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

Contents of /cl-l10n/i18n.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Wed Dec 1 11:52:35 2004 UTC (9 years, 4 months ago) by sross
Branch: MAIN
Changelog 2004-12-01
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 (winner #'>
62 (compose #'length #'car)
63 (remove-if-not #'(lambda (x)
64 (search (car x)
65 (locale-name *locale*)))
66 it)))))
67
68 (defun gettext (name bundle &optional (loc *locale* ))
69 (let ((*locale* (locale-des->locale loc)))
70 (or (cdr (lookup-name bundle name))
71 name)))
72
73
74
75
76 ;; EOF

  ViewVC Help
Powered by ViewVC 1.1.5