Update of /project/cl-l10n/cvsroot/cl-l10n
In directory common-lisp.net:/tmp/cvs-serv17408
Modified Files:
ChangeLog LICENCE cl-l10n.asd load-locale.lisp locale.lisp
printers.lisp utils.lisp
Added Files:
LGPL-2.1
Log Message:
ChangeLog 2004-11-30
Date: Tue Nov 30 10:45:35 2004
Author: sross
Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.1 cl-l10n/ChangeLog:1.2
--- cl-l10n/ChangeLog:1.1 Mon Nov 29 11:40:59 2004
+++ cl-l10n/ChangeLog Tue Nov 30 10:45:32 2004
@@ -1,3 +1,19 @@
+2004-11-30 Sean Ross <sross(a)common-lisp.net>
+ * utils.lisp, printers.lisp:
+ Changed read-from-string to parse-integer.
+ * printers.lisp: implemented time format directives
+ %c, %j, %u, %w, %x and fixed %a and %A directives.
+ * locales: Added new locales.
+ * LICENCE, LGPL-2.1: Update licence to reflect that
+ the locale definition files are licenced under the
+ LGPL.
+ * README: Basic readme file.
+ * load-locale.lisp: Fixed load-all-locales to really
+ load from a specific path and warnings if loading
+ a locale fails.
+ * locale.lisp: Changed the typecase for locale-des->locale
+ to etypecase.
+
2004-11-29 Sean Ross <sross(a)common-lisp.net>
* cl-l10n.asd, locale.lisp, load-locale.lisp, printers.lisp:
Initial import into cvs
Index: cl-l10n/LICENCE
diff -u cl-l10n/LICENCE:1.1.1.1 cl-l10n/LICENCE:1.2
--- cl-l10n/LICENCE:1.1.1.1 Mon Nov 29 10:56:55 2004
+++ cl-l10n/LICENCE Tue Nov 30 10:45:32 2004
@@ -24,3 +24,24 @@
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.
+
+
+The following applies to the locale definition files (locales/*)
+Also see LGPL-2.1
+
+Copyright (C) 1991,92,93,94,95,96,97,98,99,2000,2001 Free Software Foundation, Inc.
+
+ The GNU C Library is free software; you can redistribute it and/or
+ modify it under the terms of the GNU Lesser General Public
+ License as published by the Free Software Foundation; either
+ version 2.1 of the License, or (at your option) any later version.
+
+ The GNU C Library is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ Lesser General Public License for more details.
+
+ You should have received a copy of the GNU Lesser General Public
+ License along with the GNU C Library; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+ 02111-1307 USA.
Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.1.1.1 cl-l10n/cl-l10n.asd:1.2
--- cl-l10n/cl-l10n.asd:1.1.1.1 Mon Nov 29 10:56:55 2004
+++ cl-l10n/cl-l10n.asd Tue Nov 30 10:45:32 2004
@@ -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.0.1"
+ :version "0.0.6"
: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.4 cl-l10n/load-locale.lisp:1.5
--- cl-l10n/load-locale.lisp:1.4 Mon Nov 29 12:27:03 2004
+++ cl-l10n/load-locale.lisp Tue Nov 30 10:45:32 2004
@@ -32,10 +32,12 @@
(setf (get-category (category-name it) locale) it)))))
(setf (get-locale name) locale))))
-(defun load-all-locales (&optional (path *locale-path*))
- (dolist (x (directory (merge-pathnames path "*")))
+(defun load-all-locales (&optional (*locale-path* *locale-path*))
+ (dolist (x (directory (merge-pathnames *locale-path* "*")))
(when (pathname-name x)
- (load-locale (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)))))))
(defvar *category-loaders*
'(("LC_IDENTIFICATION" . load-identification)
@@ -80,7 +82,7 @@
(dolist (x *id-vals*)
(aif (cdr (assoc (car x) vals :test #'string=))
(setf (slot-value locale (cdr x))
- (read-from-string it nil "")))))
+ (remove #\" it)))))
(defun line-comment-p (line comment)
(or (string= line "")
Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.2 cl-l10n/locale.lisp:1.3
--- cl-l10n/locale.lisp:1.2 Mon Nov 29 15:14:41 2004
+++ cl-l10n/locale.lisp Tue Nov 30 10:45:32 2004
@@ -2,7 +2,6 @@
;; See the file LICENCE for licence information.
;; TODO
-;; README
;; What to do with LC_CTYPE, LC_COLLATE
;; Tests
;; Finish time format directives
Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.2 cl-l10n/printers.lisp:1.3
--- cl-l10n/printers.lisp:1.2 Mon Nov 29 15:14:41 2004
+++ cl-l10n/printers.lisp Tue Nov 30 10:45:32 2004
@@ -30,7 +30,7 @@
(locale-thousands-sep locale)))
(defun locale-des->locale (loc)
- (typecase loc
+ (etypecase loc
(locale loc)
(string (locale loc))
(symbol (locale (string loc)))))
@@ -45,7 +45,7 @@
(grouping (locale-grouping locale))
(*read-eval* nil))
(print-int stream sign int-part sep grouping)
- (unless (and (zerop (read-from-string float-part nil 0)) no-dp)
+ (unless (and (or* (string= float-part "" "0")) no-dp)
(princ point stream)
(princ float-part stream))))))
@@ -133,10 +133,10 @@
(defvar *time-formatters* (make-hash-table))
(defmacro def-formatter (sym &body body)
- (let ((name (symb (mkstr "FORMATTER-" sym))))
- `(flet ((,name (stream locale sec min hour date month year day
+ (let ((name (gensym (mkstr "FORMATTER-" sym))))
+ `(flet ((,name (stream locale ut sec min hour date month year day
daylight-p zone)
- (declare (ignorable stream locale sec min hour date month
+ (declare (ignorable stream locale ut sec min hour date month
year day daylight-p zone))
,@body))
(setf (gethash ,sym *time-formatters*)
@@ -145,7 +145,7 @@
(defun lookup-formatter (char)
(aif (gethash char *time-formatters*)
it
- (locale-error "No time formatter for char ~S." char)))
+ (locale-error "No format directive for char ~S." char)))
(defun pad-val (val &optional (pad "0"))
(if (< val 10)
@@ -156,40 +156,48 @@
(mod val 100))
(def-formatter #\a
- (princ (nth (1+ day) (locale-abday locale))
- stream))
+ (let ((day (1+ day)))
+ (if (> day 6) (decf day 7))
+ (format stream "~:(~A~)" (nth day (locale-abday locale)))))
(def-formatter #\A
- (princ (nth (1+ day) (locale-day locale))
- stream))
+ (let ((day (1+ day)))
+ (if (> day 6) (decf day 7))
+ (format stream "~:(~A~)"
+ (nth day (locale-day locale)))))
+
(def-formatter #\b
- (princ (nth (1- month) (locale-abmon locale))
- stream))
+ (format stream "~:(~A~)" (nth (1- month) (locale-abmon locale))))
+
(def-formatter #\B
- (princ (nth (1- month) (locale-mon locale))
- stream))
+ (format stream "~:(~A~)"
+ (nth (1- month) (locale-mon locale))))
-;; %c
+(def-formatter #\c
+ (print-time-string "%a %b %d %T %Z %Y" stream ut locale))
(def-formatter #\C
(princ (pad-val (truncate (/ year 100))) stream))
-
(def-formatter #\d
(princ (pad-val date) stream))
-;; %D
+(def-formatter #\D
+ (print-time-string "%m/%d/%y" stream ut locale))
(def-formatter #\e
(princ (pad-val month " ") stream))
-;; %F
-
+(def-formatter #\F
+ (print-time-string "%Y-%m-%d" stream ut locale))
+
+(def-formatter #\g
+ (print-time-string "%y" stream ut locale))
-;; %g
-;; %G
+(def-formatter #\G
+ (print-time-string "%Y" stream ut locale))
(def-formatter #\h
(princ (nth (1- month) (locale-abmon locale))
@@ -199,20 +207,38 @@
(princ (pad-val hour) stream))
(def-formatter #\I
- (princ (pad-val (if (> hour 12)
- (- hour 12)
- hour))
+ (princ (pad-val (if (> hour 12) (- hour 12) hour))
stream))
-;; %j
+;; %j day of year
+(defvar *mon-days*
+ '(31 28 31 30 31 30 31 31 30 31 30 31))
+
+(defvar *mon-days-leap*
+ (substitute 29 28 *mon-days*))
+
+(defun leap-year-p (year)
+ (cond ((zerop (mod year 400)) t)
+ ((zerop (mod year 100)) nil)
+ ((zerop (mod year 4)) t)
+ (t nil)))
+
+(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))
+ (incf total date)
+ total))
+
+(def-formatter #\j
+ (princ (day-of-year date month year) stream))
(def-formatter #\k
(princ (pad-val hour " ") stream))
(def-formatter #\l
- (princ (pad-val (if (> hour 12)
- (- hour 12)
- hour)
+ (princ (pad-val (if (> hour 12) (- hour 12) hour)
" ")
stream))
@@ -229,9 +255,7 @@
(princ "000000000" stream))
(defun get-am-pm (hour locale)
- (funcall (if (< hour 12)
- #'car
- #'cadr)
+ (funcall (if (< hour 12) #'car #'cadr)
(locale-am-pm locale)))
(def-formatter #\p
@@ -243,14 +267,10 @@
stream))
(def-formatter #\r
- (format stream "~A:~A:~A ~A"
- (pad-val hour) (pad-val min) (pad-val sec)
- (string-upcase (get-am-pm hour locale))))
+ (print-time-string "%X %p" stream ut locale))
(def-formatter #\R
- (format stream "~A:~A"
- (pad-val hour) (pad-val min)))
-
+ (print-time-string "%H:%M" stream ut locale))
(def-formatter #\S
(princ (pad-val sec) stream))
@@ -258,32 +278,57 @@
(def-formatter #\t
(princ #\Tab stream))
-
(def-formatter #\T
- (format stream "~A:~A:~A" (pad-val hour) (pad-val min) (pad-val sec)))
+ (print-time-string "%X" stream ut locale))
+
+(def-formatter #\u
+ (let ((day (1+ day)))
+ (when (> day 7) (decf day 7))
+ (princ day stream)))
+
+(def-formatter #\U
+ (locale-error "Unsupported time format directive ~S." #\U))
+
+(def-formatter #\V
+ (locale-error "Unsupported time format directive ~S." #\V))
+
+(def-formatter #\w
+ (let ((day (1- day)))
+ (if (< day 0) (incf day 7))
+ (princ day stream)))
+
+(def-formatter #\W
+ (locale-error "Unsupported time format directive ~S." #\W))
+
+(def-formatter #\x
+ (print-time-string "%m/%d/%y" stream ut locale))
+
+(def-formatter #\X
+ (print-time-string "%R:%S" stream ut locale))
-;; %u
-;; %U
-;; %V
-;; %w
-;; %W
-;; %x
-;; %X
(def-formatter #\y
(princ (pad-val (last-2-digits year)) stream))
(def-formatter #\Y
(princ year stream))
-(def-formatter #\z
- (princ zone 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)
+ (format stream "~2,'0D~2,'0D"
+ hr (floor (* 60 mn))))))
+;; FIXME should be printing SAST rather than +0200
(def-formatter #\Z
- (princ zone stream))
+ (print-time-string "%z" stream ut locale))
-(defun format-time (stream ut show-date show-time &optional (locale *locale*) fmt)
+
+(defun format-time (stream ut show-date show-time &optional (locale *locale*)
+ fmt)
(let ((locale (locale-des->locale (or locale *locale*))))
- (print-time-string (or fmt (get-time-fmt-string locale show-date show-time))
+ (print-time-string (or fmt (get-time-fmt-string locale
+ show-date show-time))
stream ut locale)))
(defun print-time-string (fmt-string stream ut locale)
@@ -295,7 +340,7 @@
(progn (princ #\% stream) (setf perc nil))
(setf perc t)))
(t (if perc
- (progn (apply (lookup-formatter x) stream locale values)
+ (progn (apply (lookup-formatter x) stream locale ut values)
(setf perc nil))
(princ x stream)))))))
@@ -304,6 +349,5 @@
(let ((locale (locale-des->locale locale)))
(format-time stream ut show-date show-time locale fmt)
ut))
-
-
+
;; EOF
Index: cl-l10n/utils.lisp
diff -u cl-l10n/utils.lisp:1.1.1.1 cl-l10n/utils.lisp:1.2
--- cl-l10n/utils.lisp:1.1.1.1 Mon Nov 29 10:56:55 2004
+++ cl-l10n/utils.lisp Tue Nov 30 10:45:32 2004
@@ -112,7 +112,7 @@
(defun split-float (float)
(multiple-value-bind (fore aft) (flonum-to-digits float)
- (values (read-from-string (get-first fore aft))
+ (values (parse-integer (get-first fore aft))
(let ((val (get-second fore aft)))
(if (string= val "") "0" val)))))
