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@jhb.ucs.co.za" - :maintainer "Sean Ross sdr@jhb.ucs.co.za" - :version "0.3.4" + :author "Sean Ross sross@common-lisp.net" + :maintainer "Sean Ross sross@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@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@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@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@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.