(FILECREATED " 5-Oct-84 18:06:17" {ERIS}<LISPCORE>SOURCES>CHAT.;12 50914
changes to: (FNS CHAT.TYPEIN CHAT FIND.CHAT.PROTOCOL CHAT.RESHAPEWINDOW)
previous date: "25-Sep-84 16:32:15" {ERIS}<LISPCORE>SOURCES>CHAT.;11)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHATCOMS)
(RPAQQ CHATCOMS [(COMS (* CHAT typein)
(FNS CHAT 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 and DM simulation)
(FNS CHAT.TYPEOUT CHAT.RESET.DISPLAY.PARMS CHAT.DID.RESHAPE DMCHAT.HANDLECHARACTER
CHAT.SCREENPARAMS CHAT.ADDCHAR CHAT.ADDLINE DMCHAT.ADDRESS CHAT.CLEAR
CHAT.CLEARMODES CHAT.DELCHAR CHAT.DELETELINE CHAT.DOWN CHAT.ERASE.TO.EOL
CHAT.ERASEBITS CHAT.HOME CHAT.LEFT DMCHAT.NEWLINE DMCHAT.PRINTCHAR DMCHAT.RIGHT
CHAT.UP))
(COMS (* window stuff)
(FNS GETCHATWINDOW CHAT.BUTTONFN CHAT.HOLD 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 EMACS)
(FNS CHAT.EMACS.MOVE CHAT.SWITCH.EMACS))
(ADDVARS (CHAT.DRIVERTYPES (DM2500 . DMCHAT.HANDLECHARACTER)))
(INITVARS (CHAT.EMULATORTYPE (QUOTE DM2500))
(CHAT.DISPLAYTYPE 10)
(CHAT.METACHAR 195)
(CHAT.CONTROLCHAR 193)
(CHAT.INTERRUPTS)
(CHAT.KEYACTIONS)
(DEFAULTCHATHOST)
(CHATDEBUGFLG)
(CHATWINDOWLST)
(CHATWINDOW)
(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)
(CHAT.PROTOCOLS))
(VARS (CHATMENU)
(CHAT.REOPENMENU)
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))
(FILES BSP])
(* CHAT typein)
(DEFINEQ
(CHAT
[LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* bvm: " 5-Oct-84 14:51")
[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)
[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]
(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 WINDOW (GETCHATWINDOW HOST WINDOW))
(CHAT.INIT STREAMS WINDOW HOST)
(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.INIT
[LAMBDA (STREAMS WINDOW HOST) (* rda: "24-Aug-84 22:54")
(PROG ((INSTREAM (CAR STREAMS)))
(WINDOWPROP WINDOW (QUOTE CHATSTATE)
(create CHATUSERSTATE
RUNNING? ← T
CHATINEMACS ← CHAT.IN.EMACS?
INSTREAM ← INSTREAM
OUTSTREAM ←(CDR STREAMS)))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION CHAT.RESHAPEWINDOW))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.BUTTONFN))
(WINDOWADDPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION CHAT.CLOSEFN))
(STREAMPROP INSTREAM (QUOTE OLDEOSOP)
(fetch ENDOFSTREAMOP of INSTREAM))
(replace ENDOFSTREAMOP of INSTREAM with (FUNCTION CHAT.ENDOFSTREAMOP])
(FIND.CHAT.PROTOCOL
[LAMBDA (NAME) (* bvm: " 5-Oct-84 14:50")
(* * 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 FN in CHAT.PROTOCOLS bind RESULT when (SETQ RESULT (APPLY* FN NAME)) do (RETURN RESULT])
(CHAT.TYPEIN
[LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* bvm: " 5-Oct-84 14:41")
(DECLARE (SPECVARS STREAM)) (* so that menu can change it)
(PROG ((THISPROC (THIS.PROCESS))
(DEFAULTSTREAM T)
(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
CHATSTREAM WINDOWSTREAM STREAM CH DPYCODE DPYNAME X)
(SETQ CHATSTREAM (fetch (CHATUSERSTATE OUTSTREAM) 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 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
((FIXP (SETQ DPYCODE CHAT.DISPLAYTYPE)) (* Old way, one numeric code for display)
)
((AND (LISTP DPYCODE)
(OR (SETQ X (ASSOC HOST DPYCODE))
(ASSOC NIL DPYCODE)))
(SETQ DPYNAME (CADDR X))
(SETQ DPYCODE (CADR X)))
(T (SETQ DPYCODE NIL)))
[replace TYPEOUTPROC of STATE with (ADD.PROCESS (LIST (QUOTE CHAT.TYPEOUT)
WINDOW
(KWOTE DPYNAME]
(CHAT.SCREENPARAMS (fetch (CHATUSERSTATE INSTREAM) of STATE)
WINDOW)
(COND
(DPYCODE (CHAT.SETDISPLAYTYPE (fetch (CHATUSERSTATE INSTREAM) of STATE)
DPYCODE)))
(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 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 X (GETPROMPTWINDOW WINDOW NIL NIL T))
(* Indicate completion of Input if came from menu
command)
(CLEARW X]
(\TTYBACKGROUND))
(* * Get here if we close connection.)
[SELECTQ (fetch RUNNING? of STATE)
(CLOSE (CHAT.CLOSE WINDOW))
(ABORT (CHAT.CLOSE WINDOW T))
(NIL (* Already dead.))
(SHOULDNT (CONCAT "Unknown state in CHAT: " (fetch 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) (* rda: "27-Aug-84 01:12")
(* Close chat connection that is using WINDOW.
Also serves as the CLOSEFN of this window, when CLOSING
is NIL)
(PROG ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
PROC FILE KEEP)
(DETACHALLWINDOWS WINDOW)
(COND
[CHATSTATE (DEL.PROCESS (fetch TYPEOUTPROC of CHATSTATE))
(COND
((SETQ FILE (fetch TYPESCRIPTOFD of CHATSTATE))
(TERPRI WINDOW)
(PRIN1 "Closing " WINDOW)
(PRINT (CLOSEF FILE)
WINDOW)))
(\CHECKCARET WINDOW)
(replace RUNNING? of (WINDOWPROP WINDOW (QUOTE CHATSTATE)
NIL)
with NIL)
(OR ABORTED (CHAT.CLOSE.CONNECTION (fetch (CHATUSERSTATE INSTREAM)
of CHATSTATE)
(fetch (CHATUSERSTATE 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)
(WINDOWDELPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION CHAT.CLOSEFN))
(PROG [(TITLE (WINDOWPROP WINDOW (QUOTE TITLE]
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (SUBSTRING TITLE 1 (IPLUS (OR (STRPOS ", height" TITLE)
0)
-1))
", closed"))) (* Change title to indicate closure)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT))
(if (AND (NOT (SETQ KEEP (WINDOWPROP WINDOW (QUOTE KEEPCHAT)
NIL)))
(NOT CLOSING)
(OR CLOSECHATWINDOWFLG (NEQ WINDOW CHATWINDOW)))
then (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])
(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.)
(if (OPENP INSTREAM)
then (CLOSEF INSTREAM))
(if (OPENP OUTSTREAM)
then (CLOSEF OUTSTREAM])
(CHAT.LOGIN
[LAMBDA (HOST OPTION WINDOW CHATSTATE) (* rda: "27-Aug-84 01:12")
(* * 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 (CHATUSERSTATE 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 (CHATUSERSTATE OUTSTREAM) of STATE))
(for X in (CDR LOGINFO) do (SELECTQ X
(CR (BOUT OUTSTREAM (CHARCODE CR))
(FORCEOUTPUT OUTSTREAM))
(USERNAME (PRIN3 (CAR NAME/PASS)
OUTSTREAM))
(PASSWORD (PRIN3 (\DECRYPT.PWD (CDR NAME/PASS))
OUTSTREAM))
(WAIT (* Some systems do not permit typeahead)
(if (NOT (CHAT.FLUSH&WAIT INSTREAM))
then
(* 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 (if (FNTYP FN)
then (APPLY* FN HOST NAME])
(CHAT.SENDSCREENPARAMS
[LAMBDA (INSTREAM HEIGHT WIDTH) (* rda: "22-Aug-84 16:56")
(* * Invoke the SENDSCREENPARAMS method for INSTREAM, if any.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE SENDSCREENPARAMS]
(RETURN (if (FNTYP FN)
then (APPLY* FN INSTREAM HEIGHT WIDTH])
(CHAT.SETDISPLAYTYPE
[LAMBDA (INSTREAM CODE) (* rda: "24-Aug-84 11:09")
(* * Invoke the SETDISPLAYTYPE method for INSTREAM.)
(OR (NUMBERP CODE)
(ERROR "Non-numeric arg: " CODE))
(PROG [(FN (STREAMPROP INSTREAM (QUOTE SETDISPLAYTYPE]
(RETURN (if (FNTYP FN)
then (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 (if (FNTYP FN)
then (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 (if (FNTYP FN)
then (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) (* rda: "31-Aug-84 16:33")
(* * Apply the menu-building method for INSTREAM, if any.)
(PROG [(FN (STREAMPROP INSTREAM (QUOTE OPTIONMENU]
(RETURN (if (FNTYP FN)
then (APPLY* FN INSTREAM])
)
(* CHAT typeout and DM simulation)
(DEFINEQ
(CHAT.TYPEOUT
[LAMBDA (WINDOW DPYTYPE) (* rda: "27-Aug-84 01:07")
(DECLARE (SPECVARS WINDOW DSP OUTSTREAM INSTREAM DINGED EATLF EATCRLF EATTOCRLF AUTOLF TTYWIDTH
TTYHEIGHT XPOS YPOS ADDRESSING IDMODE ROLLMODE BLINKMODE FONTWIDTH FONTHEIGHT
FONTDESCENT FONT PLAINFONT CHATBOLDFONT HOMEPOS TYPESCRIPTSTREAM))
(bind (XPOS ← 0)
(YPOS ← 0)
(CNT ← 1)
(HANDLECHARFN ←(OR (CDR (ASSOC (OR DPYTYPE CHAT.EMULATORTYPE)
CHAT.DRIVERTYPES))
(FUNCTION DMCHAT.HANDLECHARACTER)))
(STATE ←(WINDOWPROP WINDOW (QUOTE CHATSTATE)))
MSG HOMEPOS INSTREAM OUTSTREAM DSP TTYWIDTH TTYHEIGHT DINGED CH ADDRESSING IDMODE
TYPESCRIPTSTREAM BLINKMODE EATLF EATCRLF EATTOCRLF AUTOLF FONT CHATBOLDFONT PLAINFONT
FONTWIDTH FONTHEIGHT FONTDESCENT CRPENDING (ROLLMODE ← T)
first (SETQ DSP (WINDOWPROP WINDOW (QUOTE DSP)))
(SETQ INSTREAM (fetch (CHATUSERSTATE INSTREAM) of STATE))
(SETQ OUTSTREAM (\GETSTREAM WINDOW (QUOTE OUTPUT)))
(CHAT.RESET.DISPLAY.PARMS)
(CHAT.HOME)
while (IGEQ (SETQ CH (\BIN INSTREAM))
0)
do (while (fetch HELD of STATE) do (BLOCK))
(\CHECKCARET OUTSTREAM)
(if (SETQ MSG (STREAMPROP INSTREAM (QUOTE MESSAGE)))
then (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)
(if TYPESCRIPTSTREAM
then (if (SELCHARQ CH
(CR (PROG1 CRPENDING (SETQ CRPENDING T)))
(LF (if CRPENDING
then (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL))
(* Have the typescript put turn crlf into whatever it
likes for eol)
(SETQ CRPENDING NIL)
else T))
(PROGN (if CRPENDING
then (\BOUT TYPESCRIPTSTREAM (CHARCODE CR))
(SETQ CRPENDING NIL))
T))
then (\BOUT TYPESCRIPTSTREAM CH)))
[COND
(CHATDEBUGFLG (COND
((OR (EQ CHATDEBUGFLG T)
(IGREATERP (add CNT 1)
CHATDEBUGFLG))
(BLOCK)
(SETQ CNT 1]
finally (SELECTQ CH
(-1 (printout OUTSTREAM T "[Connection closed by remote host]" T)
(replace RUNNING? of STATE with (QUOTE CLOSE)))
(-2 (printout OUTSTREAM T "[Connection aborted by remote host]" T)
(replace RUNNING? of STATE with (QUOTE ABORT)))
(PROGN (printout OUTSTREAM T
"[Connection closed by remote host in unknown way]"
T)
(replace RUNNING? of STATE with (QUOTE CLOSE])
(CHAT.RESET.DISPLAY.PARMS
[LAMBDA NIL
(DECLARE (USEDFREE (DSP WINDOW COM FONTHEIGHT FONTWIDTH PLAINFONT FONT FONTDESCENT TTYWIDTH
TTYHEIGHT HOMEPOS))) (* bvm: " 2-Jun-84 15:31")
(* Reset state)
(SETQ FONTHEIGHT (IMINUS (DSPLINEFEED NIL DSP)))
[SETQ FONTWIDTH (CHARWIDTH (CHARCODE A)
(SETQ PLAINFONT (SETQ FONT (DSPFONT NIL DSP]
(SETQ FONTDESCENT (FONTPROP FONT (QUOTE DESCENT)))
(SETQ TTYWIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
(SETQ TTYWIDTH (ITIMES (IQUOTIENT TTYWIDTH FONTWIDTH)
FONTWIDTH)) (* Make TTYWIDTH multiple of FONTWIDTH)
(SETQ TTYHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(SETQ HOMEPOS (IPLUS (ITIMES (SUB1 (IQUOTIENT TTYHEIGHT FONTHEIGHT))
FONTHEIGHT)
FONTDESCENT])
(CHAT.DID.RESHAPE
[LAMBDA NIL
(DECLARE (USEDFREE INSTREAM DSP)) (* rda: "22-Aug-84 16:40")
(* Invoked in the type-out process when window is
reshaped)
(CHAT.SCREENPARAMS INSTREAM DSP)
(CHAT.RESET.DISPLAY.PARMS])
(DMCHAT.HANDLECHARACTER
[LAMBDA (CHAR) (* bvm: " 2-Jun-84 15:07")
(DECLARE (USEDFREE WINDOW DSP OUTSTREAM DINGED EATLF EATCRLF EATTOCRLF AUTOLF TTYWIDTH TTYHEIGHT
XPOS YPOS ADDRESSING IDMODE ROLLMODE BLINKMODE FONT PLAINFONT CHATBOLDFONT
FONTWIDTH FONTHEIGHT FONTDESCENT HOMEPOS))
(* Here and/or below)
(PROG NIL
[COND
((EQ CHAR (CHARCODE BELL))
(RETURN (COND
((NOT DINGED)
(APPLY* INVERTWINDOWFN WINDOW) (* Complement window)
(SETQ DINGED T]
(COND
(DINGED (APPLY* INVERTWINDOWFN WINDOW)
(SETQ DINGED NIL)))
(COND
((AND AUTOLF (OR (NEQ CHAR (CHARCODE CR))
(NOT EATTOCRLF)))
(* We last received a CR, so DM wants auto LF after it. However, we postpone doing so until the next char is
received, so that we get scroll holding right)
(CHAT.DOWN)
(SETQ AUTOLF NIL)))
[COND
(ADDRESSING (COND
((DMCHAT.ADDRESS CHAR)
(RETURN]
[COND
((AND (IGEQ CHAR (CHARCODE SPACE))
(ILESSP CHAR (CHARCODE DEL))) (* Normal char)
(SETQ EATLF (SETQ EATCRLF NIL))
(RETURN (COND
((NOT EATTOCRLF) (* Print the char)
(COND
(IDMODE (* this is discouraged by the DM manual, but apparently
EMACS does it, so might as well support it)
(CHAT.ADDCHAR)))
(DMCHAT.PRINTCHAR CHAR]
[COND
(EATLF (SETQ EATLF NIL) (* LF is ignored after CR)
(COND
((EQ CHAR (CHARCODE LF))
(RETURN]
[COND
(EATCRLF (* We just wrapped around, so ignore CR and/or LF if
next)
(COND
((EQ CHAR (CHARCODE CR))
(SETQ EATLF T)
(RETURN (SETQ EATCRLF NIL)))
(T (* Intervening control characters do not stop the
eating, except for a few inconsistent exceptions...)
(SELCHARQ CHAR
((↑B ↑\ ↑↑ ↑←)
(SETQ EATCRLF NIL))
NIL]
(SELCHARQ CHAR
[LF (COND
(IDMODE (CHAT.ADDLINE))
(T (CHAT.DOWN]
(CR (SETQ EATTOCRLF NIL)
(DMCHAT.NEWLINE T))
[BS (COND
(IDMODE (CHAT.DELCHAR))
(T (CHAT.LEFT]
(↑W (* Erase to end of line)
(CHAT.ERASE.TO.EOL))
(↑L (* Start of cursor address)
(SETQ ADDRESSING -1))
(↑B (* Homes cursor, cancels some modes)
(CHAT.HOME)
(CHAT.CLEARMODES))
(↑X (* Cancel --resets modes)
(CHAT.CLEARMODES)
(SETQ ROLLMODE))
((↑↑ ↑←) (* Master Reset -- Clears screen, modes)
(CHAT.CLEAR))
[↑\ (* Forward space)
(COND
((NOT EATTOCRLF)
(COND
(IDMODE (CHAT.ADDCHAR))
(T (DMCHAT.RIGHT]
[↑Z (* Up)
(COND
(IDMODE (CHAT.DELETELINE))
(T (CHAT.UP]
[(↑N ↑O) (* Enter blink mode, enter protected mode.
Do both as embolden)
(COND
((NOT BLINKMODE)
(SETQ BLINKMODE T)
(DSPFONT [SETQ FONT (OR CHATBOLDFONT (SETQ CHATBOLDFONT
(FONTCOPY PLAINFONT (QUOTE WEIGHT)
(QUOTE BOLD]
DSP]
(↑P (* Enter i/d mode)
(SETQ IDMODE T))
(↑%] (* Set roll mode)
(SETQ ROLLMODE T))
NIL])
(CHAT.SCREENPARAMS
[LAMBDA (INSTREAM WINDOW) (* rda: "22-Aug-84 16:42")
(* * 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)))
(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
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 (CHATUSERSTATE CHATINEMACS) of STATE))
(AND TITLEMIDDLE (NOT (FIXP (NTHCHAR TITLE -1]
(CONCAT ", Emacs " (COND
(EMACSMODE "ON")
(T "OFF"]
(T ""])
(CHAT.ADDCHAR
[LAMBDA NIL (* bvm: "28-APR-82 21:46")
(* Insert a space at cursor position, pushing rest of
line to right)
(PROG ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP XPOS Y DSP (IPLUS XPOS FONTWIDTH)
Y
(IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Blt remainder of line to the right by FONTWIDTH, then
erase the character under the cursor)
(CHAT.ERASEBITS XPOS Y FONTWIDTH FONTHEIGHT])
(CHAT.ADDLINE
[LAMBDA (ATYPOS) (* bvm: "28-APR-82 18:19")
(OR ATYPOS (SETQ ATYPOS YPOS)) (* To insert line at ATYPOS, we blt everything below it
down one, then clear the line at ATYPOS)
(BITBLT DSP 0 FONTHEIGHT DSP 0 0 TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(CHAT.ERASEBITS 0 (IDIFFERENCE ATYPOS FONTDESCENT)
TTYWIDTH FONTHEIGHT])
(DMCHAT.ADDRESS
[LAMBDA (CHAR) (* bvm: "28-APR-82 21:22")
(* In the middle of doing absolute address.
Return T unless a cancel is received)
(COND
((SELCHARQ CHAR
((↑X ↑↑ ↑←)
T)
NIL) (* Cancel it)
(SETQ ADDRESSING NIL))
((EQ CHAR (CHARCODE ↑L)) (* Restarting the address in the middle of the address
is legal)
(SETQ ADDRESSING -1))
((ILESSP ADDRESSING 0) (* Accept first position)
(SETQ ADDRESSING (LOGXOR CHAR 96)))
(T (* Accept second position and go there)
(MOVETO (SETQ XPOS (IMIN (ITIMES ADDRESSING FONTWIDTH)
(IDIFFERENCE TTYWIDTH FONTWIDTH)))
[SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE HOMEPOS (ITIMES (LOGXOR CHAR 96)
FONTHEIGHT]
DSP)
(SETQ ADDRESSING)
T])
(CHAT.CLEAR
[LAMBDA (SETROLL) (* bvm: "17-SEP-82 12:53")
(CLEARW WINDOW)
(CHAT.CLEARMODES)
(AND SETROLL (SETQ ROLLMODE T))
(CHAT.HOME])
(CHAT.CLEARMODES
[LAMBDA NIL (* bvm: "17-SEP-82 13:03")
(COND
(BLINKMODE (* Restore normal font)
(DSPFONT PLAINFONT DSP)
(SETQ FONT PLAINFONT)
(SETQ BLINKMODE)))
(SETQ IDMODE (SETQ ADDRESSING])
(CHAT.DELCHAR
[LAMBDA NIL (* bvm: "28-APR-82 21:48")
(* Delete character under cursor, moving rest of line to
left)
(PROG ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP (IPLUS XPOS FONTWIDTH)
Y DSP XPOS Y (IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Blt remainder of line to the left by FONTWIDTH, then
erase the rightmost character position)
(CHAT.ERASEBITS (IDIFFERENCE TTYWIDTH FONTWIDTH)
Y FONTWIDTH FONTHEIGHT])
(CHAT.DELETELINE
[LAMBDA (ATYPOS) (* bvm: "28-APR-82 18:16")
(OR ATYPOS (SETQ ATYPOS YPOS)) (* To delete line at ATYPOS, we blt everything below it
up one, then clear the bottom line)
(BITBLT DSP 0 0 DSP 0 FONTHEIGHT TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(CHAT.ERASEBITS 0 0 TTYWIDTH FONTHEIGHT])
(CHAT.DOWN
[LAMBDA NIL (* bvm: "28-APR-82 17:05")
(* Move down a line)
(COND
((IGREATERP YPOS FONTDESCENT)
(MOVETO XPOS (SETQ YPOS (IDIFFERENCE YPOS FONTHEIGHT))
DSP))
((NULL ROLLMODE) (* Wraparound to top)
(MOVETO XPOS (SETQ YPOS HOMEPOS)
DSP))
(T (* On bottom line in rollmode, scroll screen up one)
(CHAT.DELETELINE HOMEPOS])
(CHAT.ERASE.TO.EOL
[LAMBDA NIL (* bvm: "28-APR-82 21:16")
(CHAT.ERASEBITS XPOS (IDIFFERENCE YPOS FONTDESCENT)
(IDIFFERENCE TTYWIDTH XPOS)
FONTHEIGHT])
(CHAT.ERASEBITS
[LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* bvm: "28-APR-82 18:13")
(BITBLT NIL NIL NIL DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(CHAT.HOME
[LAMBDA NIL (* bvm: "28-APR-82 16:42")
(MOVETO (SETQ XPOS 0)
(SETQ YPOS HOMEPOS)
DSP])
(CHAT.LEFT
[LAMBDA NIL (* bvm: "28-APR-82 21:42")
(COND
((IGREATERP XPOS 0)
(MOVETO (SETQ XPOS (IDIFFERENCE XPOS FONTWIDTH))
YPOS DSP])
(DMCHAT.NEWLINE
[LAMBDA (EXPLICIT) (* bvm: "28-APR-82 17:05")
(* Do a CRLF. EXPLICIT = T means a CR was received, NIL
means we did autowraparound)
(MOVETO (SETQ XPOS 0)
YPOS DSP) (* Do only the CR part now, saving the LF for when next
char arrives)
(SETQ AUTOLF T)
(COND
(EXPLICIT (SETQ EATLF T))
(T (SETQ EATCRLF T])
(DMCHAT.PRINTCHAR
[LAMBDA (CHAR) (* bvm: " 2-Jun-84 15:07")
(\OUTCHAR OUTSTREAM CHAR)
(COND
((IGEQ (add XPOS FONTWIDTH)
TTYWIDTH) (* Have reached right margin, so wrap around)
(COND
(CHAT.AUTOCRLF (DMCHAT.NEWLINE))
(T (SETQ EATTOCRLF T])
(DMCHAT.RIGHT
[LAMBDA NIL (* bvm: " 2-Jun-84 15:07")
(COND
((ILESSP (IPLUS XPOS FONTWIDTH)
TTYWIDTH)
(add XPOS FONTWIDTH)
(MOVETO XPOS YPOS DSP))
(T (* Auto crlf)
(DMCHAT.NEWLINE])
(CHAT.UP
[LAMBDA NIL (* bvm: "28-APR-82 16:59")
(COND
((ILESSP YPOS HOMEPOS)
(MOVETO XPOS (SETQ YPOS (IPLUS YPOS FONTHEIGHT))
DSP])
)
(* window stuff)
(DEFINEQ
(GETCHATWINDOW
[LAMBDA (HOST WINDOW) (* rda: "21-Aug-84 13:22")
(* Return a window, possibly new, to run a chat
connection to HOST. Uses WINDOW if possible)
(PROG ((TITLE (CONCAT "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 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) (* bvm: "11-SEP-83 17:09")
(COND
[(LASTMOUSESTATE LEFT)
(PROG (TMP)
(COND
((AND (SETQ TMP (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(fetch CHATINEMACS of TMP)
(SETQ TMP (fetch TYPEOUTPROC of TMP)))
(PROCESS.APPLY TMP (FUNCTION CHAT.EMACS.MOVE)))
(T (CHAT.HOLD WINDOW]
((LASTMOUSESTATE MIDDLE)
(CHAT.MENU WINDOW])
(CHAT.HOLD
[LAMBDA (WINDOW) (* bvm: "23-SEP-81 12:14")
(* * Toggle HOLD while button is down)
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(TOTOPW WINDOW)
(OR STATE (RETURN))
[COND
((NOT (fetch HELD of STATE))
(replace HELD of STATE with T)
(UNINTERRUPTABLY
(UNTILMOUSESTATE UP))]
(replace HELD of STATE with NIL])
(CHAT.MENU
[LAMBDA (WINDOW) (* rda: "31-Aug-84 16:27")
(DECLARE (GLOBALVARS CHATMENU CHAT.REOPENMENU)
(SPECVARS WINDOW STATE)) (* Called by YELLOW)
(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 HELD of STATE with T)
(\CHECKCARET WINDOW)
(SELECTQ [SETQ COMMAND (MENU (OR CHATMENU (SETQ CHATMENU (create MENU
ITEMS ← CHATMENUITEMS]
(Close (replace RUNNING? of STATE with (QUOTE CLOSE))
(* Ask CHAT.TYPEIN to shut things down.)
)
(New (replace RUNNING? of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
(QUOTE NEW)))
(Suspend (replace RUNNING? of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
T))
(Freeze (* Leave in HELD state)
(RETURN))
(NIL)
(APPLY* COMMAND STATE WINDOW))
(replace HELD of STATE with NIL])
(CHAT.CLEAR.FROM.MENU
[LAMBDA (STATE) (* rda: "10-Aug-84 17:18")
(PROCESS.EVAL (fetch TYPEOUTPROC of STATE)
(QUOTE (CHAT.CLEAR T])
(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) (* bvm: " 3-Jun-84 15:24")
(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: " 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 (STATE WINDOW) (* rda: "31-Aug-84 16:27")
(* * Pop up a menu of protocol specific options.)
(PROG [(MENU (CHAT.OPTIONMENU (fetch (CHATUSERSTATE INSTREAM) of STATE]
(if MENU
then (MENU MENU)
else (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) (* bvm: " 5-Oct-84 18:05")
(* 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)
(PROG [(X (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(COND
((AND X (SETQ X (fetch TYPEOUTPROC of X)))
(PROCESS.APPLY X (FUNCTION CHAT.DID.RESHAPE])
(CHAT.TTYENTRYFN
[LAMBDA (PROCESS) (* bvm: "12-Jul-84 17:36")
(* Switch to a chat window)
(DECLARE (GLOBALVARS \CURRENTINTERRUPTS CHAT.INTERRUPTS))
(PROG ((WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW)))
STATE INTERRUPTS)
(COND
([AND WINDOW (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(replace HELD of STATE with NIL)))
[SETQ INTERRUPTS (for PAIR in (APPEND \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) (* bvm: " 2-Jun-84 15:43")
(PROG ((PROC (fetch TYPEOUTPROC of STATE)))
(COND
(PROC (PROCESS.APPLY PROC (FUNCTION CHAT.TYPESCRIPT1)
(LIST STATE])
(CHAT.TYPESCRIPT1
[LAMBDA (CHATSTATE)
(DECLARE (USEDFREE TYPESCRIPTSTREAM WINDOW)) (* bvm: " 2-Jun-84 16:51")
(* Called in context of type-out proc to change the
dribble file)
(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 TYPESCRIPTOFD of CHATSTATE with (SETQ TYPESCRIPTSTREAM FILE))
(AND FILE (printout PWINDOW "Opened " (FULLNAME FILE]
(T (printout PWINDOW "Could not open " FILE])
)
(* for EMACS)
(DEFINEQ
(CHAT.EMACS.MOVE
[LAMBDA NIL (* rda: "27-Aug-84 01:13")
(DECLARE (USEDFREE FONTHEIGHT FONTWIDTH WINDOW XPOS YPOS))
(* * 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)
(PROG ([OUTSTREAM (fetch (CHATUSERSTATE OUTSTREAM) of (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(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) (* rda: "22-Aug-84 16:40")
(* * Toggles the value of CHAT.IN.EMACS?)
(replace CHATINEMACS of CHATSTATE with (NOT (fetch CHATINEMACS of CHATSTATE)))
(* Now update title to show Emacs state)
(CHAT.SCREENPARAMS NIL WINDOW])
)
(ADDTOVAR CHAT.DRIVERTYPES (DM2500 . DMCHAT.HANDLECHARACTER))
(RPAQ? CHAT.EMULATORTYPE (QUOTE DM2500))
(RPAQ? CHAT.DISPLAYTYPE 10)
(RPAQ? CHAT.METACHAR 195)
(RPAQ? CHAT.CONTROLCHAR 193)
(RPAQ? CHAT.INTERRUPTS )
(RPAQ? CHAT.KEYACTIONS )
(RPAQ? DEFAULTCHATHOST )
(RPAQ? CHATDEBUGFLG )
(RPAQ? CHATWINDOWLST )
(RPAQ? CHATWINDOW )
(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? CHAT.PROTOCOLS )
(RPAQQ CHATMENU NIL)
(RPAQQ CHAT.REOPENMENU NIL)
(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 USERNAME CR WAIT PASSWORD CR))
(IFS (LOGIN "Login " USERNAME " " PASSWORD CR)
(ATTACH))))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(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 BSP)
)
(PUTPROPS CHAT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2427 16662 (CHAT 2437 . 5415) (CHAT.INIT 5417 . 6206) (FIND.CHAT.PROTOCOL 6208 . 6640)
(CHAT.TYPEIN 6642 . 11582) (CHAT.BIN 11584 . 11868) (CHAT.CLOSE 11870 . 14275) (CHAT.CLOSEFN 14277 .
14548) (CHAT.CLOSE.CONNECTION 14550 . 14862) (CHAT.LOGIN 14864 . 16660)) (16688 19289 (
ADD.CHAT.MESSAGE 16698 . 16920) (CHAT.LOGINFO 16922 . 17231) (CHAT.SENDSCREENPARAMS 17233 . 17581) (
CHAT.SETDISPLAYTYPE 17583 . 17967) (CHAT.LOGINFO 17969 . 18278) (CHAT.FLUSH&WAIT 18280 . 18588) (
CHAT.ENDOFSTREAMOP 18590 . 18966) (CHAT.OPTIONMENU 18968 . 19287)) (19333 35161 (CHAT.TYPEOUT 19343 .
22142) (CHAT.RESET.DISPLAY.PARMS 22144 . 23007) (CHAT.DID.RESHAPE 23009 . 23359) (
DMCHAT.HANDLECHARACTER 23361 . 27281) (CHAT.SCREENPARAMS 27283 . 28367) (CHAT.ADDCHAR 28369 . 29047) (
CHAT.ADDLINE 29049 . 29544) (DMCHAT.ADDRESS 29546 . 30601) (CHAT.CLEAR 30603 . 30813) (CHAT.CLEARMODES
30815 . 31136) (CHAT.DELCHAR 31138 . 31846) (CHAT.DELETELINE 31848 . 32304) (CHAT.DOWN 32306 . 32888)
(CHAT.ERASE.TO.EOL 32890 . 33117) (CHAT.ERASEBITS 33119 . 33338) (CHAT.HOME 33340 . 33508) (CHAT.LEFT
33510 . 33715) (DMCHAT.NEWLINE 33717 . 34255) (DMCHAT.PRINTCHAR 34257 . 34625) (DMCHAT.RIGHT 34627 .
34956) (CHAT.UP 34958 . 35159)) (35187 44508 (GETCHATWINDOW 35197 . 36257) (CHAT.BUTTONFN 36259 .
36725) (CHAT.HOLD 36727 . 37229) (CHAT.MENU 37231 . 38599) (CHAT.CLEAR.FROM.MENU 38601 . 38804) (
CHAT.TAKE.INPUT 38806 . 39026) (CHAT.TAKE.INPUT1 39028 . 39841) (DO.CHAT.OPTION 39843 . 40235) (
CHAT.RECONNECT 40237 . 41029) (CHAT.RESHAPEWINDOW 41031 . 41842) (CHAT.TTYENTRYFN 41844 . 42936) (
CHAT.TTYEXITFN 42938 . 43286) (CHAT.TYPESCRIPT 43288 . 43550) (CHAT.TYPESCRIPT1 43552 . 44506)) (44531
46989 (CHAT.EMACS.MOVE 44541 . 46563) (CHAT.SWITCH.EMACS 46565 . 46987)) (50305 50632 (\SPAWN.CHAT
50315 . 50630)))))
STOP