From sross at common-lisp.net  Wed May 18 15:34:13 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 18 May 2005 17:34:13 +0200 (CEST)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/README
	cl-l10n/cl-l10n.asd cl-l10n/i18n.lisp
	cl-l10n/load-locale.lisp cl-l10n/locale.lisp
	cl-l10n/package.lisp cl-l10n/parse-number.lisp
	cl-l10n/parsers.lisp cl-l10n/printers.lisp cl-l10n/tests.lisp
	cl-l10n/utils.lisp 
Message-ID: <20050518153413.54C828873F@common-lisp.net>

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 at 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 at 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 at jhb.ucs.co.za>"
   :maintainer "Sean Ross <sdr at 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 , at body)))
+(defmacro when-let ((var form) &body body)
+  `(let ((,var ,form))
+     (when ,var
+       , at body)))
 
 (defmacro with-gensyms (names &body body)
   `(let ,(mapcar #'(lambda (x) `(,x (gensym))) names)
-    , at body))
-
-(defmacro awhile (test &body body)
-  `(loop for it = ,test until (not it) do
     , at body))
 
 



From sross at common-lisp.net  Wed May 18 15:34:14 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 18 May 2005 17:34:14 +0200 (CEST)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/locales/ar_SA 
Message-ID: <20050518153414.AC9AF88742@common-lisp.net>

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

Modified Files:
	ar_SA 
Log Message:
Changelog 2005-05-18
Date: Wed May 18 17:34:13 2005
Author: sross

Index: cl-l10n/locales/ar_SA
diff -u cl-l10n/locales/ar_SA:1.2 cl-l10n/locales/ar_SA:1.3
--- cl-l10n/locales/ar_SA:1.2	Tue Nov 30 10:45:48 2004
+++ cl-l10n/locales/ar_SA	Wed May 18 17:34:12 2005
@@ -300,10 +300,10 @@
 % t_fmt_ampm	"%.1H:%M:%S"
 
 LC_TIME
-d_t_fmt	"<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-d_fmt	"<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
-t_fmt	"<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-t_fmt_ampm	"<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_t_fmt	"<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_fmt	"<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
+t_fmt	"<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+t_fmt_ampm	"<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
 day	"<U0627><U0644><U0623><U062D><U062F>"; /
 	"<U0627><U0644><U0625><U062B><U0646><U064A><U0646>"; /
 	"<U0627><U0644><U062B><U0644><U0627><U062B><U0627><U0621>"; /



From sross at common-lisp.net  Wed May 25 09:30:54 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 25 May 2005 11:30:54 +0200 (CEST)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog
	cl-l10n/load-locale.lisp cl-l10n/printers.lisp 
Message-ID: <20050525093054.2D2D288730@common-lisp.net>

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

Modified Files:
	ChangeLog load-locale.lisp printers.lisp 
Log Message:
Changelog 2005-05-25
Date: Wed May 25 11:30:51 2005
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.17 cl-l10n/ChangeLog:1.18
--- cl-l10n/ChangeLog:1.17	Wed May 18 17:34:07 2005
+++ cl-l10n/ChangeLog	Wed May 25 11:30:51 2005
@@ -1,3 +1,7 @@
+2005-05-25 Sean Ross	<sross at common-lisp.net>
+	* locales/ar_SA: revert.
+	* load-locale.lisp, printers.lisp: Added support for the .1 in the ar_SA locale.
+	
 2005-05-18 Sean Ross	<sross at common-lisp.net>
 	load-all-locales now works.
 	* cl-l10n.asd: Added dependency to cl-fad
@@ -9,7 +13,7 @@
 	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
+	* locales/ar_SA: This locale has a .1 in front of
 	various time printing directives. I have no idea what these
 	mean....
 	


Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.13 cl-l10n/load-locale.lisp:1.14
--- cl-l10n/load-locale.lisp:1.13	Wed May 18 17:34:08 2005
+++ cl-l10n/load-locale.lisp	Wed May 25 11:30:51 2005
@@ -172,9 +172,13 @@
 (defun compute-order (fmt)
   (let ((res nil))
     (loop for char across fmt 
-          with perc = nil do
+          with perc = nil 
+          with in-dot = nil do
           (cond ((char= char #\%) (setf perc (not perc)))
                 ((member char date-dividers) nil)
+                ((and perc (char= char #\.))  (setf in-dot t))
+                ((and perc in-dot (char= char #\1))  
+                 (setf in-dot nil))
                 (perc (unless (char= char #\E)
                         ;; some locales (eg lo_LA) have this funny E before
                         ;; various time format designators. Debian 


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.15 cl-l10n/printers.lisp:1.16
--- cl-l10n/printers.lisp:1.15	Wed May 18 17:34:08 2005
+++ cl-l10n/printers.lisp	Wed May 25 11:30:51 2005
@@ -328,13 +328,18 @@
   (declare (optimize speed) (type simple-string fmt-string))
   (let ((values (multiple-value-list (decode-universal-time ut *time-zone*))))
     (loop for x across fmt-string 
-          with perc = nil do
+          with perc = nil 
+          with in-dot = nil do
           (case x 
             (#\% (if perc 
                      (progn (princ #\% stream) (setf perc nil))
                      (setf perc t)))
             ;; see compute-order in load-locale.lisp
             ;; for why this line is here.
+            (#\. (if perc (setf in-dot t) (princ x stream)))
+            (#\1 (if (and perc in-dot) 
+                     (setf in-dot nil)
+                     (princ x stream)))
             (#\E (unless perc (princ x stream)))
             (t (if perc
                    (progn (apply (the function (lookup-formatter x))



From sross at common-lisp.net  Wed May 25 09:30:55 2005
From: sross at common-lisp.net (Sean Ross)
Date: Wed, 25 May 2005 11:30:55 +0200 (CEST)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/locales/ar_SA 
Message-ID: <20050525093055.892288873D@common-lisp.net>

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

Modified Files:
	ar_SA 
Log Message:
Changelog 2005-05-25
Date: Wed May 25 11:30:54 2005
Author: sross

Index: cl-l10n/locales/ar_SA
diff -u cl-l10n/locales/ar_SA:1.3 cl-l10n/locales/ar_SA:1.4
--- cl-l10n/locales/ar_SA:1.3	Wed May 18 17:34:12 2005
+++ cl-l10n/locales/ar_SA	Wed May 25 11:30:54 2005
@@ -300,10 +300,10 @@
 % t_fmt_ampm	"%.1H:%M:%S"
 
 LC_TIME
-d_t_fmt	"<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-d_fmt	"<U0025><U0041><U0020><U0025><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
-t_fmt	"<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
-t_fmt_ampm	"<U0025><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_t_fmt	"<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059><U0020><U0020><U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+d_fmt	"<U0025><U0041><U0020><U0025><U002E><U0031><U0064><U0020><U0025><U0042><U0020><U0025><U0059>"
+t_fmt	"<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
+t_fmt_ampm	"<U0025><U002E><U0031><U0048><U003A><U0025><U004D><U003A><U0025><U0053>"
 day	"<U0627><U0644><U0623><U062D><U062F>"; /
 	"<U0627><U0644><U0625><U062B><U0646><U064A><U0646>"; /
 	"<U0627><U0644><U062B><U0644><U0627><U062B><U0627><U0621>"; /