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 "." ,@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 - ,@body))) - -(defmacro with-gensyms (names &body body) - `(let ,(mapcar #'(lambda (x) `(,x (gensym))) names) - ,@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) ""