(FILECREATED "23-Apr-87 17:08:34" {PHYLUM}<GOBBEL>LISP>CHATEMACS.;6 11080
changes to: (FNS CHAT.BUTTONFN CHAT.TYPEOUT)
(VARS CHATEMACSCOMS)
previous date: "20-Mar-87 19:16:51" {PHYLUM}<GOBBEL>LISP>CHATEMACS.;4)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CHATEMACSCOMS)
(RPAQQ CHATEMACSCOMS ((DECLARE: (GLOBALVARS CHATEMACS.SWITCH.ENABLED))
(INITVARS (CHATEMACS.SWITCH.ENABLED T))
(FNS CHAT.BUTTONFN CHAT.TYPEIN CHAT.TYPEOUT)
(ADVISE CHAT.INIT CHAT.CLOSE)))
(DECLARE:
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CHATEMACS.SWITCH.ENABLED)
)
)
(RPAQ? CHATEMACS.SWITCH.ENABLED T)
(DEFINEQ
(CHAT.BUTTONFN
[LAMBDA (WINDOW) (* Randy.Gobbel "23-Apr-87 17:02")
(GETMOUSESTATE)
(if (type? CHAT.STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
then [with CHAT.STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE))
(LET ((CY (LASTMOUSEY WINDOW))
(CX (LASTMOUSEX WINDOW))
(BUTTONS LASTMOUSEBUTTONS)
(TTYLINES (IQUOTIENT TTYHEIGHT FONTHEIGHT))
CSTRING
(SHIFTSTATE 0))
(* * The characters are FONTHEIGHT high by FONTWIDTH wide)
(COND
[(IGREATERP CY TOPMARGIN)
(COND
((MOUSESTATE (ONLY RIGHT))
(DOWINDOWCOM WINDOW))
((MOUSESTATE (ONLY MIDDLE))
(CHAT.MENU WINDOW]
((EQ BUTTONS 0)
NIL)
(CHATINEMACS (for SS in (QUOTE (SHIFT CTRL META)) as I
from 1 by I when (SHIFTDOWNP SS)
do (SETQ SHIFTSTATE (IPLUS SHIFTSTATE I)))
(SETQ CY (MAX (SUB1 (IDIFFERENCE TTYLINES
(IQUOTIENT
CY FONTHEIGHT)))
0))
(SETQ CX (IQUOTIENT (IPLUS (IQUOTIENT FONTWIDTH 2)
CX)
FONTWIDTH))
(SETQ CSTRING (CONCAT (CHARACTER (CHARCODE ↑\))
CX ";" CY ";" BUTTONS ";"
SHIFTSTATE ";"))
(UNINTERRUPTABLY
(BKSYSBUF CSTRING)))
(T (CHAT.HOLD WINDOW]
else (DOWINDOWCOM WINDOW])
(CHAT.TYPEIN
[LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* Randy.Gobbel " 9-Mar-87 12:01")
(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
((AND CHAT.META.ESC (NEQ (LOGAND CH 256)
0))
(BOUT CHATSTREAM 27)
(LOGAND CH 127))
((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 (COND
((AND CHAT.META.ESC (NEQ (LOGAND (SETQ CH
(\BIN STREAM))
256)
0))
(BOUT CHATSTREAM 27)
(LOGAND CH 127))
(T CH]
(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.TYPEOUT
[LAMBDA (WINDOW DPYNAME CHAT.STATE) (* Randy.Gobbel "20-Mar-87 18:38")
(bind (CNT ← 1)
HANDLECHARFN MSG CH INSTREAM OUTSTREAM TYPESCRIPTSTREAM CRPENDING ESCPENDING 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)
(SETQ CH (LOGAND CH (MASK.1'S 0 7)))
(SELCHARQ CH
(ESC (if ESCPENDING
then (SETQ ESCPENDING NIL)
(if CHATEMACS.SWITCH.ENABLED
then (CHAT.SWITCH.EMACS CHAT.STATE WINDOW))
else (SETQ ESCPENDING T)))
(PROGN (SETQ ESCPENDING NIL)
(SPREADAPPLY* HANDLECHARFN CH CHAT.STATE TERM.STATE)))
[COND
((SETQ TYPESCRIPTSTREAM (fetch (CHAT.STATE TYPESCRIPTSTREAM) of CHAT.STATE))
(COND
((SELCHARQ CH
(CR (PROG1 CRPENDING (SETQ CRPENDING T)))
(LF (COND
(CRPENDING (\OUTCHAR TYPESCRIPTSTREAM (CHARCODE EOL))
(* Have the typescript put turn crlf into whatever it
likes for eol)
(SETQ CRPENDING NIL))
(T T)))
(PROGN (COND
(CRPENDING (\BOUT TYPESCRIPTSTREAM (CHARCODE CR))
(SETQ CRPENDING NIL)))
T))
(\BOUT TYPESCRIPTSTREAM CH]
[COND
(CHATDEBUGFLG (COND
((OR (EQ CHATDEBUGFLG T)
(IGREATERP (add CNT 1)
CHATDEBUGFLG))
(BLOCK)
(SETQ CNT 1]
finally (SELECTQ CH
(-1 (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])
)
(PUTPROPS CHAT.INIT READVICE [NIL (AFTER NIL (WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION CHAT.BUTTONFN])
(PUTPROPS CHAT.CLOSE READVICE (NIL (AFTER NIL (WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
NIL))))
(READVISE CHAT.INIT CHAT.CLOSE)
(PUTPROPS CHATEMACS COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (669 10730 (CHAT.BUTTONFN 679 . 2287) (CHAT.TYPEIN 2289 . 7620) (CHAT.TYPEOUT 7622 .
10728)))))
STOP