(FILECREATED " 1-Jul-85 14:22:53" {ERIS}<LISPCORE>LIBRARY>CHAT.;16 50946
changes to: (VARS CHATCOMS CHATMENUITEMS)
(FNS CHAT.LOGIN)
previous date: "23-Jun-85 19:37:53" {ERIS}<LISPCORE>LIBRARY>CHAT.;15)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHATCOMS)
(RPAQQ CHATCOMS ((COMS (* CHAT typein)
(FNS CHAT CHAT.CHOOSE.EMULATOR CHAT.INIT FIND.CHAT.PROTOCOL CHAT.TYPEIN
CHAT.BIN CHAT.CLOSE CHAT.CLOSEFN CHAT.CLOSE.CONNECTION CHAT.LOGIN))
(COMS (* Chat streams)
(FNS ADD.CHAT.MESSAGE CHAT.LOGINFO CHAT.SENDSCREENPARAMS CHAT.SETDISPLAYTYPE
CHAT.LOGINFO CHAT.FLUSH&WAIT CHAT.ENDOFSTREAMOP CHAT.OPTIONMENU))
(COMS (* CHAT typeout)
(FNS CHAT.TYPEOUT CHAT.DID.RESHAPE CHAT.SCREENPARAMS))
(COMS (* window stuff)
(FNS GETCHATWINDOW CHAT.BUTTONFN CHAT.HOLD CHAT.ICONFN CHAT.MENU CHAT.CLEAR.FROM.MENU
CHAT.TAKE.INPUT CHAT.TAKE.INPUT1 DO.CHAT.OPTION CHAT.RECONNECT CHAT.RESHAPEWINDOW
CHAT.TTYENTRYFN CHAT.TTYEXITFN CHAT.TYPESCRIPT CHAT.TYPESCRIPT1))
(COMS (* for dialouts)
(FNS CHAT.CHOOSE.PHONE.NUMBER)
(INITVARS (CHAT.PHONE.NUMBER.MENU)
(CHAT.PHONE.NUMBERS (QUOTE (Other)))))
(COMS (* for EMACS)
(FNS CHAT.EMACS.MOVE CHAT.SWITCH.EMACS))
(BITMAPS TTYKBD TTYKBDMASK)
(INITVARS (CHAT.DISPLAYTYPES (QUOTE ((NIL 10 DM2500))))
(CHAT.DRIVERTYPES)
(CHAT.PROTOCOLTYPES)
(CHAT.EMULATORTYPE (QUOTE DM2500))
(CHAT.METACHAR 195)
(CHAT.CONTROLCHAR 193)
(CHAT.INTERRUPTS)
(CHAT.KEYACTIONS)
(DEFAULTCHATHOST)
(CHATDEBUGFLG)
(CHATWINDOW)
(CHATWINDOWLST)
(CHAT.AUTOCRLF T)
(CLOSECHATWINDOWFLG)
(CHAT.ALLHOSTS)
(CHAT.HOSTMENU)
(CHAT.FONT)
(CHAT.IN.EMACS? NIL)
(CHAT.EMACSCOMMANDS (QUOTE (21 16 14 6 1)))
(CHAT.WAIT.TIME 2000)
(TTYKBDICONSPEC))
(VARS (CHATMENU)
(CHAT.REOPENMENU)
(TTYKBDICONSPECREGION (QUOTE (6 10 58 18)))
CHATMENUITEMS NETWORKLOGINFO)
(DECLARE: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(COMS * CHATDEFS))
(INITVARS (INVERTWINDOWFN (QUOTE INVERTW)))
(COMS (FNS \SPAWN.CHAT)
(DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (BackgroundMenuCommands (CHAT (QUOTE (
\SPAWN.CHAT))
"Runs a new CHAT process; prompts for host")))
(P (SETQ BackgroundMenu))
(* need DMCHAT since its the default emulator)
(FILES DMCHAT)))
(RECORDS CHAT.STATE CHATDISPLAYTYPE)))
(* CHAT typein)
(DEFINEQ
(CHAT
[LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* lmm "30-Apr-85 16:44")
[COND
((NOT (THIS.PROCESS))
(PRIN1 "Turning on Process mechanism and trying again...
" T)
(COND
((READP T)
(PRINTBELLS)
(DISMISS 1000)))
(CLEARBUF T)
[BKSYSBUF (MKSTRING (CONS (QUOTE CHAT)
(AND (OR HOST LOGOPTION)
(CONS (KWOTE HOST)
(AND LOGOPTION (CONS (KWOTE LOGOPTION]
(RETEVAL (QUOTE CHAT)
(QUOTE (PROCESSWORLD T]
(PROG (CONNECTION STREAMS OPENFN RESULT PROCESS HOSTS DISPLAYTYPE)
[OR HOST (COND
[FROMMENU (COND
((OR CHAT.HOSTMENU (PROGN (SETQ HOSTS CHAT.ALLHOSTS)
(COND
(DEFAULTCHATHOST (pushnew HOSTS
DEFAULTCHATHOST)))
HOSTS))
[SETQ HOST (MENU (OR CHAT.HOSTMENU (SETQ CHAT.HOSTMENU
(create MENU
ITEMS ←(APPEND HOSTS (QUOTE (Other)))
TITLE ← "Host"]
(COND
((EQ HOST (QUOTE Other))
(SETQ HOST NIL))
((NULL HOST)
(RETURN]
(T (SETQ HOST DEFAULTCHATHOST]
TOP [COND
((NOT HOST)
(COND
([NOT (SETQ HOST (MKATOM (PROMPTFORWORD "
Host: " NIL "Enter name of host to chat to, or <cr> to abort" (AND FROMMENU PROMPTWINDOW)
NIL NIL (CHARCODE (CR]
(GO FAIL]
(COND
[(NOT (SETQ OPENFN (FIND.CHAT.PROTOCOL HOST))) (* Don't know how to talk to this host)
(SETQ RESULT (CONCAT "Unknown Chat host: " HOST))
(COND
(FROMMENU (printout PROMPTWINDOW T RESULT]
((NOT (SETQ STREAMS (APPLY* (PROGN (SETQ HOST (CAR OPENFN))
(* Value returned was (CanonicalHostName OpenFn))
(CADR OPENFN))
HOST)))
(SETQ RESULT "Failed"))
(T (SETQ DISPLAYTYPE (CHAT.CHOOSE.EMULATOR HOST))
(SETQ WINDOW (GETCHATWINDOW HOST WINDOW (fetch (CHATDISPLAYTYPE DPYNAME) of
DISPLAYTYPE)))
(CHAT.INIT STREAMS WINDOW HOST DISPLAYTYPE)
(COND
((NOT (FMEMB HOST CHAT.ALLHOSTS))
(SETQ CHAT.ALLHOSTS (CONS HOST CHAT.ALLHOSTS))
(SETQ CHAT.HOSTMENU)))
[COND
(FROMMENU (PROCESSPROP (THIS.PROCESS)
(QUOTE NAME)
(PACK* "CHAT#" HOST))
(RETURN (CHAT.TYPEIN HOST WINDOW LOGOPTION INITSTREAM)))
(T (ADD.PROCESS (LIST (QUOTE CHAT.TYPEIN)
(KWOTE HOST)
(KWOTE WINDOW)
(KWOTE LOGOPTION)
(KWOTE INITSTREAM))
(QUOTE NAME)
(PACK* "CHAT#" HOST)
(QUOTE RESTARTABLE)
(QUOTE NO]
(RETURN HOST)))
FAIL[COND
((AND WINDOW (WINDOWPROP WINDOW (QUOTE CHATHOST)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT]
(RETURN RESULT])
(CHAT.CHOOSE.EMULATOR
[LAMBDA (HOST) (* ejs: "13-Nov-84 16:13")
(* * Returns a record of type CHATDISPLAYTYPE to be used for this session)
(COND
[(FIXP CHAT.DISPLAYTYPES)
(COND
(CHAT.EMULATORTYPE (create CHATDISPLAYTYPE
HOST ← NIL
DPYNAME ← CHAT.EMULATORTYPE
DPYCODE ← CHAT.DISPLAYTYPES]
((LISTP CHAT.DISPLAYTYPES)
(OR (FASSOC HOST CHAT.DISPLAYTYPES)
(FASSOC NIL CHAT.DISPLAYTYPES)))
(T (ERROR "Please set CHAT.DISPLAYTYPES to be a list of (HOST TTY-TYPE-# EMULATORTYPE)")
NIL])
(CHAT.INIT
(LAMBDA (STREAMS WINDOW HOST DISPLAYTYPE) (* ejs: "14-Jun-85 15:09")
(LET* ((INSTREAM (CAR STREAMS))
(OUTSTREAM (CDR STREAMS))
(DPYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE))
(STATE (create CHAT.STATE
RUNNING? ← T
CHATINEMACS ← CHAT.IN.EMACS?
INSTREAM ← INSTREAM
OUTSTREAM ← OUTSTREAM
WINDOW ← WINDOW
DSP ←(WINDOWPROP WINDOW (QUOTE DSP)))))
(WINDOWPROP WINDOW (QUOTE CHATSTATE)
STATE)
(COND
((EQ DPYNAME (QUOTE TEDIT))
(replace (CHAT.STATE TEXTSTREAM) of STATE with (TEDITSTREAM.INIT WINDOW
(FUNCTION TEDITCHAT.MENUFN)
)))
(T (WINDOWPROP WINDOW (QUOTE CURSORMOVEDFN)
NIL)
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION CHAT.RESHAPEWINDOW))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.BUTTONFN))
(WINDOWPROP WINDOW (QUOTE REPAINTFN)
NIL)
(WINDOWPROP WINDOW (QUOTE NEWREGIONFN)
NIL)
(WINDOWPROP WINDOW (QUOTE WINDOWENTRYFN)
(QUOTE GIVE.TTY.PROCESS))
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
NIL)
(WINDOWPROP WINDOW (QUOTE CURSOROUTFN)
NIL)
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
NIL)))
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION CHAT.CLOSEFN))
(WINDOWPROP WINDOW (QUOTE ICONWINDOW)
NIL)
(WINDOWPROP WINDOW (QUOTE ICONFN)
(FUNCTION CHAT.ICONFN))
(STREAMPROP INSTREAM (QUOTE OLDEOSOP)
(fetch ENDOFSTREAMOP of INSTREAM))
(STREAMPROP INSTREAM (QUOTE DISPLAYTYPE)
DISPLAYTYPE)
(replace ENDOFSTREAMOP of INSTREAM with (FUNCTION CHAT.ENDOFSTREAMOP)))))
(FIND.CHAT.PROTOCOL
[LAMBDA (NAME) (* ejs: "13-Nov-84 16:24")
(* * Find a protocol for use by CHAT by calling the filter fns on CHAT.PROTOCOLS. The fns should return a
CHAT.PROTOCOL that can be used to contact NAME or NIL.)
(for PAIR in CHAT.PROTOCOLTYPES bind RESULT when (SETQ RESULT (APPLY* (CDR PAIR)
NAME))
do (RETURN RESULT])
(CHAT.TYPEIN
[LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* ejs: "12-May-85 16:06")
(DECLARE (SPECVARS STREAM)) (* so that menu can change it)
(PROG ((THISPROC (THIS.PROCESS))
(DEFAULTSTREAM T)
(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
CHATSTREAM INSTREAM WINDOWSTREAM STREAM CH DISPLAYTYPE DISPLAYNAME CHATPROMPTWINDOW)
(SETQ CHATSTREAM (fetch (CHAT.STATE OUTSTREAM) of STATE))
(SETQ INSTREAM (fetch (CHAT.STATE INSTREAM) of STATE))
(PROCESSPROP THISPROC (QUOTE TTYEXITFN)
(FUNCTION CHAT.TTYEXITFN))
(PROCESSPROP THISPROC (QUOTE TTYENTRYFN)
(FUNCTION CHAT.TTYENTRYFN))
(COND
((TTY.PROCESSP)
(* Already have tty (probably from menu), so explicitly turn off interrupts, since our TTYENTRYFN hadn't been set
yet (so that ↑E could interrupt GETCHATWINDOW))
(CHAT.TTYENTRYFN THISPROC))
(T (* want to do this early so users can start typing
ahead)
(TTY.PROCESS THISPROC)))
(PROCESSPROP THISPROC (QUOTE WINDOW)
WINDOW)
(SETQ WINDOWSTREAM (WINDOWPROP WINDOW (QUOTE DSP)))
(DSPFONT (OR CHAT.FONT (DEFAULTFONT (QUOTE DISPLAY)))
WINDOWSTREAM)
(DSPRESET WINDOWSTREAM)
(WINDOWPROP WINDOW (QUOTE PROCESS)
(THIS.PROCESS))
(WINDOWPROP WINDOW (QUOTE CHATHOST)
(CONS HOST LOGOPTION))
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (WINDOW STATE)
(AND RESETSTATE (fetch (CHAT.STATE RUNNING?) of STATE)
(CHAT.CLOSE WINDOW T]
WINDOW STATE)) (* If an error occurs, process is killed, or HARDRESET
happens, this will flush the connection etc)
[COND
((SETQ DISPLAYTYPE (STREAMPROP INSTREAM (QUOTE DISPLAYTYPE)))
(SETQ DISPLAYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE]
(replace (CHAT.STATE TYPEOUTPROC) of STATE with (ADD.PROCESS (BQUOTE (CHAT.TYPEOUT
, WINDOW
(QUOTE , DISPLAYNAME)
(QUOTE , STATE)))
(QUOTE NAME)
(QUOTE CHAT.TYPEOUT)))
[COND
(DISPLAYTYPE (CHAT.SETDISPLAYTYPE INSTREAM (fetch (CHATDISPLAYTYPE DPYCODE) of
DISPLAYTYPE]
(CHAT.SCREENPARAMS STATE INSTREAM WINDOW)
(AND (NEQ LOGOPTION (QUOTE NONE))
(CHAT.LOGIN HOST LOGOPTION WINDOW STATE))
(COND
(INITSTREAM (XNLSETQ (SETQ STREAM (\GETSTREAM (OR (STRINGP INITSTREAM)
(OPENFILE INITSTREAM (QUOTE INPUT)))
(QUOTE INPUT)))
NOBREAK)))
(TTYDISPLAYSTREAM WINDOWSTREAM) (* So that \TTYBACKGROUND flashes the caret where we
expect)
(while (EQ (fetch (CHAT.STATE RUNNING?) of STATE)
T)
do (COND
((NULL STREAM)
(SETQ STREAM DEFAULTSTREAM)))
[COND
[(EQ STREAM T) (* Handle terminal differently.
Mainly because we may be inside a blocked process's
\fillbuffer, making READP think there is input.
Ugh!!!)
(OR (TTY.PROCESSP)
(\WAIT.FOR.TTY))
(COND
((\SYSBUFP)
(do (SETQ CH (\GETKEY))
(BOUT CHATSTREAM (COND
((EQ CH CHAT.CONTROLCHAR)
(* Controlify it)
(LOGAND (CHAT.BIN CHATSTREAM STATE)
31))
((EQ CH CHAT.METACHAR) (* Prefix meta, turn on 200q bit)
(LOGOR (CHAT.BIN CHATSTREAM STATE)
128))
(T CH)))
repeatwhile (\SYSBUFP))
(FORCEOUTPUT CHATSTREAM]
(T (until (EOFP STREAM) do (BOUT CHATSTREAM (\BIN STREAM)))
(FORCEOUTPUT CHATSTREAM)
(CLOSEF STREAM)
(SETQ STREAM)
(COND
((SETQ CHATPROMPTWINDOW (GETPROMPTWINDOW WINDOW NIL NIL T))
(* Indicate completion of Input if came from menu
command)
(CLEARW CHATPROMPTWINDOW]
(\TTYBACKGROUND))
(* * Get here if we close connection.)
[SELECTQ (fetch (CHAT.STATE RUNNING?) of STATE)
(CLOSE (CHAT.CLOSE WINDOW))
(ABORT (CHAT.CLOSE WINDOW T))
(NIL (* Already dead.))
(SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch (CHAT.STATE RUNNING?)
of STATE]
(BLOCK])
(CHAT.BIN
[LAMBDA (OUTSTREAM STATE) (* rda: "20-Aug-84 23:09")
(until (\SYSBUFP) bind (FIRSTTIME ← T)
do (COND
(FIRSTTIME (FORCEOUTPUT OUTSTREAM)
(SETQ FIRSTTIME NIL)))
(\TTYBACKGROUND))
(\GETKEY])
(CHAT.CLOSE
[LAMBDA (WINDOW ABORTED CLOSING) (* AJB "10-Jun-85 16:30")
(* Close chat connection that is using WINDOW.
Also serves as the CLOSEFN of this window, when CLOSING
is NIL)
(DECLARE (GLOBALVARS HIGHLIGHTSHADE))
(PROG ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(ACTIVE? (ACTIVEWP WINDOW))
ICON PROC FILE KEEP)
(DETACHALLWINDOWS WINDOW) (* Restore REPLACE mode for BITBLT)
(DSPOPERATION (QUOTE REPLACE)
WINDOW) (* Turn scrolling back on)
(DSPSCROLL (QUOTE ON)
WINDOW)
(COND
[CHATSTATE (DEL.PROCESS (fetch (CHAT.STATE TYPEOUTPROC) of CHATSTATE))
[COND
((SETQ FILE (fetch (CHAT.STATE TYPESCRIPTSTREAM) of CHATSTATE))
(COND
(ACTIVE? (TERPRI WINDOW)
(PRIN1 "Closing " WINDOW)
(PRINT (CLOSEF FILE)
WINDOW))
(T (CLOSEF FILE]
(AND ACTIVE? (\CHECKCARET WINDOW))
(replace (CHAT.STATE RUNNING?) of (WINDOWPROP WINDOW (QUOTE CHATSTATE)
NIL)
with NIL)
(OR ABORTED (CHAT.CLOSE.CONNECTION (fetch (CHAT.STATE INSTREAM) of CHATSTATE)
(fetch (CHAT.STATE OUTSTREAM) of CHATSTATE]
(T (RETURN)))
(SETQ CHATWINDOWLST (DREMOVE WINDOW CHATWINDOWLST))
(SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)
NIL))
(* Save the process running, if any; don't do anything with it until after we close the window, if we're going to,
so that windows don't flip around excessively)
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
NIL) (* Clear all CLOSE functions so that next time this
chatwindow is reused it will be clean)
(COND
[ACTIVE? (* Change title to indicate closure)
(PROG [(TITLE (WINDOWPROP WINDOW (QUOTE TITLE]
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (SUBSTRING TITLE 1 (IPLUS (OR (STRPOS ", height" TITLE)
0)
-1))
", closed")))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT))
(COND
((AND (NOT (SETQ KEEP (WINDOWPROP WINDOW (QUOTE KEEPCHAT)
NIL)))
(NOT CLOSING)
(OR CLOSECHATWINDOWFLG (NEQ WINDOW CHATWINDOW)))
(CLOSEW WINDOW)))
[COND
((EQ KEEP (QUOTE NEW)) (* Invoked via the New command -- start up a new
connection in this window)
(ADD.PROCESS (LIST (QUOTE CHAT)
NIL NIL NIL WINDOW T]
(COND
(PROC (* Do this last, because if we are PROC, DEL.PROCESS
won't return)
(DEL.PROCESS PROC]
((AND (SETQ ICON (WINDOWPROP WINDOW (QUOTE ICONWINDOW)))
(ACTIVEWP ICON)) (* Shade the icon if the chat window is currently
closed)
(ICONW.SHADE ICON HIGHLIGHTSHADE])
(CHAT.CLOSEFN
[LAMBDA (WINDOW) (* rda: "21-Aug-84 13:23")
(* * Close this chat connection making sure that the window gets closed. Used as CLOSEFN of the chat window.)
(CHAT.CLOSE WINDOW NIL T])
(CHAT.CLOSE.CONNECTION
[LAMBDA (INSTREAM OUTSTREAM) (* rda: "23-Aug-84 15:25")
(* * Close the streams for a connection if they are open.)
(COND
((OPENP INSTREAM)
(CLOSEF INSTREAM)))
(COND
((OPENP OUTSTREAM)
(CLOSEF OUTSTREAM])
(CHAT.LOGIN
(LAMBDA (HOST OPTION WINDOW CHATSTATE) (* ejs: " 1-Jul-85 14:20")
(* * Login to HOST. If a job already exists on HOST, Attach to it unless OPTION overrides.)
(PROG ((LOGINFO (CDR (ASSOC (OR (GETOSTYPE HOST)
(QUOTE IFS))
NETWORKLOGINFO)))
(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
NAME/PASS COM INSTREAM OUTSTREAM)
(SETQ INSTREAM (fetch (CHAT.STATE INSTREAM) of STATE))
(OR LOGINFO (RETURN))
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOST))
(SETQ COM (COND
(OPTION)
((ASSOC (QUOTE ATTACH)
LOGINFO)
(OR (CHAT.LOGINFO INSTREAM HOST (CAR NAME/PASS))
(QUOTE LOGIN)))
(T (* Don't know how to do anything but login, so silly to
try anything else)
(QUOTE LOGIN))))
(COND
((NULL (SETQ LOGINFO (ASSOC COM LOGINFO)))
(printout PROMPTWINDOW T "Login option " COM " not implemented for this type of host"))
(T (SETQ OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) of STATE))
(for X in (CDR LOGINFO) do (SELECTQ X
(CR (BOUT OUTSTREAM (CHARCODE CR))
(FORCEOUTPUT OUTSTREAM))
(LF (BOUT OUTSTREAM (CHARCODE LF))
(FORCEOUTPUT OUTSTREAM))
(USERNAME (PRIN3 (CAR NAME/PASS)
OUTSTREAM))
(PASSWORD (PRIN3 (\DECRYPT.PWD (CDR NAME/PASS))
OUTSTREAM))
(WAIT (* Some systems do not permit typeahead)
(COND
((NOT (CHAT.FLUSH&WAIT INSTREAM))
(* Couldn't sync, so wait longer.)
(DISMISS CHAT.WAIT.TIME)))
(DISMISS CHAT.WAIT.TIME))
(PRIN3 X OUTSTREAM)))
(FORCEOUTPUT OUTSTREAM))))))
)
(* Chat streams)
(DEFINEQ
(ADD.CHAT.MESSAGE
[LAMBDA (STREAM MSG) (* rda: "22-Aug-84 18:07")
(STREAMPROP STREAM (QUOTE MESSAGE)
(CONCAT (OR (STREAMPROP STREAM (QUOTE MESSAGE))
"")
MSG])
(CHAT.LOGINFO
[LAMBDA (INSTREAM HOST NAME) (* rda: "22-Aug-84 17:04")
(* * Invoke the LOGINFO method for INSTREAM, if any.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE LOGINFO]
(RETURN (COND
((FNTYP FN)
(APPLY* FN HOST NAME])
(CHAT.SENDSCREENPARAMS
[LAMBDA (INSTREAM HEIGHT WIDTH) (* ejs: "13-Nov-84 15:33")
(* * Invoke the SENDSCREENPARAMS method for INSTREAM, if any.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE SENDSCREENPARAMS]
(RETURN (COND
((FNTYP FN)
(APPLY* FN INSTREAM HEIGHT WIDTH])
(CHAT.SETDISPLAYTYPE
[LAMBDA (INSTREAM CODE) (* ejs: "13-Nov-84 15:35")
(* * Invoke the SETDISPLAYTYPE method for INSTREAM.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE SETDISPLAYTYPE]
(RETURN (AND (NUMBERP CODE)
(COND
((FNTYP FN)
(APPLY* FN INSTREAM CODE])
(CHAT.LOGINFO
[LAMBDA (INSTREAM HOST NAME) (* rda: "22-Aug-84 17:04")
(* * Invoke the LOGINFO method for INSTREAM, if any.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE LOGINFO]
(RETURN (COND
((FNTYP FN)
(APPLY* FN HOST NAME])
(CHAT.FLUSH&WAIT
[LAMBDA (INSTREAM) (* rda: "21-Aug-84 13:48")
(* * Invoke the FLUSH&WAIT method for INSTREAM)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE FLUSH&WAIT]
(RETURN (COND
((FNTYP FN)
(APPLY* FN INSTREAM])
(CHAT.ENDOFSTREAMOP
[LAMBDA (STREAM) (* rda: "24-Aug-84 22:52")
(* * Return -1 to indicate EOS to CHAT, and restore the streams EOS op incase it's needed for other things.)
(replace ENDOFSTREAMOP of STREAM with (OR (STREAMPROP STREAM (QUOTE EOSOP))
(FUNCTION \EOSERROR)))
-1])
(CHAT.OPTIONMENU
(LAMBDA (INSTREAM) (* ejs: "23-Jun-85 17:04")
(* * Apply the menu-building method for INSTREAM, if any.)
(PROG ((FN (STREAMPROP INSTREAM (QUOTE OPTIONMENU))))
(RETURN (COND
((FNTYP FN)
(APPLY* FN INSTREAM))
((type? MENU FN)
FN))))))
)
(* CHAT typeout)
(DEFINEQ
(CHAT.TYPEOUT
(LAMBDA (WINDOW DPYNAME CHAT.STATE) (* ejs: "12-Jun-85 21:18")
(bind (CNT ← 1)
HANDLECHARFN MSG CH INSTREAM OUTSTREAM TYPESCRIPTSTREAM CRPENDING TERM.STATE
first (SETQ INSTREAM (fetch (CHAT.STATE INSTREAM) of CHAT.STATE))
(SETQ HANDLECHARFN (CADR (FASSOC DPYNAME CHAT.DRIVERTYPES)))
(COND
((NOT (TYPENAMEP (fetch (CHAT.STATE TERM.STATE) of CHAT.STATE)
(TYPENAME (APPLY* (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES))
CHAT.STATE))))
(replace (CHAT.STATE TERM.STATE) of CHAT.STATE
with (SETQ TERM.STATE (APPLY* (CADDR (FASSOC DPYNAME CHAT.DRIVERTYPES))
CHAT.STATE))))
(T (SETQ TERM.STATE (fetch (CHAT.STATE TERM.STATE) of CHAT.STATE))))
(COND
((EQ DPYNAME (QUOTE TEDIT))
(SETQ OUTSTREAM (WINDOWPROP WINDOW (QUOTE TEXTSTREAM))))
(T (SETQ OUTSTREAM (WINDOWPROP WINDOW (QUOTE DSP)))))
(* TERM.HOME CHAT.STATE)
while (IGEQ (SETQ CH (BIN INSTREAM))
0)
do (while (fetch (CHAT.STATE HELD) of CHAT.STATE) do (BLOCK))
(\CHECKCARET OUTSTREAM)
(COND
((SETQ MSG (STREAMPROP INSTREAM (QUOTE MESSAGE)))
(PRIN1 MSG OUTSTREAM)
(STREAMPROP INSTREAM (QUOTE MESSAGE)
NIL))) (* Print any protocol related msgs that might have come
along while we where asleep)
(SPREADAPPLY* HANDLECHARFN CH CHAT.STATE TERM.STATE)
(COND
((SETQ TYPESCRIPTSTREAM (fetch (CHAT.STATE TYPESCRIPTSTREAM) of CHAT.STATE))
(COND
((SELCHARQ CH
(CR (PROG1 CRPENDING (SETQ CRPENDING T)))
(LF (COND
(CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL))
(* Have the typescript put turn crlf into whatever it
likes for eol)
(SETQ CRPENDING NIL))
(T T)))
(PROGN (COND
(CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR))
(SETQ CRPENDING NIL)))
T))
(\BOUT TYPESCRIPTSTREAM CH)))))
(COND
(CHATDEBUGFLG (COND
((OR (EQ CHATDEBUGFLG T)
(IGREATERP (add CNT 1)
CHATDEBUGFLG))
(BLOCK)
(SETQ CNT 1)))))
finally (SELECTQ CH
(-1 (COND
((ACTIVEWP OUTSTREAM)
(printout OUTSTREAM T "[Connection closed by remote host]" T)))
(replace (CHAT.STATE RUNNING?) of CHAT.STATE with (QUOTE CLOSE)))
(-2 (COND
((ACTIVEWP OUTSTREAM)
(printout OUTSTREAM T "[Connection aborted by remote host]" T)))
(replace (CHAT.STATE RUNNING?) of CHAT.STATE with (QUOTE ABORT)))
(PROGN (COND
((ACTIVEWP OUTSTREAM)
(printout OUTSTREAM T
"[Connection closed by remote host in unknown way]"
T)))
(replace (CHAT.STATE RUNNING?) of CHAT.STATE with (QUOTE CLOSE))))
(COND
((NOT (ACTIVEWP WINDOW))
(DEL.PROCESS (WINDOWPROP WINDOW (QUOTE PROCESS))))))))
(CHAT.DID.RESHAPE
[LAMBDA (CHAT.STATE)
(DECLARE (USEDFREE INSTREAM DSP)) (* ejs: "12-May-85 15:23")
(* Invoked in the type-out process when window is
reshaped)
(with CHAT.STATE CHAT.STATE (CHAT.SCREENPARAMS CHAT.STATE INSTREAM DSP)
(TERM.RESET.DISPLAY.PARMS CHAT.STATE])
(CHAT.SCREENPARAMS
[LAMBDA (CHAT.STATE INSTREAM WINDOW) (* ejs: "12-May-85 15:51")
(* * Sends screen width, height to partner and updates title. If INSTREAM is NIL then only update title.)
(PROG ((HEIGHT (IMIN [IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT))
(IABS (DSPLINEFEED NIL (WINDOWPROP WINDOW (QUOTE DSP]
127))
(WIDTH (IMIN (LINELENGTH NIL WINDOW)
127))
(TITLE (WINDOWPROP WINDOW (QUOTE TITLE)))
EMACSMODE TITLEMIDDLE)
(COND
(INSTREAM (CHAT.SENDSCREENPARAMS INSTREAM HEIGHT WIDTH)))
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (SUBSTRING TITLE 1 (SUB1 (OR (SETQ TITLEMIDDLE (STRPOS ", height" TITLE)
)
0)))
", height = " HEIGHT ", width = " WIDTH
(COND
[[OR (SETQ EMACSMODE (fetch (CHAT.STATE CHATINEMACS) of CHAT.STATE))
(AND TITLEMIDDLE (NOT (FIXP (NTHCHAR TITLE -1]
(CONCAT ", Emacs " (COND
(EMACSMODE "ON")
(T "OFF"]
(T ""])
)
(* window stuff)
(DEFINEQ
(GETCHATWINDOW
[LAMBDA (HOST WINDOW DPYTYPE) (* ejs: "12-May-85 15:52")
(* Return a window, possibly new, to run a chat
connection to HOST. Uses WINDOW if possible)
(PROG ((TITLE (CONCAT (L-CASE DPYTYPE T)
" Chat connection to " HOST))
DSP STATE)
[COND
[[AND (WINDOWP (OR WINDOW (SETQ WINDOW CHATWINDOW)))
(OR [NOT (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(COND
((NOT (fetch (CHAT.STATE RUNNING?) of STATE))
(* Connection in CHATWINDOW is dead)
(CHAT.CLOSE WINDOW NIL T)
T] (* Old window not in use. This shouldn't happen,
but...)
(WINDOWPROP WINDOW (QUOTE TITLE)
TITLE)
(SETQ DSP (WINDOWPROP WINDOW (QUOTE DSP]
(T (SETQ DSP (WINDOWPROP (SETQ WINDOW (CREATEW NIL TITLE))
(QUOTE DSP)))
(DSPSCROLL T DSP)
(OR CHATWINDOW (SETQ CHATWINDOW WINDOW]
(push CHATWINDOWLST WINDOW)
(RETURN WINDOW])
(CHAT.BUTTONFN
[LAMBDA (WINDOW) (* ejs: "12-May-85 17:59")
(COND
[(LASTMOUSESTATE LEFT)
(PROG (CHAT.STATE CHAT.PROC)
(COND
((AND (SETQ CHAT.STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(fetch (CHAT.STATE CHATINEMACS) of CHAT.STATE)
(SETQ CHAT.PROC (fetch (CHAT.STATE TYPEOUTPROC) of CHAT.STATE)))
(PROCESS.APPLY CHAT.PROC (FUNCTION CHAT.EMACS.MOVE)
(LIST CHAT.STATE)))
(T (CHAT.HOLD WINDOW]
((LASTMOUSESTATE MIDDLE)
(CHAT.MENU WINDOW])
(CHAT.HOLD
[LAMBDA (WINDOW) (* ejs: "12-May-85 16:33")
(* * Toggle HOLD while button is down)
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(TOTOPW WINDOW)
(OR STATE (RETURN))
[COND
((NOT (fetch (CHAT.STATE HELD) of STATE))
(replace (CHAT.STATE HELD) of STATE with T)
(UNINTERRUPTABLY
(UNTILMOUSESTATE UP))]
(replace (CHAT.STATE HELD) of STATE with NIL])
(CHAT.ICONFN
[LAMBDA (WINDOW) (* ejs: " 5-Mar-85 18:47")
(DECLARE (GLOBALVARS TTYKBDICONSPEC TTYKBD TTYKBDMASK TTYKBDICONSPECREGION))
(COND
((TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(TTY.PROCESS T)))
(COND
((FNTYP (QUOTE TITLEDICONW))
(OR (WINDOWPROP WINDOW (QUOTE ICONWINDOW))
(TITLEDICONW (OR TTYKBDICONSPEC
(SETQ TTYKBDICONSPEC
(create TITLEDICON
ICON ← TTYKBD
MASK ← TTYKBDMASK
TITLEREG ← TTYKBDICONSPECREGION)))
(CAR (WINDOWPROP WINDOW (QUOTE CHATHOST)))
(FONTCREATE (QUOTE HELVETICA)
8)
NIL NIL (QUOTE TOP])
(CHAT.MENU
[LAMBDA (WINDOW) (* ejs: "12-May-85 16:02")
(DECLARE (GLOBALVARS CHATMENU CHAT.REOPENMENU)
(SPECVARS WINDOW STATE)) (* Called by MIDDLE)
(PROG ((STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
COMMAND)
[COND
((NOT STATE) (* No Connection here; try to reestablish)
(RETURN (COND
((LASTMOUSESTATE MIDDLE)
(CHAT.RECONNECT WINDOW))
(T (TOTOPW WINDOW]
(replace (CHAT.STATE HELD) of STATE with T)
(\CHECKCARET WINDOW)
(SELECTQ [SETQ COMMAND (MENU (OR CHATMENU (SETQ CHATMENU (create MENU
ITEMS ← CHATMENUITEMS]
(Close (replace (CHAT.STATE RUNNING?) of STATE with (QUOTE CLOSE))
(* Ask CHAT.TYPEIN to shut things down.)
)
(New (replace (CHAT.STATE RUNNING?) of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
(QUOTE NEW)))
(Suspend (replace (CHAT.STATE RUNNING?) of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
T))
(Freeze (* Leave in HELD state)
(RETURN))
(NIL)
(APPLY* COMMAND STATE WINDOW))
(replace (CHAT.STATE HELD) of STATE with NIL])
(CHAT.CLEAR.FROM.MENU
[LAMBDA (STATE WINDOW) (* AJB "24-May-85 17:42")
(DSPRESET WINDOW)
(TERM.RESET.DISPLAY.PARMS STATE)
(TERM.HOME STATE])
(CHAT.TAKE.INPUT
[LAMBDA (STATE WINDOW) (* bvm: " 1-Jun-84 17:43")
(PROCESS.APPLY (WINDOWPROP WINDOW (QUOTE PROCESS))
(FUNCTION CHAT.TAKE.INPUT1)
(LIST WINDOW])
(CHAT.TAKE.INPUT1
[LAMBDA (WINDOW) (* ejs: " 3-Apr-85 15:37")
(DECLARE (USEDFREE STREAM)) (* In CHAT.TYPEIN)
(PROG ((PWINDOW (GETPROMPTWINDOW WINDOW))
FILE)
(CLEARW PWINDOW)
(COND
((AND STREAM (NEQ STREAM T))
(printout PWINDOW "Can't, still reading " (FULLNAME STREAM)))
(T (SETQ FILE (PROMPTFORWORD "Take input from file (cr to return): " NIL NIL PWINDOW))
(COND
((NULL FILE)
(CLEARW PWINDOW))
[[SETQ FILE (CAR (PROG1 (NLSETQ (OPENSTREAM (MKATOM FILE)
(QUOTE INPUT)))
(CLEARW PWINDOW]
(printout PWINDOW "Reading " (FULLNAME (SETQ STREAM FILE]
(T (printout PWINDOW (ERRORSTRING (CAR (ERRORN)))
" - "
(CADR (ERRORN])
(DO.CHAT.OPTION
[LAMBDA (CHAT.STATE WINDOW) (* ejs: "12-May-85 15:52")
(* * Pop up a menu of protocol specific options.)
(PROG [(MENU (CHAT.OPTIONMENU (fetch (CHAT.STATE INSTREAM) of CHAT.STATE]
(COND
(MENU (MENU MENU))
(T (printout PROMPTWINDOW "This protocol has no options."])
(CHAT.RECONNECT
[LAMBDA (WINDOW) (* bvm: "22-Apr-84 22:30")
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE CHATHOST]
(COND
((NULL STATE)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE TOTOPW))
(TOTOPW WINDOW))
((NOT (LASTMOUSESTATE MIDDLE))
(TOTOPW WINDOW))
([MENU (OR CHAT.REOPENMENU (SETQ CHAT.REOPENMENU (create MENU
ITEMS ←(QUOTE ((ReConnect T
"Will reestablish this Chat connection"]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE TOTOPW)) (* Don't let this command get issued twice)
(TTY.PROCESS (ADD.PROCESS (LIST (QUOTE CHAT)
(KWOTE (CAR STATE))
(KWOTE (CDR STATE))
NIL WINDOW T])
(CHAT.RESHAPEWINDOW
(LAMBDA (WINDOW OLDIMAGE IMAGEREGION OLDSCREENREGION) (* ejs: "14-Jun-85 15:08")
(* RESHAPEFN for the chat window)
(RESHAPEBYREPAINTFN WINDOW OLDIMAGE IMAGEREGION)
(* Note: Don't pass OLDSCREENREGION to RESHAPEBYREPAINTFN or it may try to leave the image fixed and move the
coordinate system. Our code assumes that the bottom of the window is zero. If someone gets ambitious, can figure out
how to change the rest of Chat code so it does not make that assumption)
(LET* ((CHAT.STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(CHAT.PROC (AND CHAT.STATE (fetch (CHAT.STATE TYPEOUTPROC) of CHAT.STATE))))
(COND
((AND (PROCESSP CHAT.PROC)
(NOT (RELPROCESSP CHAT.PROC)))
(PROCESS.APPLY CHAT.PROC (FUNCTION CHAT.DID.RESHAPE)
(LIST CHAT.STATE)))))))
(CHAT.TTYENTRYFN
[LAMBDA (PROCESS) (* ejs: "12-May-85 16:33")
(* Switch to a chat window)
(DECLARE (GLOBALVARS CHAT.INTERRUPTS))
(PROG ((WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW)))
STATE INTERRUPTS)
(COND
([AND WINDOW (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(replace (CHAT.STATE HELD) of STATE with NIL)))
[SETQ INTERRUPTS (for PAIR in (CURRENTINTERRUPTS) collect (INTERRUPTCHAR (CAR PAIR]
(* Turn everything off, then turn selected interrupts
back on)
(PROCESSPROP PROCESS (QUOTE CHAT.INTERRUPTS)
(NCONC (MAPCAR CHAT.INTERRUPTS (FUNCTION INTERRUPTCHAR))
INTERRUPTS))
(PROCESSPROP PROCESS (QUOTE CHAT.KEYACTIONS)
(for PAIR in CHAT.KEYACTIONS collect (CONS (CAR PAIR)
(KEYACTION (CAR PAIR)
(CDR PAIR])
(CHAT.TTYEXITFN
[LAMBDA (PROCESS NEWPROCESS) (* bvm: "12-Jul-84 17:36")
(MAPC (PROCESSPROP PROCESS (QUOTE CHAT.INTERRUPTS)
NIL)
(FUNCTION INTERRUPTCHAR))
(for PAIR in (PROCESSPROP PROCESS (QUOTE CHAT.KEYACTIONS)
NIL)
do (KEYACTION (CAR PAIR)
(CDR PAIR])
(CHAT.TYPESCRIPT
[LAMBDA (STATE) (* ejs: "12-May-85 16:08")
(PROG ((PROC (fetch (CHAT.STATE TYPEOUTPROC) of STATE)))
(COND
(PROC (PROCESS.APPLY PROC (FUNCTION CHAT.TYPESCRIPT1)
(LIST STATE])
(CHAT.TYPESCRIPT1
[LAMBDA (CHAT.STATE) (* AJB "24-May-85 15:16")
(* Called in context of type-out proc to change the
dribble file)
(with CHAT.STATE CHAT.STATE (PROG ((PWINDOW (GETPROMPTWINDOW WINDOW))
FILE OLDFILE)
(CLEARW PWINDOW)
(COND
((NEQ (SETQ FILE (MKATOM (PROMPTFORWORD
"Typescript to file (cr to close): "
NIL NIL PWINDOW)))
T)
(CLEARW PWINDOW)
(COND
[[OR (NULL FILE)
(NLSETQ (SETQ FILE (OPENSTREAM FILE (QUOTE OUTPUT)
(QUOTE NEW]
(COND
(TYPESCRIPTSTREAM (printout PWINDOW (CLOSEF
TYPESCRIPTSTREAM)
" closed. ")))
(replace TYPESCRIPTSTREAM of CHAT.STATE
with (SETQ TYPESCRIPTSTREAM FILE))
(AND FILE (printout PWINDOW "Opened " (FULLNAME FILE]
(T (printout PWINDOW "Could not open " FILE])
)
(* for dialouts)
(DEFINEQ
(CHAT.CHOOSE.PHONE.NUMBER
(LAMBDA NIL (* ejs: "12-Jun-85 18:30")
(* Prompt user for phone number)
(DECLARE (GLOBALVARS CHAT.PHONE.NUMBER.MENU CHAT.PHONE.NUMBERS))
(COND
((IGREATERP (LENGTH CHAT.PHONE.NUMBERS)
(CONSTANT (LENGTH (QUOTE (Other)))))
(OR CHAT.PHONE.NUMBER.MENU (SETQ CHAT.PHONE.NUMBER.MENU
(create MENU
ITEMS ← CHAT.PHONE.NUMBERS
TITLE ← "Phone Number ")))))
(LET ((NUMBER (COND
(CHAT.PHONE.NUMBER.MENU (MENU CHAT.PHONE.NUMBER.MENU))
(T (QUOTE Other))))
NEWNUMBER)
(COND
((EQ NUMBER (QUOTE Other))
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(SETQ NUMBER (PROMPTFORWORD
"Please enter a phone number in the form (800)555-1212: ")))
(push CHAT.PHONE.NUMBERS (LIST NUMBER (SETQ NEWNUMBER
(LET* ((LIST (for CHAR in (CHCON NUMBER) collect CHAR
when (AND (IGEQ CHAR (CHARCODE 0))
(ILEQ CHAR (CHARCODE 9)))))
(STRING (ALLOCSTRING (LENGTH LIST))))
(for I from 1 to (NCHARS STRING) as C in LIST
do (RPLCHARCODE STRING I C))
STRING))))
(SETQ CHAT.PHONE.NUMBER.MENU NIL)
NEWNUMBER)
(T NUMBER)))))
)
(RPAQ? CHAT.PHONE.NUMBER.MENU )
(RPAQ? CHAT.PHONE.NUMBERS (QUOTE (Other)))
(* for EMACS)
(DEFINEQ
(CHAT.EMACS.MOVE
[LAMBDA (CHAT.STATE) (* ejs: "12-May-85 15:44")
(* * This function is invoked in the context of the typeout process, so that we can easily see where we are on the
display, and so that we don't hang up the mouse if connection gets in trouble)
(with CHAT.STATE CHAT.STATE (PROG ((CLOC (CURSORPOSITION NIL WINDOW))
DROW CCOLUMN)
(* * The characters are FONTHEIGHT high by FONTWIDTH wide)
[COND
((IGEQ XPOS FONTWIDTH)
(* Go back to column 0)
(BOUT OUTSTREAM (fetch EMCOL0 of CHAT.EMACSCOMMANDS]
(SETQ DROW (IDIFFERENCE (IQUOTIENT YPOS FONTHEIGHT)
(IQUOTIENT (fetch YCOORD of CLOC)
FONTHEIGHT)))
(* * Positive DROW means go DOWN)
[COND
((ILESSP DROW 0) (* Go up DROW rows)
(COND
((NEQ DROW -1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING (IMINUS DROW))
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMUP of CHAT.EMACSCOMMANDS)))
((IGREATERP DROW 0)
(* Go down DROW rows)
(COND
((NEQ DROW 1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING DROW)
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMDOWN of CHAT.EMACSCOMMANDS]
(SETQ CCOLUMN (IQUOTIENT (fetch XCOORD of CLOC)
FONTWIDTH))
[COND
((IGREATERP CCOLUMN 0)
(* Now go to the correct column)
(COND
((NEQ CCOLUMN 1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING CCOLUMN)
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMFORWARD of CHAT.EMACSCOMMANDS]
(FORCEOUTPUT OUTSTREAM])
(CHAT.SWITCH.EMACS
[LAMBDA (CHATSTATE WINDOW) (* ejs: "12-May-85 17:05")
(* * Toggles the value of CHAT.IN.EMACS?)
(replace (CHAT.STATE CHATINEMACS) of CHATSTATE with (NOT (fetch (CHAT.STATE CHATINEMACS)
of CHATSTATE)))
(* Now update title to show Emacs state)
(CHAT.SCREENPARAMS CHATSTATE NIL WINDOW])
)
(RPAQ TTYKBD (READBITMAP))
(72 72
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@COOOOOOOOON@@@@@@"
"@@@GOOOOOOOOOO@@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@N@@@@@@@@@GH@@@@@"
"@@@N@@@@@@@@@CH@@@@@"
"@@@NCOOOOOOONCH@@@@@"
"@@@NGOOOOOOOOCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@NHHIO@CCH@@@@@"
"@@@NFA@HIDD@CCH@@@@@"
"@@@NFA@HIDD@CCH@@@@@"
"@@@NFA@OILD@CCH@@@@@"
"@@@NFA@HJBD@CCH@@@@@"
"@@@NFA@HJBD@CCH@@@@@"
"@@@NF@NHJBD@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NF@@@@@@@CCH@@@@@"
"@@@NGOOOOOOOOCH@@@@@"
"@@@NCOOOOOOONCH@@@@@"
"@@CN@@@@@@@@@CN@@@@@"
"@@GN@@@@@@@@@CO@@@@@"
"@@O@@@@@@@@@@@GH@@@@"
"@ANALNGCILNGCLCL@@@@"
"@CL@@@@@@@@@@@AN@@@@"
"@GHGCILNGCILNG@O@@@@"
"@O@@@@@@@@@@@@@GH@@@"
"ANAILNGCILNGCLNCL@@@"
"CL@@@@@@@@@@@@@AN@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@OOOOOOOOOOOOOOOH@@@"
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"CL@@@@@@@@@@@@@AN@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CH@@@@@@@@@@@@@@N@@@"
"CL@@@@@@@@@@@@@AN@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@OOOOOOOOOOOOOOOH@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@")
(RPAQ TTYKBDMASK (READBITMAP))
(72 72
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@COOOOOOOOON@@@@@@"
"@@@GOOOOOOOOOO@@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@@OOOOOOOOOOOH@@@@@"
"@@COOOOOOOOOOON@@@@@"
"@@GOOOOOOOOOOOO@@@@@"
"@@OOOOOOOOOOOOOH@@@@"
"@AOOOOOOOOOOOOOL@@@@"
"@COOOOOOOOOOOOON@@@@"
"@GOOOOOOOOOOOOOO@@@@"
"@OOOOOOOOOOOOOOOH@@@"
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@OOOOOOOOOOOOOOOH@@@"
"AOOOOOOOOOOOOOOOL@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"COOOOOOOOOOOOOOON@@@"
"AOOOOOOOOOOOOOOOL@@@"
"@OOOOOOOOOOOOOOOH@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@@@@@")
(RPAQ? CHAT.DISPLAYTYPES (QUOTE ((NIL 10 DM2500))))
(RPAQ? CHAT.DRIVERTYPES )
(RPAQ? CHAT.PROTOCOLTYPES )
(RPAQ? CHAT.EMULATORTYPE (QUOTE DM2500))
(RPAQ? CHAT.METACHAR 195)
(RPAQ? CHAT.CONTROLCHAR 193)
(RPAQ? CHAT.INTERRUPTS )
(RPAQ? CHAT.KEYACTIONS )
(RPAQ? DEFAULTCHATHOST )
(RPAQ? CHATDEBUGFLG )
(RPAQ? CHATWINDOW )
(RPAQ? CHATWINDOWLST )
(RPAQ? CHAT.AUTOCRLF T)
(RPAQ? CLOSECHATWINDOWFLG )
(RPAQ? CHAT.ALLHOSTS )
(RPAQ? CHAT.HOSTMENU )
(RPAQ? CHAT.FONT )
(RPAQ? CHAT.IN.EMACS? NIL)
(RPAQ? CHAT.EMACSCOMMANDS (QUOTE (21 16 14 6 1)))
(RPAQ? CHAT.WAIT.TIME 2000)
(RPAQ? TTYKBDICONSPEC )
(RPAQQ CHATMENU NIL)
(RPAQQ CHAT.REOPENMENU NIL)
(RPAQQ TTYKBDICONSPECREGION (6 10 58 18))
(RPAQQ CHATMENUITEMS ((Close (QUOTE Close)
"Closes the connection and returns")
(Suspend (QUOTE Suspend)
"Closes the connection but leaves window up")
(New (QUOTE New)
"Closes this connection and prompts for a new host")
(Freeze (QUOTE Freeze)
"Holds typeout in this window until you bug it again")
(Clear (FUNCTION CHAT.CLEAR.FROM.MENU)
"Clears window, sets roll mode")
("Dribble" (FUNCTION CHAT.TYPESCRIPT)
"Starts a typescript of window typeout")
("Input" (FUNCTION CHAT.TAKE.INPUT)
"Allows input from a file")
("Emacs" (FUNCTION CHAT.SWITCH.EMACS)
"Toggle EMACS positioning")
("Option" (FUNCTION DO.CHAT.OPTION)
"Do protocol specific option")))
(RPAQQ NETWORKLOGINFO ((TENEX (LOGIN "LOGIN " USERNAME " " PASSWORD "
")
(ATTACH "ATTACH " USERNAME " " PASSWORD "
")
(WHERE "WHERE " USERNAME CR "ATTACH " USERNAME " " PASSWORD CR))
(TOPS20 (LOGIN "LOGIN " USERNAME CR PASSWORD CR)
(ATTACH "ATTACH " USERNAME "" CR PASSWORD CR)
(WHERE "LOGIN " USERNAME CR PASSWORD CR))
(UNIX (LOGIN WAIT CR WAIT USERNAME CR WAIT PASSWORD CR))
(IFS (LOGIN "Login " USERNAME " " PASSWORD CR)
(ATTACH))
(NS (LOGIN "Logon" CR USERNAME CR PASSWORD CR))
(VMS (LOGIN USERNAME CR PASSWORD CR))))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(RPAQQ CHATDEFS ((RECORDS CHATUSERSTATE EMACSCOMMANDS)
(GLOBALVARS CHAT.ALLHOSTS CHAT.AUTOCRLF CHAT.CONTROLCHAR CHAT.DISPLAYTYPE CHAT.EMACSCOMMANDS
CHAT.FONT CHAT.HOSTMENU CHAT.INTERRUPTS CHAT.KEYACTIONS CHAT.METACHAR
CHAT.REOPENMENU CHAT.WAIT.TIME CHATDEBUGFLG CHATMARKTYPES CHATMENU CHATWINDOW
CHATWINDOWLST CLOSECHATWINDOWFLG DEFAULTCHATHOST INVERTWINDOWFN NETWORKLOGINFO
PUPTYPES \CURRENTINTERRUPTS CHATMENUITEMS CHAT.EMULATORTYPE CHAT.DRIVERTYPES)))
[DECLARE: EVAL@COMPILE
(RECORD CHATUSERSTATE (HELD RUNNING? INSTREAM OUTSTREAM CARETSTATE TYPESCRIPTOFD TYPEOUTPROC
CHATINEMACS))
(RECORD EMACSCOMMANDS (EMARG EMUP EMDOWN EMFORWARD EMCOL0))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CHAT.ALLHOSTS CHAT.AUTOCRLF CHAT.CONTROLCHAR CHAT.DISPLAYTYPE CHAT.EMACSCOMMANDS
CHAT.FONT CHAT.HOSTMENU CHAT.INTERRUPTS CHAT.KEYACTIONS CHAT.METACHAR CHAT.REOPENMENU
CHAT.WAIT.TIME CHATDEBUGFLG CHATMARKTYPES CHATMENU CHATWINDOW CHATWINDOWLST
CLOSECHATWINDOWFLG DEFAULTCHATHOST INVERTWINDOWFN NETWORKLOGINFO PUPTYPES
\CURRENTINTERRUPTS CHATMENUITEMS CHAT.EMULATORTYPE CHAT.DRIVERTYPES)
)
)
(RPAQ? INVERTWINDOWFN (QUOTE INVERTW))
(DEFINEQ
(\SPAWN.CHAT
[LAMBDA NIL (* bvm: "22-Apr-84 22:41")
(* From the Background Menu, runs CHAT as a process)
(AND (THIS.PROCESS)
(TTY.PROCESS (ADD.PROCESS (QUOTE (CHAT NIL NIL NIL NIL T])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BackgroundMenuCommands (CHAT (QUOTE (\SPAWN.CHAT))
"Runs a new CHAT process; prompts for host"))
(SETQ BackgroundMenu)
(FILESLOAD DMCHAT)
)
[DECLARE: EVAL@COMPILE
(DATATYPE CHAT.STATE ((HELD FLAG)
(CHATINEMACS FLAG)
(UNDERLINEMODE FLAG)
(ROLLMODE FLAG)
(NIL BITS 3)
(RUNNING? POINTER)
(WINDOW POINTER)
(DSP POINTER)
(OUTSTREAM POINTER)
(INSTREAM POINTER)
(TEXTSTREAM POINTER)
(TTYWIDTH WORD)
(TTYHEIGHT WORD)
(XPOS WORD)
(YPOS WORD)
(FONTWIDTH WORD)
(FONTHEIGHT WORD)
(FONTDESCENT WORD)
(TOPMARGIN WORD)
(BOTTOMMARGIN WORD)
CARETSTATE TYPEOUTPROC TERM.TAB.STOPS TERM.IDENTITY.STRING TERM.NORMAL.FONT
TERM.BOLD.FONT TERM.STATE FONT PLAINFONT CHATBOLDFONT HOMEPOS TYPESCRIPTSTREAM)
XPOS ← 0 YPOS ← 0 BOTTOMMARGIN ← 0 ROLLMODE ← T)
(RECORD CHATDISPLAYTYPE (HOST DPYCODE DPYNAME))
]
(/DECLAREDATATYPE (QUOTE CHAT.STATE)
(QUOTE (FLAG FLAG FLAG FLAG (BITS 3)
POINTER POINTER POINTER POINTER POINTER POINTER WORD WORD WORD WORD
WORD WORD WORD WORD WORD POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
(QUOTE ((CHAT.STATE 0 (FLAGBITS . 0))
(CHAT.STATE 0 (FLAGBITS . 16))
(CHAT.STATE 0 (FLAGBITS . 32))
(CHAT.STATE 0 (FLAGBITS . 48))
(CHAT.STATE 0 (BITS . 66))
(CHAT.STATE 0 POINTER)
(CHAT.STATE 2 POINTER)
(CHAT.STATE 4 POINTER)
(CHAT.STATE 6 POINTER)
(CHAT.STATE 8 POINTER)
(CHAT.STATE 10 POINTER)
(CHAT.STATE 12 (BITS . 15))
(CHAT.STATE 13 (BITS . 15))
(CHAT.STATE 14 (BITS . 15))
(CHAT.STATE 15 (BITS . 15))
(CHAT.STATE 16 (BITS . 15))
(CHAT.STATE 17 (BITS . 15))
(CHAT.STATE 18 (BITS . 15))
(CHAT.STATE 19 (BITS . 15))
(CHAT.STATE 20 (BITS . 15))
(CHAT.STATE 22 POINTER)
(CHAT.STATE 24 POINTER)
(CHAT.STATE 26 POINTER)
(CHAT.STATE 28 POINTER)
(CHAT.STATE 30 POINTER)
(CHAT.STATE 32 POINTER)
(CHAT.STATE 34 POINTER)
(CHAT.STATE 36 POINTER)
(CHAT.STATE 38 POINTER)
(CHAT.STATE 40 POINTER)
(CHAT.STATE 42 POINTER)
(CHAT.STATE 44 POINTER)))
(QUOTE 46))
(PUTPROPS CHAT COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2482 19034 (CHAT 2492 . 5248) (CHAT.CHOOSE.EMULATOR 5250 . 5864) (CHAT.INIT 5866 . 7786
) (FIND.CHAT.PROTOCOL 7788 . 8240) (CHAT.TYPEIN 8242 . 12913) (CHAT.BIN 12915 . 13199) (CHAT.CLOSE
13201 . 16402) (CHAT.CLOSEFN 16404 . 16675) (CHAT.CLOSE.CONNECTION 16677 . 16982) (CHAT.LOGIN 16984 .
19032)) (19060 21679 (ADD.CHAT.MESSAGE 19070 . 19292) (CHAT.LOGINFO 19294 . 19599) (
CHAT.SENDSCREENPARAMS 19601 . 19945) (CHAT.SETDISPLAYTYPE 19947 . 20294) (CHAT.LOGINFO 20296 . 20601)
(CHAT.FLUSH&WAIT 20603 . 20907) (CHAT.ENDOFSTREAMOP 20909 . 21285) (CHAT.OPTIONMENU 21287 . 21677)) (
21705 26573 (CHAT.TYPEOUT 21715 . 25123) (CHAT.DID.RESHAPE 25125 . 25533) (CHAT.SCREENPARAMS 25535 .
26571)) (26599 37122 (GETCHATWINDOW 26609 . 27781) (CHAT.BUTTONFN 27783 . 28348) (CHAT.HOLD 28350 .
28891) (CHAT.ICONFN 28893 . 29579) (CHAT.MENU 29581 . 31014) (CHAT.CLEAR.FROM.MENU 31016 . 31214) (
CHAT.TAKE.INPUT 31216 . 31436) (CHAT.TAKE.INPUT1 31438 . 32254) (DO.CHAT.OPTION 32256 . 32629) (
CHAT.RECONNECT 32631 . 33423) (CHAT.RESHAPEWINDOW 33425 . 34388) (CHAT.TTYENTRYFN 34390 . 35453) (
CHAT.TTYEXITFN 35455 . 35803) (CHAT.TYPESCRIPT 35805 . 36080) (CHAT.TYPESCRIPT1 36082 . 37120)) (37148
38629 (CHAT.CHOOSE.PHONE.NUMBER 37158 . 38627)) (38737 41288 (CHAT.EMACS.MOVE 38747 . 40818) (
CHAT.SWITCH.EMACS 40820 . 41286)) (48176 48503 (\SPAWN.CHAT 48186 . 48501)))))
STOP