From a92bce555f688dfa0c0cd38f17f7431726d327ae Mon Sep 17 00:00:00 2001 From: Nick Briggs Date: Fri, 1 Oct 2021 15:57:00 -0700 Subject: [PATCH] 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. --- library/VTCHAT | 86 ++++++++++++++++++++++++++------------------ library/VTCHAT.LCOM | Bin 8553 -> 8571 bytes 2 files changed, 52 insertions(+), 34 deletions(-) diff --git a/library/VTCHAT b/library/VTCHAT index 736b50cb..7f14664c 100644 --- a/library/VTCHAT +++ b/library/VTCHAT @@ -1,40 +1,37 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Jan-93 15:06:01" {DSK}lde>lispcore>library>VTCHAT.;2 21782 +(FILECREATED "30-Sep-2021 17:41:51" {DSK}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}lde>lispcore>library>VTCHAT.;1) + previous date%: "20-Jan-93 15:06:01" {DSK}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 diff --git a/library/VTCHAT.LCOM b/library/VTCHAT.LCOM index cc919efebc6b78390e0d58998d97a4afe5f0764b..05bb61f03bd836b084c6f63a3430dd62ea573f18 100644 GIT binary patch delta 995 zcmbVKO=!~q6ke?k4Qf}FwQJJu85lN)mL&aIn`!A^x^637ZBsqW3H^z++CS1wC@Q@x zq7v|=f)}ND5yuXmHZRhvcoBB<=1Dzym@r@3OezS%dieU@`(D0$@8x}s?nWQYcL`@= zAtlDLVnh<-KzmqMPHwq)mgj(*6}+6_<7jZwrDnZVt;uC*Hh>1=c09Lq_k6xBEA3EG zsa7iOP)2FqkV|XrP+cz9dI~?#J^8n8Uc`xXO z30P~QX=fsxgTIV3&{E`E)#iG8U=(|3o^>r28m^!RxQjl4^$RR6;UGKpFr!NnL5K&4 zjW33)1_QAXF;=A;c-wKvYFbyIXe?Kj++ zc&WFF=6Be-XWrCWH&4I9Wc5to5GGG18AD6mo}{~rwejz76UiD$jNxx9Sz8$f;r>Lp ze`@FE=j1*yw@;YDee)=h)jN)93KL^ajtxR$IU5s~^HL@+0mt$X#TamJne0NEgW1_( z!5_GwSA2Sl*E3}Jz>vT*@WJ2?wQCYF1)c|*Twxn{BI=ff#A$XcWyG*`74f=zS%;EZjwS=B3+0bavt$LSwftlw9XflO?^s7cD6vw4sQIoMBN+~SR=NMBsKz4>u=++>W%rce@Mp_DGIL}s-3(17Oe=UyNbLcYmN#n;DyafJmH7ND>oPBeP5u$sdY z$MvkCuRy)g@Ap&4rYm^kpWAUShT_!wcW8M(bWo9d6`B2a$W@UNI17b2WR}wTMZFA_ z!bt@@B&o(HlZh0}XiSz<12gKb@~1Q$l^2R7{YtK|T(0KC4U`3ZBg;5C8Dyq#t^|S< z$iHUgt`CcONo{V`8$d~f$%eJzoW(*mDvgVc_}gjuC008Jdzvi7Y$A`5PstN3%^h)| zWA3zg&HJsfYMGkNZEH34tnFbwo_2`(U5BVxqzE!9Ig#^{4|z)(M81axWx6o_dBEhF_(LDx9