Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv28413

Modified Files: ChangeLog cl-l10n.asd load-locale.lisp locale.lisp package.lisp printers.lisp utils.lisp Log Message: Changelog 2004-12-01 Date: Wed Dec 1 12:48:40 2004 Author: sross

Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.2 cl-l10n/ChangeLog:1.3 --- cl-l10n/ChangeLog:1.2 Tue Nov 30 10:45:32 2004 +++ cl-l10n/ChangeLog Wed Dec 1 12:48:39 2004 @@ -1,3 +1,9 @@ +2004-12-01 Sean Ross sross@common-lisp.net + Version 0.1 Release + * i18n.lisp: Basic internationalisation support. + * tests.lisp: Basic tests for package. + * printers.lisp: Added format directive %s + 2004-11-30 Sean Ross sross@common-lisp.net * utils.lisp, printers.lisp: Changed read-from-string to parse-integer. @@ -9,7 +15,7 @@ LGPL. * README: Basic readme file. * load-locale.lisp: Fixed load-all-locales to really - load from a specific path and warnings if loading + load from a specific path and to signal a warning if loading a locale fails. * locale.lisp: Changed the typecase for locale-des->locale to etypecase.

Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.2 cl-l10n/cl-l10n.asd:1.3 --- cl-l10n/cl-l10n.asd:1.2 Tue Nov 30 10:45:32 2004 +++ cl-l10n/cl-l10n.asd Wed Dec 1 12:48:40 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.6" + :version "0.1" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" @@ -19,10 +19,23 @@ (:file "utils" :depends-on ("package")) (:file "locale" :depends-on ("utils")) (:file "printers" :depends-on ("locale")) + (:file "i18n" :depends-on ("printers")) (:file "load-locale" :depends-on ("printers"))) :depends-on (:cl-ppcre))

(defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n)))) (provide 'cl-l10n)) - + + +(defmethod perform ((op test-op) (sys (eql (find-system :cl-l10n)))) + (oos 'load-op :cl-l10n-tests) + (oos 'test-op :cl-l10n-tests)) + +(defsystem cl-l10n-tests + :depends-on (rt cl-l10n) + :components ((:file "tests"))) + +(defmethod perform ((op test-op) (sys (eql (find-system :cl-l10n-tests)))) + (funcall (find-symbol "DO-TESTS" "REGRESSION-TEST"))) + ;; EOF

Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.5 cl-l10n/load-locale.lisp:1.6 --- cl-l10n/load-locale.lisp:1.5 Tue Nov 30 10:45:32 2004 +++ cl-l10n/load-locale.lisp Wed Dec 1 12:48:40 2004 @@ -18,7 +18,7 @@

(defun load-locale (name) (let ((path (merge-pathnames *locale-path* name))) - (format t ";; Loading locale from ~A.~%" path) + (format t "~&;; Loading locale from ~A.~%" path) (let ((locale (make-instance 'locale :name name)) (*read-eval* nil) (*print-circle* nil))

Index: cl-l10n/locale.lisp diff -u cl-l10n/locale.lisp:1.3 cl-l10n/locale.lisp:1.4 --- cl-l10n/locale.lisp:1.3 Tue Nov 30 10:45:32 2004 +++ cl-l10n/locale.lisp Wed Dec 1 12:48:40 2004 @@ -3,12 +3,7 @@

;; TODO ;; What to do with LC_CTYPE, LC_COLLATE -;; Tests -;; Finish time format directives ;; Test on windows. -;; Merge with property files -;; Cache getters? (reset on reload of locales) -;; Time Zone printing ;; Parsers?

(in-package :cl-l10n ) @@ -147,9 +142,6 @@ (defgetter "postal_fmt" "LC_ADDRESS") (defgetter "tel_int_fmt" "LC_TELEPHONE") (defgetter "measurement" "LC_MEASUREMENT") - - -

;; EOF

Index: cl-l10n/package.lisp diff -u cl-l10n/package.lisp:1.1.1.1 cl-l10n/package.lisp:1.2 --- cl-l10n/package.lisp:1.1.1.1 Mon Nov 29 10:56:55 2004 +++ cl-l10n/package.lisp Wed Dec 1 12:48:40 2004 @@ -8,5 +8,6 @@ #:get-category #:get-cat-val #:locale-value #:load-all-locales #:*locale* #:*locale-path* #:*locales* #:format-number #:print-number #:format-money #:print-money - #:format-time #:print-time)) + #:format-time #:print-time #:add-resources #:bundle + #:add-resource #:gettext))

Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.3 cl-l10n/printers.lisp:1.4 --- cl-l10n/printers.lisp:1.3 Tue Nov 30 10:45:32 2004 +++ cl-l10n/printers.lisp Wed Dec 1 12:48:40 2004 @@ -108,7 +108,7 @@ (princ point stream) (princ float-part stream)) (unless prec - (format stream "~A~A" sym-sep sym)) + (format stream "~A~A" sym-sep (trim sym))) (when (or* (= spos 0 2 4)) (when (= 2 sep-by-space) (print #\Space stream)) @@ -158,13 +158,12 @@ (def-formatter #\a (let ((day (1+ day))) (if (> day 6) (decf day 7)) - (format stream "~:(~A~)" (nth day (locale-abday locale))))) + (princ (nth day (locale-abday locale)) stream)))

(def-formatter #\A (let ((day (1+ day))) (if (> day 6) (decf day 7)) - (format stream "~:(~A~)" - (nth day (locale-day locale))))) + (princ (nth day (locale-day locale)) stream)))

(def-formatter #\b @@ -210,7 +209,6 @@ (princ (pad-val (if (> hour 12) (- hour 12) hour)) stream))

-;; %j day of year (defvar *mon-days* '(31 28 31 30 31 30 31 31 30 31 30 31))

@@ -272,6 +270,11 @@ (def-formatter #\R (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)) + (def-formatter #\S (princ (pad-val sec) stream))

@@ -286,9 +289,11 @@ (when (> day 7) (decf day 7)) (princ day stream)))

+;; FIXME (def-formatter #\U (locale-error "Unsupported time format directive ~S." #\U))

+;; FIXME (def-formatter #\V (locale-error "Unsupported time format directive ~S." #\V))

@@ -297,6 +302,7 @@ (if (< day 0) (incf day 7)) (princ day stream)))

+;; FIXME (def-formatter #\W (locale-error "Unsupported time format directive ~S." #\W))

Index: cl-l10n/utils.lisp diff -u cl-l10n/utils.lisp:1.2 cl-l10n/utils.lisp:1.3 --- cl-l10n/utils.lisp:1.2 Tue Nov 30 10:45:32 2004 +++ cl-l10n/utils.lisp Wed Dec 1 12:48:40 2004 @@ -86,6 +86,29 @@

+(defun winner (test get seq) + (if (null seq) + nil + (let* ((val (elt seq 0)) + (res (funcall get val))) + (dolist (x (subseq seq 1) (values val res)) + (let ((call (funcall get x))) + (when (funcall test call res) + (setf res call + val x))))))) + +(defun compose (&rest fns) + (if fns + (let ((last-fn (last1 fns)) + (fns (butlast fns))) + #'(lambda (&rest args) + (reduce #'funcall + fns + :from-end t + :initial-value (apply last-fn args)))) + #'identity)) + + (defun get-first (fore aft) (if (< fore 1) "0"