- cl-l10n-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[cl-l10n-cvs] CVS cl-l10n
by sross 27 Apr '06

27 Apr '06

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

[cl-l10n-cvs] CVS cl-l10n/doc
by sross 27 Apr '06

27 Apr '06

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">  <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">  <head> <title>%%TITLE%%</title> <meta http-equiv="content-type" content='text/html; charset=utf-8' />   <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>      <body> <h3>%%TITLE%%</h3>  <address>last updated %%DATE%%</address>  <hr /> <p>This document  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> Copyright (C) 2004-2006 Sean Ross <sross at common-lisp.net><br />  </p> <p> Updated: %%DATE%%    </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

[cl-l10n-cvs] CVS cl-l10n
by sross 20 Mar '06

20 Mar '06

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

[cl-l10n-cvs] CVS update: cl-l10n/locales/ar_SA
by sross＠common-lisp.net 25 May '05

25 May '05

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

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

[cl-l10n-cvs] CVS update: cl-l10n/locales/ar_SA
by sross＠common-lisp.net 18 May '05

18 May '05

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

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

[cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi
by sross＠common-lisp.net 31 Mar '05

31 Mar '05

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

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

[cl-l10n-cvs] CVS update: cl-l10n/parse-time.lisp
by sross＠common-lisp.net 30 Mar '05

30 Mar '05

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