From d8c25a44d0fd8181a31a63fcac61aff4038b81cb Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 23 Apr 1995 05:43:50 +0000 Subject: [PATCH] Implement procedures to return strings for weekdays. --- v7/src/runtime/datime.scm | 100 ++++++++++++++++++++----------------- v7/src/runtime/runtime.pkg | 4 +- v8/src/runtime/runtime.pkg | 4 +- 3 files changed, 61 insertions(+), 47 deletions(-) diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm index 65db21be0..85607562e 100644 --- a/v7/src/runtime/datime.scm +++ b/v7/src/runtime/datime.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: datime.scm,v 14.10 1995/04/23 03:19:48 cph Exp $ +$Id: datime.scm,v 14.11 1995/04/23 05:43:43 cph Exp $ Copyright (c) 1988-95 Massachusetts Institute of Technology @@ -79,29 +79,6 @@ MIT in each case. |# ((ucode-primitive decode-time 2) dt ((ucode-primitive encode-time 1) dt)) dt)) -(define (month/max-days month) - (guarantee-month month 'MONTH/MAX-DAYS) - (vector-ref '#(31 29 31 30 31 30 31 31 30 31 30 31) (- month 1))) - -(define (month/short-string month) - (guarantee-month month 'MONTH/SHORT-STRING) - (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" - "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") - (- month 1))) - -(define (month/long-string month) - (guarantee-month month 'MONTH/LONG-STRING) - (vector-ref '#("January" "February" "March" "April" "May" "June" - "July" "August" "September" "October" - "November" "December") - (- month 1))) - -(define (guarantee-month month name) - (if (not (exact-integer? month)) - (error:wrong-type-argument month "month integer" name)) - (if (not (<= 1 month 12)) - (error:bad-range-argument month name))) - (define (decode-universal-time time) (let ((result (allocate-decoded-time))) ((ucode-primitive decode-time 2) result time) @@ -116,20 +93,23 @@ MIT in each case. |# (define (get-decoded-time) (decode-universal-time (get-universal-time))) +(define (time-zone? object) + (and (number? object) + (exact? object) + (<= -24 object 24) + (integer? (* 3600 object)))) + +(define (decoded-time/daylight-savings-time? dt) + (> (decoded-time/daylight-savings-time dt) 0)) + (define (decoded-time/date-string time) - (string-append - (if (decoded-time/day-of-week time) - (string-append - (vector-ref '#("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" - "Saturday" "Sunday") - (decoded-time/day-of-week time)) - " ") - "") - (month/long-string (decoded-time/month time)) - " " - (number->string (decoded-time/day time)) - ", " - (number->string (decoded-time/year time)))) + (string-append (weekday/long-string (decoded-time/day-of-week time)) + " " + (month/long-string (decoded-time/month time)) + " " + (number->string (decoded-time/day time)) + ", " + (number->string (decoded-time/year time)))) (define (decoded-time/time-string time) (let ((second (decoded-time/second time)) @@ -146,12 +126,6 @@ MIT in each case. |# " " (if (< hour 12) "AM" "PM")))) -(define (time-zone? object) - (and (number? object) - (exact? object) - (<= -24 object 24) - (integer? (* 3600 object)))) - (define (time-zone->string tz) (if (not (time-zone? tz)) (error:wrong-type-argument tz "time zone" 'TIME-ZONE->STRING)) @@ -162,5 +136,41 @@ MIT in each case. |# (d2 (integer-divide-quotient qr)) (d2 (integer-divide-remainder qr)))))) -(define (decoded-time/daylight-savings-time? dt) - (> (decoded-time/daylight-savings-time dt) 0)) \ No newline at end of file +(define (month/max-days month) + (guarantee-month month 'MONTH/MAX-DAYS) + (vector-ref '#(31 29 31 30 31 30 31 31 30 31 30 31) (- month 1))) + +(define (month/short-string month) + (guarantee-month month 'MONTH/SHORT-STRING) + (vector-ref '#("Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") + (- month 1))) + +(define (month/long-string month) + (guarantee-month month 'MONTH/LONG-STRING) + (vector-ref '#("January" "February" "March" "April" "May" "June" + "July" "August" "September" "October" + "November" "December") + (- month 1))) + +(define (guarantee-month month name) + (if (not (exact-integer? month)) + (error:wrong-type-argument month "month integer" name)) + (if (not (<= 1 month 12)) + (error:bad-range-argument month name))) + +(define (day-of-week/short-string day) + (guarantee-day-of-week day 'DAY-OF-WEEK/SHORT-STRING) + (vector-ref '#("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") day-of-week)) + +(define (day-of-week/long-string day) + (guarantee-day-of-week day 'DAY-OF-WEEK/LONG-STRING) + (vector-ref '#("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" + "Saturday" "Sunday") + day-of-week)) + +(define (guarantee-day-of-week day name) + (if (not (exact-integer? day)) + (error:wrong-type-argument day "day-of-week integer" name)) + (if (not (<= 0 day 6)) + (error:bad-range-argument day name))) \ No newline at end of file diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index fda3995f5..a48e77d7b 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.253 1995/04/22 23:37:23 cph Exp $ +$Id: runtime.pkg,v 14.254 1995/04/23 05:43:50 cph Exp $ Copyright (c) 1988-95 Massachusetts Institute of Technology @@ -371,6 +371,8 @@ MIT in each case. |# (files "datime") (parent ()) (export () + day-of-week/long-string + day-of-week/short-string decode-universal-time decoded-time/date-string decoded-time/day diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index fda3995f5..a48e77d7b 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.253 1995/04/22 23:37:23 cph Exp $ +$Id: runtime.pkg,v 14.254 1995/04/23 05:43:50 cph Exp $ Copyright (c) 1988-95 Massachusetts Institute of Technology @@ -371,6 +371,8 @@ MIT in each case. |# (files "datime") (parent ()) (export () + day-of-week/long-string + day-of-week/short-string decode-universal-time decoded-time/date-string decoded-time/day -- 2.25.1