Changeset 13955 in project


Ignore:
Timestamp:
03/27/09 05:36:01 (11 years ago)
Author:
Kon Lovett
Message:

Added 'local-timezone' stuff.

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

Legend:

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

    r13951 r13955  
    3434(define-constant DEFAULT-DST-OFFSET 3600)
    3535
    36 (define (local-timezone-name) (or (local-timezone-abbreviation) UNKNOWN-LOCAL-TZ-NAME))
     36(define (current-local-time) (seconds->local-time (current-seconds)))
     37
     38(define (local-timezone-name tv)
     39  (local-timezone (+ (vector-ref tv 5) 1900) (vector-ref tv 4) (vector-ref tv 2)) )
    3740
    3841(define (make-builtin-timezone)
    3942  ; Need local timezone info
    40   (let* ((tzn (local-timezone-name))
    41          (tv (seconds->local-time (current-seconds)))
    42          (dstf (vector-ref tv 8))
    43          (tzo (vector-ref tv 9)) )
    44     (cond-expand
    45       (macosx
    46         ; Since the tzo reflects the dst status need to fake the one not in effect.
    47         (if dstf
    48             (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
    49             (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) )
    50       (else
    51         ; Since only the standard tzn & tzo are available need to
    52         ; fake summer time.
    53         (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) )
     43  (let ((tv (current-local-time)))
     44    (let ((tzn (local-timezone-name tv))
     45          (tzo (vector-ref tv 9))
     46          (dst? (vector-ref tv 8)) )
     47      ; Since the tzo reflects the dst status need to fake the one not in effect.
     48      (if dst?
     49          (make-posix-timezone UNKNOWN-LOCAL-TZ-NAME (+ tzo DEFAULT-DST-OFFSET) tzn tzo)
     50          (make-posix-timezone tzn tzo UNKNOWN-LOCAL-TZ-NAME (- tzo DEFAULT-DST-OFFSET)) ) ) ) )
    5451
    5552(define (use-builtin-timezone)
  • release/3/locale/trunk/locale-posix.scm

    r13951 r13955  
    147147;;
    148148
     149#| ;NOT YET
    149150(cond-expand
    150151  (macosx
     
    161162    (if (file-exists? pn) (parse-posix-tzfile tz pn)
    162163        #f ) ) )
     164|#
    163165
    164166(define (parse-posix-implementation-defined-timezone tz str)
     167  (warning "cannot understand Posix implementation-defined timezone" str)
     168  #f
     169  #; ;NOT YET
    165170  (or (parse-posix-pathname-timezone tz (substring str 1))
    166171      (begin
     
    173178  (let ((tz (make-timezone-components str (optional src "POSIX"))))
    174179    (cond ((string-prefix? ":" str)
    175             (parse-posix-implementation-defined-timezone tz str) )
     180           (parse-posix-implementation-defined-timezone tz str) )
    176181          (else
    177             (or (parse-posix-pathname-timezone tz str)
    178                 (parse-posix-literal-timezone tz str) ) ) ) ) )
     182           (parse-posix-literal-timezone tz str) ) ) ) )
    179183
    180184;;; Locale
     
    226230;;
    227231
     232#| ;NOT YET
    228233(cond-expand
    229234  (macosx
     
    240245    (if (file-exists? pn) (parse-posix-localefile lc pn)
    241246        #f ) ) )
     247|#
    242248
    243249;;
     
    247253    (let ((lc (make-locale-components str src tag)))
    248254      (cond ((or (string=? str "C") (string=? str "POSIX"))
    249               ;FIXME - #f so BUILTIN source used but ...
    250               #f )
     255             ;FIXME - #f so BUILTIN source used but ...
     256             #f )
    251257            (else
    252               (or (parse-posix-pathname-locale lc str)
    253                   (parse-posix-literal-locale lc str) ) ) ) ) ) )
     258             (parse-posix-literal-locale lc str) ) ) ) ) )
    254259
    255260;;; The POSIX/GNU locale categories
  • release/3/locale/trunk/locale-timezone.scm

    r13951 r13955  
    55  (usual-integrations)
    66  (inline)
     7  (fixnum)
    78  (no-procedure-checks)
    89  (export
    9     local-timezone) )
     10    local-timezone
     11    local-timezone-offset) )
    1012
    1113#>
     
    1618
    1719#ifdef _WIN32
    18 inline struct tm *
     20static struct tm *
    1921localtime_r( const time_t *clock, struct tm *result )
    2022{
     
    3335  time_t t;
    3436
    35   const int size = 32;
     37  const int size = 31 + 1;
    3638  char *buf = malloc( size * sizeof( char ) );
    3739
     
    4446
    4547  t = mktime( &tm );
    46   localtime_r( &t, &tm );
    47   strftime( buf, size, (as_offset ? "%z" : "%Z"), &tm );
     48  strftime( buf, size, (as_offset ? "%z" : "%Z"), localtime_r( &t, &tm ) );
    4849
    4950  return buf;
     
    5455
    5556;; Return the timezone for the given date as a string,
    56 ;; (e.g. "EST"). If offset?: is true, then return it in RFC-822
    57 ;; format (e.g. -0500).
     57;; (e.g. "EST"). If offset?: #t, then return it in RFC-822
     58;; format (e.g. "-0500").
    5859
    59 ;#!optional (hr 12) (mn 0) #!key offset?
    60 (define (local-timezone yr mo dy . args)
     60(define (local-timezone yr mo dy . args) ;#!optional (hr 12) (mn 0) #!key offset?
     61
     62  ; DSSSL lambda list parsing behavior as I wish it was
    6163  (let ((hr #f) (mn #f) (offset? #f))
    6264    (let loop ((args args))
    63       (unless (null? args)
    64         (let ((arg (car args)))
    65           (cond ((keyword? arg)
    66                  (if (eq? #:offset? arg) (set! offset? (cadr args))
    67                      (error 'local-timezone "unknown keyword argument" arg) )
    68                  (loop (cddr args)) )
    69                 ((and hr mn)
    70                  (error 'local-timezone "too many optional arguments" args) )
    71                 (else
    72                  (unless (and (fixnum? arg) (<= 0 arg))
    73                    (error 'local-timezone "bad argument type - expected non-negative fixnum" arg) )
    74                  (if hr (set! mn arg)
    75                      (set! hr arg) )
    76                  (loop (cdr args)) ) ) ) ) )
    77     (unless hr (set! hr 12))
    78     (unless mn (set! mn 0))
    79     (let ((tz (get-tz yr mo dy hr mn offset?)))
    80       (if offset? (string->number tz)
    81           tz ) ) ) )
     65      (if (null? args) (begin (unless hr (set! hr 12)) (unless mn (set! mn 0)))
     66          (let ((arg (car args)))
     67            (cond ((keyword? arg)
     68                   (if (eq? #:offset? arg) (set! offset? (cadr args))
     69                       (error 'local-timezone "unknown keyword argument" arg) )
     70                   (loop (cddr args)) )
     71                  ((and hr mn)
     72                   (error 'local-timezone "too many optional arguments" args) )
     73                  ((and (fixnum? arg) (<= 0 arg))
     74                   (if hr (set! mn arg) (set! hr arg))
     75                   (loop (cdr args)) )
     76                  (else
     77                   (error 'local-timezone "bad argument type - expected non-negative fixnum" arg) ) ) ) ) )
     78
     79    (get-tz yr mo dy hr mn offset?) ) )
     80
     81;; Return the timezone offset as seconds where positive is east of UTC &
     82;; negative is west of UTC.
     83
     84(define (local-timezone-offset yr mo dy #!optional (hr 12) (mn 0))
     85  (let* ((tzo (local-timezone yr mo dy hr mn #:offset? #t))
     86         (1stch (string-ref tzo 0))
     87         (neg? (char=? #\- 1stch))
     88         (start (if (or neg? (char=? #\+ 1stch)) 1 0))
     89         (end (+ start 2))
     90         (secs (+ (* (string->number (substring tzo start end)) 3600)
     91                  (* (string->number (substring tzo end (+ end 2))) 60))) )
     92    (if neg? (- secs) secs) ) )
Note: See TracChangeset for help on using the changeset viewer.