[cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/locale.lisp cl-l10n/printers.lisp

[Sean Ross]

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

Modified Files:
	ChangeLog cl-l10n.asd load-locale.lisp locale.lisp 
	printers.lisp 
Log Message:
Changelog 2005-02-22
Date: Tue Feb 22 15:18:25 2005
Author: sross

Index: cl-l10n/ChangeLog
diff -u cl-l10n/ChangeLog:1.10 cl-l10n/ChangeLog:1.11
--- cl-l10n/ChangeLog:1.10	Tue Feb  1 08:58:25 2005
+++ cl-l10n/ChangeLog	Tue Feb 22 15:18:25 2005
@@ -1,3 +1,10 @@
+2005-02-22 Sean Ross	<sross at common-lisp.net>
+	* printers.lisp: Added a formatter compiler macro 
+	to remove unnecessary calls to parse-fmt-string.
+	
+2005-02-17 Sean Ross	<sross at common-lisp.net>
+	* locale.lisp: Added support for Allegro CL.
+
 2005-02-01 Sean Ross	<sross at common-lisp.net>
 	* load-locale.lisp: Revert to a default thousands separator
 	if the the locale to be loaded doesn't have one.


Index: cl-l10n/cl-l10n.asd
diff -u cl-l10n/cl-l10n.asd:1.8 cl-l10n/cl-l10n.asd:1.9
--- cl-l10n/cl-l10n.asd:1.8	Tue Feb  1 08:58:25 2005
+++ cl-l10n/cl-l10n.asd	Tue Feb 22 15:18:25 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.2.2"
+  :version "0.2.3"
   :description "Portable CL Locale Support"
   :long-description "Portable CL Package to support localization"
   :licence "MIT"


Index: cl-l10n/load-locale.lisp
diff -u cl-l10n/load-locale.lisp:1.9 cl-l10n/load-locale.lisp:1.10
--- cl-l10n/load-locale.lisp:1.9	Tue Feb  1 08:58:25 2005
+++ cl-l10n/load-locale.lisp	Tue Feb 22 15:18:25 2005
@@ -7,11 +7,12 @@
 
 
 ;; Add a restart here?
-(defun locale (loc-name &key (use-cache t) (errorp t))
+(defun locale (loc-name &key (use-cache t) (errorp t) (loader nil))
   "Find locale named by the string LOC-NAME. If USE-CACHE
 is non-nil forcefully reload the locale from *locale-path* else
 the locale is first looked for in *locales*. If ERRORP is non-nil
-signal a warning rather than an error if the locale file cannot be found."
+signal a warning rather than an error if the locale file cannot be found.
+If LOADER is non-nil skip everything and call loader with LOC-NAME."
   (let ((name (aif (position #\. loc-name)
                    (subseq loc-name 0 it)
                    loc-name)))
@@ -20,8 +21,9 @@
       (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)))
            ((probe-file (merge-pathnames *locale-path* name))
-            (load-locale name))
+            (setf (get-locale name) (load-locale name)))
            (t (funcall (if errorp #'error #'warn)
                        "Can't find locale ~A." name)))))
 
@@ -45,7 +47,7 @@
 
 (defun load-locale (name)
   (let ((path (merge-pathnames *locale-path* name)))
-    (cl:format t "~&;; Loading locale from ~A.~%" path)
+    (cl:format *debug-io* "~&;; Loading locale from ~A.~%" path)
     (let ((locale (make-instance *locale-type* :name name))
           (*read-eval* nil)
           (*print-circle* nil))
@@ -58,7 +60,7 @@
                                                             escape comment))
               (setf (get-category locale (category-name it)) it)))))
       (add-printers locale)
-      (setf (get-locale name) locale))))
+      locale)))
 
 (defun load-all-locales (&optional (path *locale-path*))
   "Load all locale found in pathname designator PATH."
@@ -137,7 +139,6 @@
                (list :money-n-ts
                      (create-money-fmt-string locale nil t))
                (printers locale))))
-        
 
 (defvar *category-loaders*
   '(("LC_IDENTIFICATION" . load-identification)


Index: cl-l10n/locale.lisp
diff -u cl-l10n/locale.lisp:1.7 cl-l10n/locale.lisp:1.8
--- cl-l10n/locale.lisp:1.7	Tue Jan  4 16:32:15 2005
+++ cl-l10n/locale.lisp	Tue Feb 22 15:18:25 2005
@@ -93,6 +93,7 @@
 (defun getenv (word)
   #+sbcl (sb-ext:posix-getenv word)
   #+lispworks (hcl:getenv word)
+  #+acl (sys:getenv word)
   #+cmu (cdr (assoc (intern word :keyword) ext:*environment-list*))
   #+clisp (ext:getenv word)
   #+ecl (si:getenv word))


Index: cl-l10n/printers.lisp
diff -u cl-l10n/printers.lisp:1.9 cl-l10n/printers.lisp:1.10
--- cl-l10n/printers.lisp:1.9	Tue Feb  1 08:58:25 2005
+++ cl-l10n/printers.lisp	Tue Feb 22 15:18:25 2005
@@ -332,6 +332,12 @@
       
 
 ;; Format
+(define-compiler-macro format (&whole form dest control &rest args)
+  "Compiler macro to remove unnecessary calls to parse-fmt-string."
+  (if (stringp control)
+      `(cl::format ,dest ,(really-parse-fmt-string control) , at args)
+      form))
+
 (defmacro formatter (fmt-string)
   (etypecase fmt-string 
     (string `(cl:formatter ,(parse-fmt-string fmt-string)))))
@@ -345,8 +351,12 @@
 
 (defvar *scanner* (cl-ppcre:create-scanner "~[@v,:]*[m|u|n|M|U|N]"))
 
+(defun needs-parsing (string)
+  (declare (optimize speed (safety 1) (debug 0)))
+  (cl-ppcre:scan *scanner* string))
+
 (defun parse-fmt-string (string)
-  (if (cl-ppcre:scan *scanner* string)
+  (if (needs-parsing string)
       (really-parse-fmt-string string)
       string))
 
@@ -378,4 +388,4 @@
 
 
 
-;; EOF
\ No newline at end of file
+;; EOF