summaryrefslogtreecommitdiffstats
path: root/report.scm
diff options
context:
space:
mode:
authorSteve Langasek <vorlon@debian.org>2005-01-10 08:53:33 +0000
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:30 -0800
commite33f9eb9cf5cc29c36ce2aa7e10cd0f37ae0cc8e (patch)
treeabbf06041619e445f9d0b772b0d58132009d8234 /report.scm
parentf559c149c83da84d0b1c285f0298c84aec564af9 (diff)
parent8466d8cfa486fb30d1755c4261b781135083787b (diff)
downloadslib-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.scm116
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))))