(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "31-Mar-89 17:08:22" {ERINYES}MEDLEY>CHATEMACS.;2 19237 changes to%: (FILES CHATDECLS) (FNS CHAT.BUTTONFN CHAT.TYPEIN CHAT.TYPEOUT CHAT.SCREENPARAMS) (VARS CHATEMACSCOMS) previous date%: "18-Jan-89 16:46:52" |{IE:PARC:XEROX}MEDLEY>CHATEMACS.;1|) (* " Copyright (c) 1987, 1988, 1989 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 CHAT.SCREENPARAMS) (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 4-Mar-89 21:55 by Randy.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 ^\)) "m" CX ";" CY ";" BUTTONS ";" SHIFTSTATE ";")) (UNINTERRUPTABLY (BKSYSBUF CSTRING))) (T (CHAT.HOLD WINDOW] else (DOWINDOWCOM WINDOW]) (CHAT.TYPEIN [LAMBDA (HOST WINDOW LOGOPTION INITSTREAM) (* ; "Edited 4-Mar-89 21:55 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 CSTRING) (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!!!") [COND ((STREAMPROP CHATSTREAM 'SEND.SCREEN.SIZE) (STREAMPROP CHATSTREAM 'SEND.SCREEN.SIZE NIL) (SETQ CSTRING (CONCAT (CHARACTER (CHARCODE ^\)) "s" (IQUOTIENT (fetch (CHAT.STATE TTYWIDTH) of STATE) (fetch (CHAT.STATE FONTWIDTH) of STATE)) ";" (IQUOTIENT (fetch (CHAT.STATE TTYHEIGHT) of STATE) (fetch (CHAT.STATE FONTHEIGHT) of STATE)) ";")) (UNINTERRUPTABLY (BKSYSBUF CSTRING))] (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 4-Mar-89 21:44 by Randy.Gobbel") (bind (CNT _ 1) HANDLECHARFN MSG CH INSTREAM DSPSTREAM TYPESCRIPTSTREAM CRPENDING ESCPENDING TERM.STATE CHAT.OUTSTREAM first (SETQ INSTREAM (fetch (CHAT.STATE INSTREAM) of CHAT.STATE )) (SETQ CHAT.OUTSTREAM (fetch (CHAT.STATE OUTSTREAM) 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 DSPSTREAM (WINDOWPROP WINDOW 'TEXTSTREAM] (T (SETQ DSPSTREAM (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 DSPSTREAM) (COND ((SETQ MSG (STREAMPROP INSTREAM 'MESSAGE)) (PRIN1 MSG DSPSTREAM) (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) (STREAMPROP CHAT.OUTSTREAM 'SEND.SCREEN.SIZE T))) (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 DSPSTREAM CHAT.STATE 'CLOSE "closed")) (-2 (CHAT.TYPEOUT.CLOSE WINDOW DSPSTREAM CHAT.STATE 'ABORT "aborted")) (CHAT.TYPEOUT.CLOSE WINDOW DSPSTREAM CHAT.STATE 'CLOSE "closed somehow")) (COND ((NOT (OPENWP WINDOW)) (DEL.PROCESS (WINDOWPROP WINDOW 'PROCESS]) (CHAT.SCREENPARAMS [LAMBDA (CHAT.STATE INSTREAM WINDOW) (* ; "Edited 4-Mar-89 22:09 by Randy.Gobbel") (* ;; "Sends screen width, height to partner and updates title. If INSTREAM is NIL then only update title.") (PROG ((HEIGHT (IMIN [IQUOTIENT (WINDOWPROP WINDOW 'HEIGHT) (IABS (DSPLINEFEED NIL (WINDOWPROP WINDOW 'DSP] 127)) (WIDTH (IMIN (LINELENGTH NIL WINDOW) 127)) (TITLE (WINDOWPROP WINDOW 'TITLE)) EMACSMODE TITLEMIDDLE) (COND (INSTREAM (CHAT.SENDSCREENPARAMS INSTREAM HEIGHT WIDTH))) [WINDOWPROP WINDOW '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 ""] (COND (EMACSMODE (STREAMPROP (fetch (CHAT.STATE OUTSTREAM) of CHAT.STATE) 'SEND.SCREEN.SIZE T]) ) [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 1989)) (DECLARE%: DONTCOPY (FILEMAP (NIL (1254 18858 (CHAT.BUTTONFN 1264 . 3610) (CHAT.TYPEIN 3612 . 11510) (CHAT.TYPEOUT 11512 . 16871) (CHAT.SCREENPARAMS 16873 . 18856))))) STOP