(FILECREATED "16-AUG-83 17:51:53" {PHYLUM}<LISPCORE>SOURCES>CHAT.;53 47813
changes to: (FNS GETCHATWINDOW)
previous date: "31-JUL-83 17:25:48" {PHYLUM}<LISPCORE>SOURCES>CHAT.;52)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT CHATCOMS)
(RPAQQ CHATCOMS ((COMS (* CHAT and its main -- typein -- process)
(FNS CHAT CHAT.TYPEIN CHAT.BIN BSPSOUT CHAT.CLOSE CHAT.WHENCLOSED
CHAT.DISABLE.INTERRUPTS CHAT.ENABLE.INTERRUPTS CHAT.FLASHCARET
CHAT.LOGINFO CHAT.COMPUTE.LOGINFO CHAT.SENDSCREENPARAMS))
(COMS (* Typeout process, datamedia simulation)
(FNS CHAT.TYPEOUT CHAT.HANDLECHARACTER)
(FNS CHAT.ADDCHAR CHAT.ADDLINE CHAT.ADDRESS CHAT.CLEAR CHAT.CLEARMODES CHAT.DELCHAR
CHAT.DELETELINE CHAT.DOWN CHAT.ERASE.TO.EOL CHAT.ERASEBITS CHAT.HOME CHAT.LEFT
CHAT.NEWLINE CHAT.PRINTCHAR CHAT.RIGHT CHAT.UP))
(FNS CHAT.TYPESCRIPT)
(COMS (* window stuff)
(FNS GETCHATWINDOW CHAT.BUTTONFN CHAT.HOLD CHAT.MENU CHAT.RECONNECT CHAT.RESHAPEWINDOW
CHAT.BEFORE.LOGOUT CHAT.TTYENTRYFN CHAT.TTYEXITFN))
(COMS (* BSP hackers)
(FNS CHAT.ERRORHANDLER CHAT.HANDLEMARK CHAT.PUPHANDLER CHAT.IMMEDIATE.PUPHANDLER))
(INITVARS (CHAT.CONTROLCHAR 193)
(CHAT.METACHAR 195)
(CHAT.DISPLAYTYPE 10)
(CHAT.INTERRUPTS)
(DEFAULTCHATHOST (QUOTE MAXC2))
(CHATDEBUGFLG)
(CTRLC.COUNT 4)
(CHATWINDOWLST)
(CHAT.OLDINTERRUPTS)
(CHATWINDOW)
(CHAT.AUTOCRLF T)
(CLOSECHATWINDOWFLG)
(CHAT.ALLHOSTS)
(CHAT.HOSTMENU)
(CHAT.FONT))
(VARS (CHATMENU)
(CHAT.REOPENMENU))
[DECLARE: DONTEVAL@LOAD DOCOPY (ADDVARS (BEFORELOGOUTFORMS (CHAT.BEFORE.LOGOUT]
(COMS (* Caret stuff)
(FNS \DOWNCARET \FLIPCARET)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CARET)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CHATUSERSTATE)
(CONSTANTS (\PT.WHEREISUSER 152)
(\PT.WHEREUSERRESPONSE 153)
(\PT.WHEREUSERERROR 154))
(ALISTS (PUPPRINTMACROS 152 154))
(CONSTANTS (\PUPSOCKET.TELNET 1)
(\PUPSOCKET.MISCSERVICES 4))
(CONSTANTS * CHATMARKTYPES)
(GLOBALVARS CHAT.CONTROLCHAR CHAT.METACHAR CHAT.DISPLAYTYPE CHAT.OLDINTERRUPTS
CHATDEBUGFLG CHATMARKTYPES CHATMENU CHATWINDOW CHATWINDOWLST
CTRLC.COUNT DEFAULTCHATHOST PUPTYPES CHAT.INTERRUPTS INVERTWINDOWFN
WHITESHADE CHAT.AUTOCRLF CLOSECHATWINDOWFLG CHAT.HOSTMENU CHAT.ALLHOSTS
CHAT.FONT)
(LOCALVARS . T))
(INITVARS (INVERTWINDOWFN (QUOTE INVERTW)))
(FNS CHAT.ADD.BACKGROUND.COMMAND)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (CHAT.ADD.BACKGROUND.COMMAND))
(FILES BSP PROC))))
(* CHAT and its main -- typein -- process)
(DEFINEQ
(CHAT
[LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* bvm: "22-JUL-83 15:34")
[COND
((NOT (THIS.PROCESS))
(PRIN1 "Turning on Process mechanism and trying again...
" T)
(COND
((READP T)
(PRINTBELLS)
(DISMISS 1750Q)))
(CLEARBUF T)
[BKSYSBUF (MKSTRING (CONS (QUOTE CHAT)
(AND (OR HOST LOGOPTION)
(CONS (KWOTE HOST)
(AND LOGOPTION (CONS (KWOTE LOGOPTION]
(RETEVAL (QUOTE CHAT)
(QUOTE (PROCESSWORLD T]
(PROG (SOCKET PORT MSG PROCESS)
[OR HOST (COND
[FROMMENU [SETQ HOST (MENU (OR CHAT.HOSTMENU (SETQ CHAT.HOSTMENU
(create MENU
ITEMS ←(APPEND (UNION (LIST DEFAULTCHATHOST)
CHAT.ALLHOSTS)
(QUOTE (Other)))
TITLE ← "Host"]
(COND
((EQ HOST (QUOTE Other))
(SETQ HOST NIL))
((NULL HOST)
(RETURN]
(T (SETQ HOST DEFAULTCHATHOST]
TOP [COND
((NOT HOST)
(COND
([NOT (SETQ HOST (CAR (PROCESS.READ (AND FROMMENU PROMPTWINDOW)
"
Host: "]
(GO FAIL]
(COND
((EQ HOST (QUOTE ?))
(SETQ HOST)
(PRIN1 "Enter name of host to chat to, or NIL to abort" (COND
(FROMMENU PROMPTWINDOW)
(T T)))
(GO TOP))
[(NOT (SETQ PORT (ETHERPORT HOST)))
(SETQ MSG (CONS HOST (QUOTE (not found]
([NOT (SETQ SOCKET (OPENBSPSTREAM (COND
((ZEROP (CDR PORT))
(* No socket given, use normal telnet socket)
(CONS (CAR PORT)
\PUPSOCKET.TELNET))
(T PORT))
(FUNCTION CHAT.IMMEDIATE.PUPHANDLER)
(FUNCTION CHAT.ERRORHANDLER)
NIL NIL (FUNCTION CHAT.WHENCLOSED]
(SETQ MSG (CONCAT "Unable to open Chat connection with " HOST)))
(T (SETQ WINDOW (GETCHATWINDOW (SETQ HOST (\CANONICAL.HOSTNAME HOST))
WINDOW))
(COND
((NOT (FMEMB HOST CHAT.ALLHOSTS))
(SETQ CHAT.ALLHOSTS (CONS HOST CHAT.ALLHOSTS))
(SETQ CHAT.HOSTMENU)))
[WINDOWPROP WINDOW (QUOTE CHATSTATE)
(SETBSPUSERINFO SOCKET
(create CHATUSERSTATE
RUNNING? ← T
SYNCHCOUNT ← 0
CARETSTATE ←(create CARET
CARETDS ←(WINDOWPROP
WINDOW
(QUOTE DSP]
(* Need to store this info with the socket as well so
that the error handler can get at it)
(WINDOWPROP WINDOW (QUOTE SOCKET)
SOCKET)
[WINDOWPROP WINDOW (QUOTE PROCESS)
(SETQ PROCESS (ADD.PROCESS (LIST (QUOTE CHAT.TYPEIN)
SOCKET WINDOW (KWOTE LOGOPTION)
(KWOTE HOST)
(KWOTE INITSTREAM))
(QUOTE NAME)
(PACK* "CHAT#" HOST)
(QUOTE RESTARTABLE)
(QUOTE NO)
(QUOTE WINDOW)
WINDOW
(QUOTE TTYENTRYFN)
(FUNCTION CHAT.TTYENTRYFN)
(QUOTE TTYEXITFN)
(FUNCTION CHAT.TTYEXITFN]
(WINDOWPROP WINDOW (QUOTE CHATHOST)
(CONS HOST LOGOPTION))
(TTY.PROCESS PROCESS) (* transfer control to the chat window)
(RETURN HOST)))
(COND
(FROMMENU (PRIN1 MSG PROMPTWINDOW)))
FAIL[COND
((AND WINDOW (WINDOWPROP WINDOW (QUOTE CHATHOST)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT]
(RETURN MSG])
(CHAT.TYPEIN
[LAMBDA (SOCKET WINDOW LOGOPTION HOST INITSTREAM) (* bvm: "22-JUL-83 15:33")
(DECLARE (SPECVARS STREAM)) (* so that menu can change it)
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION CHAT.RESHAPEWINDOW))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.BUTTONFN))
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
(FUNCTION CHAT.CLOSE))
[RESETSAVE (PROGN WINDOW)
(QUOTE (AND RESETSTATE (CHAT.CLOSE OLDVALUE 0]
(* If an error occurs, process is killed, or HARDRESET
happens, this will flush the connection etc)
(bind (DEFAULTSTREAM ← T)
(STATE ←(WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(CHATSTREAM ←(BSPOUTPUTSTREAM SOCKET))
(WINDOWSTREAM ←(WINDOWPROP WINDOW (QUOTE DSP)))
STREAM CH
first (replace TYPEOUTPROC of STATE with (ADD.PROCESS (LIST (QUOTE CHAT.TYPEOUT)
SOCKET WINDOW)))
(CHAT.SENDSCREENPARAMS CHATSTREAM WINDOW)
(AND (NEQ LOGOPTION (QUOTE NONE))
(SETQ LOGOPTION (CHAT.LOGINFO HOST LOGOPTION))
(PRIN3 LOGOPTION CHATSTREAM))
(COND
(INITSTREAM (XNLSETQ (SETQ STREAM (\GETOFD (OR (STRINGP INITSTREAM)
(OPENFILE INITSTREAM (QUOTE INPUT)))
(QUOTE INPUT)))
NOBREAK)))
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))
(while (\SYSBUFP)
do (SETQ CH (\GETKEY))
(BOUT CHATSTREAM (COND
((EQ CH CHAT.CONTROLCHAR) (* Controlify it)
(LOGAND (CHAT.BIN SOCKET STATE)
37Q))
((EQ CH CHAT.METACHAR) (* Prefix meta, turn on 200q bit)
(LOGOR (CHAT.BIN SOCKET STATE)
200Q))
(T CH]
(T (until (EOFP STREAM) do (BOUT CHATSTREAM (\BIN STREAM)))
(CLOSEF STREAM)
(SETQ STREAM)))
(BSPFORCEOUTPUT CHATSTREAM)
(CHAT.FLASHCARET STATE)
(BLOCK)
(SELECTQ (fetch RUNNING? of STATE)
[NIL (* Connection died somehow)
(while (fetch UNUSUALQ of STATE) do (BLOCK))
(* Wait for CHAT.TYPEOUT to finish.
Not sure this is really necessary)
(RETURN (CHAT.CLOSE WINDOW (COND
((BSPOPENP SOCKET (QUOTE OUTPUT))
1750Q)
(T 0]
(CLOSE (RETURN (CHAT.CLOSE WINDOW 35230Q)))
NIL))
(* * Get here if we close connection.)
(BLOCK])
(CHAT.BIN
[LAMBDA (SOCKET STATE) (* bvm: "28-APR-82 18:35")
(until (\SYSBUFP) bind FIRSTTIME←T do (COND
(FIRSTTIME (BSPFORCEOUTPUT SOCKET)
(SETQ FIRSTTIME NIL)))
(CHAT.FLASHCARET STATE)
(BLOCK))
(\GETKEY])
(BSPSOUT
[LAMBDA (STREAM STR) (* bvm: "10-MAY-83 18:28")
(PRIN3 STR STREAM])
(CHAT.CLOSE
[LAMBDA (WINDOW TIMEOUT ABORTED) (* bvm: "31-JUL-83 15:48")
(* Close chat connection that is using WINDOW.
Also serves as the CLOSEFN of this window, when TIMEOUT
is NIL)
(PROG ((CHATSTATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
PROC FILE SOCKET KEEP)
(COND
[CHATSTATE (SETQ SOCKET (WINDOWPROP WINDOW (QUOTE SOCKET)))
(DEL.PROCESS (fetch TYPEOUTPROC of CHATSTATE))
(\DOWNCARET (fetch CARETSTATE of CHATSTATE))
(COND
((SETQ FILE (fetch TYPESCRIPTOFD of CHATSTATE))
(TERPRI WINDOW)
(PRIN1 "Closing " WINDOW)
(PRINT (CLOSEF FILE)
WINDOW)))
(WINDOWPROP WINDOW (QUOTE CHATSTATE)
NIL)
(WINDOWPROP WINDOW (QUOTE SOCKET)
NIL)
(OR ABORTED (CLOSEBSPSTREAM SOCKET (OR TIMEOUT 0]
(T (RETURN)))
(SETQ CHATWINDOWLST (DREMOVE WINDOW CHATWINDOWLST))
(SETQ PROC (WINDOWPROP WINDOW (QUOTE PROCESS)
NIL))
(* Save the process running, if any; don't do anything with it until after we close the window, if we're going to,
so that windows don't flip around excessively)
(WINDOWPROP WINDOW (QUOTE CLOSEFN)
NIL)
[COND
((AND (NOT (SETQ KEEP (WINDOWPROP WINDOW (QUOTE KEEPCHAT)
NIL)))
(FIXP TIMEOUT)
(OR CLOSECHATWINDOWFLG (NEQ WINDOW CHATWINDOW)))
(CLOSEW WINDOW))
(T (* Change title to indicate closure)
(PROG [(TITLE (WINDOWPROP WINDOW (QUOTE TITLE]
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (SUBSTRING TITLE 1 (SUB1 (OR (STRPOS ", height" TITLE)
0)))
", closed")))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(COND
((EQ KEEP (FUNCTION NEW)) (* Window will be busy soon)
(FUNCTION TOTOPW))
(T (FUNCTION CHAT.RECONNECT]
[COND
((EQ KEEP (QUOTE NEW)) (* Invoked via the New command -- start up a new
connection in this window)
(ADD.PROCESS (LIST (QUOTE CHAT)
NIL NIL NIL WINDOW T]
(COND
(PROC (* Do this last, because if we are PROC, DEL.PROCESS
won't return)
(DEL.PROCESS PROC])
(CHAT.WHENCLOSED
[LAMBDA (BSPSTREAM) (* bvm: " 5-JUN-83 16:03")
(PROG ((CHATSTATE (GETBSPUSERINFO BSPSTREAM))
WINDOW)
(COND
([AND CHATSTATE (SETQ WINDOW (find WINDOW in CHATWINDOWLST
suchthat (EQ (WINDOWPROP WINDOW (QUOTE CHATSTATE))
CHATSTATE]
(CHAT.CLOSE WINDOW NIL T])
(CHAT.DISABLE.INTERRUPTS
[LAMBDA NIL (* bvm: "24-AUG-81 00:08")
(DECLARE (GLOBALVARS \CURRENTINTERRUPTS CHAT.OLDINTERRUPTS CHAT.INTERRUPTS))
(* Turns off interrupts and returns a list of things to
feed to INTERRUPTCHAR to turn them back on)
(OR CHAT.OLDINTERRUPTS (PROG1 [SETQ CHAT.OLDINTERRUPTS (for PAIR
in (APPEND \CURRENTINTERRUPTS)
collect (INTERRUPTCHAR (CAR PAIR]
(* Turn everything off, then turn selected interrupts
back on)
(MAPC CHAT.INTERRUPTS (FUNCTION INTERRUPTCHAR])
(CHAT.ENABLE.INTERRUPTS
[LAMBDA NIL (* bvm: "21-AUG-81 16:20")
(MAPC CHAT.OLDINTERRUPTS (FUNCTION INTERRUPTCHAR))
(SETQ CHAT.OLDINTERRUPTS])
(CHAT.FLASHCARET
[LAMBDA (CHATSTATE) (* bvm: "23-SEP-81 12:16")
(OR (fetch HELD of CHATSTATE)
(\FLIPCARET (fetch CARETSTATE of CHATSTATE])
(CHAT.LOGINFO
[LAMBDA (HOST OPTION) (* bvm: " 8-FEB-83 18:35")
(PROG ((NAME/PASS (\INTERNAL/GETPASSWORD HOST))
COM)
(RETURN (SELECTQ [SETQ COM (OR OPTION (CHAT.COMPUTE.LOGINFO HOST (CAR NAME/PASS]
((LOGIN ATTACH)
(CONCAT COM " " (CAR NAME/PASS)
" "
(CDR NAME/PASS)
" "
(CHARACTER EOLCHARCODE)))
(WHERE (CONCAT COM " " (CAR NAME/PASS)
(CHARACTER EOLCHARCODE)
"ATTACH "
(CAR NAME/PASS)
" "
(CDR NAME/PASS)
" "))
(GUEST (CONCAT "LOGIN GUEST GUEST " (CHARACTER EOLCHARCODE)))
NIL])
(CHAT.COMPUTE.LOGINFO
[LAMBDA (HOST USER) (* bvm: "14-FEB-83 10:40")
(PROG ((OPUP (ALLOCATE.PUP))
SOC LEN IPUP)
(SETUPPUP OPUP HOST \PUPSOCKET.MISCSERVICES \PT.WHEREISUSER NIL (SETQ SOC (\GETMISCSOCKET))
T)
(PUTPUPSTRING OPUP USER)
(RETURN (to \MAXETHERTRIES when (SETQ IPUP (EXCHANGEPUPS SOC OPUP NIL T))
do (SELECTC (fetch PUPTYPE of IPUP)
[\PT.WHEREUSERRESPONSE
(RETURN (COND
[(IGREATERP (SETQ LEN (IDIFFERENCE (fetch PUPLENGTH
of IPUP)
\PUPOVLEN))
0)
(for (I ← 1) to LEN by 2
bind (DATA ←(fetch PUPCONTENTS of IPUP))
JOB
do [COND
((EQ (\GETBASEBYTE DATA I)
377Q)
(* Term=377Q means detached)
(COND
(JOB
(* More than one detached job, punt)
(RETURN (QUOTE WHERE)))
(T (SETQ JOB (\GETBASEBYTE DATA
(SUB1 I]
finally (RETURN (COND
(JOB (QUOTE ATTACH))
(T (QUOTE LOGIN]
(T (QUOTE LOGIN]
(\PT.WHEREUSERERROR (RETURN))
[\PT.ERROR (COND
((EQ (fetch ERRORPUPCODE of IPUP)
2) (* No such port)
(RETURN]
NIL])
(CHAT.SENDSCREENPARAMS
[LAMBDA (SOCKET WINDOW) (* bvm: "31-DEC-00 16:33")
(* * Sends screen width, height to partner)
(PROG [(HEIGHT (IMIN [IQUOTIENT (WINDOWPROP WINDOW (QUOTE HEIGHT))
(IABS (DSPLINEFEED NIL (WINDOWPROP WINDOW (QUOTE DSP]
127))
(WIDTH (IMIN (LINELENGTH NIL WINDOW)
127))
(TITLE (WINDOWPROP WINDOW (QUOTE TITLE]
(BSPPUTMARK SOCKET \MARK.TERMTYPE)
(BSPBOUT SOCKET CHAT.DISPLAYTYPE) (* Terminal type of "display")
(BSPPUTMARK SOCKET \MARK.PAGELENGTH)
(BSPBOUT SOCKET HEIGHT)
(BSPPUTMARK SOCKET \MARK.LINEWIDTH)
(BSPBOUT SOCKET WIDTH)
(WINDOWPROP WINDOW (QUOTE TITLE)
(CONCAT (SUBSTRING TITLE 1 (SUB1 (OR (STRPOS ", height" TITLE)
0)))
", height = " HEIGHT ", width = " WIDTH])
)
(* Typeout process, datamedia simulation)
(DEFINEQ
(CHAT.TYPEOUT
[LAMBDA (SOCKET WINDOW) (* rrb "18-APR-83 18:24")
(DECLARE (SPECVARS WINDOW DSP OUTSTREAM DINGED EATLF EATCRLF EATTOCRLF AUTOLF TTYWIDTH TTYHEIGHT
XPOS YPOS ADDRESSING IDMODE ROLLMODE BLINKMODE FONTWIDTH FONTHEIGHT
FONTDESCENT FONT PLAINFONT CHATBOLDFONT HOMEPOS))
(bind (STATE ←(WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(DSP ←(WINDOWPROP WINDOW (QUOTE DSP)))
(XPOS ← 0)
(YPOS ← 0)
HOMEPOS
(CNT ← 1)
(OUTSTREAM ←(\GETOFD WINDOW (QUOTE OUTPUT)))
TYPESCRIPTSTREAM TTYWIDTH TTYHEIGHT DINGED CH COM CARET ADDRESSING IDMODE (ROLLMODE ← T)
BLINKMODE EATLF EATCRLF EATTOCRLF AUTOLF FONT CHATBOLDFONT PLAINFONT FONTWIDTH FONTHEIGHT
FONTDESCENT
first (push (fetch UNUSUALQ of STATE)
(QUOTE FIRST)) (* Hack to initialize)
(SETQ CARET (fetch CARETSTATE of STATE))
while T
do (SETQ CH (BSPBIN SOCKET))
(while (fetch HELD of STATE) do (BLOCK))
(\DOWNCARET CARET)
[while (fetch UNUSUALQ of STATE)
do (* Stuff that happened while we were HELD or that menu
did)
(SETQ COM (pop (fetch UNUSUALQ of STATE)))
(COND
[(LITATOM COM) (* Reset state)
(SETQ TYPESCRIPTSTREAM (fetch TYPESCRIPTOFD of STATE))
(SETQ FONTHEIGHT (IMINUS (DSPLINEFEED NIL DSP)))
[SETQ FONTWIDTH (CHARWIDTH (CHARCODE A)
(SETQ PLAINFONT (SETQ FONT (DSPFONT NIL DSP]
(SETQ FONTDESCENT (FONTPROP FONT (QUOTE DESCENT)))
(SETQ TTYWIDTH (WINDOWPROP WINDOW (QUOTE WIDTH)))
(SETQ TTYWIDTH (ITIMES (IQUOTIENT TTYWIDTH FONTWIDTH)
FONTWIDTH)) (* Make TTYWIDTH multiple of FONTWIDTH)
(SETQ TTYHEIGHT (WINDOWPROP WINDOW (QUOTE HEIGHT)))
(SETQ HOMEPOS (IPLUS (ITIMES (SUB1 (IQUOTIENT TTYHEIGHT FONTHEIGHT))
FONTHEIGHT)
FONTDESCENT))
(COND
((EQ COM (QUOTE FIRST))
(CHAT.HOME]
(T (CHAT.PUPHANDLER COM SOCKET OUTSTREAM]
(* Handle any error pups etc that came in while we were
asleep)
[COND
[(IGEQ CH 0) (* Normal char)
(COND
((IGREATERP (fetch SYNCHCOUNT of STATE)
0) (* In the middle of flushing output from a synch)
)
(T (CHAT.HANDLECHARACTER CH)))
(COND
(TYPESCRIPTSTREAM (\BOUT TYPESCRIPTSTREAM CH]
(T (SELECTQ CH
(-1 (* Mark byte)
(CHAT.HANDLEMARK SOCKET STATE OUTSTREAM))
((-2 -3) (* Dead)
(COND
((EQ CH -2)
(PRIN1 "
[Connection closed by remote host]
" OUTSTREAM)))
(while T
do (* Wait to be killed)
(replace UNUSUALQ of STATE with NIL)
(* flush any errors that come along, so CHAT.TYPEIN
doesn't wait on us)
(BLOCK)))
(printout OUTSTREAM "[Unknown: " CH "]"]
(COND
(CHATDEBUGFLG (COND
((OR (EQ CHATDEBUGFLG T)
(IGREATERP (add CNT 1)
CHATDEBUGFLG))
(BLOCK)
(SETQ CNT 1])
(CHAT.HANDLECHARACTER
[LAMBDA (CHAR) (* bvm: "17-SEP-82 13:05")
(DECLARE (USEDFREE WINDOW DSP OUTSTREAM DINGED EATLF EATCRLF EATTOCRLF AUTOLF TTYWIDTH TTYHEIGHT
XPOS YPOS ADDRESSING IDMODE ROLLMODE BLINKMODE FONT PLAINFONT CHATBOLDFONT
FONTWIDTH FONTHEIGHT FONTDESCENT HOMEPOS))
(* Here and/or below)
(PROG NIL
[COND
((EQ CHAR (CHARCODE BELL))
(RETURN (COND
((NOT DINGED)
(APPLY* INVERTWINDOWFN WINDOW) (* Complement window)
(SETQ DINGED T]
(COND
(DINGED (APPLY* INVERTWINDOWFN WINDOW)
(SETQ DINGED NIL)))
(COND
((AND AUTOLF (OR (NEQ CHAR (CHARCODE CR))
(NOT EATTOCRLF)))
(* We last received a CR, so DM wants auto LF after it. However, we postpone doing so until the next char is
received, so that we get scroll holding right)
(CHAT.DOWN)
(SETQ AUTOLF NIL)))
[COND
(ADDRESSING (COND
((CHAT.ADDRESS CHAR)
(RETURN]
[COND
((IGEQ CHAR (CHARCODE SPACE)) (* Normal char)
(SETQ EATLF (SETQ EATCRLF NIL))
(RETURN (COND
((AND (NEQ CHAR (CHARCODE DEL))
(NOT EATTOCRLF)) (* Print the char)
(COND
(IDMODE (CHAT.ADDCHAR))
(T (CHAT.PRINTCHAR CHAR]
[COND
(EATLF (SETQ EATLF NIL) (* LF is ignored after CR)
(COND
((EQ CHAR (CHARCODE LF))
(RETURN]
[COND
(EATCRLF (* We just wrapped around, so ignore CR and/or LF if
next)
(COND
((EQ CHAR (CHARCODE CR))
(SETQ EATLF T)
(RETURN (SETQ EATCRLF NIL)))
(T (* Intervening control characters do not stop the
eating, except for a few inconsistent exceptions...)
(SELCHARQ CHAR
((↑B ↑\ ↑↑ ↑←)
(SETQ EATCRLF NIL))
NIL]
(SELCHARQ CHAR
[LF (COND
(IDMODE (CHAT.ADDLINE))
(T (CHAT.DOWN]
(CR (SETQ EATTOCRLF NIL)
(CHAT.NEWLINE T))
[BS (COND
(IDMODE (CHAT.DELCHAR))
(T (CHAT.LEFT]
(↑W (* Erase to end of line)
(CHAT.ERASE.TO.EOL))
(↑L (* Start of cursor address)
(SETQ ADDRESSING -1))
(↑B (* Homes cursor, cancels some modes)
(CHAT.HOME)
(CHAT.CLEARMODES))
(↑X (* Cancel --resets modes)
(CHAT.CLEARMODES)
(SETQ ROLLMODE))
((↑↑ ↑←) (* Master Reset -- Clears screen, modes)
(CHAT.CLEAR))
[↑\ (* Forward space)
(COND
((NOT EATTOCRLF)
(COND
(IDMODE (CHAT.ADDCHAR))
(T (CHAT.RIGHT]
[↑Z (* Up)
(COND
(IDMODE (CHAT.DELETELINE))
(T (CHAT.UP]
[(↑N ↑O) (* Enter blink mode, enter protected mode.
Do both as embolden)
(COND
((NOT BLINKMODE)
(SETQ BLINKMODE T)
(DSPFONT [SETQ FONT (OR CHATBOLDFONT (SETQ CHATBOLDFONT
(FONTCOPY PLAINFONT (QUOTE WEIGHT)
(QUOTE BOLD]
DSP]
(↑P (* Enter i/d mode)
(SETQ IDMODE T))
(↑%] (* Set roll mode)
(SETQ ROLLMODE T))
NIL])
)
(DEFINEQ
(CHAT.ADDCHAR
[LAMBDA NIL (* bvm: "28-APR-82 21:46")
(* Insert a space at cursor position, pushing rest of
line to right)
(PROG ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP XPOS Y DSP (IPLUS XPOS FONTWIDTH)
Y
(IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Blt remainder of line to the right by FONTWIDTH, then
erase the character under the cursor)
(CHAT.ERASEBITS XPOS Y FONTWIDTH FONTHEIGHT])
(CHAT.ADDLINE
[LAMBDA (ATYPOS) (* bvm: "28-APR-82 18:19")
(OR ATYPOS (SETQ ATYPOS YPOS)) (* To insert line at ATYPOS, we blt everything below it
down one, then clear the line at ATYPOS)
(BITBLT DSP 0 FONTHEIGHT DSP 0 0 TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(CHAT.ERASEBITS 0 (IDIFFERENCE ATYPOS FONTDESCENT)
TTYWIDTH FONTHEIGHT])
(CHAT.ADDRESS
[LAMBDA (CHAR) (* bvm: "28-APR-82 21:22")
(* In the middle of doing absolute address.
Return T unless a cancel is received)
(COND
((SELCHARQ CHAR
((↑X ↑↑ ↑←)
T)
NIL) (* Cancel it)
(SETQ ADDRESSING NIL))
((EQ CHAR (CHARCODE ↑L)) (* Restarting the address in the middle of the address
is legal)
(SETQ ADDRESSING -1))
((ILESSP ADDRESSING 0) (* Accept first position)
(SETQ ADDRESSING (LOGXOR CHAR 140Q)))
(T (* Accept second position and go there)
(MOVETO (SETQ XPOS (IMIN (ITIMES ADDRESSING FONTWIDTH)
(IDIFFERENCE TTYWIDTH FONTWIDTH)))
[SETQ YPOS (IMAX FONTDESCENT (IDIFFERENCE HOMEPOS (ITIMES (LOGXOR CHAR 140Q)
FONTHEIGHT]
DSP)
(SETQ ADDRESSING)
T])
(CHAT.CLEAR
[LAMBDA (SETROLL) (* bvm: "17-SEP-82 12:53")
(CLEARW WINDOW)
(CHAT.CLEARMODES)
(AND SETROLL (SETQ ROLLMODE T))
(CHAT.HOME])
(CHAT.CLEARMODES
[LAMBDA NIL (* bvm: "17-SEP-82 13:03")
(COND
(BLINKMODE (* Restore normal font)
(DSPFONT PLAINFONT DSP)
(SETQ FONT PLAINFONT)
(SETQ BLINKMODE)))
(SETQ IDMODE (SETQ ADDRESSING])
(CHAT.DELCHAR
[LAMBDA NIL (* bvm: "28-APR-82 21:48")
(* Delete character under cursor, moving rest of line to
left)
(PROG ((Y (IDIFFERENCE YPOS FONTDESCENT)))
(BITBLT DSP (IPLUS XPOS FONTWIDTH)
Y DSP XPOS Y (IPLUS (IDIFFERENCE TTYWIDTH XPOS)
FONTWIDTH)
FONTHEIGHT
(QUOTE INPUT)
(QUOTE REPLACE)) (* Blt remainder of line to the left by FONTWIDTH, then
erase the rightmost character position)
(CHAT.ERASEBITS (IDIFFERENCE TTYWIDTH FONTWIDTH)
Y FONTWIDTH FONTHEIGHT])
(CHAT.DELETELINE
[LAMBDA (ATYPOS) (* bvm: "28-APR-82 18:16")
(OR ATYPOS (SETQ ATYPOS YPOS)) (* To delete line at ATYPOS, we blt everything below it
up one, then clear the bottom line)
(BITBLT DSP 0 0 DSP 0 FONTHEIGHT TTYWIDTH (IDIFFERENCE ATYPOS FONTDESCENT)
(QUOTE INPUT)
(QUOTE REPLACE))
(CHAT.ERASEBITS 0 0 TTYWIDTH FONTHEIGHT])
(CHAT.DOWN
[LAMBDA NIL (* bvm: "28-APR-82 17:05")
(* Move down a line)
(COND
((IGREATERP YPOS FONTDESCENT)
(MOVETO XPOS (SETQ YPOS (IDIFFERENCE YPOS FONTHEIGHT))
DSP))
((NULL ROLLMODE) (* Wraparound to top)
(MOVETO XPOS (SETQ YPOS HOMEPOS)
DSP))
(T (* On bottom line in rollmode, scroll screen up one)
(CHAT.DELETELINE HOMEPOS])
(CHAT.ERASE.TO.EOL
[LAMBDA NIL (* bvm: "28-APR-82 21:16")
(CHAT.ERASEBITS XPOS (IDIFFERENCE YPOS FONTDESCENT)
(IDIFFERENCE TTYWIDTH XPOS)
FONTHEIGHT])
(CHAT.ERASEBITS
[LAMBDA (LEFT BOTTOM WIDTH HEIGHT) (* bvm: "28-APR-82 18:13")
(BITBLT NIL NIL NIL DSP LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(CHAT.HOME
[LAMBDA NIL (* bvm: "28-APR-82 16:42")
(MOVETO (SETQ XPOS 0)
(SETQ YPOS HOMEPOS)
DSP])
(CHAT.LEFT
[LAMBDA NIL (* bvm: "28-APR-82 21:42")
(COND
((IGREATERP XPOS 0)
(MOVETO (SETQ XPOS (IDIFFERENCE XPOS FONTWIDTH))
YPOS DSP])
(CHAT.NEWLINE
[LAMBDA (EXPLICIT) (* bvm: "28-APR-82 17:05")
(* Do a CRLF. EXPLICIT = T means a CR was received, NIL
means we did autowraparound)
(MOVETO (SETQ XPOS 0)
YPOS DSP) (* Do only the CR part now, saving the LF for when next
char arrives)
(SETQ AUTOLF T)
(COND
(EXPLICIT (SETQ EATLF T))
(T (SETQ EATCRLF T])
(CHAT.PRINTCHAR
[LAMBDA (CHAR) (* bvm: "28-APR-82 21:14")
(\OUTCHAR OUTSTREAM CHAR)
(COND
((IGEQ (add XPOS FONTWIDTH)
TTYWIDTH) (* Have reached right margin, so wrap around)
(COND
(CHAT.AUTOCRLF (CHAT.NEWLINE))
(T (SETQ EATTOCRLF T])
(CHAT.RIGHT
[LAMBDA NIL (* bvm: "28-APR-82 21:33")
(COND
((ILESSP (IPLUS XPOS FONTWIDTH)
TTYWIDTH)
(add XPOS FONTWIDTH)
(MOVETO XPOS YPOS DSP))
(T (* Auto crlf)
(CHAT.NEWLINE])
(CHAT.UP
[LAMBDA NIL (* bvm: "28-APR-82 16:59")
(COND
((ILESSP YPOS HOMEPOS)
(MOVETO XPOS (SETQ YPOS (IPLUS YPOS FONTHEIGHT))
DSP])
)
(DEFINEQ
(CHAT.TYPESCRIPT
[LAMBDA (CHATSTATE) (* bvm: "13-JUN-82 14:28")
(NLSETQ (PROG ((FILE (PROCESS.READ PROMPTWINDOW "Typescript to file: " T))
OLDFILE)
(COND
((AND FILE (NEQ (SETQ FILE (CAR FILE))
T))
(COND
([OR (NULL FILE)
(NLSETQ (SETQ FILE (OPENFILE FILE (QUOTE OUTPUT)
(QUOTE NEW]
(COND
((SETQ OLDFILE (fetch TYPESCRIPTOFD of CHATSTATE))
(PRIN1 "Closing " PROMPTWINDOW)
(PRINT (CLOSEF OLDFILE)
PROMPTWINDOW)))
[replace TYPESCRIPTOFD of CHATSTATE with (AND FILE (\GETOFD (PRIN2 FILE
PROMPTWINDOW]
(push (fetch UNUSUALQ of CHATSTATE)
T))
(T (PRIN1 "failed" PROMPTWINDOW])
)
(* window stuff)
(DEFINEQ
(GETCHATWINDOW
[LAMBDA (HOST WINDOW) (* bvm: "16-AUG-83 17:51")
(* Return a window, possibly new, to run a chat
connection to HOST. Uses WINDOW if possible)
(PROG ((TITLE (CONCAT "Chat connection to " HOST))
DSP STATE)
[COND
[[AND (WINDOWP (OR WINDOW (SETQ WINDOW CHATWINDOW)))
(OR [NOT (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(COND
((NOT (fetch RUNNING? of STATE)) (* Connection in CHATWINDOW is dead)
(CHAT.CLOSE WINDOW)
T] (* Old window not in use)
(WINDOWPROP WINDOW (QUOTE TITLE)
TITLE)
(SETQ DSP (WINDOWPROP WINDOW (QUOTE DSP]
(T (SETQ DSP (WINDOWPROP (SETQ WINDOW (CREATEW NIL TITLE))
(QUOTE DSP)))
(DSPSCROLL T DSP)
(OR CHATWINDOW (SETQ CHATWINDOW WINDOW]
(DSPFONT (OR CHAT.FONT (DEFAULTFONT (QUOTE DISPLAY)))
DSP)
(DSPRESET DSP)
(push CHATWINDOWLST WINDOW)
(RETURN WINDOW])
(CHAT.BUTTONFN
[LAMBDA (WINDOW) (* bvm: " 9-AUG-81 15:16")
(COND
((LASTMOUSESTATE RED)
(CHAT.HOLD WINDOW))
((LASTMOUSESTATE YELLOW)
(CHAT.MENU WINDOW])
(CHAT.HOLD
[LAMBDA (WINDOW) (* bvm: "23-SEP-81 12:14")
(* * Toggle HOLD while button is down)
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(TOTOPW WINDOW)
(OR STATE (RETURN))
[COND
((NOT (fetch HELD of STATE))
(replace HELD of STATE with T)
(UNINTERRUPTABLY
(UNTILMOUSESTATE UP))]
(replace HELD of STATE with NIL])
(CHAT.MENU
[LAMBDA (WINDOW) (* bvm: "21-JUL-83 17:29")
(DECLARE (GLOBALVARS CHATMENU CHAT.REOPENMENU)) (* Called by YELLOW)
(PROG ((SOCKET (WINDOWPROP WINDOW (QUOTE SOCKET)))
STATE)
[COND
((NOT SOCKET) (* No Connection here; try to reestablish)
(RETURN (COND
((LASTMOUSESTATE MIDDLE)
(CHAT.RECONNECT WINDOW))
(T (TOTOPW WINDOW]
(replace HELD of (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE))) with NIL)
(* (BSPFORCEOUTPUT SOCKET))
(replace HELD of STATE with T)
(\DOWNCARET (fetch CARETSTATE of STATE))
(SELECTQ [MENU (OR CHATMENU (SETQ CHATMENU (create MENU
ITEMS ←(QUOTE ((Close (QUOTE Close)
"Closes the connection and returns")
(Suspend (QUOTE Suspend)
"Closes the connection but leaves window up")
(New (QUOTE New)
"Closes this connection and prompts for a new host")
(Clear (QUOTE Clear)
"Clears window, sets roll mode")
(Freeze (QUOTE Freeze)
"Holds typeout in this window until you bug it again")
(Dribble (QUOTE Dribble)
"Starts a typescript of window typeout")
(Input (QUOTE Input)
"Allows input from a file"]
(Close (replace RUNNING? of STATE with (QUOTE CLOSE)))
(New (replace RUNNING? of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
(QUOTE NEW)))
(Suspend (replace RUNNING? of STATE with (QUOTE CLOSE))
(WINDOWPROP WINDOW (QUOTE KEEPCHAT)
T))
[Clear (PROCESS.EVAL (fetch TYPEOUTPROC of STATE)
(QUOTE (CHAT.CLEAR T]
(Freeze (* Leave in HELD state)
(RETURN))
(Dribble (CHAT.TYPESCRIPT STATE))
[Input (PROG ((FILE (PROCESS.READ PROMPTWINDOW "Take input from file: " T)))
[COND
((AND FILE (CAR FILE))
(SETQ FILE (CAR (COND
[(NLSETQ (OPENFILE (CAR FILE)
(QUOTE INPUT]
(T (PRINT (ERRORSTRING (CAR (ERRORN)))
PROMPTWINDOW)
(PRINT (CADR (ERRORN))
PROMPTWINDOW)
(RETURN]
(PROCESS.APPLY (WINDOWPROP WINDOW (QUOTE PROCESS))
(FUNCTION SET)
(LIST (QUOTE STREAM)
(\GETOFD FILE (QUOTE INPUT]
NIL)
(replace HELD of STATE with NIL])
(CHAT.RECONNECT
[LAMBDA (WINDOW) (* bvm: "31-JUL-83 17:08")
(PROG [(STATE (WINDOWPROP WINDOW (QUOTE CHATHOST]
(COND
((NULL STATE)
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE TOTOPW))
(TOTOPW WINDOW))
((NOT (LASTMOUSESTATE MIDDLE))
(TOTOPW WINDOW))
([MENU (OR CHAT.REOPENMENU (SETQ CHAT.REOPENMENU (create MENU
ITEMS ←(QUOTE ((ReConnect T
"Will reestablish this Chat connection"]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE TOTOPW)) (* Don't let this command get issued twice)
(ADD.PROCESS (LIST (QUOTE CHAT)
(KWOTE (CAR STATE))
(KWOTE (CDR STATE))
NIL WINDOW T])
(CHAT.RESHAPEWINDOW
[LAMBDA (WINDOW OLDIMAGE OLDREGION) (* bvm: "15-JAN-82 15:24")
(* RESHAPEFN for the chat window)
(RESHAPEBYREPAINTFN WINDOW OLDIMAGE OLDREGION)
(PROG [(SOCKET (WINDOWPROP WINDOW (QUOTE SOCKET]
(COND
(SOCKET (CHAT.SENDSCREENPARAMS SOCKET (WINDOWPROP WINDOW (QUOTE DSP)))
(push (fetch UNUSUALQ of (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
T) (* Tell CHAT.TYPEOUT to reset parms)
])
(CHAT.BEFORE.LOGOUT
[LAMBDA NIL (* bvm: "31-JUL-83 15:51")
(* * called before logout, aborts chat connections)
(while CHATWINDOWLST do (CHAT.CLOSE (CAR CHATWINDOWLST)
500])
(CHAT.TTYENTRYFN
[LAMBDA (PROCESS) (* bvm: "22-JUL-83 15:12")
(* Switch to a chat window)
(PROG ((WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW)))
STATE)
(COND
((SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(replace HELD of STATE with NIL)))
(CHAT.DISABLE.INTERRUPTS])
(CHAT.TTYEXITFN
[LAMBDA (PROCESS NEWPROCESS) (* bvm: "22-JUL-83 15:11")
(PROG ((WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW)))
STATE)
[COND
([AND WINDOW (SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE]
(* Switch from chat window)
(\DOWNCARET (fetch CARETSTATE of STATE]
(CHAT.ENABLE.INTERRUPTS])
)
(* BSP hackers)
(DEFINEQ
(CHAT.ERRORHANDLER
[LAMBDA (SOCKET ERRCODE) (* bvm: " 5-MAR-82 16:54")
(SELECTQ ERRCODE
(MARK.ENCOUNTERED -1)
(COND
((BSPOPENP SOCKET (QUOTE BOTH)) (* non-fatal error?)
(printout T "[" ERRCODE "]")
-4)
(T (replace RUNNING? of (GETBSPUSERINFO SOCKET) with NIL)
(COND
((BSPOPENP SOCKET (QUOTE OUTPUT))
-2)
(T -3])
(CHAT.HANDLEMARK
[LAMBDA (SOCKET CHATSTATE TTYFILE) (* bvm: "23-SEP-81 11:59")
(PROG ((MARK (BSPGETMARK SOCKET)))
(SELECTC MARK
(\MARK.TIMING (* For synchronization)
(BSPPUTMARK SOCKET \MARK.TIMINGREPLY))
(\MARK.SYNC (* For use with Synch interrupt)
(add (fetch SYNCHCOUNT of CHATSTATE)
-1))
(PROGN (PRIN1 "[Mark " TTYFILE)
(PRIN2 MARK TTYFILE)
(PRIN1 "]" TTYFILE])
(CHAT.PUPHANDLER
[LAMBDA (PUP SOCKET FILE) (* bvm: " 8-FEB-83 18:48")
(DECLARE (GLOBALVARS PUPTRACEFILE))
(* * called on error and non-bsp pups. CHAT.IMMEDIATE.PUPHANDLER has already filtered out interrupts and non-2
errors)
(PROG (OFFSET)
(COND
((SELECTC (fetch PUPTYPE of PUP)
(\PT.ERROR (* For now don't filter out abort errors)
(printout FILE T "[Error] ")
(SETQ OFFSET 30Q))
(\PT.ABORT (printout FILE T "[Abort] ")
(SETQ OFFSET 2))
(COND
((NEQ PUPTRACEFILE T)
(PRIN1 "{Strange pup: " PUPTRACEFILE)
(PRINTCONSTANT (fetch PUPTYPE of PUP)
PUPTYPES PUPTRACEFILE)
(PRIN1 "}" PUPTRACEFILE)
NIL)))
(printout FILE (GETPUPSTRING PUP OFFSET)
T)))
(RELEASE.PUP PUP])
(CHAT.IMMEDIATE.PUPHANDLER
[LAMBDA (PUP SOCKET) (* bvm: " 8-FEB-83 18:45")
(DECLARE (GLOBALVARS PUPTRACEFILE))
(* * called on error, interrupt and non-bsp pups. Anything that we'd be inclined to print to T is queued up for
CHAT.TYPEOUT to handle)
(PROG ((INFO (GETBSPUSERINFO SOCKET)))
(COND
((NULL INFO) (* CHAT has died. Synchrony problem that we got here at
all)
)
((SELECTC (fetch PUPTYPE of PUP)
(\PT.ERROR (* For now don't filter out abort errors)
(COND
((EQ (fetch ERRORPUPCODE of PUP)
2)
T)
((NEQ PUPTRACEFILE T)
(PRINTERRORPUP PUP PUPTRACEFILE)
NIL)))
(\PT.INTERRUPT (* Synch. Means flush any output waiting to be processed
up until the matching Synch Mark)
(add (fetch SYNCHCOUNT of (GETBSPUSERINFO SOCKET))
1)
NIL)
T)
(change (fetch UNUSUALQ of INFO)
(NCONC1 DATUM PUP)))
(T (RELEASE.PUP PUP])
)
(RPAQ? CHAT.CONTROLCHAR 193)
(RPAQ? CHAT.METACHAR 195)
(RPAQ? CHAT.DISPLAYTYPE 10)
(RPAQ? CHAT.INTERRUPTS )
(RPAQ? DEFAULTCHATHOST (QUOTE MAXC2))
(RPAQ? CHATDEBUGFLG )
(RPAQ? CTRLC.COUNT 4)
(RPAQ? CHATWINDOWLST )
(RPAQ? CHAT.OLDINTERRUPTS )
(RPAQ? CHATWINDOW )
(RPAQ? CHAT.AUTOCRLF T)
(RPAQ? CLOSECHATWINDOWFLG )
(RPAQ? CHAT.ALLHOSTS )
(RPAQ? CHAT.HOSTMENU )
(RPAQ? CHAT.FONT )
(RPAQQ CHATMENU NIL)
(RPAQQ CHAT.REOPENMENU NIL)
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BEFORELOGOUTFORMS (CHAT.BEFORE.LOGOUT))
)
(* Caret stuff)
(DEFINEQ
(\DOWNCARET
[LAMBDA (CARET) (* bvm: "21-SEP-81 22:47")
(AND (fetch UP of CARET)
(\FLIPCARET CARET T)) (* CARET:FORCEDDOWN is set so that caret will come up
quickly.)
(replace FORCEDDOWN of CARET with T])
(\FLIPCARET
[LAMBDA (CARET FORCE) (* lmm "15-OCT-82 11:01")
(* changes the caret from on to off or off to on.)
(COND
([AND (fetch CURSORBM of CARET)
(OR FORCE (fetch FORCEDDOWN of CARET)
(IGREATERP (CLOCK0 (fetch NOWTIME of CARET))
(fetch THENTIME of CARET]
(UNINTERRUPTABLY (* note the time of the next change.)
(* must be done without creating boxes because happens
during keyboard wait.)
(\BOXIPLUS (CLOCK0 (fetch THENTIME of CARET))
(fetch CARETRATE of CARET))
(replace UP of CARET with (NOT (fetch UP of CARET)))
(* CARET:DOWN indicates whether caret is on or off.
necessary so it can be turned off before the character
is echoed)
(* CARET:FORCEDDOWN indicates that the caret was taken
down so that it will go back up quickly.)
(replace FORCEDDOWN of CARET with NIL)
(PROG ((DS (fetch CARETDS of CARET))
(CURS (fetch CURSORBM of CARET)))
(BITBLT (fetch CURSORBITMAP of CURS)
0 0 DS (IDIFFERENCE (DSPXPOSITION NIL DS)
(fetch CURSORHOTSPOTX of CURS))
(IDIFFERENCE (DSPYPOSITION NIL DS)
(fetch CURSORHOTSPOTY of CURS))
CURSORWIDTH CURSORHEIGHT (QUOTE INPUT)
(QUOTE INVERT))))])
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD CARET (NOWTIME THENTIME FORCEDDOWN UP CARETDS CURSORBM CARETRATE)
NOWTIME ←(CREATECELL \FIXP)
THENTIME ←(CREATECELL \FIXP)
CURSORBM ← \CARET CARETRATE ← \CARETRATE)
]
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD CHATUSERSTATE (RUNNING? HELD CARETSTATE SYNCHCOUNT UNUSUALQ TYPESCRIPTOFD TYPEOUTPROC))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \PT.WHEREISUSER 152)
(RPAQQ \PT.WHEREUSERRESPONSE 153)
(RPAQQ \PT.WHEREUSERERROR 154)
(CONSTANTS (\PT.WHEREISUSER 152)
(\PT.WHEREUSERRESPONSE 153)
(\PT.WHEREUSERERROR 154))
)
(ADDTOVAR PUPPRINTMACROS (152 CHARS)
(154 CHARS))
(DECLARE: EVAL@COMPILE
(RPAQQ \PUPSOCKET.TELNET 1)
(RPAQQ \PUPSOCKET.MISCSERVICES 4)
(CONSTANTS (\PUPSOCKET.TELNET 1)
(\PUPSOCKET.MISCSERVICES 4))
)
(RPAQQ CHATMARKTYPES ((\MARK.SYNC 1)
(\MARK.LINEWIDTH 2)
(\MARK.PAGELENGTH 3)
(\MARK.TERMTYPE 4)
(\MARK.TIMING 5)
(\MARK.TIMINGREPLY 6)))
(DECLARE: EVAL@COMPILE
(RPAQQ \MARK.SYNC 1)
(RPAQQ \MARK.LINEWIDTH 2)
(RPAQQ \MARK.PAGELENGTH 3)
(RPAQQ \MARK.TERMTYPE 4)
(RPAQQ \MARK.TIMING 5)
(RPAQQ \MARK.TIMINGREPLY 6)
(CONSTANTS (\MARK.SYNC 1)
(\MARK.LINEWIDTH 2)
(\MARK.PAGELENGTH 3)
(\MARK.TERMTYPE 4)
(\MARK.TIMING 5)
(\MARK.TIMINGREPLY 6))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS CHAT.CONTROLCHAR CHAT.METACHAR CHAT.DISPLAYTYPE CHAT.OLDINTERRUPTS CHATDEBUGFLG
CHATMARKTYPES CHATMENU CHATWINDOW CHATWINDOWLST CTRLC.COUNT DEFAULTCHATHOST PUPTYPES
CHAT.INTERRUPTS INVERTWINDOWFN WHITESHADE CHAT.AUTOCRLF CLOSECHATWINDOWFLG CHAT.HOSTMENU
CHAT.ALLHOSTS CHAT.FONT)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(RPAQ? INVERTWINDOWFN (QUOTE INVERTW))
(DEFINEQ
(CHAT.ADD.BACKGROUND.COMMAND
[LAMBDA NIL (* rrb "23-FEB-83 10:02")
(* RRB works for both old menu updating scheme and for new. The first part of the COND can be removed once the Feb
23 version of lisp is released.)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands))
(COND
[(type? MENU BackgroundMenu)
(PROG ((BACKGROUNDITEMS (fetch ITEMS of BackgroundMenu)))
(RETURN (OR (FASSOC (QUOTE CHAT)
BACKGROUNDITEMS)
(SETQ BackgroundMenu
(create MENU
ITEMS ←(CONS (QUOTE (CHAT (COND
[(THIS.PROCESS)
(ADD.PROCESS (QUOTE (CHAT NIL NIL
NIL NIL T]
(T (ERROR "No Processes!" "" T)))
"Runs a new CHAT process; prompts for host"))
BACKGROUNDITEMS]
((FASSOC (QUOTE CHAT)
BackgroundMenuCommands))
(T (SETQ BackgroundMenuCommands
(CONS (QUOTE (CHAT (COND
[(THIS.PROCESS)
(ADD.PROCESS (QUOTE (CHAT NIL NIL NIL NIL T]
(T (ERROR "No Processes!" "" T)))
"Runs a new CHAT process; prompts for host"))
BackgroundMenuCommands)) (* set it to NIL here so that after first condition is
removed it will still work.)
(SETQ BackgroundMenu NIL])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(CHAT.ADD.BACKGROUND.COMMAND)
(FILESLOAD BSP PROC)
)
(PUTPROPS CHAT COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2673 16520 (CHAT 2683 . 6125) (CHAT.TYPEIN 6127 . 9028) (CHAT.BIN 9030 . 9341) (BSPSOUT
9343 . 9471) (CHAT.CLOSE 9473 . 11929) (CHAT.WHENCLOSED 11931 . 12314) (CHAT.DISABLE.INTERRUPTS 12316
. 13074) (CHAT.ENABLE.INTERRUPTS 13076 . 13281) (CHAT.FLASHCARET 13283 . 13495) (CHAT.LOGINFO 13497
. 14153) (CHAT.COMPUTE.LOGINFO 14155 . 15619) (CHAT.SENDSCREENPARAMS 15621 . 16518)) (16571 23803 (
CHAT.TYPEOUT 16581 . 20037) (CHAT.HANDLECHARACTER 20039 . 23801)) (23804 30598 (CHAT.ADDCHAR 23814 .
24492) (CHAT.ADDLINE 24494 . 24989) (CHAT.ADDRESS 24991 . 26048) (CHAT.CLEAR 26050 . 26260) (
CHAT.CLEARMODES 26262 . 26583) (CHAT.DELCHAR 26585 . 27293) (CHAT.DELETELINE 27295 . 27751) (CHAT.DOWN
27753 . 28335) (CHAT.ERASE.TO.EOL 28337 . 28564) (CHAT.ERASEBITS 28566 . 28785) (CHAT.HOME 28787 .
28955) (CHAT.LEFT 28957 . 29162) (CHAT.NEWLINE 29164 . 29700) (CHAT.PRINTCHAR 29702 . 30066) (
CHAT.RIGHT 30068 . 30393) (CHAT.UP 30395 . 30596)) (30599 31395 (CHAT.TYPESCRIPT 30609 . 31393)) (
31421 38565 (GETCHATWINDOW 31431 . 32553) (CHAT.BUTTONFN 32555 . 32784) (CHAT.HOLD 32786 . 33288) (
CHAT.MENU 33290 . 36044) (CHAT.RECONNECT 36046 . 36807) (CHAT.RESHAPEWINDOW 36809 . 37395) (
CHAT.BEFORE.LOGOUT 37397 . 37664) (CHAT.TTYENTRYFN 37666 . 38107) (CHAT.TTYEXITFN 38109 . 38563)) (
38590 41710 (CHAT.ERRORHANDLER 38600 . 39051) (CHAT.HANDLEMARK 39053 . 39592) (CHAT.PUPHANDLER 39594
. 40497) (CHAT.IMMEDIATE.PUPHANDLER 40499 . 41708)) (42336 44415 (\DOWNCARET 42346 . 42687) (
\FLIPCARET 42689 . 44413)) (46280 47647 (CHAT.ADD.BACKGROUND.COMMAND 46290 . 47645)))))
STOP