(FILECREATED "20-Sep-85 12:51:37" {ERIS}<LISPCORE>LIBRARY>CHAT.;25 51850
changes to: (FNS CHAT.TYPEOUT)
previous date: " 6-Sep-85 14:47:01" {ERIS}<LISPCORE>LIBRARY>CHAT.;24)
(* 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.DEACTIVATE.WINDOW 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.TYPEOUT.CLOSE CHAT.DID.RESHAPE CHAT.SCREENPARAMS))
(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.RECONNECT.OFF
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))
(COMS (FNS CHAT.ICONFN)
(BITMAPS TTYKBD TTYKBDMASK)
(VARS TTYKBDICONSPECREGION)
(INITVARS (TTYKBDICONSPEC)))
(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)
(CHAT.WINDOW.REGION)
(CHAT.WINDOW.SIZE)
(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))
(VARS (CHATMENU)
(CHAT.REOPENMENU)
CHATMENUITEMS NETWORKLOGINFO)
(DECLARE: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (SOURCE)
CHATDECLS)
(RECORDS EMACSCOMMANDS)
(GLOBALVARS CHAT.ALLHOSTS CHAT.CONTROLCHAR CHAT.EMACSCOMMANDS CHAT.FONT
CHAT.HOSTMENU CHAT.INTERRUPTS CHAT.KEYACTIONS CHAT.METACHAR
CHAT.REOPENMENU CHAT.WAIT.TIME CHATDEBUGFLG CHATMENU CHATWINDOW
CHAT.WINDOW.REGION CHAT.WINDOW.SIZE CHATWINDOWLST CLOSECHATWINDOWFLG
DEFAULTCHATHOST NETWORKLOGINFO CHATMENUITEMS CHAT.EMULATORTYPE
CHAT.DRIVERTYPES))
(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)
(INITRECORDS CHAT.STATE])
(* CHAT typein)
(DEFINEQ
(CHAT
[LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* bvm: " 4-Sep-85 23:18")
[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)
(TTY.PROCESS (THIS.PROCESS))
(COND
([NOT (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 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 (COND
(WINDOW (GETPROMPTWINDOW WINDOW))
(T 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) (* bvm: " 4-Sep-85 23:15")
(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 (NLSETQ (SETQ STREAM (COND
((STRINGP INITSTREAM)
(OPENSTRINGSTREAM INITSTREAM))
(T (OPENSTREAM INITSTREAM (QUOTE INPUT]
(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) (* bvm: " 4-Sep-85 23:08")
(* 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? (OPENWP 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)
(CHAT.DEACTIVATE.WINDOW WINDOW)
(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 (FUNCTION 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)))
(OPENWP ICON)) (* Shade the icon if the chat window is currently
closed)
(ICONW.SHADE ICON HIGHLIGHTSHADE) (* And arrange for middle-button to offer Reconnect
option)
(WINDOWPROP ICON (QUOTE OLDBUTTONEVENTFN)
(WINDOWPROP ICON (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT])
(CHAT.DEACTIVATE.WINDOW
[LAMBDA (WINDOW) (* bvm: " 4-Sep-85 19:41")
(LET [(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))
(WINDOWPROP WINDOW (QUOTE EXPANDFN)
NIL])
(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) (* edited: "20-Sep-85 12:23")
(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)))
(replace (CHAT.STATE TERM.STATE) of CHAT.STATE with (SETQ TERM.STATE
(APPLY* (CADDR (FASSOC DPYNAME
CHAT.DRIVERTYPES))
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 (LOGAND CH (MASK.1'S 0 7))
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 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE)
"closed"))
(-2 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE ABORT)
"aborted"))
(CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE (QUOTE CLOSE)
"closed somehow"))
(COND
((NOT (OPENWP WINDOW))
(DEL.PROCESS (WINDOWPROP WINDOW (QUOTE PROCESS])
(CHAT.TYPEOUT.CLOSE
[LAMBDA (WINDOW OUTSTREAM CHAT.STATE NEWSTATE MSG) (* bvm: " 5-Sep-85 15:29")
(COND
((OPENWP WINDOW)
(printout OUTSTREAM T "[Connection " MSG " by remote host]" T)))
(replace (CHAT.STATE RUNNING?) of CHAT.STATE with NEWSTATE])
(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) (* bvm: " 5-Sep-85 12:04")
(* 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 (OR (WINDOWP WINDOW)
(WINDOWP (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 (LET ((SIZE (LISTP CHAT.WINDOW.SIZE)))
(DECODE.WINDOW.ARG (AND (NULL CHATWINDOWLST)
CHAT.WINDOW.REGION)
(CAR SIZE)
(CDR SIZE)
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.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: " 4-Sep-85 19:52")
(LET* ((MAINW (OR (WINDOWPROP WINDOW (QUOTE ICONFOR))
WINDOW))
(STATE (WINDOWPROP MAINW (QUOTE CHATHOST)))
FN)
(COND
((NULL STATE)
(APPLY* (CHAT.RECONNECT.OFF WINDOW)
WINDOW))
((NOT (LASTMOUSESTATE MIDDLE))
(APPLY* (OR (WINDOWPROP WINDOW (QUOTE OLDBUTTONEVENTFN))
(FUNCTION TOTOPW))
WINDOW))
([MENU (OR CHAT.REOPENMENU (SETQ CHAT.REOPENMENU (create MENU
ITEMS ←(QUOTE ((ReConnect T
"Will reestablish this Chat connection"]
(CHAT.RECONNECT.OFF WINDOW) (* Don't let this command get issued twice)
(TTY.PROCESS (ADD.PROCESS (LIST (QUOTE CHAT)
(KWOTE (CAR STATE))
(KWOTE (CDR STATE))
NIL MAINW T])
(CHAT.RECONNECT.OFF
[LAMBDA (WINDOW) (* bvm: " 4-Sep-85 19:51")
(* * Removes CHAT.RECONNECT as the buttonfn for WINDOW and returns new buttonfn)
(LET [(FN (OR (WINDOWPROP WINDOW (QUOTE OLDBUTTONEVENTFN)
NIL)
(FUNCTION TOTOPW]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
FN)
FN])
(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) (* bvm: " 4-Sep-85 23:11")
(* 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 (RESETFORM (TTY.PROCESS (THIS.PROCESS
))
(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])
)
(DEFINEQ
(CHAT.ICONFN
[LAMBDA (WINDOW OLDICON) (* bvm: " 4-Sep-85 19:23")
(DECLARE (GLOBALVARS TTYKBDICONSPEC TTYKBD TTYKBDMASK TTYKBDICONSPECREGION))
(COND
((TTY.PROCESSP (WINDOWPROP WINDOW (QUOTE PROCESS)))
(TTY.PROCESS T)))
(COND
((FNTYP (QUOTE TITLEDICONW))
(OR OLDICON (TITLEDICONW (OR TTYKBDICONSPEC
(SETQ TTYKBDICONSPEC
(create TITLEDICON
ICON ← TTYKBD
MASK ← TTYKBDMASK
TITLEREG ← TTYKBDICONSPECREGION)))
(CAR (WINDOWPROP WINDOW (QUOTE CHATHOST)))
(FONTCREATE (QUOTE HELVETICA)
8])
)
(RPAQ TTYKBD (READBITMAP))
(64 64
"@@@OOOOOOOOOO@@@"
"@@AOOOOOOOOOOH@@"
"@@COOOOOOOOOOL@@"
"@@CH@@@@@@@@CL@@"
"@@CH@@@@@@@@AL@@"
"@@CHOOOOOOOOAL@@"
"@@CIOOOOOOOOIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIHAIBBGLAIL@@"
"@@CIHBEBEA@AIL@@"
"@@CIHBABEA@AIL@@"
"@@CIHBANGA@AIL@@"
"@@CIHBABHI@AIL@@"
"@@CIHBEBHI@AIL@@"
"@@CIHAIBHI@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIH@@@@@@AIL@@"
"@@CIOOOOOOOOIL@@"
"@@CHOOOOOOOOAL@@"
"@@OH@@@@@@@@AO@@"
"@AOH@@@@@@@@AOH@"
"@CL@@@@@@@@@@CL@"
"@GHGCILNGCILNAN@"
"@O@@@@@@@@@@@@O@"
"ANALNGCILNGCILGH"
"CL@@@@@@@@@@@@CL"
"GHFGCILNGCILNGAN"
"O@@@@@@@@@@@@@@O"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"COOOOOOOOOOOOOOL"
"GOOOOOOOOOOOOOON"
"OOOOOOOOOOOOOOOO"
"O@@@@@@@@@@@@@@O"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"N@@@@@@@@@@@@@@G"
"O@@@@@@@@@@@@@@O"
"OOOOOOOOOOOOOOOO"
"GOOOOOOOOOOOOOON"
"COOOOOOOOOOOOOOL")
(RPAQ TTYKBDMASK (READBITMAP))
(64 64
"@@@OOOOOOOOOO@@@"
"@@AOOOOOOOOOOH@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@COOOOOOOOOOL@@"
"@@OOOOOOOOOOOO@@"
"@AOOOOOOOOOOOOH@"
"@COOOOOOOOOOOOL@"
"@GOOOOOOOOOOOON@"
"@OOOOOOOOOOOOOO@"
"AOOOOOOOOOOOOOOH"
"COOOOOOOOOOOOOOL"
"GOOOOOOOOOOOOOON"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@@@@@"
"COOOOOOOOOOOOOOL"
"GOOOOOOOOOOOOOON"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"GOOOOOOOOOOOOOON"
"COOOOOOOOOOOOOOL")
(RPAQQ TTYKBDICONSPECREGION (4 3 56 14))
(RPAQ? TTYKBDICONSPEC )
(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? CHAT.WINDOW.REGION )
(RPAQ? CHAT.WINDOW.SIZE )
(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)
(RPAQQ CHATMENU NIL)
(RPAQQ CHAT.REOPENMENU NIL)
(RPAQQ CHATMENUITEMS ((Kermit (FUNCTION KERMIT.MENU.OPEN)
"Opens a kermit command menu")
(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)
)
(FILESLOAD (SOURCE)
CHATDECLS)
[DECLARE: EVAL@COMPILE
(RECORD EMACSCOMMANDS (EMARG EMUP EMDOWN EMFORWARD EMCOL0))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CHAT.ALLHOSTS CHAT.CONTROLCHAR CHAT.EMACSCOMMANDS CHAT.FONT CHAT.HOSTMENU CHAT.INTERRUPTS
CHAT.KEYACTIONS CHAT.METACHAR CHAT.REOPENMENU CHAT.WAIT.TIME CHATDEBUGFLG CHATMENU
CHATWINDOW CHAT.WINDOW.REGION CHAT.WINDOW.SIZE CHATWINDOWLST CLOSECHATWINDOWFLG
DEFAULTCHATHOST NETWORKLOGINFO 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)
(/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 (3013 21326 (CHAT 3023 . 6423) (CHAT.CHOOSE.EMULATOR 6425 . 7039) (CHAT.INIT 7041 . 8961
) (FIND.CHAT.PROTOCOL 8963 . 9415) (CHAT.TYPEIN 9417 . 14468) (CHAT.BIN 14470 . 14754) (CHAT.CLOSE
14756 . 18160) (CHAT.DEACTIVATE.WINDOW 18162 . 18694) (CHAT.CLOSEFN 18696 . 18967) (
CHAT.CLOSE.CONNECTION 18969 . 19274) (CHAT.LOGIN 19276 . 21324)) (21352 23971 (ADD.CHAT.MESSAGE 21362
. 21584) (CHAT.LOGINFO 21586 . 21891) (CHAT.SENDSCREENPARAMS 21893 . 22237) (CHAT.SETDISPLAYTYPE
22239 . 22586) (CHAT.LOGINFO 22588 . 22893) (CHAT.FLUSH&WAIT 22895 . 23199) (CHAT.ENDOFSTREAMOP 23201
. 23577) (CHAT.OPTIONMENU 23579 . 23969)) (23997 28517 (CHAT.TYPEOUT 24007 . 26766) (
CHAT.TYPEOUT.CLOSE 26768 . 27067) (CHAT.DID.RESHAPE 27069 . 27477) (CHAT.SCREENPARAMS 27479 . 28515))
(28543 39507 (GETCHATWINDOW 28553 . 30059) (CHAT.BUTTONFN 30061 . 30626) (CHAT.HOLD 30628 . 31169) (
CHAT.MENU 31171 . 32604) (CHAT.CLEAR.FROM.MENU 32606 . 32804) (CHAT.TAKE.INPUT 32806 . 33026) (
CHAT.TAKE.INPUT1 33028 . 33844) (DO.CHAT.OPTION 33846 . 34219) (CHAT.RECONNECT 34221 . 35215) (
CHAT.RECONNECT.OFF 35217 . 35623) (CHAT.RESHAPEWINDOW 35625 . 36588) (CHAT.TTYENTRYFN 36590 . 37653) (
CHAT.TTYEXITFN 37655 . 38003) (CHAT.TYPESCRIPT 38005 . 38280) (CHAT.TYPESCRIPT1 38282 . 39505)) (39533
41014 (CHAT.CHOOSE.PHONE.NUMBER 39543 . 41012)) (41122 43673 (CHAT.EMACS.MOVE 41132 . 43203) (
CHAT.SWITCH.EMACS 43205 . 43671)) (43674 44392 (CHAT.ICONFN 43684 . 44390)) (49917 50244 (\SPAWN.CHAT
49927 . 50242)))))
STOP