From 18ef8bb39d1ff45170b6cd8c6fbaf369fea5975f Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Wed, 29 Mar 2000 11:52:16 +0000 Subject: [PATCH] *** empty log message *** git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@2131 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/gnome/Makefile.in | 3 +- src/scm/printing/print-check.scm | 171 +++++++++++++++++++++++-------- src/scm/qif-import/qif-file.scm | 1 - 3 files changed, 129 insertions(+), 46 deletions(-) diff --git a/src/gnome/Makefile.in b/src/gnome/Makefile.in index 094e8f016c..cc6976bc53 100644 --- a/src/gnome/Makefile.in +++ b/src/gnome/Makefile.in @@ -71,7 +71,8 @@ GNOME_SRCS := top-level.c window-main.c window-register.c window-adjust.c \ extensions.c query-user.c reconcile-list.c \ window-report.c global-options.c \ dialog-qif-import.c glade-gnc-dialogs.c \ - dialog-account-picker.c print-session.c + dialog-account-picker.c print-session.c \ + dialog-print-check.c ###################################################################### all: gnome diff --git a/src/scm/printing/print-check.scm b/src/scm/printing/print-check.scm index d1d26e793d..c5d3d5f21e 100644 --- a/src/scm/printing/print-check.scm +++ b/src/scm/printing/print-check.scm @@ -8,52 +8,135 @@ (gnc:support "print-check.scm") (gnc:depend "number-to-words.scm") +(gnc:depend "simple-obj.scm") -;; format notes (I found a GIF of the check form and am measuring from -;; that, so this is definitely not perfect) positions are lower-left -;; text origin, (0,0) at lower left of page, in inches, for -;; US-Letter format paper. -(define quicken-check-3up-at-top-us-letter - '((payee . (1.25 9.5625)) - (amount-words . (1.25 9.1875)) - (amount-number . (7.0 9.625)) - (date . (7.0 10.0625)) - (memo . (0.75 8.0625)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; class +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define + (make-simple-class + 'print-check-format + '(format + position + date-format + custom-info))) + +(define (print-check-format? self) + (eq? (simple-obj-type self) 'print-check-format)) + +(define (print-check-format:format self) + (simple-obj-getter self 'format)) + +(define (print-check-format:set-format! self value) + (simple-obj-setter self 'format value)) + +(define (print-check-format:position self) + (simple-obj-getter self 'position)) + +(define (print-check-format:set-position! self value) + (simple-obj-setter self 'position value)) + +(define (print-check-format:date-format self) + (simple-obj-getter self 'date-format)) + +(define (print-check-format:set-date-format! self value) + (simple-obj-setter self 'date-format value)) + +(define (print-check-format:custom-info self) + (simple-obj-getter self 'custom-info)) + +(define (print-check-format:set-custom-info! self value) + (simple-obj-setter self 'custom-info value)) + +(define (make-print-check-format fmt pos dateformat cust) + (let ((retval (make-simple-obj ))) + (print-check-format:set-format! retval fmt) + (print-check-format:set-position! retval pos) + (print-check-format:set-date-format! retval dateformat) + (print-check-format:set-custom-info! retval cust) + retval)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; stock formats +;; units for stock formats and positions are points (72/inch) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define gnc:*stock-check-formats* + '((quicken . ((payee . (90.0 150.0)) + (amount-words . (90.0 120.0)) + (amount-number . (500.0 150.0)) + (date . (500.0 185.0)) + (memo . (50.0 40.0)))))) + +(define gnc:*stock-check-positions* + '((top . 540.0) + (middle . 288.0) + (bottom . 0.0))) (define (gnc:print-check payee amount date memo) - (let* ((int-part (inexact->exact (truncate amount))) - (frac-part (inexact->exact + (define (print-check-callback format-info) + (let* ((int-part (inexact->exact (truncate amount))) + (frac-part (inexact->exact (truncate (+ (/ .5 100) (* 100 (- amount int-part)))))) - (ps (gnc:print-session-create)) - (format quicken-check-3up-at-top-us-letter) - (inches-to-points - (lambda (inches) - (* inches 72)))) - - (let ((date-pos (assq 'date format))) - (gnc:print-session-moveto ps - (inches-to-points (cadr date-pos)) - (inches-to-points (caddr date-pos))) - (gnc:print-session-text ps date)) - - (let ((payee-pos (assq 'payee format))) - (gnc:print-session-moveto ps - (inches-to-points (cadr payee-pos)) - (inches-to-points (caddr payee-pos))) - (gnc:print-session-text ps payee)) - - (let ((number-pos (assq 'amount-number format))) - (gnc:print-session-moveto ps - (inches-to-points (cadr number-pos)) - (inches-to-points (caddr number-pos))) - (gnc:print-session-text ps (printable-value amount 100))) - - (let ((words-pos (assq 'amount-words format))) - (gnc:print-session-moveto ps - (inches-to-points (cadr words-pos)) - (inches-to-points (caddr words-pos))) - (gnc:print-session-text ps (number-to-words amount 100))) - - (gnc:print-session-done ps) - (gnc:print-dialog-create ps))) + (ps (gnc:print-session-create)) + (format #f) + (offset #f) + (date-string "")) + (if (not (eq? (print-check-format:format format-info) 'custom)) + (begin + (set! format (assq (print-check-format:format format-info) + gnc:*stock-check-formats*)) + (if (pair? format) + (set! format (cdr format)))) + (set! format (print-check-format:custom-info format-info))) + + (if (not (eq? (print-check-format:position format-info) 'custom)) + (begin + (set! offset + (cdr (assq (print-check-format:position format-info) + gnc:*stock-check-positions*))) + (if (pair? offset) + (set! offset (cdr offset)))) + (set! offset + (cdr (assq 'position + (print-check-format:custom-info format-info))))) + + (let ((fmt (print-check-format:date-format format-info))) + (if (string=? fmt "custom") + (let* ((custom-info (print-check-format:custom-info format-info)) + (date-fmt (assq 'date-format custom-info))) + (if date-fmt + (set! date-fmt (cdr date-fmt))) + (set! date-string + (strftime date-fmt (localtime date)))) + (begin + (set! date-string (strftime fmt (localtime date)))))) + + (let ((date-pos (assq 'date format))) + (gnc:print-session-moveto ps (cadr date-pos) + (+ offset (caddr date-pos))) + (gnc:print-session-text ps date-string)) + + (let ((payee-pos (assq 'payee format))) + (gnc:print-session-moveto ps (cadr payee-pos) + (+ offset (caddr payee-pos))) + (gnc:print-session-text ps payee)) + + (let ((number-pos (assq 'amount-number format))) + (gnc:print-session-moveto ps (cadr number-pos) + (+ offset (caddr number-pos))) + (gnc:print-session-text ps (printable-value amount 100))) + + (let ((words-pos (assq 'amount-words format))) + (gnc:print-session-moveto ps (cadr words-pos) + (+ offset (caddr words-pos))) + (gnc:print-session-text ps (number-to-words amount 100))) + + (gnc:print-session-done ps) + (gnc:print-dialog-create ps))) + + (gnc:print-check-dialog-create print-check-callback)) + diff --git a/src/scm/qif-import/qif-file.scm b/src/scm/qif-import/qif-file.scm index acb4db0aa6..f33443f95c 100644 --- a/src/scm/qif-import/qif-file.scm +++ b/src/scm/qif-import/qif-file.scm @@ -426,7 +426,6 @@ (set! reparse-ok (qif-acct:reparse acct self)))) (qif-file:accounts self)) - (display "reparse-ok == ") (write reparse-ok) (newline) reparse-ok)) (begin (display "There was a heinous error. Failed to read file.")