format: Add specifier ~h for localized number output.

* doc/ref/misc-modules.texi (Formatted Output): Document ~h.  Recommend
  use of ~h instead of ~:d.

* module/ice-9/format.scm (format): Add support for ~h.

* test-suite/tests/format.test ("~h localized number"): New test prefix.

* test-suite/tests/i18n.test (%american-english-locale-name,
  %american-english-locale): New variables.
  (under-american-english-locale-or-unresolved): New procedure.
  ("format ~h"): New test prefix.

4 files changed, 109 insertions, 7 deletions

diff --git a/doc/ref/misc-modules.texi b/doc/ref/misc-modules.texi
index 2a6630cd6..022b7cb5b 100644
--- a/doc/ref/misc-modules.texi
+++ b/doc/ref/misc-modules.texi
@@ -269,7 +269,7 @@ Integer.  Parameters: @var{minwidth}, @var{padchar}, @var{commachar},
 @var{commawidth}.
 
 Output an integer argument as a decimal, hexadecimal, octal or binary
-integer (respectively).
+integer (respectively), in a locale-independent way.
 
 @example
 (format #t "~d" 123) @print{} 123
@@ -297,7 +297,9 @@ minimum), it's padded on the left with the @var{padchar} parameter
 @end example
 
 @nicode{~:d} adds commas (or the @var{commachar} parameter) every
-three digits (or the @var{commawidth} parameter many).
+three digits (or the @var{commawidth} parameter many).  However, when
+your intent is to write numbers in a way that follows typographical
+conventions, using @nicode{~h} is recommended.
 
 @example
 (format #t "~:d" 1234567)         @print{} 1,234,567
@@ -404,6 +406,29 @@ printed instead of the value.
 (format #t "~5,,,'xf" 12345) @print{} xxxxx
 @end example
 
+@item @nicode{~h}
+Localized number@footnote{The @nicode{~h} format specifier first
+appeared in Guile version 2.0.6.}.  Parameters: @var{width},
+@var{decimals}, @var{padchar}.
+
+Like @nicode{~f}, output an exact or floating point number, but do so
+according to the current locale, or according to the given locale object
+when the @code{:} modifier is used (@pxref{Number Input and Output,
+@code{number->locale-string}}).
+
+@example
+(format #t "~h" 12345.5678)  ; with "C" as the current locale
+@print{} 12345.5678
+
+(format #t "~14,,'*:h" 12345.5678
+        (make-locale LC_ALL "en_US"))
+@print{} ***12,345.5678
+
+(format #t "~,2:h" 12345.5678
+        (make-locale LC_NUMERIC "fr_FR"))
+@print{} 12 345,56
+@end example
+
 @item @nicode{~e}
 Exponential float.  Parameters: @var{width}, @var{mantdigits},
 @var{expdigits}, @var{intdigits}, @var{overflowchar}, @var{padchar},
diff --git a/module/ice-9/format.scm b/module/ice-9/format.scm
index c62348d9f..d038ace5a 100644
--- 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 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")
@@ -272,6 +273,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))
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index 24ad8354c..a411b49e7 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -1,7 +1,7 @@
 ;;;; format.test --- test suite for Guile's CL-ish format  -*- scheme -*-
 ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001
 ;;;;
-;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012 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
@@ -19,6 +19,7 @@
 
 (define-module (test-format)
   #:use-module (test-suite lib)
+  #:use-module (ice-9 i18n)
   #:use-module (ice-9 format))
 
 
@@ -97,6 +98,31 @@
     (string=? "2.5" (format #f "~f" "02.5"))))
 
 ;;;
+;;; ~h
+;;;
+
+(setlocale LC_ALL "C")
+(with-test-prefix "~h localized number"
+
+  (pass-if "1234.5"
+    (string=? (format #f "~h" 1234.5) "1234.5"))
+
+  (pass-if "padding"
+    (string=? (format #f "~6h" 123.2) " 123.2"))
+
+  (pass-if "padchar"
+    (string=? (format #f "~8,,'*h" 123.2) "***123.2"))
+
+  (pass-if "decimals"
+    (string=? (format #f "~,2h" 123.4567)
+              "123.45"))
+
+  (pass-if "locale"
+    (string=? (format #f "~,3:h, ~a" 1234.5678
+                      %global-locale "approximately")
+              "1234.567, approximately")))
+
+;;;
 ;;; ~{
 ;;;
 
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index f7824d39b..335f45017 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -18,9 +18,10 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-suite i18n)
-  :use-module (ice-9 i18n)
-  :use-module (srfi srfi-1)
-  :use-module (test-suite lib))
+  #:use-module (ice-9 i18n)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (test-suite lib))
 
 ;; Start from a pristine locale state.
 (setlocale LC_ALL "C")
@@ -94,6 +95,9 @@
 (define %greek-utf8-locale-name
   "el_GR.UTF-8")
 
+(define %american-english-locale-name
+  "en_US")
+
 (define %french-locale
   (false-if-exception
    (make-locale (list LC_CTYPE LC_COLLATE LC_NUMERIC LC_TIME)
@@ -119,6 +123,11 @@
    (make-locale LC_ALL
                 %turkish-utf8-locale-name)))
 
+(define %american-english-locale
+  (false-if-exception
+   (make-locale LC_ALL
+                %american-english-locale-name)))
+
 (define (under-locale-or-unresolved locale thunk)
   ;; On non-GNU systems, an exception may be raised only when the locale is
   ;; actually used rather than at `make-locale'-time.  Thus, we must guard
@@ -153,6 +162,10 @@
 (define (under-greek-utf8-locale-or-unresolved thunk)
   (under-locale-or-unresolved %greek-utf8-locale thunk))
 
+(define (under-american-english-locale-or-unresolved thunk)
+  (under-locale-or-unresolved %american-english-locale thunk))
+
+
 (with-test-prefix "text collation (French)"
 
   (pass-if "string-locale<?"
@@ -480,6 +493,25 @@
            (string=? "1 234,5"
                      (number->locale-string 1234.567 1 fr))))))))
 
+(with-test-prefix "format ~h"
+
+  (with-test-prefix "French"
+
+    (pass-if "12345.5678"
+      (under-french-locale-or-unresolved
+       (lambda ()
+         (string=? "12 345,6789"
+                   (format #f "~:h" 12345.6789 %french-locale))))))
+
+  (with-test-prefix "English"
+
+    (pass-if "12345.5678"
+      (under-american-english-locale-or-unresolved
+       (lambda ()
+         (string=? "12,345.6789"
+                   (format #f "~:h" 12345.6789
+                           %american-english-locale)))))))
+
 (with-test-prefix "monetary-amount->locale-string"
 
   (with-test-prefix "French"