[cl-l10n-cvs] CVS cl-l10n
alendvai
alendvai at common-lisp.net
Thu Jun 15 19:57:34 UTC 2006
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)
""
More information about the Cl-l10n-cvs
mailing list