From 3d275a3715cb04d9b9b94f3847dc340cae3ed310 Mon Sep 17 00:00:00 2001 From: John Ralls Date: Sat, 6 Aug 2022 11:18:32 -0700 Subject: [PATCH] [options] Improve Scheme API consistency --- bindings/guile/gnc-optiondb.i | 28 ++++-- bindings/guile/options.scm | 93 +++++++++---------- .../test/test-gnc-option-scheme-output.scm | 14 +-- bindings/guile/test/test-gnc-optiondb.scm | 39 +++----- bindings/guile/test/test-options.scm | 2 +- gnucash/report/gnc-report.cpp | 2 +- gnucash/report/report-core.scm | 51 +++++----- .../reports/standard/account-summary.scm | 2 +- .../report/reports/standard/view-column.scm | 2 +- gnucash/report/test/test-report.scm | 12 +-- 10 files changed, 119 insertions(+), 126 deletions(-) diff --git a/bindings/guile/gnc-optiondb.i b/bindings/guile/gnc-optiondb.i index 557b2228a1..e804f8d869 100644 --- a/bindings/guile/gnc-optiondb.i +++ b/bindings/guile/gnc-optiondb.i @@ -931,11 +931,18 @@ wrap_unique_ptr(GncOptionDBPtr, GncOptionDB); return gnc_relative_date_to_time64(scm_relative_date_get_period(date)); } - %} +%} //%header %ignore GncOptionMultichoiceKeyType; %inline %{ + + inline SCM + is_gncoptiondb (const SCM ptr) + { + return SWIG_Guile_IsPointerOfType (ptr, SWIGTYPE_p_std__unique_ptrT_GncOptionDB_t) ? SCM_BOOL_T : SCM_BOOL_F; + } + inline GncMultichoiceOptionIndexVec scm_to_multichoices(const SCM new_value, const GncOptionMultichoiceValue& option) @@ -1108,6 +1115,11 @@ inline SCM return_scm_value(ValueType value) %template(gnc_make_int64_option) gnc_make_option; %template(gnc_make_query_option) gnc_make_option; %template(gnc_make_owner_option) gnc_make_option; + +%rename (get_value) GncOption::get_scm_value; +%rename (get_default_value) GncOption::get_scm_default_value; +%rename (set_value) GncOption::set_value_from_scm; +%rename (set_default_value) GncOption::set_default_value_from_scm; %extend GncOption { bool is_budget_option() { @@ -1529,8 +1541,7 @@ inline SCM return_scm_value(ValueType value) %template(set_option_time64) set_option; }; -%template(gnc_register_number_range_option_double) gnc_register_number_range_option; -%template(gnc_register_number_range_option_int) gnc_register_number_range_option; +%template(gnc_register_number_range_option) gnc_register_number_range_option; %inline %{ /* qof_book_set_data isn't exported by sw-engine and we need it to set up a @@ -1812,7 +1823,7 @@ inline SCM return_scm_value(ValueType value) using GncOptionDBPtr = std::unique_ptr; /* Forward decls */ - GncOptionDBPtr new_gnc_optiondb(); + GncOptionDBPtr gnc_new_optiondb(); GncOption* gnc_lookup_option(const GncOptionDBPtr& optiondb, const char* section, const char* name); @@ -1827,8 +1838,9 @@ inline SCM return_scm_value(ValueType value) } static SCM - gnc_option_db_lookup_value(const GncOptionDB* optiondb, const char* section, - const char* name) + gnc_optiondb_lookup_value(const GncOptionDBPtr& optiondb, + const char* section, + const char* name) { auto db_opt = optiondb->find_option(section, name); if (!db_opt) @@ -1869,7 +1881,7 @@ inline SCM return_scm_value(ValueType value) } GncOptionDBPtr - new_gnc_optiondb() + gnc_new_optiondb() { auto db_ptr{std::make_unique()}; return db_ptr; @@ -1883,7 +1895,7 @@ inline SCM return_scm_value(ValueType value) } static void - gnc_option_db_set_option_selectable_by_name(GncOptionDBPtr& odb, + gnc_optiondb_set_option_selectable_by_name(GncOptionDBPtr& odb, const char* section, const char* name, bool selectable) diff --git a/bindings/guile/options.scm b/bindings/guile/options.scm index 847fc00e05..c1a4f58e25 100644 --- a/bindings/guile/options.scm +++ b/bindings/guile/options.scm @@ -31,24 +31,30 @@ (use-modules (ice-9 format)) (use-modules (ice-9 pretty-print)) +;; Conditionally extract the GncOptionDBPtr& from a passed in options: +; If it's a procedure then it's the object returned by gnc:new-options; +; otherwise it is assumed to be a GncOptionDBPtr&. +(define-public (gnc:optiondb options) + (if (procedure? options) (options 'get) options)) + (define-public (gnc:lookup-option options section name) (if options - (gnc-lookup-option (options 'lookup) section name) + (gnc-lookup-option (gnc:optiondb options) section name) #f)) (define-public (gnc:option-setter option) - (issue-deprecation-warning "gnc:option-setter is deprecated. Option values are set and retrieved by gnc-set-option and gnc-option-db-lookup.") + (issue-deprecation-warning "gnc:option-setter is deprecated. Option values are set and retrieved by gnc-set-option and gnc-optiondb-lookup-value.") (lambda (value) - (GncOption-set-value-from-scm option value) + (GncOption-set-value option value) )) (define-public (gnc:option-set-value option value) (issue-deprecation-warning "gnc:option-set-value and indeed all direct option access is deprecated. Use gnc-set-option instead.") - (GncOption-set-value-from-scm option value)) + (GncOption-set-value option value)) (define-public (gnc:option-set-default-value option value) (issue-deprecation-warning "gnc:option-set-default-value and indeed all direct option access is deprecated. Use gnc-set-option instead.") - (GncOption-set-default-value-from-scm option value)) + (GncOption-set-default-value option value)) (define-public (gnc:option-section option) (GncOption-get-section option)) @@ -57,29 +63,31 @@ (GncOption-get-name option)) (define-public (gnc:option-default-value option) - (GncOption-get-scm-default-value option)) + (GncOption-get-default-value option)) (define-public (gnc:option-value option) - (issue-deprecation-warning "gnc:option-value and indeed all direct option access is deprecated. Use gnc-option-db-lookup-option instead.") - (GncOption-get-scm-value option)) + (issue-deprecation-warning "gnc:option-value and indeed all direct option access is deprecated. Use gnc-optiondb-lookup-value instead.") + (GncOption-get-value option)) -(define-public (gnc:color-option->html opt) +(define-public (gnc:color->html color) ;; HTML doesn't like alpha values. - (let* ((color (GncOption-get-scm-value opt)) - (html-color (if (> (string-length color) 6) - (substring color 0 6) - color))) + (let ((html-color (if (> (string-length color) 6) + (substring color 0 6) + color))) (format #f "#~a" html-color))) +(define-public (gnc:color-option->html opt) + (gnc:color->html (GncOption-get-value opt))) + (define-public (gnc:color-option->hex-string opt) - (format #f "~a" (GncOption-get-scm-value opt))) + (format #f "~a" (GncOption-get-value opt))) (define-public (gnc:option-get-value book category key) (define acc (if (pair? key) cons list)) (qof-book-get-option book (acc category key))) (define-public (gnc:option-make-internal! options section name) - (let ((option (gnc-lookup-option (options 'lookup) section name))) + (let ((option (gnc-lookup-option (gnc:optiondb options) section name))) (and option (GncOption-make-internal option)))) (define-public (gnc:option-type option) @@ -87,20 +95,16 @@ ;; Create the database and return a dispatch function. (define-public (gnc:new-options) - (let ((optiondb (new-gnc-optiondb))) + (let ((optiondb (gnc-new-optiondb))) (define (dispatch key) optiondb) dispatch)) -;; Use the dispatch function to get the optiondb -(define-public (gnc:options-get dispatch) - (dispatch 'get)) - -(define-public (gnc:options-set-default-section optiondb section) - (GncOptionDB-set-default-section (GncOptionDBPtr-get (optiondb 'set-default-section)) section)) +(define-public (gnc:options-set-default-section options section) + (GncOptionDBPtr-set-default-section (gnc:optiondb options) section)) (define-public (gnc:options-for-each func optdb) - (gnc-optiondb-foreach (optdb 'foreach) func)) + (gnc-optiondb-foreach (gnc:optiondb optdb) func)) ;; Copies all values from src-options to dest-options, that is, it ;; copies the values of all options from src which exist in dest to @@ -110,12 +114,12 @@ dest-options (gnc:options-for-each (lambda (src-option) - (let ((dest-option (gnc:lookup-option dest-options + (let ((dest-option (gnc-lookup-option (gnc:optiondb dest-options) (gnc:option-section src-option) (gnc:option-name src-option)))) (if dest-option - (gnc:option-set-value dest-option - (gnc:option-value src-option))))) + (GncOption-set-value dest-option + (GncOption-get-value src-option))))) src-options))) ;; Get scheme commands to set changed options, used to write a file that will @@ -132,8 +136,8 @@ (GncOption-is-budget-option option)) (define (option-op option) - (let ((value (gnc:option-value option)) - (default-value (gnc:option-default-value option))) + (let ((value (GncOption-get-value option)) + (default-value (GncOption-get-default-value option))) (if (not (equal? value default-value)) (display (string-append "(let ((option (gnc:lookup-option " toplevel-name "\n" @@ -144,7 +148,7 @@ " (" (cond ((gnc:option-is-budget? option) - (let* ((budget (gnc:option-value option)) + (let* ((budget (GncOption-get-value option)) (guid (gncBudgetGetGUID budget)) (guid-string (gnc:value->string guid))) (if (string? guid-string) @@ -163,8 +167,7 @@ " option))\n\n"))))) (define (generate-forms) - (let ((odb (options 'generate-restore-forms))) - (gnc-optiondb-foreach2 odb section-op option-op))) + (gnc-optiondb-foreach2 (gnc:optiondb options) section-op option-op)) (with-output-to-string generate-forms)) @@ -172,11 +175,11 @@ ;; The following implement the old API that separated creation from registration. (define-public (gnc:register-option optdb opt) (issue-deprecation-warning "gnc:register-option is deprecated. Use gnc-register-foo-option instead.") - (GncOptionDB-register-option (GncOptionDBPtr-get (optdb 'register-option)) - (GncOption-get-section opt) opt)) + (GncOptionDBPtr-register-option (gnc:optiondb optdb) + (GncOption-get-section opt) opt)) (define-public (gnc:unregister-option optdb section name) - (GncOptionDB-unregister-option (GncOptionDBPtr-get (optdb 'unregister-option)) section name)) + (GncOptionDBPtr-unregister-option (gnc:optiondb optdb) section name)) (define-public (gnc:make-string-option section name key docstring default) (issue-deprecation-warning "gnc:make-string-option is deprecated. Make and register the option in one command with gnc-register-string-option.") @@ -226,7 +229,7 @@ (let ((defval (if default (default) '()))) (gnc-make-account-sel-limited-option section name key docstring defval '()))) (define-public (gnc:make-multichoice-option section name key docstring default multichoice) - (issue-deprecation-warning "gnc:make-multichoice-option is deprecated. Make and register the option in one command with gnc:register-multichoice-option.") + (issue-deprecation-warning "gnc:make-multichoice-option is deprecated. Make and register the option in one command with gnc-register-multichoice-option.") (let ((defval (cond ((symbol? default) (symbol->string default)) ((number? default) @@ -321,13 +324,13 @@ (both (if (eq? subtype 'both) #t #f))) (gnc-make-date-option section name key docstring default relative-date-list both))) -(define-public (gnc:options-make-end-date! optiondb pagename optname sort-tag docstring) - (gnc-register-end-date-option (optiondb 'make-option) pagename optname sort-tag docstring)) +(define-public (gnc:options-make-end-date! options pagename optname sort-tag docstring) + (gnc-register-end-date-option (gnc:optiondb options) pagename optname sort-tag docstring)) -(define-public (gnc:options-make-date-interval! optiondb pagename name-from info-from name-to info-to sort-tag) - (gnc-register-start-date-option (optiondb 'make-option) pagename name-from +(define-public (gnc:options-make-date-interval! options pagename name-from info-from name-to info-to sort-tag) + (gnc-register-start-date-option (gnc:optiondb options) pagename name-from (string-append sort-tag "a") info-from) - (gnc-register-end-date-option (optiondb 'make-option) pagename name-to + (gnc-register-end-date-option (gnc:optiondb options) pagename name-to (string-append sort-tag "b") info-to)) (define-public (gnc:date-option-absolute-time option-value) (if (pair? option-value) @@ -335,16 +338,6 @@ (cdr option-value) (gnc-relative-date-to-time64 (cdr option-value))) option-value)) -;; This is a special case where we can't use the exported registration function -;; because we need to transform the default argument first depending on its -;; Scheme type. -(define-public (gnc:register-multichoice-option options section name key docstring default multichoice) - (let ((defval (cond ((symbol? default) - (symbol->string default)) - ((number? default) - (number->string default)) - (else default)))) - (gnc-register-multichoice-option options section name key docstring defval multichoice))) ;; Scheme code for supporting options for the business modules ;; diff --git a/bindings/guile/test/test-gnc-option-scheme-output.scm b/bindings/guile/test/test-gnc-option-scheme-output.scm index dd32ea3c6f..bca38a1374 100644 --- a/bindings/guile/test/test-gnc-option-scheme-output.scm +++ b/bindings/guile/test/test-gnc-option-scheme-output.scm @@ -142,7 +142,7 @@ (define (test-gnc-string-option-to-scheme) (test-begin "test-gnc-string-option-to-scheme") (test-option-scheme-output "string" - gnc:make-string-option GncOption-get-scm-value + gnc:make-string-option GncOption-get-value test-string-output-template "waldo" "pepper") (test-end "test-gnc-string-option-to-scheme")) @@ -150,7 +150,7 @@ (define (test-gnc-text-option-to-scheme) (test-begin "test-gnc-text-option-to-scheme") (test-option-scheme-output "text" - gnc:make-string-option GncOption-get-scm-value + gnc:make-string-option GncOption-get-value test-string-output-template "" "Sed ut perspiciatis, unde omnis iste natus error sit voluptatem accusantium @@ -161,7 +161,7 @@ veritatis et quasi architecto beatae vitae dicta sunt, explicabo.") (define (test-gnc-font-option-to-scheme) (test-begin "test-gnc-font-option-to-scheme") (test-option-scheme-output "font" - gnc:make-font-option GncOption-get-scm-value + gnc:make-font-option GncOption-get-value test-string-output-template "URW Bookman L Bold Italic 12" "Helvetica 12") @@ -231,14 +231,14 @@ veritatis et quasi architecto beatae vitae dicta sunt, explicabo.") (test-begin "test-gnc-bool-option-to-scheme") (test-option-scheme-output "bool" gnc:make-simple-boolean-option - GncOption-get-scm-value + GncOption-get-value test-string-output-template #f #t) (test-end "test-gnc-bool-option-to-scheme")) (define (test-gnc-pixmap-option-to-scheme) (test-begin "test-gnc-pixmap-option-to-scheme") (test-option-scheme-output "pixmap" - gnc:make-pixmap-option GncOption-get-scm-value + gnc:make-pixmap-option GncOption-get-value test-string-output-template "" "~/mybusiness/mylogo.png") (test-end "test-gnc-pixmap-option-to-scheme")) @@ -258,7 +258,7 @@ veritatis et quasi architecto beatae vitae dicta sunt, explicabo.") (gnc:generate-restore-forms odb "options")) (set! value '(relative . end-prev-year)) (gnc:option-set-value option value) - (test-equal "Relative Date Value" value (GncOption-get-scm-value option)) + (test-equal "Relative Date Value" value (GncOption-get-value option)) (test-equal "Relative Date" (test-template (GncOption-serialize option)) (gnc:generate-restore-forms odb "options")))) (test-end "test-gnc-date-option-to-scheme")) @@ -503,7 +503,7 @@ veritatis et quasi architecto beatae vitae dicta sunt, explicabo.") (let ((option (gnc:lookup-option odb "__reg" "query")) (test-template query-literal-output-template)) (gnc:option-set-value option (gnc-scm2query query-scm)) - (test-equal "query form" (test-template (GncOption-get-scm-value option)) + (test-equal "query form" (test-template (GncOption-get-value option)) (gnc:generate-restore-forms odb "options")) )) (test-end "test-gnc-query-option-to-scheme")) diff --git a/bindings/guile/test/test-gnc-optiondb.scm b/bindings/guile/test/test-gnc-optiondb.scm index f19af10088..64bcb48424 100644 --- a/bindings/guile/test/test-gnc-optiondb.scm +++ b/bindings/guile/test/test-gnc-optiondb.scm @@ -24,18 +24,6 @@ (use-modules (srfi srfi-64)) (use-modules (tests srfi64-extras)) -;; This is a special case where we can't use the exported registration function -;; because we need to transform the default argument first depending on its -;; Scheme type. -(define (gnc:register-multichoice-option options section name key docstring default multichoice) - (issue-deprecation-warning "gnc:make-multichoice-option is deprecated. Make and register the option in one command with gnc-register-multichoice-option.") - (let ((defval (cond ((symbol? default) - (symbol->string default)) - ((number? default) - (number->string default)) - (else default)))) - (gnc-register-multichoice-option options section name key docstring defval multichoice))) - ;; Load the C++ option implementation, avoiding the options.scm ones. (eval-when (compile load eval expand) @@ -59,7 +47,7 @@ (define (test-gnc-make-text-option) (test-begin "test-gnc-test-string-option") - (let* ((option-db (new-gnc-optiondb)) + (let* ((option-db (gnc-new-optiondb)) (string-opt (gnc-register-string-option option-db "foo" "bar" "baz" "Phony Option" "waldo"))) (test-equal "waldo" (gnc-option-value option-db "foo" "bar")) @@ -103,7 +91,7 @@ (define (test-make-account-list-option book) (test-group "test-make-account-list-option" - (let ((option-db (new-gnc-optiondb)) + (let ((option-db (gnc-new-optiondb)) (acctlist (gnc-account-list-from-types book (list ACCT-TYPE-STOCK)))) (gnc-register-account-list-option option-db "foo" "bar" "baz" @@ -114,7 +102,7 @@ (define (test-make-account-list-limited-option book) (test-group "test-make-account-list-limited-option" - (let ((option-db (new-gnc-optiondb)) + (let ((option-db (gnc-new-optiondb)) (acctlist (gnc-account-list-from-types book (list ACCT-TYPE-STOCK)))) (gnc-register-account-list-limited-option ;; Error not account type twice @@ -131,7 +119,7 @@ (define (test-make-account-sel-limited-option book) (test-group "test-make-account-list-option" - (let ((option-db (new-gnc-optiondb)) + (let ((option-db (gnc-new-optiondb)) (acctlist (gnc-account-list-from-types book (list ACCT-TYPE-STOCK)))) (gnc-register-account-sel-limited-option @@ -165,15 +153,16 @@ (assq-ref (assq-ref keylist key) info)) (test-begin "test-gnc-test-multichoice-option") - (let* ((option-db (new-gnc-optiondb)) + (let* ((option-db (gnc-new-optiondb)) (multilist (list (list "plugh" (cons 'text "xyzzy") (cons 'tip "thud")) (list 'waldo (cons 'text "pepper") (cons 'tip "salt")) (list "pork" (cons 'text "sausage") (cons 'tip "links")) (list "corge" (cons 'text "grault") (cons 'tip "garply")))) (multichoice (keylist->vectorlist multilist)) - (multi-opt (gnc:register-multichoice-option option-db "foo" "bar" "baz" - "Phony Option" 'waldo multichoice))) + (multi-opt (gnc-register-multichoice-option + option-db "foo" "bar" "baz" + "Phony Option" "waldo" multichoice))) (test-equal 'waldo (gnc-option-value option-db "foo" "bar")) (gnc-set-option option-db "foo" "bar" "corge") @@ -183,7 +172,7 @@ (define (test-gnc-make-list-option) (test-begin "test-gnc-test-list-option") - (let* ((option-db (new-gnc-optiondb)) + (let* ((option-db (gnc-new-optiondb)) (value-list (list (vector "AvgBalPlot" "Average" "Average Balance") (vector "GainPlot" "Profit" "Profit (Gain minus Loss)") (vector "GLPlot" "Gain/Loss" "Gain and Loss"))) @@ -198,7 +187,7 @@ (define (test-gnc-make-date-option) (test-begin "test-gnc-test-date-option") - (let* ((option-db (new-gnc-optiondb)) + (let* ((option-db (gnc-new-optiondb)) (date-opt (gnc-register-date-option option-db "foo" "bar" "baz" "Phony Option" (RelativeDatePeriod-TODAY))) @@ -210,7 +199,7 @@ (define (test-gnc-make-date-set-option) (test-begin "test-gnc-test-date-set-option") - (let* ((option-db (new-gnc-optiondb)) + (let* ((option-db (gnc-new-optiondb)) (date-opt (gnc-register-date-option-set option-db "foo" "bar" "baz" "Phony Option" '(today @@ -228,8 +217,8 @@ (define (test-gnc-make-number-range-option) (test-begin "test-gnc-number-range-option") - (let* ((option-db (new-gnc-optiondb)) - (number-opt (gnc-register-number-range-option-double option-db "foo" "bar" + (let* ((option-db (gnc-new-optiondb)) + (number-opt (gnc-register-number-range-option option-db "foo" "bar" "baz" "Phony Option" 15 5 30 1))) (test-equal 15.0 (gnc-option-value option-db "foo" "bar")) @@ -242,7 +231,7 @@ (let* ((report1 123) (report2 456) (rp (list (list report1 2 3) (list report2 3 2))) - (option-db (new-gnc-optiondb))) + (option-db (gnc-new-optiondb))) (gnc-register-report-placement-option option-db "foo" "bar") (gnc-set-option option-db "foo" "bar" rp) (test-equal report2 (car (cadr (gnc-option-value option-db "foo" "bar"))))) diff --git a/bindings/guile/test/test-options.scm b/bindings/guile/test/test-options.scm index f243e195f8..c6692e73f9 100644 --- a/bindings/guile/test/test-options.scm +++ b/bindings/guile/test/test-options.scm @@ -14,7 +14,7 @@ (test-end "test-options")) (define (test-lookup-option) - (let* ((options (new-gnc-optiondb)) + (let* ((options (gnc-new-optiondb)) (string-opt (gnc-register-string-option options "Section" "Start Date" "sort-tag" "docstring" "waldo") )) diff --git a/gnucash/report/gnc-report.cpp b/gnucash/report/gnc-report.cpp index 544f01139d..71c429de8c 100644 --- a/gnucash/report/gnc-report.cpp +++ b/gnucash/report/gnc-report.cpp @@ -397,7 +397,7 @@ gnc_saved_reports_write_to_file (const gchar* report_def, gboolean overwrite) GncOptionDB* gnc_get_optiondb_from_dispatcher(SCM dispatcher) { - SCM get_options = scm_c_eval_string("gnc:options-get"); + SCM get_options = scm_c_eval_string("gnc:optiondb"); if (dispatcher == SCM_BOOL_F) return nullptr; auto scm_ptr{scm_call_1(get_options, dispatcher)}; diff --git a/gnucash/report/report-core.scm b/gnucash/report/report-core.scm index 26573c0ca9..4aa199c1c4 100644 --- a/gnucash/report/report-core.scm +++ b/gnucash/report/report-core.scm @@ -286,37 +286,36 @@ not found."))) (gnc:report-template-renderer templ)))) (define (gnc:report-template-new-options report-template) - (let ((generator (gnc:report-template-options-generator report-template)) - (namer - (gnc:make-string-option - gnc:pagename-general gnc:optname-reportname "0a" - (N_ "Enter a descriptive name for this report.") - (G_ (gnc:report-template-name report-template)))) - (stylesheet - (gnc:make-multichoice-option - gnc:pagename-general gnc:optname-stylesheet "0b" - (N_ "Select a stylesheet for the report.") - (string->symbol (N_ "Default")) - (map - (lambda (ss) - (vector - (string->symbol (gnc:html-style-sheet-name ss)) - (gnc:html-style-sheet-name ss))) - (gnc:get-html-style-sheets))))) - - (let ((options (if (procedure? generator) + (let* ((generator (gnc:report-template-options-generator report-template)) + (options (if (procedure? generator) (or (gnc:backtrace-if-exception generator) (begin (gnc:warn "BUG DETECTED: Scheme exception raised in " "report options generator procedure named " (procedure-name generator)) - (gnc:new-options))) - (gnc:new-options)))) - (or (gnc:lookup-option options gnc:pagename-general gnc:optname-reportname) - (gnc:register-option options namer)) - (or (gnc:lookup-option options gnc:pagename-general gnc:optname-stylesheet) - (gnc:register-option options stylesheet)) - options))) + (gnc-new-optiondb))) + (gnc-new-optiondb))) + (optiondb (gnc:optiondb options))) + (or + (gnc-lookup-option optiondb gnc:pagename-general gnc:optname-reportname) + (gnc-register-string-option optiondb + gnc:pagename-general gnc:optname-reportname "0a" + (N_ "Enter a descriptive name for this report.") + (G_ (gnc:report-template-name report-template)))) + (or + (gnc-lookup-option optiondb gnc:pagename-general gnc:optname-stylesheet) + (gnc-register-multichoice-option + optiondb + gnc:pagename-general gnc:optname-stylesheet "0b" + (N_ "Select a stylesheet for the report.") + (N_ "Default") + (map + (lambda (ss) + (vector + (string->symbol (gnc:html-style-sheet-name ss)) + (gnc:html-style-sheet-name ss))) + (gnc:get-html-style-sheets)))) + options)) ;; A represents an instantiation of a particular report type. (define-record-type diff --git a/gnucash/report/reports/standard/account-summary.scm b/gnucash/report/reports/standard/account-summary.scm index 14a9347acb..c8d628b250 100644 --- a/gnucash/report/reports/standard/account-summary.scm +++ b/gnucash/report/reports/standard/account-summary.scm @@ -143,7 +143,7 @@ (define (accsum-options-generator sx? reportname) (let* ((options (gnc:new-options)) - (odb (gnc:options-get options))) + (odb (gnc:optiondb options))) (gnc-register-string-option odb gnc:pagename-general optname-report-title diff --git a/gnucash/report/reports/standard/view-column.scm b/gnucash/report/reports/standard/view-column.scm index 352d59317a..e075f2f48d 100644 --- a/gnucash/report/reports/standard/view-column.scm +++ b/gnucash/report/reports/standard/view-column.scm @@ -42,7 +42,7 @@ (gnc:register-option options opt)))) ;; the report-list is edited by a special add-on page for the ;; options editor. - (gnc-register-report-placement-option (gnc:options-get options) "__general" "report-list") + (gnc-register-report-placement-option (gnc:optiondb options) "__general" "report-list") (opt-register (gnc:make-number-range-option diff --git a/gnucash/report/test/test-report.scm b/gnucash/report/test/test-report.scm index 94bff2c080..50386fcdbc 100644 --- a/gnucash/report/test/test-report.scm +++ b/gnucash/report/test/test-report.scm @@ -132,8 +132,8 @@ (define test4-name "Test Report Template") (test-begin "test-report-template-getters") (test-assert "gnc:report-template-new-options/report-guid" - (procedure? - (gnc:report-template-new-options/report-guid test4-guid test4-name))) + (is-gncoptiondb + (gnc:optiondb (gnc:report-template-new-options/report-guid test4-guid test4-name)))) (test-equal "gnc:report-template-menu-name/report-guid" "Menu Name" (gnc:report-template-menu-name/report-guid test4-guid test4-name)) @@ -141,8 +141,8 @@ "Renderer" (gnc:report-template-renderer/report-guid test4-guid test4-name)) (test-assert "gnc:report-template-new-options" - (procedure? - (gnc:report-template-new-options (gnc:find-report-template test4-guid)))) + (is-gncoptiondb + (gnc:optiondb (gnc:report-template-new-options (gnc:find-report-template test4-guid))))) (test-end "test-report-template-getters")) (define (test-make-report) @@ -159,8 +159,8 @@ (gnc:restore-report-by-guid-with-custom-template "id" test4-guid test4-name "custom-template-id" #f))) (test-assert "gnc:make-report-options" - (procedure? - (gnc:make-report-options test4-guid))) + (is-gncoptiondb + (gnc:optiondb (gnc:make-report-options test4-guid)))) (test-end "test-make-report")) (define (test-report)