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/")