From b038a6b16e2b047499aa82c924556ee931fbef86 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Fri, 15 Mar 2024 12:31:19 -0700 Subject: [PATCH] Rmk112 fix tedit hardcopy smash (#1580) * Hardcopy wasn't binding the internally created textstreams, only the textobjs * Putting the stream instead of the textobj in hardcopy lines * TEDIT-SCREEN: Fixed \FORMATLINE to deal with a last-line ending in white space * Added TEDIT-STRESS Not part of the loadup, a collection of offline routines to stress various Tedit interfaces --- library/tedit/TEDIT-PAGE | 119 ++++++++------- library/tedit/TEDIT-PAGE.LCOM | Bin 24208 -> 24206 bytes library/tedit/TEDIT-SCREEN | 71 +++++---- library/tedit/TEDIT-SCREEN.LCOM | Bin 32997 -> 33381 bytes library/tedit/TEDIT-STRESS | 260 ++++++++++++++++++++++++++++++++ library/tedit/TEDIT-STRESS.LCOM | Bin 0 -> 9192 bytes 6 files changed, 371 insertions(+), 79 deletions(-) create mode 100644 library/tedit/TEDIT-STRESS create mode 100644 library/tedit/TEDIT-STRESS.LCOM diff --git a/library/tedit/TEDIT-PAGE b/library/tedit/TEDIT-PAGE index 1183fb5a..e99f067d 100644 --- a/library/tedit/TEDIT-PAGE +++ b/library/tedit/TEDIT-PAGE @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Mar-2024 09:55:14" {WMEDLEY}TEDIT>TEDIT-PAGE.;154 111276 +(FILECREATED "13-Mar-2024 17:12:34" {WMEDLEY}TEDIT>TEDIT-PAGE.;163 112427 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY) + :CHANGES-TO (FNS TEDIT.FORMATBOX \TEDIT.FORMAT.FOOTNOTE) + (RECORDS PAGEFORMATTINGSTATE PAGEREGION) + (MACROS GETPFS SETPFS) - :PREVIOUS-DATE " 7-Mar-2024 00:14:19" {WMEDLEY}TEDIT>TEDIT-PAGE.;152) + :PREVIOUS-DATE "13-Mar-2024 10:28:14" {WMEDLEY}tedit>TEDIT-PAGE.;157) (PRETTYCOMPRINT TEDIT-PAGECOMS) @@ -559,7 +561,7 @@ (TEDIT.FORMAT.HARDCOPY [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG - ENDPG) (* ; "Edited 7-Mar-2024 09:55 by rmk") + ENDPG) (* ; "Edited 7-Mar-2024 12:34 by rmk") (* ; "Edited 19-Jan-2024 23:39 by rmk") (* ; "Edited 24-Dec-2023 14:10 by rmk") (* ; "Edited 15-Nov-2023 23:56 by rmk") @@ -577,9 +579,9 @@ (SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T) elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM) then (CL:UNLESS (\GETSTREAM TEXTSTREAM 'INPUT T) - [RESETSAVE (SETQ TEXTSTREAM (OPENSTREAM TEXTSTREAM 'INPUT)) + [RESETSAVE (SETQ TEXTSTREAM (OPENTEXTSTREAM TEXTSTREAM)) `(PROGN (CLOSEF? OLDVALUE]) - (OPENTEXTSTREAM TEXTSTREAM) + TEXTSTREAM else (ERROR TEXTSTREAM "is not a Tedit stream"))) (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTSTREAM)) [FORMATTINGSTATE (create PAGEFORMATTINGSTATE @@ -705,6 +707,7 @@ (TEDIT.FORMATBOX [LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE) + (* ; "Edited 13-Mar-2024 17:09 by rmk") (* ; "Edited 20-Jan-2024 12:16 by rmk") (* ; "Edited 28-Jun-2023 15:54 by rmk") (* ; "Edited 22-Jun-2023 21:50 by rmk") @@ -820,32 +823,36 @@  "For now, draw a box around it, too.") ) NIL) - (for LINE in LINES when LINE do (* ; + (for LINE LTEXTOBJ in LINES when LINE do (* ;  "Run thru the lines displaying them all.") - (BLOCK) - (CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#)) - (IGEQ (GETPFS FORMATTINGSTATE PAGE#) - (GETPFS FORMATTINGSTATE MINPAGE#))) + (BLOCK) + (SETQ LTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) + of (FGETLD LINE LTEXTSTREAM))) + (CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#) + ) + (IGEQ (GETPFS FORMATTINGSTATE PAGE#) + (GETPFS FORMATTINGSTATE MINPAGE# + ))) (* ;  "We're beyond the min page number -- go ahead and print the line") - (\TEDIT.HARDCOPY.DISPLAYLINE (GETLD LINE LTEXTOBJ) - LINE - (SCALEREGION (DSPSCALE NIL PRSTREAM) - REGION) - PRSTREAM FORMATTINGSTATE)) - (CL:WHEN (EQ TEXTOBJ (GETLD LINE LTEXTOBJ)) + (\TEDIT.HARDCOPY.DISPLAYLINE + LTEXTOBJ LINE (SCALEREGION (DSPSCALE NIL + PRSTREAM) + REGION) + PRSTREAM FORMATTINGSTATE)) + (CL:WHEN (EQ TEXTOBJ LTEXTOBJ) - (* ;; + (* ;;  "This line refers back to the main text, so update the current-char pointer.") - (* ;; + (* ;;  "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") - [SETQ CHNO (IMAX (OR CHNO 0) - (ADD1 (GETLD LINE LCHARLIM]) - (push (GETPFS FORMATTINGSTATE PAGELINECACHE) - LINE) - (SETLD LINE LTEXTOBJ NIL)) + [SETQ CHNO (IMAX (OR CHNO 0) + (ADD1 (FGETLD LINE LCHARLIM]) + (push (GETPFS FORMATTINGSTATE PAGELINECACHE) + LINE) + (FSETLD LINE LTEXTSTREAM NIL)) (COND (LAST-CHNO (* ;  "We got a definite last chno from FORMATTEXTBOX.") @@ -855,7 +862,8 @@ (SETPFS FORMATTINGSTATE CHNO CHNO]) (TEDIT.FORMATHEADING - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 6-Mar-2024 13:09 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk") + (* ; "Edited 6-Mar-2024 13:09 by rmk") (* ; "Edited 15-Feb-2024 22:02 by rmk") (* ; "Edited 19-Jan-2024 23:20 by rmk") (* ; "Edited 9-Sep-2023 22:17 by rmk") @@ -868,15 +876,17 @@ (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))) (LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) - HEADINGTEXTOBJ FORCENEXTPAGE HEADING) + HEADINGTEXTOBJ HEADINGSTREAM FORCENEXTPAGE HEADING) (CL:WHEN [AND (for FORM inside (LISTGET LOCALINFO 'PRECONDITIONS) always (EVAL FORM)) (SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS) (LISTGET LOCALINFO 'HEADINGTYPE] - [SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) - of (OPENTEXTSTREAM - NIL NIL NIL NIL - `(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST) - of HEADING] + + (* ;; "Bind the stream to make sure it isn't collected.") + + [SETQ HEADINGSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL + `(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST) + of HEADING] + (SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of HEADINGSTREAM)) (* ;; "Insert the heading pieces into HEADINGTEXTOBJ") @@ -912,7 +922,8 @@ LINE))]) (TEDIT.FORMATPAGE - [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:10 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 10:28 by rmk") + (* ; "Edited 19-Jan-2024 23:10 by rmk") (* ; "Edited 11-Dec-2023 22:02 by rmk") (* ; "Edited 13-Nov-2023 00:15 by rmk") (* ; "Edited 22-Sep-2023 20:37 by rmk") @@ -997,7 +1008,7 @@ (* ;; "We now fill up the next complete page. Afterwards, we either continue to the next page (DPSNEWPAGE) or finish up. TEDIT.FORMATBOX is responsible for setting up NEWPAGEBEFORFE and NEWPAGEAFTER") - (SETPFS FORMATTINGSTATE CHNO CHNO with CHNO) + (SETPFS FORMATTINGSTATE CHNO CHNO) (for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) while (ILEQ (GETPFS FORMATTINGSTATE CHNO) TEXTLEN) do @@ -1269,7 +1280,8 @@ FORMATTINGSTATE FINAL-CHNO)))]) (TEDIT.FORMATFOLIO - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 19-Jan-2024 23:28 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk") + (* ; "Edited 19-Jan-2024 23:28 by rmk") (* ; "Edited 18-Jan-2024 17:04 by rmk") (* ; "Edited 13-Nov-2023 00:24 by rmk") (* ; "Edited 1-Jun-2023 00:12 by rmk") @@ -1281,7 +1293,7 @@ (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))) (FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) - FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST) + FOLIOSTREAM FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST) (CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE) (LISTGET FOLIOINFO 'NOFIRSTPAGE)) (* ;  "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.") @@ -1300,10 +1312,14 @@ (UPPERROMAN (ROMANNUMERALS (GETPFS FORMATTINGSTATE PAGE#) T)) (MKSTRING (GETPFS FORMATTINGSTATE PAGE#] - [SETQ FOLIOTEXTOBJ (TEXTOBJ (OPENTEXTSTREAM NIL NIL NIL NIL - `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS) - LOOKS - ,(LISTGET FOLIOINFO 'CHARLOOKS] + + (* ;; "Bind the stream to make sure it isn't collected.") + + [SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL + `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS) + LOOKS + ,(LISTGET FOLIOINFO 'CHARLOOKS] + (SETQ FOLIOTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of FOLIOSTREAM)) (TEDIT.INSERT FOLIOTEXTOBJ (CONCAT PRETEXT PAGE# POSTTEXT) 1 NIL T) (bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ)) @@ -1745,7 +1761,8 @@ (DEFINEQ (\TEDIT.FORMAT.FOOTNOTE - [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:30 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 17:00 by rmk") + (* ; "Edited 19-Jan-2024 23:30 by rmk") (* ; "Edited 6-May-2023 20:38 by rmk") (* ; "Edited 7-Mar-2023 13:11 by rmk") (* ; "Edited 30-May-91 12:52 by jds") @@ -1766,8 +1783,6 @@ REGION PRSTREAM FORMATTINGSTATE)) (* ;  "Format the line, noting any form-feeds") - (SETLD LINE LTEXTOBJ TEXTOBJ) (* ; - "And remember the document it came from.") (add (FGETLD LINE LEFTMARGIN) LEFT) (add (FGETLD LINE RIGHTMARGIN) @@ -1780,14 +1795,14 @@ (RETURN (DREMOVE NIL $$VAL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11921 15254 (\TEDIT.PARSE.PAGEFRAMES 11931 . 13431) (\TEDIT.PUT.PAGEFRAMES 13433 . -14257) (\TEDIT.UNPARSE.PAGEFRAMES 14259 . 15252)) (15317 31779 (TEDIT.SINGLE.PAGEFORMAT 15327 . 25545) - (TEDIT.COMPOUND.PAGEFORMAT 25547 . 26526) (TEDIT.PAGEFORMAT 26528 . 31777)) (31866 90148 ( -TEDIT.FORMAT.HARDCOPY 31876 . 42886) (TEDIT.FORMATBOX 42888 . 55048) (TEDIT.FORMATHEADING 55050 . -58664) (TEDIT.FORMATPAGE 58666 . 66869) (TEDIT.FORMATTEXTBOX 66871 . 81654) (TEDIT.FORMATFOLIO 81656 - . 86040) (\TEDIT.FORMAT.FOUNDBOX? 86042 . 88081) (TEDIT.SKIP.SPECIALCOND 88083 . 90146)) (90228 92509 - (TEDIT.HARDCOPY.PAGEHEADINGS 90238 . 92507)) (92618 99801 (TEDIT.HARDCOPY-COLUMN-END 92628 . 99799)) -(99846 104787 (SCALEPAGEUNITS 99856 . 100997) (SCALEPAGEXUNITS 100999 . 101769) (SCALEPAGEYUNITS -101771 . 102542) (\TEDIT.PAPERHEIGHT 102544 . 103479) (\TEDIT.PAPERWIDTH 103481 . 104785)) (105203 -108771 (ROMANNUMERALS 105213 . 108769)) (108807 111253 (\TEDIT.FORMAT.FOOTNOTE 108817 . 111251))))) + (FILEMAP (NIL (12038 15371 (\TEDIT.PARSE.PAGEFRAMES 12048 . 13548) (\TEDIT.PUT.PAGEFRAMES 13550 . +14374) (\TEDIT.UNPARSE.PAGEFRAMES 14376 . 15369)) (15434 31896 (TEDIT.SINGLE.PAGEFORMAT 15444 . 25662) + (TEDIT.COMPOUND.PAGEFORMAT 25664 . 26643) (TEDIT.PAGEFORMAT 26645 . 31894)) (31983 91368 ( +TEDIT.FORMAT.HARDCOPY 31993 . 42983) (TEDIT.FORMATBOX 42985 . 55757) (TEDIT.FORMATHEADING 55759 . +59542) (TEDIT.FORMATPAGE 59544 . 67846) (TEDIT.FORMATTEXTBOX 67848 . 82631) (TEDIT.FORMATFOLIO 82633 + . 87260) (\TEDIT.FORMAT.FOUNDBOX? 87262 . 89301) (TEDIT.SKIP.SPECIALCOND 89303 . 91366)) (91448 93729 + (TEDIT.HARDCOPY.PAGEHEADINGS 91458 . 93727)) (93838 101021 (TEDIT.HARDCOPY-COLUMN-END 93848 . 101019) +) (101066 106007 (SCALEPAGEUNITS 101076 . 102217) (SCALEPAGEXUNITS 102219 . 102989) (SCALEPAGEYUNITS +102991 . 103762) (\TEDIT.PAPERHEIGHT 103764 . 104699) (\TEDIT.PAPERWIDTH 104701 . 106005)) (106423 +109991 (ROMANNUMERALS 106433 . 109989)) (110027 112404 (\TEDIT.FORMAT.FOOTNOTE 110037 . 112402))))) STOP diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM index 68bd0a7114359e33561b4835422c42f9bb2515ef..9c31e89463ed358ff17b95081f0313507272d14c 100644 GIT binary patch delta 2188 zcmZuyU2NM_6pqvVW^I?YSr?)#J@dM>-PSC&6X&NJ)Jfbnt>f!C?$T`?R<%q`SJ

wC_3zI*EtbMp~%tJK8_gN2!eK|adIfJ>w~J}un7k_?E#0C?D~lhJ6J6Vp-g_Ct0i zL#ANvDzGDyiUM1mB9RCS<(V6o%m2HYi?ais{*k;QXLVUJfVO?iVwBVlB^YeZW^y_k#=(!?T?Zv~4$2wU&z(QKn<+FJ*Ssct^+-+f_X+CKU zGY1dif6d)^8TZW_gPJrdM~1j~V!&g~ob=Z^-5>jhfAQ{fF(sJuxbUeDmtZdi_m7ug zmV&u`^j&-D8vQtvm!J{|l)`~a;YJB+tARUAI-Uf3kBFv|f@WxXUNs;V=OIhftb{NY z-GD+IXckqeAcG)UKL)$n;>RoK^Bg1BAHsGyctsmyGOKgeDOLK7~6? z8ASurSpYu81H!yIssSGpH*r+7m{Q;)}hl( z%zAvNYcZOlA?(OWZUc&&Ry^psgAj!r$xaq9NW?x2mq?&R?K6Oji;$5=h%S#wdM-<} zb0aDwwnTxvs!bZm49tuOEDJFtBMaP(Yxs_F0>0l^n7fMA!(lWD>~;F(si%NP#@U(K z%Pbz>x)%yCV(q)oH_Sc}6nY$z83$_yesYT)wf@5&y0eG9B-m2-btzv}U3YTs=A-x- zFJp%8zrBZ6wn0KG>@JE{{3bNeiTO0g(9iSLT9APC_mO}Hp56D4*ITZTkk!*W2o)dO zAVIeotgg+DKWJMIJdS}~{Ryn&o4q}u1QfH9BJ1*Ko?r@i4su1!Hi4Lo*1qi>Vmx9h z>Lj%m3qNM8KT|!UimZYLNyrexAO(a8z;sd&hcQ{oVZ{;0s4*+6w7N)cv<_ z{qs9`ughiioH$_p-oJM`vomiKyRV~Tw_0y`uj=}BuJZx?{*!T1gQs?U`YzftPb=ke z*=E$|;#TIDWNfUOV?Bwly!Fpxj(Bgj5NqnoA>f6dv)%DRh@m0p8Oq=aw2AjTt z*IJ)FB%%5&!P2aFe=|dvNhc0kNXSPk^2Fyx^NN4|iRnXN1{%a)KTZObfay288_S=R zTfR2i8vsNIUkf;&Lrj*E%ZIwF4v&HvNt2+5!e?UA{-Uu`YZf3G!J9H4Mo* zO;aivN?w(L!w#L!t3_Eiw7i^^i>Puji#;}sO-vnfGWKC!Gq82IWb8jCJ`P1$SzpPC zwY$eo?O(Ku_CkF)5zb*vu~J;z4nh$J*)f$+6x}R%v(MLgkXJ{Dtq+t58Y$WxjVnZy z37N7UG3pBXkmjLq9P0zhiX#Yx=G1z7pjb2w4ofQOsT~WQn=DBz?8&&9&m0ykRhgUv zO>ddGNW5;QzS~yBR}pUv%y!E^6l4lkd}x4~w#=cv#q;arxKLIV(r%0Cd}Xf5oQW0p zn46jJxYR+qN#|$EBp60wRoC7nes6^m1f^>$FL<7Jq`gTF z;8C3%Rp(N|hKM?<$i)RHOyGbvDCa|!#S1}FRg_6xQjk=5FMV-pa51%=K|J1l+jz!D z*L49YM>!(t3Lz61B!S#%B9vxL!pP1@*gC?CW>V9r+~Xf0%aXXL)Ew4^Pw((WZtixu zcG~)vWrkPWnP#%PJF>gR^Q*Pj)z4Mi@^cujJbPeT3uk(*FVFCucMIW%%S)9B`^v7nci@e+kSvllj2)iC&||&owWW7KD9CX delta 2215 zcmZuy-EY%Y6t7c0Mrli0vJy-h&O%9BM!VRt<0R!PA8zZ^@pT=y<)d3DO-0f&ib@&U z9_X|^j7b9xEHO5*mp)HgL&(E4AkrQtb#L1f@IN3?X_NMXx^tbhly*_%`}4Wyo^ySE z=i~Mh=3D%a?FFePJu%nA2Y3Mjk*Fv}xjWNgRusCS!S~i?ILZg3eBjPw-@CnoF(a8E z`WYx(24DY(ssc!NUhWJ3&jG>L-O$yqsB*%PW2T&hx2;xPTF02KU7`RS$MI6g`j|P& zulwkRsBXxk3K_}tB+ zN$aL=D4GdEh=&Bx5;25gU>yn~&;V(%v zjJa8YHVk3_eg)BGZG$bmHkDYvw;x{+#jRK6BGf$f%15|$D7}%Q z$u$Kb07;S8>=imF#np4EM@?%^Qs|_vO9}?8A3F|uk?urHl?{17AsR?r2$C7y z79pd2=|x8$GZYSppemZ2lreP_-9)w}By_U~GikGE%fZq?|DQ}ofHQGof(~5JK7uF$ zi9wAZ2!kqXxJrO3CP^a<0kTVh0E2QYiOGpLNQDVmqlp+Bkgd_K8OQs3tY=X;%WqTc zO6+WD*^w^Se^IRatI+z0u7AgCk;Z`5bUMfFofr9BE@z)ot1+%yc4E0UZKnaRO5A5v z>tuKPLNjra))ge_o1weNREo6b2V?OjTPe#{b=gaeuYM(-@&(dN*k$MQtfxZQTy@V$ zSmJTjAve!l4iqoDXP#wS5oFyJ(pL5pcb?6*WnGn}`?>nXr};0Lr)kF%&F(UHi>m|f zd~wx7-2QA^rMP+>&o?eD5*KpHV{OW#F%^pxy8w+@%%qH9n8PrxXc^fsbwy6d8IA{g>dz>~aZwLVEWv6d)oip0gPMd2~Dq26WdlDs6 zCmFkcAc-P2C7CMP4}>qhjn<5CM{I&@)Y+`;@%WAbj1 zIZ=bz<{UFlnjK7er`?7>M7;j;k@Z2JhfyuHubVk%ebU$2V~6%^EaS`WA=>~z)XVy&j{)H?ceKv8f3h|crkyd;~n!PpfdgZ&NUr^Mz^pbei zdG`=6<=t!Z?#Z$h;x0E47U^~)nM*eb>&F}@u6|D1oOwzp^0Sdg9?R1n6=rXhP2dC4 z+HBw=k{xpl5pWTHb2sKh9@0bA-VPj&0~|InO~aOI#8gZOUb22Z)-zo#$PJawi_(^a z2;)G)W~&l1geN5dY6u&)9z%0gIZm(*Z`f%^be+x$bc>@|Dh(fRb}{#@^TX}V>)Hd& zE{;F^F#YOL!MZivvHcYGuekNou+(}h?SH&GSpN)nbaLF5n{8=05aF%h LsY4~*IMMhYbU!>{ diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN index 71baf30e..d8fd641a 100644 --- a/library/tedit/TEDIT-SCREEN +++ b/library/tedit/TEDIT-SCREEN @@ -1,12 +1,17 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}tedit>TEDIT-SCREEN.;612 184763 +(FILECREATED "14-Mar-2024 12:53:18" {WMEDLEY}tedit>TEDIT-SCREEN.;618 186031 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.MARK.LINES.DIRTY) + :CHANGES-TO (FNS \FORMATLINE \TEDIT.CREATEPLINE) + (I.S.OPRS inlines backlines incharslots backcharslots) + (RECORDS THISLINE LINECACHE LINEDESCRIPTOR CHARSLOT) + (MACROS GETLD FGETLD SETLD FSETLD SETYPOS LINKLD HCSCALE HCUNSCALE CHAR CHARW + PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT NTHCHARSLOT + LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR CHARSLOTP DIACRITICP) - :PREVIOUS-DATE " 2-Mar-2024 07:40:06" {WMEDLEY}tedit>TEDIT-SCREEN.;611) + :PREVIOUS-DATE "13-Mar-2024 14:40:10" {WMEDLEY}tedit>TEDIT-SCREEN.;613) (PRETTYCOMPRINT TEDIT-SCREENCOMS) @@ -146,7 +151,7 @@ NEXTLINE (* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)") - LTEXTOBJ (* ; "A cached TEXTOBJ that this line took its text from. Used only in hardcopy to disambiguate when chno's should be updated.") + LTEXTSTREAM (* ; "A cached textstream that this line took its text from. Filled in by \TEDIT.FORMATLINE only in hardcopy, used temporarily and the cleared by \TEDIT.FORMATBOX to avoid the circularity.") NIL (* ; "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ") NIL (* ;  "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") @@ -616,6 +621,7 @@ (\FORMATLINE [LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 14-Mar-2024 12:53 by rmk") (* ; "Edited 2-Mar-2024 07:39 by rmk") (* ; "Edited 5-Feb-2024 09:35 by rmk") (* ; "Edited 26-Jan-2024 11:01 by rmk") @@ -1072,6 +1078,14 @@ (* ;;  "Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?") + (CL:WHEN (AND (EQ PREVSP (PREVCHARSLOT CHARSLOT)) + (NULL (CHAR PREVSP))) + + (* ;; "The line ended in a space that needs to be resolved. If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.") + + (FILLCHARSLOT PREVSP (CHARCODE SPACE) + (CHARW PREVSP)) + (SETQ PREVSP NIL)) (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT)) (add CHNO -1) (SETQ DX 0) (* ; "TX is already correct") @@ -1142,10 +1156,13 @@ (* ;; "") (FSETLD LINE LFMTSPEC FMTSPEC) - (FSETLD LINE LTEXTOBJ TEXTOBJ) (* ; - "XPOINTER, valid if TEXTOBJ is held") + (CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY) + + (* ;; "Used temporarily and cleared by \TEDIT.FORMATBOX; not an XPOINTER") + + (FSETLD LINE LTEXTSTREAM TSTREAM)) (freplace (THISLINE DESC) of THISLINE with LINE) - (\TEDIT.FORMATLINE.VERTICAL LINE TEXTOBJ) + (\TEDIT.FORMATLINE.VERTICAL LINE TSTREAM) (\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.") @@ -2347,7 +2364,8 @@ (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))]) (\TEDIT.CREATEPLINE - [LAMBDA (TEXTOBJ PANE FIRSTLINE) (* ; "Edited 21-Feb-2024 23:36 by rmk") + [LAMBDA (TEXTOBJ PANE FIRSTLINE) (* ; "Edited 13-Mar-2024 17:02 by rmk") + (* ; "Edited 21-Feb-2024 23:36 by rmk") (* ; "Edited 2-Jan-2024 13:04 by rmk") (* ; "Edited 29-Dec-2023 15:48 by rmk") @@ -2377,8 +2395,7 @@ LTRUEDESCENT _ 0 LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC 1STLN _ NIL - LSTLN _ NIL - LTEXTOBJ _ TEXTOBJ)) + LSTLN _ NIL)) (replace (TEXTWINDOW PLINES) of PANE with DUMMYLINE)(* ; "Install PANE's new dummy line") (LINKLD DUMMYLINE FIRSTLINE) (* ; "Link the possible first line") DUMMYLINE]) @@ -2928,21 +2945,21 @@ (SETQ TAILLINE NIL))))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (24320 25729 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24330 . 25727)) (33226 109797 (\FORMATLINE -33236 . 67170) (\FORMATLINE.SETUP 67172 . 70557) (\TEDIT.FORMATLINE.HORIZONTAL 70559 . 74834) ( -\TEDIT.FORMATLINE.VERTICAL 74836 . 76805) (\FORMATLINE.JUSTIFY 76807 . 82741) (\FORMATLINE.TABS 82743 - . 90224) (\FORMATLINE.SCALETABS 90226 . 91223) (\FORMATLINE.PURGE.SPACES 91225 . 92529) ( -\FORMATLINE.EMPTY 92531 . 97234) (\FORMATLINE.UPDATELOOKS 97236 . 104181) (\FORMATLINE.LASTLEGAL -104183 . 107659) (\FORMATBLOCK 107661 . 109795)) (109914 112220 (\CLEARTHISLINE 109924 . 110593) ( -\TLVALIDATE 110595 . 112218)) (112414 132131 (\DISPLAYLINE 112424 . 124536) (\DISPLAYLINE.TABS 124538 - . 127155) (\TEDIT.LINECACHE 127157 . 127885) (\TEDIT.CREATE.LINECACHE 127887 . 128723) ( -\TEDIT.BLTCHAR 128725 . 131246) (\TEDIT.DIACRITIC.SHIFT 131248 . 132129)) (132746 184740 ( -TEDIT.UPDATE.SCREEN 132756 . 134395) (\BACKFORMAT 134397 . 136151) (\TEDIT.PREVIOUS.LINEBREAK 136153 - . 138341) (\FILLPANE 138343 . 140662) (\TEDIT.UPDATE.LINES 140664 . 145543) (\TEDIT.CREATEPLINE -145545 . 147315) (\TEDIT.FIND.DIRTYCHARS 147317 . 149329) (\TEDIT.FORMATLINES 149331 . 152680) ( -\FORMAT.GAP.LINES 152682 . 156546) (\TEDIT.LOWER.LINES 156548 . 160800) (\TEDIT.RAISE.LINES 160802 . -164127) (\TEDIT.VALID.LINES 164129 . 173413) (\TEDIT.CLEARPANE.BELOW.LINE 173415 . 174733) ( -\TEDIT.INSERTLINE 174735 . 175993) (\TEDIT.INSURE.TRAILING.LINE 175995 . 177183) ( -\TEDIT.MARK.LINES.DIRTY 177185 . 179896) (\TEDIT.LINE.BOTTOM 179898 . 182738) (\TEDIT.NCONC.LINES -182740 . 184738))))) + (FILEMAP (NIL (24822 26231 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24832 . 26229)) (33728 110992 (\FORMATLINE +33738 . 68365) (\FORMATLINE.SETUP 68367 . 71752) (\TEDIT.FORMATLINE.HORIZONTAL 71754 . 76029) ( +\TEDIT.FORMATLINE.VERTICAL 76031 . 78000) (\FORMATLINE.JUSTIFY 78002 . 83936) (\FORMATLINE.TABS 83938 + . 91419) (\FORMATLINE.SCALETABS 91421 . 92418) (\FORMATLINE.PURGE.SPACES 92420 . 93724) ( +\FORMATLINE.EMPTY 93726 . 98429) (\FORMATLINE.UPDATELOOKS 98431 . 105376) (\FORMATLINE.LASTLEGAL +105378 . 108854) (\FORMATBLOCK 108856 . 110990)) (111109 113415 (\CLEARTHISLINE 111119 . 111788) ( +\TLVALIDATE 111790 . 113413)) (113609 133326 (\DISPLAYLINE 113619 . 125731) (\DISPLAYLINE.TABS 125733 + . 128350) (\TEDIT.LINECACHE 128352 . 129080) (\TEDIT.CREATE.LINECACHE 129082 . 129918) ( +\TEDIT.BLTCHAR 129920 . 132441) (\TEDIT.DIACRITIC.SHIFT 132443 . 133324)) (133941 186008 ( +TEDIT.UPDATE.SCREEN 133951 . 135590) (\BACKFORMAT 135592 . 137346) (\TEDIT.PREVIOUS.LINEBREAK 137348 + . 139536) (\FILLPANE 139538 . 141857) (\TEDIT.UPDATE.LINES 141859 . 146738) (\TEDIT.CREATEPLINE +146740 . 148583) (\TEDIT.FIND.DIRTYCHARS 148585 . 150597) (\TEDIT.FORMATLINES 150599 . 153948) ( +\FORMAT.GAP.LINES 153950 . 157814) (\TEDIT.LOWER.LINES 157816 . 162068) (\TEDIT.RAISE.LINES 162070 . +165395) (\TEDIT.VALID.LINES 165397 . 174681) (\TEDIT.CLEARPANE.BELOW.LINE 174683 . 176001) ( +\TEDIT.INSERTLINE 176003 . 177261) (\TEDIT.INSURE.TRAILING.LINE 177263 . 178451) ( +\TEDIT.MARK.LINES.DIRTY 178453 . 181164) (\TEDIT.LINE.BOTTOM 181166 . 184006) (\TEDIT.NCONC.LINES +184008 . 186006))))) STOP diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM index 45794b22c8f91ff184634822988a778be7e4b889..f79d8277c71b8e92c885b89e4949f02957c64e4d 100644 GIT binary patch delta 1670 zcmZux&2Jk;6pu|sDyu38oPMNL^sp)sM~XEwJ3BLL#9_U=jyG9*R=ewvph|6M3Jp!u zuOI%(UR%bKrLzjC62zeCSB3Z1$I@O$ zFF&ab{KKr0DlGc7xTeD>#-et2_HI9hPquE|9h`RdZr#~>^mzCF{s0|GrE2=e{i~NC z3*maP6Zv7HBXC-F6bCv zTUSbf9Vf$3fENx%Li+c^YYbf9#*B&YgjJ}Ak+<&aZoKSbPo^42d7a|`$kCIfH;ig2 zJ-5Hms}%n_Q`k%AX8$Z4_GZs+6tCUXLi2n7{`TspD_We)^yakKh4Rd?7TYJqa`E`i z4RPGNS^DA4!Uw&7-hNgn>#Lv5;PdMH#%j58yw>=2rm>p-{LYVWSro1}KlUOWflEpC@BdE-!A%aby*;oQ^#YWaD z#WT-&DscgFo>ZuQf!maGi38k-fO4WvPX=Y+x9t^AH&(Ii5En>^QynwO>4{om%8JU| ztte3{tAkS_IkdfY11Q1pQzOh&72YOIYCIVmKZ!%T)c% z476TD_E=coFcz~|UpVNeVK`P;iM))T=rb}>*%VK+GeyTWWK1J*WFs@FknTetiQEry z;w{g1{mu$7DaL|GQyol|FR-tn*U5~L^2m5bypRPwAX!qQRV1CabKrcNln=+uD@9N51@U! AasU7T delta 1394 zcmZux&u_1;#$53`_Ft5t_P zw;tZTb28hlH)?CWxNpMDbaE5Hd<*VR%6?N_KSh9A`JS{tJKu7{^Nj|y)68tg$=0YD zF`2n^q+R%JCECKPL(Q&M*Q(g4*=LVd$M>qA7MzaVJN41Y$Nkg073cE!^_f4vbZ(As zpL^-lx>pwKSG#Y&=w7kS#lOxf4{r4KOqQfTL7=VET3w((6Cb{^m%cllQlJF%l3^Yu z=`|p&YG_AbT9Raz40{d=#IU*M|@HpbUm1fBx z&C@I%=0J*y8k13lo1JWAI3^XAVkF#2p$mjQXG@I)`S#zhm#Zq6z*f-HC+I=X{jBFM zDkSK|yBVPL<@7|p5AmS0VUq3-tTF{;*#|jvrziAq4u!Jx2o$cIC{ZY600T4VLcrzc z-Ws?iruJz<#i!YC@2r7}4Q{7nWyRhL;+BHc}uJMC|U+u<=MjvG0D8TxFZ+Kp!$mv&d@e|lvllJI#E2_0P^K*5$?t6_h;mL zh>)6L0cLNrwY7jz&dwbGVL-=n$luH?wlK)CJO7Fz6SCL(Oh$h;i9Szm3eJj7D7o6f z7^8TU_B+?unZAH-vNepl$u1!B%t{bsV;@@qqU(+KEzYDKE?e=9$>o!9pM n_LBwvPyB70-!IvJwzZ?J+_|{M@0#-;>XNO{qw#M$@7Mna|5Rr5 diff --git a/library/tedit/TEDIT-STRESS b/library/tedit/TEDIT-STRESS new file mode 100644 index 00000000..9c3ce7af --- /dev/null +++ b/library/tedit/TEDIT-STRESS @@ -0,0 +1,260 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "14-Mar-2024 15:16:05" {WMEDLEY}tedit>TEDIT-STRESS.;49 12388 + + :EDIT-BY rmk + + :CHANGES-TO (FNS STRESSHC) + + :PREVIOUS-DATE "13-Mar-2024 00:24:06" {WMEDLEY}tedit>TEDIT-STRESS.;48) + + +(PRETTYCOMPRINT TEDIT-STRESSCOMS) + +(RPAQQ TEDIT-STRESSCOMS ( (* ; "Preload typical image objects") + (FILES SKETCH DATEFORMAT-EDITOR) + (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD) + (FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE))) + + + +(* ; "Preload typical image objects") + + +(FILESLOAD SKETCH DATEFORMAT-EDITOR) +(DEFINEQ + +(STRESSHC + [LAMBDA (FILES NSYSOUTS REPS NOERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP) + (* ; "Edited 14-Mar-2024 15:15 by rmk") + (* ; "Edited 13-Mar-2024 00:23 by rmk") + (DECLARE (SPECVARS SINGLESTEP)) + + (* ;; "If all arguments are defaulted, runs through all TEDIT files in the current directory until it fails, doing SAVEVM before each file. The HC files are made as {CORE}FOO.PS.") + + (CL:UNLESS FILES + (SETQ FILES (FILDIR '*.TEDIT;))) + (SETQ REPS (SELECTQ REPS + (NIL MAX.SMALLP) + REPS)) + (SETQ NOERROR T) + (CL:UNLESS NSYSOUTS + (SETQ NSYSOUTS 'SAVEVM)) + [SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY + MEDLEYDIR 'NAME + "STRESSHC" 'EXTENSION + 'SYSOUT] + (PRINTOUT T REPS " reps of " (LENGTH FILES) + " files saving " + (if (EQ NSYSOUTS 0) + then "no sysouts" + elseif (EQ NSYSOUTS 'SAVEVM) + then " the virtual memory" + else (PRINTOUT NIL NSYSOUTS " sysouts on " 3) + SYSOUTNAME) + T) + (PRINTOUT T "First file is " (CAR FILES) + T T) + (BKSYSBUF " ") + (for R SYSOUTS (ITYPE _ (CL:IF PDF + 'pdf + 'ps)) + (N _ 0) from 1 to REPS + do (PRINTOUT T "Rep " R T) + (if (EQ NSYSOUTS 'SAVEVM) + then (SAVEVM) + else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS))) + [for F TS HCFILE inside FILES + do (PROMPTPRINT F) + (SETQ HCFILE (CL:IF SEPARATEOUT + (OUTFILEP (PACKFILENAME 'EXTENSION ITYPE 'VERSION 1 'BODY F)) + (CL:IF PDF + "{CORE}FOO.PDF;1" + "{CORE}FOO.PS;1"))) + (if [if NOERROR + then [NLSETQ (SETQ TS (OPENTEXTSTREAM F)) + (TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL + (CL:IF PDF + 'PDF + 'POSTSCRIPT)] + else (SETQ TS (OPENTEXTSTREAM F)) + (TEDIT.FORMAT.HARDCOPY TS HCFILE T NIL NIL NIL (CL:IF PDF + 'PDF + 'POSTSCRIPT)] + then (add N 1) + else (PRINTOUT T " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F) + T)) + (CLOSEF? TS) + (CL:WHEN SINGLESTEP + (HELP (CONCAT "Just hardcopied " F " to " HCFILE)))] + (PRINTOUT T " Hardcopied " N " files without failure" T) + finally (RETURN (LIST R N]) + +(STRESSRAND + [LAMBDA (FILES REPS NOERROR PROBESPERFILE) (* ; "Edited 12-Mar-2024 09:47 by rmk") + + (* ;; "Opens, fetches random characters") + + (CL:UNLESS FILES + (SETQ FILES (FILDIR '*.TEDIT;))) + (SETQ REPS (SELECTQ REPS + (T MAX.SMALLP) + (NIL 1) + REPS)) + (CL:UNLESS PROBESPERFILE (SETQ PROBESPERFILE 100)) + (PRINTOUT T REPS " reps of " (LENGTH FILES) + " files with " PROBESPERFILE " probes per file" T) + (for R (N _ 0) from 1 to REPS + do (PRINTOUT T R " ") + (for F TS inside FILES + do (if [if NOERROR + then [NLSETQ (SETQ TS (OPENTEXTSTREAM F)) + (for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE + do (TEDIT.NTHCHARCODE TS (RAND 1 LEN] + else (SETQ TS (OPENTEXTSTREAM F)) + (for I (LEN _ (TEDIT.NCHARS TS)) from 1 to PROBESPERFILE + do (TEDIT.NTHCHARCODE TS (RAND 1 LEN] + then (CLOSEF TS) + (add N 1) + else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F) + T))) finally (RETURN (LIST R N]) + +(STRESSPUT + [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 12-Mar-2024 09:48 by rmk") + + (* ;; "Opens, puts, reopens and tests for equivalence") + + (CL:UNLESS FILES + (SETQ FILES (FILDIR '*.TEDIT;))) + (SETQ REPS (SELECTQ REPS + (T MAX.SMALLP) + (NIL 1) + REPS)) + (PRINTOUT T REPS " reps of " (LENGTH FILES) + " files" T) + (for R (N _ 0) from 1 to REPS + do (PRINTOUT T R " ") + (for F TS TSP inside FILES + do (if (if NOERROR + then (NLSETQ (SETQ TS (OPENTEXTSTREAM F)) + (TEDIT.PUT TS "{CORE}FOO.TEDIT;1") + (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1")) + (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP))) + (HELP "Get of put not equivalent" F)) + (CLOSEF TSP)) + else (SETQ TS (OPENTEXTSTREAM F)) + (TEDIT.PUT TS "{CORE}FOO.TEDIT;1") + (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1")) + (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP))) + (HELP "Get of put not equivalent" F)) + (CLOSEF TSP)) + then (CLOSEF TS) + (add N 1) + else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F) + T))) finally (RETURN (LIST R N]) + +(STRESSOPEN + [LAMBDA (FILES REPS NOERROR) (* ; "Edited 12-Mar-2024 09:48 by rmk") + (* ; "Edited 11-Mar-2024 09:15 by rmk") + (CL:UNLESS FILES + (SETQ FILES (FILDIR '*.TEDIT;))) + (SETQ REPS (SELECTQ REPS + (T MAX.SMALLP) + (NIL 1) + REPS)) + (PRINTOUT T REPS " reps of " (LENGTH FILES) + " files" T) + (for R (N _ 0) from 1 to REPS + do (PRINTOUT T R " ") + (for F TS inside FILES do (if (if NOERROR + then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))) + else (SETQ TS (OPENTEXTSTREAM F))) + then (CLOSEF TS) + (add N 1) + else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL + 'DIRECTORY NIL + 'BODY F) + T))) finally (RETURN (LIST R N]) + +(STRESSREAD + [LAMBDA (FILES REPS NOERROR) (* ; "Edited 12-Mar-2024 09:48 by rmk") + (* ; "Edited 11-Mar-2024 09:13 by rmk") + (CL:UNLESS FILES + (SETQ FILES (FILDIR '*.TEDIT;))) + (SETQ REPS (SELECTQ REPS + (T MAX.SMALLP) + (NIL 1) + REPS)) + (PRINTOUT T REPS " reps of " (LENGTH FILES) + " files" T) + (for R (N _ 0) from 1 to REPS + do (PRINTOUT T R " ") + (for F TS inside FILES + do (if (if NOERROR + then (NLSETQ (SETQ TS (OPENTEXTSTREAM F)) + (for I from 1 while (TEDIT.NTHCHARCODE TS I))) + else (SETQ TS (OPENTEXTSTREAM F)) + (for I from 1 while (TEDIT.NTHCHARCODE TS I))) + then (CLOSEF TS) + (add N 1) + else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F) + T))) finally (RETURN (LIST R N]) +) +(DEFINEQ + +(EQTEXTSTREAM + [LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk") + (AND (IEQP (TEDIT.NCHARS TS1) + (TEDIT.NCHARS TS2)) + (OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I)) + (SETQ C2 (TEDIT.NTHCHARCODE TS2 I)) + unless (OR (EQ C1 C2) + (AND (EQ C1 10) + (EQ C2 13)) + (AND (EQ C1 13) + (EQ C2 10)) + (AND (IMAGEOBJP C1) + (IMAGEOBJP C2) + (EQUALALL C1 C2))) do (CL:WHEN STOP + (HELP "Different characters: " + (LIST I C1 C2))) + (RETURN NIL) finally (RETURN T]) + +(SYSOUTRING + [LAMBDA (NSYSOUTS SYSOUTNAME SYSOUTS) (* ; "Edited 12-Mar-2024 17:52 by rmk") + + (* ;; "SYSOUTS is the list of names of sysouts that currently exist.") + + (DECLARE (USEDFREE SINGLESTEP)) + (CL:WHEN (IGREATERP NSYSOUTS 0) (* ; + "Keep NSYSOUT sysouts with increasing versions") + (CL:WHEN (IGEQ (LENGTH SYSOUTS) + NSYSOUTS) + (DELFILE (pop SYSOUTS))) (* ; + "Drop the firstr (oldest), new one goes at the end") + (SETQ SYSOUTNAME (SYSOUT SYSOUTNAME)) + (CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting") + (SETQ SINGLESTEP T)) + (NCONC1 SYSOUTS SYSOUTNAME))]) + +(COPYTOCORE + [LAMBDA (FILES NORECLAIM) (* ; "Edited 12-Mar-2024 22:45 by rmk") + + (* ;; "Copy FILES to {CORE}, defaulting to TEDIT files in connected directory") + + (CL:UNLESS (LISTP FILES) + (SETQ FILES (FILDIR (OR FILES "*.TEDIT;")))) + (PRINTOUT T "Copying " (LENGTH FILES) + " files to {CORE} " + (CL:IF NORECLAIM + "without " + "with ") + "reclaiming" T) + (for F in FILES collect (COPYFILE F (PACKFILENAME 'HOST 'CORE 'DIRECTORY NIL 'BODY F)) + finally (CL:UNLESS NORECLAIM (RECLAIM]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (742 9789 (STRESSHC 752 . 4159) (STRESSRAND 4161 . 5577) (STRESSPUT 5579 . 7289) ( +STRESSOPEN 7291 . 8579) (STRESSREAD 8581 . 9787)) (9790 12365 (EQTEXTSTREAM 9800 . 10851) (SYSOUTRING +10853 . 11733) (COPYTOCORE 11735 . 12363))))) +STOP diff --git a/library/tedit/TEDIT-STRESS.LCOM b/library/tedit/TEDIT-STRESS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..3436fc4a625d30ba9f72542f6a8cf1cd2d5a1cdf GIT binary patch literal 9192 zcmd5?-ESOM6<@C%C)p;Eome5YP<1sz+T;D0&CJ-Tp{TXJo9f?0A6yI?wHfjnj#de+s` zg&oCd-7$zHPR3#rw1*6;xki=^{M2@}Qr~_GU6^j%ac#qKrcbM>NfHwzrQ4$@vK|uxS!-2; zF00?&Y;Apcmhg598B)g>xursZgxgL}PYa~7ih=reDrv&xCtAxVojZ|aC7C3%Y)R=A z(z?(fvDwUmUYa+YxNDJ#T*(RMJV|EDwy|tlOHMosQ9_cv>z3775$le9!r_yXF<%_I zD2fu9%_d_LWg-#BoSmJ@=x$~qZX52BU5e*yt2jlX7+ zQHbl{M`hJY1;=pD#FzELl7T{vEM%x6;5I?Z+1wOC<(%}U>XxB>hAP{Zf7%Ac?HTwtg->ke8#0K(~H3P|}MA9yPiq{GuPDtlQ8MbcSd2Wf`_@(H>-C8)XMK z5-Itknb=vnH+1tPW!EZDsO~G0NfLeeXf$$Y?rpY7Y%|v)o%F2(7w_F$8>+7j>%V7j z)}kHuTVvPUttZ&;^K^^ZT{F02k4J~;^AUPkJCd%)=uL;!@$To?P<>wLmGgIg!K=2P zWPROvl{IWXuGd2Sc=sEFwaO!`_ng;Ro%P%^)x7N4$gT}`EpfTB3O_NfvLUXp>vJQW%=PKfk;Bi^*_<68ue0K_UmPDD zJYtQp7RULFZw^__{$^VVuY+~KRe)c;3H6G`I>uKp zf9$u{KK>VLUt(8lglPnSd+p=Dn)%xJIDjD`17nN=4wEbr9AJPG(NY@86fDQcJx#PE z4x3?@Z5)&&z`!<3647P=1Tbq<{n;tf)Rg~9k@i3uO;mS44N;Rgbj&O*WH_Fx3MwtR zv}2rX8NG&wQGvJsi(=WO^KgkWLt%|gPD%JPP_!9uE=n*fMNWE$9_{9dg0(vOvawtQ zz^Q&0a>{QgC;iT3O(y9)j(mCvc&*AoT}2CS(Ki>1ECtQPWbm5JnMzGc0qXTMk&=qn zK$@ZJVebIY-W>&5UM3|8Pa5_f=uR{!K?vqGx(;BXiZOgcpeE!nD2E{%`vf7;?o}y4mJQp13BbKb zU{s6}dr~Ac=MtAOnawRCV=9}KbD%St|7Hfb&!C(@zq)M`D&b0&BAnk~1w>Or3sDo^ z_+l`;5{#E1Q`5}$orWYx0#GfG?Itb>afS$sm$tS^ZM9WdZ*JB>Vg&R|YY?N=YPQHZ z{0T(GK22l_v)mj^hXmmnx=Es{Ng}+Iv25ezoMlayozs#KL#f;-pZ*#$my=DtWQq+P<{9K`vA;G+UPi*e6W+V$-jV0$6*0UR$d#)-S$*M@iIh zZB?;l&2zX*q+&$y4=uQRTmamfzfLi-C3gYT(#}{}1E+z|RT3z>_maMH`ZK8D;DpE$YwZ(8*^>{BDHTv^U#fr# ze6dr#!74)r&Q3INs>|}N|ub@>n;Vt2;f~(NVDCv;GJPs@>#jG>j}Au7%EH}OJLV!ac73YO zjXr)Lf9voG#svO6_(uNy+Lipk`}yd5>Fe>)k>NfT{jg_ZeTzO=I^I?bOus(JG>V?0 z9kEVYV|Q;nT5MRSLJDS`Y}|hCWcwc{YQN$&JBy9m?_Rt2J&%#>Yw!!4f%F>uYxmM% z_ex-H6xd&GJ`@V-VT+)MzWtWrL3wsl2Gnv}Ph`z^62fXPYtRCw_kh$M#g}Der$Lut zO?LuSa65@L?Li*BzWL#M!GGD}45P1n#VVuBkw z8Ai#sXi{=-i`Hv1x&X)w}$yj2+8z?UQj}BhpD*-k_+?IZECtUVP!8iw@LNem+CLBZd5OB!;1D8ZO#&4 zpe0z*t}XYALwgclnLjoSym>2b5DQ>%nG?*1q) z?V17n)%{)gNis11NHlWbJ}6%42eV8$`n>p`pjsN<3##FK9pq4b(s#a2!TE|=BWz$F zs)wv&$J<}$SpBWO`ukz#`WK3&Y)E-IJ?L-gfC=Zbt0wY{A%?=V=pB)t_mE=$! zV334!;o~=K3v*I{)!w9FNO%zlC%*w!d#K%Y#DX5es0|aqP+JCCc2S#pVaz?D4pV^I z)LrNvlpa512WnF;97b(fLBW1tfL-Ww>>(;p?cH!dq=Xu~pIbm3H);kF)EY3rhc|)l zb|XC%|EB`=`^FRj<)@;9I|7K|Kw-alAQZI=sXhwQ`T8*Ud9l~~an;?iMW7s@Zy(48 z%8kULk-^Um<@P3|UkwQ9n2&NNfpUEa>5n{&dp$%l+kbcnxN1fwY@jI7gQP6w0CHiT=x(;p+YwCk1?MFQa7n%?&T4PKVZk#w# zyM8K+Ft1r-aBs&t?Y}())VRK?Vv41i`7kLtkr2~iycLmvi!z^^_F0O}!;UgQc;4t|F)Q3hT*P{_o8 zIMUn;0U2~CJc;;~046^eia_-lj_BSzpI_(M&ufc$u8XJAH^&&GHy3GQW1N-NMiAF| zr~P_lLPEfwWjRvR!CcY{I?~vPZkt79=B@N1;%f+01`jGFwL3KjzUc14UBSShB@YhL zECK6?Jx<0-W&vKQ1oACp>*vl@TW~|kI^xf(>)X}V)-0hBRTcwhi3%ojCSNbbNi&fA zy_dZdy9vo0OEvq6PDnoy8G!W9e{@qyGilBJ=cBjN1L^46P=`Ht_@1mqD}%4p*O7YE zYg};13nA+BY>DQBWa@-_VR<=0vPOZ0UxCz|+k0!8jL~$mYtaa}kLEPo$Wo>#%M^68 z$TWjCcQCu(9f(AtbAx}JyLGS|KtKYNJ$Sz2o^d}toPgWYv78&#hZY8JJ)*yP2${Kv zIWq7pi#>ENJeB4})|k?~w|MIaROlP;EJUAa|0(~(yX}8Ne~=QV>*GrYcj!SPx}E+C zyU-ONSKt^S7{LJxSpj|ngXnokG}XnkK3X?#BSG}cF_PpkT1e13CTEIL6gFt21Mn!| z>y3@o`UM2;xyM113)J}lJ@NAla6bZ9gr-5bUxP{r<_VeR=4C(XPXs@0Lcid^R}`+h zl0oVXlXSUKdta2G&_NBmte-iv>jjyZm?Ec%P;ON>nyVGEeR;FKjvPe&!s-iE(p)=V zUEkgkCh^q<)e7R|4SYdC=%*U|Lxng!J(f)?;Ioe4;|tF-WpT;CN%abuW8wuNK`p$d aJx~@pVO_1AoWv^FGzu0N$(~bTXZXK-3T!(7 literal 0 HcmV?d00001