(FILECREATED "29-JUN-83 11:28:50" {PHYLUM}<LISPCORE>SOURCES>RS232CHAT.;61 37921
changes to: (FNS \RS232CHAT.DUPLEX \RS232CHAT.GETMENUS)
previous date: "29-JUN-83 07:17:48" {PHYLUM}<JONL>LISP>RS232CHAT.;1)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT RS232CHATCOMS)
(RPAQQ RS232CHATCOMS ((FILES (SYSLOAD)
RS232 RS232LOGIN)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(P (OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))))
(LOCALVARS . T)
(* CHAT and similar tools)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS RS232CHATEXITSTATE SAVEDTERMENV))
(INITVARS (RS232CHATEXITSTATE NIL)
(\RS232CHAT.PERMITTED.INTERRUPTS NIL)
(\RS232CHATSTATE.GLOBALVARS (QUOTE (\RCHATS \RS232CHATTTBL
RS232XON\XOFF?
RS232CHATBINHOOK
\RS232CHAT.LocalEchoStream))))
(GLOBALVARS RS232CHATEXITSTATE \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 RS232CHATBINHOOK)
(INITVARS (\RS232CHAT7? T)
(RS232REMOTEXOFF? NIL)
(\RS232FTPSLOW.BaudRate 1200))
(FNS \RS232CHAT.BIN \RS232CHAT.NEWLINE \RS232CHAT.NEWLINE.AUX
\RS232CHAT.*APPLY2* \RS232CHAT.GAGHIM)
(GLOBALVARS \RS232CHAT7? RS232REMOTEXOFF? \RS232FTPSLOW.BaudRate))
(COMS (* Menu, window, process, and blinker functions)
(FNS \RS232CHAT.GETMENUS \RCHATD.SETUP \RCHATW.SETUP \RS232CHAT.RESHAPEFN
\RS232CHAT.BUTTONFN \RS232CHAT.DOMENU)
(GLOBALVARS \RCHATD \RCHATD.FONTDESCENT \RCHATD.BTMY \RCHATD.TOPY)
(FNS \RS232CHAT.PROCESS.EXIT)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS RS232CHATBLINKER))
(FNS \RS232CHATBLINKWINK \RS232CHATBLINKOFF)
(INITVARS (\RS232CHATWINDOW NIL)
(\RS232CHATMENU NIL)
(\RS232CHATSPEEDMENU NIL)
(\RS232CHAT.MENUSIGNAL NIL)
(\RS232CHATBLINKER NIL))
(GLOBALVARS \RS232CHATWINDOW \RS232CHATMENU \RS232CHATSPEEDMENU
\RS232CHAT.MENUSIGNAL \RS232CHATBLINKER))))
(FILESLOAD (SYSLOAD)
RS232 RS232LOGIN)
(DECLARE: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(OR (GETMACROPROP (QUOTE RS232INITIALIZECHECK)
COMPILERMACROPROPS)
(LOADFROM (QUOTE RS232)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(* CHAT and similar tools)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(TYPERECORD RS232CHATEXITSTATE (GLOBALVARS SPECVARS SAVEDTERMENV)
GLOBALVARS ←(MAPCAR \RS232CHATSTATE.GLOBALVARS (FUNCTION EVALV))
SPECVARS ←(MAPCAR \RS232CHATSTATE.SPECVARS (FUNCTION EVALV))
(RECORD GLOBALVARS (\RCHATS \RS232CHATTTBL RS232XON\XOFF?)))
(RECORD SAVEDTERMENV (SAVEDTTBL SAVEDINTERRUPTS SAVEDKEYACTIONS))
]
)
(RPAQ? RS232CHATEXITSTATE NIL)
(RPAQ? \RS232CHAT.PERMITTED.INTERRUPTS NIL)
(RPAQ? \RS232CHATSTATE.GLOBALVARS (QUOTE (\RCHATS \RS232CHATTTBL RS232XON\XOFF? RS232CHATBINHOOK
\RS232CHAT.LocalEchoStream)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS RS232CHATEXITSTATE \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
(ADDTOVAR 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 XON\XOFF? LocalEchoStream BINHOOK)
(DECLARE (GLOBALVARS \ORIGKEYACTIONS)) (* JonL " 8-APR-83 19:43")
(RS232INITIALIZECHECK) (* Sets up the GLOBALVARS relevant to RS232CHAT)
(SETQ RS232CHATEXITSTATE)
(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 (GETSTREAM (OR (OR TypeScriptStream \RS232CHATWINDOW)
(CREATEW NIL (QUOTE RS232ChatConnection)))
(QUOTE OUTPUT)))
(SETQ RS232CHATBINHOOK (AND (type? RS232CHATBINHOOK BINHOOK)
BINHOOK))
(SETQ \RS232CHAT.XON\XOFF? XON\XOFF?)
(SETQ \RS232CHAT.LocalEchoStream (if (NULL LocalEchoStream)
then NIL
elseif (EQ T LocalEchoStream)
then \RCHATS
else (GETSTREAM LocalEchoStream (QUOTE OUTPUT))))
(EVAL.AS.PROCESS (QUOTE (\RS232CHAT.REENTER)))))
(\RS232CHAT.REENTER
(LAMBDA (STATE) (* JonL "23-JUN-83 20:42")
(\CHECKCARET (TTYDISPLAYSTREAM)) (* Since we're becoming the TTY process, then flush the
caret in the previous window)
(RESETLST (RESETSAVE (\RS232CHAT.SWITCHSTATE STATE T))
(\RCHATD.SETUP)
(if (THIS.PROCESS)
then (if \RCHATD
then (PROCESS.WINDOW (THIS.PROCESS)
\RS232CHATWINDOW)
(PROCESS.SWITCH.TO.WINDOW \RS232CHATWINDOW)
(WINDOWPROP \RS232CHATWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \RS232CHAT.BUTTONFN))
(* Foo, patch up for bug in PROCESS.SWITCH.TO.WINDOW)
else (RESETSAVE (TTY.PROCESS (THIS.PROCESS)))))
(if RS232XON\XOFF?
then (* If we're playing the XON\XOFF? game, then be sure he
isn't gagged)
(PROG NIL
(\RS232DECODE.LINESTATUS (OR (\RS232CHAT.GAGHIM)
(RETURN)))))
(\RS232CHAT.DUPLEX) (* This call is mainly to provide a frame name from
which to RETFROM)
(SETQ \LastInWindow) (* Foo, Terrible Kludges in WINDOW.MOUSE.HANDLER will
cause the chat window to flicker if the mouse stays in
it when quitting this function.)
NIL)))
(\RS232CHAT.SWITCHSTATE
(LAMBDA (STATE ENTERING?) (* JonL " 8-MAY-83 00:29")
(SETQ \RS232CHAT.MENUSIGNAL) (* This FLG is only for coordination between the mouse
and \RS232CHAT.DUPLEX)
(\RS232CHATBLINKOFF) (* Regardless of whether we are coming or going, the
"cursor" wants to be off.)
(PROG ((CURRENTSTATE (create RS232CHATEXITSTATE)))
(UNINTERRUPTABLY
(if STATE
then (MAP2C \RS232CHATSTATE.GLOBALVARS (fetch GLOBALVARS of STATE)
(FUNCTION SET))
(MAP2C \RS232CHATSTATE.SPECVARS (fetch SPECVARS of STATE)
(FUNCTION SET))
else (* The random variable \RS232CHAT.XON\XOFF? is merely to
transfer the 2nd 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 NIL)
(replace SAVEDTERMENV of CURRENTSTATE
with (\RS232CHAT.MODIFY.TERMENV (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))
(RS232MODEMCONTROL (QUOTE (DTR RTS)))
elseif (NULL STATE)
then (SHOULDNT (QUOTE \RS232CHAT.SWITCHSTATE))
else (\RS232CHAT.MODIFY.TERMENV (fetch SAVEDTERMENV of STATE))
(RS232MODEMCONTROL (QUOTE (DTR))))
(SETQ RS232CHATEXITSTATE (AND (NOT ENTERING?)
CURRENTSTATE)))
(RETURN CURRENTSTATE))))
(\RS232CHAT.MODIFY.TERMENV
(LAMBDA (ENV SAVECURRENT?) (* JonL " 5-MAY-83 23:05")
(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.)
(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 NIL (* JonL "29-JUN-83 10:09")
(PROG ((BLOCKINTERVAL (SETUPTIMER 0 NIL (QUOTE TICKS)))
(PROMPTSTREAM (GETSTREAM PROMPTWINDOW))
ECHOSTREAM ECHO=OUT? ECHOING.NOW? C)
(DECLARE (SPECVARS ECHO=OUT? ECHOING.NOW? PROMPTSTREAM)
(GLOBALVARS \RS232CHATBLINKER)) (* Just to be sure that these SPECVARS are "looked up")
(SETQ ECHO=OUT? (EQ \RCHATS \RS232CHAT.LocalEchoStream))
(SETQ ECHOSTREAM (OR \RS232CHAT.LocalEchoStream \RCHATS))
A (* Just printout chars from remote host, while waiting
for keyboard input.)
(repeatuntil (\SYSBUFP)
do (\RS232CHATBLINKWINK)
(if (RS232PEEKBYTE)
then (\RS232CHAT.BIN ECHOING.NOW?)
elseif (TIMEREXPIRED? BLOCKINTERVAL (QUOTE TICKS))
then (PROG NIL (* Every so often, we must permit the background
processes to run, so that we can still have a mouse.)
B (if (AND (PROG1 \RS232BACKGROUNDSTATE
(* Comment PPLossage))
(ILESSP (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT)
\RS232FTPSLOW.BaudRate))
then (BLOCK)
else (\RS232CHECK.BLOCK))
(if (PROG1 (SETQ C \RS232CHAT.MENUSIGNAL)
(SETQ \RS232CHAT.MENUSIGNAL))
then (\RS232CHATBLINKOFF)
(SELECTQ C
(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)))
(RS232LOGIN (RS232.PROMPT&LOGIN \RCHATS T))
(HELP "Unrecognized \RS23CHAT.MENUSIGNAL" C))))
(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)))
(SETQ BLOCKINTERVAL (SETUPTIMER \RS232.BLOCKINTERVAL.tics BLOCKINTERVAL
(QUOTE TICKS))))
(SERVICEIRING)) (* Send typed-in byte to remote host
(unless it is the escape char))
(if (NOT (SMALLP (SETQ C (\GETSYSBUF))))
then (SHOULDNT (QUOTE \GETSYSBUF)))
(SERVICEIRING)
(if (EQ C \RS232ESCAPE.CHARCODE)
then (ERSETQ (\RS232CHAT.DOCOMMAND))
else (* Send out the typed-in byte, but check for extra stuff
on EOL)
(if (EQ C (CHARCODE EOL))
then (RS232WRITECHARS \RS232CHAT.EOLsequence T)
else (RS232WRITEBYTE C T)) (* Perhaps local echoing for the keyboard is wanted?)
(if \RS232CHAT.LocalEchoStream
then (if ECHO=OUT?
then (\RS232CHATBLINKOFF))
(if (NOT ECHOING.NOW?)
then (SETQ ECHOING.NOW? T)
(if ECHO=OUT?
then (SERVICEIRING)
(BOUT \RS232CHAT.LocalEchoStream (CHARCODE %[))))
(SERVICEIRING)
(BOUT \RS232CHAT.LocalEchoStream C)))
(GO A))))
(\RS232CHAT.DOCOMMAND
(LAMBDA NIL (* JonL "27-JUN-83 20:31")
(DECLARE (SPECVARS PROMPTSTREAM))
(PROG (C S)
(\RS232CHATBLINKOFF)
B (SERVICEIRING)
(\RS232BOUTSTRING PROMPTSTREAM "
RS232Chat Command: ")
(SETQ S
(SELCHARQ
(SETQ C (\RS232CHAT.GETKEY))
((Q K q k)
(\RS232BOUTSTRING PROMPTSTREAM "Quit.")
(RETFROM (QUOTE \RS232CHAT.DUPLEX)))
(? (DSPRESET PROMPTWINDOW)
"? - 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))
"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))
(SERVICEIRING))))
(\RS232CHAT.GETKEY
(LAMBDA NIL (* JonL "22-NOV-82 23:12")
(eachtime (SERVICEIRING) until (\SYSBUFP) finally (RETURN (PROG1 (\GETSYSBUF)
(SERVICEIRING))))))
(\RS232CHAT.DO↑B
(LAMBDA NIL (* JonL " 9-MAY-83 14:49")
(RESETFORM (\RS232CHAT.MODIFY.TERMENV (fetch SAVEDTERMENV of RS232CHATEXITSTATE)
T)
(NLSETQ (BREAK1 NIL T RS232CHAT)))))
)
(* Byte I/O for RS232CHAT)
[DECLARE: EVAL@COMPILE
(TYPERECORD RS232CHATBINHOOK (HOOKCHARTABLE HOOKFN))
]
(RPAQ? \RS232CHAT7? T)
(RPAQ? RS232REMOTEXOFF? NIL)
(RPAQ? \RS232FTPSLOW.BaudRate 1200)
(DEFINEQ
(\RS232CHAT.BIN
(LAMBDA (LOCALECHOINGNOW?) (* JonL "27-JUN-83 20:54")
(DECLARE (SPECVARS ECHO=OUT? ECHOING.NOW? \RS232CHAT.BellSequence))
(PROG ((C (RS232READBYTE)))
(if (NULL C)
then
(* Well, we're only supposed to come to \RS232CHAT.BIN when there is a byte in the input ring buffer, but you know
how those things go ...)
(RETURN)
elseif (AND (EQ C (CHARCODE ↑G))
RS232XON\XOFF?)
then (* Can this really be right? TOPS-20 seems to do it --
JonL May 1983)
(SETQ RS232REMOTEXOFF? T)
(RETURN))
(\RS232CHATBLINKOFF) (* Even though the blinker is taken down here, it will
come back on again due to the call to \BLINKWINK in
\RS232CHAT.DUPLEX)
(if (AND RS232CHATBINHOOK (\SYNCODE (fetch HOOKCHARTABLE of RS232CHATBINHOOK)
C))
then (APPLY* (fetch HOOKFN of RS232CHATBINHOOK)
C)
elseif (NOT (FMEMB C \RS232CHAT.IgnoreCharcodes))
then (if \RS232CHAT7?
then (SETQ C (LOADBYTE C 0 7)))
(if LOCALECHOINGNOW?
then (SETQ ECHOING.NOW?)
(if ECHO=OUT?
then (BOUT \RS232CHAT.LocalEchoStream (CHARCODE %]))
(SERVICEIRING)))
(if (NULL \RCHATD)
then (BOUT \RCHATS C)
elseif (EQ C \RS232CHAT.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)
(DSPXPOSITION (DSPLEFTMARGIN NIL \RCHATD)
\RCHATD))
((LF) (* Phooey! We'd just like to have \RS232CHAT.NEWLINE be
the EOLFN for \RCHATD)
(\RS232CHAT.NEWLINE))
((BELL) (* Glaaag, the display code for BELL takes mannnny
milliseconds -- it "flashes" the DisplayStream window.)
(if (\RS232CHAT.*APPLY2* (FUNCTION BOUT)
\RCHATS C 0)
elseif \RS232CHAT.BellSequence
then (\RS232BOUTSTRING \RCHATS \RS232CHAT.BellSequence)
else (SERVICEIRING)
(RESETFORM (VIDEOCOLOR (SETQ C T))
(FRPTQ BELLCNT (\RS232CHECK.BLOCK BELLRATE)
(VIDEOCOLOR (SETQ C (NOT C))))
(SERVICEIRING))))
(BOUT \RCHATS C))))
(SERVICEIRING))))
(\RS232CHAT.NEWLINE
(LAMBDA (C) (* JonL "23-JUN-83 18:49")
(OR (\RS232CHAT.*APPLY2* (FUNCTION \RS232CHAT.NEWLINE.AUX)
C T \RS232FTPSLOW.BaudRate)
(\RS232CHAT.NEWLINE.AUX C))))
(\RS232CHAT.NEWLINE.AUX
(LAMBDA (C NO.RINGB.SERVICE.FLG) (* JonL "28-JUN-83 05:11")
(OR NO.RINGB.SERVICE.FLG (SERVICEIRING))
(PROG ((LFSIZE (IMINUS (ffetch \SFLINEFEED of \RCHATD)))
(LEFTMARGIN (ffetch \SFLeftMargin of \RCHATD))
(SCROLL? (ffetch \SFScroll of \RCHATD))
(OLDY (DSPYPOSITION NIL \RCHATD))
NEWY)
(OR NO.RINGB.SERVICE.FLG (SERVICEIRING))
(DSPXPOSITION LEFTMARGIN \RCHATD)
(OR NO.RINGB.SERVICE.FLG (SERVICEIRING))
(SETQ NEWY (IDIFFERENCE OLDY LFSIZE))
(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 LEFTMARGIN (fetch (REGION BOTTOM)
of (ffetch \SFClippingRegion
of \RCHATD))
DIFFERENTIAL))
(OR NO.RINGB.SERVICE.FLG (SERVICEIRING))
(if SCROLL?
then
(* Well, foo, as of June 83 we'll just let the system display code handle this case, not worrying about all the
time it will surely take.)
(DSPSCROLLUP \RCHATD (IDIFFERENCE OLDY \RCHATD.FONTDESCENT)
NIL
(IDIFFERENCE LFSIZE DIFFERENTIAL))
(SETQ NEWY \RCHATD.BTMY)
(GO XIT)
else (* Wrap, wrap, wrap, wrap, Wrap-around Sue -- to the
tune of the Beach Boys "Run Around Sue")
(SETQ NEWY \RCHATD.TOPY))))
(DSPCLEOL \RCHATD LEFTMARGIN (IDIFFERENCE NEWY \RCHATD.FONTDESCENT)
LFSIZE) (* Clean out the tubes on the new line)
XIT (OR NO.RINGB.SERVICE.FLG (SERVICEIRING))
(DSPYPOSITION NEWY \RCHATD)
(OR NO.RINGB.SERVICE.FLG (SERVICEIRING)))))
(\RS232CHAT.*APPLY2*
(LAMBDA (FUN A1 A2 BaudRateLimit) (* JonL "28-JUN-83 05:02")
(SERVICEIRING)
(PROG ((SLOWENOUGH (ILESSP (fetch (RS232CHARACTERISTICS BAUDRATE) of RS232INIT)
BaudRateLimit)))
(if SLOWENOUGH
then (SPREADAPPLY* FUN A1 A2)
elseif (NULL RS232XON\XOFF?)
then (RETURN)
elseif (NOT RS232REMOTEXOFF?)
then (PROG (STATUS1 STATUS2)
(UNINTERRUPTABLY
(SETQ STATUS1 (\RS232CHAT.GAGHIM T))
(SPREADAPPLY* FUN A1 A2)
(SETQ STATUS2 (\RS232CHAT.GAGHIM)))
(if (OR STATUS1 STATUS2)
then (\RS232DECODE.LINESTATUS (LOGOR (OR (FIXP STATUS1)
0)
(OR (FIXP STATUS2)
0)))))
else (* Here, either the remote host is gagged
(XOFF) or the speed is so slow that it doesn't matter)
(SPREADAPPLY* FUN A1 A2))
(SERVICEIRING)
(RETURN T))))
(\RS232CHAT.GAGHIM
(LAMBDA (OFF?) (* JonL " 5-MAY-83 19:28")
(PROG ((FIRST.STATUS (FIXP (\RS232CHECK.THRE)))
OLDHI STATUS) (* Wait until Transmitter holding register **should** be
off.)
(RS232DATAO (if OFF?
then (CHARCODE ↑S)
else (CHARCODE ↑Q)))
(if (NOT OFF?)
then (SETQ RS232REMOTEXOFF?)
(RETURN FIRST.STATUS)
else (SETQ RS232REMOTEXOFF? T)) (* Wait until 8 byte-intervals have passed "quietly"
before proceeding -- it may take him a while to hear the
XOFF)
A (SETQ OLDHI \RS232ORING.WRITE)
(during \RS232.Tovh&BIC8.tics timerUnits (QUOTE TICKS) usingTimer \RS232.THRE.BOX
do (if (RS232INTERRUPT?)
then (SETQ STATUS (\RS232.PROCESSINTERRUPT (QUOTE NOERROR)))
(if (NULL STATUS)
then (if (NEQ OLDHI \RS232ORING.WRITE)
then (* Foo, some character just walked in, so start the
waiting all over again.)
(GO A))
else (* Foo, there is some sort of error, so exit now)
(if (NOT (FIXP STATUS))
then (SHOULDNT))
(RETURN))))
(RETURN (OR (FIXP STATUS)
FIRST.STATUS)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232CHAT7? RS232REMOTEXOFF? \RS232FTPSLOW.BaudRate)
)
(* Menu, window, process, and blinker functions)
(DEFINEQ
(\RS232CHAT.GETMENUS
(LAMBDA NIL (* JonL "29-JUN-83 10:22")
(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
((7 (SETQ \RS232CHAT7? T)
"Trim incoming bytes to 7-bits")
(8 (SETQ \RS232CHAT7?)
"Don't trim incoming bytes to 7-bits")
(NewLine:LF (SETQ \RS232CHAT.NEWLINECHAR
(CHARCODE LF))
"Remote sends LF for 'NewLine'")
(NewLine:CR (SETQ \RS232CHAT.NEWLINECHAR
(CHARCODE CR))
"Remote sends CR for 'NewLine'")
(CR->CR/LF (SETQ \RS232CHAT.EOLsequence
(CONSTANT (CONCAT (CHARACTER
(CHARCODE CR))
(CHARACTER
(CHARCODE LF)))))
"'Return' key sends CR/LF")
(CR->CR (SETQ \RS232CHAT.EOLsequence
(CONSTANT (CONCAT (CHARACTER (CHARCODE
CR)))))
"'Return' key sends CR")
(Bye (SETQ \RS232CHAT.MENUSIGNAL (QUOTE Bye))
"'Hangs up' modem and exits")
(Quit (SETQ \RS232CHAT.MENUSIGNAL (QUOTE QUIT))
"Exits from RS232CHAT.")
(XON (SETQ RS232XON\OFF? T)
"Enable XON/XOFF protocol.")
(XOFF (SETQ RS232XON\OFF?)
"Disable XON/XOFF protocol.")
(ChangeSpeed (ERSETQ (APPLY (QUOTE RS232INIT)
(CONS (MENU
\RS232CHATSPEEDMENU)
(CDR RS232INIT))))
"Pop-Up menu for line speed selection")
(RAID (RAID)
"Calls RAID")
(Login (SETQ \RS232CHAT.MENUSIGNAL (QUOTE RS232LOGIN))
"Prompt for LOGIN to corresponding Host.")
(StopLogin (SETQ \RS232LOGIN.STOP? T)
"If RS232LOGIN is in process, then stops at a 'convenient' time.")
(SendBreak (RS232SENDBREAK)
"Sends 'Break' signal (0.25secs).")
(LongBreak (RS232SENDBREAK T)
"Sends 'Break' signal (3.5secs).")
(Exit (SETQ \RS232CHAT.MENUSIGNAL (QUOTE QUIT))
"Exits from RS232CHAT.")
(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')")
(Clear (DSPRESET \RS232CHATWINDOW)
"Clears this RS232CHAT window.")
(↑B (SETQ \RS232CHAT.MENUSIGNAL (QUOTE BREAK))
"Enters a Lisp-level HELP/BREAK loop")))
MENUCOLUMNS ← 2
MENUFONT ←(DSPFONT NIL WindowTitleDisplayStream)
TITLE ← "RS232Chat Coms"
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 NIL (* JonL " 8-APR-83 20:00")
(if (type? DISPLAYSTREAM (ffetch (STREAMOFDISPLAYSTREAM DISPLAYSTREAM) of \RCHATS))
then (* Makes sure that \RCHATD has its OFD pointer back to
\RCHATS)
(SETQ \RCHATD (\GETDISPLAYSTREAMFROMSTREAM \RCHATS))
((LAMBDA (DFONT CREG) (* Caches a few important values)
(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)))
(DSPFONT NIL \RCHATD)
(DSPCLIPPINGREGION NIL \RCHATD))
(SETQ \RS232CHATWINDOW (WFROMDS \RCHATD))
(replace \SFEOLFN of \RCHATD with (FUNCTION \RS232CHAT.NEWLINE))
(MAPC (QUOTE ((RESHAPEFN \RS232CHAT.RESHAPEFN)
(BUTTONEVENTFN \RS232CHAT.BUTTONFN)
(PROCESS.IDLEFN \RS232CHAT.BUTTONFN)
(PROCESS.EXITFN \RS232CHAT.PROCESS.EXIT)))
(FUNCTION (LAMBDA (X)
(WINDOWPROP \RS232CHATWINDOW (CAR X)
(CADR X)))))
(\RCHATW.SETUP \RS232CHATWINDOW)
(if (NULL (SETQ \RS232CHATBLINKER (WINDOWPROP \RS232CHATWINDOW (QUOTE RS232CHATBLINKER)))
)
then (* Be sure that there is a "caret" for it.)
(SETQ \RS232CHATBLINKER (create RS232CHATBLINKER))
(WINDOWPROP \RS232CHATWINDOW (QUOTE RS232CHATBLINKER)
\RS232CHATBLINKER))
else (SETQ \RS232CHATBLINKER (SETQ \RCHATD (SETQ \RS232CHATWINDOW))))))
(\RCHATW.SETUP
(LAMBDA (W) (* JonL "15-DEC-82 21:22")
(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 (IQUOTIENT (WINDOWPROP W (QUOTE HEIGHT))
(IABS (DSPLINEFEED NIL \RCHATD)))
127))
(SETQ LINELENGTH (IMIN 127 (LINELENGTH NIL W)))
(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 "18-DEC-82 03:55")
(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?)
(SETQ \RCHATS (GETSTREAM \RS232CHATWINDOW))
(\RCHATD.SETUP)
else (* Just re-calculates the linelength and pagelength
parameters.)
(\RCHATW.SETUP W))
T))
(\RS232CHAT.BUTTONFN
(LAMBDA (WINDOW) (* JonL "22-APR-83 16:40")
(if (AND (PROG1 RS232CHATEXITSTATE (* RS232CHATEXITSTATE is NIL when we are already within
an RS232CHAT))
(LASTMOUSESTATE (OR LEFT MIDDLE)))
then (if (NOT (WINDOWP WINDOW))
then (SHOULDNT (QUOTE WINDOW))
elseif (NOT (type? RS232CHATEXITSTATE RS232CHATEXITSTATE))
then (SHOULDNT (QUOTE RS232CHATEXITSTATE))
elseif (OR (NEQ WINDOW \RS232CHATWINDOW)
((LAMBDA (S D)
(SETQ D (fetch (STREAMOFDISPLAYSTREAM DISPLAYSTREAM) of S))
(OR (NOT (type? DISPLAYSTREAM D))
(NOT (EQ (fetch (DISPLAYSTREAM XWINDOWHINT) of D)
\RS232CHATWINDOW))))
(fetch (RS232CHATEXITSTATE GLOBALVARS \RCHATS) of RS232CHATEXITSTATE)))
then (* Foo, window still active even though someone has
reset \RS232CHATWINDOW variable.)
(replace (RS232CHATEXITSTATE GLOBALVARS \RCHATS) of RS232CHATEXITSTATE
with (GETSTREAM WINDOW (QUOTE OUTPUT))))
(EVAL.AS.PROCESS (LIST (QUOTE \RS232CHAT.REENTER)
(KWOTE RS232CHATEXITSTATE)))
elseif (LASTMOUSESTATE MIDDLE)
then (SETQ \RS232CHAT.MENUSIGNAL (QUOTE MENU)))))
(\RS232CHAT.DOMENU
(LAMBDA (WINDOW) (* JonL " 8-APR-83 20:12")
(* As of 4/8/83 this function is no longer needed;
it used to be the RIGHTBUTTONFN for the
\RS232CHATWINDOW)
(OR (WINDOWP WINDOW)
(SHOULDNT (QUOTE WINDOW)))
(if (AND (NULL RS232CHATEXITSTATE)
(EQ WINDOW \RS232CHATWINDOW)
(type? MENU \RS232CHATMENU)
(IGEQ (ffetch \SFClippingTop of (WINDOWPROP WINDOW (QUOTE DSP)))
LASTMOUSEY))
then (MENU \RS232CHATMENU)
else (* Standard RIGHTBUTTONFN when not running in RS232CHAT
or if mouse was clicked in title region)
(DOWINDOWCOM WINDOW))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RCHATD \RCHATD.FONTDESCENT \RCHATD.BTMY \RCHATD.TOPY)
)
(DEFINEQ
(\RS232CHAT.PROCESS.EXIT
(LAMBDA (MYWINDOW) (* JonL " 8-APR-83 19:45")
(\RS232CHATBLINKOFF)
((LAMBDA (PROC)
(if (AND (PROCESSP PROC)
(WINDOWPROP MYWINDOW (QUOTE PROCESS.EXITFN)
NIL))
then (DEL.PROCESS PROC)))
(WINDOWPROP MYWINDOW (QUOTE PROCESS)))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD RS232CHATBLINKER (NEXTBLINKTIME BLINKUP? BLINKINTERVAL)
NEXTBLINKTIME ←(\RCLOCK0 (NCREATE (QUOTE FIXP)))
BLINKINTERVAL ←(ITIMES \CARETRATE \RCLKMILLISECOND))
]
)
(DEFINEQ
(\RS232CHATBLINKWINK
(LAMBDA (FORCETIMEOUT?) (* JonL "28-DEC-82 05:29")
(if (NULL \RS232CHATBLINKER)
then NIL
elseif (OR FORCETIMEOUT? (TIMEREXPIRED? (fetch NEXTBLINKTIME of \RS232CHATBLINKER)
(QUOTE TICS)))
then (replace NEXTBLINKTIME of \RS232CHATBLINKER with (SETUPTIMER (fetch BLINKINTERVAL
of \RS232CHATBLINKER)
(fetch NEXTBLINKTIME
of \RS232CHATBLINKER)
(QUOTE TICS)))
(replace BLINKUP? of \RS232CHATBLINKER with (NOT (fetch BLINKUP? of \RS232CHATBLINKER)))
(SERVICEIRING)
(UNINTERRUPTABLY
(TOTOPW \RCHATD)
(BITBLT (fetch (CURSOR CURSORBITMAP) of \CARET)
0 0 (PROG1 \RCHATD (* Comment PPLossage))
(IDIFFERENCE (DSPXPOSITION NIL \RCHATD)
(fetch CURSORHOTSPOTX of \CARET))
(IDIFFERENCE (DSPYPOSITION NIL \RCHATD)
(fetch CURSORHOTSPOTY of \CARET))
CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE INVERT))))
(SERVICEIRING)))
(\RS232CHATBLINKOFF
(LAMBDA NIL (* JonL "28-DEC-82 04:55")
(if \RS232CHATBLINKER
then (SERVICEIRING)
(if (fetch BLINKUP? of \RS232CHATBLINKER)
then (\RS232CHATBLINKWINK T)) (* Either he's already off, or we turn him off)
(replace NEXTBLINKTIME of (PROG1 \RS232CHATBLINKER
(* Comment PPLossage))
with (SETUPTIMER 0 (fetch NEXTBLINKTIME of \RS232CHATBLINKER)
(QUOTE TICS)))) (* And set his timer now so that any subsequent calls to
\BLINKWINK will turn him on)
(SERVICEIRING)))
)
(RPAQ? \RS232CHATWINDOW NIL)
(RPAQ? \RS232CHATMENU NIL)
(RPAQ? \RS232CHATSPEEDMENU NIL)
(RPAQ? \RS232CHAT.MENUSIGNAL NIL)
(RPAQ? \RS232CHATBLINKER NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232CHATWINDOW \RS232CHATMENU \RS232CHATSPEEDMENU \RS232CHAT.MENUSIGNAL
\RS232CHATBLINKER)
)
(PUTPROPS RS232CHAT COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4983 17378 (RS232CHAT 4993 . 6281) (\RS232CHAT.REENTER 6283 . 7777) (
\RS232CHAT.SWITCHSTATE 7779 . 9935) (\RS232CHAT.MODIFY.TERMENV 9937 . 10676) (\RS232CHAT.DUPLEX 10678
. 14234) (\RS232CHAT.DOCOMMAND 14236 . 16867) (\RS232CHAT.GETKEY 16869 . 17110) (\RS232CHAT.DO↑B
17112 . 17376)) (17601 25274 (\RS232CHAT.BIN 17611 . 20539) (\RS232CHAT.NEWLINE 20541 . 20794) (
\RS232CHAT.NEWLINE.AUX 20796 . 22769) (\RS232CHAT.*APPLY2* 22771 . 23845) (\RS232CHAT.GAGHIM 23847 .
25272)) (25444 34913 (\RS232CHAT.GETMENUS 25454 . 28892) (\RCHATD.SETUP 28894 . 30618) (\RCHATW.SETUP
30620 . 32028) (\RS232CHAT.RESHAPEFN 32030 . 32699) (\RS232CHAT.BUTTONFN 32701 . 34079) (
\RS232CHAT.DOMENU 34081 . 34911)) (35027 35381 (\RS232CHAT.PROCESS.EXIT 35037 . 35379)) (35622 37504 (
\RS232CHATBLINKWINK 35632 . 36773) (\RS232CHATBLINKOFF 36775 . 37502)))))
STOP