Use Scheme to generate and parse saved option files.

The saved option files being Scheme executables.
This commit is contained in:
John Ralls
2021-08-30 13:46:10 -07:00
parent 00c2e99d2e
commit 00a982d97d
4 changed files with 577 additions and 13 deletions

View File

@@ -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 <std_string.i>
%import <base-typemaps.i>
%import (module="sw_engine") <gnc-budget.h>
@@ -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));
@@ -971,6 +974,12 @@ inline SCM return_scm_value(ValueType value)
%template(gnc_make_owner_option) gnc_make_option<const GncOwner*>;
%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<decltype(option),
GncOptionMultichoiceValue>)
@@ -1137,6 +1181,30 @@ inline SCM return_scm_value(ValueType value)
%template(gnc_register_number_range_option_int) gnc_register_number_range_option<int>;
%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(
[&section_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<void*>(
const_cast<GncOption*>(&option))};
auto scm_opt{scm_from_pointer(optvoidptr, nullptr)};
scm_call_1(option_op, scm_opt);
});
});
}
%}

View File

@@ -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)

View File

@@ -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()

View File

@@ -0,0 +1,432 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; test-gnc-option-scheme-output.scm -- Test Scheme option i/o. ;
; Copyright (C) 2021 John Ralls <jralls@ceridwen.us> ;
; ;
; 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)