[Mit-cadr-cvs] r332 - in trunk/lisp: io1 window zwei

[rswindells at common-lisp.net]

Author: rswindells
Date: Mon Nov 19 11:18:28 2012
New Revision: 332

Log:
Add Y2K fixes from patch 78-49.

Modified:
   trunk/lisp/io1/time.lisp
   trunk/lisp/window/wholin.lisp
   trunk/lisp/zwei/files.lisp

Modified: trunk/lisp/io1/time.lisp
==============================================================================
--- trunk/lisp/io1/time.lisp	Mon Nov 19 09:49:02 2012	(r331)
+++ trunk/lisp/io1/time.lisp	Mon Nov 19 11:18:28 2012	(r332)
@@ -273,7 +273,7 @@
 (DEFUN PRINT-TIME (SECONDS MINUTES HOURS DAY MONTH YEAR &OPTIONAL (STREAM STANDARD-OUTPUT))
   (FORMAT STREAM
 	  '( (D) "//" (D 2 60) "//" (D 2 60) " " (D 2 60) ":" (D 2 60) ":" (D 2 60) )
-	      MONTH    DAY           YEAR         HOURS        MINUTES	  SECONDS))
+	      MONTH    DAY         (\ YEAR 100.)   HOURS        MINUTES	  SECONDS))
 
 (DEFUN PRINT-CURRENT-DATE (&OPTIONAL (STREAM STANDARD-OUTPUT))
   (AND (UPDATE-TIMEBASE)
@@ -296,8 +296,9 @@
   (SETQ MONTH (MONTH-STRING MONTH)
 	DAY-OF-THE-WEEK (DAY-OF-THE-WEEK-STRING DAY-OF-THE-WEEK))
   (FORMAT STREAM
-	  "~A the ~:R of ~A, 19~D/; ~D:~2,48D:~2,48D ~A"
-	  DAY-OF-THE-WEEK DAY MONTH YEAR (1+ (\ (+ HOURS 11.) 12.)) MINUTES SECONDS
+	  "~A the ~:R of ~A, ~D/; ~D:~2,48D:~2,48D ~A"
+	  DAY-OF-THE-WEEK DAY MONTH (+ YEAR 1900.) (1+ (\ (+ HOURS 11.) 12.))
+	  MINUTES SECONDS
 	  (COND ((AND (ZEROP SECONDS)
 		      (ZEROP MINUTES)
 		      (MEMQ HOURS '(0 12.)))
@@ -315,7 +316,8 @@
 	(DECODE-UNIVERSAL-TIME REF-UT)
       ;; If not same day, print month and day numerically
       (IF (OR ( DAY REF-DAY) ( MONTH REF-MONTH) ( YEAR REF-YEAR))
-	  (FORMAT STREAM "~D//~D~:[//~2,'0D~] " MONTH DAY (= YEAR REF-YEAR) YEAR))
+	  (FORMAT STREAM "~D//~D~:[//~2,'0D~] "
+		  MONTH DAY (= YEAR REF-YEAR) (\ YEAR 100.)))
       ;; Always print hours colon minutes, even if same as now
       (FORMAT STREAM "~2,'0D:~2,'0D" HOURS MINUTES))))
 

@@ -537,7 +539,7 @@
 (DEFUN TIME-PRINT (STREAM SECONDS MINUTES HOURS DAY MONTH YEAR)
   (FORMAT STREAM
 	  '( (D) "//" (D 2 60) "//" (D 2 60) " " (D 2 60) ":" (D 2 60) ":" (D 2 60) )
-	       MONTH DAY           YEAR         HOURS        MINUTES	  SECONDS))
+	       MONTH DAY           (\ YEAR 100.)   HOURS        MINUTES	  SECONDS))
 
 (ADD-INITIALIZATION "Initialize Timebase" '(INITIALIZE-TIMEBASE) '(:WARM :NOW))
 (ADD-INITIALIZATION "Forget Time" '(SETQ *LAST-TIME-UPDATE-TIME* NIL) '(:BEFORE-COLD))

Modified: trunk/lisp/window/wholin.lisp
==============================================================================
--- trunk/lisp/window/wholin.lisp	Mon Nov 19 09:49:02 2012	(r331)
+++ trunk/lisp/window/wholin.lisp	Mon Nov 19 11:18:28 2012	(r332)
@@ -378,12 +378,12 @@
   (LET (YEAR MONTH DAY HOURS MINUTES SECONDS LEFTX)
     (MULTIPLE-VALUE (SECONDS MINUTES HOURS DAY MONTH YEAR)
       (TIME:GET-TIME))
-    (if (> year 100) (setq year (- year 100.)))
     (COND ((NULL SECONDS)			       
 	   (SHEET-SET-CURSORPOS WHO-SHEET 0 0)
 	   (SHEET-CLEAR-EOL WHO-SHEET)
 	   (COPY-ARRAY-CONTENTS "MM//DD//YY HH:MM:SS" WHO-LINE-EXTRA-STATE))
 	  (T
+	   (SETQ YEAR (\ YEAR 100.))
 	   (SETQ LEFTX (MIN (NWATCH-N MONTH WHO-LINE-EXTRA-STATE 0)
 			    (NWATCH-N DAY WHO-LINE-EXTRA-STATE 3)
 			    (NWATCH-N YEAR WHO-LINE-EXTRA-STATE 6)

Modified: trunk/lisp/zwei/files.lisp
==============================================================================
--- trunk/lisp/zwei/files.lisp	Mon Nov 19 09:49:02 2012	(r331)
+++ trunk/lisp/zwei/files.lisp	Mon Nov 19 11:18:28 2012	(r332)
@@ -312,13 +312,14 @@
 		 (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOURS DAY MONTH YEAR)
 		     (TIME:DECODE-UNIVERSAL-TIME CREATION-DATE)
 		   (FORMAT STREAM "~2,'0D//~2,'0D//~2,'0D ~2,'0D:~2,'0D:~2,'0D"
-			   MONTH DAY YEAR HOURS MINUTES SECONDS))
+			   MONTH DAY (\ YEAR 100.) HOURS MINUTES SECONDS))
 		 (FORMAT STREAM "~17X")))
 	   (LET ((REFERENCE-DATE (GET FILE ':REFERENCE-DATE)))
 	     (AND REFERENCE-DATE
 		  (MULTIPLE-VALUE-BIND (NIL NIL NIL DAY MONTH YEAR)
 		      (TIME:DECODE-UNIVERSAL-TIME REFERENCE-DATE)
-		    (FORMAT STREAM " (~2,'0D//~2,'0D//~2,'0D)" MONTH DAY YEAR))))
+		    (FORMAT STREAM " (~2,'0D//~2,'0D//~2,'0D)"
+			    MONTH DAY (\ YEAR 100.)))))
 	   (LET ((AUTHOR (GET FILE ':AUTHOR)))
 	     (AND AUTHOR (NOT (EQUAL AUTHOR (FUNCALL PATHNAME ':DIRECTORY)))
 		  (FORMAT STREAM "~72T~A" AUTHOR)))