1
0
mirror of synced 2026-03-05 19:19:56 +00:00

Fix long-standing error wherein VTCHAT.STATUS attempts to BOUT a string (#510)

In replying to a request for the cursor position, the VTCHAT.STATUS
code attempted to construct the escape-sequence response passing a
string representing the X (and Y) coordinate as text to BOUT rather
than using PRIN1.
This commit is contained in:
Nick Briggs
2021-10-01 15:57:00 -07:00
committed by GitHub
parent ae26c3c9fa
commit a92bce555f
2 changed files with 52 additions and 34 deletions

View File

@@ -1,40 +1,37 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jan-93 15:06:01" {DSK}<python>lde>lispcore>library>VTCHAT.;2 21782
(FILECREATED "30-Sep-2021 17:41:51" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;4 21924
changes to%: (RECORDS VT100SAVE VT100.STATE)
changes to%: (FNS VTCHAT.STATUS)
previous date%: "13-Jun-90 01:22:35" {DSK}<python>lde>lispcore>library>VTCHAT.;1)
previous date%: "20-Jan-93 15:06:01" {DSK}<Users>briggs>Projects>medley>library>VTCHAT.;3)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1983-1988, 1990, 1993 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT VTCHATCOMS)
(RPAQQ VTCHATCOMS [
(* ;; "VT100 emulator")
(RPAQQ VTCHATCOMS
[
(* ;; "VT100 emulator")
(FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
(FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT
VTCHAT.CLEARMODES VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE
VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
(INITVARS (VTCHAT.DEBUGGING.FLG)
(VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
(GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT
VTCHAT.TERM.IDENTITY.STRING)
(ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (LOADCOMP)
CHATDECLS)
(RECORDS VT100SAVE VT100.STATE))
(INITRECORDS VT100.STATE)
(SYSRECORDS VT100.STATE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
VT100KP)
(ADDVARS (CHAT.DISPLAYTYPES (
"Replace this string with NIL to prefer vt100"
NIL VT100])
(FNS VTCHAT.STATE VTCHAT.HANDLECHARACTER VTCHAT.SEQUENCE VTCHAT.DOCOMMAND)
(FNS VTCHAT.ADDRESS VTCHAT.REVERSE.INDEX VTCHAT.ATTRIBUTES VTCHAT.DECLFONT VTCHAT.CLEARMODES
VTCHAT.SAVE VTCHAT.RESTORE VTCHAT.SETMODE VTCHAT.SETMARGINS VTCHAT.REPORT VTCHAT.STATUS)
(INITVARS (VTCHAT.DEBUGGING.FLG)
(VTCHAT.TERM.IDENTITY.STRING "[?1;0c"))
(GLOBALVARS VTCHAT.DEBUGGING.FLG CHATFONT GRAPHICSFONT VTCHAT.TERM.IDENTITY.STRING)
(ADDVARS (CHAT.DRIVERTYPES (VT100 VTCHAT.HANDLECHARACTER VTCHAT.STATE)))
(DECLARE%: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (LOADCOMP)
CHATDECLS)
(RECORDS VT100SAVE VT100.STATE))
(INITRECORDS VT100.STATE)
(SYSRECORDS VT100.STATE)
(DECLARE%: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD)
VT100KP)
(ADDVARS (CHAT.DISPLAYTYPES ("Replace this string with NIL to prefer vt100" NIL VT100])
@@ -101,8 +98,29 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
)
(VTCHAT.STATUS
(LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ; "Edited 18-Dec-86 15:16 by amd") (* ;; "Returns VT100 status info") (LET ((OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE (QUOTE CHAT.STATE))))) (SELECTQ TYPE (5 (* ; "Host wants device status") (PRIN1 "" OUTSTREAM)) (6 (* ; "Host wants cursor coords") (BOUT OUTSTREAM (CHARCODE ESC)) (BOUT OUTSTREAM (CHARCODE %[)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE ;)) (BOUT OUTSTREAM (MKSTRING (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE) (ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE))))) (BOUT OUTSTREAM (CHARCODE R))) NIL) (FORCEOUTPUT OUTSTREAM)))
)
[LAMBDA (CHAT.STATE VT100.STATE TYPE) (* ;
 "Edited 30-Sep-2021 17:30 by briggs")
(* ; "Edited 18-Dec-86 15:16 by amd")
(* ;; "Returns VT100 status info")
(LET [(OUTSTREAM (ffetch (CHAT.STATE OUTSTREAM) of (\DTEST CHAT.STATE 'CHAT.STATE]
(SELECTQ TYPE
(5 (* ; "Host wants device status")
(PRIN1 "" OUTSTREAM))
(6 (* ; "Host wants cursor coords")
(BOUT OUTSTREAM (CHARCODE ESC))
(BOUT OUTSTREAM (CHARCODE %[))
(PRIN1 (ADD1 (IQUOTIENT (ffetch (CHAT.STATE YPOS) of CHAT.STATE)
(ffetch (CHAT.STATE FONTHEIGHT) of CHAT.STATE)))
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE ;))
(PRIN1 (ADD1 (IQUOTIENT (ffetch (CHAT.STATE XPOS) of CHAT.STATE)
(ffetch (CHAT.STATE FONTWIDTH) of CHAT.STATE)))
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE R)))
NIL)
(FORCEOUTPUT OUTSTREAM])
)
(RPAQ? VTCHAT.DEBUGGING.FLG )
@@ -236,10 +254,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993 by Venue & Xerox Co
)
(PUTPROPS VTCHAT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1995 10061 (VTCHAT.STATE 2005 . 2515) (VTCHAT.HANDLECHARACTER 2517 . 5091) (
VTCHAT.SEQUENCE 5093 . 6636) (VTCHAT.DOCOMMAND 6638 . 10059)) (10062 16968 (VTCHAT.ADDRESS 10072 .
10590) (VTCHAT.REVERSE.INDEX 10592 . 11161) (VTCHAT.ATTRIBUTES 11163 . 11549) (VTCHAT.DECLFONT 11551
. 11820) (VTCHAT.CLEARMODES 11822 . 12325) (VTCHAT.SAVE 12327 . 13066) (VTCHAT.RESTORE 13068 . 13775)
(VTCHAT.SETMODE 13777 . 14849) (VTCHAT.SETMARGINS 14851 . 15442) (VTCHAT.REPORT 15444 . 16204) (
VTCHAT.STATUS 16206 . 16966)))))
(FILEMAP (NIL (1532 9598 (VTCHAT.STATE 1542 . 2052) (VTCHAT.HANDLECHARACTER 2054 . 4628) (
VTCHAT.SEQUENCE 4630 . 6173) (VTCHAT.DOCOMMAND 6175 . 9596)) (9599 17110 (VTCHAT.ADDRESS 9609 . 10127)
(VTCHAT.REVERSE.INDEX 10129 . 10698) (VTCHAT.ATTRIBUTES 10700 . 11086) (VTCHAT.DECLFONT 11088 . 11357
) (VTCHAT.CLEARMODES 11359 . 11862) (VTCHAT.SAVE 11864 . 12603) (VTCHAT.RESTORE 12605 . 13312) (
VTCHAT.SETMODE 13314 . 14386) (VTCHAT.SETMARGINS 14388 . 14979) (VTCHAT.REPORT 14981 . 15741) (
VTCHAT.STATUS 15743 . 17108)))))
STOP

Binary file not shown.