[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
Sean Ross
sross at common-lisp.net
Wed Mar 30 11:14:56 UTC 2005
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 at 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 at 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 at 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 at jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr at 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/")
More information about the Cl-l10n-cvs
mailing list