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

Contents of /cl-l10n/i18n.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (hide annotations)
Tue Jan 4 15:32:15 2005 UTC (9 years, 3 months ago) by sross
Branch: MAIN
Changes since 1.1: +2 -0 lines
Changelog 2005-01-04
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    
6     ;; (defparameter bundle (make-instance 'bundle))
7    
8     ;; (add-resources (bundle "af_")
9     ;; "showtime" "Danke, die tyd is ~:@/cl-l10n:format-time/~%")
10    
11     ;; ;; an empty string as the locale matcher becomes the default
12     ;; (add-resources (bundle "")
13     ;; "showtime" "Thanks, the time is ~:@/cl-l10n:format-time/~%")
14    
15     ;; (set-dispatch-macro-character
16     ;; #\# #\"
17     ;; #'(lambda (s c1 c2)
18     ;; (declare (ignore c2))
19     ;; (unread-char c1 s)
20     ;; `(cl-l10n:gettext ,(read s) bundle)))
21    
22     ;; or this (probably a bad idea)
23    
24     ;; (defvar *orig-string-char*
25     ;; (get-macro-character #\"))
26     ;; (set-macro-character #\"
27     ;; #'(lambda (s c1)
28     ;; `(cl-l10n:gettext ,(funcall *orig-string-char* s c1) bundle)))
29    
30     ;; or this
31     ;; (defmacro _ (text)
32     ;; `(cl-l10n:gettext ,text bundle))
33    
34     ;; (defun timey ()
35     ;; (format t #"showtime" (get-universal-time)))
36    
37     (defclass bundle ()
38     ((resources :accessor resources :initform (make-hash-table :test #'equal))))
39    
40     (defgeneric add-resource (bundle from to lang))
41     (defmethod add-resource (bundle from to lang)
42     (aif (assoc lang (gethash from (resources bundle)) :test #'equal)
43     (setf (cdr it) to)
44     (pushnew (cons lang to) (gethash from (resources bundle))
45     :test #'equal))
46     t)
47    
48     (defmacro add-resources ((bundle loc-name) &body args)
49     (with-gensyms (gloc gbundle)
50     `(let ((,gloc ,loc-name) (,gbundle ,bundle))
51     ,@(mapcar #'(lambda (x) `(add-resource ,gbundle ,@x ,gloc))
52     (group args 2)))))
53    
54     (defgeneric get-name (bundle name)
55     (:method ((bundle t) (name t))
56     (gethash name (resources bundle))))
57    
58     (defgeneric lookup-name (bundle name)
59     (:method ((bundle t) (name t))
60     (awhen (get-name bundle name)
61 sross 1.2 ;; The match with the longest name is the most
62     ;; specific key.
63 sross 1.1 (winner #'>
64     (compose #'length #'car)
65     (remove-if-not #'(lambda (x)
66     (search (car x)
67     (locale-name *locale*)))
68     it)))))
69    
70     (defun gettext (name bundle &optional (loc *locale* ))
71     (let ((*locale* (locale-des->locale loc)))
72     (or (cdr (lookup-name bundle name))
73     name)))
74    
75    
76    
77    
78     ;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5