mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[options] Improve Scheme API consistency
This commit is contained in:
John Ralls
parent
418bb7d0cc
commit
3d275a3715
@ -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<int64_t>;
|
||||
%template(gnc_make_query_option) gnc_make_option<const QofQuery*>;
|
||||
%template(gnc_make_owner_option) gnc_make_option<const GncOwner*>;
|
||||
|
||||
%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<time64>;
|
||||
};
|
||||
|
||||
%template(gnc_register_number_range_option_double) gnc_register_number_range_option<double>;
|
||||
%template(gnc_register_number_range_option_int) gnc_register_number_range_option<int>;
|
||||
%template(gnc_register_number_range_option) gnc_register_number_range_option<double>;
|
||||
|
||||
%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<GncOptionDB>;
|
||||
/* 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<GncOptionDB>()};
|
||||
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)
|
||||
|
||||
@ -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
|
||||
;;
|
||||
|
||||
@ -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"))
|
||||
|
||||
@ -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")))))
|
||||
|
||||
@ -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")
|
||||
))
|
||||
|
||||
@ -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)};
|
||||
|
||||
@ -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 <report> represents an instantiation of a particular report type.
|
||||
(define-record-type <report>
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user