test-extras.scm: centralize (sxml->table-row-col)

This is used in conjunction with (gnc:options->sxml) to extract
html table cells.

From SXML tree, retrieve, from a <table>, the th/tr/td cells as a list
of string.
This commit is contained in:
Christopher Lam
2018-05-09 20:36:40 +08:00
parent bb551af948
commit 66fcaa4f91
2 changed files with 18 additions and 23 deletions

View File

@@ -23,6 +23,7 @@
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system))
(use-modules (sxml simple))
(use-modules (sxml xpath))
(export pattern-streamer)
@@ -120,3 +121,19 @@
(format #t "*** XML error. see render output at ~a\n~a"
filename (gnc:html-render-options-changed options #t))
(throw k args))))))
(export sxml->table-row-col)
(define (sxml->table-row-col sxml tbl row col)
;; sxml - sxml input tree
;; tbl - table number (e.g. 2 = second table in tree)
;; row - row number (negative counts from bottom) or #f (all rows)
;; or zero (retrieves <th> headers)
;; col - col number (negative counts from right) or all cols
;;
;; output: list-of-string
(let* ((tbl-path `(table ,tbl))
(row-path (if (and row (not (zero? row))) `(tr ,row) 'tr))
(col-tag (if (and row (zero? row)) 'th 'td))
(col-path (if col `(,col-tag ,col) col-tag))
(xpath `(// ,tbl-path // ,row-path // ,col-path // *text*)))
((sxpath xpath) sxml)))

View File

@@ -94,29 +94,7 @@
(gnc:options->sxml trep-uuid options "test-trep" test-title))
(define (get-row-col sxml row col)
;; sxml, row & col (numbers or #f) -> list-of-string
;;
;; from an SXML table tree with tr/th/td elements, retrieve row/col
;; if row = 0 retrieve <tr><th> elements
;; if row = #f retrieve whole <td> col, excludes <th> cols
;; if col = #f retrieve whole <tr> row
;; if both = #f retrieve all text elements
;;
;; NOTE: This will retrieve cells from the first table in the tree.
;; If there are multiple tables, I recommend that the tree is first
;; pruned to the desired table via e.g. '(// (table 2)) then sent as
;; argument to this function.
(let ((xpath (cond
((not (or row col)) '(// (table 1) // tr // *text*))
((not row) `(// (table 1) // tr // (td ,col) // *text*))
((and (equal? row 0) (not col)) '(// (table 1) // tr // th // *text*))
((not col) `(// (table 1) // (tr ,row) // td // *text*))
((equal? row 0) `(// (table 1) // tr // (th ,col) // *text*))
(else `(// (table 1) // (tr ,row) // (td ,col) // *text*)))))
((sxpath xpath) sxml)))
;;
;; END CANDIDATES
;;
(sxml->table-row-col sxml 1 row col))
(define (set-option! options section name value)
(let ((option (gnc:lookup-option options section name)))