;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 125.2 ;;; Reason: ;;; The function tv:background-stream is responsible for setting *terminal-io* ;;; to be a tv:background-lisp-interactor. Change to leave *terminal-io* alone ;;; if it is already a stream. Thus, PRINTing to this function while in a normal ;;; Lisp Listener will no longer clobber *terminal-io* and PRINTing multiple times ;;; to this function will not generate multiple background-lisp-interactors. ;;; Written 11-Jul-88 12:16:33 by pld at site Gigamos Cambridge ;;; while running on Brahms' First from band 3 ;;; with System 125.1, ZWEI 125.0, ZMail 73.0, Local-File 75.0, File-Server 24.0, Unix-Interface 13.0, Tape 24.0, Lambda-Diag 17.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103. ; From modified file DJ: L.WINDOW; BASSTR.LISP#414 at 11-Jul-88 12:16:47 #8R TV#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV"))) (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; BASSTR  " (DEFUN BACKGROUND-STREAM (OP &REST ARGS) "This function is defaultly used as *TERMINAL-IO* for all processes. If it gets called at all, it turns *TERMINAL-IO* into a lisp listener window, and notifies the user that the process wants the terminal." (cond ((NOT (AND (VARIABLE-BOUNDP INITIAL-LISP-LISTENER) INITIAL-LISP-LISTENER)) ;; Window system not fully turned on yet. (LEXPR-SEND COLD-LOAD-STREAM OP ARGS)) ((EQ *TERMINAL-IO* DEFAULT-BACKGROUND-STREAM) (CASE OP (:operation-handled-p (memq (first args) (background-stream :which-operations))) (:WHICH-OPERATIONS ;; Get the which-operations once, but after the flavor has been compiled (OR (BOUNDP 'BACKGROUND-STREAM-WHICH-OPERATIONS) (USING-RESOURCE (WINDOW BACKGROUND-LISP-INTERACTORS) (SETQ BACKGROUND-STREAM-WHICH-OPERATIONS (SEND WINDOW :WHICH-OPERATIONS)) (mapcar #'(lambda (operation) (pushnew operation background-stream-which-operations)) ;;; Include the operations handled here. '(:operation-handled-p :which-operations :send-if-handles :beep :listen :inhibit-output-for-abort-p :await-exposure)))) BACKGROUND-STREAM-WHICH-OPERATIONS) ;; If the stream hasn't changed since the process was started, do default action (:SEND-IF-HANDLES (IF (MEMQ (CAR ARGS) (BACKGROUND-STREAM :WHICH-OPERATIONS)) (APPLY #'BACKGROUND-STREAM ARGS))) (:BEEP (LET ((W (WITHOUT-INTERRUPTS (IF SELECTED-WINDOW (SHEET-GET-SCREEN SELECTED-WINDOW) DEFAULT-SCREEN)))) (LEXPR-SEND W :BEEP ARGS))) (:LISTEN NIL) (:INHIBIT-OUTPUT-FOR-ABORT-P T) (:AWAIT-EXPOSURE NIL) (OTHERWISE (IF (EQ %CURRENT-STACK-GROUP SCHEDULER-STACK-GROUP) (FERROR "Attempt to create a background window while in the scheduler.")) (SETQ *TERMINAL-IO* (ALLOCATE-RESOURCE 'BACKGROUND-LISP-INTERACTORS)) (SHEET-FORCE-ACCESS (*TERMINAL-IO* :NO-PREPARE) (let ((new-name (string-append (process-name current-process) " Background Stream"))) (SEND *TERMINAL-IO* :SET-LABEL new-name) (SEND *TERMINAL-IO* :SET-PROCESS CURRENT-PROCESS) (SEND *TERMINAL-IO* :CLEAR-WINDOW))) (SEND *TERMINAL-IO* :ACTIVATE) (LEXPR-SEND *TERMINAL-IO* OP ARGS)))) ((streamp *terminal-io*) (LEXPR-SEND *TERMINAL-IO* OP ARGS)) (t (SETQ *TERMINAL-IO* DEFAULT-BACKGROUND-STREAM) (LEXPR-SEND *TERMINAL-IO* OP ARGS)))) ))