File [phylum]<LispLibrary>Lyric>CHATPATCH!1

(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "25-Jul-88 14:32:40" {ERIS}<VANMELLE>LISP>CHATPATCH.;2 7034   

      changes to%:  (VARS CHATPATCHCOMS)

      previous date%: "25-Jul-88 11:47:01" {ERIS}<VANMELLE>LISP>CHATPATCH.;1)


(* "
Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CHATPATCHCOMS)

(RPAQQ CHATPATCHCOMS ((DECLARE%: DONTEVAL@LOAD DOCOPY FIRST (FILES (SYSLOAD) CHAT) (P (LET ((CHATCOM (QUOTE ("Chat" (QUOTE (\SPAWN.CHAT)) "Runs a new CHAT process; prompts for host" (SUBITEMS ("No Login" (QUOTE (\SPAWN.CHAT (QUOTE NONE))) "Runs CHAT without doing automatic login"))))) (OLDCOM (CL:ASSOC "Chat" BackgroundMenuCommands :TEST (QUOTE STRING-EQUAL)))) (COND (OLDCOM (/RPLNODE2 OLDCOM CHATCOM)) (T (push BackgroundMenuCommands CHATCOM))) (SETQ BackgroundMenu)))) (FNS \SPAWN.CHAT CHAT CHAT.STARTUP) (PROP (VARTYPE) CHAT.OSTYPES NETWORKLOGINFO) (ALISTS (NETWORKLOGINFO UNIX) (CHAT.OSTYPES UNIX)) (ADDVARS (CHAT.PROTOCOL.ABBREVS (N . TCP) (T . TCP) (X . NS) (P . PUP))) (INITVARS (CHAT.HOST.TO.PROTOCOL)) (GLOBALVARS CHAT.OSTYPES CHAT.PROTOCOL.ABBREVS CHAT.HOST.TO.PROTOCOL)))
(DECLARE%: DONTEVAL@LOAD DOCOPY FIRST 

(FILESLOAD (SYSLOAD) CHAT)


(LET ((CHATCOM (QUOTE ("Chat" (QUOTE (\SPAWN.CHAT)) "Runs a new CHAT process; prompts for host" (SUBITEMS ("No Login" (QUOTE (\SPAWN.CHAT (QUOTE NONE))) "Runs CHAT without doing automatic login"))))) (OLDCOM (CL:ASSOC "Chat" BackgroundMenuCommands :TEST (QUOTE STRING-EQUAL)))) (COND (OLDCOM (/RPLNODE2 OLDCOM CHATCOM)) (T (push BackgroundMenuCommands CHATCOM))) (SETQ BackgroundMenu))
)
(DEFINEQ

(\SPAWN.CHAT
(LAMBDA (LOGOPTION) (* ; "Edited 25-May-88 16:20 by bvm") (* ; "From the Background Menu, runs CHAT as a process") (ADD.PROCESS (BQUOTE (CHAT NIL (QUOTE (\, LOGOPTION)) NIL NIL T))))
)

(CHAT
(LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* ; "Edited 26-May-88 12:06 by bvm") (LET (SUCCESS RESULT HOSTS PROC) (if (AND (OR HOST (SETQ HOST (COND ((AND FROMMENU (OR CHAT.HOSTMENU (PROGN (SETQ HOSTS CHAT.ALLHOSTS) (COND (DEFAULTCHATHOST (pushnew HOSTS DEFAULTCHATHOST))) HOSTS))) (MENU (OR CHAT.HOSTMENU (SETQ CHAT.HOSTMENU (create MENU ITEMS ← (APPEND HOSTS (QUOTE (Other))) TITLE ← "Host"))))) (T (OR DEFAULTCHATHOST (QUOTE Other)))))) (OR (NEQ HOST (QUOTE Other)) (SETQ HOST (MKATOM (PROMPTFORWORD "
Host: " NIL "Enter name of host to chat to, or <cr> to abort" (COND (FROMMENU (COND (WINDOW (GETPROMPTWINDOW WINDOW)) (T PROMPTWINDOW)))) NIL (QUOTE TTY) (CHARCODE (CR))))))) then (* ; "Have a host--get the process started.  Want to get this proc going as soon as possible so we can give it the tty") (SETQ PROC (ADD.PROCESS (BQUOTE (CHAT.STARTUP (QUOTE (\, HOST)) (QUOTE (\, LOGOPTION)) (QUOTE (\, INITSTREAM)) (QUOTE (\, WINDOW)) (QUOTE (\, FROMMENU)))) (QUOTE RESTARTABLE) (QUOTE NO))) (do (* ; "Wait for it to open or fail") (if (NOT (PROCESSP PROC)) then (RETURN (SETQ RESULT (PROCESS.RESULT PROC))) elseif (PROCESSPROP PROC (QUOTE CHAT.STARTUP)) then (RETURN (SETQ RESULT (SETQ SUCCESS HOST))) else (BLOCK 1000)))) (COND ((AND (NOT SUCCESS) WINDOW (WINDOWPROP WINDOW (QUOTE CHATHOST))) (* ; "Window not useable, let it reconnect") (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN) (FUNCTION CHAT.RECONNECT)) (REMOVEPROMPTWINDOW WINDOW))) RESULT))
)

(CHAT.STARTUP
(LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* ; "Edited 25-Jul-88 11:39 by bvm") (PROG (STREAMS RESULT OPENFN DISPLAYTYPE SLASH PROTOCOL) (if (OR FROMMENU CHAT.TTY.PROCESS) then (* ; "Grab tty right away, not when we finally get connected.") (TTY.PROCESS (THIS.PROCESS))) (if (AND (SETQ SLASH (STRPOS "/" HOST)) (SETQ PROTOCOL (CDR (CL:ASSOC (SUBSTRING HOST (ADD1 SLASH)) CHAT.PROTOCOL.ABBREVS :TEST (QUOTE STRING-EQUAL))))) then (* ; "Caller explicitly specified protocol to use") (if (NOT (SETQ OPENFN (CDR (ASSOC PROTOCOL CHAT.PROTOCOLTYPES)))) then (SETQ RESULT (CONCAT "The " PROTOCOL " Chat protocol is not loaded.")) (GO FAIL) elseif (NOT (SETQ OPENFN (CL:FUNCALL OPENFN (SETQ HOST (SUBSTRING HOST 1 (SUB1 SLASH)))))) then (SETQ RESULT (CONCAT HOST " is not a recognized " PROTOCOL " host.")) (GO FAIL)) elseif (AND (SETQ PROTOCOL (CDR (CL:ASSOC HOST CHAT.HOST.TO.PROTOCOL :TEST (QUOTE STRING-EQUAL)))) (SETQ OPENFN (CDR (ASSOC PROTOCOL CHAT.PROTOCOLTYPES))) (SETQ OPENFN (CL:FUNCALL OPENFN HOST))) then (* ; "use protocol that worked the last time.  Clear PROTOCOL to skip the test below for remembering it") (SETQ PROTOCOL NIL) else (* ; "Try all protocols") (for PAIR in CHAT.PROTOCOLTYPES when (SETQ OPENFN (CL:FUNCALL (CDR PAIR) HOST)) do (* ; "Value returned is (CanonicalHostName OpenFn)") (SETQ PROTOCOL (CAR PAIR)) (RETURN OPENFN))) (COND ((NOT OPENFN) (* ; "Don't know how to talk to this host") (SETQ RESULT (CONCAT "Unknown Chat host: " HOST)) (GO FAIL))) (SETQ HOST (CAR OPENFN)) (COND ((NOT (CL:MEMBER HOST CHAT.ALLHOSTS :TEST (QUOTE STRING-EQUAL))) (SETQ CHAT.ALLHOSTS (SORT (CONS HOST CHAT.ALLHOSTS) (FUNCTION UALPHORDER))) (SETQ CHAT.HOSTMENU))) (COND ((NOT (SETQ STREAMS (CL:FUNCALL (CADR OPENFN) HOST))) (RETURN "Failed"))) (if PROTOCOL then (* ; "Remember protcol that worked for next time") (LET ((TEM (CL:ASSOC HOST CHAT.HOST.TO.PROTOCOL :TEST (QUOTE STRING-EQUAL)))) (if TEM then (RPLACD TEM PROTOCOL) else (push CHAT.HOST.TO.PROTOCOL (CONS HOST PROTOCOL))))) (SETQ DISPLAYTYPE (CHAT.CHOOSE.EMULATOR HOST)) (SETQ WINDOW (GETCHATWINDOW HOST WINDOW (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE))) (CHAT.INIT STREAMS WINDOW HOST DISPLAYTYPE) (LET ((PROC (THIS.PROCESS))) (PROCESSPROP PROC (QUOTE KEYACTION) (SETQ \CURRENTKEYACTION (LET ((KEY (KEYACTIONTABLE \DEFAULTKEYACTION)) (INFO (CDR (ASSOC (GETHOSTINFO HOST (QUOTE OSTYPE)) CHAT.OSTYPES)))) (for PAIR in (CURRENTINTERRUPTS KEY) when (LEQ (CAR PAIR) 255) do (INTCHAR (CAR PAIR) NIL NIL KEY)) (* ; " turn off all interrupts in charset 0") (for PAIR in CHAT.INTERRUPTS do (INTCHAR (CAR PAIR) NIL NIL KEY)) (for PAIR in CHAT.KEYACTIONS do (KEYACTION (CAR PAIR) (CDR PAIR) KEY)) (if INFO then (for PAIR in (LISTGET INFO :INTERRUPTS) do (INTCHAR (CAR PAIR) NIL NIL KEY)) (for PAIR in (LISTGET INFO :KEYACTIONS) do (KEYACTION (CAR PAIR) (CDR PAIR) KEY))) KEY))) (PROCESSPROP PROC (QUOTE NAME) (CONCAT "CHAT#" HOST)) (PROCESSPROP PROC (QUOTE CHAT.STARTUP) T)) (RETURN (CHAT.TYPEIN HOST WINDOW LOGOPTION INITSTREAM)) FAIL (* ;; "Come here with RESULT set to description of failure") (COND (FROMMENU (printout (COND (WINDOW (GETPROMPTWINDOW WINDOW)) (T PROMPTWINDOW)) T RESULT))) (RETURN RESULT)))
)
)

(PUTPROPS CHAT.OSTYPES VARTYPE ALIST)

(PUTPROPS NETWORKLOGINFO VARTYPE ALIST)

(ADDTOVAR NETWORKLOGINFO (UNIX (LOGIN WAIT LF WAIT USERNAME LF WAIT PASSWORD LF)))

(ADDTOVAR CHAT.OSTYPES (UNIX :KEYACTIONS ((CR (10 10)) (BS (127 127)))))

(ADDTOVAR CHAT.PROTOCOL.ABBREVS (N . TCP) (T . TCP) (X . NS) (P . PUP))

(RPAQ? CHAT.HOST.TO.PROTOCOL)
(DECLARE%: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS CHAT.OSTYPES CHAT.PROTOCOL.ABBREVS CHAT.HOST.TO.PROTOCOL)
)
(PUTPROPS CHATPATCH COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (1615 6503 (\SPAWN.CHAT 1625 . 1826) (CHAT 1828 . 3297) (CHAT.STARTUP 3299 . 6501)))))
STOP