diff options
author | Steve Langasek <vorlon@debian.org> | 2005-01-10 08:53:33 +0000 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:30 -0800 |
commit | e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch) | |
tree | abbf06041619e445f9d0b772b0d58132009d8234 /report.scm | |
parent | f559c149c83da84d0b1c285f0298c84aec564af9 (diff) | |
parent | 8466d8cfa486fb30d1755c4261b781135083787b (diff) | |
download | slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.tar.gz slib-e33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e.zip |
Import Debian changes 3a1-4.2debian/3a1-4.2
slib (3a1-4.2) unstable; urgency=low
* Non-maintainer upload.
* Add guile.init.local for use within the build dir, since otherwise we
have an (earlier unnoticed) circular build-dep due to a difference
between scm and guile.
slib (3a1-4.1) unstable; urgency=low
* Non-maintainer upload.
* Build-depend on guile-1.6 instead of scm, since the new version of
scm is wedged in unstable (closes: #281809).
slib (3a1-4) unstable; urgency=low
* Also check for expected creation on slibcat. (Closes: #240096)
slib (3a1-3) unstable; urgency=low
* Also check for /usr/share/guile/1.6/slib before installing for guile
1.6. (Closes: #239267)
slib (3a1-2) unstable; urgency=low
* Add format.scm back into slib until gnucash stops using it.
* Call guile-1.6 new-catalog (Closes: #238231)
slib (3a1-1) unstable; urgency=low
* New upstream release
* Remove Info section from doc-base file (Closes: #186950)
* Remove period from end of description (linda, lintian)
* html gen fixed upstream (Closes: #111778)
slib (2d4-2) unstable; urgency=low
* Fix url for upstream source (Closes: #144981)
* Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
* Add build depends.
slib (2d4-1) unstable; urgency=low
* New upstream.
slib (2d3-1) unstable; urgency=low
* New upstream.
* Remove texi2html call in debian/rules. Now done upstream. Add make
html instead.
* Changes to rules and doc-base to conform to upstream html gen
* Clean up upstream makefile to make sure it cleans up after itself.
Diffstat (limited to 'report.scm')
-rw-r--r-- | report.scm | 116 |
1 files changed, 0 insertions, 116 deletions
diff --git a/report.scm b/report.scm deleted file mode 100644 index 2c44a23..0000000 --- a/report.scm +++ /dev/null @@ -1,116 +0,0 @@ -;;; "report.scm" relational-database-utility -; Copyright 1995 Aubrey Jaffer -; -;Permission to copy this software, to modify it, to redistribute it, -;to distribute modified versions, and to use it for any purpose is -;granted, subject to the following restrictions and understandings. -; -;1. Any copy made of this software must include this copyright notice -;in full. -; -;2. I have made no warrantee or representation that the operation of -;this software will be error-free, and I am under no obligation to -;provide any services, by way of maintenance, update, or otherwise. -; -;3. In conjunction with products arising from the use of this -;material, there shall be no use of my name in any advertising, -;promotional, or sales literature without prior written consent in -;each case. - -;;;; Considerations for report generation: -; * columnar vs. fixed-multi-line vs. variable-multi-line -; * overflow lines within column boundaries. -; * break overflow across page? -; * Page headers and footers (need to know current/previous record-number -; and next record-number). -; * Force page break on general expression (needs next row as arg). -; * Hierachical reports. - -;================================================================ - -(require 'format) -(require 'database-utilities) - -(define (dbutil:database arg) - (cond ((procedure? arg) arg) - ((string? arg) (dbutil:open-database arg)) - ((symbol? arg) (slib:eval arg)) - (else (slib:error "can't coerce to database: " arg)))) - -(define (dbutil:table arg) - (cond ((procedure? arg) arg) - ((and (list? arg) (= 2 (length arg))) - (((dbutil:database (car arg)) 'open-table) (cadr arg) #f)))) - -(define (dbutil:print-report table header reporter footer . args) - (define output-port (and (pair? args) (car args))) - (define page-height (and (pair? args) (pair? (cdr args)) (cadr args))) - (define minimum-break - (and (pair? args) (pair? (cdr args)) (pair? (cddr args)) (caddr args))) - (set! table (dbutil:table table)) - ((lambda (fun) - (cond ((output-port? output-port) - (fun output-port)) - ((string? output-port) - (call-with-output-file output-port fun)) - ((or (boolean? output-port) (null? output-port)) - (fun (current-output-port))) - (else (slib:error "can't coerce to output-port: " arg)))) - (lambda (output-port) - (set! page-height (or page-height (output-port-height output-port))) - (set! minimum-break (or minimum-break 0)) - (let ((output-page 0) - (output-line 0) - (nth-newline-index - (lambda (str n) - (define len (string-length str)) - (do ((i 0 (+ i 1))) - ((or (zero? n) (> i len)) (+ -1 i)) - (cond ((char=? #\newline (string-ref str i)) - (set! n (+ -1 n))))))) - (count-newlines - (lambda (str) - (define cnt 0) - (do ((i (+ -1 (string-length str)) (+ -1 i))) - ((negative? i) cnt) - (cond ((char=? #\newline (string-ref str i)) - (set! cnt (+ 1 cnt))))))) - (format (let ((oformat format)) - (lambda (dest fmt arg) - (cond ((not (procedure? fmt)) (oformat dest fmt arg)) - ((output-port? dest) (fmt dest arg)) - ((eq? #t dest) (fmt (current-output-port) arg)) - ((eq? #f dest) (call-with-output-string - (lambda (port) (fmt port arg)))) - (else (oformat dest fmt arg))))))) - (define column-names (table 'column-names)) - (define (do-header) - (let ((str (format #f header column-names))) - (display str output-port) - (set! output-line (count-newlines str)))) - (define (do-lines str inc) - (cond - ((< (+ output-line inc) page-height) - (display str output-port) - (set! output-line (+ output-line inc))) - (else ;outputting footer - (cond ((and (not (zero? minimum-break)) - (> cnt (* 2 minimum-break)) - (> (- page-height output-line) minimum-break)) - (let ((break (nth-newline-index - str (- page-height output-line)))) - (display (substring str 0 (+ 1 break) output-port)) - (set! str (substring str (+ 1 break) (string-length str))) - (set! inc (- inc (- page-height output-line)))))) - (format output-port footer column-names) - (display slib:form-feed output-port) - (set! output-page (+ 1 output-page)) - (do-header) - (do-lines str inc)))) - - (do-header) - ((table 'for-each-row) - (lambda (row) - (let ((str (format #f reporter row))) - (do-lines str (count-newlines str))))) - output-page)))) |