[Mit-cadr-cvs] r344 - trunk/lisp/patch
ggilley at common-lisp.net
ggilley at common-lisp.net
Fri Nov 23 17:16:11 UTC 2012
Author: ggilley
Date: Fri Nov 23 09:16:11 2012
New Revision: 344
Log:
changed case of filenames
Added:
trunk/lisp/patch/system-78-49.lisp
- copied unchanged from r343, trunk/lisp/patch/System-78-49.lisp
trunk/lisp/patch/system-78-50.lisp
- copied unchanged from r343, trunk/lisp/patch/System-78-50.lisp
trunk/lisp/patch/system-78-51.lisp
- copied unchanged from r343, trunk/lisp/patch/System-78-51.lisp
trunk/lisp/patch/system-78-52.lisp
- copied unchanged from r343, trunk/lisp/patch/System-78-52.lisp
Deleted:
trunk/lisp/patch/System-78-49.lisp
trunk/lisp/patch/System-78-50.lisp
trunk/lisp/patch/System-78-51.lisp
trunk/lisp/patch/System-78-52.lisp
Copied: trunk/lisp/patch/system-78-49.lisp (from r343, trunk/lisp/patch/System-78-49.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lisp/patch/system-78-49.lisp Fri Nov 23 09:16:11 2012 (r344, copy of r343, trunk/lisp/patch/System-78-49.lisp)
@@ -0,0 +1,128 @@
+;;; -*- 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))
+
+)
Copied: trunk/lisp/patch/system-78-50.lisp (from r343, trunk/lisp/patch/System-78-50.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lisp/patch/system-78-50.lisp Fri Nov 23 09:16:11 2012 (r344, copy of r343, trunk/lisp/patch/System-78-50.lisp)
@@ -0,0 +1,41 @@
+;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*-
+;;; Patch file for System version 78.50
+;;; Reason: Extra Y2K fix.
+;;; Written 7/25/08 02:13:26 by RJS,
+;;; while running on Unknown from band 1
+;;; with System 78.49, ZMail 38.5, Tape 6.5, LMFS 21.34, Symbolics 8.13, microcode 841.
+
+
+
+; From file WHOLIN.LISP >LMWIN UNKNOWN:
+#8R TV:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "TV")))
+
+;;; Date and time in the who-line, continuously updating.
+
+(DECLARE-FLAVOR-INSTANCE-VARIABLES (WHO-LINE-SHEET)
+(DEFUN NWATCH-WHO-FUNCTION (WHO-SHEET)
+ (OR WHO-LINE-EXTRA-STATE
+ (LET ((DEFAULT-CONS-AREA WHO-LINE-AREA))
+ (SETQ WHO-LINE-EXTRA-STATE (STRING-APPEND "MM//DD//YY HH:MM:SS"))))
+ (LET (YEAR MONTH DAY HOURS MINUTES SECONDS LEFTX)
+ (MULTIPLE-VALUE (SECONDS MINUTES HOURS DAY MONTH YEAR)
+ (TIME:GET-TIME))
+ (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)
+ (NWATCH-N HOURS WHO-LINE-EXTRA-STATE 9)
+ (NWATCH-N MINUTES WHO-LINE-EXTRA-STATE 12.)
+ (NWATCH-N SECONDS WHO-LINE-EXTRA-STATE 15.)))
+ (OR WHO-LINE-ITEM-STATE (SETQ LEFTX 0)) ;was clobbered, redisplay all
+ (SHEET-SET-CURSORPOS WHO-SHEET (* LEFTX CHAR-WIDTH) 0)
+ (SHEET-CLEAR-EOL WHO-SHEET)
+ (SHEET-STRING-OUT WHO-SHEET WHO-LINE-EXTRA-STATE LEFTX)
+ (SETQ WHO-LINE-ITEM-STATE T))))))
+
+)
Copied: trunk/lisp/patch/system-78-51.lisp (from r343, trunk/lisp/patch/System-78-51.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lisp/patch/system-78-51.lisp Fri Nov 23 09:16:11 2012 (r344, copy of r343, trunk/lisp/patch/System-78-51.lisp)
@@ -0,0 +1,21 @@
+;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*-
+;;; Patch file for System version 78.51
+;;; Reason: Make ASSIGN-ALTERNATE only read symbols into current package.
+;;; Written 6/08/10 16:36:29 by RJS,
+;;; while running on Unknown from band 1
+;;; with System 78.50, ZMail 38.5, Tape 6.5, LMFS 21.34, Symbolics 8.13, microcode 841.
+
+
+
+; From file qmisc.lisp >sys UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+;These are for reading in QCOM, and the like
+(DEFUN ASSIGN-ALTERNATE (X)
+ (PROG NIL
+ L (COND ((NULL X)(RETURN NIL)))
+ (SET (INTERN-LOCAL (GET-PNAME (CAR X)) PACKAGE) (CADR X))
+ (SETQ X (CDDR X))
+ (GO L)))
+
+)
Copied: trunk/lisp/patch/system-78-52.lisp (from r343, trunk/lisp/patch/System-78-52.lisp)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ trunk/lisp/patch/system-78-52.lisp Fri Nov 23 09:16:11 2012 (r344, copy of r343, trunk/lisp/patch/System-78-52.lisp)
@@ -0,0 +1,53 @@
+;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*-
+;;; Patch file for System version 78.52
+;;; Reason: Add SEND, GETF, WHEN and UNLESS.
+;;; Written 6/09/10 23:44:09 by RJS,
+;;; while running on Unknown from band 1
+;;; with System 78.51, ZMail 38.5, Tape 6.5, LMFS 21.34, Symbolics 8.13, microcode 841.
+
+
+
+; From file lmmac.lisp >sys2 UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+(DEFMACRO GETF (PLACE PROPERTY &OPTIONAL (DEFAULT NIL))
+ `(OR (GET (LOCF ,PLACE) ,PROPERTY) ,DEFAULT))
+
+)
+
+; From file lmmac.lisp >sys2 UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+(DEFMACRO SEND (OBJECT OPERATION &REST ARGUMENTS)
+ `(FUNCALL ,OBJECT ,OPERATION . ,ARGUMENTS))
+
+)
+
+; From file lmmac.lisp >sys2 UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+;;; (WHEN pred {form}*)
+(DEFMACRO WHEN (PRED &BODY BODY)
+ `(AND ,PRED (PROGN , at BODY)))
+
+)
+
+; From file lmmac.lisp >sys2 UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+;;; (UNLESS pred {form}*)
+(DEFMACRO UNLESS (PRED &BODY BODY)
+ `(IF ,PRED () , at BODY))
+
+)
+
+; From file lmmac.lisp >sys2 UNKNOWN:
+#8R SYSTEM-INTERNALS:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
+
+(DEFMACRO DO-FOREVER (&BODY BODY)
+ `(DO ()
+ (())
+ . ,BODY))
+
+)
+
More information about the mit-cadr-cvs
mailing list