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

Modified Files: ChangeLog README cl-l10n.asd i18n.lisp load-locale.lisp locale.lisp package.lisp parse-number.lisp parsers.lisp printers.lisp tests.lisp utils.lisp Log Message: Changelog 2005-05-18 Date: Wed May 18 17:34:08 2005 Author: sross

Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.16 cl-l10n/ChangeLog:1.17 --- cl-l10n/ChangeLog:1.16 Thu Mar 31 15:53:42 2005 +++ cl-l10n/ChangeLog Wed May 18 17:34:07 2005 @@ -1,3 +1,19 @@ +2005-05-18 Sean Ross sross@common-lisp.net + load-all-locales now works. + * cl-l10n.asd: Added dependency to cl-fad + * load-locale.lisp: Only do printer creation if LC_MONETARY + and LC_NUMERIC exist. + Added a check for a funny #\E in some locales date fields. + Only do date-parsers if LC_TIME Exists. + Fixed line parser to handle normal characters in locale files, + now "%d<U0020>" parses correctly. + * utils.lisp: Removed awhen, awhile. + * printers.lisp: Added a check for #\E in date printing. + * locales/ar_SA: This locales ha(s/d) a .1 in front of + various time printing directives. I have no idea what these + mean.... + + 2005-03-31 Sean Ross sross@common-lisp.net Version 0.3 Release * parse-time.lisp, load-locale.lisp: Create

Index: cl-l10n/README diff -u cl-l10n/README:1.3 cl-l10n/README:1.4 --- cl-l10n/README:1.3 Thu Mar 31 15:53:42 2005 +++ cl-l10n/README Wed May 18 17:34:07 2005 @@ -9,6 +9,8 @@ various locale functions. It currently runs on CMUCL, SBCL, CLISP, ECL, Lispworks and Allegro CL although porting to a new implementation should be trivial. +It is distributed under an MIT style license although the locale +files themselves are distributed under the LGPL.

1. API

Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.13 cl-l10n/cl-l10n.asd:1.14 --- cl-l10n/cl-l10n.asd:1.13 Thu Mar 31 15:53:42 2005 +++ cl-l10n/cl-l10n.asd Wed May 18 17:34:08 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.3" + :version "0.3.4" :description "Portable CL Locale Support" :long-description "Portable CL Package to support localization" :licence "MIT" @@ -24,7 +24,7 @@ (:file "parsers" :depends-on ("printers" "parse-number")) (:file "parse-time" :depends-on ("load-locale")) (:file "i18n" :depends-on ("printers"))) - :depends-on (:cl-ppcre)) + :depends-on (:cl-ppcre :cl-fad))

(defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n)))) (funcall (find-symbol "LOAD-DEFAULT-LOCALE" "CL-L10N"))

Index: cl-l10n/i18n.lisp diff -u cl-l10n/i18n.lisp:1.2 cl-l10n/i18n.lisp:1.3 --- cl-l10n/i18n.lisp:1.2 Tue Jan 4 16:32:15 2005 +++ cl-l10n/i18n.lisp Wed May 18 17:34:08 2005 @@ -6,33 +6,24 @@ ;; (defparameter bundle (make-instance 'bundle))

;; (add-resources (bundle "af_") -;; "showtime" "Danke, die tyd is ~:@/cl-l10n:format-time/~%") +;; "showtime" "Dankie, die tyd is ~:@U~%")

;; ;; an empty string as the locale matcher becomes the default ;; (add-resources (bundle "") -;; "showtime" "Thanks, the time is ~:@/cl-l10n:format-time/~%") +;; "showtime" "Thanks, the time is ~:@U~%")

;; (set-dispatch-macro-character -;; ## #" +;; ## #\i ;; #'(lambda (s c1 c2) ;; (declare (ignore c2)) -;; (unread-char c1 s) ;; `(cl-l10n:gettext ,(read s) bundle)))

-;; or this (probably a bad idea) - -;; (defvar *orig-string-char* -;; (get-macro-character #")) -;; (set-macro-character #" -;; #'(lambda (s c1) -;; `(cl-l10n:gettext ,(funcall *orig-string-char* s c1) bundle))) - ;; or this ;; (defmacro _ (text) ;; `(cl-l10n:gettext ,text bundle))

;; (defun timey () -;; (format t #"showtime" (get-universal-time))) +;; (format t #i"showtime" (get-universal-time)))

(defclass bundle () ((resources :accessor resources :initform (make-hash-table :test #'equal)))) @@ -57,15 +48,15 @@

(defgeneric lookup-name (bundle name) (:method ((bundle t) (name t)) - (awhen (get-name bundle name) + (when-let (name (get-name bundle name)) ;; The match with the longest name is the most ;; specific key. (winner #'> - (compose #'length #'car) + (load-time-value (compose #'length #'car)) (remove-if-not #'(lambda (x) (search (car x) (locale-name *locale*))) - it))))) + name)))))

(defun gettext (name bundle &optional (loc *locale* )) (let ((*locale* (locale-des->locale loc))) @@ -75,4 +66,4 @@

-;; EOF \ No newline at end of file +;; EOF

Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.12 cl-l10n/load-locale.lisp:1.13 --- cl-l10n/load-locale.lisp:1.12 Thu Mar 31 15:53:42 2005 +++ cl-l10n/load-locale.lisp Wed May 18 17:34:08 2005 @@ -16,9 +16,6 @@ (let ((name (aif (position #. loc-name) (subseq loc-name 0 it) loc-name))) - (unless use-cache - ;; The local file might have changed so ... - (clear-getter-cache)) (acond ((and (not name) (not errorp)) nil) ((and use-cache (get-locale name)) it) (loader (setf (get-locale name) (funcall loader name))) @@ -48,30 +45,33 @@ (defun load-locale (name) (let ((path (merge-pathnames *locale-path* name))) (cl:format *debug-io* "~&;; Loading locale from ~A.~%" path) - (let ((locale (make-instance *locale-type* :name name)) - (*read-eval* nil) - (*print-circle* nil)) + (let ((locale (make-instance *locale-type* :name name))) (with-open-file (stream path :external-format #+(and sbcl sb-unicode) :latin1 #-(and sbcl sb-unicode) :default) (multiple-value-bind (escape comment) (munge-headers stream) - (awhile (next-header stream) - (awhen (make-category locale it (parse-category it stream - escape comment)) - (setf (get-category locale (category-name it)) it))))) + (loop for header = (next-header stream) + while header do + (when-let (cat (make-category locale header + (parse-category header stream + escape comment))) + (setf (get-category locale header) cat))))) (add-printers locale) (add-parsers locale) locale)))

-(defun load-all-locales (&optional (path *locale-path*)) +(defun load-all-locales (&key (path *locale-path*) (ignore-errors nil) (use-cache nil)) "Load all locale found in pathname designator PATH." (let ((*locale-path* path)) - ;; Is this portable? - (dolist (x (directory (merge-pathnames *locale-path* "*"))) - (when (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)))))))) + (dolist (x (list-directory *locale-path*)) + (when (and (not (directory-pathname-p x)) (pathname-name x)) + (let ((locale (pathname-name x))) + (with-simple-restart (continue "Ignore locale ~A." x) + (handler-bind ((error (lambda (&optional c) + (when ignore-errors + (warn "Failed to load locale ~S, Ignoring." locale) + (invoke-restart (find-restart 'continue c)))))) + (locale locale :use-cache use-cache))))))))

(defvar *default-thousands-sep* #,)

@@ -126,26 +126,29 @@

(defun add-printers (locale) "Creates monetary and numeric format strings for locale LOCALE." - (setf (printers locale) - (nconc (list :number-no-ts - (create-number-fmt-string locale t)) - (list :number-ts - (create-number-fmt-string locale nil)) - (list :money-p-no-ts - (create-money-fmt-string locale t nil)) - (list :money-p-ts - (create-money-fmt-string locale nil nil)) - (list :money-n-no-ts - (create-money-fmt-string locale t t)) - (list :money-n-ts - (create-money-fmt-string locale nil t)) - (printers locale)))) + (when (and (get-category locale "LC_MONETARY") + (get-category locale "LC_NUMERIC")) + ;; otherwise its an include locale (tranlit* etc) + (setf (printers locale) + (nconc (list :number-no-ts + (create-number-fmt-string locale t)) + (list :number-ts + (create-number-fmt-string locale nil)) + (list :money-p-no-ts + (create-money-fmt-string locale t nil)) + (list :money-p-ts + (create-money-fmt-string locale nil nil)) + (list :money-n-no-ts + (create-money-fmt-string locale t t)) + (list :money-n-ts + (create-money-fmt-string locale nil t)) + (printers locale)))))

(defun day-element-p (x) (member x '(#\d #\e)))

(defun month-element-p (x) - (char= x #\m)) + (member x '(#\m #\b #\B)))

(defun year-element-p (x) (member x '(#\y #\Y))) @@ -172,21 +175,25 @@ with perc = nil do (cond ((char= char #%) (setf perc (not perc))) ((member char date-dividers) nil) - (perc (let ((val (element-type char))) - (when val (push val res)) - (setf perc nil))))) + (perc (unless (char= char #\E) + ;; some locales (eg lo_LA) have this funny E before + ;; various time format designators. Debian + ;; treats this as if it wasn't there so neither do we. + (let ((val (element-type char))) + (when val (push val res)) + (setf perc nil)))))) (nreverse res)))

- (defun add-parsers (locale) - (destructuring-bind (first second third) - (locale-date-month-order locale) - (setf (parsers locale) - (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn)) - `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute - (time-divider) (secondp) (am-pm) (date-divider) (zone)) - `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider) - (secondp) (date-divider) ,third (date-divider) (zone)))))) + (when (get-category locale "LC_TIME") + (destructuring-bind (first second third) + (locale-date-month-order locale) + (setf (parsers locale) + (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn)) + `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute + (time-divider) (secondp) (am-pm) (date-divider) (zone)) + `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider) + (secondp) (date-divider) ,third (date-divider) (zone)))))))

(defvar *category-loaders* '(("LC_IDENTIFICATION" . load-identification) @@ -205,8 +212,8 @@ (cdr (assoc name *category-loaders* :test #'string=)))

(defun make-category (locale name vals) - (awhen (get-loader name) - (funcall it locale name vals))) + (when-let (loader (get-loader name)) + (funcall loader locale name vals)))

(defgeneric load-category (locale name vals) (:documentation "Load a category for LOCALE using VALS.") @@ -283,8 +290,6 @@ (schar (cdr (get-value line stream escape)) 0))))) (values escape comment-char)))

- - (defun get-full-line (line stream escape) (let ((length (length line))) (if (char= (elt line (1- length)) escape) @@ -299,34 +304,25 @@ escape))) line)))

- -(defun real-character (char) - (let ((int (parse-integer (trim char (list* #\U #> #< *whitespace*)) - :radix 16))) - (handler-case (code-char int) - (type-error (c) - (declare (ignore c)) - (locale-error "Cannot represent ~A as a character." int))))) - -(defvar *regex* '(:sequence - #< - (:greedy-repetition 0 nil - (:inverted-char-class #> #<) - :everything) - #>)) - -(defvar *match-scanner* (cl-ppcre:create-scanner *regex*)) - -(defun old-real-value (val) - (aif (all-matches-as-strings *match-scanner* val) - (map #-lispworks 'string #+lispworks - 'lw:text-string #'real-character it) - val)) - -;; KLUDGE -(defun real-value (val) - (remove #" (old-real-value val))) - +(defun real-value (string) + (loop for char across string + with in-special = nil + with result = () + with special-val = () do + (cond ((eql char #")) + ((eql char #<) (setf in-special t)) + ((and in-special (eq char #>)) + (push (code-char + (parse-integer (coerce (cdr (nreverse special-val)) 'string) + :radix 16)) + result) + (setf in-special nil + special-val nil)) + (in-special (push char special-val)) + (t (push char result))) + finally (return (coerce (nreverse result) + #-lispworks 'string + #+lispworks 'lw:text-string))))

(defvar *split-scanner* (cl-ppcre:create-scanner '(:char-class #;)))

Index: cl-l10n/locale.lisp diff -u cl-l10n/locale.lisp:1.9 cl-l10n/locale.lisp:1.10 --- cl-l10n/locale.lisp:1.9 Thu Mar 31 15:53:42 2005 +++ cl-l10n/locale.lisp Wed May 18 17:34:08 2005 @@ -2,12 +2,11 @@ ;; See the file LICENCE for licence information.

;; TODO -;; What to do with LC_CTYPE, LC_COLLATE +;; use LC_COLLATE to define locale-uppercase and friends ;; Test on windows. ;; Parsers (money) ;; locale aliases? ;; Optimizing print-time -;; Thread safety

(in-package :cl-l10n )

@@ -21,12 +20,9 @@ "Hash table containing all loaded locales keyed on name (eg. "af_ZA")")

;; Conditions -(defun locale-report (obj stream) - (cl:format stream "~A" (mesg obj))) - (define-condition locale-error (error) ((mesg :accessor mesg :initarg :mesg :initform "Unknown.")) - (:report locale-report)) + (:report (lambda (obj stream) (cl:format stream "~A" (mesg obj)))))

(defun locale-error (string &rest args) (error 'locale-error :mesg (apply #'cl:format nil string args))) @@ -88,8 +84,8 @@ new-val))

(defun locale-value (locale cat key) - (awhen (get-category locale cat) - (category-value it key))) + (when-let (cat (get-category locale cat)) + (category-value cat key)))

(defun getenv (word) #+sbcl (sb-ext:posix-getenv word) @@ -100,24 +96,13 @@ #+ecl (si:getenv word))

;; Getters -(let ((getter-cache (make-hash-table :test #'equal))) - (defun gett-value (locale cat key &optional (wrap #'identity)) - (let ((lookup-key (list locale cat key))) - (multiple-value-bind (val win) (gethash lookup-key getter-cache) - (if (or val win) - val - (setf (gethash lookup-key getter-cache) - (funcall wrap (locale-value locale cat key))))))) - (defun clear-getter-cache () - (setf getter-cache (make-hash-table :test #'equal)))) - -(defmacro defgetter (key cat &key wrap) +(defmacro defgetter (key cat &key (wrap '#'identity)) (let ((name (symb "LOCALE-" (substitute #- #_ (string-upcase key))))) `(progn (defun ,name (&optional (locale *locale*)) (let ((locale (locale-des->locale locale))) (when locale - (gett-value locale ,cat ,key ,@(if wrap (list wrap) nil))))) + (funcall ,wrap (locale-value locale ,cat ,key))))) (export ',name))))

(defun parse-car-or-val (x)

Index: cl-l10n/package.lisp diff -u cl-l10n/package.lisp:1.6 cl-l10n/package.lisp:1.7 --- cl-l10n/package.lisp:1.6 Thu Mar 31 15:53:42 2005 +++ cl-l10n/package.lisp Wed May 18 17:34:08 2005 @@ -3,7 +3,7 @@ (in-package #:cl-l10n.system)

(defpackage #:cl-l10n - (:use #:cl #:cl-ppcre) + (:use #:cl #:cl-ppcre #:cl-fad) (:shadow cl:format cl:formatter) (:export #:locale-name #:category-name #:locale #:category #:locale-error #:get-category #:get-cat-val #:locale-value #:load-all-locales

Index: cl-l10n/parse-number.lisp diff -u cl-l10n/parse-number.lisp:1.4 cl-l10n/parse-number.lisp:1.5 --- cl-l10n/parse-number.lisp:1.4 Thu Mar 31 15:53:42 2005 +++ cl-l10n/parse-number.lisp Wed May 18 17:34:08 2005 @@ -30,7 +30,7 @@ ;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ;;;; SUCH DAMAGE.

-(in-package #:cl-l10n) +(in-package :cl-l10n)

(define-condition parser-error (error) ((value :reader value

Index: cl-l10n/parsers.lisp diff -u cl-l10n/parsers.lisp:1.3 cl-l10n/parsers.lisp:1.4 --- cl-l10n/parsers.lisp:1.3 Wed Mar 30 13:14:53 2005 +++ cl-l10n/parsers.lisp Wed May 18 17:34:08 2005 @@ -1,4 +1,4 @@ -(in-package #:cl-l10n) +(in-package :cl-l10n)

(defun parse-number (num &optional (locale *locale*)) (let ((locale (locale-des->locale locale)))

Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.14 cl-l10n/printers.lisp:1.15 --- cl-l10n/printers.lisp:1.14 Thu Mar 31 15:53:42 2005 +++ cl-l10n/printers.lisp Wed May 18 17:34:08 2005 @@ -67,7 +67,7 @@ (locale-frac-digits locale))) (val-to-print (round-money (abs (coerce arg 'double-float)) frac-digits)) - (float-part (float-part (coerce val-to-print 'float))) + (float-part (float-part val-to-print)) (sym (if use-int-sym (locale-int-curr-symbol locale) (locale-currency-symbol locale))) @@ -333,6 +333,9 @@ (#% (if perc (progn (princ #% stream) (setf perc nil)) (setf perc t))) + ;; see compute-order in load-locale.lisp + ;; for why this line is here. + (#\E (unless perc (princ x stream))) (t (if perc (progn (apply (the function (lookup-formatter x)) stream locale ut values)

Index: cl-l10n/tests.lisp diff -u cl-l10n/tests.lisp:1.7 cl-l10n/tests.lisp:1.8 --- cl-l10n/tests.lisp:1.7 Thu Mar 31 15:53:42 2005 +++ cl-l10n/tests.lisp Wed May 18 17:34:08 2005 @@ -262,4 +262,4 @@

-;; EOF \ No newline at end of file +;; EOF

Index: cl-l10n/utils.lisp diff -u cl-l10n/utils.lisp:1.6 cl-l10n/utils.lisp:1.7 --- cl-l10n/utils.lisp:1.6 Wed Mar 23 11:58:16 2005 +++ cl-l10n/utils.lisp Wed May 18 17:34:08 2005 @@ -16,15 +16,13 @@ `(aif ,(caar options) (progn ,@(cdar options)))))

-(defmacro awhen (test &body body) - `(aif ,test (progn ,@body))) +(defmacro when-let ((var form) &body body) + `(let ((,var ,form)) + (when ,var + ,@body)))

(defmacro with-gensyms (names &body body) `(let ,(mapcar #'(lambda (x) `(,x (gensym))) names) - ,@body)) - -(defmacro awhile (test &body body) - `(loop for it = ,test until (not it) do ,@body))