diff --git a/src/app-utils/gw-app-utils-spec.scm b/src/app-utils/gw-app-utils-spec.scm index 77b3866ec3..3e7af6fd67 100644 --- a/src/app-utils/gw-app-utils-spec.scm +++ b/src/app-utils/gw-app-utils-spec.scm @@ -1,41 +1,28 @@ (define-module (g-wrapped gw-app-utils-spec)) +(debug-set! maxdepth 100000) +(debug-set! stack 2000000) + (use-modules (g-wrap)) +(use-modules (g-wrap simple-type)) + +(use-modules (g-wrap gw-standard-spec)) +(use-modules (g-wrap gw-wct-spec)) + (use-modules (g-wrapped gw-engine-spec)) -(debug-set! maxdepth 100000) -(debug-set! stack 2000000) +(let ((ws (gw:new-wrapset "gw-app-utils"))) -(let ((mod (gw:new-module "gw-app-utils"))) - (define (standard-c-call-gen result func-call-code) - (list (gw:result-get-c-name result) " = " func-call-code ";\n")) - - (define (add-standard-result-handlers! type c->scm-converter) - (define (standard-pre-handler result) - (let* ((ret-type-name (gw:result-get-proper-c-type-name result)) - (ret-var-name (gw:result-get-c-name result))) - (list "{\n" - " " ret-type-name " " ret-var-name ";\n"))) - - (gw:type-set-pre-call-result-ccodegen! type standard-pre-handler) - - (gw:type-set-post-call-result-ccodegen! - type - (lambda (result) - (let* ((scm-name (gw:result-get-scm-name result)) - (c-name (gw:result-get-c-name result))) - (list - (c->scm-converter scm-name c-name) - " }\n"))))) - - (gw:module-depends-on mod "gw-runtime") - (gw:module-depends-on mod "gw-engine") - - (gw:module-set-guile-module! mod '(g-wrapped gw-app-utils)) - - (gw:module-set-declarations-ccodegen! - mod - (lambda (client-only?) + (gw:wrapset-depends-on ws "gw-standard") + (gw:wrapset-depends-on ws "gw-wct") + + (gw:wrapset-depends-on ws "gw-engine") + + (gw:wrapset-set-guile-module! ws '(g-wrapped gw-app-utils)) + + (gw:wrapset-add-cs-declarations! + ws + (lambda (wrapset client-wrapset) (list "#include \n" "#include \n" @@ -46,48 +33,19 @@ "#include \n" "#include \n" "#include \n" - "#include \n" - ))) - (let ((wt (gw:wrap-type - mod - ' - "GNCPrintAmountInfo" "const GNCPrintAmountInfo"))) - (gw:type-set-scm-arg-type-test-ccodegen! - wt - (lambda (param) - (let ((old-func - (lambda (x) (list "gnc_printinfo_p(" x ")")))) - (old-func (gw:param-get-scm-name param))))) - (gw:type-set-pre-call-arg-ccodegen! - wt - (lambda (param) - (let* ((scm-name (gw:param-get-scm-name param)) - (c-name (gw:param-get-c-name param)) - (old-func - (lambda (x) (list "gnc_scm2printinfo(" x ")")))) - (list c-name - " = " - (old-func scm-name) - ";\n")))) - (gw:type-set-call-ccodegen! wt standard-c-call-gen) - - (add-standard-result-handlers! - wt - (lambda (scm-name c-name) - (let ((old-func - (lambda (x) (list "gnc_printinfo2scm(" x ")")))) - (list scm-name - " = " - (old-func c-name) - ";\n"))))) - - (gw:wrap-non-native-type - mod ' - "GNCOptionChangeCallback" "const GNCOptionChangeCallback") - - - (gw:wrap-function - mod + "#include \n"))) + + (gw:wrap-simple-type ws ' "GNCPrintAmountInfo" + '("gnc_printinfo_p(" scm-var ")") + '(c-var " = gnc_scm2printinfo(" scm-var ");\n") + '(scm-var " = gnc_printinfo2scm(" c-var ");\n")) + + (gw:wrap-as-wct ws + ' + "GNCOptionChangeCallback" "const GNCOptionChangeCallback") + + (gw:wrap-function + ws 'gnc:get-current-group ' "gnc_get_current_group" @@ -95,7 +53,7 @@ "Get the current top-level group.") (gw:wrap-function - mod + ws 'gnc:get-current-book ' "gnc_get_current_book" @@ -103,7 +61,7 @@ "Get the current top-level book.") (gw:wrap-function - mod + ws 'gnc:get-current-session ' "gnc_get_current_session" @@ -111,7 +69,7 @@ "Get the current session.") (gw:wrap-function - mod + ws 'gnc:exp-parser-init ' "gnc_exp_parser_init" @@ -119,7 +77,7 @@ "Initialize the expression parser.") (gw:wrap-function - mod + ws 'gnc:exp-parser-shutdown ' "gnc_exp_parser_shutdown" @@ -127,16 +85,16 @@ "Shutdown the expression parser and free any associated memory.") (gw:wrap-function - mod + ws 'gnc:parse-amount ' "gnc_parse_amount_helper" - '((( gw:const) string) + '((( caller-owned const) str) ( monetary)) "Parse the expression and return either a gnc numeric or #f.") (gw:wrap-function - mod + ws 'gnc:setup-gettext ' "gnc_setup_gettext" @@ -144,15 +102,15 @@ "Runs bindtextdomain and textdomain.") (gw:wrap-function - mod + ws 'gnc:gettext-helper - '( gw:const) + '( caller-owned const) "gnc_gettext_helper" - '((( gw:const) string)) + '((( caller-owned const) str)) "Returns the translated version of string") (gw:wrap-function - mod + ws 'gnc:c-options-init ' "gnc_options_init" @@ -160,7 +118,7 @@ "Initialize the C side options code.") (gw:wrap-function - mod + ws 'gnc:c-options-shutdown ' "gnc_options_shutdown" @@ -168,38 +126,38 @@ "Shutdown the C side options code.") (gw:wrap-function - mod + ws 'gnc:set-option-selectable-by-name ' "gnc_set_option_selectable_by_name" - '((( gw:const) section) - (( gw:const) name) + '((( caller-owned const) section) + (( caller-owned const) name) ( selectable)) "Set the appropriate option widget to be selectable or not selectable, depending on if selectable is true or false respectively.") (gw:wrap-function - mod + ws 'gnc:option-db-set-option-selectable-by-name ' "gnc_option_db_set_option_selectable_by_name" '(( guile-options) - (( gw:const) section) - (( gw:const) name) + (( caller-owned const) section) + (( caller-owned const) name) ( selectable)) "Set the appropriate option widget to be selectable or not selectable, depending on if selectable is true or false respectively.") (gw:wrap-function - mod + ws 'gnc:default-currency - '( gw:const) + '( const) "gnc_default_currency" '() "Return the default currency set by the user.") (gw:wrap-function - mod + ws 'gnc:amount->string - '( gw:const) + '( callee-owned const) "xaccPrintAmount" '(( amount) ( info)) @@ -207,7 +165,7 @@ determines formatting details.") (gw:wrap-function - mod + ws 'gnc:option-refresh-ui ' "gncp_option_refresh_ui" @@ -215,7 +173,7 @@ determines formatting details.") "Refresh the gui option with the current values.") (gw:wrap-function - mod + ws 'gnc:option-invoke-callback ' "gncp_option_invoke_callback" @@ -223,7 +181,7 @@ determines formatting details.") "Invoke the c option callback on the given data.") (gw:wrap-function - mod + ws 'gnc:option-db-register-option ' "gncp_option_db_register_option" @@ -231,7 +189,7 @@ determines formatting details.") "Register the option with the option database db_handle.") (gw:wrap-function - mod + ws 'gnc:locale-decimal-places ' "gnc_locale_decimal_places" @@ -239,33 +197,33 @@ determines formatting details.") "Return the number of decimal places for this locale.") (gw:wrap-function - mod + ws 'gnc:locale-default-currency - '( gw:const) + '( const) "gnc_locale_default_currency" '() "Return the default currency for the current locale.") (gw:wrap-function - mod + ws 'gnc:locale-default-iso-currency-code - '( gw:const) + '( callee-owned const) "gnc_locale_default_iso_currency_code" '() "Return the default iso currency code for the current locale.") (gw:wrap-function - mod + ws 'gnc:register-gui-component ' "gnc_register_gui_component_scm" - '((( gw:const) component-class) + '((( caller-owned const) component-class) ( refresh-handler) ( close-handler)) "Register a gui component with the component manager.") (gw:wrap-function - mod + ws 'gnc:gui-component-watch-entity ' "gnc_gui_component_watch_entity_direct" @@ -275,17 +233,17 @@ determines formatting details.") "Watch the events for a particular entity.") (gw:wrap-function - mod + ws 'gnc:gui-component-watch-entity-type ' "gnc_gui_component_watch_entity_type" '(( component-id) - (( gw:const) id-type) + (( caller-owned const) id-type) ( event-type-mask)) "Watch the events for a particular entity type.") (gw:wrap-function - mod + ws 'gnc:unregister-gui-component ' "gnc_unregister_gui_component" @@ -293,7 +251,7 @@ determines formatting details.") "Unregister a gui component by id.") (gw:wrap-function - mod + ws 'gnc:suspend-gui-refresh ' "gnc_suspend_gui_refresh" @@ -301,7 +259,7 @@ determines formatting details.") "Suspend gui refresh events.") (gw:wrap-function - mod + ws 'gnc:resume-gui-refresh ' "gnc_resume_gui_refresh" @@ -309,7 +267,7 @@ determines formatting details.") "Resume gui refresh events.") (gw:wrap-function - mod + ws 'gnc:gui-refresh-all ' "gnc_gui_refresh_all" @@ -317,7 +275,7 @@ determines formatting details.") "Refresh all gui components.") (gw:wrap-function - mod + ws 'gnc:gui-refresh-suspended ' "gnc_gui_refresh_suspended" @@ -325,7 +283,7 @@ determines formatting details.") "Return #t if refreshes are suspended.") (gw:wrap-function - mod + ws 'gnc:close-gui-component ' "gnc_close_gui_component" @@ -333,15 +291,15 @@ determines formatting details.") "Close a gui component by id.") (gw:wrap-function - mod + ws 'gnc:account-get-full-name - '() + '( caller-owned) "gnc_account_get_full_name" '(( account)) "Return the fully-qualified name of the account.") (gw:wrap-function - mod + ws 'gnc:default-print-info ' "gnc_default_print_info" @@ -349,7 +307,7 @@ determines formatting details.") "Return the default print info object.") (gw:wrap-function - mod + ws 'gnc:commodity-print-info ' "gnc_commodity_print_info" @@ -357,7 +315,7 @@ determines formatting details.") "Return the default print info for commodity.") (gw:wrap-function - mod + ws 'gnc:account-print-info ' "gnc_account_print_info" @@ -365,7 +323,7 @@ determines formatting details.") "Return a print info for printing account balances.") (gw:wrap-function - mod + ws 'gnc:split-amount-print-info ' "gnc_split_amount_print_info" @@ -373,7 +331,7 @@ determines formatting details.") "Return a print info for printing split amounts.") (gw:wrap-function - mod + ws 'gnc:split-value-print-info ' "gnc_split_value_print_info" @@ -381,7 +339,7 @@ determines formatting details.") "Return a print info for print split value quantities.") (gw:wrap-function - mod + ws 'gnc:default-share-print-info ' "gnc_default_share_print_info" @@ -389,7 +347,7 @@ determines formatting details.") "Return a print info for printing generic share quantities.") (gw:wrap-function - mod + ws 'gnc:default-price-print-info ' "gnc_default_price_print_info" @@ -397,7 +355,7 @@ determines formatting details.") "Return a print info for printing generic price quantities.") (gw:wrap-function - mod + ws 'gnc:account-reverse-balance? ' "gnc_reverse_balance" @@ -405,7 +363,7 @@ determines formatting details.") "Given an account, find out whether the balance should be reversed for display") (gw:wrap-function - mod + ws 'gnc:is-euro-currency ' "gnc_is_euro_currency" @@ -413,15 +371,15 @@ determines formatting details.") "Check if a given currency is a EURO currency") (gw:wrap-function - mod + ws 'gnc:is-euro-currency-code ' "gnc_is_euro_currency_code" - '(( gw:const)) + '((( caller-owned const) str)) "Check if a given currency is a EURO currency") (gw:wrap-function - mod + ws 'gnc:convert-to-euro ' "gnc_convert_to_euro" @@ -429,7 +387,7 @@ determines formatting details.") "Convert the value from the given currency to EURO") (gw:wrap-function - mod + ws 'gnc:convert-from-euro ' "gnc_convert_from_euro" @@ -437,7 +395,7 @@ determines formatting details.") "Convert the value from EURO to the given currency") (gw:wrap-function - mod + ws 'gnc:euro-currency-get-rate ' "gnc_euro_currency_get_rate" @@ -445,7 +403,7 @@ determines formatting details.") "Returns the exchange rate from the given currency to EURO") (gw:wrap-function - mod + ws 'gnc:get-euro ' "gnc_get_euro" @@ -453,10 +411,9 @@ determines formatting details.") "Returns the commodity EURO") (gw:wrap-function - mod + ws 'gnc:account-separator-char - '( gw:const) + '( callee-owned const) "gnc_get_account_separator_string" '() - "Returns a string with the user-selected account separator") -) + "Returns a string with the user-selected account separator"))