From sross at common-lisp.net  Tue Jan  4 15:32:19 2005
From: sross at common-lisp.net (Sean Ross)
Date: Tue,  4 Jan 2005 16:32:19 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/i18n.lisp
	cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/printers.lisp 
Message-ID: <20050104153219.0F9B9884F7@common-lisp.net>

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 at 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 at 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