gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sun Jul 28 00:17:10 EDT 2019
Updated via https://github.com/Gnucash/gnucash/commit/e8a41bbf (commit)
via https://github.com/Gnucash/gnucash/commit/bd0cbbf9 (commit)
via https://github.com/Gnucash/gnucash/commit/66511f17 (commit)
from https://github.com/Gnucash/gnucash/commit/887f7fac (commit)
commit e8a41bbf5480d3beec08034c422a51a25cc7122b
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 11:23:10 2019 +0800
[options] compact lookup-option
diff --git a/libgnucash/app-utils/options.scm b/libgnucash/app-utils/options.scm
index 7c1622566..499da99bc 100644
--- a/libgnucash/app-utils/options.scm
+++ b/libgnucash/app-utils/options.scm
@@ -1653,70 +1653,68 @@ the option '~a'."))
(define callback-hash (make-hash-table 23))
(define last-callback-id 0)
+ (define new-names-alist
+ '(("Accounts to include" #f "Accounts")
+ ("Exclude transactions between selected accounts?" #f
+ "Exclude transactions between selected accounts")
+ ("Filter Accounts" #f "Filter By...")
+ ("Flatten list to depth limit?" #f "Flatten list to depth limit")
+ ("From" #f "Start Date")
+ ("Report Accounts" #f "Accounts")
+ ("Report Currency" #f "Report's currency")
+ ("Show Account Code?" #f "Show Account Code")
+ ("Show Full Account Name?" #f "Show Full Account Name")
+ ("Show Multi-currency Totals?" #f "Show Multi-currency Totals")
+ ("Show zero balance items?" #f "Show zero balance items")
+ ("Sign Reverses?" #f "Sign Reverses")
+ ("To" #f "End Date")
+ ("Charge Type" #f "Action") ;easy-invoice.scm, renamed June 2018
+ ;; the following 4 options in income-gst-statement.scm renamed Dec 2018
+ ("Individual income columns" #f "Individual sales columns")
+ ("Individual expense columns" #f "Individual purchases columns")
+ ("Remittance amount" #f "Gross Balance")
+ ("Net Income" #f "Net Balance")
+ ;; transaction.scm:
+ ("Use Full Account Name?" #f "Use Full Account Name")
+ ("Use Full Other Account Name?" #f "Use Full Other Account Name")
+ ("Void Transactions?" "Filter" "Void Transactions")
+ ("Void Transactions" "Filter" "Void Transactions")
+ ("Account Substring" "Filter" "Account Name Filter")
+ ;; invoice.scm, renamed November 2018
+ ("Individual Taxes" #f "Use Detailed Tax Summary")
+ ))
(define (lookup-option section name)
(let ((section-hash (hash-ref option-hash section)))
- (if section-hash
- (let ((option-hash (hash-ref section-hash name)))
- (if option-hash
- option-hash
- ;; Option name was not found. Perhaps it was renamed ?
- ;; Let's try to map it to a known new name.
- ;; This list will try match names - if one is found
- ;; the next item will describe a pair.
- ;; (cons newsection newname)
- ;; If newsection is #f then reuse previous section name.
- ;;
- ;; Please note the rename list currently supports renaming
- ;; individual option names, or individual option names moved
- ;; to another section. It does not currently support renaming
- ;; whole sections.
- (let* ((new-names-list (list
- "Accounts to include" (cons #f "Accounts")
- "Exclude transactions between selected accounts?" (cons #f "Exclude transactions between selected accounts")
- "Filter Accounts" (cons #f "Filter By...")
- "Flatten list to depth limit?" (cons #f "Flatten list to depth limit")
- "From" (cons #f "Start Date")
- "Report Accounts" (cons #f "Accounts")
- "Report Currency" (cons #f "Report's currency")
- "Show Account Code?" (cons #f "Show Account Code")
- "Show Full Account Name?" (cons #f "Show Full Account Name")
- "Show Multi-currency Totals?" (cons #f "Show Multi-currency Totals")
- "Show zero balance items?" (cons #f "Show zero balance items")
- "Sign Reverses?" (cons #f "Sign Reverses")
- "To" (cons #f "End Date")
- "Charge Type" (cons #f "Action") ;easy-invoice.scm, renamed June 2018
- ;; the following 4 options in income-gst-statement.scm renamed Dec 2018
- "Individual income columns" (cons #f "Individual sales columns")
- "Individual expense columns" (cons #f "Individual purchases columns")
- "Remittance amount" (cons #f "Gross Balance")
- "Net Income" (cons #f "Net Balance")
- ;; transaction.scm:
- "Use Full Account Name?" (cons #f "Use Full Account Name")
- "Use Full Other Account Name?" (cons #f "Use Full Other Account Name")
- "Void Transactions?" (cons "Filter" "Void Transactions")
- "Void Transactions" (cons "Filter" "Void Transactions")
- "Account Substring" (cons "Filter" "Account Name Filter")
- ;; invoice.scm, renamed November 2018
- "Individual Taxes" (cons "#f" "Use Detailed Tax Summary")
- ))
- (name-match (member name new-names-list)))
-
- (and name-match
- (let ((new-section (car (cadr name-match)))
- (new-name (cdr (cadr name-match))))
- (gnc:debug
- (format #f "option ~s/~s has been renamed to ~s/~s\n"
- section name new-section new-name))
- ;; compare if new-section name exists.
- (if new-section
- ;; if so, if it's different to current section name
- ;; then try new section name
- (and (not (string=? new-section section))
- (lookup-option new-section new-name))
- ;; else reuse section-name with new-name
- (lookup-option section new-name)))))))
- #f)))
+ (and section-hash
+ (or (hash-ref section-hash name)
+ ;; Option name was not found. Perhaps it was renamed?
+ ;; Let's try to map to a known new name. The alist
+ ;; new-names-alist will try match names - car is the old
+ ;; name, cdr is the 2-element list describing
+ ;; newsection newname. If newsection is #f then reuse
+ ;; previous section name. Please note the rename list
+ ;; currently supports renaming individual option names,
+ ;; or individual option names moved to another
+ ;; section. It does not currently support renaming
+ ;; whole sections.
+ (let ((name-match (assoc-ref new-names-alist name)))
+ (and name-match
+ (let ((new-section (car name-match))
+ (new-name (cadr name-match)))
+ (gnc:debug
+ (format #f "option ~a/~a has been renamed to ~a/~a\n"
+ section name new-section new-name))
+ (cond
+ ;; new-name only
+ ((not new-section)
+ (lookup-option section new-name))
+ ;; new-section different to current section
+ ;; name, and possibly new-name
+ ((not (string=? new-section section))
+ (lookup-option new-section new-name))
+ ;; no match, return #f
+ (else #f)))))))))
(define (option-changed section name)
(set! options-changed #t)
commit bd0cbbf9311d7dbc79a3361d50c89d052a2dbe5e
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 11:45:34 2019 +0800
[test-options] initial commit
* test lookup option changed section/name
diff --git a/libgnucash/app-utils/test/CMakeLists.txt b/libgnucash/app-utils/test/CMakeLists.txt
index d3a55cc41..dd9e259a1 100644
--- a/libgnucash/app-utils/test/CMakeLists.txt
+++ b/libgnucash/app-utils/test/CMakeLists.txt
@@ -47,6 +47,7 @@ set(test_app_utils_scheme_SOURCES
set (test_app_utils_scheme_SRFI64_SOURCES
test-date-utilities.scm
+ test-options.scm
)
gnc_add_scheme_targets(scm-test-load-app-utils-module
diff --git a/libgnucash/app-utils/test/test-options.scm b/libgnucash/app-utils/test/test-options.scm
new file mode 100644
index 000000000..94c288089
--- /dev/null
+++ b/libgnucash/app-utils/test/test-options.scm
@@ -0,0 +1,28 @@
+(use-modules (gnucash gnc-module))
+(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
+(use-modules (srfi srfi-64))
+(use-modules (gnucash engine test srfi64-extras))
+
+(define (run-test)
+ (test-runner-factory gnc:test-runner)
+ (test-begin "test-options")
+ (test-lookup-option)
+ (test-end "test-options"))
+
+(define (test-lookup-option)
+ (let ((options (gnc:new-options)))
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ "Section" "Start Date" "sort-tag" "docstring" 'default-val))
+
+ (gnc:register-option
+ options
+ (gnc:make-simple-boolean-option
+ "Filter" "Void Transactions" "sort-tag" "docstring" 'default-val))
+
+ (test-assert "lookup-option changed name"
+ (gnc:lookup-option options "Section" "From"))
+
+ (test-assert "lookup-option changed section and name"
+ (gnc:lookup-option options "Section" "Void Transactions?"))))
commit 66511f17bb7848c290f5d08e58b52b8fb4eaf061
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Jul 28 11:22:36 2019 +0800
[c-interface] compact functions
fix whitespace. this module has good coverage in test-c-interface.scm.
diff --git a/libgnucash/app-utils/c-interface.scm b/libgnucash/app-utils/c-interface.scm
index 559bc32bb..8dba2b985 100644
--- a/libgnucash/app-utils/c-interface.scm
+++ b/libgnucash/app-utils/c-interface.scm
@@ -20,30 +20,25 @@
(captured-error #f)
(result #f))
(catch #t
- (lambda ()
- ;; Execute the code in which
- ;; you want to catch errors here.
- (if (procedure? cmd)
- (set! result (apply cmd args)))
- (if (string? cmd)
- (set! result (eval-string cmd)))
- )
- (lambda (key . parameters)
- ;; Put the code which you want
- ;; to handle an error after the
- ;; stack has been unwound here.
- (let* ((str-port (open-output-string)))
- (display-backtrace captured-stack str-port)
- (display "\n" str-port)
- (print-exception str-port #f key parameters)
- (set! captured-error (get-output-string str-port))))
- (lambda (key . parameters)
- ;; Capture the stack here, cut the last 3 frames which are
- ;; make-stack, this one, and the throw handler.
- (set! captured-stack (make-stack #t 3))))
-
- (list result captured-error)
-))
+ (lambda ()
+ ;; Execute the code in which you want to catch errors here.
+ (cond
+ ((procedure? cmd) (set! result (apply cmd args)))
+ ((string? cmd) (set! result (eval-string cmd)))))
+ (lambda (key . parameters)
+ ;; Put the code which you want to handle an error after the
+ ;; stack has been unwound here.
+ (set! captured-error
+ (call-with-output-string
+ (lambda (port)
+ (display-backtrace captured-stack port)
+ (newline port)
+ (print-exception port #f key parameters)))))
+ (lambda (key . parameters)
+ ;; Capture the stack here, cut the last 3 frames which are
+ ;; make-stack, this one, and the throw handler.
+ (set! captured-stack (make-stack #t 3))))
+ (list result captured-error)))
;; gnc:eval-string-with-error-handling will evaluate the input string (cmd)
;; an captures any exception that would be generated. It returns
@@ -53,7 +48,7 @@
;; We'll use this to wrap guile calls in C(++), allowing
;; the C(++) code to decide how to handle the errors.
(define (gnc:eval-string-with-error-handling cmd)
- (gnc:call-with-error-handling cmd '()))
+ (gnc:call-with-error-handling cmd '()))
;; gnc:apply-with-error-handling will call guile's apply to run func with args
;; an captures any exception that would be generated. It returns
@@ -63,33 +58,28 @@
;; We'll use this to wrap guile calls in C(++), allowing
;; the C(++) code to decide how to handle the errors.
(define (gnc:apply-with-error-handling func args)
- (gnc:call-with-error-handling func args))
-
+ (gnc:call-with-error-handling func args))
(define (gnc:backtrace-if-exception proc . args)
(let* ((apply-result (gnc:apply-with-error-handling proc args))
(result (car apply-result))
(error (cadr apply-result)))
- (if error
- (begin
- (display error (current-error-port))
- (if (defined? 'gnc:warn)
- (gnc:warn error)))
- result)))
+ (cond
+ (error
+ (display error (current-error-port))
+ (when (defined? 'gnc:warn)
+ (gnc:warn error)))
+ (else result))))
;; This database can be used to store and retrieve translatable
;; strings. Strings that are returned by the lookup function are
;; translated with gettext.
(define (gnc:make-string-database)
-
- (define string-hash (make-hash-table 23))
-
+ (define string-hash (make-hash-table))
(define (lookup key)
(_ (hash-ref string-hash key)))
-
(define (store key string)
(hash-set! string-hash key string))
-
(define (dispatch message . args)
(let ((func (case message
((lookup) lookup)
@@ -98,5 +88,4 @@
(if func
(apply func args)
(gnc:warn "string-database: bad message" message "\n"))))
-
dispatch)
Summary of changes:
libgnucash/app-utils/c-interface.scm | 67 +++++++---------
libgnucash/app-utils/options.scm | 120 ++++++++++++++---------------
libgnucash/app-utils/test/CMakeLists.txt | 1 +
libgnucash/app-utils/test/test-options.scm | 28 +++++++
4 files changed, 116 insertions(+), 100 deletions(-)
create mode 100644 libgnucash/app-utils/test/test-options.scm
More information about the gnucash-changes
mailing list