;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*-
;;; Patch file for System version 78.49
;;; Reason: Y2K Fixes.
;;; Written 7/25/108 00:37:58 by RJS,
;;; while running on Unknown from band 1
;;; with System 78.48, ZMail 38.5, Tape 6.5, LMFS 21.34, Symbolics 8.13, microcode 841.



; From file FILES.LISP >ZWEI UNKNOWN:
#8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI")))

(DEFUN DEFAULT-LIST-ONE-FILE (FILE &OPTIONAL (STREAM STANDARD-OUTPUT) &AUX PATHNAME)
  (COND ((AND (TYPEP STREAM ':CLOSURE) (EQ (CLOSURE-FUNCTION STREAM) 'INTERVAL-IO))
	 (STORE-ARRAY-LEADER 0 *DIR-LISTING-BUFFER* 0)
	 (WITH-OUTPUT-TO-STRING (S *DIR-LISTING-BUFFER*)
	   (DEFAULT-LIST-ONE-FILE FILE S))
	 (DECF (ARRAY-LEADER *DIR-LISTING-BUFFER* 0))	;Flush the carriage return
	 (FUNCALL STREAM ':LINE-OUT *DIR-LISTING-BUFFER*))
	((NULL (SETQ PATHNAME (CAR FILE)))
	 (COND ((GET FILE ':DISK-SPACE-DESCRIPTION)
		(FUNCALL STREAM ':LINE-OUT (GET FILE ':DISK-SPACE-DESCRIPTION)))
	       ((GET FILE ':PHYSICAL-VOLUME-FREE-BLOCKS)
		(DO ((FREE (GET FILE ':PHYSICAL-VOLUME-FREE-BLOCKS) (CDR FREE))
		     (FLAG T NIL))
		    ((NULL FREE) (FUNCALL STREAM ':TYO #\CR))
		 (FORMAT STREAM "~A #~A=~D" (IF FLAG "Free:" ",") (CAAR FREE) (CDAR FREE))))
	       (T
		(FUNCALL STREAM ':TYO #\CR))))
	(T (FUNCALL STREAM ':TYO (IF (GET FILE ':DELETED) #/D #\SP))
	   (FORMAT STREAM " ~3A " (OR (GET FILE ':PHYSICAL-VOLUME) ""))
	   (IF (FUNCALL STREAM ':OPERATION-HANDLED-P ':ITEM)
	       (FUNCALL STREAM ':ITEM 'FILE PATHNAME "~A"
			(FUNCALL PATHNAME ':STRING-FOR-DIRED))
	       (FUNCALL STREAM ':STRING-OUT (FUNCALL PATHNAME ':STRING-FOR-DIRED)))
	   (FORMAT STREAM "~20T")
	   (LET ((LINK-TO (GET FILE ':LINK-TO)))
	     (IF LINK-TO
		 (FORMAT STREAM "=> ~A~41T" LINK-TO)
		 (LET ((LENGTH (GET FILE ':LENGTH-IN-BLOCKS)))
		   (IF LENGTH
		       (FORMAT STREAM "~4D " LENGTH)
		       (FORMAT STREAM "~5X")))
		 (LET ((LENGTH (GET FILE ':LENGTH-IN-BYTES)))
		   (AND LENGTH
			(FORMAT STREAM "~6D(~D)" LENGTH (GET FILE ':BYTE-SIZE))))
		 (FORMAT STREAM "~39T")
		 (FUNCALL STREAM ':TYO (IF (GET FILE ':NOT-BACKED-UP) #/! #\SP))
		 (FUNCALL STREAM ':TYO (IF (GET FILE ':DONT-REAP) #/$ #\SP))))
	   (LET ((CREATION-DATE (GET FILE ':CREATION-DATE)))
	     (IF CREATION-DATE
		 (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))
		 (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.)))))
	   (LET ((AUTHOR (GET FILE ':AUTHOR)))
	     (AND AUTHOR (NOT (EQUAL AUTHOR (FUNCALL PATHNAME ':DIRECTORY)))
		  (FORMAT STREAM "~72T~A" AUTHOR)))
	   (LET ((READER (GET FILE ':READER)))
	     (AND READER (NOT (EQUAL READER (FUNCALL PATHNAME ':DIRECTORY)))
		  (FORMAT STREAM "~82T~A" READER)))
	   (FUNCALL STREAM ':TYO #\CR))))

)

; From file TIME.LISP >LMIO1 UNKNOWN:
#8R TIME:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TIME")))

(DEFUN PRINT-BRIEF-UNIVERSAL-TIME (UT &OPTIONAL (STREAM STANDARD-OUTPUT)
						(REF-UT (GET-UNIVERSAL-TIME)))
  "Prints only those aspects of the time, UT, that differ from the current time.
Also never prints seconds.  Used by notifications, for example."
  (MULTIPLE-VALUE-BIND (IGNORE MINUTES HOURS DAY MONTH YEAR)
      (DECODE-UNIVERSAL-TIME UT)
    (MULTIPLE-VALUE-BIND (IGNORE IGNORE IGNORE REF-DAY REF-MONTH REF-YEAR)
	(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.)))
      ;; Always print hours colon minutes, even if same as now
      (FORMAT STREAM "~2,'0D:~2,'0D" HOURS MINUTES))))

)

; From file TIME.LISP >LMIO1 UNKNOWN:
#8R TIME:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TIME")))

(DEFUN PRINT-DATE (SECONDS MINUTES HOURS DAY MONTH YEAR DAY-OF-THE-WEEK
		   &OPTIONAL (STREAM STANDARD-OUTPUT))
  (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
	  (COND ((AND (ZEROP SECONDS)
		      (ZEROP MINUTES)
		      (MEMQ HOURS '(0 12.)))
		 (IF (= HOURS 0) "midnight" "noon"))
		(( HOURS 12.) "pm")
		(T "am")) ))

)

; From file TIME.LISP >LMIO1 UNKNOWN:
#8R TIME:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TIME")))

(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))

)

; From file TIME.LISP >LMIO1 UNKNOWN:
#8R TIME:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TIME")))

(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))

)