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(a)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(a)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
