i18n: Use Gnulib's `nl_langinfo' module.
[bpt/guile.git] / module / ice-9 / i18n.scm
index 2a8e741..c574a7e 100644 (file)
@@ -1,11 +1,11 @@
-;;;; i18n.scm --- internationalization support
+;;;; i18n.scm --- internationalization support    -*- coding: utf-8 -*-
 
-;;;;   Copyright (C) 2006, 2007 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2006, 2007, 2009, 2010, 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
 ;;;; License as published by the Free Software Foundation; either
-;;;; version 2.1 of the License, or (at your option) any later version.
+;;;; version 3 of the License, or (at your option) any later version.
 ;;;;
 ;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,7 +16,7 @@
 ;;;; License along with this library; if not, write to the Free Software
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
-;;; Author: Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Author: Ludovic Courtès <ludo@gnu.org>
 
 ;;; Commentary:
 ;;;
@@ -42,8 +42,8 @@
            char-locale-ci<? char-locale-ci>? char-locale-ci=?
 
            ;; character mapping
-           char-locale-downcase char-locale-upcase
-           string-locale-downcase string-locale-upcase
+           char-locale-downcase char-locale-upcase char-locale-titlecase
+           string-locale-downcase string-locale-upcase string-locale-titlecase
 
            ;; reading numbers
            locale-string->integer locale-string->inexact
@@ -83,9 +83,9 @@
            locale-yes-regexp locale-no-regexp))
 
 
-(eval-case
((load-toplevel compile-toplevel)
-  (load-extension "libguile-i18n-v-0" "scm_init_i18n")))
+(eval-when (eval load compile)
 (load-extension (string-append "libguile-" (effective-version))
+                  "scm_init_i18n"))
 
 \f
 ;;;
 ;;;
 
 ;; Helper macro: Define a procedure named NAME that maps its argument to
-;; NL-ITEMS (when `nl-langinfo' is provided) or DEFAULTS (when `nl-langinfo'
-;; is not provided).
-(define-macro (define-vector-langinfo-mapping name nl-items defaults)
+;; NL-ITEMS (when `nl-langinfo' is provided).
+(define-macro (define-vector-langinfo-mapping name nl-items)
   (let* ((item-count (length nl-items))
-         (defines    (if (provided? 'nl-langinfo)
-                         `(define %nl-items (vector #f ,@nl-items))
-                         `(define %defaults (vector #f ,@defaults))))
+         (defines   `(define %nl-items (vector #f ,@nl-items)))
          (make-body (lambda (result)
                       `(if (and (integer? item) (exact? item))
                            (if (and (>= item 1) (<= item ,item-count))
                            (throw 'wrong-type-arg "wrong argument type" item)))))
     `(define (,name item . locale)
        ,defines
-       ,(make-body (if (provided? 'nl-langinfo)
-                       '(apply nl-langinfo (vector-ref %nl-items item) locale)
-                       '(vector-ref %defaults item))))))
+       ,(make-body '(apply nl-langinfo (vector-ref %nl-items item) locale)))))
 
 
 (define-vector-langinfo-mapping locale-day-short
-  (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7)
-  ("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"))
+  (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7))
 
 (define-vector-langinfo-mapping locale-day
-  (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7)
-  ("Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"))
+  (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7))
 
 (define-vector-langinfo-mapping locale-month-short
   (ABMON_1 ABMON_2 ABMON_3 ABMON_4 ABMON_5 ABMON_6
-   ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12)
-  ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
+   ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12))
 
 (define-vector-langinfo-mapping locale-month
-  (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12)
-  ("January" "February" "March" "April" "May" "June" "July" "August"
-   "September" "October" "November" "December"))
+  (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12))
 
 
 \f
 ;;; Date and time.
 ;;;
 
-;; Helper macro: Define a procedure NAME that gets langinfo item ITEM.
-(define-macro (define-simple-langinfo-mapping name item default)
-  (let ((body (if (and (provided? 'nl-langinfo) (defined? item))
-                  `(apply nl-langinfo ,item locale)
-                  default)))
-    `(define (,name . locale)
-       ,body)))
+;; Define a procedure NAME that gets langinfo item ITEM.  Gnulib's
+;; `nl_langinfo' guarantees that all these items are supported.
+(define-syntax-rule (define-simple-langinfo-mapping name item)
+  (define* (name #:optional (locale %global-locale))
+    (nl-langinfo item locale)))
 
 (define-simple-langinfo-mapping locale-am-string
-  AM_STR "AM")
+  AM_STR)
 (define-simple-langinfo-mapping locale-pm-string
-  PM_STR "PM")
+  PM_STR)
 (define-simple-langinfo-mapping locale-date+time-format
-  D_T_FMT "%a %b %e %H:%M:%S %Y")
+  D_T_FMT)
 (define-simple-langinfo-mapping locale-date-format
-  D_FMT   "%m/%d/%y")
+  D_FMT)
 (define-simple-langinfo-mapping locale-time-format
-  T_FMT   "%H:%M:%S")
+  T_FMT)
 (define-simple-langinfo-mapping locale-time+am/pm-format
-  T_FMT_AMPM "%I:%M:%S %p")
+  T_FMT_AMPM)
 (define-simple-langinfo-mapping locale-era
-  ERA        "")
+  ERA)
 (define-simple-langinfo-mapping locale-era-year
-  ERA_YEAR   "")
+  ERA_YEAR)
 (define-simple-langinfo-mapping locale-era-date+time-format
-  ERA_D_T_FMT "")
+  ERA_D_T_FMT)
 (define-simple-langinfo-mapping locale-era-date-format
-  ERA_D_FMT   "")
+  ERA_D_FMT)
 (define-simple-langinfo-mapping locale-era-time-format
-  ERA_T_FMT   "")
+  ERA_T_FMT)
 
 
 \f
 ;;; Monetary information.
 ;;;
 
+;; Define a procedure NAME that gets item LOCAL-ITEM or INTL-ITEM,
+;; depending on whether the caller asked for the international version
+;; or not.  Since Gnulib's `nl_langinfo' module doesn't guarantee that
+;; all these items are available, use DEFAULT/LOCAL and DEFAULT/INTL as
+;; default values when the system does not support them.
 (define-macro (define-monetary-langinfo-mapping name local-item intl-item
                                                 default/local default/intl)
   (let ((body
-         (let ((intl  (if (and (provided? 'nl-langinfo) (defined? intl-item))
+         (let ((intl  (if (defined? intl-item)
                           `(apply nl-langinfo ,intl-item locale)
                           default/intl))
-               (local (if (and (provided? 'nl-langinfo) (defined? local-item))
+               (local (if (defined? local-item)
                           `(apply nl-langinfo ,local-item locale)
                           default/local)))
            `(if intl? ,intl ,local))))
   2                  2)
 
 (define-simple-langinfo-mapping locale-monetary-positive-sign
-  POSITIVE_SIGN        "+")
+  POSITIVE_SIGN)
 (define-simple-langinfo-mapping locale-monetary-negative-sign
-  NEGATIVE_SIGN        "-")
+  NEGATIVE_SIGN)
 (define-simple-langinfo-mapping locale-monetary-decimal-point
-  MON_DECIMAL_POINT    "")
+  MON_DECIMAL_POINT)
 (define-simple-langinfo-mapping locale-monetary-thousands-separator
-  MON_THOUSANDS_SEP    "")
+  MON_THOUSANDS_SEP)
 (define-simple-langinfo-mapping locale-monetary-digit-grouping
-  MON_GROUPING         '())
+  MON_GROUPING)
 
 (define-monetary-langinfo-mapping locale-currency-symbol-precedes-positive?
   P_CS_PRECEDES       INT_P_CS_PRECEDES
@@ -359,11 +352,11 @@ locale is used."
 ;;;
 
 (define-simple-langinfo-mapping locale-digit-grouping
-  GROUPING             '())
+  GROUPING)
 (define-simple-langinfo-mapping locale-decimal-point
-  RADIXCHAR            ".")
+  RADIXCHAR)
 (define-simple-langinfo-mapping locale-thousands-separator
-  THOUSEP              "")
+  THOUSEP)
 
 (define* (number->locale-string number
                                 #:optional (fraction-digits #t)
@@ -409,15 +402,10 @@ number of fractional digits to be displayed."
 ;;;
 
 (define-simple-langinfo-mapping locale-yes-regexp
-  YESEXPR              "^[yY]")
+  YESEXPR)
 (define-simple-langinfo-mapping locale-no-regexp
-  NOEXPR               "^[nN]")
+  NOEXPR)
 
 ;; `YESSTR' and `NOSTR' are considered deprecated so we don't provide them.
 
-
-;;; Local Variables:
-;;; coding: latin-1
-;;; End:
-
 ;;; i18n.scm ends here