;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 123.221 ;;; Reason: ;;; Changes to the ZWEI displayer caused serious problems if you were foolish ;;; or unlucky enough to request a "Lisp (Edit)" window from the system menu. ;;; A patch to Release 3 to "Make ZTOP work again" caused another problem ;;; without really making ZTOP work. ;;; The EDITOR-STREAM-MIXIN was also throwing away typeahead and doing too ;;; much work for normal non-alphabetic graphic characters. ;;; ZTOP had probllems of it's own: M-X Select Last ZTOP Buffer messed you ;;; up really badly if you had not previously done a M-X ZTOP Mode in a buffer. ;;; Both "Lisp (Edit)" windows and ZTOP should work now... ;;; Written 6-Apr-88 13:26:52 by pld at site Gigamos Cambridge ;;; while running on Jack Flanders from band 1 ;;; with Experimental System 123.220, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 21.2, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8. ; From modified file DJ: L.ZWEI; DISPLA.LISP#175 at 6-Apr-88 13:26:58 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DISPLA  " (defmethod (displayer :redisplay) (recenter-type rc1 rc2 force-to-completion-p) (prepare-window-for-redisplay self) (block redisplay (let ((lh (send self :line-height)) (now (tick)) point-pline (point-line (bp-line point)) (point-index (bp-index point)) (top-line (bp-line start-bp)) (top-index (bp-index start-bp)) (initial-degree redisplay-degree) ;; Bind *INTERVAL* in case we decide to call any primitives, e.g. inside the ;; special-blinker which blinks matching parens. This is an implicit argument. (*interval* interval) ;; Temporary. Move these three instance variables from flavor WINDOW to flavor DISPLAYER ;; and then these three bindings will not be needed. (pline-marking-left-array (send self :pline-marking-left-array)) ; (pline-marking-width-array (send self :pline-marking-width-array)) ; These two not needed in this function. ; (pline-text-width-array (send self :pline-text-width-array)) ) (declare (special point-pline)) ;; We prefer not to start redisplay in the middle of a line. ;; The start-bp of the window may have ended up there via a command like rubout at ;; the beginning of the window or may have been scrolled there explicitly. If the ;; top line has changed so that continuation may not be necessary any more, attempt ;; recentering. (and (eq recenter-type :point) (not (zerop top-index)) (> n-plines 1) (> (line-tick top-line) (or (pline-tick self 0) 0)) (let ((new-top-index (if (eq top-line (bp-line (interval-first-bp interval))) (bp-index (interval-first-bp interval)) 0))) (and ( top-index new-top-index) (< (nth-value 1 (tv:sheet-compute-motion self 0 0 top-line new-top-index point-index nil 0 most-positive-fixnum most-positive-fixnum)) (* lh n-plines)) (setq recenter-type :absolute)))) ;; :POINT recentering is a conditional sort of :ABSOLUTE recentering. ;; So decide here whether :ABSOLUTE recentering should be done. (when (eq recenter-type :point) (cond (( redisplay-degree dis-mark-goes)) ((and (bp-= point (interval-last-bp *interval*)) (bp-= point start-bp) (not (bp-= point (interval-first-bp *interval*)))) ;; Don't let display be empty at end of buffer. (setq recenter-type :absolute)) ;; When typing at the end of the line, dont try to compute POINT-PLINE yet, ;; but wait till after we have faked out the pline-text-width correctly. ;; Otherwise it will be much, much slower ((and (= redisplay-degree dis-line) (eq redisplay-line point-line) ;; lines with displayers don't hack dis-line (if (getf (line-plist point-line) 'displayer) (progn (setq redisplay-degree dis-text) nil) t) (neq point-line (pline-line self (1- n-plines))) (or ( (1+ redisplay-index) point-index) (zerop (nth-value 1 (tv:sheet-compute-motion self 0 0 point-line 0 point-index t)))))) ((setq point-pline (pline-of-point t self point))) (t (setq recenter-type :absolute)))) ;; If recentering is needed, do it, and see what changes it made. (unless (memq recenter-type '(:none :point)) (recenter-window self recenter-type rc1 rc2) (setq top-line (bp-line start-bp) top-index (bp-index start-bp) point-line (bp-line point) point-index (bp-index point)) ;; Gobble point-pline as computed by recenter-window ;; if it is accurate. (setq point-pline last-point-pline) (or (and (eq point-line (pline-line self point-pline)) ( (pline-from-index self point-pline) point-index) (< point-index (pline-to-index self point-pline))) (setq point-pline nil))) ;; Now we have TOP-LINE and TOP-INDEX, and possibly POINT-PLINE. ;; First, handle the case where just one line needs to be updated. (when (= redisplay-degree dis-line) (window-redisplay-dis-line now)) ;; If all the window should be redisplayed, mark each pline as unknown. (when ( redisplay-degree dis-all) (tv:sheet-clear self t) (send self :refresh-margins) (do ((i 0 (1+ i))) ((= i n-plines)) (setf (pline-tick self i) -1) (setf (pline-marking-left self i) nil))) (when ( redisplay-degree dis-text) (if (eq (window-redisplay-dis-text now top-line top-index force-to-completion-p) :abort) (return-from redisplay nil))) (when ( redisplay-degree dis-bps) (if (eq (window-redisplay-dis-bps now recenter-type initial-degree) :retry) (return-from redisplay (send self :redisplay recenter-type rc1 rc2 force-to-completion-p)))) (when ( redisplay-degree dis-mark-goes) ;; The region marking may have changed. (send self :update-region-marking)) ;;The character under the mouse also (when ( redisplay-degree dis-bps) (mouse-rethink self)) (when ( redisplay-degree dis-text) (send self :new-scroll-position)) (setf redisplay-degree dis-none)))) )) ; From modified file DJ: L.ZWEI; DISPLA.LISP#175 at 6-Apr-88 13:27:01 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DISPLA  " (defun window-redisplay-dis-line (now) (declare (:self-flavor displayer) (special point-pline)) (macrolet ((punt-if (cond) `(when ,cond (setq redisplay-degree dis-text point-pline nil) (return-from window-redisplay-dis-line nil)))) (let* ((lh (send self :line-height)) (last-bp (interval-last-bp interval)) (line redisplay-line) (index redisplay-index) (p (find-bp-in-window self line index)) ;; Temporary. Move these three instance variables from flavor WINDOW to flavor DISPLAYER ;; and then these three bindings will not be needed. (pline-marking-left-array (send self :pline-marking-left-array)) (pline-marking-width-array (send self :pline-marking-width-array)) (pline-text-width-array (send self :pline-text-width-array))) (punt-if (null p)) (let* ((line-length (if (eq line (bp-line last-bp)) (bp-index last-bp) (line-length line))) ;; LEN gets the raster position in the pline P ;; of the character in LINE at position INDEX. (len (without-interrupts (if (and (eq (pline-line self p) *last-redisplay-line*) (= index *last-redisplay-index*) (eq self *last-redisplay-sheet*)) *last-redisplay-cursor-x* (string-width line (pline-from-index self p) index self)))) dwid) ;; If P and LEN say we are at the start of a continuation line, ;; then maybe they are wrong ;; (if the contin line has been exactly deleted). (punt-if (and (zerop len) (not (zerop index)))) ;; Reverse-video region marking must be removed before updating. (when (and (eq *region-marking-mode* ':reverse-video) (or (pline-marking-left self p) (pline-marking-left self (min (1+ p) (1- n-plines))))) (region-unmark-pline p)) ;; Go to the place in the line where changes start. Clear from there. ;; This means that any region marking from there on is gone now. (cond ((and (pline-marking-left self p) (< (pline-marking-left self p) len)) (setf (pline-marking-width self p) (min (- len (pline-marking-left self p)) (pline-marking-width self p)))) (t (setf (pline-marking-left self p) nil) (setf (pline-marking-width self p) nil))) ;; If the character is wider than it claims to be, draw an extra ;; character, since the clear-eol will erase data. (unless (zerop index) (let ((ch (aref line (1- index)))) (when (< (char-code ch) #o200) (let ((fmap (send self :font-map))) (when fmap (let* ((font (aref fmap (char-font ch))) (cwt (font-char-width-table font))) (when cwt (let ((cwid (aref cwt (setq ch (char-code ch)))) (rwid (fed:font-char-min-raster-width font ch))) (when (> rwid cwid) (setq dwid cwid)))))))))) (multiple-value-bind (i tw) ;; Neither displayers nor diagrams can get here. (tv:sheet-line-out self line index line-length len (* lh p) dwid) ;; Save cursor x to avoid calls to STRING-WIDTH while inserting text. (without-interrupts ; Don't confuse other zmacs processes (setq *last-redisplay-sheet* self *last-redisplay-line* line *last-redisplay-index* line-length *last-redisplay-cursor-x* tw)) ;; We have output the first PLINE of this line (setf (pline-to-index self p) i) (setf (pline-text-width self p) (if ( i line-length) tw ;Continuation needed (+ tw (send self :char-width)))) ;Allow for CR (setf (pline-tick self p) now) ;; See if plines below this need to be redisplayed, due ;; to line-continuation issues (when (and (< (1+ p) n-plines) (or ( i line-length) ( tw (send self :inside-width)) (eq (pline-line self (1+ p)) line))) (setq redisplay-degree dis-text point-pline nil) ;; If we are just creating a new continuation line, make it ;; still look munged, so REDISPLAY-BLT can understand. (or (eq (pline-line self (1+ p)) line) (setf (pline-tick self p) -1))))))) nil) )) ; From modified file DJ: L.ZWEI; DISPLA.LISP#175 at 6-Apr-88 13:27:02 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; DISPLA  " (defun window-redisplay-dis-text (now top-line top-index force-to-completion-p) (declare (:self-flavor displayer) (special point-pline)) (macrolet ((abort-redisplay () `(return-from window-redisplay-dis-text :abort))) (let ( ;; Temporary. Move these three instance variables from flavor WINDOW to flavor DISPLAYER ;; and then these three bindings will not be needed. (pline-marking-left-array (send self :pline-marking-left-array)) ; (pline-marking-width-array (send self :pline-marking-width-array)) ; This one isn't used here (pline-text-width-array (send self :pline-text-width-array))) (setq *last-redisplay-line* nil) ;; In case we abort before we are done, don't forget what's needed. (setf redisplay-degree dis-text) (setf last-bp-displayed-p nil) (do ((l (send self :special-blinker-list) (cdr l))) ((null l)) (send (cdar l) :set-visibility nil)) ;; Abort now if input available (and (not force-to-completion-p) (send *standard-input* :listen) (abort-redisplay)) ;; Attempt to do insert and delete line cleverness. (send self :redisplay-blt) ;; This might have invalidated the value of POINT-PLINE. ;; It won't be hard to recompute, so do so. (setq point-pline nil) ;; First loop over actual lines. (block lines (let* ((last-bp (interval-last-bp interval)) (stop-line (bp-line last-bp)) (lh (send self :line-height)) (max-n-plines (send self :max-n-plines))) (do ((line top-line (line-next line)) (from-index top-index 0) to-index (pline 0)) ((null line)) ;should not get here, but be defensive... ;; Between lines, check for input available and abort if so. (and (not force-to-completion-p) (zerop (cl:rem pline 30.)) (send *standard-input* :listen) (abort-redisplay)) (setq to-index (if (eq line stop-line) (bp-index last-bp) (line-length line))) ;; Now loop over the plines of this line. (loop do (when ( pline max-n-plines) (return-from lines)) (when ( pline n-plines) ;; Note cannot get here if self is a zwei:window, but can for other flavors. (send self :new-pline pline)) ;; Check for a line that has not been changed. (if (and (eq line (pline-line self pline)) (> (pline-tick self pline) (line-tick line)) (= (pline-from-index self pline) from-index)) (setq from-index (pline-to-index self pline)) ;; Reverse-video region marking must be removed before updating. (and (eq *region-marking-mode* ':reverse-video) (or (pline-marking-left self pline) (pline-marking-left self (min (1+ pline) (1- n-plines)))) (region-unmark-pline pline)) (multiple-value-bind (i tw) (let ((displayer (getf (line-plist line) 'displayer))) (cond (displayer (tv:sheet-set-cursorpos self 0 (* lh pline)) (tv:sheet-clear-eol self) (send displayer :display self line from-index)) ((setq displayer (getf (line-plist line) ':diagram)) (tv:sheet-set-cursorpos self 0 (* lh pline)) (tv:sheet-clear-eol self) (send displayer :draw line self) (values 1 0)) (t (tv:sheet-line-out self line from-index to-index 0 (* lh pline))))) (setf (pline-line self pline) line) (setf (pline-from-index self pline) from-index) (setf (pline-to-index self pline) i) (setf (pline-tick self pline) now) (setf (pline-marking-left self pline) nil) (setf (pline-text-width self pline) (if ( i (line-length line)) tw ;Continuation needed (+ tw (send self :char-width)))) ;Allow for CR (setq from-index i))) (setq pline (1+ pline)) ;; This is >, not , because if line isn't cont'd then PLINE-TO-PLINE ;; counts the phony CR which is output by SHEET-LINE-OUT. until (> from-index to-index)) ;; Check for the last line in the interval. (when (eq line stop-line) (setf last-bp-displayed-p t) (when ( pline n-plines) (return-from lines)) (unless (and (null (pline-line self pline)) ;Return if screen already blanked (pline-tick self pline) (> (pline-tick self pline) 0)) ;; Reverse-video region marking must be removed before updating. (and (eq *region-marking-mode* ':reverse-video) (or (pline-marking-left self pline) (pline-marking-left self (min (1+ pline) (1- n-plines)))) (region-unmark-pline pline)) ;; Clean out the rest of the window beneath it. Then exit. (tv:sheet-set-cursorpos self 0 (* lh pline)) (tv:sheet-clear-eof self) (do ((pline pline (1+ pline))) (( pline n-plines)) (setf (pline-line self pline) nil) (setf (pline-tick self pline) now) (setf (pline-marking-left self pline) nil))) (return-from lines))))))) nil) )) ; From modified file DJ: L.ZWEI; STREAM.LISP#172 at 6-Apr-88 13:27:14 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  " (undefmethod (editor-stream-mixin :string-out)) )) ; From modified file DJ: L.ZWEI; STREAM.LISP#172 at 6-Apr-88 13:52:58 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  " (DEFUN FAKE-OUT-TOP-LINE (WINDOW BUFFER &AUX START-LINE START-INDEX START-PLINE LAST-BP SHEET) (SETQ LAST-BP (INTERVAL-LAST-BP BUFFER) SHEET (WINDOW-SHEET WINDOW)) (SETQ START-PLINE (DO ((PLINE 0 (1+ PLINE)) (N-PLINES (WINDOW-N-PLINES WINDOW)) (LINE)) (( PLINE N-PLINES) (1- N-PLINES)) (SETQ LINE (PLINE-LINE WINDOW PLINE)) (AND (OR (NULL LINE) (eq (line-tick line) 'deleted) (> (LINE-TICK LINE) (PLINE-TICK WINDOW PLINE))) (RETURN (1- PLINE))))) ;; If the screen was glitched, the pline structure is all wrong. (IF (OR (NEQ (BP-LINE (WINDOW-START-BP WINDOW)) (PLINE-LINE WINDOW 0)) ( (BP-INDEX (WINDOW-START-BP WINDOW)) (PLINE-FROM-INDEX WINDOW 0))) (SETQ START-PLINE -1)) (IF (MINUSP START-PLINE) (LET ((BP (OR (WINDOW-START-BP WINDOW) (INTERVAL-FIRST-BP (WINDOW-INTERVAL WINDOW))))) (SETQ START-LINE (BP-LINE BP) START-INDEX (BP-INDEX BP) START-PLINE 0)) (SETQ START-LINE (PLINE-LINE WINDOW START-PLINE) START-INDEX (PLINE-TO-INDEX WINDOW START-PLINE)) (AND (>= START-INDEX (LINE-LENGTH START-LINE)) ;Includes CR (SETQ START-LINE (LINE-NEXT START-LINE) START-INDEX 0 START-PLINE (1+ START-PLINE)))) (DO-NAMED LINES ((LINE START-LINE (LINE-NEXT LINE)) (FROM-INDEX START-INDEX 0) (TO-INDEX) (PLINE START-PLINE) (N-PLINES (WINDOW-N-PLINES WINDOW)) (STOP-LINE (BP-LINE LAST-BP)) (LH (TV:SHEET-LINE-HEIGHT SHEET)) (I) (TW)) ;; If we exhaust the test there is to display, mark remaining screen lines as empty. ((NULL LINE) (DO ((PLINE PLINE (1+ PLINE))) ((= PLINE N-PLINES)) (SETF (PLINE-LINE WINDOW PLINE) NIL) (SETF (PLINE-TICK WINDOW PLINE) NIL) (SETF (PLINE-MARKING-LEFT WINDOW PLINE) NIL))) (IF (= PLINE N-PLINES) (RETURN NIL)) (SETQ TO-INDEX (IF (EQ LINE STOP-LINE) (BP-INDEX LAST-BP) (LINE-LENGTH LINE))) (DO NIL (NIL) (MULTIPLE-VALUE (TW NIL I) (TV:SHEET-COMPUTE-MOTION SHEET 0 0 LINE FROM-INDEX TO-INDEX NIL 0 LH)) (OR (NUMBERP I) (SETQ I (1+ (LINE-LENGTH LINE)))) (SETF (PLINE-LINE WINDOW PLINE) LINE) (SETF (PLINE-FROM-INDEX WINDOW PLINE) FROM-INDEX) (SETF (PLINE-TO-INDEX WINDOW PLINE) I) (SETF (PLINE-TICK WINDOW PLINE) *TICK*) (SETF (PLINE-MARKING-LEFT WINDOW PLINE) NIL) (SETF (PLINE-TEXT-WIDTH WINDOW PLINE) (IF ( I (LINE-LENGTH LINE)) TW (+ TW (TV:SHEET-CHAR-WIDTH SHEET)))) (SETQ FROM-INDEX I) (AND ( (SETQ PLINE (1+ PLINE)) N-PLINES) (RETURN-FROM LINES NIL)) (AND (> FROM-INDEX TO-INDEX) (RETURN NIL))) ;; This is another way of exhausting the text we have to display. (IF (EQ LINE STOP-LINE) (RETURN (DO ((PLINE PLINE (1+ PLINE))) ((= PLINE N-PLINES)) (SETF (PLINE-LINE WINDOW PLINE) NIL) (SETF (PLINE-TICK WINDOW PLINE) NIL) (SETF (PLINE-MARKING-LEFT WINDOW PLINE) NIL)))))) )) ; From modified file DJ: L.ZWEI; STREAM.LISP#172 at 6-Apr-88 14:11:37 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  " (DEFMETHOD (EDITOR-STREAM-MIXIN :ANY-TYI) (&OPTIONAL IGNORE) (IF (eq rubout-handler self) ;; If input is being edited... (IF (AND (NULL *SRE-INPUT-POINT*) (NOT (BP-= *STREAM-BP* (INTERVAL-LAST-BP (WINDOW-INTERVAL *STREAM-SHEET*))))) ;; If we have more to fetch from the buffer, just fetch it. (PROG1 (LDB %%CH-CHAR (BP-CHAR *STREAM-BP*)) ;Give buffered character if any (MUST-REDISPLAY *STREAM-SHEET* DIS-BPS) ;We are moving point, so... (LET ((*INTERVAL* INTERVAL)) (IBP *STREAM-BP*))) ;; We have to get more input, probably invoking the editor. (LET ((*EDITOR-STREAM-ALREADY-KNOWS* T)) (SEND SELF ':STREAM-RUBOUT-HANDLER))) ;; If input is not being edited ;; Then we read it directly, as if were not an editor stream. ;; Make sure screen is right before we read it. ;; But if came from within the rubout handler, that is already done. (OR *EDITOR-STREAM-ALREADY-KNOWS* (STREAM-REDISPLAY)) (cond ((TV:KBD-IO-BUFFER-GET TV:IO-BUFFER T)) (t (FUNCALL-SELF ':NOTICE ':INPUT-WAIT) (TV:KBD-IO-BUFFER-GET TV:IO-BUFFER))))) (DEFMETHOD (EDITOR-STREAM-MIXIN :STREAM-RUBOUT-HANDLER) (&AUX (RUBOUT-HANDLER NIL) CHAR) ;; If there is a saved-up activation character, return it from :ANY-TYI now. ;; This happens at the end of a rescan of the input. (IF *SRE-ACTIVATION-CHARACTER* (PROG1 *SRE-ACTIVATION-CHARACTER* (SETQ *SRE-ACTIVATION-CHARACTER* NIL)) ;; We could just call the editor, but we must pass certain characters (editing-commands) ;; that the program doing the read is handling, and we also want to ;; save some time for alphabetic characters. (IF *SRE-INPUT-POINT* (MUST-REDISPLAY *STREAM-SHEET* DIS-BPS) (SETQ CHAR (FUNCALL-SELF ':ANY-TYI))) ;; Just type out and insert self-inserting printing characters ;; but not if they are the caller's editing-commands or activations or commands, ;; or if they have been redefined in the editor itself. (let ((editing-command (cdr (assq ':editing-command rubout-handler-options))) (command-handler (cdr (assq ':command rubout-handler-options))) (activation-handler (cdr (assq ':activation rubout-handler-options))) (do-not-echo (cdr (assq ':do-not-echo rubout-handler-options))) (pass-through (cdr (assq ':pass-though rubout-handler-options)))) (IF (AND (NUMBERP CHAR) (NOT (OR (MEMQ CHAR editing-command) (SI:ASSQ-CAREFUL CHAR editing-command))) (NOT (AND command-handler (APPLY (car command-handler) CHAR (cdr command-handler)))) (NOT (AND activation-handler (APPLY (car activation-handler) CHAR (cdr activation-handler)))) (NOT (MEMQ CHAR DO-NOT-ECHO)) (OR (AND (graphic-char-p CHAR) (EQ 'COM-ORDINARILY-SELF-INSERT (COMMAND-LOOKUP CHAR *STREAM-COMTAB*))) (AND (< CHAR 400) (MEMQ CHAR pass-through)))) (LET ((*WINDOW* *STREAM-SHEET*)) (INSERT-MOVING *STREAM-BP* CHAR) (STREAM-IMMEDIATE-OUTPUT (TV:SHEET-TYO *STREAM-SHEET* CHAR)) CHAR) ;; Otherwise, run the editor till COM-ACTIVATE throws to us, ;; then throw to RUBOUT-HANDLER to restart the read using the buffer contents. ;; Move editor point to where we are reading. (MOVE-BP *STREAM-BP* (OR *SRE-INPUT-POINT* (INTERVAL-LAST-BP (WINDOW-INTERVAL *STREAM-SHEET*)))) (SETQ *SRE-INPUT-POINT* NIL) ;; Update buffer display and window data so editor gets consistent data. (STREAM-REDISPLAY T) ;; Unread this character so editor will execute it. (WHEN CHAR (TV:IO-BUFFER-UNGET (SEND *STREAM-SHEET* ':IO-BUFFER) CHAR)) ;; Edit. (SET-IN-CLOSURE EDITOR-CLOSURE '*EDITOR-STREAM-ACTIVATION-NEEDED* NIL) ;; PASS-ON characters throw here ;; to return from the :ANY-TYI method. (*CATCH 'RETURN-FROM-ANY-TYI (LET ((*STREAM-IBEAM-SHOULD-BLINK* NIL) (*INSIDE-EDITOR-STREAM* NIL)) (SI:%BIND (LOCF (TV:SHEET-MORE-VPOS *STREAM-SHEET*)) NIL) (UNLESS (BP-= *STREAM-BP* (INTERVAL-LAST-BP (WINDOW-INTERVAL *STREAM-SHEET*))) (SEND SELF ':ENTER-EDITOR) (SETQ *STREAM-IBEAM-SHOULD-BLINK* T) (LET ((IBEAM-BLINKER (CDR (ASSQ 'STREAM-BLINK-IBEAM (WINDOW-SPECIAL-BLINKER-LIST *STREAM-SHEET*))))) (WHEN IBEAM-BLINKER (STREAM-BLINK-IBEAM IBEAM-BLINKER *STREAM-SHEET* *STREAM-BP* NIL)))) (UNWIND-PROTECT (FUNCALL *STREAM-SHEET* ':EDIT EDITOR-CLOSURE) (FUNCALL *STREAM-SHEET* ':EXIT-EDITOR) ;; Put blinker into ordinary stream mode instead of editor mode. (MULTIPLE-VALUE-BIND (X Y) (TV:BLINKER-READ-CURSORPOS *STREAM-BLINKER*) (TV:SHEET-SET-CURSORPOS *STREAM-SHEET* X Y)) (FUNCALL *STREAM-BLINKER* ':SET-FOLLOW-P T) ;Make the blinker follow again (TV:BLINKER-SET-VISIBILITY *STREAM-BLINKER* (IF (EQ *STREAM-SHEET* TV:SELECTED-WINDOW) ':BLINK ':ON))) ;; Tell the :RUBOUT-HANDLER method to restart the read. (*THROW 'RUBOUT-HANDLER T))))))) )) ; From modified file DJ: L.ZWEI; STREAM.LISP#173 at 6-Apr-88 14:37:03 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  " (DEFMETHOD (ZTOP-STREAM-MIXIN :STRING-OUT) (&rest ignore) (MUST-REDISPLAY *STREAM-SHEET* DIS-TEXT) (STREAM-REDISPLAY T)) (DEFMAJOR COM-ZTOP-MODE ZTOP-MODE "ZTOP" "Sets things up for zmacs buffer editor top level." () (COMMAND-HOOK (MAKE-ZTOP-COMMAND-HOOK *INTERVAL* *WINDOW*) *POST-COMMAND-HOOK*) (COMMAND-HOOK (MAKE-ZTOP-PRE-COMMAND-HOOK *INTERVAL* *WINDOW*) *COMMAND-HOOK*) (SETQ *SPACE-INDENT-FLAG* T) (SETQ *PARAGRAPH-DELIMITER-LIST* NIL) (SETQ *COMMENT-START* 'LISP-FIND-COMMENT-START-AND-END) (SET-COMTAB *MODE-COMTAB* '(#/END COM-FINISH-ZTOP-EVALUATION #/C-CR COM-FINISH-ZTOP-EVALUATION #/ABORT COM-ZTOP-ABORT #/META-ABORT COM-ZTOP-ABORT-ALL #/C-M-Y COM-ZTOP-YANK-INPUT-HISTORY #/TAB COM-INDENT-FOR-LISP #/RUBOUT COM-TAB-HACKING-RUBOUT #/C-RUBOUT COM-RUBOUT) '(("Require Activation Mode" . COM-REQUIRE-ACTIVATION-MODE))) (SETQ *MODE-LINE-LIST* (APPEND *MODE-LINE-LIST* '((*ZTOP-ACTIVATION-NEEDED* " Type End to resume reading input") (*ZTOP-READING-INPUT* " Reading input") (*ZTOP-EDITING* " Editing")))) (PROGN (AND (TYPEP *INTERVAL* 'FILE-BUFFER) (setq *last-ztop-buffer* (cons *INTERVAL* (delete *INTERVAL* *LAST-ZTOP-BUFFER*)))))) (DEFCOM COM-FINISH-ZTOP-EVALUATION "Begin execution of buffered input." () (LET ((ZTOP-BUFFER *INTERVAL*) ZTOP-STREAM STREAM-START-BP) (OR (SETQ ZTOP-STREAM (FUNCALL *INTERVAL* ':GET 'ZTOP-STREAM)) (SETQ ZTOP-BUFFER (if *LAST-ZTOP-BUFFER* (first *last-ztop-buffer*) (MAKE-ZTOP-BUFFER)) ZTOP-STREAM (FUNCALL ZTOP-BUFFER ':GET 'ZTOP-STREAM))) (SETQ STREAM-START-BP (FUNCALL ZTOP-STREAM ':*STREAM-START-BP*)) (COND ((WINDOW-MARK-P *WINDOW*) ;If there is a region (SETF (WINDOW-MARK-P *WINDOW*) NIL) (WITH-BP (BP (INTERVAL-LAST-BP ZTOP-BUFFER) ':NORMAL) (INSERT-INTERVAL BP (POINT) (MARK)) ;copy it to the end (DELETE-INTERVAL STREAM-START-BP BP T)) (COND ((NEQ *INTERVAL* ZTOP-BUFFER) (FUNCALL ZTOP-BUFFER ':SET-ATTRIBUTE ':PACKAGE *PACKAGE*) (SETF (BUFFER-PACKAGE ZTOP-BUFFER) *PACKAGE*) (SEND ZTOP-STREAM ':SET-PACKAGE *PACKAGE*) (DO-IT-SELECT-WINDOW-BUFFER ZTOP-BUFFER)))) ((NEQ *INTERVAL* ZTOP-BUFFER) (BARF "There is no region")))) (LET ((LAST-BP (INTERVAL-LAST-BP *INTERVAL*))) (LET ((CH (BP-CHAR-BEFORE LAST-BP))) (COND ((= CH #/CR) (DELETE-INTERVAL (FORWARD-CHAR LAST-BP -1) LAST-BP T)) ((= (LIST-SYNTAX CH) LIST-ALPHABETIC) (INSERT LAST-BP #/SPACE)))) (MOVE-BP (POINT) LAST-BP)) (SETQ *CURRENT-COMMAND-TYPE* 'ACTIVATE-ZTOP) DIS-TEXT) (DEFCOM COM-SELECT-LAST-ZTOP-BUFFER "Move to the most recently used ZTOP mode buffer." () (make-buffer-current (if *last-ztop-buffer* (first *last-ztop-buffer*) (create-one-buffer-to-go "ZTOP"))) (com-ztop-mode) DIS-TEXT) )) ; From modified file DJ: L.ZWEI; METH.LISP#52 at 6-Apr-88 14:37:03 #8R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; METH  " (DEFMETHOD (ZMACS-BUFFER :AFTER :KILL) () (POINT-PDL-PURGE SELF) (WITHOUT-INTERRUPTS (LET ((ELEMENT (SI:RASSOC-EQUAL SELF *ZMACS-BUFFER-NAME-ALIST*))) (WHEN ELEMENT (SETQ *ZMACS-BUFFER-NAME-ALIST* (DELQ ELEMENT *ZMACS-BUFFER-NAME-ALIST*)))) (SETQ *ZMACS-BUFFER-LIST* (REMQ SELF *ZMACS-BUFFER-LIST*))) (DOLIST (W *ALL-ZMACS-WINDOWS*) (WITHOUT-INTERRUPTS (LET ((HISTORY (SEND W :BUFFER-HISTORY))) (DELETE-FROM-HISTORY SELF HISTORY)))) (DOLIST (NODE INFERIORS) (LET ((SYM (SECTION-NODE-NAME NODE))) (UNLESS (STRINGP SYM) (SETF (SI:FUNCTION-SPEC-GET SYM 'ZMACS-BUFFERS) (DEL #'(LAMBDA (BUF PROP) (EQ BUF (CAR PROP))) SELF (SI:FUNCTION-SPEC-GET SYM 'ZMACS-BUFFERS)))))) ;; Any other windows lying around should not have pointers to this window. ;; Make them redisplay; that will check for this. (DOLIST (WINDOW (SEND SELF :WINDOWS)) (SEND WINDOW :FORCE-KBD-INPUT '(REDISPLAY))) (SETF (GETF SI:PROPERTY-LIST :KILLED) T) (setq *last-ztop-buffer* (delete self *last-ztop-buffer*)) T) ))