Changeset 14048 in project


Ignore:
Timestamp:
04/03/09 04:03:10 (11 years ago)
Author:
Kon Lovett
Message:

Added tm vec support.

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

Legend:

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

    r13973 r14048  
    33
    44(declare
     5  (uses posix)
    56  (usual-integrations)
    67  (inline)
     
    89  (no-procedure-checks)
    910  (run-time-macros)
     11  (bound-to-procedure
     12    ##sys#error-hook)
    1013  (export
    1114    local-timezone
    12     local-timezone-offset) )
     15    local-timezone-offset
     16    with-tzset) )
    1317
    1418#>
     
    3135
    3236static char *
    33 get_tz( int yr, int mo, int dy, int hr, int mn, int as_offset )
     37get_tz( int yr, int mo, int dy, int hr, int mn, int sc, int as_offset )
    3438{
    3539  struct tm tm;
     
    4246  tm.tm_hour = hr;
    4347  tm.tm_min = mn;
     48  tm.tm_sec = sc;
     49  tm.tm_year = yr - 1900;
     50  tm.tm_mon = mo;
    4451  tm.tm_mday = dy;
    45   tm.tm_mon = mo;
    46   tm.tm_year = yr - 1900;
    4752
    4853  t = mktime( &tm );
     
    5358<#
    5459
    55 (define get-tz (foreign-lambda c-string* "get_tz" int int int int int bool))
     60;;;
     61
     62(define get-tz (foreign-lambda c-string* "get_tz" int int int int int int bool))
     63
     64; #!required tm | hr mo dy #!optional (hr 12) (mn 0) (sc 0) #!key offset?
     65(define (*local-timezone loc . args)
     66
     67  (let ((arglen (length args))
     68        (yr #f) (mo #f) (dy #f) (hr #f) (mn #f) (sc #f) (offset? #f))
     69
     70    ; DSSSL lambda list parsing behavior as I wish it was
     71    (unless (<= 1 arglen) (##sys#error-hook 2 loc arglen 1))
     72    (if (vector? (car args))
     73        (let ((tm (car args)))
     74          (when (< (vector-length tm) 10) (error loc "time vector too short" tm))
     75          (set! yr (+ (vector-ref tm 5) 1900))
     76          (set! mo (vector-ref tm 4))
     77          (set! dy (vector-ref tm 3))
     78          (set! hr (vector-ref tm 2))
     79          (set! mn (vector-ref tm 1))
     80          (set! sc (vector-ref tm 0))
     81          (let ((args (cdr args)))
     82            (if (= 3 arglen)
     83                (let ((arg (car args)))
     84                  (if (eq? #:offset? arg) (set! offset? (cadr args))
     85                      (if (keyword? arg) (error loc "unknown keyword argument" arg)
     86                          (##sys#error-hook 1 loc arglen 3) ) ) )
     87                (unless (= 1 arglen) (##sys#error-hook 1 loc arglen 3)) ) ) )
     88        (begin
     89          (unless (<= 3 arglen) (##sys#error-hook 2 loc arglen 3))
     90          (set! yr (car args))
     91          (set! mo (cadr args))
     92          (set! dy (caddr args))
     93          (let loop ((args (cdddr args)))
     94            (if (null? args)
     95                (begin (unless hr (set! hr 12)) (unless mn (set! mn 0)) (unless sc (set! sc 0)))
     96                (let ((arg (car args)))
     97                  (cond ((keyword? arg)
     98                         (if (eq? #:offset? arg) (set! offset? (cadr args))
     99                             (error loc "unknown keyword argument" arg) )
     100                         (loop (cddr args)) )
     101                        ((and hr mn sc)
     102                         (##sys#error-hook 1 loc arglen 8) )
     103                        (else
     104                         (if hr (if mn (set! sc arg) (set! mn arg)) (set! hr arg))
     105                         (loop (cdr args)) ) ) ) ) ) ) )
     106
     107    (unless (and (fixnum? yr) (fixnum? mo) (fixnum? dy) (fixnum? hr) (fixnum? mn) (fixnum? sc))
     108      (apply error loc "bad argument type - expected fixnum" args) )
     109    (unless (and (<= 0 sc 60) (<= 0 mn 59) (<= 0 hr 23) (<= 1 dy 31) (<= 0 mn 11))
     110      (apply error loc "bad argument type - out of range" args) )
     111
     112    (get-tz yr mo dy hr mn sc offset?) ) )
     113
     114;;;
    56115
    57116;; Return the timezone for the given date as a string,
     
    59118;; format (e.g. "-0500").
    60119
    61 (define (local-timezone yr mo dy . args) ;#!optional (hr 12) (mn 0) #!key offset?
    62 
    63   ; DSSSL lambda list parsing behavior as I wish it was
    64   (let ((hr #f) (mn #f) (offset? #f))
    65     (let loop ((args args))
    66       (if (null? args) (begin (unless hr (set! hr 12)) (unless mn (set! mn 0)))
    67           (let ((arg (car args)))
    68             (cond ((keyword? arg)
    69                    (if (eq? #:offset? arg) (set! offset? (cadr args))
    70                        (error 'local-timezone "unknown keyword argument" arg) )
    71                    (loop (cddr args)) )
    72                   ((and hr mn)
    73                    (error 'local-timezone "too many optional arguments" args) )
    74                   ((and (fixnum? arg) (<= 0 arg))
    75                    (if hr (set! mn arg) (set! hr arg))
    76                    (loop (cdr args)) )
    77                   (else
    78                    (error 'local-timezone "bad argument type - expected non-negative fixnum" arg) ) ) ) ) )
    79 
    80     (get-tz yr mo dy hr mn offset?) ) )
     120(define (local-timezone . args)
     121  (apply *local-timezone 'local-timezone args) )
    81122
    82123;; Return the timezone offset as seconds where positive is east of UTC &
    83124;; negative is west of UTC.
    84125
    85 (define (local-timezone-offset yr mo dy #!optional (hr 12) (mn 0))
    86   (let* ((tzo (local-timezone yr mo dy hr mn #:offset? #t))
     126(define (local-timezone-offset . args)
     127  (let* ((tzo (apply 'local-timezone-offset *local-timezone args))
    87128         (1stch (string-ref tzo 0))
    88129         (neg? (char=? #\- 1stch))
     
    95136;;
    96137
    97 (define-macro (with-tzset ?tz . ?body)
    98   (let ((tzvar (gensym)))
    99     `(let ((,tzvar (getenv "TZ")))
    100        (dynamic-wind
    101          (lambda () (setenv "TZ" ,?tz) ((foreign-lambda void "tzset")))
    102          (lambda () ,@?body)
    103          (lambda () (setenv "TZ" ,tzvar) ((foreign-lambda void "tzset"))) ) ) ) )
     138(define (with-tzset tz thunk)
     139  (let ((orgtz (getenv "TZ")))
     140     (dynamic-wind
     141       (lambda () (setenv "TZ" tz) ((foreign-lambda void "tzset")))
     142       thunk
     143       (lambda () (setenv "TZ" orgtz) ((foreign-lambda void "tzset"))) ) ) )
  • release/3/locale/trunk/tests/locale-test.scm

    r13886 r14048  
    66(define-test locale-test "Locale"
    77
    8         (test/case "Timezone" (
     8        (test/case "Posix Timezone" (
    99                [tz0 (make-timezone-components "PST+8:00" "TEST")]
    1010                [tz1 (make-timezone-components "PST+8:00PDT+7:00:00" '("POSIX" "TZ"))]
     
    4545        )
    4646
    47         (test/case "Locale" (
     47        (test/case "Posix Locale" (
    4848                [lc0 (make-locale-components "en_US" '("POSIX" "LANG"))]
    4949                [lc1 (make-locale-components "en-Latn_US.UTF8@foo,bar,baz" "TEST")] )
     
    7373                (expect-equal "S4" lc0 (locale-category-ref 'monetary))
    7474        )
     75
     76  #;
     77        (test/case "Local Timezone" ()
     78          (with-tzset "" (lambda () ))
     79        )
    7580)
    7681
Note: See TracChangeset for help on using the changeset viewer.