Merge commit '750ac8c592e792e627444f476877f282525b132e'

[bpt/guile.git] / module / ice-9 / format.scm

diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index 7cd0183..1ef4cb5 100644 (file)
--- a/module/ice-9/format.scm
+++ b/module/ice-9/format.scm
@@ -1,5 +1,5 @@
 ;;;; "format.scm" Common LISP text output formatter for SLIB
-;;;    Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;    Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -31,6 +31,7 @@
 
 (define-module (ice-9 format)
   #:autoload (ice-9 pretty-print) (pretty-print truncated-print)
+  #:autoload (ice-9 i18n)         (%global-locale number->locale-string)
   #:replace (format))
 
 (define format:version "3.0")
@@ -269,6 +270,24 @@
                   ((#\D)                ; Decimal
                    (format:out-num-padded modifier (next-arg) params 10)
                    (anychar-dispatch))
+                  ((#\H)                ; Localized number
+                   (let* ((num      (next-arg))
+                          (locale   (case modifier
+                                      ((colon) (next-arg))
+                                      (else    %global-locale)))
+                          (argc     (length params))
+                          (width    (format:par params argc 0 #f "width"))
+                          (decimals (format:par params argc 1 #t "decimals"))
+                          (padchar  (integer->char
+                                     (format:par params argc 2 format:space-ch
+                                                 "padchar")))
+                          (str      (number->locale-string num decimals
+                                                           locale)))
+                     (format:out-str (if (and width
+                                              (< (string-length str) width))
+                                         (string-pad str width padchar)
+                                         str)))
+                   (anychar-dispatch))
                   ((#\X)                ; Hexadecimal
                    (format:out-num-padded modifier (next-arg) params 16)
                    (anychar-dispatch))
@@ -405,15 +424,15 @@
                      (case modifier
                        ((at)
                         (format:out-str
-                         (with-output-to-string 
-                           (lambda ()
-                             (truncated-print (next-arg)
+                         (call-with-output-string
+                           (lambda (p)
+                             (truncated-print (next-arg) p
                                               #:width width)))))
                        ((colon-at)
                         (format:out-str
-                         (with-output-to-string 
-                           (lambda ()
-                             (truncated-print (next-arg)
+                         (call-with-output-string
+                           (lambda (p)
+                             (truncated-print (next-arg) p
                                               #:width
                                               (max (- width
                                                       output-col)
@@ -757,7 +776,7 @@
     (define (format:obj->str obj slashify)
       (let ((res (if slashify
                      (object->string obj)
-                     (with-output-to-string (lambda () (display obj))))))
+                     (call-with-output-string (lambda (p) (display obj p))))))
         (if (and format:read-proof (string-prefix? "#<" res))
             (object->string res)
             res)))