(FILECREATED "24-Jan-84 18:36:10" {PHYLUM}<LISPCORE>SOURCES>CHAT.;68 51062
changes to: (FNS CHAT.IMMEDIATE.PUPHANDLER CHAT.PUPHANDLER)
previous date: "20-Jan-84 17:09:11" {PHYLUM}<LISPCORE>SOURCES>CHAT.;67)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT CHATCOMS)
(RPAQQ CHATCOMS ((COMS (* CHAT and its main -- typein -- process)
(FNS CHAT CHAT.TYPEIN CHAT.BIN CHAT.CLOSE CHAT.WHENCLOSED CHAT.FLASHCARET
CHAT.LOGIN 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.TTYENTRYFN CHAT.TTYEXITFN))
(COMS (* EMACS hackers)
(FNS CHAT.EMACS.MOVE CHAT.SWITCH.EMACS))
(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)
(CHATDEBUGFLG)
(CHATWINDOWLST)
(CHAT.OLDINTERRUPTS)
(CHATWINDOW)
(CHAT.AUTOCRLF T)
(CLOSECHATWINDOWFLG)
(CHAT.ALLHOSTS)
(CHAT.HOSTMENU)
(CHAT.FONT)
(CHAT.IN.EMACS? NIL)
(CHAT.EMACSCOMMANDS (QUOTE (21 16 14 6 1)))
(CHAT.WAIT.TIME 2000))
(VARS (CHATMENU)
(CHAT.REOPENMENU)
NETWORKLOGINFO)
(COMS (* Caret stuff)
(FNS \DOWNCARET \FLIPCARET)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CARET)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS CHATUSERSTATE EMACSCOMMANDS)
(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
DEFAULTCHATHOST PUPTYPES CHAT.INTERRUPTS INVERTWINDOWFN WHITESHADE
CHAT.AUTOCRLF CLOSECHATWINDOWFLG CHAT.HOSTMENU CHAT.ALLHOSTS CHAT.FONT
CHAT.EMACSCOMMANDS NETWORKLOGINFO CHAT.WAIT.TIME)
(LOCALVARS . T))
(INITVARS (INVERTWINDOWFN (QUOTE INVERTW)))
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDVARS (BackgroundMenuCommands (CHAT [AND (THIS.PROCESS)
(ADD.PROCESS (QUOTE (CHAT NIL NIL NIL
NIL T]
"Runs a new CHAT process; prompts for host"))
)
(P (SETQ BackgroundMenu))
(FILES BSP))))
(* CHAT and its main -- typein -- process)
(DEFINEQ
(CHAT
[LAMBDA (HOST LOGOPTION INITSTREAM WINDOW FROMMENU) (* bvm: " 1-NOV-83 17:44")
[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 RESULT PROCESS HOSTS)
[OR HOST (COND
[FROMMENU (COND
((OR CHAT.HOSTMENU (PROGN (SETQ HOSTS CHAT.ALLHOSTS)
(COND
(DEFAULTCHATHOST (pushnew HOSTS
DEFAULTCHATHOST)))
HOSTS))
[SETQ HOST (MENU (OR CHAT.HOSTMENU (SETQ CHAT.HOSTMENU
(create MENU
ITEMS ←(APPEND HOSTS (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))
([OR (NOT (SETQ PORT (BESTPUPADDRESS HOST PROMPTWINDOW)))
(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)
"Can't open Chat connection"]
(SETQ RESULT "Failed"))
(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)))
CHATINEMACS ← CHAT.IN.EMACS?
CHATMARKCOUNT ← 0)))
(* 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)))
FAIL[COND
((AND WINDOW (WINDOWPROP WINDOW (QUOTE CHATHOST)))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION CHAT.RECONNECT]
(RETURN RESULT])
(CHAT.TYPEIN
[LAMBDA (SOCKET WINDOW LOGOPTION HOST INITSTREAM) (* bvm: "20-Jan-84 14:38")
(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))
(CHAT.LOGIN HOST LOGOPTION CHATSTREAM STATE))
(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))
(COND
((\SYSBUFP)
(do (SETQ CH (\GETKEY))
(BOUT CHATSTREAM (COND
((EQ CH CHAT.CONTROLCHAR) (* Controlify it)
(LOGAND (CHAT.BIN SOCKET STATE)
31))
((EQ CH CHAT.METACHAR) (* Prefix meta, turn on 200q bit)
(LOGOR (CHAT.BIN SOCKET STATE)
128))
(T CH)))
repeatwhile (\SYSBUFP))
(BSPFORCEOUTPUT CHATSTREAM]
(T (until (EOFP STREAM) do (BOUT CHATSTREAM (\BIN STREAM)))
(BSPFORCEOUTPUT CHATSTREAM)
(CLOSEF STREAM)
(SETQ STREAM)))
(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))
1000)
(T 0]
(CLOSE (RETURN (CHAT.CLOSE WINDOW 15000)))
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])
(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.FLASHCARET
[LAMBDA (CHATSTATE) (* bvm: "23-SEP-81 12:16")
(OR (fetch HELD of CHATSTATE)
(\FLIPCARET (fetch CARETSTATE of CHATSTATE])
(CHAT.LOGIN
[LAMBDA (HOST OPTION OUTSTREAM CHATSTATE) (* bvm: "20-Jan-84 17:08")
(PROG ((LOGINFO (CDR (ASSOC (OR (GETOSTYPE HOST)
(QUOTE IFS))
NETWORKLOGINFO)))
NAME/PASS COM)
(OR LOGINFO (RETURN))
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOST))
[SETQ COM (COND
(OPTION)
((ASSOC (QUOTE ATTACH)
LOGINFO)
(CHAT.COMPUTE.LOGINFO HOST (CAR NAME/PASS)))
(T (* Don't know how to do anything but login, so silly to
try whereis)
(QUOTE LOGIN]
(COND
((NULL (SETQ LOGINFO (ASSOC COM LOGINFO)))
(printout PROMPTWINDOW T COM " not implemented for this type of host"))
(T (for X in (CDR LOGINFO) do (SELECTQ X
(CR (BOUT OUTSTREAM (CHARCODE CR))
(BSPFORCEOUTPUT OUTSTREAM))
(USERNAME (PRIN3 (CAR NAME/PASS)
OUTSTREAM))
(PASSWORD (PRIN3 (\DECRYPT.PWD (CDR NAME/PASS))
OUTSTREAM))
(WAIT (* Some systems do not permit typeahead)
(BSPFORCEOUTPUT OUTSTREAM)
(replace CHATMARKCOUNT of CHATSTATE
with 1)
(BSPPUTMARK OUTSTREAM \MARK.TIMING)
(until (ZEROP (fetch CHATMARKCOUNT
of CHATSTATE))
do (BLOCK))
(DISMISS CHAT.WAIT.TIME))
(PRIN3 X OUTSTREAM)))
(BSPFORCEOUTPUT OUTSTREAM])
(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) (* bvm: " 4-NOV-83 20:18")
(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 CRPENDING
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 (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]
(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: "11-SEP-83 17:09")
(COND
[(LASTMOUSESTATE LEFT)
(PROG (TMP)
(COND
((AND (SETQ TMP (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(fetch CHATINEMACS of TMP)
(SETQ TMP (fetch TYPEOUTPROC of TMP)))
(PROCESS.APPLY TMP (FUNCTION CHAT.EMACS.MOVE)))
(T (CHAT.HOLD WINDOW]
((LASTMOUSESTATE MIDDLE)
(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: "11-SEP-83 17:10")
(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")
(Emacs (QUOTE Emacs)
"Toggle EMACS positioning"]
(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]
(Emacs (CHAT.SWITCH.EMACS STATE))
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.TTYENTRYFN
[LAMBDA (PROCESS) (* bvm: "23-SEP-83 18:44")
(* Switch to a chat window)
(DECLARE (GLOBALVARS \CURRENTINTERRUPTS CHAT.INTERRUPTS))
(PROG ((WINDOW (PROCESSPROP PROCESS (QUOTE WINDOW)))
STATE INTERRUPTS)
(COND
((SETQ STATE (WINDOWPROP WINDOW (QUOTE CHATSTATE)))
(replace HELD of STATE with NIL)))
[SETQ INTERRUPTS (for PAIR in (APPEND \CURRENTINTERRUPTS) collect (INTERRUPTCHAR
(CAR PAIR]
(* Turn everything off, then turn selected interrupts
back on)
(PROCESSPROP PROCESS (QUOTE CHAT.INTERRUPTS)
(NCONC (MAPCAR CHAT.INTERRUPTS (FUNCTION INTERRUPTCHAR))
INTERRUPTS])
(CHAT.TTYEXITFN
[LAMBDA (PROCESS NEWPROCESS) (* bvm: "23-SEP-83 18:42")
(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]
(MAPC (PROCESSPROP PROCESS (QUOTE CHAT.INTERRUPTS)
NIL)
(FUNCTION INTERRUPTCHAR])
)
(* EMACS hackers)
(DEFINEQ
(CHAT.EMACS.MOVE
[LAMBDA NIL (* bvm: " 9-SEP-83 22:09")
(DECLARE (USEDFREE FONTHEIGHT FONTWIDTH WINDOW XPOS YPOS))
(* * This function is invoked in the context of the typeout process, so that we can easily see where we are on the
display, and so that we don't hang up the mouse if connection gets in trouble)
(PROG ((OUTSTREAM (WINDOWPROP WINDOW (QUOTE SOCKET)))
(CLOC (CURSORPOSITION NIL WINDOW))
DROW CCOLUMN)
(* * The characters are FONTHEIGHT high by FONTWIDTH wide)
[COND
((IGEQ XPOS FONTWIDTH) (* Go back to column 0)
(BOUT OUTSTREAM (fetch EMCOL0 of CHAT.EMACSCOMMANDS]
(SETQ DROW (IDIFFERENCE (IQUOTIENT YPOS FONTHEIGHT)
(IQUOTIENT (fetch YCOORD of CLOC)
FONTHEIGHT)))
(* * Positive DROW means go DOWN)
[COND
((ILESSP DROW 0) (* Go up DROW rows)
(COND
((NEQ DROW -1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING (IMINUS DROW))
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMUP of CHAT.EMACSCOMMANDS)))
((IGREATERP DROW 0) (* Go down DROW rows)
(COND
((NEQ DROW 1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING DROW)
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMDOWN of CHAT.EMACSCOMMANDS]
(SETQ CCOLUMN (IQUOTIENT (fetch XCOORD of CLOC)
FONTWIDTH))
(COND
((IGREATERP CCOLUMN 0) (* Now go to the correct column)
(COND
((NEQ CCOLUMN 1)
(BOUT OUTSTREAM (fetch EMARG of CHAT.EMACSCOMMANDS))
(PRIN3 (MKSTRING CCOLUMN)
OUTSTREAM)))
(BOUT OUTSTREAM (fetch EMFORWARD of CHAT.EMACSCOMMANDS])
(CHAT.SWITCH.EMACS
[LAMBDA (CHATSTATE) (* bvm: "11-SEP-83 17:10")
(* * Toggles the value of CHAT.IN.EMACS?)
(printout PROMPTWINDOW T "EMACS positioning " (COND
((fetch CHATINEMACS of CHATSTATE)
(replace CHATINEMACS of CHATSTATE with NIL)
"OFF")
(T (replace CHATINEMACS of CHATSTATE with T)
"ON"])
)
(* 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: "11-SEP-83 16:56")
(PROG ((MARK (BSPGETMARK SOCKET)))
(SELECTC MARK
(\MARK.TIMING (* For synchronization)
(BSPPUTMARK SOCKET \MARK.TIMINGREPLY))
(\MARK.TIMINGREPLY (* For synchronizing typein with remote responses)
(add (fetch CHATMARKCOUNT of CHATSTATE)
-1))
(\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: "24-Jan-84 18:27")
(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 24))
(\PT.ABORT (printout FILE T "[Abort] ")
(SETQ OFFSET 2))
(COND
(PUPTRACEFLG (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: "24-Jan-84 18:26")
(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)
(PUPTRACEFLG (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 )
(RPAQ? CHATDEBUGFLG )
(RPAQ? CHATWINDOWLST )
(RPAQ? CHAT.OLDINTERRUPTS )
(RPAQ? CHATWINDOW )
(RPAQ? CHAT.AUTOCRLF T)
(RPAQ? CLOSECHATWINDOWFLG )
(RPAQ? CHAT.ALLHOSTS )
(RPAQ? CHAT.HOSTMENU )
(RPAQ? CHAT.FONT )
(RPAQ? CHAT.IN.EMACS? NIL)
(RPAQ? CHAT.EMACSCOMMANDS (QUOTE (21 16 14 6 1)))
(RPAQ? CHAT.WAIT.TIME 2000)
(RPAQQ CHATMENU NIL)
(RPAQQ CHAT.REOPENMENU NIL)
(RPAQQ NETWORKLOGINFO ((TENEX (LOGIN "LOGIN " USERNAME " " PASSWORD "
")
(ATTACH "ATTACH " USERNAME " " PASSWORD "
")
(WHERE "WHERE " USERNAME CR "ATTACH " USERNAME " " PASSWORD CR))
(TOPS20 (LOGIN "LOGIN " USERNAME CR PASSWORD CR)
(ATTACH "ATTACH " USERNAME "" CR PASSWORD CR)
(WHERE "LOGIN " USERNAME CR PASSWORD CR))
(UNIX (LOGIN WAIT USERNAME CR WAIT PASSWORD CR))
(IFS (LOGIN "LOGIN " USERNAME " " PASSWORD CR))))
(* 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
CHATMARKCOUNT CHATINEMACS))
(RECORD EMACSCOMMANDS (EMARG EMUP EMDOWN EMFORWARD EMCOL0))
]
(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 DEFAULTCHATHOST PUPTYPES CHAT.INTERRUPTS
INVERTWINDOWFN WHITESHADE CHAT.AUTOCRLF CLOSECHATWINDOWFLG CHAT.HOSTMENU CHAT.ALLHOSTS
CHAT.FONT CHAT.EMACSCOMMANDS NETWORKLOGINFO CHAT.WAIT.TIME)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(RPAQ? INVERTWINDOWFN (QUOTE INVERTW))
(DECLARE: DONTEVAL@LOAD DOCOPY
(ADDTOVAR BackgroundMenuCommands (CHAT [AND (THIS.PROCESS)
(ADD.PROCESS (QUOTE (CHAT NIL NIL NIL NIL T]
"Runs a new CHAT process; prompts for host"))
(SETQ BackgroundMenu)
(FILESLOAD BSP)
)
(PUTPROPS CHAT COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2904 16627 (CHAT 2914 . 6484) (CHAT.TYPEIN 6486 . 9413) (CHAT.BIN 9415 . 9726) (
CHAT.CLOSE 9728 . 12184) (CHAT.WHENCLOSED 12186 . 12569) (CHAT.FLASHCARET 12571 . 12783) (CHAT.LOGIN
12785 . 14260) (CHAT.COMPUTE.LOGINFO 14262 . 15726) (CHAT.SENDSCREENPARAMS 15728 . 16625)) (16678
24457 (CHAT.TYPEOUT 16688 . 20691) (CHAT.HANDLECHARACTER 20693 . 24455)) (24458 31252 (CHAT.ADDCHAR
24468 . 25146) (CHAT.ADDLINE 25148 . 25643) (CHAT.ADDRESS 25645 . 26702) (CHAT.CLEAR 26704 . 26914) (
CHAT.CLEARMODES 26916 . 27237) (CHAT.DELCHAR 27239 . 27947) (CHAT.DELETELINE 27949 . 28405) (CHAT.DOWN
28407 . 28989) (CHAT.ERASE.TO.EOL 28991 . 29218) (CHAT.ERASEBITS 29220 . 29439) (CHAT.HOME 29441 .
29609) (CHAT.LEFT 29611 . 29816) (CHAT.NEWLINE 29818 . 30354) (CHAT.PRINTCHAR 30356 . 30720) (
CHAT.RIGHT 30722 . 31047) (CHAT.UP 31049 . 31250)) (31253 32049 (CHAT.TYPESCRIPT 31263 . 32047)) (
32075 39838 (GETCHATWINDOW 32085 . 33207) (CHAT.BUTTONFN 33209 . 33675) (CHAT.HOLD 33677 . 34179) (
CHAT.MENU 34181 . 37071) (CHAT.RECONNECT 37073 . 37834) (CHAT.RESHAPEWINDOW 37836 . 38422) (
CHAT.TTYENTRYFN 38424 . 39318) (CHAT.TTYEXITFN 39320 . 39836)) (39865 42241 (CHAT.EMACS.MOVE 39875 .
41818) (CHAT.SWITCH.EMACS 41820 . 42239)) (42266 45543 (CHAT.ERRORHANDLER 42276 . 42727) (
CHAT.HANDLEMARK 42729 . 43445) (CHAT.PUPHANDLER 43447 . 44351) (CHAT.IMMEDIATE.PUPHANDLER 44353 .
45541)) (46652 48731 (\DOWNCARET 46662 . 47003) (\FLIPCARET 47005 . 48729)))))
STOP