scsh-conservatory
/
scsh-0.5
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- fixed timezone-formatting bug 

- added date field-mod procs
- commented a bit
This commit is contained in:
shivers 1997-11-10 02:53:24 +00:00
parent c7344577f3
commit a5f1300753
1 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
scsh/time.scm
View File

@ -65,6 +65,18 @@
(define set-date:week-day set-%date:week-day) (define set-date:week-day set-%date:week-day)
(define set-date:year-day set-%date:year-day) (define set-date:year-day set-%date:year-day)
(define modify-date:seconds modify-%date:seconds)
(define modify-date:minute modify-%date:minute)
(define modify-date:hour modify-%date:hour)
(define modify-date:month-day modify-%date:month-day)
(define modify-date:month modify-%date:month)
(define modify-date:year modify-%date:year)
(define modify-date:tz-name modify-%date:tz-name)
(define modify-date:tz-secs modify-%date:tz-secs)
(define modify-date:summer? modify-%date:summer?)
(define modify-date:week-day modify-%date:week-day)
(define modify-date:year-day modify-%date:year-day)
(define (make-date s mi h md mo y . args) (define (make-date s mi h md mo y . args)
(let-optionals args ((tzn #f) (tzs #f) (s? #f) (wd 0) (yd 0)) (let-optionals args ((tzn #f) (tzs #f) (s? #f) (wd 0) (yd 0))
(make-%date s mi h md mo y tzn tzs s? wd yd))) (make-%date s mi h md mo y tzn tzs s? wd yd)))
@ -295,14 +307,15 @@
(if (< offset 0) (if (< offset 0)
(values #\+ (- offset)) ; Notice the flipped sign (values #\+ (- offset)) ; Notice the flipped sign
(values #\- offset)) ; of SIGN. (values #\- offset)) ; of SIGN.
(let* ((offset (modulo offset 86400)) (let* ((offset (modulo offset 86400)) ; seconds/day
(h (quotient offset 3600)) (h (quotient offset 3600)) ; seconds/hour
(m (quotient (modulo offset 3600) 60)) (m (quotient (modulo offset 3600) 60))
(s (modulo offset 60))) (s (modulo offset 60)))
(if (zero? s) (if (zero? s)
(if (zero? m) (if (zero? m)
(format #f "~a~a~d" name sign h) ; name+h (format #f "~a~a~d" name sign h) ; name+h
(format #f "~a~a~a:~a" ; name+hh:mm (format #f "~a~a~a:~a" ; name+hh:mm
sign (two-digits h) (two-digits m))) name sign (two-digits h) (two-digits m)))
(format #f "~a~a~a:~a:~a" ; name+hh:mm:ss (format #f "~a~a~a:~a:~a" ; name+hh:mm:ss
sign (two-digits h) (two-digits m) (two-digits s))))))) name sign
(two-digits h) (two-digits m) (two-digits s)))))))