diff --git a/src/register/table-allgui.h b/src/register/table-allgui.h index b79af9030b..e8102596f5 100644 --- a/src/register/table-allgui.h +++ b/src/register/table-allgui.h @@ -8,11 +8,11 @@ * important functions: * -- an array of strings, one for each cell of the displayed table. * These strings are kept in sync with what the user sees in - * the GUI (although they may be out of sync in currently + * the GUI (although they may be out of sync in currently * edited row(s)). * -- an array of cell-block handlers. The handlers provide * the actual GUI editing infrastructure: the handlers - * ake sure that only allowed edits are made to a block + * make sure that only allowed edits are made to a block * of cells. * -- The "cursor", which defines the region of cells that * are currently being edited. @@ -20,7 +20,7 @@ * to the cellblock handlers that know how to handle edits * to the physical, display cells. * -- A table of user-defined data hooks that can be associated - * with each cell block. By "user" we ean the prograer who + * with each cell block. By "user" we mean the programmer who * makes use of this object. * -- Tab-traversing mechanism so that operator can tab in a * predefined order between cells. diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm index 4277ba75d8..b62181264e 100644 --- a/src/scm/date-utilities.scm +++ b/src/scm/date-utilities.scm @@ -1,7 +1,9 @@ ;; -*-scheme-*- +;; $ID$ ;; dateutils.scm ;; date utility functions. mainly used by budget ;; Bryan Larsen (blarsen@ada-works.com) +;; Revised by Christopher Browne (gnc:support "dateutils.scm") @@ -80,3 +82,121 @@ ((gnc:budget-month) "months") ((gnc:budget-year) "years"))) +;; Modify a date +(define (moddate op adate delta) + (let ((newtm (localtime (car adate)))) + (begin + (set-tm:sec newtm (op (tm:sec newtm) (tm:sec delta))) + (set-tm:min newtm (op (tm:min newtm) (tm:min delta))) + (set-tm:hour newtm (op (tm:hour newtm) (tm:hour delta))) + (set-tm:mday newtm (op (tm:mday newtm) (tm:mday delta))) + (set-tm:mon newtm (op (tm:mon newtm) (tm:mon delta))) + (set-tm:year newtm (op (tm:year newtm) (tm:year delta))) + + (let ((time (car (mktime newtm)))) + (cons time 0))))) + +;; Add or subtract time from a date +(define (decdate adate delta)(moddate - adate delta )) +(define (incdate adate delta)(moddate + adate delta )) + +;; Time comparison, true if t2 is later than t1 +(define (gnc:timepair-later t1 t2) + (< (car t1) (car t2))) + +;; Build a list of time intervals +(define (dateloop curd endd incr) + (cond ((gnc:timepair-later curd endd) + (let ((nextd (incdate curd incr))) + (cons (list curd (decdate nextd SecDelta) '()) + (dateloop nextd endd incr)))) + (else '()))) + +; A reference zero date - the Beginning Of The Epoch +; Note: use of eval is evil... by making this a generator function, +; each delta function gets its own instance of Zero Date +(define (make-zdate) + (let ((zd (localtime 0))) + (set-tm:hour zd 0) + (set-tm:min zd 0) + (set-tm:sec zd 0) + (set-tm:mday zd 0) + (set-tm:mon zd 0) + (set-tm:year zd 0) + (set-tm:yday zd 0) + (set-tm:wday zd 0) + zd)) + +(define SecDelta + (let ((ddt (make-zdate))) + (set-tm:sec ddt 1) + ddt)) + +(define YearDelta + (let ((ddt (make-zdate))) + (set-tm:year ddt 1) + ddt)) + +(define DayDelta + (let ((ddt (make-zdate))) + (set-tm:mday ddt 1) + ddt)) + +(define WeekDelta + (let ((ddt (make-zdate))) + (set-tm:mday ddt 7) + ddt)) + +(define TwoWeekDelta + (let ((ddt (make-zdate))) + (set-tm:mday ddt 14) + ddt)) + +(define MonthDelta + (let ((ddt (make-zdate))) + (set-tm:mon ddt 1) + ddt)) + +(define (gnc:timepair-to-ldatestring tp) + (let ((bdtime (localtime (car tp)))) + (strftime "%m/%d/%Y" bdtime))) + +;; Find difference in seconds (?) between time 1 and time2 +(define (gnc:timepair-delta t1 t2) + (- (car t2) (car t1))) + +;; timepair manipulation functions +;; hack alert - these should probably be put somewhere else +;; and be implemented PROPERLY rather than hackily +;;; Added from transaction-report.scm + +(define (gnc:timepair-to-datestring tp) + (let ((bdtime (localtime (car tp)))) + (strftime "%x" bdtime))) + +;; given a timepair contains any time on a certain day (local time) +;; converts it to be midday that day. + +(define (gnc:timepair-canonical-day-time tp) + (let ((bdt (localtime (car tp)))) + (set-tm:sec bdt 0) + (set-tm:min bdt 0) + (set-tm:hour bdt 12) + (let ((newtime (car (mktime bdt)))) + ; alert - blarsen@ada-works.com fixed this. you may want to + ; revert if I'm wrong. + (cons newtime 0)))) + +(define (gnc:timepair-earlier-or-eq-date t1 t2) + (let ((time1 (car (gnc:timepair-canonical-day-time t1))) + (time2 (car (gnc:timepair-canonical-day-time t2)))) + (<= time1 time2))) + +(define (gnc:timepair-later-date t1 t2) + (let ((time1 (car (gnc:timepair-canonical-day-time t1))) + (time2 (car (gnc:timepair-canonical-day-time t2)))) + (< time1 time2))) + +(define (gnc:timepair-later-or-eq-date t1 t2) + (gnc:timepair-earlier-or-eq-date t2 t1)) + diff --git a/src/scm/html-generator.scm b/src/scm/html-generator.scm index 40826cc690..5f155522c5 100644 --- a/src/scm/html-generator.scm +++ b/src/scm/html-generator.scm @@ -98,3 +98,50 @@ (define (html-end-table) (list "")) +;;;; Here's functions defined in average-balance.scm +;;;; The point to this is twofold: +;;;; 1. It doesn't break anything because if the functions get +;;;; redefined somewhere here, things were *already broken.* +;;;; 2. It pushes all HTML stuff into *this* file, and encourages +;;;; fixing any resulting mess. +;;;;;;;;;;;;;;;;;;;; +;; HTML Table +;;;;;;;;;;;;;;;;;;;; + +; Convert to string +(define (tostring val) + (if (number? val) + (sprintf #f "%.2f" val) + (call-with-output-string + (lambda (p) + (display val p))))) + +; Create a column entry +(define (html-table-col val) + (sprintf #f " %s " (tostring val))) + +; Create an html table row from a list of entries +(define (html-table-row lst) + (cond ((string? lst) lst) + (else + (string-append + (sprintf #f "") + (apply string-append (map html-table-col lst)) + (sprintf #f "\n"))))) + +; Create an html table from a list of rows, each containing +; a list of column entries +(define (html-table hdrlst llst) + (string-append + (html-table-header hdrlst) + (apply string-append (map html-table-row llst)) + (html-table-footer))) + +(define (html-table-headcol val) + (sprintf #f " %s " (tostring val))) + +(define (html-table-header vec) + (apply string-append "\n" (map html-table-headcol vec))) + +(define (html-table-footer) + (sprintf #f "
")) diff --git a/src/scm/dates-qif.scm b/src/scm/qifs/dates-qif.scm similarity index 99% rename from src/scm/dates-qif.scm rename to src/scm/qifs/dates-qif.scm index b063496543..08e4646417 100644 --- a/src/scm/dates-qif.scm +++ b/src/scm/qifs/dates-qif.scm @@ -1,4 +1,7 @@ ;; $Id$ +(gnc:support "qifs/dates-qif.scm") +(gnc:depend "substring-search.scm") + ;;;;;;; Date-related code (define findspace (substring-search-maker " ")) diff --git a/src/scm/gc-import-qifs.scm b/src/scm/qifs/gc-import-qifs.scm similarity index 89% rename from src/scm/gc-import-qifs.scm rename to src/scm/qifs/gc-import-qifs.scm index 8d173733b4..57f7772f3a 100644 --- a/src/scm/gc-import-qifs.scm +++ b/src/scm/qifs/gc-import-qifs.scm @@ -1,4 +1,8 @@ ;;; $Id$ +(gnc:support "qifs/gc-import-qifs.scm") +(gnc:depend "qifs/qifcats.scm") +(gnc:depend "qifs/qif2gc.scm") + (display "Started gc-impor.scm") (newline) (define (gnc:get-account-list account-group) @@ -13,7 +17,6 @@ (newline) (filteroutnulls fullacclist)))) - (define (gnc:import-file-into-account-group account-group) ;(sample-dialog) (let ((file-name diff --git a/src/scm/guess-category-qif.scm b/src/scm/qifs/guess-category-qif.scm similarity index 96% rename from src/scm/guess-category-qif.scm rename to src/scm/qifs/guess-category-qif.scm index b4c76c11d8..622f0ae484 100644 --- a/src/scm/guess-category-qif.scm +++ b/src/scm/qifs/guess-category-qif.scm @@ -1,4 +1,7 @@ ;;; $Id$ +(gnc:support "qifs/guess-category-qif.scm") +(gnc:depend "substring-search.scm") + ;;; Need a bunch of metrics, and probably to vectorize this... ;;; 1. Braces --> pick gnucash entries from account list ;;; No braces --> pick gnucash entries from category list @@ -100,4 +103,4 @@ (guess-corresponding-categories kept-categories (gnc:get-incomes-list account-group) - (gnc:get-account-list account-group))) \ No newline at end of file + (gnc:get-account-list account-group))) diff --git a/src/scm/importqif.scm b/src/scm/qifs/importqif.scm similarity index 90% rename from src/scm/importqif.scm rename to src/scm/qifs/importqif.scm index 991adc82ca..9ee38f211d 100644 --- a/src/scm/importqif.scm +++ b/src/scm/qifs/importqif.scm @@ -1,7 +1,7 @@ ;;; $Id$ ;;; Import QIF File - (gnc:support "importqif.scm") +(gnc:depend "qifs/gc-import-qifs.scm") (define testing? #f) ;;; Should we do testing? @@ -15,7 +15,7 @@ (begin (display "account-group:") (display account-group) (newline) - (let ((loadfun (lambda (x) (gnc:load x))) + (let ((loadfun (lambda (x) (gnc:load (string-append "qifs/" x)))) (loadlist '("testbed.scm" "analytical-qifs.scm" "gc-import-qifs.scm" "qifutils.scm" "acc-create.scm"))) @@ -35,7 +35,7 @@ (begin (display "account-group:") (display account-group) (newline) - (let ((loadfun (lambda (x) (gnc:load x))) + (let ((loadfun (lambda (x) (gnc:load (string-append "qifs/" x)))) (loadlist '("testbed.scm" "analytical-qifs.scm" "gc-import-qifs.scm" "qifutils.scm" "acc-create.scm" "txn-create.scm"))) @@ -55,8 +55,8 @@ (begin (display "account-group:") (display account-group) (newline) - (let ((loadfun (lambda (x) (gnc:load x))) - (loadlist '("testbed.scm" "sstring-qif.scm" + (let ((loadfun (lambda (x) (gnc:load (string-append "qifs/" x)))) + (loadlist '("testbed.scm" "qifutils.scm" "dates-qif.scm" "acc-create.scm" "txn-create.scm" diff --git a/src/scm/parseqif.scm b/src/scm/qifs/parseqif.scm similarity index 96% rename from src/scm/parseqif.scm rename to src/scm/qifs/parseqif.scm index 61a41688ea..ae4a84969f 100644 --- a/src/scm/parseqif.scm +++ b/src/scm/qifs/parseqif.scm @@ -1,7 +1,12 @@ ;;; $Id$ -;;;;;;;;;;; QIF Parsing ;;;;;;;;;;;;;; - (require 'hash-table) +(gnc:support "qifs/parseqif.scm") +(gnc:depend "qifs/qifcats.scm") +(gnc:depend "qifs/dates-qif.scm") +(gnc:depend "qifs/gc-import-qifs.scm") +(gnc:depend "qifs/qifstate.scm") +(gnc:depend "qifs/split-qif.scm") +(gnc:depend "qifs/guess-category-qif.scm") (define qif-txn-list '()) diff --git a/src/scm/qif2gc.scm b/src/scm/qifs/qif2gc.scm similarity index 98% rename from src/scm/qif2gc.scm rename to src/scm/qifs/qif2gc.scm index bf2ec22e65..ff96bd6ca8 100644 --- a/src/scm/qif2gc.scm +++ b/src/scm/qifs/qif2gc.scm @@ -1,4 +1,6 @@ ;;; $Id$ +(gnc:support "qifs/qif2gc.scm") +(gnc:depend "qifs/guess-category-qif.scm") ;;;; Take the set of stuff from a QIF file, and turn it into the ;;;; structures expected by GnuCash. diff --git a/src/scm/qifcats.scm b/src/scm/qifs/qifcats.scm similarity index 98% rename from src/scm/qifcats.scm rename to src/scm/qifs/qifcats.scm index fc97f9c46a..d46ca8192e 100644 --- a/src/scm/qifcats.scm +++ b/src/scm/qifs/qifcats.scm @@ -1,5 +1,6 @@ ;;; $Id$ ;;;;; Category management +(gnc:support "qifs/qifcats.scm") (define qif-cat-list (initialize-hashtable)) diff --git a/src/scm/qifstate.scm b/src/scm/qifs/qifstate.scm similarity index 98% rename from src/scm/qifstate.scm rename to src/scm/qifs/qifstate.scm index 569d9b896e..7ffe80d40c 100644 --- a/src/scm/qifstate.scm +++ b/src/scm/qifs/qifstate.scm @@ -1,4 +1,5 @@ ;;; $Id$ +(gnc:support "qifs/qifstate.scm") ;;;;; - Transactions should not be marked off as being finally reconciled on ;;;;; the GnuCash side, as the reconciliation hasn't been done there. ;;;;; diff --git a/src/scm/qifutils.scm b/src/scm/qifs/qifutils.scm similarity index 64% rename from src/scm/qifutils.scm rename to src/scm/qifs/qifutils.scm index 84f68a4812..825df1cade 100644 --- a/src/scm/qifutils.scm +++ b/src/scm/qifs/qifutils.scm @@ -1,75 +1,6 @@ ;;; $Id$ -(define (directory? path) - ;; This follows symlinks normally. - (let* ((status (false-if-exception (stat path))) - (type (if status (stat:type status) #f))) - (eq? type 'directory))) - -(define (filteroutnulls lst) - (cond - ((null? lst) '()) - ((eq? (car lst) #f) (filteroutnulls (cdr lst))) - (else - (cons (car lst) (filteroutnulls (cdr lst)))))) - -(if testing? - (let ((i1 '(a b #f f g h #f #f (c d e #f #f) #f)) - (i2 '(#f #f #f #f))) - (testing "filteroutnulls" - i1 - '(a b f g h (c d e #f #f)) - (filteroutnulls i1)) - - (testing "filteroutnulls" - i2 - '() - (filteroutnulls i2)))) - -(define (atom? x) - (and - (not (pair? x)) - (not (null? x)))) - -(define (flatten lst) - (cond - ((null? lst) '()) - ((atom? lst) (list lst)) - ((list? lst) - (append (flatten (car lst)) - (flatten (cdr lst)))) - (else lst))) - -(if testing? - (let ((input '(a b (c d (e (f) (g) (h i (j k))) l m no p)))) - (testing "flatten" - input - '(a b c d e f g h i j k l m no p) - (flatten input)))) - -(define (striptrailingwhitespace line) - (let - ((stringsize (string-length line))) - (if - (< stringsize 1) - "" - (let* - ((lastchar (string-ref line (- stringsize 1)))) - (if - (char-whitespace? lastchar) - (striptrailingwhitespace (substring line 0 (- stringsize 1))) - line))))) - -(if testing? - (begin - (newline) - (display "Test striptrailingwhitespace") (newline) - (let ((tstring "Here's a string - - - -")) - (display tstring) (newline) - (display "Result:") (display (striptrailingwhitespace tstring)) (newline)))) +(gnc:support "qifs/qifutils.scm") +(gnc:depend "utilities.scm") (define (strip-qif-header line) (substring line 1 (string-length line))) @@ -130,16 +61,6 @@ #\. (thousands-separator num))))) -(define (string-join lst joinstr) - (let ((len (length lst))) - (cond - ((< 1 len) - (string-append (car lst) joinstr (string-join (cdr lst) joinstr))) - ((= 1 len) - (car lst)) - (else - "")))) - (define (numerizeamount amount-as-string) (let* ( @@ -215,11 +136,3 @@ '(d a e) (shorten-to-best! 3 alist)))) -;;;; Simple lookup scheme; can be turned into a hash table If Need Be. -;;; Initialize lookup table -(define (initialize-hashtable . size) - (make-vector - (if (null? size) - 313 - (car size)) - '())) \ No newline at end of file diff --git a/src/scm/split-qif.scm b/src/scm/qifs/split-qif.scm similarity index 97% rename from src/scm/split-qif.scm rename to src/scm/qifs/split-qif.scm index acb582f383..f17071a28e 100644 --- a/src/scm/split-qif.scm +++ b/src/scm/qifs/split-qif.scm @@ -3,6 +3,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Variables used to handle splits ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(gnc:support "qifs/split-qif.scm") +(gnc:depend "structure.scm") + (define splits? #f) (define splitlist '()) (define qif-split-structure diff --git a/src/scm/report-utilities.scm b/src/scm/report-utilities.scm index 588c178b40..7490d609e2 100644 --- a/src/scm/report-utilities.scm +++ b/src/scm/report-utilities.scm @@ -1,6 +1,5 @@ ;;; $Id$ ;;; Reporting utilities - (gnc:support "report-utilities.scm") (define (gnc:account-separator-char) @@ -197,4 +196,127 @@ (vector-N-ref vector ref-list)) (loop (+ 1 i)))))))))) +;;; applies thunk to each split in account account +(define (gnc:for-each-split-in-account account thunk) + (gnc:for-loop (lambda (x) + (thunk (gnc:account-get-split account x))) + 0 (gnc:account-get-split-count account) 1)) + +;; register a configuration option for the transaction report +(define (trep-options-generator) + (define gnc:*transaction-report-options* (gnc:new-options)) + (define (gnc:register-trep-option new-option) + (gnc:register-option gnc:*transaction-report-options* new-option)) + ;; from date + ;; hack alert - could somebody set this to an appropriate date? + (gnc:register-trep-option + (gnc:make-date-option + "Report Options" "From" + "a" "Report Items from this date" + (lambda () + (let ((bdtime (localtime (current-time)))) + (set-tm:sec bdtime 0) + (set-tm:min bdtime 0) + (set-tm:hour bdtime 0) + (set-tm:mday bdtime 1) + (set-tm:mon bdtime 0) + (let ((time (car (mktime bdtime)))) + (cons time 0)))) + #f)) + + ;; to-date + (gnc:register-trep-option + (gnc:make-date-option + "Report Options" "To" + "b" "Report items up to and including this date" + (lambda () (cons (current-time) 0)) + #f)) + + ;; account to do report on + (gnc:register-trep-option + (gnc:make-account-list-option + "Report Options" "Account" + "c" "Do transaction report on this account" + (lambda () + (let ((current-accounts (gnc:get-current-accounts)) + (num-accounts (gnc:group-get-num-accounts (gnc:get-current-group))) + (first-account (gnc:group-get-account (gnc:get-current-group) 0))) + (cond ((not (null? current-accounts)) (list (car current-accounts))) + ((> num-accounts 0) (list first-account)) + (else ())))) + #f #f)) + + ;; primary sorting criterion + (gnc:register-trep-option + (gnc:make-multichoice-option + "Sorting" "Primary Key" + "a" "Sort by this criterion first" + 'date + (list #(date + "Date" + "Sort by date") + #(time + "Time" + "Sort by EXACT entry time") + #(corresponding-acc + "Transfer from/to" + "Sort by account transferred from/to's name") + #(amount + "Amount" + "Sort by amount") + #(description + "Description" + "Sort by description") + #(number + "Number" + "Sort by check/transaction number") + #(memo + "Memo" + "Sort by memo")))) + + (gnc:register-trep-option + (gnc:make-multichoice-option + "Sorting" "Primary Sort Order" + "b" "Order of primary sorting" + 'ascend + (list #(ascend "Ascending" "smallest to largest, earliest to latest") + #(descend "Descending" "largest to smallest, latest to earliest")))) + + (gnc:register-trep-option + (gnc:make-multichoice-option + "Sorting" "Secondary Key" + "c" + "Sort by this criterion second" + 'corresponding-acc + (list #(date + "Date" + "Sort by date") + #(time + "Time" + "Sort by EXACT entry time") + #(corresponding-acc + "Transfer from/to" + "Sort by account transferred from/to's name") + #(amount + "Amount" + "Sort by amount") + #(description + "Description" + "Sort by description") + #(number + "Number" + "Sort by check/transaction number") + #(memo + "Memo" + "Sort by memo")))) + + (gnc:register-trep-option + (gnc:make-multichoice-option + "Sorting" "Secondary Sort Order" + "d" "Order of Secondary sorting" + 'ascend + (list #(ascend "Ascending" "smallest to largest, earliest to latest") + #(descend "Descending" "largest to smallest, latest to earliest")))) + + gnc:*transaction-report-options*) diff --git a/src/scm/report/average-balance.scm b/src/scm/report/average-balance.scm index 3ac163c4c6..dcb00bf40c 100644 --- a/src/scm/report/average-balance.scm +++ b/src/scm/report/average-balance.scm @@ -10,47 +10,12 @@ ;; Matt Martin (gnc:support "report/average-balance.scm") - (use-modules (ice-9 regex)) (require 'hash-table) (gnc:depend "structure.scm") -(gnc:depend "report/transaction-report.scm") - -;; Modify a date -(define (moddate op adate delta) - (let ((newtm (localtime (car adate)))) - (begin - (set-tm:sec newtm (op (tm:sec newtm) (tm:sec delta))) - (set-tm:min newtm (op (tm:min newtm) (tm:min delta))) - (set-tm:hour newtm (op (tm:hour newtm) (tm:hour delta))) - (set-tm:mday newtm (op (tm:mday newtm) (tm:mday delta))) - (set-tm:mon newtm (op (tm:mon newtm) (tm:mon delta))) - (set-tm:year newtm (op (tm:year newtm) (tm:year delta))) - - (let ((time (car (mktime newtm)))) - (cons time 0)) - )) - ) - -;; Add or subtract time from a date -(define (decdate adate delta)(moddate - adate delta )) -(define (incdate adate delta)(moddate + adate delta )) - -;; Time comparison, true if t2 is later than t1 -(define (gnc:timepair-later t1 t2) - (< (car t1) (car t2))) - -;; Build a list of time intervals -(define (dateloop curd endd incr) - (cond ((gnc:timepair-later curd endd) - (let ((nextd (incdate curd incr))) - (cons (list curd (decdate nextd SecDelta) '()) - (dateloop nextd endd incr)))) - (else '()) - ) - ) - +(gnc:depend "html-generator.scm") +(gnc:depend "date-utilities.scm") ;; Options (define (runavg-options-generator) @@ -73,9 +38,8 @@ (set-tm:hour bdtime 0) (set-tm:mday bdtime 1) (set-tm:mon bdtime 0) - (let ((time (car (mktime bdtime)))) - (cons time 0)))) - #f)) + (cons (car (mktime bdtime)) 0)))) + #f)) ;; to-date (gnc:register-runavg-option @@ -135,45 +99,10 @@ (list #(NoPlot "Nothing" "Make No Plot") #(AvgBalPlot "Average" "Average Balance") #(GainPlot "Net Gain" "Net Gain") - #(GLPlot "Gain/Loss" "Gain And Loss") - ))) + #(GLPlot "Gain/Loss" "Gain And Loss")))) gnc:*runavg-track-options*) -; A reference zero date -(define zdate (let ((zd (localtime 0))) - (set-tm:hour zd 0) - (set-tm:min zd 0) - (set-tm:sec zd 0) - (set-tm:mday zd 0) - (set-tm:mon zd 0) - (set-tm:year zd 0) - (set-tm:yday zd 0) - (set-tm:wday zd 0) - zd - )) - -(define SecDelta (let ((ddt (eval zdate))) - (set-tm:sec ddt 1) - ddt)) -(define YearDelta (let ((ddt (eval zdate))) - (set-tm:year ddt 1) - ddt)) - -(define DayDelta (let ((ddt (eval zdate))) - (set-tm:mday ddt 1) - ddt)) -(define WeekDelta (let ((ddt (eval zdate))) - (set-tm:mday ddt 7) - ddt)) -(define TwoWeekDelta (let ((ddt (eval zdate))) - (set-tm:mday ddt 14) - ddt)) - -(define MonthDelta (let ((ddt (eval zdate))) - (set-tm:mon ddt 1) - ddt)) - ;; Plot strings (define AvgBalPlot "using 2:3:4:5 t 'Average Balance' with errorbars, '' using 2:3 smooth sbezier t '' with lines") (define GainPlot "using 2:6 t 'Net Gain' with linespoints, '' using 2:6 smooth sbezier t '' with lines" ) @@ -199,64 +128,6 @@ (define (gnc:split-get-account-name split) (gnc:account-get-name (gnc:split-get-account split))) -(define (gnc:timepair-to-ldatestring tp) - (let ((bdtime (localtime (car tp)))) - (strftime "%m/%d/%Y" bdtime))) - - -;; Find difference in seconds (?) between time 1 and time2 -(define (gnc:timepair-delta t1 t2) - (- (car t2) (car t1))) - -; Convert to string -(define (tostring val) - (cond ((number? val) (sprintf #f "%.2f" val)) - (else (call-with-output-string (lambda (p)(display val p)))) - )) - -;;;;;;;;;;;;;;;;;;;; -;; HTML Table -;;;;;;;;;;;;;;;;;;;; - -; Create a column entry -(define (html-table-col val) - (sprintf #f " %s " (tostring val)) - ) - -; Create an html table row from a list of entries -(define (html-table-row lst) - (cond ((string? lst) lst) - (else - (string-append - (sprintf #f "") - (apply string-append (map html-table-col lst)) - (sprintf #f "\n") - ))) - ) - -; Create an html table from a list of rows, each containing -; a list of column entries -(define (html-table hdrlst llst) - (string-append - (html-table-header hdrlst) - (apply string-append (map html-table-row llst)) - (html-table-footer) - ) - ) - -(define (html-table-headcol val) - (sprintf #f " %s " (tostring val)) - ) - -(define (html-table-header vec) - (apply string-append "\n" (map html-table-headcol vec)) - ) - -(define (html-table-footer) - (sprintf #f "
") - ) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Text table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -489,6 +360,120 @@ (gnc:account-get-children (car accounts))) (allsubaccounts (cdr accounts)))))) +(define (average-balance-renderer options) + (let* ((begindate (gnc:option-value + (gnc:lookup-option options "Report Options" "From"))) + (enddate (gnc:option-value + (gnc:lookup-option options "Report Options" "To"))) + (stepsize (gnc:option-value + (gnc:lookup-option options "Report Options" "Step Size"))) + + (plotstr (gnc:option-value + (gnc:lookup-option options "Report Options" "Plot Type"))) + + (accounts (gnc:option-value + (gnc:lookup-option options + "Report Options" "Account"))) + + (dosubs (gnc:option-value + (gnc:lookup-option options + "Report Options" "Sub-Accounts"))) + + (prefix (list "" "")) + (suffix (list "" "")) + (collist + (list "Beginning" "Ending" "Average" "Max" "Min" "Net Gain" "Gain" "Loss")) + + (report-lines '()) + (rept-data '()) + (sum-data '()) + (tempstruct '()) + (rept-text "") + (gncq (gnc:malloc-query)) + + (slist '())) + + (gnc:init-query gncq) + + (if (null? accounts) + (set! rept-text + (list "You have not selected an account.")) + (begin + ; Grab account names + (set! acctname (string-join + (map gnc-account-getname accounts) + " , ")) + (cond ((equal? dosubs #t) + (map (lambda (a) + (set! accounts (addunique accounts a))) + (allsubaccounts accounts)) + + (set! acctname (string-append acctname " and sub-accounts")))) + + (map (lambda(acct) (gnc:query-add-account gncq acct)) accounts) + + (set! tempstruct + (build-mystruct-instance + (define-mystruct + (gnc:acctnames-from-list accounts)))) + + (set! acctcurrency (gnc:account-get-currency (car accounts))) + + (set! report-lines + (gnc:convert-split-list (gnc:query-get-splits gncq))) + + (gnc:free-query gncq) + + (display (length report-lines)) + (display " Splits\n") + + ; Set initial balances to zero + (map (lambda(an) (tempstruct 'put an 0)) + (gnc:acctnames-from-list accounts)) + + (dateloop begindate + enddate + (eval stepsize)) + (set! rept-data + (reduce-split-list + (dateloop begindate + enddate + (eval stepsize)) + report-lines zdate tempstruct)) + + (set! sum-data (get-averages rept-data)) + + ;; Create HTML + (set! rept-text + (html-table + collist + (append rept-data + (list "
" sum-data)))) + + ;; Do a plot + (if (not (equal? NoPlot (eval plotstr))) + (let* ((fn "/tmp/gncplot.dat") + (preplot (string-append + "set xdata time\n" + "set timefmt '%m/%d/%Y'\n" + "set pointsize 2\n" + "set title '" acctname "'\n" + "set ylabel '" acctcurrency "'\n" + "set xlabel 'Period Ending'\n" + ))) + + (data-to-gpfile collist rept-data fn (eval plotstr)) + (system + (string-append "echo \"" preplot "plot '" + fn "'" (eval plotstr) + "\"|gnuplot -persist " )))))) + + (append prefix + (if (null? accounts) + () + (list "Report for " acctname "

\n")) + (list rept-text) suffix)))) + (gnc:define-report ;; version 1 @@ -497,128 +482,4 @@ ;; Options runavg-options-generator ;; renderer - (lambda (options) - (let* ( - (begindate (gnc:option-value - (gnc:lookup-option options "Report Options" "From"))) - (enddate (gnc:option-value - (gnc:lookup-option options "Report Options" "To"))) - (stepsize (gnc:option-value - (gnc:lookup-option options "Report Options" "Step Size"))) - - (plotstr (gnc:option-value - (gnc:lookup-option options "Report Options" "Plot Type"))) - - (accounts (gnc:option-value - (gnc:lookup-option options - "Report Options" "Account"))) - - (dosubs (gnc:option-value - (gnc:lookup-option options - "Report Options" "Sub-Accounts"))) - - (prefix (list "" "")) - (suffix (list "" "")) - (collist - (list "Beginning" "Ending" "Average" "Max" "Min" "Net Gain" "Gain" "Loss")) - - (report-lines '()) - (rept-data '()) - (sum-data '()) - (tempstruct '()) - (rept-text "") - (gncq (gnc:malloc-query)) - - (slist '()) - - ) - - (gnc:init-query gncq) - - (if (null? accounts) - (set! rept-text - (list "You have not selected an account.")) - (begin - ; Grab account names - (set! acctname (gnc:account-get-name (car accounts))) - (map (lambda(an) - (set! acctname - (string-append - acctname - " , " - (gnc:account-get-name an)))) - (cdr accounts) ) - - (cond ((equal? dosubs #t) - (map (lambda (a) - (set! accounts (addunique accounts a))) - (allsubaccounts accounts)) - - (set! acctname (string-append acctname " and sub-accounts")) - )) - - (map (lambda(acct) (gnc:query-add-account gncq acct)) accounts) - - (set! tempstruct - (build-mystruct-instance - (define-mystruct - (gnc:acctnames-from-list accounts)))) - - (set! acctcurrency (gnc:account-get-currency (car accounts))) - - (set! report-lines - (gnc:convert-split-list (gnc:query-get-splits gncq))) - - (gnc:free-query gncq) - - (display (length report-lines)) - (display " Splits\n") - - ; Set initial balances to zero - (map (lambda(an) (tempstruct 'put an 0)) - (gnc:acctnames-from-list accounts)) - - (dateloop begindate - enddate - (eval stepsize)) - (set! rept-data - (reduce-split-list - (dateloop begindate - enddate - (eval stepsize)) - report-lines zdate tempstruct)) - - (set! sum-data (get-averages rept-data)) - - ;; Create HTML - (set! rept-text - (html-table - collist - (append rept-data - (list "

" sum-data)))) - - ;; Do a plot - (if (not (equal? NoPlot (eval plotstr))) - (let* ((fn "/tmp/gncplot.dat") - (preplot (string-append - "set xdata time\n" - "set timefmt '%m/%d/%Y'\n" - "set pointsize 2\n" - "set title '" acctname "'\n" - "set ylabel '" acctcurrency "'\n" - "set xlabel 'Period Ending'\n" - ))) - - (data-to-gpfile collist rept-data fn (eval plotstr)) - (system - (string-append "echo \"" preplot "plot '" - fn "'" (eval plotstr) - "\"|gnuplot -persist " )))) - )) - - (append prefix - (if (null? accounts) - () - (list "Report for " acctname "

\n")) - (list rept-text) suffix))) -) +average-balance-renderer) diff --git a/src/scm/report/balance-and-pnl.scm b/src/scm/report/balance-and-pnl.scm index a41afcb6a9..aa481413d3 100644 --- a/src/scm/report/balance-and-pnl.scm +++ b/src/scm/report/balance-and-pnl.scm @@ -1,7 +1,6 @@ ;; -*-scheme-*- (gnc:support "report/balance-and-pnl.scm") - (gnc:depend "text-export.scm") (let () @@ -94,7 +93,6 @@ ;; Ignore '() - (let ((childrens-output (gnc:group-map-accounts handle-level-2-account (gnc:account-get-children account))) @@ -107,13 +105,13 @@ (set! level-1-balance (+ level-1-balance account-balance)) (set! level-0-balance (+ level-0-balance level-1-balance)) - (let ((level-1-output (render-level-1-account account - level-1-balance - level-2-balance))) + (let ((level-1-output + (render-level-1-account account + level-1-balance + level-2-balance))) (set! level-1-balance 0) (set! level-2-balance 0) (list childrens-output level-1-output)))))) - (if (not (pointer-token-null? current-group)) (set! output (list diff --git a/src/scm/report/budget-report.scm b/src/scm/report/budget-report.scm index d651f0f051..347f95b17b 100644 --- a/src/scm/report/budget-report.scm +++ b/src/scm/report/budget-report.scm @@ -15,7 +15,6 @@ (gnc:depend "html-generator.scm") (gnc:depend "date-utilities.scm") - ;; time values ;(define gnc:budget-day 1) ;(define gnc:budget-week 2) @@ -38,10 +37,21 @@ ;; 3 - period: the time span of the budget line in #4 ;; 4 - period-type: ;; 5 - triggers: as yet undefined -(define gnc:budget - #(#("lunch" 8 ("Food:Lunch") 1 gnc:budget-day gnc:budget-recurring) - #("junk food" 0.50 ("Food:Junk") 1 gnc:budget-day gnc:budget-recurring) - #("car repairs" 2500 ("Car:Repairs") 5 gnc:budget-year gnc:budget-contingency))) + +(define (make-budget-entry desc amt acct per ptype trigger) + (list->vector desc amt acct per ptype trigger)) + +(define gnc:budget + (list->vector + (make-budget-entry "lunch" 8 ("Food:Lunch") 1 + gnc:budget-day gnc:budget-recurring) + (make-budget-entry "junk food" 0.50 ("Food:Junk") 1 + gnc:budget-day gnc:budget-recurring) + (make-budget-entry "car repairs" 2500 ("Car:Repairs") 5 + gnc:budget-year gnc:budget-contingency))) + +;;; For future: make-budget-entry should create a structure. +;;; And gnc:budget should be a list, not a vector. (define gnc:budget-headers #(("" "Description") @@ -239,12 +249,8 @@ #(status "Status" "How are you doing on your budget?")))) - - gnc:*budget-report-options*) - - (gnc:define-report ;; version 1 @@ -254,7 +260,11 @@ budget-report-options-generator ;; renderer (lambda (options) - (let* ((begindate (gnc:lookup-option options "Report Options" "From")) + (let* ((maxrow (vector-length gnc:budget)) + ;;; Note that by using maxrow, *all* references to + ;;; (vector-length gnc:budget) disappear, and this notably + ;;; takes some code out of at least 3 loops... + (begindate (gnc:lookup-option options "Report Options" "From")) (enddate (gnc:lookup-option options "Report Options" "To")) (date-filter-pred (gnc:tr-report-make-filter-predicate (gnc:option-value begindate) @@ -263,13 +273,13 @@ (gnc:option-value begindate)))) (end-date-secs (car (gnc:timepair-canonical-day-time (gnc:option-value enddate)))) - (budget-report (make-vector (vector-length gnc:budget))) + (budget-report (make-vector maxrow)) (budget-order #()) (budget-report-order #())) (gnc:debug gnc:budget) (do ((i 0 (+ i 1))) - ((= i (vector-length gnc:budget))) + ((= i maxrow)) (vector-set! budget-report i (vector 0 0 0 0 0 0))) (let loop ((group (gnc:get-current-group))) @@ -291,8 +301,10 @@ (loop children))) group))) + ;;; Note: This shouldn't need to use a set of vectors... + (do ((i 0 (+ i 1))) - ((= i (vector-length gnc:budget))) + ((= i maxrow)) (let ((budget-line (vector-ref gnc:budget i)) (budget-report-line (vector-ref budget-report i))) (gnc:budget-calculate-periods! @@ -316,9 +328,8 @@ (set! budget-report-order #(10 #f #f 4 5 2))) (else (gnc:debug "Invalid view option"))) - (let ((order (find-vector-mappings - (vector budget-order budget-report-order)))) + (vector budget-order budget-report-order)))) (list (html-start-document) "

This is a budget report. It is very preliminary, but you may find it useful. To actually change the budget, currently you have to edit budget-report.scm.

" @@ -333,17 +344,18 @@ (lambda (item) (html-cell-header (cadr item))) (vector gnc:budget-headers gnc:budget-report-headers) order)) + ;;; This loop ought not to need to use a vector (let loop ((row 0)) - (cond ((= row (vector-length gnc:budget)) '()) - (else - (cons - (html-table-row-manual - (vector-map-in-specified-order-uniquely - (vector (gnc:budget-html-cell-pred) - (gnc:budget-report-html-cell-pred)) - (vector (vector-ref gnc:budget row) - (vector-ref budget-report row)) - order)) - (loop (+ row 1)))))) + (if (= row maxrow) + '() + (cons + (html-table-row-manual + (vector-map-in-specified-order-uniquely + (vector (gnc:budget-html-cell-pred) + (gnc:budget-report-html-cell-pred)) + (vector (vector-ref gnc:budget row) + (vector-ref budget-report row)) + order)) + (loop (+ row 1))))) (html-end-table) (html-end-document)))))) \ No newline at end of file diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm index e2d1b538d9..4f0e6652a0 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -1,7 +1,6 @@ ;; Index file to load all of the releavant reports. (gnc:support "report/report-list.scm") - (gnc:depend "report/average-balance.scm") (gnc:depend "report/balance-and-pnl.scm") (gnc:depend "report/folio.scm") diff --git a/src/scm/report/transaction-report.scm b/src/scm/report/transaction-report.scm index 98c357f5f5..9dc41ba5d6 100644 --- a/src/scm/report/transaction-report.scm +++ b/src/scm/report/transaction-report.scm @@ -3,23 +3,20 @@ ;; Report on all transactions in an account ;; Robert Merkel (rgmerk@mira.net) -(gnc:support "report/transaction-report.scm") - (require 'sort) - +(gnc:support "report/transaction-report.scm") ;hack alert - is this line necessary? (gnc:depend "text-export.scm") (gnc:depend "report-utilities.scm") +(gnc:depend "date-utilities.scm") +(gnc:depend "html-generator.scm") ;; hack alert - possibly unecessary globals - - ;; functions for manipulating total inflow and outflow counts. (define gnc:total-inflow 0) (define gnc:total-outflow 0) - (define (gnc:set-total-inflow! x) (set! gnc:total-inflow x)) @@ -53,128 +50,6 @@ (else (cons (fn (car the-list)) (gnc:inorder-map (cdr the-list) fn))))) -;; register a configuration option for the transaction report -(define (trep-options-generator) - - (define gnc:*transaction-report-options* (gnc:new-options)) - - (define (gnc:register-trep-option new-option) - (gnc:register-option gnc:*transaction-report-options* new-option)) - - ;; from date - ;; hack alert - could somebody set this to an appropriate date? - (gnc:register-trep-option - (gnc:make-date-option - "Report Options" "From" - "a" "Report Items from this date" - (lambda () - (let ((bdtime (localtime (current-time)))) - (set-tm:sec bdtime 0) - (set-tm:min bdtime 0) - (set-tm:hour bdtime 0) - (set-tm:mday bdtime 1) - (set-tm:mon bdtime 0) - (let ((time (car (mktime bdtime)))) - (cons time 0)))) - #f)) - - ;; to-date - (gnc:register-trep-option - (gnc:make-date-option - "Report Options" "To" - "b" "Report items up to and including this date" - (lambda () (cons (current-time) 0)) - #f)) - - ;; account to do report on - (gnc:register-trep-option - (gnc:make-account-list-option - "Report Options" "Account" - "c" "Do transaction report on this account" - (lambda () - (let ((current-accounts (gnc:get-current-accounts)) - (num-accounts (gnc:group-get-num-accounts (gnc:get-current-group))) - (first-account (gnc:group-get-account (gnc:get-current-group) 0))) - (cond ((not (null? current-accounts)) (list (car current-accounts))) - ((> num-accounts 0) (list first-account)) - (else ())))) - #f #f)) - - ;; primary sorting criterion - (gnc:register-trep-option - (gnc:make-multichoice-option - "Sorting" "Primary Key" - "a" "Sort by this criterion first" - 'date - (list #(date - "Date" - "Sort by date") - #(time - "Time" - "Sort by EXACT entry time") - #(corresponding-acc - "Transfer from/to" - "Sort by account transferred from/to's name") - #(amount - "Amount" - "Sort by amount") - #(description - "Description" - "Sort by description") - #(number - "Number" - "Sort by check/transaction number") - #(memo - "Memo" - "Sort by memo")))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - "Sorting" "Primary Sort Order" - "b" "Order of primary sorting" - 'ascend - (list #(ascend "Ascending" "smallest to largest, earliest to latest") - #(descend "Descending" "largest to smallest, latest to earliest")))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - "Sorting" "Secondary Key" - "c" - "Sort by this criterion second" - 'corresponding-acc - (list #(date - "Date" - "Sort by date") - #(time - "Time" - "Sort by EXACT entry time") - #(corresponding-acc - "Transfer from/to" - "Sort by account transferred from/to's name") - #(amount - "Amount" - "Sort by amount") - #(description - "Description" - "Sort by description") - #(number - "Number" - "Sort by check/transaction number") - #(memo - "Memo" - "Sort by memo")))) - - (gnc:register-trep-option - (gnc:make-multichoice-option - "Sorting" "Secondary Sort Order" - "d" "Order of Secondary sorting" - 'ascend - (list #(ascend "Ascending" "smallest to largest, earliest to latest") - #(descend "Descending" "largest to smallest, latest to earliest")))) - - gnc:*transaction-report-options*) - - ;; extract fields out of the scheme split representation (define (gnc:tr-report-get-memo split-scm) @@ -210,26 +85,11 @@ (define (gnc:tr-report-get-other-splits split-scm) (vector-ref split-scm 10)) - - (define (gnc:tr-report-get-first-acc-name split-scm) (let ((other-splits (gnc:tr-report-get-other-splits split-scm))) (cond ((= (length other-splits) 0) "-") (else (caar other-splits))))) -;;; something like -;;; for(i = first; i < last; i+= step) { thunk(i);} - -(define (gnc:for-loop thunk first last step) - (cond ((< first last) (thunk first) - (gnc:for-loop thunk (+ first step) last step)) - (else #f))) - -;;; applies thunk to each split in account account -(define (gnc:for-each-split-in-account account thunk) - (gnc:for-loop (lambda (x) (thunk (gnc:account-get-split account x))) - 0 (gnc:account-get-split-count account) 1)) - ;; get transactions date from split - needs to be done indirectly ;; as it's stored in the parent transaction @@ -284,39 +144,8 @@ (gnc:split-get-corresponding-account-name-and-values split split-filter))) -;; timepair manipulation functions -;; hack alert - these should probably be put somewhere else -;; and be implemented PROPERLY rather than hackily - -(define (gnc:timepair-to-datestring tp) - (let ((bdtime (localtime (car tp)))) - (strftime "%x" bdtime))) - -;; given a timepair contains any time on a certain day (local time) -;; converts it to be midday that day. - -(define (gnc:timepair-canonical-day-time tp) - (let ((bdt (localtime (car tp)))) - (set-tm:sec bdt 0) - (set-tm:min bdt 0) - (set-tm:hour bdt 12) - (let ((newtime (car (mktime bdt)))) - ; alert - blarsen@ada-works.com fixed this. you may want to - ; revert if I'm wrong. - (cons newtime 0)))) - -(define (gnc:timepair-earlier-or-eq-date t1 t2) - (let ((time1 (car (gnc:timepair-canonical-day-time t1))) - (time2 (car (gnc:timepair-canonical-day-time t2)))) - (<= time1 time2))) - -(define (gnc:timepair-later-date t1 t2) - (let ((time1 (car (gnc:timepair-canonical-day-time t1))) - (time2 (car (gnc:timepair-canonical-day-time t2)))) - (< time1 time2))) - -(define (gnc:timepair-later-or-eq-date t1 t2) - (gnc:timepair-earlier-or-eq-date t2 t1)) +;;;; Note: This can be turned into a lookup table which will +;;;; *massively* simplify it... (define (gnc:sort-predicate-component component order) (let ((ascending-order-comparator @@ -439,7 +268,8 @@ (gnc:tr-report-get-value split-scm)))) (else (gnc:set-total-outflow! (+ gnc:total-outflow - (- (gnc:tr-report-get-value split-scm)))))) + (- (gnc:tr-report-get-value + split-scm)))))) (for-each (lambda (split-sub first last) (set! report-string diff --git a/src/scm/sstring-qif.scm b/src/scm/substring-search.scm similarity index 98% rename from src/scm/sstring-qif.scm rename to src/scm/substring-search.scm index 727f508987..d7a552bc66 100644 --- a/src/scm/sstring-qif.scm +++ b/src/scm/substring-search.scm @@ -1,4 +1,5 @@ ;;; $Id$ +(gnc:support "substring-search.scm") ; IMPLEMENTS Substring search ; AUTHOR Ken Dickey ; DATE 1991 August 6 diff --git a/src/scm/text-export.scm b/src/scm/text-export.scm index ce6235c52b..adf256e53a 100644 --- a/src/scm/text-export.scm +++ b/src/scm/text-export.scm @@ -27,16 +27,12 @@ ; (gnc:transaction-set-write-flag transaction 2))) ; (loop num-splits (+ i 1)))))) - - - (define (gnc:main-win-export-data-as-text win) (let ((account-group (gnc:get-current-group))) (if (not account-group) (gnc:error-dialog "No account group available for text export.") (gnc:account-group-export-as-text account-group)))) - (define (gnc:account->output-form a) (list 'account diff --git a/src/scm/utilities.scm b/src/scm/utilities.scm index 9e800ffcf8..e688b66f87 100644 --- a/src/scm/utilities.scm +++ b/src/scm/utilities.scm @@ -1,4 +1,5 @@ - +;;;; $Id$ +;;;; These utilities are loaded straight off (define (directory? path) ;; This follows symlinks normally. (let* ((status (false-if-exception (stat path))) @@ -7,8 +8,7 @@ (define (gnc:directory-subdirectories dir-name) ;; Return a recursive list of the subdirs of dir-name, including - ;; dir-name. Follow symlinks. - + ;; dir-name. Follow symlinks. (let ((dir-port (opendir dir-name))) (if (not dir-port) #f @@ -48,3 +48,56 @@ string and 'directories' must be a list of strings." (gnc:debug "found file " file-name) (set! finished? #t) (set! result file-name)))))) + +(define (filteroutnulls lst) + (cond + ((null? lst) '()) + ((eq? (car lst) #f) (filteroutnulls (cdr lst))) + (else + (cons (car lst) (filteroutnulls (cdr lst)))))) + +(define (atom? x) + (and + (not (pair? x)) + (not (null? x)))) + +(define (flatten lst) + (cond + ((null? lst) '()) + ((atom? lst) (list lst)) + ((list? lst) + (append (flatten (car lst)) + (flatten (cdr lst)))) + (else lst))) + +(define (striptrailingwhitespace line) + (let + ((stringsize (string-length line))) + (if + (< stringsize 1) + "" + (let* + ((lastchar (string-ref line (- stringsize 1)))) + (if + (char-whitespace? lastchar) + (striptrailingwhitespace (substring line 0 (- stringsize 1))) + line))))) + +(define (string-join lst joinstr) + (let ((len (length lst))) + (cond + ((< 1 len) + (string-append (car lst) joinstr (string-join (cdr lst) joinstr))) + ((= 1 len) + (car lst)) + (else + "")))) + +;;;; Simple lookup scheme; can be turned into a hash table If Need Be. +;;; Initialize lookup table +(define (initialize-hashtable . size) + (make-vector + (if (null? size) + 313 + (car size)) + '())) \ No newline at end of file