April 2006 - cl-l10n-cvs@common-lisp.net - mailman3.common-lisp.net

[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-serv9576/doc Added Files: .cvsignore Log Message: --- /project/cl-l10n/cvsroot/cl-l10n/doc/.cvsignore 2006/04/27 18:37:35 NONE +++ /project/cl-l10n/cvsroot/cl-l10n/doc/.cvsignore 2006/04/27 18:37:35 1.1 cl-l10n.aux cl-l10n.cp cl-l10n.fn cl-l10n.fns cl-l10n.info cl-l10n.ky cl-l10n.log cl-l10n.pg cl-l10n.toc cl-l10n.tp cl-l10n.tps cl-l10n.vr cl-l10n.vrs manual

1 0

[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