Merge branch 'scheme-progress-1' of https://github.com/christopherlam/gnucash into unstable

This commit is contained in:
Geert Janssens 2018-03-01 13:01:29 +01:00
commit dd0553af6a
5 changed files with 49 additions and 56 deletions

View File

@ -2,7 +2,6 @@
;; daily-reports.scm: reports based on the day of the week ;; daily-reports.scm: reports based on the day of the week
;; ;;
;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com> ;; Copyright (C) 2003, Andy Wingo <wingo at pobox dot com>
;; Christopher Lam upgrade to time64 (2017)
;; ;;
;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net) ;; based on account-piecharts.scm by Robert Merkel (rgmerk@mira.net)
;; and Christian Stimming <stimming@tu-harburg.de> with ;; and Christian Stimming <stimming@tu-harburg.de> with

View File

@ -5,7 +5,6 @@
;; Copyright 2004 David Montenegro <sunrise2000@comcast.net> ;; Copyright 2004 David Montenegro <sunrise2000@comcast.net>
;; Copyright 2001 Christian Stimming <stimming@tu-harburg.de> ;; Copyright 2001 Christian Stimming <stimming@tu-harburg.de>
;; Copyright 2000-2001 Bill Gribble <grib@gnumatic.com> ;; Copyright 2000-2001 Bill Gribble <grib@gnumatic.com>
;; Copyright 2017 Christopher Lam upgrade to time64
;; ;;
;; This program is free software; you can redistribute it and/or ;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as ;; modify it under the terms of the GNU General Public License as

View File

@ -318,25 +318,30 @@ in the Options panel."))
(cons 'tip (_ "Show both (and include void transactions in totals).")))))) (cons 'tip (_ "Show both (and include void transactions in totals)."))))))
(define reconcile-status-list (define reconcile-status-list
;; value will be either #f to disable reconciled-status filter
;; or a list of xaccSplitGetReconcile values. e.g. value can
;; be '(#\c #\y) to retrieve list of cleared and reconciled splits.
(list (list
(cons #f (list (cons 'all
(list
(cons 'text (_ "All")) (cons 'text (_ "All"))
(cons 'tip (_ "Show All Transactions")))) (cons 'tip (_ "Show All Transactions"))
(cons 'filter-types #f)))
(cons '(#\n) (list (cons 'unreconciled
(list
(cons 'text (_ "Unreconciled")) (cons 'text (_ "Unreconciled"))
(cons 'tip (_ "Unreconciled only")))) (cons 'tip (_ "Unreconciled only"))
(cons 'filter-types (list #\n))))
(cons '(#\c) (list (cons 'cleared
(list
(cons 'text (_ "Cleared")) (cons 'text (_ "Cleared"))
(cons 'tip (_ "Cleared only")))) (cons 'tip (_ "Cleared only"))
(cons 'filter-types (list #\c))))
(cons '(#\y) (list (cons 'reconciled
(list
(cons 'text (_ "Reconciled")) (cons 'text (_ "Reconciled"))
(cons 'tip (_ "Reconciled only")))))) (cons 'tip (_ "Reconciled only"))
(cons 'filter-types (list #\y))))))
(define ascending-list (define ascending-list
@ -460,17 +465,17 @@ Credit Card, and Income accounts."))
(gnc:make-multichoice-option (gnc:make-multichoice-option
gnc:pagename-general optname-infobox-display gnc:pagename-general optname-infobox-display
"h" (_ "Add summary of options.") "h" (_ "Add summary of options.")
'(no-match) 'no-match
;; This is an alist of conditions for displaying the infobox ;; This is an alist of conditions for displaying the infobox
;; 'no-match for empty-report ;; 'no-match for empty-report
;; 'match for generated report ;; 'match for generated report
(list (vector '(no-match) (list (vector 'no-match
(_ "If no transactions matched") (_ "If no transactions matched")
(_ "Display summary if no transactions were matched.")) (_ "Display summary if no transactions were matched."))
(vector '(no-match match) (vector 'always
(_ "Always") (_ "Always")
(_ "Always display summary.")) (_ "Always display summary."))
(vector '() (vector 'never
(_ "Never") (_ "Never")
(_ "Disable report summary."))))) (_ "Disable report summary.")))))
@ -515,7 +520,7 @@ tags within description, notes or memo. ")
(gnc:make-multichoice-option (gnc:make-multichoice-option
pagename-filter optname-reconcile-status pagename-filter optname-reconcile-status
"j1" (_ "Filter by reconcile status.") "j1" (_ "Filter by reconcile status.")
#f 'all
(keylist->vectorlist reconcile-status-list))) (keylist->vectorlist reconcile-status-list)))
(gnc:register-trep-option (gnc:register-trep-option
@ -1669,7 +1674,9 @@ tags within description, notes or memo. ")
(transaction-matcher (opt-val pagename-filter optname-transaction-matcher)) (transaction-matcher (opt-val pagename-filter optname-transaction-matcher))
(transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex) (transaction-matcher-regexp (and (opt-val pagename-filter optname-transaction-matcher-regex)
(make-regexp transaction-matcher))) (make-regexp transaction-matcher)))
(reconcile-status-filter (opt-val pagename-filter optname-reconcile-status)) (reconcile-status-filter (keylist-get-info reconcile-status-list
(opt-val pagename-filter optname-reconcile-status)
'filter-types))
(report-title (opt-val gnc:pagename-general gnc:optname-reportname)) (report-title (opt-val gnc:pagename-general gnc:optname-reportname))
(primary-key (opt-val pagename-sorting optname-prime-sortkey)) (primary-key (opt-val pagename-sorting optname-prime-sortkey))
(primary-order (opt-val pagename-sorting optname-prime-sortorder)) (primary-order (opt-val pagename-sorting optname-prime-sortorder))
@ -1742,23 +1749,21 @@ tags within description, notes or memo. ")
(if (or (null? c_account_1) (and-map not c_account_1)) (if (or (null? c_account_1) (and-map not c_account_1))
;; error condition: no accounts specified or obtained after filtering ;; error condition: no accounts specified or obtained after filtering
(begin
;; error condition: no accounts specified
(begin (begin
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:html-make-no-account-warning report-title (gnc:report-id report-obj))) (gnc:html-make-no-account-warning
report-title (gnc:report-id report-obj)))
;; if an empty-report-message is passed by a derived report to ;; if an empty-report-message is passed by a derived report to
;; the renderer, display it here. ;; the renderer, display it here.
(if empty-report-message (if empty-report-message
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
empty-report-message))) empty-report-message))
(if (member 'no-match infobox-display) (if (memq infobox-display '(always no-match))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:render-options-changed options)))) (gnc:render-options-changed options))))
@ -1817,21 +1822,23 @@ tags within description, notes or memo. ")
(match? (xaccSplitGetMemo split))) (match? (xaccSplitGetMemo split)))
(or (not custom-split-filter) ; #f = ignore custom-split-filter (or (not custom-split-filter) ; #f = ignore custom-split-filter
(custom-split-filter split)) (custom-split-filter split))
(or (not reconcile-status-filter) ; #f = ignore next filter (or (not reconcile-status-filter) ; #f = ignore reconcile-status-filter
(member (xaccSplitGetReconcile split) reconcile-status-filter))))) (memv (xaccSplitGetReconcile split)
reconcile-status-filter)))))
splits)) splits))
(if (null? splits) (if (null? splits)
;; error condition: no splits found ;; error condition: no splits found
(begin (begin
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:make-html-text (gnc:html-make-generic-warning
(gnc:html-markup-h2 NO-MATCHING-TRANS-HEADER) report-title (gnc:report-id report-obj)
(gnc:html-markup-p NO-MATCHING-TRANS-TEXT))) NO-MATCHING-TRANS-HEADER NO-MATCHING-TRANS-TEXT))
(if (member 'no-match infobox-display) (if (memq infobox-display '(always no-match))
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:render-options-changed options)))) (gnc:render-options-changed options))))
@ -1849,7 +1856,7 @@ tags within description, notes or memo. ")
(qof-print-date begindate) (qof-print-date begindate)
(qof-print-date enddate))))) (qof-print-date enddate)))))
(if (member 'match infobox-display) (if (eq? infobox-display 'always)
(gnc:html-document-add-object! (gnc:html-document-add-object!
document document
(gnc:render-options-changed options))) (gnc:render-options-changed options)))

View File

@ -91,19 +91,7 @@
604800)) 604800))
(begin-string (qof-print-date (+ beginweekt64 345600))) (begin-string (qof-print-date (+ beginweekt64 345600)))
(end-string (qof-print-date (+ beginweekt64 864000)))) (end-string (qof-print-date (+ beginweekt64 864000))))
(format #f (_ "~s to ~s") begin-string end-string))) (format #f (_ "~a to ~a") begin-string end-string)))
; (let ((begin-string (qof-print-date
; (+ (* (gnc:date-get-week
; (gnc:time64-start-day-time
; (gnc-mktime datevec)))
; 604800) 345600)))
; (end-string (qof-print-date
; (+ (* (gnc:date-get-week
; (gnc:time64-start-day-time
; (gnc-mktime datevec)))
; 604800) 864000))))
; (format #f (_ "~s to ~s") begin-string end-string)))
;; is leap year? ;; is leap year?
(define (gnc:leap-year? year) (define (gnc:leap-year? year)

View File

@ -2056,8 +2056,8 @@
(set! row-contents (cons return-string row-contents))))) (set! row-contents (cons return-string row-contents)))))
(gnc:options-for-each disp-option-if-changed options) (gnc:options-for-each disp-option-if-changed options)
(string-append (string-join (reverse row-contents) (string-append (string-join (reverse row-contents)
(if plaintext? "\n" "<br />")) (if plaintext? "\n" "<br />\n"))
(if plaintext? "\n\n" "<br /><br />")))) (if plaintext? "\n\n" "<br />\n<br />\n"))))
(define (gnc:send-options db_handle options) (define (gnc:send-options db_handle options)
(gnc:options-for-each (gnc:options-for-each