;;; -*- Mode: Lisp; Package: User; Base: 8.; Patch-File: T -*- ;;; Patch file for System version 78.16 ;;; Reason: Finish 78.13 ;;; Written 12/15/81 14:35:06 by MMcM, ;;; while running on Lisp Machine Five from band 5 ;;; with System 78.5, ZMail 38.0, microcode 836. ; From file ZMACS > ZWEI; AI: #8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI"))) (DEFUN MAKE-FILE-BUFFER-STREAM (PATHNAME &OPTIONAL (CONCATENATE-P T) &AUX BUFFER ISTREAM) (SETQ PATHNAME (FS:MERGE-PATHNAME-DEFAULTS PATHNAME *PATHNAME-DEFAULTS*)) (SETQ BUFFER (FIND-BUFFER-NAMED PATHNAME T)) (IF (BUFFER-FILE-ID BUFFER) (OR CONCATENATE-P (DELETE-INTERVAL BUFFER)) (LET ((*INTERVAL* NIL)) (SET-BUFFER-FILE-ID BUFFER T)) (SETF (BUFFER-PATHNAME BUFFER) PATHNAME) (LET ((GENERIC-PATHNAME (FUNCALL PATHNAME ':GENERIC-PATHNAME))) (SETF (BUFFER-GENERIC-PATHNAME BUFFER) GENERIC-PATHNAME) (INITIALIZE-GENERIC-PATHNAME GENERIC-PATHNAME))) (SETQ ISTREAM (INTERVAL-STREAM BUFFER)) (FUNCALL ISTREAM ':SET-BP (IF (EQ CONCATENATE-P ':POINT) (BUFFER-SAVED-POINT BUFFER) (INTERVAL-LAST-BP BUFFER))) ISTREAM) ) ; From file ZMACS > ZWEI; AI: #8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI"))) (DEFCOM COM-WRITE-FILE "Write out the buffer to the specified file." () (LET ((PATHNAME (READ-DEFAULTED-PATHNAME "Write File:" (PATHNAME-DEFAULTS) NIL NIL ':WRITE))) (SET-BUFFER-PATHNAME PATHNAME) (SET-BUFFER-FILE-ID *INTERVAL* NIL) (WRITE-FILE-INTERNAL PATHNAME)) (MAYBE-DISPLAY-DIRECTORY ':WRITE) DIS-NONE) ) ; From file ZFIX #8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI"))) (DOLIST (E *EDITORS-WHOSE-MODES-TO-RESET*) (LET* ((MLW (SYMEVAL-IN-INSTANCE E '*MODE-LINE-WINDOW*)) (MBW (FUNCALL MLW ':SEARCH-MINI-BUFFER-WINDOW))) (TV:BLINKER-SET-VISIBILITY (WINDOW-POINT-BLINKER MBW) NIL) (SETF (WINDOW-POINT-BLINKER MBW) (TV:MAKE-BLINKER (WINDOW-SHEET MBW))))) ) ; From file QFILE > LMIO; AI: #8R FILE-SYSTEM:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "FILE-SYSTEM"))) ;;; Check that connection hasn't gone away, making a new one if necessary (DEFMETHOD (HOST-UNIT :VALIDATE-CONTROL-CONNECTION) (&OPTIONAL NO-ERROR-P) (LOCK-HOST-UNIT (SELF) (COND ((AND CONTROL-CONNECTION (EQ (CHAOS:STATE CONTROL-CONNECTION) 'CHAOS:OPEN-STATE) (LOOP FOR DATA-CONN IN DATA-CONNECTIONS ALWAYS (EQ (CHAOS:STATE (DATA-CONNECTION DATA-CONN)) 'CHAOS:OPEN-STATE))) T) (T (FUNCALL-SELF ':RESET T) ;Arg of T means don't unlock lock (DO (CONN) (NIL) (SETQ CONN (CHAOS:CONNECT HOST *FILE-CONTACT-NAME* *FILE-CONTROL-WINDOW-SIZE*)) (COND ((NOT (STRINGP CONN)) (SETF (CHAOS:INTERRUPT-FUNCTION CONN) (LET-CLOSED ((HOST-UNIT SELF)) 'HOST-CHAOS-INTERRUPT-FUNCTION)) (SETQ CONTROL-CONNECTION CONN) (FUNCALL HOST ':LOGIN-UNIT SELF T) (RETURN T)) (NO-ERROR-P (RETURN NIL))) (CERROR T NIL ':FILE-ERROR "Cannot connect to ~A: ~A" HOST CONN)))))) ) ; From file SCREEN > ZWEI; AI: #8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI"))) ;;; Update the mode line if necessary, FORCE says really do it ;;; MODE-LINE-LIST is a list of things to be displayed, whose elements can be: ;;; a constant string ;;; a symbol, which is evaluated to either a string or NIL, and printed in the former case ;;; a list, the CAR of which should be an atom, which is evaluated and the rest of the ;;; list handled as strings or symbols as above if it is non-NIL (up to any :ELSE), or ;;; if NIL, anything after a :ELSE in the list. ;;; eg ("FOOMACS" "(" MODE-NAME ")" (BUFFER-NAMED-P BUFFER-NAME :ELSE "(Null buffer)") ;;; (FILE-NAME-P FILE-NAME)) ;;; a list starting with the symbol :RIGHT-FLUSH is special: ;;; the cadr of the list is a string to be displayed flush against the right margin. ;;; As a special hack, if MODE-LINE-LIST is NIL, then the mode line is not changed, ;;; this is appropriate for things that want to typeout on the prompt-line and then ;;; invoke the mini-buffer. ;;; PREVIOUS-MODE-LINE is a list of strings that make up the line, since nothing we do ;;; generates new guys for this, EQness is used to determine if the mode-line has changed (DEFMETHOD (MODE-LINE-WINDOW-MIXIN :REDISPLAY) (MODE-LINE-LIST &OPTIONAL FORCE) (AND FORCE ;If we are going to type things out MODE-LINE-LIST ;unless suppressed (SETQ PREVIOUS-MODE-LINE NIL)) (DO ((MODES MODE-LINE-LIST) (PREV PREVIOUS-MODE-LINE) (L) (THING)) (NIL) (COND (L ;Still more to go on a list (POP L THING) (AND (EQ THING ':ELSE) (SETQ L NIL THING NIL))) ((NULL MODES) ;All done with MODE-LINE-LIST (AND PREV (NOT FORCE) (FUNCALL-SELF ':REDISPLAY MODE-LINE-LIST T)) (RETURN NIL)) (T ;Get next object from MODE-LINE-LIST (POP MODES THING) (COND ((SYMBOLP THING) (SETQ THING (SYMEVAL THING)) (AND (LISTP THING) ;If value is a list, dont check CAR (SETQ L THING THING NIL))) ((AND (LISTP THING) ;It's a list, (NEQ (CAR THING) ':RIGHT-FLUSH)) (SETQ L THING) (POP L THING) (COND ((NULL (SYMEVAL THING)) (DO () ;Failing conditional, look for :ELSE ((NULL L)) (POP L THING) (AND (EQ THING ':ELSE) (RETURN NIL))))) (SETQ THING NIL))))) ;And get stuff next pass (AND (SYMBOLP THING) (SETQ THING (SYMEVAL THING))) (COND ((NULL THING)) ;;THING is now the next string to be put into the mode line (FORCE ;Put it in if consing new one (PUSH THING PREVIOUS-MODE-LINE)) ((AND PREV (EQ THING (POP PREV)))) ;Still matching? (T ;Different thing, (FUNCALL-SELF ':REDISPLAY MODE-LINE-LIST T) ;do it right this time! (RETURN NIL)))) (COND (FORCE (SETQ PREVIOUS-MODE-LINE (NREVERSE PREVIOUS-MODE-LINE)) (COND (TV:EXPOSED-P (TV:SHEET-HOME SELF) (TV:SHEET-CLEAR-EOL SELF) (*CATCH 'MODE-LINE-OVERFLOW (DOLIST (STR PREVIOUS-MODE-LINE) (AND (STRINGP STR) (FUNCALL-SELF ':STRING-OUT STR)))) (DOLIST (ELT PREVIOUS-MODE-LINE) (AND (LISTP ELT) (LET* ((STR (CADR ELT)) (LEN (TV:SHEET-STRING-LENGTH SELF STR))) (TV:SHEET-SET-CURSORPOS SELF (- (TV:SHEET-INSIDE-WIDTH SELF) LEN) 0) (TV:SHEET-CLEAR-EOL SELF) (*CATCH 'MODE-LINE-OVERFLOW (FUNCALL-SELF ':STRING-OUT STR)) (RETURN))))))))) ) ; From file SCREEN > ZWEI; AI: #8R ZWEI:(COMPILER-LET ((PACKAGE (PKG-FIND-PACKAGE "ZWEI"))) (DEFMETHOD (TEMPORARY-MODE-LINE-WINDOW :AFTER :REDISPLAY) (IGNORE &OPTIONAL FORCE) (AND FORCE (NOT TV:EXPOSED-P) (LET ((LEN (LOOP FOR STR IN PREVIOUS-MODE-LINE WHEN (LISTP STR) DO (SETQ STR (SECOND STR)) SUM (TV:SHEET-STRING-LENGTH SELF STR)))) (AND (> LEN (TV:SHEET-INSIDE-WIDTH)) (FUNCALL-SELF ':SET-SIZE (MIN (+ TV:LEFT-MARGIN-SIZE LEN TV:RIGHT-MARGIN-SIZE) (TV:SHEET-INSIDE-WIDTH TV:SUPERIOR)) TV:HEIGHT)) (AND (> (+ TV:X-OFFSET TV:WIDTH) (TV:SHEET-INSIDE-RIGHT TV:SUPERIOR)) (FUNCALL-SELF ':SET-POSITION (- (TV:SHEET-INSIDE-RIGHT TV:SUPERIOR) TV:WIDTH) TV:Y-OFFSET))))) )