(FILECREATED "29-Dec-84 15:12:11" {ERIS}<LISPCORE>SOURCES>DMCHAT.;2
 8368   

      changes to:  (VARS DMCHATCOMS)
		   (FNS DMCHAT.CLEAR DMCHAT.HANDLECHARACTER)

      previous date: "18-Dec-84 19:49:12" {ERIS}<SCHOEN>DMCHAT.;4)


(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT DMCHATCOMS)

(RPAQQ DMCHATCOMS
 ((* DM peculiar functions)
		   (FNS DMCHAT.ADDRESS DMCHAT.CLEAR DMCHAT.CLEARMODES DMCHAT.HANDLECHARACTER 
			DMCHAT.NEWLINE DMCHAT.PRINTCHAR DMCHAT.RIGHT)
		   (* Terminal emulator support)
		   (FILES CHATTERMINAL)
		   (ADDVARS (CHAT.DRIVERTYPES (DM2500 . DMCHAT.HANDLECHARACTER))
			    (TERM.SPECVARS (DM2500 DINGED EATLF EATCRLF EATTOCRLF AUTOLF ADDRESSING 
						   IDMODE (ROLLMODE T)
						   BLINKMODE BRIGHTMODE)))))



(* DM peculiar functions)


(DEFINEQ

(DMCHAT.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 96)))
      (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 96)
									   FONTHEIGHT))))
		 DSP)
	 (
SETQ
 ADDRESSING)
	 T))))

(DMCHAT.CLEAR

  (LAMBDA (SETROLL)                                          (* ejs: "29-Dec-84 15:10")

    (
CLEARW
 WINDOW)
    (DMCHAT.CLEARMODES
)
    (
AND
 SETROLL (
SETQ
 ROLLMODE T))
    (
TERM.HOME
)))

(DMCHAT.CLEARMODES

  (LAMBDA NIL                                                (* ejs: "13-Nov-84 17:17")

    (
COND

      ((
OR
 BLINKMODE BRIGHTMODE)                             (* Restore normal font)

	(
DSPFONT
 PLAINFONT DSP)
	(
SETQ
 FONT PLAINFONT)
	(
SETQ
 BRIGHTMODE (
SETQ
 BLINKMODE))))
    (
SETQ
 IDMODE (
SETQ
 ADDRESSING))))

(DMCHAT.HANDLECHARACTER

  (LAMBDA (CHAR)                                             (* ejs: "29-Dec-84 15:10")

    (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 BRIGHTMODE))
                                                             (* 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)



	      (
TERM.DOWN
)
	      (
SETQ
 AUTOLF NIL)))
          (
COND

	    (ADDRESSING (
COND

			  ((DMCHAT.ADDRESS
 CHAR)
			    (
RETURN
)))))
          (
COND

	    ((
AND
 (
IGEQ
 CHAR (
CHARCODE
 SPACE))
		  (
ILESSP
 CHAR (
CHARCODE
 DEL)))              (* Normal char)

	      (
SETQ
 EATLF (
SETQ
 EATCRLF NIL))
	      (
RETURN
 (
COND

			((
NOT
 EATTOCRLF)                     (* Print the char)

			  (
COND

			    (IDMODE                          (* this is discouraged by the DM manual, but apparently

							     EMACS does it, so might as well support it)

				    (
TERM.ADDCHAR
)))
			  (DMCHAT.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 (
TERM.ADDLINE
))
			  (T (
TERM.DOWN
))))
		    (CR (
SETQ
 EATTOCRLF NIL)
			(DMCHAT.NEWLINE
 T))
		    (BS (
COND

			  (IDMODE (
TERM.DELCHAR
))
			  (T (
TERM.LEFT
))))
		    (^W                                      (* Erase to end of line)

			(
TERM.ERASE.TO.EOL
))
		    (^L                                      (* Start of cursor address)

			(
SETQ
 ADDRESSING -1))
		    (^B                                      (* Homes cursor, cancels some modes)

			(
TERM.HOME
)
			(DMCHAT.CLEARMODES
))
		    (^X                                      (* Cancel --resets modes)

			(DMCHAT.CLEARMODES
)
			(
SETQ
 ROLLMODE))
		    ((^^ ^_)                                 (* Master Reset -- Clears screen, modes)

		      (DMCHAT.CLEAR
))
		    (^\                                      (* Forward space)

			(
COND

			  ((
NOT
 EATTOCRLF)
			    (
COND

			      (IDMODE (
TERM.ADDCHAR
))
			      (T (DMCHAT.RIGHT
))))))
		    (^Z                                      (* Up)

			(
COND

			  (IDMODE (
TERM.DELETELINE
))
			  (T (
TERM.UP
))))
		    ((^N ^O)                                 (* Enter blink mode, enter protected mode.

							     Do both as embolden)

		      (
TERM.MODIFY.ATTRIBUTES
 (
QUOTE
 BRIGHT)
					      (
NOT
 (
SETQ
 BRIGHTMODE (
NOT
 BRIGHTMODE)))))
		    (^P                                      (* Enter i/d mode)

			(
SETQ
 IDMODE T))
		    (^%]                                     (* Set roll mode)

			 (
SETQ
 ROLLMODE T))
		    NIL))))

(DMCHAT.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)))))

(DMCHAT.PRINTCHAR

  (LAMBDA (CHAR)                                             (* bvm: " 2-Jun-84 15:07")

    (
\OUTCHAR
 OUTSTREAM CHAR)
    (
COND

      ((
IGEQ
 (add
 XPOS FONTWIDTH)
	     TTYWIDTH)                                       (* Have reached right margin, so wrap around)

	(
COND

	  (CHAT.AUTOCRLF (DMCHAT.NEWLINE
))
	  (T (
SETQ
 EATTOCRLF T)))))))

(DMCHAT.RIGHT

  (LAMBDA NIL                                                (* bvm: " 2-Jun-84 15:07")

    (
COND

      ((
ILESSP
 (
IPLUS
 XPOS FONTWIDTH)
	       TTYWIDTH)
	(add
 XPOS FONTWIDTH)
	(
MOVETO
 XPOS YPOS DSP))
      (T                                                     (* Auto crlf)

	 (DMCHAT.NEWLINE
)))))
)



(* Terminal emulator support)


(FILESLOAD CHATTERMINAL)

(ADDTOVAR CHAT.DRIVERTYPES
 (DM2500 . DMCHAT.HANDLECHARACTER))

(ADDTOVAR TERM.SPECVARS
 (DM2500 DINGED EATLF EATCRLF EATTOCRLF AUTOLF ADDRESSING IDMODE (ROLLMODE
				  T)
				BLINKMODE BRIGHTMODE))
(PUTPROPS DMCHAT COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (817 8022 (DMCHAT.ADDRESS 827 . 1967) (DMCHAT.CLEAR 1969 . 2196) (DMCHAT.CLEARMODES 2198
 . 2567) (DMCHAT.HANDLECHARACTER 2569 . 6710) (DMCHAT.NEWLINE 6712 . 7275) (DMCHAT.PRINTCHAR 7277 . 
7670) (DMCHAT.RIGHT 7672 . 8020)))))
STOP