(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