Commit | Line | Data |
---|---|---|
bce5cb56 | 1 | ;;;; i18n.scm --- internationalization support -*- coding: utf-8 -*- |
5b3a39c7 | 2 | |
a0919aef | 3 | ;;;; Copyright (C) 2006, 2007, 2009, 2010, 2012 Free Software Foundation, Inc. |
5b3a39c7 LC |
4 | ;;;; |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
756e8a3a | 9 | ;;;; |
5b3a39c7 LC |
10 | ;;;; This library is distributed in the hope that it will be useful, |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
756e8a3a | 14 | ;;;; |
5b3a39c7 LC |
15 | ;;;; You should have received a copy of the GNU Lesser General Public |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
bce5cb56 | 19 | ;;; Author: Ludovic Courtès <ludo@gnu.org> |
5b3a39c7 LC |
20 | |
21 | ;;; Commentary: | |
22 | ;;; | |
23 | ;;; This module provides a number of routines that support | |
24 | ;;; internationalization (e.g., locale-dependent text collation, character | |
25 | ;;; mapping, etc.). It also defines `locale' objects, representing locale | |
26 | ;;; settings, that may be passed around to most of these procedures. | |
27 | ;;; | |
28 | ||
29 | ;;; Code: | |
30 | ||
31 | (define-module (ice-9 i18n) | |
a2f00b9b | 32 | :use-module (ice-9 optargs) |
5b3a39c7 LC |
33 | :export (;; `locale' type |
34 | make-locale locale? | |
a2f00b9b | 35 | %global-locale |
5b3a39c7 LC |
36 | |
37 | ;; text collation | |
38 | string-locale<? string-locale>? | |
39 | string-locale-ci<? string-locale-ci>? string-locale-ci=? | |
40 | ||
41 | char-locale<? char-locale>? | |
42 | char-locale-ci<? char-locale-ci>? char-locale-ci=? | |
43 | ||
44 | ;; character mapping | |
820f33aa JG |
45 | char-locale-downcase char-locale-upcase char-locale-titlecase |
46 | string-locale-downcase string-locale-upcase string-locale-titlecase | |
5b3a39c7 LC |
47 | |
48 | ;; reading numbers | |
a2f00b9b LC |
49 | locale-string->integer locale-string->inexact |
50 | ||
51 | ;; charset/encoding | |
52 | locale-encoding | |
53 | ||
54 | ;; days and months | |
55 | locale-day-short locale-day locale-month-short locale-month | |
56 | ||
57 | ;; date and time | |
58 | locale-am-string locale-pm-string | |
59 | locale-date+time-format locale-date-format locale-time-format | |
60 | locale-time+am/pm-format | |
61 | locale-era locale-era-year | |
62 | locale-era-date-format locale-era-date+time-format | |
63 | locale-era-time-format | |
64 | ||
65 | ;; monetary | |
66 | locale-currency-symbol | |
67 | locale-monetary-decimal-point locale-monetary-thousands-separator | |
68 | locale-monetary-grouping locale-monetary-fractional-digits | |
69 | locale-currency-symbol-precedes-positive? | |
70 | locale-currency-symbol-precedes-negative? | |
71 | locale-positive-separated-by-space? | |
72 | locale-negative-separated-by-space? | |
73 | locale-monetary-positive-sign locale-monetary-negative-sign | |
74 | locale-positive-sign-position locale-negative-sign-position | |
75 | monetary-amount->locale-string | |
76 | ||
77 | ;; number formatting | |
78 | locale-digit-grouping locale-decimal-point | |
79 | locale-thousands-separator | |
80 | number->locale-string | |
81 | ||
82 | ;; miscellaneous | |
83 | locale-yes-regexp locale-no-regexp)) | |
5b3a39c7 LC |
84 | |
85 | ||
f6ddf827 | 86 | (eval-when (expand load eval) |
44602b08 AW |
87 | (load-extension (string-append "libguile-" (effective-version)) |
88 | "scm_init_i18n")) | |
5b3a39c7 | 89 | |
a2f00b9b LC |
90 | \f |
91 | ;;; | |
92 | ;;; Charset/encoding. | |
93 | ;;; | |
94 | ||
95 | (define (locale-encoding . locale) | |
96 | (apply nl-langinfo CODESET locale)) | |
97 | ||
98 | \f | |
99 | ;;; | |
100 | ;;; Months and days. | |
101 | ;;; | |
102 | ||
103 | ;; Helper macro: Define a procedure named NAME that maps its argument to | |
e7f7691f | 104 | ;; NL-ITEMS. Gnulib guarantees that these items are available. |
a0919aef | 105 | (define-macro (define-vector-langinfo-mapping name nl-items) |
a2f00b9b | 106 | (let* ((item-count (length nl-items)) |
a0919aef | 107 | (defines `(define %nl-items (vector #f ,@nl-items))) |
a2f00b9b LC |
108 | (make-body (lambda (result) |
109 | `(if (and (integer? item) (exact? item)) | |
110 | (if (and (>= item 1) (<= item ,item-count)) | |
111 | ,result | |
112 | (throw 'out-of-range "out of range" item)) | |
113 | (throw 'wrong-type-arg "wrong argument type" item))))) | |
114 | `(define (,name item . locale) | |
115 | ,defines | |
a0919aef | 116 | ,(make-body '(apply nl-langinfo (vector-ref %nl-items item) locale))))) |
a2f00b9b LC |
117 | |
118 | ||
119 | (define-vector-langinfo-mapping locale-day-short | |
a0919aef | 120 | (ABDAY_1 ABDAY_2 ABDAY_3 ABDAY_4 ABDAY_5 ABDAY_6 ABDAY_7)) |
a2f00b9b LC |
121 | |
122 | (define-vector-langinfo-mapping locale-day | |
a0919aef | 123 | (DAY_1 DAY_2 DAY_3 DAY_4 DAY_5 DAY_6 DAY_7)) |
a2f00b9b LC |
124 | |
125 | (define-vector-langinfo-mapping locale-month-short | |
126 | (ABMON_1 ABMON_2 ABMON_3 ABMON_4 ABMON_5 ABMON_6 | |
a0919aef | 127 | ABMON_7 ABMON_8 ABMON_9 ABMON_10 ABMON_11 ABMON_12)) |
a2f00b9b LC |
128 | |
129 | (define-vector-langinfo-mapping locale-month | |
a0919aef | 130 | (MON_1 MON_2 MON_3 MON_4 MON_5 MON_6 MON_7 MON_8 MON_9 MON_10 MON_11 MON_12)) |
a2f00b9b LC |
131 | |
132 | ||
133 | \f | |
134 | ;;; | |
135 | ;;; Date and time. | |
136 | ;;; | |
137 | ||
a0919aef | 138 | ;; Define a procedure NAME that gets langinfo item ITEM. Gnulib's |
e7f7691f LC |
139 | ;; `nl_langinfo' does not guarantee that all these items are supported |
140 | ;; (for instance, `GROUPING' is lacking on Darwin and Gnulib provides no | |
141 | ;; replacement), so use DEFAULT as the default value when ITEM is not | |
142 | ;; available. | |
143 | (define-macro (define-simple-langinfo-mapping name item default) | |
144 | (let ((body (if (defined? item) | |
145 | `(apply nl-langinfo ,item locale) | |
146 | default))) | |
147 | `(define (,name . locale) | |
148 | ,body))) | |
a2f00b9b LC |
149 | |
150 | (define-simple-langinfo-mapping locale-am-string | |
e7f7691f | 151 | AM_STR "AM") |
a2f00b9b | 152 | (define-simple-langinfo-mapping locale-pm-string |
e7f7691f | 153 | PM_STR "PM") |
a2f00b9b | 154 | (define-simple-langinfo-mapping locale-date+time-format |
e7f7691f | 155 | D_T_FMT "%a %b %e %H:%M:%S %Y") |
a2f00b9b | 156 | (define-simple-langinfo-mapping locale-date-format |
e7f7691f | 157 | D_FMT "%m/%d/%y") |
a2f00b9b | 158 | (define-simple-langinfo-mapping locale-time-format |
e7f7691f | 159 | T_FMT "%H:%M:%S") |
a2f00b9b | 160 | (define-simple-langinfo-mapping locale-time+am/pm-format |
e7f7691f | 161 | T_FMT_AMPM "%I:%M:%S %p") |
a2f00b9b | 162 | (define-simple-langinfo-mapping locale-era |
e7f7691f | 163 | ERA "") |
a2f00b9b | 164 | (define-simple-langinfo-mapping locale-era-year |
e7f7691f | 165 | ERA_YEAR "") |
a2f00b9b | 166 | (define-simple-langinfo-mapping locale-era-date+time-format |
e7f7691f | 167 | ERA_D_T_FMT "") |
a2f00b9b | 168 | (define-simple-langinfo-mapping locale-era-date-format |
e7f7691f | 169 | ERA_D_FMT "") |
a2f00b9b | 170 | (define-simple-langinfo-mapping locale-era-time-format |
e7f7691f | 171 | ERA_T_FMT "") |
a2f00b9b LC |
172 | |
173 | ||
174 | \f | |
175 | ;;; | |
176 | ;;; Monetary information. | |
177 | ;;; | |
178 | ||
a0919aef LC |
179 | ;; Define a procedure NAME that gets item LOCAL-ITEM or INTL-ITEM, |
180 | ;; depending on whether the caller asked for the international version | |
181 | ;; or not. Since Gnulib's `nl_langinfo' module doesn't guarantee that | |
182 | ;; all these items are available, use DEFAULT/LOCAL and DEFAULT/INTL as | |
183 | ;; default values when the system does not support them. | |
a2f00b9b LC |
184 | (define-macro (define-monetary-langinfo-mapping name local-item intl-item |
185 | default/local default/intl) | |
186 | (let ((body | |
a0919aef | 187 | (let ((intl (if (defined? intl-item) |
a2f00b9b LC |
188 | `(apply nl-langinfo ,intl-item locale) |
189 | default/intl)) | |
a0919aef | 190 | (local (if (defined? local-item) |
a2f00b9b LC |
191 | `(apply nl-langinfo ,local-item locale) |
192 | default/local))) | |
193 | `(if intl? ,intl ,local)))) | |
194 | ||
195 | `(define (,name intl? . locale) | |
196 | ,body))) | |
197 | ||
198 | ;; FIXME: How can we use ALT_DIGITS? | |
199 | (define-monetary-langinfo-mapping locale-currency-symbol | |
200 | CRNCYSTR INT_CURR_SYMBOL | |
201 | "-" "") | |
202 | (define-monetary-langinfo-mapping locale-monetary-fractional-digits | |
203 | FRAC_DIGITS INT_FRAC_DIGITS | |
204 | 2 2) | |
205 | ||
206 | (define-simple-langinfo-mapping locale-monetary-positive-sign | |
e7f7691f | 207 | POSITIVE_SIGN "+") |
a2f00b9b | 208 | (define-simple-langinfo-mapping locale-monetary-negative-sign |
e7f7691f | 209 | NEGATIVE_SIGN "-") |
a2f00b9b | 210 | (define-simple-langinfo-mapping locale-monetary-decimal-point |
e7f7691f | 211 | MON_DECIMAL_POINT "") |
a2f00b9b | 212 | (define-simple-langinfo-mapping locale-monetary-thousands-separator |
e7f7691f | 213 | MON_THOUSANDS_SEP "") |
a2f00b9b | 214 | (define-simple-langinfo-mapping locale-monetary-digit-grouping |
e7f7691f | 215 | MON_GROUPING '()) |
a2f00b9b LC |
216 | |
217 | (define-monetary-langinfo-mapping locale-currency-symbol-precedes-positive? | |
218 | P_CS_PRECEDES INT_P_CS_PRECEDES | |
219 | #t #t) | |
220 | (define-monetary-langinfo-mapping locale-currency-symbol-precedes-negative? | |
221 | N_CS_PRECEDES INT_N_CS_PRECEDES | |
222 | #t #t) | |
223 | ||
224 | ||
225 | (define-monetary-langinfo-mapping locale-positive-separated-by-space? | |
226 | ;; Whether a space should be inserted between a positive amount and the | |
227 | ;; currency symbol. | |
228 | P_SEP_BY_SPACE INT_P_SEP_BY_SPACE | |
229 | #t #t) | |
230 | (define-monetary-langinfo-mapping locale-negative-separated-by-space? | |
231 | ;; Whether a space should be inserted between a negative amount and the | |
232 | ;; currency symbol. | |
233 | N_SEP_BY_SPACE INT_N_SEP_BY_SPACE | |
234 | #t #t) | |
235 | ||
236 | (define-monetary-langinfo-mapping locale-positive-sign-position | |
237 | ;; Position of the positive sign wrt. currency symbol and quantity in a | |
238 | ;; monetary amount. | |
239 | P_SIGN_POSN INT_P_SIGN_POSN | |
240 | 'unspecified 'unspecified) | |
241 | (define-monetary-langinfo-mapping locale-negative-sign-position | |
242 | ;; Position of the negative sign wrt. currency symbol and quantity in a | |
243 | ;; monetary amount. | |
244 | N_SIGN_POSN INT_N_SIGN_POSN | |
245 | 'unspecified 'unspecified) | |
246 | ||
247 | ||
248 | (define (%number-integer-part int grouping separator) | |
249 | ;; Process INT (a string denoting a number's integer part) and return a new | |
250 | ;; string with digit grouping and separators according to GROUPING (a list, | |
251 | ;; potentially circular) and SEPARATOR (a string). | |
252 | ||
253 | ;; Process INT from right to left. | |
254 | (let loop ((int int) | |
255 | (grouping grouping) | |
256 | (result '())) | |
257 | (cond ((string=? int "") (apply string-append result)) | |
258 | ((null? grouping) (apply string-append int result)) | |
259 | (else | |
260 | (let* ((len (string-length int)) | |
261 | (cut (min (car grouping) len))) | |
262 | (loop (substring int 0 (- len cut)) | |
263 | (cdr grouping) | |
264 | (let ((sub (substring int (- len cut) len))) | |
265 | (if (> len cut) | |
266 | (cons* separator sub result) | |
267 | (cons sub result))))))))) | |
268 | ||
269 | (define (add-monetary-sign+currency amount figure intl? locale) | |
270 | ;; Add a sign and currency symbol around FIGURE. FIGURE should be a | |
271 | ;; formatted unsigned amount (a string) representing AMOUNT. | |
272 | (let* ((positive? (> amount 0)) | |
273 | (sign | |
274 | (cond ((> amount 0) (locale-monetary-positive-sign locale)) | |
275 | ((< amount 0) (locale-monetary-negative-sign locale)) | |
276 | (else ""))) | |
277 | (currency (locale-currency-symbol intl? locale)) | |
278 | (currency-precedes? | |
279 | (if positive? | |
280 | locale-currency-symbol-precedes-positive? | |
281 | locale-currency-symbol-precedes-negative?)) | |
282 | (separated? | |
283 | (if positive? | |
284 | locale-positive-separated-by-space? | |
285 | locale-negative-separated-by-space?)) | |
286 | (sign-position | |
287 | (if positive? | |
288 | locale-positive-sign-position | |
289 | locale-negative-sign-position)) | |
290 | (currency-space | |
291 | (if (separated? intl? locale) " " "")) | |
292 | (append-currency | |
293 | (lambda (amt) | |
294 | (if (currency-precedes? intl? locale) | |
295 | (string-append currency currency-space amt) | |
296 | (string-append amt currency-space currency))))) | |
297 | ||
298 | (case (sign-position intl? locale) | |
299 | ((parenthesize) | |
300 | (string-append "(" (append-currency figure) ")")) | |
301 | ((sign-before) | |
302 | (string-append sign (append-currency figure))) | |
303 | ((sign-after unspecified) | |
304 | ;; following glibc's recommendation for `unspecified'. | |
305 | (if (currency-precedes? intl? locale) | |
306 | (string-append currency currency-space sign figure) | |
307 | (string-append figure currency-space currency sign))) | |
308 | ((sign-before-currency-symbol) | |
309 | (if (currency-precedes? intl? locale) | |
310 | (string-append sign currency currency-space figure) | |
311 | (string-append figure currency-space sign currency))) ;; unlikely | |
312 | ((sign-after-currency-symbol) | |
313 | (if (currency-precedes? intl? locale) | |
314 | (string-append currency sign currency-space figure) | |
315 | (string-append figure currency-space currency sign))) | |
316 | (else | |
317 | (error "unsupported sign position" (sign-position intl? locale)))))) | |
318 | ||
319 | ||
320 | (define* (monetary-amount->locale-string amount intl? | |
321 | #:optional (locale %global-locale)) | |
322 | "Convert @var{amount} (an inexact) into a string according to the cultural | |
323 | conventions of either @var{locale} (a locale object) or the current locale. | |
324 | If @var{intl?} is true, then the international monetary format for the given | |
325 | locale is used." | |
326 | ||
327 | (let* ((fraction-digits | |
328 | (or (locale-monetary-fractional-digits intl? locale) 2)) | |
329 | (decimal-part | |
330 | (lambda (dec) | |
331 | (if (or (string=? dec "") (eq? 0 fraction-digits)) | |
332 | "" | |
333 | (string-append (locale-monetary-decimal-point locale) | |
334 | (if (< fraction-digits (string-length dec)) | |
335 | (substring dec 0 fraction-digits) | |
336 | dec))))) | |
337 | ||
338 | (external-repr (number->string (if (> amount 0) amount (- amount)))) | |
339 | (int+dec (string-split external-repr #\.)) | |
340 | (int (car int+dec)) | |
341 | (dec (decimal-part (if (null? (cdr int+dec)) | |
342 | "" | |
343 | (cadr int+dec)))) | |
344 | (grouping (locale-monetary-digit-grouping locale)) | |
345 | (separator (locale-monetary-thousands-separator locale))) | |
346 | ||
347 | (add-monetary-sign+currency amount | |
348 | (string-append | |
349 | (%number-integer-part int grouping | |
350 | separator) | |
351 | dec) | |
352 | intl? locale))) | |
353 | ||
354 | ||
355 | \f | |
356 | ;;; | |
357 | ;;; Number formatting. | |
358 | ;;; | |
359 | ||
360 | (define-simple-langinfo-mapping locale-digit-grouping | |
e7f7691f | 361 | GROUPING '()) |
a2f00b9b | 362 | (define-simple-langinfo-mapping locale-decimal-point |
e7f7691f | 363 | RADIXCHAR ".") |
a2f00b9b | 364 | (define-simple-langinfo-mapping locale-thousands-separator |
e7f7691f | 365 | THOUSEP "") |
a2f00b9b LC |
366 | |
367 | (define* (number->locale-string number | |
368 | #:optional (fraction-digits #t) | |
369 | (locale %global-locale)) | |
370 | "Convert @var{number} (an inexact) into a string according to the cultural | |
371 | conventions of either @var{locale} (a locale object) or the current locale. | |
372 | Optionally, @var{fraction-digits} may be bound to an integer specifying the | |
373 | number of fractional digits to be displayed." | |
374 | ||
375 | (let* ((sign | |
376 | (cond ((> number 0) "") | |
377 | ((< number 0) "-") | |
378 | (else ""))) | |
379 | (decimal-part | |
380 | (lambda (dec) | |
381 | (if (or (string=? dec "") (eq? 0 fraction-digits)) | |
382 | "" | |
383 | (string-append (locale-decimal-point locale) | |
384 | (if (and (integer? fraction-digits) | |
385 | (< fraction-digits | |
386 | (string-length dec))) | |
387 | (substring dec 0 fraction-digits) | |
388 | dec)))))) | |
389 | ||
390 | (let* ((external-repr (number->string (if (> number 0) | |
391 | number | |
392 | (- number)))) | |
393 | (int+dec (string-split external-repr #\.)) | |
394 | (int (car int+dec)) | |
395 | (dec (decimal-part (if (null? (cdr int+dec)) | |
396 | "" | |
397 | (cadr int+dec)))) | |
398 | (grouping (locale-digit-grouping locale)) | |
399 | (separator (locale-thousands-separator locale))) | |
400 | ||
401 | (string-append sign | |
402 | (%number-integer-part int grouping separator) | |
403 | dec)))) | |
404 | ||
405 | \f | |
406 | ;;; | |
407 | ;;; Miscellaneous. | |
408 | ;;; | |
409 | ||
410 | (define-simple-langinfo-mapping locale-yes-regexp | |
e7f7691f | 411 | YESEXPR "^[yY]") |
a2f00b9b | 412 | (define-simple-langinfo-mapping locale-no-regexp |
e7f7691f | 413 | NOEXPR "^[nN]") |
a2f00b9b LC |
414 | |
415 | ;; `YESSTR' and `NOSTR' are considered deprecated so we don't provide them. | |
416 | ||
5b3a39c7 | 417 | ;;; i18n.scm ends here |