;; compensate for them. I think having both [1] and [3] is the right thing. (DEFUN READ-10-CHARS-FLASH (&OPTIONAL (STREAM TERMINAL-IO) &AUX (W-O (FUNCALL STREAM ':WHICH-OPERATIONS)) CHARS X Y) (SETQ CHARS (READ-10-CHARS STREAM)) (COND ((MEMQ ':READ-CURSORPOS W-O) ;; Kludge. Hopefully unnecessary in nws. (SETQ X (SYMEVAL-IN-CLOSURE STREAM 'ES-X-ORIGIN)) (SETQ Y (SYMEVAL-IN-CLOSURE STREAM 'ES-Y-ORIGIN)) (FUNCALL STREAM ':SET-CURSORPOS X Y) (COND ((MEMQ ':INSERT-CHAR W-O) (FUNCALL STREAM ':INSERT-CHAR #/[) (FUNCALL STREAM ':CURSOR-MOTION NIL NIL CHARS)) (T (FUNCALL STREAM ':TYO #/[) (FUNCALL STREAM ':STRING-OUT CHARS))) (FUNCALL STREAM ':TYO #/]))) (IF (MEMQ ':BEEP W-O) (FUNCALL STREAM ':BEEP)) (RETURN-ARRAY CHARS)) ;; Uses the rubout handler to read characters until a Control-C is typed, but ;; does no consing at all. Useful for testing if a rubout handler conses ;; and also tests the :PASS-THROUGH option. (DEFUN CHARACTER-SINK (&OPTIONAL (STOP-CHARS '(#{{#/}}/c #{{#/}}/C)) (STREAM STANDARD-INPUT)) (COND ((AND (NOT RUBOUT-HANDLER) (MEMQ ':RUBOUT-HANDLER (FUNCALL STREAM ':WHICH-OPERATIONS))) (FUNCALL STREAM ':RUBOUT-HANDLER `((:PASS-THROUGH . ,STOP-CHARS) (:PROMPT ES-DEBUG-PROMPT) (:REPROMPT ES-DEBUG-REPROMPT)) #'CHARACTER-SINK STOP-CHARS STREAM)) ;; CHAR-EQUAL throws away bucky bits. (T (DO () ((MEMQ (FUNCALL STREAM ':TYI) STOP-CHARS))) (DOTIMES (I 3) (FUNCALL STREAM ':BEEP))))) (DEFUN ES-DEBUG-PROMPT (STREAM IGNORE) (FORMAT STREAM "~&~11A" "Prompt:")) (DEFUN ES-DEBUG-REPROMPT (STREAM IGNORE) (FORMAT STREAM "~11A" "Reprompt:")) (DEFUN ES-DEBUG-FULL-RUBOUT (STREAM) (FORMAT STREAM "[Full Rubout]~%")) ;; Various testing functions which affect a local lisp listener only. ;; Test display editor, printing editor, multiple font stuff. (DEFUN ES-DEBUG-DISPLAY (&AUX WINDOW STREAM) (SETQ WINDOW (<- SELECTED-WINDOW ':PANE)) (SETQ TERMINAL-IO (MAKE-EDITOR-STREAM (MAKE-TV-STREAM (<- WINDOW ':PC-PPR)) #'DISPLAY-EDITOR)) (<- WINDOW ':STREAM<- TERMINAL-IO)) (DEFUN ES-DEBUG-PRINTING (&AUX WINDOW) (SETQ WINDOW (<- SELECTED-WINDOW ':PANE)) (SETQ TERMINAL-IO (MAKE-EDITOR-STREAM (MAKE-TV-STREAM (<- WINDOW ':PC-PPR)) #'PRINTING-EDITOR)) ;; Make the stream look like a printing console. (SET-IN-CLOSURE TERMINAL-IO 'ES-WHICH-OPERATIONS '(:TYI :TYI-NO-HANG :LISTEN :TYO :STRING-OUT :LINE-OUT :FRESH-LINE :BEEP :UNTYI :RUBOUT-HANDLER :CLEAR-INPUT :LISTEN)) (<- WINDOW ':STREAM<- TERMINAL-IO)) (DEFUN ES-DEBUG-FONT (&OPTIONAL (FONT "TR10B")) (SETQ FONT (STRING-UPCASE FONT)) ;; Can't use LOAD-IF-NEEDED since CPTFONT comes from CPTFON >. (IF (NOT (SECOND (MULTIPLE-VALUE-LIST (INTERN FONT "Fonts")))) (LOAD (FORMAT NIL "AI:LMFONT;~A" FONT))) (SETQ FONT (SYMEVAL (INTERN FONT "Fonts"))) (TV-REDEFINE-PC-PPR (FUNCALL TERMINAL-IO ':PC-PPR) ':FONTS (LIST FONT))) (DEFUN ES-DEBUG-OFF (&AUX WINDOW) (SETQ WINDOW (<- SELECTED-WINDOW ':PANE)) (SETQ TERMINAL-IO (TV-MAKE-STREAM (<- WINDOW ':PC-PPR))) (<- WINDOW ':STREAM<- TERMINAL-IO)) ) ;; End of Debug conditionalization (DEFUN DE-TV-MAKE-STREAM (PC-PPR) (MAKE-EDITOR-STREAM (MAKE-TV-STREAM PC-PPR) #'DISPLAY-EDITOR)) ;; This function is for turning the thing on globally. It clobbers ;; TV-MAKE-STREAM and TOP-WINDOW and should only be called from inside ;; the initial lisp listener. (DEFUN DE-GLOBAL-ENABLE () (FSET 'TV-MAKE-STREAM #'DE-TV-MAKE-STREAM) (SETQ TERMINAL-IO (DE-TV-MAKE-STREAM CONSOLE-IO-PC-PPR)) (<- TOP-WINDOW ':STREAM<- TERMINAL-IO)) #-DEBUG (DE-GLOBAL-ENABLE) ;; To do: Modify kill ring representation to not include current buffer. ;; Change font set and default font. ;; Make kill ring stuff work for printing editor. ;; Make printing editor cross out characters with slashes. Be careful ;; about newlines. ;; Write a Macsyma printing editor (regular editor plus ?? command) {{#/}}{{#/}}