From 738310320195515a86933e6d0050c720ccd1a519 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 24 Apr 1996 03:27:06 +0000 Subject: [PATCH] Implement support for time-zone information in decoded-time data type. Generalize the procedure FILE-TIME->STRING so that it generates an RFC-822 time string (when time-zone information is available from the microcode). --- v7/src/runtime/datime.scm | 49 +++++++++++++++++++++++++++++++++++---- v7/src/runtime/dosprm.scm | 7 +----- v7/src/runtime/ntprm.scm | 7 +----- v7/src/runtime/os2prm.scm | 8 +------ v7/src/runtime/unxprm.scm | 6 +---- 5 files changed, 49 insertions(+), 28 deletions(-) diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm index ee6d9afdc..302ae711e 100644 --- a/v7/src/runtime/datime.scm +++ b/v7/src/runtime/datime.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: datime.scm,v 14.12 1995/04/23 05:58:14 cph Exp $ +$Id: datime.scm,v 14.13 1996/04/24 03:22:03 cph Exp $ -Copyright (c) 1988-95 Massachusetts Institute of Technology +Copyright (c) 1988-96 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -57,7 +57,8 @@ MIT in each case. |# (month #f read-only #t) (year #f read-only #t) (day-of-week #f read-only #t) - (daylight-savings-time #f read-only #t)) + (daylight-savings-time #f read-only #t) + (zone #f)) (define (make-decoded-time second minute hour day month year) (let ((dt @@ -74,14 +75,19 @@ MIT in each case. |# month (if (< year 0) 0 year) 0 - -1))))) + -1 + #f))))) ;; These calls fill in the other fields of the structure. ((ucode-primitive decode-time 2) dt ((ucode-primitive encode-time 1) dt)) + (if (decoded-time/zone dt) + (set-decoded-time/zone! dt (/ (decoded-time/zone dt) 3600))) dt)) (define (decode-universal-time time) (let ((result (allocate-decoded-time))) ((ucode-primitive decode-time 2) result time) + (if (decoded-time/zone result) + (set-decoded-time/zone! result (/ (decoded-time/zone result) 3600))) result)) (define (encode-universal-time dt) @@ -126,6 +132,41 @@ MIT in each case. |# " " (if (< hour 12) "AM" "PM")))) +(define (universal-time->string time) + (decoded-time->string (decode-universal-time time))) + +(define (file-time->string time) + (decoded-time->string (decode-file-time time))) + +(define (decoded-time->string dt) + ;; The returned string is in the format specified by RFC 822, + ;; "Standard for the Format of ARPA Internet Text Messages", + ;; provided that time-zone information is available from the C + ;; library. + (let ((d2 (lambda (n) (string-pad-left (number->string n) 2 #\0)))) + (string-append (day-of-week/short-string (decoded-time/day-of-week dt)) + ", " + (number->string (decoded-time/day dt)) + " " + (month/short-string (decoded-time/month dt)) + " " + (number->string (decoded-time/year dt)) + " " + (d2 (decoded-time/hour dt)) + ":" + (d2 (decoded-time/minute dt)) + ":" + (d2 (decoded-time/second dt)) + (let ((zone (decoded-time/zone dt))) + (if zone + (string-append + " " + (time-zone->string + (if (decoded-time/daylight-savings-time? dt) + (- zone 1) + zone))) + ""))))) + (define (time-zone->string tz) (if (not (time-zone? tz)) (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING)) diff --git a/v7/src/runtime/dosprm.scm b/v7/src/runtime/dosprm.scm index 795a85715..607b30113 100644 --- a/v7/src/runtime/dosprm.scm +++ b/v7/src/runtime/dosprm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: dosprm.scm,v 1.36 1995/11/10 23:48:18 cph Exp $ +$Id: dosprm.scm,v 1.37 1996/04/24 03:21:49 cph Exp $ Copyright (c) 1992-95 Massachusetts Institute of Technology @@ -257,10 +257,6 @@ MIT in each case. |# user-name))))) (merge-pathnames "\\"))) -(define (file-time->string time) - (or ((ucode-primitive file-time->string 1) time) - "Thu Jan 1 00:00:00 1970")) - (define (decode-file-time time) (decode-universal-time time)) (define (encode-file-time dt) (encode-universal-time dt)) (define (file-time->universal-time time) time) @@ -269,7 +265,6 @@ MIT in each case. |# (define dos/user-home-directory user-home-directory) (define dos/current-user-name current-user-name) (define dos/current-home-directory current-home-directory) -(define dos/file-time->string file-time->string) (define (file-touch filename) ((ucode-primitive file-touch 1) diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm index 9d6a29ca7..e5f5eb596 100644 --- a/v7/src/runtime/ntprm.scm +++ b/v7/src/runtime/ntprm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: ntprm.scm,v 1.4 1996/04/09 20:13:30 adams Exp $ +$Id: ntprm.scm,v 1.5 1996/04/24 03:21:37 cph Exp $ Copyright (c) 1992-96 Massachusetts Institute of Technology @@ -274,10 +274,6 @@ MIT in each case. |# (pathname-as-directory (merge-pathnames (or homepath home) homedrive))))) -(define (file-time->string time) - (or ((ucode-primitive file-time->string 1) time) - "Thu Jan 1 00:00:00 1970")) - (define (decode-file-time time) (decode-universal-time time)) (define (encode-file-time dt) (encode-universal-time dt)) (define (file-time->universal-time time) time) @@ -286,7 +282,6 @@ MIT in each case. |# (define dos/user-home-directory user-home-directory) (define dos/current-user-name current-user-name) (define dos/current-home-directory current-home-directory) -(define dos/file-time->string file-time->string) (define (file-touch filename) ((ucode-primitive file-touch 1) diff --git a/v7/src/runtime/os2prm.scm b/v7/src/runtime/os2prm.scm index d29e09982..b0d0e119a 100644 --- a/v7/src/runtime/os2prm.scm +++ b/v7/src/runtime/os2prm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: os2prm.scm,v 1.25 1996/04/24 03:21:30 cph Exp $ +$Id: os2prm.scm,v 1.26 1996/04/24 03:25:32 cph Exp $ Copyright (c) 1994-95 Massachusetts Institute of Technology @@ -110,12 +110,6 @@ MIT in each case. |# access-time modification-time)) -(define (local-time-zone) - (/ ((ucode-primitive os2-time-zone 0)) 3600)) - -(define os2/daylight-savings-time? - (ucode-primitive os2-daylight-savings-time? 0)) - (define (decode-file-time time) (let* ((twosecs (remainder time 32)) (time (quotient time 32)) (minutes (remainder time 64)) (time (quotient time 64)) diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm index 21748c9cb..b92bf7f13 100644 --- a/v7/src/runtime/unxprm.scm +++ b/v7/src/runtime/unxprm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: unxprm.scm,v 1.41 1995/10/28 01:16:00 cph Exp $ +$Id: unxprm.scm,v 1.42 1996/04/24 03:27:06 cph Exp $ Copyright (c) 1988-95 Massachusetts Institute of Technology @@ -230,9 +230,6 @@ MIT in each case. |# (define-integrable current-user-name (ucode-primitive current-user-name 0)) -(define-integrable file-time->string - (ucode-primitive file-time->string 1)) - (define (decode-file-time time) (decode-universal-time time)) (define (encode-file-time dt) (encode-universal-time dt)) (define (file-time->universal-time time) time) @@ -241,7 +238,6 @@ MIT in each case. |# (define unix/user-home-directory user-home-directory) (define unix/current-home-directory current-home-directory) (define unix/current-user-name current-user-name) -(define unix/file-time->string file-time->string) (define-integrable unix/current-uid (ucode-primitive current-uid 0)) -- 2.25.1