From sross at common-lisp.net Thu Apr 27 18:30:30 2006
From: sross at common-lisp.net (sross)
Date: Thu, 27 Apr 2006 14:30:30 -0400 (EDT)
Subject: [cl-l10n-cvs] CVS cl-l10n/doc
Message-ID: <20060427183030.A53793000E@common-lisp.net>
Update of /project/cl-l10n/cvsroot/cl-l10n/doc
In directory clnet:/tmp/cvs-serv9196/doc
Modified Files:
cl-l10n.texi
Added Files:
style.css gendocs_template gendocs.sh Makefile
Log Message:
* parse-number.lisp: Changed parse-error to extend parser-error
* parse-time.lisp: Changed uses of eq to eql when using numbers
or characters.
* printers.lisp: Default length fraction digits to 0 if it can't
be found in the current locale. Fixed printers of %R time format directive.
* load-locale.lisp: Search environment variable LANG before trying using
POSIX locale when loading default locale.
Add shadowing-format which shadows format and formatter into the current package.
* package.lisp: Export load-default-locale
* doc/cl-l10n.texi: Rename the Index node to Comprehensive Index in
order to avoid a name clash with index.html on platforms with
case-insensitive filesystems. Prettify the copyright notice.
* doc/Makefile, doc/style.css, doc/gendocs.sh, doc/gendocs_template, doc/style.css:
New files.
* load-locale.lisp (load-locale): Specify an explicit
external-format for CLISP
* test.lisp: Fix indentation of deftest forms.
(time.2): Obtain the o-with-diaeresis in a slightly more portable way.
--- /project/cl-l10n/cvsroot/cl-l10n/doc/cl-l10n.texi 2005/03/31 13:53:47 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/cl-l10n.texi 2006/04/27 18:30:30 1.8
@@ -10,32 +10,40 @@
@end direntry
@copying
-Copyright @copyright{} (c) (C) 2004 Sean Ross All rights reserved.
+Copyright @copyright{} 2004 Sean Ross All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
-1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
-3. The names of the authors and contributors may not be used to endorse
- or promote products derived from this software without specific prior
- written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS "AS IS" AND
-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS
-BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ at enumerate
+ at item
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+ at item
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+ at item
+The names of the authors and contributors may not be used to endorse
+or promote products derived from this software without specific prior
+written permission.
+ at end enumerate
+
+ at sc{This software is provided by the authors and contributors ``as is''
+and any express or implied warranties, including, but not limited to,
+the implied warranties of merchantability and fitness for a particular
+purpose are disclaimed. In no event shall the authors or contributors
+be liable for any direct, indirect, incidental, special, exemplary, or
+consequential damages (including, but not limited to, procurement of
+substitute goods or services; loss of use, data, or profits; or
+business interruption) however caused and on any theory of liability,
+whether in contract, strict liability, or tort (including negligence
+or otherwise) arising in any way out of the use of this software, even
+if advised of the possibility of such damage.}
+
@end copying
@c
@@ -63,7 +71,7 @@
* I18N: I18N
* Notes: Notes
* Credits: Credits
-* Index::
+* Comprehensive Index::
@end menu
@@ -632,7 +640,7 @@
@item Common-Lisp.net: For project hosting.
@end itemize
- at node Index
+ at node Comprehensive Index
@chapter Index
@section Function Index
--- /project/cl-l10n/cvsroot/cl-l10n/doc/style.css 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/style.css 2006/04/27 18:30:30 1.1
body {font-family: century schoolbook, serif;
line-height: 1.3;
padding-left: 5em; padding-right: 1em;
padding-bottom: 1em; max-width: 60em;}
table {border-collapse: collapse}
span.roman { font-family: century schoolbook, serif; font-weight: normal; }
h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif}
/*h4 {padding-top: 0.75em;}*/
dfn {font-family: inherit; font-variant: italic; font-weight: bolder }
kbd {font-family: monospace; text-decoration: underline}
/*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/
var {font-variant: slanted;}
td {padding-right: 1em; padding-left: 1em}
sub {font-size: smaller}
.node {padding: 0; margin: 0}
.lisp { font-family: monospace;
background-color: #F4F4F4; border: 1px solid #AAA;
padding-top: 0.5em; padding-bottom: 0.5em; }
/* coloring */
.lisp-bg { background-color: #F4F4F4 ; color: black; }
.lisp-bg:hover { background-color: #F4F4F4 ; color: black; }
.symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;}
a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; }
.special { font-weight: bold; color: #FF5000; background-color: inherit; }
.keyword { font-weight: bold; color: #770000; background-color: inherit; }
.comment { font-weight: normal; color: #007777; background-color: inherit; }
.string { font-weight: bold; color: #777777; background-color: inherit; }
.character { font-weight: bold; color: #0055AA; background-color: inherit; }
.syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; }
span.paren1 { font-weight: bold; color: #777777; }
span.paren1:hover { color: #777777; background-color: #BAFFFF; }
span.paren2 { color: #777777; }
span.paren2:hover { color: #777777; background-color: #FFCACA; }
span.paren3 { color: #777777; }
span.paren3:hover { color: #777777; background-color: #FFFFBA; }
span.paren4 { color: #777777; }
span.paren4:hover { color: #777777; background-color: #CACAFF; }
span.paren5 { color: #777777; }
span.paren5:hover { color: #777777; background-color: #CAFFCA; }
span.paren6 { color: #777777; }
span.paren6:hover { color: #777777; background-color: #FFBAFF; }
--- /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs_template 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs_template 2006/04/27 18:30:30 1.1
%%TITLE%%
%%TITLE%%
last updated %%DATE%%
This document is available in the following formats:
(This page was generated by the %%SCRIPTNAME%%
script.)
Return to CL-L10N's home page.
Copyright (C) 2004-2006 Sean Ross <sross at common-lisp.net>
Updated: %%DATE%%
--- /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs.sh 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/gendocs.sh 2006/04/27 18:30:30 1.1
#!/bin/sh
# gendocs.sh -- generate a GNU manual in many formats. This script is
# mentioned in maintain.texi. See the help message below for usage details.
# $Id: gendocs.sh,v 1.1 2006/04/27 18:30:30 sross Exp $
#
# Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
[289 lines skipped]
--- /project/cl-l10n/cvsroot/cl-l10n/doc/Makefile 2006/04/27 18:30:30 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/Makefile 2006/04/27 18:30:30 1.1
[304 lines skipped]
From sross at common-lisp.net Thu Apr 27 18:30:31 2006
From: sross at common-lisp.net (sross)
Date: Thu, 27 Apr 2006 14:30:31 -0400 (EDT)
Subject: [cl-l10n-cvs] CVS cl-l10n
Message-ID: <20060427183031.0E6E632006@common-lisp.net>
Update of /project/cl-l10n/cvsroot/cl-l10n
In directory clnet:/tmp/cvs-serv9196
Modified Files:
utils.lisp tests.lisp printers.lisp parse-time.lisp
parse-number.lisp package.lisp locale.lisp load-locale.lisp
i18n.lisp cl-l10n.asd ChangeLog
Added Files:
TODO
Log Message:
* parse-number.lisp: Changed parse-error to extend parser-error
* parse-time.lisp: Changed uses of eq to eql when using numbers
or characters.
* printers.lisp: Default length fraction digits to 0 if it can't
be found in the current locale. Fixed printers of %R time format directive.
* load-locale.lisp: Search environment variable LANG before trying using
POSIX locale when loading default locale.
Add shadowing-format which shadows format and formatter into the current package.
* package.lisp: Export load-default-locale
* doc/cl-l10n.texi: Rename the Index node to Comprehensive Index in
order to avoid a name clash with index.html on platforms with
case-insensitive filesystems. Prettify the copyright notice.
* doc/Makefile, doc/style.css, doc/gendocs.sh, doc/gendocs_template, doc/style.css:
New files.
* load-locale.lisp (load-locale): Specify an explicit
external-format for CLISP
* test.lisp: Fix indentation of deftest forms.
(time.2): Obtain the o-with-diaeresis in a slightly more portable way.
--- /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2005/05/18 15:34:08 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/utils.lisp 2006/04/27 18:30:30 1.8
@@ -182,4 +182,105 @@
(scale (* f 2) (* (expt float-radix (- e)) 2) 1 1)
(scale (* f float-radix 2)
(* (expt float-radix (- 1 e)) 2) float-radix 1))))))))
-;; EOF
\ No newline at end of file
+
+#+(or)
+(defun flonum-to-digits (v &optional position relativep)
+ (let ((print-base 10) ; B
+ (float-radix 2) ; b
+ (float-digits (float-digits v)) ; p
+ (digit-characters "0123456789")
+ (min-e
+ (etypecase v
+ (single-float single-float-min-e)
+ (double-float double-float-min-e))))
+ (multiple-value-bind (f e)
+ (integer-decode-float v)
+ (let (;; FIXME: these even tests assume normal IEEE rounding
+ ;; mode. I wonder if we should cater for non-normal?
+ (high-ok (evenp f))
+ (low-ok (evenp f))
+ (result (make-array 50 :element-type 'base-char
+ :fill-pointer 0 :adjustable t)))
+ (labels ((scale (r s m+ m-)
+ (do ((k 0 (1+ k))
+ (s s (* s print-base)))
+ ((not (or (> (+ r m+) s)
+ (and high-ok (= (+ r m+) s))))
+ (do ((k k (1- k))
+ (r r (* r print-base))
+ (m+ m+ (* m+ print-base))
+ (m- m- (* m- print-base)))
+ ((not (or (< (* (+ r m+) print-base) s)
+ (and (not high-ok)
+ (= (* (+ r m+) print-base) s))))
+ (values k (generate r s m+ m-)))))))
+ (generate (r s m+ m-)
+ (let (d tc1 tc2)
+ (tagbody
+ loop
+ (setf (values d r) (truncate (* r print-base) s))
+ (setf m+ (* m+ print-base))
+ (setf m- (* m- print-base))
+ (setf tc1 (or (< r m-) (and low-ok (= r m-))))
+ (setf tc2 (or (> (+ r m+) s)
+ (and high-ok (= (+ r m+) s))))
+ (when (or tc1 tc2)
+ (go end))
+ (vector-push-extend (char digit-characters d) result)
+ (go loop)
+ end
+ (let ((d (cond
+ ((and (not tc1) tc2) (1+ d))
+ ((and tc1 (not tc2)) d)
+ (t ; (and tc1 tc2)
+ (if (< (* r 2) s) d (1+ d))))))
+ (vector-push-extend (char digit-characters d) result)
+ (return-from generate result)))))
+ (initialize ()
+ (let (r s m+ m-)
+ (if (>= e 0)
+ (let* ((be (expt float-radix e))
+ (be1 (* be float-radix)))
+ (if (/= f (expt float-radix (1- float-digits)))
+ (setf r (* f be 2)
+ s 2
+ m+ be
+ m- be)
+ (setf r (* f be1 2)
+ s (* float-radix 2)
+ m+ be1
+ m- be)))
+ (if (or (= e min-e)
+ (/= f (expt float-radix (1- float-digits))))
+ (setf r (* f 2)
+ s (* (expt float-radix (- e)) 2)
+ m+ 1
+ m- 1)
+ (setf r (* f float-radix 2)
+ s (* (expt float-radix (- 1 e)) 2)
+ m+ float-radix
+ m- 1)))
+ (when position
+ (when relativep
+ (assert (> position 0))
+ (do ((k 0 (1+ k))
+ ;; running out of letters here
+ (l 1 (* l print-base)))
+ ((>= (* s l) (+ r m+))
+ ;; k is now \hat{k}
+ (if (< (+ r (* s (/ (expt print-base (- k position)) 2)))
+ (* s (expt print-base k)))
+ (setf position (- k position))
+ (setf position (- k position 1))))))
+ (let ((low (max m- (/ (* s (expt print-base position)) 2)))
+ (high (max m+ (/ (* s (expt print-base position)) 2))))
+ (when (<= m- low)
+ (setf m- low)
+ (setf low-ok t))
+ (when (<= m+ high)
+ (setf m+ high)
+ (setf high-ok t))))
+ (values r s m+ m-))))
+ (multiple-value-bind (r s m+ m-) (initialize)
+ (scale r s m+ m-)))))))
+;; EOF
--- /project/cl-l10n/cvsroot/cl-l10n/tests.lisp 2005/05/18 15:34:08 1.8
+++ /project/cl-l10n/cvsroot/cl-l10n/tests.lisp 2006/04/27 18:30:30 1.9
@@ -1,5 +1,6 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;; See the file LICENCE for licence information.
+
(defpackage :cl-l10n-tests
(:shadowing-import-from :cl-l10n format formatter)
(:use :cl :regression-test :cl-l10n))
@@ -7,97 +8,100 @@
(in-package :cl-l10n-tests)
(rem-all-tests)
-(deftest load-locs
- (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
+
+(deftest load-locs
+ (progn (locale "en_ZA") (locale "sv_SE") (locale "en_GB")
(locale "en_US") (locale "af_ZA") t)
- t)
+ t)
+;;; Format number tests
-;; Format number tests
(deftest number.1
- (format nil "~v:/cl-l10n:format-number/" "en_ZA" 1000)
- "1,000")
+ (format nil "~v:/cl-l10n:format-number/" "en_ZA" 1000)
+ "1,000")
(deftest number.2
- (format nil "~v:@/cl-l10n:format-number/" "en_ZA" 1000)
- "1000")
+ (format nil "~v:@/cl-l10n:format-number/" "en_ZA" 1000)
+ "1000")
(deftest number.3
- (format nil "~v/cl-l10n:format-number/" "en_ZA" 1000)
- "1,000.00")
+ (format nil "~v/cl-l10n:format-number/" "en_ZA" 1000)
+ "1,000.00")
(deftest number.4
- (format nil "~v/cl-l10n:format-number/" "sv_SE" 1000)
- "1 000,00")
+ (format nil "~v/cl-l10n:format-number/" "sv_SE" 1000)
+ "1 000,00")
(deftest number.5
- (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1000)
- "1 000")
+ (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1000)
+ "1 000")
(deftest number.6
- (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2)
- "0,50")
+ (format nil "~v:/cl-l10n:format-number/" "sv_SE" 1/2)
+ "0,50")
(deftest number.7
- (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0)
- "100.12312")
+ (format nil "~v:/cl-l10n:format-number/" "en_GB" 100.12312d0)
+ "100.12312")
+;;; Money tests
-;; Money tests
(deftest money.1
- (format nil "~v:/cl-l10n:format-money/" "en_ZA" 1000)
- "ZAR 1,000.00")
-
+ (format nil "~v:/cl-l10n:format-money/" "en_ZA" 1000)
+ "ZAR 1,000.00")
(deftest money.2
- (format nil "~v@/cl-l10n:format-money/" "en_ZA" 1000)
- "R1000.00")
+ (format nil "~v@/cl-l10n:format-money/" "en_ZA" 1000)
+ "R1000.00")
(deftest money.3
- (format nil "~v:@/cl-l10n:format-money/" "en_ZA" 1000)
- "ZAR 1000.00")
+ (format nil "~v:@/cl-l10n:format-money/" "en_ZA" 1000)
+ "ZAR 1000.00")
(deftest money.4
- (format nil "~v:/cl-l10n:format-money/" "sv_SE" 1000)
- "1 000,00 SEK")
-
+ (format nil "~v:/cl-l10n:format-money/" "sv_SE" 1000)
+ "1 000,00 SEK")
(deftest money.5
- (format nil "~v@/cl-l10n:format-money/" "sv_SE" 1000)
- "1000,00 kr")
+ (format nil "~v@/cl-l10n:format-money/" "sv_SE" 1000)
+ "1000,00 kr")
(deftest money.6
- (format nil "~v:@/cl-l10n:format-money/" "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil "~v:@/cl-l10n:format-money/" "sv_SE" 1000)
+ "1000,00 SEK")
+
+;;; Time tests
-;; Time tests
(deftest time.1
- (format nil "~v,,v:@/cl-l10n:format-time/" "en_ZA" 0 3091103120)
- "Sun 14 Dec 1997 15:45:20 +0000")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "en_ZA" 0 3091103120)
+ "Sun 14 Dec 1997 15:45:20 +0000")
+;;; FIXME
(deftest time.2
- (format nil "~v,,v:@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
- "s?n 14 dec 1997 15.45.20")
+ (format nil "~v,,v:@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
+ #.(format nil "s~Cn 14 dec 1997 15.45.20"
+ #+(or sb-unicode clisp) #\LATIN_SMALL_LETTER_O_WITH_DIAERESIS
+ #-(or sb-unicode clisp) (code-char #xF6)))
(deftest time.3
- (format nil "~v,,v/cl-l10n:format-time/" "en_US" 0 3091103120)
- "03:45:20 ")
+ (format nil "~v,,v/cl-l10n:format-time/" "en_US" 0 3091103120)
+ "03:45:20 ")
(deftest time.4
- (format nil "~v:/cl-l10n:format-time/" "en_US" 3091103120)
- "12/14/1997")
+ (format nil "~v:/cl-l10n:format-time/" "en_US" 3091103120)
+ "12/14/1997")
(deftest time.5
- (format nil "~v,,v@/cl-l10n:format-time/" "en_US" 0 3091103120)
- "15:45:20 ")
+ (format nil "~v,,v@/cl-l10n:format-time/" "en_US" 0 3091103120)
+ "15:45:20 ")
(deftest time.6
- (format nil "~v,,v@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
- "15.45.20")
+ (format nil "~v,,v@/cl-l10n:format-time/" "sv_SE" 0 3091103120)
+ "15.45.20")
(defmacro def-time-directive-test (name directive result)
`(deftest ,name (format nil "~v,v,vU" "en_ZA" ,directive 0 3320556360)
- ,result))
+ ,result))
(def-time-directive-test directive.1 "%%" "%")
(def-time-directive-test directive.2 "%a" "Wed")
@@ -132,10 +136,10 @@
(def-time-directive-test directive.31 "%t" " ")
(def-time-directive-test directive.32 "%T" "08:46:00")
(def-time-directive-test directive.33 "%u" "3")
-;(def-time-directive-test directive.34 "%U" "12")
-;(def-time-directive-test directive.35 "%V" "12")
+;;(def-time-directive-test directive.34 "%U" "12")
+;;(def-time-directive-test directive.35 "%V" "12")
(def-time-directive-test directive.36 "%w" "3")
-;(def-time-directive-test directive.37 "%W" "12")
+;;(def-time-directive-test directive.37 "%W" "12")
(def-time-directive-test directive.38 "%x" "23/03/2005")
(def-time-directive-test directive.39 "%X" "08:46:00")
(def-time-directive-test directive.40 "%y" "05")
@@ -143,9 +147,8 @@
(def-time-directive-test directive.42 "%z" "+0000")
(def-time-directive-test directive.43 "%Z" "+0000")
+;;; i18n tests
-
-;; i18n tests
(defvar *my-bundle* (make-instance 'bundle))
(add-resources (*my-bundle* "af_")
@@ -155,108 +158,110 @@
"howareyou" "How are you")
(deftest i18n.1
- (gettext "howareyou" *my-bundle* "en_ZA")
- "How are you")
+ (gettext "howareyou" *my-bundle* "en_ZA")
+ "How are you")
(deftest i18n.2
- (gettext "howareyou" *my-bundle* "af_ZA")
- "Hoe lyk it")
+ (gettext "howareyou" *my-bundle* "af_ZA")
+ "Hoe lyk it")
+
+;;; format
-;; format
(deftest format.1
- (format nil "~v,,v:@U" "en_ZA" -2 3091103120)
- "Sun 14 Dec 1997 17:45:20 +0200")
+ (format nil "~v,,v:@U" "en_ZA" -2 3091103120)
+ "Sun 14 Dec 1997 17:45:20 +0200")
(deftest format.2
- (format nil "~v:n" "en_ZA" 1000)
- "1,000")
+ (format nil "~v:n" "en_ZA" 1000)
+ "1,000")
(deftest format.3
- (format nil "~v:@m" "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil "~v:@m" "sv_SE" 1000)
+ "1000,00 SEK")
+
+;;; formatter
-;; formatter
(deftest formatter.1
- (format nil (formatter "~v,,v:@U") "en_ZA" -2 3091103120)
- "Sun 14 Dec 1997 17:45:20 +0200")
+ (format nil (formatter "~v,,v:@U") "en_ZA" -2 3091103120)
+ "Sun 14 Dec 1997 17:45:20 +0200")
(deftest formatter.2
- (format nil (formatter "~v:n") "en_ZA" 1000)
- "1,000")
+ (format nil (formatter "~v:n") "en_ZA" 1000)
+ "1,000")
(deftest formatter.3
- (format nil (formatter "~v:@m") "sv_SE" 1000)
- "1000,00 SEK")
+ (format nil (formatter "~v:@m") "sv_SE" 1000)
+ "1000,00 SEK")
+;;; parse-number
-;; parse-number
(deftest parse-number.1
- (parse-number (format nil "~vn" "af_ZA" -1001231.5) "af_ZA")
- -1001231.5)
+ (parse-number (format nil "~vn" "af_ZA" -1001231.5) "af_ZA")
+ -1001231.5)
(deftest parse-number.2
- (parse-number (format nil "~v@:n" "en_ZA" -1001231.5) "en_ZA")
- -1001231.5)
+ (parse-number (format nil "~v@:n" "en_ZA" -1001231.5) "en_ZA")
+ -1001231.5)
(deftest parse-number.3
- (parse-number (format nil "~v@:n" "sv_SE" -1001231.5) "sv_SE")
- -1001231.5)
+ (parse-number (format nil "~v@:n" "sv_SE" -1001231.5) "sv_SE")
+ -1001231.5)
+;;; parse-time
-;; parse-time
(deftest parse-time.1
- (let ((*locale* "en_ZA")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_ZA")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.2
- (let ((*locale* "sv_SE")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "sv_SE")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.3
- (let ((*locale* "en_US")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_US")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.4
- (let ((*locale* "en_GB")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:U~:* ~@U" time))))
- t)
+ (let ((*locale* "en_GB")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:U~:* ~@U" time))))
+ t)
(deftest parse-time.5
- (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
- 3258482400)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
+ 3258482400)
(deftest parse-time.6
- (parse-time "05/04/03" :default-zone -2 :locale "en_US")
- 3260988000)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_US")
+ 3260988000)
(deftest parse-time.7
- (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
- 3258482400)
+ (parse-time "05/04/03" :default-zone -2 :locale "en_ZA")
+ 3258482400)
(deftest parse-time.8
- (let ((*locale* "en_ZA")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "en_ZA")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
(deftest parse-time.9
- (let ((*locale* "en_US")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "en_US")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
(deftest parse-time.10
- (let ((*locale* "sv_SE")
- (time (get-universal-time)))
- (= time (parse-time (format nil "~:@U" time))))
- t)
+ (let ((*locale* "sv_SE")
+ (time (get-universal-time)))
+ (= time (parse-time (format nil "~:@U" time))))
+ t)
--- /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2005/05/25 09:30:51 1.16
+++ /project/cl-l10n/cvsroot/cl-l10n/printers.lisp 2006/04/27 18:30:30 1.17
@@ -62,9 +62,10 @@
(defun format-money (stream arg use-int-sym no-ts &optional (locale *locale*))
(let* ((locale (locale-des->locale locale))
- (frac-digits (if use-int-sym
- (locale-int-frac-digits locale)
- (locale-frac-digits locale)))
+ (frac-digits (max (if use-int-sym
+ (locale-int-frac-digits locale)
+ (locale-frac-digits locale))
+ 0))
(val-to-print (round-money (abs (coerce arg 'double-float))
frac-digits))
(float-part (float-part val-to-print))
@@ -113,9 +114,8 @@
#',name))))
(defun lookup-formatter (char)
- (aif (gethash char *time-formatters*)
- it
- (locale-error "No format directive for char ~S." char)))
+ (or (gethash char *time-formatters*)
+ (locale-error "No format directive for char ~S." char)))
(defun princ-pad-val (val stream &optional (pad "0") (size 2))
(declare (type stream stream) (optimize speed)
@@ -243,7 +243,7 @@
(print-time-string "%H:%M:%S %p" stream ut locale))
(def-formatter #\R
- (print-time-string "%H:%M" stream ut locale))
+ (print-time-string "%I:%M" stream ut locale))
(defvar *1970-01-01* (encode-universal-time 0 0 0 01 01 1970 0))
@@ -314,11 +314,11 @@
(def-formatter #\Z
(print-time-string "%z" stream ut locale))
-(defvar *time-zone* (nth-value 8 (get-decoded-time)))
+(defvar *time-zone*)
(defun format-time (stream ut show-date show-time &optional (locale *locale*) fmt time-zone)
(let ((locale (locale-des->locale (or locale *locale*)))
- (*time-zone* (or time-zone *time-zone*)))
+ (*time-zone* (or time-zone (nth-value 8 (decode-universal-time ut)))))
(print-time-string (or fmt (get-time-fmt-string locale
show-date show-time))
stream ut locale))
@@ -371,11 +371,14 @@
(string (parse-fmt-string fmt-cntrl)))
args))
-(defvar *scanner* (cl-ppcre:create-scanner "~[@v,:]*[m|u|n|M|U|N]"))
+(defun shadow-format (&optional (package *package*))
+ (shadowing-import '(cl-l10n::format cl-l10n::formatter) package))
+
+(defvar *scanner* (cl-ppcre:create-scanner "~[@V,:]*[M|U|N]"))
(defun needs-parsing (string)
(declare (optimize speed (safety 1) (debug 0)))
- (cl-ppcre:scan *scanner* string))
+ (cl-ppcre:scan *scanner* (string-upcase string)))
(defun parse-fmt-string (string)
(if (needs-parsing string)
--- /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2005/03/31 13:53:42 1.2
+++ /project/cl-l10n/cvsroot/cl-l10n/parse-time.lisp 2006/04/27 18:30:30 1.3
@@ -423,7 +423,7 @@
(do ((string-index start)
(next-negative nil)
(parts-list nil))
- ((eq string-index end) (nreverse parts-list))
+ ((eql string-index end) (nreverse parts-list))
(let ((next-char (char string string-index))
(prev-char (if (= string-index start)
nil
@@ -431,7 +431,7 @@
(cond ((alpha-char-p next-char)
;; Alphabetic character - scan to the end of the substring.
(do ((scan-index (1+ string-index) (1+ scan-index)))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(not (alpha-char-p (char string scan-index))))
(let ((match-symbol (match-substring
(subseq string string-index scan-index))))
@@ -444,7 +444,7 @@
(do ((scan-index string-index (1+ scan-index))
(numeric-value 0 (+ (* numeric-value radix)
(digit-char-p (char string scan-index) radix))))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(not (digit-char-p (char string scan-index) radix)))
;; If next-negative is t, set the numeric value to it's
;; opposite and reset next-negative to nil.
@@ -475,7 +475,7 @@
((char= next-char #\()
;; Parenthesized string - scan to the end and ignore it.
(do ((scan-index string-index (1+ scan-index)))
- ((or (eq scan-index end)
+ ((or (eql scan-index end)
(char= (char string scan-index) #\)))
(setf string-index (1+ scan-index)))))
(t
@@ -551,7 +551,7 @@
(defun deal-with-am-pm (form-value parsed-values)
(let ((hour (decoded-time-hour parsed-values)))
(cond ((eq form-value 'am)
- (cond ((eq hour 12)
+ (cond ((eql hour 12)
(setf (decoded-time-hour parsed-values) 0))
((not (<= 0 hour 12))
(if *error-on-mismatch*
--- /project/cl-l10n/cvsroot/cl-l10n/parse-number.lisp 2005/05/18 15:34:08 1.5
+++ /project/cl-l10n/cvsroot/cl-l10n/parse-number.lisp 2006/04/27 18:30:30 1.6
@@ -32,7 +32,7 @@
(in-package :cl-l10n)
-(define-condition parser-error (error)
+(define-condition parser-error (parse-error)
((value :reader value
:initarg :value
:initform nil)
--- /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2005/05/18 15:34:08 1.7
+++ /project/cl-l10n/cvsroot/cl-l10n/package.lisp 2006/04/27 18:30:30 1.8
@@ -7,11 +7,12 @@
(:shadow cl:format cl:formatter)
(:export #:locale-name #:category-name #:locale #:category #:locale-error
#:get-category #:get-cat-val #:locale-value #:load-all-locales
- #:*locale* #:*locale-path* #:*locales*
+ #:*locale* #:*locale-path* #:*locales* #:load-default-locale
#:format-number #:print-number #:format-money #:print-money
#:format-time #:print-time #:add-resources #:bundle
#:add-resource #:gettext #:parse-number #:*float-digits*
#:parse-time #:month #:day #:year #:hour #:minute #:second
- #:date-divider #:time-divider #:weekday #:noon-midn
- #:secondp #:am-pm #:zone #:parser-error))
-
+ #:date-divider #:time-divider #:weekday #:noon-midn #:shadow-format
+ #:secondp #:am-pm #:zone #:parser-error #:set-locale))
+
+
--- /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/03/20 09:13:58 1.11
+++ /project/cl-l10n/cvsroot/cl-l10n/locale.lisp 2006/04/27 18:30:30 1.12
@@ -7,6 +7,8 @@
;; Parsers (money)
;; locale aliases?
;; Optimizing print-time
+;; Handle _ and - in time directives (see date --help)
+;; Compile locales into fasl files.
(in-package :cl-l10n )
--- /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2005/05/25 09:30:51 1.14
+++ /project/cl-l10n/cvsroot/cl-l10n/load-locale.lisp 2006/04/27 18:30:30 1.15
@@ -5,7 +5,6 @@
(defparameter *ignore-categories*
(list "LC_CTYPE" "LC_COLLATE"))
-
;; Add a restart here?
(defun locale (loc-name &key (use-cache t) (errorp t) (loader nil))
"Find locale named by the string LOC-NAME. If USE-CACHE
@@ -43,12 +42,14 @@
(symbol (locale (string loc)))))
(defun load-locale (name)
- (let ((path (merge-pathnames *locale-path* name)))
+ (let ((path (merge-pathnames *locale-path* name))
+ (ef #+sbcl :iso-8859-1
+ #+clisp (ext:make-encoding :charset 'charset:iso-8859-1
+ :line-terminator :unix)
+ #-(or sbcl clisp) :default))
(cl:format *debug-io* "~&;; Loading locale from ~A.~%" path)
(let ((locale (make-instance *locale-type* :name name)))
- (with-open-file (stream path
- :external-format #+(and sbcl sb-unicode) :latin1
- #-(and sbcl sb-unicode) :default)
+ (with-open-file (stream path :external-format ef)
(multiple-value-bind (escape comment) (munge-headers stream)
(loop for header = (next-header stream)
while header do
@@ -83,7 +84,7 @@
(defun create-number-fmt-string (locale no-ts)
(cl:format nil "~~A~~,,'~A,~A~A~~{~~A~~}"
(thousands-sep-char (locale-thousands-sep locale))
- (locale-grouping locale)
+ (if (minusp (locale-grouping locale)) 3 (locale-grouping locale))
(if no-ts "D" ":D")))
(defun get-descriptors (minusp locale)
@@ -114,7 +115,7 @@
;; Actual number
(cl:format stream "~~,,'~A,~A~A~~{~~A~~}"
(thousands-sep-char (locale-mon-thousands-sep locale))
- (locale-mon-grouping locale)
+ (if (minusp (locale-mon-grouping locale)) 3 (locale-mon-grouping locale))
(if no-ts "D" ":D"))
(unless prec
(princ sym-sep stream))
@@ -313,9 +314,9 @@
with in-special = nil
with result = ()
with special-val = () do
- (cond ((eql char #\"))
+ (cond ((eql char #\") nil) ;;ignore
((eql char #\<) (setf in-special t))
- ((and in-special (eq char #\>))
+ ((and in-special (eql char #\>))
(push (code-char
(parse-integer (coerce (cdr (nreverse special-val)) 'string)
:radix 16))
@@ -358,14 +359,18 @@
*ignore-categories*))
(return-from next-header (trim line)))))
+(defun set-locale (locale-des)
+ (setf *locale* (locale-des->locale locale-des)))
+
(defun load-default-locale ()
(setf *locale* (get-default-locale)))
(defun get-default-locale ()
(or (locale (getenv "CL_LOCALE") :errorp nil)
(locale (getenv "LC_CTYPE") :errorp nil)
- (locale "POSIX")))
-
+ (locale (getenv "LANG") :errorp nil)
+ (locale "POSIX" :errorp nil)))
+(load-default-locale)
-;; EOF
\ No newline at end of file
+;; EOF
--- /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2005/05/18 15:34:08 1.3
+++ /project/cl-l10n/cvsroot/cl-l10n/i18n.lisp 2006/04/27 18:30:30 1.4
@@ -58,7 +58,7 @@
(locale-name *locale*)))
name)))))
-(defun gettext (name bundle &optional (loc *locale* ))
+(defun gettext (name bundle &optional (loc *locale*))
(let ((*locale* (locale-des->locale loc)))
(or (cdr (lookup-name bundle name))
name)))
--- /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2005/05/18 15:34:08 1.14
+++ /project/cl-l10n/cvsroot/cl-l10n/cl-l10n.asd 2006/04/27 18:30:30 1.15
@@ -9,9 +9,9 @@
(defsystem cl-l10n
:name "CL-L10N"
- :author "Sean Ross "
- :maintainer "Sean Ross "
- :version "0.3.4"
+ :author "Sean Ross "
+ :maintainer "Sean Ross "
+ :version "0.3.10"
:description "Portable CL Locale Support"
:long-description "Portable CL Package to support localization"
:licence "MIT"
@@ -27,7 +27,6 @@
:depends-on (:cl-ppcre :cl-fad))
(defmethod perform :after ((o load-op) (c (eql (find-system :cl-l10n))))
- (funcall (find-symbol "LOAD-DEFAULT-LOCALE" "CL-L10N"))
(provide 'cl-l10n))
--- /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2006/03/20 09:13:57 1.19
+++ /project/cl-l10n/cvsroot/cl-l10n/ChangeLog 2006/04/27 18:30:30 1.20
@@ -1,3 +1,27 @@
+2006-04-27 Sean Ross
+ * parse-number.lisp: Changed parse-error to extend parser-error
+ * parse-time.lisp: Changed uses of eq to eql when using numbers
+ or characters.
+ * printers.lisp: Default length fraction digits to 0 if it can't
+ be found in the current locale. Fixed printers of %R time format directive.
+ * load-locale.lisp: Search environment variable LANG before trying using
+ POSIX locale when loading default locale.
+ Add shadowing-format which shadows format and formatter into the current package.
+ * package.lisp: Export load-default-locale
+
+2006-04-15 Lu??s Oliveira
+ * doc/cl-l10n.texi: Rename the Index node to Comprehensive Index in
+ order to avoid a name clash with index.html on platforms with
+ case-insensitive filesystems. Prettify the copyright notice.
+ * doc/Makefile, doc/style.css, doc/gendocs.sh, doc/gendocs_template, doc/style.css:
+ New files.
+
+2006-04-15 Lu??s Oliveira
+ * load-locale.lisp (load-locale): Specify an explicit
+ external-format for CLISP
+ * test.lisp: Fix indentation of deftest forms.
+ (time.2): Obtain the o-with-diaeresis in a slightly more portable way.
+
2006-03-20 Sean Ross
* locale.lisp: Changed definition of *locale-path* to use
asdf:component-pathname of cl-l10n rather than the load path.
--- /project/cl-l10n/cvsroot/cl-l10n/TODO 2006/04/27 18:30:31 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/TODO 2006/04/27 18:30:31 1.1
use LC_COLLATE to define locale-uppercase and friends
Test on windows.
Parsers (money)
locale aliases?
Optimizing print-time
Handle _ and - in time directives (see date --help)
Compile locales directly into fasl files.
From sross at common-lisp.net Thu Apr 27 18:37:35 2006
From: sross at common-lisp.net (sross)
Date: Thu, 27 Apr 2006 14:37:35 -0400 (EDT)
Subject: [cl-l10n-cvs] CVS cl-l10n/doc
Message-ID: <20060427183735.6897C5C120@common-lisp.net>
Update of /project/cl-l10n/cvsroot/cl-l10n/doc
In directory clnet:/tmp/cvs-serv9576/doc
Added Files:
.cvsignore
Log Message:
--- /project/cl-l10n/cvsroot/cl-l10n/doc/.cvsignore 2006/04/27 18:37:35 NONE
+++ /project/cl-l10n/cvsroot/cl-l10n/doc/.cvsignore 2006/04/27 18:37:35 1.1
cl-l10n.aux
cl-l10n.cp
cl-l10n.fn
cl-l10n.fns
cl-l10n.info
cl-l10n.ky
cl-l10n.log
cl-l10n.pg
cl-l10n.toc
cl-l10n.tp
cl-l10n.tps
cl-l10n.vr
cl-l10n.vrs
manual