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

Contents of /cl-l10n/i18n.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Thu Jun 8 09:38:19 2006 UTC (7 years, 10 months ago) by alendvai
Branch: MAIN
Changes since 1.4: +112 -60 lines
Merge attila.lendvai@gmail.com's changes, mostly i18n stuff
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     (defmacro enable-sharpquote-reader ()
88     "Enable quote reader for the rest of the file (being loaded or compiled).
89     #\"my i18n text\" parts will be replaced by a lookup-resource call for the string.
90     Be careful when using in different situations, because it modifies *readtable*."
91     ;; The standard sais that *readtable* is restored after loading/compiling a file,
92     ;; so we make a copy and alter that. The effect is that it will be enabled
93     ;; for the rest of the file being processed.
94     `(eval-when (:compile-toplevel :execute)
95     (setf *readtable* (copy-readtable *readtable*))
96     (%enable-sharpquote-reader)))
97    
98     (defun %enable-sharpquote-reader ()
99     (set-dispatch-macro-character
100     #\# #\"
101     #'(lambda (s c1 c2)
102     (declare (ignore c2))
103     (unread-char c1 s)
104     `(lookup-resource ,(read s) nil))))
105    
106     (defun with-sharpquote-syntax ()
107     "To be used with the curly reader from arnesi: {with-sharpquote-reader (foo #\"locale-specific\") }"
108     (lambda (handler)
109     (%enable-sharpquote-reader)
110     `(progn ,@(funcall handler))))
111 sross 1.1
112    
113    
114 alendvai 1.5 (defgeneric localize (object)
115     (:documentation "Override this generic method for various data types. Return (values result foundp)."))
116 sross 1.1
117 alendvai 1.5 (defmethod localize ((str string))
118     (lookup-resource str nil))
119 sross 1.1
120 alendvai 1.5 (defmethod localize ((str symbol))
121     (lookup-resource str nil))

  ViewVC Help
Powered by ViewVC 1.1.5