Changeset 12794 in project


Ignore:
Timestamp:
12/08/08 07:40:06 (11 years ago)
Author:
Kon Lovett
Message:

Save for refactor.

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

Legend:

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

    r12791 r12794  
    88;; - Used selectors for *-components since it is assumed extra elements will be needed by
    99;; platform specific code. May switch to records later & deprecate the existing interface.
    10 
    11 (use srfi-1)
    1210
    1311(eval-when (compile)
     
    4240      timezone-component-ref
    4341      timezone-components?) ) )
     42
     43(require-extension srfi-1)
    4444
    4545;;;
  • release/3/locale/trunk/locale-posix.scm

    r12791 r12794  
    44;; Issues
    55;;
    6 ;; - does not interact w/ setlocale or tzset
    7 ;;
    8 ;; - if LC_ALL or LANG is not set but any LC_* is set then (current-locale)
     6;; - Does not interact w/ setlocale or tzset
     7;;
     8;; - If LC_ALL or LANG is not set but any LC_* is set then (current-locale)
    99;; will still be #f, while some locale-categories will be valued
    10 
    11 (use srfi-1 srfi-13 regex)
    12 (use locale-categories locale-components locale-parameters)
    1310
    1411(eval-when (compile)
     
    2623      posix-load-locale) ) )
    2724
     25(require-extension
     26  srfi-1 srfi-13 regex
     27  locale-categories locale-components locale-parameters)
     28
    2829;;
    2930
     
    6364            [str-len (string-length strtz)])
    6465        (letrec (
     66            [next-match
     67              (lambda (re)
     68                (and-let* ([m (string-match re strtz str-idx)])
     69                  (set! str-idx (+ str-idx (string-length (car m))))
     70                  m ) )]
     71            [all-parsed
     72              (lambda () (= str-idx str-len))]
    6573            [fake-dst-rule
    6674              (lambda ()
     
    6876                (set-timezone-component! tz 'dst-end (make-timezone-dst-rule-mwd 10 5 0 +defoff+))
    6977                #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))]
    7878            [to-num
    7979              (lambda (str)
     
    8989                               (to-num (cadddr hms)))])
    9090                  (if (equal? g "-") (- secs) secs)))]
    91             [tz-parsed
     91            [parse-nam+off
    9292              (lambda (namkey offkey)
    9393                (and-let* ([n-m (next-match name-re)]
     
    9696                  (set-timezone-component! tz offkey (to-offset (cadr o-m) (cdr o-m)))
    9797                  #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?
     98            [decode-dst-rule
     99              (lambda (g v o)
     100                (let ([n1 (string->number (car v))])
     101                  (if (not g)
     102                      ; Then assume Julian style rule
     103                      (make-timezone-dst-rule-julian-leap n1 o)
     104                      ; Else select rule
     105                      (let ([rch (string-ref g 0)])
     106                        (case rch
     107                          [(#\J)  ; Julian
     108                            (make-timezone-dst-rule-julian-noleap n1 o)]
     109                          [(#\M)  ; Date
     110                            (make-timezone-dst-rule-mwd n1 (to-num (cadr v)) (to-num (caddr v)) o)]
     111                          [else
     112                            (warning "unknown DST rule type" rch)
     113                            (make-timezone-dst-rule-julian-leap n1 o) ] ) ) ) ) ) ]
     114            [parse-dst-rule
    113115              (lambda (key)
    114116                (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+)))
     117                  (let* ([t-m (next-match time-re)]
     118                         [off (if t-m (to-offset #f t-m) +defoff+)])
     119                    (set-timezone-component! tz key (decode-dst-rule (cadr d-m) (cdr d-m) off))
    121120                    #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))
     121          ; Walk the match set
     122          (and ; At least standard timezone info
     123               (parse-nam+off 'std-name 'std-offset)
     124               ; Ok, then try optional DST section
     125               (or (not (parse-nam+off 'dst-name 'dst-offset))
     126                   ; Ok, then try optional DST start+end
     127                   (or (and (parse-dst-rule 'dst-start)
     128                            (parse-dst-rule 'dst-end))
     129                       ; Else dummy something up
    127130                       (fake-dst-rule)))
    128                (nothing-matched)
     131               ; Matched at least the minimum
     132               (all-parsed)
     133               ; Valid timezone info
    129134               tz ) ) ) ) ) )
    130135
     
    232237        (let ([str (getenv "LC_ALL")])
    233238                (if (or (not str) (string-null? str))
    234         ; then set individually, w/ lang as default
     239        ; Then set individually, w/ lang as default
    235240        (begin
    236241          ;
     
    251256                    (unless (locale-category-ref (cdr p))
    252257                      (set-locale-category! (cdr p) lc)) )
    253                   *posix-locale-category-names*)))))
    254         ; else lc all overrides all others
     258                  *posix-locale-category-names*) ) ) ) )
     259        ; Else lc all overrides all others
    255260        (let ([lc (posix-locale-value->locale-components str)])
    256261          (current-locale str)
     
    258263            (lambda (p)
    259264              (set-locale-category! (cdr p) lc) )
    260             *posix-locale-category-names*)) ) ) )
     265            *posix-locale-category-names*) ) ) ) )
Note: See TracChangeset for help on using the changeset viewer.