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

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/package.lisp cl-l10n/parsers.lisp cl-l10n/printers.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-serv11724 Modified Files: ChangeLog cl-l10n.asd package.lisp parsers.lisp printers.lisp Log Message: Changelog 2005-03-30 Date: Wed Mar 30 13:14:54 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.14 cl-l10n/ChangeLog:1.15 --- cl-l10n/ChangeLog:1.14 Thu Mar 24 15:47:01 2005 +++ cl-l10n/ChangeLog Wed Mar 30 13:14:53 2005 @@ -1,3 +1,14 @@ +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 + dates and times. + * package.lisp: Exported parse-time and various pattern + symbols. + +2005-03-29 Sean Ross <sross(a)common-lisp.net> + * printers.lisp: Fix to %z time format directive, 0 time zone + was printed as -0000, should be +0000 + 2005-03-24 Sean Ross <sross(a)common-lisp.net> * cl-l10n.asd, load-locale.lisp: Moved loading of initial locale to the asdf load-op. Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.11 cl-l10n/cl-l10n.asd:1.12 --- cl-l10n/cl-l10n.asd:1.11 Thu Mar 24 15:47:01 2005 +++ cl-l10n/cl-l10n.asd Wed Mar 30 13:14:53 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.6" + :version "0.2.9" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" @@ -22,6 +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 "i18n" :depends-on ("printers"))) :depends-on (:cl-ppcre)) Index: cl-l10n/package.lisp diff -u cl-l10n/package.lisp:1.4 cl-l10n/package.lisp:1.5 --- cl-l10n/package.lisp:1.4 Thu Dec 30 12:56:38 2004 +++ cl-l10n/package.lisp Wed Mar 30 13:14:53 2005 @@ -10,5 +10,8 @@ #:*locale* #:*locale-path* #:*locales* #:format-number #:print-number #:format-money #:print-money #:format-time #:print-time #:add-resources #:bundle - #:add-resource #:gettext #:parse-number #:*float-digits*)) + #: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)) Index: cl-l10n/parsers.lisp diff -u cl-l10n/parsers.lisp:1.2 cl-l10n/parsers.lisp:1.3 --- cl-l10n/parsers.lisp:1.2 Fri Dec 17 11:06:43 2004 +++ cl-l10n/parsers.lisp Wed Mar 30 13:14:53 2005 @@ -9,15 +9,15 @@ (case (length ts) (0 num) (1 (remove (schar ts 0) num)) - (t num)))) + (t num)))) ; FIXME (defun replace-dp (num locale) (let ((dp (locale-decimal-point locale))) (case (length dp) (0 num) (1 (substitute #\. (schar dp 0) num)) - (t num)))) - + (t num)))) ; FIXME ;; money parser -;; EOF \ No newline at end of file + +;; EOF Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.12 cl-l10n/printers.lisp:1.13 --- cl-l10n/printers.lisp:1.12 Thu Mar 24 15:47:01 2005 +++ cl-l10n/printers.lisp Wed Mar 30 13:14:54 2005 @@ -21,7 +21,7 @@ (princ "0" s))))) (defun format-number (stream arg no-dp no-ts - &optional (locale *locale*)) + &optional (locale *locale*)) (let ((locale (locale-des->locale locale)) (float-part (float-part (coerce (abs arg) 'double-float)))) (cl:format stream @@ -35,7 +35,7 @@ (values))) (defun print-number (number &key (stream *standard-output*) - no-ts no-dp (locale *locale*)) + no-ts no-dp (locale *locale*)) (format-number stream number no-dp no-ts locale) number) @@ -84,7 +84,7 @@ (values)) (defun print-money (num &key (stream *standard-output*) use-int-sym no-ts - (locale *locale*)) + (locale *locale*)) (format-money stream num use-int-sym no-ts locale) num) @@ -135,56 +135,56 @@ (mod val 100)) (def-formatter #\a - (let ((day (1+ day))) - (if (> day 6) (decf day 7)) - (princ (nth day (locale-abday locale)) stream))) + (let ((day (1+ day))) + (if (> day 6) (decf day 7)) + (princ (nth day (locale-abday locale)) stream))) (def-formatter #\A - (let ((day (1+ day))) - (if (> day 6) (decf day 7)) - (princ (nth day (locale-day locale)) stream))) + (let ((day (1+ day))) + (if (> day 6) (decf day 7)) + (princ (nth day (locale-day locale)) stream))) (def-formatter #\b - (cl:format stream (cl:formatter "~A") - (nth (1- month) (locale-abmon locale)))) + (cl:format stream (cl:formatter "~A") + (nth (1- month) (locale-abmon locale)))) (def-formatter #\B - (cl:format stream (cl:formatter "~A") - (nth (1- month) (locale-mon locale)))) + (cl:format stream (cl:formatter "~A") + (nth (1- month) (locale-mon locale)))) (def-formatter #\c (print-time-string (locale-d-t-fmt locale) stream ut locale)) (def-formatter #\C - (princ-pad-val (truncate (/ year 100)) stream)) + (princ-pad-val (truncate (/ year 100)) stream)) (def-formatter #\d - (princ-pad-val date stream)) + (princ-pad-val date stream)) (def-formatter #\D - (print-time-string "%m/%d/%y" stream ut locale)) + (print-time-string "%m/%d/%y" stream ut locale)) (def-formatter #\e - (princ-pad-val date stream " ")) + (princ-pad-val date stream " ")) (def-formatter #\F - (print-time-string "%Y-%m-%d" stream ut locale)) + (print-time-string "%Y-%m-%d" stream ut locale)) (def-formatter #\g - (print-time-string "%y" stream ut locale)) + (print-time-string "%y" stream ut locale)) (def-formatter #\G - (print-time-string "%Y" stream ut locale)) + (print-time-string "%Y" stream ut locale)) (def-formatter #\h - (princ (nth (1- month) (locale-abmon locale)) - stream)) + (princ (nth (1- month) (locale-abmon locale)) + stream)) (def-formatter #\H - (princ-pad-val hour stream)) + (princ-pad-val hour stream)) (def-formatter #\I - (princ-pad-val (if (> hour 12) (- hour 12) hour) stream)) + (princ-pad-val (if (> hour 12) (- hour 12) hour) stream)) (defvar *mon-days* '(31 28 31 30 31 30 31 31 30 31 30 31)) @@ -201,85 +201,85 @@ (defun day-of-year (date month year) (let ((total 0)) (loop repeat (1- month) - for x in (if (leap-year-p year) *mon-days-leap* *mon-days*) do - (incf total x)) + for x in (if (leap-year-p year) *mon-days-leap* *mon-days*) do + (incf total x)) (incf total date))) (def-formatter #\j - (princ-pad-val (day-of-year date month year) stream "0" 3)) + (princ-pad-val (day-of-year date month year) stream "0" 3)) (def-formatter #\k - (princ-pad-val hour stream " ")) + (princ-pad-val hour stream " ")) (def-formatter #\l - (princ-pad-val (if (> hour 12) (- hour 12) hour) stream - " ")) + (princ-pad-val (if (> hour 12) (- hour 12) hour) stream + " ")) (def-formatter #\m - (princ-pad-val month stream)) + (princ-pad-val month stream)) (def-formatter #\M - (princ-pad-val min stream)) + (princ-pad-val min stream)) (def-formatter #\n - (princ #\Newline stream)) + (princ #\Newline stream)) (def-formatter #\N - (princ "000000000" stream)) + (princ "000000000" stream)) (defun get-am-pm (hour locale) (funcall (if (< hour 12) #'car #'cadr) (locale-am-pm locale))) (def-formatter #\p - (princ (string-upcase (get-am-pm hour locale)) - stream)) + (princ (string-upcase (get-am-pm hour locale)) + stream)) (def-formatter #\P - (princ (string-downcase (get-am-pm hour locale)) - stream)) + (princ (string-downcase (get-am-pm hour locale)) + stream)) (def-formatter #\r - (print-time-string "%H:%M:%S %p" stream ut locale)) + (print-time-string "%H:%M:%S %p" stream ut locale)) (def-formatter #\R - (print-time-string "%H:%M" stream ut locale)) + (print-time-string "%H:%M" stream ut locale)) (defvar *1970-01-01* (encode-universal-time 0 0 0 01 01 1970 0)) (def-formatter #\s - (princ (- ut *1970-01-01*) stream)) + (princ (- ut *1970-01-01*) stream)) (def-formatter #\S - (princ-pad-val sec stream)) + (princ-pad-val sec stream)) (def-formatter #\t - (princ #\Tab stream)) + (princ #\Tab stream)) (def-formatter #\T - (print-time-string "%H:%M:%S" stream ut locale)) + (print-time-string "%H:%M:%S" stream ut locale)) (def-formatter #\u - (let ((day (1+ day))) - (when (> day 7) (decf day 7)) - (princ day stream))) + (let ((day (1+ day))) + (when (> day 7) (decf day 7)) + (princ day stream))) ;; FIXME (def-formatter #\U - (locale-error "Unsupported time format directive ~S." #\U)) + (locale-error "Unsupported time format directive ~S." #\U)) ;; FIXME (def-formatter #\V - (locale-error "Unsupported time format directive ~S." #\V)) + (locale-error "Unsupported time format directive ~S." #\V)) (def-formatter #\w - (let ((day (1+ day))) - (when (>= day 7) (decf day 7)) - (princ day stream))) + (let ((day (1+ day))) + (when (>= day 7) (decf day 7)) + (princ day stream))) ;; FIXME (def-formatter #\W - (locale-error "Unsupported time format directive ~S." #\W)) + (locale-error "Unsupported time format directive ~S." #\W)) (def-formatter #\x (print-time-string (locale-d-fmt locale) stream ut locale)) @@ -288,25 +288,34 @@ (print-time-string (locale-t-fmt locale) stream ut locale)) (def-formatter #\y - (princ-pad-val (last-2-digits year) stream)) + (princ-pad-val (last-2-digits year) stream)) (def-formatter #\Y - (princ year stream)) + (princ year stream)) -(def-formatter #\z - (let ((d-zone (if daylight-p (1- zone) zone))) - (multiple-value-bind (hr mn) (truncate (abs d-zone)) - (princ (if (minusp d-zone) #\+ #\-) stream) - (cl:format stream (cl:formatter "~2,'0D~2,'0D") - hr (floor (* 60 mn)))))) -;; FIXME should be printing SAST rather than +0200 +; This was all severely broken until I took a look +; at Daniel Barlow's net-telent-date package, +; which is a must read for anyone working with dates +; in CL. +(def-formatter #\z + (let ((d-zone (if daylight-p (1- zone) zone))) + (multiple-value-bind (hr mn) (truncate (abs d-zone)) + (princ (if (<= d-zone 0) #\+ #\-) stream) + (cl:format stream (cl:formatter "~2,'0D~2,'0D") + hr (floor (* 60 mn)))))) + +;; Probably Should be printing SAST rather than +0200 +;; but since all these wonderful codes are not +;; standardized i'm keeping it the same as %z +;; so that we can parse it back. +;; eg. Does IST mean 'Israeli Standard Time','Indian Standard Time' +;; or 'Irish Summer Time' ? (def-formatter #\Z - (print-time-string "%z" stream ut locale)) - + (print-time-string "%z" stream ut locale)) (defun format-time (stream ut show-date show-time &optional (locale *locale*) - fmt) + fmt) (let ((locale (locale-des->locale (or locale *locale*)))) (print-time-string (or fmt (get-time-fmt-string locale show-date show-time)) @@ -317,19 +326,19 @@ (declare (optimize speed) (type simple-string fmt-string)) (let ((values (multiple-value-list (decode-universal-time ut)))) (loop for x across fmt-string - with perc = nil do - (case x - (#\% (if perc - (progn (princ #\% stream) (setf perc nil)) - (setf perc t))) - (t (if perc - (progn (apply (the function (lookup-formatter x)) - stream locale ut values) - (setf perc nil)) - (princ x stream))))))) + with perc = nil do + (case x + (#\% (if perc + (progn (princ #\% stream) (setf perc nil)) + (setf perc t))) + (t (if perc + (progn (apply (the function (lookup-formatter x)) + stream locale ut values) + (setf perc nil)) + (princ x stream))))))) (defun print-time (ut &key show-date show-time (stream *standard-output*) - (locale *locale*) fmt) + (locale *locale*) fmt) (format-time stream ut show-date show-time locale fmt) ut) @@ -367,17 +376,17 @@ (declare (optimize speed) (type string string)) (with-output-to-string (fmt-string) (loop for char across string - with tilde = nil do - (case char - ((#\@ #\v #\, #\:) (princ char fmt-string)) - (#\~ (princ char fmt-string) - (if tilde - (setf tilde nil) - (setf tilde t))) - (t (if tilde - (progn (setf tilde nil) - (princ (get-replacement char) fmt-string)) - (princ char fmt-string))))))) + with tilde = nil do + (case char + ((#\@ #\v #\, #\:) (princ char fmt-string)) + (#\~ (princ char fmt-string) + (if tilde + (setf tilde nil) + (setf tilde t))) + (t (if tilde + (progn (setf tilde nil) + (princ (get-replacement char) fmt-string)) + (princ char fmt-string))))))) (defvar *directive-replacements* '((#\M . "/cl-l10n:format-money/")

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/printers.lisp
by sross＠common-lisp.net 24 Mar '05

24 Mar '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv12231 Modified Files: ChangeLog cl-l10n.asd load-locale.lisp printers.lisp Log Message: Changelog 2005-03-24 Date: Thu Mar 24 15:47:02 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.13 cl-l10n/ChangeLog:1.14 --- cl-l10n/ChangeLog:1.13 Wed Mar 23 11:58:16 2005 +++ cl-l10n/ChangeLog Thu Mar 24 15:47:01 2005 @@ -1,3 +1,9 @@ +2005-03-24 Sean Ross <sross(a)common-lisp.net> + * cl-l10n.asd, load-locale.lisp: Moved loading of initial locale + to the asdf load-op. + * load-locale.lisp: Bug fix, incorrect order of arguments to + get-category in copy-category. + 2005-03-23 Sean Ross <sross(a)common-lisp.net> * printers.lisp: Fixed the %w, %e, %x, %X, %d and %j time format directives. * tests.lisp: Added a test for each supported time format directive. Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.10 cl-l10n/cl-l10n.asd:1.11 --- cl-l10n/cl-l10n.asd:1.10 Wed Mar 23 11:58:16 2005 +++ cl-l10n/cl-l10n.asd Thu Mar 24 15:47:01 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.5" + :version "0.2.6" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" @@ -26,6 +26,7 @@ :depends-on (:cl-ppcre)) (defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n)))) + (funcall (find-symbol "LOAD-DEFAULT-LOCALE" "CL-L10N")) (provide 'cl-l10n)) @@ -40,4 +41,4 @@ (defmethod perform ((op test-op) (sys (eql (find-system :cl-l10n-tests)))) (funcall (find-symbol "DO-TESTS" "REGRESSION-TEST"))) -;; EOF \ No newline at end of file +;; EOF Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.10 cl-l10n/load-locale.lisp:1.11 --- cl-l10n/load-locale.lisp:1.10 Tue Feb 22 15:18:25 2005 +++ cl-l10n/load-locale.lisp Thu Mar 24 15:47:01 2005 @@ -196,7 +196,7 @@ (let ((from (trim (subseq line (position #\Space line)) (cons #\" *whitespace*)))) (handler-case (let* ((locale (locale from))) - (or (get-category cat locale) + (or (get-category locale cat) (locale-error "No category ~A in locale ~A." cat from))) (error (c) (locale-error "Unable to copy Category ~A from ~A. ~A." @@ -318,7 +318,6 @@ (locale (getenv "LC_CTYPE") :errorp nil) (locale "POSIX"))) -(load-default-locale) ;; EOF Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.11 cl-l10n/printers.lisp:1.12 --- cl-l10n/printers.lisp:1.11 Wed Mar 23 11:58:16 2005 +++ cl-l10n/printers.lisp Thu Mar 24 15:47:01 2005 @@ -338,7 +338,7 @@ (define-compiler-macro format (&whole form dest control &rest args) "Compiler macro to remove unnecessary calls to parse-fmt-string." (if (stringp control) - `(cl::format ,dest ,(really-parse-fmt-string control) ,@args) + `(cl::format ,dest ,(parse-fmt-string control) ,@args) form)) (defmacro formatter (fmt-string)

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/printers.lisp cl-l10n/tests.lisp cl-l10n/utils.lisp
by sross＠common-lisp.net 23 Mar '05

23 Mar '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv11902 Modified Files: ChangeLog cl-l10n.asd printers.lisp tests.lisp utils.lisp Log Message: Changelog 2005-03-23 Date: Wed Mar 23 11:58:16 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.12 cl-l10n/ChangeLog:1.13 --- cl-l10n/ChangeLog:1.12 Thu Mar 17 12:40:34 2005 +++ cl-l10n/ChangeLog Wed Mar 23 11:58:16 2005 @@ -1,6 +1,9 @@ +2005-03-23 Sean Ross <sross(a)common-lisp.net> + * printers.lisp: Fixed the %w, %e, %x, %X, %d and %j time format directives. + * tests.lisp: Added a test for each supported time format directive. + 2005-03-17 Sean Ross <sross(a)common-lisp.net> - * doc/cl-l10n.texi: Cleaned up so that it - works with makeinfo. + * 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 Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.9 cl-l10n/cl-l10n.asd:1.10 --- cl-l10n/cl-l10n.asd:1.9 Tue Feb 22 15:18:25 2005 +++ cl-l10n/cl-l10n.asd Wed Mar 23 11:58:16 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.3" + :version "0.2.5" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.10 cl-l10n/printers.lisp:1.11 --- cl-l10n/printers.lisp:1.10 Tue Feb 22 15:18:25 2005 +++ cl-l10n/printers.lisp Wed Mar 23 11:58:16 2005 @@ -36,9 +36,8 @@ (defun print-number (number &key (stream *standard-output*) no-ts no-dp (locale *locale*)) - (let ((locale (locale-des->locale locale))) - (format-number stream number no-dp no-ts locale) - number)) + (format-number stream number no-dp no-ts locale) + number) ;; Money @@ -86,9 +85,8 @@ (defun print-money (num &key (stream *standard-output*) use-int-sym no-ts (locale *locale*)) - (let ((locale (locale-des->locale locale))) - (format-money stream num use-int-sym no-ts locale) - num)) + (format-money stream num use-int-sym no-ts locale) + num) ;; ;; Time and date printing. (defun get-time-fmt-string (locale show-date show-time) @@ -119,12 +117,19 @@ it (locale-error "No format directive for char ~S." char))) -(defun princ-pad-val (val stream &optional (pad "0")) +(defun princ-pad-val (val stream &optional (pad "0") (size 2)) (declare (type stream stream) (optimize speed) (type fixnum val)) - (when (< val 10) - (princ pad stream)) - (princ val stream)) + (assert (not (minusp val)) (val) "Value ~A cannot be smaller than 0." val) + (cond ((zerop val) + (dotimes (x (1- size)) + (princ pad stream)) + (princ 0 stream)) + (t + (loop for x = (* val 10) then (* x 10) + until (>= x (expt 10 size)) do + (princ pad stream)) + (princ val stream)))) (defun last-2-digits (val) (mod val 100)) @@ -139,17 +144,16 @@ (if (> day 6) (decf day 7)) (princ (nth day (locale-day locale)) stream))) - (def-formatter #\b - (cl:format stream (cl:formatter "~:(~A~)") + (cl:format stream (cl:formatter "~A") (nth (1- month) (locale-abmon locale)))) (def-formatter #\B - (cl:format stream (cl:formatter "~:(~A~)") + (cl:format stream (cl:formatter "~A") (nth (1- month) (locale-mon locale)))) (def-formatter #\c - (print-time-string "%a %b %d %T %Z %Y" stream ut locale)) + (print-time-string (locale-d-t-fmt locale) stream ut locale)) (def-formatter #\C (princ-pad-val (truncate (/ year 100)) stream)) @@ -161,7 +165,7 @@ (print-time-string "%m/%d/%y" stream ut locale)) (def-formatter #\e - (princ-pad-val month stream " ")) + (princ-pad-val date stream " ")) (def-formatter #\F (print-time-string "%Y-%m-%d" stream ut locale)) @@ -202,7 +206,7 @@ (incf total date))) (def-formatter #\j - (princ (day-of-year date month year) stream)) + (princ-pad-val (day-of-year date month year) stream "0" 3)) (def-formatter #\k (princ-pad-val hour stream " ")) @@ -236,7 +240,7 @@ stream)) (def-formatter #\r - (print-time-string "%X %p" stream ut locale)) + (print-time-string "%H:%M:%S %p" stream ut locale)) (def-formatter #\R (print-time-string "%H:%M" stream ut locale)) @@ -253,7 +257,7 @@ (princ #\Tab stream)) (def-formatter #\T - (print-time-string "%X" stream ut locale)) + (print-time-string "%H:%M:%S" stream ut locale)) (def-formatter #\u (let ((day (1+ day))) @@ -269,19 +273,19 @@ (locale-error "Unsupported time format directive ~S." #\V)) (def-formatter #\w - (let ((day (1- day))) - (if (< day 0) (incf day 7)) - (princ day stream))) + (let ((day (1+ day))) + (when (>= day 7) (decf day 7)) + (princ day stream))) ;; FIXME (def-formatter #\W (locale-error "Unsupported time format directive ~S." #\W)) (def-formatter #\x - (print-time-string "%m/%d/%y" stream ut locale)) + (print-time-string (locale-d-fmt locale) stream ut locale)) (def-formatter #\X - (print-time-string "%R:%S" stream ut locale)) + (print-time-string (locale-t-fmt locale) stream ut locale)) (def-formatter #\y (princ-pad-val (last-2-digits year) stream)) @@ -326,9 +330,8 @@ (defun print-time (ut &key show-date show-time (stream *standard-output*) (locale *locale*) fmt) - (let ((locale (locale-des->locale locale))) - (format-time stream ut show-date show-time locale fmt) - ut)) + (format-time stream ut show-date show-time locale fmt) + ut) ;; Format Index: cl-l10n/tests.lisp diff -u cl-l10n/tests.lisp:1.5 cl-l10n/tests.lisp:1.6 --- cl-l10n/tests.lisp:1.5 Tue Feb 1 08:58:25 2005 +++ cl-l10n/tests.lisp Wed Mar 23 11:58:16 2005 @@ -77,7 +77,7 @@ (deftest time.2 (format nil "~v:@/cl-l10n:format-time/" "sv_SE" 3091103120) - "sön 12 Dec 1997 17.45.20") + "sön 14 dec 1997 17.45.20") (deftest time.3 (format nil "~v/cl-l10n:format-time/" "en_US" 3091103120) @@ -95,26 +95,55 @@ (format nil "~v@/cl-l10n:format-time/" "sv_SE" 3091103120) "17.45.20") -(defparameter *full-test* - (format nil "%% %a %A %b %B %c %C %d %D %e %F %g %G %h %H %I ~ -%j %k %l %m %M %n %N %p %P %r %R %S %t %T %u %w %x %X %y %z %Z")) - -(deftest time.7 - (format nil "~v,v/cl-l10n:format-time/" "en_ZA" *full-test* 3091103120) - "% Sun Sunday Dec December Sun Dec 14 17:45:20 +0200 1997 19 14 12/14/97 12 1997-12-14 97 1997 Dec 17 05 348 17 5 12 45 - 000000000 17:45:20 17:45 20 17:45:20 7 5 12/14/97 17:45:20 97 +0200 +0200") - - -(deftest time.8 - (format nil "~v,v/cl-l10n:format-time/" "en_US" *full-test* 3091103120) - "% Sun Sunday Dec December Sun Dec 14 17:45:20 +0200 1997 19 14 12/14/97 12 1997-12-14 97 1997 Dec 17 05 348 17 5 12 45 - 000000000 17:45:20 17:45 20 17:45:20 7 5 12/14/97 17:45:20 97 +0200 +0200") - -(deftest time.9 - (format nil "~v,v/cl-l10n:format-time/" "sv_SE" *full-test* 3091103120) -"% sön söndag Dec December sön Dec 14 17:45:20 +0200 1997 19 14 12/14/97 12 1997-12-14 97 1997 dec 17 05 348 17 5 12 45 - 000000000 17:45:20 17:45 20 17:45:20 7 5 12/14/97 17:45:20 97 +0200 +0200") - +(defmacro def-time-directive-test (name directive result) + `(deftest ,name (format nil "~v,vU" "en_ZA" ,directive 3320556360) + ,result)) + +(def-time-directive-test directive.1 "%%" "%") +(def-time-directive-test directive.2 "%a" "Wed") +(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.7 "%C" "20") +(def-time-directive-test directive.8 "%d" "23") +(def-time-directive-test directive.9 "%D" "03/23/05") +(def-time-directive-test directive.10 "%e" "23") +(def-time-directive-test directive.11 "%F" "2005-03-23") +(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.17 "%j" "082") +(def-time-directive-test directive.18 "%k" "10") +(def-time-directive-test directive.19 "%l" "10") +(def-time-directive-test directive.21 "%m" "03") +(def-time-directive-test directive.22 "%M" "46") +(def-time-directive-test directive.23 "%n" " +") +(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.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.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.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") + + ;; i18n tests (defvar *my-bundle* (make-instance 'bundle)) Index: cl-l10n/utils.lisp diff -u cl-l10n/utils.lisp:1.5 cl-l10n/utils.lisp:1.6 --- cl-l10n/utils.lisp:1.5 Thu Dec 30 12:56:38 2004 +++ cl-l10n/utils.lisp Wed Mar 23 11:58:16 2005 @@ -48,11 +48,6 @@ (and (consp list) (not (cdr list)))) -(defun mklist (thing) - (if (listp thing) - thing - (list thing))) - (defun last1 (list) (car (last list)))

1 0

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

17 Mar '05

Update of /project/cl-l10n/cvsroot/cl-l10n/doc In directory common-lisp.net:/tmp/cvs-serv32081/doc Modified Files: cl-l10n.texi Log Message: Changelog 2005-03-17 Date: Thu Mar 17 12:40:39 2005 Author: sross Index: cl-l10n/doc/cl-l10n.texi diff -u cl-l10n/doc/cl-l10n.texi:1.5 cl-l10n/doc/cl-l10n.texi:1.6 --- cl-l10n/doc/cl-l10n.texi:1.5 Thu Dec 30 12:56:45 2004 +++ cl-l10n/doc/cl-l10n.texi Thu Mar 17 12:40:39 2005 @@ -99,7 +99,7 @@ CL-L10N uses @uref{http://cliki.net/asdf,,asdf} as it's system definition tool and is required whenever you load the package. You will need to download it, or if you have @uref{http://sbcl.org,,sbcl} -@lisp (require 'asdf) @end lisp +@code{(require 'asdf)} @section Downloading @@ -107,7 +107,7 @@ @item ASDF-INSTALL CL-L10N is available through asdf-install. If you are new to Common Lisp this is the suggested download method. With asdf-install loaded run -@lisp (asdf-install:install :cl-l10n) @end lisp +@code{(asdf-install:install :cl-l10n)} This will download and install the package for you. Asdf-install will try to verify that the package signature is correct and that you trust the author. If the key is not found or the trust level is not sufficient a continuable error will be signalled. @@ -141,25 +141,25 @@ @chapter API @section Variables -@anchor {Variable *locale*} +@anchor{Variable *locale*} @vindex *locale* @deftp {Variable} *locale* The default locale which will be used. @end deftp -@anchor {Variable *locale-path*} +@anchor{Variable *locale-path*} @vindex *locale-path* @deftp {Variable} *locale-path* The default pathname where locale definition files can be found. @end deftp -@anchor {Variable *locales*} +@anchor{Variable *locales*} @vindex *locales* @deftp {Variable} *locales* A hash table containing loaded locales keyed on locale name. @end deftp -@anchor {Variable *float-digits*} +@anchor{Variable *float-digits*} @vindex *float-digits* @deftp {Variable} *float-digits* An integer value which determines the number of digits @@ -170,12 +170,12 @@ @section Functions -@anchor {Function locale-name} +@anchor{Function locale-name} @deffn {Function} locale-name locale Returns the name of @emph{locale}. @end deffn -@anchor {Function locale} +@anchor{Function locale} @deffn {Function} locale name &key (use-cache t) (errorp t) Loads the locale designated by the locale-designator @emph{name} which is expected to be found in @code{*locale-path*}. If use-cache is @code{nil} the @@ -184,25 +184,25 @@ will be signalled. @end deffn -@anchor {Function locale-value} +@anchor{Function locale-value} @deffn {Function} locale-value locale category-name key Returns the value of @emph{key} in cagetory @emph{category-name} found in the @code{locale} @emph{locale}. @end deffn -@anchor {Function load-all-locales} +@anchor{Function load-all-locales} @deffn {Function} load-all-locales &optional (path *locale-path*) Load all locales found in pathname @emph{path}. @end deffn -@anchor {Function print-number} +@anchor{Function print-number} @deffn {Function} print-number number &key (stream *standard-output) no-ts no-dp locale *locale* Prints @emph{number} using locale @emph{locale}. If @emph{no-ts} is not nil no thousand seperators will be used when printing @emph{number}. If @emph{no-dp} is not nil the decimal seperator will be suppressed if @emph{number} is not an integer. @end deffn -@anchor {Function format-number} +@anchor{Function format-number} @deffn {Function} format-number stream arg no-dp no-ts &optional (locale *locale*) format-number is intended to be used as an argument to the ~/ / format directive. Example (assuming *locale* is en_ZA) @@ -214,14 +214,14 @@ @end deffn -@anchor {Function print-money} +@anchor{Function print-money} @deffn {Function} print-money value &key (stream *standard-output) use-int-sym no-ts (locale *locale*) Prints @emph{value} as a monetary value using locale @emph{locale}. If @emph{no-ts} is not nil no thousand seperators will be used when printing @emph{number}. If @emph{use-int-sym} is not nil @code{locale-int-curr-symbol} will be used instead of the default @code{locale-currency-symbol} @end deffn -@anchor {Function format-money} +@anchor{Function format-money} @deffn {Function} format-money stream arg use-int-sym no-ts &optional (locale *locale*) Prints @emph{value} as a monetary value using locale @emph{locale}. format-money is intended to be used as the function to the ~/ / format directive @@ -238,13 +238,13 @@ @end lisp @end deffn -@anchor {Function print-time} +@anchor{Function print-time} @deffn {Function} print-time ut &key show-date show-time (stream *standard-output) (locale *locale) fmt 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)}. @end deffn -@anchor {Function format-time} +@anchor{Function format-time} @deffn {function} format-time stream ut show-date show-time &optional (locale *locale*) fmt 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}. @@ -284,7 +284,7 @@ @end verbatim @end deffn -@anchor {Function format} +@anchor{Function format} @deffn {Function} format stream fmt-string &rest args Format is an unexported symbol in the cl-l10n package. It's use is to make formatting of dates, times, numbers and monetary @@ -318,27 +318,27 @@ @end deffn -@anchor {Macro formatter} +@anchor{Macro formatter} @deffn {Macro} formatter fmt-string Formatter is another unexported symbol in the cl-l10n package Shadow importing formatter gives support for the new format control directives. @end deffn -@anchor {Function parse-number} +@anchor{Function parse-number} @deffn {Function} parse-number num-string &optional (locale *locale*) Parses the string @emph{num-string} into a number using @emph{locale}. @end deffn @section Classes -@anchor {Class locale} +@anchor{Class locale} @deftp {Class} locale Class Precedence: @code{standard-object} The class representing a loaded locale. @end deftp -@anchor {Class category} +@anchor{Class category} @deftp {Class} category Class Precedence: @code{standard-object} The class representing a loaded category within a locale. @@ -346,7 +346,7 @@ @section Conditions -@anchor {Condition locale-error} +@anchor{Condition locale-error} @deftp {Condition} locale-error Class Precedence: @code{condition} @@ -419,7 +419,7 @@ @end lisp @section API -@anchor {Generic add-resource} +@anchor{Generic add-resource} @deffn {Generic} add-resource bundle from to locale-name Adds an entry to @emph{bundle} for @emph{locale-name} mapping @emph{from} to @emph{to}. The @emph{locale-name} does not @@ -435,7 +435,7 @@ @end lisp @end deffn -@anchor {Macro add-resources} +@anchor{Macro add-resources} @deffn {Macro} add-resources (bundle locale-name) &rest entries Utility macro to group large amounts of entries into a single logical block for a locale. @@ -456,7 +456,7 @@ @end lisp @end deffn -@anchor {Function gettext} +@anchor{Function gettext} @deffn {Function} gettext name bundle &optional (*locale* *locale* ) Looks for a mapping for @emph{name} in @emph{bundle}. If no mapping is found returns name.

1 0

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

17 Mar '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv32081 Modified Files: ChangeLog Log Message: Changelog 2005-03-17 Date: Thu Mar 17 12:40:36 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.11 cl-l10n/ChangeLog:1.12 --- cl-l10n/ChangeLog:1.11 Tue Feb 22 15:18:25 2005 +++ cl-l10n/ChangeLog Thu Mar 17 12:40:34 2005 @@ -1,6 +1,12 @@ +2005-03-17 Sean Ross <sross(a)common-lisp.net> + * 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 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. 2005-02-17 Sean Ross <sross(a)common-lisp.net> * locale.lisp: Added support for Allegro CL.

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/printers.lisp
by sross＠common-lisp.net 22 Feb '05

22 Feb '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv18065 Modified Files: ChangeLog cl-l10n.asd load-locale.lisp locale.lisp printers.lisp Log Message: Changelog 2005-02-22 Date: Tue Feb 22 15:18:25 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.10 cl-l10n/ChangeLog:1.11 --- cl-l10n/ChangeLog:1.10 Tue Feb 1 08:58:25 2005 +++ cl-l10n/ChangeLog Tue Feb 22 15:18:25 2005 @@ -1,3 +1,10 @@ +2005-02-22 Sean Ross <sross(a)common-lisp.net> + * printers.lisp: Added a formatter compiler macro + to remove unnecessary calls to parse-fmt-string. + +2005-02-17 Sean Ross <sross(a)common-lisp.net> + * locale.lisp: Added support for Allegro CL. + 2005-02-01 Sean Ross <sross(a)common-lisp.net> * load-locale.lisp: Revert to a default thousands separator if the the locale to be loaded doesn't have one. Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.8 cl-l10n/cl-l10n.asd:1.9 --- cl-l10n/cl-l10n.asd:1.8 Tue Feb 1 08:58:25 2005 +++ cl-l10n/cl-l10n.asd Tue Feb 22 15:18:25 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.2" + :version "0.2.3" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.9 cl-l10n/load-locale.lisp:1.10 --- cl-l10n/load-locale.lisp:1.9 Tue Feb 1 08:58:25 2005 +++ cl-l10n/load-locale.lisp Tue Feb 22 15:18:25 2005 @@ -7,11 +7,12 @@ ;; Add a restart here? -(defun locale (loc-name &key (use-cache t) (errorp t)) +(defun locale (loc-name &key (use-cache t) (errorp t) (loader nil)) "Find locale named by the string LOC-NAME. If USE-CACHE is non-nil forcefully reload the locale from *locale-path* else the locale is first looked for in *locales*. If ERRORP is non-nil -signal a warning rather than an error if the locale file cannot be found." +signal a warning rather than an error if the locale file cannot be found. +If LOADER is non-nil skip everything and call loader with LOC-NAME." (let ((name (aif (position #\. loc-name) (subseq loc-name 0 it) loc-name))) @@ -20,8 +21,9 @@ (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))) ((probe-file (merge-pathnames *locale-path* name)) - (load-locale name)) + (setf (get-locale name) (load-locale name))) (t (funcall (if errorp #'error #'warn) "Can't find locale ~A." name))))) @@ -45,7 +47,7 @@ (defun load-locale (name) (let ((path (merge-pathnames *locale-path* name))) - (cl:format t "~&;; Loading locale from ~A.~%" path) + (cl:format *debug-io* "~&;; Loading locale from ~A.~%" path) (let ((locale (make-instance *locale-type* :name name)) (*read-eval* nil) (*print-circle* nil)) @@ -58,7 +60,7 @@ escape comment)) (setf (get-category locale (category-name it)) it))))) (add-printers locale) - (setf (get-locale name) locale)))) + locale))) (defun load-all-locales (&optional (path *locale-path*)) "Load all locale found in pathname designator PATH." @@ -137,7 +139,6 @@ (list :money-n-ts (create-money-fmt-string locale nil t)) (printers locale)))) - (defvar *category-loaders* '(("LC_IDENTIFICATION" . load-identification) Index: cl-l10n/locale.lisp diff -u cl-l10n/locale.lisp:1.7 cl-l10n/locale.lisp:1.8 --- cl-l10n/locale.lisp:1.7 Tue Jan 4 16:32:15 2005 +++ cl-l10n/locale.lisp Tue Feb 22 15:18:25 2005 @@ -93,6 +93,7 @@ (defun getenv (word) #+sbcl (sb-ext:posix-getenv word) #+lispworks (hcl:getenv word) + #+acl (sys:getenv word) #+cmu (cdr (assoc (intern word :keyword) ext:*environment-list*)) #+clisp (ext:getenv word) #+ecl (si:getenv word)) Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.9 cl-l10n/printers.lisp:1.10 --- cl-l10n/printers.lisp:1.9 Tue Feb 1 08:58:25 2005 +++ cl-l10n/printers.lisp Tue Feb 22 15:18:25 2005 @@ -332,6 +332,12 @@ ;; Format +(define-compiler-macro format (&whole form dest control &rest args) + "Compiler macro to remove unnecessary calls to parse-fmt-string." + (if (stringp control) + `(cl::format ,dest ,(really-parse-fmt-string control) ,@args) + form)) + (defmacro formatter (fmt-string) (etypecase fmt-string (string `(cl:formatter ,(parse-fmt-string fmt-string))))) @@ -345,8 +351,12 @@ (defvar *scanner* (cl-ppcre:create-scanner "~[@v,:]*[m|u|n|M|U|N]")) +(defun needs-parsing (string) + (declare (optimize speed (safety 1) (debug 0))) + (cl-ppcre:scan *scanner* string)) + (defun parse-fmt-string (string) - (if (cl-ppcre:scan *scanner* string) + (if (needs-parsing string) (really-parse-fmt-string string) string)) @@ -378,4 +388,4 @@ -;; EOF \ No newline at end of file +;; EOF

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/printers.lisp cl-l10n/tests.lisp
by sross＠common-lisp.net 01 Feb '05

01 Feb '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv7773 Modified Files: ChangeLog cl-l10n.asd load-locale.lisp printers.lisp tests.lisp Log Message: Changelog 2005-02-01 Date: Mon Jan 31 23:58:25 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.9 cl-l10n/ChangeLog:1.10 --- cl-l10n/ChangeLog:1.9 Tue Jan 4 07:32:15 2005 +++ cl-l10n/ChangeLog Mon Jan 31 23:58:25 2005 @@ -1,3 +1,8 @@ +2005-02-01 Sean Ross <sross(a)common-lisp.net> + * load-locale.lisp: Revert to a default thousands separator + if the the locale to be loaded doesn't have one. + * printers.lisp: Fixed bug in float padding. + 2005-01-04 Sean Ross <sross(a)common-lisp.net> * locale.lisp: Changed get-category, get-locale to generic-functions Changed macro get-cat-val to method category-value. Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.7 cl-l10n/cl-l10n.asd:1.8 --- cl-l10n/cl-l10n.asd:1.7 Thu Dec 30 03:56:38 2004 +++ cl-l10n/cl-l10n.asd Mon Jan 31 23:58:25 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.0" + :version "0.2.2" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.8 cl-l10n/load-locale.lisp:1.9 --- cl-l10n/load-locale.lisp:1.8 Tue Jan 4 07:32:15 2005 +++ cl-l10n/load-locale.lisp Mon Jan 31 23:58:25 2005 @@ -70,9 +70,16 @@ (handler-case (load-locale (pathname-name x)) (locale-error (c) (warn "Unable to load locale ~A. ~%~A." x c)))))))) +(defvar *default-thousands-sep* #\,) + +(defun thousands-sep-char (sep) + (if (> (length sep) 0) + (schar sep 0) + *default-thousands-sep*)) (defun create-number-fmt-string (locale no-ts) - (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" (schar (locale-thousands-sep locale) 0) + (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" + (thousands-sep-char (locale-thousands-sep locale)) (locale-grouping locale) (if no-ts "D" ":D"))) @@ -103,7 +110,7 @@ (princ sym-sep stream)) ;; Actual number (cl:format stream "~~,,'~A,~A~A~~{~~A~~}" - (schar (locale-mon-thousands-sep locale) 0) + (thousands-sep-char (locale-mon-thousands-sep locale)) (locale-mon-grouping locale) (if no-ts "D" ":D")) (unless prec Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.8 cl-l10n/printers.lisp:1.9 --- cl-l10n/printers.lisp:1.8 Tue Jan 4 07:32:15 2005 +++ cl-l10n/printers.lisp Mon Jan 31 23:58:25 2005 @@ -1,4 +1,4 @@ -;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; See the file LICENCE for licence information. (in-package :cl-l10n) @@ -13,9 +13,12 @@ determine the number of zero's to print") (defun fix-float-string (string size) - (if (string= string "") - (make-string size :initial-element #\0) - string)) + "Pads the string with trailing zero's if it is smaller than size" + (with-output-to-string (s) + (princ string s) + (when (< (length string) size) + (dotimes (x (- size (length string))) + (princ "0" s))))) (defun format-number (stream arg no-dp no-ts &optional (locale *locale*)) Index: cl-l10n/tests.lisp diff -u cl-l10n/tests.lisp:1.4 cl-l10n/tests.lisp:1.5 --- cl-l10n/tests.lisp:1.4 Thu Dec 30 03:56:38 2004 +++ cl-l10n/tests.lisp Mon Jan 31 23:58:25 2005 @@ -35,7 +35,7 @@ (deftest number.6 (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2) - "0,5") + "0,50") (deftest number.7 (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0)

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/i18n.lisp cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/printers.lisp
by sross＠common-lisp.net 04 Jan '05

04 Jan '05

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv30363 Modified Files: ChangeLog i18n.lisp load-locale.lisp locale.lisp printers.lisp Log Message: Changelog 2005-01-04 Date: Tue Jan 4 16:32:16 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.8 cl-l10n/ChangeLog:1.9 --- cl-l10n/ChangeLog:1.8 Thu Dec 30 13:29:54 2004 +++ cl-l10n/ChangeLog Tue Jan 4 16:32:15 2005 @@ -1,3 +1,8 @@ +2005-01-04 Sean Ross <sross(a)common-lisp.net> + * locale.lisp: Changed get-category, get-locale to generic-functions + Changed macro get-cat-val to method category-value. + * load-locale.lisp: Added *locale-type* and *category-type*. + 2004-12-30 Sean Ross <sross(a)common-lisp.net> Version 0.2 Release * printers.lisp, load-locale.lisp: Changed format-number and Index: cl-l10n/i18n.lisp diff -u cl-l10n/i18n.lisp:1.1 cl-l10n/i18n.lisp:1.2 --- cl-l10n/i18n.lisp:1.1 Wed Dec 1 12:52:35 2004 +++ cl-l10n/i18n.lisp Tue Jan 4 16:32:15 2005 @@ -58,6 +58,8 @@ (defgeneric lookup-name (bundle name) (:method ((bundle t) (name t)) (awhen (get-name bundle name) + ;; The match with the longest name is the most + ;; specific key. (winner #'> (compose #'length #'car) (remove-if-not #'(lambda (x) Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.7 cl-l10n/load-locale.lisp:1.8 --- cl-l10n/load-locale.lisp:1.7 Thu Dec 30 12:56:38 2004 +++ cl-l10n/load-locale.lisp Tue Jan 4 16:32:15 2005 @@ -3,9 +3,15 @@ (in-package :cl-l10n) (defparameter *ignore-categories* - (list "LC_CTYPE" "LC_COLLATE")) + (list "LC_CTYPE" "LC_COLLATE")) + +;; Add a restart here? (defun locale (loc-name &key (use-cache t) (errorp t)) + "Find locale named by the string LOC-NAME. If USE-CACHE +is non-nil forcefully reload the locale from *locale-path* else +the locale is first looked for in *locales*. If ERRORP is non-nil +signal a warning rather than an error if the locale file cannot be found." (let ((name (aif (position #\. loc-name) (subseq loc-name 0 it) loc-name))) @@ -16,12 +22,22 @@ ((and use-cache (get-locale name)) it) ((probe-file (merge-pathnames *locale-path* name)) (load-locale name)) - ((not errorp) (warn "Can't find locale ~A." name)) - (errorp (locale-error "Can't find locale ~A." name))))) + (t (funcall (if errorp #'error #'warn) + "Can't find locale ~A." name))))) + +(defvar *locale-type* 'locale + "The class of loaded locales.") + +(defvar *category-type* 'category + "The class of loaded categories") -(defvar *locale-type* 'locale) +(deftype locale-descriptor () + `(or locale string symbol)) (defun locale-des->locale (loc) + "Turns a locale descriptor(a string, symbol or locale) into an +actual locale object." + (check-type loc locale-descriptor) (etypecase loc (locale loc) (string (locale loc)) @@ -40,16 +56,19 @@ (awhile (next-header stream) (awhen (make-category locale it (parse-category it stream escape comment)) - (setf (get-category (category-name it) locale) it))))) + (setf (get-category locale (category-name it)) it))))) (add-printers locale) (setf (get-locale name) locale)))) -(defun load-all-locales (&optional (*locale-path* *locale-path*)) - (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))))))) +(defun load-all-locales (&optional (path *locale-path*)) + "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)))))))) (defun create-number-fmt-string (locale no-ts) @@ -96,6 +115,7 @@ (princ (if (zerop spos) ")" sign) stream)))))) (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)) @@ -122,7 +142,8 @@ ("LC_TELEPHONE" . load-category) ("LC_MEASUREMENT" . load-category) ("LC_NAME" . load-category) - ("LC_ADDRESS" . load-category))) + ("LC_ADDRESS" . load-category)) + "Map of category names to the function which will load them.") (defun get-loader (name) (cdr (assoc name *category-loaders* :test #'string=))) @@ -131,14 +152,15 @@ (awhen (get-loader name) (funcall it locale name vals))) -(defun load-category (locale name vals) - (declare (ignore locale)) - (let ((cat (make-instance 'category :name name))) - (etypecase vals - (category vals) - (cons (dolist (x vals) - (setf (get-cat-val (car x) cat) (cdr x))) - cat)))) +(defgeneric load-category (locale name vals) + (:documentation "Load a category for LOCALE using VALS.") + (:method ((locale locale) (name string) (vals category)) + vals) + (:method ((locale locale) (name string) (vals cons)) + (let ((cat (make-instance *category-type* :name name))) + (dolist (x vals) + (setf (category-value cat (car x)) (cdr x))) + cat))) (defvar *id-vals* '(("title" . title) @@ -148,7 +170,6 @@ ("revision" . revision) ("date" . date) ("categories" . categories))) - (defun load-identification (locale name vals) (declare (ignore name)) @@ -159,7 +180,7 @@ (defun line-comment-p (line comment) (or (string= line "") - (and (> (length line) 0) ;; Ignore a comment line + (and (> (length line) 0) (char= (schar line 0) comment)))) Index: cl-l10n/locale.lisp diff -u cl-l10n/locale.lisp:1.6 cl-l10n/locale.lisp:1.7 --- cl-l10n/locale.lisp:1.6 Thu Dec 30 12:56:38 2004 +++ cl-l10n/locale.lisp Tue Jan 4 16:32:15 2005 @@ -7,18 +7,13 @@ ;; Parsers (money and time) ;; locale aliases ;; Optimizing print-time +;; Thread safety (in-package :cl-l10n ) -;; Variables (defvar *locale-path* - (let ((path *load-pathname*)) - (make-pathname :host (pathname-host path) - :device (pathname-device path) - :directory - (append (pathname-directory path) - '("locales")) - :defaults #P""))) + (merge-pathnames (make-pathname :directory '(:relative "locales")) + (directory-namestring *load-pathname*))) (defvar *locale* nil) @@ -65,19 +60,35 @@ (princ (category-name obj) stream))) -;; Macros -(defmacro get-locale (name) - `(gethash ,name *locales*)) - -(defmacro get-category (name locale) - `(gethash ,name (categories ,locale))) - -(defmacro get-cat-val (value cat) - `(gethash ,value (vals ,cat))) +(declaim (inline get-locale)) +(defun get-locale (name) + (gethash name *locales*)) + +(defun (setf get-locale) (new-val name) + (setf (gethash name *locales*) + new-val)) + +(defgeneric get-category (locale name) + (:documentation "Find category called NAME in locale LOCALE.") + (:method ((locale locale) (name string)) + (gethash name (categories locale)))) + +(defmethod (setf get-category) ((new-val category) (locale locale) (name string)) + (setf (gethash name (categories locale)) + new-val)) + +(defgeneric category-value (category key) + (:documentation "Lookup attribute named by string KEY in category CATEGORY.") + (:method ((category category) (key string)) + (gethash key (vals category)))) + +(defmethod (setf category-value) ((new-val t) (category category) (key string)) + (setf (gethash key (vals category)) + new-val)) (defun locale-value (locale cat key) - (awhen (get-category cat locale) - (get-cat-val key it))) + (awhen (get-category locale cat) + (category-value it key))) (defun getenv (word) #+sbcl (sb-ext:posix-getenv word) Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.7 cl-l10n/printers.lisp:1.8 --- cl-l10n/printers.lisp:1.7 Thu Dec 30 12:56:38 2004 +++ cl-l10n/printers.lisp Tue Jan 4 16:32:15 2005 @@ -100,7 +100,7 @@ (defvar *time-formatters* (make-hash-table)) (defmacro def-formatter (sym &body body) - "Creates a function with body which can be looked up using lookup-formatter + "Creates a function with BODY which can be looked up using lookup-formatter using the character SYM." (let ((name (gensym (mkstr "FORMATTER-" sym)))) `(flet ((,name (stream locale ut sec min hour date month year day

1 0

[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog
by sross＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv11724 Modified Files: ChangeLog Log Message: ChangeLog 2004-12-30 Date: Thu Dec 30 13:29:54 2004 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.7 cl-l10n/ChangeLog:1.8 --- cl-l10n/ChangeLog:1.7 Thu Dec 30 12:56:38 2004 +++ cl-l10n/ChangeLog Thu Dec 30 13:29:54 2004 @@ -1,6 +1,8 @@ 2004-12-30 Sean Ross <sross(a)common-lisp.net> + Version 0.2 Release * printers.lisp, load-locale.lisp: Changed format-number and format-money to use a format string created at locale load time. + * printers.lisp: Added rounding of monetary values * locale.lisp: Cache Getter functions. 2004-12-20 Sean Ross <sross(a)common-lisp.net>

1 0

[cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi
by sross＠common-lisp.net 30 Dec '04

30 Dec '04

Update of /project/cl-l10n/cvsroot/cl-l10n/doc In directory common-lisp.net:/tmp/cvs-serv10150/doc Modified Files: cl-l10n.texi Log Message: ChangeLog 2004-12-30 Date: Thu Dec 30 12:56:45 2004 Author: sross Index: cl-l10n/doc/cl-l10n.texi diff -u cl-l10n/doc/cl-l10n.texi:1.4 cl-l10n/doc/cl-l10n.texi:1.5 --- cl-l10n/doc/cl-l10n.texi:1.4 Fri Dec 17 11:06:46 2004 +++ cl-l10n/doc/cl-l10n.texi Thu Dec 30 12:56:45 2004 @@ -318,6 +318,13 @@ @end deffn +@anchor {Macro formatter} +@deffn {Macro} formatter fmt-string +Formatter is another unexported symbol in the cl-l10n package +Shadow importing formatter gives support for the new format +control directives. +@end deffn + @anchor {Function parse-number} @deffn {Function} parse-number num-string &optional (locale *locale*) Parses the string @emph{num-string} into a number using @emph{locale}. @@ -485,7 +492,6 @@ @section Known Issues @itemize @bullet @item LC_COLLATE and LC_CTYPE categories in the locale files are currently ignored. -@item Some locales do not have a value for locale-t-fmt-ampm. @item Not all time format directives are supported. @end itemize

1 0