Termcaps/VT100

[David Vinayak Wallace <Gumby@mc.lcs.mit.edu>]

    Date: 23 Nov 1987 1147-EST (Monday)
    From: Hunter Barr <barr@pineapple.bbn.com>

    It doesn't solve much, but it keeps me from having to do do a
    <NETWORK>-X everytime I login to a Unix host.  If other people send
    more useful things to you, would you mind forwarding them to me also?
    My next few months of work involve a LOT of Unix, and any little
    tidbits may help.

Here's some more telnet fixes, from the MAC system.  The first replaces
inverse video with bold (much easier on the eyes), the second adds the
terminal emulation in effect to the window label (obviously doesn't
apply to SUPDUP or 3600-login).  You might want to ftp the sudup server
from prep so you don't have to deal with this terminal-type nonsense.

;;; -*- Mode: LISP; Package: TELNET; Base: 8; Patch-File: T; Lowercase: yes -*-

;;; Turn off inverse-video-p if on
(DEFMETHOD (:SUPDUP-RESET SUPDUP-STATE-BLOCK) (&OPTIONAL IGNORE)
  (WHEN INVERSE-VIDEO-P
    (LET ((ROMAN (SI:MERGE-CHARACTER-STYLES
		   '(NIL :ROMAN NIL) (SEND *TERMINAL-SCREEN* :MERGED-CURRENT-STYLE))))
      (IF (SI:GET-FONT (SEND *TERMINAL-SCREEN* :DISPLAY-DEVICE-TYPE)
		       SI:*STANDARD-CHARACTER-SET* ROMAN NIL T)
	  (SEND *TERMINAL-SCREEN* :SET-DEFAULT-CHARACTER-STYLE ROMAN)
	  (SWAPF (TV:SHEET-CHAR-ALUF *TERMINAL-SCREEN*)
		 (TV:SHEET-ERASE-ALUF *TERMINAL-SCREEN*))
	  (SEND *TERMINAL-SCREEN* :CLEAR-REST-OF-LINE))
      (SETQ INVERSE-VIDEO-P NIL)))
  (WHEN SUPDUP-GRAPHICS-STATE
    (SEND SUPDUP-GRAPHICS-STATE ':GRAPHICS-RESET))
  NIL)

;;; Turn on inverse-video-p
(DEFMETHOD (:SUPDUP-BOW SUPDUP-STATE-BLOCK) (IGNORE)
  (UNLESS INVERSE-VIDEO-P
    (LET ((BOLD (SI:MERGE-CHARACTER-STYLES
		  '(NIL :BOLD NIL) (SEND *TERMINAL-SCREEN* :MERGED-CURRENT-STYLE))))
      (IF (SI:GET-FONT (SEND *TERMINAL-SCREEN* :DISPLAY-DEVICE-TYPE)
		       SI:*STANDARD-CHARACTER-SET* BOLD NIL T)
	  (SEND *TERMINAL-SCREEN* :SET-DEFAULT-CHARACTER-STYLE BOLD)
	  (SWAPF (TV:SHEET-CHAR-ALUF *TERMINAL-SCREEN*)
		 (TV:SHEET-ERASE-ALUF *TERMINAL-SCREEN*))
	  (SEND *TERMINAL-SCREEN* :CLEAR-REST-OF-LINE)))
    (SETQ INVERSE-VIDEO-P T))
  NIL)

;;;; Add terminal emulation mode to the telnet mode line.
;;; my changes are in lower case

;;; I can't decide what's most attractive (best would be after the
;;; protocol name in parenthesis, but the absraction won't allow that)
(defvar *terminal-emulator-printing-format-string* "~'i~A:~")

(DEFUN-IN-FLAVOR (RECOMPUTE-LABEL NVT-WINDOW) ()
  (SEND SELF ':SET-LABEL
	(FORMAT NIL "~A ~@[~a ~]~A~@[  { ~A}~]"
		TV:NAME
		;; despite name, typeout-filters is a structure, not a list
		(when (and network-stream
			   (memq (typep typeout-filters) *terminal-simulator-types*)
			   (not (typep typeout-filters 'null-terminal-simulator)))
		  ;; ~? might cons less, but this isn't called much so who cares?
		  (format nil *terminal-emulator-printing-format-string*
			  (send typeout-filters :name)))
		LABEL-TAG
		(AND (SEND *TERMINAL-SCREEN* :WALLPAPERING)
		     (SEND (SEND *TERMINAL-SCREEN* :WALLPAPER-FILE) :TRUENAME)))))

(DEFMETHOD (:HANDLE-ESCAPE NVT-WINDOW) (ESCAPE-FILTER)
  (UNWIND-PROTECT
      (PROGN
	(SEND TERMINAL-IO :EXPOSE-FOR-TYPEOUT)
	(LOOP NAMED HANDLE-ESCAPE DOING
	  (MULTIPLE-VALUE-BIND (COMMAND ARGUMENTS)
	      (CP:READ-ACCELERATED-COMMAND
		:PROMPT "Terminal command: "
		:COMMAND-TABLE *COMMAND-TABLE*
		:UNKNOWN-ACCELERATOR-TESTER
		(LAMBDA (CHAR)
		  (COND ((CHAR-EQUAL CHAR (SEND ESCAPE-FILTER :ESCAPE-CHAR))
			 (RETURN-FROM HANDLE-ESCAPE
			   (SEND (SEND ESCAPE-FILTER :OUTPUT-STREAM) :TYO CHAR)))
			((CHAR-EQUAL CHAR #\RUBOUT)
			 (RETURN-FROM HANDLE-ESCAPE NIL)))))
	    (LET ((*ESCAPE-FILTER* ESCAPE-FILTER))
	      (WHEN COMMAND
		(APPLY COMMAND ARGUMENTS)))
	    (UNLESS (EQ COMMAND 'COM-CANNED-HELP)	;+++
	      (RETURN-FROM HANDLE-ESCAPE T)))))
    (SEND TERMINAL-IO :DEEXPOSE)
    (recompute-label)))

(defmethod (:connect nvt-window :after) (&rest ignore)
  (recompute-label))

(compile-flavor-methods nvt-window supdup-state-block)