/[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.11 by sross, Thu Mar 24 14:47:01 2005 UTC revision 1.12 by sross, Thu Mar 31 13:53:42 2005 UTC
# Line 60  actual locale object." Line 60  actual locale object."
60                                                              escape comment))                                                              escape comment))
61                (setf (get-category locale (category-name it)) it)))))                (setf (get-category locale (category-name it)) it)))))
62        (add-printers locale)        (add-printers locale)
63          (add-parsers locale)
64        locale)))        locale)))
65    
66  (defun load-all-locales (&optional (path *locale-path*))  (defun load-all-locales (&optional (path *locale-path*))
# Line 140  actual locale object." Line 141  actual locale object."
141                       (create-money-fmt-string locale nil t))                       (create-money-fmt-string locale nil t))
142                 (printers locale))))                 (printers locale))))
143    
144    (defun day-element-p (x)
145      (member x '(#\d #\e)))
146    
147    (defun month-element-p (x)
148      (char= x #\m))
149    
150    (defun year-element-p (x)
151      (member x '(#\y #\Y)))
152    
153    (defun element-type (char)
154      (cond ((day-element-p char) 'day)
155            ((month-element-p char) 'month)
156            ((year-element-p char) 'year)))
157    
158    (defvar date-dividers '(#\\ #\/ #\-))
159    
160    ;; FIXME
161    ;; this effort definitely doesn't cover
162    ;; every single case but it will do for now.
163    (defun locale-date-month-order (locale)
164      (let ((fmt (locale-d-fmt locale)))
165        (cond ((string= fmt "%D") '(month day year))
166              ((string= fmt "%F") '(year month day))
167              (t (compute-order fmt)))))
168    
169    (defun compute-order (fmt)
170      (let ((res nil))
171        (loop for char across fmt
172              with perc = nil do
173              (cond ((char= char #\%) (setf perc (not perc)))
174                    ((member char date-dividers) nil)
175                    (perc (let ((val (element-type char)))
176                            (when val (push val res))
177                            (setf perc nil)))))
178        (nreverse res)))
179    
180    
181    (defun add-parsers (locale)
182      (destructuring-bind (first second third)
183          (locale-date-month-order locale)
184        (setf (parsers locale)
185              (list `((noon-midn) (weekday) ,first (date-divider) ,second (date-divider) ,third (noon-midn))
186                    `((weekday) ,first (date-divider) ,second (date-divider) ,third hour (time-divider) minute
187                      (time-divider) (secondp) (am-pm) (date-divider) (zone))
188                    `(hour (time-divider) minute (time-divider) (secondp) (am-pm) (weekday) ,first (date-divider)
189                           (secondp) (date-divider) ,third (date-divider) (zone))))))
190    
191  (defvar *category-loaders*  (defvar *category-loaders*
192    '(("LC_IDENTIFICATION" . load-identification)    '(("LC_IDENTIFICATION" . load-identification)
193      ("LC_MONETARY" . load-category)      ("LC_MONETARY" . load-category)
# Line 308  actual locale object." Line 356  actual locale object."
356               (notany #'(lambda (x)               (notany #'(lambda (x)
357                           (search x line :test #'string=))                           (search x line :test #'string=))
358                       *ignore-categories*))                       *ignore-categories*))
359          (return-from next-header line))))          (return-from next-header (trim line)))))
360    
361  (defun load-default-locale ()  (defun load-default-locale ()
362    (setf *locale* (get-default-locale)))    (setf *locale* (get-default-locale)))

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

  ViewVC Help
Powered by ViewVC 1.1.5