From sross at common-lisp.net Tue Feb 1 07:58:27 2005 From: sross at common-lisp.net (Sean Ross) Date: Mon, 31 Jan 2005 23:58:27 -0800 (PST) Subject: [cl-l10n-cvs] CVS update: cl-l10n/ChangeLog cl-l10n/cl-l10n.asd cl-l10n/load-locale.lisp cl-l10n/printers.lisp cl-l10n/tests.lisp Message-ID: <20050201075827.E66178864B@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory common-lisp.net:/tmp/cvs-serv7773 Modified Files: ChangeLog cl-l10n.asd load-locale.lisp printers.lisp tests.lisp Log Message: Changelog 2005-02-01 Date: Mon Jan 31 23:58:25 2005 Author: sross Index: cl-l10n/ChangeLog diff -u cl-l10n/ChangeLog:1.9 cl-l10n/ChangeLog:1.10 --- cl-l10n/ChangeLog:1.9 Tue Jan 4 07:32:15 2005 +++ cl-l10n/ChangeLog Mon Jan 31 23:58:25 2005 @@ -1,3 +1,8 @@ +2005-02-01 Sean Ross + * load-locale.lisp: Revert to a default thousands separator + if the the locale to be loaded doesn't have one. + * printers.lisp: Fixed bug in float padding. + 2005-01-04 Sean Ross * locale.lisp: Changed get-category, get-locale to generic-functions Changed macro get-cat-val to method category-value. Index: cl-l10n/cl-l10n.asd diff -u cl-l10n/cl-l10n.asd:1.7 cl-l10n/cl-l10n.asd:1.8 --- cl-l10n/cl-l10n.asd:1.7 Thu Dec 30 03:56:38 2004 +++ cl-l10n/cl-l10n.asd Mon Jan 31 23:58:25 2005 @@ -11,7 +11,7 @@ :name "CL-L10N" :author "Sean Ross " :maintainer "Sean Ross " - :version "0.2.0" + :version "0.2.2" :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.8 cl-l10n/load-locale.lisp:1.9 --- cl-l10n/load-locale.lisp:1.8 Tue Jan 4 07:32:15 2005 +++ cl-l10n/load-locale.lisp Mon Jan 31 23:58:25 2005 @@ -70,9 +70,16 @@ (handler-case (load-locale (pathname-name x)) (locale-error (c) (warn "Unable to load locale ~A. ~%~A." x c)))))))) +(defvar *default-thousands-sep* #\,) + +(defun thousands-sep-char (sep) + (if (> (length sep) 0) + (schar sep 0) + *default-thousands-sep*)) (defun create-number-fmt-string (locale no-ts) - (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" (schar (locale-thousands-sep locale) 0) + (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" + (thousands-sep-char (locale-thousands-sep locale)) (locale-grouping locale) (if no-ts "D" ":D"))) @@ -103,7 +110,7 @@ (princ sym-sep stream)) ;; Actual number (cl:format stream "~~,,'~A,~A~A~~{~~A~~}" - (schar (locale-mon-thousands-sep locale) 0) + (thousands-sep-char (locale-mon-thousands-sep locale)) (locale-mon-grouping locale) (if no-ts "D" ":D")) (unless prec Index: cl-l10n/printers.lisp diff -u cl-l10n/printers.lisp:1.8 cl-l10n/printers.lisp:1.9 --- cl-l10n/printers.lisp:1.8 Tue Jan 4 07:32:15 2005 +++ cl-l10n/printers.lisp Mon Jan 31 23:58:25 2005 @@ -1,4 +1,4 @@ -;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;; See the file LICENCE for licence information. (in-package :cl-l10n) @@ -13,9 +13,12 @@ determine the number of zero's to print") (defun fix-float-string (string size) - (if (string= string "") - (make-string size :initial-element #\0) - string)) + "Pads the string with trailing zero's if it is smaller than size" + (with-output-to-string (s) + (princ string s) + (when (< (length string) size) + (dotimes (x (- size (length string))) + (princ "0" s))))) (defun format-number (stream arg no-dp no-ts &optional (locale *locale*)) Index: cl-l10n/tests.lisp diff -u cl-l10n/tests.lisp:1.4 cl-l10n/tests.lisp:1.5 --- cl-l10n/tests.lisp:1.4 Thu Dec 30 03:56:38 2004 +++ cl-l10n/tests.lisp Mon Jan 31 23:58:25 2005 @@ -35,7 +35,7 @@ (deftest number.6 (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2) - "0,5") + "0,50") (deftest number.7 (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0) From sross at common-lisp.net Tue Feb 22 14:18:26 2005 From: sross at common-lisp.net (Sean Ross) Date: Tue, 22 Feb 2005 15:18:26 +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/printers.lisp Message-ID: <20050222141826.053A8884E2@common-lisp.net> 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 + * printers.lisp: Added a formatter compiler macro + to remove unnecessary calls to parse-fmt-string. + +2005-02-17 Sean Ross + * locale.lisp: Added support for Allegro CL. + 2005-02-01 Sean Ross * 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 " :maintainer "Sean Ross " - :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