summaryrefslogtreecommitdiffstats
path: root/cltime.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commitf24b9140d6f74804d5599ec225717d38ca443813 (patch)
tree0da952f1a5a7c0eacfc05c296766523e32c05fe2 /cltime.scm
parent8ffbc2df0fde83082610149d24e594c1cd879f4a (diff)
downloadslib-f24b9140d6f74804d5599ec225717d38ca443813.tar.gz
slib-f24b9140d6f74804d5599ec225717d38ca443813.zip
Import Upstream version 2c0upstream/2c0
Diffstat (limited to 'cltime.scm')
-rw-r--r--cltime.scm37
1 files changed, 15 insertions, 22 deletions
diff --git a/cltime.scm b/cltime.scm
index 248f638..441e7f9 100644
--- a/cltime.scm
+++ b/cltime.scm
@@ -1,5 +1,5 @@
;;;; "cltime.scm" Common-Lisp time conversion routines.
-;;; Copyright (C) 1994 Aubrey Jaffer.
+;;; Copyright (C) 1994, 1997 Aubrey Jaffer.
;
;Permission to copy this software, to redistribute it, and to use it
;for any purpose is granted, subject to the following restrictions and
@@ -18,8 +18,11 @@
;each case.
(require 'values)
+(require 'time-zone)
(require 'posix-time)
+(define time:1900 (time:invert time:gmtime '#(0 0 0 1 0 0 #f #f 0 0 "GMT")))
+
(define (get-decoded-time)
(decode-universal-time (get-universal-time)))
@@ -27,13 +30,11 @@
(difftime (current-time) time:1900))
(define (decode-universal-time utime . tzarg)
- (let* ((tz (if (null? tzarg) *timezone* (* 3600 (car tzarg))))
- (tv (time:split
- (offset-time time:1900 utime)
- (if (null? tzarg) time:daylight 0)
- tz
- (if (= tz *timezone*) (vector-ref time:tzname time:daylight)
- ""))))
+ (let ((tv (apply time:split
+ (offset-time time:1900 utime)
+ (if (null? tzarg)
+ (tz:params utime (tzset))
+ (list 0 (* 3600 (car tzarg)) "???")))))
(values
(vector-ref tv 0) ;second [0..59]
(vector-ref tv 1) ;minute [0..59]
@@ -41,18 +42,18 @@
(vector-ref tv 3) ;date [1..31]
(+ 1 (vector-ref tv 4)) ;month [1..12]
(+ 1900 (vector-ref tv 5)) ;year [0....]
- (modulo (+ -1 (vector-ref tv 6)) 7);day-of-week [0..6] (0 is Monday)
+ (modulo (+ -1 (vector-ref tv 6)) 7) ;day-of-week [0..6] (0 is Monday)
(eqv? 1 (vector-ref tv 8)) ;daylight-saving-time?
(if (provided? 'inexact)
(inexact->exact (/ (vector-ref tv 9) 3600))
(/ (vector-ref tv 9) 3600)) ;time-zone [-24..24]
)))
-(define time:1900 (time:invert time:gmtime #(0 0 0 1 0 0 #f #f 0 0 "GMT")))
-
(define (encode-universal-time second minute hour date month year . tzarg)
- (let* ((tz (if (null? tzarg) *timezone*
- (* 3600 (car tzarg))))
+ (let* ((tz (if (null? tzarg)
+ (tzset)
+ (time-zone (string-append
+ "???" (number->string (car tzarg))))))
(tv (vector second
minute
hour
@@ -61,14 +62,6 @@
(+ -1900 year)
#f ;ignored
#f ;ignored
- (if (= tz *timezone*) time:daylight 0)
- tz
- (cond ((= tz *timezone*)
- (vector-ref time:tzname time:daylight))
- ((zero? tz) "GMT")
- (else ""))
)))
- (if (= tz *timezone*) (difftime (time:invert localtime tv) time:1900)
- (difftime (offset-time (time:invert gmtime tv) tz) time:1900))))
+ (difftime (time:invert localtime tv) time:1900)))
-(tzset)