(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Aug-88 13:16:59" {ERINYES}<LISPUSERS>LYRIC>CHATEMACS.;2 15331
changes to%: (ADVICE CHAT.CLOSE CHAT.INIT)
(FNS CHAT.TYPEOUT CHAT.TYPEIN)
(VARS CHATEMACSCOMS)
previous date%: " 9-Dec-87 12:22:32" {PHYLUM}<GOBBEL>LISP>CHATEMACS.;9)
(* "
Copyright (c) 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT CHATEMACSCOMS)
(RPAQQ CHATEMACSCOMS
((DECLARE%: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (FILES (SOURCE FROM LOADUP)
CHATDECLS))
(DECLARE%: (GLOBALVARS CHATEMACS.SWITCH.ENABLED CHAT.META.ESC))
(INITVARS (CHATEMACS.SWITCH.ENABLED T)
(CHAT.META.ESC T))
(FNS CHAT.BUTTONFN CHAT.TYPEIN CHAT.TYPEOUT)
(ADVISE CHAT.INIT CHAT.CLOSE)))
(DECLARE%: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE FROM LOADUP)
CHATDECLS)
)
(DECLARE%:
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS CHATEMACS.SWITCH.ENABLED CHAT.META.ESC)
)
)
(RPAQ? CHATEMACS.SWITCH.ENABLED T)
(RPAQ? CHAT.META.ESC T)
(DEFINEQ
(CHAT.BUTTONFN
[LAMBDA (WINDOW) (* ; "Edited 9-Dec-87 12:05 by Gobbel")
(GETMOUSESTATE)
(if (type? CHAT.STATE (WINDOWPROP WINDOW 'CHATSTATE))
then [with CHAT.STATE (WINDOWPROP WINDOW '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 '(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) (* ; "Edited 17-Aug-88 17:46 by Randy.Gobbel")
(DECLARE (SPECVARS STREAM)) (* ; "so that menu can change it")
(PROG ((THISPROC (THIS.PROCESS))
(DEFAULTSTREAM T)
(STATE (WINDOWPROP WINDOW '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 'TTYEXITFN (FUNCTION CHAT.TTYEXITFN))
(PROCESSPROP THISPROC '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 'WINDOW WINDOW)
(SETQ WINDOWSTREAM (WINDOWPROP WINDOW 'DSP))
(DSPFONT (OR CHAT.FONT (DEFAULTFONT 'DISPLAY))
WINDOWSTREAM)
(DSPRESET WINDOWSTREAM)
(WINDOWPROP WINDOW 'PROCESS (THIS.PROCESS))
(WINDOWPROP WINDOW '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 'DISPLAYTYPE))
(SETQ DISPLAYNAME (fetch (CHATDISPLAYTYPE DPYNAME) of DISPLAYTYPE]
(replace (CHAT.STATE TYPEOUTPROC) of STATE with (ADD.PROCESS
`(CHAT.TYPEOUT ,WINDOW ',DISPLAYNAME
',STATE)
',NAME
'CHAT.TYPEOUT))
[COND
(DISPLAYTYPE (CHAT.SETDISPLAYTYPE INSTREAM (fetch (CHATDISPLAYTYPE DPYCODE) of
DISPLAYTYPE
]
(CHAT.SCREENPARAMS STATE INSTREAM WINDOW)
(AND (NEQ LOGOPTION 'NONE)
(CHAT.LOGIN HOST LOGOPTION WINDOW STATE))
[COND
(INITSTREAM (NLSETQ (SETQ STREAM (COND
((STRINGP INITSTREAM)
(OPENSTRINGSTREAM INITSTREAM))
(T (OPENSTREAM INITSTREAM '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) (* ; "Edited 18-Aug-88 16:07 by Randy.Gobbel")
(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 'TEDIT)
(SETQ OUTSTREAM (WINDOWPROP WINDOW 'TEXTSTREAM]
(T (SETQ OUTSTREAM (WINDOWPROP WINDOW '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 'MESSAGE))
(PRIN1 MSG OUTSTREAM)
(STREAMPROP INSTREAM '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)))
(if ESCPENDING
then (SETQ ESCPENDING NIL)
(SELCHARQ CH
(1 (if (NOT (fetch (CHAT.STATE CHATINEMACS) of CHAT.STATE))
then (CHAT.SWITCH.EMACS CHAT.STATE WINDOW)))
(0 (if (fetch (CHAT.STATE CHATINEMACS) of CHAT.STATE)
then (CHAT.SWITCH.EMACS CHAT.STATE WINDOW)))
(PROGN (SPREADAPPLY* HANDLECHARFN (CHARCODE ESC)
CHAT.STATE TERM.STATE)
(SPREADAPPLY* HANDLECHARFN CH CHAT.STATE TERM.STATE)))
else (if (EQ CH (CHARCODE ESC))
then (SETQ ESCPENDING T)
else (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 'CLOSE "closed"))
(-2 (CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE 'ABORT "aborted"))
(CHAT.TYPEOUT.CLOSE WINDOW OUTSTREAM CHAT.STATE 'CLOSE "closed somehow"))
(COND
((NOT (OPENWP WINDOW))
(DEL.PROCESS (WINDOWPROP WINDOW 'PROCESS])
)
[XCL:REINSTALL-ADVICE 'CHAT.INIT :AFTER '((:LAST (WINDOWPROP WINDOW 'RIGHTBUTTONFN
(FUNCTION CHAT.BUTTONFN]
[XCL:REINSTALL-ADVICE 'CHAT.CLOSE :AFTER '((:LAST (WINDOWPROP WINDOW 'RIGHTBUTTONFN NIL]
(READVISE CHAT.INIT CHAT.CLOSE)
(PUTPROPS CHATEMACS COPYRIGHT ("Xerox Corporation" 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1196 14957 (CHAT.BUTTONFN 1206 . 3395) (CHAT.TYPEIN 3397 . 10096) (CHAT.TYPEOUT 10098
. 14955)))))
STOP