mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
[lot-viewer] show lot guid in headers
* also compact code, use partition * also don't need to localise option string for debugging tool
This commit is contained in:
@@ -22,6 +22,7 @@
|
||||
(define-module (gnucash report standard-reports lot-viewer))
|
||||
|
||||
(use-modules (srfi srfi-1))
|
||||
(use-modules (srfi srfi-11)) ;for let-values
|
||||
(use-modules (ice-9 match))
|
||||
(use-modules (gnucash utilities))
|
||||
(use-modules (gnucash gnc-module))
|
||||
@@ -35,7 +36,7 @@
|
||||
(define optname-from-date (N_ "Start Date"))
|
||||
(define optname-to-date (N_ "End Date"))
|
||||
(define optname-account (N_ "Account"))
|
||||
(define optname-desc-filter (N_ "Desc Filter"))
|
||||
(define optname-desc-filter "Description Filter")
|
||||
|
||||
(define txn-type-alist
|
||||
(list (cons TXN-TYPE-NONE "None")
|
||||
@@ -133,6 +134,9 @@
|
||||
(let ((title (gnc-lot-get-title lot)))
|
||||
(if (string-null? title) "None" title)))
|
||||
|
||||
(define (lot->guid lot)
|
||||
(string-take (gncLotReturnGUID lot) 8))
|
||||
|
||||
(define (to-cell elt)
|
||||
(gnc:make-html-table-cell/markup "number-cell" elt))
|
||||
|
||||
@@ -158,8 +162,9 @@
|
||||
|
||||
(else
|
||||
(let ((table (gnc:make-html-table)))
|
||||
(gnc:html-table-set-col-headers!
|
||||
table `("Date" "Desc" "Type" ,@(map lot->title lots) "Non-APAR"))
|
||||
(gnc:html-table-set-multirow-col-headers!
|
||||
table `(("Date" "Desc" "Type" ,@(map lot->title lots) "Other Account")
|
||||
(#f #f #f ,@(map lot->guid lots) #f)))
|
||||
|
||||
(gnc:html-table-append-row!
|
||||
table `(#f "Document" #f ,@(map lot->document lots)))
|
||||
@@ -180,11 +185,8 @@
|
||||
(() (map (compose to-cell list->text) (reverse (cons splits accum))))
|
||||
((this-lot . rest-lots)
|
||||
(define (in-lot? s) (member s (car lots-splits)))
|
||||
(let lp1 ((splits splits) (next '()) (this '()))
|
||||
(match splits
|
||||
(() (lp rest-lots (cdr lots-splits) next (cons this accum)))
|
||||
(((? in-lot? head) . tail) (lp1 tail next (cons head this)))
|
||||
((head . tail) (lp1 tail (cons head next) this))))))))))
|
||||
(let-values (((this next) (partition in-lot? splits)))
|
||||
(lp rest-lots (cdr lots-splits) next (cons this accum)))))))))
|
||||
(sort transactions (lambda (a b) (< (xaccTransOrder a b) 0))))
|
||||
|
||||
(gnc:html-table-append-row!
|
||||
|
||||
Reference in New Issue
Block a user