Ignore:
Timestamp:
04/22/18 18:46:48 (7 months ago)
Author:
kon
Message:

reflow

File:
1 edited

Legend:

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

    r35363 r35430  
    4848(define (get-tz tv)
    4949  ;Note that the tz-off should be in the tv!
    50   (let* ((tz (time->string (seconds->local-time (local-time->seconds tv)) "%z %Z"))
    51          (1stch (string-ref tz 0))
    52          (neg? (char=? #\- 1stch))
    53          (start (if (or neg? (char=? #\+ 1stch)) 1 0))
    54          (end (+ start 2))
    55          (secs (+ (* (string->number (substring tz start end)) 3600)
    56                   (* (string->number (substring tz end (+ end 2))) 60))) )
     50  (let* (
     51    (tz (time->string (seconds->local-time (local-time->seconds tv)) "%z %Z"))
     52    (1stch (string-ref tz 0))
     53    (neg? (char=? #\- 1stch))
     54    (start (if (or neg? (char=? #\+ 1stch)) 1 0))
     55    (end (+ start 2))
     56    (secs
     57      (+
     58        (* (string->number (substring tz start end)) 3600)
     59        (* (string->number (substring tz end (+ end 2))) 60))) )
    5760    (values (if neg? (- secs) secs) (substring tz (+ start 5))) ) )
    5861
    5962;#!required tv | yr mo dy #!optional (hr 12) (mn 0) (sc 0) #!key dst?
    6063(define (*local-tz-info loc . args)
    61 
    62   (let ((argcnt (length args))
    63         (yr #f) (mo #f) (dy #f) (hr #f) (mn #f) (sc #f) (dst? #f))
    64 
     64  ;
     65  (let (
     66    (argcnt (length args))
     67    (yr #f) (mo #f) (dy #f) (hr #f) (mn #f) (sc #f) (dst? #f) )
     68    ;
    6569    (define (kwdarg kwd rest)
    6670      (cond
    6771        ((eq? #:dst? kwd) (set! dst? (cadr rest)) )
    6872        (else (error-argument-type loc "keyword #:dst?" kwd) ) ) )
    69 
     73    ;
    7074    ; DSSSL lambda list parsing behavior as I wish it was
    7175    (check-minimum-argument-count loc argcnt 1)
    7276    (if (vector? (car args))
    73         ;then time-vector is argument
    74         ;kwd dst? overrides vector elm
    75         (let ((tv (car args)))
    76           (when (< (vector-length tv) 10)
    77             (error-argument-type loc tv "ten element time vector") )
    78           (set! dst? (vector-ref tv 8))
    79           (set! yr (+ (vector-ref tv 5) 1900))
    80           (set! mo (vector-ref tv 4))
    81           (set! dy (vector-ref tv 3))
    82           (set! hr (vector-ref tv 2))
    83           (set! mn (vector-ref tv 1))
    84           (set! sc (vector-ref tv 0))
    85           (let loop ((args (cdr args)))
    86             (unless (null? args)
    87               (let ((arg (car args)))
    88                 (cond
    89                   ((keyword? arg)
    90                     (kwdarg arg args)
    91                     (loop (cddr args)) )
    92                   (else
    93                     (error-keyword loc arg) ) ) ) ) ) )
    94         ;else atomic time elements
    95         (begin
    96           (check-minimum-argument-count loc argcnt 3)
    97           (set! yr (car args))
    98           (set! mo (cadr args))
    99           (set! dy (caddr args))
    100           (let loop ((args (cdddr args)))
    101             (if (null? args)
    102                 (begin
    103                   (unless hr (set! hr 12))
    104                   (unless mn (set! mn 0))
    105                   (unless sc (set! sc 0)))
    106                 (let ((arg (car args)))
    107                   (cond
    108                     ((keyword? arg)
    109                       (kwdarg arg args)
    110                       (loop (cddr args)) )
    111                     ((and hr mn sc)
    112                       (error-argument-count loc argcnt 8) )
    113                     (else
    114                       (if hr (if mn (set! sc arg) (set! mn arg)) (set! hr arg))
    115                       (loop (cdr args)) ) ) ) ) ) ) )
    116 
     77      ;then time-vector is argument
     78      ;kwd dst? overrides vector elm
     79      (let ((tv (car args)))
     80        (when (< (vector-length tv) 10)
     81          (error-argument-type loc tv "ten element time vector") )
     82        (set! dst? (vector-ref tv 8))
     83        (set! yr (+ (vector-ref tv 5) 1900))
     84        (set! mo (vector-ref tv 4))
     85        (set! dy (vector-ref tv 3))
     86        (set! hr (vector-ref tv 2))
     87        (set! mn (vector-ref tv 1))
     88        (set! sc (vector-ref tv 0))
     89        (let loop ((args (cdr args)))
     90          (unless (null? args)
     91            (let ((arg (car args)))
     92              (cond
     93                ((keyword? arg)
     94                  (kwdarg arg args)
     95                  (loop (cddr args)) )
     96                (else
     97                  (error-keyword loc arg) ) ) ) ) ) )
     98      ;else atomic time elements
     99      (begin
     100        (check-minimum-argument-count loc argcnt 3)
     101        (set! yr (car args))
     102        (set! mo (cadr args))
     103        (set! dy (caddr args))
     104        (let loop ((args (cdddr args)))
     105          (if (null? args)
     106            (begin
     107              (unless hr (set! hr 12))
     108              (unless mn (set! mn 0))
     109              (unless sc (set! sc 0)))
     110            (let ((arg (car args)))
     111              (cond
     112                ((keyword? arg)
     113                  (kwdarg arg args)
     114                  (loop (cddr args)) )
     115                ((and hr mn sc)
     116                  (error-argument-count loc argcnt 8) )
     117                (else
     118                  (if hr (if mn (set! sc arg) (set! mn arg)) (set! hr arg))
     119                  (loop (cdr args)) ) ) ) ) ) ) )
     120    ;
    117121    (check-fixnums loc yr mo dy hr mn sc)
    118122    (check-closed-intervals loc
     
    122126      (<= 1 dy 31)
    123127      (<= 0 mo 11))
    124 
     128    ;
    125129    (get-tz (vector sc mn hr dy mo (- yr 1900) 0 0 dst? 0)) ) )
    126130
     
    130134
    131135(define (local-timezone-name . args)
    132   (let-values (((tzo tzn) (apply *local-tz-info 'local-timezone-name args)))
     136  (let-values (
     137    ((tzo tzn) (apply *local-tz-info 'local-timezone-name args)) )
    133138    tzn ) )
    134139
     
    139144
    140145(define (local-timezone-offset . args)
    141   (let-values (((tzo tzn) (apply *local-tz-info 'local-timezone-offset args)))
     146  (let-values (
     147    ((tzo tzn) (apply *local-tz-info 'local-timezone-offset args)) )
    142148    tzo ) )
    143149
Note: See TracChangeset for help on using the changeset viewer.