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

Modified Files: ChangeLog i18n.lisp load-locale.lisp locale.lisp printers.lisp Log Message: Changelog 2005-01-04 Date: Tue Jan 4 16:32:16 2005 Author: sross

Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.8 cl-l10n/ChangeLog:1.9 --- cl-l10n/ChangeLog:1.8 Thu Dec 30 13:29:54 2004 +++ cl-l10n/ChangeLog Tue Jan 4 16:32:15 2005 @@ -1,3 +1,8 @@ +2005-01-04 Sean Ross sross@common-lisp.net + * locale.lisp: Changed get-category, get-locale to generic-functions + Changed macro get-cat-val to method category-value. + * load-locale.lisp: Added *locale-type* and *category-type*. + 2004-12-30 Sean Ross sross@common-lisp.net Version 0.2 Release * printers.lisp, load-locale.lisp: Changed format-number and

Index: cl-l10n/i18n.lisp diff -u cl-l10n/i18n.lisp:1.1 cl-l10n/i18n.lisp:1.2 --- cl-l10n/i18n.lisp:1.1 Wed Dec 1 12:52:35 2004 +++ cl-l10n/i18n.lisp Tue Jan 4 16:32:15 2005 @@ -58,6 +58,8 @@ (defgeneric lookup-name (bundle name) (:method ((bundle t) (name t)) (awhen (get-name bundle name) + ;; The match with the longest name is the most + ;; specific key. (winner #'> (compose #'length #'car) (remove-if-not #'(lambda (x)

Index: cl-l10n/load-locale.lisp diff -u cl-l10n/load-locale.lisp:1.7 cl-l10n/load-locale.lisp:1.8 --- cl-l10n/load-locale.lisp:1.7 Thu Dec 30 12:56:38 2004 +++ cl-l10n/load-locale.lisp Tue Jan 4 16:32:15 2005 @@ -3,9 +3,15 @@ (in-package :cl-l10n)

(defparameter *ignore-categories* - (list "LC_CTYPE" "LC_COLLATE")) + (list "LC_CTYPE" "LC_COLLATE"))

+ +;; Add a restart here? (defun locale (loc-name &key (use-cache t) (errorp t)) + "Find locale named by the string LOC-NAME. If USE-CACHE +is non-nil forcefully reload the locale from *locale-path* else +the locale is first looked for in *locales*. If ERRORP is non-nil +signal a warning rather than an error if the locale file cannot be found." (let ((name (aif (position #. loc-name) (subseq loc-name 0 it) loc-name))) @@ -16,12 +22,22 @@ ((and use-cache (get-locale name)) it) ((probe-file (merge-pathnames *locale-path* name)) (load-locale name)) - ((not errorp) (warn "Can't find locale ~A." name)) - (errorp (locale-error "Can't find locale ~A." name))))) + (t (funcall (if errorp #'error #'warn) + "Can't find locale ~A." name))))) + +(defvar *locale-type* 'locale + "The class of loaded locales.") + +(defvar *category-type* 'category + "The class of loaded categories")

-(defvar *locale-type* 'locale) +(deftype locale-descriptor () + `(or locale string symbol))

(defun locale-des->locale (loc) + "Turns a locale descriptor(a string, symbol or locale) into an +actual locale object." + (check-type loc locale-descriptor) (etypecase loc (locale loc) (string (locale loc)) @@ -40,16 +56,19 @@ (awhile (next-header stream) (awhen (make-category locale it (parse-category it stream escape comment)) - (setf (get-category (category-name it) locale) it))))) + (setf (get-category locale (category-name it)) it))))) (add-printers locale) (setf (get-locale name) locale))))

-(defun load-all-locales (&optional (*locale-path* *locale-path*)) - (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))))))) +(defun load-all-locales (&optional (path *locale-path*)) + "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))))))))

(defun create-number-fmt-string (locale no-ts) @@ -96,6 +115,7 @@ (princ (if (zerop spos) ")" sign) stream))))))

(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)) @@ -122,7 +142,8 @@ ("LC_TELEPHONE" . load-category) ("LC_MEASUREMENT" . load-category) ("LC_NAME" . load-category) - ("LC_ADDRESS" . load-category))) + ("LC_ADDRESS" . load-category)) + "Map of category names to the function which will load them.")

(defun get-loader (name) (cdr (assoc name *category-loaders* :test #'string=))) @@ -131,14 +152,15 @@ (awhen (get-loader name) (funcall it locale name vals)))

-(defun load-category (locale name vals) - (declare (ignore locale)) - (let ((cat (make-instance 'category :name name))) - (etypecase vals - (category vals) - (cons (dolist (x vals) - (setf (get-cat-val (car x) cat) (cdr x))) - cat)))) +(defgeneric load-category (locale name vals) + (:documentation "Load a category for LOCALE using VALS.") + (:method ((locale locale) (name string) (vals category)) + vals) + (:method ((locale locale) (name string) (vals cons)) + (let ((cat (make-instance *category-type* :name name))) + (dolist (x vals) + (setf (category-value cat (car x)) (cdr x))) + cat)))

(defvar *id-vals* '(("title" . title) @@ -148,7 +170,6 @@ ("revision" . revision) ("date" . date) ("categories" . categories))) -

(defun load-identification (locale name vals) (declare (ignore name)) @@ -159,7 +180,7 @@

(defun line-comment-p (line comment) (or (string= line "") - (and (> (length line) 0) ;; Ignore a comment line + (and (> (length line) 0) (char= (schar line 0) comment))))

Index: cl-l10n/locale.lisp diff -u cl-l10n/locale.lisp:1.6 cl-l10n/locale.lisp:1.7 --- cl-l10n/locale.lisp:1.6 Thu Dec 30 12:56:38 2004 +++ cl-l10n/locale.lisp Tue Jan 4 16:32:15 2005 @@ -7,18 +7,13 @@ ;; Parsers (money and time) ;; locale aliases ;; Optimizing print-time +;; Thread safety

(in-package :cl-l10n )

-;; Variables (defvar *locale-path* - (let ((path *load-pathname*)) - (make-pathname :host (pathname-host path) - :device (pathname-device path) - :directory - (append (pathname-directory path) - '("locales")) - :defaults #P""))) + (merge-pathnames (make-pathname :directory '(:relative "locales")) + (directory-namestring *load-pathname*)))

(defvar *locale* nil)

@@ -65,19 +60,35 @@ (princ (category-name obj) stream)))

-;; Macros -(defmacro get-locale (name) - `(gethash ,name *locales*)) - -(defmacro get-category (name locale) - `(gethash ,name (categories ,locale))) - -(defmacro get-cat-val (value cat) - `(gethash ,value (vals ,cat))) +(declaim (inline get-locale)) +(defun get-locale (name) + (gethash name *locales*)) + +(defun (setf get-locale) (new-val name) + (setf (gethash name *locales*) + new-val)) + +(defgeneric get-category (locale name) + (:documentation "Find category called NAME in locale LOCALE.") + (:method ((locale locale) (name string)) + (gethash name (categories locale)))) + +(defmethod (setf get-category) ((new-val category) (locale locale) (name string)) + (setf (gethash name (categories locale)) + new-val)) + +(defgeneric category-value (category key) + (:documentation "Lookup attribute named by string KEY in category CATEGORY.") + (:method ((category category) (key string)) + (gethash key (vals category)))) + +(defmethod (setf category-value) ((new-val t) (category category) (key string)) + (setf (gethash key (vals category)) + new-val))

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

(defun getenv (word) #+sbcl (sb-ext:posix-getenv word)

Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.7 cl-l10n/printers.lisp:1.8 --- cl-l10n/printers.lisp:1.7 Thu Dec 30 12:56:38 2004 +++ cl-l10n/printers.lisp Tue Jan 4 16:32:15 2005 @@ -100,7 +100,7 @@

(defvar *time-formatters* (make-hash-table)) (defmacro def-formatter (sym &body body) - "Creates a function with body which can be looked up using lookup-formatter + "Creates a function with BODY which can be looked up using lookup-formatter using the character SYM." (let ((name (gensym (mkstr "FORMATTER-" sym)))) `(flet ((,name (stream locale ut sec min hour date month year day