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