/[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 - (show 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 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;; See the file LICENCE for licence information.
3 (in-package :cl-l10n)
4
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 (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 (multiple-value-bind (resource foundp)
110 (lookup-resource ,fallback-tmp nil :warn-if-missing nil :fallback-to-name nil)
111 (when foundp
112 (return-from ,block (values resource t))))
113 ,@(iter (for lookup in lookups)
114 (collect `(multiple-value-bind (resource foundp) ,lookup
115 (when foundp
116 (return-from ,block (values resource t))))))
117 (return-from ,block (values ,fallback-tmp nil)))))))))
118
119 (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
144
145
146 (defgeneric localize (object)
147 (:documentation "Override this generic method for various data types. Return (values result foundp)."))
148
149 (defmethod localize ((str string))
150 (lookup-resource str nil))
151
152 (defmethod localize ((str symbol))
153 (lookup-resource str nil))

  ViewVC Help
Powered by ViewVC 1.1.5