From 00a982d97d6a628d2750611fe8a5b533cb682535 Mon Sep 17 00:00:00 2001 From: John Ralls Date: Mon, 30 Aug 2021 13:46:10 -0700 Subject: [PATCH] Use Scheme to generate and parse saved option files. The saved option files being Scheme executables. --- libgnucash/app-utils/gnc-optiondb.i | 96 +++- libgnucash/app-utils/options.scm | 59 ++- libgnucash/app-utils/test/CMakeLists.txt | 3 +- .../test/test-gnc-option-scheme-output.scm | 432 ++++++++++++++++++ 4 files changed, 577 insertions(+), 13 deletions(-) create mode 100644 libgnucash/app-utils/test/test-gnc-option-scheme-output.scm diff --git a/libgnucash/app-utils/gnc-optiondb.i b/libgnucash/app-utils/gnc-optiondb.i index 1fbbf575a5..39a9f18606 100644 --- a/libgnucash/app-utils/gnc-optiondb.i +++ b/libgnucash/app-utils/gnc-optiondb.i @@ -54,6 +54,8 @@ static const QofLogModule log_module = "gnc.optiondb"; SCM scm_init_sw_gnc_optiondb_module(void); %} +%ignore gnc_get_current_session(void); + %include %import %import (module="sw_engine") @@ -550,6 +552,7 @@ gnc_option_test_book_destroy(QofBook* book) %typemap(in) GncOptionAccountList& (GncOptionAccountList acclist) { auto len = scm_is_true($input) ? scm_to_size_t(scm_length($input)) : 0; + acclist.reserve(len); for (std::size_t i = 0; i < len; ++i) { SCM s_account = scm_list_ref($input, scm_from_size_t(i)); @@ -737,7 +740,7 @@ wrap_unique_ptr(GncOptionDBPtr, GncOptionDB); reldate_str = scm_to_utf8_string(scm_symbol_to_string(reldate_scm)); else reldate_str = scm_to_utf8_string(reldate_scm); - + auto date_iter = std::find_if(reldate_values.begin(), reldate_values.end(), [&reldate_scm](auto val)->bool { @@ -971,6 +974,12 @@ inline SCM return_scm_value(ValueType value) %template(gnc_make_owner_option) gnc_make_option; %extend GncOption { + bool is_budget_option() + { + auto uitype{$self->get_ui_type()}; + return uitype == GncOptionUIType::BUDGET; + } + SCM get_scm_value() { if (!$self) @@ -994,6 +1003,41 @@ inline SCM return_scm_value(ValueType value) }, swig_get_option($self)); } + SCM save_scm_value() + { + const SCM plain_format_str{scm_from_utf8_string("~s")}; + const SCM ticked_format_str{scm_from_utf8_string("'~a")}; +//scm_simple_format needs a scheme list of arguments to match the format +//placeholders. + auto value{scm_list_1(GncOption_get_scm_value($self))}; + auto uitype{$self->get_ui_type()}; + if (uitype == GncOptionUIType::STRING || + uitype == GncOptionUIType::TEXT || + uitype == GncOptionUIType::FONT || + uitype == GncOptionUIType::BOOLEAN || + uitype == GncOptionUIType::PIXMAP + ) + { + return scm_simple_format(SCM_BOOL_F, plain_format_str, value); + } + else if (uitype == GncOptionUIType::ACCOUNT_LIST || + uitype == GncOptionUIType::ACCOUNT_SEL || + uitype == GncOptionUIType::INVOICE || + uitype == GncOptionUIType::TAX_TABLE || + uitype == GncOptionUIType::OWNER) + { + if (value && scm_is_true(value)) + return scm_simple_format(SCM_BOOL_F, plain_format_str, value); + else + return scm_simple_format(SCM_BOOL_F, plain_format_str, + SCM_BOOL_F); + } + else + { + return scm_simple_format(SCM_BOOL_F, ticked_format_str, value); + } + } + void set_value_from_scm(SCM new_value) { if (!$self) @@ -1066,7 +1110,7 @@ inline SCM return_scm_value(ValueType value) option.set_default_value(scm_absolute_date_to_time64(new_value)); else option.set_default_value(scm_relative_date_get_period(new_value)); - return; + return; } if constexpr (is_same_decayed_v) @@ -1137,6 +1181,30 @@ inline SCM return_scm_value(ValueType value) %template(gnc_register_number_range_option_int) gnc_register_number_range_option; %inline %{ + /* qof_book_set_data isn't exported by sw-engine and we need it to set up a + * commodity namespace table to test currencies.*/ + static void + test_book_set_data(QofBook* book, const char* key, void* data) + { + qof_book_set_data(book, key, data); + } + + static void + test_book_clear_data(QofBook* book, const char* key) + { + qof_book_set_data(book, key, nullptr); + } + + static void + test_book_set_default_budget(QofBook* book, GncBudget* budget) + { + auto budget_guid{gnc_budget_get_guid(budget)}; + qof_book_begin_edit(book); + qof_instance_set(QOF_INSTANCE(book), "default-budget", + budget_guid, nullptr); + qof_book_commit_edit(book); + } + static GncOption* gnc_make_account_list_option(const char* section, const char* name, const char* key, @@ -1473,10 +1541,28 @@ inline SCM return_scm_value(ValueType value) }); } - std::string - gnc_optiondb_save_to_scheme(GncOptionDBPtr& odb, const char* prolog) + /** Tailred for gnc:generate-restore-forms. + * @param section_op A function to be called on each section name + * @param option_op a function to be called on each option + */ + static void + gnc_optiondb_foreach2(GncOptionDBPtr& odb, SCM section_op, + SCM option_op) { - return prolog; + odb->foreach_section( + [§ion_op, &option_op](const GncOptionSectionPtr& section) + { + auto scm_name{scm_from_utf8_string(section->get_name().c_str())}; + scm_call_1(section_op, scm_name); + section->foreach_option( + [&option_op](auto& option) + { + auto optvoidptr{reinterpret_cast( + const_cast(&option))}; + auto scm_opt{scm_from_pointer(optvoidptr, nullptr)}; + scm_call_1(option_op, scm_opt); + }); + }); } %} diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm index 33ee587bf1..81bbb26a6f 100644 --- a/libgnucash/app-utils/options.scm +++ b/libgnucash/app-utils/options.scm @@ -32,12 +32,6 @@ (use-modules (ice-9 pretty-print)) -(define-public (gnc:value->string value) - (format #f "~s" value)) - -(define-public (gnc:generate-restore-forms options name) - (let ((optiondb (options 'generate-restore-forms))) - (gnc-optiondb-save-to-scheme optiondb name))) (define-public (gnc:lookup-option options section name) (if options @@ -136,6 +130,57 @@ (gnc:option-value src-option))))) src-options))) +;; Get scheme commands to set changed options, used to write a file that will +;; restore a customized report or stylesheet. +(define-public (gnc:value->string value) + (format #f "~s" value)) + +(define-public (gnc:generate-restore-forms options toplevel-name) + (define (section-op section-name) + (display + (string-append "\n; Section: " section-name "\n\n"))) + + (define (gnc:option-is-budget? option) + (GncOption-is-budget-option option)) + + (define (option-op option) + (let ((value (gnc:option-value option)) + (default-value (gnc:option-default-value option))) + (if (not (equal? value default-value)) + (display (string-append + "(let ((option (gnc:lookup-option " toplevel-name "\n" + " " + (gnc:value->string (gnc:option-section option)) "\n" + " " + (gnc:value->string (gnc:option-name option)) ")))\n" + " (" + (cond + ((gnc:option-is-budget? option) + (let* ((budget (gnc:option-value option)) + (guid (gncBudgetGetGUID budget)) + (guid-string (gnc:value->string guid))) + (if (string? guid-string) + (string-append + "(lambda (option) " + "(if option ((gnc:option-setter option) " + "(gnc-budget-lookup " guid-string + " (gnc-get-current-book)))))" + ) + ("Failed to get GUID for budget option.")))) + (else + (string-append + "(lambda (o) (if o (gnc:option-set-value o " + (GncOption-save-scm-value option) ")))" + ))) + " option))\n\n"))))) + + (define (generate-forms) + (let ((odb (options 'generate-restore-forms))) + (gnc-optiondb-foreach2 odb section-op option-op))) + + (with-output-to-string generate-forms)) + + ;; FIXME: Fake callback functions for boolean-complex and multichoice-callback (define-public (gnc:options-register-callback section name callback options) (options 'register-callback) 1) @@ -169,7 +214,7 @@ (define-public (gnc:make-budget-option section name key docstring) (issue-deprecation-warning "gnc:make-budget-option is deprecated. Make and register the option in one command with gnc-register-color-option.") (let ((option (gnc-make-qofinstance-option section name key docstring #f (GncOptionUIType-BUDGET)))) - (gnc:option-set-value option + (gnc:option-set-default-value option (gnc-budget-get-default (gnc-get-current-book))) option)) (define-public (gnc:make-commodity-option section name key docstring default) diff --git a/libgnucash/app-utils/test/CMakeLists.txt b/libgnucash/app-utils/test/CMakeLists.txt index f4c7425daa..37071adf22 100644 --- a/libgnucash/app-utils/test/CMakeLists.txt +++ b/libgnucash/app-utils/test/CMakeLists.txt @@ -85,10 +85,11 @@ if (HAVE_SRFI64) DEPENDS "${GUILE_DEPENDS};scm-srfi64-extras") gnc_add_scheme_test_targets(scm-test-gnc-optiondb - SOURCES "test-gnc-optiondb.scm" + SOURCES "test-gnc-optiondb.scm" "test-gnc-option-scheme-output.scm" OUTPUT_DIR "tests" DEPENDS "swig-apputils-guile-cpp;scm-srfi64-extras") gnc_add_scheme_tests("test-gnc-optiondb.scm") + gnc_add_scheme_tests("test-gnc-option-scheme-output.scm") gnc_add_scheme_tests("${test_app_utils_scheme_SRFI64_SOURCES}") endif() diff --git a/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm b/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm new file mode 100644 index 0000000000..d0b3147e11 --- /dev/null +++ b/libgnucash/app-utils/test/test-gnc-option-scheme-output.scm @@ -0,0 +1,432 @@ + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ; test-gnc-option-scheme-output.scm -- Test Scheme option i/o. ; + ; Copyright (C) 2021 John Ralls ; + ; ; + ; This program is free software; you can redistribute it and/or ; + ; modify it under the terms of the GNU General Public License as ; + ; published by the Free Software Foundation; either version 2 of ; + ; the License, or (at your option) any later version. ; + ; ; + ; This program is distributed in the hope that it will be useful, ; + ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; + ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; + ; GNU General Public License for more details. ; + ; ; + ; You should have received a copy of the GNU General Public License; + ; along with this program; if not, contact: ; + ; ; + ; Free Software Foundation Voice: +1-617-542-5942 ; + ; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652 ; + ; Boston, MA 02110-1301, USA gnu@gnu.org ; + ; ; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(use-modules (srfi srfi-64)) +(use-modules (tests srfi64-extras)) +(use-modules (gnucash app-utils options)) +(use-modules (sw_app_utils)) +(use-modules (sw_engine)) + +(define (run-test) + (test-runner-factory gnc:test-runner) + (test-begin "test-gnc-option-scheme-io") + (test-gnc-string-option-to-scheme) + (test-gnc-text-option-to-scheme) + (test-gnc-pixmap-option-to-scheme) + (test-gnc-currency-option-to-scheme) + (test-gnc-budget-option-to-scheme) + (test-gnc-font-option-to-scheme) + (test-gnc-commodity-option-to-scheme) + (test-gnc-date-option-to-scheme) + (test-gnc-multichoice-option-to-scheme) + (test-end "test-gnc-option-scheme-io")) + +(define test-unchanged-section-output-template + " +; Section: foo + +" + ) + +(define (test-string-output-template value) + (format #f " +; Section: foo + +(let ((option (gnc:lookup-option options + \"foo\" + \"bar\"))) + ((lambda (o) (if o (gnc:option-set-value o ~s))) option)) + +" value)) + +(define (test-literal-output-template value) + (format #f " +; Section: foo + +(let ((option (gnc:lookup-option options + \"foo\" + \"bar\"))) + ((lambda (o) (if o (gnc:option-set-value o '~s))) option)) + +" value)) + +(define (test-budget-output-template value) + (format #f " +; Section: foo + +(let ((option (gnc:lookup-option options + \"foo\" + \"bar\"))) + ((lambda (option) (if option ((gnc:option-setter option) (gnc-budget-lookup ~s (gnc-get-current-book))))) option)) + +" + (gncBudgetGetGUID value))) + + +(define (test-option-scheme-output make-option-func test-template default value) + (let ((odb (gnc:new-options)) + (option (make-option-func "foo" "bar" "baz" "Test Option" default))) + (gnc:register-option odb option) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (gnc:option-set-value (gnc:lookup-option odb "foo" "bar") value) + (test-equal (test-template value) + (gnc:generate-restore-forms odb "options")))) + +(define (test-gnc-string-option-to-scheme) + (test-begin "test-gnc-string-option-to-scheme") + (test-option-scheme-output gnc:make-string-option test-string-output-template + "waldo" "pepper") + (test-end "test-gnc-string-option-to-scheme")) + +(define (test-gnc-text-option-to-scheme) + (test-begin "test-gnc-text-option-to-scheme") + (test-option-scheme-output gnc:make-string-option test-string-output-template + "" +"Sed ut perspiciatis, unde omnis iste natus error sit voluptatem accusantium +doloremque laudantium, totam rem aperiam eaque ipsa, quae ab illo inventore +veritatis et quasi architecto beatae vitae dicta sunt, explicabo.") + (test-end "test-gnc-text-option-to-scheme")) + +(define (test-gnc-font-option-to-scheme) + (test-begin "test-gnc-font-option-to-scheme") + (test-option-scheme-output gnc:make-font-option test-string-output-template + "URW Bookman L Bold Italic 12" + "Helvetica 12") + (test-end "test-gnc-font-option-to-scheme")) + +(define (test-gnc-currency-option-to-scheme) + (test-begin "test-gnc-currency-option-to-scheme") + (let ((session (gnc-get-current-session)) + (book (gnc-get-current-book)) + (table (gnc-commodity-table-new))) + (test-book-set-data book "gnc-commodity-table" table) + (let ((USD (gnc-commodity-new book "United States Dollar" "CURRENCY" "USD" "" 100)) + (EUR (gnc-commodity-new book "European Union Euro" "CURRENCY" "EUR" "" 100))) + (gnc-commodity-table-insert table USD) + (gnc-commodity-table-insert table EUR) + (test-option-scheme-output gnc:make-currency-option test-literal-output-template + USD EUR) +;; Garbage collection has already eaten USD and EUR. + (test-book-clear-data book "gnc-commodity-table") + (gnc-commodity-table-destroy table) + (gnc-clear-current-session))) + (test-end "test-gnc-currency-option-to-scheme")) + +(define (test-gnc-budget-option-to-scheme) + (test-begin "test-gnc-budget-option-to-scheme") + (let* ((session (gnc-get-current-session)) + (book (gnc-get-current-book)) + (budget2 (gnc-budget-new book)) + (budget1 (gnc-budget-new book)) + (guid1 (gncBudgetGetGUID budget1)) + (guid2 (gncBudgetGetGUID budget2))) + + (test-book-set-default-budget book budget1) + (gnc-budget-set-name budget1 "First Budget") + (gnc-budget-set-name budget2 "Second Budget") + + (let ((odb (gnc:new-options)) + (option (gnc:make-budget-option "foo" "bar" "baz" "Test Option"))) + (gnc:register-option odb option) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (gnc:option-set-value (gnc:lookup-option odb "foo" "bar") budget2) + (test-equal (gnc-budget-get-default book) budget1) + (test-equal (test-budget-output-template budget2) + (gnc:generate-restore-forms odb "options"))) + (gnc-clear-current-session)) + (test-end "test-gnc-budget-option-to-scheme")) + +(define (test-gnc-commodity-option-to-scheme) + (test-begin "test-gnc-commodity-option-to-scheme") + (let* ((book (gnc-option-test-book-new)) + (AAPL (gnc-commodity-new book "Apple" "NASDAQ" "AAPL" "" 1)) + (FMAGX (gnc-commodity-new book "Fidelity Magellan Fund" "FUND" "FMAGX" "" 1000))) + (test-option-scheme-output gnc:make-commodity-option test-literal-output-template + AAPL FMAGX)) + (test-end "test-gnc-commodity-option-to-scheme")) + +(define (test-gnc-bool-option-to-scheme) + (test-begin "test-gnc-bool-option-to-scheme") + (test-option-scheme-output gnc:make-simple-boolean-option 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 gnc:make-pixmap-option test-string-output-template "" "~/mybusiness/mylogo.png") + (test-end "test-gnc-pixmap-option-to-scheme")) + +(define (test-gnc-date-option-to-scheme) + (test-begin "test-gnc-date-option-to-scheme") + (let ((odb (gnc:new-options))) + (gnc:options-make-end-date! odb "foo" "bar" "baz" "Phoney Option") + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let* ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template) + (time (gnc-dmy2time64 25 12 2020)) + (value `(absolute . ,time))) + (gnc:option-set-value option value) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + (set! value '(relative . end-prev-year)) + (gnc:option-set-value option value) + (test-equal value (GncOption-get-scm-value option)) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")))) + (test-end "test-gnc-date-option-to-scheme")) + +(define (test-gnc-account-options-to-scheme) + (define (create-account book parent type name) + (let ((account (xaccMallocAccount book))) + (xaccAccountBeginEdit account) + (xaccAccountSetType account type) + (xaccAccountSetName account name) + (xaccAccountBeginEdit parent) + (gnc-account-append-child parent account) + (xaccAccountCommitEdit parent) + (xaccAccountCommitEdit account) + account)) + + (define (make-account-tree book root) + (let* ((assets (create-account book root ACCT-TYPE-ASSET "Assets")) + (liabilities (create-account book root ACCT-TYPE-LIABILITY "Liabilities")) + (equity (create-account book root ACCT-TYPE-EQUITY "Equity")) + (expenses (create-account book root ACCT-TYPE-EXPENSE "Expenses")) + (equity (create-account book root ACCT-TYPE-INCOME "Income")) + (broker (create-account book assets ACCT-TYPE-EQUITY "broker")) + (stocks (create-account book broker ACCT-TYPE-STOCK "Stocks"))) + (create-account book assets ACCT-TYPE-BANK "Bank") + (create-account book stocks ACCT-TYPE-STOCK "AAPL") + (create-account book stocks ACCT-TYPE-STOCK "MSFT") + (create-account book stocks ACCT-TYPE-STOCK "HPE") + (create-account book broker ACCT-TYPE-BANK "Cash Management") + (create-account book expenses ACCT-TYPE-EXPENSE "Food") + (create-account book expenses ACCT-TYPE-EXPENSE "Gas") + (create-account book expenses ACCT-TYPE-EXPENSE "Rent"))) + + (define (cleanup book root) +;; Destroying the book destroys the account tree too + (gnc-option-test-book-destroy book)) + + (define (test-gnc-account-list-option-to-scheme) + (test-begin "test-gnc-account-list-option-to-scheme") + (let ((odb (gnc:new-options)) + (acctlist (gnc-account-list-from-types book + (list ACCT-TYPE-STOCK)))) + (gnc-register-option odb + (gnc:make-account-list-option + "foo" "bar" "a" "baz" acctlist + (lambda (ac) + (let ((type (xaccAccountGetAccountType ac))) + (or (eq type ACCT-TYPE-STOCK) + (eq type ACCT-TYPE-BANK)))) #t)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template) + (new-acclist (gnc-account-list-from-types book (list ACCT-TYPE-BANK)))) + (gnc-option-set-value option new-acclist) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-account-list-option-to-scheme")) + + (define (test-gnc-account-sel-option-to-scheme) + (test-begin "test-gnc-account-sel-option-to-scheme") + (let ((odb (gnc:new-options)) + (acctlist (gnc-account-list-from-types book + (list ACCT-TYPE-STOCK)))) + (gnc-register-option odb + (gnc:make-account-list-option + "foo" "bar" "a" "baz" acctlist + (lambda (ac) + (let ((type (xaccAccountGetAccountType ac))) + (or (eq type ACCT-TYPE-STOCK) + (eq type ACCT-TYPE-BANK)))) #t)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template) + (new-acclist (gnc-account-list-from-types book (list ACCT-TYPE-BANK)))) + (gnc-option-set-value option new-acclist) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-account-sel-option-to-scheme")) + + (let* ((book (gnc-option-test-book-new)) + (root-account (gnc-account-create-root book))) + (test-group-with-cleanup "test-gnc-account-options-to-schemes" + (make-account-tree book root-account) + (test-gnc-account-list-option-to-scheme) + (test-gnc-account-sel-option-to-scheme) + (cleanup book root-account)))) + + +(define (test-gnc-multichoice-option-to-scheme) + (test-begin "test-gnc-multichoice-option-to-scheme") + (let ((odb (gnc:new-options)) + (test-template test-literal-output-template) + (value "5")) + (gnc:register-option + odb + (gnc:make-multichoice-option + "foo" "bar" "baz" "Phoney Option" 3 + (list (vector 'all "All") + (vector 1 "1") (vector 2 "2") (vector 3 "3") + (vector 4 "4") (vector 5 "5") (vector 6 "6")))) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar"))) + (gnc:option-set-value option value) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")))) + (test-end "test-gnc-multichoice-option-to-scheme")) + +(define (test-gnc-list-option-to-scheme) + (test-begin "test-gnc-list-option-to-scheme") + (let ((odb (gnc:new-options)) + (choices (list (vector 'good "The Good") + (vector 'bad "The Bad") + (vector 'ugly "The Ugly")))) + (gnc-register-option odb + (gnc:make-list-option + "foo" "bar" "a" "baz" '(bad) choices)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template)) + (gnc-option-set-value option '(ugly)) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-list-option-to-scheme")) + +(define (test-gnc-number-range-option-to-scheme) + (test-begin "test-gnc-number-range-option-to-scheme") + (let ((odb (gnc:new-options)) + (min-value 0.0) + (max-value 100.0) + (dec-places 2.0) + (step 0.10)) + (gnc-register-option odb + (gnc:make-number-range-option + "foo" "bar" "a" "baz" 49.0 min-value + max-value dec-places step)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template)) + (gnc-option-set-value option 42.0) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-number-range-option-to-scheme")) + +(define (test-gnc-number-plot-size-option-to-scheme) + (test-begin "test-gnc-number-plot-size-option-to-scheme") + (let ((odb (gnc:new-options)) + (min-value 100) + (max-value 10000) + (dec-places 0) + (step 5)) + (gnc-register-option odb + (gnc:make-number-plot-size-option + "foo" "bar" "a" "baz" 490 min-value + max-value dec-places step)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template)) + (gnc-option-set-value option 420) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-number-plot-size-option-to-scheme")) + +(define (test-gnc-query-option-to-scheme) + (test-begin "test-gnc-number-plot-size-option-to-scheme") + (let ((odb (gnc:new-options)) + (query-scm '(query-v2 + (terms (((("book" "guid") #f guid 3 1 ("3a5a4bc736d84b879b776ea8caadd3b2")) + (("account" "guid") #f guid 3 1 ("b7e4ca23652049fca62a0e4f95296a15"))))) + (search-for Split) + (primary-sort (("QofQueryDefaultSort") 0 #t)) + (secondary-sort #f) + (tertiary-sort #f) + (max-results -1)))) + (gnc-register-option odb + (gnc:make-query-option "__reg" "query" '())) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "__reg" "query")) + (test-template test-literal-output-template)) + (gnc-option-set-value option (gnc-scm2query query-scm)) + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-number-plot-size-option-to-scheme")) + +(define (test-gnc-color-option-to-scheme) + (test-begin "test-gnc-coloroption-to-scheme") + (let ((odb (gnc:new-options)) + (default-color (list #xb2 #x22 $x22 #xff)) + (new-color (list #x00 #xca #x3b #xff))) + (test-option-scheme-output gnc:make-color-option + test-literal-output-template + default-color new-color)) + (test-end "test-gnc-color-option-to-scheme")) + +(define (test-gnc-invoice-option-to-scheme) + (test-begin "test-gnc-invoice-option-to-scheme") + (let ((odb (gnc:new-options)) + (invoice '"13b305236443451a86c5366b7f890ecb")) + (test-option-scheme-output gnc:make-color-option + test-literal-output-template + (lambda () '()) invoice)) + (test-end "test-gnc-invoice-option-to-scheme")) + +(define (test-gnc-owner-option-to-scheme) + (test-begin "test-owner-option-to-scheme") + (let ((odb (gnc:new-options))) + (gnc-register-option odb + (gnc:make-owner-option "foo" "bar" "a" "baz" + (lambda () '()) #f + 'GNC-OWNER-CUSTOMER)) + (test-equal test-unchanged-section-output-template + (gnc:generate-restore-forms odb "options")) + (let ((option (gnc:lookup-option odb "foo" "bar")) + (test-template test-literal-output-template)) + (gnc-option-set-value option '"13b305236443451a86c5366b7f890ecb") + (test-equal (test-template (GncOption-get-scm-value option)) + (gnc:generate-restore-forms odb "options")) + )) + (test-end "test-gnc-owner-option-to-scheme")) + +;; The following are saved only to KVP, no Scheme generator needed: +;;(define (test-gnc-dateformat-option-to-scheme) +;;(define (test-gnc-taxtable-option-to-scheme) +;;(define (test-gnc-counter-option-to-scheme) +;;(define (test-gnc-counter-format-option-to-scheme)