gnucash unstable: Replace sprintf with Guile's built-in format.
John Ralls
jralls at code.gnucash.org
Sat Feb 17 18:28:26 EST 2018
Updated via https://github.com/Gnucash/gnucash/commit/48bdab38 (commit)
from https://github.com/Gnucash/gnucash/commit/e3cd9f88 (commit)
commit 48bdab38d4fd66e2c2ea59d971c60d3e1ae235ab
Author: John Ralls <jralls at ceridwen.us>
Date: Sat Feb 17 14:58:18 2018 -0800
Replace sprintf with Guile's built-in format.
diff --git a/gnucash/import-export/qif-imp/qif-file.scm b/gnucash/import-export/qif-imp/qif-file.scm
index f224084..77ecfb6 100644
--- a/gnucash/import-export/qif-imp/qif-file.scm
+++ b/gnucash/import-export/qif-imp/qif-file.scm
@@ -26,7 +26,6 @@
(use-modules (gnucash core-utils))
-(use-modules (gnucash printf))
(use-modules (ice-9 regex))
(use-modules (srfi srfi-13))
(use-modules (ice-9 rdelim))
@@ -1028,7 +1027,7 @@
(gnc:list-display-to-string (list
(_ "Parse ambiguity between formats") " "
formats "\n"
- (sprintf #f (_ "Value '%s' could be %s or %s.")
+ (format #f (_ "Value '~a' could be ~a or ~a.")
parsed
(printer parsed)
(printer this-parsed))))))))))
diff --git a/gnucash/import-export/qif-imp/qif-parse.scm b/gnucash/import-export/qif-imp/qif-parse.scm
index dab31f6..733cae6 100644
--- a/gnucash/import-export/qif-imp/qif-parse.scm
+++ b/gnucash/import-export/qif-imp/qif-parse.scm
@@ -23,9 +23,6 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(use-modules (gnucash printf))
-
(define qif-category-compiled-rexp
(make-regexp "^ *(\\[)?([^]/|]*)(]?)(/?)([^|]*)(\\|(\\[)?([^]/]*)(]?)(/?)(.*))? *$"))
@@ -188,7 +185,7 @@
(list GNC-BANK-TYPE))
(#t
(errorproc errortype
- (sprintf #f (_ "Unrecognized account type '%s'. Defaulting to Bank.")
+ (format #f (_ "Unrecognized account type '~s'. Defaulting to Bank.")
read-value))
(list GNC-BANK-TYPE)))))
@@ -295,7 +292,7 @@
; 'vest)
(else
(errorproc errortype
- (sprintf #f (_ "Unrecognized action '%s'.") read-value))
+ (format #f (_ "Unrecognized action '~a'.") read-value))
#f)))
#f))
@@ -320,7 +317,7 @@
'budgeted)
(else
(errorproc errortype
- (sprintf #f (_ "Unrecognized status '%s'. Defaulting to uncleared.")
+ (format #f (_ "Unrecognized status '~a'. Defaulting to uncleared.")
read-value))
#f)))
#f))
diff --git a/gnucash/import-export/qif-imp/qif-to-gnc.scm b/gnucash/import-export/qif-imp/qif-to-gnc.scm
index 519d6e9..11ea351 100644
--- a/gnucash/import-export/qif-imp/qif-to-gnc.scm
+++ b/gnucash/import-export/qif-imp/qif-to-gnc.scm
@@ -26,8 +26,6 @@
(use-modules (srfi srfi-13))
-(use-modules (gnucash printf))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; qif-import:find-or-make-acct
@@ -65,12 +63,12 @@
(if (not (null? (gnc-account-lookup-by-full-name old-root long-name)))
(let loop ((count 2))
(let* ((test-name
- (string-append long-name (sprintf #f " %a" count)))
+ (string-append long-name (format #f " ~a" count)))
(test-acct
(gnc-account-lookup-by-full-name old-root test-name)))
(if (and (not (null? test-acct)) (not (compatible? test-acct)))
(loop (+ 1 count))
- (string-append short-name (sprintf #f " %a" count)))))
+ (string-append short-name (format #f " ~a" count)))))
short-name))
;; If a GnuCash account already exists in the old root with the same
diff --git a/gnucash/report/business-reports/aging.scm b/gnucash/report/business-reports/aging.scm
index 4e8ce1f..da2bd39 100644
--- a/gnucash/report/business-reports/aging.scm
+++ b/gnucash/report/business-reports/aging.scm
@@ -27,7 +27,6 @@
(define-module (gnucash report aging))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -222,8 +221,8 @@
"\nClient Currency" (gnc-ommodity-get-mnemonic(company-get-currency company-info)))))
(gnc-error-dialog '() error-str)
(gnc:error error-str)
- (cons #f (sprintf
- (_ "Transactions relating to '%s' contain \
+ (cons #f (format
+ (_ "Transactions relating to '~a' contain \
more than one currency. This report is not designed to cope with this possibility.") (gncOwnerGetName owner))))
(begin
(gnc:debug "it's an old company")
diff --git a/gnucash/report/business-reports/customer-summary.scm b/gnucash/report/business-reports/customer-summary.scm
index 192a299..34ca9d5 100644
--- a/gnucash/report/business-reports/customer-summary.scm
+++ b/gnucash/report/business-reports/customer-summary.scm
@@ -30,7 +30,6 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash gnc-module))
-(use-modules (gnucash printf))
(use-modules (gnucash utilities)) ; for gnc:debug
(use-modules (gnucash gettext))
@@ -904,8 +903,8 @@
(list
(gncOwnerGetName owner)
(gnc:make-gnc-monetary currency profit)
- ;;(sprintf #f (if (< (abs markupfloat) 10) "%2.1f%%" "%2.0f%%") markupfloat)
- (sprintf #f "%2.0f%%" markupfloat)
+ ;;(format #f (if (< (abs markupfloat) 10) "~2.1f%%" "%2.0f%%") markupfloat)
+ (format #f "~2,0f%" markupfloat)
(gnc:make-gnc-monetary currency sales))))
(if show-column-expense?
(set!
@@ -928,7 +927,7 @@
(list
(_ "No Customer")
(gnc:make-gnc-monetary currency other-profit)
- (sprintf #f "%2.0f%%" markupfloat)
+ (format #f "~2,0f%" markupfloat)
(gnc:make-gnc-monetary currency other-sales))))
(if show-column-expense?
(set!
@@ -959,8 +958,8 @@
(list
(_ "Total")
(gnc:make-gnc-monetary currency total-profit)
- ;;(sprintf #f (if (< (abs markupfloat) 10) "%2.1f%%" "%2.0f%%") markupfloat)
- (sprintf #f "%2.0f%%" markupfloat)
+ ;;(format #f (if (< (abs markupfloat) 10) "~2,1f%" "~2,0f%") markupfloat)
+ (format #f "~2,0f%" markupfloat)
(gnc:make-gnc-monetary currency toplevel-total-income))))
(if show-column-expense?
(set!
@@ -1000,8 +999,8 @@
(if any-valid-owner?
;; Report contains valid data
(let ((headline
- (sprintf
- #f (_ "%s %s - %s")
+ (format
+ #f (_ "~a ~a - ~a")
report-title
(qof-print-date start-date)
(qof-print-date end-date))))
@@ -1020,9 +1019,9 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (sprintf #f
- (_ "No valid %s selected. Click on the Options button to select a company.")
- (_ type-str))))) ;; FIXME because of translations: Please change this string into full sentences instead of sprintf, because in non-english languages the "no valid" has different forms depending on the grammatical gender of the "%s".
+ (format #f
+ (_ "No valid ~a selected. Click on the Options button to select a company.")
+ (_ type-str))))) ;; FIXME because of translations: Please change this string into full sentences instead of format, because in non-english languages the "no valid" has different forms depending on the grammatical gender of the "%s".
(qof-query-destroy owner-query)
(qof-query-destroy toplevel-income-query)
diff --git a/gnucash/report/business-reports/easy-invoice.scm b/gnucash/report/business-reports/easy-invoice.scm
index 4b89071..4e4a68c 100644
--- a/gnucash/report/business-reports/easy-invoice.scm
+++ b/gnucash/report/business-reports/easy-invoice.scm
@@ -31,7 +31,6 @@
(define-module (gnucash report easy-invoice))
(use-modules (srfi srfi-1))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -714,7 +713,7 @@
(begin
(set! credit-note? #t)
(set! default-title (_ "Credit Note"))))))
- (set! title (sprintf #f (_"%s #%d") (title-string default-title custom-title)
+ (set! title (format #f (_"~a #~d") (title-string default-title custom-title)
(gncInvoiceGetID invoice)))))
; (gnc:html-document-set-title! document title)
@@ -735,7 +734,7 @@
(add-html! document "<td align='left'>")
(add-html! document "<b><u>")
(add-html! document title)
-;; (add-html! document (sprintf #f (_ "Invoice #%d")
+;; (add-html! document (format #f (_ "Invoice #~d")
;; (gncInvoiceGetID invoice)))
(add-html! document "</u></b></td>")
(add-html! document "<td align='right'>")
diff --git a/gnucash/report/business-reports/fancy-invoice.scm b/gnucash/report/business-reports/fancy-invoice.scm
index 17a47a7..2cc8f20 100644
--- a/gnucash/report/business-reports/fancy-invoice.scm
+++ b/gnucash/report/business-reports/fancy-invoice.scm
@@ -49,7 +49,6 @@
(define-module (gnucash report fancy-invoice))
(use-modules (srfi srfi-1))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -867,13 +866,13 @@
;; Translators: %s below is "Invoice" or "Bill" or even the
;; custom title from the options. The next column contains
;; the number of the document.
- date-table (list (sprintf #f (_ "%s #") title) (gncInvoiceGetID invoice)))
+ date-table (list (format #f (_ "~s #") title) (gncInvoiceGetID invoice)))
;; Translators: The first %s below is "Invoice" or
;; "Bill" or even the custom title from the
;; options. This string sucks for i18n, but I don't
;; have a better solution right now without breaking
;; other people's invoices.
- (make-date-row! date-table (sprintf #f (_ "%s Date") title) post-date date-format)
+ (make-date-row! date-table (format #f (_ "~s Date") title) post-date date-format)
(make-date-row! date-table (_ "Due Date") due-date date-format)
date-table)
(gnc:make-html-text
diff --git a/gnucash/report/business-reports/invoice.scm b/gnucash/report/business-reports/invoice.scm
index a74e48f..96236ae 100644
--- a/gnucash/report/business-reports/invoice.scm
+++ b/gnucash/report/business-reports/invoice.scm
@@ -25,7 +25,6 @@
(define-module (gnucash report invoice))
(use-modules (srfi srfi-1))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -687,7 +686,7 @@
(set! title (title-string default-title custom-title))))
- (gnc:html-document-set-title! document (sprintf #f (_"%s #%d") title
+ (gnc:html-document-set-title! document (format #f (_"~a #~d") title
(gncInvoiceGetID invoice)))
(if (not (null? invoice))
diff --git a/gnucash/report/business-reports/job-report.scm b/gnucash/report/business-reports/job-report.scm
index 9cec45a..8ec2dad 100644
--- a/gnucash/report/business-reports/job-report.scm
+++ b/gnucash/report/business-reports/job-report.scm
@@ -27,7 +27,6 @@
(define-module (gnucash report job-report))
(use-modules (srfi srfi-1))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash utilities)) ; for gnc:debug
(use-modules (gnucash gettext))
@@ -632,9 +631,9 @@
(gnc:html-document-add-object!
document
(gnc:make-html-text
- (sprintf #f
- (_ "No valid %s selected. Click on the Options button to select a company.")
- (_ type-str))))) ;; FIXME because of translations: Please change this string into full sentences instead of sprintf, because in non-english languages the "no valid" has different forms depending on the grammatical gender of the "%s".
+ (format #f
+ (_ "No valid ~a selected. Click on the Options button to select a company.")
+ (_ type-str))))) ;; FIXME because of translations: Please change this string into full sentences instead of format, because in non-english languages the "no valid" has different forms depending on the grammatical gender of the "%s".
(qof-query-destroy query)
document))
diff --git a/gnucash/report/locale-specific/us/taxtxf-de_DE.scm b/gnucash/report/locale-specific/us/taxtxf-de_DE.scm
index 9d6cd90..ee5aa2d 100644
--- a/gnucash/report/locale-specific/us/taxtxf-de_DE.scm
+++ b/gnucash/report/locale-specific/us/taxtxf-de_DE.scm
@@ -69,7 +69,6 @@
(define-module (gnucash report taxtxf-de_DE))
(use-modules (gnucash utilities))
(use-modules (srfi srfi-1))
-(use-modules (gnucash printf))
(use-modules (gnucash core-utils)) ; for gnc:version
(use-modules (gnucash gettext))
@@ -845,7 +844,7 @@
"center"
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "Period from %s to %s") from-date to-date)))))
+ (_ "Period from ~a to ~a") from-date to-date)))))
(gnc:html-document-add-object!
doc (gnc:make-html-text
diff --git a/gnucash/report/locale-specific/us/taxtxf.scm b/gnucash/report/locale-specific/us/taxtxf.scm
index 8bd1f51..bb0d067 100644
--- a/gnucash/report/locale-specific/us/taxtxf.scm
+++ b/gnucash/report/locale-specific/us/taxtxf.scm
@@ -102,7 +102,6 @@
(load-extension "libgncmod-gnome-utils" "scm_init_sw_gnome_utils_module"))
(use-modules (sw_gnome_utils)) ;; to get to gnc-error-dialog
-(use-modules (gnucash printf))
(use-modules (gnucash core-utils)) ; for gnc:version
(gnc:module-load "gnucash/html" 0) ; added for 'gnc-html-engine-supports-css'
@@ -594,7 +593,7 @@
(value (string-append "$" ; in txf output, income is positive; expense negative
; liabilities are positive, assets are negative;
; essentially, just reverse signs on dr's & cr's
- (sprintf #f "%.2f" (gnc-numeric-to-double
+ (format #f "!0,2f" (gnc-numeric-to-double
(gnc-numeric-neg
account-value)))))
)
@@ -3180,8 +3179,8 @@
(not (string=? ""
(gnc-get-current-book-tax-name))))
"Tax Name: %s<BR>"
- "%s")
- "Period from %s to %s<BR>Tax Year %s<BR>Tax Entity Type: %s<BR>All amounts in USD unless otherwise noted")
+ "~a")
+ "Period from ~a to ~s<BR>Tax Year ~a<BR>Tax Entity Type: %s<BR>All amounts in USD unless otherwise noted")
(gnc-get-current-book-tax-name)
from-date
to-date
@@ -3456,27 +3455,27 @@
(string-append
"Selected Report Options:<BR>"
;; selected accounts
- " %s <BR>"
+ " ~a <BR>"
;; suppress 0.00 values
- " %s <BR>"
+ " ~a <BR>"
;; full acct names
- " %s <BR>"
+ " ~a <BR>"
;; transfer detail
- " %s <BR>"
+ " ~a <BR>"
;; TXF detail
- " %s <BR>"
+ " ~a <BR>"
;; action:memo detail
- " %s <BR>"
+ " ~a <BR>"
;; transaction detail
- " %s <BR>"
+ " ~a <BR>"
;; special dates
- " %s <BR>"
+ " ~a <BR>"
;; currency conversion date
- " %s <BR>"
+ " ~a <BR>"
;; alternate transaction shading
(if (gnc-html-engine-supports-css)
""
- " %s <BR>"
+ " ~a <BR>"
))
(if (not (null? user-sel-accnts))
"Subset of accounts"
diff --git a/gnucash/report/report-gnome/report-gnome.scm b/gnucash/report/report-gnome/report-gnome.scm
index 61f83ca..ade1d0f 100644
--- a/gnucash/report/report-gnome/report-gnome.scm
+++ b/gnucash/report/report-gnome/report-gnome.scm
@@ -31,8 +31,6 @@
(use-modules (gnucash gettext))
(use-modules (gnucash report utility-reports))
-(use-modules (gnucash printf))
-
(eval-when
(compile load eval expand)
(load-extension "libgncmod-gnome-utils" "scm_init_sw_gnome_utils_module")
@@ -67,7 +65,7 @@
(if (not menu-tip)
(set! menu-tip
- (sprintf #f (_ "Display the %s report") (_ name))))
+ (format #f (_ "Display the ~a report") (_ name))))
(set! item
(gnc:make-menu-item
diff --git a/gnucash/report/report-system/eguile-gnc.scm b/gnucash/report/report-system/eguile-gnc.scm
index 1f8a614..012b427 100644
--- a/gnucash/report/report-system/eguile-gnc.scm
+++ b/gnucash/report/report-system/eguile-gnc.scm
@@ -86,7 +86,6 @@
(use-modules (ice-9 regex)) ; for regular expressions
(use-modules (ice-9 rdelim)) ; for read-line
(use-modules (ice-9 local-eval)) ; for the-environment
-(use-modules (gnucash printf))
(use-modules (gnucash app-utils)) ; for _
;; This is needed for displaying error messages -- note that it assumes that
@@ -244,7 +243,7 @@
;; Process a template file and return the result as a string
(define (eguile-file-to-string infile environment)
(if (not (access? infile R_OK))
- (sprintf #f (_ "Template file \"%s\" can not be read") infile)
+ (format #f (_ "Template file \"~a\" can not be read") infile)
(let ((script (with-input-from-file
infile
(lambda () (with-output-to-string template->script)))))
diff --git a/gnucash/report/report-system/html-document.scm b/gnucash/report/report-system/html-document.scm
index c8edb98..b95ddb1 100644
--- a/gnucash/report/report-system/html-document.scm
+++ b/gnucash/report/report-system/html-document.scm
@@ -22,7 +22,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(gnc:module-load "gnucash/html" 0)
-(use-modules (gnucash printf))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-document> class
@@ -238,7 +237,7 @@
(if (not style-info)
(gnc:make-html-data-style-info
(lambda (datum parms)
- (sprintf #f "%a %a" markup datum))
+ (format #f "~a ~a" markup datum))
#f)
style-info)))
diff --git a/gnucash/report/report-system/html-table.scm b/gnucash/report/report-system/html-table.scm
index ae21218..e33e6d6 100644
--- a/gnucash/report/report-system/html-table.scm
+++ b/gnucash/report/report-system/html-table.scm
@@ -33,8 +33,6 @@
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(use-modules (gnucash printf))
-
(define <html-table>
(make-record-type "<html-table>"
'(col-headers
@@ -147,8 +145,8 @@
(gnc:html-document-push-style doc style)
(push (gnc:html-document-markup-start
doc (gnc:html-table-cell-tag cell) #t
- (sprintf #f "rowspan=\"%a\"" (gnc:html-table-cell-rowspan cell))
- (sprintf #f "colspan=\"%a\"" (gnc:html-table-cell-colspan cell))))
+ (format #f "rowspan=\"~a\"" (gnc:html-table-cell-rowspan cell))
+ (format #f "colspan=\"~a\"" (gnc:html-table-cell-colspan cell))))
(for-each
(lambda (child)
(push (gnc:html-object-render child doc)))
diff --git a/gnucash/report/report-system/html-text.scm b/gnucash/report/report-system/html-text.scm
index 76b0d79..b9e61d5 100644
--- a/gnucash/report/report-system/html-text.scm
+++ b/gnucash/report/report-system/html-text.scm
@@ -30,8 +30,6 @@
;; doc as arg to get the string out.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(use-modules (gnucash printf))
-
(define <html-text>
(make-record-type "<html-text>"
'(body style)))
@@ -125,12 +123,12 @@
;; I'm not entirely pleased about the way this works, but I can't
;; really see a way around it. It still works within the style
;; system, but it flattens out its children's lists prematurely. Has
-;; to, to pass them as args to sprintf.
+;; to, to pass them as args to format.
(define (gnc:html-markup/format format . entities)
(lambda (doc)
(apply
- sprintf #f format
+ format #f format
(map
(lambda (elt)
(let ((rendered-elt
diff --git a/gnucash/report/report-system/html-utilities.scm b/gnucash/report/report-system/html-utilities.scm
index 5fe50f0..2357036 100644
--- a/gnucash/report/report-system/html-utilities.scm
+++ b/gnucash/report/report-system/html-utilities.scm
@@ -22,8 +22,6 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(use-modules (gnucash printf))
-
;; returns a list with n #f (empty cell) values
(define (gnc:html-make-empty-cell) #f)
(define (gnc:html-make-empty-cells n)
@@ -808,7 +806,7 @@
(gnc:html-markup-p
(gnc:html-markup-anchor
(gnc-build-url URL-TYPE-OPTIONS
- (string-append "report-id=" (sprintf #f "%a" report-id))
+ (string-append "report-id=" (format #f "~a" report-id))
"")
(_ "Edit report options")))))
diff --git a/gnucash/report/report-system/report-collectors.scm b/gnucash/report/report-system/report-collectors.scm
index c1bc225..523c8a7 100644
--- a/gnucash/report/report-system/report-collectors.scm
+++ b/gnucash/report/report-system/report-collectors.scm
@@ -26,7 +26,6 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash report report-system))
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
diff --git a/gnucash/report/report-system/report-utilities.scm b/gnucash/report/report-system/report-utilities.scm
index a2ba5eb..dbe56c6 100644
--- a/gnucash/report/report-system/report-utilities.scm
+++ b/gnucash/report/report-system/report-utilities.scm
@@ -18,7 +18,6 @@
;; Boston, MA 02110-1301, USA gnu at gnu.org
(use-modules (srfi srfi-13))
-(use-modules (gnucash printf))
(define (list-ref-safe list elt)
(if (> (length list) elt)
@@ -686,14 +685,14 @@
(xaccTransGetVoidStatus trans)))
(define (gnc:report-starting report-name)
- (gnc-window-show-progress (sprintf #f
- (_ "Building '%s' report ...")
+ (gnc-window-show-progress (format #f
+ (_ "Building '~a' report ...")
(gnc:gettext report-name))
0))
(define (gnc:report-render-starting report-name)
- (gnc-window-show-progress (sprintf #f
- (_ "Rendering '%s' report ...")
+ (gnc-window-show-progress (format #f
+ (_ "Rendering '~a' report ...")
(if (string-null? report-name)
(gnc:gettext "Untitled")
(gnc:gettext report-name)))
diff --git a/gnucash/report/report-system/report.scm b/gnucash/report/report-system/report.scm
index 13dff54..2e7712a 100644
--- a/gnucash/report/report-system/report.scm
+++ b/gnucash/report/report-system/report.scm
@@ -22,7 +22,6 @@
(use-modules (gnucash utilities))
(use-modules (gnucash app-utils))
-(use-modules (gnucash printf))
(use-modules (gnucash gettext))
(eval-when
(compile load eval expand)
diff --git a/gnucash/report/report-system/test/test-test-extras.scm b/gnucash/report/report-system/test/test-test-extras.scm
index 64c8dab..f551748 100644
--- a/gnucash/report/report-system/test/test-test-extras.scm
+++ b/gnucash/report/report-system/test/test-test-extras.scm
@@ -96,7 +96,6 @@
;(use-modules (gnucash engine))
;(use-modules (gnucash utilities))
-;(use-modules (gnucash printf))
;(use-modules (gnucash report report-system))
;(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
diff --git a/gnucash/report/standard-reports/account-piecharts.scm b/gnucash/report/standard-reports/account-piecharts.scm
index a5845fc..0277dc9 100644
--- a/gnucash/report/standard-reports/account-piecharts.scm
+++ b/gnucash/report/standard-reports/account-piecharts.scm
@@ -31,8 +31,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define menuname-income (N_ "Income Piechart"))
@@ -564,17 +562,17 @@ balance at a given time"))
(gnc:html-piechart-set-subtitle!
chart (string-append
(if do-intervals?
- (sprintf #f
- (_ "%s to %s")
+ (format #f
+ (_ "~a to ~a")
(qof-print-date from-date)
(qof-print-date to-date))
- (sprintf #f
- (_ "Balance at %s")
+ (format #f
+ (_ "Balance at ~a")
(qof-print-date to-date)))
(if show-total?
(let ((total (apply + (unzip1 combined))))
- (sprintf
- #f ": %s"
+ (format
+ #f ": ~a"
(xaccPrintAmount
(double-to-gnc-numeric
total
@@ -602,8 +600,8 @@ balance at a given time"))
)
"")
(if show-percent?
- (sprintf
- #f " (%2.2f %%)"
+ (format
+ #f " (~2,2f %)"
(* 100.0 (/ (car pair) (apply + (unzip1 combined)))))
"")
))
diff --git a/gnucash/report/standard-reports/advanced-portfolio.scm b/gnucash/report/standard-reports/advanced-portfolio.scm
index 2586156..b696674 100644
--- a/gnucash/report/standard-reports/advanced-portfolio.scm
+++ b/gnucash/report/standard-reports/advanced-portfolio.scm
@@ -32,8 +32,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define reportname (N_ "Advanced Portfolio"))
@@ -945,7 +943,7 @@
)
(if (= 0.0 moneyinvalue)
""
- (sprintf #f "%.2f%%" (* 100 (/ bothgainvalue moneyinvalue)))))
+ (format #f "~0,2f%" (* 100 (/ bothgainvalue moneyinvalue)))))
)
(gnc:make-html-table-header-cell/markup "number-cell" income)))
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
@@ -959,7 +957,7 @@
)
(if (= 0.0 moneyinvalue)
""
- (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue moneyinvalue))))))
+ (format #f "~0,2f%" (* 100 (/ totalreturnvalue moneyinvalue))))))
)
)
@@ -1027,7 +1025,7 @@
(gnc:html-document-set-title!
document (string-append
report-title
- (sprintf #f " %s" (qof-print-date to-date))))
+ (format #f " ~a" (qof-print-date to-date))))
(if (not (null? accounts))
; at least 1 account selected
@@ -1145,7 +1143,7 @@
)
(if (= 0.0 totalinvalue)
""
- (sprintf #f "%.2f%%" (* 100 (/ totalgainvalue totalinvalue))))))
+ (format #f "~0,2f%" (* 100 (/ totalgainvalue totalinvalue))))))
(gnc:make-html-table-cell/markup
"total-number-cell" sum-total-income)))
(if (not (eq? handle-brokerage-fees 'ignore-brokerage))
@@ -1164,7 +1162,7 @@
)
(if (= 0.0 totalinvalue)
""
- (sprintf #f "%.2f%%" (* 100 (/ totalreturnvalue totalinvalue))))))
+ (format #f "~0,2f%" (* 100 (/ totalreturnvalue totalinvalue))))))
))
diff --git a/gnucash/report/standard-reports/budget-barchart.scm b/gnucash/report/standard-reports/budget-barchart.scm
index fcec355..05b721c 100644
--- a/gnucash/report/standard-reports/budget-barchart.scm
+++ b/gnucash/report/standard-reports/budget-barchart.scm
@@ -31,8 +31,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
;; included since Bug726449
diff --git a/gnucash/report/standard-reports/budget-flow.scm b/gnucash/report/standard-reports/budget-flow.scm
index 457db2b..f718968 100644
--- a/gnucash/report/standard-reports/budget-flow.scm
+++ b/gnucash/report/standard-reports/budget-flow.scm
@@ -30,8 +30,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc-build-url
@@ -318,7 +316,7 @@
;; Display Title Name - Budget - Period
(gnc:html-document-set-title!
- doc (sprintf #f (_ "%s: %s - %s")
+ doc (format #f (_ "~a: ~a - ~a")
report-name (gnc-budget-get-name budget)
(qof-print-date (gnc-budget-get-period-start-date budget (- period 1)))))
diff --git a/gnucash/report/standard-reports/budget-income-statement.scm b/gnucash/report/standard-reports/budget-income-statement.scm
index 58f2fad..c220781 100644
--- a/gnucash/report/standard-reports/budget-income-statement.scm
+++ b/gnucash/report/standard-reports/budget-income-statement.scm
@@ -42,7 +42,6 @@
(define-module (gnucash report standard-reports budget-income-statement))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -503,20 +502,20 @@
(period-for
(if use-budget-period-range?
(if (equal? user-budget-period-start user-budget-period-end)
- (sprintf
+ (format
#f
- (_ "for Budget %s Period %u")
+ (_ "for Budget ~a Period ~d")
budget-name
user-budget-period-start)
- (sprintf
+ (format
#f
- (_ "for Budget %s Periods %u - %u")
+ (_ "for Budget ~a Periods ~d - ~d")
budget-name
user-budget-period-start
user-budget-period-end))
- (sprintf
+ (format
#f
- (_ "for Budget %s")
+ (_ "for Budget ~a")
budget-name)))
)
@@ -615,7 +614,7 @@
(gnc:html-document-set-title!
doc
- (sprintf #f "%s %s %s" company-name report-title period-for))
+ (format #f "~a ~a ~a" company-name report-title period-for))
(set! table-env
(list
diff --git a/gnucash/report/standard-reports/budget.scm b/gnucash/report/standard-reports/budget.scm
index 12ab6f5..fb1d969 100644
--- a/gnucash/report/standard-reports/budget.scm
+++ b/gnucash/report/standard-reports/budget.scm
@@ -31,7 +31,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
(use-modules (gnucash engine))
(use-modules (srfi srfi-1))
@@ -876,7 +875,7 @@
)
(gnc:html-document-set-title!
- doc (sprintf #f (_ "%s: %s")
+ doc (format #f (_ "~a: ~a")
report-name (gnc-budget-get-name budget)))
(set! accounts (sort accounts account-full-name<?))
diff --git a/gnucash/report/standard-reports/cash-flow.scm b/gnucash/report/standard-reports/cash-flow.scm
index 56da0dd..eb22721 100644
--- a/gnucash/report/standard-reports/cash-flow.scm
+++ b/gnucash/report/standard-reports/cash-flow.scm
@@ -32,7 +32,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(use-modules (gnucash engine))
-(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/gnome-utils" 0) ;for gnc-build-url
@@ -164,7 +163,7 @@
doc (string-append
(get-option gnc:pagename-general gnc:optname-reportname)
" - "
- (sprintf #f (_ "%s to %s")
+ (format #f (_ "~a to ~a")
(qof-print-date from-date-t64) (qof-print-date to-date-t64))))
@@ -238,9 +237,9 @@
(if (and (= (gnc-account-get-current-depth account) tree-depth)
(not (eq? (gnc-account-get-children account) '())))
(if show-subaccts?
- (_ "%s and subaccounts")
- (_ "%s and selected subaccounts"))
- "%s")
+ (_ "~a and subaccounts")
+ (_ "~a and selected subaccounts"))
+ "~a")
(gnc:html-markup-anchor
(gnc:account-anchor-text account)
(if show-full-names?
diff --git a/gnucash/report/standard-reports/cashflow-barchart.scm b/gnucash/report/standard-reports/cashflow-barchart.scm
index a848f54..28738d9 100644
--- a/gnucash/report/standard-reports/cashflow-barchart.scm
+++ b/gnucash/report/standard-reports/cashflow-barchart.scm
@@ -33,7 +33,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(use-modules (gnucash engine))
-(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
@@ -309,8 +308,8 @@
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
- chart (sprintf #f
- (_ "%s to %s")
+ chart (format #f
+ (_ "~a to ~a")
(qof-print-date from-date-t64)
(qof-print-date to-date-t64)))
(gnc:html-barchart-set-width! chart width)
diff --git a/gnucash/report/standard-reports/category-barchart.scm b/gnucash/report/standard-reports/category-barchart.scm
index ddbca53..342607c 100644
--- a/gnucash/report/standard-reports/category-barchart.scm
+++ b/gnucash/report/standard-reports/category-barchart.scm
@@ -32,8 +32,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
;; included since Bug726449
@@ -532,10 +530,10 @@ developing over time"))
(begin
(gnc:html-barchart-set-title! chart report-title)
(gnc:html-barchart-set-subtitle!
- chart (sprintf #f
+ chart (format #f
(if do-intervals?
- (_ "%s to %s")
- (_ "Balances %s to %s"))
+ (_ "~a to ~a")
+ (_ "Balances ~a to ~a"))
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
@@ -558,10 +556,10 @@ developing over time"))
(begin
(gnc:html-linechart-set-title! chart report-title)
(gnc:html-linechart-set-subtitle!
- chart (sprintf #f
+ chart (format #f
(if do-intervals?
- (_ "%s to %s")
- (_ "Balances %s to %s"))
+ (_ "~a to ~a")
+ (_ "Balances ~a to ~a"))
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
diff --git a/gnucash/report/standard-reports/daily-reports.scm b/gnucash/report/standard-reports/daily-reports.scm
index 1e23ccd..c87eccf 100644
--- a/gnucash/report/standard-reports/daily-reports.scm
+++ b/gnucash/report/standard-reports/daily-reports.scm
@@ -35,8 +35,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define menuname-income (N_ "Income vs. Day of Week"))
@@ -475,14 +473,14 @@
(gnc:html-piechart-set-subtitle!
chart (string-append
- (sprintf #f
- (_ "%s to %s")
+ (format #f
+ (_ "~a to ~a")
(qof-print-date from-date)
(qof-print-date to-date))
(if show-total?
(let ((total (apply + daily-totals)))
- (sprintf
- #f ": %s"
+ (format
+ #f ": ~a"
(xaccPrintAmount
(double-to-gnc-numeric
total
diff --git a/gnucash/report/standard-reports/equity-statement.scm b/gnucash/report/standard-reports/equity-statement.scm
index 3222518..9d1e617 100644
--- a/gnucash/report/standard-reports/equity-statement.scm
+++ b/gnucash/report/standard-reports/equity-statement.scm
@@ -50,8 +50,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define reportname (N_ "Equity Statement"))
@@ -277,9 +275,9 @@
)
(gnc:html-document-set-title!
- doc (sprintf #f
- (string-append "%s %s "
- (_ "For Period Covering %s to %s"))
+ doc (format #f
+ (string-append "~a ~a "
+ (_ "For Period Covering ~a to ~a"))
company-name report-title
(qof-print-date start-date-printable)
(qof-print-date end-date)))
@@ -344,7 +342,7 @@
(terse-period? #t)
(period-for (if terse-period?
(string-append " " (_ "for Period"))
- (sprintf #f (string-append ", " (_ "%s to %s"))
+ (format #f (string-append ", " (_ "~a to ~a"))
(qof-print-date start-date-printable)
(qof-print-date end-date))
))
diff --git a/gnucash/report/standard-reports/income-statement.scm b/gnucash/report/standard-reports/income-statement.scm
index c9c701c..c57e2a2 100644
--- a/gnucash/report/standard-reports/income-statement.scm
+++ b/gnucash/report/standard-reports/income-statement.scm
@@ -43,7 +43,6 @@
(define-module (gnucash report standard-reports income-statement))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -430,8 +429,8 @@
(if (equal? tabbing 'canonically-tabbed) 1 0))))
(gnc:html-document-set-title!
- doc (sprintf #f
- (string-append "%s %s "
+ doc (format #f
+ (string-append "~a ~a "
(_ "For Period Covering %s to %s"))
company-name report-title
(qof-print-date start-date-printable)
@@ -472,7 +471,7 @@
(terse-period? #t)
(period-for (if terse-period?
(string-append " " (_ "for Period"))
- (sprintf #f (string-append ", " (_ "%s to %s"))
+ (format #f (string-append ", " (_ "~a to ~a"))
(qof-print-date start-date-printable)
(qof-print-date end-date))
)
diff --git a/gnucash/report/standard-reports/net-barchart.scm b/gnucash/report/standard-reports/net-barchart.scm
index 7d17afe..d424263 100644
--- a/gnucash/report/standard-reports/net-barchart.scm
+++ b/gnucash/report/standard-reports/net-barchart.scm
@@ -31,7 +31,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
(use-modules (gnucash report report-system report-collectors))
(use-modules (gnucash report report-system collectors))
(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
@@ -333,8 +332,8 @@
(gnc:html-barchart-set-title!
chart report-title)
(gnc:html-barchart-set-subtitle!
- chart (sprintf #f
- (_ "%s to %s")
+ chart (format #f
+ (_ "~a to ~a")
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
(gnc:html-barchart-set-width! chart width)
diff --git a/gnucash/report/standard-reports/net-linechart.scm b/gnucash/report/standard-reports/net-linechart.scm
index 2a54a6b..7d2d554 100644
--- a/gnucash/report/standard-reports/net-linechart.scm
+++ b/gnucash/report/standard-reports/net-linechart.scm
@@ -32,7 +32,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
(use-modules (gnucash report report-system report-collectors))
(use-modules (gnucash report report-system collectors))
(use-modules (gnucash report standard-reports category-barchart)) ; for guids of called reports
@@ -376,8 +375,8 @@
(gnc:html-linechart-set-title!
chart report-title)
(gnc:html-linechart-set-subtitle!
- chart (sprintf #f
- (_ "%s to %s")
+ chart (format #f
+ (_ "~a to ~a")
(qof-print-date from-date-t64)
(qof-print-date to-date-t64)))
(gnc:html-linechart-set-width! chart width)
diff --git a/gnucash/report/standard-reports/portfolio.scm b/gnucash/report/standard-reports/portfolio.scm
index 3c5f8ed..38f113a 100644
--- a/gnucash/report/standard-reports/portfolio.scm
+++ b/gnucash/report/standard-reports/portfolio.scm
@@ -28,8 +28,6 @@
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define reportname (N_ "Investment Portfolio"))
@@ -156,7 +154,7 @@
(gnc:html-price-anchor price price-monetary))
(gnc:make-html-table-header-cell/markup
"number-cell" value)))
- ;;(display (sprintf #f "Shares: %6.6d " (gnc-numeric-to-double units)))
+ ;;(display (format #f "Shares: ~6d " (gnc-numeric-to-double units)))
;;(display units) (newline)
(if price (gnc-price-unref price))
(table-add-stock-rows-internal rest (not odd-row?)))
@@ -191,7 +189,7 @@
(gnc:html-document-set-title!
document (string-append
report-title
- (sprintf #f " %s" (qof-print-date to-date))))
+ (format #f " ~a" (qof-print-date to-date))))
;(gnc:debug "accounts" accounts)
(if (not (null? accounts))
diff --git a/gnucash/report/standard-reports/price-scatter.scm b/gnucash/report/standard-reports/price-scatter.scm
index a1c0470..a926138 100644
--- a/gnucash/report/standard-reports/price-scatter.scm
+++ b/gnucash/report/standard-reports/price-scatter.scm
@@ -30,8 +30,6 @@
(use-modules (gnucash core-utils))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(define optname-from-date (N_ "Start Date"))
@@ -200,8 +198,8 @@
(gnc-commodity-get-mnemonic report-currency)
(gnc-commodity-get-mnemonic price-commodity))
" - "
- (sprintf #f
- (_ "%s to %s")
+ (format #f
+ (_ "~a to ~a")
(qof-print-date from-date)
(qof-print-date to-date))))
(gnc:html-scatter-set-width! chart width)
diff --git a/gnucash/report/standard-reports/sx-summary.scm b/gnucash/report/standard-reports/sx-summary.scm
index 09977bb..550ae99 100644
--- a/gnucash/report/standard-reports/sx-summary.scm
+++ b/gnucash/report/standard-reports/sx-summary.scm
@@ -36,7 +36,6 @@
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -310,9 +309,9 @@
)
(gnc:html-document-set-title!
- doc (sprintf #f
- (string-append "%s %s "
- (_ "For Period Covering %s to %s"))
+ doc (format #f
+ (string-append "~a ~a "
+ (_ "For Period Covering ~a to ~a"))
company-name report-title
(qof-print-date from-date)
(qof-print-date to-date))
diff --git a/gnucash/report/standard-reports/test/test-generic-category-report.scm b/gnucash/report/standard-reports/test/test-generic-category-report.scm
index adf21a8..4848b26 100644
--- a/gnucash/report/standard-reports/test/test-generic-category-report.scm
+++ b/gnucash/report/standard-reports/test/test-generic-category-report.scm
@@ -27,7 +27,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash report report-system))
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
diff --git a/gnucash/report/standard-reports/test/test-standard-category-report.scm b/gnucash/report/standard-reports/test/test-standard-category-report.scm
index f720a84..32c9fda 100644
--- a/gnucash/report/standard-reports/test/test-standard-category-report.scm
+++ b/gnucash/report/standard-reports/test/test-standard-category-report.scm
@@ -31,7 +31,6 @@
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash report report-system))
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
diff --git a/gnucash/report/standard-reports/transaction.scm b/gnucash/report/standard-reports/transaction.scm
index 1e4e523..45836de 100644
--- a/gnucash/report/standard-reports/transaction.scm
+++ b/gnucash/report/standard-reports/transaction.scm
@@ -44,7 +44,6 @@
(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
-(use-modules (gnucash printf))
(gnc:module-load "gnucash/report/report-system" 0)
@@ -1845,8 +1844,8 @@ tags within description, notes or memo. ")
document
(gnc:make-html-text
(gnc:html-markup-h3
- (sprintf #f
- (_ "From %s to %s")
+ (format #f
+ (_ "From ~a to ~a")
(qof-print-date begindate)
(qof-print-date enddate)))))
diff --git a/gnucash/report/standard-reports/trial-balance.scm b/gnucash/report/standard-reports/trial-balance.scm
index 38a8098..b0042cf 100644
--- a/gnucash/report/standard-reports/trial-balance.scm
+++ b/gnucash/report/standard-reports/trial-balance.scm
@@ -52,7 +52,6 @@
(define-module (gnucash report standard-reports trial-balance))
(use-modules (gnucash utilities))
-(use-modules (gnucash printf))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
@@ -388,7 +387,7 @@
(terse-period? #t)
(period-for (if terse-period?
(string-append " " (_ "for Period"))
- (sprintf #f (string-append ", " (_ "%s to %s"))
+ (format #f (string-append ", " (_ "~a to ~a"))
(qof-print-date start-date-printable)
(qof-print-date end-date))
))
@@ -396,11 +395,11 @@
(gnc:html-document-set-title!
doc (if (equal? report-variant 'current)
- (sprintf #f (string-append "%s %s %s")
+ (format #f (string-append "~a ~a ~a")
company-name report-title
(qof-print-date end-date))
- (sprintf #f (string-append "%s %s "
- (_ "For Period Covering %s to %s"))
+ (format #f (string-append "~a ~a "
+ (_ "For Period Covering ~a to ~a"))
company-name report-title
(qof-print-date start-date-printable)
(qof-print-date end-date))
diff --git a/gnucash/report/utility-reports/hello-world.scm b/gnucash/report/utility-reports/hello-world.scm
index 57bbe18..8cc6b1d 100644
--- a/gnucash/report/utility-reports/hello-world.scm
+++ b/gnucash/report/utility-reports/hello-world.scm
@@ -346,7 +346,7 @@ or extending existing reports.")))
(gnc:html-markup-p
(gnc:html-markup/format
(_ "For help on writing reports, or to contribute your brand \
-new, totally cool report, consult the mailing list %s.")
+new, totally cool report, consult the mailing list ~a.")
(gnc:html-markup-anchor
"mailto:gnucash-devel at gnucash.org"
(gnc:html-markup-tt "gnucash-devel at gnucash.org")))
@@ -355,47 +355,47 @@ new, totally cool report, consult the mailing list %s.")
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The current time is %s.")
+ (_ "The current time is ~a.")
(gnc:html-markup-b time-string)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The boolean option is %s.")
+ (_ "The boolean option is ~a.")
(gnc:html-markup-b (if bool-val (_ "true") (_ "false")))))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The multi-choice option is %s.")
+ (_ "The multi-choice option is ~a.")
(gnc:html-markup-b (symbol->string mult-val))))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The string option is %s.")
+ (_ "The string option is ~a.")
(gnc:html-markup-b string-val)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The date option is %s.")
+ (_ "The date option is ~a.")
(gnc:html-markup-b date-string)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The date and time option is %s.")
+ (_ "The date and time option is ~a.")
(gnc:html-markup-b date-string2)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The relative date option is %s.")
+ (_ "The relative date option is ~a.")
(gnc:html-markup-b rel-date-string)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The combination date option is %s.")
+ (_ "The combination date option is ~a.")
(gnc:html-markup-b combo-date-string)))
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The number option is %s.")
+ (_ "The number option is ~a.")
(gnc:html-markup-b (number->string num-val))))
;; Here we print the value of the number option formatted as
@@ -406,7 +406,7 @@ new, totally cool report, consult the mailing list %s.")
;; it yourself -- it will be wrong in other locales.
(gnc:html-markup-p
(gnc:html-markup/format
- (_ "The number option formatted as currency is %s.")
+ (_ "The number option formatted as currency is ~a.")
(gnc:html-markup-b
(xaccPrintAmount
(inexact->exact num-val)
diff --git a/gnucash/report/utility-reports/view-column.scm b/gnucash/report/utility-reports/view-column.scm
index 6e9a918..49a300d 100644
--- a/gnucash/report/utility-reports/view-column.scm
+++ b/gnucash/report/utility-reports/view-column.scm
@@ -36,8 +36,6 @@
(load-extension "libgncmod-report-system" "scm_init_sw_report_system_module"))
(use-modules (sw_report_system))
-(use-modules (gnucash printf))
-
(gnc:module-load "gnucash/report/report-system" 0)
(gnc:module-load "gnucash/html" 0) ;for gnc-build-url
@@ -172,7 +170,7 @@
(gnc-build-url
URL-TYPE-OPTIONS
(string-append "report-id="
- (sprintf #f "%a" (car report-info)))
+ (format #f "~a" (car report-info)))
"")
(_ "Edit Options"))
" "
@@ -180,7 +178,7 @@
(gnc-build-url
URL-TYPE-REPORT
(string-append "id="
- (sprintf #f "%a" (car report-info)))
+ (format #f "~a" (car report-info)))
"")
(_ "Single Report")))))
diff --git a/libgnucash/app-utils/date-utilities.scm b/libgnucash/app-utils/date-utilities.scm
index 3627d29..ffad895 100644
--- a/libgnucash/app-utils/date-utilities.scm
+++ b/libgnucash/app-utils/date-utilities.scm
@@ -22,7 +22,6 @@
(use-modules (gnucash core-utils)
- (gnucash printf)
(gnucash gettext))
(define gnc:reldate-list '())
@@ -72,7 +71,7 @@
(gnc-locale-to-utf8 (strftime "%Y" datevec)))
(define (gnc:date-get-quarter-string datevec)
- (sprintf #f "Q%d" (gnc:date-get-quarter datevec)))
+ (format #f "Q~d" (gnc:date-get-quarter datevec)))
(define (gnc:date-get-quarter-year-string datevec)
(string-append
@@ -92,7 +91,7 @@
604800))
(begin-string (qof-print-date (+ beginweekt64 345600)))
(end-string (qof-print-date (+ beginweekt64 864000))))
- (sprintf #f (_ "%s to %s") begin-string end-string)))
+ (format #f (_ "~s to ~s") begin-string end-string)))
; (let ((begin-string (qof-print-date
; (+ (* (gnc:date-get-week
@@ -104,7 +103,7 @@
; (gnc:time64-start-day-time
; (gnc-mktime datevec)))
; 604800) 864000))))
-; (sprintf #f (_ "%s to %s") begin-string end-string)))
+; (format #f (_ "~s to ~s") begin-string end-string)))
;; is leap year?
(define (gnc:leap-year? year)
diff --git a/libgnucash/app-utils/test/CMakeLists.txt b/libgnucash/app-utils/test/CMakeLists.txt
index 6e77225..2489498 100644
--- a/libgnucash/app-utils/test/CMakeLists.txt
+++ b/libgnucash/app-utils/test/CMakeLists.txt
@@ -58,7 +58,7 @@ GNC_ADD_SCHEME_TARGETS(scm-test-c-interface
FALSE
)
-GNC_ADD_SCHEME_TESTS(${test_app_utils_scheme_SOURCES})
+GNC_ADD_SCHEME_TESTS("${test_app_utils_scheme_SOURCES}")
# Doesn't work yet:
GNC_ADD_TEST_WITH_GUILE(test-app-utils "${test_app_utils_SOURCES}" APP_UTILS_TEST_INCLUDE_DIRS APP_UTILS_TEST_LIBS)
diff --git a/libgnucash/app-utils/test/test-date-utilities.scm b/libgnucash/app-utils/test/test-date-utilities.scm
index 6fca517..1dc30e1 100644
--- a/libgnucash/app-utils/test/test-date-utilities.scm
+++ b/libgnucash/app-utils/test/test-date-utilities.scm
@@ -3,9 +3,10 @@
(use-modules (gnucash engine test test-extras))
(define (run-test)
- (and (test test-weeknum-calculator)))
+ (and (test test-weeknum-calculator)
+ (test test-date-get-quarter-string)))
-(define (create-time64 l)
+(define (create-datevec l)
(let ((now (gnc-localtime (current-time))))
(set-tm:sec now (list-ref l 5))
(set-tm:min now (list-ref l 4))
@@ -14,6 +15,10 @@
(set-tm:mon now (list-ref l 1))
(set-tm:year now (list-ref l 0))
(set-tm:isdst now -1)
+ now))
+
+(define (create-time64 l)
+ (let ((now (create-datevec l)))
(gnc-mktime now)))
(define (weeknums-equal? pair-of-dates)
@@ -36,3 +41,15 @@
(not (weeknums-equal? (cons '(1969 12 28 0 0 1)
'(1970 1 5 0 0 1))))
))
+
+(define (test-date-get-quarter-string)
+ (and (or (string=? "Q1" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
+ (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (creaete-datevec '(2001 2 14 11 42 23))))
+ #f))
+ (or (string=? "Q2" (gnc:date-get-quarter-string (create-datevec '(2013 4 23 18 11 49))))
+ (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23))))
+ #f))
+ (or (string=? "Q3" (gnc:date-get-quarter-string (create-datevec '(1997 9 11 08 14 21))))
+ (begin (format #t "Expected Q1, got ~a~%" (gnc:date-get-quarter-string (create-datevec '(2001 2 14 11 42 23)))))
+ #f)))
+
diff --git a/libgnucash/engine/test/test-extras.scm b/libgnucash/engine/test/test-extras.scm
index a8f0519..d9a8636 100644
--- a/libgnucash/engine/test/test-extras.scm
+++ b/libgnucash/engine/test/test-extras.scm
@@ -21,7 +21,6 @@
(use-modules (gnucash gnc-module))
-(use-modules (gnucash printf))
(use-modules (gnucash app-utils))
(use-modules (gnucash engine))
(use-modules (srfi srfi-1))
diff --git a/libgnucash/scm/CMakeLists.txt b/libgnucash/scm/CMakeLists.txt
index 785ef82..7fd32ca 100644
--- a/libgnucash/scm/CMakeLists.txt
+++ b/libgnucash/scm/CMakeLists.txt
@@ -1,5 +1,5 @@
SET(GUILE_DEPENDS scm-core-utils scm-gnc-module)
-SET(scm_scm_1_SCHEME printf.scm string.scm utilities.scm)
+SET(scm_scm_1_SCHEME string.scm utilities.scm)
GNC_ADD_SCHEME_TARGETS(scm-scm-1
diff --git a/libgnucash/scm/printf.scm b/libgnucash/scm/printf.scm
deleted file mode 100644
index db6f2e8..0000000
--- a/libgnucash/scm/printf.scm
+++ /dev/null
@@ -1,1219 +0,0 @@
-;; gnucash
-;; Copyright (C) 2009 Andy Wingo <wingo at pobox dot com>
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2 of
-;; the License, or (at your option) any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, contact:
-;;
-;; Free Software Foundation Voice: +1-617-542-5942
-;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
-;; Boston, MA 02111-1307, USA gnu at gnu.org
-
-;;; Commentary:
-;;
-;;Code pulled in from Aubrey Jaffer's SLIB.
-;;
-;;; Code:
-
-(define-module (gnucash printf)
- #:export (printf fprintf sprintf))
-
-;; Stub slib support, so we don't depend on slib proper.
-(define slib:error error)
-(define slib:tab #\tab)
-(define slib:form-feed #\page)
-(define (require feature) #f) ; noop
-(define (require-if condition feature) #f) ; noop
-
-;; The parts of slib that we need: glob.scm, genwrite.scm, and printf.scm.
-
-;;; "glob.scm" String matching for filenames (a la BASH).
-;;; Copyright (C) 1998 Radey Shouman.
-;
-;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 warranty 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.
-
-;;@code{(require 'filename)} or @code{(require 'glob)}
-;;@ftindex filename
-;;@ftindex glob
-
-(define (glob:pattern->tokens pat)
- (cond
- ((string? pat)
- (let loop ((i 0)
- (toks '()))
- (if (>= i (string-length pat))
- (reverse toks)
- (let ((pch (string-ref pat i)))
- (case pch
- ((#\? #\*)
- (loop (+ i 1)
- (cons (substring pat i (+ i 1)) toks)))
- ((#\[)
- (let ((j
- (let search ((j (+ i 2)))
- (cond
- ((>= j (string-length pat))
- (slib:error 'glob:make-matcher
- "unmatched [" pat))
- ((char=? #\] (string-ref pat j))
- (if (and (< (+ j 1) (string-length pat))
- (char=? #\] (string-ref pat (+ j 1))))
- (+ j 1)
- j))
- (else (search (+ j 1)))))))
- (loop (+ j 1) (cons (substring pat i (+ j 1)) toks))))
- (else
- (let search ((j (+ i 1)))
- (cond ((= j (string-length pat))
- (loop j (cons (substring pat i j) toks)))
- ((memv (string-ref pat j) '(#\? #\* #\[))
- (loop j (cons (substring pat i j) toks)))
- (else (search (+ j 1)))))))))))
- ((pair? pat)
- (for-each (lambda (elt) (or (string? elt)
- (slib:error 'glob:pattern->tokens
- "bad pattern" pat)))
- pat)
- pat)
- (else (slib:error 'glob:pattern->tokens "bad pattern" pat))))
-
-(define (glob:make-matcher pat ch=? ch<=?)
- (define (match-end str k kmatch)
- (and (= k (string-length str)) (reverse (cons k kmatch))))
- (define (match-str pstr nxt)
- (let ((plen (string-length pstr)))
- (lambda (str k kmatch)
- (and (<= (+ k plen) (string-length str))
- (let loop ((i 0))
- (cond ((= i plen)
- (nxt str (+ k plen) (cons k kmatch)))
- ((ch=? (string-ref pstr i)
- (string-ref str (+ k i)))
- (loop (+ i 1)))
- (else #f)))))))
- (define (match-? nxt)
- (lambda (str k kmatch)
- (and (< k (string-length str))
- (nxt str (+ k 1) (cons k kmatch)))))
- (define (match-set1 chrs)
- (let recur ((i 0))
- (cond ((= i (string-length chrs))
- (lambda (ch) #f))
- ((and (< (+ i 2) (string-length chrs))
- (char=? #\- (string-ref chrs (+ i 1))))
- (let ((nxt (recur (+ i 3))))
- (lambda (ch)
- (or (and (ch<=? ch (string-ref chrs (+ i 2)))
- (ch<=? (string-ref chrs i) ch))
- (nxt ch)))))
- (else
- (let ((nxt (recur (+ i 1)))
- (chrsi (string-ref chrs i)))
- (lambda (ch)
- (or (ch=? chrsi ch) (nxt ch))))))))
- (define (match-set tok nxt)
- (let ((chrs (substring tok 1 (- (string-length tok) 1))))
- (if (and (positive? (string-length chrs))
- (memv (string-ref chrs 0) '(#\^ #\!)))
- (let ((pred (match-set1 (substring chrs 1 (string-length chrs)))))
- (lambda (str k kmatch)
- (and (< k (string-length str))
- (not (pred (string-ref str k)))
- (nxt str (+ k 1) (cons k kmatch)))))
- (let ((pred (match-set1 chrs)))
- (lambda (str k kmatch)
- (and (< k (string-length str))
- (pred (string-ref str k))
- (nxt str (+ k 1) (cons k kmatch))))))))
- (define (match-* nxt)
- (lambda (str k kmatch)
- (let ((kmatch (cons k kmatch)))
- (let loop ((kk (string-length str)))
- (and (>= kk k)
- (or (nxt str kk kmatch)
- (loop (- kk 1))))))))
-
- (let ((matcher
- (let recur ((toks (glob:pattern->tokens pat)))
- (if (null? toks)
- match-end
- (let ((pch (or (string=? (car toks) "")
- (string-ref (car toks) 0))))
- (case pch
- ((#\?) (match-? (recur (cdr toks))))
- ((#\*) (match-* (recur (cdr toks))))
- ((#\[) (match-set (car toks) (recur (cdr toks))))
- (else (match-str (car toks) (recur (cdr toks))))))))))
- (lambda (str) (matcher str 0 '()))))
-
-(define (glob:caller-with-matches pat proc ch=? ch<=?)
- (define (glob:wildcard? pat)
- (cond ((string=? pat "") #f)
- ((memv (string-ref pat 0) '(#\* #\? #\[)) #t)
- (else #f)))
- (let* ((toks (glob:pattern->tokens pat))
- (wild? (map glob:wildcard? toks))
- (matcher (glob:make-matcher toks ch=? ch<=?)))
- (lambda (str)
- (let loop ((inds (matcher str))
- (wild? wild?)
- (res '()))
- (cond ((not inds) #f)
- ((null? wild?)
- (apply proc (reverse res)))
- ((car wild?)
- (loop (cdr inds)
- (cdr wild?)
- (cons (substring str (car inds) (cadr inds)) res)))
- (else
- (loop (cdr inds) (cdr wild?) res)))))))
-
-(define (glob:make-substituter pattern template ch=? ch<=?)
- (define (wildcard? pat)
- (cond ((string=? pat "") #f)
- ((memv (string-ref pat 0) '(#\* #\? #\[)) #t)
- (else #f)))
- (define (countq val lst)
- (do ((lst lst (cdr lst))
- (c 0 (if (eq? val (car lst)) (+ c 1) c)))
- ((null? lst) c)))
- (let ((tmpl-literals (map (lambda (tok)
- (if (wildcard? tok) #f tok))
- (glob:pattern->tokens template)))
- (pat-wild? (map wildcard? (glob:pattern->tokens pattern)))
- (matcher (glob:make-matcher pattern ch=? ch<=?)))
- (or (= (countq #t pat-wild?) (countq #f tmpl-literals))
- (slib:error 'glob:make-substituter
- "number of wildcards doesn't match" pattern template))
- (lambda (str)
- (let ((indices (matcher str)))
- (and indices
- (let loop ((inds indices)
- (wild? pat-wild?)
- (lits tmpl-literals)
- (res '()))
- (cond
- ((null? lits)
- (apply string-append (reverse res)))
- ((car lits)
- (loop inds wild? (cdr lits) (cons (car lits) res)))
- ((null? wild?) ;this should never happen.
- (loop '() '() lits res))
- ((car wild?)
- (loop (cdr inds) (cdr wild?) (cdr lits)
- (cons (substring str (car inds) (cadr inds))
- res)))
- (else
- (loop (cdr inds) (cdr wild?) lits res)))))))))
-
-;;@body
-;;Returns a predicate which returns a non-false value if its string argument
-;;matches (the string) @var{pattern}, false otherwise. Filename matching
-;;is like
-;;@cindex glob
-;;@dfn{glob} expansion described the bash manpage, except that names
-;;beginning with @samp{.} are matched and @samp{/} characters are not
-;;treated specially.
-;;
-;;These functions interpret the following characters specially in
-;;@var{pattern} strings:
-;;@table @samp
-;;@item *
-;;Matches any string, including the null string.
-;;@item ?
-;;Matches any single character.
-;;@item [@dots{}]
-;;Matches any one of the enclosed characters. A pair of characters
-;;separated by a minus sign (-) denotes a range; any character lexically
-;;between those two characters, inclusive, is matched. If the first
-;;character following the @samp{[} is a @samp{!} or a @samp{^} then any
-;;character not enclosed is matched. A @samp{-} or @samp{]} may be
-;;matched by including it as the first or last character in the set.
-;;@end table
-(define (filename:match?? pattern)
- (glob:make-matcher pattern char=? char<=?))
-(define (filename:match-ci?? pattern)
- (glob:make-matcher pattern char-ci=? char-ci<=?))
-
-
-;;@args pattern template
-;;Returns a function transforming a single string argument according to
-;;glob patterns @var{pattern} and @var{template}. @var{pattern} and
-;;@var{template} must have the same number of wildcard specifications,
-;;which need not be identical. @var{pattern} and @var{template} may have
-;;a different number of literal sections. If an argument to the function
-;;matches @var{pattern} in the sense of @code{filename:match??} then it
-;;returns a copy of @var{template} in which each wildcard specification is
-;;replaced by the part of the argument matched by the corresponding
-;;wildcard specification in @var{pattern}. A @code{*} wildcard matches
-;;the longest leftmost string possible. If the argument does not match
-;;@var{pattern} then false is returned.
-;;
-;;@var{template} may be a function accepting the same number of string
-;;arguments as there are wildcard specifications in @var{pattern}. In
-;;the case of a match the result of applying @var{template} to a list
-;;of the substrings matched by wildcard specifications will be returned,
-;;otherwise @var{template} will not be called and @code{#f} will be returned.
-(define (filename:substitute?? pattern template)
- (cond ((procedure? template)
- (glob:caller-with-matches pattern template char=? char<=?))
- ((string? template)
- (glob:make-substituter pattern template char=? char<=?))
- (else
- (slib:error 'filename:substitute?? "bad second argument" template))))
-(define (filename:substitute-ci?? pattern template)
- (cond ((procedure? template)
- (glob:caller-with-matches pattern template char-ci=? char-ci<=?))
- ((string? template)
- (glob:make-substituter pattern template char-ci=? char-ci<=?))
- (else
- (slib:error 'filename:substitute-ci?? "bad second argument" template))))
-
-;;@example
-;;((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm")
-;; "scm_10.html")
-;;@result{} "scm5c4_10.htm"
-;;((filename:substitute?? "??" "beg?mid?end") "AZ")
-;;@result{} "begAmidZend"
-;;((filename:substitute?? "*na*" "?NA?") "banana")
-;;@result{} "banaNA"
-;;((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1)))
-;; "ABZ")
-;;@result{} "ZA"
-;;@end example
-
-;;@body
-;;@var{str} can be a string or a list of strings. Returns a new string
-;;(or strings) similar to @code{str} but with the suffix string @var{old}
-;;removed and the suffix string @var{new} appended. If the end of
-;;@var{str} does not match @var{old}, an error is signaled.
-(define (replace-suffix str old new)
- (let* ((f (glob:make-substituter (list "*" old) (list "*" new)
- char=? char<=?))
- (g (lambda (st)
- (or (f st)
- (slib:error 'replace-suffix "suffix doesn't match:"
- old st)))))
- (if (pair? str)
- (map g str)
- (g str))))
-
-;;@example
-;;(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c")
-;;@result{} "/usr/local/lib/slib/batch.c"
-;;@end example
-
-;;@args proc k
-;;@args proc
-;;Calls @1 with @2 arguments, strings returned by successive calls to
-;;@code{tmpnam}.
-;;If @1 returns, then any files named by the arguments to @1 are
-;;deleted automatically and the value(s) yielded by the @1 is(are)
-;;returned. @2 may be ommited, in which case it defaults to @code{1}.
-;;
-;;@args proc suffix1 ...
-;;Calls @1 with strings returned by successive calls to @code{tmpnam},
-;;each with the corresponding @var{suffix} string appended.
-;;If @1 returns, then any files named by the arguments to @1 are
-;;deleted automatically and the value(s) yielded by the @1 is(are)
-;;returned.
-(define (call-with-tmpnam proc . suffi)
- (define (do-call paths)
- (let ((ans (apply proc paths)))
- (for-each (lambda (path) (if (file-exists? path) (delete-file path)))
- paths)
- ans))
- (cond ((null? suffi) (do-call (list (tmpnam))))
- ((and (= 1 (length suffi)) (number? (car suffi)))
- (do ((cnt (if (null? suffi) 0 (+ -1 (car suffi))) (+ -1 cnt))
- (paths '() (cons (tmpnam) paths)))
- ((negative? cnt)
- (do-call paths))))
- (else (do-call (map (lambda (suffix) (string-append (tmpnam) suffix))
- suffi)))))
-
-
-;;"genwrite.scm" generic write used by pretty-print and truncated-print.
-;; Copyright (c) 1991, Marc Feeley
-;; Author: Marc Feeley (feeley at iro.umontreal.ca)
-;; Distribution restrictions: none
-
-(define genwrite:newline-str (make-string 1 #\newline))
-;@
-(define (generic-write obj display? width output)
-
- (define (read-macro? l)
- (define (length1? l) (and (pair? l) (null? (cdr l))))
- (let ((head (car l)) (tail (cdr l)))
- (case head
- ((quote quasiquote unquote unquote-splicing) (length1? tail))
- (else #f))))
-
- (define (read-macro-body l)
- (cadr l))
-
- (define (read-macro-prefix l)
- (let ((head (car l)) (tail (cdr l)))
- (case head
- ((quote) "'")
- ((quasiquote) "`")
- ((unquote) ",")
- ((unquote-splicing) ",@"))))
-
- (define (out str col)
- (and col (output str) (+ col (string-length str))))
-
- (define (wr obj col)
-
- (define (wr-expr expr col)
- (if (read-macro? expr)
- (wr (read-macro-body expr) (out (read-macro-prefix expr) col))
- (wr-lst expr col)))
-
- (define (wr-lst l col)
- (if (pair? l)
- (let loop ((l (cdr l))
- (col (and col (wr (car l) (out "(" col)))))
- (cond ((not col) col)
- ((pair? l)
- (loop (cdr l) (wr (car l) (out " " col))))
- ((null? l) (out ")" col))
- (else (out ")" (wr l (out " . " col))))))
- (out "()" col)))
-
- (cond ((pair? obj) (wr-expr obj col))
- ((null? obj) (wr-lst obj col))
- ((vector? obj) (wr-lst (vector->list obj) (out "#" col)))
- ((boolean? obj) (out (if obj "#t" "#f") col))
- ((number? obj) (out (number->string obj) col))
- ((symbol? obj) (out (symbol->string obj) col))
- ((procedure? obj) (out "#[procedure]" col))
- ((string? obj) (if display?
- (out obj col)
- (let loop ((i 0) (j 0) (col (out "\"" col)))
- (if (and col (< j (string-length obj)))
- (let ((c (string-ref obj j)))
- (if (or (char=? c #\\)
- (char=? c #\"))
- (loop j
- (+ j 1)
- (out "\\"
- (out (substring obj i j)
- col)))
- (loop i (+ j 1) col)))
- (out "\""
- (out (substring obj i j) col))))))
- ((char? obj) (if display?
- (out (make-string 1 obj) col)
- (out (case obj
- ((#\space) "space")
- ((#\newline) "newline")
- (else (make-string 1 obj)))
- (out "#\\" col))))
- ((input-port? obj) (out "#[input-port]" col))
- ((output-port? obj) (out "#[output-port]" col))
- ((eof-object? obj) (out "#[eof-object]" col))
- (else (out "#[unknown]" col))))
-
- (define (pp obj col)
-
- (define (spaces n col)
- (if (> n 0)
- (if (> n 7)
- (spaces (- n 8) (out " " col))
- (out (substring " " 0 n) col))
- col))
-
- (define (indent to col)
- (and col
- (if (< to col)
- (and (out genwrite:newline-str col) (spaces to 0))
- (spaces (- to col) col))))
-
- (define (pr obj col extra pp-pair)
- (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
- (let ((result '())
- (left (min (+ (- (- width col) extra) 1) max-expr-width)))
- (generic-write obj display? #f
- (lambda (str)
- (set! result (cons str result))
- (set! left (- left (string-length str)))
- (> left 0)))
- (if (> left 0) ; all can be printed on one line
- (out (reverse-string-append result) col)
- (if (pair? obj)
- (pp-pair obj col extra)
- (pp-list (vector->list obj) (out "#" col) extra pp-expr))))
- (wr obj col)))
-
- (define (pp-expr expr col extra)
- (if (read-macro? expr)
- (pr (read-macro-body expr)
- (out (read-macro-prefix expr) col)
- extra
- pp-expr)
- (let ((head (car expr)))
- (if (symbol? head)
- (let ((proc (style head)))
- (if proc
- (proc expr col extra)
- (if (> (string-length (symbol->string head))
- max-call-head-width)
- (pp-general expr col extra #f #f #f pp-expr)
- (pp-call expr col extra pp-expr))))
- (pp-list expr col extra pp-expr)))))
-
- ; (head item1
- ; item2
- ; item3)
- (define (pp-call expr col extra pp-item)
- (let ((col* (wr (car expr) (out "(" col))))
- (and col
- (pp-down (cdr expr) col* (+ col* 1) extra pp-item))))
-
- ; (item1
- ; item2
- ; item3)
- (define (pp-list l col extra pp-item)
- (let ((col (out "(" col)))
- (pp-down l col col extra pp-item)))
-
- (define (pp-down l col1 col2 extra pp-item)
- (let loop ((l l) (col col1))
- (and col
- (cond ((pair? l)
- (let ((rest (cdr l)))
- (let ((extra (if (null? rest) (+ extra 1) 0)))
- (loop rest
- (pr (car l) (indent col2 col) extra pp-item)))))
- ((null? l)
- (out ")" col))
- (else
- (out ")"
- (pr l
- (indent col2 (out "." (indent col2 col)))
- (+ extra 1)
- pp-item)))))))
-
- (define (pp-general expr col extra named? pp-1 pp-2 pp-3)
-
- (define (tail1 rest col1 col2 col3)
- (if (and pp-1 (pair? rest))
- (let* ((val1 (car rest))
- (rest (cdr rest))
- (extra (if (null? rest) (+ extra 1) 0)))
- (tail2 rest col1 (pr val1 (indent col3 col2) extra pp-1) col3))
- (tail2 rest col1 col2 col3)))
-
- (define (tail2 rest col1 col2 col3)
- (if (and pp-2 (pair? rest))
- (let* ((val1 (car rest))
- (rest (cdr rest))
- (extra (if (null? rest) (+ extra 1) 0)))
- (tail3 rest col1 (pr val1 (indent col3 col2) extra pp-2)))
- (tail3 rest col1 col2)))
-
- (define (tail3 rest col1 col2)
- (pp-down rest col2 col1 extra pp-3))
-
- (let* ((head (car expr))
- (rest (cdr expr))
- (col* (wr head (out "(" col))))
- (if (and named? (pair? rest))
- (let* ((name (car rest))
- (rest (cdr rest))
- (col** (wr name (out " " col*))))
- (tail1 rest (+ col indent-general) col** (+ col** 1)))
- (tail1 rest (+ col indent-general) col* (+ col* 1)))))
-
- (define (pp-expr-list l col extra)
- (pp-list l col extra pp-expr))
-
- (define (pp-LAMBDA expr col extra)
- (pp-general expr col extra #f pp-expr-list #f pp-expr))
-
- (define (pp-IF expr col extra)
- (pp-general expr col extra #f pp-expr #f pp-expr))
-
- (define (pp-COND expr col extra)
- (pp-call expr col extra pp-expr-list))
-
- (define (pp-CASE expr col extra)
- (pp-general expr col extra #f pp-expr #f pp-expr-list))
-
- (define (pp-AND expr col extra)
- (pp-call expr col extra pp-expr))
-
- (define (pp-LET expr col extra)
- (let* ((rest (cdr expr))
- (named? (and (pair? rest) (symbol? (car rest)))))
- (pp-general expr col extra named? pp-expr-list #f pp-expr)))
-
- (define (pp-BEGIN expr col extra)
- (pp-general expr col extra #f #f #f pp-expr))
-
- (define (pp-DO expr col extra)
- (pp-general expr col extra #f pp-expr-list pp-expr-list pp-expr))
-
- ; define formatting style (change these to suit your style)
-
- (define indent-general 2)
-
- (define max-call-head-width 5)
-
- (define max-expr-width 50)
-
- (define (style head)
- (case head
- ((lambda let* letrec define) pp-LAMBDA)
- ((if set!) pp-IF)
- ((cond) pp-COND)
- ((case) pp-CASE)
- ((and or) pp-AND)
- ((let) pp-LET)
- ((begin) pp-BEGIN)
- ((do) pp-DO)
- (else #f)))
-
- (pr obj col 0 pp-expr))
-
- (if width
- (out genwrite:newline-str (pp obj 0))
- (wr obj 0)))
-
-; (reverse-string-append l) = (apply string-append (reverse l))
-;@
-(define (reverse-string-append l)
-
- (define (rev-string-append l i)
- (if (pair? l)
- (let* ((str (car l))
- (len (string-length str))
- (result (rev-string-append (cdr l) (+ i len))))
- (let loop ((j 0) (k (- (- (string-length result) i) len)))
- (if (< j len)
- (begin
- (string-set! result k (string-ref str j))
- (loop (+ j 1) (+ k 1)))
- result)))
- (make-string i)))
-
- (rev-string-append l 0))
-
-
-;;;; "printf.scm" Implementation of standard C functions for Scheme
-;;; Copyright (C) 1991-1993, 1996, 1999-2001 Aubrey Jaffer and Radey Shouman.
-;
-;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 warranty 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.
-
-(require 'string-case)
-(require-if 'compiling 'generic-write)
-
-;; Determine the case of digits > 9. We assume this to be constant.
-(define stdio:hex-upper-case? (string=? "-F" (number->string -15 16)))
-
-;; Parse the output of NUMBER->STRING and pass the results to PROC.
-;; PROC takes (SIGN-CHARACTER DIGIT-STRING EXPONENT-INTEGER . IMAGPART)
-;; SIGN-CHAR will be either #\+ or #\-, DIGIT-STRING will always begin
-;; with a "0", after which a decimal point should be understood.
-;; If STR denotes a number with imaginary part not exactly zero,
-;; 3 additional elements for the imaginary part are passed.
-;; If STR cannot be parsed, return #F without calling PROC.
-(define (stdio:parse-float str proc)
- (let ((n (string-length str)))
- (define (parse-error) #f)
- (define (prefix i cont)
- (if (and (< i (- n 1))
- (char=? #\# (string-ref str i)))
- (case (string-ref str (+ i 1))
- ((#\d #\i #\e) (prefix (+ i 2) cont))
- ((#\.) (cont i))
- (else (parse-error)))
- (cont i)))
- (define (sign i cont)
- (if (< i n)
- (let ((c (string-ref str i)))
- (case c
- ((#\- #\+) (cont (+ i 1) c))
- (else (cont i #\+))))))
- (define (digits i cont)
- (do ((j i (+ j 1)))
- ((or (>= j n)
- (not (or (char-numeric? (string-ref str j))
- (char=? #\# (string-ref str j)))))
- (cont j (if (= i j) "0" (substring str i j))))))
- (define (point i cont)
- (if (and (< i n)
- (char=? #\. (string-ref str i)))
- (cont (+ i 1))
- (cont i)))
- (define (exp i cont)
- (cond ((>= i n) (cont i 0))
- ((memv (string-ref str i)
- '(#\e #\s #\f #\d #\l #\E #\S #\F #\D #\L))
- (sign (+ i 1)
- (lambda (i sgn)
- (digits i
- (lambda (i digs)
- (cont i
- (if (char=? #\- sgn)
- (- (string->number digs))
- (string->number digs))))))))
- (else (cont i 0))))
- (define (real i cont)
- (prefix
- i
- (lambda (i)
- (sign
- i
- (lambda (i sgn)
- (digits
- i
- (lambda (i idigs)
- (point
- i
- (lambda (i)
- (digits
- i
- (lambda (i fdigs)
- (exp i
- (lambda (i ex)
- (let* ((digs (string-append "0" idigs fdigs))
- (ndigs (string-length digs)))
- (let loop ((j 1)
- (ex (+ ex (string-length idigs))))
- (cond ((>= j ndigs) ;; Zero
- (cont i sgn "0" 1))
- ((char=? #\0 (string-ref digs j))
- (loop (+ j 1) (- ex 1)))
- (else
- (cont i sgn
- (substring digs (- j 1) ndigs)
- ex))))))))))))))))))
- (real 0
- (lambda (i sgn digs ex)
- (cond
- ((= i n) (proc sgn digs ex))
- ((memv (string-ref str i) '(#\+ #\-))
- (real i
- (lambda (j im-sgn im-digs im-ex)
- (if (and (= j (- n 1))
- (char-ci=? #\i (string-ref str j)))
- (proc sgn digs ex im-sgn im-digs im-ex)
- (parse-error)))))
- ((eqv? (string-ref str i) #\@)
- ;; Polar form: No point in parsing the angle ourselves,
- ;; since some transcendental approximation is unavoidable.
- (let ((num (string->number str)))
- (if num
- (stdio:parse-float
- (number->string (real-part num))
- (lambda (sgn digs ex)
- (stdio:parse-float
- (number->string (imag-part num))
- (lambda (im-sgn im-digs im-ex)
- (proc sgn digs ex im-sgn im-digs im-ex)))))
- (parse-error))))
- (else #f))))))
-
-;; STR is a digit string representing a floating point mantissa, STR must
-;; begin with "0", after which a decimal point is understood.
-;; The output is a digit string rounded to NDIGS digits after the decimal
-;; point implied between chars 0 and 1.
-;; If STRIP-0S is not #F then trailing zeros will be stripped from the result.
-;; In this case, STRIP-0S should be the minimum number of digits required
-;; after the implied decimal point.
-(define (stdio:round-string str ndigs strip-0s)
- (let* ((n (- (string-length str) 1))
- (res
- (cond ((< ndigs 0) "")
- ((= n ndigs) str)
- ((< n ndigs)
- (let ((padlen (max 0 (- (or strip-0s ndigs) n))))
- (if (zero? padlen)
- str
- (string-append str
- (make-string padlen
- (if (char-numeric?
- (string-ref str n))
- #\0 #\#))))))
- (else
- (let ((res (substring str 0 (+ ndigs 1)))
- (dig (lambda (i)
- (let ((c (string-ref str i)))
- (if (char-numeric? c)
- (string->number (string c))
- 0)))))
- (let ((ldig (dig (+ 1 ndigs))))
- (if (or (> ldig 5)
- (and (= ldig 5)
- (let loop ((i (+ 2 ndigs)))
- (if (> i n)
- (odd? (dig ndigs))
- (if (zero? (dig i))
- (loop (+ i 1))
- #t)))))
- (let inc! ((i ndigs))
- (let ((d (dig i)))
- (if (< d 9)
- (string-set! res i
- (string-ref
- (number->string (+ d 1)) 0))
- (begin
- (string-set! res i #\0)
- (inc! (- i 1))))))))
- res)))))
- (if strip-0s
- (let loop ((i (- (string-length res) 1)))
- (if (or (<= i strip-0s)
- (not (char=? #\0 (string-ref res i))))
- (substring res 0 (+ i 1))
- (loop (- i 1))))
- res)))
-
-(define (stdio:iprintf out format-string . args)
- (cond
- ((not (equal? "" format-string))
- (let ((pos -1)
- (fl (string-length format-string))
- (fc (string-ref format-string 0)))
-
- (define (advance)
- (set! pos (+ 1 pos))
- (cond ((>= pos fl) (set! fc #f))
- (else (set! fc (string-ref format-string pos)))))
- (define (must-advance)
- (set! pos (+ 1 pos))
- (cond ((>= pos fl) (incomplete))
- (else (set! fc (string-ref format-string pos)))))
- (define (end-of-format?)
- (>= pos fl))
- (define (incomplete)
- (slib:error 'printf "conversion specification incomplete"
- format-string))
- (define (wna)
- (slib:error 'printf "wrong number of arguments"
- (length args)
- format-string))
- (define (out* strs)
- (if (string? strs) (out strs)
- (let out-loop ((strs strs))
- (or (null? strs)
- (and (out (car strs))
- (out-loop (cdr strs)))))))
-
- (let loop ((args args))
- (advance)
- (cond
- ((end-of-format?)
- ;;(or (null? args) (wna)) ;Extra arguments are *not* a bug.
- )
- ((eqv? #\\ fc);;Emulating C strings may not be a good idea.
- (must-advance)
- (and (case fc
- ((#\n #\N) (out #\newline))
- ((#\t #\T) (out slib:tab))
- ;;((#\r #\R) (out #\return))
- ((#\f #\F) (out slib:form-feed))
- ((#\newline) #t)
- (else (out fc)))
- (loop args)))
- ((eqv? #\% fc)
- (must-advance)
- (let ((left-adjust #f) ;-
- (signed #f) ;+
- (blank #f)
- (alternate-form #f) ;#
- (leading-0s #f) ;0
- (width 0)
- (precision -1)
- (type-modifier #f)
- (read-format-number
- (lambda ()
- (cond
- ((eqv? #\* fc) ; GNU extension
- (must-advance)
- (let ((ans (car args)))
- (set! args (cdr args))
- ans))
- (else
- (do ((c fc fc)
- (accum 0 (+ (* accum 10)
- (string->number (string c)))))
- ((not (char-numeric? fc)) accum)
- (must-advance)))))))
- (define (pad pre . strs)
- (let loop ((len (string-length pre))
- (ss strs))
- (cond ((>= len width) (cons pre strs))
- ((null? ss)
- (cond (left-adjust
- (cons pre
- (append strs
- (list (make-string
- (- width len) #\space)))))
- (leading-0s
- (cons pre
- (cons (make-string (- width len) #\0)
- strs)))
- (else
- (cons (make-string (- width len) #\space)
- (cons pre strs)))))
- (else
- (loop (+ len (string-length (car ss))) (cdr ss))))))
- (define integer-convert
- (lambda (s radix fixcase)
- (cond ((not (negative? precision))
- (set! leading-0s #f)
- (if (and (zero? precision)
- (eqv? 0 s))
- (set! s ""))))
- (set! s (cond ((symbol? s) (symbol->string s))
- ((number? s) (number->string s radix))
- ((or (not s) (null? s)) "0")
- ((string? s) s)
- (else "1")))
- (if fixcase (set! s (fixcase s)))
- (let ((pre (cond ((equal? "" s) "")
- ((eqv? #\- (string-ref s 0))
- (set! s (substring s 1 (string-length s)))
- "-")
- (signed "+")
- (blank " ")
- (alternate-form
- (case radix
- ((8) "0")
- ((16) "0x")
- (else "")))
- (else ""))))
- (pad pre
- (if (< (string-length s) precision)
- (make-string
- (- precision (string-length s)) #\0)
- "")
- s))))
- (define (float-convert num fc)
- (define (f digs exp strip-0s)
- (let ((digs (stdio:round-string
- digs (+ exp precision) (and strip-0s exp))))
- (cond ((>= exp 0)
- (let* ((i0 (cond ((zero? exp) 0)
- ((char=? #\0 (string-ref digs 0)) 1)
- (else 0)))
- (i1 (max 1 (+ 1 exp)))
- (idigs (substring digs i0 i1))
- (fdigs (substring digs i1
- (string-length digs))))
- (cons idigs
- (if (and (string=? fdigs "")
- (not alternate-form))
- '()
- (list "." fdigs)))))
- ((zero? precision)
- (list (if alternate-form "0." "0")))
- ((and strip-0s (string=? digs "") (list "0")))
- (else
- (list "0."
- (make-string (min precision (- -1 exp)) #\0)
- digs)))))
- (define (e digs exp strip-0s)
- (let* ((digs (stdio:round-string
- digs (+ 1 precision) (and strip-0s 0)))
- (istrt (if (char=? #\0 (string-ref digs 0)) 1 0))
- (fdigs (substring
- digs (+ 1 istrt) (string-length digs)))
- (exp (if (zero? istrt) exp (- exp 1))))
- (list
- (substring digs istrt (+ 1 istrt))
- (if (and (string=? fdigs "") (not alternate-form))
- "" ".")
- fdigs
- (if (char-upper-case? fc) "E" "e")
- (if (negative? exp) "-" "+")
- (if (< -10 exp 10) "0" "")
- (number->string (abs exp)))))
- (define (g digs exp)
- (let ((strip-0s (not alternate-form)))
- (set! alternate-form #f)
- (cond ((<= (- 1 precision) exp precision)
- (set! precision (- precision exp))
- (f digs exp strip-0s))
- (else
- (set! precision (- precision 1))
- (e digs exp strip-0s)))))
- (define (k digs exp sep)
- (let* ((units '#("y" "z" "a" "f" "p" "n" "u" "m" ""
- "k" "M" "G" "T" "P" "E" "Z" "Y"))
- (base 8) ;index of ""
- (uind (let ((i (if (negative? exp)
- (quotient (- exp 3) 3)
- (quotient (- exp 1) 3))))
- (and
- (< -1 (+ i base) (vector-length units))
- i))))
- (cond (uind
- (set! exp (- exp (* 3 uind)))
- (set! precision (max 0 (- precision exp)))
- (append
- (f digs exp #f)
- (list sep
- (vector-ref units (+ uind base)))))
- (else
- (g digs exp)))))
-
- (cond ((negative? precision)
- (set! precision 6))
- ((and (zero? precision)
- (char-ci=? fc #\g))
- (set! precision 1)))
- (let* ((str
- (cond ((number? num)
- (number->string (exact->inexact num)))
- ((string? num) num)
- ((symbol? num) (symbol->string num))
- (else "???"))))
- (define (format-real signed? sgn digs exp . rest)
- (if (null? rest)
- (cons
- (if (char=? #\- sgn) "-"
- (if signed? "+" (if blank " " "")))
- (case fc
- ((#\e #\E) (e digs exp #f))
- ((#\f #\F) (f digs exp #f))
- ((#\g #\G) (g digs exp))
- ((#\k) (k digs exp ""))
- ((#\K) (k digs exp " "))))
- (append (format-real signed? sgn digs exp)
- (apply format-real #t rest)
- '("i"))))
- (or (stdio:parse-float str
- (lambda (sgn digs expon . imag)
- (apply pad
- (apply format-real
- signed
- sgn digs expon imag))))
- (pad "???"))))
- (do ()
- ((case fc
- ((#\-) (set! left-adjust #t) #f)
- ((#\+) (set! signed #t) #f)
- ((#\ ) (set! blank #t) #f)
- ((#\#) (set! alternate-form #t) #f)
- ((#\0) (set! leading-0s #t) #f)
- (else #t)))
- (must-advance))
- (cond (left-adjust (set! leading-0s #f)))
- (cond (signed (set! blank #f)))
-
- (set! width (read-format-number))
- (cond ((negative? width)
- (set! left-adjust #t)
- (set! width (- width))))
- (cond ((eqv? #\. fc)
- (must-advance)
- (set! precision (read-format-number))))
- (case fc ;Ignore these specifiers
- ((#\l #\L #\h)
- (set! type-modifier fc)
- (must-advance)))
-
- ;;At this point fc completely determines the format to use.
- (if (null? args)
- (if (memv (char-downcase fc)
- '(#\c #\s #\a #\d #\i #\u #\o #\x #\b
- #\f #\e #\g #\k))
- (wna)))
-
- (case fc
- ;; only - is allowed between % and c
- ((#\c #\C) ; C is enhancement
- (and (out (string (car args))) (loop (cdr args))))
-
- ;; only - flag, no type-modifiers
- ((#\s #\S) ; S is enhancement
- (let ((s (cond
- ((symbol? (car args)) (symbol->string (car args)))
- ((not (car args)) "(NULL)")
- (else (car args)))))
- (cond ((not (or (negative? precision)
- (>= precision (string-length s))))
- (set! s (substring s 0 precision))))
- (and
- (out* (cond
- ((<= width (string-length s)) s)
- (left-adjust
- (list
- s (make-string (- width (string-length s)) #\ )))
- (else
- (list
- (make-string (- width (string-length s))
- (if leading-0s #\0 #\ ))
- s))))
- (loop (cdr args)))))
-
- ;; SLIB extension
- ((#\a #\A) ;#\a #\A are pretty-print
- (require 'generic-write)
- (let ((os "") (pr precision))
- (generic-write
- (car args) (not alternate-form) #f
- (cond ((and left-adjust (negative? pr))
- (set! pr 0)
- (lambda (s)
- (set! pr (+ pr (string-length s)))
- (out s)))
- (left-adjust
- (lambda (s)
- (define sl (- pr (string-length s)))
- (set! pr (cond ((negative? sl)
- (out (substring s 0 pr)) 0)
- (else (out s) sl)))
- (positive? sl)))
- ((negative? pr)
- (set! pr width)
- (lambda (s)
- (set! pr (- pr (string-length s)))
- (cond ((not os) (out s))
- ((negative? pr)
- (out os)
- (set! os #f)
- (out s))
- (else (set! os (string-append os s))))
- #t))
- (else
- (lambda (s)
- (define sl (- pr (string-length s)))
- (cond ((negative? sl)
- (set! os (string-append
- os (substring s 0 pr))))
- (else (set! os (string-append os s))))
- (set! pr sl)
- (positive? sl)))))
- (cond ((and left-adjust (negative? precision))
- (cond
- ((> width pr) (out (make-string (- width pr) #\ )))))
- (left-adjust
- (cond
- ((> width (- precision pr))
- (out (make-string (- width (- precision pr)) #\ )))))
- ((not os))
- ((<= width (string-length os)) (out os))
- (else (and (out (make-string
- (- width (string-length os)) #\ ))
- (out os)))))
- (loop (cdr args)))
- ((#\d #\D #\i #\I #\u #\U)
- (and (out* (integer-convert (car args) 10 #f))
- (loop (cdr args))))
- ((#\o #\O)
- (and (out* (integer-convert (car args) 8 #f))
- (loop (cdr args))))
- ((#\x)
- (and (out* (integer-convert
- (car args) 16
- (if stdio:hex-upper-case? string-downcase #f)))
- (loop (cdr args))))
- ((#\X)
- (and (out* (integer-convert
- (car args) 16
- (if stdio:hex-upper-case? #f string-upcase)))
- (loop (cdr args))))
- ((#\b #\B)
- (and (out* (integer-convert (car args) 2 #f))
- (loop (cdr args))))
- ((#\%) (and (out #\%) (loop args)))
- ((#\f #\F #\e #\E #\g #\G #\k #\K)
- (and (out* (float-convert (car args) fc)) (loop (cdr args))))
- (else
- (cond
- ((end-of-format?) (incomplete))
- (else (and (out #\%) (out fc) (out #\?) (loop args))))))))
- (else (and (out fc) (loop args)))))))))
-;@
-(define (fprintf port format . args)
- (let ((cnt 0))
- (apply stdio:iprintf
- (lambda (x)
- (cond ((string? x)
- (set! cnt (+ (string-length x) cnt)) (display x port) #t)
- (else (set! cnt (+ 1 cnt)) (display x port) #t)))
- format args)
- cnt))
-;@
-(define (printf format . args)
- (apply stdio:fprintf (current-output-port) format args))
-;@
-(define (sprintf str format . args)
- (let* ((cnt 0)
- (s (cond ((string? str) str)
- ((number? str) (make-string str))
- ((not str) (make-string 100))
- (else (slib:error 'sprintf "first argument not understood"
- str))))
- (end (string-length s)))
- (apply stdio:iprintf
- (lambda (x)
- (cond ((string? x)
- (if (or str (>= (- end cnt) (string-length x)))
- (do ((lend (min (string-length x) (- end cnt)))
- (i 0 (+ i 1)))
- ((>= i lend))
- (string-set! s cnt (string-ref x i))
- (set! cnt (+ cnt 1)))
- (let ()
- (set! s (string-append (substring s 0 cnt) x))
- (set! cnt (string-length s))
- (set! end cnt))))
- ((and str (>= cnt end)))
- (else (cond ((and (not str) (>= cnt end))
- (set! s (string-append s (make-string 100)))
- (set! end (string-length s))))
- (string-set! s cnt (if (char? x) x #\?))
- (set! cnt (+ cnt 1))))
- (not (and str (>= cnt end))))
- format
- args)
- (cond ((string? str) cnt)
- ((eqv? end cnt) s)
- (else (substring s 0 cnt)))))
-
-(define stdio:fprintf fprintf)
-
-;;(do ((i 0 (+ 1 i))) ((> i 50)) (printf "%s\\n" (sprintf i "%#-13a:%#13a:%-13.8a:" "123456789" "123456789" "123456789")))
diff --git a/po/POTFILES.in b/po/POTFILES.in
index f0ab599..47fd1c8 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -694,7 +694,6 @@ libgnucash/gnc-module/example/gncmod-example.c
libgnucash/gnc-module/gnc-module.c
libgnucash/gnc-module/gnc-module.scm
libgnucash/scm/price-quotes.scm
-libgnucash/scm/printf.scm
libgnucash/scm/string.scm
libgnucash/scm/utilities.scm
libgnucash/tax/us/de_DE.scm
Summary of changes:
gnucash/import-export/qif-imp/qif-file.scm | 3 +-
gnucash/import-export/qif-imp/qif-parse.scm | 9 +-
gnucash/import-export/qif-imp/qif-to-gnc.scm | 6 +-
gnucash/report/business-reports/aging.scm | 5 +-
.../report/business-reports/customer-summary.scm | 21 +-
gnucash/report/business-reports/easy-invoice.scm | 5 +-
gnucash/report/business-reports/fancy-invoice.scm | 5 +-
gnucash/report/business-reports/invoice.scm | 3 +-
gnucash/report/business-reports/job-report.scm | 7 +-
gnucash/report/locale-specific/us/taxtxf-de_DE.scm | 3 +-
gnucash/report/locale-specific/us/taxtxf.scm | 27 +-
gnucash/report/report-gnome/report-gnome.scm | 4 +-
gnucash/report/report-system/eguile-gnc.scm | 3 +-
gnucash/report/report-system/html-document.scm | 3 +-
gnucash/report/report-system/html-table.scm | 6 +-
gnucash/report/report-system/html-text.scm | 6 +-
gnucash/report/report-system/html-utilities.scm | 4 +-
gnucash/report/report-system/report-collectors.scm | 1 -
gnucash/report/report-system/report-utilities.scm | 9 +-
gnucash/report/report-system/report.scm | 1 -
.../report/report-system/test/test-test-extras.scm | 1 -
.../report/standard-reports/account-piecharts.scm | 18 +-
.../report/standard-reports/advanced-portfolio.scm | 12 +-
.../report/standard-reports/budget-barchart.scm | 2 -
gnucash/report/standard-reports/budget-flow.scm | 4 +-
.../standard-reports/budget-income-statement.scm | 15 +-
gnucash/report/standard-reports/budget.scm | 3 +-
gnucash/report/standard-reports/cash-flow.scm | 9 +-
.../report/standard-reports/cashflow-barchart.scm | 5 +-
.../report/standard-reports/category-barchart.scm | 14 +-
gnucash/report/standard-reports/daily-reports.scm | 10 +-
.../report/standard-reports/equity-statement.scm | 10 +-
.../report/standard-reports/income-statement.scm | 7 +-
gnucash/report/standard-reports/net-barchart.scm | 5 +-
gnucash/report/standard-reports/net-linechart.scm | 5 +-
gnucash/report/standard-reports/portfolio.scm | 6 +-
gnucash/report/standard-reports/price-scatter.scm | 6 +-
gnucash/report/standard-reports/sx-summary.scm | 7 +-
.../test/test-generic-category-report.scm | 1 -
.../test/test-standard-category-report.scm | 1 -
gnucash/report/standard-reports/transaction.scm | 5 +-
gnucash/report/standard-reports/trial-balance.scm | 9 +-
gnucash/report/utility-reports/hello-world.scm | 22 +-
gnucash/report/utility-reports/view-column.scm | 6 +-
libgnucash/app-utils/date-utilities.scm | 7 +-
libgnucash/app-utils/test/CMakeLists.txt | 2 +-
libgnucash/app-utils/test/test-date-utilities.scm | 21 +-
libgnucash/engine/test/test-extras.scm | 1 -
libgnucash/scm/CMakeLists.txt | 2 +-
libgnucash/scm/printf.scm | 1219 --------------------
po/POTFILES.in | 1 -
51 files changed, 151 insertions(+), 1416 deletions(-)
delete mode 100644 libgnucash/scm/printf.scm
More information about the gnucash-changes
mailing list