blob: 248f638d21aee0d390aa101ff7d9ab121b1f6a2e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
;;;; "cltime.scm" Common-Lisp time conversion routines.
;;; Copyright (C) 1994 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
;understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warrantee or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
(require 'values)
(require 'posix-time)
(define (get-decoded-time)
(decode-universal-time (get-universal-time)))
(define (get-universal-time)
(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)
""))))
(values
(vector-ref tv 0) ;second [0..59]
(vector-ref tv 1) ;minute [0..59]
(vector-ref tv 2) ;hour [0..23]
(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)
(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))))
(tv (vector second
minute
hour
date
(+ -1 month)
(+ -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))))
(tzset)
|
