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(a)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(a)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(a)jhb.ucs.co.za>"
:maintainer "Sean Ross <sdr(a)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))
