cl-l10n-cvs
Threads by month
- ----- 2026 -----
- February
- January
- ----- 2025 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2007 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2006 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2005 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2004 -----
- December
- November
- 49 discussions
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(a)jhb.ucs.co.za>"
- :maintainer "Sean Ross <sdr(a)jhb.ucs.co.za>"
- :version "0.3.4"
+ :author "Sean Ross <sross(a)common-lisp.net>"
+ :maintainer "Sean Ross <sross(a)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(a)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(a)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(a)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(a)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.
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n/doc
In directory clnet:/tmp/cvs-serv9196/doc
Modified Files:
cl-l10n.texi
Added Files:
style.css gendocs_template gendocs.sh Makefile
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/doc/cl-l10n.texi 2005/03/31 13:53:47 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/cl-l10n.texi 2006/04/27 18:30:30 1.8
@@ -10,32 +10,40 @@
@end direntry
@copying
-Copyright @copyright{} (c) (C) 2004 Sean Ross All rights reserved.
+Copyright @copyright{} 2004 Sean Ross All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
-1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
-3. The names of the authors and contributors may not be used to endorse
- or promote products derived from this software without specific prior
- written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS
-BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@enumerate
+@item
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+@item
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+@item
+The names of the authors and contributors may not be used to endorse
+or promote products derived from this software without specific prior
+written permission.
+@end enumerate
+
+@sc{This software is provided by the authors and contributors ``as is''
+and any express or implied warranties, including, but not limited to,
+the implied warranties of merchantability and fitness for a particular
+purpose are disclaimed. In no event shall the authors or contributors
+be liable for any direct, indirect, incidental, special, exemplary, or
+consequential damages (including, but not limited to, procurement of
+substitute goods or services; loss of use, data, or profits; or
+business interruption) however caused and on any theory of liability,
+whether in contract, strict liability, or tort (including negligence
+or otherwise) arising in any way out of the use of this software, even
+if advised of the possibility of such damage.}
+
@end copying
@c
@@ -63,7 +71,7 @@
* I18N: I18N
* Notes: Notes
* Credits: Credits
-* Index::
+* Comprehensive Index::
@end menu
@@ -632,7 +640,7 @@
@item Common-Lisp.net: For project hosting.
@end itemize
-@node Index
+@node Comprehensive Index
@chapter Index
@section Function Index
--- /project/cl-l10n/cvsroot/cl-l10n/doc/style.css 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/style.css 2006/04/27 18:30:30 1.1
body {font-family: century schoolbook, serif;
line-height: 1.3;
padding-left: 5em; padding-right: 1em;
padding-bottom: 1em; max-width: 60em;}
table {border-collapse: collapse}
span.roman { font-family: century schoolbook, serif; font-weight: normal; }
h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif}
/*h4 {padding-top: 0.75em;}*/
dfn {font-family: inherit; font-variant: italic; font-weight: bolder }
kbd {font-family: monospace; text-decoration: underline}
/*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/
var {font-variant: slanted;}
td {padding-right: 1em; padding-left: 1em}
sub {font-size: smaller}
.node {padding: 0; margin: 0}
.lisp { font-family: monospace;
background-color: #F4F4F4; border: 1px solid #AAA;
padding-top: 0.5em; padding-bottom: 0.5em; }
/* coloring */
.lisp-bg { background-color: #F4F4F4 ; color: black; }
.lisp-bg:hover { background-color: #F4F4F4 ; color: black; }
.symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;}
a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
.special { font-weight: bold; color: #FF5000; background-color: inherit; }
.keyword { font-weight: bold; color: #770000; background-color: inherit; }
.comment { font-weight: normal; color: #007777; background-color: inherit; }
.string { font-weight: bold; color: #777777; background-color: inherit; }
.character { font-weight: bold; color: #0055AA; background-color: inherit; }
.syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; }
span.paren1 { font-weight: bold; color: #777777; }
span.paren1:hover { color: #777777; background-color: #BAFFFF; }
span.paren2 { color: #777777; }
span.paren2:hover { color: #777777; background-color: #FFCACA; }
span.paren3 { color: #777777; }
span.paren3:hover { color: #777777; background-color: #FFFFBA; }
span.paren4 { color: #777777; }
span.paren4:hover { color: #777777; background-color: #CACAFF; }
span.paren5 { color: #777777; }
span.paren5:hover { color: #777777; background-color: #CAFFCA; }
span.paren6 { color: #777777; }
span.paren6:hover { color: #777777; background-color: #FFBAFF; }
--- /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs_template 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs_template 2006/04/27 18:30:30 1.1
<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<!-- $Id: gendocs_template,v 1.1 2006/04/27 18:30:30 sross Exp $ -->
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<!--
This template was adapted from Texinfo:
http://savannah.gnu.org/cgi-bin/viewcvs/texinfo/texinfo/util/gendocs_templa…
-->
<head>
<title>%%TITLE%%</title>
<meta http-equiv="content-type" content='text/html; charset=utf-8' />
<!-- <link rel="stylesheet" type="text/css" href="/gnu.css" /> -->
<!-- <link rev="made" href="webmasters(a)gnu.org" /> -->
<style>
/* CSS style taken from http://gnu.org/gnu.css */
html, body {
background-color: #FFFFFF;
color: #000000;
font-family: sans-serif;
}
a:link {
color: #1f00ff;
background-color: transparent;
text-decoration: underline;
}
a:visited {
color: #9900dd;
background-color: transparent;
text-decoration: underline;
}
a:hover {
color: #9900dd;
background-color: transparent;
text-decoration: none;
}
.center {
text-align: center;
}
.italic {
font-style: italic;
}
.bold {
font-weight: bold;
}
.quote {
margin-left: 40px;
margin-right: 40px;
}
.hrsmall {
width: 80px;
height: 1px;
margin-left: 20px;
}
.td_title {
border-color: #3366cc;
border-style: solid;
border-width: thin;
color: #3366cc;
background-color : #f2f2f9;
font-weight: bold;
}
.td_con {
padding-top: 3px;
padding-left: 8px;
padding-bottom: 3px;
color : #303030;
background-color : #fefefe;
font-size: smaller;
}
.translations {
background-color: transparent;
color: black;
font-family: serif;
font-size: smaller;
}
.fsflink {
font-size: smaller;
font-family: monospace;
color : #000000;
border-left: #3366cc thin solid;
border-bottom: #3366cc thin solid;
padding-left: 5px;
padding-bottom: 5px;
}
/*
* rtl stands for right-to-left layout, as in farsi/persian,
* arabic, etc. See also trans_rtl.
*/
.fsflink_rtl {
font-size: smaller;
font-family: monospace;
color : #000000;
border-right: #3366cc thin solid;
border-bottom: #3366cc thin solid;
padding-right: 5px;
padding-bottom: 5px;
}
.trans {
font-size: smaller;
color : #000000;
border-left: #3366cc thin solid;
padding-left: 20px;
}
.trans_rtl {
font-size: smaller;
color : #000000;
border-right: #3366cc thin solid;
padding-right: 20px;
}
img {
border: none 0;
}
td.side {
color: #3366cc;
/* background: #f2f2f9;
border-color: #3366cc;
border-style: solid;
border-width: thin; */
border-color: white;
border-style: none;
vertical-align: top;
width: 150px;
}
div.copyright {
font-size: 80%;
border: 2px solid #3366cc;
padding: 4px;
background: #f2f2f9;
border-style: solid;
border-width: thin;
}
.footnoteref {
font-size: smaller;
vertical-align: text-top;
}
</style>
</head>
<!-- This document is in XML, and xhtml 1.0 -->
<!-- Please make sure to properly nest your tags -->
<!-- and ensure that your final document validates -->
<!-- consistent with W3C xhtml 1.0 and CSS standards -->
<!-- See validator.w3.org -->
<body>
<h3>%%TITLE%%</h3>
<!-- <address>Free Software Foundation</address> -->
<address>last updated %%DATE%%</address>
<!--
<p>
<a href="/graphics/gnu-head.jpg">
<img src="/graphics/gnu-head-sm.jpg"
alt=" [image of the head of a GNU] "
width="129" height="122" />
</a>
<a href="/philosophy/gif.html">(no gifs due to patent problems)</a>
</p>
-->
<hr />
<p>This document <!--(%%PACKAGE%%)--> is available in the following formats:</p>
<ul>
<li><a href="%%PACKAGE%%.html">HTML
(%%HTML_MONO_SIZE%%K characters)</a> - entirely on one web page.</li>
<li><a href="html_node/index.html">HTML</a> - with one web page per
node.</li>
<li><a href="%%PACKAGE%%.html.gz">HTML compressed
(%%HTML_MONO_GZ_SIZE%%K gzipped characters)</a> - entirely on
one web page.</li>
<li><a href="%%PACKAGE%%.html_node.tar.gz">HTML compressed
(%%HTML_NODE_TGZ_SIZE%%K gzipped tar file)</a> -
with one web page per node.</li>
<li><a href="%%PACKAGE%%.info.tar.gz">Info document
(%%INFO_TGZ_SIZE%%K characters gzipped tar file)</a>.</li>
<li><a href="%%PACKAGE%%.txt">ASCII text
(%%ASCII_SIZE%%K characters)</a>.</li>
<li><a href="%%PACKAGE%%.txt.gz">ASCII text compressed
(%%ASCII_GZ_SIZE%%K gzipped characters)</a>.</li>
<li><a href="%%PACKAGE%%.dvi.gz">TeX dvi file
(%%DVI_GZ_SIZE%%K characters gzipped)</a>.</li>
<li><a href="%%PACKAGE%%.ps.gz">PostScript file
(%%PS_GZ_SIZE%%K characters gzipped)</a>.</li>
<li><a href="%%PACKAGE%%.pdf">PDF file
(%%PDF_SIZE%%K characters)</a>.</li>
<li><a href="%%PACKAGE%%.texi.tar.gz">Texinfo source
(%%TEXI_TGZ_SIZE%%K characters gzipped tar file)</a></li>
</ul>
<p>(This page was generated by the <a href="%%SCRIPTURL%%">%%SCRIPTNAME%%
script</a>.)</p>
<div class="copyright">
<p>
Return to <a href="/project/cl-l10n/">CL-L10N's home page</a>.
</p>
<!--
<p>
Please send FSF & GNU inquiries to
<a href="mailto:gnu@gnu.org"><em>gnu(a)gnu.org</em></a>.
There are also <a href="/home.html#ContactInfo">other ways to contact</a>
the FSF.
<br />
Please send broken links and other corrections (or suggestions) to
<a href="mailto:webmasters@gnu.org"><em>webmasters(a)gnu.org</em></a>.
</p>
-->
<p>
Copyright (C) 2004-2006 Sean Ross <sross at common-lisp.net><br />
<!--
<br />
Verbatim copying and distribution of this entire article is
permitted in any medium, provided this notice is preserved.
-->
</p>
<p>
Updated: %%DATE%%
<!-- timestamp start -->
<!-- $Date: 2006/04/27 18:30:30 $ $Author: sross $ -->
<!-- timestamp end -->
</p>
</div>
</body>
</html>
--- /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs.sh 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs.sh 2006/04/27 18:30:30 1.1
#!/bin/sh
# gendocs.sh -- generate a GNU manual in many formats. This script is
# mentioned in maintain.texi. See the help message below for usage details.
# $Id: gendocs.sh,v 1.1 2006/04/27 18:30:30 sross Exp $
#
# Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
[289 lines skipped]
--- /project/cl-l10n/cvsroot/cl-l10n/doc/Makefile 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/Makefile 2006/04/27 18:30:30 1.1
[304 lines skipped]
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory clnet:/tmp/cvs-serv22485
Modified Files:
ChangeLog locale.lisp
Log Message:
Fix for *locale-path*
--- /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2005/05/25 09:30:51 1.18
+++ /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2006/03/20 09:13:57 1.19
@@ -1,3 +1,10 @@
+2006-03-20 Sean Ross <sross(a)common-lisp.net>
+ * locale.lisp: Changed definition of *locale-path* to use
+ asdf:component-pathname of cl-l10n rather than the load path.
+ This resolves problems finding the locale files when fasl's are
+ not in the same directory as the source files.
+ Patch by Aycan iRiCAN
+
2005-05-25 Sean Ross <sross(a)common-lisp.net>
* locales/ar_SA: revert.
* load-locale.lisp, printers.lisp: Added support for the .1 in the ar_SA locale.
--- /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2005/05/18 15:34:08 1.10
+++ /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/03/20 09:13:58 1.11
@@ -12,7 +12,7 @@
(defvar *locale-path*
(merge-pathnames (make-pathname :directory '(:relative "locales"))
- (directory-namestring *load-pathname*)))
+ (asdf:component-pathname (asdf:find-system :cl-l10n))))
(defvar *locale* nil)
@@ -89,7 +89,7 @@
(defun getenv (word)
#+sbcl (sb-ext:posix-getenv word)
- #+lispworks (hcl:getenv word)
+ #+lispworks (lw:environment-variable word)
#+acl (sys:getenv word)
#+cmu (cdr (assoc (intern word :keyword) ext:*environment-list*))
#+clisp (ext:getenv word)
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n/locales
In directory common-lisp.net:/tmp/cvs-serv12691/locales
Modified Files:
ar_SA
Log Message:
Changelog 2005-05-25
Date: Wed May 25 11:30:54 2005
Author: sross
Index: cl-l10n/locales/ar_SA
diff -u cl-l10n/locales/ar_SA:1.3 cl-l10n/locales/ar_SA:1.4
--- cl-l10n/locales/ar_SA:1.3 Wed May 18 17:34:12 2005
+++ cl-l10n/locales/ar_SA Wed May 25 11:30:54 2005
@@ -300,10 +300,10 @@
% t_fmt_ampm "%.1H:%M:%S"
LC_TIME
-d_t_fmt "<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-d_fmt "<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
-t_fmt "<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-t_fmt_ampm "<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_t_fmt "<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_fmt "<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
+t_fmt "<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+t_fmt_ampm "<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
day "<U0627><U0644><U0623><U062D><U062F>"; /
"<U0627><U0644><U0625><U062B><U0646><U064A><U0646>"; /
"<U0627><U0644><U062B><U0644><U0627><U062B><U0627><U0621>"; /
1
0
[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/load-locale.lisp cl-l10n/printers.lisp
by sross@common-lisp.net 25 May '05
by sross@common-lisp.net 25 May '05
25 May '05
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory common-lisp.net:/tmp/cvs-serv12691
Modified Files:
ChangeLog load-locale.lisp printers.lisp
Log Message:
Changelog 2005-05-25
Date: Wed May 25 11:30:51 2005
Author: sross
Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.17 cl-l10n/ChangeLog:1.18
--- cl-l10n/ChangeLog:1.17 Wed May 18 17:34:07 2005
+++ cl-l10n/ChangeLog Wed May 25 11:30:51 2005
@@ -1,3 +1,7 @@
+2005-05-25 Sean Ross <sross(a)common-lisp.net>
+ * locales/ar_SA: revert.
+ * load-locale.lisp, printers.lisp: Added support for the .1 in the ar_SA locale.
+
2005-05-18 Sean Ross <sross(a)common-lisp.net>
load-all-locales now works.
* cl-l10n.asd: Added dependency to cl-fad
@@ -9,7 +13,7 @@
now "%d<U0020>" parses correctly.
* utils.lisp: Removed awhen, awhile.
* printers.lisp: Added a check for #\E in date printing.
- * locales/ar_SA: This locales ha(s/d) a .1 in front of
+ * locales/ar_SA: This locale has a .1 in front of
various time printing directives. I have no idea what these
mean....
Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.13 cl-l10n/load-locale.lisp:1.14
--- cl-l10n/load-locale.lisp:1.13 Wed May 18 17:34:08 2005
+++ cl-l10n/load-locale.lisp Wed May 25 11:30:51 2005
@@ -172,9 +172,13 @@
(defun compute-order (fmt)
(let ((res nil))
(loop for char across fmt
- with perc = nil do
+ with perc = nil
+ with in-dot = nil do
(cond ((char= char #\%) (setf perc (not perc)))
((member char date-dividers) nil)
+ ((and perc (char= char #\.)) (setf in-dot t))
+ ((and perc in-dot (char= char #\1))
+ (setf in-dot nil))
(perc (unless (char= char #\E)
;; some locales (eg lo_LA) have this funny E before
;; various time format designators. Debian
Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.15 cl-l10n/printers.lisp:1.16
--- cl-l10n/printers.lisp:1.15 Wed May 18 17:34:08 2005
+++ cl-l10n/printers.lisp Wed May 25 11:30:51 2005
@@ -328,13 +328,18 @@
(declare (optimize speed) (type simple-string fmt-string))
(let ((values (multiple-value-list (decode-universal-time ut *time-zone*))))
(loop for x across fmt-string
- with perc = nil do
+ with perc = nil
+ with in-dot = nil do
(case x
(#\% (if perc
(progn (princ #\% stream) (setf perc nil))
(setf perc t)))
;; see compute-order in load-locale.lisp
;; for why this line is here.
+ (#\. (if perc (setf in-dot t) (princ x stream)))
+ (#\1 (if (and perc in-dot)
+ (setf in-dot nil)
+ (princ x stream)))
(#\E (unless perc (princ x stream)))
(t (if perc
(progn (apply (the function (lookup-formatter x))
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n/locales
In directory common-lisp.net:/tmp/cvs-serv6677/locales
Modified Files:
ar_SA
Log Message:
Changelog 2005-05-18
Date: Wed May 18 17:34:13 2005
Author: sross
Index: cl-l10n/locales/ar_SA
diff -u cl-l10n/locales/ar_SA:1.2 cl-l10n/locales/ar_SA:1.3
--- cl-l10n/locales/ar_SA:1.2 Tue Nov 30 10:45:48 2004
+++ cl-l10n/locales/ar_SA Wed May 18 17:34:12 2005
@@ -300,10 +300,10 @@
% t_fmt_ampm "%.1H:%M:%S"
LC_TIME
-d_t_fmt "<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-d_fmt "<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
-t_fmt "<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-t_fmt_ampm "<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_t_fmt "<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_fmt "<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
+t_fmt "<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+t_fmt_ampm "<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
day "<U0627><U0644><U0623><U062D><U062F>"; /
"<U0627><U0644><U0625><U062B><U0646><U064A><U0646>"; /
"<U0627><U0644><U062B><U0644><U0627><U062B><U0627><U0621>"; /
1
0
[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/README cl-l10n/cl-l10n.asd cl-l10n/i18n.lisp cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/package.lisp cl-l10n/parse-number.lisp cl-l10n/parsers.lisp cl-l10n/printers.lisp cl-l10n/tests.lisp cl-l10n/utils.lisp
by sross@common-lisp.net 18 May '05
by sross@common-lisp.net 18 May '05
18 May '05
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory common-lisp.net:/tmp/cvs-serv6677
Modified Files:
ChangeLog README cl-l10n.asd i18n.lisp load-locale.lisp
locale.lisp package.lisp parse-number.lisp parsers.lisp
printers.lisp tests.lisp utils.lisp
Log Message:
Changelog 2005-05-18
Date: Wed May 18 17:34:08 2005
Author: sross
Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.16 cl-l10n/ChangeLog:1.17
--- cl-l10n/ChangeLog:1.16 Thu Mar 31 15:53:42 2005
+++ cl-l10n/ChangeLog Wed May 18 17:34:07 2005
@@ -1,3 +1,19 @@
+2005-05-18 Sean Ross <sross(a)common-lisp.net>
+ load-all-locales now works.
+ * cl-l10n.asd: Added dependency to cl-fad
+ * load-locale.lisp: Only do printer creation if LC_MONETARY
+ and LC_NUMERIC exist.
+ Added a check for a funny #\E in some locales date fields.
+ Only do date-parsers if LC_TIME Exists.
+ Fixed line parser to handle normal characters in locale files,
+ now "%d<U0020>" parses correctly.
+ * utils.lisp: Removed awhen, awhile.
+ * printers.lisp: Added a check for #\E in date printing.
+ * locales/ar_SA: This locales ha(s/d) a .1 in front of
+ various time printing directives. I have no idea what these
+ mean....
+
+
2005-03-31 Sean Ross <sross(a)common-lisp.net>
Version 0.3 Release
* parse-time.lisp, load-locale.lisp: Create
Index: cl-l10n/README
diff -u cl-l10n/README:1.3 cl-l10n/README:1.4
--- cl-l10n/README:1.3 Thu Mar 31 15:53:42 2005
+++ cl-l10n/README Wed May 18 17:34:07 2005
@@ -9,6 +9,8 @@
various locale functions. It currently runs on
CMUCL, SBCL, CLISP, ECL, Lispworks and Allegro CL although porting
to a new implementation should be trivial.
+It is distributed under an MIT style license although the locale
+files themselves are distributed under the LGPL.
1. API
Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.13 cl-l10n/cl-l10n.asd:1.14
--- cl-l10n/cl-l10n.asd:1.13 Thu Mar 31 15:53:42 2005
+++ cl-l10n/cl-l10n.asd Wed May 18 17:34:08 2005
@@ -11,7 +11,7 @@
:name "CL-L10N"
:author "Sean Ross <sdr(a)jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr(a)jhb.ucs.co.za>"
- :version "0.3"
+ :version "0.3.4"
:description "Portable CL Locale Support"
:long-description "Portable CL Package to support localization"
:licence "MIT"
@@ -24,7 +24,7 @@
(:file "parsers" :depends-on ("printers" "parse-number"))
(:file "parse-time" :depends-on ("load-locale"))
(:file "i18n" :depends-on ("printers")))
- :depends-on (:cl-ppcre))
+ :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"))
Index: cl-l10n/i18n.lisp
diff -u cl-l10n/i18n.lisp:1.2 cl-l10n/i18n.lisp:1.3
--- cl-l10n/i18n.lisp:1.2 Tue Jan 4 16:32:15 2005
+++ cl-l10n/i18n.lisp Wed May 18 17:34:08 2005
@@ -6,33 +6,24 @@
;; (defparameter bundle (make-instance 'bundle))
;; (add-resources (bundle "af_")
-;; "showtime" "Danke, die tyd is ~:@/cl-l10n:format-time/~%")
+;; "showtime" "Dankie, die tyd is ~:@U~%")
;; ;; an empty string as the locale matcher becomes the default
;; (add-resources (bundle "")
-;; "showtime" "Thanks, the time is ~:@/cl-l10n:format-time/~%")
+;; "showtime" "Thanks, the time is ~:@U~%")
;; (set-dispatch-macro-character
-;; #\# #\"
+;; #\# #\i
;; #'(lambda (s c1 c2)
;; (declare (ignore c2))
-;; (unread-char c1 s)
;; `(cl-l10n:gettext ,(read s) bundle)))
-;; or this (probably a bad idea)
-
-;; (defvar *orig-string-char*
-;; (get-macro-character #\"))
-;; (set-macro-character #\"
-;; #'(lambda (s c1)
-;; `(cl-l10n:gettext ,(funcall *orig-string-char* s c1) bundle)))
-
;; or this
;; (defmacro _ (text)
;; `(cl-l10n:gettext ,text bundle))
;; (defun timey ()
-;; (format t #"showtime" (get-universal-time)))
+;; (format t #i"showtime" (get-universal-time)))
(defclass bundle ()
((resources :accessor resources :initform (make-hash-table :test #'equal))))
@@ -57,15 +48,15 @@
(defgeneric lookup-name (bundle name)
(:method ((bundle t) (name t))
- (awhen (get-name bundle name)
+ (when-let (name (get-name bundle name))
;; The match with the longest name is the most
;; specific key.
(winner #'>
- (compose #'length #'car)
+ (load-time-value (compose #'length #'car))
(remove-if-not #'(lambda (x)
(search (car x)
(locale-name *locale*)))
- it)))))
+ name)))))
(defun gettext (name bundle &optional (loc *locale* ))
(let ((*locale* (locale-des->locale loc)))
@@ -75,4 +66,4 @@
-;; EOF
\ No newline at end of file
+;; EOF
Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.12 cl-l10n/load-locale.lisp:1.13
--- cl-l10n/load-locale.lisp:1.12 Thu Mar 31 15:53:42 2005
+++ cl-l10n/load-locale.lisp Wed May 18 17:34:08 2005
@@ -16,9 +16,6 @@
(let ((name (aif (position #\. loc-name)
(subseq loc-name 0 it)
loc-name)))
- (unless use-cache
- ;; The local file might have changed so ...
- (clear-getter-cache))
(acond ((and (not name) (not errorp)) nil)
((and use-cache (get-locale name)) it)
(loader (setf (get-locale name) (funcall loader name)))
@@ -48,30 +45,33 @@
(defun load-locale (name)
(let ((path (merge-pathnames *locale-path* name)))
(cl:format *debug-io* "~&;; Loading locale from ~A.~%" path)
- (let ((locale (make-instance *locale-type* :name name))
- (*read-eval* nil)
- (*print-circle* nil))
+ (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)
(multiple-value-bind (escape comment) (munge-headers stream)
- (awhile (next-header stream)
- (awhen (make-category locale it (parse-category it stream
- escape comment))
- (setf (get-category locale (category-name it)) it)))))
+ (loop for header = (next-header stream)
+ while header do
+ (when-let (cat (make-category locale header
+ (parse-category header stream
+ escape comment)))
+ (setf (get-category locale header) cat)))))
(add-printers locale)
(add-parsers locale)
locale)))
-(defun load-all-locales (&optional (path *locale-path*))
+(defun load-all-locales (&key (path *locale-path*) (ignore-errors nil) (use-cache nil))
"Load all locale found in pathname designator PATH."
(let ((*locale-path* path))
- ;; Is this portable?
- (dolist (x (directory (merge-pathnames *locale-path* "*")))
- (when (pathname-name x)
- (with-simple-restart (continue "Ignore locale ~A." x)
- (handler-case (load-locale (pathname-name x))
- (locale-error (c) (warn "Unable to load locale ~A. ~%~A." x c))))))))
+ (dolist (x (list-directory *locale-path*))
+ (when (and (not (directory-pathname-p x)) (pathname-name x))
+ (let ((locale (pathname-name x)))
+ (with-simple-restart (continue "Ignore locale ~A." x)
+ (handler-bind ((error (lambda (&optional c)
+ (when ignore-errors
+ (warn "Failed to load locale ~S, Ignoring." locale)
+ (invoke-restart (find-restart 'continue c))))))
+ (locale locale :use-cache use-cache))))))))
(defvar *default-thousands-sep* #\,)
@@ -126,26 +126,29 @@
(defun add-printers (locale)
"Creates monetary and numeric format strings for locale LOCALE."
- (setf (printers locale)
- (nconc (list :number-no-ts
- (create-number-fmt-string locale t))
- (list :number-ts
- (create-number-fmt-string locale nil))
- (list :money-p-no-ts
- (create-money-fmt-string locale t nil))
- (list :money-p-ts
- (create-money-fmt-string locale nil nil))
- (list :money-n-no-ts
- (create-money-fmt-string locale t t))
- (list :money-n-ts
- (create-money-fmt-string locale nil t))
- (printers locale))))
+ (when (and (get-category locale "LC_MONETARY")
+ (get-category locale "LC_NUMERIC"))
+ ;; otherwise its an include locale (tranlit* etc)
+ (setf (printers locale)
+ (nconc (list :number-no-ts
+ (create-number-fmt-string locale t))
+ (list :number-ts
+ (create-number-fmt-string locale nil))
+ (list :money-p-no-ts
+ (create-money-fmt-string locale t nil))
+ (list :money-p-ts
+ (create-money-fmt-string locale nil nil))
+ (list :money-n-no-ts
+ (create-money-fmt-string locale t t))
+ (list :money-n-ts
+ (create-money-fmt-string locale nil t))
+ (printers locale)))))
(defun day-element-p (x)
(member x '(#\d #\e)))
(defun month-element-p (x)
- (char= x #\m))
+ (member x '(#\m #\b #\B)))
(defun year-element-p (x)
(member x '(#\y #\Y)))
@@ -172,21 +175,25 @@
with perc = nil do
(cond ((char= char #\%) (setf perc (not perc)))
((member char date-dividers) nil)
- (perc (let ((val (element-type char)))
- (when val (push val res))
- (setf perc nil)))))
+ (perc (unless (char= char #\E)
+ ;; some locales (eg lo_LA) have this funny E before
+ ;; various time format designators. Debian
+ ;; treats this as if it wasn't there so neither do we.
+ (let ((val (element-type char)))
+ (when val (push val res))
+ (setf perc nil))))))
(nreverse res)))
-
(defun add-parsers (locale)
- (destructuring-bind (first second third)
- (locale-date-month-order locale)
- (setf (parsers locale)
- (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn))
- `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute
- (time-divider) (secondp) (am-pm) (date-divider) (zone))
- `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider)
- (secondp) (date-divider) ,third (date-divider) (zone))))))
+ (when (get-category locale "LC_TIME")
+ (destructuring-bind (first second third)
+ (locale-date-month-order locale)
+ (setf (parsers locale)
+ (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn))
+ `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute
+ (time-divider) (secondp) (am-pm) (date-divider) (zone))
+ `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider)
+ (secondp) (date-divider) ,third (date-divider) (zone)))))))
(defvar *category-loaders*
'(("LC_IDENTIFICATION" . load-identification)
@@ -205,8 +212,8 @@
(cdr (assoc name *category-loaders* :test #'string=)))
(defun make-category (locale name vals)
- (awhen (get-loader name)
- (funcall it locale name vals)))
+ (when-let (loader (get-loader name))
+ (funcall loader locale name vals)))
(defgeneric load-category (locale name vals)
(:documentation "Load a category for LOCALE using VALS.")
@@ -283,8 +290,6 @@
(schar (cdr (get-value line stream escape)) 0)))))
(values escape comment-char)))
-
-
(defun get-full-line (line stream escape)
(let ((length (length line)))
(if (char= (elt line (1- length)) escape)
@@ -299,34 +304,25 @@
escape)))
line)))
-
-(defun real-character (char)
- (let ((int (parse-integer (trim char (list* #\U #\> #\< *whitespace*))
- :radix 16)))
- (handler-case (code-char int)
- (type-error (c)
- (declare (ignore c))
- (locale-error "Cannot represent ~A as a character." int)))))
-
-(defvar *regex* '(:sequence
- #\<
- (:greedy-repetition 0 nil
- (:inverted-char-class #\> #\<)
- :everything)
- #\>))
-
-(defvar *match-scanner* (cl-ppcre:create-scanner *regex*))
-
-(defun old-real-value (val)
- (aif (all-matches-as-strings *match-scanner* val)
- (map #-lispworks 'string #+lispworks
- 'lw:text-string #'real-character it)
- val))
-
-;; KLUDGE
-(defun real-value (val)
- (remove #\" (old-real-value val)))
-
+(defun real-value (string)
+ (loop for char across string
+ with in-special = nil
+ with result = ()
+ with special-val = () do
+ (cond ((eql char #\"))
+ ((eql char #\<) (setf in-special t))
+ ((and in-special (eq char #\>))
+ (push (code-char
+ (parse-integer (coerce (cdr (nreverse special-val)) 'string)
+ :radix 16))
+ result)
+ (setf in-special nil
+ special-val nil))
+ (in-special (push char special-val))
+ (t (push char result)))
+ finally (return (coerce (nreverse result)
+ #-lispworks 'string
+ #+lispworks 'lw:text-string))))
(defvar *split-scanner*
(cl-ppcre:create-scanner '(:char-class #\;)))
Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.9 cl-l10n/locale.lisp:1.10
--- cl-l10n/locale.lisp:1.9 Thu Mar 31 15:53:42 2005
+++ cl-l10n/locale.lisp Wed May 18 17:34:08 2005
@@ -2,12 +2,11 @@
;; See the file LICENCE for licence information.
;; TODO
-;; What to do with LC_CTYPE, LC_COLLATE
+;; use LC_COLLATE to define locale-uppercase and friends
;; Test on windows.
;; Parsers (money)
;; locale aliases?
;; Optimizing print-time
-;; Thread safety
(in-package :cl-l10n )
@@ -21,12 +20,9 @@
"Hash table containing all loaded locales keyed on name (eg. \"af_ZA\")")
;; Conditions
-(defun locale-report (obj stream)
- (cl:format stream "~A" (mesg obj)))
-
(define-condition locale-error (error)
((mesg :accessor mesg :initarg :mesg :initform "Unknown."))
- (:report locale-report))
+ (:report (lambda (obj stream) (cl:format stream "~A" (mesg obj)))))
(defun locale-error (string &rest args)
(error 'locale-error :mesg (apply #'cl:format nil string args)))
@@ -88,8 +84,8 @@
new-val))
(defun locale-value (locale cat key)
- (awhen (get-category locale cat)
- (category-value it key)))
+ (when-let (cat (get-category locale cat))
+ (category-value cat key)))
(defun getenv (word)
#+sbcl (sb-ext:posix-getenv word)
@@ -100,24 +96,13 @@
#+ecl (si:getenv word))
;; Getters
-(let ((getter-cache (make-hash-table :test #'equal)))
- (defun gett-value (locale cat key &optional (wrap #'identity))
- (let ((lookup-key (list locale cat key)))
- (multiple-value-bind (val win) (gethash lookup-key getter-cache)
- (if (or val win)
- val
- (setf (gethash lookup-key getter-cache)
- (funcall wrap (locale-value locale cat key)))))))
- (defun clear-getter-cache ()
- (setf getter-cache (make-hash-table :test #'equal))))
-
-(defmacro defgetter (key cat &key wrap)
+(defmacro defgetter (key cat &key (wrap '#'identity))
(let ((name (symb "LOCALE-" (substitute #\- #\_ (string-upcase key)))))
`(progn
(defun ,name (&optional (locale *locale*))
(let ((locale (locale-des->locale locale)))
(when locale
- (gett-value locale ,cat ,key ,@(if wrap (list wrap) nil)))))
+ (funcall ,wrap (locale-value locale ,cat ,key)))))
(export ',name))))
(defun parse-car-or-val (x)
Index: cl-l10n/package.lisp
diff -u cl-l10n/package.lisp:1.6 cl-l10n/package.lisp:1.7
--- cl-l10n/package.lisp:1.6 Thu Mar 31 15:53:42 2005
+++ cl-l10n/package.lisp Wed May 18 17:34:08 2005
@@ -3,7 +3,7 @@
(in-package #:cl-l10n.system)
(defpackage #:cl-l10n
- (:use #:cl #:cl-ppcre)
+ (:use #:cl #:cl-ppcre #:cl-fad)
(:shadow cl:format cl:formatter)
(:export #:locale-name #:category-name #:locale #:category #:locale-error
#:get-category #:get-cat-val #:locale-value #:load-all-locales
Index: cl-l10n/parse-number.lisp
diff -u cl-l10n/parse-number.lisp:1.4 cl-l10n/parse-number.lisp:1.5
--- cl-l10n/parse-number.lisp:1.4 Thu Mar 31 15:53:42 2005
+++ cl-l10n/parse-number.lisp Wed May 18 17:34:08 2005
@@ -30,7 +30,7 @@
;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;;; SUCH DAMAGE.
-(in-package #:cl-l10n)
+(in-package :cl-l10n)
(define-condition parser-error (error)
((value :reader value
Index: cl-l10n/parsers.lisp
diff -u cl-l10n/parsers.lisp:1.3 cl-l10n/parsers.lisp:1.4
--- cl-l10n/parsers.lisp:1.3 Wed Mar 30 13:14:53 2005
+++ cl-l10n/parsers.lisp Wed May 18 17:34:08 2005
@@ -1,4 +1,4 @@
-(in-package #:cl-l10n)
+(in-package :cl-l10n)
(defun parse-number (num &optional (locale *locale*))
(let ((locale (locale-des->locale locale)))
Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.14 cl-l10n/printers.lisp:1.15
--- cl-l10n/printers.lisp:1.14 Thu Mar 31 15:53:42 2005
+++ cl-l10n/printers.lisp Wed May 18 17:34:08 2005
@@ -67,7 +67,7 @@
(locale-frac-digits locale)))
(val-to-print (round-money (abs (coerce arg 'double-float))
frac-digits))
- (float-part (float-part (coerce val-to-print 'float)))
+ (float-part (float-part val-to-print))
(sym (if use-int-sym
(locale-int-curr-symbol locale)
(locale-currency-symbol locale)))
@@ -333,6 +333,9 @@
(#\% (if perc
(progn (princ #\% stream) (setf perc nil))
(setf perc t)))
+ ;; see compute-order in load-locale.lisp
+ ;; for why this line is here.
+ (#\E (unless perc (princ x stream)))
(t (if perc
(progn (apply (the function (lookup-formatter x))
stream locale ut values)
Index: cl-l10n/tests.lisp
diff -u cl-l10n/tests.lisp:1.7 cl-l10n/tests.lisp:1.8
--- cl-l10n/tests.lisp:1.7 Thu Mar 31 15:53:42 2005
+++ cl-l10n/tests.lisp Wed May 18 17:34:08 2005
@@ -262,4 +262,4 @@
-;; EOF
\ No newline at end of file
+;; EOF
Index: cl-l10n/utils.lisp
diff -u cl-l10n/utils.lisp:1.6 cl-l10n/utils.lisp:1.7
--- cl-l10n/utils.lisp:1.6 Wed Mar 23 11:58:16 2005
+++ cl-l10n/utils.lisp Wed May 18 17:34:08 2005
@@ -16,15 +16,13 @@
`(aif ,(caar options)
(progn ,@(cdar options)))))
-(defmacro awhen (test &body body)
- `(aif ,test (progn ,@body)))
+(defmacro when-let ((var form) &body body)
+ `(let ((,var ,form))
+ (when ,var
+ ,@body)))
(defmacro with-gensyms (names &body body)
`(let ,(mapcar #'(lambda (x) `(,x (gensym))) names)
- ,@body))
-
-(defmacro awhile (test &body body)
- `(loop for it = ,test until (not it) do
,@body))
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n/doc
In directory common-lisp.net:/tmp/cvs-serv7026/doc
Modified Files:
cl-l10n.texi
Log Message:
Changelog 2005-03-31
Date: Thu Mar 31 15:53:47 2005
Author: sross
Index: cl-l10n/doc/cl-l10n.texi
diff -u cl-l10n/doc/cl-l10n.texi:1.6 cl-l10n/doc/cl-l10n.texi:1.7
--- cl-l10n/doc/cl-l10n.texi:1.6 Thu Mar 17 12:40:39 2005
+++ cl-l10n/doc/cl-l10n.texi Thu Mar 31 15:53:47 2005
@@ -90,6 +90,7 @@
@item CLISP
@item Lispworks
@item ECL
+@item Allegro CL
@end itemize
@@ -239,13 +240,13 @@
@end deffn
@anchor{Function print-time}
-@deffn {Function} print-time ut &key show-date show-time (stream *standard-output) (locale *locale) fmt
+@deffn {Function} print-time ut &key show-date show-time (stream *standard-output) (locale *locale) fmt time-zone
Prints the @code{universal-time} @emph{ut} as a locale specific time to @emph{stream}.
-Equivalent to @code{(format-time stream ut show-date show-time locale fmt)}.
+Equivalent to @code{(format-time stream ut show-date show-time locale fmt time-zone)}.
@end deffn
@anchor{Function format-time}
-@deffn {function} format-time stream ut show-date show-time &optional (locale *locale*) fmt
+@deffn {function} format-time stream ut show-date show-time &optional (locale *locale*) fmt time-zone
Prints the @code{universal-time} @emph{ut} as a locale specific time to @emph{stream}.
The format of the time printed is controlled by @emph{show-time} and @emph{show-date}.
@@ -262,10 +263,10 @@
@end table
If @emph{fmt} is not nil then @emph{show-date} and @emph{show-time} are ignored
-and @emph{fmt} is used as the format control string. For details of format
-directive look at 'man 1 date' although some directives are not supported, namely %U, %V and %W.
+and @emph{fmt} is used as the format control string. See the Notes Section for
+the defined control characters which can be used.
-Examples (assuming *locale* is ``en_ZA'')
+Examples (assuming *locale* is ``en_ZA'' and a CL -2 Time Zone)
@verbatim
(format t "~:/cl-l10n:format-time/" 3192624000)
prints `03/03/01'
@@ -281,6 +282,11 @@
(format t "~,v/cl-l10n:format-time/" "%A" 3192624000)
prints `Saturday'
+
+; The Time Zone can be overriden with an extra v argument
+(format t "~v,v,v/cl-l10n:format-time/" "en_ZA" "%A" -8 3192624000)
+ print `Sunday'
+
@end verbatim
@end deffn
@@ -297,7 +303,7 @@
drop in replacements for the ~/cl-l10n:format-?/ calls.
@verbatim
-;; These examples assume an en_ZA locale
+;; These examples assume an en_ZA locale and a CL -2 Time Zone
(in-package :cl-user)
(shadowing-import 'cl-l10n::format)
@@ -330,6 +336,30 @@
Parses the string @emph{num-string} into a number using @emph{locale}.
@end deffn
+@anchor{Function parse-time}
+@deffn {Function} parse-time time-string &key (start 0) (end (length time-string)) (error-on-mismatch nil) (patterns *default-date-time-patterns*) (default-seconds nil) (default-minutes nil) (default-hours nil) (default-day nil) (default-month nil) (default-year nil) (default-zone nil) (default-weekday nil) (locale *locale*)
+
+Tries very hard to make sense out of the argument time-string using
+locale and returns a single integer representing the universal time if
+successful. If not, it returns nil. If the :error-on-mismatch
+keyword is true, parse-time will signal an error instead of
+returning nil. Default values for each part of the time/date
+can be specified by the appropriate :default- keyword. These
+keywords can be given a numeric value or the keyword :current
+to set them to the current value. The default-default values
+are 00:00:00 on the current date, current time-zone.
+
+Example, what date does the string ``02/03/05'' specify?
+parse-time will use the current locale or the locale-designator
+passed to it to determine the correct format for dates.
+In America (en_US) this date is the 3rd of February 2005, with an South African English (en_ZA)
+locale this date is the 2nd of March 2005 and with a Swedish locale (sv_SE) it's the 5th of March 2002.
+
+Note. This is not my work but was done by Jim Healy and is a part of the CMUCL project,
+ which has been modified to handle differt locales.
+
+@end deffn
+
@section Classes
@anchor{Class locale}
@@ -348,12 +378,20 @@
@section Conditions
@anchor{Condition locale-error}
@deftp {Condition} locale-error
-Class Precedence: @code{condition}
+Class Precedence: @code{error}
Root CL-L10N condition which will be signalled when an exceptional
situation occurs.
@end deftp
+@anchor{Condition parser-error}
+@deftp {Condition} parser-error
+Class Precedence: @code{error}
+Error which is signalled when an error occurs when parsing numbers
+or time strings.
+@end deftp
+
+
@node I18N
@chapter I18N
@@ -482,17 +520,108 @@
is loaded. If these two have failed then the POSIX locale is loaded
as the default.
+@section Time Format Control Characters
+The following is a list of each legal control character in a time
+format string followed by a description of what is does.
+@itemize
+@item %% A percentage sign.
+@item %a locale's abbreviated weekday name (Sun..Sat)
+@item %A locale's full weekday name, variable length (Sunday..Saturday)
+@item %b locale's abbreviated month name (Jan..Dec)
+@item %B locale's full month name, variable length (January..December)
+@item %c locale's date and time (Sat Nov 04 12:02:33 EST 1989)
+@item %C century [00-99]
+@item %d day of month (01..31)
+@item %D date (mm/dd/yy)
+@item %e day of month, blank padded ( 1..31)
+@item %F same as %Y-%m-%d
+@item %g the 2-digit year corresponding to the %V week number
+@item %G the 4-digit year corresponding to the %V week number
+@item %h same as %b
+@item %H hour (00..23)
+@item %I hour (01..12)
+@item %j day of year (001..366)
+@item %k hour ( 0..23)
+@item %l hour ( 1..12)
+@item %m month (01..12)
+@item %M minute (00..59)
+@item %n a newline
+@item %N nanoseconds (Always 000000000)
+@item %p locale's upper case AM or PM indicator (blank in many locales)
+@item %P locale's lower case am or pm indicator (blank in many locales)
+@item %r time, 12-hour (hh:mm:ss [AP]M)
+@item %R time, 24-hour (hh:mm)
+@item %s seconds since `00:00:00 1970-01-01 UTC'
+@item %S second (00..60)
+@item %t a horizontal tab
+@item %T time, 24-hour (hh:mm:ss)
+@item %u day of week (1..7); 1 represents Monday
+@item %U week number of year with Sunday as first day of week (00..53)
+@item %V week number of year with Monday as first day of week (01..53)
+@item %w day of week (0..6); 0 represents Sunday
+@item %W week number of year with Monday as first day of week (00..53)
+@item %x locale's date representation (locale-d-fmt)
+@item %X locale's time representation (locale-t-fmt)
+@item %y last two digits of year (00..99)
+@item %Y year (1900...)
+@item %z RFC-2822 style numeric timezone (-0500)
+@item %Z RFC-2822 style numeric timezone (-0500)
+@end itemize
+
@section Accessors to Locale Values.
There are a number of accessor functions to the various locale
attributes defined. The functions are named by replacing
-underscores with hypens and prepending locale- to the name
-For example the attribute int_frac_digits
-can be accessed by the function @code{locale-int-frac-digits}.
+underscores with hypens and prepending locale- to the name.
+The following is each defined accessor function in the format
+Category, Keyword and the accessor function for it.
+@itemize
+@item LC_MONETARY int_curr_symbol @code{locale-int-curr-symbol}
+@item LC_MONETARY currency_symbol @code{locale-currency-symbol}
+@item LC_MONETARY mon_decimal_point @code{locale-mon-decimal-point}
+@item LC_MONETARY mon_thousands_sep @code{locale-mon-thousands-sep}
+@item LC_MONETARY mon_grouping @code{locale-mon-grouping}
+@item LC_MONETARY positive_sign @code{locale-positive-sign}
+@item LC_MONETARY negative_sign @code{locale-negative-sign}
+@item LC_MONETARY int_frac_digits @code{locale-int-frac-digits }
+@item LC_MONETARY frac_digits @code{locale-frac-digits }
+@item LC_MONETARY p_cs_precedes @code{locale-p-cs-precedes }
+@item LC_MONETARY p_sep_by_space @code{locale-p-sep-by-space }
+@item LC_MONETARY n_cs_precedes @code{locale-n-cs-precedes }
+@item LC_MONETARY n_sep_by_space @code{locale-n-sep-by-space }
+@item LC_MONETARY p_sign_posn @code{locale-p-sign-posn }
+@item LC_MONETARY n_sign_posn @code{locale-n-sign-posn }
+@item LC_NUMERIC decimal_point @code{locale-decimal-point}
+@item LC_NUMERIC thousands_sep @code{locale-thousands-sep}
+@item LC_NUMERIC grouping @code{locale-grouping }
+@item LC_TIME abday @code{locale-abday}
+@item LC_TIME day @code{locale-day}
+@item LC_TIME abmon @code{locale-abmon}
+@item LC_TIME mon @code{locale-mon}
+@item LC_TIME d_t_fmt @code{locale-d-t-fmt}
+@item LC_TIME d_fmt @code{locale-d-fmt}
+@item LC_TIME t_fmt @code{locale-t-fmt}
+@item LC_TIME am_pm @code{locale-am-pm}
+@item LC_TIME t_fmt_ampm @code{locale-t-fmt-ampm}
+@item LC_TIME date_fmt @code{locale-date-fmt}
+@item LC_MESSAGES yesexpr @code{locale-yesexpr}
+@item LC_MESSAGES noexpr @code{locale-noexpr}
+@item LC_PAPER height @code{locale-height}
+@item LC_PAPER width @code{locale-width}
+@item LC_NAME name_fmt @code{locale-name-fmt}
+@item LC_NAME name_gen @code{locale-name-gen}
+@item LC_NAME name_mr @code{locale-name-mr}
+@item LC_NAME name_mrs @code{locale-name-mrs}
+@item LC_NAME name_miss @code{locale-name-miss}
+@item LC_NAME name_ms @code{locale-name-ms}
+@item LC_ADDRESS postal_fmt @code{locale-postal-fmt}
+@item LC_TELEPHONE tel_int_fmt @code{locale-tel-int-fmt}
+@item LC_MEASUREMENT measurement @code{locale-measurement}
+@end itemize
@section Known Issues
@itemize @bullet
@item LC_COLLATE and LC_CTYPE categories in the locale files are currently ignored.
-@item Not all time format directives are supported.
+@item Not all time format directives are supported (U, V and W are not implemented).
@end itemize
1
0
[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/README cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/package.lisp cl-l10n/parse-number.lisp cl-l10n/parse-time.lisp cl-l10n/printers.lisp cl-l10n/tests.lisp
by sross@common-lisp.net 31 Mar '05
by sross@common-lisp.net 31 Mar '05
31 Mar '05
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory common-lisp.net:/tmp/cvs-serv7026
Modified Files:
ChangeLog README cl-l10n.asd load-locale.lisp locale.lisp
package.lisp parse-number.lisp parse-time.lisp printers.lisp
tests.lisp
Log Message:
Changelog 2005-03-31
Date: Thu Mar 31 15:53:42 2005
Author: sross
Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.15 cl-l10n/ChangeLog:1.16
--- cl-l10n/ChangeLog:1.15 Wed Mar 30 13:14:53 2005
+++ cl-l10n/ChangeLog Thu Mar 31 15:53:42 2005
@@ -1,3 +1,22 @@
+2005-03-31 Sean Ross <sross(a)common-lisp.net>
+ Version 0.3 Release
+ * parse-time.lisp, load-locale.lisp: Create
+ more comprehensive time parsers for each locale
+ at locale load time. 02/03/04 now parses correctly.
+ * tests.lisp: Added tests for the time parser.
+ * printers.lisp: Added a time-zone argument to format-time
+ and print-time.
+ * parse-number.lisp: Changed invalid-number condition to
+ parser-error condition.
+ * parse-time.lisp: Changed errors which are signalled during
+ parsing to be of type parser-error.
+ * locale.lisp: Changed superclass of locale-error to be error.
+ * tests.lisp: Changed all time related tests to use
+ a default time zone since they were crashing when running
+ in a zone other than +0200 (-2 CL Zone).
+ * doc/cl-l10n.texi: Made current and added full listing of
+ locale accessor functions and time format control characters.
+
2005-03-30 Sean Ross <sross(a)common-lisp.net>
* parse-time.lisp: New file borrowed from cmucl with
minor changes to be less hostile towards non english
@@ -23,7 +42,7 @@
* doc/cl-l10n.texi: Cleaned up so that it works with makeinfo.
2005-02-22 Sean Ross <sross(a)common-lisp.net>
- * printers.lisp: Added a formatter compiler macro
+ * printers.lisp: Added a format compiler macro
to remove unnecessary calls to parse-fmt-string.
* load-locale.lisp: Added a loader for the locale
function which will be called if passed in.
Index: cl-l10n/README
diff -u cl-l10n/README:1.2 cl-l10n/README:1.3
--- cl-l10n/README:1.2 Thu Dec 30 12:56:38 2004
+++ cl-l10n/README Thu Mar 31 15:53:42 2005
@@ -3,18 +3,22 @@
Homepage: http://www.common-lisp.net/project/cl-l10n/
-
0. About
cl-l10n is a localization package for common-lisp. It is meant
to be serve the same purpose as Allegro Common Lisp's
various locale functions. It currently runs on
-CMUCL, SBCL, CLISP, ECL and Lispworks although porting to a new
-implementation should be ridiculously trivial.
+CMUCL, SBCL, CLISP, ECL, Lispworks and Allegro CL although porting
+to a new implementation should be trivial.
1. API
-Check docs/cl-l10n.texi
+See docs/cl-l10n.texi
+
+2. Testing
+Run (asdf:oos 'asdf:test-op :cl-l10n) to test the package.
+If any tests fail please drop me a line at the mailing lists
+or at (sross <at> common-lisp.net)
Enjoy
Sean.
Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.12 cl-l10n/cl-l10n.asd:1.13
--- cl-l10n/cl-l10n.asd:1.12 Wed Mar 30 13:14:53 2005
+++ cl-l10n/cl-l10n.asd Thu Mar 31 15:53:42 2005
@@ -11,7 +11,7 @@
:name "CL-L10N"
:author "Sean Ross <sdr(a)jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr(a)jhb.ucs.co.za>"
- :version "0.2.9"
+ :version "0.3"
:description "Portable CL Locale Support"
:long-description "Portable CL Package to support localization"
:licence "MIT"
@@ -22,7 +22,7 @@
(:file "load-locale" :depends-on ("locale"))
(:file "printers" :depends-on ("load-locale"))
(:file "parsers" :depends-on ("printers" "parse-number"))
- (:file "parse-time" :depends-on ("parsers"))
+ (:file "parse-time" :depends-on ("load-locale"))
(:file "i18n" :depends-on ("printers")))
:depends-on (:cl-ppcre))
Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.11 cl-l10n/load-locale.lisp:1.12
--- cl-l10n/load-locale.lisp:1.11 Thu Mar 24 15:47:01 2005
+++ cl-l10n/load-locale.lisp Thu Mar 31 15:53:42 2005
@@ -60,6 +60,7 @@
escape comment))
(setf (get-category locale (category-name it)) it)))))
(add-printers locale)
+ (add-parsers locale)
locale)))
(defun load-all-locales (&optional (path *locale-path*))
@@ -140,6 +141,53 @@
(create-money-fmt-string locale nil t))
(printers locale))))
+(defun day-element-p (x)
+ (member x '(#\d #\e)))
+
+(defun month-element-p (x)
+ (char= x #\m))
+
+(defun year-element-p (x)
+ (member x '(#\y #\Y)))
+
+(defun element-type (char)
+ (cond ((day-element-p char) 'day)
+ ((month-element-p char) 'month)
+ ((year-element-p char) 'year)))
+
+(defvar date-dividers '(#\\ #\/ #\-))
+
+;; FIXME
+;; this effort definitely doesn't cover
+;; every single case but it will do for now.
+(defun locale-date-month-order (locale)
+ (let ((fmt (locale-d-fmt locale)))
+ (cond ((string= fmt "%D") '(month day year))
+ ((string= fmt "%F") '(year month day))
+ (t (compute-order fmt)))))
+
+(defun compute-order (fmt)
+ (let ((res nil))
+ (loop for char across fmt
+ with perc = nil do
+ (cond ((char= char #\%) (setf perc (not perc)))
+ ((member char date-dividers) nil)
+ (perc (let ((val (element-type char)))
+ (when val (push val res))
+ (setf perc nil)))))
+ (nreverse res)))
+
+
+(defun add-parsers (locale)
+ (destructuring-bind (first second third)
+ (locale-date-month-order locale)
+ (setf (parsers locale)
+ (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn))
+ `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute
+ (time-divider) (secondp) (am-pm) (date-divider) (zone))
+ `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider)
+ (secondp) (date-divider) ,third (date-divider) (zone))))))
+
(defvar *category-loaders*
'(("LC_IDENTIFICATION" . load-identification)
("LC_MONETARY" . load-category)
@@ -308,7 +356,7 @@
(notany #'(lambda (x)
(search x line :test #'string=))
*ignore-categories*))
- (return-from next-header line))))
+ (return-from next-header (trim line)))))
(defun load-default-locale ()
(setf *locale* (get-default-locale)))
Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.8 cl-l10n/locale.lisp:1.9
--- cl-l10n/locale.lisp:1.8 Tue Feb 22 15:18:25 2005
+++ cl-l10n/locale.lisp Thu Mar 31 15:53:42 2005
@@ -4,8 +4,8 @@
;; TODO
;; What to do with LC_CTYPE, LC_COLLATE
;; Test on windows.
-;; Parsers (money and time)
-;; locale aliases
+;; Parsers (money)
+;; locale aliases?
;; Optimizing print-time
;; Thread safety
@@ -24,7 +24,7 @@
(defun locale-report (obj stream)
(cl:format stream "~A" (mesg obj)))
-(define-condition locale-error ()
+(define-condition locale-error (error)
((mesg :accessor mesg :initarg :mesg :initform "Unknown."))
(:report locale-report))
@@ -37,6 +37,7 @@
:initform (required-arg :name))
(title :accessor title :initarg :title :initform nil)
(printers :accessor printers :initarg :printers :initform nil)
+ (parsers :accessor parsers :initarg :parsers :initform nil)
(source :accessor source :initarg :source :initform nil)
(language :accessor language :initarg :language :initform nil)
(territory :accessor territory :initarg :territory :initform nil)
Index: cl-l10n/package.lisp
diff -u cl-l10n/package.lisp:1.5 cl-l10n/package.lisp:1.6
--- cl-l10n/package.lisp:1.5 Wed Mar 30 13:14:53 2005
+++ cl-l10n/package.lisp Thu Mar 31 15:53:42 2005
@@ -13,5 +13,5 @@
#: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))
+ #:secondp #:am-pm #:zone #:parser-error))
Index: cl-l10n/parse-number.lisp
diff -u cl-l10n/parse-number.lisp:1.3 cl-l10n/parse-number.lisp:1.4
--- cl-l10n/parse-number.lisp:1.3 Thu Dec 30 12:56:38 2004
+++ cl-l10n/parse-number.lisp Thu Mar 31 15:53:42 2005
@@ -32,7 +32,7 @@
(in-package #:cl-l10n)
-(define-condition invalid-number ()
+(define-condition parser-error (error)
((value :reader value
:initarg :value
:initform nil)
@@ -40,7 +40,7 @@
:initarg :reason
:initform "Not specified"))
(:report (lambda (c s)
- (cl:format s "Invalid number: ~S [Reason: ~A]"
+ (cl:format s "Unable to parse: ~S [Reason: ~A]"
(value c) (reason c)))))
(declaim (inline parse-integer-and-places))
@@ -106,7 +106,7 @@
(defun %parse-number (string &key (start 0) (end nil) (radix 10))
"Given a string, and start, end, and radix parameters, produce a number according to the syntax definitions in the Common Lisp Hyperspec."
(flet ((invalid-number (reason)
- (error 'invalid-number
+ (error 'parser-error
:value (subseq string start end)
:reason reason)))
(let ((end (or end (length string))))
@@ -179,7 +179,7 @@
:end end
:key #'char-downcase)))
(unless r-pos
- (error 'invalid-number
+ (error 'parser-error
:value (subseq string start end)
:reason "Missing R in #radixR"))
(parse-real-number string
@@ -198,7 +198,7 @@
(let ((end (or end (length string)))
(first-char (char string start)))
(flet ((invalid-number (reason)
- (error 'invalid-number
+ (error 'parser-error
:value (subseq string start end)
:reason reason))
(base-for-exponent-marker (char)
Index: cl-l10n/parse-time.lisp
diff -u cl-l10n/parse-time.lisp:1.1 cl-l10n/parse-time.lisp:1.2
--- cl-l10n/parse-time.lisp:1.1 Wed Mar 30 13:23:56 2005
+++ cl-l10n/parse-time.lisp Thu Mar 31 15:53:42 2005
@@ -13,14 +13,13 @@
;;; **********************************************************************
;; This has been borrowed and slightly modified to be more friendly
-;; towards non english time strings and differing locales.
+;; towards non english time strings and locales.
;; Sean Ross 29 March 2005.
(in-package :cl-l10n)
(defvar whitespace-chars '(#\space #\tab #\newline #\, #\' #\`))
(defvar time-dividers '(#\: #\.))
-(defvar date-dividers '(#\\ #\/ #\-))
(defvar *error-on-mismatch* nil
"If t, an error will be signalled if parse-time is unable
@@ -69,7 +68,12 @@
;;; year, time-divider, date-divider, am-pm, zone, izone, weekday,
;;; noon-midn, and any special symbol.
-; TODO (add more linux like dates. eg 3 days ago)
+#|
+
+
+
+|#
+
(defparameter *default-date-time-patterns*
'(
@@ -88,13 +92,9 @@
((noon-midn) month (date-divider) year)
((noon-midn) year (date-divider) month)
- ;; Time formats.
- (hour (time-divider) (minute) (time-divider) (secondp) (am-pm)
- (date-divider) (zone))
- (noon-midn)
- (hour (noon-midn))
- ;; Time/date combined formats.
+ ;; Time/date combined formats.
+
((weekday) month (date-divider) day (date-divider) year
hour (time-divider) (minute) (time-divider) (secondp)
(am-pm) (date-divider) (zone))
@@ -131,6 +131,13 @@
(hour (time-divider) (minute) (time-divider) (secondp) (am-pm)
(date-divider) (zone) year (date-divider) month)
+
+ ;; Time formats.
+ (hour (time-divider) (minute) (time-divider) (secondp) (am-pm)
+ (date-divider) (zone))
+ (noon-midn)
+ (hour (noon-midn))
+
;; Weird, non-standard formats.
(weekday month day hour (time-divider) minute (time-divider)
secondp (am-pm)
@@ -402,8 +409,9 @@
(let ((test-value (special-string-p substring)))
(if test-value (cons 'special test-value)))
(if *error-on-mismatch*
- (error "\"~A\" is not a recognized word or abbreviation."
- substring)
+ (error 'parser-error
+ :value substring
+ :reason "Not a recognized word or abbreviation.")
(return-from match-substring nil)))))
;;; Decompose-string takes the time/date string and decomposes it into a
@@ -473,11 +481,9 @@
(t
;; Unrecognized character - barf voraciously.
(if *error-on-mismatch*
- (error
- 'simple-error
- :format-control "Can't parse time/date string.~%>>> ~A~
- ~%~VT^-- Bogus character encountered here."
- :format-arguments (list string (+ string-index 4)))
+ (error 'parser-error
+ :value string
+ :reason "Can't parse time/date string. Bogus character encountered.")
(return-from decompose-string nil)))))))
;;; Match-pattern-element tries to match a pattern element with a datum
@@ -533,7 +539,8 @@
(setf (decoded-time-hour parsed-values) 12))
((eq form-value 'midn)
(setf (decoded-time-hour parsed-values) 0))
- (t (error "Unrecognized symbol: ~A" form-value)))
+ (t (error 'parser-error :value form-value
+ :reason "Unrecognized symbol.")))
(setf (decoded-time-minute parsed-values) 0)
(setf (decoded-time-second parsed-values) 0))
@@ -548,12 +555,12 @@
(setf (decoded-time-hour parsed-values) 0))
((not (<= 0 hour 12))
(if *error-on-mismatch*
- (error "~D is not an AM hour, dummy." hour)))))
+ (error 'parser-error :value hour :reason "Not an AM hour, dummy.")))))
((eq form-value 'pm)
(if (<= 0 hour 11)
(setf (decoded-time-hour parsed-values)
(mod (+ hour 12) 24))))
- (t (error "~A isn't AM/PM - this shouldn't happen."
+ (t (error 'parser-error :value form-value :reason "Not an AM/PM - this shouldn't happen."
form-value)))))
;;; Internet numerical time zone, e.g. RFC1123, in hours and minutes.
@@ -582,47 +589,8 @@
(am-pm (deal-with-am-pm form-value parsed-values))
(noon-midn (deal-with-noon-midn form-value parsed-values))
(special (funcall form-value parsed-values))
- (t (error "Unrecognized symbol in form list: ~A." form-type))))))
-
-(defun day-element-p (x)
- (member x '(#\d #\e)))
-
-(defun month-element-p (x)
- (char= x #\m))
+ (t (error 'parser-error :value form-type :reason "Unrecognized symbol in form list."))))))
-(defun year-element-p (x)
- (member x '(#\y #\Y)))
-
-(defun element-type (char)
- (cond ((day-element-p char) 'day)
- ((month-element-p char) 'month)
- ((year-element-p char) 'year)))
-
-;; FIXME
-;; this effort definitely doesn't cover
-;; every single case but it will do for now.
-(defun locale-date-month-order ()
- (let ((fmt (locale-d-fmt)))
- (cond ((string= fmt "%D") '(month day year))
- ((string= fmt "%F") '(year month day))
- (t (compute-order fmt)))))
-
-(defun compute-order (fmt)
- (let ((res nil))
- (loop for char across fmt
- with perc = nil do
- (cond ((char= char #\%) (setf perc (not perc)))
- ((member char date-dividers) nil)
- (perc (let ((val (element-type char)))
- (when val (push val res))
- (setf perc nil)))))
- (nreverse res)))
-
-(defun locale-date-pattern ()
- (let ((order (locale-date-month-order)))
- (when order
- (loop for x in order
- append (list x '(date-divider))))))
(defun default-patterns-p (patterns)
(eq patterns *default-date-time-patterns*))
@@ -632,11 +600,12 @@
;; patterns have not been explicitly specified so we try
;; to match against locale a specific date pattern first.
;; eg. 03/04/2005 is 3rd April in UK but 4 March in US.
- (let ((res (match-pattern (locale-date-pattern)
- string-parts
- parts-length)))
- (when res
- (return-from get-matching-pattern res))))
+ (dolist (pattern (parsers *locale*))
+ (let ((res (match-pattern pattern
+ string-parts
+ parts-length)))
+ (when res
+ (return-from get-matching-pattern res)))))
(dolist (pattern patterns)
(let ((match-result (match-pattern pattern string-parts
parts-length)))
@@ -652,8 +621,8 @@
(default-month nil) (default-year nil)
(default-zone nil) (default-weekday nil)
(locale *locale*))
- "Tries very hard to make sense out of the argument time-string and
- returns a single integer representing the universal time if
+ "Tries very hard to make sense out of the argument time-string using
+ locale and returns a single integer representing the universal time if
successful. If not, it returns nil. If the :error-on-mismatch
keyword is true, parse-time will signal an error instead of
returning nil. Default values for each part of the time/date
@@ -674,7 +643,7 @@
(set-time-values string-form parsed-values)
(convert-to-unitime parsed-values))
(if *error-on-mismatch*
- (error "\"~A\" is not a recognized time/date format." time-string)
+ (error 'parser-error :value time-string :reason "Not a recognized time/date format.")
nil))))
Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.13 cl-l10n/printers.lisp:1.14
--- cl-l10n/printers.lisp:1.13 Wed Mar 30 13:14:54 2005
+++ cl-l10n/printers.lisp Thu Mar 31 15:53:42 2005
@@ -314,9 +314,11 @@
(def-formatter #\Z
(print-time-string "%z" stream ut locale))
-(defun format-time (stream ut show-date show-time &optional (locale *locale*)
- fmt)
- (let ((locale (locale-des->locale (or locale *locale*))))
+(defvar *time-zone* (nth-value 8 (get-decoded-time)))
+
+(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*)))
(print-time-string (or fmt (get-time-fmt-string locale
show-date show-time))
stream ut locale))
@@ -324,7 +326,7 @@
(defun print-time-string (fmt-string stream ut locale)
(declare (optimize speed) (type simple-string fmt-string))
- (let ((values (multiple-value-list (decode-universal-time ut))))
+ (let ((values (multiple-value-list (decode-universal-time ut *time-zone*))))
(loop for x across fmt-string
with perc = nil do
(case x
@@ -338,8 +340,8 @@
(princ x stream)))))))
(defun print-time (ut &key show-date show-time (stream *standard-output*)
- (locale *locale*) fmt)
- (format-time stream ut show-date show-time locale fmt)
+ (locale *locale*) fmt time-zone)
+ (format-time stream ut show-date show-time locale fmt time-zone)
ut)
Index: cl-l10n/tests.lisp
diff -u cl-l10n/tests.lisp:1.6 cl-l10n/tests.lisp:1.7
--- cl-l10n/tests.lisp:1.6 Wed Mar 23 11:58:16 2005
+++ cl-l10n/tests.lisp Thu Mar 31 15:53:42 2005
@@ -8,95 +8,95 @@
(rem-all-tests)
(deftest load-locs
- (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
+ (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
(locale "en_US") (locale "af_ZA") t)
- t)
+ t)
+
;; 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
(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
(deftest time.1
- (format nil "~v:@/cl-l10n:format-time/" "en_ZA" 3091103120)
- "Sun 14 Dec 1997 17:45:20 +0200")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "en_ZA" 0 3091103120)
+ "Sun 14 Dec 1997 15:45:20 +0000")
(deftest time.2
- (format nil "~v:@/cl-l10n:format-time/" "sv_SE" 3091103120)
- "sön 14 dec 1997 17.45.20")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
+ "sön 14 dec 1997 15.45.20")
(deftest time.3
- (format nil "~v/cl-l10n:format-time/" "en_US" 3091103120)
- "05: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@/cl-l10n:format-time/" "en_US" 3091103120)
- "17:45:20 ")
+ (format nil "~v,,v@/cl-l10n:format-time/" "en_US" 0 3091103120)
+ "15:45:20 ")
(deftest time.6
- (format nil "~v@/cl-l10n:format-time/" "sv_SE" 3091103120)
- "17.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,vU" "en_ZA" ,directive 3320556360)
+ `(deftest ,name (format nil "~v,v,vU" "en_ZA" ,directive 0 3320556360)
,result))
(def-time-directive-test directive.1 "%%" "%")
@@ -104,7 +104,7 @@
(def-time-directive-test directive.3 "%A" "Wednesday")
(def-time-directive-test directive.4 "%b" "Mar")
(def-time-directive-test directive.5 "%B" "March")
-(def-time-directive-test directive.6 "%c" "Wed 23 Mar 2005 10:46:00 +0200")
+(def-time-directive-test directive.6 "%c" "Wed 23 Mar 2005 08:46:00 +0000")
(def-time-directive-test directive.7 "%C" "20")
(def-time-directive-test directive.8 "%d" "23")
(def-time-directive-test directive.9 "%D" "03/23/05")
@@ -113,11 +113,11 @@
(def-time-directive-test directive.12 "%g" "05")
(def-time-directive-test directive.13 "%G" "2005")
(def-time-directive-test directive.14 "%h" "Mar")
-(def-time-directive-test directive.15 "%H" "10")
-(def-time-directive-test directive.16 "%I" "10")
+(def-time-directive-test directive.15 "%H" "08")
+(def-time-directive-test directive.16 "%I" "08")
(def-time-directive-test directive.17 "%j" "082")
-(def-time-directive-test directive.18 "%k" "10")
-(def-time-directive-test directive.19 "%l" "10")
+(def-time-directive-test directive.18 "%k" " 8")
+(def-time-directive-test directive.19 "%l" " 8")
(def-time-directive-test directive.21 "%m" "03")
(def-time-directive-test directive.22 "%M" "46")
(def-time-directive-test directive.23 "%n" "
@@ -125,23 +125,23 @@
(def-time-directive-test directive.24 "%N" "000000000")
(def-time-directive-test directive.25 "%p" "")
(def-time-directive-test directive.26 "%P" "")
-(def-time-directive-test directive.27 "%r" "10:46:00 ")
-(def-time-directive-test directive.28 "%R" "10:46")
+(def-time-directive-test directive.27 "%r" "08:46:00 ")
+(def-time-directive-test directive.28 "%R" "08:46")
(def-time-directive-test directive.29 "%s" "1111567560")
(def-time-directive-test directive.30 "%S" "00")
(def-time-directive-test directive.31 "%t" " ")
-(def-time-directive-test directive.32 "%T" "10:46:00")
+(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.36 "%w" "3")
;(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" "10:46:00")
+(def-time-directive-test directive.39 "%X" "08:46:00")
(def-time-directive-test directive.40 "%y" "05")
(def-time-directive-test directive.41 "%Y" "2005")
-(def-time-directive-test directive.42 "%z" "+0200")
-(def-time-directive-test directive.43 "%Z" "+0200")
+(def-time-directive-test directive.42 "%z" "+0000")
+(def-time-directive-test directive.43 "%Z" "+0000")
@@ -155,48 +155,111 @@
"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
(deftest format.1
- (format nil "~v:@U" "en_ZA" 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
(deftest formatter.1
- (format nil (formatter "~v:@U") "en_ZA" 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
(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-time
+(deftest parse-time.1
+ (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)
+
+(deftest parse-time.3
+ (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)
+
+(deftest parse-time.5
+ (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)
+
+(deftest parse-time.7
+ (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)
+
+(deftest parse-time.9
+ (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)
+
+
+
;; EOF
1
0
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory common-lisp.net:/tmp/cvs-serv12565
Added Files:
parse-time.lisp
Log Message:
Added parse-time.lisp
Date: Wed Mar 30 13:23:56 2005
Author: sross
1
0