Changeset 12791 in project


Ignore:
Timestamp:
12/08/08 07:05:17 (12 years ago)
Author:
Kon Lovett
Message:

Save.

Location:
release/3/locale/trunk
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • release/3/locale/trunk/locale-components.scm

    r8924 r12791  
    44;; ISSUES
    55;;
    6 ;; - components predicates are not fool-proof
     6;; - Components predicates are not fool-proof.
    77;;
    8 ;; - used selectors for *-components since it is assumed extra elements will be needed by
    9 ;; platform specific code. may switch to records later & deprecate the existing interface
     8;; - Used selectors for *-components since it is assumed extra elements will be needed by
     9;; platform specific code. May switch to records later & deprecate the existing interface.
    1010
    1111(use srfi-1)
     
    4646
    4747;;
     48
    4849(define (component-ref al what . def)
    4950        (let ([p (assq what al)])
     
    5253        (optional def #f) ) ) )
    5354
    54 ;; components argument cannot be null to effect in-place modification.
     55;; Components argument cannot be null to effect in-place modification.
    5556
    5657(define (set-component! al what value)
    5758        (let ([p (assq what al)])
    58                 (cond (p (set-cdr! p value))
    59           ((null? al) (set! al (alist-cons what value al)))
    60           (else (set-cdr! (last-pair al) (list (cons what value)))))
    61                 al) )
     59                (cond (p
     60                        (set-cdr! p value))
     61          ((null? al)
     62            (set! al (alist-cons what value al)))
     63          (else
     64            (set-cdr! (last-pair al) (list (cons what value)))))
     65                al ) )
    6266
    6367;;;
    6468
    6569;;
     70
    6671(define (timezone-dst-rule-julian-noleap? r)
    6772        (let ([d (car r)])
    68                 (and (= (length d) 2) (= (car d) 1))))
     73                (and (= 2 (length d)) (= 1 (car d))) ) )
    6974
    7075;;
     76
    7177(define (timezone-dst-rule-julian-leap? r)
    7278        (let ([d (car r)])
    73                 (and (= (length d) 2) (= (car d) 0))))
     79                (and (= 2 (length d)) (= 0 (car d))) ) )
    7480
    7581;;
     82
    7683(define (timezone-dst-rule-mwd? r)
    7784        (let ([d (car r)])
    78                 (= (length d) 3)))
     85                (= 3 (length d)) ) )
    7986
    8087;;
     88
    8189(define (timezone-dst-rule-julian r)
    82         (cadr (car r)))
     90        (cadar r) )
    8391
    8492;;
     93
    8594(define (timezone-dst-rule-month r)
    86         (car (car r)))
     95        (caar r) )
    8796
    8897;;
     98
    8999(define (timezone-dst-rule-week r)
    90         (cadr (car r)))
     100        (cadar r) )
    91101
    92102;;
     103
    93104(define (timezone-dst-rule-day r)
    94         (caddr (car r)))
     105        (caddar r) )
    95106
    96107;;
     108
    97109(define (timezone-dst-rule-offset r)
    98         (cdr r))
     110        (cdr r) )
    99111
    100112;;
     113
    101114(define (make-timezone-dst-rule-julian-noleap j o)
    102         (cons (list 1 j) o))
     115        (cons (list 1 j) o) )
    103116
    104117;;
     118
    105119(define (make-timezone-dst-rule-julian-leap j o)
    106         (cons (list 0 j) o))
     120        (cons (list 0 j) o) )
    107121
    108122;;
     123
    109124(define (make-timezone-dst-rule-mwd m w d o)
    110         (cons (list m w d) o))
     125        (cons (list m w d) o) )
    111126
    112127;;
     128;FIXME not a viable test
     129
    113130(define (timezone-components? tz)
    114         (pair? tz))
     131        (pair? tz) )
    115132
    116133;;
     134
    117135(define (timezone-component-ref tz what . def)
    118         (apply component-ref tz what def))
     136        (apply component-ref tz what def) )
    119137
    120138;; timezone-components argument cannot be null to effect in-place modification.
    121139
    122140(define (set-timezone-component! tz what value)
    123         (set-component! tz what value))
     141        (set-component! tz what value) )
    124142
    125143(define (empty-timezone-components)
    126         '())
     144        '() )
    127145
    128146;;
     147
    129148(define (make-timezone-components . r)
    130149        (let loop ([tz (empty-timezone-components)] [key-val-lst r])
    131150                (if (null? key-val-lst)
    132151        tz
    133         (loop (set-timezone-component! tz (car key-val-lst) (cadr key-val-lst))
    134               (cddr key-val-lst)))))
     152        (loop (set-timezone-component! tz (car key-val-lst) (cadr key-val-lst)) (cddr key-val-lst)) ) ) )
    135153
    136154(define (unknown-timezone-components s)
    137         (set-timezone-component! (empty-timezone-components) 'name s))
     155        (set-timezone-component! (empty-timezone-components) 'name s) )
    138156
    139157(define (default-timezone-components)
     
    141159                (set-timezone-component! tz 'std-name "UTC")
    142160                (set-timezone-component! tz 'std-offset 0)
    143                 tz))
     161                tz ) )
    144162
    145163;;;
    146164
    147165;;
    148 (define (locale-components? lc)
    149         (pair? lc))
     166
     167(define (locale-components? obj)
     168        (pair? obj) )
    150169
    151170;;
     171
    152172(define (locale-component-ref lc what . def)
    153         (apply component-ref lc what def))
     173        (apply component-ref lc what def) )
    154174
    155175;; locale-components argument cannot be null to effect in-place modification.
    156176
    157177(define (set-locale-component! lc what value)
    158         (set-component! lc what value))
     178        (set-component! lc what value) )
    159179
    160180;;
     181
    161182(define (empty-locale-components)
    162         '())
     183        '() )
    163184
    164185;;
     186
    165187(define (make-locale-components . r)
    166188        (let loop ([lc (empty-locale-components)] [key-val-lst r])
    167189                (if (null? key-val-lst)
    168190        lc
    169         (loop (set-locale-component! lc (car key-val-lst) (cadr key-val-lst))
    170               (cddr key-val-lst)))))
     191        (loop (set-locale-component! lc (car key-val-lst) (cadr key-val-lst)) (cddr key-val-lst)) ) ) )
    171192
    172193(define (unknown-locale-components s)
    173         (set-locale-component! (empty-locale-components) 'name s))
     194        (set-locale-component! (empty-locale-components) 'name s) )
    174195
    175196(define (default-locale-components)
    176         (unknown-locale-components ""))
     197        (unknown-locale-components "") )
  • release/3/locale/trunk/locale-eggdoc.scm

    r8925 r12791  
    3939
    4040                (documentation
    41                         (p "locale is a set of routines supporting locale query operations.
    42                         The environment locale information is queried upon module load and the
    43                         corresponding parameters are set.")
    44 
    45                         (p "NOTE: This is a work in progress. Currently only the Posix locale
    46                         information is supported. Plans are to support the native MacOS X and Windows locale
    47                         APIs. Changes to this API are almost certain.")
     41                        (p "locale is a set of routines supporting locale query operations. "
     42                        "The environment locale information is queried upon module load and the "
     43                        "corresponding parameters are set.")
     44
     45                        (p "NOTE: This is a work in progress. Currently only the Posix locale "
     46                        "information is supported. Plans are to support the native MacOS X and Windows locale "
     47                        "APIs. Changes to this API are almost certain.")
     48
     49      (subsection "Locale Components"
     50
     51        (p "The major data structure is the " (code "locale-components") " type, "
     52        "portrayed as an extensible " (tt "key+value") " pairing. The " (tt "key") " "
     53        "is a (code "symbol") ". The " (tt "value") " is usually a " (code "string") ".")
     54
     55        (p "A " (code "locale-components") " object will have more properties but the "
     56        "following are provided for every instance:")
     57                          (symbol-table "Common Component Keys"
     58          (describe name "The composite information object, source specific.")
     59          (describe source "The origin for the information.") )
     60
     61        (p "The " (code "source") " property is one of the following (others are possible):")
     62                          (symbol-table "Source Values"
     63          (describe PLATFORM "Information from the system.")
     64          (describe POSIX "Information from POSIX environment. The \"name\" is a string.")
     65          (describe BUILTIN "Information from system defaults.") )
     66
     67        (p "The " (code "PLATFORM") " is queried for information first. Then the "
     68        (code "POSIX") " source is attempted. When all have failed the " (code "BUILTIN") " "
     69        "source is used. The point being locale information will be available, but "
     70        "without an accuracy guarantee.")
     71
     72        (p "The " (code "BUILTIN") " source creates a POSIX-style string \"name\" "
     73        "constructed using constants and library procedures.")
     74      )
     75
     76      (subsection "Generic Locale Components Property Access"
     77
     78        (procedure "(locale-components? OBJECT)"
     79          (p "Is the " (tt "OBJECT") " a " (code "locale-compenents") " object?") )
     80
     81        (procedure "(locale-component-ref LOCALE-COMPONENTS KEY [DEFAULT #f])"
     82          (p "Returns the " (tt "KEY") " property of " (tt "LOCALE-COMPONENTS") " "
     83          "or the " (tt "DEFAULT") " when not found.") )
     84
     85        (procedure "(set-locale-component! LOCALE-COMPONENTS KEY VALUE)"
     86          (p "Updates or creates the " (tt "KEY") " property of " (tt "LOCALE-COMPONENTS") " "
     87          "with the " (tt "VALUE") ".") )
     88      )
    4889
    4990                        (subsection "Timezone"
    5091
    51                                 (p "Access to local timezone information. A timezone object is composed of a
    52                                 Standard Time Name and Offset, and an optional Summer or Daylight Savings
    53                                 Time Name and Offset. The offset is seconds west (positive) or east (negative)
    54                                 of UTC. The name is some locally accepted timezone name, such as PST. A
    55                                 Daylight Savings Time start rule and end rule are optional components.")
    56 
    57                                 (p "Timezone component selectors are 'std-name, 'std-offset, 'dst-name, 'dst-offset,
    58                                 'dst-start, 'dst-end.")
     92                                (p "Access to timezone information. A timezone object is a " (code "locale-components") " "
     93                                "object with properties for Standard Time Name and Offset, and an optional Summer or "
     94                                "Daylight Saving Time Name and Offset. The offset is seconds west (positive) or east "
     95                                "(negative) of UTC. The name is some locally accepted timezone name, such as \"PST\". A "
     96                                "Daylight Saving Time start rule and end rule are optional properties.")
     97
     98                          (symbol-table "Timezone Component Properties"
     99          (describe std-name "The normal timezone name.")
     100          (describe std-offset "")
     101          (describe dst-name "The Daylight Saving Time timezone name")
     102          (describe dst-offset "")
     103          (describe dst-start "")
     104          (describe dst-end "") )
    59105
    60106                                (group
    61107                                        (parameter "(current-timezone [VALUE])"
    62                                                 (p "The currently defined timezone. The specified " (tt "VALUE")
    63                                                 " is either a timezone string value, or #f, indicating no timezone. When
    64                                                 no timezone value is set the default timezone is UTC.")
    65                                         )
     108                                                (p "The currently defined timezone. The specified " (tt "VALUE") " "
     109                                                "is either a timezone string value, or #f, indicating no timezone. When "
     110                                                "no timezone value is set the default timezone is UTC.") )
    66111
    67112                                        (procedure "(current-timezone-components)"
    68                                                 (p "Returns the timezone-components object corresponding to the current-timezone.")
    69                                         )
     113                                                (p "Returns the timezone-components object corresponding to the current-timezone.") )
    70114
    71115                                        (procedure "(timezone-components? TIMEZONE-COMPONENTS)"
    72                                                 (p "Is the specified " (tt "TIMEZONE-COMPONENTS") " object actually a
    73                                                 timezone-components object?")
    74                                         )
    75 
    76                                         (procedure "(timezone-component-ref TIMEZONE-COMPONENTS SELECTOR [DEFAULT #f])"
    77                                                 (p "Returns the timezone-component " (tt "SELECTOR") " of the "
    78                                                 (tt "TIMEZONE-COMPONENTS") " object, or the " (tt "DEFAULT") " for a
    79                                                 missing component.")
    80                                         )
    81 
    82                                         (procedure "(set-timezone-component! TIMEZONE-COMPONENTS SELECTOR VALUE)"
    83                                                 (p "Sets the timezone-component " (tt "SELECTOR") " of the "
    84                                                 (tt "TIMEZONE-COMPONENTS") " object to " (tt "VALUE") ".")
    85                                         )
     116                                                (p "Is the specified " (tt "TIMEZONE-COMPONENTS") " object actually a "
     117                                                "timezone-components object?") )
     118
     119                                        (procedure "(timezone-component-ref TIMEZONE-COMPONENTS KEY [DEFAULT #f])"
     120                                                (p "Returns the timezone-component " (tt "KEY") " of the "
     121                                                (tt "TIMEZONE-COMPONENTS") " object, or the " (tt "DEFAULT") " for a "
     122                                                "missing component.") )
     123
     124                                        (procedure "(set-timezone-component! TIMEZONE-COMPONENTS KEY VALUE)"
     125                                                (p "Sets the timezone-component " (tt "KEY") " of the "
     126                                                (tt "TIMEZONE-COMPONENTS") " object to " (tt "VALUE") ".") )
    86127
    87128                                        (procedure "(timezone-dst-rule-julian-noleap? TIMEZONE-RULE)"
    88                                                 (p "Is the specified " (tt "TIMEZONE-RULE") " object actually
    89                                                 a daylight saving time julian day without leap seconds object?")
    90                                         )
     129                                                (p "Is the specified " (tt "TIMEZONE-RULE") " object actually a "
     130                                                "daylight saving time julian day without leap seconds object?") )
    91131
    92132                                        (procedure "(timezone-dst-rule-julian-leap? TIMEZONE-RULE)"
    93                                                 (p "Is the specified " (tt "TIMEZONE-RULE") " object actually
    94                                                 a daylight saving time julian day assuming leap seconds object?")
    95                                         )
     133                                                (p "Is the specified " (tt "TIMEZONE-RULE") " object actually "
     134                                                "a daylight saving time julian day assuming leap seconds object?") )
    96135
    97136                                        (procedure "(timezone-dst-rule-mwd? TIMEZONE-RULE)"
    98                                                 (p "Is the specified " (tt "TIMEZONE-RULE") " object actually
    99                                                 a daylight saving time month.week.day object?")
    100                                         )
     137                                                (p "Is the specified " (tt "TIMEZONE-RULE") " object actually "
     138                                                "a daylight saving time month.week.day object?") )
    101139
    102140                                        (procedure "(timezone-dst-rule-offset TIMEZONE-RULE)"
    103141                                                (p "Returns the seconds within day offset component of the specified "
    104                                                 (tt "TIMEZONE-RULE") " object.")
    105                                         )
     142                                                (tt "TIMEZONE-RULE") " object.") )
    106143
    107144                                        (procedure "(timezone-dst-rule-julian TIMEZONE-RULE)"
    108145                                                (p "Returns the julian day component of the specified "
    109                                                 (tt "TIMEZONE-RULE") " object.")
    110                                         )
     146                                                (tt "TIMEZONE-RULE") " object.") )
    111147
    112148                                        (procedure "(timezone-dst-rule-month TIMEZONE-RULE)"
    113149                                                (p "Returns the month of year component of the specified "
    114                                                 (tt "TIMEZONE-RULE") " object.")
    115                                         )
     150                                                (tt "TIMEZONE-RULE") " object.") )
    116151
    117152                                        (procedure "(timezone-dst-rule-week TIMEZONE-RULE)"
    118153                                                (p "Returns the week of month component of the specified "
    119                                                 (tt "TIMEZONE-RULE") " object.")
    120                                         )
     154                                                (tt "TIMEZONE-RULE") " object.") )
    121155
    122156                                        (procedure "(timezone-dst-rule-day TIMEZONE-RULE)"
    123157                                                (p "Returns the day of week component of the specified "
    124                                                 (tt "TIMEZONE-RULE") " object.")
    125                                         )
     158                                                (tt "TIMEZONE-RULE") " object.") )
    126159
    127160                                        (procedure "(make-timezone-dst-rule-julian-leap JULIAN-DAY OFFSET)"
    128                                                 (p "Returns a daylight saving time julian day assuming leap seconds rule object.")
    129                                         )
     161                                                (p "Returns a daylight saving time julian day assuming leap seconds rule object.") )
    130162
    131163                                        (procedure "(make-timezone-dst-rule-julian-noleap JULIAN-DAY OFFSET)"
    132                                                 (p "Returns a daylight saving time julian day without leap seconds rule object.")
    133                                         )
     164                                                (p "Returns a daylight saving time julian day without leap seconds rule object.") )
    134165
    135166                                        (procedure "(make-timezone-dst-rule-mwd MONTH WEEK DAY OFFSET)"
    136                                                 (p "Returns a daylight saving time month.week.day rule object.")
    137                                         )
     167                                                (p "Returns a daylight saving time month.week.day rule object.") )
    138168
    139169                                        (procedure "(posix-timezone-value->timezone-components STRING [SOURCE \"POSIX\"])"
    140                                                 (p "Parses a POSIX timezone string specification, " (tt "STRING") ", and
    141                                                 returns the corresponding timezone-components object, or #f when a parse
    142                                                 error occurs. A #f or empty string value is mapped to the default timezone. The
    143                                                 optional " (tt "SOURCE") " indicates what locale system supplied the string.")
    144                                         )
     170                                                (p "Parses a POSIX timezone string specification, " (tt "STRING") ", and "
     171                                                "returns the corresponding timezone-components object, or #f when a parse "
     172                                                "error occurs. A #f or empty string value is mapped to the default timezone. The "
     173                                                "optional " (tt "SOURCE") " indicates what locale system supplied the string.") )
    145174
    146175                                        (procedure "(posix-load-timezone)"
    147                                                 (p "Initialize the current-timezone from the TZ environment variable.")
    148                                         )
     176                                                (p "Initialize the current-timezone from the TZ environment variable.") )
    149177                                )
    150178                        )
     
    152180                        (subsection "Locale"
    153181
    154                                 (p "Access to locale information. A locale object is composed of a
    155                                 Language, an optional Script, an optional Region, an optional Codeset, and an
    156                                 optional Modifier. The language should be an ISO 639-1 or ISO 639-2 name. The
    157                                 Script should be a RFC 3066bis name. The region should be an ISO 3166-1 name.
    158                                 The codeset and modifier forms are locale dependent.")
    159 
    160                                 (p "Locale component selectors are 'language, 'script, 'region, 'codeset, and 'modifier.")
     182                                (p "Access to locale information. A locale object is composed of a "
     183                                "Language, an optional Script, an optional Region, an optional Codeset, and an "
     184                                "optional Modifier. The language should be an ISO 639-1 or ISO 639-2 name. The "
     185                                "Script should be a RFC 3066bis name. The region should be an ISO 3166-1 name. "
     186                                "The codeset and modifier forms are locale dependent.")
     187
     188                                (symbol-table "Locale Properties"
     189                                  (describe language "ISO 639-1 or ISO 639-2 name string. Default \"en\".")
     190                                  (describe script "RFC 3066bis name string.")
     191                                  (describe region "ISO 3166-1 name string. Default \"US\".")
     192                                  (describe codeset "?")
     193                                  (describe modifier "?") )
    161194
    162195                                (group
    163196                                        (parameter "(current-locale [VALUE])"
    164                                                 (p "The currently defined locale. The specified " (tt "VALUE")
    165                                                 " is either a locale string value, or #f, indicating locale independence.
    166                                                 When no locale value is set the default locale is #f.")
    167                                         )
     197                                                (p "The currently defined locale. The specified " (tt "VALUE") " "
     198                                                "is either a locale string value, or #f, indicating locale independence. "
     199                                                "When no locale value is set the default locale is #f.") )
    168200
    169201                                        (procedure "(current-locale-components)"
    170                                                 (p "Returns the locale-components object corresponding to the current-locale.")
    171                                         )
     202                                                (p "Returns the locale-components object corresponding to the current-locale.") )
    172203
    173204                                        (procedure "(locale-components? LOCALE-COMPONENTS)"
    174                                                 (p "Is the specified " (tt "LOCALE-COMPONENTS") " object actually a
    175                                                 locale-components object?")
    176                                         )
    177 
    178                                         (procedure "(locale-component-ref LOCALE-COMPONENTS SELECTOR [DEFAULT #f])"
    179                                                 (p "Returns the locale-component " (tt "SELECTOR") " of the "
    180                                                 (tt "LOCALE-COMPONENTS") " object, or the " (tt "DEFAULT") " for a
    181                                                 missing component.")
    182                                         )
    183 
    184                                         (procedure "(set-locale-component! LOCALE-COMPONENTS SELECTOR VALUE)"
    185                                                 (p "Sets the locale-component " (tt "SELECTOR") " of the "
    186                                                 (tt "LOCALE-COMPONENTS") " object to " (tt "VALUE") ".")
    187                                         )
     205                                                (p "Is the specified " (tt "LOCALE-COMPONENTS") " object actually a "
     206                                                "locale-components object?") )
     207
     208                                        (procedure "(locale-component-ref LOCALE-COMPONENTS KEY [DEFAULT #f])"
     209                                                (p "Returns the locale-component " (tt "KEY") " of the "
     210                                                (tt "LOCALE-COMPONENTS") " object, or the " (tt "DEFAULT") " for a "
     211                                                "missing component.") )
     212
     213                                        (procedure "(set-locale-component! LOCALE-COMPONENTS KEY VALUE)"
     214                                                (p "Sets the locale-component " (tt "KEY") " of the "
     215                                                (tt "LOCALE-COMPONENTS") " object to " (tt "VALUE") ".") )
    188216
    189217                                        (procedure "(posix-locale-value->locale-components STRING [SOURCE \"POSIX\"])"
    190                                                 (p "Parses a POSIX locale string specification, " (tt "STRING") ", and
    191                                                 returns the corresponding locale-components object, or #f when a parse
    192                                                 error occurs. A #f or empty string value is mapped to the default locale. The
    193                                                 optional " (tt "SOURCE") " indicates what locale system supplied the string.")
    194                                         )
     218                                                (p "Parses a POSIX locale string specification, " (tt "STRING") ", and "
     219                                                "returns the corresponding locale-components object, or #f when a parse "
     220                                                "error occurs. A #f or empty string value is mapped to the default locale. The "
     221                                                "optional " (tt "SOURCE") " indicates what locale system supplied the string.") )
    195222
    196223                                        (procedure "(posix-load-locale)"
    197                                                 (p "Initialize the current-locale from the LC_* or LANG environment variables. When
    198                                                 both the LC_ALL and LANG environment variables are not set the current-locale is #f,
    199                                                 even though some locale-categories may have values. LC_ALL or LANG should be
    200                                                 set if any locale categories are set.")
    201                                         )
     224                                                (p "Initialize the current-locale from the LC_* or LANG environment variables. When "
     225                                                "both the LC_ALL and LANG environment variables are not set the current-locale is #f, "
     226                                                "even though some locale-categories may have values. LC_ALL or LANG should be "
     227                                                "set if any locale categories are set.") )
    202228                                )
    203229                        )
     
    207233                                (p "Access to the locale information by category.")
    208234
    209                                 (p "The locale category selectors are
    210                                 'COLLATE, 'CTYPE, 'MESSAGES, 'MONETARY, 'NUMERIC, and 'TIME.")
     235                          (symbol-table "Locale Category Keys"
     236          (describe ADDRESS "")
     237          (describe COLLATE "")
     238          (describe CTYPE "")
     239          (describe IDENTIFICATION "")
     240          (describe LANGUAGE "")
     241          (describe MEASUREMENT "")
     242          (describe MESSAGES "")
     243          (describe MONETARY "")
     244          (describe NAME "")
     245          (describe NUMERIC "")
     246          (describe PAPER "")
     247          (describe TELEPHONE "")
     248          (describe TIME "") )
    211249
    212250                                (group
    213251                                        (procedure "(set-locale-category! CATEGORY LOCALE-COMPONENTS)"
    214252                                                (p "Sets the specified " (tt "CATEGORY") " to the specified "
    215                                                 (tt "LOCALE-COMPONENTS") " object.")
    216                                         )
     253                                                (tt "LOCALE-COMPONENTS") " object.") )
    217254
    218255                                        (procedure "(locale-category-ref CATEGORY)"
    219                                                 (p "Returns the specified " (tt "CATEGORY") " locale-components object, or #f
    220                                                 if the category is not valued.")
    221                                         )
     256                                                (p "Returns the specified " (tt "CATEGORY") " locale-components object, or #f "
     257                                                "if the category is not valued.") )
    222258
    223259                                )
     
    228264
    229265                (history
     266                        (version "0.4.0" "Added \"default\" timezone & locale")
    230267                        (version "0.3.3" "Removed use of 'critical-section'")
    231268                        (version "0.3.2" "Dropped :optional")
  • release/3/locale/trunk/locale-parameters.scm

    r8924 r12791  
    2424        (lambda (l)
    2525                (cond ((string? l) l)
    26           ((and (boolean? l) (not l)) l)
     26          ((not l) l)
    2727          (else (current-timezone)))) )
    2828
     
    3232        (lambda (l)
    3333                (cond ((string? l) l)
    34           ((and (boolean? l) (not l)) l)
     34          ((not l) l)
    3535          (else (current-locale)))) )
  • release/3/locale/trunk/locale-posix.scm

    r8924 r12791  
    2020    (no-bound-checks)
    2121    (export
     22      make-posix-timezone
    2223      posix-timezone-value->timezone-components
    2324      posix-locale-value->locale-components
     
    2526      posix-load-locale) ) )
    2627
     28;;
     29
     30(define-constant SEC/HR   3600)
     31(define-constant SEC/MIN  60)
     32
     33(define make-posix-timezone
     34  (let ([hms
     35          (lambda (secs)
     36            (let* ([asecs (abs secs)]
     37                   [rsecs (remainder asecs SEC/HR)])
     38              (string-append
     39                (if (negative? secs) "-" "+")
     40                (number->string (quotient asecs SEC/HR))
     41                ":" (number->string (quotient rsecs SEC/MIN))
     42                ":" (number->string (remainder rsecs SEC/MIN)))))])
     43    (lambda (dst-tzn dst-off std-tzn std-off)
     44      (string-append dst-tzn (hms dst-off) std-tzn (hms std-off)) ) ) )
     45
    2746;; Splits an IEEEÊStdÊ1003.1-2001 TZ specifier string into components.
    2847;;
     
    3453;; timezone specifier
    3554
    36 (define posix-timezone-value->timezone-components
     55(define parse-posix-standard-timezone-value
    3756        (let ([name-re (regexp "([A-Za-z]+)|<([^>]+)>")]
    3857                                [offset-re (regexp "([+-])?([0-9]+)(:[0-9]+)?(:[0-9]+)?")]
    3958                                [date-re (regexp ",([MJ])?([0-9]+)(\\.[0-9]+)?(\\.[0-9]+)?")]
    4059                                [time-re (regexp "/([0-9]+)(:[0-9]+)?(:[0-9]+)?")]
    41                                 [def-off 3600])
    42                 (lambda (str-val . src)
    43                         (let ([tz (unknown-timezone-components str-val)])
    44                                 (set-timezone-component! tz 'source (:optional src "POSIX"))
    45                                 (cond [(or (not str-val) (string-null? str-val))
    46                 (default-timezone-components)]
    47               [(string-prefix? ":" str-val)
    48                 (warning "cannot understand implementation-defined values" str-val)
    49                 #f]
    50               [else
    51                 (let ([str-idx 0]
    52                       [str-len (string-length str-val)])
    53                   (letrec (
    54                       [fake-dst-rule
    55                         (lambda ()
    56                           (set-timezone-component! tz 'dst-start
    57                             (make-timezone-dst-rule-mwd 4 1 0 def-off))
    58                           (set-timezone-component! tz 'dst-end
    59                             (make-timezone-dst-rule-mwd 10 5 0 def-off))
    60                           #t)]
    61                       [next-match
    62                         (lambda (re)
    63                           (and-let* ([m (string-match re str-val str-idx)])
    64                             (set! str-idx (+ str-idx (string-length (car m))))
    65                             m ) )]
    66                       [empty-match?
    67                         (lambda ()
    68                           (= str-idx str-len))]
    69                       [to-num
    70                         (lambda (str)
    71                           (string->number
    72                             (cond [(not str) "0"]
    73                                   [(string-prefix? ":" str) (string-trim str #\:)]
    74                                   [(string-prefix? "." str) (string-trim str #\.)]
    75                                   [else str])))]
    76                       [to-offset
    77                         (lambda (g h m s)
    78                           (let ([secs
    79                                   (+ (* (string->number h) 3600)
    80                                      (* (to-num m) 60)
    81                                      (to-num s))])
    82                             (if (equal? g "-") (- secs) secs)))]
    83                       [process-tz?
    84                         (lambda (nm-sym of-sym)
    85                           (and-let* ([n-m (next-match name-re)]
    86                                      [o-m (next-match offset-re)])
    87                             (set-timezone-component! tz nm-sym
    88                               (cadr n-m))
    89                             (set-timezone-component! tz of-sym
    90                               (to-offset (cadr o-m)
    91                                 (caddr o-m) (cadddr o-m) (car (cddddr o-m))))
    92                             #t ) )]
    93                       [to-dst-rule
    94                         (lambda (g n1 n2 n3 o)
    95                           (if g
    96                               (switch (string-ref g 0)
    97                                 [#\J
    98                                   (make-timezone-dst-rule-julian-noleap
    99                                     (string->number n1) o)]
    100                                 [#\M
    101                                   (make-timezone-dst-rule-mwd
    102                                     (string->number n1)
    103                                     (to-num n2) (to-num n3) o)]
    104                                 [else
    105                                   (warning "unknown daylight saving time rule"
    106                                     (string-ref g 0))
    107                                   (make-timezone-dst-rule-julian-leap
    108                                     (string->number n1) o)])
    109                               (make-timezone-dst-rule-julian-leap
    110                                 (string->number n1) o)))]
    111                       [process-dst-rule?
    112                         (lambda (c-sym)
    113                           (and-let* ([d-m (next-match date-re)])
    114                             (let ([t-m (next-match time-re)])
    115                               (set-timezone-component! tz c-sym
    116                                   (to-dst-rule
    117                                     (cadr d-m)
    118                                     (caddr d-m) (cadddr d-m) (car (cddddr d-m))
    119                                     (if t-m
    120                                         (to-offset #f (cadr t-m) (caddr t-m) (cadddr t-m))
    121                                         def-off)))
    122                               #t)))] )
    123                     ;
    124                     (and (process-tz? 'std-name 'std-offset)
    125                          (or (not (process-tz? 'dst-name 'dst-offset))
    126                              (or (and (process-dst-rule? 'dst-start)
    127                                       (process-dst-rule? 'dst-end))
    128                                  (fake-dst-rule)))
    129                            (empty-match?)
    130                          tz ) ) )]) ) ) ) )
     60                                [+defoff+ 3600])
     61                (lambda (tz strtz)
     62                        (let ([str-idx 0]
     63            [str-len (string-length strtz)])
     64        (letrec (
     65            [fake-dst-rule
     66              (lambda ()
     67                (set-timezone-component! tz 'dst-start (make-timezone-dst-rule-mwd 4 1 0 +defoff+))
     68                (set-timezone-component! tz 'dst-end (make-timezone-dst-rule-mwd 10 5 0 +defoff+))
     69                #t)]
     70            [next-match
     71              (lambda (re)
     72                (and-let* ([m (string-match re strtz str-idx)])
     73                  (set! str-idx (+ str-idx (string-length (car m))))
     74                  m ) )]
     75            [nothing-matched
     76              (lambda ()
     77                (= str-idx str-len))]
     78            [to-num
     79              (lambda (str)
     80                (string->number
     81                  (cond [(not str)                "0"]
     82                        [(string-prefix? ":" str) (string-trim str #\:)]
     83                        [(string-prefix? "." str) (string-trim str #\.)]
     84                        [else                     str])))]
     85            [to-offset
     86              (lambda (g hms)
     87                (let ([secs (+ (* (string->number (cadr hms)) 3600)
     88                               (* (to-num (caddr hms)) 60)
     89                               (to-num (cadddr hms)))])
     90                  (if (equal? g "-") (- secs) secs)))]
     91            [tz-parsed
     92              (lambda (namkey offkey)
     93                (and-let* ([n-m (next-match name-re)]
     94                           [o-m (next-match offset-re)])
     95                  (set-timezone-component! tz namkey (cadr n-m))
     96                  (set-timezone-component! tz offkey (to-offset (cadr o-m) (cdr o-m)))
     97                  #t ) )]
     98            [to-dst-rule
     99              (lambda (g n1 n2 n3 o)
     100                (if g
     101                    (let ([rch (string-ref g 0)])
     102                      (case rch
     103                        [(#\J)  ; Julian
     104                          (make-timezone-dst-rule-julian-noleap (string->number n1) o)]
     105                        [(#\M)  ; Date
     106                          (make-timezone-dst-rule-mwd
     107                           (string->number n1) (to-num n2) (to-num n3) o)]
     108                        [else
     109                          (warning "unknown daylight saving time rule type" rch)
     110                          (make-timezone-dst-rule-julian-leap (string->number n1) o)]) )
     111                    (make-timezone-dst-rule-julian-leap (string->number n1) o)))]
     112            [process-dst-rule?
     113              (lambda (key)
     114                (and-let* ([d-m (next-match date-re)])
     115                  (let ([t-m (next-match time-re)])
     116                    (set-timezone-component! tz key
     117                                             (to-dst-rule
     118                                              (cadr d-m)
     119                                              (caddr d-m) (cadddr d-m) (car (cddddr d-m))
     120                                              (if t-m (to-offset #f t-m) +defoff+)))
     121                    #t)))] )
     122          ;
     123          (and (tz-parsed 'std-name 'std-offset)
     124               (or (not (tz-parsed 'dst-name 'dst-offset))
     125                   (or (and (process-dst-rule? 'dst-start)
     126                            (process-dst-rule? 'dst-end))
     127                       (fake-dst-rule)))
     128               (nothing-matched)
     129               tz ) ) ) ) ) )
     130
     131(define (parse-posix-implementation-defined-timezone-value tz strtz)
     132  (warning "cannot understand implementation-defined values" strtz)
     133  #f )
     134
     135(define (posix-timezone-value->timezone-components strtz . src)
     136  (let ([tz (unknown-timezone-components strtz)])
     137    (set-timezone-component! tz 'source (optional src "POSIX"))
     138    (cond [(or (not strtz) (string-null? strtz))
     139            (default-timezone-components) ]
     140          [(string-prefix? ":" strtz)
     141            (parse-posix-implementation-defined-timezone-value tz strtz) ]
     142          [else
     143            (parse-posix-standard-timezone-value tz strtz) ] ) ) )
    131144
    132145;; Splits an IEEEÊStdÊ1003.1-2001 locale specifier string into
     
    136149;; Returns a locale-components object or #f, indicating a parse error.
    137150;;
    138 ;;     name: language[-|_script][_territory][.codeset][@modifier]
     151;;     name: language[-script][_territory][.codeset][@modifier]
    139152;; language: ISO 639-1 or ISO 639-2
    140153;;   script: RFC 3066bis
     
    143156;; modifier:
    144157
    145 (define posix-locale-value->locale-components
     158(define parse-posix-standard-locale
    146159        (let ([locale-re (regexp "([a-zA-Z]+)(-[a-zA-Z]+)?(_[a-zA-Z]+)?(\\.[^@]+)?(@.+)?")])
    147                 (lambda (str-val . src)
    148                         (let ([lc (unknown-locale-components str-val)])
    149                                 (set-locale-component! lc 'source (:optional src "POSIX"))
    150                                 (cond [(or (not str-val) (string-null? str-val))
    151                 (default-locale-components)]
    152               [(or (string=? str-val "C") (string=? str-val "POSIX"))
    153                 lc]
    154               [(string-prefix? "/" str-val)
    155                 (warning "cannot understand pathname locale values" str-val)
    156                 #f]
    157               [else
    158                 (and-let* ([r (string-match locale-re str-val)]
    159                            [matched-len 0])
    160                   (let ([l (cadr r)]
    161                         [s (caddr r)]
    162                         [t (cadddr r)]
    163                         [c (car (cddddr r))]
    164                         [m (cadr (cddddr r))]
    165                         [inc-matched-len
    166                           (lambda (v)
    167                             (set! matched-len (+ matched-len (string-length v))))])
    168                     (when l
    169                       (inc-matched-len l)
    170                       (set-locale-component! lc 'language (string-downcase l)))
    171                     (when s
    172                       (inc-matched-len s)
    173                       (set-locale-component! lc 'script (string-titlecase (substring s 1))))
    174                     (when t
    175                       (inc-matched-len t)
    176                       (set-locale-component! lc 'region (string-upcase (substring t 1))))
    177                     (when c
    178                       (inc-matched-len c)
    179                       (set-locale-component! lc 'codeset (substring c 1)))
    180                     (when m
    181                       (inc-matched-len m)
    182                       (set-locale-component! lc 'modifier (substring m 1)))
    183                     (and (= matched-len (string-length str-val)) lc)))]) ) ) ) )
     160                (lambda (lc strlcl)
     161                        (and-let* ([r (string-match locale-re strlcl)]
     162                 [matched-len 0])
     163        (let ([l (cadr r)]
     164              [s (caddr r)]
     165              [t (cadddr r)]
     166              [c (car (cddddr r))]
     167              [m (cadr (cddddr r))]
     168              [inc-matched-len
     169                (lambda (v)
     170                  (set! matched-len (+ matched-len (string-length v))))])
     171          (when l
     172            (inc-matched-len l)
     173            (set-locale-component! lc 'language (string-downcase l)))
     174          (when s
     175            (inc-matched-len s)
     176            (set-locale-component! lc 'script (string-titlecase (substring s 1))))
     177          (when t
     178            (inc-matched-len t)
     179            (set-locale-component! lc 'region (string-upcase (substring t 1))))
     180          (when c
     181            (inc-matched-len c)
     182            (set-locale-component! lc 'codeset (substring c 1)))
     183          (when m
     184            (inc-matched-len m)
     185            (set-locale-component! lc 'modifier (substring m 1)))
     186          (and (= matched-len (string-length strlcl))
     187               lc ) ) ) ) ) )
     188
     189(define (parse-posix-pathname-locale lc strlcl)
     190  (warning "cannot understand pathname locale values" strlcl)
     191  #f )
     192
     193(define (posix-locale-value->locale-components strlcl . src)
     194        (let ([lc (unknown-locale-components strlcl)])
     195    (set-locale-component! lc 'source (optional src "POSIX"))
     196    (cond [(or (not strlcl) (string-null? strlcl))
     197            (default-locale-components) ]
     198          [(or (string=? strlcl "C") (string=? strlcl "POSIX"))
     199            lc ]
     200          [(string-prefix? "/" strlcl)
     201            (parse-posix-pathname-locale lc strlcl) ]
     202          [else
     203            (parse-posix-standard-locale lc strlcl) ] ) ) )
    184204
    185205;; Sets the current timezone posix style
     
    205225                ("LC_PAPER" . PAPER)
    206226                ("LC_TELEPHONE" . TELEPHONE)
    207                 ("LANGUAGE" . LANGUAGE)
    208227                ("LC_TIME" . TIME)) )
    209228
  • release/3/locale/trunk/locale.html

    r8924 r12791  
    156156<h3>Author</h3><a href="mailto:klovett@pacbell.net">Kon Lovett</a></div>
    157157<div class="section">
     158<h3>Usage</h3><tt>(require-extension locale)</tt></div>
     159<div class="section">
     160<h3>Download</h3><a href="locale.egg">locale.egg</a></div>
     161<div class="section">
     162<h3>Requires</h3>
     163<ul>
     164<li><a href="miscmacros.html">miscmacros</a></li></ul></div>
     165<div class="section">
     166<h3>Documentation</h3>
     167<p>locale is a set of routines supporting locale query operations. The environment locale information is queried upon module load and the corresponding parameters are set.</p>
     168<p>NOTE: This is a work in progress. Currently only the Posix locale information is supported. Plans are to support the native MacOS X and Windows locale APIs. Changes to this API are almost certain.</p>
     169<div class="subsection">
     170<h4>Timezone</h4>
     171<p>Access to local timezone information. A timezone object is composed of a Standard Time Name and Offset, and an optional Summer or Daylight Saving Time Name and Offset. The offset is seconds west (positive) or east (negative) of UTC. The name is some locally accepted timezone name, such as PST. A Daylight Saving Time start rule and end rule are optional components.</p><table class="symbol-table">Timezone Component Selectors:
     172<tr>
     173<td class="symbol">std-name</td>
     174<td></td></tr>
     175<tr>
     176<td class="symbol">std-offset</td>
     177<td></td></tr>
     178<tr>
     179<td class="symbol">dst-name</td>
     180<td></td></tr>
     181<tr>
     182<td class="symbol">dst-offset</td>
     183<td></td></tr>
     184<tr>
     185<td class="symbol">dst-start</td>
     186<td></td></tr>
     187<tr>
     188<td class="symbol">dst-end</td>
     189<td></td></tr></table>
     190<dl>
     191<dt class="definition"><strong>parameter:</strong> (current-timezone [VALUE])</dt>
     192<dd>
     193<p>The currently defined timezone. The specified <tt>VALUE</tt> is either a timezone string value, or #f, indicating no timezone. When no timezone value is set the default timezone is UTC.</p></dd>
     194<dt class="definition"><strong>procedure:</strong> (current-timezone-components)</dt>
     195<dd>
     196<p>Returns the timezone-components object corresponding to the current-timezone.</p></dd>
     197<dt class="definition"><strong>procedure:</strong> (timezone-components? TIMEZONE-COMPONENTS)</dt>
     198<dd>
     199<p>Is the specified <tt>TIMEZONE-COMPONENTS</tt> object actually a timezone-components object?</p></dd>
     200<dt class="definition"><strong>procedure:</strong> (timezone-component-ref TIMEZONE-COMPONENTS SELECTOR [DEFAULT #f])</dt>
     201<dd>
     202<p>Returns the timezone-component <tt>SELECTOR</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a missing component.</p></dd>
     203<dt class="definition"><strong>procedure:</strong> (set-timezone-component! TIMEZONE-COMPONENTS SELECTOR VALUE)</dt>
     204<dd>
     205<p>Sets the timezone-component <tt>SELECTOR</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
     206<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-noleap? TIMEZONE-RULE)</dt>
     207<dd>
     208<p>Is the specified <tt>TIMEZONE-RULE</tt> object actually a daylight saving time julian day without leap seconds object?</p></dd>
     209<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-leap? TIMEZONE-RULE)</dt>
     210<dd>
     211<p>Is the specified <tt>TIMEZONE-RULE</tt> object actually a daylight saving time julian day assuming leap seconds object?</p></dd>
     212<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-mwd? TIMEZONE-RULE)</dt>
     213<dd>
     214<p>Is the specified <tt>TIMEZONE-RULE</tt> object actually a daylight saving time month.week.day object?</p></dd>
     215<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-offset TIMEZONE-RULE)</dt>
     216<dd>
     217<p>Returns the seconds within day offset component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
     218<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian TIMEZONE-RULE)</dt>
     219<dd>
     220<p>Returns the julian day component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
     221<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-month TIMEZONE-RULE)</dt>
     222<dd>
     223<p>Returns the month of year component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
     224<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-week TIMEZONE-RULE)</dt>
     225<dd>
     226<p>Returns the week of month component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
     227<dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-day TIMEZONE-RULE)</dt>
     228<dd>
     229<p>Returns the day of week component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
     230<dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-leap JULIAN-DAY OFFSET)</dt>
     231<dd>
     232<p>Returns a daylight saving time julian day assuming leap seconds rule object.</p></dd>
     233<dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-noleap JULIAN-DAY OFFSET)</dt>
     234<dd>
     235<p>Returns a daylight saving time julian day without leap seconds rule object.</p></dd>
     236<dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-mwd MONTH WEEK DAY OFFSET)</dt>
     237<dd>
     238<p>Returns a daylight saving time month.week.day rule object.</p></dd>
     239<dt class="definition"><strong>procedure:</strong> (posix-timezone-value-&gt;timezone-components STRING [SOURCE &quot;POSIX&quot;])</dt>
     240<dd>
     241<p>Parses a POSIX timezone string specification, <tt>STRING</tt>, and returns the corresponding timezone-components object, or #f when a parse error occurs. A #f or empty string value is mapped to the default timezone. The optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
     242<dt class="definition"><strong>procedure:</strong> (posix-load-timezone)</dt>
     243<dd>
     244<p>Initialize the current-timezone from the TZ environment variable.</p></dd></dl></div>
     245<div class="subsection">
     246<h4>Locale</h4>
     247<p>Access to locale information. A locale object is composed of a Language, an optional Script, an optional Region, an optional Codeset, and an optional Modifier. The language should be an ISO 639-1 or ISO 639-2 name. The Script should be a RFC 3066bis name. The region should be an ISO 3166-1 name. The codeset and modifier forms are locale dependent.</p>
     248<p>Locale component selectors are 'language, 'script, 'region, 'codeset, and 'modifier.</p>
     249<p>The default language is <code>EN</code>. The default region is <code>US</code>.</p>
     250<dl>
     251<dt class="definition"><strong>parameter:</strong> (current-locale [VALUE])</dt>
     252<dd>
     253<p>The currently defined locale. The specified <tt>VALUE</tt> is either a locale string value, or #f, indicating locale independence. When no locale value is set the default locale is #f.</p></dd>
     254<dt class="definition"><strong>procedure:</strong> (current-locale-components)</dt>
     255<dd>
     256<p>Returns the locale-components object corresponding to the current-locale.</p></dd>
     257<dt class="definition"><strong>procedure:</strong> (locale-components? LOCALE-COMPONENTS)</dt>
     258<dd>
     259<p>Is the specified <tt>LOCALE-COMPONENTS</tt> object actually a locale-components object?</p></dd>
     260<dt class="definition"><strong>procedure:</strong> (locale-component-ref LOCALE-COMPONENTS SELECTOR [DEFAULT #f])</dt>
     261<dd>
     262<p>Returns the locale-component <tt>SELECTOR</tt> of the <tt>LOCALE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a missing component.</p></dd>
     263<dt class="definition"><strong>procedure:</strong> (set-locale-component! LOCALE-COMPONENTS SELECTOR VALUE)</dt>
     264<dd>
     265<p>Sets the locale-component <tt>SELECTOR</tt> of the <tt>LOCALE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
     266<dt class="definition"><strong>procedure:</strong> (posix-locale-value-&gt;locale-components STRING [SOURCE &quot;POSIX&quot;])</dt>
     267<dd>
     268<p>Parses a POSIX locale string specification, <tt>STRING</tt>, and returns the corresponding locale-components object, or #f when a parse error occurs. A #f or empty string value is mapped to the default locale. The optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
     269<dt class="definition"><strong>procedure:</strong> (posix-load-locale)</dt>
     270<dd>
     271<p>Initialize the current-locale from the LC_* or LANG environment variables. When both the LC_ALL and LANG environment variables are not set the current-locale is #f, even though some locale-categories may have values. LC_ALL or LANG should be set if any locale categories are set.</p></dd></dl></div>
     272<div class="subsection">
     273<h4>Locale Category</h4>
     274<p>Access to the locale information by category.</p><table class="symbol-table">Locale Category Selectors
     275<tr>
     276<td class="symbol">ADDRESS</td>
     277<td></td></tr>
     278<tr>
     279<td class="symbol">COLLATE</td>
     280<td></td></tr>
     281<tr>
     282<td class="symbol">CTYPE</td>
     283<td></td></tr>
     284<tr>
     285<td class="symbol">IDENTIFICATION</td>
     286<td></td></tr>
     287<tr>
     288<td class="symbol">LANGUAGE</td>
     289<td></td></tr>
     290<tr>
     291<td class="symbol">MEASUREMENT</td>
     292<td></td></tr>
     293<tr>
     294<td class="symbol">MESSAGES</td>
     295<td></td></tr>
     296<tr>
     297<td class="symbol">MONETARY</td>
     298<td></td></tr>
     299<tr>
     300<td class="symbol">NAME</td>
     301<td></td></tr>
     302<tr>
     303<td class="symbol">NUMERIC</td>
     304<td></td></tr>
     305<tr>
     306<td class="symbol">PAPER</td>
     307<td></td></tr>
     308<tr>
     309<td class="symbol">TELEPHONE</td>
     310<td></td></tr>
     311<tr>
     312<td class="symbol">TIME</td>
     313<td></td></tr></table>
     314<dl>
     315<dt class="definition"><strong>procedure:</strong> (set-locale-category! CATEGORY LOCALE-COMPONENTS)</dt>
     316<dd>
     317<p>Sets the specified <tt>CATEGORY</tt> to the specified <tt>LOCALE-COMPONENTS</tt> object.</p></dd>
     318<dt class="definition"><strong>procedure:</strong> (locale-category-ref CATEGORY)</dt>
     319<dd>
     320<p>Returns the specified <tt>CATEGORY</tt> locale-components object, or #f if the category is not valued.</p></dd></dl></div></div>
     321<div class="section">
    158322<h3>Version</h3>
    159323<ul>
     324<li>0.4.0 Added &quot;default&quot; timezone &amp; locale</li>
    160325<li>0.3.3 Removed use of 'critical-section'</li>
    161326<li>0.3.2 Dropped :optional</li>
     
    164329<li>0.2 Exports</li>
    165330<li>0.1 Initial release</li></ul></div>
    166 <div class="section">
    167 <h3>Usage</h3><tt>(require-extension locale)</tt></div>
    168 <div class="section">
    169 <h3>Download</h3><a href="locale.egg">locale.egg</a></div>
    170 <div class="section">
    171 <h3>Requires</h3>
    172 <ul>
    173 <li><a href="miscmacros.html">miscmacros</a></li></ul></div>
    174 <div class="section">
    175 <h3>Documentation</h3>
    176 <p>locale is a set of routines supporting locale query operations.
    177                         The environment locale information is queried upon module load and the
    178                         corresponding parameters are set.</p>
    179 <p>NOTE: This is a work in progress. Currently only the Posix locale
    180                         information is supported. Plans are to support the native MacOS X and Windows locale
    181                         APIs. Changes to this API are almost certain.</p>
    182 <div class="subsection">
    183 <h4>Timezone</h4>
    184 <p>Access to local timezone information. A timezone object is composed of a
    185                                 Standard Time Name and Offset, and an optional Summer or Daylight Savings
    186                                 Time Name and Offset. The offset is seconds west (positive) or east (negative)
    187                                 of UTC. The name is some locally accepted timezone name, such as PST. A
    188                                 Daylight Savings Time start rule and end rule are optional components.</p>
    189 <p>Timezone component selectors are 'std-name, 'std-offset, 'dst-name, 'dst-offset,
    190                                 'dst-start, 'dst-end.</p>
    191 <dl>
    192 <dt class="definition"><strong>parameter:</strong> (current-timezone [VALUE])</dt>
    193 <dd>
    194 <p>The currently defined timezone. The specified <tt>VALUE</tt> is either a timezone string value, or #f, indicating no timezone. When
    195                                                 no timezone value is set the default timezone is UTC.</p></dd>
    196 <dt class="definition"><strong>procedure:</strong> (current-timezone-components)</dt>
    197 <dd>
    198 <p>Returns the timezone-components object corresponding to the current-timezone.</p></dd>
    199 <dt class="definition"><strong>procedure:</strong> (timezone-components? TIMEZONE-COMPONENTS)</dt>
    200 <dd>
    201 <p>Is the specified <tt>TIMEZONE-COMPONENTS</tt> object actually a
    202                                                 timezone-components object?</p></dd>
    203 <dt class="definition"><strong>procedure:</strong> (timezone-component-ref TIMEZONE-COMPONENTS SELECTOR [DEFAULT #f])</dt>
    204 <dd>
    205 <p>Returns the timezone-component <tt>SELECTOR</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a
    206                                                 missing component.</p></dd>
    207 <dt class="definition"><strong>procedure:</strong> (set-timezone-component! TIMEZONE-COMPONENTS SELECTOR VALUE)</dt>
    208 <dd>
    209 <p>Sets the timezone-component <tt>SELECTOR</tt> of the <tt>TIMEZONE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
    210 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-noleap? TIMEZONE-RULE)</dt>
    211 <dd>
    212 <p>Is the specified <tt>TIMEZONE-RULE</tt> object actually
    213                                                 a daylight saving time julian day without leap seconds object?</p></dd>
    214 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian-leap? TIMEZONE-RULE)</dt>
    215 <dd>
    216 <p>Is the specified <tt>TIMEZONE-RULE</tt> object actually
    217                                                 a daylight saving time julian day assuming leap seconds object?</p></dd>
    218 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-mwd? TIMEZONE-RULE)</dt>
    219 <dd>
    220 <p>Is the specified <tt>TIMEZONE-RULE</tt> object actually
    221                                                 a daylight saving time month.week.day object?</p></dd>
    222 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-offset TIMEZONE-RULE)</dt>
    223 <dd>
    224 <p>Returns the seconds within day offset component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
    225 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-julian TIMEZONE-RULE)</dt>
    226 <dd>
    227 <p>Returns the julian day component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
    228 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-month TIMEZONE-RULE)</dt>
    229 <dd>
    230 <p>Returns the month of year component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
    231 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-week TIMEZONE-RULE)</dt>
    232 <dd>
    233 <p>Returns the week of month component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
    234 <dt class="definition"><strong>procedure:</strong> (timezone-dst-rule-day TIMEZONE-RULE)</dt>
    235 <dd>
    236 <p>Returns the day of week component of the specified <tt>TIMEZONE-RULE</tt> object.</p></dd>
    237 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-leap JULIAN-DAY OFFSET)</dt>
    238 <dd>
    239 <p>Returns a daylight saving time julian day assuming leap seconds rule object.</p></dd>
    240 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-julian-noleap JULIAN-DAY OFFSET)</dt>
    241 <dd>
    242 <p>Returns a daylight saving time julian day without leap seconds rule object.</p></dd>
    243 <dt class="definition"><strong>procedure:</strong> (make-timezone-dst-rule-mwd MONTH WEEK DAY OFFSET)</dt>
    244 <dd>
    245 <p>Returns a daylight saving time month.week.day rule object.</p></dd>
    246 <dt class="definition"><strong>procedure:</strong> (posix-timezone-value-&gt;timezone-components STRING [SOURCE &quot;POSIX&quot;])</dt>
    247 <dd>
    248 <p>Parses a POSIX timezone string specification, <tt>STRING</tt>, and
    249                                                 returns the corresponding timezone-components object, or #f when a parse
    250                                                 error occurs. A #f or empty string value is mapped to the default timezone. The
    251                                                 optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
    252 <dt class="definition"><strong>procedure:</strong> (posix-load-timezone)</dt>
    253 <dd>
    254 <p>Initialize the current-timezone from the TZ environment variable.</p></dd></dl></div>
    255 <div class="subsection">
    256 <h4>Locale</h4>
    257 <p>Access to locale information. A locale object is composed of a
    258                                 Language, an optional Script, an optional Region, an optional Codeset, and an
    259                                 optional Modifier. The language should be an ISO 639-1 or ISO 639-2 name. The
    260                                 Script should be a RFC 3066bis name. The region should be an ISO 3166-1 name.
    261                                 The codeset and modifier forms are locale dependent.</p>
    262 <p>Locale component selectors are 'language, 'script, 'region, 'codeset, and 'modifier.</p>
    263 <dl>
    264 <dt class="definition"><strong>parameter:</strong> (current-locale [VALUE])</dt>
    265 <dd>
    266 <p>The currently defined locale. The specified <tt>VALUE</tt> is either a locale string value, or #f, indicating locale independence.
    267                                                 When no locale value is set the default locale is #f.</p></dd>
    268 <dt class="definition"><strong>procedure:</strong> (current-locale-components)</dt>
    269 <dd>
    270 <p>Returns the locale-components object corresponding to the current-locale.</p></dd>
    271 <dt class="definition"><strong>procedure:</strong> (locale-components? LOCALE-COMPONENTS)</dt>
    272 <dd>
    273 <p>Is the specified <tt>LOCALE-COMPONENTS</tt> object actually a
    274                                                 locale-components object?</p></dd>
    275 <dt class="definition"><strong>procedure:</strong> (locale-component-ref LOCALE-COMPONENTS SELECTOR [DEFAULT #f])</dt>
    276 <dd>
    277 <p>Returns the locale-component <tt>SELECTOR</tt> of the <tt>LOCALE-COMPONENTS</tt> object, or the <tt>DEFAULT</tt> for a
    278                                                 missing component.</p></dd>
    279 <dt class="definition"><strong>procedure:</strong> (set-locale-component! LOCALE-COMPONENTS SELECTOR VALUE)</dt>
    280 <dd>
    281 <p>Sets the locale-component <tt>SELECTOR</tt> of the <tt>LOCALE-COMPONENTS</tt> object to <tt>VALUE</tt>.</p></dd>
    282 <dt class="definition"><strong>procedure:</strong> (posix-locale-value-&gt;locale-components STRING [SOURCE &quot;POSIX&quot;])</dt>
    283 <dd>
    284 <p>Parses a POSIX locale string specification, <tt>STRING</tt>, and
    285                                                 returns the corresponding locale-components object, or #f when a parse
    286                                                 error occurs. A #f or empty string value is mapped to the default locale. The
    287                                                 optional <tt>SOURCE</tt> indicates what locale system supplied the string.</p></dd>
    288 <dt class="definition"><strong>procedure:</strong> (posix-load-locale)</dt>
    289 <dd>
    290 <p>Initialize the current-locale from the LC_* or LANG environment variables. When
    291                                                 both the LC_ALL and LANG environment variables are not set the current-locale is #f,
    292                                                 even though some locale-categories may have values. LC_ALL or LANG should be
    293                                                 set if any locale categories are set.</p></dd></dl></div>
    294 <div class="subsection">
    295 <h4>Locale Category</h4>
    296 <p>Access to the locale information by category.</p>
    297 <p>The locale category selectors are
    298                                 'COLLATE, 'CTYPE, 'MESSAGES, 'MONETARY, 'NUMERIC, and 'TIME.</p>
    299 <dl>
    300 <dt class="definition"><strong>procedure:</strong> (set-locale-category! CATEGORY LOCALE-COMPONENTS)</dt>
    301 <dd>
    302 <p>Sets the specified <tt>CATEGORY</tt> to the specified <tt>LOCALE-COMPONENTS</tt> object.</p></dd>
    303 <dt class="definition"><strong>procedure:</strong> (locale-category-ref CATEGORY)</dt>
    304 <dd>
    305 <p>Returns the specified <tt>CATEGORY</tt> locale-components object, or #f
    306                                                 if the category is not valued.</p></dd></dl></div></div>
    307331<div class="section">
    308332<h3>License</h3>
  • release/3/locale/trunk/locale.scm

    r8924 r12791  
    55;;
    66;; - Only Posix for now.
    7 
    8 (use locale-posix locale-components locale-parameters)
    97
    108(eval-when (compile)
     
    1614    (no-bound-checks)
    1715    (export
     16      UNKNOWN-LOCAL-TZ-NAME
    1817      current-timezone-components
    1918      current-locale-components) ) )
     19
     20(require-extension
     21  posix
     22  locale-posix locale-components locale-parameters)
    2023
    2124;;
     
    2427        (let ([cached-timezone #f]
    2528                                [cached-components (default-timezone-components)])
    26                 (lambda ()
    27                         (let ([timezone (current-timezone)])
    28                                 (unless (equal? cached-timezone timezone)
    29                                   (unless (and timezone
    30                        (and-let* ([tzc
    31                                    (posix-timezone-value->timezone-components
    32                                      timezone)])
    33                          (set! cached-components tzc)
    34                          (set! cached-timezone timezone)
    35                          #t ) )
    36                                           (set! cached-timezone #f)
    37                                           (set! cached-components (default-timezone-components)) ) )
    38                                 cached-components ) ) ) )
     29                (lambda args
     30                  (cond [(null? args)
     31              (let ([timezone (current-timezone)])
     32                (unless (equal? cached-timezone timezone)
     33                  (unless (and timezone
     34                               (and-let* ([(string? timezone)]
     35                                          [tzc (posix-timezone-value->timezone-components timezone)])
     36                                 (current-timezone-components timezone tzc)
     37                                 #t ) )
     38                    (current-timezone-components #f (default-timezone-components)) ) ) ) ]
     39            [(= 2 (length args))
     40              (set! cached-timezone (car args))
     41              (set! cached-components (cadr args)) ]
     42            [else
     43              (error 'current-timezone-components "too few arguments" args) ] )
     44      cached-components ) ) )
    3945
    4046;;
     
    4349        (let ([cached-locale #f]
    4450                                [cached-components (default-locale-components)])
    45                 (lambda ()
    46                         (let ([locale (current-locale)])
    47                                 (unless (equal? cached-locale locale)
    48           (unless (and locale
    49                        (and-let* ([lc
    50                                    (posix-locale-value->locale-components
    51                                      locale)])
    52                          (set! cached-components lc)
    53                          (set! cached-locale locale)
    54                          #t ) )
    55                                           (set! cached-locale #f)
    56                                           (set! cached-components (default-locale-components)) ) )
    57                                 cached-components ) ) ) )
     51                (lambda args
     52                  (cond [(null? args)
     53              (let ([locale (current-locale)])
     54                (unless (equal? cached-locale locale)
     55                  (unless (and locale
     56                               (and-let* ([(string? locale)]
     57                                          [lc (posix-locale-value->locale-components locale)])
     58                                 (current-locale-components locale lc)
     59                                 #t ) )
     60                    (current-locale-components #f (default-locale-components)) ) ) ) ]
     61            [(= 2 (length args))
     62              (set! cached-locale (car args))
     63              (set! cached-components (cadr args)) ]
     64            [else
     65              (error 'current-locale-components "too few arguments" args) ] )
     66      cached-components ) ) )
     67
     68;;; When no environment info use Plan B
     69
     70(define BUILTIN-SOURCE "BUILTIN")
     71
     72;; Daylight saving time offset from standard offset.
     73;; ("spring forward" add it, "fall back" subtract it)
     74
     75(define-constant DEFAULT-DST-OFFSET 3600)
     76
     77(define UNKNOWN-LOCAL-TZ-NAME "XXXX")
     78
     79(define (local-timezone-name)
     80  (or (local-timezone-abbreviation)
     81      UNKNOWN-LOCAL-TZ-NAME) )
     82
     83(define (fake-timezone)
     84  ; Need local timezone info
     85  (let* ([tv (seconds->local-time (current-seconds))]
     86         [dstf (vector-ref tv 8)]
     87         [tzn (local-timezone-name)] )
     88    ; Set the current-timezone for future reference.
     89    (current-timezone
     90      (cond-expand
     91        [macosx
     92          ; Since the tzo reflects the dst status need to fake the one not in effect.
     93          (let ([tzo (vector-ref tv 9)])
     94            (if dstf
     95                (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
     96                (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ]
     97        [else
     98          ; Since only the standard tzn & tzo are available need to
     99          ; fake summer time.
     100          (let ([tzo (vector-ref tv 9)])
     101            (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ] ) ) ) )
     102
     103;;
     104
     105(define-constant DEFAULT-LANGUAGE "en")
     106(define-constant DEFAULT-REGION "US")
     107
     108(define (fake-locale)
     109  (current-locale (string-append DEFAULT-LANGUAGE "_" DEFAULT-REGION)) )
    58110
    59111;;;
     
    62114
    63115;; Use posix locale system, for now
    64 ;;
     116
    65117(posix-load-locale)
    66118(posix-load-timezone)
     119
     120;; Need the current-timezone-components, and unless we
     121;; have a current-timezone need to fake one from system
     122;; time info.
     123
     124(unless (current-locale)
     125  (fake-locale)
     126  (let ([lc (current-locale)])
     127    (current-locale-components lc (posix-locale-value->locale-components lc BUILTIN-SOURCE)) ) )
     128
     129(unless (current-timezone)
     130  (fake-timezone)
     131  (let ([tz (current-timezone)])
     132    (current-timezone-components tz (posix-timezone-value->timezone-components tz BUILTIN-SOURCE)) ) )
Note: See TracChangeset for help on using the changeset viewer.