From alendvai at common-lisp.net Tue Jun 6 14:58:46 2006 From: alendvai at common-lisp.net (alendvai) Date: Tue, 6 Jun 2006 10:58:46 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060606145846.30FA51D007@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv20708 Modified Files: load-locale.lisp Log Message: Wrap load-default-locale in eval-when :load-toplevel :execute --- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/04/27 18:30:30 1.15 +++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/06 14:58:46 1.16 @@ -371,6 +371,7 @@ (locale (getenv "LANG") :errorp nil) (locale "POSIX" :errorp nil))) -(load-default-locale) +(eval-when (:load-toplevel :execute) + (load-default-locale)) ;; EOF From alendvai at common-lisp.net Thu Jun 8 09:38:20 2006 From: alendvai at common-lisp.net (alendvai) Date: Thu, 8 Jun 2006 05:38:20 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060608093820.695A615007@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv6511 Modified Files: cl-l10n.asd i18n.lisp load-locale.lisp locale.lisp package.lisp parse-time.lisp parsers.lisp printers.lisp Log Message: Merge attila.lendvai at gmail.com's changes, mostly i18n stuff --- /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/04/27 18:30:30 1.15 +++ /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/06/08 09:38:19 1.16 @@ -28,7 +28,6 @@ (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) --- /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/04/27 18:30:30 1.4 +++ /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/06/08 09:38:19 1.5 @@ -2,68 +2,120 @@ ;; See the file LICENCE for licence information. (in-package :cl-l10n) +#| +(defresources en + (indefinit-article-for (str) + ;; calculate "a"/"an" here + ) + (foo.bar "some constant")) + +then writing (indefinit-article-for "asdf") will call the locale-specific +implementation of that function + +|# + +(defvar *resources* (make-hash-table :test 'equal)) + +(defun clear-resources () + (setf *resources* (make-hash-table :test 'equal))) + +(defun resource-key (locale name) + (list (if (stringp locale) locale (locale-name locale)) + (if (stringp name) (string-downcase name) (string-downcase (symbol-name name))))) + +(define-condition resource-missing (warning) + ((name :accessor name-of :initarg :name))) + +(defun add-resource (locale name args body) + ;; store in resouce map + (setf (gethash (resource-key locale name) *resources*) + (if (and (= (length body) 1) + (stringp (first body))) + (first body) + (eval `(lambda ,args , at body)))) + ;; make a function + (setf (symbol-function name) (eval `(lambda (&rest args) (lookup-resource ',name args)))) + name) + +(defun %lookup-resource (locale name args) + (declare (type locale locale) + (type (or symbol string) name)) + (let* ((key (resource-key locale name))) + (multiple-value-bind (resource found) + (gethash key *resources*) + (unless found + ;; try again with the default locale for the language + (setf key (resource-key (canonical-locale-name-from (first (split "_" (locale-name locale)))) name)) + (setf resource (gethash key *resources*))) + ;; dispatch on resource type + (cond ((functionp resource) + (apply resource args)) + ;; literal + ((not (null resource)) + resource))))) + +(defun lookup-resource (name args &key (warn-if-missing t) (fallback-to-name t)) + (loop for locale in (if (consp *locale*) *locale* (list *locale*)) do + (let ((result (funcall '%lookup-resource locale name args))) + (when result + (return-from lookup-resource (values result t))))) + (resource-not-found name warn-if-missing fallback-to-name)) + +(defun lookup-resource-without-fallback (locale name args &key (warn-if-missing t) (fallback-to-name t)) + (aif (%lookup-resource locale name args) + it + (resource-not-found name warn-if-missing fallback-to-name))) + +(defun resource-not-found (name warn-if-missing fallback-to-name) + (if warn-if-missing + (signal 'resource-missing :name name)) + (values (if fallback-to-name + (string-downcase (string name))) + nil)) + +(defmacro defresources (locale &body resources) + (let ((locale-name (canonical-locale-name-from locale))) + (cons 'progn + (loop for resource in resources + if (= 2 (length resource)) + collect `(add-resource ,locale-name + ',(first resource) nil ',(cdr resource)) + else + collect `(add-resource ,locale-name + ',(first resource) ',(second resource) ',(cddr resource)))))) + +(defmacro enable-sharpquote-reader () + "Enable quote reader for the rest of the file (being loaded or compiled). +#\"my i18n text\" parts will be replaced by a lookup-resource call for the string. +Be careful when using in different situations, because it modifies *readtable*." + ;; The standard sais that *readtable* is restored after loading/compiling a file, + ;; so we make a copy and alter that. The effect is that it will be enabled + ;; for the rest of the file being processed. + `(eval-when (:compile-toplevel :execute) + (setf *readtable* (copy-readtable *readtable*)) + (%enable-sharpquote-reader))) + +(defun %enable-sharpquote-reader () + (set-dispatch-macro-character + #\# #\" + #'(lambda (s c1 c2) + (declare (ignore c2)) + (unread-char c1 s) + `(lookup-resource ,(read s) nil)))) + +(defun with-sharpquote-syntax () + "To be used with the curly reader from arnesi: {with-sharpquote-reader (foo #\"locale-specific\") }" + (lambda (handler) + (%enable-sharpquote-reader) + `(progn ,@(funcall handler)))) -;; (defparameter bundle (make-instance 'bundle)) -;; (add-resources (bundle "af_") -;; "showtime" "Dankie, die tyd is ~:@U~%") -;; ;; an empty string as the locale matcher becomes the default -;; (add-resources (bundle "") -;; "showtime" "Thanks, the time is ~:@U~%") - -;; (set-dispatch-macro-character -;; #\# #\i -;; #'(lambda (s c1 c2) -;; (declare (ignore c2)) -;; `(cl-l10n:gettext ,(read s) bundle))) - -;; or this -;; (defmacro _ (text) -;; `(cl-l10n:gettext ,text bundle)) - -;; (defun timey () -;; (format t #i"showtime" (get-universal-time))) - -(defclass bundle () - ((resources :accessor resources :initform (make-hash-table :test #'equal)))) - -(defgeneric add-resource (bundle from to lang)) -(defmethod add-resource (bundle from to lang) - (aif (assoc lang (gethash from (resources bundle)) :test #'equal) - (setf (cdr it) to) - (pushnew (cons lang to) (gethash from (resources bundle)) - :test #'equal)) - t) - -(defmacro add-resources ((bundle loc-name) &body args) - (with-gensyms (gloc gbundle) - `(let ((,gloc ,loc-name) (,gbundle ,bundle)) - ,@(mapcar #'(lambda (x) `(add-resource ,gbundle , at x ,gloc)) - (group args 2))))) - -(defgeneric get-name (bundle name) - (:method ((bundle t) (name t)) - (gethash name (resources bundle)))) - -(defgeneric lookup-name (bundle name) - (:method ((bundle t) (name t)) - (when-let (name (get-name bundle name)) - ;; The match with the longest name is the most - ;; specific key. - (winner #'> - (load-time-value (compose #'length #'car)) - (remove-if-not #'(lambda (x) - (search (car x) - (locale-name *locale*))) - name))))) - -(defun gettext (name bundle &optional (loc *locale*)) - (let ((*locale* (locale-des->locale loc))) - (or (cdr (lookup-name bundle name)) - name))) +(defgeneric localize (object) + (:documentation "Override this generic method for various data types. Return (values result foundp).")) +(defmethod localize ((str string)) + (lookup-resource str nil)) - - -;; EOF +(defmethod localize ((str symbol)) + (lookup-resource str nil)) --- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/06 14:58:46 1.16 +++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/08 09:38:19 1.17 @@ -5,23 +5,69 @@ (defparameter *ignore-categories* (list "LC_CTYPE" "LC_COLLATE")) +(defparameter *language->default-locale-name* (make-hash-table :test #'equal) + "This map specifies what is the default locale for locale specifications without a region (i.e. en_US for en)") + +(deftype locale-descriptor () + `(or locale string symbol)) + +(defun canonical-locale-name-from (locale) + (check-type locale locale-descriptor) + (if (typep locale 'locale) + (locale-name locale) + (let ((name locale)) + (when (and (not (null name)) + (symbolp name)) + (setf name (symbol-name name))) + (let* ((parts (split "_" name)) + (count (list-length parts)) + (first-length (length (first parts))) + (second-length (length (second parts)))) + (when (> count 2) + (error "Locale variants are not yet supported")) + (when (or (> first-length 3) + (< first-length 2) + (and (> count 1) + (or (> second-length 3) + (< second-length 2)))) + (error "~A is not a valid locale name (examples: en_GB, en_US, en)" locale)) + (let ((language (string-downcase (first parts))) + (region (when (> count 1) + (second parts)))) + (if (> count 1) + (concatenate 'string language "_" region) + (aif (gethash language *language->default-locale-name*) + it + (concatenate 'string language "_" (string-upcase language))))))))) + +;; set up the default region mappings while loading +(eval-when (:load-toplevel :execute) + (loop for (language locale) in + '((en "en_US")) do + (setf (gethash (string-downcase (symbol-name language)) *language->default-locale-name*) + (canonical-locale-name-from locale))) + (values)) + ;; Add a restart here? (defun locale (loc-name &key (use-cache t) (errorp t) (loader nil)) - "Find locale named by the string LOC-NAME. If USE-CACHE + "Find locale named by the specification 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. 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))) - (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)) - (setf (get-locale name) (load-locale name))) - (t (funcall (if errorp #'error #'warn) - "Can't find locale ~A." name))))) + (if (typep loc-name 'locale) + loc-name + (let ((name (canonical-locale-name-from + (aif (position #\. loc-name) + (subseq loc-name 0 it) + loc-name)))) + (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)) + (setf (get-locale name) (load-locale name))) + (t (funcall (if errorp #'error #'warn) + "Can't find locale ~A." name)))))) (defvar *locale-type* 'locale "The class of loaded locales.") @@ -29,18 +75,6 @@ (defvar *category-type* 'category "The class of loaded categories") -(deftype locale-descriptor () - `(or locale string symbol)) - -(defun locale-des->locale (loc) - "Turns a locale descriptor(a string, symbol or locale) into an -actual locale object." - (check-type loc locale-descriptor) - (etypecase loc - (locale loc) - (string (locale loc)) - (symbol (locale (string loc))))) - (defun load-locale (name) (let ((path (merge-pathnames *locale-path* name)) (ef #+sbcl :iso-8859-1 @@ -360,16 +394,26 @@ (return-from next-header (trim line))))) (defun set-locale (locale-des) - (setf *locale* (locale-des->locale locale-des))) + (setf *locale* (if (listp locale-des) + (loop for locale in locale-des + collect (locale locale)) + (locale locale-des)))) + +(defmacro with-locale (locale &body body) + `(let ((*locale* (locale ,locale))) + , at body)) (defun load-default-locale () - (setf *locale* (get-default-locale))) + (set-locale (get-default-locale))) (defun get-default-locale () - (or (locale (getenv "CL_LOCALE") :errorp nil) - (locale (getenv "LC_CTYPE") :errorp nil) - (locale (getenv "LANG") :errorp nil) - (locale "POSIX" :errorp nil))) + (macrolet ((try (name) + `(when-let (it (getenv ,name)) + (locale it :errorp nil)))) + (or (try "CL_LOCALE") + (try "LC_CTYPE") + (try "LANG") + (locale "POSIX" :errorp nil)))) (eval-when (:load-toplevel :execute) (load-default-locale)) --- /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/04/27 18:30:30 1.12 +++ /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/06/08 09:38:19 1.13 @@ -16,7 +16,14 @@ (merge-pathnames (make-pathname :directory '(:relative "locales")) (asdf:component-pathname (asdf:find-system :cl-l10n)))) -(defvar *locale* nil) +(defvar *locale* nil + "Either a locale or a list of locales in which case resources will be looked for in each locale in order.") + +(defun current-locale () + (declare (inline current-locale)) + (if (consp *locale*) + (car *locale*) + *locale*)) (defvar *locales* (make-hash-table :test #'equal) "Hash table containing all loaded locales keyed on name (eg. \"af_ZA\")") @@ -101,8 +108,8 @@ (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))) + (defun ,name (&optional (locale (current-locale))) + (let ((locale (locale locale))) (when locale (funcall ,wrap (locale-value locale ,cat ,key))))) (export ',name)))) --- /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/04/27 18:30:30 1.8 +++ /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/06/08 09:38:19 1.9 @@ -7,12 +7,16 @@ (: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* #:load-default-locale + #:get-locale #:*locale-path* #:*locales* #:load-default-locale #:format-number #:print-number #:format-money #:print-money - #:format-time #:print-time #:add-resources #:bundle - #:add-resource #:gettext #:parse-number #:*float-digits* + #:format-time #:print-time #:add-resources + #:parse-number #:*float-digits* #:parse-time #:month #:day #:year #:hour #:minute #:second #:date-divider #:time-divider #:weekday #:noon-midn #:shadow-format - #:secondp #:am-pm #:zone #:parser-error #:set-locale)) + #:secondp #:am-pm #:zone #:parser-error #:set-locale + #:with-locale #:lookup-resource + #:lookup-resource-without-fallback #:localize + #:missing-resource #:defresources #:enable-sharpquote-reader + #:with-sharpquote-reader)) --- /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2006/04/27 18:30:30 1.3 +++ /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2006/06/08 09:38:19 1.4 @@ -600,7 +600,7 @@ ;; patterns have not been explicitly specified so we try ;; to match against locale a specific date pattern first. ;; eg. 03/04/2005 is 3rd April in UK but 4 March in US. - (dolist (pattern (parsers *locale*)) + (dolist (pattern (parsers (current-locale))) (let ((res (match-pattern pattern string-parts parts-length))) @@ -620,7 +620,7 @@ (default-hours nil) (default-day nil) (default-month nil) (default-year nil) (default-zone nil) (default-weekday nil) - (locale *locale*)) + (locale (current-locale))) "Tries very hard to make sense out of the argument time-string using locale and returns a single integer representing the universal time if successful. If not, it returns nil. If the :error-on-mismatch @@ -630,21 +630,21 @@ keywords can be given a numeric value or the keyword :current to set them to the current value. The default-default values are 00:00:00 on the current date, current time-zone." - (let* ((*error-on-mismatch* error-on-mismatch) - (*locale* (locale-des->locale locale)) - (string-parts (decompose-string time-string :start start :end end)) - (parts-length (length string-parts)) - (string-form (get-matching-pattern patterns string-parts parts-length))) - (if string-form - (let ((parsed-values (make-default-time default-seconds default-minutes - default-hours default-day - default-month default-year - default-zone default-weekday))) - (set-time-values string-form parsed-values) - (convert-to-unitime parsed-values)) - (if *error-on-mismatch* - (error 'parser-error :value time-string :reason "Not a recognized time/date format.") - nil)))) + (with-locale locale + (let* ((*error-on-mismatch* error-on-mismatch) + (string-parts (decompose-string time-string :start start :end end)) + (parts-length (length string-parts)) + (string-form (get-matching-pattern patterns string-parts parts-length))) + (if string-form + (let ((parsed-values (make-default-time default-seconds default-minutes + default-hours default-day + default-month default-year + default-zone default-weekday))) + (set-time-values string-form parsed-values) + (convert-to-unitime parsed-values)) + (if *error-on-mismatch* + (error 'parser-error :value time-string :reason "Not a recognized time/date format.") + nil))))) ; EOF --- /project/cl-l10n/cvsroot/cl-l10n/parsers.lisp 2005/05/18 15:34:08 1.4 +++ /project/cl-l10n/cvsroot/cl-l10n/parsers.lisp 2006/06/08 09:38:20 1.5 @@ -1,7 +1,7 @@ (in-package :cl-l10n) -(defun parse-number (num &optional (locale *locale*)) - (let ((locale (locale-des->locale locale))) +(defun parse-number (num &optional (locale (current-locale))) + (let ((locale (locale locale))) (%parse-number (replace-dp (remove-ts num locale) locale)))) (defun remove-ts (num locale) --- /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/04/27 18:30:30 1.17 +++ /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/06/08 09:38:20 1.18 @@ -21,8 +21,8 @@ (princ "0" s))))) (defun format-number (stream arg no-dp no-ts - &optional (locale *locale*)) - (let ((locale (locale-des->locale locale)) + &optional (locale (current-locale))) + (let ((locale (locale locale)) (float-part (float-part (coerce (abs arg) 'double-float)))) (cl:format stream (getf (printers locale) @@ -35,7 +35,7 @@ (values))) (defun print-number (number &key (stream *standard-output*) - no-ts no-dp (locale *locale*)) + no-ts no-dp (locale (current-locale))) (format-number stream number no-dp no-ts locale) number) @@ -60,8 +60,8 @@ :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)) +(defun format-money (stream arg use-int-sym no-ts &optional (locale (current-locale))) + (let* ((locale (locale locale)) (frac-digits (max (if use-int-sym (locale-int-frac-digits locale) (locale-frac-digits locale)) @@ -85,7 +85,7 @@ (values)) (defun print-money (num &key (stream *standard-output*) use-int-sym no-ts - (locale *locale*)) + (locale (current-locale))) (format-money stream num use-int-sym no-ts locale) num) @@ -119,15 +119,16 @@ (defun princ-pad-val (val stream &optional (pad "0") (size 2)) (declare (type stream stream) (optimize speed) - (type fixnum val)) + (type fixnum val size)) (assert (not (minusp val)) (val) "Value ~A cannot be smaller than 0." val) (cond ((zerop val) (dotimes (x (1- size)) (princ pad stream)) (princ 0 stream)) (t - (loop for x = (* val 10) then (* x 10) - until (>= x (expt 10 size)) do + (loop with stop-value = (expt 10 size) + for x integer = (* val 10) then (* x 10) + until (>= x stop-value) do (princ pad stream)) (princ val stream)))) @@ -316,8 +317,8 @@ (defvar *time-zone*) -(defun format-time (stream ut show-date show-time &optional (locale *locale*) fmt time-zone) - (let ((locale (locale-des->locale (or locale *locale*))) +(defun format-time (stream ut show-date show-time &optional (locale (current-locale)) fmt time-zone) + (let ((locale (locale locale)) (*time-zone* (or time-zone (nth-value 8 (decode-universal-time ut))))) (print-time-string (or fmt (get-time-fmt-string locale show-date show-time)) @@ -348,7 +349,7 @@ (princ x stream))))))) (defun print-time (ut &key show-date show-time (stream *standard-output*) - (locale *locale*) fmt time-zone) + (locale (current-locale)) fmt time-zone) (format-time stream ut show-date show-time locale fmt time-zone) ut) @@ -386,7 +387,7 @@ string)) (defun really-parse-fmt-string (string) - (declare (optimize speed) (type string string)) + (declare (optimize speed) (type simple-string string)) (with-output-to-string (fmt-string) (loop for char across string with tilde = nil do From alendvai at common-lisp.net Thu Jun 15 19:57:34 2006 From: alendvai at common-lisp.net (alendvai) Date: Thu, 15 Jun 2006 15:57:34 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060615195734.AB3BB200F@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv1831 Modified Files: cl-l10n.asd i18n.lisp load-locale.lisp locale.lisp package.lisp printers.lisp utils.lisp Log Message: Added arnesi and iterate dependency, lookup-first-matching-resource --- /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/06/08 09:38:19 1.16 +++ /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/06/15 19:57:34 1.17 @@ -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 :cl-fad)) + :depends-on (:arnesi :iterate :cl-ppcre :cl-fad)) (defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n)))) (provide 'cl-l10n)) --- /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/06/08 09:38:19 1.5 +++ /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/06/15 19:57:34 1.6 @@ -84,6 +84,38 @@ collect `(add-resource ,locale-name ',(first resource) ',(second resource) ',(cddr resource)))))) +(defmacro lookup-first-matching-resource (&body specs) + "Try to look up the resource keys, return the first match, fallback to the first key. +An example usage: + (lookup-first-matching-resource + ((awhen attribute (name-of it)) (name-of state)) + ((name-of (state-machine-of state)) (name-of state)) + (\"state-name\" (name-of state)) + \"last-try\") +When a resource key is a list, its elements will be concatenated separated by dots." + (iter (with fallback = nil) + (for spec in specs) + (for el = (if (or (and (consp spec) + (symbolp (car spec))) + (atom spec)) + spec + `(strcat-separated-by "." , at spec))) + (if (first-time-p) + (setf fallback el) + (collect `(lookup-resource ,el nil :warn-if-missing nil :fallback-to-name nil) into lookups)) + (finally (return (with-unique-names (block fallback-tmp) + `(block ,block + (let ((,fallback-tmp ,fallback)) + (bind (((values resource foundp) (lookup-resource + ,fallback-tmp nil :warn-if-missing nil :fallback-to-name nil))) + (when foundp + (return-from ,block (values resource t)))) + ,@(iter (for lookup in lookups) + (collect `(bind (((values resource foundp) ,lookup)) + (when foundp + (return-from ,block (values resource t)))))) + (return-from ,block (values ,fallback-tmp nil))))))))) + (defmacro enable-sharpquote-reader () "Enable quote reader for the rest of the file (being loaded or compiled). #\"my i18n text\" parts will be replaced by a lookup-resource call for the string. --- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/08 09:38:19 1.17 +++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/15 19:57:34 1.18 @@ -87,10 +87,10 @@ (multiple-value-bind (escape comment) (munge-headers stream) (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))))) + (when-bind cat (make-category locale header + (parse-category header stream + escape comment)) + (setf (get-category locale header) cat))))) (add-printers locale) (add-parsers locale) locale))) @@ -251,8 +251,8 @@ (cdr (assoc name *category-loaders* :test #'string=))) (defun make-category (locale name vals) - (when-let (loader (get-loader name)) - (funcall loader locale name vals))) + (awhen (get-loader name) + (funcall it locale name vals))) (defgeneric load-category (locale name vals) (:documentation "Load a category for LOCALE using VALS.") @@ -297,7 +297,7 @@ cat from c))))) (defun parse-category (name stream escape comment) - (let ((end (mkstr "END " name)) + (let ((end (strcat "END " name)) (ret nil)) (loop for line = (read-line stream nil stream) until (eq line stream) do @@ -408,7 +408,7 @@ (defun get-default-locale () (macrolet ((try (name) - `(when-let (it (getenv ,name)) + `(awhen (getenv ,name) (locale it :errorp nil)))) (or (try "CL_LOCALE") (try "LC_CTYPE") --- /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/06/08 09:38:19 1.13 +++ /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/06/15 19:57:34 1.14 @@ -93,8 +93,8 @@ new-val)) (defun locale-value (locale cat key) - (when-let (cat (get-category locale cat)) - (category-value cat key))) + (awhen (get-category locale cat) + (category-value it key))) (defun getenv (word) #+sbcl (sb-ext:posix-getenv word) @@ -106,7 +106,7 @@ ;; Getters (defmacro defgetter (key cat &key (wrap '#'identity)) - (let ((name (symb "LOCALE-" (substitute #\- #\_ (string-upcase key))))) + (let ((name (intern-concat (list "LOCALE-" (substitute #\- #\_ (string-upcase key)))))) `(progn (defun ,name (&optional (locale (current-locale))) (let ((locale (locale locale))) --- /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/06/08 09:38:19 1.9 +++ /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/06/15 19:57:34 1.10 @@ -3,8 +3,10 @@ (in-package #:cl-l10n.system) (defpackage #:cl-l10n - (:use #:cl #:cl-ppcre #:cl-fad) + (:use #:cl #:cl-ppcre #:cl-fad #:arnesi #:iterate) (:shadow cl:format cl:formatter) + (:shadowing-import-from :cl-fad + #:copy-stream #:copy-file) (:export #:locale-name #:category-name #:locale #:category #:locale-error #:get-category #:get-cat-val #:locale-value #:load-all-locales #:get-locale #:*locale-path* #:*locales* #:load-default-locale @@ -17,6 +19,5 @@ #:with-locale #:lookup-resource #:lookup-resource-without-fallback #:localize #:missing-resource #:defresources #:enable-sharpquote-reader - #:with-sharpquote-reader)) - + #:with-sharpquote-reader #:lookup-first-matching-resource)) --- /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/06/08 09:38:20 1.18 +++ /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/06/15 19:57:34 1.19 @@ -104,7 +104,7 @@ (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)))) + (let ((name (gensym (strcat "FORMATTER-" sym)))) `(flet ((,name (stream locale ut sec min hour date month year day daylight-p zone) (declare (ignorable stream locale ut sec min hour date month --- /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/04/27 18:30:30 1.8 +++ /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/06/15 19:57:34 1.9 @@ -4,27 +4,6 @@ ;; Macros ;;;;;;;;;;; -(defmacro aif (test then &optional else) - `(let ((it ,test)) - (if it ,then ,else))) - -(defmacro acond (&rest options) - (if (cdr options) - `(aif ,(caar options) - (progn ,@(cdar options)) - (acond ,@(cdr options))) - `(aif ,(caar options) - (progn ,@(cdar options))))) - -(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)) - ;; dont worry it's nothing like if* (defmacro or* (&rest vals) @@ -42,21 +21,6 @@ ;; Functions ;;;;;;;;;;;;;; -(defun singlep (list) - (and (consp list) - (not (cdr list)))) - -(defun last1 (list) - (car (last list))) - -(defun mkstr (&rest args) - (with-output-to-string (s) - (dolist (x args) - (princ x s)))) - -(defun symb (&rest args) - (values (intern (apply #'mkstr args)))) - (defun mappend (fn &rest lists) (apply #'append (apply #'mapcar fn lists))) @@ -88,17 +52,6 @@ (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 float-part (float) (if (zerop float) "" From alendvai at common-lisp.net Thu Jun 15 20:23:07 2006 From: alendvai at common-lisp.net (alendvai) Date: Thu, 15 Jun 2006 16:23:07 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060615202307.10E46111CC@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv5714 Modified Files: utils.lisp Log Message: Added missing strcat-separated-by function --- /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/06/15 19:57:34 1.9 +++ /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/06/15 20:23:07 1.10 @@ -29,6 +29,15 @@ (defvar *whitespace* (list #\Space #\Tab)) +(defun strcat-separated-by (separator &rest args) + (iter (for el in args) + (unless el + (next-iteration)) + (unless (first-time-p) + (collect separator into components)) + (collect el into components) + (finally (return (apply #'strcat components))))) + (defun trim (string &optional (bag *whitespace*)) (string-trim bag string)) From alendvai at common-lisp.net Thu Jun 15 22:56:18 2006 From: alendvai at common-lisp.net (alendvai) Date: Thu, 15 Jun 2006 18:56:18 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060615225618.5D78579000@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv26914 Modified Files: i18n.lisp load-locale.lisp Log Message: Some fixes --- /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/06/15 19:57:34 1.6 +++ /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/06/15 22:56:18 1.7 @@ -106,12 +106,12 @@ (finally (return (with-unique-names (block fallback-tmp) `(block ,block (let ((,fallback-tmp ,fallback)) - (bind (((values resource foundp) (lookup-resource - ,fallback-tmp nil :warn-if-missing nil :fallback-to-name nil))) + (multiple-value-bind (resource foundp) + (lookup-resource ,fallback-tmp nil :warn-if-missing nil :fallback-to-name nil) (when foundp (return-from ,block (values resource t)))) ,@(iter (for lookup in lookups) - (collect `(bind (((values resource foundp) ,lookup)) + (collect `(multiple-value-bind (resource foundp) ,lookup (when foundp (return-from ,block (values resource t)))))) (return-from ,block (values ,fallback-tmp nil))))))))) --- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/15 19:57:34 1.18 +++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/06/15 22:56:18 1.19 @@ -400,8 +400,11 @@ (locale locale-des)))) (defmacro with-locale (locale &body body) - `(let ((*locale* (locale ,locale))) - , at body)) + (rebinding (locale) + `(let ((*locale* (if (consp ,locale) + ,locale + (locale ,locale)))) + , at body))) (defun load-default-locale () (set-locale (get-default-locale))) From sross at common-lisp.net Fri Jun 30 14:55:10 2006 From: sross at common-lisp.net (sross) Date: Fri, 30 Jun 2006 10:55:10 -0400 (EDT) Subject: [cl-l10n-cvs] CVS cl-l10n Message-ID: <20060630145510.5DF0337004@common-lisp.net> Update of /project/cl-l10n/cvsroot/cl-l10n In directory clnet:/tmp/cvs-serv11542 Added Files: NO_LONGER_MAINTAINED.readme Log Message: --- /project/cl-l10n/cvsroot/cl-l10n/NO_LONGER_MAINTAINED.readme 2006/06/30 14:55:10 NONE +++ /project/cl-l10n/cvsroot/cl-l10n/NO_LONGER_MAINTAINED.readme 2006/06/30 14:55:10 1.1 Hi, If you are reading this then you have checked out a branch of cl-l10n that is no longer maintained. Well, the real reason this file is here is because we have changed to using Darcs as our VC manager of choice. If you still want to be on the bleeding edge then you can get to the latest source by using the following command. darcs get http://www.common-lisp.net/project/cl-l10n/repos/cl-l10n (This of course assumes that darcs is installed on your machine.) Browsing the source tree can be done by pointing your favorite browser at http://common-lisp.net/cgi-bin/darcsweb/darcsweb.cgi?r=cl-l10n%20cl-l10n The cvs tree only remains to keep all the nice cvs history and for historical reasons. Happy hacking, Sean.