(FILECREATED " 5-Nov-84 22:24:16" {ERIS}<LISPCORE>LIBRARY>RS232CHAT.;14 44309
changes to: (FNS \RS232CHAT.BIN)
previous date: " 4-Oct-84 21:11:35" {ERIS}<LISPCORE>LIBRARY>RS232CHAT.;13)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RS232CHATCOMS)
(RPAQQ RS232CHATCOMS ((COMS (* Temporary patch)
(P (MOVD? (QUOTE CHARWIDTH)
(QUOTE \STREAMCHARWIDTH))))
(FILES (SYSLOAD)
RS232 RS232LOGIN DSPVTS)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(P (OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))))
(COMS (* Blinker utilities a.k.a. CARET)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS BLINKER)
(GLOBALVARS \BLINKWINK.CURSOR))
(FNS \BLINKWINK \BLINKOFF)
(CURSORS \BLINKWINK.CURSOR))
(LOCALVARS . T)
(* CHAT and similar tools)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS RS232CHATSTATE SAVEDTERMENV))
(INITVARS (\RS232CHATEXITSTATE NIL)
(\RS232CHATCURRENTSTATE NIL)
(\RS232CHAT.PERMITTED.INTERRUPTS NIL)
(\RS232CHATSTATE.GLOBALVARS (QUOTE (\RCHATS \RS232CHATTTBL
RS232XON\XOFF?
RS232CHATBINHOOK
\RS232CHAT.LocalEchoStream))))
(GLOBALVARS \RS232CHATEXITSTATE \RS232CHATCURRENTSTATE \RS232CHAT.GLOBALVARS
\RS232CHAT.SPECVARS)
(INITVARS * (MAPCAR \RS232CHATSTATE.GLOBALVARS (FUNCTION (LAMBDA (X)
(LIST X NIL))))
)
(INITVARS * \RS232CHATSTATE.SPECVARS.ALIST)
(INITVARS (\RS232CHATSTATE.SPECVARS (MAPCAR \RS232CHATSTATE.SPECVARS.ALIST
(FUNCTION CAR))))
(GLOBALVARS * (EVAL (QUOTE \RS232CHATSTATE.GLOBALVARS)))
(SPECVARS * (EVAL (QUOTE \RS232CHATSTATE.SPECVARS)))
(FNS RS232CHAT \RS232CHAT.REENTER \RS232CHAT.SWITCHSTATE
\RS232CHAT.MODIFY.TERMENV \RS232CHAT.DUPLEX \RS232CHAT.DOCOMMAND
\RS232CHAT.GETKEY \RS232CHAT.DO↑B)
(COMS (* Byte I/O for RS232CHAT)
(RECORDS ByteInputHook)
(FNS MAKEBINHOOK)
(INITVARS (\RS232CHAT7? T)
(\RS232CHAT.GAGWAIT.tics NIL)
(RS232REMOTEXOFF? NIL)
(\RS232FTPSLOW.BaudRate 1200))
(FNS \RS232CHAT.BIN \RS232CHAT.CHECKBLOCK \RS232CHAT.NEWLINE
\RS232CHAT.SCROLLUP \RS232CHAT.*APPLY2* \RS232CHAT.GAGHIM)
(GLOBALVARS \RS232CHAT7? \RS232CHAT.GAGWAIT.tics RS232REMOTEXOFF?
\RS232FTPSLOW.BaudRate))
(COMS (* Menu, window, process, and blinker functions)
(INITVARS (\RS232CHATWINDOW NIL)
(\RS232CHATMENU NIL)
(\RS232CHATSPEEDMENU NIL)
(\RS232CHAT.MENUSIGNAL NIL))
(FNS \RS232CHAT.GETMENUS \RCHATD.SETUP \RCHATD.SIZE&TITLE
\RS232CHAT.RESHAPEFN \RS232CHAT.BUTTONFN)
(GLOBALVARS \RCHATD \RCHATD.FONTDESCENT \RCHATD.BTMY \RCHATD.TOPY
\RCHATD.LMARG \RCHATD.RMARG)
(FNS \RS232CHAT.PROCESS.EXIT)
(GLOBALVARS \RS232CHATWINDOW \RS232CHATMENU \RS232CHATSPEEDMENU
\RS232CHAT.MENUSIGNAL))))
(* Temporary patch)
(MOVD? (QUOTE CHARWIDTH)
(QUOTE \STREAMCHARWIDTH))
(FILESLOAD (SYSLOAD)
RS232 RS232LOGIN DSPVTS)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))
)
(* Blinker utilities a.k.a. CARET)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD BLINKER (NEXTBLINKTIME BLINKUP? BLINKINTERVAL BLINKARET)
NEXTBLINKTIME ←(SETUPTIMER 0 NIL (QUOTE TICKS))
BLINKINTERVAL ←(ITIMES (OR (AND (BOUNDP (QUOTE \CARETRATE))
(FIXP \CARETRATE))
333)
\RCLKMILLISECOND)
BLINKARET ←(RESETFORM (CARET T)
(CARET))
(TYPE? (AND (LISTP (CDDDR (LISTP DATUM)))
(\TIMER.TIMERP (fetch NEXTBLINKTIME of DATUM))
(type? CURSOR (fetch BLINKARET of DATUM))))
(SYSTEM))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \BLINKWINK.CURSOR)
)
)
(DEFINEQ
(\BLINKWINK
(LAMBDA (BLINKER FORCETIMEOUT?) (* JonL "30-May-84 21:42")
(PROG1 (if (AND BLINKER (OR FORCETIMEOUT? (TIMEREXPIRED? (fetch NEXTBLINKTIME of BLINKER)
(QUOTE TICKS))))
then (CHECKUART)
(replace NEXTBLINKTIME of BLINKER with (SETUPTIMER (fetch BLINKINTERVAL
of BLINKER)
(fetch NEXTBLINKTIME
of BLINKER)
(QUOTE TICKS)))
(replace BLINKUP? of BLINKER with (NOT (fetch BLINKUP? of BLINKER)))
(CHECKUART)
(PROG ((DD (\GETDISPLAYDATA \RCHATD)))
(BITBLT (fetch (CURSOR CURSORBITMAP) of \BLINKWINK.CURSOR)
0 0 (PROG1 \RCHATD (* Comment PPLossage))
(IDIFFERENCE (ffetch DDXPOSITION of DD)
(fetch CURSORHOTSPOTX of \BLINKWINK.CURSOR))
(IDIFFERENCE (ffetch DDYPOSITION of DD)
(fetch CURSORHOTSPOTY of \BLINKWINK.CURSOR))
CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE INVERT)))
T)
(SERVICEIRING))))
(\BLINKOFF
(LAMBDA (BLINKER) (* JonL "30-May-84 21:49")
(if BLINKER
then (CHECKUART)
(if (fetch BLINKUP? of BLINKER)
then (\BLINKWINK BLINKER T)) (* Either he's already off, or we turn him off)
(replace NEXTBLINKTIME of (PROG1 BLINKER (* Comment PPLossage))
with (SETUPTIMER 0 (fetch NEXTBLINKTIME of BLINKER)
(QUOTE TICKS)))) (* And set his timer now so that any subsequent calls to
\BLINKWINK will turn him on)
(CHECKUART)))
)
(RPAQ \BLINKWINK.CURSOR (CURSORCREATE (READBITMAP) 2 4))
(16 16
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"@@@@"
"A@@@"
"CH@@"
"FL@@"
"LF@@"
"HB@@")(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(* CHAT and similar tools)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(TYPERECORD RS232CHATSTATE (GLOBALVARS SPECVARS SAVEDTERMENV TERMINALIO)
GLOBALVARS ←(MAPCAR \RS232CHATSTATE.GLOBALVARS (FUNCTION EVALV))
SPECVARS ←(MAPCAR \RS232CHATSTATE.SPECVARS (FUNCTION EVALV))
TERMINALIO ←(AND (NEQ \DEFAULTTTYDISPLAYSTREAM (TTYDISPLAYSTREAM))
(TTYDISPLAYSTREAM))
(RECORD GLOBALVARS (\RCHATS \RS232CHATTTBL RS232XON\XOFF? RS232CHATBINHOOK
\RS232CHAT.LocalEchoStream)))
(RECORD SAVEDTERMENV (SAVEDTTBL SAVEDINTERRUPTS SAVEDKEYACTIONS))
]
)
(RPAQ? \RS232CHATEXITSTATE NIL)
(RPAQ? \RS232CHATCURRENTSTATE NIL)
(RPAQ? \RS232CHAT.PERMITTED.INTERRUPTS NIL)
(RPAQ? \RS232CHATSTATE.GLOBALVARS (QUOTE (\RCHATS \RS232CHATTTBL RS232XON\XOFF? RS232CHATBINHOOK
\RS232CHAT.LocalEchoStream)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RS232CHATEXITSTATE \RS232CHATCURRENTSTATE \RS232CHAT.GLOBALVARS \RS232CHAT.SPECVARS)
)
(RPAQ? \RCHATS NIL)
(RPAQ? \RS232CHATTTBL NIL)
(RPAQ? RS232XON\XOFF? NIL)
(RPAQ? RS232CHATBINHOOK NIL)
(RPAQ? \RS232CHAT.LocalEchoStream NIL)
(RPAQQ \RS232CHATSTATE.SPECVARS.ALIST ((\RS232PERMITTED.INTERRUPTS NIL)
(\RS232ESCAPE.CHARCODE (CHARCODE #B))
(\RS232CHAT.EOLsequence "
")
(\RS232CHAT.NEWLINECHAR (CHARCODE LF))
(\RS232CHAT.BellSequence "↑<Bell>")
(\RS232CHAT.IgnoreCharcodes (LIST (CHARCODE NULL)))))
(RPAQ? \RS232PERMITTED.INTERRUPTS NIL)
(RPAQ? \RS232ESCAPE.CHARCODE (CHARCODE #B))
(RPAQ? \RS232CHAT.EOLsequence "
")
(RPAQ? \RS232CHAT.NEWLINECHAR (CHARCODE LF))
(RPAQ? \RS232CHAT.BellSequence "↑<Bell>")
(RPAQ? \RS232CHAT.IgnoreCharcodes (LIST (CHARCODE NULL)))
(RPAQ? \RS232CHATSTATE.SPECVARS (MAPCAR \RS232CHATSTATE.SPECVARS.ALIST (FUNCTION CAR)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RCHATS \RS232CHATTTBL RS232XON\XOFF? RS232CHATBINHOOK \RS232CHAT.LocalEchoStream)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS \RS232PERMITTED.INTERRUPTS \RS232ESCAPE.CHARCODE \RS232CHAT.EOLsequence
\RS232CHAT.NEWLINECHAR \RS232CHAT.BellSequence \RS232CHAT.IgnoreCharcodes)
)
(DEFINEQ
(RS232CHAT
(LAMBDA (TypeScriptStream BINHOOK LocalEchoStream XON\XOFF?)
(DECLARE (GLOBALVARS \ORIGKEYACTIONS)) (* JonL " 3-Dec-83 17:55")
(RS232INITIALIZECHECK) (* Sets up the GLOBALVARS relevant to RS232CHAT)
(OR (TERMTABLEP \RS232CHATTTBL)
(for I (TTBL ←(COPYTERMTABLE (QUOTE ORIG))) from 0 to 31
do (ECHOCONTROL I (if (FMEMB I (CHARCODE (TAB EOL BELL)))
then (QUOTE SIMULATE)
else (QUOTE INDICATE))
TTBL)
finally (PROGN (ECHOMODE NIL TTBL)
(CONTROL T TTBL)
(SETQ \RS232CHATTTBL TTBL))))
(OR (type? MENU \RS232CHATMENU)
(\RS232CHAT.GETMENUS))
(SETQ \RCHATS (\OUTSTREAMARG (OR (OR TypeScriptStream \RS232CHATWINDOW)
(SETQ \RS232CHATWINDOW (CREATEW NIL (QUOTE RS232ChatConnection)))
)))
(SETQ RS232CHATBINHOOK (AND (type? ByteInputHook BINHOOK)
BINHOOK))
(SETQ \RS232CHAT.XON\XOFF? XON\XOFF?)
(SETQ \RS232CHAT.LocalEchoStream (if (NULL LocalEchoStream)
then NIL
elseif (EQ T LocalEchoStream)
then \RCHATS
else (\OUTSTREAMARG LocalEchoStream)))
(EVAL.AS.PROCESS (QUOTE (\RS232CHAT.REENTER)))))
(\RS232CHAT.REENTER
(LAMBDA (STATE)
(DECLARE (SPECVARS (\RS232PERMITTED.INTERRUPTS \RS232ESCAPE.CHARCODE \RS232CHAT.EOLsequence
\RS232CHAT.NEWLINECHAR \RS232CHAT.BellSequence
\RS232CHAT.IgnoreCharcodes))
(GLOBALVARS \RS232.Tovh&BIC16.tics \RCLKSECOND \RS232CHAT.LocalEchoStream))
(* JonL "27-Apr-84 14:52")
(SETQ \RS232CHAT.GAGWAIT.tics (IPLUS \RS232.Tovh&BIC16.tics (FOLDLO \RCLKSECOND 16)))
(RESETLST (\CHECKCARET (TTYDISPLAYSTREAM)) (* Since we're becoming the TTY process, then flush the
caret in the previous window)
(\RCHATD.SETUP (if STATE
then (fetch (RS232CHATSTATE GLOBALVARS \RCHATS) of STATE)
else \RCHATS))
(if \RS232CHATWINDOW
then (WINDOWPROP \RS232CHATWINDOW (QUOTE \RS232CHATEXITSTATE)
NIL))
(PROG ((PROC (THIS.PROCESS)))
(OR PROC (RETURN))
(if \RCHATD
then (* Remember, we got to here via an EVAL.AS.PROCESS which
created a unique process to run here)
(PROCESSPROP PROC (QUOTE TTYEXITFN)
(QUOTE \RS232CHAT.PROCESS.EXIT))
(PROCESS.WINDOW PROC \RS232CHATWINDOW)
(TTY.PROCESS PROC)
else (RESETSAVE (TTY.PROCESS PROC))))
(RESETSAVE RECLAIMWAIT MAX.SMALLP)
(RESETSAVE (SETQ \RS232CHATEXITSTATE (\RS232CHAT.SWITCHSTATE STATE T)))
(\RS232CHAT.DUPLEX (fetch (RS232CHATSTATE GLOBALVARS \RS232CHAT.LocalEchoStream)
of STATE)) (* This call is mainly to provide a frame name from
which to RETFROM)
NIL)))
(\RS232CHAT.SWITCHSTATE
(LAMBDA (STATE ENTERING?) (* JonL " 3-Dec-83 20:36")
(SETQ \RS232CHAT.MENUSIGNAL) (* This FLG is only for coordination between the mouse
and \RS232CHAT.DUPLEX)
(PROG ((CURRENTSTATE (if ENTERING?
then (create RS232CHATSTATE))))
(UNINTERRUPTABLY (* Foo)
(if STATE
then (MAP2C \RS232CHATSTATE.GLOBALVARS (fetch GLOBALVARS of STATE)
(FUNCTION SET))
(MAP2C \RS232CHATSTATE.SPECVARS (fetch SPECVARS of STATE)
(FUNCTION SET))
(PROG ((TIO (fetch (RS232CHATSTATE TERMINALIO) of STATE)))
(if TIO
then (TTYDISPLAYSTREAM TIO)))
else (* The random variable \RS232CHAT.XON\XOFF? is merely to
transfer the argument of RS232CHAT into here, knowing
that upon exiting RS232XON\XOFF? will be restored.)
(SETQ RS232XON\XOFF? \RS232CHAT.XON\XOFF?))
(if ENTERING?
then (* Save initial terminal environment while installing
the one appropriate for RS232CHAT)
(replace SAVEDTERMENV of CURRENTSTATE
with (\RS232CHAT.MODIFY.TERMENV
(if STATE
then (fetch (RS232CHATSTATE SAVEDTERMENV) of STATE)
else (* First entry, so cons a SAVEDTERMENV simply in order
to pass args)
(create SAVEDTERMENV
SAVEDTTBL ← \RS232CHATTTBL
SAVEDINTERRUPTS ← \RS232CHAT.PERMITTED.INTERRUPTS
SAVEDKEYACTIONS ←(DEFERREDCONSTANT
(LIST (ASSOC (QUOTE BLANK-TOP)
\ORIGKEYACTIONS)
(ASSOC (QUOTE BLANK-MIDDLE)
\ORIGKEYACTIONS)
(QUOTE (BLANK-BOTTOM METADOWN . METAUP))))))
T))
elseif (NULL STATE)
then (SHOULDNT (QUOTE \RS232CHAT.SWITCHSTATE))
else (if (HASTTYWINDOWP NIL)
then (replace (RS232CHATSTATE TERMINALIO) of STATE with (TTYDISPLAYSTREAM)))
(replace SAVEDTERMENV of STATE with (\RS232CHAT.MODIFY.TERMENV (fetch
SAVEDTERMENV
of STATE)))))
(RETURN CURRENTSTATE))))
(\RS232CHAT.MODIFY.TERMENV
(LAMBDA (ENV SAVECURRENT?) (* JonL " 1-AUG-83 19:42")
(PROG ((TTBL (fetch SAVEDTTBL of ENV))
(INTS (fetch SAVEDINTERRUPTS of ENV))
(ACTS (fetch SAVEDKEYACTIONS of ENV)))
(if SAVECURRENT?
then (* Note how the returned TERMENV record has the previous
settings of these states, except for TERMINALIO)
(RETURN (create SAVEDTERMENV
SAVEDTTBL ←(SETTERMTABLE TTBL)
SAVEDINTERRUPTS ←(RESET.INTERRUPTS INTS T)
SAVEDKEYACTIONS ←(MODIFY.KEYACTIONS ACTS T)))
else (SETTERMTABLE TTBL)
(RESET.INTERRUPTS INTS)
(MODIFY.KEYACTIONS ACTS)))))
(\RS232CHAT.DUPLEX
(LAMBDA (LOCALECHOSTREAM) (* JonL " 4-Oct-84 20:47")
(DECLARE (SPECVARS LOCALECHOSTREAM)
(SPECVARS (\RS232PERMITTED.INTERRUPTS \RS232ESCAPE.CHARCODE \RS232CHAT.EOLsequence
\RS232CHAT.NEWLINECHAR \RS232CHAT.BellSequence
\RS232CHAT.IgnoreCharcodes)))
(PROG ((\RS232CHAT.BellSequence \RS232CHAT.BellSequence)
(\RS232CHAT.IgnoreCharcodes \RS232CHAT.IgnoreCharcodes)
(BLOCKINTERVAL (SETUPTIMER 0 NIL (QUOTE TICKS)))
(PROMPTSTREAM (GETSTREAM PROMPTWINDOW))
(CHATWINDOW (AND \RCHATD (WFROMDS \RCHATD)))
(FORCEOUT? (NOT \RS232DLionRS232C?))
ECHOING.NOW? LOCALECHO.TO.T? NOLOCALECHOP ESCAPECHARCODE EOLSEQUENCE NEWLINECHAR BLINKER C)
(DECLARE (SPECVARS NEWLINECHAR ECHOING.NOW? LOCALECHO.TO.T? NOLOCALECHOP PROMPTSTREAM))
(if LOCALECHOSTREAM
then (SETQ LOCALECHO.TO.T? (EQ \RCHATS LOCALECHOSTREAM))
else (SETQ LOCALECHOSTREAM \RCHATS)
(SETQ NOLOCALECHOP T))
(SETQ BLINKER (AND CHATWINDOW (WINDOWPROP CHATWINDOW (QUOTE BLINKER))))
(if RS232XON\XOFF?
then (* If we're playing the XON\XOFF? game, then be sure he
isn't gagged)
(OR (PROG1 \RS232DLionRS232C? (* Comment PPLossage))
(PROG NIL
(\RS232DECODE.LINESTATUS (OR (\RS232CHAT.GAGHIM)
(RETURN))))))
(RESETSAVE (RS232MODIFYMODEMCONTROL (QUOTE (DTR RTS)))
(QUOTE RS232MODEMCONTROL))
RECACHE
(SETQ ESCAPECHARCODE \RS232ESCAPE.CHARCODE)
(SETQ EOLSEQUENCE \RS232CHAT.EOLsequence)
(SETQ NEWLINECHAR \RS232CHAT.NEWLINECHAR)
(if (AND \RCHATD (IGREATERP \RCHATD.BTMY (DSPYPOSITION NIL \RCHATD)))
then
(* When control gets out of our hands, it may print to the chat window without scrolling; so bring the cursor back
up to top.)
(\RS232CHAT.NEWLINE (CHARCODE EOL)))
A (* Just printout chars from remote host, while waiting
for keyboard input.)
(do (if (SETQ C (RS232READBYTE))
then (\BLINKOFF BLINKER) (* Even though the blinker is taken down here, it will
come back on again due to the call to \BLINKWINK in
\RS232CHAT.DUPLEX)
(\RS232CHAT.BIN C RS232CHATBINHOOK \RS232CHAT.IgnoreCharcodes ECHOING.NOW?
NEWLINECHAR)
else (\BLINKWINK BLINKER))
(AND (TIMEREXPIRED? BLOCKINTERVAL (QUOTE TICKS))
(PROG1 (\RS232CHAT.CHECKBLOCK BLINKER)
(SETQ BLOCKINTERVAL (SETUPTIMER \RS232.BLOCKINTERVAL.tics BLOCKINTERVAL
(QUOTE TICKS))))
(GO RECACHE))
(CHECKUART) repeatuntil (SETQ C (\GETSYSBUF)))
(\BLINKOFF BLINKER) (* Send typed-in byte to remote host
(unless it is the escape char))
(if (EQ C ESCAPECHARCODE)
then (CHECKUART)
(ERSETQ (\RS232CHAT.DOCOMMAND))
(GO RECACHE)
else (* Send out the typed-in byte, but check for extra
stuff on EOL Note that next operations will service the
UART)
(if (EQ C (CHARCODE EOL))
then (RS232WRITESTRING EOLSEQUENCE FORCEOUT?)
else (RS232WRITEBYTE C FORCEOUT?))
(if (NULL FORCEOUT?)
then (* This is synonymous with \RS232DLionRS232C?)
(\RS232.SERVICEORING))
(if (NOT NOLOCALECHOP)
then (* Perhaps local echoing for the keyboard is wanted?)
(if LOCALECHO.TO.T?
then (\BLINKOFF BLINKER))
(if (NOT ECHOING.NOW?)
then (SETQ ECHOING.NOW? T)
(if LOCALECHO.TO.T?
then (CHECKUART)
(BOUT LOCALECHOSTREAM (CHARCODE %[))))
(CHECKUART)
(BOUT LOCALECHOSTREAM C))
(GO A)))))
(\RS232CHAT.DOCOMMAND
(LAMBDA NIL (* JonL " 4-Aug-84 23:23")
(DECLARE (SPECVARS PROMPTSTREAM))
(PROG (C S)
B (CHECKUART)
(\RS232BOUTSTRING PROMPTSTREAM "
RS232Chat Command: ")
(SETQ S
(SELCHARQ
(SETQ C (\RS232CHAT.GETKEY))
((Q K q k)
(\RS232BOUTSTRING PROMPTSTREAM "Quit.")
(RETFROM (QUOTE \RS232CHAT.DUPLEX)))
(? (if (DISPLAYSTREAMP PROMPTSTREAM)
then (DSPRESET PROMPTSTREAM)
else (TERPRI PROMPTSTREAM))
"? - print this help; 7 - truncate to 7-bits; 8 - to 8-bits;
E - change Escape char; O - XON (use ↑Q/↑S protocol); F - XOFF;
S - Change Speed; <CR> - set EOL to CR; <LF> - set EOL to CR/LF;
↑B - BREAK Interrupt; L - LOGIN; C - Clear RS232CHAT Window;
R - Call RAID; B - send Break signal; Q - Quit (or exit); ")
((B b)
(RS232SENDBREAK)
"BREAK sent!")
((L l)
(RS232.PROMPT&LOGIN \RCHATS)
NIL)
((C c)
(AND \RCHATD (DSPRESET \RCHATD))
"Clear.")
((↑B R r)
(if (EQ C (CHARCODE ↑B))
then (\RS232CHAT.DO↑B)
else (RAID))
NIL)
((O o)
(SETQ RS232XON\XOFF? T)
"XON")
((F f)
(SETQ RS232XON\XOFF?)
"XOFF")
((S s) (* Note that the interrupts are set as for RS232CHAT, so
PROMPTFORWORD doesn't have to fiddle with them)
(FRESHLINE PROMPTSTREAM)
(if (NLSETQ (APPLY (QUOTE RS232INIT)
(CONS (READ (OR (STRINGP (PROMPTFORWORD
"LineSpeed = " "1200"
(QUOTE (LAMBDA NIL
(QUOTE (110 150 300 600
1200 2400
4800 9600
19200))))
PROMPTSTREAM NIL (QUOTE TTY)))
"FOOBAR"))
(CDR RS232INIT))))
then NIL
else (CONCAT "Unacceptable value; Speed still = " (MKSTRING (fetch (
RS232CHARACTERISTICS BAUDRATE) of RS232INIT)))))
((E e)
(\RS232BOUTSTRING PROMPTSTREAM "Escape/Command character = ")
(SETQ \RS232ESCAPE.CHARCODE (\RS232CHAT.GETKEY))
(CONCAT (CHARACTER \RS232ESCAPE.CHARCODE)
(CONSTANT (CHARACTER (CHARCODE EOL)))))
((CR LF)
(SETQ \RS232CHAT.EOLsequence (if (EQ C (CHARCODE CR))
then (CONSTANT (CONCAT (CHARACTER (CHARCODE CR))))
else (SETQ \RS232CHAT.EOLsequence
(CONSTANT (CONCAT (CHARACTER (CHARCODE CR))
(CHARACTER (CHARCODE LF)))))))
)
((7 8)
(SETQ \RS232CHAT7? (EQ C (CHARCODE 7)))
(if \RS232CHAT7?
then "7bit"
else "8bit"))
(GO B)))
(AND S (\RS232BOUTSTRING PROMPTSTREAM S))
(CHECKUART))))
(\RS232CHAT.GETKEY
(LAMBDA NIL (* JonL "30-May-84 21:43")
(CHECKUART)
(bind C do (\RS232CHECK.BLOCK) repeatuntil (SETQ C (\GETSYSBUF)) finally (RETURN (PROG1 C
(CHECKUART
))))))
(\RS232CHAT.DO↑B
(LAMBDA NIL (* JonL " 3-Dec-83 18:00")
(RESETFORM (\RS232CHAT.MODIFY.TERMENV (fetch SAVEDTERMENV of \RS232CHATEXITSTATE)
T)
(NLSETQ (BREAK1 NIL T RS232CHAT)))))
)
(* Byte I/O for RS232CHAT)
[DECLARE: EVAL@COMPILE
(TYPERECORD ByteInputHook (HOOKFN HOOKCHARTABLE))
]
(DEFINEQ
(MAKEBINHOOK
(LAMBDA (FN CHARSLST) (* JonL " 1-Dec-83 02:43")
(PROG ((TBL (create CHARTABLE))
TEM)
(MAPC CHARSLST (FUNCTION (LAMBDA (C)
(SETQ TEM (\GETCHARCODE C))
(OR (CHARCODEP TEM)
(\ILLEGAL.ARG C))
(\SETSYNCODE TBL TEM 1))))
(RETURN (create ByteInputHook
HOOKCHARTABLE ← TBL
HOOKFN ← FN)))))
)
(RPAQ? \RS232CHAT7? T)
(RPAQ? \RS232CHAT.GAGWAIT.tics NIL)
(RPAQ? RS232REMOTEXOFF? NIL)
(RPAQ? \RS232FTPSLOW.BaudRate 1200)
(DEFINEQ
(\RS232CHAT.BIN
(LAMBDA (C BINHOOK IGNORECHARCODES LOCALECHOINGNOW? NEWLINECHAR)
(* JonL " 5-Nov-84 22:20")
(DECLARE (USEDFREE ECHOING.NOW? LOCALECHO.TO.T? LOCALECHOSTREAM \RS232CHAT.BellSequence))
(if (AND (PROG1 BINHOOK (* Comment PPLossage))
(NEQ 0 (\SYNCODE (fetch HOOKCHARTABLE of BINHOOK)
C)))
then (APPLY* (fetch HOOKFN of BINHOOK)
C)
elseif (NOT (FMEMB C IGNORECHARCODES))
then (if \RS232CHAT7?
then (SETQ C (LOADBYTE C 0 7)))
(if LOCALECHOINGNOW?
then (* Local echoing does take longer -- there are the
following SPECVARS that have to be looked up)
(PROG NIL
(DECLARE (SPECVARS ECHOING.NOW? LOCALECHO.TO.T? LOCALECHOSTREAM))
(SETQ ECHOING.NOW?)
(if LOCALECHO.TO.T?
then (BOUT LOCALECHOSTREAM (CHARCODE %]))
(CHECKUART))))
(SERVICEIRING)
(if (NULL \RCHATD)
then (BOUT \RCHATS C)
elseif (EQ C NEWLINECHAR)
then
(* Normally, this would be (CHARCODE LF) which works both for systems that send both CR/LF and those that send only
LF. If the remote host sends only CR, then \RS232CHAT.NEWLINECHAR has to be reset.)
(\RS232CHAT.NEWLINE)
else (* Special hacks for Display code.)
(SELCHARQ C
((CR) (* This is so we don't get extra LF's on display stream
when a CR/LF is sent from remote host)
(CHECKUART)
(DSPXPOSITION \RCHATD.LMARG \RCHATD))
((LF) (* Phooey! We'd just like to have \RS232CHAT.NEWLINE be
the EOLFN for \RCHATD)
(\RS232CHAT.NEWLINE))
((BELL)
(if RS232XON\XOFF?
then (* Can this really be right? TOPS-20 seems to do it --
JonL May 1983)
(SETQ RS232REMOTEXOFF? T)
elseif \RS232CHAT.BellSequence
then (\RS232BOUTSTRING \RCHATS \RS232CHAT.BellSequence)
elseif (NOT (\RS232CHAT.*APPLY2* (FUNCTION BOUT)
\RCHATS C 0))
then (* Glaaag, the display code for BELL takes mannnny
milliseconds -- it "flashes" the DisplayStream window.)
(RESETLST (if \RS232DLion?
then (RESETSAVE NIL (QUOTE (BEEPOFF)))
(CHECKUART)
(BEEPON 240)
else ((LAMBDA (VC OVC)
(CHECKUART)
(RESETSAVE (VIDEOCOLOR T)
(if OVC
then
(QUOTE (VIDEOCOLOR
T))
else (QUOTE (VIDEOCOLOR
NIL))))
(* Kludgy code to defeat consing in the RESETSAVE)
(CHECKUART))
T
(VIDEOCOLOR)))
(during \RS232.BLOCKINTERVAL.tics
timerUnits (QUOTE TICKS) do (CHECKUART))
(* Wait a modest interval)
)))
(PROGN (BOUT \RCHATS C)
(if (IGREATERP (DSPXPOSITION NIL \RCHATS)
\RCHATD.RMARG)
then (* If this character drops off the right margin, then
"take it back" etc)
(CHECKUART)
(DSPRUBOUTCHAR \RCHATS C)
(TERPRI \RCHATS)
(CHECKUART)
(BOUT \RCHATS C))))))
(SERVICEIRING)))
(\RS232CHAT.CHECKBLOCK
(LAMBDA (BLINKER) (* JonL " 3-Aug-84 21:09")
(* Every so often, we must permit the background
processes to run, so that we can still have a mouse.)
(* Returns non-NIL iff something "interesting" happens)
(DECLARE (SPECVARS NOLOCALECHOP ECHOING.NOW? LOCALECHO.TO.T? LOCALECHOSTREAM)
(GLOBALVARS \RS232BACKGROUNDSTATE RS232INIT \RS232CHAT.MENUSIGNAL \RS232CHATMENU \RCHATD
\RCHATS))
(PROG (MENUSIGNAL INTERESTINGP)
B (CHECKUART)
(if (OR (PROG1 \RS232DLionRS232C? (* Comment PPLossage))
(AND (BACKGROUND? BOTH INPUT)
(IGEQ 600 (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT))))
then (BLOCK)
else (SETQ INTERESTINGP (\RS232CHECK.BLOCK)))
(if (PROG1 (SETQ MENUSIGNAL \RS232CHAT.MENUSIGNAL)
(SETQ \RS232CHAT.MENUSIGNAL))
then (SETQ INTERESTINGP T)
(\BLINKOFF BLINKER)
(SELECTQ MENUSIGNAL
(BREAK (\RS232CHAT.DO↑B))
(MENU (MENU \RS232CHATMENU) (* Go around again, since the menu may communicate to us
via \RS232CHAT.MENUSIGNAL)
(GO B))
(QUIT (RETFROM (QUOTE \RS232CHAT.DUPLEX)))
(Bye (RS232MODEMHANGUP)
(RETFROM (QUOTE \RS232CHAT.DUPLEX)))
(Login (RS232.PROMPT&LOGIN \RCHATS))
(~RollMode (if \RCHATD
then (DSPSCROLL (SELECTQ (DSPSCROLL NIL \RCHATD)
(OFF T)
(QUOTE OFF))
\RCHATD)))
(~LocalEcho (if (SETQ NOLOCALECHOP (NOT NOLOCALECHOP))
then (* This clause when we are gagging local echoing)
(if (AND ECHOING.NOW? LOCALECHO.TO.T?)
then (\BLINKOFF BLINKER)
(BOUT \RCHATS (QUOTE %])))
else (* This clause when we are initiating local echoing)
(if (NULL LOCALECHOSTREAM)
then (SETQ LOCALECHOSTREAM (OR
\RS232CHAT.LocalEchoStream
\RCHATS)))
(AND (EQ LOCALECHOSTREAM \RCHATS)
(SETQ LOCALECHO.TO.T? T)))
(SETQ ECHOING.NOW?))
(StopLogin)
(if (AND (LISTP MENUSIGNAL)
(LITATOM (CAR MENUSIGNAL))
(CAR MENUSIGNAL)
(NEQ T (CAR MENUSIGNAL)))
then (SET (CAR MENUSIGNAL)
(CAR (LISTP (CDR MENUSIGNAL))))
else (HELP "Unrecognized \RS23CHAT.MENUSIGNAL" MENUSIGNAL))))
(CHECKUART)
(RETURN INTERESTINGP))))
(\RS232CHAT.NEWLINE
(LAMBDA (C) (* JonL "30-May-84 21:44")
(CHECKUART)
(if \RCHATD
then (PROG ((DD (\GETDISPLAYDATA \RCHATD))
LFSIZE OLDY NEWY)
(SETQ LFSIZE (IMINUS (ffetch DDLINEFEED of DD)))
(SETQ OLDY (ffetch DDYPOSITION of DD))
(SETQ NEWY (IDIFFERENCE OLDY LFSIZE))
(CHECKUART)
(DSPXPOSITION \RCHATD.LMARG \RCHATD)
(CHECKUART)
(if (ILESSP NEWY \RCHATD.BTMY)
then (PROG ((DIFFERENTIAL (IDIFFERENCE OLDY \RCHATD.BTMY)))
(if (IGREATERP DIFFERENTIAL 0)
then (* Clean out a few garbage lines at the bottom of the
window)
(DSPCLEOL \RCHATD \RCHATD.LMARG
(fetch (REGION BOTTOM)
of (ffetch DDClippingRegion of DD))
DIFFERENTIAL))
(CHECKUART)
(AND (ffetch DDScroll of DD)
(PROG ((Y (IDIFFERENCE OLDY \RCHATD.FONTDESCENT))
(H (IDIFFERENCE LFSIZE DIFFERENTIAL)))
(if (\RS232CHAT.*APPLY2* (FUNCTION \RS232CHAT.SCROLLUP)
Y H 310)
then (SETQ NEWY \RCHATD.BTMY)
(* Bub, Bub, Bubble up; and away! Sounds like Lawrence
Welk!)
(GO XIT))))
(* Wrap, wrap, wrap, wrap, Wrap-around Sue -- to the
tune of the Beach Boys "Run Around Sue")
(SETQ NEWY \RCHATD.TOPY)))
(DSPCLEOL \RCHATD \RCHATD.LMARG (IDIFFERENCE NEWY \RCHATD.FONTDESCENT)
LFSIZE) (* Clean out the tubes on the new line)
XIT (CHECKUART)
(DSPYPOSITION NEWY \RCHATD)
(CHECKUART))
else (BOUT \RCHATS C))))
(\RS232CHAT.SCROLLUP
(LAMBDA (Y H) (* JonL "30-JUN-83 22:59")
(DSPSCROLLUP \RCHATD Y NIL H)))
(\RS232CHAT.*APPLY2*
(LAMBDA (FUN A1 A2 BaudRateLimit) (* JonL "13-Jun-84 23:05")
(CHECKUART)
(PROG ((YESP T))
(if (OR (PROG1 \RS232DLionRS232C? (* Comment PPLossage))
(ILESSP (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT)
BaudRateLimit))
then (SPREADAPPLY* FUN A1 A2)
elseif (NULL RS232XON\XOFF?)
then (SETQ YESP)
elseif (NOT RS232REMOTEXOFF?)
then (PROG (BadStatus)
(if (UNINTERRUPTABLY
(if (SETQ BadStatus (\RS232CHAT.GAGHIM T))
else (SPREADAPPLY* FUN A1 A2)
(SETQ BadStatus (\RS232CHAT.GAGHIM))))
then (\RS232DECODE.LINESTATUS BadStatus)))
else (* Here, either the remote host is gagged
(XOFF) or the speed is so slow that it doesn't matter)
(SPREADAPPLY* FUN A1 A2))
(CHECKUART)
(RETURN YESP))))
(\RS232CHAT.GAGHIM
(LAMBDA (OFF?) (* JonL "13-Jun-84 23:07")
(* Returns non-NIL only as an error code for line
status.)
(AND \RS232DLionRS232C? (SHOULDNT))
(PROG (STATUS)
(if (NULL (SETQ STATUS (\RS232CHECK.THRE)))
then (* Wait until Transmitter holding register **should** be
off.)
(RS232DATAO (if OFF?
then (CHARCODE ↑S)
else (CHARCODE ↑Q)))
else (* Can't do anything if the Transmitter is wedged.)
(RETURN STATUS))
(if (SETQ RS232REMOTEXOFF? (NOT (NULL OFF?)))
then
(* When gagging the remote host, wait until 16 byte-intervals have passed "quietly" before proceeding -- it may
take him a while to hear the XOFF)
(PROG (ORG.RINGWRITE)
A (SETQ ORG.RINGWRITE \RS232ORING.WRITE)
(during \RS232CHAT.GAGWAIT.tics while (NULL STATUS) timerUnits (QUOTE TICKS)
usingTimer \RS232.THRE.BOX
do (if (RS232INTERRUPT?)
then (* Foo, what if some character just walked in, so start
the waiting all over again.)
(AND (NULL (SETQ STATUS (\RS232.PROCESSINTERRUPT
(QUOTE NOERROR))))
(NEQ ORG.RINGWRITE \RS232ORING.WRITE)
(GO A))))))
(RETURN STATUS))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RS232CHAT7? \RS232CHAT.GAGWAIT.tics RS232REMOTEXOFF? \RS232FTPSLOW.BaudRate)
)
(* Menu, window, process, and blinker functions)
(RPAQ? \RS232CHATWINDOW NIL)
(RPAQ? \RS232CHATMENU NIL)
(RPAQ? \RS232CHATSPEEDMENU NIL)
(RPAQ? \RS232CHAT.MENUSIGNAL NIL)
(DEFINEQ
(\RS232CHAT.GETMENUS
(LAMBDA NIL (* JonL " 5-Dec-83 01:13")
(RESETFORM (RADIX 10)
(SETQ \RS232CHATSPEEDMENU
(create MENU
ITEMS ←(QUOTE (75 110 150 300 600 1200 2400 4800 9600 19200))
TITLE ← "Line Speed"
MENUCOLUMNS ← 2
MENUFONT ←(DSPFONT NIL WindowTitleDisplayStream)
CHANGEOFFSETFLG ← T
CENTERFLG ← T))
(SETQ \RS232CHATMENU
(create MENU
ITEMS ←(QUOTE ((XON (SETQ RS232XON\XOFF? T)
"Enable XON/XOFF protocol.")
(XOFF (SETQ RS232XON\XOFF?)
"Disable XON/XOFF protocol.")
(NewLine:LF (SETQ \RS232CHAT.MENUSIGNAL
(CONSTANT (LIST (QUOTE \RS232CHAT.NEWLINECHAR)
(CHARCODE LF))))
"Remote sends LF for 'NewLine'")
(NewLine:CR (SETQ \RS232CHAT.MENUSIGNAL
(CONSTANT (LIST (QUOTE \RS232CHAT.NEWLINECHAR)
(CHARCODE CR))))
"Remote sends CR for 'NewLine'")
(CR->CR (SETQ \RS232CHAT.MENUSIGNAL
(CONSTANT (LIST (QUOTE \RS232CHAT.EOLsequence)
(CONCAT (CHARACTER (CHARCODE
CR))))))
"'Return' key to send CR")
(CR->CR/LF (SETQ \RS232CHAT.MENUSIGNAL
(CONSTANT (LIST (QUOTE \RS232CHAT.EOLsequence)
(CONCAT (CHARACTER
(CHARCODE CR))
(CHARACTER
(CHARCODE LF))))))
"'Return' key to send CR/LF")
(7 (SETQ \RS232CHAT7? T)
"Trim incoming bytes to 7-bits")
(8 (SETQ \RS232CHAT7?)
"Don't trim incoming bytes to 7-bits")
(↑B (SETQ \RS232CHAT.MENUSIGNAL (QUOTE BREAK))
"Enters a Lisp-level HELP/BREAK loop")
(RAID (RAID)
"Calls RAID (Immediately)")
(SendBreak (RS232SENDBREAK)
"Sends 'Break' signal (0.25secs).")
(ChangeSpeed (ERSETQ (PROGN (APPLY (QUOTE RS232INIT)
(CONS (MENU
\RS232CHATSPEEDMENU)
(CDR RS232INIT)))
(SETQ \RS232CHAT.GAGWAIT.tics
(IPLUS \RS232.Tovh&BIC16.tics
(LRSH \RCLKSECOND 4)))))
"Pop-Up menu for line speed selection")
(~RollMode (SETQ \RS232CHAT.MENUSIGNAL (QUOTE ~RollMode))
"Toggles 'Roll Mode' for RS232Chat window")
(~LocalEcho (SETQ \RS232CHAT.MENUSIGNAL (QUOTE ~LocalEcho))
"Toggles local echoing")
(Login (SETQ \RS232CHAT.MENUSIGNAL (QUOTE Login))
"Prompt for LOGIN to corresponding Host.")
(StopLogin (SETQ \RS232CHAT.MENUSIGNAL (QUOTE StopLogin))
"If RS232LOGIN is in process, then stops at a 'convenient' time.")
(Exit (SETQ \RS232CHAT.MENUSIGNAL (QUOTE QUIT))
"Exits from RS232CHAT.")
(Bye (SETQ \RS232CHAT.MENUSIGNAL (QUOTE Bye))
"'Hangs up' modem and exits")
(Clear (DSPRESET \RS232CHATWINDOW)
"Clears this RS232CHAT window.")
(PageSize (if \RS232LOGIN.LASTHOSTSYSTEMTYPE
then (\RS232LOGIN.SENDPAGESIZE
\RS232CHATWINDOW
\RS232LOGIN.LASTHOSTSYSTEMTYPE
(ITIMES 3
\RCLKSECOND)))
"Send Page size parameters to logged-in host (which must be at 'exec')")))
MENUCOLUMNS ← 2
MENUFONT ←(DSPFONT NIL WindowTitleDisplayStream)
TITLE ← "RS232Chat Menu"
MENUBORDERSIZE ← 1
CENTERFLG ← T))) (* Must wait until after MENU is created to set the
MENUOFFSET since we don't know the exact IMAGEWIDTH
beforehand.)
(replace MENUOFFSET of (PROG1 \RS232CHATMENU (* Comment PPLossage))
with (create POSITION
XCOORD ←(IQUOTIENT (IDIFFERENCE (fetch (MENU IMAGEWIDTH) of \RS232CHATMENU)
6)
2)
YCOORD ← 20))))
(\RCHATD.SETUP
(LAMBDA (\RCHATS.stream?) (* JonL " 3-Dec-83 19:31")
(if (DISPLAYSTREAMP \RCHATS.stream?)
then (SETQ \RCHATD \RCHATS.stream?)
(SETQ \RS232CHATWINDOW (WFROMDS \RCHATD))
(PROG (DFONT CREG (DD (\GETDISPLAYDATA \RCHATD)))
(SETQ DFONT (ffetch DDFONT of DD))
(SETQ CREG (ffetch DDClippingRegion of DD))
(SETQ \RCHATD.FONTDESCENT (FONTDESCENT DFONT))
(SETQ \RCHATD.TOPY (ADD1 (IDIFFERENCE (fetch TOP of CREG)
(FONTASCENT DFONT))))
(SETQ \RCHATD.BTMY (IPLUS (fetch BOTTOM of CREG)
\RCHATD.FONTDESCENT))
(SETQ \RCHATD.LMARG (ffetch DDLeftMargin of DD))
(SETQ \RCHATD.RMARG (ffetch DDRightMargin of DD))
(replace DDEOLFN of DD with (FUNCTION \RS232CHAT.NEWLINE))
(WINDOWPROP \RS232CHATWINDOW (QUOTE RESHAPEFN)
(QUOTE \RS232CHAT.RESHAPEFN))
(WINDOWPROP \RS232CHATWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \RS232CHAT.BUTTONFN))
(\RCHATD.SIZE&TITLE \RS232CHATWINDOW)
(if (NULL (SETQ \RS232CHATBLINKER (WINDOWPROP \RS232CHATWINDOW (QUOTE BLINKER))))
then (* Be sure that there is a "caret" for it.)
(WINDOWPROP \RS232CHATWINDOW (QUOTE BLINKER)
(create BLINKER)))
(if (IGREATERP (SETQ CREG (fetch CURSORHOTSPOTX of (fetch BLINKARET
of (WINDOWPROP
\RS232CHATWINDOW
(QUOTE
BLINKER)))))
\RCHATD.RMARG)
then (DSPLEFTMARGIN (SETQ \RCHATD.LMARG CREG)
\RCHATD)))
else (SETQ \RCHATD (SETQ \RS232CHATWINDOW)))))
(\RCHATD.SIZE&TITLE
(LAMBDA (W) (* JonL " 8-May-84 00:05")
(PROG (PAGEHEIGHT LINELENGTH OLDTITLE)
(if (SETQ OLDTITLE (WINDOWPROP W (QUOTE TITLE)))
then (if (STRPOS (QUOTE :% % PageLength% =% )
OLDTITLE)
then (SETQ OLDTITLE (SUBSTRING OLDTITLE 1 (SUB1 (STRPOS (QUOTE
:% % PageLength% =% )
OLDTITLE)))))
else (* Be sure there is a TITLE before calculating
pagelength parameter.)
(WINDOWPROP W (QUOTE TITLE)
(SETQ OLDTITLE (QUOTE RS232ChatConnection))))
(* Be sure window is open, and fix up the Title)
(TOTOPW W) (* Also, clip the PAGEHEIGHT and LINELENGTH at 127,
since TENEX only has a 7-bit field for these
quantities.)
(SETQ PAGEHEIGHT (IMIN 127 (IQUOTIENT (WINDOWPROP W (QUOTE HEIGHT))
(IABS (DSPLINEFEED NIL W)))))
(SETQ LINELENGTH (IMIN 127 (IQUOTIENT (WINDOWPROP W (QUOTE WIDTH))
(\STREAMCHARWIDTH (CHARCODE M)
(WINDOWPROP W (QUOTE DSP))))))
(WINDOWPROP W (QUOTE TITLE)
(CONCAT OLDTITLE (QUOTE :% % PageLength% =% )
PAGEHEIGHT ", LineLength = " LINELENGTH))
(WINDOWPROP W (QUOTE PAGESIZE)
(LIST PAGEHEIGHT LINELENGTH)))))
(\RS232CHAT.RESHAPEFN
(LAMBDA (W IMG REG) (* JonL " 3-Dec-83 16:27")
(RESHAPEBYREPAINTFN W IMG REG)
(if (EQ W \RS232CHATWINDOW)
then (* A moby setup of cached parameters.
How can it happen that some window which isn't
\RS232CHATWINDOW gets passed in here?)
(\RCHATD.SETUP (SETQ \RCHATS (\OUTSTREAMARG \RS232CHATWINDOW)))
else (* Just re-calculates the linelength and pagelength
parameters.)
(\RCHATD.SIZE&TITLE W))
T))
(\RS232CHAT.BUTTONFN
(LAMBDA (WINDOW) (* JonL " 3-Dec-83 18:01")
(PROG (STATE)
(if (NOT (WINDOWP WINDOW))
then (SHOULDNT (QUOTE WINDOW))
elseif (AND (SETQ STATE (WINDOWPROP WINDOW (QUOTE \RS232CHATEXITSTATE)))
(if (type? RS232CHATSTATE STATE)
else (* Patch up an irregular WINDOWPROP)
(WINDOWPROP WINDOW (QUOTE \RS232CHATEXITSTATE)
NIL)
NIL)
(LASTMOUSESTATE (OR LEFT MIDDLE)))
then (if (NEQ (fetch (RS232CHATSTATE GLOBALVARS \RCHATS) of STATE)
(\OUTSTREAMARG WINDOW))
then (* What the heck?)
(replace (RS232CHATSTATE GLOBALVARS \RCHATS) of STATE
with (\OUTSTREAMARG WINDOW)))
(EVAL.AS.PROCESS (LIST (QUOTE \RS232CHAT.REENTER)
(KWOTE STATE)))
elseif (AND (NULL STATE)
(LASTMOUSESTATE MIDDLE))
then (SETQ \RS232CHAT.MENUSIGNAL (QUOTE MENU))))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RCHATD \RCHATD.FONTDESCENT \RCHATD.BTMY \RCHATD.TOPY \RCHATD.LMARG \RCHATD.RMARG)
)
(DEFINEQ
(\RS232CHAT.PROCESS.EXIT
(LAMBDA (PROC) (* JonL " 3-Dec-83 18:06")
(* Note how we have to kludge it so that the stack will
be unwound and the RESETLST restorations performed)
(if (PROCESSP PROC)
then (PROG (TEM (W (PROCESSPROP PROC (QUOTE WINDOW))))
(OR W (RETURN))
(WINDOWPROP W (QUOTE \RS232CHATEXITSTATE)
\RS232CHATEXITSTATE)
(AND (SETQ TEM (WINDOWPROP W (QUOTE BLINKER)))
(\BLINKOFF TEM)))
(PROCESSPROP PROC (QUOTE TTYEXITFN)
NIL)
(DEL.PROCESS PROC))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RS232CHATWINDOW \RS232CHATMENU \RS232CHATSPEEDMENU \RS232CHAT.MENUSIGNAL)
)
(PUTPROPS RS232CHAT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4087 5842 (\BLINKWINK 4097 . 5221) (\BLINKOFF 5223 . 5840)) (8331 22143 (RS232CHAT 8341
. 9604) (\RS232CHAT.REENTER 9606 . 11348) (\RS232CHAT.SWITCHSTATE 11350 . 13734) (
\RS232CHAT.MODIFY.TERMENV 13736 . 14497) (\RS232CHAT.DUPLEX 14499 . 18884) (\RS232CHAT.DOCOMMAND 18886
. 21582) (\RS232CHAT.GETKEY 21584 . 21874) (\RS232CHAT.DO↑B 21876 . 22141)) (22260 22681 (MAKEBINHOOK
22270 . 22679)) (22826 34102 (\RS232CHAT.BIN 22836 . 26713) (\RS232CHAT.CHECKBLOCK 26715 . 29389) (
\RS232CHAT.NEWLINE 29391 . 31336) (\RS232CHAT.SCROLLUP 31338 . 31490) (\RS232CHAT.*APPLY2* 31492 .
32529) (\RS232CHAT.GAGHIM 32531 . 34100)) (34429 43275 (\RS232CHAT.GETMENUS 34439 . 38240) (
\RCHATD.SETUP 38242 . 40038) (\RCHATD.SIZE&TITLE 40040 . 41536) (\RS232CHAT.RESHAPEFN 41538 . 42210) (
\RS232CHAT.BUTTONFN 42212 . 43273)) (43408 44095 (\RS232CHAT.PROCESS.EXIT 43418 . 44093)))))
STOP