(FILECREATED " 8-Jul-85 00:09:02" {ERIS}<LISPCORE>LIBRARY>DMCHAT.;3 10971
changes to: (FNS DMCHAT.HANDLECHARACTER)
previous date: "24-May-85 11:37:11" {ERIS}<LISPCORE>LIBRARY>DMCHAT.;2)
(* Copyright (c) 1984, 1985 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 DMCHAT.STATE)
(* Terminal emulator support)
(FILES CHATTERMINAL)
(ADDVARS (CHAT.DRIVERTYPES (DM2500 DMCHAT.HANDLECHARACTER DMCHAT.STATE)))
(RECORDS DM2500.STATE)))
(* DM peculiar functions)
(DEFINEQ
(DMCHAT.ADDRESS
(LAMBDA (CHAT.STATE DM2500.STATE CHAR) (* ejs: "12-May-85 15:26")
(* In the middle of doing absolute address.
Return T unless a cancel is received)
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE
(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 (CHAT.STATE DM2500.STATE SETROLL) (* ejs: "12-May-85 17:13")
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE (CLEARW WINDOW)
(DMCHAT.CLEARMODES CHAT.STATE DM2500.STATE)
(AND SETROLL (SETQ ROLLMODE T))
(TERM.HOME CHAT.STATE)))))
(DMCHAT.CLEARMODES
(LAMBDA (CHAT.STATE DM2500.STATE) (* ejs: "12-May-85 15:08")
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE (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 CHAT.STATE DM2500.STATE) (* ejs: " 8-Jul-85 00:08")
(* Here and/or below)
(PROG NIL
(with DM2500.STATE DM2500.STATE (with CHAT.STATE CHAT.STATE
(COND
((EQ CHAR (CHARCODE BELL))
(RETURN (COND
((EQ \MACHINETYPE \DANDELION)
(BOUT (WINDOWPROP WINDOW
(QUOTE DSP))
7))
((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 CHAT.STATE)
(SETQ AUTOLF NIL)))
(COND
(ADDRESSING (COND
((DMCHAT.ADDRESS CHAT.STATE
DM2500.STATE 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 CHAT.STATE)))
(DMCHAT.PRINTCHAR CHAT.STATE
DM2500.STATE 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 CHAT.STATE))
(T (TERM.DOWN CHAT.STATE))))
(CR (SETQ EATTOCRLF NIL)
(DMCHAT.NEWLINE CHAT.STATE DM2500.STATE
T))
(BS (COND
(IDMODE (TERM.DELCHAR CHAT.STATE))
(T (TERM.LEFT CHAT.STATE))))
(↑W
(* Erase to end of line)
(TERM.ERASE.TO.EOL CHAT.STATE))
(↑L
(* Start of cursor address)
(SETQ ADDRESSING -1))
(↑B
(* Homes cursor, cancels some modes)
(TERM.HOME CHAT.STATE)
(DMCHAT.CLEARMODES CHAT.STATE
DM2500.STATE))
(↑X
(* Cancel --resets modes)
(DMCHAT.CLEARMODES CHAT.STATE
DM2500.STATE)
(SETQ ROLLMODE))
((↑↑ ↑←)
(* Master Reset -- Clears screen, modes)
(DMCHAT.CLEAR CHAT.STATE DM2500.STATE))
(↑\
(* Forward space)
(COND
((NOT EATTOCRLF)
(COND
(IDMODE (TERM.ADDCHAR CHAT.STATE))
(T (DMCHAT.RIGHT CHAT.STATE
DM2500.STATE)))))
)
(↑Z
(* Up)
(COND
(IDMODE (TERM.DELETELINE CHAT.STATE))
(T (TERM.UP CHAT.STATE))))
((↑N ↑O)
(* Enter blink mode, enter protected mode.
Do both as embolden)
(TERM.MODIFY.ATTRIBUTES
CHAT.STATE
(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 (CHAT.STATE DM2500.STATE EXPLICIT) (* ejs: "12-May-85 15:12")
(* Do a CRLF. EXPLICIT = T means a CR was received, NIL
means we did autowraparound)
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE (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 (CHAT.STATE DM2500.STATE CHAR) (* ejs: "12-May-85 16:42")
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE (\OUTCHAR DSP CHAR)
(COND
((IGEQ (SETQ XPOS (PLUS XPOS FONTWIDTH))
TTYWIDTH) (* Have reached right margin, so wrap around)
(COND
(CHAT.AUTOCRLF (DMCHAT.NEWLINE CHAT.STATE DM2500.STATE))
(T (SETQ EATTOCRLF T)))))))))
(DMCHAT.RIGHT
(LAMBDA (CHAT.STATE DM2500.STATE) (* ejs: "12-May-85 15:31")
(with CHAT.STATE CHAT.STATE (with DM2500.STATE DM2500.STATE (COND
((ILESSP (IPLUS XPOS FONTWIDTH)
TTYWIDTH)
(SETQ XPOS (PLUS XPOS FONTWIDTH))
(MOVETO XPOS YPOS DSP))
(T (* Auto crlf)
(DMCHAT.NEWLINE CHAT.STATE DM2500.STATE)))))))
(DMCHAT.STATE
[LAMBDA (CHAT.STATE) (* AJB "23-May-85 15:24")
(TERM.RESET.DISPLAY.PARMS CHAT.STATE)
(TERM.HOME CHAT.STATE)
(create DM2500.STATE])
)
(* Terminal emulator support)
(FILESLOAD CHATTERMINAL)
(ADDTOVAR CHAT.DRIVERTYPES (DM2500 DMCHAT.HANDLECHARACTER DMCHAT.STATE))
[DECLARE: EVAL@COMPILE
(DATATYPE DM2500.STATE ((DINGED FLAG)
(EATLF FLAG)
(EATCRLF FLAG)
(EATTOCRLF FLAG)
(AUTOLF FLAG)
ADDRESSING
(IDMODE FLAG)
(BLINKMODE FLAG)
(BRIGHTMODE FLAG)))
]
(/DECLAREDATATYPE (QUOTE DM2500.STATE)
(QUOTE (FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG))
(QUOTE ((DM2500.STATE 0 (FLAGBITS . 0))
(DM2500.STATE 0 (FLAGBITS . 16))
(DM2500.STATE 0 (FLAGBITS . 32))
(DM2500.STATE 0 (FLAGBITS . 48))
(DM2500.STATE 0 (FLAGBITS . 64))
(DM2500.STATE 0 POINTER)
(DM2500.STATE 0 (FLAGBITS . 80))
(DM2500.STATE 0 (FLAGBITS . 96))
(DM2500.STATE 0 (FLAGBITS . 112))))
(QUOTE 2))
(PUTPROPS DMCHAT COPYRIGHT ("Xerox Corporation" 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (708 10075 (DMCHAT.ADDRESS 718 . 2035) (DMCHAT.CLEAR 2037 . 2387) (DMCHAT.CLEARMODES
2389 . 2884) (DMCHAT.HANDLECHARACTER 2886 . 8255) (DMCHAT.NEWLINE 8257 . 8926) (DMCHAT.PRINTCHAR 8928
. 9421) (DMCHAT.RIGHT 9423 . 9863) (DMCHAT.STATE 9865 . 10073)))))
STOP