(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