/[cl-l10n]/cl-l10n/load-locale.lisp
ViewVC logotype

Diff of /cl-l10n/load-locale.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by sross, Wed Dec 1 11:48:40 2004 UTC revision 1.7 by sross, Thu Dec 30 11:56:38 2004 UTC
# Line 9  Line 9 
9    (let ((name (aif (position #\. loc-name)    (let ((name (aif (position #\. loc-name)
10                     (subseq loc-name 0 it)                     (subseq loc-name 0 it)
11                     loc-name)))                     loc-name)))
12        (unless use-cache
13          ;; The local file might have changed so ...
14          (clear-getter-cache))
15      (acond ((and (not name) (not errorp)) nil)      (acond ((and (not name) (not errorp)) nil)
16             ((and use-cache (get-locale name)) it)             ((and use-cache (get-locale name)) it)
17             ((probe-file (merge-pathnames *locale-path* name))             ((probe-file (merge-pathnames *locale-path* name))
# Line 16  Line 19 
19             ((not errorp) (warn "Can't find locale ~A." name))             ((not errorp) (warn "Can't find locale ~A." name))
20             (errorp (locale-error "Can't find locale ~A." name)))))             (errorp (locale-error "Can't find locale ~A." name)))))
21    
22    (defvar *locale-type* 'locale)
23    
24    (defun locale-des->locale (loc)
25      (etypecase loc
26        (locale loc)
27        (string (locale loc))
28        (symbol (locale (string loc)))))
29    
30  (defun load-locale (name)  (defun load-locale (name)
31    (let ((path (merge-pathnames *locale-path* name)))    (let ((path (merge-pathnames *locale-path* name)))
32      (format t "~&;; Loading locale from ~A.~%" path)      (cl:format t "~&;; Loading locale from ~A.~%" path)
33      (let ((locale (make-instance 'locale :name name))      (let ((locale (make-instance *locale-type* :name name))
34            (*read-eval* nil)            (*read-eval* nil)
35            (*print-circle* nil))            (*print-circle* nil))
36        (with-open-file (stream path        (with-open-file (stream path
# Line 30  Line 41 
41              (awhen (make-category locale it (parse-category it stream              (awhen (make-category locale it (parse-category it stream
42                                                              escape comment))                                                              escape comment))
43                (setf (get-category (category-name it) locale) it)))))                (setf (get-category (category-name it) locale) it)))))
44          (add-printers locale)
45        (setf (get-locale name) locale))))        (setf (get-locale name) locale))))
46    
47  (defun load-all-locales (&optional (*locale-path* *locale-path*))  (defun load-all-locales (&optional (*locale-path* *locale-path*))
# Line 39  Line 51 
51          (handler-case (load-locale (pathname-name x))          (handler-case (load-locale (pathname-name x))
52            (locale-error (c) (warn "Unable to load locale ~A. ~%~A." x c)))))))            (locale-error (c) (warn "Unable to load locale ~A. ~%~A." x c)))))))
53    
54    
55    (defun create-number-fmt-string (locale no-ts)
56      (cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}" (schar (locale-thousands-sep locale) 0)
57                 (locale-grouping locale)
58                 (if no-ts "D" ":D")))
59    
60    (defun get-descriptors (minusp locale)
61      (if minusp
62          (values (locale-n-sep-by-space locale)
63                  (= 1 (locale-n-cs-precedes locale))
64                  (locale-n-sign-posn locale)
65                  (locale-negative-sign locale))
66          (values (locale-p-sep-by-space locale)
67                  (= 1 (locale-p-cs-precedes locale))
68                  (locale-p-sign-posn locale)
69                  (locale-positive-sign locale))))
70    
71    (defun create-money-fmt-string (locale no-ts minusp)
72      (multiple-value-bind (sep-by-space prec spos sign)
73          (get-descriptors minusp locale)
74        (let ((sym-sep (if (zerop sep-by-space) "" " ")))
75          (with-output-to-string (stream)
76            ;; sign and sign separator
77            (when (or* (= spos 0 1 3))
78              (princ (if (zerop spos) "(" sign) stream)
79              (when (= 2 sep-by-space)
80                (princ #\Space stream)))
81            ;; Sym and seperator
82            (princ "~A" stream)
83            (when prec
84              (princ sym-sep stream))
85            ;; Actual number
86            (cl:format stream "~~,,'~A,~A~A~~{~~A~~}"
87                       (schar (locale-mon-thousands-sep locale) 0)
88                       (locale-mon-grouping locale)
89                       (if no-ts "D" ":D"))
90            (unless prec
91              (princ sym-sep stream))
92            (princ "~A" stream)
93            (when (or* (= spos 0 2 4))
94              (when (= 2 sep-by-space)
95                (princ #\Space stream))
96              (princ (if (zerop spos) ")" sign) stream))))))
97    
98    (defun add-printers (locale)
99      (setf (printers locale)
100            (nconc (list :number-no-ts
101                         (create-number-fmt-string locale t))
102                   (list :number-ts
103                         (create-number-fmt-string locale nil))
104                   (list :money-p-no-ts
105                         (create-money-fmt-string locale t nil))
106                   (list :money-p-ts
107                         (create-money-fmt-string locale nil nil))
108                   (list :money-n-no-ts
109                         (create-money-fmt-string locale t t))
110                   (list :money-n-ts
111                         (create-money-fmt-string locale nil t))
112                   (printers locale))))
113    
114    
115  (defvar *category-loaders*  (defvar *category-loaders*
116    '(("LC_IDENTIFICATION" . load-identification)    '(("LC_IDENTIFICATION" . load-identification)
117      ("LC_MONETARY" . load-category)      ("LC_MONETARY" . load-category)
# Line 61  Line 134 
134  (defun load-category (locale name vals)  (defun load-category (locale name vals)
135    (declare (ignore locale))    (declare (ignore locale))
136    (let ((cat (make-instance 'category :name name)))    (let ((cat (make-instance 'category :name name)))
137      (typecase vals      (etypecase vals
138        (category vals)        (category vals)
139        (t (dolist (x vals)        (cons (dolist (x vals)
140             (setf (get-cat-val (car x) cat) (cdr x)))                (setf (get-cat-val (car x) cat) (cdr x)))
141           cat))))              cat))))
142    
143  (defvar *id-vals*  (defvar *id-vals*
144    '(("title" . title)    '(("title" . title)
# Line 165  Line 238 
238                     :everything)                     :everything)
239                    #\>))                    #\>))
240    
241    (defvar *match-scanner* (cl-ppcre:create-scanner *regex*))
242    
243  (defun old-real-value (val)  (defun old-real-value (val)
244    (aif (all-matches-as-strings *regex* val)    (aif (all-matches-as-strings *match-scanner* val)
245         (map #-lispworks 'string #+lispworks         (map #-lispworks 'string #+lispworks
246              'lw:text-string #'real-character it)              'lw:text-string #'real-character it)
247         val))         val))
248    
249  ;; KLUDGE  ;; KLUDGE
250  (defun real-value (val)  (defun real-value (val)
251    (let ((val (old-real-value val)))    (remove #\" (old-real-value val)))
     (if (string= val "\"\"")  
         ""  
         val)))  
252    
253    
254    (defvar *split-scanner*
255      (cl-ppcre:create-scanner '(:char-class #\;)))
256    
257  (defun parse-value (val)  (defun parse-value (val)
258    (let ((all-vals (split '(:char-class #\;) val)))    (let ((all-vals (split *split-scanner* val)))
259      (if (singlep all-vals)      (if (singlep all-vals)
260          (real-value (car all-vals))          (real-value (car all-vals))
261          (mapcar #'real-value all-vals))))          (mapcar #'real-value all-vals))))
# Line 201  Line 276 
276    (loop for line = (read-line stream nil stream)    (loop for line = (read-line stream nil stream)
277          until (eq line stream) do          until (eq line stream) do
278      (if (and (> (length line) 3) (search "LC_" line :end2 3)      (if (and (> (length line) 3) (search "LC_" line :end2 3)
279               (not (some #'(lambda (x)               (notany #'(lambda (x)
280                              (search x line :test #'string=))                           (search x line :test #'string=))
281                          *ignore-categories*)))                       *ignore-categories*))
282          (return-from next-header line))))          (return-from next-header line))))
283    
284  (defun load-default-locale ()  (defun load-default-locale ()

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5