Changeset 11875 in project


Ignore:
Timestamp:
09/03/08 07:19:53 (13 years ago)
Author:
Kon Lovett
Message:

Printing of \"xxx.0\" => "xxx". More use of fixnum ops in srfi-19-io.

Location:
release/3/srfi-19
Files:
6 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/3/srfi-19/tags/2.6.11/srfi-19-eggdoc.scm

    r8940 r11875  
    5959    (description (p "Time Data Types and Procedures"))
    6060    (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
    61     (history
    62       (version "2.6.10" "Dropped :optional.")
    63       (version "2.6.9" "Needs Chicken 2.610 for MacOS X & Windows.")
    64       (version "2.6.8" "Bug fix for make-date supplied dst flag. Added Bugs section.")
    65       (version "2.6.7" "Uses fixnum arithmetic where possible. Added time->julian-day, time->modified-julian-day, date comparisons. Bug fix for multiply-duration, divide-duration, & make-duration. Changed read-leap-second-table to required filename parameter.")
    66       (version "2.6.6" "Bug fix for time<=? & time>=?. Added time-period-preceding & time-period-succeeding. Split periods into srfi-19-period.")
    67       (version "2.6.5" "Bug fix for platforms not MacOS X, timezone offset was sign reversed.")
    68       (version "2.6.4" "Bug fix to time ctors/setters - allowed negative nanoseconds. Added make-local-timezone-locale w/ special case for platforms not Windows or Macintosh. Made local-timezone-locale a parameter.")
    69       (version "2.6.3" "Made time-max & time-min n-ary. Added make-null-time-period, time-negative?, time-positive?, time-zero?. Bug fix for local-timezone-offset [reported by Hans Bulfone]")
    70       (version "2.6.2" "Bug fix for local-timezone-locale, seconds->date/type, current-nanoseconds, & current-date [reported by Hans Bulfone]")
    71       (version "2.6.1" "Deprecated local-timezone-info, local-timezone-name, local-timezone-offset, and local-timezone-dst?. Bug fix for milliseconds->time. Bug fix for current-date when no tz-locale. [reported by Graham Fawcett]")
    72       (version "2.6" "Added time-period, date arithmetic, duration routines, fix for possible seconds limit in time object")
    73       (version "2.5" "Added Dutch locale, ISO-8601 conversion bug fix, 'date-year-day' bug fix [thanks to Arno Peters]")
    74       (version "2.4" "Removed annoying warnings, made srfi-19 an umbrella - uses -core & -io")
    75       (version "2.3" "Date dst? field, timezone-locale structure accessors")
    76       (version "2.2" "Bug fix for no local timezone setting situation [reported by Mario Domenech Goulart]")
    77       (version "2.1" "Bug fix for ->fixnum [reported by Mario Domenech Goulart]")
    78       (version "2.0" "Removed I/O routines to own extension")
    79       (version "1.9" "Fix, in conjunction w/ srfi-29, for locale details")
    80       (version "1.8" "Version removed")
    81       (version "1.7" "Brazilian Portuguese [thanks to Mario Domenech Goulart]")
    82       (version "1.6" "Bug fix for inexact seconds in time->date [thanks to Peter Bex]")
    83       (version "1.5" "Bug fix for compiled use")
    84       (version "1.4" "Exports")
    85       (version "1.3" "Bug fix")
    86       (version "1.2" "Slightly smaller and faster")
    87       (version "1.1" "Some SRFI-18 conflict reduction")
    88       (version "1.0" "Initial release"))
    8961
    9062    (requires
     
    561533  (examples "; See the \"srfi-19-test.scm\" file in the egg.")
    562534
     535  (history
     536    (version "2.6.11" "Printing of \"xxx.0\" => "xxx". More use of fixnum ops in srfi-19-io.")
     537    (version "2.6.10" "Dropped :optional.")
     538    (version "2.6.9" "Needs Chicken 2.610 for MacOS X & Windows.")
     539    (version "2.6.8" "Bug fix for make-date supplied dst flag. Added Bugs section.")
     540    (version "2.6.7" "Uses fixnum arithmetic where possible. Added time->julian-day, time->modified-julian-day, date comparisons. Bug fix for multiply-duration, divide-duration, & make-duration. Changed read-leap-second-table to required filename parameter.")
     541    (version "2.6.6" "Bug fix for time<=? & time>=?. Added time-period-preceding & time-period-succeeding. Split periods into srfi-19-period.")
     542    (version "2.6.5" "Bug fix for platforms not MacOS X, timezone offset was sign reversed.")
     543    (version "2.6.4" "Bug fix to time ctors/setters - allowed negative nanoseconds. Added make-local-timezone-locale w/ special case for platforms not Windows or Macintosh. Made local-timezone-locale a parameter.")
     544    (version "2.6.3" "Made time-max & time-min n-ary. Added make-null-time-period, time-negative?, time-positive?, time-zero?. Bug fix for local-timezone-offset [reported by Hans Bulfone]")
     545    (version "2.6.2" "Bug fix for local-timezone-locale, seconds->date/type, current-nanoseconds, & current-date [reported by Hans Bulfone]")
     546    (version "2.6.1" "Deprecated local-timezone-info, local-timezone-name, local-timezone-offset, and local-timezone-dst?. Bug fix for milliseconds->time. Bug fix for current-date when no tz-locale. [reported by Graham Fawcett]")
     547    (version "2.6" "Added time-period, date arithmetic, duration routines, fix for possible seconds limit in time object")
     548    (version "2.5" "Added Dutch locale, ISO-8601 conversion bug fix, 'date-year-day' bug fix [thanks to Arno Peters]")
     549    (version "2.4" "Removed annoying warnings, made srfi-19 an umbrella - uses -core & -io")
     550    (version "2.3" "Date dst? field, timezone-locale structure accessors")
     551    (version "2.2" "Bug fix for no local timezone setting situation [reported by Mario Domenech Goulart]")
     552    (version "2.1" "Bug fix for ->fixnum [reported by Mario Domenech Goulart]")
     553    (version "2.0" "Removed I/O routines to own extension")
     554    (version "1.9" "Fix, in conjunction w/ srfi-29, for locale details")
     555    (version "1.8" "Version removed")
     556    (version "1.7" "Brazilian Portuguese [thanks to Mario Domenech Goulart]")
     557    (version "1.6" "Bug fix for inexact seconds in time->date [thanks to Peter Bex]")
     558    (version "1.5" "Bug fix for compiled use")
     559    (version "1.4" "Exports")
     560    (version "1.3" "Bug fix")
     561    (version "1.2" "Slightly smaller and faster")
     562    (version "1.1" "Some SRFI-18 conflict reduction")
     563    (version "1.0" "Initial release"))
     564
    563565  (section "License" (pre ,license))
    564566) ) )
  • release/3/srfi-19/tags/2.6.11/srfi-19-io.scm

    r10022 r11875  
    8787(load-best-available-bundle! (most-specific-bundle-specifier 'srfi-19))
    8888
    89 (define (item@ key)
     89(define-inline (item@ key)
    9090  (localized-template/default 'srfi-19 key) )
    9191
     
    9696(define (tm:natural-year n)
    9797  (let* ([current-year (date-year (current-date))]
    98          [current-century (* (quotient current-year 100) 100)])
    99     (cond
    100       [(>= n 100) n]
    101       [(<  n 0) n]
    102       [(<= (- (+ current-century n) current-year) 50) (+ current-century n)]
    103       [else (+ (- current-century 100) n)]) ) )
     98         [current-century (fx* (fx/ current-year 100) 100)])
     99    (cond [(fx>= n 100)
     100            n]
     101          [(fx< n 0)
     102            n]
     103          [(fx<= (fx- (fx+ current-century n) current-year) 50)
     104            (fx+ current-century n)]
     105          [else
     106            (fx+ (fx- current-century 100) n)]) ) )
    104107
    105108;; Return a string representing the decimal expansion of the fractional
     
    107110
    108111(define (tm:decimal-expansion r precision)
    109   (let loop ([num (- r (round r))] [p precision] [lst '()])
    110     (if (or (zero? p) (zero? num))
    111       (apply string-append (reverse! lst))
    112       (let* ([num-times-10 (* 10 num)]
    113              [round-num-times-10 (round num-times-10)])
    114         (loop (- num-times-10 round-num-times-10)
    115               (sub1 p)
    116               (cons (number->string (inexact->exact round-num-times-10))
    117                     lst)) ) ) ) )
     112  (let loop ([num (- r (round r))]
     113             [p precision]
     114             [lst '()])
     115    (if (or (fx= 0 p) (zero? num))
     116        (apply string-append (reverse! lst))
     117        (let* ([num-times-10 (* 10 num)]
     118               [round-num-times-10 (round num-times-10)])
     119          (loop (- num-times-10 round-num-times-10)
     120                (fx- p 1)
     121                (cons (number->string (inexact->exact round-num-times-10))
     122                      lst)) ) ) ) )
    118123
    119124;; Returns a string rep. of number N, of minimum LENGTH,
     
    123128
    124129(define (tm:padding n pad-with length)
    125   (let ([str (number->string n)])
    126     (if (or (not pad-with) (> (string-length str) length))
    127       str
    128       (string-pad str length pad-with)) ) )
     130  (let* ([str (number->string n)]
     131         [len (string-length str)])
     132    (let ((str (if (and (fx>= len 2)
     133                        (char=? #\. (string-ref str (fx- len 2)))
     134                        (char=? #\0 (string-ref str (fx- len 1))) )
     135                   (substring str 0 (fx- len 2))
     136                   str) ) )
     137      (if (or (not pad-with) (> len length))
     138          str
     139          (string-pad str length pad-with)) ) ) )
    129140
    130141(define (tm:last-n-digits i n)
     
    174185(define (tm:tz-printer offset port)
    175186  (if (= offset 0)
    176     (display "Z" port)
    177     (begin
    178       (cond
    179         [(negative? offset) (display #\- port)]
    180         [else (display #\+ port)])
    181       (let ([offset (abs offset)])
    182         (display
    183           (tm:padding (quotient offset SEC/HR) #\0 2)
    184           port)
    185         (display
    186           (tm:padding (quotient (remainder offset SEC/HR) SEC/MIN) #\0 2)
    187           port) ) ) ) )
     187      (display "Z" port)
     188      (let ((isneg (fx< offset 0)))
     189        (display (if isneg #\- #\+) port)
     190        (let ([offset (if isneg (fxneg offset) offset)])
     191          (display (tm:padding (quotient offset SEC/HR) #\0 2) port)
     192          (display (tm:padding (quotient (remainder offset SEC/HR) SEC/MIN) #\0 2) port) ) ) ) )
    188193
    189194;; A table of output formatting directives.
     
    216221    (cons #\c
    217222      (lambda (date pad-with port)
    218         (display (date->string date
    219               (item@ LOCALE-DATE-TIME-FORMAT)) port)))
     223        (display (date->string date (item@ LOCALE-DATE-TIME-FORMAT)) port)))
    220224
    221225    (cons #\d
     
    234238      (lambda (date pad-with port)
    235239        (let ([ns (date-nanosecond date)] [sec (date-second date)])
    236           (if (> ns NS/S) ;this shouldn't happen!
    237             (display (tm:padding (+ sec 1) pad-with 2) port)
    238             (display (tm:padding sec pad-with 2) port))
     240          (if (> ns NS/S) ; This shouldn't happen!
     241              (display (tm:padding (+ sec 1) pad-with 2) port)
     242              (display (tm:padding sec pad-with 2) port))
    239243          (let ([f (tm:decimal-expansion (/ ns NS/S) 6)])
    240             (when (positive? (string-length f))
     244            (when (fx> (string-length f) 0)
    241245              (display (item@ LOCALE-NUMBER-SEPARATOR) port)
    242246              (display f port))))))
     
    253257      (lambda (date pad-with port)
    254258        (let ([hr (date-hour date)])
    255           (if (> hr 12)
    256             (display (tm:padding (- hr 12) pad-with 2) port)
    257             (display (tm:padding hr pad-with 2) port)))))
     259          (if (fx> hr 12)
     260              (display (tm:padding (fx- hr 12) pad-with 2) port)
     261              (display (tm:padding hr pad-with 2) port)))))
    258262
    259263    (cons #\j
     
    268272      (lambda (date pad-with port)
    269273        (let ([hr (date-hour date)])
    270           (display (tm:padding (if (> hr 12) (- hr 12) hr) #\space 2) port))))
     274          (display (tm:padding (if (fx> hr 12) (fx- hr 12) hr) #\space 2) port))))
    271275
    272276    (cons #\m
     
    301305      (lambda (date pad-with port)
    302306        (let ([sec (date-second date)])
    303           (if (> (date-nanosecond date) NS/S)
    304             (display (tm:padding (+ sec 1) pad-with 2) port)
    305             (display (tm:padding sec pad-with 2) port)))))
     307          (if (> (date-nanosecond date) NS/S) ; This shouldn't happen!
     308              (display (tm:padding (+ sec 1) pad-with 2) port)
     309              (display (tm:padding sec pad-with 2) port)))))
    306310
    307311    (cons #\t
     
    316320      (lambda (date pad-with port)
    317321        (let ([wkno (date-week-number date 0)])
    318           (if (positive? (tm:days-before-first-week date 0))
    319             (display (tm:padding (+ wkno 1) #\0 2) port)
    320             (display (tm:padding wkno #\0 2) port)))))
     322          (if (fx> (tm:days-before-first-week date 0) 0)
     323              (display (tm:padding (fx+ wkno 1) #\0 2) port)
     324              (display (tm:padding wkno #\0 2) port)))))
    321325
    322326    (cons #\V
     
    331335      (lambda (date pad-with port)
    332336        (let ([wkno (date-week-number date 1)])
    333           (if (positive? (tm:days-before-first-week date 1))
    334             (display (tm:padding (+ wkno 1) #\0 2) port)
    335             (display (tm:padding wkno #\0 2) port)))))
     337          (if (fx> (tm:days-before-first-week date 1) 0)
     338              (display (tm:padding (fx+ wkno 1) #\0 2) port)
     339              (display (tm:padding wkno #\0 2) port)))))
    336340
    337341    (cons #\x
     
    378382    (cons #\5
    379383      (lambda (date pad-with port)
    380         (display (date->string date "~Y-~m-~dT~H:~M:~S") port)))
    381   ))
     384        (display (date->string date "~Y-~m-~dT~H:~M:~S") port))) ) )
    382385
    383386(define (tm:date-printer loc date format-rem len-rem port)
     
    389392              (and-let* ([associated (assoc char tm:display-directives)])
    390393                (cdr associated)))])
    391       (cond
    392         [(not (char=? current-char #\~))
    393           (display current-char port)
    394           (tm:date-printer loc date (cdr format-rem) (fx- len-rem 1) port)]
    395         [(fx< len-rem 2)
    396           (error loc "bad date format" (list->string format-rem))]
    397         [else
    398           (let ([pad-ch (cadr format-rem)])
    399             (cond
    400               [(char=? pad-ch #\-)
    401                 (if (fx< len-rem 3)
    402                   (error loc "bad date format" (list->string format-rem))
    403                   (let ([formatter (get-formatter (caddr format-rem))])
    404                     (if (not formatter)
    405                       (error loc "bad date format" (list->string format-rem))
    406                       (begin
    407                         (formatter date #f port)
    408                         (tm:date-printer loc date (cdddr format-rem) (fx- len-rem 3) port)))))]
    409               [(char=? pad-ch #\_)
    410                 (if (fx< len-rem 3)
    411                   (error loc "bad date format" (list->string format-rem))
    412                   (let ([formatter (get-formatter (caddr format-rem))])
    413                     (if (not formatter)
    414                       (error loc "bad date format" (list->string format-rem))
    415                       (begin
    416                         (formatter date #\space port)
    417                         (tm:date-printer loc date (cdddr format-rem) (fx- len-rem 3) port)))))]
    418               [else
    419                 (let ([formatter (get-formatter pad-ch)])
    420                   (if (not formatter)
    421                     (error loc "bad date format" (list->string format-rem))
    422                     (begin
    423                       (formatter date #\0 port)
    424                       (tm:date-printer loc date (cddr format-rem) (fx- len-rem 2) port))))]))]) )) )
     394      (cond [(not (char=? current-char #\~))
     395              (display current-char port)
     396              (tm:date-printer loc date (cdr format-rem) (fx- len-rem 1) port)]
     397            [(fx< len-rem 2)
     398              (error loc "bad date format" (list->string format-rem))]
     399            [else
     400              (let ([pad-ch (cadr format-rem)])
     401                (cond [(char=? pad-ch #\-)
     402                        (if (fx< len-rem 3)
     403                            (error loc "bad date format" (list->string format-rem))
     404                            (let ([formatter (get-formatter (caddr format-rem))])
     405                              (if (not formatter)
     406                                  (error loc "bad date format" (list->string format-rem))
     407                                  (begin
     408                                    (formatter date #f port)
     409                                    (tm:date-printer loc date (cdddr format-rem)
     410                                                     (fx- len-rem 3) port)))))]
     411                      [(char=? pad-ch #\_)
     412                        (if (fx< len-rem 3)
     413                            (error loc "bad date format" (list->string format-rem))
     414                            (let ([formatter (get-formatter (caddr format-rem))])
     415                              (if (not formatter)
     416                                  (error loc "bad date format" (list->string format-rem))
     417                                  (begin
     418                                    (formatter date #\space port)
     419                                    (tm:date-printer loc date (cdddr format-rem)
     420                                                     (fx- len-rem 3) port)))))]
     421                      [else
     422                        (let ([formatter (get-formatter pad-ch)])
     423                          (if (not formatter)
     424                              (error loc "bad date format" (list->string format-rem))
     425                              (begin
     426                                (formatter date #\0 port)
     427                                (tm:date-printer loc date (cddr format-rem)
     428                                                 (fx- len-rem 2) port))))]))]) )) )
    425429
    426430(define (format-date dest fmt-str . r)
    427431  (let ([port #f] [date (optional r #f)])
    428     (cond
    429       [(not dest)
    430         (set! port (open-output-string))]
    431       [(string? dest)
    432         (set! date fmt-str)
    433         (set! fmt-str dest)
    434         (set! port (open-output-string))]
    435       [(number? dest)
    436         (set! port (current-error-port))]
    437       [(port? dest)
    438         (set! port dest)]
    439       [else
    440         (set! port (current-output-port))])
     432    (cond [(not dest)
     433            (set! port (open-output-string))]
     434          [(string? dest)
     435            (set! date fmt-str)
     436            (set! fmt-str dest)
     437            (set! port (open-output-string))]
     438          [(number? dest)
     439            (set! port (current-error-port))]
     440          [(port? dest)
     441            (set! port dest)]
     442          [else
     443            (set! port (current-output-port))])
    441444    (tm:date-printer 'display-date date (string->list fmt-str) (string-length fmt-str) port)
    442445    (if (or (not dest) (string? dest))
    443       (get-output-string port)
    444       #t) ) )
     446        (get-output-string port)
     447        #t) ) )
    445448
    446449(define (date->string date . format-string)
     
    472475              (not (char-numeric? ch))
    473476              (and upto (fx>= nchars upto)))
    474         accum
    475         (loop
    476           (fx+ (fx* accum 10) (tm:char->int (read-char port)))
    477           (fx+ nchars 1))) ) ) )
     477          accum
     478          (loop (fx+ (fx* accum 10) (tm:char->int (read-char port))) (fx+ nchars 1))) ) ) )
    478479
    479480(define (tm:make-integer-reader upto)
     
    487488    (let loop ([accum 0] [nchars 0])
    488489      (let ([ch (peek-char port)])
    489         (cond
    490           [(fx>= nchars n)
    491             accum]
    492           [(eof-object? ch)
    493             (error 'string->date "bad date template: premature ending to integer read")]
    494           [(char-numeric? ch)
    495             (set! padding-ok #f)
    496             (loop
    497               (fx+ (fx* accum 10) (tm:char->int (read-char port)))
    498               (fx+ nchars 1))]
    499           [padding-ok
    500             (read-char port)    ; consume padding
    501             (loop accum (fx+ nchars 1))]
    502           [else                 ; padding where it shouldn't be
    503             (error 'string->date "bad date template: non-numeric characters in integer read")]) ) ) ) )
     490        (cond [(fx>= nchars n)
     491                accum]
     492              [(eof-object? ch)
     493                (error 'string->date "bad date template: premature ending to integer read")]
     494              [(char-numeric? ch)
     495                (set! padding-ok #f)
     496                (loop (fx+ (fx* accum 10) (tm:char->int (read-char port))) (fx+ nchars 1))]
     497              [padding-ok
     498                (read-char port)    ; consume padding
     499                (loop accum (fx+ nchars 1))]
     500              [else                 ; padding where it shouldn't be
     501                (error 'string->date "bad date template: non-numeric characters in integer read")]) ) ) ) )
    504502
    505503(define (tm:make-integer-exact-reader n)
     
    513511        (error 'string->date "bad date template: invalid time zone +/-"))
    514512      (if (or (char=? ch #\Z) (char=? ch #\z))
    515         0
    516         (begin
    517           (cond
    518             [(char=? ch #\+) (set! is-pos #t)]
    519             [(char=? ch #\-) (set! is-pos #f)]
    520             [else (error 'string->date "bad date template: invalid time zone +/-" ch)])
    521           (let ([ch (read-char port)])
    522             (when (eof-object? ch)
    523               (error 'string->date "bad date template: invalid time zone number"))
    524             (set! offset (fx* (tm:char->int ch) (fx* 10 SEC/HR))))
    525           ;; non-existing values are considered zero
    526           (let ([ch (read-char port)])
    527             (unless (eof-object? ch)
    528               (set! offset (fx+ offset (fx* (tm:char->int ch) SEC/HR)))))
    529           (let ([ch (read-char port)])
    530             (unless (eof-object? ch)
    531               (set! offset (fx+ offset (fx* (tm:char->int ch) 600)))))
    532           (let ([ch (read-char port)])
    533             (unless (eof-object? ch)
    534               (set! offset (fx+ offset (fx* (tm:char->int ch) 60)))))
    535           (if is-pos offset (fxneg offset)))) ) ) )
     513          0
     514          (begin
     515            (cond [(char=? ch #\+) (set! is-pos #t)]
     516                  [(char=? ch #\-) (set! is-pos #f)]
     517                  [else
     518                    (error 'string->date "bad date template: invalid time zone +/-" ch)])
     519            (let ([ch (read-char port)])
     520              (when (eof-object? ch)
     521                (error 'string->date "bad date template: invalid time zone number"))
     522              (set! offset (fx* (tm:char->int ch) (fx* 10 SEC/HR))))
     523            ;; non-existing values are considered zero
     524            (let ([ch (read-char port)])
     525              (unless (eof-object? ch)
     526                (set! offset (fx+ offset (fx* (tm:char->int ch) SEC/HR)))))
     527            (let ([ch (read-char port)])
     528              (unless (eof-object? ch)
     529                (set! offset (fx+ offset (fx* (tm:char->int ch) 600)))))
     530            (let ([ch (read-char port)])
     531              (unless (eof-object? ch)
     532                (set! offset (fx+ offset (fx* (tm:char->int ch) 60)))))
     533            (if is-pos offset (fxneg offset)))) ) ) )
    536534
    537535;; Looking at a char, read the char string, run thru indexer, return index
     
    558556  (lambda (port)
    559557    (if (char=? char (read-char port))
    560       char
    561       (error 'string->date "bad date template: invalid character match"))) )
     558        char
     559        (error 'string->date "bad date template: invalid character match"))) )
    562560
    563561;; A List of formatted read directives.
     
    642640        tm:zone-reader
    643641        (lambda (val object)
    644           (%date-zone-offset-set! object val)))
    645     )))
     642          (%date-zone-offset-set! object val))) ) ) )
    646643
    647644(define (tm:date-reader date format-rem len-rem port)
     
    651648              (let loop ([ch (peek-char port)])
    652649                (if (eof-object? ch)
    653                   (error 'scan-date "bad date template" (list->string format-rem))
    654                   (unless (skipper ch)
    655                     (read-char port)
    656                     (loop (peek-char port))))))])
     650                    (error 'scan-date "bad date template" (list->string format-rem))
     651                    (unless (skipper ch)
     652                      (read-char port)
     653                      (loop (peek-char port))))))])
    657654      (when (fx< 0 len-rem)
    658655        (let ([current-char (car format-rem)])
    659           (cond
    660             [(not (char=? current-char #\~))
    661               (let ([port-char (read-char port)])
    662                 (when (or (eof-object? port-char) (not (char=? current-char port-char)))
    663                   (error 'scan-date "bad date template" (list->string format-rem))))
    664               (loop (cdr format-rem) (fx- len-rem 1))]
    665               ;; otherwise, it's an escape, we hope
    666             [(fx< len-rem 2)
    667               (error 'scan-date "bad date template" (list->string format-rem))]
    668             [else
    669               (let* ([format-char (cadr format-rem)]
    670                      [format-info (assoc format-char tm:read-directives)])
    671                 (unless format-info
    672                   (error 'scan-date "bad date template" (list->string format-rem)))
    673                 (let ([skipper (cadr format-info)]
    674                       [reader (caddr format-info)]
    675                       [actor (cadddr format-info)])
    676                   (skip-until skipper)
    677                   (let ([val (reader port)])
    678                     (if (eof-object? val)
    679                       (error 'scan-date "bad date template" (list->string format-rem))
    680                       (actor val date))))
    681                 (loop (cddr format-rem) (fx- len-rem 2)))]) ) ) ) ) )
     656          (cond [(not (char=? current-char #\~))
     657                  (let ([port-char (read-char port)])
     658                    (when (or (eof-object? port-char)
     659                              (not (char=? current-char port-char)))
     660                      (error 'scan-date "bad date template" (list->string format-rem))))
     661                  (loop (cdr format-rem) (fx- len-rem 1))]
     662                  ;; otherwise, it's an escape, we hope
     663                [(fx< len-rem 2)
     664                  (error 'scan-date "bad date template" (list->string format-rem))]
     665                [else
     666                  (let* ([format-char (cadr format-rem)]
     667                         [format-info (assoc format-char tm:read-directives)])
     668                    (unless format-info
     669                      (error 'scan-date "bad date template" (list->string format-rem)))
     670                    (let ([skipper (cadr format-info)]
     671                          [reader (caddr format-info)]
     672                          [actor (cadddr format-info)])
     673                      (skip-until skipper)
     674                      (let ([val (reader port)])
     675                        (if (eof-object? val)
     676                            (error 'scan-date "bad date template" (list->string format-rem))
     677                            (actor val date))))
     678                    (loop (cddr format-rem) (fx- len-rem 2)))]) ) ) ) ) )
    682679
    683680(define (scan-date src template-string)
     
    688685    (let ([date-compl?
    689686            (lambda ()
    690               (and
    691                 (date-nanosecond newdate)
    692                 (date-second newdate) (date-minute newdate) (date-hour newdate)
    693                 (date-day newdate) (date-month newdate) (date-year newdate)
    694                 (date-zone-offset newdate)))]
     687              (and (date-nanosecond newdate)
     688                   (date-second newdate) (date-minute newdate) (date-hour newdate)
     689                   (date-day newdate) (date-month newdate) (date-year newdate)
     690                   (date-zone-offset newdate)))]
    695691          [date-ok?
    696692            (lambda ()
     
    702698                (date-zone-offset newdate)
    703699                (date-zone-name newdate)))])
    704       (cond
    705         [(string? src) (set! port (open-input-string src))]
    706         [(port? src) (set! port src)]
    707         [src (set! port (current-input-port))])
     700      (cond [(string? src)  (set! port (open-input-string src))]
     701            [(port? src)    (set! port src)]
     702            [src            (set! port (current-input-port))])
    708703      (tm:date-reader newdate (string->list template-string) (string-length template-string) port)
    709704      (unless (date-compl?)
  • release/3/srfi-19/tags/2.6.11/srfi-19.html

    r8940 r11875  
    156156<h3>Author</h3><a href="mailto:klovett@pacbell.net">Kon Lovett</a></div>
    157157<div class="section">
     158<h3>Requires</h3>
     159<ul>
     160<li>Chicken 2.610</li>
     161<li>locale</li>
     162<li>srfi-29</li>
     163<li>numbers</li></ul></div>
     164<div class="section">
     165<h3>Usage</h3><tt>(require-extension srfi-19)</tt></div>
     166<div class="section">
     167<h3>Download</h3><a href="srfi-19.egg">srfi-19.egg</a></div>
     168<div class="section">
     169<h3>Documentation</h3>
     170<p>This is a Chicken port of SRFI-19. This document only describes the extensions. For the SRFI-19 API see <a href="http://srfi.schemers.org/srfi-19/srfi-19.html">SRFI-19</a>.</p>
     171<div class="subsection">
     172<h4>Core Procedures</h4>
     173<div class="section">
     174<h3>Usage</h3>(require-extension srfi-19-core)</div>
     175<div class="subsubsection">
     176<h5>SRFI-19 Document Changes</h5>
     177<p>The <b>nanosecond</b> time object element is an integer between 0 and 999,999,999 inclusive. (The SRFI-19 document mis-states the value.)</p>
     178<p>A <i>tz-offset</i> value follows ISO 8601; positive for <em>east</em> of UTC, and negative for <em>west</em>. This is the <em>opposite</em> of the POSIX TZ environment variable.</p>
     179<p>Where the SRFI-19 document states a <i>tz-offset</i> argument a timezone-locale object is also legal.</p>
     180<p>The <code>string-&gt;date</code> procedure allows the template-name argument to be optional. When missing the locale's date-time-format string is used. The supplied locale bundle's strings are invertible.</p>
     181<dt class="definition"><strong>procedure:</strong> (make-date NANOSECOND SECOND MINUTE HOUR DAY MONTH YEAR ZONE-OFFSET [TZ-NAME #f] [DST-FLAG #f])</dt>
     182<dd>
     183<p>Same as SRFI-19 except for the optional parameters and allowing a timezone-locale object for the <tt>ZONE-OFFSET</tt>.</p></dd>
     184<dt class="definition"><strong>procedure:</strong> (read-leap-second-table FILENAME)</dt>
     185<dd>
     186<p>Sets the leap second table from the specified <tt>FILENAME</tt>.</p>
     187<p>The file format is the same as the &quot;tai-utc.dat&quot; file in the distribution. Provided by the U.S. Naval Observatory.</p></dd>
     188<dt class="definition"><strong>procedure:</strong> (leap-year? DATE)</dt>
     189<dd>
     190<p>Does the specified <tt>DATE</tt> fall on a leap year?</p></dd></div>
     191<div class="subsubsection">
     192<h5>SRFI-18 Time</h5>
     193<p>Due to conflicts between SRFI-18 and SRFI-19 procedure variables <code>srfi-19:current-time</code> is a synonym for <code>current-time</code> and <code>srfi-19:time?</code> is a synonym for <code>time?</code>.</p>
     194<dt class="definition"><strong>procedure:</strong> (time-&gt;srfi-18-time TIME)</dt>
     195<dd>
     196<p>Converts a SRFI-19 time object to a SRFI-18 time object. The conversion is really only meaningful for time-duration, but any time-type is accepted.</p></dd>
     197<dt class="definition"><strong>procedure:</strong> (srfi-18-time-&gt;time TIME)</dt>
     198<dd>
     199<p>Converts a SRFI-18 time object into a SRFI-19 time-duration object.</p></dd></div>
     200<div class="subsubsection">
     201<h5>Time Conversion</h5>
     202<dt class="definition"><strong>procedure:</strong> (seconds-&gt;time/type SECONDS [TIME-TYPE time-duration])</dt>
     203<dd>
     204<p>Converts a <tt>SECONDS</tt> value, may be fractional, into a <tt>TIME-TYPE</tt> time object.</p></dd>
     205<dt class="definition"><strong>procedure:</strong> (seconds-&gt;date/type SECONDS [TIMEZONE-INFO #f])</dt>
     206<dd>
     207<p>Converts a <tt>SECONDS</tt> value, which may be fractional, into a date object. The <tt>TIMEZONE-INFO</tt> is <code>#t</code> for the local timezone, <code>#f</code> for the utc timezone, or a timezone-locale object.</p>
     208<p><tt>SECONDS</tt> is relative to 00:00:00 January 1, 1970 UTC.</p></dd>
     209<dt class="definition"><strong>procedure:</strong> (time-&gt;nanoseconds TIME)</dt>
     210<dd>
     211<p>Returns the <tt>TIME</tt> object value as a nanoseconds value.</p></dd>
     212<dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;time NANOSECONDS [TIME-TYPE time-duration])</dt>
     213<dd>
     214<p>Returns the <tt>NANOSECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
     215<dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;seconds NANOSECONDS)</dt>
     216<dd>
     217<p>Returns the <tt>NANOSECONDS</tt> value as an inexact seconds value.</p></dd>
     218<dt class="definition"><strong>procedure:</strong> (time-&gt;milliseconds TIME)</dt>
     219<dd>
     220<p>Returns the <tt>TIME</tt> object value as a milliseconds value.</p></dd>
     221<dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;time MILLISECONDS [TIME-TYPE time-duration])</dt>
     222<dd>
     223<p>Returns the <tt>MILLISECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
     224<dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;seconds MILLISECONDS)</dt>
     225<dd>
     226<p>Returns the <tt>MILLISECONDS</tt> value as an inexact seconds value.</p></dd>
     227<dt class="definition"><strong>procedure:</strong> (time-&gt;date TIME)</dt>
     228<dd>
     229<p>Returns the <tt>TIME</tt> object value as a date. A shorthand for the <code>(time-*-&gt;date ...)</code> procedures.</p></dd>
     230<dt class="definition"><strong>procedure:</strong> (time-&gt;julian-day TIME)</dt>
     231<dd>
     232<p>Returns the julian day for the <tt>TIME</tt> object.</p></dd>
     233<dt class="definition"><strong>procedure:</strong> (time-&gt;modified-julian-day TIME)</dt>
     234<dd>
     235<p>Returns the modified julian day for the <tt>TIME</tt> object.</p></dd></div>
     236<div class="subsubsection">
     237<h5>Time Arithmetic</h5>
     238<dt class="definition"><strong>procedure:</strong> (make-duration [#:days 0] [#:hours 0] [#:minutes 0] [#:seconds 0] [#:milliseconds 0] [#:microseconds 0] [#:nanoseconds 0])</dt>
     239<dd>
     240<p>Returns a time-object of clock-type <code>time-duration</code> where the seconds and nanoseconds values are calculated by summing the keyword arguments.</p>
     241<p><code>ONE-SECOND-DURATION</code> and <code>ONE-NANOSECOND-DURATION</code> are pre-defined.</p></dd>
     242<dt class="definition"><strong>procedure:</strong> (divide-duration DURATION NUMBER)</dt>
     243<dd>
     244<p>Returns a duration, from <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
     245<dt class="definition"><strong>procedure:</strong> (divide-duration! DURATION NUMBER)</dt>
     246<dd>
     247<p>Returns <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
     248<dt class="definition"><strong>procedure:</strong> (multiply-duration DURATION NUMBER)</dt>
     249<dd>
     250<p>Returns a duration, from <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
     251<dt class="definition"><strong>procedure:</strong> (multiply-duration! DURATION NUMBER)</dt>
     252<dd>
     253<p>Returns <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
     254<dt class="definition"><strong>procedure:</strong> (time-negative? TIME)</dt>
     255<dd>
     256<p>Is <tt>TIME</tt> negative?</p>
     257<p>A time object will never have a negative nanoseconds value.</p></dd>
     258<dt class="definition"><strong>procedure:</strong> (time-positve? TIME)</dt>
     259<dd>
     260<p>Is <tt>TIME</tt> positive?</p></dd>
     261<dt class="definition"><strong>procedure:</strong> (time-zero? TIME)</dt>
     262<dd>
     263<p>Is <tt>TIME</tt> zero?</p></dd>
     264<dt class="definition"><strong>procedure:</strong> (time-abs TIME)</dt>
     265<dd>
     266<p>Returns the absolute time value, from <tt>TIME</tt>.</p></dd>
     267<dt class="definition"><strong>procedure:</strong> (time-abs! TIME)</dt>
     268<dd>
     269<p>Returns the absolute <tt>TIME</tt> value.</p></dd>
     270<dt class="definition"><strong>procedure:</strong> (time-negate TIME)</dt>
     271<dd>
     272<p>Returns the sign inverted time value, from <tt>TIME</tt>.</p></dd>
     273<dt class="definition"><strong>procedure:</strong> (time-negate! TIME)</dt>
     274<dd>
     275<p>Returns the<tt>TIME</tt> sign inverted value.</p></dd></div>
     276<div class="subsubsection">
     277<h5>Time Comparison</h5>
     278<dt class="definition"><strong>procedure:</strong> (time-max TIME1 [TIME2 ...])</dt>
     279<dd>
     280<p>Returns the maximum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd>
     281<dt class="definition"><strong>procedure:</strong> (time-min TIME1 [TIME2 ...])</dt>
     282<dd>
     283<p>Returns the minimum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd></div>
     284<div class="subsubsection">
     285<h5>Dates</h5>
     286<dt class="definition"><strong>parameter:</strong> (default-date-clock-type [CLOCK-TYPE time-utc])</dt>
     287<dd>
     288<p>Sets or gets the clock-type used by default for conversion of a date to a time.</p></dd>
     289<dt class="definition"><strong>procedure:</strong> (copy-date DATE)</dt>
     290<dd>
     291<p>Returns an exact copy of the specified <tt>DATE</tt> object.</p></dd>
     292<dt class="definition"><strong>procedure:</strong> (date-&gt;time DATE [CLOCK-TYPE (default-date-clock-type)])</dt>
     293<dd>
     294<p>Returns the specified <tt>DATE</tt> as a time-object of type <tt>CLOCK-TYPE</tt>.</p></dd>
     295<dt class="definition"><strong>procedure:</strong> (date-zone-name DATE)</dt>
     296<dd>
     297<p>Returns the timezone abbreviation of the specified <tt>DATE</tt> object. The result is either a string or <code>#f</code>.</p></dd>
     298<dt class="definition"><strong>procedure:</strong> (date-dst? DATE)</dt>
     299<dd>
     300<p>Returns the daylight saving time flag of the specified <tt>DATE</tt> object.</p>
     301<p>Only valid for &quot;current&quot; dates. Historical dates will not have a correct setting. Future dates cannot have a correct setting.</p></dd></div>
     302<div class="subsubsection">
     303<h5>Date Arithmetic</h5>
     304<dt class="definition"><strong>procedure:</strong> (date-difference DATE1 DATE2 [CLOCK-TYPE])</dt>
     305<dd>
     306<p>Returns the duration between <tt>DATE1</tt> and <tt>DATE2</tt>.</p></dd>
     307<dt class="definition"><strong>procedure:</strong> (date-add-duration DATE DURATION [CLOCK-TYPE])</dt>
     308<dd>
     309<p>Returns the <tt>DATE</tt> plus the <tt>DURATION</tt>.</p></dd>
     310<dt class="definition"><strong>procedure:</strong> (date-subtract-duration DATE DURATION [CLOCK-TYPE])</dt>
     311<dd>
     312<p>Returns the <tt>DATE</tt> minus the <tt>DURATION</tt>.</p></dd></div>
     313<div class="subsubsection">
     314<h5>Date Comparison</h5>
     315<dt class="definition"><strong>procedure:</strong> (date=? DATE1 DATE2)</dt>
     316<dd>
     317<p>Is <tt>DATE1</tt> on <tt>DATE2</tt>?</p></dd>
     318<dt class="definition"><strong>procedure:</strong> (date&gt;? DATE1 DATE2)</dt>
     319<dd>
     320<p>Is <tt>DATE1</tt> after <tt>DATE2</tt>?</p></dd>
     321<dt class="definition"><strong>procedure:</strong> (date&lt;? DATE1 DATE2)</dt>
     322<dd>
     323<p>Is <tt>DATE1</tt> before <tt>DATE2</tt>?</p></dd>
     324<dt class="definition"><strong>procedure:</strong> (date&gt;=? DATE1 DATE2)</dt>
     325<dd>
     326<p>Is <tt>DATE1</tt> after or on <tt>DATE2</tt>?</p></dd>
     327<dt class="definition"><strong>procedure:</strong> (date&lt;=? DATE1 DATE2)</dt>
     328<dd>
     329<p>Is <tt>DATE1</tt> before or on <tt>DATE2</tt>?</p></dd></div>
     330<div class="subsubsection">
     331<h5>Timezone</h5>
     332<p><b>Note</b> that the daylight saving time (summer time) flag is <em>always</em> taken from the system, unless supplied. Any summer time rule component of a <code>timezone-components</code> object is <em>not</em> processed.</p>
     333<p>Remember that SRFI-19 timezone offset follows ISO 8601.</p>
     334<dt class="definition"><strong>procedure:</strong> (make-timezone-locale DST-FLAG TZ-COMPONENTS)</dt>
     335<dd>
     336<p>Returns a timezone-locale object.</p>
     337<p>A <tt>TZ-COMPONENTS</tt> object is as described by the <a href="locale.html">locale egg</a>.</p></dd>
     338<dt class="definition"><strong>procedure:</strong> (timezone-locale? OBJ)</dt>
     339<dd>
     340<p>Is the <tt>OBJ</tt> a timezone-locale object?</p></dd>
     341<dt class="definition"><strong>procedure:</strong> (make-local-timezone-locale)</dt>
     342<dd>
     343<p>Creates a local timezone-locale object. When the current timezone is not set a timezone-locale is built with information from <code>(seconds-&gt;local-time (current-seconds))</code>.</p></dd>
     344<dt class="definition"><strong>parameter:</strong> (local-timezone-locale [TZ-LOCALE])</dt>
     345<dd>
     346<p>Gets or sets the local timezone-locale object.</p></dd>
     347<dt class="definition"><strong>parameter:</strong> (utc-timezone-locale [TZ-LOCALE])</dt>
     348<dd>
     349<p>Gets or sets the utc timezone-locale object.</p>
     350<p>Probably not a good idea to change the value.</p></dd>
     351<dt class="definition"><strong>procedure:</strong> (timezone-locale-name [TZ-LOCALE])</dt>
     352<dd>
     353<p>Returns the timezone-locale name of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
     354<dt class="definition"><strong>procedure:</strong> (timezone-locale-offset [TZ-LOCALE])</dt>
     355<dd>
     356<p>Returns the timezone-locale offset of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
     357<dt class="definition"><strong>procedure:</strong> (timezone-locale-dst? [TZ-LOCALE])</dt>
     358<dd>
     359<p>Returns the timezone-locale daylight saving time flag of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd></div></div>
     360<div class="subsection">
     361<h4>Time Period</h4>
     362<div class="section">
     363<h3>Usage</h3>(require-extension srfi-19-period)</div>
     364<p>A time-period is an interval, [begin end), where begin and end are time objects of the same clock type. When end &lt;= begin the interval is null.</p>
     365<dt class="definition"><strong>procedure:</strong> (make-null-time-period [CLOCK-TYPE (default-date-clock-type)])</dt>
     366<dd>
     367<p>Returns a null interval for the specified <tt>CLOCK-TYPE</tt>.</p></dd>
     368<dt class="definition"><strong>procedure:</strong> (make-time-period BEGIN END [CLOCK-TYPE (default-date-clock-type)])</dt>
     369<dd>
     370<p>Returns a new time-period object. The clock types must be compatible.</p>
     371<p><tt>BEGIN</tt> maybe a seconds value, a date, or a time (except time-duration). A seconds value or date are converted to <tt>CLOCK-TYPE</tt>.</p>
     372<p><tt>END</tt> maybe a seconds value, a date, or a time. A seconds value or date are converted to the same clock type as <tt>BEGIN</tt>. A time-duration is treated as an offset from <tt>BEGIN</tt>.</p></dd>
     373<dt class="definition"><strong>procedure:</strong> (copy-time-period TIME-PERIOD)</dt>
     374<dd>
     375<p>Returns a copy of <tt>TIME-PERIOD</tt>.</p></dd>
     376<dt class="definition"><strong>procedure:</strong> (time-period-begin TIME-PERIOD)</dt>
     377<dd>
     378<p>Returns the start time for the <tt>TIME-PERIOD</tt>.</p></dd>
     379<dt class="definition"><strong>procedure:</strong> (time-period-end TIME-PERIOD)</dt>
     380<dd>
     381<p>Returns the end time for the <tt>TIME-PERIOD</tt>.</p></dd>
     382<dt class="definition"><strong>procedure:</strong> (time-period-last TIME-PERIOD)</dt>
     383<dd>
     384<p>Returns the last time for the <tt>TIME-PERIOD</tt>; (time-period-end - 1ns).</p></dd>
     385<dt class="definition"><strong>procedure:</strong> (time-period-type TIME-PERIOD)</dt>
     386<dd>
     387<p>Returns the clock-type of the <tt>TIME-PERIOD</tt>.</p></dd>
     388<dt class="definition"><strong>procedure:</strong> (time-period? OBJECT)</dt>
     389<dd>
     390<p>Is <tt>OBJECT</tt> a time-period?</p></dd>
     391<dt class="definition"><strong>procedure:</strong> (time-period-null? TIME-PERIOD)</dt>
     392<dd>
     393<p>Is the <tt>TIME-PERIOD</tt> null?</p></dd>
     394<dt class="definition"><strong>procedure:</strong> (time-period-length TIME-PERIOD)</dt>
     395<dd>
     396<p>Returns the time-duration of the <tt>TIME-PERIOD</tt>.</p></dd>
     397<dt class="definition"><strong>procedure:</strong> (time-period=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     398<dd>
     399<p>Does <tt>TIME-PERIOD-1</tt> begin &amp; end with <tt>TIME-PERIOD-2</tt>?</p></dd>
     400<dt class="definition"><strong>procedure:</strong> (time-period&lt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     401<dd>
     402<p>Does <tt>TIME-PERIOD-1</tt> end before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
     403<dt class="definition"><strong>procedure:</strong> (time-period&gt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     404<dd>
     405<p>Does <tt>TIME-PERIOD-1</tt> begin after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
     406<dt class="definition"><strong>procedure:</strong> (time-period&lt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     407<dd>
     408<p>Does <tt>TIME-PERIOD-1</tt> end on or before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
     409<dt class="definition"><strong>procedure:</strong> (time-period&gt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     410<dd>
     411<p>Does <tt>TIME-PERIOD-1</tt> begin on or after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
     412<dt class="definition"><strong>procedure:</strong> (time-period-preceding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     413<dd>
     414<p>Return the portion of <tt>TIME-PERIOD-1</tt> before <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't precede.</p></dd>
     415<dt class="definition"><strong>procedure:</strong> (time-period-succeeding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     416<dd>
     417<p>Return the portion of <tt>TIME-PERIOD-1</tt> after <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't succeed.</p></dd>
     418<dt class="definition"><strong>procedure:</strong> (time-period-contains/period? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     419<dd>
     420<p>Is <tt>TIME-PERIOD-2</tt> within <tt>TIME-PERIOD-1</tt>?</p></dd>
     421<dt class="definition"><strong>procedure:</strong> (time-period-contains/time? TIME-PERIOD TIME)</dt>
     422<dd>
     423<p>Is <tt>TIME</tt> within <tt>TIME-PERIOD</tt>?</p>
     424<p><tt>TIME</tt> is converted to a compatible clock-type if possible.</p></dd>
     425<dt class="definition"><strong>procedure:</strong> (time-period-contains/date? TIME-PERIOD DATE)</dt>
     426<dd>
     427<p>Is <tt>DATE</tt> within <tt>TIME-PERIOD</tt>?</p>
     428<p><tt>DATE</tt> is converted to a compatible time if possible.</p></dd>
     429<dt class="definition"><strong>procedure:</strong> (time-period-contains? TIME-PERIOD OBJECT)</dt>
     430<dd>
     431<p>Is <tt>OBJECT</tt> within <tt>TIME-PERIOD</tt>?</p>
     432<p><tt>OBJECT</tt> maybe a time, date, or time-period.</p></dd>
     433<dt class="definition"><strong>procedure:</strong> (time-period-intersects? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     434<dd>
     435<p>Does <tt>TIME-PERIOD-2</tt> overlap <tt>TIME-PERIOD-1</tt>?</p></dd>
     436<dt class="definition"><strong>procedure:</strong> (time-period-intersection TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     437<dd>
     438<p>The overlapping time-period of <tt>TIME-PERIOD-2</tt> and <tt>TIME-PERIOD-1</tt>, or <code>#f</code> when no overlap.</p></dd>
     439<dt class="definition"><strong>procedure:</strong> (time-period-union TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     440<dd>
     441<p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, or <code>#f</code> when they do not intersect.</p></dd>
     442<dt class="definition"><strong>procedure:</strong> (time-period-span TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     443<dd>
     444<p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, including any gaps.</p></dd>
     445<dt class="definition"><strong>procedure:</strong> (time-period-shift TIME-PERIOD DURATION)</dt>
     446<dd>
     447<p>Returns a copy of <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd>
     448<dt class="definition"><strong>procedure:</strong> (time-period-shift! TIME-PERIOD DURATION)</dt>
     449<dd>
     450<p>Returns <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd></div>
     451<div class="subsection">
     452<h4>Input/Output Procedures</h4>
     453<div class="section">
     454<h3>Usage</h3>(require-extension srfi-19-io)</div>
     455<dt class="definition"><strong>procedure:</strong> (format-date DESTINATION DATE-FORMAT-STRING [DATE])</dt>
     456<dd>
     457<p>Displays a text form of the <tt>DATE</tt> on the <tt>DESTINATION</tt> using the <tt>DATE-FORMAT-STRING</tt>.</p>
     458<p>When the destination is <code>#t</code> the <code>(current-output-port)</code> is used, and the date object must be specified.</p>
     459<p>When the destination is a string the <tt>DATE-FORMAT-STRING</tt> value must be a date object, the <tt>DESTINATION</tt> value is used as the <tt>DATE-FORMAT-STRING</tt>, and the result is returned as a string.</p>
     460<p>When the destination is a port it must be an <code>output-port</code>, and the date object must be specified. When the destination is a number the <code>(current-error-port)</code> is the destination, and the <tt>DATE</tt> object must be specified.</p>
     461<p>When the destination is <code>#f</code> the result is returned as a string, and the <tt>DATE</tt> object must be specified.</p></dd>
     462<dt class="definition"><strong>procedure:</strong> (scan-date SOURCE TEMPLATE-STRING)</dt>
     463<dd>
     464<p>Reads a text form of a date from the <tt>SOURCE</tt>, following the <tt>TEMPLATE-STRING</tt>, and returns a date object.</p>
     465<p>When the source is <code>#t</code> the <code>(current-input-port)</code> is used.</p>
     466<p>When the source is a port it must be an <code>input-port</code>.</p>
     467<p>When the source is string it should be a date text form.</p></dd></div></div>
     468<div class="section">
     469<h3>Bugs</h3>
     470<p>Local timezone information is not necessarily valid for historic dates and problematic for future dates. Daylight saving time is especially an issue. Conversion of a time or seconds value to a local date will use the current timezone offset value. The current offset will reflect the daylight saving time status. So target dates outside of the DST period will be converted incorrectly!</p>
     471<p>Will not read years less than 1 properly. The ISO 8601 year convention for years 1 BCE and before and years 10000 CE and after is not supported.</p></div>
     472<div class="section">
     473<h3>Issues</h3>
     474<p>31 December 1 BCE + 1 day =&gt; 1 January 1 CE. There is no year 0. Unlike the ISO 8601 convention do not subtract 1 when converting a year BCE to a SRFI-19 year, just negate the year.</p>
     475<p>The SRFI-18 <code>current-time</code> and <code>time?</code> bindings conflict with SRFI-19 bindings.</p>
     476<p>The SRFI-18 time object is not accepted except by the conversion procedures.</p>
     477<p>The expression <code>(time=? (seconds-&gt;time/type (nanoseconds-&gt;seconds (time-&gt;nanoseconds &lt;time-duration&gt;))) &lt;time-duration&gt;)</code> might be <code>#f</code>, due to the use of inexact arithmetic.</p>
     478<p>Be careful using the procedures that return some form of 'julian-day'. These are implemented using the full numeric tower and <em>will</em> return rational numbers. Performing arithmetic with such a result will require the &quot;numbers&quot; egg. See the file &quot;srfi-19-test.scm&quot; in this egg for an example.</p>
     479<p>This will be a problem with code that assumes fixnum and/or flonum <em>only</em> numbers. Perhaps an intermediate file that wraps any 'julian-day' calls and coerces to an inexact number. Use the wrapped 'julian-day' call in the problematic code.</p></div>
     480<div class="section">
     481<h3>Examples</h3>
     482<div id="examples">; See the &quot;srfi-19-test.scm&quot; file in the egg.</div></div>
     483<div class="section">
    158484<h3>Version</h3>
    159485<ul>
     486<li>2.6.11 Printing of &quot;xxx.0&quot; =&gt; xxx. More use of fixnum ops in srfi-19-10.</li>
    160487<li>2.6.10 Dropped :optional.</li>
    161488<li>2.6.9 Needs Chicken 2.610 for MacOS X &amp; Windows.</li>
     
    186513<li>1.0 Initial release</li></ul></div>
    187514<div class="section">
    188 <h3>Requires</h3>
    189 <ul>
    190 <li>Chicken 2.610</li>
    191 <li>locale</li>
    192 <li>srfi-29</li>
    193 <li>numbers</li></ul></div>
    194 <div class="section">
    195 <h3>Usage</h3><tt>(require-extension srfi-19)</tt></div>
    196 <div class="section">
    197 <h3>Download</h3><a href="srfi-19.egg">srfi-19.egg</a></div>
    198 <div class="section">
    199 <h3>Documentation</h3>
    200 <p>This is a Chicken port of SRFI-19. This document only describes the extensions. For the SRFI-19 API see <a href="http://srfi.schemers.org/srfi-19/srfi-19.html">SRFI-19</a>.</p>
    201 <div class="subsection">
    202 <h4>Core Procedures</h4>
    203 <div class="section">
    204 <h3>Usage</h3>(require-extension srfi-19-core)</div>
    205 <div class="subsubsection">
    206 <h5>SRFI-19 Document Changes</h5>
    207 <p>The <b>nanosecond</b> time object element is an integer between 0 and 999,999,999 inclusive. (The SRFI-19 document mis-states the value.)</p>
    208 <p>A <i>tz-offset</i> value follows ISO 8601; positive for <em>east</em> of UTC, and negative for <em>west</em>. This is the <em>opposite</em> of the POSIX TZ environment variable.</p>
    209 <p>Where the SRFI-19 document states a <i>tz-offset</i> argument a timezone-locale object is also legal.</p>
    210 <p>The <code>string-&gt;date</code> procedure allows the template-name argument to be optional. When missing the locale's date-time-format string is used. The supplied locale bundle's strings are invertible.</p>
    211 <dt class="definition"><strong>procedure:</strong> (make-date NANOSECOND SECOND MINUTE HOUR DAY MONTH YEAR ZONE-OFFSET [TZ-NAME #f] [DST-FLAG #f])</dt>
    212 <dd>
    213 <p>Same as SRFI-19 except for the optional parameters and allowing a timezone-locale object for the <tt>ZONE-OFFSET</tt>.</p></dd>
    214 <dt class="definition"><strong>procedure:</strong> (read-leap-second-table FILENAME)</dt>
    215 <dd>
    216 <p>Sets the leap second table from the specified <tt>FILENAME</tt>.</p>
    217 <p>The file format is the same as the &quot;tai-utc.dat&quot; file in the distribution. Provided by the U.S. Naval Observatory.</p></dd>
    218 <dt class="definition"><strong>procedure:</strong> (leap-year? DATE)</dt>
    219 <dd>
    220 <p>Does the specified <tt>DATE</tt> fall on a leap year?</p></dd></div>
    221 <div class="subsubsection">
    222 <h5>SRFI-18 Time</h5>
    223 <p>Due to conflicts between SRFI-18 and SRFI-19 procedure variables <code>srfi-19:current-time</code> is a synonym for <code>current-time</code> and <code>srfi-19:time?</code> is a synonym for <code>time?</code>.</p>
    224 <dt class="definition"><strong>procedure:</strong> (time-&gt;srfi-18-time TIME)</dt>
    225 <dd>
    226 <p>Converts a SRFI-19 time object to a SRFI-18 time object. The conversion is really only meaningful for time-duration, but any time-type is accepted.</p></dd>
    227 <dt class="definition"><strong>procedure:</strong> (srfi-18-time-&gt;time TIME)</dt>
    228 <dd>
    229 <p>Converts a SRFI-18 time object into a SRFI-19 time-duration object.</p></dd></div>
    230 <div class="subsubsection">
    231 <h5>Time Conversion</h5>
    232 <dt class="definition"><strong>procedure:</strong> (seconds-&gt;time/type SECONDS [TIME-TYPE time-duration])</dt>
    233 <dd>
    234 <p>Converts a <tt>SECONDS</tt> value, may be fractional, into a <tt>TIME-TYPE</tt> time object.</p></dd>
    235 <dt class="definition"><strong>procedure:</strong> (seconds-&gt;date/type SECONDS [TIMEZONE-INFO #f])</dt>
    236 <dd>
    237 <p>Converts a <tt>SECONDS</tt> value, which may be fractional, into a date object. The <tt>TIMEZONE-INFO</tt> is <code>#t</code> for the local timezone, <code>#f</code> for the utc timezone, or a timezone-locale object.</p>
    238 <p><tt>SECONDS</tt> is relative to 00:00:00 January 1, 1970 UTC.</p></dd>
    239 <dt class="definition"><strong>procedure:</strong> (time-&gt;nanoseconds TIME)</dt>
    240 <dd>
    241 <p>Returns the <tt>TIME</tt> object value as a nanoseconds value.</p></dd>
    242 <dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;time NANOSECONDS [TIME-TYPE time-duration])</dt>
    243 <dd>
    244 <p>Returns the <tt>NANOSECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
    245 <dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;seconds NANOSECONDS)</dt>
    246 <dd>
    247 <p>Returns the <tt>NANOSECONDS</tt> value as an inexact seconds value.</p></dd>
    248 <dt class="definition"><strong>procedure:</strong> (time-&gt;milliseconds TIME)</dt>
    249 <dd>
    250 <p>Returns the <tt>TIME</tt> object value as a milliseconds value.</p></dd>
    251 <dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;time MILLISECONDS [TIME-TYPE time-duration])</dt>
    252 <dd>
    253 <p>Returns the <tt>MILLISECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
    254 <dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;seconds MILLISECONDS)</dt>
    255 <dd>
    256 <p>Returns the <tt>MILLISECONDS</tt> value as an inexact seconds value.</p></dd>
    257 <dt class="definition"><strong>procedure:</strong> (time-&gt;date TIME)</dt>
    258 <dd>
    259 <p>Returns the <tt>TIME</tt> object value as a date. A shorthand for the <code>(time-*-&gt;date ...)</code> procedures.</p></dd>
    260 <dt class="definition"><strong>procedure:</strong> (time-&gt;julian-day TIME)</dt>
    261 <dd>
    262 <p>Returns the julian day for the <tt>TIME</tt> object.</p></dd>
    263 <dt class="definition"><strong>procedure:</strong> (time-&gt;modified-julian-day TIME)</dt>
    264 <dd>
    265 <p>Returns the modified julian day for the <tt>TIME</tt> object.</p></dd></div>
    266 <div class="subsubsection">
    267 <h5>Time Arithmetic</h5>
    268 <dt class="definition"><strong>procedure:</strong> (make-duration [#:days 0] [#:hours 0] [#:minutes 0] [#:seconds 0] [#:milliseconds 0] [#:microseconds 0] [#:nanoseconds 0])</dt>
    269 <dd>
    270 <p>Returns a time-object of clock-type <code>time-duration</code> where the seconds and nanoseconds values are calculated by summing the keyword arguments.</p>
    271 <p><code>ONE-SECOND-DURATION</code> and <code>ONE-NANOSECOND-DURATION</code> are pre-defined.</p></dd>
    272 <dt class="definition"><strong>procedure:</strong> (divide-duration DURATION NUMBER)</dt>
    273 <dd>
    274 <p>Returns a duration, from <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
    275 <dt class="definition"><strong>procedure:</strong> (divide-duration! DURATION NUMBER)</dt>
    276 <dd>
    277 <p>Returns <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
    278 <dt class="definition"><strong>procedure:</strong> (multiply-duration DURATION NUMBER)</dt>
    279 <dd>
    280 <p>Returns a duration, from <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
    281 <dt class="definition"><strong>procedure:</strong> (multiply-duration! DURATION NUMBER)</dt>
    282 <dd>
    283 <p>Returns <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
    284 <dt class="definition"><strong>procedure:</strong> (time-negative? TIME)</dt>
    285 <dd>
    286 <p>Is <tt>TIME</tt> negative?</p>
    287 <p>A time object will never have a negative nanoseconds value.</p></dd>
    288 <dt class="definition"><strong>procedure:</strong> (time-positve? TIME)</dt>
    289 <dd>
    290 <p>Is <tt>TIME</tt> positive?</p></dd>
    291 <dt class="definition"><strong>procedure:</strong> (time-zero? TIME)</dt>
    292 <dd>
    293 <p>Is <tt>TIME</tt> zero?</p></dd>
    294 <dt class="definition"><strong>procedure:</strong> (time-abs TIME)</dt>
    295 <dd>
    296 <p>Returns the absolute time value, from <tt>TIME</tt>.</p></dd>
    297 <dt class="definition"><strong>procedure:</strong> (time-abs! TIME)</dt>
    298 <dd>
    299 <p>Returns the absolute <tt>TIME</tt> value.</p></dd>
    300 <dt class="definition"><strong>procedure:</strong> (time-negate TIME)</dt>
    301 <dd>
    302 <p>Returns the sign inverted time value, from <tt>TIME</tt>.</p></dd>
    303 <dt class="definition"><strong>procedure:</strong> (time-negate! TIME)</dt>
    304 <dd>
    305 <p>Returns the<tt>TIME</tt> sign inverted value.</p></dd></div>
    306 <div class="subsubsection">
    307 <h5>Time Comparison</h5>
    308 <dt class="definition"><strong>procedure:</strong> (time-max TIME1 [TIME2 ...])</dt>
    309 <dd>
    310 <p>Returns the maximum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd>
    311 <dt class="definition"><strong>procedure:</strong> (time-min TIME1 [TIME2 ...])</dt>
    312 <dd>
    313 <p>Returns the minimum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd></div>
    314 <div class="subsubsection">
    315 <h5>Dates</h5>
    316 <dt class="definition"><strong>parameter:</strong> (default-date-clock-type [CLOCK-TYPE time-utc])</dt>
    317 <dd>
    318 <p>Sets or gets the clock-type used by default for conversion of a date to a time.</p></dd>
    319 <dt class="definition"><strong>procedure:</strong> (copy-date DATE)</dt>
    320 <dd>
    321 <p>Returns an exact copy of the specified <tt>DATE</tt> object.</p></dd>
    322 <dt class="definition"><strong>procedure:</strong> (date-&gt;time DATE [CLOCK-TYPE (default-date-clock-type)])</dt>
    323 <dd>
    324 <p>Returns the specified <tt>DATE</tt> as a time-object of type <tt>CLOCK-TYPE</tt>.</p></dd>
    325 <dt class="definition"><strong>procedure:</strong> (date-zone-name DATE)</dt>
    326 <dd>
    327 <p>Returns the timezone abbreviation of the specified <tt>DATE</tt> object. The result is either a string or <code>#f</code>.</p></dd>
    328 <dt class="definition"><strong>procedure:</strong> (date-dst? DATE)</dt>
    329 <dd>
    330 <p>Returns the daylight saving time flag of the specified <tt>DATE</tt> object.</p>
    331 <p>Only valid for &quot;current&quot; dates. Historical dates will not have a correct setting. Future dates cannot have a correct setting.</p></dd></div>
    332 <div class="subsubsection">
    333 <h5>Date Arithmetic</h5>
    334 <dt class="definition"><strong>procedure:</strong> (date-difference DATE1 DATE2 [CLOCK-TYPE])</dt>
    335 <dd>
    336 <p>Returns the duration between <tt>DATE1</tt> and <tt>DATE2</tt>.</p></dd>
    337 <dt class="definition"><strong>procedure:</strong> (date-add-duration DATE DURATION [CLOCK-TYPE])</dt>
    338 <dd>
    339 <p>Returns the <tt>DATE</tt> plus the <tt>DURATION</tt>.</p></dd>
    340 <dt class="definition"><strong>procedure:</strong> (date-subtract-duration DATE DURATION [CLOCK-TYPE])</dt>
    341 <dd>
    342 <p>Returns the <tt>DATE</tt> minus the <tt>DURATION</tt>.</p></dd></div>
    343 <div class="subsubsection">
    344 <h5>Date Comparison</h5>
    345 <dt class="definition"><strong>procedure:</strong> (date=? DATE1 DATE2)</dt>
    346 <dd>
    347 <p>Is <tt>DATE1</tt> on <tt>DATE2</tt>?</p></dd>
    348 <dt class="definition"><strong>procedure:</strong> (date&gt;? DATE1 DATE2)</dt>
    349 <dd>
    350 <p>Is <tt>DATE1</tt> after <tt>DATE2</tt>?</p></dd>
    351 <dt class="definition"><strong>procedure:</strong> (date&lt;? DATE1 DATE2)</dt>
    352 <dd>
    353 <p>Is <tt>DATE1</tt> before <tt>DATE2</tt>?</p></dd>
    354 <dt class="definition"><strong>procedure:</strong> (date&gt;=? DATE1 DATE2)</dt>
    355 <dd>
    356 <p>Is <tt>DATE1</tt> after or on <tt>DATE2</tt>?</p></dd>
    357 <dt class="definition"><strong>procedure:</strong> (date&lt;=? DATE1 DATE2)</dt>
    358 <dd>
    359 <p>Is <tt>DATE1</tt> before or on <tt>DATE2</tt>?</p></dd></div>
    360 <div class="subsubsection">
    361 <h5>Timezone</h5>
    362 <p><b>Note</b> that the daylight saving time (summer time) flag is <em>always</em> taken from the system, unless supplied. Any summer time rule component of a <code>timezone-components</code> object is <em>not</em> processed.</p>
    363 <p>Remember that SRFI-19 timezone offset follows ISO 8601.</p>
    364 <dt class="definition"><strong>procedure:</strong> (make-timezone-locale DST-FLAG TZ-COMPONENTS)</dt>
    365 <dd>
    366 <p>Returns a timezone-locale object.</p>
    367 <p>A <tt>TZ-COMPONENTS</tt> object is as described by the <a href="locale.html">locale egg</a>.</p></dd>
    368 <dt class="definition"><strong>procedure:</strong> (timezone-locale? OBJ)</dt>
    369 <dd>
    370 <p>Is the <tt>OBJ</tt> a timezone-locale object?</p></dd>
    371 <dt class="definition"><strong>procedure:</strong> (make-local-timezone-locale)</dt>
    372 <dd>
    373 <p>Creates a local timezone-locale object. When the current timezone is not set a timezone-locale is built with information from <code>(seconds-&gt;local-time (current-seconds))</code>.</p></dd>
    374 <dt class="definition"><strong>parameter:</strong> (local-timezone-locale [TZ-LOCALE])</dt>
    375 <dd>
    376 <p>Gets or sets the local timezone-locale object.</p></dd>
    377 <dt class="definition"><strong>parameter:</strong> (utc-timezone-locale [TZ-LOCALE])</dt>
    378 <dd>
    379 <p>Gets or sets the utc timezone-locale object.</p>
    380 <p>Probably not a good idea to change the value.</p></dd>
    381 <dt class="definition"><strong>procedure:</strong> (timezone-locale-name [TZ-LOCALE])</dt>
    382 <dd>
    383 <p>Returns the timezone-locale name of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
    384 <dt class="definition"><strong>procedure:</strong> (timezone-locale-offset [TZ-LOCALE])</dt>
    385 <dd>
    386 <p>Returns the timezone-locale offset of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
    387 <dt class="definition"><strong>procedure:</strong> (timezone-locale-dst? [TZ-LOCALE])</dt>
    388 <dd>
    389 <p>Returns the timezone-locale daylight saving time flag of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd></div></div>
    390 <div class="subsection">
    391 <h4>Time Period</h4>
    392 <div class="section">
    393 <h3>Usage</h3>(require-extension srfi-19-period)</div>
    394 <p>A time-period is an interval, [begin end), where begin and end are time objects of the same clock type. When end &lt;= begin the interval is null.</p>
    395 <dt class="definition"><strong>procedure:</strong> (make-null-time-period [CLOCK-TYPE (default-date-clock-type)])</dt>
    396 <dd>
    397 <p>Returns a null interval for the specified <tt>CLOCK-TYPE</tt>.</p></dd>
    398 <dt class="definition"><strong>procedure:</strong> (make-time-period BEGIN END [CLOCK-TYPE (default-date-clock-type)])</dt>
    399 <dd>
    400 <p>Returns a new time-period object. The clock types must be compatible.</p>
    401 <p><tt>BEGIN</tt> maybe a seconds value, a date, or a time (except time-duration). A seconds value or date are converted to <tt>CLOCK-TYPE</tt>.</p>
    402 <p><tt>END</tt> maybe a seconds value, a date, or a time. A seconds value or date are converted to the same clock type as <tt>BEGIN</tt>. A time-duration is treated as an offset from <tt>BEGIN</tt>.</p></dd>
    403 <dt class="definition"><strong>procedure:</strong> (copy-time-period TIME-PERIOD)</dt>
    404 <dd>
    405 <p>Returns a copy of <tt>TIME-PERIOD</tt>.</p></dd>
    406 <dt class="definition"><strong>procedure:</strong> (time-period-begin TIME-PERIOD)</dt>
    407 <dd>
    408 <p>Returns the start time for the <tt>TIME-PERIOD</tt>.</p></dd>
    409 <dt class="definition"><strong>procedure:</strong> (time-period-end TIME-PERIOD)</dt>
    410 <dd>
    411 <p>Returns the end time for the <tt>TIME-PERIOD</tt>.</p></dd>
    412 <dt class="definition"><strong>procedure:</strong> (time-period-last TIME-PERIOD)</dt>
    413 <dd>
    414 <p>Returns the last time for the <tt>TIME-PERIOD</tt>; (time-period-end - 1ns).</p></dd>
    415 <dt class="definition"><strong>procedure:</strong> (time-period-type TIME-PERIOD)</dt>
    416 <dd>
    417 <p>Returns the clock-type of the <tt>TIME-PERIOD</tt>.</p></dd>
    418 <dt class="definition"><strong>procedure:</strong> (time-period? OBJECT)</dt>
    419 <dd>
    420 <p>Is <tt>OBJECT</tt> a time-period?</p></dd>
    421 <dt class="definition"><strong>procedure:</strong> (time-period-null? TIME-PERIOD)</dt>
    422 <dd>
    423 <p>Is the <tt>TIME-PERIOD</tt> null?</p></dd>
    424 <dt class="definition"><strong>procedure:</strong> (time-period-length TIME-PERIOD)</dt>
    425 <dd>
    426 <p>Returns the time-duration of the <tt>TIME-PERIOD</tt>.</p></dd>
    427 <dt class="definition"><strong>procedure:</strong> (time-period=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    428 <dd>
    429 <p>Does <tt>TIME-PERIOD-1</tt> begin &amp; end with <tt>TIME-PERIOD-2</tt>?</p></dd>
    430 <dt class="definition"><strong>procedure:</strong> (time-period&lt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    431 <dd>
    432 <p>Does <tt>TIME-PERIOD-1</tt> end before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
    433 <dt class="definition"><strong>procedure:</strong> (time-period&gt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    434 <dd>
    435 <p>Does <tt>TIME-PERIOD-1</tt> begin after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
    436 <dt class="definition"><strong>procedure:</strong> (time-period&lt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    437 <dd>
    438 <p>Does <tt>TIME-PERIOD-1</tt> end on or before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
    439 <dt class="definition"><strong>procedure:</strong> (time-period&gt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    440 <dd>
    441 <p>Does <tt>TIME-PERIOD-1</tt> begin on or after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
    442 <dt class="definition"><strong>procedure:</strong> (time-period-preceding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    443 <dd>
    444 <p>Return the portion of <tt>TIME-PERIOD-1</tt> before <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't precede.</p></dd>
    445 <dt class="definition"><strong>procedure:</strong> (time-period-succeeding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    446 <dd>
    447 <p>Return the portion of <tt>TIME-PERIOD-1</tt> after <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't succeed.</p></dd>
    448 <dt class="definition"><strong>procedure:</strong> (time-period-contains/period? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    449 <dd>
    450 <p>Is <tt>TIME-PERIOD-2</tt> within <tt>TIME-PERIOD-1</tt>?</p></dd>
    451 <dt class="definition"><strong>procedure:</strong> (time-period-contains/time? TIME-PERIOD TIME)</dt>
    452 <dd>
    453 <p>Is <tt>TIME</tt> within <tt>TIME-PERIOD</tt>?</p>
    454 <p><tt>TIME</tt> is converted to a compatible clock-type if possible.</p></dd>
    455 <dt class="definition"><strong>procedure:</strong> (time-period-contains/date? TIME-PERIOD DATE)</dt>
    456 <dd>
    457 <p>Is <tt>DATE</tt> within <tt>TIME-PERIOD</tt>?</p>
    458 <p><tt>DATE</tt> is converted to a compatible time if possible.</p></dd>
    459 <dt class="definition"><strong>procedure:</strong> (time-period-contains? TIME-PERIOD OBJECT)</dt>
    460 <dd>
    461 <p>Is <tt>OBJECT</tt> within <tt>TIME-PERIOD</tt>?</p>
    462 <p><tt>OBJECT</tt> maybe a time, date, or time-period.</p></dd>
    463 <dt class="definition"><strong>procedure:</strong> (time-period-intersects? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    464 <dd>
    465 <p>Does <tt>TIME-PERIOD-2</tt> overlap <tt>TIME-PERIOD-1</tt>?</p></dd>
    466 <dt class="definition"><strong>procedure:</strong> (time-period-intersection TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    467 <dd>
    468 <p>The overlapping time-period of <tt>TIME-PERIOD-2</tt> and <tt>TIME-PERIOD-1</tt>, or <code>#f</code> when no overlap.</p></dd>
    469 <dt class="definition"><strong>procedure:</strong> (time-period-union TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    470 <dd>
    471 <p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, or <code>#f</code> when they do not intersect.</p></dd>
    472 <dt class="definition"><strong>procedure:</strong> (time-period-span TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    473 <dd>
    474 <p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, including any gaps.</p></dd>
    475 <dt class="definition"><strong>procedure:</strong> (time-period-shift TIME-PERIOD DURATION)</dt>
    476 <dd>
    477 <p>Returns a copy of <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd>
    478 <dt class="definition"><strong>procedure:</strong> (time-period-shift! TIME-PERIOD DURATION)</dt>
    479 <dd>
    480 <p>Returns <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd></div>
    481 <div class="subsection">
    482 <h4>Input/Output Procedures</h4>
    483 <div class="section">
    484 <h3>Usage</h3>(require-extension srfi-19-io)</div>
    485 <dt class="definition"><strong>procedure:</strong> (format-date DESTINATION DATE-FORMAT-STRING [DATE])</dt>
    486 <dd>
    487 <p>Displays a text form of the <tt>DATE</tt> on the <tt>DESTINATION</tt> using the <tt>DATE-FORMAT-STRING</tt>.</p>
    488 <p>When the destination is <code>#t</code> the <code>(current-output-port)</code> is used, and the date object must be specified.</p>
    489 <p>When the destination is a string the <tt>DATE-FORMAT-STRING</tt> value must be a date object, the <tt>DESTINATION</tt> value is used as the <tt>DATE-FORMAT-STRING</tt>, and the result is returned as a string.</p>
    490 <p>When the destination is a port it must be an <code>output-port</code>, and the date object must be specified. When the destination is a number the <code>(current-error-port)</code> is the destination, and the <tt>DATE</tt> object must be specified.</p>
    491 <p>When the destination is <code>#f</code> the result is returned as a string, and the <tt>DATE</tt> object must be specified.</p></dd>
    492 <dt class="definition"><strong>procedure:</strong> (scan-date SOURCE TEMPLATE-STRING)</dt>
    493 <dd>
    494 <p>Reads a text form of a date from the <tt>SOURCE</tt>, following the <tt>TEMPLATE-STRING</tt>, and returns a date object.</p>
    495 <p>When the source is <code>#t</code> the <code>(current-input-port)</code> is used.</p>
    496 <p>When the source is a port it must be an <code>input-port</code>.</p>
    497 <p>When the source is string it should be a date text form.</p></dd></div></div>
    498 <div class="section">
    499 <h3>Bugs</h3>
    500 <p>Local timezone information is not necessarily valid for historic dates and problematic for future dates. Daylight saving time is especially an issue. Conversion of a time or seconds value to a local date will use the current timezone offset value. The current offset will reflect the daylight saving time status. So target dates outside of the DST period will be converted incorrectly!</p>
    501 <p>Will not read years less than 1 properly. The ISO 8601 year convention for years 1 BCE and before and years 10000 CE and after is not supported.</p></div>
    502 <div class="section">
    503 <h3>Issues</h3>
    504 <p>31 December 1 BCE + 1 day =&gt; 1 January 1 CE. There is no year 0. Unlike the ISO 8601 convention do not subtract 1 when converting a year BCE to a SRFI-19 year, just negate the year.</p>
    505 <p>The SRFI-18 <code>current-time</code> and <code>time?</code> bindings conflict with SRFI-19 bindings.</p>
    506 <p>The SRFI-18 time object is not accepted except by the conversion procedures.</p>
    507 <p>The expression <code>(time=? (seconds-&gt;time/type (nanoseconds-&gt;seconds (time-&gt;nanoseconds &lt;time-duration&gt;))) &lt;time-duration&gt;)</code> might be <code>#f</code>, due to the use of inexact arithmetic.</p>
    508 <p>Be careful using the procedures that return some form of 'julian-day'. These are implemented using the full numeric tower and <em>will</em> return rational numbers. Performing arithmetic with such a result will require the &quot;numbers&quot; egg. See the file &quot;srfi-19-test.scm&quot; in this egg for an example.</p>
    509 <p>This will be a problem with code that assumes fixnum and/or flonum <em>only</em> numbers. Perhaps an intermediate file that wraps any 'julian-day' calls and coerces to an inexact number. Use the wrapped 'julian-day' call in the problematic code.</p></div>
    510 <div class="section">
    511 <h3>Examples</h3>
    512 <div id="examples">; See the &quot;srfi-19-test.scm&quot; file in the egg.</div></div>
    513 <div class="section">
    514515<h3>License</h3>
    515516<pre>Copyright (c) 2005, Kon Lovett.  All rights reserved.
  • release/3/srfi-19/trunk/srfi-19-eggdoc.scm

    r8940 r11875  
    5959    (description (p "Time Data Types and Procedures"))
    6060    (author (url "mailto:klovett@pacbell.net" "Kon Lovett"))
    61     (history
    62       (version "2.6.10" "Dropped :optional.")
    63       (version "2.6.9" "Needs Chicken 2.610 for MacOS X & Windows.")
    64       (version "2.6.8" "Bug fix for make-date supplied dst flag. Added Bugs section.")
    65       (version "2.6.7" "Uses fixnum arithmetic where possible. Added time->julian-day, time->modified-julian-day, date comparisons. Bug fix for multiply-duration, divide-duration, & make-duration. Changed read-leap-second-table to required filename parameter.")
    66       (version "2.6.6" "Bug fix for time<=? & time>=?. Added time-period-preceding & time-period-succeeding. Split periods into srfi-19-period.")
    67       (version "2.6.5" "Bug fix for platforms not MacOS X, timezone offset was sign reversed.")
    68       (version "2.6.4" "Bug fix to time ctors/setters - allowed negative nanoseconds. Added make-local-timezone-locale w/ special case for platforms not Windows or Macintosh. Made local-timezone-locale a parameter.")
    69       (version "2.6.3" "Made time-max & time-min n-ary. Added make-null-time-period, time-negative?, time-positive?, time-zero?. Bug fix for local-timezone-offset [reported by Hans Bulfone]")
    70       (version "2.6.2" "Bug fix for local-timezone-locale, seconds->date/type, current-nanoseconds, & current-date [reported by Hans Bulfone]")
    71       (version "2.6.1" "Deprecated local-timezone-info, local-timezone-name, local-timezone-offset, and local-timezone-dst?. Bug fix for milliseconds->time. Bug fix for current-date when no tz-locale. [reported by Graham Fawcett]")
    72       (version "2.6" "Added time-period, date arithmetic, duration routines, fix for possible seconds limit in time object")
    73       (version "2.5" "Added Dutch locale, ISO-8601 conversion bug fix, 'date-year-day' bug fix [thanks to Arno Peters]")
    74       (version "2.4" "Removed annoying warnings, made srfi-19 an umbrella - uses -core & -io")
    75       (version "2.3" "Date dst? field, timezone-locale structure accessors")
    76       (version "2.2" "Bug fix for no local timezone setting situation [reported by Mario Domenech Goulart]")
    77       (version "2.1" "Bug fix for ->fixnum [reported by Mario Domenech Goulart]")
    78       (version "2.0" "Removed I/O routines to own extension")
    79       (version "1.9" "Fix, in conjunction w/ srfi-29, for locale details")
    80       (version "1.8" "Version removed")
    81       (version "1.7" "Brazilian Portuguese [thanks to Mario Domenech Goulart]")
    82       (version "1.6" "Bug fix for inexact seconds in time->date [thanks to Peter Bex]")
    83       (version "1.5" "Bug fix for compiled use")
    84       (version "1.4" "Exports")
    85       (version "1.3" "Bug fix")
    86       (version "1.2" "Slightly smaller and faster")
    87       (version "1.1" "Some SRFI-18 conflict reduction")
    88       (version "1.0" "Initial release"))
    8961
    9062    (requires
     
    561533  (examples "; See the \"srfi-19-test.scm\" file in the egg.")
    562534
     535  (history
     536    (version "2.6.11" "Printing of \"xxx.0\" => "xxx". More use of fixnum ops in srfi-19-io.")
     537    (version "2.6.10" "Dropped :optional.")
     538    (version "2.6.9" "Needs Chicken 2.610 for MacOS X & Windows.")
     539    (version "2.6.8" "Bug fix for make-date supplied dst flag. Added Bugs section.")
     540    (version "2.6.7" "Uses fixnum arithmetic where possible. Added time->julian-day, time->modified-julian-day, date comparisons. Bug fix for multiply-duration, divide-duration, & make-duration. Changed read-leap-second-table to required filename parameter.")
     541    (version "2.6.6" "Bug fix for time<=? & time>=?. Added time-period-preceding & time-period-succeeding. Split periods into srfi-19-period.")
     542    (version "2.6.5" "Bug fix for platforms not MacOS X, timezone offset was sign reversed.")
     543    (version "2.6.4" "Bug fix to time ctors/setters - allowed negative nanoseconds. Added make-local-timezone-locale w/ special case for platforms not Windows or Macintosh. Made local-timezone-locale a parameter.")
     544    (version "2.6.3" "Made time-max & time-min n-ary. Added make-null-time-period, time-negative?, time-positive?, time-zero?. Bug fix for local-timezone-offset [reported by Hans Bulfone]")
     545    (version "2.6.2" "Bug fix for local-timezone-locale, seconds->date/type, current-nanoseconds, & current-date [reported by Hans Bulfone]")
     546    (version "2.6.1" "Deprecated local-timezone-info, local-timezone-name, local-timezone-offset, and local-timezone-dst?. Bug fix for milliseconds->time. Bug fix for current-date when no tz-locale. [reported by Graham Fawcett]")
     547    (version "2.6" "Added time-period, date arithmetic, duration routines, fix for possible seconds limit in time object")
     548    (version "2.5" "Added Dutch locale, ISO-8601 conversion bug fix, 'date-year-day' bug fix [thanks to Arno Peters]")
     549    (version "2.4" "Removed annoying warnings, made srfi-19 an umbrella - uses -core & -io")
     550    (version "2.3" "Date dst? field, timezone-locale structure accessors")
     551    (version "2.2" "Bug fix for no local timezone setting situation [reported by Mario Domenech Goulart]")
     552    (version "2.1" "Bug fix for ->fixnum [reported by Mario Domenech Goulart]")
     553    (version "2.0" "Removed I/O routines to own extension")
     554    (version "1.9" "Fix, in conjunction w/ srfi-29, for locale details")
     555    (version "1.8" "Version removed")
     556    (version "1.7" "Brazilian Portuguese [thanks to Mario Domenech Goulart]")
     557    (version "1.6" "Bug fix for inexact seconds in time->date [thanks to Peter Bex]")
     558    (version "1.5" "Bug fix for compiled use")
     559    (version "1.4" "Exports")
     560    (version "1.3" "Bug fix")
     561    (version "1.2" "Slightly smaller and faster")
     562    (version "1.1" "Some SRFI-18 conflict reduction")
     563    (version "1.0" "Initial release"))
     564
    563565  (section "License" (pre ,license))
    564566) ) )
  • release/3/srfi-19/trunk/srfi-19-io.scm

    r10022 r11875  
    8787(load-best-available-bundle! (most-specific-bundle-specifier 'srfi-19))
    8888
    89 (define (item@ key)
     89(define-inline (item@ key)
    9090  (localized-template/default 'srfi-19 key) )
    9191
     
    9696(define (tm:natural-year n)
    9797  (let* ([current-year (date-year (current-date))]
    98          [current-century (* (quotient current-year 100) 100)])
    99     (cond
    100       [(>= n 100) n]
    101       [(<  n 0) n]
    102       [(<= (- (+ current-century n) current-year) 50) (+ current-century n)]
    103       [else (+ (- current-century 100) n)]) ) )
     98         [current-century (fx* (fx/ current-year 100) 100)])
     99    (cond [(fx>= n 100)
     100            n]
     101          [(fx< n 0)
     102            n]
     103          [(fx<= (fx- (fx+ current-century n) current-year) 50)
     104            (fx+ current-century n)]
     105          [else
     106            (fx+ (fx- current-century 100) n)]) ) )
    104107
    105108;; Return a string representing the decimal expansion of the fractional
     
    107110
    108111(define (tm:decimal-expansion r precision)
    109   (let loop ([num (- r (round r))] [p precision] [lst '()])
    110     (if (or (zero? p) (zero? num))
    111       (apply string-append (reverse! lst))
    112       (let* ([num-times-10 (* 10 num)]
    113              [round-num-times-10 (round num-times-10)])
    114         (loop (- num-times-10 round-num-times-10)
    115               (sub1 p)
    116               (cons (number->string (inexact->exact round-num-times-10))
    117                     lst)) ) ) ) )
     112  (let loop ([num (- r (round r))]
     113             [p precision]
     114             [lst '()])
     115    (if (or (fx= 0 p) (zero? num))
     116        (apply string-append (reverse! lst))
     117        (let* ([num-times-10 (* 10 num)]
     118               [round-num-times-10 (round num-times-10)])
     119          (loop (- num-times-10 round-num-times-10)
     120                (fx- p 1)
     121                (cons (number->string (inexact->exact round-num-times-10))
     122                      lst)) ) ) ) )
    118123
    119124;; Returns a string rep. of number N, of minimum LENGTH,
     
    123128
    124129(define (tm:padding n pad-with length)
    125   (let ([str (number->string n)])
    126     (if (or (not pad-with) (> (string-length str) length))
    127       str
    128       (string-pad str length pad-with)) ) )
     130  (let* ([str (number->string n)]
     131         [len (string-length str)])
     132    (let ((str (if (and (fx>= len 2)
     133                        (char=? #\. (string-ref str (fx- len 2)))
     134                        (char=? #\0 (string-ref str (fx- len 1))) )
     135                   (substring str 0 (fx- len 2))
     136                   str) ) )
     137      (if (or (not pad-with) (> len length))
     138          str
     139          (string-pad str length pad-with)) ) ) )
    129140
    130141(define (tm:last-n-digits i n)
     
    174185(define (tm:tz-printer offset port)
    175186  (if (= offset 0)
    176     (display "Z" port)
    177     (begin
    178       (cond
    179         [(negative? offset) (display #\- port)]
    180         [else (display #\+ port)])
    181       (let ([offset (abs offset)])
    182         (display
    183           (tm:padding (quotient offset SEC/HR) #\0 2)
    184           port)
    185         (display
    186           (tm:padding (quotient (remainder offset SEC/HR) SEC/MIN) #\0 2)
    187           port) ) ) ) )
     187      (display "Z" port)
     188      (let ((isneg (fx< offset 0)))
     189        (display (if isneg #\- #\+) port)
     190        (let ([offset (if isneg (fxneg offset) offset)])
     191          (display (tm:padding (quotient offset SEC/HR) #\0 2) port)
     192          (display (tm:padding (quotient (remainder offset SEC/HR) SEC/MIN) #\0 2) port) ) ) ) )
    188193
    189194;; A table of output formatting directives.
     
    216221    (cons #\c
    217222      (lambda (date pad-with port)
    218         (display (date->string date
    219               (item@ LOCALE-DATE-TIME-FORMAT)) port)))
     223        (display (date->string date (item@ LOCALE-DATE-TIME-FORMAT)) port)))
    220224
    221225    (cons #\d
     
    234238      (lambda (date pad-with port)
    235239        (let ([ns (date-nanosecond date)] [sec (date-second date)])
    236           (if (> ns NS/S) ;this shouldn't happen!
    237             (display (tm:padding (+ sec 1) pad-with 2) port)
    238             (display (tm:padding sec pad-with 2) port))
     240          (if (> ns NS/S) ; This shouldn't happen!
     241              (display (tm:padding (+ sec 1) pad-with 2) port)
     242              (display (tm:padding sec pad-with 2) port))
    239243          (let ([f (tm:decimal-expansion (/ ns NS/S) 6)])
    240             (when (positive? (string-length f))
     244            (when (fx> (string-length f) 0)
    241245              (display (item@ LOCALE-NUMBER-SEPARATOR) port)
    242246              (display f port))))))
     
    253257      (lambda (date pad-with port)
    254258        (let ([hr (date-hour date)])
    255           (if (> hr 12)
    256             (display (tm:padding (- hr 12) pad-with 2) port)
    257             (display (tm:padding hr pad-with 2) port)))))
     259          (if (fx> hr 12)
     260              (display (tm:padding (fx- hr 12) pad-with 2) port)
     261              (display (tm:padding hr pad-with 2) port)))))
    258262
    259263    (cons #\j
     
    268272      (lambda (date pad-with port)
    269273        (let ([hr (date-hour date)])
    270           (display (tm:padding (if (> hr 12) (- hr 12) hr) #\space 2) port))))
     274          (display (tm:padding (if (fx> hr 12) (fx- hr 12) hr) #\space 2) port))))
    271275
    272276    (cons #\m
     
    301305      (lambda (date pad-with port)
    302306        (let ([sec (date-second date)])
    303           (if (> (date-nanosecond date) NS/S)
    304             (display (tm:padding (+ sec 1) pad-with 2) port)
    305             (display (tm:padding sec pad-with 2) port)))))
     307          (if (> (date-nanosecond date) NS/S) ; This shouldn't happen!
     308              (display (tm:padding (+ sec 1) pad-with 2) port)
     309              (display (tm:padding sec pad-with 2) port)))))
    306310
    307311    (cons #\t
     
    316320      (lambda (date pad-with port)
    317321        (let ([wkno (date-week-number date 0)])
    318           (if (positive? (tm:days-before-first-week date 0))
    319             (display (tm:padding (+ wkno 1) #\0 2) port)
    320             (display (tm:padding wkno #\0 2) port)))))
     322          (if (fx> (tm:days-before-first-week date 0) 0)
     323              (display (tm:padding (fx+ wkno 1) #\0 2) port)
     324              (display (tm:padding wkno #\0 2) port)))))
    321325
    322326    (cons #\V
     
    331335      (lambda (date pad-with port)
    332336        (let ([wkno (date-week-number date 1)])
    333           (if (positive? (tm:days-before-first-week date 1))
    334             (display (tm:padding (+ wkno 1) #\0 2) port)
    335             (display (tm:padding wkno #\0 2) port)))))
     337          (if (fx> (tm:days-before-first-week date 1) 0)
     338              (display (tm:padding (fx+ wkno 1) #\0 2) port)
     339              (display (tm:padding wkno #\0 2) port)))))
    336340
    337341    (cons #\x
     
    378382    (cons #\5
    379383      (lambda (date pad-with port)
    380         (display (date->string date "~Y-~m-~dT~H:~M:~S") port)))
    381   ))
     384        (display (date->string date "~Y-~m-~dT~H:~M:~S") port))) ) )
    382385
    383386(define (tm:date-printer loc date format-rem len-rem port)
     
    389392              (and-let* ([associated (assoc char tm:display-directives)])
    390393                (cdr associated)))])
    391       (cond
    392         [(not (char=? current-char #\~))
    393           (display current-char port)
    394           (tm:date-printer loc date (cdr format-rem) (fx- len-rem 1) port)]
    395         [(fx< len-rem 2)
    396           (error loc "bad date format" (list->string format-rem))]
    397         [else
    398           (let ([pad-ch (cadr format-rem)])
    399             (cond
    400               [(char=? pad-ch #\-)
    401                 (if (fx< len-rem 3)
    402                   (error loc "bad date format" (list->string format-rem))
    403                   (let ([formatter (get-formatter (caddr format-rem))])
    404                     (if (not formatter)
    405                       (error loc "bad date format" (list->string format-rem))
    406                       (begin
    407                         (formatter date #f port)
    408                         (tm:date-printer loc date (cdddr format-rem) (fx- len-rem 3) port)))))]
    409               [(char=? pad-ch #\_)
    410                 (if (fx< len-rem 3)
    411                   (error loc "bad date format" (list->string format-rem))
    412                   (let ([formatter (get-formatter (caddr format-rem))])
    413                     (if (not formatter)
    414                       (error loc "bad date format" (list->string format-rem))
    415                       (begin
    416                         (formatter date #\space port)
    417                         (tm:date-printer loc date (cdddr format-rem) (fx- len-rem 3) port)))))]
    418               [else
    419                 (let ([formatter (get-formatter pad-ch)])
    420                   (if (not formatter)
    421                     (error loc "bad date format" (list->string format-rem))
    422                     (begin
    423                       (formatter date #\0 port)
    424                       (tm:date-printer loc date (cddr format-rem) (fx- len-rem 2) port))))]))]) )) )
     394      (cond [(not (char=? current-char #\~))
     395              (display current-char port)
     396              (tm:date-printer loc date (cdr format-rem) (fx- len-rem 1) port)]
     397            [(fx< len-rem 2)
     398              (error loc "bad date format" (list->string format-rem))]
     399            [else
     400              (let ([pad-ch (cadr format-rem)])
     401                (cond [(char=? pad-ch #\-)
     402                        (if (fx< len-rem 3)
     403                            (error loc "bad date format" (list->string format-rem))
     404                            (let ([formatter (get-formatter (caddr format-rem))])
     405                              (if (not formatter)
     406                                  (error loc "bad date format" (list->string format-rem))
     407                                  (begin
     408                                    (formatter date #f port)
     409                                    (tm:date-printer loc date (cdddr format-rem)
     410                                                     (fx- len-rem 3) port)))))]
     411                      [(char=? pad-ch #\_)
     412                        (if (fx< len-rem 3)
     413                            (error loc "bad date format" (list->string format-rem))
     414                            (let ([formatter (get-formatter (caddr format-rem))])
     415                              (if (not formatter)
     416                                  (error loc "bad date format" (list->string format-rem))
     417                                  (begin
     418                                    (formatter date #\space port)
     419                                    (tm:date-printer loc date (cdddr format-rem)
     420                                                     (fx- len-rem 3) port)))))]
     421                      [else
     422                        (let ([formatter (get-formatter pad-ch)])
     423                          (if (not formatter)
     424                              (error loc "bad date format" (list->string format-rem))
     425                              (begin
     426                                (formatter date #\0 port)
     427                                (tm:date-printer loc date (cddr format-rem)
     428                                                 (fx- len-rem 2) port))))]))]) )) )
    425429
    426430(define (format-date dest fmt-str . r)
    427431  (let ([port #f] [date (optional r #f)])
    428     (cond
    429       [(not dest)
    430         (set! port (open-output-string))]
    431       [(string? dest)
    432         (set! date fmt-str)
    433         (set! fmt-str dest)
    434         (set! port (open-output-string))]
    435       [(number? dest)
    436         (set! port (current-error-port))]
    437       [(port? dest)
    438         (set! port dest)]
    439       [else
    440         (set! port (current-output-port))])
     432    (cond [(not dest)
     433            (set! port (open-output-string))]
     434          [(string? dest)
     435            (set! date fmt-str)
     436            (set! fmt-str dest)
     437            (set! port (open-output-string))]
     438          [(number? dest)
     439            (set! port (current-error-port))]
     440          [(port? dest)
     441            (set! port dest)]
     442          [else
     443            (set! port (current-output-port))])
    441444    (tm:date-printer 'display-date date (string->list fmt-str) (string-length fmt-str) port)
    442445    (if (or (not dest) (string? dest))
    443       (get-output-string port)
    444       #t) ) )
     446        (get-output-string port)
     447        #t) ) )
    445448
    446449(define (date->string date . format-string)
     
    472475              (not (char-numeric? ch))
    473476              (and upto (fx>= nchars upto)))
    474         accum
    475         (loop
    476           (fx+ (fx* accum 10) (tm:char->int (read-char port)))
    477           (fx+ nchars 1))) ) ) )
     477          accum
     478          (loop (fx+ (fx* accum 10) (tm:char->int (read-char port))) (fx+ nchars 1))) ) ) )
    478479
    479480(define (tm:make-integer-reader upto)
     
    487488    (let loop ([accum 0] [nchars 0])
    488489      (let ([ch (peek-char port)])
    489         (cond
    490           [(fx>= nchars n)
    491             accum]
    492           [(eof-object? ch)
    493             (error 'string->date "bad date template: premature ending to integer read")]
    494           [(char-numeric? ch)
    495             (set! padding-ok #f)
    496             (loop
    497               (fx+ (fx* accum 10) (tm:char->int (read-char port)))
    498               (fx+ nchars 1))]
    499           [padding-ok
    500             (read-char port)    ; consume padding
    501             (loop accum (fx+ nchars 1))]
    502           [else                 ; padding where it shouldn't be
    503             (error 'string->date "bad date template: non-numeric characters in integer read")]) ) ) ) )
     490        (cond [(fx>= nchars n)
     491                accum]
     492              [(eof-object? ch)
     493                (error 'string->date "bad date template: premature ending to integer read")]
     494              [(char-numeric? ch)
     495                (set! padding-ok #f)
     496                (loop (fx+ (fx* accum 10) (tm:char->int (read-char port))) (fx+ nchars 1))]
     497              [padding-ok
     498                (read-char port)    ; consume padding
     499                (loop accum (fx+ nchars 1))]
     500              [else                 ; padding where it shouldn't be
     501                (error 'string->date "bad date template: non-numeric characters in integer read")]) ) ) ) )
    504502
    505503(define (tm:make-integer-exact-reader n)
     
    513511        (error 'string->date "bad date template: invalid time zone +/-"))
    514512      (if (or (char=? ch #\Z) (char=? ch #\z))
    515         0
    516         (begin
    517           (cond
    518             [(char=? ch #\+) (set! is-pos #t)]
    519             [(char=? ch #\-) (set! is-pos #f)]
    520             [else (error 'string->date "bad date template: invalid time zone +/-" ch)])
    521           (let ([ch (read-char port)])
    522             (when (eof-object? ch)
    523               (error 'string->date "bad date template: invalid time zone number"))
    524             (set! offset (fx* (tm:char->int ch) (fx* 10 SEC/HR))))
    525           ;; non-existing values are considered zero
    526           (let ([ch (read-char port)])
    527             (unless (eof-object? ch)
    528               (set! offset (fx+ offset (fx* (tm:char->int ch) SEC/HR)))))
    529           (let ([ch (read-char port)])
    530             (unless (eof-object? ch)
    531               (set! offset (fx+ offset (fx* (tm:char->int ch) 600)))))
    532           (let ([ch (read-char port)])
    533             (unless (eof-object? ch)
    534               (set! offset (fx+ offset (fx* (tm:char->int ch) 60)))))
    535           (if is-pos offset (fxneg offset)))) ) ) )
     513          0
     514          (begin
     515            (cond [(char=? ch #\+) (set! is-pos #t)]
     516                  [(char=? ch #\-) (set! is-pos #f)]
     517                  [else
     518                    (error 'string->date "bad date template: invalid time zone +/-" ch)])
     519            (let ([ch (read-char port)])
     520              (when (eof-object? ch)
     521                (error 'string->date "bad date template: invalid time zone number"))
     522              (set! offset (fx* (tm:char->int ch) (fx* 10 SEC/HR))))
     523            ;; non-existing values are considered zero
     524            (let ([ch (read-char port)])
     525              (unless (eof-object? ch)
     526                (set! offset (fx+ offset (fx* (tm:char->int ch) SEC/HR)))))
     527            (let ([ch (read-char port)])
     528              (unless (eof-object? ch)
     529                (set! offset (fx+ offset (fx* (tm:char->int ch) 600)))))
     530            (let ([ch (read-char port)])
     531              (unless (eof-object? ch)
     532                (set! offset (fx+ offset (fx* (tm:char->int ch) 60)))))
     533            (if is-pos offset (fxneg offset)))) ) ) )
    536534
    537535;; Looking at a char, read the char string, run thru indexer, return index
     
    558556  (lambda (port)
    559557    (if (char=? char (read-char port))
    560       char
    561       (error 'string->date "bad date template: invalid character match"))) )
     558        char
     559        (error 'string->date "bad date template: invalid character match"))) )
    562560
    563561;; A List of formatted read directives.
     
    642640        tm:zone-reader
    643641        (lambda (val object)
    644           (%date-zone-offset-set! object val)))
    645     )))
     642          (%date-zone-offset-set! object val))) ) ) )
    646643
    647644(define (tm:date-reader date format-rem len-rem port)
     
    651648              (let loop ([ch (peek-char port)])
    652649                (if (eof-object? ch)
    653                   (error 'scan-date "bad date template" (list->string format-rem))
    654                   (unless (skipper ch)
    655                     (read-char port)
    656                     (loop (peek-char port))))))])
     650                    (error 'scan-date "bad date template" (list->string format-rem))
     651                    (unless (skipper ch)
     652                      (read-char port)
     653                      (loop (peek-char port))))))])
    657654      (when (fx< 0 len-rem)
    658655        (let ([current-char (car format-rem)])
    659           (cond
    660             [(not (char=? current-char #\~))
    661               (let ([port-char (read-char port)])
    662                 (when (or (eof-object? port-char) (not (char=? current-char port-char)))
    663                   (error 'scan-date "bad date template" (list->string format-rem))))
    664               (loop (cdr format-rem) (fx- len-rem 1))]
    665               ;; otherwise, it's an escape, we hope
    666             [(fx< len-rem 2)
    667               (error 'scan-date "bad date template" (list->string format-rem))]
    668             [else
    669               (let* ([format-char (cadr format-rem)]
    670                      [format-info (assoc format-char tm:read-directives)])
    671                 (unless format-info
    672                   (error 'scan-date "bad date template" (list->string format-rem)))
    673                 (let ([skipper (cadr format-info)]
    674                       [reader (caddr format-info)]
    675                       [actor (cadddr format-info)])
    676                   (skip-until skipper)
    677                   (let ([val (reader port)])
    678                     (if (eof-object? val)
    679                       (error 'scan-date "bad date template" (list->string format-rem))
    680                       (actor val date))))
    681                 (loop (cddr format-rem) (fx- len-rem 2)))]) ) ) ) ) )
     656          (cond [(not (char=? current-char #\~))
     657                  (let ([port-char (read-char port)])
     658                    (when (or (eof-object? port-char)
     659                              (not (char=? current-char port-char)))
     660                      (error 'scan-date "bad date template" (list->string format-rem))))
     661                  (loop (cdr format-rem) (fx- len-rem 1))]
     662                  ;; otherwise, it's an escape, we hope
     663                [(fx< len-rem 2)
     664                  (error 'scan-date "bad date template" (list->string format-rem))]
     665                [else
     666                  (let* ([format-char (cadr format-rem)]
     667                         [format-info (assoc format-char tm:read-directives)])
     668                    (unless format-info
     669                      (error 'scan-date "bad date template" (list->string format-rem)))
     670                    (let ([skipper (cadr format-info)]
     671                          [reader (caddr format-info)]
     672                          [actor (cadddr format-info)])
     673                      (skip-until skipper)
     674                      (let ([val (reader port)])
     675                        (if (eof-object? val)
     676                            (error 'scan-date "bad date template" (list->string format-rem))
     677                            (actor val date))))
     678                    (loop (cddr format-rem) (fx- len-rem 2)))]) ) ) ) ) )
    682679
    683680(define (scan-date src template-string)
     
    688685    (let ([date-compl?
    689686            (lambda ()
    690               (and
    691                 (date-nanosecond newdate)
    692                 (date-second newdate) (date-minute newdate) (date-hour newdate)
    693                 (date-day newdate) (date-month newdate) (date-year newdate)
    694                 (date-zone-offset newdate)))]
     687              (and (date-nanosecond newdate)
     688                   (date-second newdate) (date-minute newdate) (date-hour newdate)
     689                   (date-day newdate) (date-month newdate) (date-year newdate)
     690                   (date-zone-offset newdate)))]
    695691          [date-ok?
    696692            (lambda ()
     
    702698                (date-zone-offset newdate)
    703699                (date-zone-name newdate)))])
    704       (cond
    705         [(string? src) (set! port (open-input-string src))]
    706         [(port? src) (set! port src)]
    707         [src (set! port (current-input-port))])
     700      (cond [(string? src)  (set! port (open-input-string src))]
     701            [(port? src)    (set! port src)]
     702            [src            (set! port (current-input-port))])
    708703      (tm:date-reader newdate (string->list template-string) (string-length template-string) port)
    709704      (unless (date-compl?)
  • release/3/srfi-19/trunk/srfi-19.html

    r8940 r11875  
    156156<h3>Author</h3><a href="mailto:klovett@pacbell.net">Kon Lovett</a></div>
    157157<div class="section">
     158<h3>Requires</h3>
     159<ul>
     160<li>Chicken 2.610</li>
     161<li>locale</li>
     162<li>srfi-29</li>
     163<li>numbers</li></ul></div>
     164<div class="section">
     165<h3>Usage</h3><tt>(require-extension srfi-19)</tt></div>
     166<div class="section">
     167<h3>Download</h3><a href="srfi-19.egg">srfi-19.egg</a></div>
     168<div class="section">
     169<h3>Documentation</h3>
     170<p>This is a Chicken port of SRFI-19. This document only describes the extensions. For the SRFI-19 API see <a href="http://srfi.schemers.org/srfi-19/srfi-19.html">SRFI-19</a>.</p>
     171<div class="subsection">
     172<h4>Core Procedures</h4>
     173<div class="section">
     174<h3>Usage</h3>(require-extension srfi-19-core)</div>
     175<div class="subsubsection">
     176<h5>SRFI-19 Document Changes</h5>
     177<p>The <b>nanosecond</b> time object element is an integer between 0 and 999,999,999 inclusive. (The SRFI-19 document mis-states the value.)</p>
     178<p>A <i>tz-offset</i> value follows ISO 8601; positive for <em>east</em> of UTC, and negative for <em>west</em>. This is the <em>opposite</em> of the POSIX TZ environment variable.</p>
     179<p>Where the SRFI-19 document states a <i>tz-offset</i> argument a timezone-locale object is also legal.</p>
     180<p>The <code>string-&gt;date</code> procedure allows the template-name argument to be optional. When missing the locale's date-time-format string is used. The supplied locale bundle's strings are invertible.</p>
     181<dt class="definition"><strong>procedure:</strong> (make-date NANOSECOND SECOND MINUTE HOUR DAY MONTH YEAR ZONE-OFFSET [TZ-NAME #f] [DST-FLAG #f])</dt>
     182<dd>
     183<p>Same as SRFI-19 except for the optional parameters and allowing a timezone-locale object for the <tt>ZONE-OFFSET</tt>.</p></dd>
     184<dt class="definition"><strong>procedure:</strong> (read-leap-second-table FILENAME)</dt>
     185<dd>
     186<p>Sets the leap second table from the specified <tt>FILENAME</tt>.</p>
     187<p>The file format is the same as the &quot;tai-utc.dat&quot; file in the distribution. Provided by the U.S. Naval Observatory.</p></dd>
     188<dt class="definition"><strong>procedure:</strong> (leap-year? DATE)</dt>
     189<dd>
     190<p>Does the specified <tt>DATE</tt> fall on a leap year?</p></dd></div>
     191<div class="subsubsection">
     192<h5>SRFI-18 Time</h5>
     193<p>Due to conflicts between SRFI-18 and SRFI-19 procedure variables <code>srfi-19:current-time</code> is a synonym for <code>current-time</code> and <code>srfi-19:time?</code> is a synonym for <code>time?</code>.</p>
     194<dt class="definition"><strong>procedure:</strong> (time-&gt;srfi-18-time TIME)</dt>
     195<dd>
     196<p>Converts a SRFI-19 time object to a SRFI-18 time object. The conversion is really only meaningful for time-duration, but any time-type is accepted.</p></dd>
     197<dt class="definition"><strong>procedure:</strong> (srfi-18-time-&gt;time TIME)</dt>
     198<dd>
     199<p>Converts a SRFI-18 time object into a SRFI-19 time-duration object.</p></dd></div>
     200<div class="subsubsection">
     201<h5>Time Conversion</h5>
     202<dt class="definition"><strong>procedure:</strong> (seconds-&gt;time/type SECONDS [TIME-TYPE time-duration])</dt>
     203<dd>
     204<p>Converts a <tt>SECONDS</tt> value, may be fractional, into a <tt>TIME-TYPE</tt> time object.</p></dd>
     205<dt class="definition"><strong>procedure:</strong> (seconds-&gt;date/type SECONDS [TIMEZONE-INFO #f])</dt>
     206<dd>
     207<p>Converts a <tt>SECONDS</tt> value, which may be fractional, into a date object. The <tt>TIMEZONE-INFO</tt> is <code>#t</code> for the local timezone, <code>#f</code> for the utc timezone, or a timezone-locale object.</p>
     208<p><tt>SECONDS</tt> is relative to 00:00:00 January 1, 1970 UTC.</p></dd>
     209<dt class="definition"><strong>procedure:</strong> (time-&gt;nanoseconds TIME)</dt>
     210<dd>
     211<p>Returns the <tt>TIME</tt> object value as a nanoseconds value.</p></dd>
     212<dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;time NANOSECONDS [TIME-TYPE time-duration])</dt>
     213<dd>
     214<p>Returns the <tt>NANOSECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
     215<dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;seconds NANOSECONDS)</dt>
     216<dd>
     217<p>Returns the <tt>NANOSECONDS</tt> value as an inexact seconds value.</p></dd>
     218<dt class="definition"><strong>procedure:</strong> (time-&gt;milliseconds TIME)</dt>
     219<dd>
     220<p>Returns the <tt>TIME</tt> object value as a milliseconds value.</p></dd>
     221<dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;time MILLISECONDS [TIME-TYPE time-duration])</dt>
     222<dd>
     223<p>Returns the <tt>MILLISECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
     224<dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;seconds MILLISECONDS)</dt>
     225<dd>
     226<p>Returns the <tt>MILLISECONDS</tt> value as an inexact seconds value.</p></dd>
     227<dt class="definition"><strong>procedure:</strong> (time-&gt;date TIME)</dt>
     228<dd>
     229<p>Returns the <tt>TIME</tt> object value as a date. A shorthand for the <code>(time-*-&gt;date ...)</code> procedures.</p></dd>
     230<dt class="definition"><strong>procedure:</strong> (time-&gt;julian-day TIME)</dt>
     231<dd>
     232<p>Returns the julian day for the <tt>TIME</tt> object.</p></dd>
     233<dt class="definition"><strong>procedure:</strong> (time-&gt;modified-julian-day TIME)</dt>
     234<dd>
     235<p>Returns the modified julian day for the <tt>TIME</tt> object.</p></dd></div>
     236<div class="subsubsection">
     237<h5>Time Arithmetic</h5>
     238<dt class="definition"><strong>procedure:</strong> (make-duration [#:days 0] [#:hours 0] [#:minutes 0] [#:seconds 0] [#:milliseconds 0] [#:microseconds 0] [#:nanoseconds 0])</dt>
     239<dd>
     240<p>Returns a time-object of clock-type <code>time-duration</code> where the seconds and nanoseconds values are calculated by summing the keyword arguments.</p>
     241<p><code>ONE-SECOND-DURATION</code> and <code>ONE-NANOSECOND-DURATION</code> are pre-defined.</p></dd>
     242<dt class="definition"><strong>procedure:</strong> (divide-duration DURATION NUMBER)</dt>
     243<dd>
     244<p>Returns a duration, from <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
     245<dt class="definition"><strong>procedure:</strong> (divide-duration! DURATION NUMBER)</dt>
     246<dd>
     247<p>Returns <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
     248<dt class="definition"><strong>procedure:</strong> (multiply-duration DURATION NUMBER)</dt>
     249<dd>
     250<p>Returns a duration, from <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
     251<dt class="definition"><strong>procedure:</strong> (multiply-duration! DURATION NUMBER)</dt>
     252<dd>
     253<p>Returns <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
     254<dt class="definition"><strong>procedure:</strong> (time-negative? TIME)</dt>
     255<dd>
     256<p>Is <tt>TIME</tt> negative?</p>
     257<p>A time object will never have a negative nanoseconds value.</p></dd>
     258<dt class="definition"><strong>procedure:</strong> (time-positve? TIME)</dt>
     259<dd>
     260<p>Is <tt>TIME</tt> positive?</p></dd>
     261<dt class="definition"><strong>procedure:</strong> (time-zero? TIME)</dt>
     262<dd>
     263<p>Is <tt>TIME</tt> zero?</p></dd>
     264<dt class="definition"><strong>procedure:</strong> (time-abs TIME)</dt>
     265<dd>
     266<p>Returns the absolute time value, from <tt>TIME</tt>.</p></dd>
     267<dt class="definition"><strong>procedure:</strong> (time-abs! TIME)</dt>
     268<dd>
     269<p>Returns the absolute <tt>TIME</tt> value.</p></dd>
     270<dt class="definition"><strong>procedure:</strong> (time-negate TIME)</dt>
     271<dd>
     272<p>Returns the sign inverted time value, from <tt>TIME</tt>.</p></dd>
     273<dt class="definition"><strong>procedure:</strong> (time-negate! TIME)</dt>
     274<dd>
     275<p>Returns the<tt>TIME</tt> sign inverted value.</p></dd></div>
     276<div class="subsubsection">
     277<h5>Time Comparison</h5>
     278<dt class="definition"><strong>procedure:</strong> (time-max TIME1 [TIME2 ...])</dt>
     279<dd>
     280<p>Returns the maximum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd>
     281<dt class="definition"><strong>procedure:</strong> (time-min TIME1 [TIME2 ...])</dt>
     282<dd>
     283<p>Returns the minimum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd></div>
     284<div class="subsubsection">
     285<h5>Dates</h5>
     286<dt class="definition"><strong>parameter:</strong> (default-date-clock-type [CLOCK-TYPE time-utc])</dt>
     287<dd>
     288<p>Sets or gets the clock-type used by default for conversion of a date to a time.</p></dd>
     289<dt class="definition"><strong>procedure:</strong> (copy-date DATE)</dt>
     290<dd>
     291<p>Returns an exact copy of the specified <tt>DATE</tt> object.</p></dd>
     292<dt class="definition"><strong>procedure:</strong> (date-&gt;time DATE [CLOCK-TYPE (default-date-clock-type)])</dt>
     293<dd>
     294<p>Returns the specified <tt>DATE</tt> as a time-object of type <tt>CLOCK-TYPE</tt>.</p></dd>
     295<dt class="definition"><strong>procedure:</strong> (date-zone-name DATE)</dt>
     296<dd>
     297<p>Returns the timezone abbreviation of the specified <tt>DATE</tt> object. The result is either a string or <code>#f</code>.</p></dd>
     298<dt class="definition"><strong>procedure:</strong> (date-dst? DATE)</dt>
     299<dd>
     300<p>Returns the daylight saving time flag of the specified <tt>DATE</tt> object.</p>
     301<p>Only valid for &quot;current&quot; dates. Historical dates will not have a correct setting. Future dates cannot have a correct setting.</p></dd></div>
     302<div class="subsubsection">
     303<h5>Date Arithmetic</h5>
     304<dt class="definition"><strong>procedure:</strong> (date-difference DATE1 DATE2 [CLOCK-TYPE])</dt>
     305<dd>
     306<p>Returns the duration between <tt>DATE1</tt> and <tt>DATE2</tt>.</p></dd>
     307<dt class="definition"><strong>procedure:</strong> (date-add-duration DATE DURATION [CLOCK-TYPE])</dt>
     308<dd>
     309<p>Returns the <tt>DATE</tt> plus the <tt>DURATION</tt>.</p></dd>
     310<dt class="definition"><strong>procedure:</strong> (date-subtract-duration DATE DURATION [CLOCK-TYPE])</dt>
     311<dd>
     312<p>Returns the <tt>DATE</tt> minus the <tt>DURATION</tt>.</p></dd></div>
     313<div class="subsubsection">
     314<h5>Date Comparison</h5>
     315<dt class="definition"><strong>procedure:</strong> (date=? DATE1 DATE2)</dt>
     316<dd>
     317<p>Is <tt>DATE1</tt> on <tt>DATE2</tt>?</p></dd>
     318<dt class="definition"><strong>procedure:</strong> (date&gt;? DATE1 DATE2)</dt>
     319<dd>
     320<p>Is <tt>DATE1</tt> after <tt>DATE2</tt>?</p></dd>
     321<dt class="definition"><strong>procedure:</strong> (date&lt;? DATE1 DATE2)</dt>
     322<dd>
     323<p>Is <tt>DATE1</tt> before <tt>DATE2</tt>?</p></dd>
     324<dt class="definition"><strong>procedure:</strong> (date&gt;=? DATE1 DATE2)</dt>
     325<dd>
     326<p>Is <tt>DATE1</tt> after or on <tt>DATE2</tt>?</p></dd>
     327<dt class="definition"><strong>procedure:</strong> (date&lt;=? DATE1 DATE2)</dt>
     328<dd>
     329<p>Is <tt>DATE1</tt> before or on <tt>DATE2</tt>?</p></dd></div>
     330<div class="subsubsection">
     331<h5>Timezone</h5>
     332<p><b>Note</b> that the daylight saving time (summer time) flag is <em>always</em> taken from the system, unless supplied. Any summer time rule component of a <code>timezone-components</code> object is <em>not</em> processed.</p>
     333<p>Remember that SRFI-19 timezone offset follows ISO 8601.</p>
     334<dt class="definition"><strong>procedure:</strong> (make-timezone-locale DST-FLAG TZ-COMPONENTS)</dt>
     335<dd>
     336<p>Returns a timezone-locale object.</p>
     337<p>A <tt>TZ-COMPONENTS</tt> object is as described by the <a href="locale.html">locale egg</a>.</p></dd>
     338<dt class="definition"><strong>procedure:</strong> (timezone-locale? OBJ)</dt>
     339<dd>
     340<p>Is the <tt>OBJ</tt> a timezone-locale object?</p></dd>
     341<dt class="definition"><strong>procedure:</strong> (make-local-timezone-locale)</dt>
     342<dd>
     343<p>Creates a local timezone-locale object. When the current timezone is not set a timezone-locale is built with information from <code>(seconds-&gt;local-time (current-seconds))</code>.</p></dd>
     344<dt class="definition"><strong>parameter:</strong> (local-timezone-locale [TZ-LOCALE])</dt>
     345<dd>
     346<p>Gets or sets the local timezone-locale object.</p></dd>
     347<dt class="definition"><strong>parameter:</strong> (utc-timezone-locale [TZ-LOCALE])</dt>
     348<dd>
     349<p>Gets or sets the utc timezone-locale object.</p>
     350<p>Probably not a good idea to change the value.</p></dd>
     351<dt class="definition"><strong>procedure:</strong> (timezone-locale-name [TZ-LOCALE])</dt>
     352<dd>
     353<p>Returns the timezone-locale name of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
     354<dt class="definition"><strong>procedure:</strong> (timezone-locale-offset [TZ-LOCALE])</dt>
     355<dd>
     356<p>Returns the timezone-locale offset of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
     357<dt class="definition"><strong>procedure:</strong> (timezone-locale-dst? [TZ-LOCALE])</dt>
     358<dd>
     359<p>Returns the timezone-locale daylight saving time flag of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd></div></div>
     360<div class="subsection">
     361<h4>Time Period</h4>
     362<div class="section">
     363<h3>Usage</h3>(require-extension srfi-19-period)</div>
     364<p>A time-period is an interval, [begin end), where begin and end are time objects of the same clock type. When end &lt;= begin the interval is null.</p>
     365<dt class="definition"><strong>procedure:</strong> (make-null-time-period [CLOCK-TYPE (default-date-clock-type)])</dt>
     366<dd>
     367<p>Returns a null interval for the specified <tt>CLOCK-TYPE</tt>.</p></dd>
     368<dt class="definition"><strong>procedure:</strong> (make-time-period BEGIN END [CLOCK-TYPE (default-date-clock-type)])</dt>
     369<dd>
     370<p>Returns a new time-period object. The clock types must be compatible.</p>
     371<p><tt>BEGIN</tt> maybe a seconds value, a date, or a time (except time-duration). A seconds value or date are converted to <tt>CLOCK-TYPE</tt>.</p>
     372<p><tt>END</tt> maybe a seconds value, a date, or a time. A seconds value or date are converted to the same clock type as <tt>BEGIN</tt>. A time-duration is treated as an offset from <tt>BEGIN</tt>.</p></dd>
     373<dt class="definition"><strong>procedure:</strong> (copy-time-period TIME-PERIOD)</dt>
     374<dd>
     375<p>Returns a copy of <tt>TIME-PERIOD</tt>.</p></dd>
     376<dt class="definition"><strong>procedure:</strong> (time-period-begin TIME-PERIOD)</dt>
     377<dd>
     378<p>Returns the start time for the <tt>TIME-PERIOD</tt>.</p></dd>
     379<dt class="definition"><strong>procedure:</strong> (time-period-end TIME-PERIOD)</dt>
     380<dd>
     381<p>Returns the end time for the <tt>TIME-PERIOD</tt>.</p></dd>
     382<dt class="definition"><strong>procedure:</strong> (time-period-last TIME-PERIOD)</dt>
     383<dd>
     384<p>Returns the last time for the <tt>TIME-PERIOD</tt>; (time-period-end - 1ns).</p></dd>
     385<dt class="definition"><strong>procedure:</strong> (time-period-type TIME-PERIOD)</dt>
     386<dd>
     387<p>Returns the clock-type of the <tt>TIME-PERIOD</tt>.</p></dd>
     388<dt class="definition"><strong>procedure:</strong> (time-period? OBJECT)</dt>
     389<dd>
     390<p>Is <tt>OBJECT</tt> a time-period?</p></dd>
     391<dt class="definition"><strong>procedure:</strong> (time-period-null? TIME-PERIOD)</dt>
     392<dd>
     393<p>Is the <tt>TIME-PERIOD</tt> null?</p></dd>
     394<dt class="definition"><strong>procedure:</strong> (time-period-length TIME-PERIOD)</dt>
     395<dd>
     396<p>Returns the time-duration of the <tt>TIME-PERIOD</tt>.</p></dd>
     397<dt class="definition"><strong>procedure:</strong> (time-period=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     398<dd>
     399<p>Does <tt>TIME-PERIOD-1</tt> begin &amp; end with <tt>TIME-PERIOD-2</tt>?</p></dd>
     400<dt class="definition"><strong>procedure:</strong> (time-period&lt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     401<dd>
     402<p>Does <tt>TIME-PERIOD-1</tt> end before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
     403<dt class="definition"><strong>procedure:</strong> (time-period&gt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     404<dd>
     405<p>Does <tt>TIME-PERIOD-1</tt> begin after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
     406<dt class="definition"><strong>procedure:</strong> (time-period&lt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     407<dd>
     408<p>Does <tt>TIME-PERIOD-1</tt> end on or before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
     409<dt class="definition"><strong>procedure:</strong> (time-period&gt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     410<dd>
     411<p>Does <tt>TIME-PERIOD-1</tt> begin on or after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
     412<dt class="definition"><strong>procedure:</strong> (time-period-preceding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     413<dd>
     414<p>Return the portion of <tt>TIME-PERIOD-1</tt> before <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't precede.</p></dd>
     415<dt class="definition"><strong>procedure:</strong> (time-period-succeeding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     416<dd>
     417<p>Return the portion of <tt>TIME-PERIOD-1</tt> after <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't succeed.</p></dd>
     418<dt class="definition"><strong>procedure:</strong> (time-period-contains/period? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     419<dd>
     420<p>Is <tt>TIME-PERIOD-2</tt> within <tt>TIME-PERIOD-1</tt>?</p></dd>
     421<dt class="definition"><strong>procedure:</strong> (time-period-contains/time? TIME-PERIOD TIME)</dt>
     422<dd>
     423<p>Is <tt>TIME</tt> within <tt>TIME-PERIOD</tt>?</p>
     424<p><tt>TIME</tt> is converted to a compatible clock-type if possible.</p></dd>
     425<dt class="definition"><strong>procedure:</strong> (time-period-contains/date? TIME-PERIOD DATE)</dt>
     426<dd>
     427<p>Is <tt>DATE</tt> within <tt>TIME-PERIOD</tt>?</p>
     428<p><tt>DATE</tt> is converted to a compatible time if possible.</p></dd>
     429<dt class="definition"><strong>procedure:</strong> (time-period-contains? TIME-PERIOD OBJECT)</dt>
     430<dd>
     431<p>Is <tt>OBJECT</tt> within <tt>TIME-PERIOD</tt>?</p>
     432<p><tt>OBJECT</tt> maybe a time, date, or time-period.</p></dd>
     433<dt class="definition"><strong>procedure:</strong> (time-period-intersects? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     434<dd>
     435<p>Does <tt>TIME-PERIOD-2</tt> overlap <tt>TIME-PERIOD-1</tt>?</p></dd>
     436<dt class="definition"><strong>procedure:</strong> (time-period-intersection TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     437<dd>
     438<p>The overlapping time-period of <tt>TIME-PERIOD-2</tt> and <tt>TIME-PERIOD-1</tt>, or <code>#f</code> when no overlap.</p></dd>
     439<dt class="definition"><strong>procedure:</strong> (time-period-union TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     440<dd>
     441<p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, or <code>#f</code> when they do not intersect.</p></dd>
     442<dt class="definition"><strong>procedure:</strong> (time-period-span TIME-PERIOD-1 TIME-PERIOD-2)</dt>
     443<dd>
     444<p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, including any gaps.</p></dd>
     445<dt class="definition"><strong>procedure:</strong> (time-period-shift TIME-PERIOD DURATION)</dt>
     446<dd>
     447<p>Returns a copy of <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd>
     448<dt class="definition"><strong>procedure:</strong> (time-period-shift! TIME-PERIOD DURATION)</dt>
     449<dd>
     450<p>Returns <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd></div>
     451<div class="subsection">
     452<h4>Input/Output Procedures</h4>
     453<div class="section">
     454<h3>Usage</h3>(require-extension srfi-19-io)</div>
     455<dt class="definition"><strong>procedure:</strong> (format-date DESTINATION DATE-FORMAT-STRING [DATE])</dt>
     456<dd>
     457<p>Displays a text form of the <tt>DATE</tt> on the <tt>DESTINATION</tt> using the <tt>DATE-FORMAT-STRING</tt>.</p>
     458<p>When the destination is <code>#t</code> the <code>(current-output-port)</code> is used, and the date object must be specified.</p>
     459<p>When the destination is a string the <tt>DATE-FORMAT-STRING</tt> value must be a date object, the <tt>DESTINATION</tt> value is used as the <tt>DATE-FORMAT-STRING</tt>, and the result is returned as a string.</p>
     460<p>When the destination is a port it must be an <code>output-port</code>, and the date object must be specified. When the destination is a number the <code>(current-error-port)</code> is the destination, and the <tt>DATE</tt> object must be specified.</p>
     461<p>When the destination is <code>#f</code> the result is returned as a string, and the <tt>DATE</tt> object must be specified.</p></dd>
     462<dt class="definition"><strong>procedure:</strong> (scan-date SOURCE TEMPLATE-STRING)</dt>
     463<dd>
     464<p>Reads a text form of a date from the <tt>SOURCE</tt>, following the <tt>TEMPLATE-STRING</tt>, and returns a date object.</p>
     465<p>When the source is <code>#t</code> the <code>(current-input-port)</code> is used.</p>
     466<p>When the source is a port it must be an <code>input-port</code>.</p>
     467<p>When the source is string it should be a date text form.</p></dd></div></div>
     468<div class="section">
     469<h3>Bugs</h3>
     470<p>Local timezone information is not necessarily valid for historic dates and problematic for future dates. Daylight saving time is especially an issue. Conversion of a time or seconds value to a local date will use the current timezone offset value. The current offset will reflect the daylight saving time status. So target dates outside of the DST period will be converted incorrectly!</p>
     471<p>Will not read years less than 1 properly. The ISO 8601 year convention for years 1 BCE and before and years 10000 CE and after is not supported.</p></div>
     472<div class="section">
     473<h3>Issues</h3>
     474<p>31 December 1 BCE + 1 day =&gt; 1 January 1 CE. There is no year 0. Unlike the ISO 8601 convention do not subtract 1 when converting a year BCE to a SRFI-19 year, just negate the year.</p>
     475<p>The SRFI-18 <code>current-time</code> and <code>time?</code> bindings conflict with SRFI-19 bindings.</p>
     476<p>The SRFI-18 time object is not accepted except by the conversion procedures.</p>
     477<p>The expression <code>(time=? (seconds-&gt;time/type (nanoseconds-&gt;seconds (time-&gt;nanoseconds &lt;time-duration&gt;))) &lt;time-duration&gt;)</code> might be <code>#f</code>, due to the use of inexact arithmetic.</p>
     478<p>Be careful using the procedures that return some form of 'julian-day'. These are implemented using the full numeric tower and <em>will</em> return rational numbers. Performing arithmetic with such a result will require the &quot;numbers&quot; egg. See the file &quot;srfi-19-test.scm&quot; in this egg for an example.</p>
     479<p>This will be a problem with code that assumes fixnum and/or flonum <em>only</em> numbers. Perhaps an intermediate file that wraps any 'julian-day' calls and coerces to an inexact number. Use the wrapped 'julian-day' call in the problematic code.</p></div>
     480<div class="section">
     481<h3>Examples</h3>
     482<div id="examples">; See the &quot;srfi-19-test.scm&quot; file in the egg.</div></div>
     483<div class="section">
    158484<h3>Version</h3>
    159485<ul>
     486<li>2.6.11 Printing of &quot;xxx.0&quot; =&gt; xxx. More use of fixnum ops in srfi-19-10.</li>
    160487<li>2.6.10 Dropped :optional.</li>
    161488<li>2.6.9 Needs Chicken 2.610 for MacOS X &amp; Windows.</li>
     
    186513<li>1.0 Initial release</li></ul></div>
    187514<div class="section">
    188 <h3>Requires</h3>
    189 <ul>
    190 <li>Chicken 2.610</li>
    191 <li>locale</li>
    192 <li>srfi-29</li>
    193 <li>numbers</li></ul></div>
    194 <div class="section">
    195 <h3>Usage</h3><tt>(require-extension srfi-19)</tt></div>
    196 <div class="section">
    197 <h3>Download</h3><a href="srfi-19.egg">srfi-19.egg</a></div>
    198 <div class="section">
    199 <h3>Documentation</h3>
    200 <p>This is a Chicken port of SRFI-19. This document only describes the extensions. For the SRFI-19 API see <a href="http://srfi.schemers.org/srfi-19/srfi-19.html">SRFI-19</a>.</p>
    201 <div class="subsection">
    202 <h4>Core Procedures</h4>
    203 <div class="section">
    204 <h3>Usage</h3>(require-extension srfi-19-core)</div>
    205 <div class="subsubsection">
    206 <h5>SRFI-19 Document Changes</h5>
    207 <p>The <b>nanosecond</b> time object element is an integer between 0 and 999,999,999 inclusive. (The SRFI-19 document mis-states the value.)</p>
    208 <p>A <i>tz-offset</i> value follows ISO 8601; positive for <em>east</em> of UTC, and negative for <em>west</em>. This is the <em>opposite</em> of the POSIX TZ environment variable.</p>
    209 <p>Where the SRFI-19 document states a <i>tz-offset</i> argument a timezone-locale object is also legal.</p>
    210 <p>The <code>string-&gt;date</code> procedure allows the template-name argument to be optional. When missing the locale's date-time-format string is used. The supplied locale bundle's strings are invertible.</p>
    211 <dt class="definition"><strong>procedure:</strong> (make-date NANOSECOND SECOND MINUTE HOUR DAY MONTH YEAR ZONE-OFFSET [TZ-NAME #f] [DST-FLAG #f])</dt>
    212 <dd>
    213 <p>Same as SRFI-19 except for the optional parameters and allowing a timezone-locale object for the <tt>ZONE-OFFSET</tt>.</p></dd>
    214 <dt class="definition"><strong>procedure:</strong> (read-leap-second-table FILENAME)</dt>
    215 <dd>
    216 <p>Sets the leap second table from the specified <tt>FILENAME</tt>.</p>
    217 <p>The file format is the same as the &quot;tai-utc.dat&quot; file in the distribution. Provided by the U.S. Naval Observatory.</p></dd>
    218 <dt class="definition"><strong>procedure:</strong> (leap-year? DATE)</dt>
    219 <dd>
    220 <p>Does the specified <tt>DATE</tt> fall on a leap year?</p></dd></div>
    221 <div class="subsubsection">
    222 <h5>SRFI-18 Time</h5>
    223 <p>Due to conflicts between SRFI-18 and SRFI-19 procedure variables <code>srfi-19:current-time</code> is a synonym for <code>current-time</code> and <code>srfi-19:time?</code> is a synonym for <code>time?</code>.</p>
    224 <dt class="definition"><strong>procedure:</strong> (time-&gt;srfi-18-time TIME)</dt>
    225 <dd>
    226 <p>Converts a SRFI-19 time object to a SRFI-18 time object. The conversion is really only meaningful for time-duration, but any time-type is accepted.</p></dd>
    227 <dt class="definition"><strong>procedure:</strong> (srfi-18-time-&gt;time TIME)</dt>
    228 <dd>
    229 <p>Converts a SRFI-18 time object into a SRFI-19 time-duration object.</p></dd></div>
    230 <div class="subsubsection">
    231 <h5>Time Conversion</h5>
    232 <dt class="definition"><strong>procedure:</strong> (seconds-&gt;time/type SECONDS [TIME-TYPE time-duration])</dt>
    233 <dd>
    234 <p>Converts a <tt>SECONDS</tt> value, may be fractional, into a <tt>TIME-TYPE</tt> time object.</p></dd>
    235 <dt class="definition"><strong>procedure:</strong> (seconds-&gt;date/type SECONDS [TIMEZONE-INFO #f])</dt>
    236 <dd>
    237 <p>Converts a <tt>SECONDS</tt> value, which may be fractional, into a date object. The <tt>TIMEZONE-INFO</tt> is <code>#t</code> for the local timezone, <code>#f</code> for the utc timezone, or a timezone-locale object.</p>
    238 <p><tt>SECONDS</tt> is relative to 00:00:00 January 1, 1970 UTC.</p></dd>
    239 <dt class="definition"><strong>procedure:</strong> (time-&gt;nanoseconds TIME)</dt>
    240 <dd>
    241 <p>Returns the <tt>TIME</tt> object value as a nanoseconds value.</p></dd>
    242 <dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;time NANOSECONDS [TIME-TYPE time-duration])</dt>
    243 <dd>
    244 <p>Returns the <tt>NANOSECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
    245 <dt class="definition"><strong>procedure:</strong> (nanoseconds-&gt;seconds NANOSECONDS)</dt>
    246 <dd>
    247 <p>Returns the <tt>NANOSECONDS</tt> value as an inexact seconds value.</p></dd>
    248 <dt class="definition"><strong>procedure:</strong> (time-&gt;milliseconds TIME)</dt>
    249 <dd>
    250 <p>Returns the <tt>TIME</tt> object value as a milliseconds value.</p></dd>
    251 <dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;time MILLISECONDS [TIME-TYPE time-duration])</dt>
    252 <dd>
    253 <p>Returns the <tt>MILLISECONDS</tt> value as a time <tt>TIME-TYPE</tt> object.</p></dd>
    254 <dt class="definition"><strong>procedure:</strong> (milliseconds-&gt;seconds MILLISECONDS)</dt>
    255 <dd>
    256 <p>Returns the <tt>MILLISECONDS</tt> value as an inexact seconds value.</p></dd>
    257 <dt class="definition"><strong>procedure:</strong> (time-&gt;date TIME)</dt>
    258 <dd>
    259 <p>Returns the <tt>TIME</tt> object value as a date. A shorthand for the <code>(time-*-&gt;date ...)</code> procedures.</p></dd>
    260 <dt class="definition"><strong>procedure:</strong> (time-&gt;julian-day TIME)</dt>
    261 <dd>
    262 <p>Returns the julian day for the <tt>TIME</tt> object.</p></dd>
    263 <dt class="definition"><strong>procedure:</strong> (time-&gt;modified-julian-day TIME)</dt>
    264 <dd>
    265 <p>Returns the modified julian day for the <tt>TIME</tt> object.</p></dd></div>
    266 <div class="subsubsection">
    267 <h5>Time Arithmetic</h5>
    268 <dt class="definition"><strong>procedure:</strong> (make-duration [#:days 0] [#:hours 0] [#:minutes 0] [#:seconds 0] [#:milliseconds 0] [#:microseconds 0] [#:nanoseconds 0])</dt>
    269 <dd>
    270 <p>Returns a time-object of clock-type <code>time-duration</code> where the seconds and nanoseconds values are calculated by summing the keyword arguments.</p>
    271 <p><code>ONE-SECOND-DURATION</code> and <code>ONE-NANOSECOND-DURATION</code> are pre-defined.</p></dd>
    272 <dt class="definition"><strong>procedure:</strong> (divide-duration DURATION NUMBER)</dt>
    273 <dd>
    274 <p>Returns a duration, from <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
    275 <dt class="definition"><strong>procedure:</strong> (divide-duration! DURATION NUMBER)</dt>
    276 <dd>
    277 <p>Returns <tt>DURATION</tt>, divided by <tt>NUMBER</tt>, without remainder.</p></dd>
    278 <dt class="definition"><strong>procedure:</strong> (multiply-duration DURATION NUMBER)</dt>
    279 <dd>
    280 <p>Returns a duration, from <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
    281 <dt class="definition"><strong>procedure:</strong> (multiply-duration! DURATION NUMBER)</dt>
    282 <dd>
    283 <p>Returns <tt>DURATION</tt>, multiplied by <tt>NUMBER</tt>, truncated.</p></dd>
    284 <dt class="definition"><strong>procedure:</strong> (time-negative? TIME)</dt>
    285 <dd>
    286 <p>Is <tt>TIME</tt> negative?</p>
    287 <p>A time object will never have a negative nanoseconds value.</p></dd>
    288 <dt class="definition"><strong>procedure:</strong> (time-positve? TIME)</dt>
    289 <dd>
    290 <p>Is <tt>TIME</tt> positive?</p></dd>
    291 <dt class="definition"><strong>procedure:</strong> (time-zero? TIME)</dt>
    292 <dd>
    293 <p>Is <tt>TIME</tt> zero?</p></dd>
    294 <dt class="definition"><strong>procedure:</strong> (time-abs TIME)</dt>
    295 <dd>
    296 <p>Returns the absolute time value, from <tt>TIME</tt>.</p></dd>
    297 <dt class="definition"><strong>procedure:</strong> (time-abs! TIME)</dt>
    298 <dd>
    299 <p>Returns the absolute <tt>TIME</tt> value.</p></dd>
    300 <dt class="definition"><strong>procedure:</strong> (time-negate TIME)</dt>
    301 <dd>
    302 <p>Returns the sign inverted time value, from <tt>TIME</tt>.</p></dd>
    303 <dt class="definition"><strong>procedure:</strong> (time-negate! TIME)</dt>
    304 <dd>
    305 <p>Returns the<tt>TIME</tt> sign inverted value.</p></dd></div>
    306 <div class="subsubsection">
    307 <h5>Time Comparison</h5>
    308 <dt class="definition"><strong>procedure:</strong> (time-max TIME1 [TIME2 ...])</dt>
    309 <dd>
    310 <p>Returns the maximum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd>
    311 <dt class="definition"><strong>procedure:</strong> (time-min TIME1 [TIME2 ...])</dt>
    312 <dd>
    313 <p>Returns the minimum time object from <tt>TIME1 TIME2 ...</tt>.</p></dd></div>
    314 <div class="subsubsection">
    315 <h5>Dates</h5>
    316 <dt class="definition"><strong>parameter:</strong> (default-date-clock-type [CLOCK-TYPE time-utc])</dt>
    317 <dd>
    318 <p>Sets or gets the clock-type used by default for conversion of a date to a time.</p></dd>
    319 <dt class="definition"><strong>procedure:</strong> (copy-date DATE)</dt>
    320 <dd>
    321 <p>Returns an exact copy of the specified <tt>DATE</tt> object.</p></dd>
    322 <dt class="definition"><strong>procedure:</strong> (date-&gt;time DATE [CLOCK-TYPE (default-date-clock-type)])</dt>
    323 <dd>
    324 <p>Returns the specified <tt>DATE</tt> as a time-object of type <tt>CLOCK-TYPE</tt>.</p></dd>
    325 <dt class="definition"><strong>procedure:</strong> (date-zone-name DATE)</dt>
    326 <dd>
    327 <p>Returns the timezone abbreviation of the specified <tt>DATE</tt> object. The result is either a string or <code>#f</code>.</p></dd>
    328 <dt class="definition"><strong>procedure:</strong> (date-dst? DATE)</dt>
    329 <dd>
    330 <p>Returns the daylight saving time flag of the specified <tt>DATE</tt> object.</p>
    331 <p>Only valid for &quot;current&quot; dates. Historical dates will not have a correct setting. Future dates cannot have a correct setting.</p></dd></div>
    332 <div class="subsubsection">
    333 <h5>Date Arithmetic</h5>
    334 <dt class="definition"><strong>procedure:</strong> (date-difference DATE1 DATE2 [CLOCK-TYPE])</dt>
    335 <dd>
    336 <p>Returns the duration between <tt>DATE1</tt> and <tt>DATE2</tt>.</p></dd>
    337 <dt class="definition"><strong>procedure:</strong> (date-add-duration DATE DURATION [CLOCK-TYPE])</dt>
    338 <dd>
    339 <p>Returns the <tt>DATE</tt> plus the <tt>DURATION</tt>.</p></dd>
    340 <dt class="definition"><strong>procedure:</strong> (date-subtract-duration DATE DURATION [CLOCK-TYPE])</dt>
    341 <dd>
    342 <p>Returns the <tt>DATE</tt> minus the <tt>DURATION</tt>.</p></dd></div>
    343 <div class="subsubsection">
    344 <h5>Date Comparison</h5>
    345 <dt class="definition"><strong>procedure:</strong> (date=? DATE1 DATE2)</dt>
    346 <dd>
    347 <p>Is <tt>DATE1</tt> on <tt>DATE2</tt>?</p></dd>
    348 <dt class="definition"><strong>procedure:</strong> (date&gt;? DATE1 DATE2)</dt>
    349 <dd>
    350 <p>Is <tt>DATE1</tt> after <tt>DATE2</tt>?</p></dd>
    351 <dt class="definition"><strong>procedure:</strong> (date&lt;? DATE1 DATE2)</dt>
    352 <dd>
    353 <p>Is <tt>DATE1</tt> before <tt>DATE2</tt>?</p></dd>
    354 <dt class="definition"><strong>procedure:</strong> (date&gt;=? DATE1 DATE2)</dt>
    355 <dd>
    356 <p>Is <tt>DATE1</tt> after or on <tt>DATE2</tt>?</p></dd>
    357 <dt class="definition"><strong>procedure:</strong> (date&lt;=? DATE1 DATE2)</dt>
    358 <dd>
    359 <p>Is <tt>DATE1</tt> before or on <tt>DATE2</tt>?</p></dd></div>
    360 <div class="subsubsection">
    361 <h5>Timezone</h5>
    362 <p><b>Note</b> that the daylight saving time (summer time) flag is <em>always</em> taken from the system, unless supplied. Any summer time rule component of a <code>timezone-components</code> object is <em>not</em> processed.</p>
    363 <p>Remember that SRFI-19 timezone offset follows ISO 8601.</p>
    364 <dt class="definition"><strong>procedure:</strong> (make-timezone-locale DST-FLAG TZ-COMPONENTS)</dt>
    365 <dd>
    366 <p>Returns a timezone-locale object.</p>
    367 <p>A <tt>TZ-COMPONENTS</tt> object is as described by the <a href="locale.html">locale egg</a>.</p></dd>
    368 <dt class="definition"><strong>procedure:</strong> (timezone-locale? OBJ)</dt>
    369 <dd>
    370 <p>Is the <tt>OBJ</tt> a timezone-locale object?</p></dd>
    371 <dt class="definition"><strong>procedure:</strong> (make-local-timezone-locale)</dt>
    372 <dd>
    373 <p>Creates a local timezone-locale object. When the current timezone is not set a timezone-locale is built with information from <code>(seconds-&gt;local-time (current-seconds))</code>.</p></dd>
    374 <dt class="definition"><strong>parameter:</strong> (local-timezone-locale [TZ-LOCALE])</dt>
    375 <dd>
    376 <p>Gets or sets the local timezone-locale object.</p></dd>
    377 <dt class="definition"><strong>parameter:</strong> (utc-timezone-locale [TZ-LOCALE])</dt>
    378 <dd>
    379 <p>Gets or sets the utc timezone-locale object.</p>
    380 <p>Probably not a good idea to change the value.</p></dd>
    381 <dt class="definition"><strong>procedure:</strong> (timezone-locale-name [TZ-LOCALE])</dt>
    382 <dd>
    383 <p>Returns the timezone-locale name of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
    384 <dt class="definition"><strong>procedure:</strong> (timezone-locale-offset [TZ-LOCALE])</dt>
    385 <dd>
    386 <p>Returns the timezone-locale offset of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd>
    387 <dt class="definition"><strong>procedure:</strong> (timezone-locale-dst? [TZ-LOCALE])</dt>
    388 <dd>
    389 <p>Returns the timezone-locale daylight saving time flag of the supplied <tt>TZ-LOCALE</tt>, or the <code>(local-timezone-locale)</code> if missing.</p></dd></div></div>
    390 <div class="subsection">
    391 <h4>Time Period</h4>
    392 <div class="section">
    393 <h3>Usage</h3>(require-extension srfi-19-period)</div>
    394 <p>A time-period is an interval, [begin end), where begin and end are time objects of the same clock type. When end &lt;= begin the interval is null.</p>
    395 <dt class="definition"><strong>procedure:</strong> (make-null-time-period [CLOCK-TYPE (default-date-clock-type)])</dt>
    396 <dd>
    397 <p>Returns a null interval for the specified <tt>CLOCK-TYPE</tt>.</p></dd>
    398 <dt class="definition"><strong>procedure:</strong> (make-time-period BEGIN END [CLOCK-TYPE (default-date-clock-type)])</dt>
    399 <dd>
    400 <p>Returns a new time-period object. The clock types must be compatible.</p>
    401 <p><tt>BEGIN</tt> maybe a seconds value, a date, or a time (except time-duration). A seconds value or date are converted to <tt>CLOCK-TYPE</tt>.</p>
    402 <p><tt>END</tt> maybe a seconds value, a date, or a time. A seconds value or date are converted to the same clock type as <tt>BEGIN</tt>. A time-duration is treated as an offset from <tt>BEGIN</tt>.</p></dd>
    403 <dt class="definition"><strong>procedure:</strong> (copy-time-period TIME-PERIOD)</dt>
    404 <dd>
    405 <p>Returns a copy of <tt>TIME-PERIOD</tt>.</p></dd>
    406 <dt class="definition"><strong>procedure:</strong> (time-period-begin TIME-PERIOD)</dt>
    407 <dd>
    408 <p>Returns the start time for the <tt>TIME-PERIOD</tt>.</p></dd>
    409 <dt class="definition"><strong>procedure:</strong> (time-period-end TIME-PERIOD)</dt>
    410 <dd>
    411 <p>Returns the end time for the <tt>TIME-PERIOD</tt>.</p></dd>
    412 <dt class="definition"><strong>procedure:</strong> (time-period-last TIME-PERIOD)</dt>
    413 <dd>
    414 <p>Returns the last time for the <tt>TIME-PERIOD</tt>; (time-period-end - 1ns).</p></dd>
    415 <dt class="definition"><strong>procedure:</strong> (time-period-type TIME-PERIOD)</dt>
    416 <dd>
    417 <p>Returns the clock-type of the <tt>TIME-PERIOD</tt>.</p></dd>
    418 <dt class="definition"><strong>procedure:</strong> (time-period? OBJECT)</dt>
    419 <dd>
    420 <p>Is <tt>OBJECT</tt> a time-period?</p></dd>
    421 <dt class="definition"><strong>procedure:</strong> (time-period-null? TIME-PERIOD)</dt>
    422 <dd>
    423 <p>Is the <tt>TIME-PERIOD</tt> null?</p></dd>
    424 <dt class="definition"><strong>procedure:</strong> (time-period-length TIME-PERIOD)</dt>
    425 <dd>
    426 <p>Returns the time-duration of the <tt>TIME-PERIOD</tt>.</p></dd>
    427 <dt class="definition"><strong>procedure:</strong> (time-period=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    428 <dd>
    429 <p>Does <tt>TIME-PERIOD-1</tt> begin &amp; end with <tt>TIME-PERIOD-2</tt>?</p></dd>
    430 <dt class="definition"><strong>procedure:</strong> (time-period&lt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    431 <dd>
    432 <p>Does <tt>TIME-PERIOD-1</tt> end before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
    433 <dt class="definition"><strong>procedure:</strong> (time-period&gt;? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    434 <dd>
    435 <p>Does <tt>TIME-PERIOD-1</tt> begin after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
    436 <dt class="definition"><strong>procedure:</strong> (time-period&lt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    437 <dd>
    438 <p>Does <tt>TIME-PERIOD-1</tt> end on or before <tt>TIME-PERIOD-2</tt> begins?</p></dd>
    439 <dt class="definition"><strong>procedure:</strong> (time-period&gt;=? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    440 <dd>
    441 <p>Does <tt>TIME-PERIOD-1</tt> begin on or after <tt>TIME-PERIOD-2</tt> ends?</p></dd>
    442 <dt class="definition"><strong>procedure:</strong> (time-period-preceding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    443 <dd>
    444 <p>Return the portion of <tt>TIME-PERIOD-1</tt> before <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't precede.</p></dd>
    445 <dt class="definition"><strong>procedure:</strong> (time-period-succeeding TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    446 <dd>
    447 <p>Return the portion of <tt>TIME-PERIOD-1</tt> after <tt>TIME-PERIOD-2</tt> or <code>#f</code> when it doesn't succeed.</p></dd>
    448 <dt class="definition"><strong>procedure:</strong> (time-period-contains/period? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    449 <dd>
    450 <p>Is <tt>TIME-PERIOD-2</tt> within <tt>TIME-PERIOD-1</tt>?</p></dd>
    451 <dt class="definition"><strong>procedure:</strong> (time-period-contains/time? TIME-PERIOD TIME)</dt>
    452 <dd>
    453 <p>Is <tt>TIME</tt> within <tt>TIME-PERIOD</tt>?</p>
    454 <p><tt>TIME</tt> is converted to a compatible clock-type if possible.</p></dd>
    455 <dt class="definition"><strong>procedure:</strong> (time-period-contains/date? TIME-PERIOD DATE)</dt>
    456 <dd>
    457 <p>Is <tt>DATE</tt> within <tt>TIME-PERIOD</tt>?</p>
    458 <p><tt>DATE</tt> is converted to a compatible time if possible.</p></dd>
    459 <dt class="definition"><strong>procedure:</strong> (time-period-contains? TIME-PERIOD OBJECT)</dt>
    460 <dd>
    461 <p>Is <tt>OBJECT</tt> within <tt>TIME-PERIOD</tt>?</p>
    462 <p><tt>OBJECT</tt> maybe a time, date, or time-period.</p></dd>
    463 <dt class="definition"><strong>procedure:</strong> (time-period-intersects? TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    464 <dd>
    465 <p>Does <tt>TIME-PERIOD-2</tt> overlap <tt>TIME-PERIOD-1</tt>?</p></dd>
    466 <dt class="definition"><strong>procedure:</strong> (time-period-intersection TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    467 <dd>
    468 <p>The overlapping time-period of <tt>TIME-PERIOD-2</tt> and <tt>TIME-PERIOD-1</tt>, or <code>#f</code> when no overlap.</p></dd>
    469 <dt class="definition"><strong>procedure:</strong> (time-period-union TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    470 <dd>
    471 <p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, or <code>#f</code> when they do not intersect.</p></dd>
    472 <dt class="definition"><strong>procedure:</strong> (time-period-span TIME-PERIOD-1 TIME-PERIOD-2)</dt>
    473 <dd>
    474 <p>Returns the time-period spanned by <tt>TIME-PERIOD-1</tt> and <tt>TIME-PERIOD-2</tt>, including any gaps.</p></dd>
    475 <dt class="definition"><strong>procedure:</strong> (time-period-shift TIME-PERIOD DURATION)</dt>
    476 <dd>
    477 <p>Returns a copy of <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd>
    478 <dt class="definition"><strong>procedure:</strong> (time-period-shift! TIME-PERIOD DURATION)</dt>
    479 <dd>
    480 <p>Returns <tt>TIME-PERIOD</tt> shifted by <tt>DURATION</tt>.</p></dd></div>
    481 <div class="subsection">
    482 <h4>Input/Output Procedures</h4>
    483 <div class="section">
    484 <h3>Usage</h3>(require-extension srfi-19-io)</div>
    485 <dt class="definition"><strong>procedure:</strong> (format-date DESTINATION DATE-FORMAT-STRING [DATE])</dt>
    486 <dd>
    487 <p>Displays a text form of the <tt>DATE</tt> on the <tt>DESTINATION</tt> using the <tt>DATE-FORMAT-STRING</tt>.</p>
    488 <p>When the destination is <code>#t</code> the <code>(current-output-port)</code> is used, and the date object must be specified.</p>
    489 <p>When the destination is a string the <tt>DATE-FORMAT-STRING</tt> value must be a date object, the <tt>DESTINATION</tt> value is used as the <tt>DATE-FORMAT-STRING</tt>, and the result is returned as a string.</p>
    490 <p>When the destination is a port it must be an <code>output-port</code>, and the date object must be specified. When the destination is a number the <code>(current-error-port)</code> is the destination, and the <tt>DATE</tt> object must be specified.</p>
    491 <p>When the destination is <code>#f</code> the result is returned as a string, and the <tt>DATE</tt> object must be specified.</p></dd>
    492 <dt class="definition"><strong>procedure:</strong> (scan-date SOURCE TEMPLATE-STRING)</dt>
    493 <dd>
    494 <p>Reads a text form of a date from the <tt>SOURCE</tt>, following the <tt>TEMPLATE-STRING</tt>, and returns a date object.</p>
    495 <p>When the source is <code>#t</code> the <code>(current-input-port)</code> is used.</p>
    496 <p>When the source is a port it must be an <code>input-port</code>.</p>
    497 <p>When the source is string it should be a date text form.</p></dd></div></div>
    498 <div class="section">
    499 <h3>Bugs</h3>
    500 <p>Local timezone information is not necessarily valid for historic dates and problematic for future dates. Daylight saving time is especially an issue. Conversion of a time or seconds value to a local date will use the current timezone offset value. The current offset will reflect the daylight saving time status. So target dates outside of the DST period will be converted incorrectly!</p>
    501 <p>Will not read years less than 1 properly. The ISO 8601 year convention for years 1 BCE and before and years 10000 CE and after is not supported.</p></div>
    502 <div class="section">
    503 <h3>Issues</h3>
    504 <p>31 December 1 BCE + 1 day =&gt; 1 January 1 CE. There is no year 0. Unlike the ISO 8601 convention do not subtract 1 when converting a year BCE to a SRFI-19 year, just negate the year.</p>
    505 <p>The SRFI-18 <code>current-time</code> and <code>time?</code> bindings conflict with SRFI-19 bindings.</p>
    506 <p>The SRFI-18 time object is not accepted except by the conversion procedures.</p>
    507 <p>The expression <code>(time=? (seconds-&gt;time/type (nanoseconds-&gt;seconds (time-&gt;nanoseconds &lt;time-duration&gt;))) &lt;time-duration&gt;)</code> might be <code>#f</code>, due to the use of inexact arithmetic.</p>
    508 <p>Be careful using the procedures that return some form of 'julian-day'. These are implemented using the full numeric tower and <em>will</em> return rational numbers. Performing arithmetic with such a result will require the &quot;numbers&quot; egg. See the file &quot;srfi-19-test.scm&quot; in this egg for an example.</p>
    509 <p>This will be a problem with code that assumes fixnum and/or flonum <em>only</em> numbers. Perhaps an intermediate file that wraps any 'julian-day' calls and coerces to an inexact number. Use the wrapped 'julian-day' call in the problematic code.</p></div>
    510 <div class="section">
    511 <h3>Examples</h3>
    512 <div id="examples">; See the &quot;srfi-19-test.scm&quot; file in the egg.</div></div>
    513 <div class="section">
    514515<h3>License</h3>
    515516<pre>Copyright (c) 2005, Kon Lovett.  All rights reserved.
Note: See TracChangeset for help on using the changeset viewer.