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@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@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@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@jhb.ucs.co.za>" :maintainer "Sean Ross <sdr@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/")