/[cl-l10n]/cl-l10n/i18n.lisp
ViewVC logotype

Contents of /cl-l10n/i18n.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (hide annotations)
Thu Jun 15 22:56:18 2006 UTC (7 years, 10 months ago) by alendvai
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +3 -3 lines
Some fixes
1 sross 1.1 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2     ;; See the file LICENCE for licence information.
3     (in-package :cl-l10n)
4    
5 alendvai 1.5 #|
6     (defresources en
7     (indefinit-article-for (str)
8     ;; calculate "a"/"an" here
9     )
10     (foo.bar "some constant"))
11    
12     then writing (indefinit-article-for "asdf") will call the locale-specific
13     implementation of that function
14    
15     |#
16    
17     (defvar *resources* (make-hash-table :test 'equal))
18    
19     (defun clear-resources ()
20     (setf *resources* (make-hash-table :test 'equal)))
21    
22     (defun resource-key (locale name)
23     (list (if (stringp locale) locale (locale-name locale))
24     (if (stringp name) (string-downcase name) (string-downcase (symbol-name name)))))
25    
26     (define-condition resource-missing (warning)
27     ((name :accessor name-of :initarg :name)))
28    
29     (defun add-resource (locale name args body)
30     ;; store in resouce map
31     (setf (gethash (resource-key locale name) *resources*)
32     (if (and (= (length body) 1)
33     (stringp (first body)))
34     (first body)
35     (eval `(lambda ,args ,@body))))
36     ;; make a function
37     (setf (symbol-function name) (eval `(lambda (&rest args) (lookup-resource ',name args))))
38     name)
39    
40     (defun %lookup-resource (locale name args)
41     (declare (type locale locale)
42     (type (or symbol string) name))
43     (let* ((key (resource-key locale name)))
44     (multiple-value-bind (resource found)
45     (gethash key *resources*)
46     (unless found
47     ;; try again with the default locale for the language
48     (setf key (resource-key (canonical-locale-name-from (first (split "_" (locale-name locale)))) name))
49     (setf resource (gethash key *resources*)))
50     ;; dispatch on resource type
51     (cond ((functionp resource)
52     (apply resource args))
53     ;; literal
54     ((not (null resource))
55     resource)))))
56    
57     (defun lookup-resource (name args &key (warn-if-missing t) (fallback-to-name t))
58     (loop for locale in (if (consp *locale*) *locale* (list *locale*)) do
59     (let ((result (funcall '%lookup-resource locale name args)))
60     (when result
61     (return-from lookup-resource (values result t)))))
62     (resource-not-found name warn-if-missing fallback-to-name))
63    
64     (defun lookup-resource-without-fallback (locale name args &key (warn-if-missing t) (fallback-to-name t))
65     (aif (%lookup-resource locale name args)
66     it
67     (resource-not-found name warn-if-missing fallback-to-name)))
68    
69     (defun resource-not-found (name warn-if-missing fallback-to-name)
70     (if warn-if-missing
71     (signal 'resource-missing :name name))
72     (values (if fallback-to-name
73     (string-downcase (string name)))
74     nil))
75    
76     (defmacro defresources (locale &body resources)
77     (let ((locale-name (canonical-locale-name-from locale)))
78     (cons 'progn
79     (loop for resource in resources
80     if (= 2 (length resource))
81     collect `(add-resource ,locale-name
82     ',(first resource) nil ',(cdr resource))
83     else
84     collect `(add-resource ,locale-name
85     ',(first resource) ',(second resource) ',(cddr resource))))))
86    
87 alendvai 1.6 (defmacro lookup-first-matching-resource (&body specs)
88     "Try to look up the resource keys, return the first match, fallback to the first key.
89     An example usage:
90     (lookup-first-matching-resource
91     ((awhen attribute (name-of it)) (name-of state))
92     ((name-of (state-machine-of state)) (name-of state))
93     (\"state-name\" (name-of state))
94     \"last-try\")
95     When a resource key is a list, its elements will be concatenated separated by dots."
96     (iter (with fallback = nil)
97     (for spec in specs)
98     (for el = (if (or (and (consp spec)
99     (symbolp (car spec)))
100     (atom spec))
101     spec
102     `(strcat-separated-by "." ,@spec)))
103     (if (first-time-p)
104     (setf fallback el)
105     (collect `(lookup-resource ,el nil :warn-if-missing nil :fallback-to-name nil) into lookups))
106     (finally (return (with-unique-names (block fallback-tmp)
107     `(block ,block
108     (let ((,fallback-tmp ,fallback))
109 alendvai 1.7 (multiple-value-bind (resource foundp)
110     (lookup-resource ,fallback-tmp nil :warn-if-missing nil :fallback-to-name nil)
111 alendvai 1.6 (when foundp
112     (return-from ,block (values resource t))))
113     ,@(iter (for lookup in lookups)
114 alendvai 1.7 (collect `(multiple-value-bind (resource foundp) ,lookup
115 alendvai 1.6 (when foundp
116     (return-from ,block (values resource t))))))
117     (return-from ,block (values ,fallback-tmp nil)))))))))
118    
119 alendvai 1.5 (defmacro enable-sharpquote-reader ()
120     "Enable quote reader for the rest of the file (being loaded or compiled).
121     #\"my i18n text\" parts will be replaced by a lookup-resource call for the string.
122     Be careful when using in different situations, because it modifies *readtable*."
123     ;; The standard sais that *readtable* is restored after loading/compiling a file,
124     ;; so we make a copy and alter that. The effect is that it will be enabled
125     ;; for the rest of the file being processed.
126     `(eval-when (:compile-toplevel :execute)
127     (setf *readtable* (copy-readtable *readtable*))
128     (%enable-sharpquote-reader)))
129    
130     (defun %enable-sharpquote-reader ()
131     (set-dispatch-macro-character
132     #\# #\"
133     #'(lambda (s c1 c2)
134     (declare (ignore c2))
135     (unread-char c1 s)
136     `(lookup-resource ,(read s) nil))))
137    
138     (defun with-sharpquote-syntax ()
139     "To be used with the curly reader from arnesi: {with-sharpquote-reader (foo #\"locale-specific\") }"
140     (lambda (handler)
141     (%enable-sharpquote-reader)
142     `(progn ,@(funcall handler))))
143 sross 1.1
144    
145    
146 alendvai 1.5 (defgeneric localize (object)
147     (:documentation "Override this generic method for various data types. Return (values result foundp)."))
148 sross 1.1
149 alendvai 1.5 (defmethod localize ((str string))
150     (lookup-resource str nil))
151 sross 1.1
152 alendvai 1.5 (defmethod localize ((str symbol))
153     (lookup-resource str nil))

  ViewVC Help
Powered by ViewVC 1.1.5