github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-06 03:29:10 +00:00
Code Issues Projects Releases Wiki Activity

Rmk112 fix tedit hardcopy smash (#1580)

Browse Source 
* 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
This commit is contained in:
rmkaplan
2024-03-15 12:31:19 -07:00
committed by GitHub
parent 5e5fea9ceb
commit b038a6b16e
6 changed files with 371 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

119
library/tedit/TEDIT-PAGE
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Mar-2024 09:55:14" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;154 111276
(FILECREATED "13-Mar-2024 17:12:34" {WMEDLEY}<library>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}<library>TEDIT>TEDIT-PAGE.;152)
:PREVIOUS-DATE "13-Mar-2024 10:28:14" {WMEDLEY}<library>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

BIN
library/tedit/TEDIT-PAGE.LCOM
View File

Binary file not shown.

71
library/tedit/TEDIT-SCREEN
View File

@@ -1,12 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;612 184763
(FILECREATED "14-Mar-2024 12:53:18" {WMEDLEY}<library>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}<library>tedit>TEDIT-SCREEN.;611)
:PREVIOUS-DATE "13-Mar-2024 14:40:10" {WMEDLEY}<library>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

BIN
library/tedit/TEDIT-SCREEN.LCOM
View File

Binary file not shown.

260
library/tedit/TEDIT-STRESS Normal file
View File

@@ -0,0 +1,260 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Mar-2024 15:16:05" {WMEDLEY}<library>tedit>TEDIT-STRESS.;49 12388
:EDIT-BY rmk
:CHANGES-TO (FNS STRESSHC)
:PREVIOUS-DATE "13-Mar-2024 00:24:06" {WMEDLEY}<library>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

BIN
library/tedit/TEDIT-STRESS.LCOM Normal file
View File

Binary file not shown.