From sross at common-lisp.net  Wed Dec  1 11:48:46 2004
From: sross at common-lisp.net (Sean Ross)
Date: Wed,  1 Dec 2004 12:48:46 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd
	cl-l10n/load-locale.lisp cl-l10n/locale.lisp
	cl-l10n/package.lisp cl-l10n/printers.lisp cl-l10n/utils.lisp
Message-ID: <20041201114846.B4C6A884FB@common-lisp.net>

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

Modified Files:
	ChangeLog cl-l10n.asd load-locale.lisp locale.lisp 
	package.lisp printers.lisp utils.lisp 
Log Message:
Changelog 2004-12-01
Date: Wed Dec  1 12:48:40 2004
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.2 cl-l10n/ChangeLog:1.3
--- cl-l10n/ChangeLog:1.2	Tue Nov 30 10:45:32 2004
+++ cl-l10n/ChangeLog	Wed Dec  1 12:48:39 2004
@@ -1,3 +1,9 @@
+2004-12-01 Sean Ross <sross at common-lisp.net>
+	Version 0.1 Release
+	* i18n.lisp: Basic internationalisation support.
+	* tests.lisp: Basic tests for package.
+	* printers.lisp: Added format directive %s
+	
 2004-11-30 Sean Ross <sross at common-lisp.net>
 	* utils.lisp, printers.lisp:
 	Changed read-from-string to parse-integer.
@@ -9,7 +15,7 @@
 	LGPL.
 	* README: Basic readme file.
 	* load-locale.lisp: Fixed load-all-locales to really
-	load from a specific path and warnings if loading 
+	load from a specific path and to signal a warning if loading 
 	a locale fails.
 	* locale.lisp: Changed the typecase for locale-des->locale
 	to etypecase.


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.2 cl-l10n/cl-l10n.asd:1.3
--- cl-l10n/cl-l10n.asd:1.2	Tue Nov 30 10:45:32 2004
+++ cl-l10n/cl-l10n.asd	Wed Dec  1 12:48:40 2004
@@ -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.0.6"
+  :version "0.1"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"
@@ -19,10 +19,23 @@
                (:file "utils" :depends-on ("package"))
                (:file "locale" :depends-on ("utils"))
                (:file "printers" :depends-on ("locale"))
+               (:file "i18n" :depends-on ("printers"))
                (:file "load-locale" :depends-on ("printers")))
   :depends-on (:cl-ppcre))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n))))
   (provide 'cl-l10n))
-               
+      
+
+(defmethod perform ((op test-op) (sys (eql (find-system :cl-l10n))))
+  (oos 'load-op :cl-l10n-tests)
+  (oos 'test-op :cl-l10n-tests))
+
+(defsystem cl-l10n-tests
+  :depends-on (rt cl-l10n)
+  :components ((:file "tests")))
+
+(defmethod perform ((op test-op) (sys (eql (find-system :cl-l10n-tests))))
+  (funcall (find-symbol "DO-TESTS" "REGRESSION-TEST")))
+
 ;; EOF


Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.5 cl-l10n/load-locale.lisp:1.6
--- cl-l10n/load-locale.lisp:1.5	Tue Nov 30 10:45:32 2004
+++ cl-l10n/load-locale.lisp	Wed Dec  1 12:48:40 2004
@@ -18,7 +18,7 @@
 
 (defun load-locale (name)
   (let ((path (merge-pathnames *locale-path* name)))
-    (format t ";; Loading locale from ~A.~%" path)
+    (format t "~&;; Loading locale from ~A.~%" path)
     (let ((locale (make-instance 'locale :name name))
           (*read-eval* nil)
           (*print-circle* nil))


Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.3 cl-l10n/locale.lisp:1.4
--- cl-l10n/locale.lisp:1.3	Tue Nov 30 10:45:32 2004
+++ cl-l10n/locale.lisp	Wed Dec  1 12:48:40 2004
@@ -3,12 +3,7 @@
 
 ;; TODO
 ;;  What to do with LC_CTYPE, LC_COLLATE
-;;  Tests
-;;  Finish time format directives
 ;;  Test on windows.
-;;  Merge with property files
-;;  Cache getters? (reset on reload of locales)
-;;  Time Zone printing
 ;;  Parsers?
 
 (in-package :cl-l10n )
@@ -147,9 +142,6 @@
 (defgetter "postal_fmt" "LC_ADDRESS")
 (defgetter "tel_int_fmt" "LC_TELEPHONE")
 (defgetter "measurement" "LC_MEASUREMENT")
-
-
-
 
 
 ;; EOF


Index: cl-l10n/package.lisp
diff -u cl-l10n/package.lisp:1.1.1.1 cl-l10n/package.lisp:1.2
--- cl-l10n/package.lisp:1.1.1.1	Mon Nov 29 10:56:55 2004
+++ cl-l10n/package.lisp	Wed Dec  1 12:48:40 2004
@@ -8,5 +8,6 @@
            #:get-category #:get-cat-val #:locale-value #:load-all-locales
            #:*locale* #:*locale-path* #:*locales*
            #:format-number #:print-number #:format-money #:print-money
-           #:format-time #:print-time))
+           #:format-time #:print-time #:add-resources #:bundle 
+           #:add-resource #:gettext))
            


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.3 cl-l10n/printers.lisp:1.4
--- cl-l10n/printers.lisp:1.3	Tue Nov 30 10:45:32 2004
+++ cl-l10n/printers.lisp	Wed Dec  1 12:48:40 2004
@@ -108,7 +108,7 @@
             (princ point stream)
             (princ float-part stream))
           (unless prec
-            (format stream "~A~A" sym-sep sym))
+            (format stream "~A~A" sym-sep (trim sym)))
           (when (or* (= spos 0 2 4))
             (when (= 2 sep-by-space)
               (print #\Space stream))
@@ -158,13 +158,12 @@
 (def-formatter #\a
     (let ((day (1+ day)))
       (if (> day 6) (decf day 7))
-      (format stream "~:(~A~)" (nth day (locale-abday locale)))))
+      (princ (nth day (locale-abday locale)) stream)))
 
 (def-formatter #\A
     (let ((day (1+ day)))
       (if (> day 6) (decf day 7))
-      (format stream "~:(~A~)"
-              (nth day (locale-day locale)))))
+      (princ (nth day (locale-day locale)) stream)))
 
 
 (def-formatter #\b
@@ -210,7 +209,6 @@
     (princ (pad-val (if (> hour 12) (- hour 12) hour))
            stream))
 
-;; %j day of year
 (defvar *mon-days* 
   '(31 28 31 30 31 30 31 31 30 31 30 31))
 
@@ -272,6 +270,11 @@
 (def-formatter #\R
     (print-time-string "%H:%M" stream ut locale))
 
+(defvar *1970-01-01* (encode-universal-time 0 0 0 01 01 1970 0))
+
+(def-formatter #\s
+    (princ (- ut *1970-01-01*) stream))
+
 (def-formatter #\S
     (princ (pad-val sec) stream))
 
@@ -286,9 +289,11 @@
       (when (> day 7) (decf day 7))
       (princ day stream)))
 
+;; FIXME
 (def-formatter #\U
     (locale-error "Unsupported time format directive ~S." #\U))
 
+;; FIXME
 (def-formatter #\V
     (locale-error "Unsupported time format directive ~S." #\V))
 
@@ -297,6 +302,7 @@
       (if (< day 0) (incf day 7))
       (princ day stream)))
 
+;; FIXME
 (def-formatter #\W
     (locale-error "Unsupported time format directive ~S." #\W))
 


Index: cl-l10n/utils.lisp
diff -u cl-l10n/utils.lisp:1.2 cl-l10n/utils.lisp:1.3
--- cl-l10n/utils.lisp:1.2	Tue Nov 30 10:45:32 2004
+++ cl-l10n/utils.lisp	Wed Dec  1 12:48:40 2004
@@ -86,6 +86,29 @@
 
 
 
+(defun winner (test get seq)
+  (if (null seq)
+      nil
+      (let* ((val (elt seq 0))
+             (res (funcall get val)))
+        (dolist (x (subseq seq 1) (values val res))
+          (let ((call (funcall get x)))
+            (when (funcall test call res)
+              (setf res call
+                    val x)))))))
+
+(defun compose (&rest fns)
+  (if fns
+      (let ((last-fn (last1 fns))
+            (fns (butlast fns)))
+        #'(lambda (&rest args)
+            (reduce #'funcall
+                    fns
+                    :from-end t 
+                    :initial-value (apply last-fn args))))
+      #'identity))
+
+
 (defun get-first (fore aft)
   (if (< fore 1)
       "0"



From sross at common-lisp.net  Wed Dec  1 11:48:48 2004
From: sross at common-lisp.net (Sean Ross)
Date: Wed,  1 Dec 2004 12:48:48 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi 
Message-ID: <20041201114848.EE20F884FB@common-lisp.net>

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

Modified Files:
	cl-l10n.texi 
Log Message:
Changelog 2004-12-01
Date: Wed Dec  1 12:48:46 2004
Author: sross

Index: cl-l10n/doc/cl-l10n.texi
diff -u cl-l10n/doc/cl-l10n.texi:1.1.1.1 cl-l10n/doc/cl-l10n.texi:1.2
--- cl-l10n/doc/cl-l10n.texi:1.1.1.1	Mon Nov 29 10:59:09 2004
+++ cl-l10n/doc/cl-l10n.texi	Wed Dec  1 12:48:46 2004
@@ -60,6 +60,7 @@
 * Introduction:         Introduction
 * Getting Started:      Getting Started
 * API:                  API
+* I18N:                 I18N
 * Notes:                Notes
 * Credits:              Credits
 * Index::
@@ -128,9 +129,12 @@
 
 @section Installing
 Once downloaded and symlinked you can load CL-L10N at anytime using
- at lisp (asdf:oos 'asdf:load-op :cl-l10n) @end lisp
+ at code{(asdf:oos 'asdf:load-op :cl-l10n)}
 This will compile CL-L10n the first time it is loaded.
 
+Once installed run @code{(asdf:oos 'asdf:test-op :cl-l10n)} to test
+the package. If any tests fail please send an email to one of the
+mailing lists.
 
 @node API
 @chapter API
@@ -194,8 +198,7 @@
 Example (assuming *locale* is  en_ZA)
 @lisp
 (format t "~:/cl-l10n:format-number/" 1002932)
-1,002,932   ;; Printed
-NIL         ;; Returned
+ prints `1,002,932`
 
 @end lisp
 @end deffn
@@ -215,14 +218,13 @@
 Examples.
 @lisp
 (format t "~/cl-l10n:format-money/" 188232.2322)
-R188,232.23 ;; Printed
-NIL         ;; Returned
+ prints `R188,232.23`
 
 ;; and 
 
 (format t "~:/cl-l10n:format-money/" 188232.2322)
-ZAR 188,232.23   ;; Printed 
-NIL              ;; Returned
+ prints `ZAR 188,232.23`  
+
 @end lisp
 @end deffn
 
@@ -238,8 +240,8 @@
 The format of the time printed is controlled by @code{show-time} and @code{show-date}.
 
 If @emph{fmt} is not nil then @emph{show-date} and @emph{show-time} are ignored 
-and @emph{fmt} is used as the format control string. For details of control
-characters try 'man date'.
+and @emph{fmt} is used as the format control string. For details of format
+directive look at 'man 1 date' although some directives are not supported, namely %U, %V and %W.
 
 Examples (assuming *locale* is ``en_ZA'')
 @lisp
@@ -284,6 +286,114 @@
 Root CL-L10N condition which will be signalled when an exceptional 
 situation occurs.
 @end deftp
+
+ at node I18N
+ at chapter I18N
+
+ at section Internationalisation
+CL-L10N supports internationalised strings through the use 
+of bundles. 
+The process is currently extremely basic, and is bound to 
+change in the future, but is flexible and does what is expected of it.
+
+First you define a bundle using @code{make-instance}.
+ at lisp
+(defvar *my-bundle* (make-instance 'bundle))
+ at end lisp
+
+Then you add resources to your bundle using either @code{add-resource} 
+or @code{add-resources}. 
+
+ at lisp
+(add-resources (bundle "af_")
+  "showtime" "Dankie, die tyd is ~:@/cl-l10n:format-time/~%")
+
+;; an empty string as the locale matcher becomes the default
+(add-resources (bundle "") 
+  "showtime" "Thanks, the time is ~:@/cl-l10n:format-time/~%")
+
+ at end lisp
+
+Then by using @code{gettext} you can lookup locale specific strings.
+ at lisp
+(defun timey () (format t (gettext "showtime" bundle) 3310880446))
+(timey) ;; with locale en_ZA
+ prints `Thanks, the time is Wed 01 Dec 2004 11:00:46 +0200`
+
+(let ((*locale* (locale "af_ZA")))
+  (timey))
+ prints `Dankie, di tyd is Wo 01 Des 2004 11:00:46 +0200`
+ at end lisp
+
+A useful trick is to define either a macro or reader macro wrapping
+gettext for your specific bundle 
+eg.
+ at lisp
+(set-dispatch-macro-character
+ #\# #\"
+ #'(lambda (s c1 c2)
+     (declare (ignore c2))
+     (unread-char c1 s)
+     `(cl-l10n:gettext ,(read s) bundle)))
+ 
+;; or this
+
+(defmacro _ (text)
+  `(cl-l10n:gettext ,text bundle))
+
+ at end lisp
+
+which would change the @code{timey} function to 
+ at lisp
+(defun timey () (format t #"showtime" 3310880446))
+;; or 
+(defun timey () (format t (_ "showtime") 3310880446))
+
+ at end lisp
+
+ at section API
+ at anchor {Generic add-resource}
+ at deffn {Generic} add-resource bundle from to locale-name
+Adds an entry to @emph{bundle} for @emph{locale-name}  mappings
+ at emph{from} to @emph{to}. The @emph{locale-name} does not 
+have to be a full name like ``en_US'' but can be a partial match
+like ``en_''. Adding mappings for these two locale-names will
+result in the mapping for ``en_US'' being used when the locale
+is ``en_US'' and the mapping for ``en_'' being used when using any
+other english locale. Adding a mapping for an empty locale-name
+will become the default.
+ at lisp
+;; Add mapping for welcome for Afrikaans languages. 
+(add-resource *my-bundle* "welcome" "welkom" "af_")
+ at end lisp
+ at end deffn
+
+ at anchor {Macro add-resources}
+ at deffn {Macro} add-resources (bundle locale-name) &rest entries
+Utility macro to group large amounts of entries into a single
+logical block for a locale.
+ at lisp
+(add-resources (bundle "af_") 
+  "hello" "hallo"
+  "goodbye" "totsiens"
+  "yes" "ja"
+  "no "nee")
+
+== 
+
+(add-resource bundle "hello" "hallo" "af_")
+(add-resource bundle "goodbye" "totsiens" "af_")
+(add-resource bundle "yes" "ja" "af_")
+(add-resource bundle "no" "nee" "af_")
+
+ at end lisp
+ at end deffn
+
+ at anchor {Function gettext}
+ at deffn {Function} gettext name bundle &optional (*locale* *locale* )
+Looks for a mapping for @emph{name} in @emph{bundle}. If no mapping
+is found returns name. 
+ at end deffn
 
 
 @node Notes



From sross at common-lisp.net  Wed Dec  1 11:52:38 2004
From: sross at common-lisp.net (Sean Ross)
Date: Wed,  1 Dec 2004 12:52:38 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/i18n.lisp cl-l10n/tests.lisp 
Message-ID: <20041201115238.74969884FB@common-lisp.net>

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

Added Files:
	i18n.lisp tests.lisp 
Log Message:
Changelog 2004-12-01
Date: Wed Dec  1 12:52:35 2004
Author: sross






From sross at common-lisp.net  Tue Dec  7 09:21:56 2004
From: sross at common-lisp.net (Sean Ross)
Date: Tue,  7 Dec 2004 10:21:56 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/utils.lisp 
Message-ID: <20041207092156.0B579880A8@common-lisp.net>

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

Modified Files:
	utils.lisp 
Log Message:
Changelog 2004-12-07
Date: Tue Dec  7 10:21:55 2004
Author: sross

Index: cl-l10n/utils.lisp
diff -u cl-l10n/utils.lisp:1.3 cl-l10n/utils.lisp:1.4
--- cl-l10n/utils.lisp:1.3	Wed Dec  1 12:48:40 2004
+++ cl-l10n/utils.lisp	Tue Dec  7 10:21:55 2004
@@ -171,7 +171,7 @@
                              (m+ m+ (* m+ print-base))
                              (m- m- (* m- print-base)))
                             ((not (or (< (* (+ r m+) print-base) s)
-                                      (and high-ok (= (* (+ r m+) print-base) s))))
+                                      (and (not high-ok) (= (* (+ r m+) print-base) s))))
                              (values k (generate r s m+ m-)))))))
                  (generate (r s m+ m-)
                    (let (d tc1 tc2)



From sross at common-lisp.net  Tue Dec  7 09:23:31 2004
From: sross at common-lisp.net (Sean Ross)
Date: Tue,  7 Dec 2004 10:23:31 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd 
Message-ID: <20041207092331.9BA5C880A8@common-lisp.net>

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

Modified Files:
	ChangeLog cl-l10n.asd 
Log Message:
Changelog 2004-12-07
Date: Tue Dec  7 10:23:29 2004
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.3 cl-l10n/ChangeLog:1.4
--- cl-l10n/ChangeLog:1.3	Wed Dec  1 12:48:39 2004
+++ cl-l10n/ChangeLog	Tue Dec  7 10:23:29 2004
@@ -1,3 +1,7 @@
+2004-12-07 Sean Ross <sross at common-lisp.net>
+	* utils.lisp: Patch for flonum-to-digits from Raymond Toy 
+	on cmucl-help (06 Dec 2004, Strange error).
+
 2004-12-01 Sean Ross <sross at common-lisp.net>
 	Version 0.1 Release
 	* i18n.lisp: Basic internationalisation support.


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.3 cl-l10n/cl-l10n.asd:1.4
--- cl-l10n/cl-l10n.asd:1.3	Wed Dec  1 12:48:40 2004
+++ cl-l10n/cl-l10n.asd	Tue Dec  7 10:23:29 2004
@@ -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.1"
+  :version "0.1.1"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"



From sross at common-lisp.net  Wed Dec  8 10:02:29 2004
From: sross at common-lisp.net (Sean Ross)
Date: Wed,  8 Dec 2004 11:02:29 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/parse-number.lisp
	cl-l10n/parsers.lisp cl-l10n/ChangeLog cl-l10n/cl-l10n.asd
	cl-l10n/locale.lisp cl-l10n/package.lisp
	cl-l10n/printers.lisp cl-l10n/tests.lisp 
Message-ID: <20041208100229.4E2E4880A8@common-lisp.net>

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

Modified Files:
	ChangeLog cl-l10n.asd locale.lisp package.lisp printers.lisp 
	tests.lisp 
Added Files:
	parse-number.lisp parsers.lisp 
Log Message:
Changelog 2004-12-08
Date: Wed Dec  8 11:02:23 2004
Author: sross





Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.4 cl-l10n/ChangeLog:1.5
--- cl-l10n/ChangeLog:1.4	Tue Dec  7 10:23:29 2004
+++ cl-l10n/ChangeLog	Wed Dec  8 11:02:23 2004
@@ -1,6 +1,15 @@
+2004-12-08 Sean Ross	<sross at common-lisp.net>
+	* printers.lisp: Added format which can be shadow imported
+	to provide 3 new format directive ~u(universal-time), ~m(monetary)
+	and ~n(numeric), all other directives are unchanged.
+	* printers.lisp: Use locale-t-fmt if locale-t-fmt-ampm is an 
+	empty string.
+	* locale.lisp: Added support for ECL.
+	* parse-number.lisp, parsers.lisp: Added a basic number parser.
+	
 2004-12-07 Sean Ross <sross at common-lisp.net>
 	* utils.lisp: Patch for flonum-to-digits from Raymond Toy 
-	on cmucl-help (06 Dec 2004, Strange error).
+	on cmucl-help (06 Dec 2004, Subject: Strange error).
 
 2004-12-01 Sean Ross <sross at common-lisp.net>
 	Version 0.1 Release


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.4 cl-l10n/cl-l10n.asd:1.5
--- cl-l10n/cl-l10n.asd:1.4	Tue Dec  7 10:23:29 2004
+++ cl-l10n/cl-l10n.asd	Wed Dec  8 11:02:23 2004
@@ -11,16 +11,18 @@
   :name "CL-L10N"
   :author "Sean Ross <sdr at jhb.ucs.co.za>"
   :maintainer "Sean Ross <sdr at jhb.ucs.co.za>"
-  :version "0.1.1"
+  :version "0.1.7"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"
   :components ((:file "package")
+               (:file "parse-number" :depends-on ("package"))
                (:file "utils" :depends-on ("package"))
                (:file "locale" :depends-on ("utils"))
                (:file "printers" :depends-on ("locale"))
+               (:file "parsers" :depends-on ("printers" "parse-number"))
                (:file "i18n" :depends-on ("printers"))
-               (:file "load-locale" :depends-on ("printers")))
+               (:file "load-locale" :depends-on ("locale")))
   :depends-on (:cl-ppcre))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n))))


Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.4 cl-l10n/locale.lisp:1.5
--- cl-l10n/locale.lisp:1.4	Wed Dec  1 12:48:40 2004
+++ cl-l10n/locale.lisp	Wed Dec  8 11:02:23 2004
@@ -5,6 +5,7 @@
 ;;  What to do with LC_CTYPE, LC_COLLATE
 ;;  Test on windows.
 ;;  Parsers?
+;;  locale aliases
 
 (in-package :cl-l10n )
 
@@ -82,7 +83,8 @@
   #+sbcl (sb-ext:posix-getenv word)
   #+lispworks (hcl:getenv word)
   #+cmu (cdr (assoc (intern word :keyword) ext:*environment-list*))
-  #+clisp (ext:getenv word))
+  #+clisp (ext:getenv word)
+  #+ecl (si:getenv word))
 
 
 ;; Getters


Index: cl-l10n/package.lisp
diff -u cl-l10n/package.lisp:1.2 cl-l10n/package.lisp:1.3
--- cl-l10n/package.lisp:1.2	Wed Dec  1 12:48:40 2004
+++ cl-l10n/package.lisp	Wed Dec  8 11:02:23 2004
@@ -4,10 +4,11 @@
 
 (defpackage #:cl-l10n 
   (:use #:cl #:cl-ppcre)
+  (:shadow cl:format)
   (:export #:locale-name #:category-name #:locale #:category #:locale-error
            #:get-category #:get-cat-val #:locale-value #:load-all-locales
            #:*locale* #:*locale-path* #:*locales*
            #:format-number #:print-number #:format-money #:print-money
            #:format-time #:print-time #:add-resources #:bundle 
-           #:add-resource #:gettext))
+           #:add-resource #:gettext #:parse-number))
            


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.4 cl-l10n/printers.lisp:1.5
--- cl-l10n/printers.lisp:1.4	Wed Dec  1 12:48:40 2004
+++ cl-l10n/printers.lisp	Wed Dec  8 11:02:23 2004
@@ -126,7 +126,9 @@
   (cond ((and show-time show-date)
          (locale-d-t-fmt locale))
         ((and (not show-date) (not show-time))
-         (locale-t-fmt-ampm locale))
+         (if (string= "" (locale-t-fmt-ampm locale))
+             (locale-t-fmt locale)
+             (locale-t-fmt-ampm locale)))
         (show-time (locale-t-fmt locale))
         (show-date (locale-d-fmt locale))))
 
@@ -356,4 +358,36 @@
     (format-time stream ut show-date show-time locale fmt)
     ut))
       
+
+;; Format
+
+(defun format (stream fmt-string &rest args)
+  (apply #'cl:format stream (parse-fmt-string fmt-string) args))
+
+(defun parse-fmt-string (string)
+  (with-output-to-string (fmt-string)
+    (loop for char across string 
+          with tilde = nil do
+         (case char
+           ((#\@ #\v #\, #\:) (princ char fmt-string))
+           (#\~ (princ char fmt-string)
+                (if tilde 
+                    (setf tilde nil)
+                    (setf tilde t)))
+           (t (if tilde
+                  (progn (setf tilde nil) (princ (get-replacement char) fmt-string))
+                  (princ char fmt-string)))))))
+
+(defvar *directive-replacements*
+  '((#\M . "/cl-l10n:format-money/")
+    (#\U . "/cl-l10n:format-time/")
+    (#\N . "/cl-l10n:format-number/")))
+
+(defun get-replacement (char)
+  (or (cdr (assoc (char-upcase char) *directive-replacements*))
+      char))
+  
+
+
+
 ;; EOF


Index: cl-l10n/tests.lisp
diff -u cl-l10n/tests.lisp:1.1 cl-l10n/tests.lisp:1.2
--- cl-l10n/tests.lisp:1.1	Wed Dec  1 12:52:35 2004
+++ cl-l10n/tests.lisp	Wed Dec  8 11:02:23 2004
@@ -1,6 +1,7 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;; See the file LICENCE for licence information.
 (defpackage :cl-l10n-tests
+  (:shadowing-import-from :cl-l10n format)
   (:use :cl :regression-test :cl-l10n))
 
 (in-package :cl-l10n-tests)
@@ -132,5 +133,28 @@
     (gettext "howareyou" *my-bundle* "af_ZA")
   "Hoe lyk it")
 
-  
+;; format
+(deftest format.1
+    (format nil "~v:@U" "en_ZA" 3091103120)
+  "Sun 14 Dec 1997 17:45:20 +0200")
+
+(deftest format.2
+    (format nil "~v:n" "en_ZA" 1000)
+  "1,000")
+
+(deftest format.3
+    (format nil "~v:@m" "sv_SE" 1000)
+  "1000,00 SEK")
+
+
+;; parse-number
+(deftest parse-number.1
+    (parse-number (format nil "~vn" "af_ZA" -1001231.5) "af_ZA")
+  -1001231.5)
+
+(deftest parse-number.2
+    (parse-number (format nil "~v@:n" "en_ZA" -1001231.5) "en_ZA")
+  -1001231.5)
+
+
 ;; EOF



From sross at common-lisp.net  Wed Dec  8 10:02:31 2004
From: sross at common-lisp.net (Sean Ross)
Date: Wed,  8 Dec 2004 11:02:31 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi 
Message-ID: <20041208100231.08F31880A8@common-lisp.net>

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

Modified Files:
	cl-l10n.texi 
Log Message:
Changelog 2004-12-08
Date: Wed Dec  8 11:02:29 2004
Author: sross

Index: cl-l10n/doc/cl-l10n.texi
diff -u cl-l10n/doc/cl-l10n.texi:1.2 cl-l10n/doc/cl-l10n.texi:1.3
--- cl-l10n/doc/cl-l10n.texi:1.2	Wed Dec  1 12:48:46 2004
+++ cl-l10n/doc/cl-l10n.texi	Wed Dec  8 11:02:28 2004
@@ -77,7 +77,7 @@
 various accessors (like locale-mon), number printing, money printing and 
 time/date printing.
 
-The CL-L10n Home Page is at @uref{http://www.common-lisp.net/project/cl-l10n}
+The CL-L10N Home Page is at @uref{http://www.common-lisp.net/project/cl-l10n}
 where one can find details about mailing lists, cvs repositories and various releases.
 
 Enjoy
@@ -89,6 +89,7 @@
 @item CMUCL
 @item CLISP
 @item Lispworks
+ at item ECL
 @end itemize
 
 
@@ -104,7 +105,7 @@
 @section Downloading
 @itemize
 @item ASDF-INSTALL 
-CL-L10n is available through asdf-install. If you are new
+CL-L10N is available through asdf-install. If you are new
 to Common Lisp this is the suggested download method. With asdf-install loaded run 
 @lisp (asdf-install:install :cl-l10n) @end lisp
 This will download and install the package for you. Asdf-install will try to verify 
@@ -130,7 +131,7 @@
 @section Installing
 Once downloaded and symlinked you can load CL-L10N at anytime using
 @code{(asdf:oos 'asdf:load-op :cl-l10n)}
-This will compile CL-L10n the first time it is loaded.
+This will compile CL-L10N the first time it is loaded.
 
 Once installed run @code{(asdf:oos 'asdf:test-op :cl-l10n)} to test
 the package. If any tests fail please send an email to one of the
@@ -237,14 +238,26 @@
 @anchor {Function format-time}
 @deffn {function} format-time stream ut show-date show-time &optional (locale *locale*) fmt
 Prints the @code{universal-time} @emph{ut} as a locale specific time to @emph{stream}.
-The format of the time printed is controlled by @code{show-time} and @code{show-date}.
+The format of the time printed is controlled by @emph{show-time} and @emph{show-date}.
+
+ at table @code 
+ at item show-time and show-date are not nil
+ at code{locale-d-t-fmt}
+ at item show-time and show-date are nil
+ at code{locale-t-fmt-ampm} or @code{locale-t-fmt} if @code{locale-t-fmt-ampm} has
+no apparent value.
+ at item show-time is not nil and show-date is nil
+locale-t-fmt
+ at item show-date is not nil and show-time is nil
+locale-d-fmt
+ at end table
 
 If @emph{fmt} is not nil then @emph{show-date} and @emph{show-time} are ignored 
 and @emph{fmt} is used as the format control string. For details of format
 directive look at 'man 1 date' although some directives are not supported, namely %U, %V and %W.
 
 Examples (assuming *locale* is ``en_ZA'')
- at lisp
+ at verbatim
 (format t "~:/cl-l10n:format-time/" 3192624000)
   prints `03/03/01'
 
@@ -252,16 +265,54 @@
   prints `18:00:00'
 
 (format t "~:@/cl-l10n:format-time/" 3192624000)
-  prints `Sat 03 Mar 2001 18:00:00 -2'
+  prints `Sat 03 Mar 2001 18:00:00 +0200'
 
 (format t "~v,v/cl-l10n:format-time/" "fr_FR" "%A" 3192624000)
   prints `samedi'
 
 (format t "~,v/cl-l10n:format-time/" "%A" 3192624000)
   prints `Saturday'
- at end lisp
+ at end verbatim
+ at end deffn
+
+ at anchor {Function format}
+ at deffn {Function} format stream fmt-string &rest args
+Format is an unexported symbol in the cl-l10n package. It's 
+use is to make formatting of dates, times, numbers and monetary
+values simpler. 
+Shadow importing @code{cl-l10::format} into your package gives
+you a few new format directives.
+The new directives are ~U : Time and Date (universal-time), 
+~N : Numbers and ~M : Monetary values. All other format directives
+are unchanged and work as normal. These new directives are 
+drop in replacements for the ~/cl-l10n:format-?/ calls.
+
+ at verbatim
+;; These examples assume an en_ZA locale
+(in-package :cl-user)
+
+(shadowing-import 'cl-l10n::format)
+
+(format t "~:U" 3192624000)
+  prints `03/03/2001'
+
+(format t "~,vU" "%A" 3192624000)
+  prints `Saturday'
+
+(format t "~:N" 3192624000)
+  prints `3,192,624,000'
+
+(format t "~:M" 3192624000)
+  prints `ZAR 3,192,624,000.00`
+
+ at end verbatim
+
 @end deffn
 
+ at anchor {Function parse-number}
+ at deffn {Function} parse-number num-string &optional (locale *locale*)
+Parses the string @emph{num-string} into a number using @emph{locale}. 
+ at end deffn
 
 
 @section Classes
@@ -304,7 +355,7 @@
 Then you add resources to your bundle using either @code{add-resource} 
 or @code{add-resources}. 
 
- at lisp
+ at verbatim
 (add-resources (bundle "af_")
   "showtime" "Dankie, die tyd is ~:@/cl-l10n:format-time/~%")
 
@@ -312,7 +363,7 @@
 (add-resources (bundle "") 
   "showtime" "Thanks, the time is ~:@/cl-l10n:format-time/~%")
 
- at end lisp
+ at end verbatim
 
 Then by using @code{gettext} you can lookup locale specific strings.
 @lisp
@@ -354,7 +405,7 @@
 @section API
 @anchor {Generic add-resource}
 @deffn {Generic} add-resource bundle from to locale-name
-Adds an entry to @emph{bundle} for @emph{locale-name}  mappings
+Adds an entry to @emph{bundle} for @emph{locale-name}  mapping
 @emph{from} to @emph{to}. The @emph{locale-name} does not 
 have to be a full name like ``en_US'' but can be a partial match
 like ``en_''. Adding mappings for these two locale-names will



From sross at common-lisp.net  Fri Dec 17 10:06:46 2004
From: sross at common-lisp.net (Sean Ross)
Date: Fri, 17 Dec 2004 11:06:46 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd
	cl-l10n/parse-number.lisp cl-l10n/parsers.lisp
	cl-l10n/printers.lisp cl-l10n/tests.lisp 
Message-ID: <20041217100646.1B40188648@common-lisp.net>

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

Modified Files:
	ChangeLog cl-l10n.asd parse-number.lisp parsers.lisp 
	printers.lisp tests.lisp 
Log Message:
Changelog 2004-12-17
Date: Fri Dec 17 11:06:43 2004
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.5 cl-l10n/ChangeLog:1.6
--- cl-l10n/ChangeLog:1.5	Wed Dec  8 11:02:23 2004
+++ cl-l10n/ChangeLog	Fri Dec 17 11:06:43 2004
@@ -1,6 +1,17 @@
+2004-12-17 Sean Ross	<sross at common-lisp.net>
+	* printers.lisp: Fixed incorrect sign when printing 
+	numbers and money.
+	* printers.lisp: The :no-dp arg whas ignored when 
+	printing numbers, fixed.
+	* printers.lisp: Added *float-digits*. Used when printing
+	numbers, when all numbers after the decimal point are zero
+	only *float-digits* zeros will be printed.
+	* printers.lisp: Fixed format to accept a function as the 
+	format control.
+
 2004-12-08 Sean Ross	<sross at common-lisp.net>
 	* printers.lisp: Added format which can be shadow imported
-	to provide 3 new format directive ~u(universal-time), ~m(monetary)
+	to provide 3 new format directives ~u(universal-time), ~m(monetary)
 	and ~n(numeric), all other directives are unchanged.
 	* printers.lisp: Use locale-t-fmt if locale-t-fmt-ampm is an 
 	empty string.


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.5 cl-l10n/cl-l10n.asd:1.6
--- cl-l10n/cl-l10n.asd:1.5	Wed Dec  8 11:02:23 2004
+++ cl-l10n/cl-l10n.asd	Fri Dec 17 11:06:43 2004
@@ -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.1.7"
+  :version "0.1.10"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"


Index: cl-l10n/parse-number.lisp
diff -u cl-l10n/parse-number.lisp:1.1 cl-l10n/parse-number.lisp:1.2
--- cl-l10n/parse-number.lisp:1.1	Wed Dec  8 11:02:23 2004
+++ cl-l10n/parse-number.lisp	Fri Dec 17 11:06:43 2004
@@ -303,15 +303,4 @@
 				      :end end
 				      :radix radix))))))))
 		 
-(defparameter *test-values*
-  '("1" "-1" "1034" "-364" "80/335" "3.5333" "2.4E4" "6.8d3" "#xFF" "#b-1000" "#o-101/75" "13.09s3" "35.66l5" "21.4f2" "#C(1 2)" "#c ( #xF #o-1 ) " "#c(1d1 2s1)" "#16rFF" "#9r10" "#C(#9r44/61 4f4)"))
-
-(defun run-tests ()
-  (format t "~&~16 at A (~16 at A) = ~16A~%~%"
-	  "String value" "READ value" "Parsed value")
-  (dolist (value *test-values*)
-    (format t "~&~16 at A (~16 at A) = ~16A~%"
-	    value
-	    (read-from-string value)
-	    (%parse-number value))))
 


Index: cl-l10n/parsers.lisp
diff -u cl-l10n/parsers.lisp:1.1 cl-l10n/parsers.lisp:1.2
--- cl-l10n/parsers.lisp:1.1	Wed Dec  8 11:02:23 2004
+++ cl-l10n/parsers.lisp	Fri Dec 17 11:06:43 2004
@@ -19,4 +19,5 @@
       (t num))))
 
 
+;; money parser
 ;; EOF


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.5 cl-l10n/printers.lisp:1.6
--- cl-l10n/printers.lisp:1.5	Wed Dec  8 11:02:23 2004
+++ cl-l10n/printers.lisp	Fri Dec 17 11:06:43 2004
@@ -15,9 +15,9 @@
             sign (mapcar #'nreverse (nreverse (group digits grouping))))))
 
 (defun get-sign (arg locale)
-  (if (plusp arg)
-      (locale-positive-sign locale)
-      (locale-negative-sign locale)))
+  (cond ((plusp arg) (locale-positive-sign locale))
+        ((minusp arg) (locale-negative-sign locale))
+        (t "")))
 
 (defun get-point (locale no-point float-part)
   (if (and (string= float-part "0") no-point)
@@ -35,17 +35,29 @@
     (string (locale loc))
     (symbol (locale (string loc)))))
 
+(defvar *float-digits* 2
+  "Used when all values after the decimal point are zero to
+determine the number of zero's to print")
+
 (defun format-number (stream arg no-dp no-ts
                       &optional (locale *locale*))
   (let ((locale (locale-des->locale locale)))
     (multiple-value-bind (int-part float-part) (split-float (abs (float arg)))
       (let* ((sign (get-sign arg locale))
              (point (get-point locale no-dp float-part))
+             (float-part (if (every #'(lambda (x)
+                                        (zerop (or (digit-char-p x) 1)))
+                                    float-part)
+                             (make-string *float-digits*
+                                          :initial-element #\0)
+                             float-part))
              (sep (get-sep locale no-ts))
-             (grouping (locale-grouping locale))
-             (*read-eval* nil))
+             (grouping (locale-grouping locale)))
         (print-int stream sign int-part sep grouping)
-        (unless (and (or* (string= float-part "" "0")) no-dp)
+        (unless (and (every #'(lambda (x)
+                                (zerop (or (digit-char-p x) 1)))
+                            float-part)
+                     no-dp)
           (princ point stream)
           (princ float-part stream))))))
 
@@ -94,7 +106,7 @@
                         (locale-int-curr-symbol locale)
                         (locale-currency-symbol locale)))
                (sym-sep (if (zerop sep-by-space) "" " ")))
-
+          
           (when (or* (= spos 0 1 3))
             (princ (if (zerop spos) "(" sign) stream)
             (when (= 2 sep-by-space)
@@ -361,8 +373,12 @@
 
 ;; Format
 
-(defun format (stream fmt-string &rest args)
-  (apply #'cl:format stream (parse-fmt-string fmt-string) args))
+(defun format (stream fmt-cntrl &rest args)
+  (apply #'cl:format stream
+         (etypecase fmt-cntrl
+           (function fmt-cntrl)
+           (string (parse-fmt-string fmt-cntrl)))
+         args))
 
 (defun parse-fmt-string (string)
   (with-output-to-string (fmt-string)


Index: cl-l10n/tests.lisp
diff -u cl-l10n/tests.lisp:1.2 cl-l10n/tests.lisp:1.3
--- cl-l10n/tests.lisp:1.2	Wed Dec  8 11:02:23 2004
+++ cl-l10n/tests.lisp	Fri Dec 17 11:06:43 2004
@@ -23,11 +23,11 @@
 
 (deftest number.3
     (format nil "~v/cl-l10n:format-number/" "en_ZA" 1000)
-  "1,000.0")
+  "1,000.00")
 
 (deftest number.4
     (format nil "~v/cl-l10n:format-number/" "sv_SE" 1000)
-  "1 000,0")
+  "1 000,00")
 
 (deftest number.5
     (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1000)



From sross at common-lisp.net  Fri Dec 17 10:06:48 2004
From: sross at common-lisp.net (Sean Ross)
Date: Fri, 17 Dec 2004 11:06:48 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi 
Message-ID: <20041217100648.C85F888649@common-lisp.net>

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

Modified Files:
	cl-l10n.texi 
Log Message:
Changelog 2004-12-17
Date: Fri Dec 17 11:06:46 2004
Author: sross

Index: cl-l10n/doc/cl-l10n.texi
diff -u cl-l10n/doc/cl-l10n.texi:1.3 cl-l10n/doc/cl-l10n.texi:1.4
--- cl-l10n/doc/cl-l10n.texi:1.3	Wed Dec  8 11:02:28 2004
+++ cl-l10n/doc/cl-l10n.texi	Fri Dec 17 11:06:46 2004
@@ -159,6 +159,15 @@
 A hash table containing loaded locales keyed on locale name. 
 @end deftp
 
+ at anchor {Variable *float-digits*}
+ at vindex *float-digits*
+ at deftp {Variable} *float-digits*
+An integer value which determines the number of digits
+after the decimal point when all said digits are zero.
+This variable only has an effect when printing numbers
+as monetary printing gets this value from the locale.
+ at end deftp
+
 
 @section Functions
 @anchor {Function locale-name}



From sross at common-lisp.net  Thu Dec 30 11:56:45 2004
From: sross at common-lisp.net (Sean Ross)
Date: Thu, 30 Dec 2004 12:56:45 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/README
	cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp
	cl-l10n/locale.lisp cl-l10n/package.lisp
	cl-l10n/parse-number.lisp cl-l10n/printers.lisp
	cl-l10n/tests.lisp cl-l10n/utils.lisp 
Message-ID: <20041230115645.16407884FE@common-lisp.net>

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

Modified Files:
	ChangeLog README cl-l10n.asd load-locale.lisp locale.lisp 
	package.lisp parse-number.lisp printers.lisp tests.lisp 
	utils.lisp 
Log Message:
ChangeLog 2004-12-30
Date: Thu Dec 30 12:56:41 2004
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.6 cl-l10n/ChangeLog:1.7
--- cl-l10n/ChangeLog:1.6	Fri Dec 17 11:06:43 2004
+++ cl-l10n/ChangeLog	Thu Dec 30 12:56:38 2004
@@ -1,3 +1,11 @@
+2004-12-30 Sean Ross	<sross at common-lisp.net>
+	* printers.lisp, load-locale.lisp: Changed format-number and
+	format-money to use a format string created at locale load time.
+	* locale.lisp: Cache Getter functions.
+	
+2004-12-20 Sean Ross	<sross at common-lisp.net>
+	* printers.lisp: Added formatter.
+	
 2004-12-17 Sean Ross	<sross at common-lisp.net>
 	* printers.lisp: Fixed incorrect sign when printing 
 	numbers and money.


Index: cl-l10n/README
diff -u cl-l10n/README:1.1 cl-l10n/README:1.2
--- cl-l10n/README:1.1	Tue Nov 30 11:05:07 2004
+++ cl-l10n/README	Thu Dec 30 12:56:38 2004
@@ -8,7 +8,7 @@
 cl-l10n is a localization package for common-lisp. It is meant 
 to be serve the same purpose as Allegro Common Lisp's
 various locale functions. It currently runs on 
-CMUCL, SBCL, CLISP and Lispworks although porting to a new
+CMUCL, SBCL, CLISP, ECL and Lispworks although porting to a new
 implementation should be ridiculously trivial.
 
 


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.6 cl-l10n/cl-l10n.asd:1.7
--- cl-l10n/cl-l10n.asd:1.6	Fri Dec 17 11:06:43 2004
+++ cl-l10n/cl-l10n.asd	Thu Dec 30 12:56:38 2004
@@ -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.1.10"
+  :version "0.2.0"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"
@@ -19,10 +19,10 @@
                (:file "parse-number" :depends-on ("package"))
                (:file "utils" :depends-on ("package"))
                (:file "locale" :depends-on ("utils"))
-               (:file "printers" :depends-on ("locale"))
+               (:file "load-locale" :depends-on ("locale"))
+               (:file "printers" :depends-on ("load-locale"))
                (:file "parsers" :depends-on ("printers" "parse-number"))
-               (:file "i18n" :depends-on ("printers"))
-               (:file "load-locale" :depends-on ("locale")))
+               (:file "i18n" :depends-on ("printers")))
   :depends-on (:cl-ppcre))
 
 (defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n))))


Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.6 cl-l10n/load-locale.lisp:1.7
--- cl-l10n/load-locale.lisp:1.6	Wed Dec  1 12:48:40 2004
+++ cl-l10n/load-locale.lisp	Thu Dec 30 12:56:38 2004
@@ -9,6 +9,9 @@
   (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)
            ((probe-file (merge-pathnames *locale-path* name))
@@ -16,10 +19,18 @@
            ((not errorp) (warn "Can't find locale ~A." name))
            (errorp (locale-error "Can't find locale ~A." name)))))
 
+(defvar *locale-type* 'locale)
+
+(defun locale-des->locale (loc)
+  (etypecase loc
+    (locale loc)
+    (string (locale loc))
+    (symbol (locale (string loc)))))
+
 (defun load-locale (name)
   (let ((path (merge-pathnames *locale-path* name)))
-    (format t "~&;; Loading locale from ~A.~%" path)
-    (let ((locale (make-instance 'locale :name name))
+    (cl:format t "~&;; Loading locale from ~A.~%" path)
+    (let ((locale (make-instance *locale-type* :name name))
           (*read-eval* nil)
           (*print-circle* nil))
       (with-open-file (stream path
@@ -30,6 +41,7 @@
             (awhen (make-category locale it (parse-category it stream
                                                             escape comment))
               (setf (get-category (category-name it) locale) it)))))
+      (add-printers locale)
       (setf (get-locale name) locale))))
 
 (defun load-all-locales (&optional (*locale-path* *locale-path*))
@@ -39,6 +51,67 @@
         (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)
+  (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" (schar (locale-thousands-sep locale) 0)
+             (locale-grouping locale)
+             (if no-ts "D" ":D")))
+
+(defun get-descriptors (minusp locale)
+  (if minusp 
+      (values (locale-n-sep-by-space locale)
+              (= 1 (locale-n-cs-precedes locale))
+              (locale-n-sign-posn locale)
+              (locale-negative-sign locale))
+      (values (locale-p-sep-by-space locale)
+              (= 1 (locale-p-cs-precedes locale))
+              (locale-p-sign-posn locale)
+              (locale-positive-sign locale))))
+
+(defun create-money-fmt-string (locale no-ts minusp)
+  (multiple-value-bind (sep-by-space prec spos sign) 
+      (get-descriptors minusp locale)
+    (let ((sym-sep (if (zerop sep-by-space) "" " ")))
+      (with-output-to-string (stream)
+        ;; sign and sign separator
+        (when (or* (= spos 0 1 3))
+          (princ (if (zerop spos) "(" sign) stream)
+          (when (= 2 sep-by-space)
+            (princ #\Space stream)))
+        ;; Sym and seperator
+        (princ "~A" stream)
+        (when prec
+          (princ sym-sep stream))
+        ;; Actual number
+        (cl:format stream "~~,,'~A,~A~A~~{~~A~~}" 
+                   (schar (locale-mon-thousands-sep locale) 0)
+                   (locale-mon-grouping locale)
+                   (if no-ts "D" ":D"))
+        (unless prec
+          (princ sym-sep stream))
+        (princ "~A" stream)
+        (when (or* (= spos 0 2 4))
+          (when (= 2 sep-by-space)
+            (princ #\Space stream))
+          (princ (if (zerop spos) ")" sign) stream))))))
+
+(defun add-printers (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))))
+        
+
 (defvar *category-loaders*
   '(("LC_IDENTIFICATION" . load-identification)
     ("LC_MONETARY" . load-category)
@@ -61,11 +134,11 @@
 (defun load-category (locale name vals)
   (declare (ignore locale))
   (let ((cat (make-instance 'category :name name)))
-    (typecase vals 
+    (etypecase vals 
       (category vals)
-      (t (dolist (x vals)
-           (setf (get-cat-val (car x) cat) (cdr x)))
-         cat))))
+      (cons (dolist (x vals)
+              (setf (get-cat-val (car x) cat) (cdr x)))
+            cat))))
 
 (defvar *id-vals* 
   '(("title" . title)
@@ -165,22 +238,24 @@
                    :everything)
                   #\>))
 
+(defvar *match-scanner* (cl-ppcre:create-scanner *regex*))
+
 (defun old-real-value (val)
-  (aif (all-matches-as-strings *regex* 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)
-  (let ((val (old-real-value val)))
-    (if (string= val "\"\"")
-        ""
-        val)))
+  (remove #\" (old-real-value val)))
 
 
+(defvar *split-scanner* 
+  (cl-ppcre:create-scanner '(:char-class #\;)))
+                         
 (defun parse-value (val)
-  (let ((all-vals (split '(:char-class #\;) val)))
+  (let ((all-vals (split *split-scanner* val)))
     (if (singlep all-vals)
         (real-value (car all-vals))
         (mapcar #'real-value all-vals))))
@@ -201,9 +276,9 @@
   (loop for line = (read-line stream nil stream)
         until (eq line stream) do
     (if (and (> (length line) 3) (search "LC_" line :end2 3)
-             (not (some #'(lambda (x)
-                            (search x line :test #'string=))
-                        *ignore-categories*))) 
+             (notany #'(lambda (x)
+                         (search x line :test #'string=))
+                     *ignore-categories*))
         (return-from next-header line))))
 
 (defun load-default-locale ()


Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.5 cl-l10n/locale.lisp:1.6
--- cl-l10n/locale.lisp:1.5	Wed Dec  8 11:02:23 2004
+++ cl-l10n/locale.lisp	Thu Dec 30 12:56:38 2004
@@ -4,8 +4,9 @@
 ;; TODO
 ;;  What to do with LC_CTYPE, LC_COLLATE
 ;;  Test on windows.
-;;  Parsers?
+;;  Parsers (money and time)
 ;;  locale aliases
+;;  Optimizing print-time
 
 (in-package :cl-l10n )
 
@@ -18,29 +19,29 @@
                    (append (pathname-directory path)
                            '("locales"))
                    :defaults #P"")))
-                  
 
 (defvar *locale* nil)
 
-(defvar *locales* (make-hash-table :test #'equal))
+(defvar *locales* (make-hash-table :test #'equal)
+  "Hash table containing all loaded locales keyed on name (eg. \"af_ZA\")")
 
 ;; Conditions
 (defun locale-report (obj stream)
-  (format stream "~A" (mesg obj)))
+  (cl:format stream "~A" (mesg obj)))
 
 (define-condition locale-error ()
   ((mesg :accessor mesg :initarg :mesg :initform "Unknown."))
   (:report locale-report))
 
 (defun locale-error (string &rest args)
-  (error 'locale-error :mesg (apply #'format nil string args)))
-
+  (error 'locale-error :mesg (apply #'cl:format nil string args)))
 
 ;; Classes
 (defclass locale ()
   ((locale-name :accessor locale-name :initarg :name 
                 :initform (required-arg :name))
    (title :accessor title :initarg :title :initform nil)
+   (printers :accessor printers :initarg :printers :initform nil)
    (source :accessor source :initarg :source :initform nil)
    (language :accessor language :initarg :language :initform nil)
    (territory :accessor territory :initarg :territory :initform nil)
@@ -74,7 +75,6 @@
 (defmacro get-cat-val (value cat)
   `(gethash ,value (vals ,cat)))
 
-
 (defun locale-value (locale cat key)
   (awhen (get-category cat locale)
     (get-cat-val key it)))
@@ -86,19 +86,26 @@
   #+clisp (ext:getenv word)
   #+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)
   (let ((name (symb "LOCALE-" (substitute #\- #\_ (string-upcase key)))))
     `(progn 
-      (defun ,name (&optional (locale *locale*))
-        (let ((locale (locale-des->locale locale)))
-          (when locale
-            (awhen (get-category ,cat locale)
-              ,(if wrap
-                   `(funcall ,wrap (get-cat-val ,key it))
-                   `(get-cat-val ,key it))))))
-      (export ',name))))
+       (defun ,name (&optional (locale *locale*))
+         (let ((locale (locale-des->locale locale)))
+           (when locale
+             (gett-value locale ,cat ,key ,@(if wrap (list wrap) nil)))))
+       (export ',name))))
 
 (defun parse-car-or-val (x)
   (values (parse-integer (if (consp x) (car x) x))))
@@ -146,4 +153,4 @@
 (defgetter "measurement" "LC_MEASUREMENT")
 
 
-;; EOF
\ No newline at end of file
+;; EOF


Index: cl-l10n/package.lisp
diff -u cl-l10n/package.lisp:1.3 cl-l10n/package.lisp:1.4
--- cl-l10n/package.lisp:1.3	Wed Dec  8 11:02:23 2004
+++ cl-l10n/package.lisp	Thu Dec 30 12:56:38 2004
@@ -4,11 +4,11 @@
 
 (defpackage #:cl-l10n 
   (:use #:cl #:cl-ppcre)
-  (:shadow cl:format)
+  (:shadow cl:format cl:formatter)
   (:export #:locale-name #:category-name #:locale #:category #:locale-error
            #:get-category #:get-cat-val #:locale-value #:load-all-locales
            #:*locale* #:*locale-path* #:*locales*
            #:format-number #:print-number #:format-money #:print-money
            #:format-time #:print-time #:add-resources #:bundle 
-           #:add-resource #:gettext #:parse-number))
+           #:add-resource #:gettext #:parse-number #:*float-digits*))
            


Index: cl-l10n/parse-number.lisp
diff -u cl-l10n/parse-number.lisp:1.2 cl-l10n/parse-number.lisp:1.3
--- cl-l10n/parse-number.lisp:1.2	Fri Dec 17 11:06:43 2004
+++ cl-l10n/parse-number.lisp	Thu Dec 30 12:56:38 2004
@@ -40,8 +40,8 @@
 	   :initarg :reason
 	   :initform "Not specified"))
   (:report (lambda (c s)
-	     (format s "Invalid number: ~S [Reason: ~A]"
-		     (value c) (reason c)))))
+	     (cl:format s "Invalid number: ~S [Reason: ~A]"
+                   (value c) (reason c)))))
 
 (declaim (inline parse-integer-and-places))
 (defun parse-integer-and-places (string start end &key (radix 10))


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.6 cl-l10n/printers.lisp:1.7
--- cl-l10n/printers.lisp:1.6	Fri Dec 17 11:06:43 2004
+++ cl-l10n/printers.lisp	Thu Dec 30 12:56:38 2004
@@ -2,64 +2,34 @@
 ;; See the file LICENCE for licence information.
 (in-package :cl-l10n)
 
-;; Number and Money
-(defun digits-list (integer &optional (radix 10))
-  (assert (>= integer 0))
-  (loop collect (mod integer radix)
-        while (> (setf integer (floor integer radix)) 0)))
-
-(defun print-int (stream sign int sep grouping)
-  (let* ((digits (digits-list int))
-         (fmt-string (mkstr "~A~{~{~A~}~^" sep "~}")))
-    (format stream fmt-string 
-            sign (mapcar #'nreverse (nreverse (group digits grouping))))))
-
+;; Number
 (defun get-sign (arg locale)
   (cond ((plusp arg) (locale-positive-sign locale))
         ((minusp arg) (locale-negative-sign locale))
         (t "")))
 
-(defun get-point (locale no-point float-part)
-  (if (and (string= float-part "0") no-point)
-      ""
-      (locale-decimal-point locale)))
-
-(defun get-sep (locale no-sep)
-  (if no-sep 
-      ""
-      (locale-thousands-sep locale)))
-
-(defun locale-des->locale (loc)
-  (etypecase loc
-    (locale loc)
-    (string (locale loc))
-    (symbol (locale (string loc)))))
-
 (defvar *float-digits* 2
   "Used when all values after the decimal point are zero to
 determine the number of zero's to print")
 
+(defun fix-float-string (string size)
+  (if (string= string "")
+      (make-string size :initial-element #\0)
+      string))
+
 (defun format-number (stream arg no-dp no-ts
                       &optional (locale *locale*))
-  (let ((locale (locale-des->locale locale)))
-    (multiple-value-bind (int-part float-part) (split-float (abs (float arg)))
-      (let* ((sign (get-sign arg locale))
-             (point (get-point locale no-dp float-part))
-             (float-part (if (every #'(lambda (x)
-                                        (zerop (or (digit-char-p x) 1)))
-                                    float-part)
-                             (make-string *float-digits*
-                                          :initial-element #\0)
-                             float-part))
-             (sep (get-sep locale no-ts))
-             (grouping (locale-grouping locale)))
-        (print-int stream sign int-part sep grouping)
-        (unless (and (every #'(lambda (x)
-                                (zerop (or (digit-char-p x) 1)))
-                            float-part)
-                     no-dp)
-          (princ point stream)
-          (princ float-part stream))))))
+  (let ((locale (locale-des->locale locale))
+        (float-part (float-part (coerce (abs arg) 'double-float))))
+    (cl:format stream 
+               (getf (printers locale)
+                     (if no-ts :number-no-ts :number-ts))
+               (get-sign arg locale)
+               (truncate (abs arg))
+               (unless (and (string= "" float-part) no-dp)
+                 (list (locale-decimal-point locale)
+                       (fix-float-string float-part *float-digits*))))
+    (values)))
 
 (defun print-number (number &key (stream *standard-output*)
                      no-ts no-dp (locale *locale*))
@@ -67,64 +37,49 @@
     (format-number stream number no-dp no-ts locale)
     number))
 
-(defun get-float-part (float locale use-int-sym)
-  (let ((size (if use-int-sym
-                  (locale-int-frac-digits locale)
-                  (locale-frac-digits locale)))
-        (len (length float)))
-    (cond ((>= len size)
-           (subseq float 0 size))
-          ((< len size)
-           (with-output-to-string (x)
-             (princ float x)
-             (dotimes (z (- size len))
-               (princ 0 x))))
-          (t float))))
-
-(defun get-descriptors (val locale)
-  (if (minusp val)
-      (values (locale-n-sep-by-space locale)
-              (= 1 (locale-n-cs-precedes locale))
-              (locale-n-sign-posn locale))
-      (values (locale-p-sep-by-space locale)
-              (= 1 (locale-p-cs-precedes locale))
-              (locale-p-sign-posn locale))))
 
-;; FIXME . Rounding  and float coercion.
+;; Money
+(defvar *default-round-mode* :round)
+  
+(defun round-money (float frac-digits &key (round-mode *default-round-mode*))
+  (let ((round-fn (ecase round-mode
+                    (:round #'fround)
+                    (:down #'ffloor)
+                    (:up #'fceiling))))
+    (let ((size (expt 10 frac-digits)))
+      (/ (funcall round-fn (* float size)) size))))
+
+(defun get-money-printer (minusp no-ts)
+  (if minusp
+      (if no-ts
+          :money-n-no-ts
+          :money-n-ts)
+      (if no-ts
+          :money-p-no-ts
+          :money-p-ts)))
+
 (defun format-money (stream arg use-int-sym no-ts &optional (locale *locale*))
-  (let ((locale (locale-des->locale locale)))
-    (multiple-value-bind (int-part float-part) 
-        (split-float (abs (float arg 1.0d0)))
-      (multiple-value-bind (sep-by-space prec spos) 
-          (get-descriptors arg locale)
-        (let* ((sign (get-sign arg locale))
-               (float-part (get-float-part float-part locale use-int-sym))
-               (point (locale-mon-decimal-point locale))
-               (sep (if no-ts "" (locale-mon-thousands-sep locale)))
-               (grouping (locale-mon-grouping locale))
-               (sym (if use-int-sym
-                        (locale-int-curr-symbol locale)
-                        (locale-currency-symbol locale)))
-               (sym-sep (if (zerop sep-by-space) "" " ")))
-          
-          (when (or* (= spos 0 1 3))
-            (princ (if (zerop spos) "(" sign) stream)
-            (when (= 2 sep-by-space)
-              (print #\Space stream)))
-          
-          (when prec 
-            (format stream "~A~A" sym sym-sep))
-          
-          (print-int stream "" int-part sep grouping)
-          (unless (or* (string= float-part "" "0"))
-            (princ point stream)
-            (princ float-part stream))
-          (unless prec
-            (format stream "~A~A" sym-sep (trim sym)))
-          (when (or* (= spos 0 2 4))
-            (when (= 2 sep-by-space)
-              (print #\Space stream))
-            (princ (if (zerop spos) ")" sign) stream)))))))
+  (let* ((locale (locale-des->locale locale))
+         (frac-digits (if use-int-sym
+                          (locale-int-frac-digits locale)
+                          (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)))
+         (sym (if use-int-sym
+                  (locale-int-curr-symbol locale)
+                  (locale-currency-symbol locale)))
+         (prec (= 1 (locale-n-cs-precedes locale))))
+    (cl:format stream 
+               (getf (printers locale) 
+                     (get-money-printer (minusp arg) no-ts))
+               (if prec sym "")
+               (truncate (abs val-to-print))
+               (unless (zerop frac-digits)
+                 (list (locale-mon-decimal-point locale)
+                       (fix-float-string float-part frac-digits)))
+               (if prec "" (trim sym))))
+  (values))
 
 (defun print-money (num &key (stream *standard-output*) use-int-sym no-ts
                     (locale *locale*))
@@ -132,8 +87,7 @@
     (format-money stream num use-int-sym no-ts locale)
     num))
 
-
-;; Time and date printing.
+;; ;; Time and date printing.
 (defun get-time-fmt-string (locale show-date show-time)
   (cond ((and show-time show-date)
          (locale-d-t-fmt locale))
@@ -144,9 +98,10 @@
         (show-time (locale-t-fmt locale))
         (show-date (locale-d-fmt locale))))
 
-
 (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
+   using the character SYM." 
   (let ((name (gensym (mkstr "FORMATTER-" sym))))
     `(flet ((,name (stream locale ut sec min hour date month year day 
                            daylight-p zone)
@@ -161,11 +116,13 @@
        it
        (locale-error "No format directive for char ~S." char)))
 
-(defun pad-val (val &optional (pad "0"))
-  (if (< val 10)
-      (format nil "~A~A" pad val)
-      val))
-
+(defun princ-pad-val (val stream &optional (pad "0"))
+  (declare (type stream stream) (optimize speed)
+           (type fixnum val))
+  (when (< val 10)
+    (princ pad stream))
+  (princ val stream))
+      
 (defun last-2-digits (val)
   (mod val 100))
 
@@ -181,27 +138,27 @@
 
 
 (def-formatter #\b
-    (format stream "~:(~A~)" (nth (1- month) (locale-abmon locale))))
-
+    (cl:format stream (cl:formatter "~:(~A~)") 
+               (nth (1- month) (locale-abmon locale))))
 
 (def-formatter #\B
-    (format stream "~:(~A~)"
+    (cl:format stream (cl:formatter "~:(~A~)")
             (nth (1- month) (locale-mon locale))))
 
 (def-formatter #\c
     (print-time-string "%a %b %d %T %Z %Y" stream ut locale))
 
 (def-formatter #\C
-    (princ (pad-val (truncate (/ year 100))) stream))
+    (princ-pad-val (truncate (/ year 100)) stream))
 
 (def-formatter #\d
-    (princ (pad-val date) stream))
+    (princ-pad-val date stream))
 
 (def-formatter #\D
     (print-time-string "%m/%d/%y" stream ut locale))
 
 (def-formatter #\e 
-    (princ (pad-val month " ") stream))
+    (princ-pad-val month stream " "))
 
 (def-formatter #\F
     (print-time-string "%Y-%m-%d" stream ut locale))
@@ -217,11 +174,10 @@
            stream))
 
 (def-formatter #\H
-    (princ (pad-val hour) stream))
+    (princ-pad-val hour stream))
 
 (def-formatter #\I
-    (princ (pad-val (if (> hour 12) (- hour 12) hour))
-           stream))
+    (princ-pad-val (if (> hour 12) (- hour 12) hour) stream))
 
 (defvar *mon-days* 
   '(31 28 31 30 31 30 31 31 30 31 30 31))
@@ -240,25 +196,23 @@
     (loop repeat (1- month) 
        for x in (if (leap-year-p year) *mon-days-leap* *mon-days*) do
          (incf total x))
-    (incf total date)
-    total))
+    (incf total date)))
 
 (def-formatter #\j 
     (princ (day-of-year date month year) stream))
 
 (def-formatter #\k
-    (princ (pad-val hour " ") stream))
+    (princ-pad-val hour stream " "))
 
 (def-formatter #\l
-    (princ (pad-val (if (> hour 12) (- hour 12) hour)
-                    " ")
-           stream))
+    (princ-pad-val (if (> hour 12) (- hour 12) hour) stream
+                   " "))
 
 (def-formatter #\m
-    (princ (pad-val month) stream))
+    (princ-pad-val month stream))
 
 (def-formatter #\M
-    (princ (pad-val min) stream))
+    (princ-pad-val min stream))
 
 (def-formatter #\n
     (princ #\Newline stream))
@@ -290,7 +244,7 @@
     (princ (- ut *1970-01-01*) stream))
 
 (def-formatter #\S
-    (princ (pad-val sec) stream))
+    (princ-pad-val sec stream))
 
 (def-formatter #\t
     (princ #\Tab stream))
@@ -327,7 +281,7 @@
     (print-time-string "%R:%S" stream ut locale))
 
 (def-formatter #\y
-    (princ (pad-val (last-2-digits year)) stream))
+    (princ-pad-val (last-2-digits year) stream))
 
 (def-formatter #\Y
     (princ year stream))
@@ -336,7 +290,7 @@
     (let ((d-zone (if daylight-p (1- zone) zone)))
       (multiple-value-bind (hr mn) (truncate (abs d-zone))
         (princ (if (minusp d-zone) #\+ #\-) stream)
-        (format stream "~2,'0D~2,'0D"
+        (cl:format stream (cl:formatter "~2,'0D~2,'0D")
                 hr (floor (* 60 mn))))))
 
 ;; FIXME should be printing SAST rather than +0200
@@ -349,9 +303,11 @@
   (let ((locale (locale-des->locale (or locale *locale*))))
     (print-time-string (or fmt (get-time-fmt-string locale 
                                                     show-date show-time))
-                       stream ut locale)))
+                       stream ut locale))
+  (values))
 
 (defun print-time-string (fmt-string stream ut locale)
+  (declare (optimize speed) (type simple-string fmt-string))
   (let ((values (multiple-value-list (decode-universal-time ut))))
     (loop for x across fmt-string 
        with perc = nil do
@@ -360,7 +316,8 @@
                     (progn (princ #\% stream) (setf perc nil))
                     (setf perc t)))
            (t (if perc
-                  (progn (apply (lookup-formatter x) stream locale ut values)
+                  (progn (apply (the function (lookup-formatter x))
+                                stream locale ut values)
                          (setf perc nil))
                   (princ x stream)))))))
 
@@ -372,6 +329,9 @@
       
 
 ;; Format
+(defmacro formatter (fmt-string)
+  (etypecase fmt-string 
+    (string `(cl:formatter ,(parse-fmt-string fmt-string)))))
 
 (defun format (stream fmt-cntrl &rest args)
   (apply #'cl:format stream
@@ -380,10 +340,18 @@
            (string (parse-fmt-string fmt-cntrl)))
          args))
 
+(defvar *scanner* (cl-ppcre:create-scanner "~[@v,:]*[m|u|n|M|U|N]"))
+
 (defun parse-fmt-string (string)
+  (if (cl-ppcre:scan *scanner* string)
+      (really-parse-fmt-string string)
+      string))
+
+(defun really-parse-fmt-string (string)
+  (declare (optimize speed) (type string string))
   (with-output-to-string (fmt-string)
     (loop for char across string 
-          with tilde = nil do
+       with tilde = nil do
          (case char
            ((#\@ #\v #\, #\:) (princ char fmt-string))
            (#\~ (princ char fmt-string)
@@ -391,9 +359,10 @@
                     (setf tilde nil)
                     (setf tilde t)))
            (t (if tilde
-                  (progn (setf tilde nil) (princ (get-replacement char) fmt-string))
+                  (progn (setf tilde nil) 
+                         (princ (get-replacement char) fmt-string))
                   (princ char fmt-string)))))))
-
+  
 (defvar *directive-replacements*
   '((#\M . "/cl-l10n:format-money/")
     (#\U . "/cl-l10n:format-time/")


Index: cl-l10n/tests.lisp
diff -u cl-l10n/tests.lisp:1.3 cl-l10n/tests.lisp:1.4
--- cl-l10n/tests.lisp:1.3	Fri Dec 17 11:06:43 2004
+++ cl-l10n/tests.lisp	Thu Dec 30 12:56:38 2004
@@ -1,7 +1,7 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;; See the file LICENCE for licence information.
 (defpackage :cl-l10n-tests
-  (:shadowing-import-from :cl-l10n format)
+  (:shadowing-import-from :cl-l10n format formatter)
   (:use :cl :regression-test :cl-l10n))
 
 (in-package :cl-l10n-tests)
@@ -144,6 +144,19 @@
 
 (deftest format.3
     (format nil "~v:@m" "sv_SE" 1000)
+  "1000,00 SEK")
+
+;; formatter
+(deftest formatter.1
+    (format nil (formatter "~v:@U") "en_ZA" 3091103120)
+  "Sun 14 Dec 1997 17:45:20 +0200")
+
+(deftest formatter.2
+    (format nil (formatter "~v:n") "en_ZA" 1000)
+  "1,000")
+
+(deftest formatter.3
+    (format nil (formatter "~v:@m") "sv_SE" 1000)
   "1000,00 SEK")
 
 


Index: cl-l10n/utils.lisp
diff -u cl-l10n/utils.lisp:1.4 cl-l10n/utils.lisp:1.5
--- cl-l10n/utils.lisp:1.4	Tue Dec  7 10:21:55 2004
+++ cl-l10n/utils.lisp	Thu Dec 30 12:56:38 2004
@@ -84,8 +84,6 @@
                    (nreverse (cons source acc))))))
     (if list (rec list nil) nil)))
 
-
-
 (defun winner (test get seq)
   (if (null seq)
       nil
@@ -108,37 +106,22 @@
                     :initial-value (apply last-fn args))))
       #'identity))
 
+(defun float-part (float)
+  (if (zerop float)
+      ""
+      (multiple-value-call 'extract-float-part (flonum-to-digits float))))
 
-(defun get-first (fore aft)
-  (if (< fore 1)
-      "0"
-      (with-output-to-string (x)
-        (let ((length (length aft)))
-          (cond ((> fore length)
-                 (princ aft x)
-                 (dotimes (z (- fore length))
-                   (princ 0 x)))
-                (t (princ (subseq aft 0 fore)
-                          x)))))))
-
-(defun get-second (fore aft)
+(defun extract-float-part (dp-pos aft)
   (let ((length (length aft)))
-    (if (> fore length)
-        "0"
+    (if (> dp-pos length)
+        ""
         (with-output-to-string (x)
-          (cond ((minusp fore)
-                 (dotimes (z (abs fore))
+          (cond ((minusp dp-pos)
+                 (dotimes (z (abs dp-pos))
                    (princ 0 x))
                  (princ aft x))
-                (t (princ (subseq aft fore)
+                (t (princ (subseq aft dp-pos)
                           x)))))))
-
-(defun split-float (float)
-  (multiple-value-bind (fore aft) (flonum-to-digits float)
-    (values (parse-integer (get-first fore aft))
-            (let ((val (get-second fore aft)))
-              (if (string= val "") "0" val)))))
-
 
 ;; From sbcl sources (src/code/print.lisp)
 (defconstant single-float-min-e



From sross at common-lisp.net  Thu Dec 30 11:56:50 2004
From: sross at common-lisp.net (Sean Ross)
Date: Thu, 30 Dec 2004 12:56:50 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/doc/cl-l10n.texi 
Message-ID: <20041230115650.071A188649@common-lisp.net>

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

Modified Files:
	cl-l10n.texi 
Log Message:
ChangeLog 2004-12-30
Date: Thu Dec 30 12:56:45 2004
Author: sross

Index: cl-l10n/doc/cl-l10n.texi
diff -u cl-l10n/doc/cl-l10n.texi:1.4 cl-l10n/doc/cl-l10n.texi:1.5
--- cl-l10n/doc/cl-l10n.texi:1.4	Fri Dec 17 11:06:46 2004
+++ cl-l10n/doc/cl-l10n.texi	Thu Dec 30 12:56:45 2004
@@ -318,6 +318,13 @@
 
 @end deffn
 
+ at anchor {Macro formatter}
+ at deffn {Macro} formatter fmt-string
+Formatter is another unexported symbol in the cl-l10n package
+Shadow importing formatter gives support for the new format
+control directives.
+ at end deffn
+
 @anchor {Function parse-number}
 @deffn {Function} parse-number num-string &optional (locale *locale*)
 Parses the string @emph{num-string} into a number using @emph{locale}. 
@@ -485,7 +492,6 @@
 @section Known Issues
 @itemize @bullet
 @item  LC_COLLATE and LC_CTYPE categories in the locale files are currently ignored.
- at item  Some locales do not have a value for locale-t-fmt-ampm.
 @item  Not all time format directives are supported.
 @end itemize
 



From sross at common-lisp.net  Thu Dec 30 12:29:55 2004
From: sross at common-lisp.net (Sean Ross)
Date: Thu, 30 Dec 2004 13:29:55 +0100 (CET)
Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog 
Message-ID: <20041230122955.2B231884F7@common-lisp.net>

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

Modified Files:
	ChangeLog 
Log Message:
ChangeLog 2004-12-30
Date: Thu Dec 30 13:29:54 2004
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.7 cl-l10n/ChangeLog:1.8
--- cl-l10n/ChangeLog:1.7	Thu Dec 30 12:56:38 2004
+++ cl-l10n/ChangeLog	Thu Dec 30 13:29:54 2004
@@ -1,6 +1,8 @@
 2004-12-30 Sean Ross	<sross at common-lisp.net>
+	Version 0.2 Release
 	* printers.lisp, load-locale.lisp: Changed format-number and
 	format-money to use a format string created at locale load time.
+	* printers.lisp: Added rounding of monetary values
 	* locale.lisp: Cache Getter functions.
 	
 2004-12-20 Sean Ross	<sross at common-lisp.net>