gnucash maint: Multiple changes pushed
Christopher Lam
clam at code.gnucash.org
Sat Feb 15 09:43:01 EST 2020
Updated via https://github.com/Gnucash/gnucash/commit/555a467a (commit)
via https://github.com/Gnucash/gnucash/commit/3ac60ed2 (commit)
from https://github.com/Gnucash/gnucash/commit/b23d2445 (commit)
commit 555a467aba7733e9bf7d6e53cc5b1054c328427a
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sat Feb 15 18:34:01 2020 +0800
[new-owner-report] revert highlight trigger to onclick
and use Windows libwebkit1-compatible javascript
diff --git a/gnucash/report/business-reports/new-owner-report.scm b/gnucash/report/business-reports/new-owner-report.scm
index e42b8df78..e39b885e7 100644
--- a/gnucash/report/business-reports/new-owner-report.scm
+++ b/gnucash/report/business-reports/new-owner-report.scm
@@ -63,18 +63,22 @@
(define javascript "
<script>
function getID(cell) { return cell.getAttribute('link-id'); }
- function mousedown(e) {
- var id = getID(e.target);
- var ishighlighted = e.target.classList.contains('highlight');
- e.preventDefault ();
- TDs.forEach(TD => TD.classList.remove('highlight'));
+
+ function clicky() {
+ var id = getID(this);
+ var ishighlighted = this.classList.contains('highlight');
+ TDs.forEach (function (item, idx) {
+ item.classList.remove('highlight')});
if (ishighlighted) return;
- TDs
- .filter (TD => getID(TD) == id)
- .forEach (TD => TD.classList.add('highlight'));}
+ TDs.forEach (function (item, idx) {
+ if (getID(item) == id)
+ item.classList.add('highlight')})}
+
var TDs = document.getElementsByTagName('td');
- TDs = [...TDs].filter(getID);
- TDs.forEach(TD => TD.onmousedown = mousedown);
+ TDs = Array.prototype.slice.call (TDs);
+ TDs = TDs.filter (getID);
+ TDs.forEach(function (item, idx) {
+ item.addEventListener('click', clicky)});
</script>
")
commit 3ac60ed2e427816fcbc70b7f757b617510caef45
Author: Christopher Lam <christopher.lck at gmail.com>
Date: Sun Feb 9 18:20:41 2020 +0800
compact, use (ice-9 match)
diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index 3744eb79a..ef050a197 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -22,6 +22,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:module-load "gnucash/html" 0)
+(use-modules (ice-9 match))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-document> class
@@ -220,95 +221,74 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (gnc:html-document-markup-start doc markup end-tag? . rest)
- (let ((childinfo (gnc:html-document-fetch-markup-style doc markup))
- (extra-attrib (and (pair? rest) rest)))
- ;; now generate the start tag
- (let ((tag (gnc:html-markup-style-info-tag childinfo))
- (attr (gnc:html-markup-style-info-attributes childinfo))
- (face (gnc:html-markup-style-info-font-face childinfo))
- (size (gnc:html-markup-style-info-font-size childinfo))
- (color (gnc:html-markup-style-info-font-color childinfo)))
-
- ;; "" tags mean "show no tag"; #f tags means use default.
- (cond ((not tag)
- (set! tag markup))
- ((and (string? tag) (string=? tag ""))
- (set! tag #f)))
- (let* ((retval '())
- (push (lambda (l) (set! retval (cons l retval))))
- (add-internal-tag (lambda (tag) (push "<") (push tag) (push ">")))
- (add-attribute
- (lambda (key value prior)
- (push " ") (push key)
- (if value (begin (push "=\"")
- (push value)
- (push "\"")))
- #t))
- (addextraatt
- (lambda (attr)
- (cond ((string? attr) (push " ") (push attr))
- (attr (gnc:warn "non-string attribute" attr)))))
- (build-first-tag
- (lambda (tag)
- (push "<") (push tag)
- (if attr (hash-fold add-attribute #f attr))
- (if extra-attrib (for-each addextraatt extra-attrib))
- (if (not end-tag?)
- (push " /")) ;;add closing "/" for no-end elements...
- (push ">"))))
- (if tag
- (if (list? tag)
- (begin
- (build-first-tag (car tag))
- (for-each add-internal-tag (cdr tag)))
- (build-first-tag tag)))
- ;; XXX Font styling should be done through CSS, NOT html code
- ;; XXX Also, why is this even here? 'Font' is an html tag just like anything else,
- ;; so why does it have it's own custom pseudo code here? It should be built
- ;; as a call to this function just like any other tag, passing face/size/color as attributes.
- (if (or face size color)
- (begin
- (issue-deprecation-warning
- "this section is unreachable in code")
- (push "<font ")
- (if face
- (begin
- (push "face=\"") (push face) (push "\" ")))
- (if size
- (begin
- (push "size=\"") (push size) (push "\" ")))
- (if color
- (begin
- (push "color=\"") (push color) (push "\" ")))
- (push ">")))
- retval))))
+ (let* ((childinfo (gnc:html-document-fetch-markup-style doc markup))
+ (extra-attrib (and (pair? rest) rest))
+ (retval '())
+ (tag (or (gnc:html-markup-style-info-tag childinfo) markup))
+ (attr (gnc:html-markup-style-info-attributes childinfo))
+ (face (gnc:html-markup-style-info-font-face childinfo))
+ (size (gnc:html-markup-style-info-font-size childinfo))
+ (color (gnc:html-markup-style-info-font-color childinfo)))
+
+ (define (push l) (set! retval (cons l retval)))
+ (define (add-internal-tag tag) (push "<") (push tag) (push ">"))
+ (define (add-attribute key value)
+ (push " ") (push key)
+ (when value (push "=\"") (push value) (push "\"")))
+ (define (addextraatt attr)
+ (cond ((string? attr) (push " ") (push attr))
+ (attr (gnc:warn "non-string attribute" attr))))
+ (define (build-first-tag tag)
+ (push "<") (push tag)
+ (if attr (hash-for-each add-attribute attr))
+ (if extra-attrib (for-each addextraatt extra-attrib))
+ (unless end-tag? (push " /")) ;;add closing "/" for no-end elements...
+ (push ">"))
+
+ (match tag
+ ("" #f)
+ ((head . tail) (build-first-tag head) (for-each add-internal-tag tail))
+ (_ (build-first-tag tag)))
+
+ ;; XXX Font styling should be done through CSS, NOT html code
+ ;; XXX Also, why is this even here? 'Font' is an html tag just like anything else,
+ ;; so why does it have it's own custom pseudo code here? It should be built
+ ;; as a call to this function just like any other tag, passing face/size/color as attributes.
+ (if (or face size color)
+ (begin
+ (issue-deprecation-warning
+ "this section is unreachable in code")
+ (push "<font ")
+ (if face
+ (begin
+ (push "face=\"") (push face) (push "\" ")))
+ (if size
+ (begin
+ (push "size=\"") (push size) (push "\" ")))
+ (if color
+ (begin
+ (push "color=\"") (push color) (push "\" ")))
+ (push ">")))
+ retval))
(define (gnc:html-document-markup-end doc markup)
- (let ((childinfo (gnc:html-document-fetch-markup-style doc markup)))
+ (let* ((childinfo (gnc:html-document-fetch-markup-style doc markup))
+ (tag (or (gnc:html-markup-style-info-tag childinfo) markup))
+ (retval '()))
+ (define (push l) (set! retval (cons l retval)))
+ (define (addtag t)
+ (push "</")
+ (push t)
+ (push ">\n"))
+ (when (gnc:html-markup-style-info-closing-font-tag childinfo)
+ (push "</font>\n"))
;; now generate the end tag
- (let ((tag (gnc:html-markup-style-info-tag childinfo))
- (closing-font-tag
- (gnc:html-markup-style-info-closing-font-tag childinfo)))
- ;; "" tags mean "show no tag"; #f tags means use default.
- (cond ((not tag)
- (set! tag markup))
- ((and (string? tag) (string=? tag ""))
- (set! tag #f)))
- (let* ((retval '())
- (push (lambda (l) (set! retval (cons l retval)))))
- (if closing-font-tag
- (push "</font>\n"))
- (if tag
- (let ((addtag (lambda (t)
- (push "</")
- (push tag)
- (push ">\n"))))
- (cond
- ((string? tag)
- (addtag tag))
- ((list? tag)
- (for-each addtag (reverse tag))))))
- retval))))
+ ;; "" tags mean "show no tag"; #f tags means use default.)
+ (match tag
+ ("" #f)
+ ((? string?) (addtag tag))
+ ((? list?) (for-each addtag (reverse tag))))
+ retval))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-document-render-data
diff --git a/gnucash/report/report-system/trep-engine.scm b/gnucash/report/report-system/trep-engine.scm
index f39a47a7b..0a10504de 100644
--- a/gnucash/report/report-system/trep-engine.scm
+++ b/gnucash/report/report-system/trep-engine.scm
@@ -1939,18 +1939,14 @@ be excluded from periodic reporting.")
(define BOOK-SPLIT-ACTION
(qof-book-use-split-action-for-num-field (gnc-get-current-book)))
(define (is-filter-member split account-list)
- (let* ((txn (xaccSplitGetParent split))
- (splitcount (xaccTransCountSplits txn))
- (is-in-account-list? (lambda (acc) (member acc account-list))))
- (cond
- ((= splitcount 2)
- (is-in-account-list?
- (xaccSplitGetAccount (xaccSplitGetOtherSplit split))))
- ((> splitcount 2)
- (or-map is-in-account-list?
- (map xaccSplitGetAccount
- (delete split (xaccTransGetSplitList txn)))))
- (else #f))))
+ (define (same-split? s) (equal? s split))
+ (define (from-account? s) (member (xaccSplitGetAccount s) account-list))
+ (let lp ((splits (xaccTransGetSplitList (xaccSplitGetParent split))))
+ (match splits
+ (() #f)
+ (((? same-split?) . rest) (lp rest))
+ (((? from-account?) . _) #t)
+ ((_ . rest) (lp rest)))))
(gnc:report-starting (opt-val gnc:pagename-general gnc:optname-reportname))
diff --git a/gnucash/report/utility-reports/view-column.scm b/gnucash/report/utility-reports/view-column.scm
index df68cf689..8d224f1c5 100644
--- a/gnucash/report/utility-reports/view-column.scm
+++ b/gnucash/report/utility-reports/view-column.scm
@@ -27,6 +27,7 @@
;; don't have to worry about that here.
(define-module (gnucash report view-column))
+(use-modules (ice-9 match))
(use-modules (gnucash utilities))
(use-modules (gnucash app-utils))
(use-modules (gnucash gnc-module))
@@ -86,20 +87,14 @@
;; make sure each subreport has an option change callback that
;; pings the parent
- (let loop ((new-reports '())
- (reports reports))
- (if (null? reports)
- (gnc:option-set-value report-opt (reverse new-reports))
- (let* ((report-info (car reports))
- (child (car report-info))
- (rowspan (cadr report-info))
- (colspan (caddr report-info))
- (callback (or (cadddr report-info)
- (make-child-options-callback
- report (gnc-report-find child)))))
- (loop (cons (list child rowspan colspan callback)
- new-reports)
- (cdr reports)))))
+ (let loop ((reports reports) (new-reports '()))
+ (match reports
+ (() (gnc:option-set-value report-opt (reverse new-reports)))
+ (((child rowspan colspan callback) . rest)
+ (let ((callback (or callback
+ (make-child-options-callback
+ report (gnc-report-find child)))))
+ (loop rest (cons (list child rowspan colspan callback) new-reports))))))
;; we really would rather do something smart here with the
;; report's cached text if possible. For the moment, we'll have
@@ -217,17 +212,11 @@
(define (cleanup-options report)
(let* ((options (gnc:report-options report))
(report-opt (gnc:lookup-option options "__general" "report-list")))
- (let loop ((new-reports '())
- (reports (gnc:option-value report-opt)))
- (if (null? reports)
- (gnc:option-set-value report-opt (reverse new-reports))
- (let* ((report-info (car reports))
- (child (car report-info))
- (rowspan (cadr report-info))
- (colspan (caddr report-info)))
- (loop (cons (list child rowspan colspan #f)
- new-reports)
- (cdr reports)))))))
+ (let loop ((reports (gnc:option-value report-opt)) (new-reports '()))
+ (match reports
+ (() (gnc:option-set-value report-opt (reverse new-reports)))
+ (((child rowspan colspan _) . rest)
+ (loop rest (cons (list child rowspan colspan #f) new-reports)))))))
;; define the view now.
(gnc:define-report
Summary of changes:
.../report/business-reports/new-owner-report.scm | 24 ++--
gnucash/report/report-system/html-document.scm | 152 +++++++++------------
gnucash/report/report-system/trep-engine.scm | 20 ++-
gnucash/report/utility-reports/view-column.scm | 39 ++----
4 files changed, 102 insertions(+), 133 deletions(-)
More information about the gnucash-changes
mailing list