[cl-l10n-cvs] CVS cl-l10n
sross
sross at common-lisp.net
Thu Apr 27 18:30:31 UTC 2006
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory clnet:/tmp/cvs-serv9196
Modified Files:
utils.lisp tests.lisp printers.lisp parse-time.lisp
parse-number.lisp package.lisp locale.lisp load-locale.lisp
i18n.lisp cl-l10n.asd ChangeLog
Added Files:
TODO
Log Message:
* parse-number.lisp: Changed parse-error to extend parser-error
* parse-time.lisp: Changed uses of eq to eql when using numbers
or characters.
* printers.lisp: Default length fraction digits to 0 if it can't
be found in the current locale. Fixed printers of %R time format directive.
* load-locale.lisp: Search environment variable LANG before trying using
POSIX locale when loading default locale.
Add shadowing-format which shadows format and formatter into the current package.
* package.lisp: Export load-default-locale
* doc/cl-l10n.texi: Rename the Index node to Comprehensive Index in
order to avoid a name clash with index.html on platforms with
case-insensitive filesystems. Prettify the copyright notice.
* doc/Makefile, doc/style.css, doc/gendocs.sh, doc/gendocs_template, doc/style.css:
New files.
* load-locale.lisp (load-locale): Specify an explicit
external-format for CLISP
* test.lisp: Fix indentation of deftest forms.
(time.2): Obtain the o-with-diaeresis in a slightly more portable way.
--- /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2005/05/18 15:34:08 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/04/27 18:30:30 1.8
@@ -182,4 +182,105 @@
(scale (* f 2) (* (expt float-radix (- e)) 2) 1 1)
(scale (* f float-radix 2)
(* (expt float-radix (- 1 e)) 2) float-radix 1))))))))
-;; EOF
\ No newline at end of file
+
+#+(or)
+(defun flonum-to-digits (v &optional position relativep)
+ (let ((print-base 10) ; B
+ (float-radix 2) ; b
+ (float-digits (float-digits v)) ; p
+ (digit-characters "0123456789")
+ (min-e
+ (etypecase v
+ (single-float single-float-min-e)
+ (double-float double-float-min-e))))
+ (multiple-value-bind (f e)
+ (integer-decode-float v)
+ (let (;; FIXME: these even tests assume normal IEEE rounding
+ ;; mode. I wonder if we should cater for non-normal?
+ (high-ok (evenp f))
+ (low-ok (evenp f))
+ (result (make-array 50 :element-type 'base-char
+ :fill-pointer 0 :adjustable t)))
+ (labels ((scale (r s m+ m-)
+ (do ((k 0 (1+ k))
+ (s s (* s print-base)))
+ ((not (or (> (+ r m+) s)
+ (and high-ok (= (+ r m+) s))))
+ (do ((k k (1- k))
+ (r r (* r print-base))
+ (m+ m+ (* m+ print-base))
+ (m- m- (* m- print-base)))
+ ((not (or (< (* (+ r m+) print-base) s)
+ (and (not high-ok)
+ (= (* (+ r m+) print-base) s))))
+ (values k (generate r s m+ m-)))))))
+ (generate (r s m+ m-)
+ (let (d tc1 tc2)
+ (tagbody
+ loop
+ (setf (values d r) (truncate (* r print-base) s))
+ (setf m+ (* m+ print-base))
+ (setf m- (* m- print-base))
+ (setf tc1 (or (< r m-) (and low-ok (= r m-))))
+ (setf tc2 (or (> (+ r m+) s)
+ (and high-ok (= (+ r m+) s))))
+ (when (or tc1 tc2)
+ (go end))
+ (vector-push-extend (char digit-characters d) result)
+ (go loop)
+ end
+ (let ((d (cond
+ ((and (not tc1) tc2) (1+ d))
+ ((and tc1 (not tc2)) d)
+ (t ; (and tc1 tc2)
+ (if (< (* r 2) s) d (1+ d))))))
+ (vector-push-extend (char digit-characters d) result)
+ (return-from generate result)))))
+ (initialize ()
+ (let (r s m+ m-)
+ (if (>= e 0)
+ (let* ((be (expt float-radix e))
+ (be1 (* be float-radix)))
+ (if (/= f (expt float-radix (1- float-digits)))
+ (setf r (* f be 2)
+ s 2
+ m+ be
+ m- be)
+ (setf r (* f be1 2)
+ s (* float-radix 2)
+ m+ be1
+ m- be)))
+ (if (or (= e min-e)
+ (/= f (expt float-radix (1- float-digits))))
+ (setf r (* f 2)
+ s (* (expt float-radix (- e)) 2)
+ m+ 1
+ m- 1)
+ (setf r (* f float-radix 2)
+ s (* (expt float-radix (- 1 e)) 2)
+ m+ float-radix
+ m- 1)))
+ (when position
+ (when relativep
+ (assert (> position 0))
+ (do ((k 0 (1+ k))
+ ;; running out of letters here
+ (l 1 (* l print-base)))
+ ((>= (* s l) (+ r m+))
+ ;; k is now \hat{k}
+ (if (< (+ r (* s (/ (expt print-base (- k position)) 2)))
+ (* s (expt print-base k)))
+ (setf position (- k position))
+ (setf position (- k position 1))))))
+ (let ((low (max m- (/ (* s (expt print-base position)) 2)))
+ (high (max m+ (/ (* s (expt print-base position)) 2))))
+ (when (<= m- low)
+ (setf m- low)
+ (setf low-ok t))
+ (when (<= m+ high)
+ (setf m+ high)
+ (setf high-ok t))))
+ (values r s m+ m-))))
+ (multiple-value-bind (r s m+ m-) (initialize)
+ (scale r s m+ m-)))))))
+;; EOF
--- /project/cl-l10n/cvsroot/cl-l10n/tests.lisp 2005/05/18 15:34:08 1.8
+++ /project/cl-l10n/cvsroot/cl-l10n/tests.lisp 2006/04/27 18:30:30 1.9
@@ -1,5 +1,6 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
+
(defpackage :cl-l10n-tests
(:shadowing-import-from :cl-l10n format formatter)
(:use :cl :regression-test :cl-l10n))
@@ -7,97 +8,100 @@
(in-package :cl-l10n-tests)
(rem-all-tests)
-(deftest load-locs
- (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
+
+(deftest load-locs
+ (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
(locale "en_US") (locale "af_ZA") t)
- t)
+ t)
+;;; Format number tests
-;; Format number tests
(deftest number.1
- (format nil "~v:/cl-l10n:format-number/" "en_ZA" 1000)
- "1,000")
+ (format nil "~v:/cl-l10n:format-number/" "en_ZA" 1000)
+ "1,000")
(deftest number.2
- (format nil "~v:@/cl-l10n:format-number/" "en_ZA" 1000)
- "1000")
+ (format nil "~v:@/cl-l10n:format-number/" "en_ZA" 1000)
+ "1000")
(deftest number.3
- (format nil "~v/cl-l10n:format-number/" "en_ZA" 1000)
- "1,000.00")
+ (format nil "~v/cl-l10n:format-number/" "en_ZA" 1000)
+ "1,000.00")
(deftest number.4
- (format nil "~v/cl-l10n:format-number/" "sv_SE" 1000)
- "1 000,00")
+ (format nil "~v/cl-l10n:format-number/" "sv_SE" 1000)
+ "1 000,00")
(deftest number.5
- (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1000)
- "1 000")
+ (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1000)
+ "1 000")
(deftest number.6
- (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2)
- "0,50")
+ (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2)
+ "0,50")
(deftest number.7
- (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0)
- "100.12312")
+ (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0)
+ "100.12312")
+;;; Money tests
-;; Money tests
(deftest money.1
- (format nil "~v:/cl-l10n:format-money/" "en_ZA" 1000)
- "ZAR 1,000.00")
-
+ (format nil "~v:/cl-l10n:format-money/" "en_ZA" 1000)
+ "ZAR 1,000.00")
(deftest money.2
- (format nil "~v@/cl-l10n:format-money/" "en_ZA" 1000)
- "R1000.00")
+ (format nil "~v@/cl-l10n:format-money/" "en_ZA" 1000)
+ "R1000.00")
(deftest money.3
- (format nil "~v:@/cl-l10n:format-money/" "en_ZA" 1000)
- "ZAR 1000.00")
+ (format nil "~v:@/cl-l10n:format-money/" "en_ZA" 1000)
+ "ZAR 1000.00")
(deftest money.4
- (format nil "~v:/cl-l10n:format-money/" "sv_SE" 1000)
- "1 000,00 SEK")
-
+ (format nil "~v:/cl-l10n:format-money/" "sv_SE" 1000)
+ "1 000,00 SEK")
(deftest money.5
- (format nil "~v@/cl-l10n:format-money/" "sv_SE" 1000)
- "1000,00 kr")
+ (format nil "~v@/cl-l10n:format-money/" "sv_SE" 1000)
+ "1000,00 kr")
(deftest money.6
- (format nil "~v:@/cl-l10n:format-money/" "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil "~v:@/cl-l10n:format-money/" "sv_SE" 1000)
+ "1000,00 SEK")
+
+;;; Time tests
-;; Time tests
(deftest time.1
- (format nil "~v,,v:@/cl-l10n:format-time/" "en_ZA" 0 3091103120)
- "Sun 14 Dec 1997 15:45:20 +0000")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "en_ZA" 0 3091103120)
+ "Sun 14 Dec 1997 15:45:20 +0000")
+;;; FIXME
(deftest time.2
- (format nil "~v,,v:@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
- "sön 14 dec 1997 15.45.20")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
+ #.(format nil "s~Cn 14 dec 1997 15.45.20"
+ #+(or sb-unicode clisp) #\LATIN_SMALL_LETTER_O_WITH_DIAERESIS
+ #-(or sb-unicode clisp) (code-char #xF6)))
(deftest time.3
- (format nil "~v,,v/cl-l10n:format-time/" "en_US" 0 3091103120)
- "03:45:20 ")
+ (format nil "~v,,v/cl-l10n:format-time/" "en_US" 0 3091103120)
+ "03:45:20 ")
(deftest time.4
- (format nil "~v:/cl-l10n:format-time/" "en_US" 3091103120)
- "12/14/1997")
+ (format nil "~v:/cl-l10n:format-time/" "en_US" 3091103120)
+ "12/14/1997")
(deftest time.5
- (format nil "~v,,v@/cl-l10n:format-time/" "en_US" 0 3091103120)
- "15:45:20 ")
+ (format nil "~v,,v@/cl-l10n:format-time/" "en_US" 0 3091103120)
+ "15:45:20 ")
(deftest time.6
- (format nil "~v,,v@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
- "15.45.20")
+ (format nil "~v,,v@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
+ "15.45.20")
(defmacro def-time-directive-test (name directive result)
`(deftest ,name (format nil "~v,v,vU" "en_ZA" ,directive 0 3320556360)
- ,result))
+ ,result))
(def-time-directive-test directive.1 "%%" "%")
(def-time-directive-test directive.2 "%a" "Wed")
@@ -132,10 +136,10 @@
(def-time-directive-test directive.31 "%t" " ")
(def-time-directive-test directive.32 "%T" "08:46:00")
(def-time-directive-test directive.33 "%u" "3")
-;(def-time-directive-test directive.34 "%U" "12")
-;(def-time-directive-test directive.35 "%V" "12")
+;;(def-time-directive-test directive.34 "%U" "12")
+;;(def-time-directive-test directive.35 "%V" "12")
(def-time-directive-test directive.36 "%w" "3")
-;(def-time-directive-test directive.37 "%W" "12")
+;;(def-time-directive-test directive.37 "%W" "12")
(def-time-directive-test directive.38 "%x" "23/03/2005")
(def-time-directive-test directive.39 "%X" "08:46:00")
(def-time-directive-test directive.40 "%y" "05")
@@ -143,9 +147,8 @@
(def-time-directive-test directive.42 "%z" "+0000")
(def-time-directive-test directive.43 "%Z" "+0000")
+;;; i18n tests
-
-;; i18n tests
(defvar *my-bundle* (make-instance 'bundle))
(add-resources (*my-bundle* "af_")
@@ -155,108 +158,110 @@
"howareyou" "How are you")
(deftest i18n.1
- (gettext "howareyou" *my-bundle* "en_ZA")
- "How are you")
+ (gettext "howareyou" *my-bundle* "en_ZA")
+ "How are you")
(deftest i18n.2
- (gettext "howareyou" *my-bundle* "af_ZA")
- "Hoe lyk it")
+ (gettext "howareyou" *my-bundle* "af_ZA")
+ "Hoe lyk it")
+
+;;; format
-;; format
(deftest format.1
- (format nil "~v,,v:@U" "en_ZA" -2 3091103120)
- "Sun 14 Dec 1997 17:45:20 +0200")
+ (format nil "~v,,v:@U" "en_ZA" -2 3091103120)
+ "Sun 14 Dec 1997 17:45:20 +0200")
(deftest format.2
- (format nil "~v:n" "en_ZA" 1000)
- "1,000")
+ (format nil "~v:n" "en_ZA" 1000)
+ "1,000")
(deftest format.3
- (format nil "~v:@m" "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil "~v:@m" "sv_SE" 1000)
+ "1000,00 SEK")
+
+;;; formatter
-;; formatter
(deftest formatter.1
- (format nil (formatter "~v,,v:@U") "en_ZA" -2 3091103120)
- "Sun 14 Dec 1997 17:45:20 +0200")
+ (format nil (formatter "~v,,v:@U") "en_ZA" -2 3091103120)
+ "Sun 14 Dec 1997 17:45:20 +0200")
(deftest formatter.2
- (format nil (formatter "~v:n") "en_ZA" 1000)
- "1,000")
+ (format nil (formatter "~v:n") "en_ZA" 1000)
+ "1,000")
(deftest formatter.3
- (format nil (formatter "~v:@m") "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil (formatter "~v:@m") "sv_SE" 1000)
+ "1000,00 SEK")
+;;; parse-number
-;; parse-number
(deftest parse-number.1
- (parse-number (format nil "~vn" "af_ZA" -1001231.5) "af_ZA")
- -1001231.5)
+ (parse-number (format nil "~vn" "af_ZA" -1001231.5) "af_ZA")
+ -1001231.5)
(deftest parse-number.2
- (parse-number (format nil "~v@:n" "en_ZA" -1001231.5) "en_ZA")
- -1001231.5)
+ (parse-number (format nil "~v@:n" "en_ZA" -1001231.5) "en_ZA")
+ -1001231.5)
(deftest parse-number.3
- (parse-number (format nil "~v@:n" "sv_SE" -1001231.5) "sv_SE")
- -1001231.5)
+ (parse-number (format nil "~v@:n" "sv_SE" -1001231.5) "sv_SE")
+ -1001231.5)
+;;; parse-time
-;; parse-time
(deftest parse-time.1
- (let ((*locale* "en_ZA")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_ZA")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.2
- (let ((*locale* "sv_SE")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "sv_SE")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.3
- (let ((*locale* "en_US")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_US")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.4
- (let ((*locale* "en_GB")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_GB")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.5
- (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
- 3258482400)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
+ 3258482400)
(deftest parse-time.6
- (parse-time "05/04/03" :default-zone -2 :locale "en_US")
- 3260988000)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_US")
+ 3260988000)
(deftest parse-time.7
- (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
- 3258482400)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
+ 3258482400)
(deftest parse-time.8
- (let ((*locale* "en_ZA")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "en_ZA")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
(deftest parse-time.9
- (let ((*locale* "en_US")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "en_US")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
(deftest parse-time.10
- (let ((*locale* "sv_SE")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "sv_SE")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
--- /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2005/05/25 09:30:51 1.16
+++ /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/04/27 18:30:30 1.17
@@ -62,9 +62,10 @@
(defun format-money (stream arg use-int-sym no-ts &optional (locale *locale*))
(let* ((locale (locale-des->locale locale))
- (frac-digits (if use-int-sym
- (locale-int-frac-digits locale)
- (locale-frac-digits locale)))
+ (frac-digits (max (if use-int-sym
+ (locale-int-frac-digits locale)
+ (locale-frac-digits locale))
+ 0))
(val-to-print (round-money (abs (coerce arg 'double-float))
frac-digits))
(float-part (float-part val-to-print))
@@ -113,9 +114,8 @@
#',name))))
(defun lookup-formatter (char)
- (aif (gethash char *time-formatters*)
- it
- (locale-error "No format directive for char ~S." char)))
+ (or (gethash char *time-formatters*)
+ (locale-error "No format directive for char ~S." char)))
(defun princ-pad-val (val stream &optional (pad "0") (size 2))
(declare (type stream stream) (optimize speed)
@@ -243,7 +243,7 @@
(print-time-string "%H:%M:%S %p" stream ut locale))
(def-formatter #\R
- (print-time-string "%H:%M" stream ut locale))
+ (print-time-string "%I:%M" stream ut locale))
(defvar *1970-01-01* (encode-universal-time 0 0 0 01 01 1970 0))
@@ -314,11 +314,11 @@
(def-formatter #\Z
(print-time-string "%z" stream ut locale))
-(defvar *time-zone* (nth-value 8 (get-decoded-time)))
+(defvar *time-zone*)
(defun format-time (stream ut show-date show-time &optional (locale *locale*) fmt time-zone)
(let ((locale (locale-des->locale (or locale *locale*)))
- (*time-zone* (or time-zone *time-zone*)))
+ (*time-zone* (or time-zone (nth-value 8 (decode-universal-time ut)))))
(print-time-string (or fmt (get-time-fmt-string locale
show-date show-time))
stream ut locale))
@@ -371,11 +371,14 @@
(string (parse-fmt-string fmt-cntrl)))
args))
-(defvar *scanner* (cl-ppcre:create-scanner "~[@v,:]*[m|u|n|M|U|N]"))
+(defun shadow-format (&optional (package *package*))
+ (shadowing-import '(cl-l10n::format cl-l10n::formatter) package))
+
+(defvar *scanner* (cl-ppcre:create-scanner "~[@V,:]*[M|U|N]"))
(defun needs-parsing (string)
(declare (optimize speed (safety 1) (debug 0)))
- (cl-ppcre:scan *scanner* string))
+ (cl-ppcre:scan *scanner* (string-upcase string)))
(defun parse-fmt-string (string)
(if (needs-parsing string)
--- /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2005/03/31 13:53:42 1.2
+++ /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2006/04/27 18:30:30 1.3
@@ -423,7 +423,7 @@
(do ((string-index start)
(next-negative nil)
(parts-list nil))
- ((eq string-index end) (nreverse parts-list))
+ ((eql string-index end) (nreverse parts-list))
(let ((next-char (char string string-index))
(prev-char (if (= string-index start)
nil
@@ -431,7 +431,7 @@
(cond ((alpha-char-p next-char)
;; Alphabetic character - scan to the end of the substring.
(do ((scan-index (1+ string-index) (1+ scan-index)))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(not (alpha-char-p (char string scan-index))))
(let ((match-symbol (match-substring
(subseq string string-index scan-index))))
@@ -444,7 +444,7 @@
(do ((scan-index string-index (1+ scan-index))
(numeric-value 0 (+ (* numeric-value radix)
(digit-char-p (char string scan-index) radix))))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(not (digit-char-p (char string scan-index) radix)))
;; If next-negative is t, set the numeric value to it's
;; opposite and reset next-negative to nil.
@@ -475,7 +475,7 @@
((char= next-char #\()
;; Parenthesized string - scan to the end and ignore it.
(do ((scan-index string-index (1+ scan-index)))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(char= (char string scan-index) #\)))
(setf string-index (1+ scan-index)))))
(t
@@ -551,7 +551,7 @@
(defun deal-with-am-pm (form-value parsed-values)
(let ((hour (decoded-time-hour parsed-values)))
(cond ((eq form-value 'am)
- (cond ((eq hour 12)
+ (cond ((eql hour 12)
(setf (decoded-time-hour parsed-values) 0))
((not (<= 0 hour 12))
(if *error-on-mismatch*
--- /project/cl-l10n/cvsroot/cl-l10n/parse-number.lisp 2005/05/18 15:34:08 1.5
+++ /project/cl-l10n/cvsroot/cl-l10n/parse-number.lisp 2006/04/27 18:30:30 1.6
@@ -32,7 +32,7 @@
(in-package :cl-l10n)
-(define-condition parser-error (error)
+(define-condition parser-error (parse-error)
((value :reader value
:initarg :value
:initform nil)
--- /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2005/05/18 15:34:08 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/04/27 18:30:30 1.8
@@ -7,11 +7,12 @@
(:shadow cl:format cl:formatter)
(:export #:locale-name #:category-name #:locale #:category #:locale-error
#:get-category #:get-cat-val #:locale-value #:load-all-locales
- #:*locale* #:*locale-path* #:*locales*
+ #:*locale* #:*locale-path* #:*locales* #:load-default-locale
#:format-number #:print-number #:format-money #:print-money
#:format-time #:print-time #:add-resources #:bundle
#:add-resource #:gettext #:parse-number #:*float-digits*
#:parse-time #:month #:day #:year #:hour #:minute #:second
- #:date-divider #:time-divider #:weekday #:noon-midn
- #:secondp #:am-pm #:zone #:parser-error))
-
+ #:date-divider #:time-divider #:weekday #:noon-midn #:shadow-format
+ #:secondp #:am-pm #:zone #:parser-error #:set-locale))
+
+
--- /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/03/20 09:13:58 1.11
+++ /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/04/27 18:30:30 1.12
@@ -7,6 +7,8 @@
;; Parsers (money)
;; locale aliases?
;; Optimizing print-time
+;; Handle _ and - in time directives (see date --help)
+;; Compile locales into fasl files.
(in-package :cl-l10n )
--- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2005/05/25 09:30:51 1.14
+++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/04/27 18:30:30 1.15
@@ -5,7 +5,6 @@
(defparameter *ignore-categories*
(list "LC_CTYPE" "LC_COLLATE"))
-
;; Add a restart here?
(defun locale (loc-name &key (use-cache t) (errorp t) (loader nil))
"Find locale named by the string LOC-NAME. If USE-CACHE
@@ -43,12 +42,14 @@
(symbol (locale (string loc)))))
(defun load-locale (name)
- (let ((path (merge-pathnames *locale-path* name)))
+ (let ((path (merge-pathnames *locale-path* name))
+ (ef #+sbcl :iso-8859-1
+ #+clisp (ext:make-encoding :charset 'charset:iso-8859-1
+ :line-terminator :unix)
+ #-(or sbcl clisp) :default))
(cl:format *debug-io* "~&;; Loading locale from ~A.~%" path)
(let ((locale (make-instance *locale-type* :name name)))
- (with-open-file (stream path
- :external-format #+(and sbcl sb-unicode) :latin1
- #-(and sbcl sb-unicode) :default)
+ (with-open-file (stream path :external-format ef)
(multiple-value-bind (escape comment) (munge-headers stream)
(loop for header = (next-header stream)
while header do
@@ -83,7 +84,7 @@
(defun create-number-fmt-string (locale no-ts)
(cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}"
(thousands-sep-char (locale-thousands-sep locale))
- (locale-grouping locale)
+ (if (minusp (locale-grouping locale)) 3 (locale-grouping locale))
(if no-ts "D" ":D")))
(defun get-descriptors (minusp locale)
@@ -114,7 +115,7 @@
;; Actual number
(cl:format stream "~~,,'~A,~A~A~~{~~A~~}"
(thousands-sep-char (locale-mon-thousands-sep locale))
- (locale-mon-grouping locale)
+ (if (minusp (locale-mon-grouping locale)) 3 (locale-mon-grouping locale))
(if no-ts "D" ":D"))
(unless prec
(princ sym-sep stream))
@@ -313,9 +314,9 @@
with in-special = nil
with result = ()
with special-val = () do
- (cond ((eql char #\"))
+ (cond ((eql char #\") nil) ;;ignore
((eql char #\<) (setf in-special t))
- ((and in-special (eq char #\>))
+ ((and in-special (eql char #\>))
(push (code-char
(parse-integer (coerce (cdr (nreverse special-val)) 'string)
:radix 16))
@@ -358,14 +359,18 @@
*ignore-categories*))
(return-from next-header (trim line)))))
+(defun set-locale (locale-des)
+ (setf *locale* (locale-des->locale locale-des)))
+
(defun load-default-locale ()
(setf *locale* (get-default-locale)))
(defun get-default-locale ()
(or (locale (getenv "CL_LOCALE") :errorp nil)
(locale (getenv "LC_CTYPE") :errorp nil)
- (locale "POSIX")))
-
+ (locale (getenv "LANG") :errorp nil)
+ (locale "POSIX" :errorp nil)))
+(load-default-locale)
-;; EOF
\ No newline at end of file
+;; EOF
--- /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2005/05/18 15:34:08 1.3
+++ /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/04/27 18:30:30 1.4
@@ -58,7 +58,7 @@
(locale-name *locale*)))
name)))))
-(defun gettext (name bundle &optional (loc *locale* ))
+(defun gettext (name bundle &optional (loc *locale*))
(let ((*locale* (locale-des->locale loc)))
(or (cdr (lookup-name bundle name))
name)))
--- /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2005/05/18 15:34:08 1.14
+++ /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/04/27 18:30:30 1.15
@@ -9,9 +9,9 @@
(defsystem cl-l10n
:name "CL-L10N"
- :author "Sean Ross <sdr at jhb.ucs.co.za>"
- :maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
- :version "0.3.4"
+ :author "Sean Ross <sross at common-lisp.net>"
+ :maintainer "Sean Ross <sross at common-lisp.net>"
+ :version "0.3.10"
:description "Portable CL Locale Support"
:long-description "Portable CL Package to support localization"
:licence "MIT"
@@ -27,7 +27,6 @@
:depends-on (:cl-ppcre :cl-fad))
(defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n))))
- (funcall (find-symbol "LOAD-DEFAULT-LOCALE" "CL-L10N"))
(provide 'cl-l10n))
--- /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2006/03/20 09:13:57 1.19
+++ /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2006/04/27 18:30:30 1.20
@@ -1,3 +1,27 @@
+2006-04-27 Sean Ross <sross at common-lisp.net>
+ * parse-number.lisp: Changed parse-error to extend parser-error
+ * parse-time.lisp: Changed uses of eq to eql when using numbers
+ or characters.
+ * printers.lisp: Default length fraction digits to 0 if it can't
+ be found in the current locale. Fixed printers of %R time format directive.
+ * load-locale.lisp: Search environment variable LANG before trying using
+ POSIX locale when loading default locale.
+ Add shadowing-format which shadows format and formatter into the current package.
+ * package.lisp: Export load-default-locale
+
+2006-04-15 LuÃs Oliveira <loliveira at common-lisp.net>
+ * doc/cl-l10n.texi: Rename the Index node to Comprehensive Index in
+ order to avoid a name clash with index.html on platforms with
+ case-insensitive filesystems. Prettify the copyright notice.
+ * doc/Makefile, doc/style.css, doc/gendocs.sh, doc/gendocs_template, doc/style.css:
+ New files.
+
+2006-04-15 LuÃs Oliveira <loliveira at common-lisp.net>
+ * load-locale.lisp (load-locale): Specify an explicit
+ external-format for CLISP
+ * test.lisp: Fix indentation of deftest forms.
+ (time.2): Obtain the o-with-diaeresis in a slightly more portable way.
+
2006-03-20 Sean Ross <sross at common-lisp.net>
* locale.lisp: Changed definition of *locale-path* to use
asdf:component-pathname of cl-l10n rather than the load path.
--- /project/cl-l10n/cvsroot/cl-l10n/TODO 2006/04/27 18:30:31 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/TODO 2006/04/27 18:30:31 1.1
use LC_COLLATE to define locale-uppercase and friends
Test on windows.
Parsers (money)
locale aliases?
Optimizing print-time
Handle _ and - in time directives (see date --help)
Compile locales directly into fasl files.
More information about the Cl-l10n-cvs
mailing list