From: Chris Hanson <org/chris-hanson/cph>
Date: Sat, 22 Apr 1995 23:42:10 +0000 (+0000)
Subject: Implement some rudimentary time-zone code so that we can produce
X-Git-Tag: 20090517-FFI~6416
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6d6660db6def3411d8b8e051728080b629527f15;p=mit-scheme.git

Implement some rudimentary time-zone code so that we can produce
reasonably accurate time zones in RFC-822 dates.
---

diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm
index d68c96c3a..8860729c8 100644
--- a/v7/src/runtime/datime.scm
+++ b/v7/src/runtime/datime.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: datime.scm,v 14.8 1995/04/22 23:37:09 cph Exp $
+$Id: datime.scm,v 14.9 1995/04/22 23:42:10 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -150,10 +150,11 @@ MIT in each case. |#
   (if (not (time-zone? tz))
       (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING))
   (let ((minutes (round (* 60 (- tz)))))
-    (let ((qr (integer-divide (abs minutes) 60)))
+    (let ((qr (integer-divide (abs minutes) 60))
+	  (d2 (lambda (n) (string-pad-left (number->string n) 2 #\0))))
       (string-append (if (< minutes 0) "-" "+")
-		     (string-pad-left (integer-divide-quotient qr) 2 #\0)
-		     (string-pad-left (integer-divide-remainder qr) 2 #\0)))))
+		     (d2 (integer-divide-quotient qr))
+		     (d2 (integer-divide-remainder qr))))))
 
 (define (decoded-time/daylight-savings-time? dt)
   ;; In current implementation, DAY-OF-WEEK field might be missing, so
diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm
index d3227964e..b692417af 100644
--- a/v7/src/runtime/os2prm.scm
+++ b/v7/src/runtime/os2prm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2prm.scm,v 1.12 1995/04/15 06:58:41 cph Exp $
+$Id: os2prm.scm,v 1.13 1995/04/22 23:38:03 cph Exp $
 
 Copyright (c) 1994-95 Massachusetts Institute of Technology
 
@@ -105,7 +105,6 @@ MIT in each case. |#
    modification-time))
 
 (define (file-time->string time)
-  ;; Except for the missing time zone, this is an RFC-822 date/time string.
   (let ((dt (decode-file-time time))
 	(d2 (lambda (n) (string-pad-left (number->string n) 2 #\0))))
     (string-append (number->string (decoded-time/day dt))
@@ -118,7 +117,24 @@ MIT in each case. |#
 		   ":"
 		   (d2 (decoded-time/minute dt))
 		   ":"
-		   (d2 (decoded-time/second dt)))))
+		   (d2 (decoded-time/second dt))
+		   " "
+		   (time-zone->string
+		    (let ((tz (local-time-zone)))
+		      (if (decoded-time/daylight-savings-time? dt)
+			  (- tz 1)
+			  tz))))))
+
+(define (local-time-zone)
+  (let ((tz (get-environment-variable "TZ")))
+    (or (and tz
+	     (let ((l (string-length tz)))
+	       (and (fix:> l 6)
+		    (let ((n (substring->number tz 3 (fix:- l 3))))
+		      (and (exact-integer? n)
+			   (<= -24 n 24)
+			   n)))))
+	5)))
 
 (define (decode-file-time time)
   (let* ((twosecs (remainder time 32))
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 568a3b353..fda3995f5 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.252 1995/04/15 06:10:04 cph Exp $
+$Id: runtime.pkg,v 14.253 1995/04/22 23:37:23 cph Exp $
 
 Copyright (c) 1988-95 Massachusetts Institute of Technology
 
@@ -375,6 +375,7 @@ MIT in each case. |#
 	  decoded-time/date-string
 	  decoded-time/day
 	  decoded-time/day-of-week
+	  decoded-time/daylight-savings-time?
 	  decoded-time/hour
 	  decoded-time/minute
 	  decoded-time/month
@@ -387,7 +388,9 @@ MIT in each case. |#
 	  make-decoded-time
 	  month/long-string
 	  month/max-days
-	  month/short-string))
+	  month/short-string
+	  time-zone->string
+	  time-zone?))
 
 (define-package (runtime debugger)
   (files "debug")