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

[rswindells at common-lisp.net]

Author: rswindells
Date: Sat May  5 07:58:51 2012
New Revision: 298

Log:
Add Y2K fixes.

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	Thu Sep 22 17:58:44 2011	(r297)
+++ trunk/lisp/io1/time.lisp	Sat May  5 07:58:51 2012	(r298)
@@ -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 100.)   HOURS        MINUTES	  SECONDS))
+	      MONTH    DAY           YEAR         HOURS        MINUTES	  SECONDS))
 
 (DEFUN PRINT-CURRENT-DATE (&OPTIONAL (STREAM STANDARD-OUTPUT))
   (AND (UPDATE-TIMEBASE)
@@ -296,8 +296,8 @@
   (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, ~D/; ~D:~2,48D:~2,48D ~A"
-	  DAY-OF-THE-WEEK DAY MONTH (+ YEAR 1900.) (1+ (\ (+ HOURS 11.) 12.)) MINUTES SECONDS
+	  "~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
 	  (COND ((AND (ZEROP SECONDS)
 		      (ZEROP MINUTES)
 		      (MEMQ HOURS '(0 12.)))
@@ -315,7 +315,7 @@
 	(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 100.)))
+	  (FORMAT STREAM "~D//~D~:[//~2,'0D~] " MONTH DAY (= YEAR REF-YEAR) YEAR))
       ;; Always print hours colon minutes, even if same as now
       (FORMAT STREAM "~2,'0D:~2,'0D" HOURS MINUTES))))
 

@@ -537,7 +537,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 100.)   HOURS        MINUTES	  SECONDS))
+	       MONTH DAY           YEAR         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	Thu Sep 22 17:58:44 2011	(r297)
+++ trunk/lisp/window/wholin.lisp	Sat May  5 07:58:51 2012	(r298)
@@ -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	Thu Sep 22 17:58:44 2011	(r297)
+++ trunk/lisp/zwei/files.lisp	Sat May  5 07:58:51 2012	(r298)
@@ -312,13 +312,13 @@
 		 (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 100.) HOURS MINUTES SECONDS))
+			   MONTH DAY YEAR 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 100.)))))
+		    (FORMAT STREAM " (~2,'0D//~2,'0D//~2,'0D)" MONTH DAY YEAR))))
 	   (LET ((AUTHOR (GET FILE ':AUTHOR)))
 	     (AND AUTHOR (NOT (EQUAL AUTHOR (FUNCALL PATHNAME ':DIRECTORY)))
 		  (FORMAT STREAM "~72T~A" AUTHOR)))