github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-26 20:31:53 +00:00
Code Issues Projects Releases Wiki Activity

Systematically renamed internal Tedit files with \TEDIT

Browse Source 
This includes some files in lispusers that are not in the Tedit core but had references to Tedit internal functions (TMAX, DOC-OBJECTS and some others) that have been renamed. (I hope to clean out those internal references, at some point.)

A few additional changes are here to track the changes that were recently made in the unrenamed master branch.  Going forward, I want to make future changes in this branch.

Eventual plan is to introduce a Tedit package and do another systematic renaming of all \TEDIT.xxx functions to TEDIT::xxx, this is a first step.

This does not yet include a backward-compatibility mapping of oldnames to newnames, as was discussed in the technical meeting.
This commit is contained in:
rmkaplan
2024-04-01 20:49:06 -07:00
parent f6eb5d9846
commit f4fd00f8b8
58 changed files with 4072 additions and 3610 deletions
Download Patch File Download Diff File Expand all files Collapse all files

181
library/TEXEC
View File

@@ -1,16 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "18-Jun-2023 09:48:54" |{WMEDLEY}<library>TEXEC.;5| 185935
(FILECREATED "28-Mar-2024 00:09:16" |{WMEDLEY}<library>TEXEC.;6| 185248
:EDIT-BY |rmk|
:CHANGES-TO (VARS TEXECCOMS)
:CHANGES-TO (FNS TEXEC.DEFAULT.MENUFN TEXEC.SHRINK.ICONCREATE)
:PREVIOUS-DATE "16-Jul-2022 23:42:20" |{WMEDLEY}<library>TEXEC.;3|)
:PREVIOUS-DATE "18-Jun-2023 09:48:54" |{WMEDLEY}<library>TEXEC.;5|)
; Copyright (c) 1985, 1900, 1986-1991 by Venue & Xerox Corporation.
(PRETTYCOMPRINT TEXECCOMS)
(RPAQQ TEXECCOMS
@@ -186,28 +184,24 @@
TEXSTREAM)))
(TEXEC.DEFAULT.MENUFN
(LAMBDA (W) (* \; "Edited 13-Jun-90 00:16 by mitani")
(LAMBDA (W) (* \; "Edited 28-Mar-2024 00:06 by rmk")
(* \; "Edited 13-Jun-90 00:16 by mitani")
(* |Default| |User| F\n |for| TEXEC |windows--displays| \a |menu| |of| |items|
 & |acts| |on| |the| |commands| |received.|)
(* |;;|
 "Default User Fn for TEXEC windows--displays a menu of items & acts on the commands received.")
(PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ))
(PROG ((TEXTOBJ (TEXTOBJ W))
(WMENU (WINDOWPROP W 'TEDIT.MENU))
THISMENU CH OFILE OCURSOR PCTB LINES SEL ITEM)
(COND
((EQ (|fetch| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ)
T) (* |We're| |busy| |doing|
 |something,| |but| |not| |sure|
 |what.| |Give| \a |general|
 "please wait" |msg|)
T) (* \;
 "We're busy doing something, but not sure what. Give a general 'please wait' msg")
(TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T)
(RETURN))
((|fetch| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ)
(* W\e |know| |specifically|
 |what's| |happening.|
 |Tell| |him|)
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (|fetch| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ
)
((|fetch| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ) (* \;
 "We know specifically what's happening. Tell him")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (|fetch| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ)
" in progress; please wait.")
T)
(RETURN)))
@@ -222,37 +216,31 @@
(ERSETQ (RESETLST
(RESETSAVE (\\TEDIT.MARKACTIVE TEXTOBJ)
'(AND (\\TEDIT.MARKINACTIVE OLDVALUE)))
(|replace| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ
|with| (OR (CAR ITEM)
T)) (* S\o |we| |ca| |ntell| |the| |guy|
 WHAT |op| |is| |active.|)
(|replace| (TEXTOBJ EDITOPACTIVE) |of| TEXTOBJ |with| (OR (CAR ITEM)
T))
(* \;
 "So we ca ntell the guy WHAT op is active.")
(SELECTQ (CAR ITEM)
(|Put| (TEDIT.PUT TEXTOBJ NIL NIL (TEXTPROP TEXTOBJ 'CLEARPUT)))
(|Plain-Text| (TEDIT.PUT TEXTOBJ NIL NIL T))
(|Old-Format| (* |Write| |out| |the| |file| |in|
 |the| OLD |TEdit| |format.|)
(|Old-Format| (* \;
 "Write out the file in the OLD TEdit format.")
(TEDIT.PUT TEXTOBJ NIL NIL NIL T))
(|Get| (* |Get| \a |new| |file|
 (|overwriting| |the| |one| |being|
 |edited.|))
(|Get| (* \;
 "Get a new file (overwriting the one being edited.)")
(TEXEC.GET TEXTOBJ NIL (TEXTPROP TEXTOBJ 'CLEARGET)))
(|Unformatted Get|
(TEXEC.GET TEXTOBJ NIL T))
(|Include| (* |Insert| \a |file| |where| |the|
 |caret| |is|)
(|Include| (* \; "Insert a file where the caret is")
(TEXEC.INCLUDE TEXTOBJ))
(|ForwardFind| (* |Normal| |forward| |search|
 |Find|)
(|ForwardFind| (* \; "Normal forward search Find")
(TEXEC.FIND.FORWARD TEXTOBJ))
(|BackwardFind| (* |Backward| |search| |Find|)
(|BackwardFind| (* \; "Backward search Find")
(TEXEC.FIND.BACKWARD TEXTOBJ))
(|Limit| (SETQ TEXEC.BUFFERLIMIT (RNUMBER)))
(COND
((CAR ITEM)
(* |This| |is| \a |user-supplied| |entry.|
 |Get| |the| |function,| |and| |apply| |it| |to| |the| TEXTSTREAM |for| |him|)
((CAR ITEM) (* \;
 "This is a user-supplied entry. Get the function, and apply it to the TEXTSTREAM for him")
(APPLY* (CAR ITEM)
(|fetch| (TEXTOBJ STREAMHINT) |of| TEXTOBJ))))))))))
@@ -1009,58 +997,44 @@
""))))
(TEXEC.SHRINK.ICONCREATE
(LAMBDA (W ICON ICONW) (* AJB " 7-Jan-86 16:37")
(* |Create| |the| |icon| |that|
 |represents| |this| |window.|)
(PROG ((ICON (WINDOWPROP W 'ICON))
(ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
(SHRINKFN (WINDOWPROP W 'SHRINKFN)))
(COND
((NOT (WINDOWPROP W 'TEXTOBJ))
(* |This| |isn't| |really| \a |TEdit| |window| |any| |more.|
 |Don't| |do| |anything|)
NIL)
((WINDOWPROP W 'TEDITMENU) (* |This| |is| \a |text| |menu,| |and|
 |shrinks| |without| |trace.|)
NIL)
((OR (IGREATERP (FLENGTH SHRINKFN)
3)
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
(IGREATERP (FLENGTH SHRINKFN)
2)))
(* |There| |are| |other| |functions| |that| |expect| |to| |handle| |this.|
 |Don't| |bother.|)
NIL)
((OR (AND ICONTITLE (EQUAL ICONTITLE (PROCESSPROP (WINDOWPROP W 'PROCESS)
'NAME)))
(AND (NOT ICONTITLE)
ICON))
(* |we| |built| |this| |and| |the| |title| |is| |the| |same,| |or| |he| |has|
 |already| |put| |an| |icon| |on| |this.|
 D\o |nothing|)
NIL)
(ICON
(* |There's| |an| |existing| |icon| |window;|
 |change| |the| |title| |in| |it|)
(LAMBDA (W ICON ICONW) (* \; "Edited 28-Mar-2024 00:08 by rmk")
(* AJB " 7-Jan-86 16:37")
(* \;
 "Create the icon that represents this window.")
(CL:WHEN (TEXTSTREAM W T)
(LET ((ICON (WINDOWPROP W 'ICON))
(ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE))
(SHRINKFN (WINDOWPROP W 'SHRINKFN)))
(COND
((WINDOWPROP W 'TEDITMENU) (* \;
 "This is a text menu, and shrinks without trace.")
)
((OR (IGREATERP (FLENGTH SHRINKFN)
3)
(AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN))
(IGREATERP (FLENGTH SHRINKFN)
2))) (* \;
 "There are other functions that expect to handle this. Don't bother.")
)
((OR (AND ICONTITLE (EQUAL ICONTITLE (PROCESSPROP (WINDOWPROP W 'PROCESS)
'NAME)))
(AND (NOT ICONTITLE)
ICON)) (* \;
 "we built this and the title is the same, or he has already put an icon on this. Do nothing")
)
(ICON (* \;
 "There's an existing icon window; change the title in it")
(WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP
(WINDOWPROP W 'PROCESS)
'NAME)))
(ICONTITLE ICONTITLE NIL NIL ICON))
(T (* \; "install a new icon")
(WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP (WINDOWPROP
W
'PROCESS)
'NAME)))
(ICONTITLE ICONTITLE NIL NIL ICON))
(T (* |install| \a |new| |icon|)
(WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (PROCESSPROP (WINDOWPROP W
'PROCESS)
'NAME)))
(WINDOWPROP W 'ICON (TITLEDICONW TEXEC.TITLED.ICON.TEMPLATE ICONTITLE TEXEC.ICON.FONT
NIL T '(BOTTOM LEFT))))))
(WINDOWPROP W 'ICON (TITLEDICONW TEXEC.TITLED.ICON.TEMPLATE ICONTITLE
TEXEC.ICON.FONT NIL T '(BOTTOM LEFT)))))))
(WINDOWPROP W 'ICON)))
(TEXEC.FILLBUFFER
@@ -3009,23 +2983,22 @@
(RPAQQ |BackgroundMenu| NIL)
(RPAQ? TEXEC.BUFFERLIMIT 10000)
(PUTPROPS TEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1987 1988 1989 1990 1991))
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3083 171708 (TEXEC.BACKSKREAD 3093 . 7717) (TEXEC.OPENTEXTSTREAM 7719 . 9777) (
TEXEC.DEFAULT.MENUFN 9779 . 14333) (TEXEC.DO?CMD 14335 . 19653) (TEXEC.CREATEMENU 19655 . 20113) (
TEXEC.GET 20115 . 28950) (TEXEC.INCLUDE 28952 . 42337) (TEXEC.FIND.FORWARD 42339 . 55227) (
TEXEC.FIND.BACKWARD 55229 . 68731) (TEXEC.MENU.WHENHELDFN 68733 . 69392) (TEXEC.SHRINK.ICONCREATE
69394 . 72197) (TEXEC.FILLBUFFER 72199 . 88633) (TEXEC.FILLBUFFER.TCLASS 88635 . 94975) (
TEXEC.CHSELPENDING 94977 . 103467) (TEXEC.FILLBUFFER.CHARDELETE 103469 . 105524) (
TEXEC.FILLBUFFER.WORDDELETE 105526 . 110654) (TEXEC.FILLBUFFER.LINEDELETE 110656 . 113538) (
TEXEC.PARENCOUNT 113540 . 114929) (TEXEC.PARENMATCH 114931 . 116471) (TEXEC.FLASHCARET 116473 . 119132
) (TEXEC.TEXTSTREAM.TO.LINEBUF 119134 . 121821) (TEXEC.FIX 121823 . 124992) (TEXEC.NTHBUFCHARBACK
124994 . 126057) (TEXEC.NTHBACKCHNUM 126059 . 127344) (TEXEC.EOTP 127346 . 128079) (TEXEC.GETKEY
128081 . 130997) (TEXEC.INSERTCHAR 130999 . 133300) (TEXEC.DELETE 133302 . 134077) (TEXEC.\\CHDEL1
134079 . 137204) (TEXEC.?EQUAL 137206 . 138255) (TEDIT.SCROLL? 138257 . 143220) (TEXEC.DISPLAYTEXT
143222 . 149997) (\\TEXEC.TEXTBOUT 149999 . 153007) (\\TEXEC.TEXTBOUT1 153009 . 158643) (
\\TEXEC.TEXTBOUT2 158645 . 160976) (\\TEXEC.TEXTBOUT3 160978 . 162368) (\\TEXEC.TEXTBOUT4 162370 .
164413) (\\TEXEC.SELFN 164415 . 165790) (TEXEC.PRINTARGS 165792 . 170755) (TEXEC.PROCENTRYFN 170757 .
171298) (TEXEC.PROCEXITFN 171300 . 171706)) (171768 178143 (TEXEC 171778 . 176200) (TTEXEC 176202 .
178141)))))
(FILEMAP (NIL (3048 171118 (TEXEC.BACKSKREAD 3058 . 7682) (TEXEC.OPENTEXTSTREAM 7684 . 9742) (
TEXEC.DEFAULT.MENUFN 9744 . 13790) (TEXEC.DO?CMD 13792 . 19110) (TEXEC.CREATEMENU 19112 . 19570) (
TEXEC.GET 19572 . 28407) (TEXEC.INCLUDE 28409 . 41794) (TEXEC.FIND.FORWARD 41796 . 54684) (
TEXEC.FIND.BACKWARD 54686 . 68188) (TEXEC.MENU.WHENHELDFN 68190 . 68849) (TEXEC.SHRINK.ICONCREATE
68851 . 71607) (TEXEC.FILLBUFFER 71609 . 88043) (TEXEC.FILLBUFFER.TCLASS 88045 . 94385) (
TEXEC.CHSELPENDING 94387 . 102877) (TEXEC.FILLBUFFER.CHARDELETE 102879 . 104934) (
TEXEC.FILLBUFFER.WORDDELETE 104936 . 110064) (TEXEC.FILLBUFFER.LINEDELETE 110066 . 112948) (
TEXEC.PARENCOUNT 112950 . 114339) (TEXEC.PARENMATCH 114341 . 115881) (TEXEC.FLASHCARET 115883 . 118542
) (TEXEC.TEXTSTREAM.TO.LINEBUF 118544 . 121231) (TEXEC.FIX 121233 . 124402) (TEXEC.NTHBUFCHARBACK
124404 . 125467) (TEXEC.NTHBACKCHNUM 125469 . 126754) (TEXEC.EOTP 126756 . 127489) (TEXEC.GETKEY
127491 . 130407) (TEXEC.INSERTCHAR 130409 . 132710) (TEXEC.DELETE 132712 . 133487) (TEXEC.\\CHDEL1
133489 . 136614) (TEXEC.?EQUAL 136616 . 137665) (TEDIT.SCROLL? 137667 . 142630) (TEXEC.DISPLAYTEXT
142632 . 149407) (\\TEXEC.TEXTBOUT 149409 . 152417) (\\TEXEC.TEXTBOUT1 152419 . 158053) (
\\TEXEC.TEXTBOUT2 158055 . 160386) (\\TEXEC.TEXTBOUT3 160388 . 161778) (\\TEXEC.TEXTBOUT4 161780 .
163823) (\\TEXEC.SELFN 163825 . 165200) (TEXEC.PRINTARGS 165202 . 170165) (TEXEC.PROCENTRYFN 170167 .
170708) (TEXEC.PROCEXITFN 170710 . 171116)) (171178 177553 (TEXEC 171188 . 175610) (TTEXEC 175612 .
177551)))))
STOP

BIN
library/TEXEC.LCOM
View File

Binary file not shown.

823
library/tedit/TEDIT
View File

File diff suppressed because it is too large Load Diff

17
library/tedit/TEDIT-ABBREV
View File

@@ -1,10 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "12-Jun-2023 10:34:12" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;6 9257
(FILECREATED "17-Mar-2024 18:15:40" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8 9500
:EDIT-BY rmk
:PREVIOUS-DATE "17-May-2023 13:40:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;5)
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
:PREVIOUS-DATE "17-Mar-2024 12:06:12"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
@@ -61,7 +65,8 @@
(DEFINEQ
(\TEDIT.ABBREV.EXPAND
[LAMBDA (TSTREAM) (* ; "Edited 17-May-2023 13:31 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 17-May-2023 13:31 by rmk")
(* ; "Edited 8-Sep-2022 23:53 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
(* ; "Edited 30-May-91 19:27 by jds")
@@ -76,7 +81,7 @@
(CL:WHEN (ZEROP CH#) (* ;
 "If we're off the front of the document, don't bother trying.")
(RETURN))
(\TEXTSETFILEPTR TSTREAM (SUB1 CH#)
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#)
CH#)
[SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM]
(TEDIT.SETSEL TSTREAM CH# 1 'RIGHT))
@@ -201,6 +206,6 @@
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2866 7913 (\TEDIT.ABBREV.EXPAND 2876 . 5128) (\TEDIT.EXPAND.DATE 5130 . 5763) (
\TEDIT.TRY.ABBREV 5765 . 7911)))))
(FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
\TEDIT.TRY.ABBREV 6008 . 8154)))))
STOP

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

Binary file not shown.

118
library/tedit/TEDIT-COMMAND
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "26-Feb-2024 11:22:29" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;62 45850
(FILECREATED "27-Mar-2024 15:28:15" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;71 46623
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
:CHANGES-TO (FNS \TEDIT.INTERRUPT.SETUP)
:PREVIOUS-DATE "22-Feb-2024 23:15:00" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;61)
:PREVIOUS-DATE "20-Mar-2024 11:07:16" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;70)
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
@@ -212,31 +212,30 @@
(DEFINEQ
(\TEDIT.INTERRUPT.SETUP
[LAMBDA (PROC FORCEOFF) (* ; "Edited 22-Sep-2023 20:45 by rmk")
[LAMBDA (PROC FORCEOFF) (* ; "Edited 27-Mar-2024 15:27 by rmk")
(* ; "Edited 22-Sep-2023 20:45 by rmk")
(* jds "12-Sep-84 15:36")
(* ;; "Disarm any inconvenient interrupts, and save re-arming info on the window.")
[LET [(TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW)
(WINDOWPROP (PROCESSPROP PROC 'WINDOW)
'TEXTOBJ)
(TEXTOBJ (PROCESSPROP PROC 'WINDOW]
(UNINTERRUPTABLY
[COND
((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
[LET ((TEXTOBJ (TEXTOBJ PROC T)))
(CL:WHEN TEXTOBJ
(UNINTERRUPTABLY
[COND
((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
(* ;
 "There are disarmed interrupts; re-arm them.")
(RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
(PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL))
([AND (NOT FORCEOFF)
(NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS]
(RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS))
(PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL))
([AND (NOT FORCEOFF)
(NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS]
(* ;
 "There aren't any interrupts disarmed; go do it.")
(PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS
(OR (AND TEXTOBJ (GETTEXTPROP TEXTOBJ
'INTERRUPTS))
TEDIT.INTERRUPTS)
T])]
(PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS
(OR (AND TEXTOBJ (GETTEXTPROP TEXTOBJ
'INTERRUPTS))
TEDIT.INTERRUPTS)
T]))]
PROC])
(\TEDIT.MARKACTIVE
@@ -250,7 +249,10 @@
TEXTOBJ])
(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* ; "Edited 24-Feb-2024 15:33 by rmk")
[LAMBDA (STREAM RTBL) (* ; "Edited 20-Mar-2024 10:59 by rmk")
(* ; "Edited 15-Mar-2024 14:23 by rmk")
(* ; "Edited 9-Mar-2024 11:35 by rmk")
(* ; "Edited 24-Feb-2024 15:33 by rmk")
(* ; "Edited 21-Feb-2024 14:49 by rmk")
(* ; "Edited 18-Feb-2024 23:35 by rmk")
(* ; "Edited 24-Dec-2023 09:50 by rmk")
@@ -264,7 +266,7 @@
(fetch (TEXTSTREAM TEXTOBJ) of STREAM)
STREAM))
SEL PANES)
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(SETQ SEL (TEXTSEL TEXTOBJ))
(SETQ PANES (FGETTOBJ TEXTOBJ \WINDOW))
(SETQ RTBL (OR RTBL (FGETTOBJ TEXTOBJ TXTRTBL)
@@ -302,10 +304,10 @@
(CL:WHEN (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE)
(* ;
 "We got here somehow with the window not in sync with the text. Run an update.")
(\SHOWSEL SEL NIL)
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL T))
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UPDATE.SCREEN TEXTOBJ)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T))
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
 "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
(FSETTOBJ TEXTOBJ EDITOPACTIVE T)
@@ -321,12 +323,12 @@
(SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL))
(NORMAL (CL:WHEN (FGETSEL SOURCESEL SET)
(SETQ SEL (\COPYSEL SOURCESEL SEL))
(SETQ SEL (\TEDIT.COPYSEL SOURCESEL SEL))
(* ; "SOURCESEL is new SEL selection")
(FSETTOBJ TEXTOBJ CARETLOOKS (
\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL))
(\SHOWSEL SEL T)))
(\TEDIT.SHOWSEL SEL T)))
(MOVE (* ; "Move source to SEL")
(TEDIT.MOVE SOURCESEL SEL))
(COPY (* ; "Copy source to SEL.")
@@ -359,28 +361,28 @@
(CHARDELETE.TTC (* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(CHARDELETE.FORWARD.TTC
(\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(WORDDELETE.TTC
(\TEDIT.WORDDELETE TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(WORDDELETE.FORWARD.TTC
(\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(DELETE.TTC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(UNDO.TTC (* ;
 "He hit the CANCEL key, so go UNDO something")
(TEDIT.UNDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(REDO.TTC (* ;
 "He hit the REDO key, so go REDO something")
(TEDIT.REDO TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(FUNCTIONCALL.TTC (* ;
 "This is a special character -- it calls a function")
(CL:WHEN [SETQ FN (CAR (FETCH MACROFN
@@ -395,9 +397,9 @@
(CL:UNLESS (MEMB CH WHEELSCROLLCHARCODES)
(* ;
 "The wheelscroll FN handled the selection. should preserve the highlighting")
(\SHOWSEL SEL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL)
(\SHOWSEL SEL T))))
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T))))
(NEXT.TTC (* ;
 "Move to the next blank to fill in. For now, blanks are delimited by >>...<<")
(TEDIT.NEXT TEXTOBJ))
@@ -409,14 +411,17 @@
(CHARDELETE.TC (* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(WORDDELETE.TC (* ; "Back-WORD handler")
(\TEDIT.WORDDELETE TEXTOBJ)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(LINEDELETE.TC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE TEXTOBJ SEL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL))
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(CL:WHEN CH (* ;
 "Any other key: insert the character.")
(\TEDIT.INSERT CH SEL TEXTOBJ))])
@@ -424,7 +429,8 @@
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))])
(\TEDIT.COMMAND.RESET.SETUP
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 22-Feb-2024 23:14 by rmk")
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 17-Mar-2024 18:54 by rmk")
(* ; "Edited 22-Feb-2024 23:14 by rmk")
(* ; "Edited 5-Oct-2023 22:41 by rmk")
(* ; "Edited 22-Sep-2023 20:41 by rmk")
(* ; "Edited 16-Sep-2023 22:30 by rmk")
@@ -434,7 +440,7 @@
(* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing")
(PROG ((TEXTOBJ (CAR TEXT&WIND))
(WINDOW (CADR TEXT&WIND))
(PANES (CADR TEXT&WIND))
(OTTYWINDOW (CADDR TEXT&WIND))
(OTTYENTRYFN (CADDDR TEXT&WIND))
(OTTYEXITFN (CAR (CDDDDR TEXT&WIND)))
@@ -447,7 +453,7 @@
 "Mark us busy until we're set up, so that nobody tries any funny stuff.")
(SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR WINDOW))) (* ;
(CAR PANES))) (* ;
 "Attach the process to this window.")
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ;
 "Disarm all interrupt chars, re-arm them when we leave the edit")
@@ -473,7 +479,7 @@
(* ;
 "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")
(WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
(WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR WINDOW)))
(WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR PANES)))
(FSETTOBJ TEXTOBJ TXTEDITING T) (* ;
 "Tell TEdit that this document is actively being edited.")
(* ;
@@ -483,20 +489,20 @@
 "Coming OUT OF the command loop -- reset everything")
(PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR WINDOW)) (* ;
(CAR PANES)) (* ;
 "Detach the window from the edit process, to prevent circularity there")
(WINDOWPROP (CAR WINDOW)
(WINDOWPROP (CAR PANES)
'PROCESS NIL)
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)
T) (* ;
 "Re-arm the interrupts we turned off coming in.")
(CL:WHEN [AND (TXTFILE TEXTOBJ)
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR WINDOW]
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR PANES]
(* ;
 "Remember to close the file we were editing (Only if the window function isn't closing it.)")
(CLOSEF? (TXTFILE TEXTOBJ)) (* ;
 "Let anyone else who wants to close the file.")
(replace (TEXTWINDOW CLOSINGFILE) of (CAR WINDOW) with NIL))
(replace (TEXTWINDOW CLOSINGFILE) of (CAR PANES) with NIL))
(PROCESSPROP (THIS.PROCESS)
'TTYEXITFN OTTYEXITFN)
(PROCESSPROP (THIS.PROCESS)
@@ -512,7 +518,7 @@
(TTYDISPLAYSTREAM OTTYWINDOW)
(PROCESSPROP (THIS.PROCESS)
'TEDITTTYWINDOW NIL))]
(RETURN (LIST TEXTOBJ WINDOW OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
(RETURN (LIST TEXTOBJ PANES OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
)
(RPAQ? TEDIT.INTERRUPTS '((2 BREAK)
@@ -834,10 +840,10 @@
(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7792 28983 (\TEDIT.INTERRUPT.SETUP 7802 . 9442) (\TEDIT.MARKACTIVE 9444 . 9656) (
\TEDIT.MARKINACTIVE 9658 . 9874) (\TEDIT.COMMAND.LOOP 9876 . 22486) (\TEDIT.COMMAND.RESET.SETUP 22488
. 28981)) (29267 44464 (\TEDIT.READTABLE 29277 . 30934) (\TEDIT.WORDBOUND.READTABLE 30936 . 33529) (
TEDIT.GETSYNTAX 33531 . 35970) (TEDIT.SETSYNTAX 35972 . 38450) (TEDIT.GETFUNCTION 38452 . 39812) (
TEDIT.SETFUNCTION 39814 . 42253) (TEDIT.WORDGET 42255 . 42516) (TEDIT.WORDSET 42518 . 43215) (
TEDIT.ATOMBOUND.READTABLE 43217 . 44462)) (44792 45701 (\TEDIT.WHEELSCROLL 44802 . 45699)))))
(FILEMAP (NIL (7795 29756 (\TEDIT.INTERRUPT.SETUP 7805 . 9452) (\TEDIT.MARKACTIVE 9454 . 9666) (
\TEDIT.MARKINACTIVE 9668 . 9884) (\TEDIT.COMMAND.LOOP 9886 . 23156) (\TEDIT.COMMAND.RESET.SETUP 23158
. 29754)) (30040 45237 (\TEDIT.READTABLE 30050 . 31707) (\TEDIT.WORDBOUND.READTABLE 31709 . 34302) (
TEDIT.GETSYNTAX 34304 . 36743) (TEDIT.SETSYNTAX 36745 . 39223) (TEDIT.GETFUNCTION 39225 . 40585) (
TEDIT.SETFUNCTION 40587 . 43026) (TEDIT.WORDGET 43028 . 43289) (TEDIT.WORDSET 43291 . 43988) (
TEDIT.ATOMBOUND.READTABLE 43990 . 45235)) (45565 46474 (\TEDIT.WHEELSCROLL 45575 . 46472)))))
STOP

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

Binary file not shown.

362
library/tedit/TEDIT-FILE
View File

@@ -1,18 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Mar-2024 23:50:57" {MEDLEY}<library>tedit>TEDIT-FILE.;2 152351
(FILECREATED "31-Mar-2024 23:54:56" {WMEDLEY}<library>tedit>TEDIT-FILE.;528 154611
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.PUT)
:PREVIOUS-DATE "11-Mar-2024 00:38:51" {MEDLEY}<library>tedit>TEDIT-FILE.;1)
:PREVIOUS-DATE "26-Mar-2024 22:10:58" {WMEDLEY}<library>tedit>TEDIT-FILE.;527)
(PRETTYCOMPRINT TEDIT-FILECOMS)
(RPAQQ TEDIT-FILECOMS
((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0)
[(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0)
(\PieceDescriptorOBJECT 1)
(\PieceDescriptorPARA 2)
(\PieceDescriptorPAGEFRAME 3)
@@ -24,8 +24,8 @@
(COMS
(* ;; "Public entries ")
(FNS TEDIT.GET TEDIT.FORMATTEDFILEP TEDIT.FILEDATE \TEDIT.GET.IDATE3 TEDIT.INCLUDE
TEDIT.RAW.INCLUDE TEDIT.PUT TEDIT.PUT.STREAM)
(FNS TEDIT.GET TEDIT.FORMATTEDFILEP TEDIT.FILEDATE TEDIT.INCLUDE TEDIT.RAW.INCLUDE
TEDIT.PUT TEDIT.PUT.STREAM)
(* ;; "Getting (pageframe functions on TEDIT-PAGE)")
@@ -37,7 +37,7 @@
 "Until CL:COMPILE-FILE and any others are updated, They should use the public TEDIT.FORMATTEDFILEP")
(P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
(FNS \TEDIT.GET.PIECES3 \TEDIT.MAKE.STRINGPIECE)
(FNS \TEDIT.GET.PIECES3 \TEDIT.GET.IDATE3 \TEDIT.MAKE.STRINGPIECE)
(FNS \TEDIT.GET.UNFORMATTED.FILE.XCCS \TEDIT.INTERPRET.XCCS.SHIFTS)
(* ; "XCCS")
(FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
@@ -45,7 +45,7 @@
(FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.CHARLOOKS
\TEDIT.GET.PARALOOKS.INDEX \TEDIT.GET.CHARLOOKS.INDEX)
(FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.GET.PARALOOKS)
(FNS TEDIT.GET.OBJECT))
(FNS \TEDIT.GET.OBJECT))
(COMS
(* ;; "Putting (pageframe functions on TEDIT-PAGE)")
@@ -53,16 +53,14 @@
\TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW \TEDIT.INSERT.NEWPIECES
\TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT)
(FNS \TEDIT.PUT.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS
\TEDIT.PUT.CHARLOOKS1)
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS)
(FNS TEDIT.PUT.OBJECT))
\TEDIT.PUT.CHARLOOKS1 \TEDIT.PUT.OBJECT)
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
(FNS TEDITFROMLISPSOURCE)
(ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)))
(INITVARS (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
(* ;
(INITVARS (* ;
 "For consistent reading and writing of info on TEdit files.")
)))
(*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE])
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
@@ -117,7 +115,9 @@
(DEFINEQ
(TEDIT.GET
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 21-Jan-2024 23:13 by rmk")
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 17-Mar-2024 18:17 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 21-Jan-2024 23:13 by rmk")
(* ; "Edited 22-Sep-2023 20:16 by rmk")
(* ; "Edited 18-Sep-2023 16:41 by rmk")
(* ; "Edited 9-Sep-2023 17:24 by rmk")
@@ -158,16 +158,15 @@
T)
(RETURN NIL))
(RESETLST
(RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ 'DON'T (GETTOBJ TEXTOBJ PROMPTWINDOW)
'DON'T)
(RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ 'DON'T (GETTOBJ TEXTOBJ PROMPTWINDOW))
(GETTOBJ TEXTOBJ PROMPTWINDOW))
PROMPTWINDOW)))
(* ;; "New file is good, clean out the old stuff")
(\SHOWSEL (TEXTSEL TEXTOBJ)
(\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ)
NIL)
(\TEXTCLOSEF TEXTOBJ) (* ;
(\TEDIT.TEXTCLOSEF TEXTOBJ) (* ;
 "Close the old files, still in TXTFILE")
(* ;; "")
@@ -184,7 +183,7 @@
(SETQ NTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of NTSTREAM))
(replace (TEXTSTREAM TEXTOBJ) of TSTREAM with NTEXTOBJ)
(SETTOBJ NTEXTOBJ STREAMHINT TSTREAM)
(\TEXTSETFILEPTR TSTREAM 0)
(\TEDIT.TEXTSETFILEPTR TSTREAM 0)
(CL:WHEN MAINWINDOW
(\TEDIT.UPDATE.TITLE NTEXTOBJ)
(WINDOWPROP MAINWINDOW 'TEDITCREATED TEDITCREATED)
@@ -197,23 +196,29 @@
(RETURN TSTREAM])
(TEDIT.FORMATTEDFILEP
[LAMBDA (FILE) (* ; "Edited 18-Jan-2024 10:29 by rmk")
[LAMBDA (FILE) (* ; "Edited 26-Mar-2024 22:10 by rmk")
(* ; "Edited 18-Jan-2024 10:29 by rmk")
(* ; "Edited 13-Jan-2024 11:57 by rmk")
(* ; "Edited 12-Jul-2023 23:35 by rmk")
(* ;; "If FILE is a Tedit formatted stream or the name of a Tedit formatted file, returns a pair consistening of its version number and piececount. Piececount is probably useless.")
(RESETLST
(LET ((STREAM (STREAMP FILE)))
[if STREAM
then [RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE]
else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
(\TEDIT.GET.TRAILER STREAM)))])
(CL:WHEN FILE
(RESETLST
(LET ((STREAM (GETSTREAM FILE 'INPUT T)))
[if STREAM
then [RESETSAVE (GETFILEPTR FILE)
`(PROGN (SETFILEPTR ,FILE OLDVALUE]
else (RESETSAVE (SETQ STREAM (OPENSTREAM (CL:IF (STREAMP FILE)
(FULLNAME FILE)
FILE)
'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
(\TEDIT.GET.TRAILER STREAM))))])
(TEDIT.FILEDATE
[LAMBDA (FILE INTEGER) (* ; "Edited 18-Jan-2024 10:26 by rmk")
[LAMBDA (FILE INTEGER) (* ; "Edited 26-Mar-2024 21:37 by rmk")
(* ; "Edited 18-Jan-2024 10:26 by rmk")
(* ; "Edited 13-Jan-2024 10:20 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 6-Dec-2023 20:11 by rmk")
@@ -223,51 +228,15 @@
(* ;; "FILE must be random access. If not, then presumably we first have to fetch the last 5+4+8 bytes to someplace else.")
(CL:WHEN FILE
(RESETLST
(LET ((STREAM (\GETSTREAM FILE 'INPUT T))
IDATE)
[if STREAM
then [RESETSAVE (GETFILEPTR STREAM)
`(PROGN (SETFILEPTR ,STREAM OLDVALUE]
else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT))
`(PROGN (CLOSEF? OLDVALUE]
[SETQ IDATE (CAR (LAST (\TEDIT.GET.TRAILER STREAM]
(CL:UNLESS IDATE
(SETQ IDATE (GETFILEINFO STREAM 'ICREATIONDATE)))
(CL:IF INTEGER
IDATE
(GDATE IDATE)))))])
(\TEDIT.GET.IDATE3
[LAMBDA (STREAM END) (* ; "Edited 6-Dec-2023 16:55 by rmk")
(* ;; "Returns the integer IDATE for slightly updated version 3 files, otherwise NIL. 4 for the bytes of the IDATE, 8 for the header. Leaves resets to starting position (assumes an error wouldn't matter).")
(CL:WHEN (IGREATERP END (IPLUS (CONSTANT (NCHARS "DATE:"))
4 8))
(LET ((FILEPTR (GETFILEPTR STREAM)))
(SETFILEPTR STREAM (IDIFFERENCE END (IPLUS (CONSTANT (NCHARS "DATE:"))
4 8)))
(* ;;
 "DATE: is the marker for this extension to version 3 (could be removed if version is update). ")
(PROG1 (CL:WHEN (AND (EQ (CHARCODE D)
(BIN STREAM))
(EQ (CHARCODE A)
(BIN STREAM))
(EQ (CHARCODE T)
(BIN STREAM))
(EQ (CHARCODE E)
(BIN STREAM))
(EQ (CHARCODE %:)
(BIN STREAM)))
(\DWIN STREAM))
(SETFILEPTR STREAM FILEPTR))))])
(LET [(IDATE (CAR (LAST (TEDIT.FORMATTEDFILEP FILE]
(CL:WHEN IDATE
(CL:IF INTEGER
IDATE
(GDATE IDATE)))])
(TEDIT.INCLUDE
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 16-Feb-2024 23:54 by rmk")
[LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 16-Feb-2024 23:54 by rmk")
(* ; "Edited 13-Jan-2024 09:39 by rmk")
(* ; "Edited 12-Nov-2023 12:29 by rmk")
(* ; "Edited 23-Jul-2023 15:30 by rmk")
@@ -384,7 +353,7 @@
(* ;; "The exit conditions are not documented, but we set the fileptr to the end of the insertion and return the length of the insertion.")
(\TEXTSETFILEPTR (FGETTOBJ TEXTOBJ STREAMHINT)
(\TEDIT.TEXTSETFILEPTR (FGETTOBJ TEXTOBJ STREAMHINT)
(SUB1 (FGETSEL TSEL CHLIM)))
(RETURN (FGETSEL FSEL DCH))))])
@@ -398,7 +367,7 @@
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
(TEDIT.PUT
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 31-Mar-2024 23:50 by rmk")
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 31-Mar-2024 23:54 by rmk")
(* ; "Edited 7-Feb-2024 13:31 by rmk")
(* ; "Edited 4-Feb-2024 00:10 by rmk")
(* ; "Edited 22-Dec-2023 10:41 by rmk")
@@ -517,6 +486,8 @@
(TEDIT.PUT.STREAM
[LAMBDA (TSTREAM DESTSTREAM UNFORMATTED? EXTERNALFORMAT CONTINUE)
(* ; "Edited 19-Mar-2024 21:38 by rmk")
(* ; "Edited 17-Mar-2024 17:29 by rmk")
(* ; "Edited 7-Feb-2024 12:41 by rmk")
(* ; "Edited 4-Feb-2024 00:19 by rmk")
(* ; "")
@@ -559,9 +530,10 @@
(\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT
THACTION _ :Put))
DESTSTREAM
elseif OPENEDHERE
then (OR (CLOSEF? DESTSTREAM)
(FULLNMAE DESTSTREAM))
(FULLNAME DESTSTREAM))
else DESTSTREAM)))])
)
@@ -572,7 +544,8 @@
(DEFINEQ
(\TEDIT.GET.FOREIGN.FILE
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 22-Oct-2023 20:40 by rmk")
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
(* ; "Edited 22-Oct-2023 20:40 by rmk")
(* ; "Edited 18-Sep-2023 16:40 by rmk")
(* ; "Edited 10-Aug-2023 17:26 by rmk")
(* ; "Edited 6-Sep-2022 12:18 by rmk")
@@ -603,7 +576,7 @@
(TEXTSTREAMP FSTREAM)) (* ; "Return NIL if we couldn't convert")
(CL:UNLESS (EQ TSTREAM FSTREAM)
(SETQ FTEXTOBJ (TEXTOBJ FSTREAM))
(\INSERTPIECES (\FIRSTPIECE FTEXTOBJ)
(\TEDIT.INSERTPIECES (\TEDIT.FIRSTPIECE FTEXTOBJ)
NIL TTEXTOBJ)
(FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE))
(* ; "Last piece have different looks")
@@ -613,7 +586,8 @@
TSTREAM)])
(\TEDIT.GET.UNFORMATTED.FILE
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 5-Feb-2024 09:26 by rmk")
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
(* ; "Edited 5-Feb-2024 09:26 by rmk")
(* ; "Edited 21-Jan-2024 09:42 by rmk")
(* ; "Edited 29-Dec-2023 11:52 by rmk")
(* ; "Edited 27-Dec-2023 13:33 by rmk")
@@ -670,10 +644,11 @@
PTYPE _ THINFILE.PTYPE
PBYTESPERCHAR _ 1
PBINABLE _ (fetch (STREAM BINABLE) of STREAM]
(\INSERTPIECES PIECES NIL TEXTOBJ)))])
(\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))])
(\TEDIT.GET.FORMATTED.FILE
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 5-Feb-2024 09:25 by rmk")
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk")
(* ; "Edited 5-Feb-2024 09:25 by rmk")
(* ; "Edited 21-Jan-2024 10:25 by rmk")
(* ; "Edited 18-Jan-2024 10:25 by rmk")
(* ; "Edited 27-Oct-2023 13:48 by rmk")
@@ -696,7 +671,7 @@
(CL:WHEN (\TEDIT.GET.IDATE3 TEXT END) (* ;
 "IDATE means 3.1, LINELEADING above-hack.")
(FSETTOBJ TEXTOBJ TXTLINELEADINGABOVE T))
(\INSERTPIECES (\TEDIT.GET.PIECES3 TEXT TEXTOBJ PCCOUNT START END)
(\TEDIT.INSERTPIECES (\TEDIT.GET.PIECES3 TEXT TEXTOBJ PCCOUNT START END)
NIL TEXTOBJ))
(2 (* ; "Version 2; obsoleted 5/22/85")
(\TEDIT.GET.PCTB2 TEXT TEXTOBJ PCCOUNT START END))
@@ -704,16 +679,17 @@
 "Version 1; obsoleted at INTERMEZZO release 2/85")
(\TEDIT.GET.PCTB1 TEXT TEXTOBJ PCCOUNT START END))
(0 (* ; "VERSION 0")
(TEDIT.GET.PCTB0 TEXT TEXTOBJ (CADR PCCOUNT)
(\TEDIT.GET.PCTB0 TEXT TEXTOBJ (CADR PCCOUNT)
PCCOUNT START END))
(SHOULDNT "File format version incompatible with this version of TEdit."))
(CL:WHEN (SETQ PC (PREVPIECE (\LASTPIECE TEXTOBJ)))
(CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ)))
(FSETPC PC PPARALAST T))
(\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL)
TEXTOBJ)])
(\TEDIT.FORMATTEDSTREAMP
[LAMBDA (TSTREAM) (* ; "Edited 22-Sep-2023 20:17 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 22-Sep-2023 20:17 by rmk")
(* ; "Edited 15-Sep-2023 00:09 by rmk")
(* ; "Edited 15-Aug-2023 17:35 by rmk")
(* ; "Edited 16-Sep-2022 21:00 by rmk")
@@ -727,7 +703,8 @@
(for PC (FORMATLEVEL _ 0)
(DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
(DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC))
(TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\FIRSTPIECE TEXTOBJ)
(TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\TEDIT.FIRSTPIECE
TEXTOBJ)
do [COND
((EQ OBJECT.PTYPE (PTYPE PC)) (* ;
 "OBJECTS require the special format")
@@ -735,11 +712,11 @@
(GO $$OUT))
([OR (AND (PPARALAST PC)
(NEXTPIECE PC))
(NOT (EQFMTSPEC DEFAULTPLOOKS (PPARALOOKS PC]
(NOT (\TEDIT.EQFMTSPEC DEFAULTPLOOKS (PPARALOOKS PC]
(* ;
 "A paragraph break not at the end, or a new plook")
(SETQ FORMATLEVEL (IMAX FORMATLEVEL 3)))
((OR (NOT (EQCLOOKS DEFAULTCLOOKS (PLOOKS PC)))
((OR (NOT (\TEDIT.EQCLOOKS DEFAULTCLOOKS (PLOOKS PC)))
(AND TENTATIVE (PNEW PC))) (* ; "Change in font, size, etc.")
(SETQ FORMATLEVEL (IMAX FORMATLEVEL 2)))
((MEMB (PTYPE PC)
@@ -809,7 +786,8 @@
(RETURN STR])
(\TEDIT.GET.TRAILER
[LAMBDA (STREAM LEN) (* ; "Edited 18-Jan-2024 10:22 by rmk")
[LAMBDA (STREAM LEN) (* ; "Edited 26-Mar-2024 21:36 by rmk")
(* ; "Edited 18-Jan-2024 10:22 by rmk")
(* ; "Edited 16-Jan-2024 22:39 by rmk")
(* ; "Edited 15-Jan-2024 17:38 by rmk")
(* ; "Edited 13-Jan-2024 21:49 by rmk")
@@ -830,7 +808,8 @@
31415))
(PROG1 (SELECTQ VERSION
(3 (* ; "Current version")
(SETQ IDATE (\TEDIT.GET.IDATE3 STREAM LEN))
[SETQ IDATE (OR (\TEDIT.GET.IDATE3 STREAM LEN)
(GETFILEINFO STREAM 'ICREATIONDATE]
(SETQ TRAILERSIZE (IPLUS 8 (CL:IF IDATE
(IPLUS (CONSTANT (NCHARS "DATE:"))
4)
@@ -884,7 +863,9 @@
(DEFINEQ
(\TEDIT.GET.PIECES3
[LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END) (* ; "Edited 14-Jan-2024 00:22 by rmk")
[LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END) (* ; "Edited 20-Mar-2024 10:59 by rmk")
(* ; "Edited 15-Mar-2024 14:37 by rmk")
(* ; "Edited 14-Jan-2024 00:22 by rmk")
(* ; "Edited 11-Jan-2024 12:37 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 8-Dec-2023 22:49 by rmk")
@@ -895,7 +876,7 @@
(* ;; "This runs through the Looks table portion of the TEXT file, gathering the looks and installing pointers to positions in the character section of the file. It doesn't actually examine the characters in the file. It returns a piece chain that covers the text but that hasn't been installed in the btree. The pieces need further adjustment for character encoding and to prevent mutlibyte characters from crossing buffer boundaries before they are installed in the btree.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETFILEPTR TEXT (\DWIN TEXT)) (* ; "Pieceinfo byte #")
@@ -949,7 +930,7 @@
PPARALOOKS _ OLDPARALOOKS
PTYPE _ OBJECT.PTYPE
PREVPIECE _ PREVPC))
(TEDIT.GET.OBJECT (GETTOBJ TEXTOBJ STREAMHINT)
(\TEDIT.GET.OBJECT (GETTOBJ TEXTOBJ STREAMHINT)
PC TEXT CURFILEBYTE#)
(add CURFILEBYTE# BYTELEN)
(FSETPC PC PLOOKS (if (ZEROP (BIN TEXT))
@@ -1010,6 +991,33 @@
(\TEDIT.INTERPRET.XCCS.SHIFTS PC TEXT))
(RETURN PC])
(\TEDIT.GET.IDATE3
[LAMBDA (STREAM END) (* ; "Edited 6-Dec-2023 16:55 by rmk")
(* ;; "Returns the integer IDATE for slightly updated version 3 files, otherwise NIL. 4 for the bytes of the IDATE, 8 for the header. Leaves resets to starting position (assumes an error wouldn't matter).")
(CL:WHEN (IGREATERP END (IPLUS (CONSTANT (NCHARS "DATE:"))
4 8))
(LET ((FILEPTR (GETFILEPTR STREAM)))
(SETFILEPTR STREAM (IDIFFERENCE END (IPLUS (CONSTANT (NCHARS "DATE:"))
4 8)))
(* ;;
 "DATE: is the marker for this extension to version 3 (could be removed if version is update). ")
(PROG1 (CL:WHEN (AND (EQ (CHARCODE D)
(BIN STREAM))
(EQ (CHARCODE A)
(BIN STREAM))
(EQ (CHARCODE T)
(BIN STREAM))
(EQ (CHARCODE E)
(BIN STREAM))
(EQ (CHARCODE %:)
(BIN STREAM)))
(\DWIN STREAM))
(SETFILEPTR STREAM FILEPTR))))])
(\TEDIT.MAKE.STRINGPIECE
[LAMBDA (PC STRING) (* ; "Edited 23-Jan-2024 14:32 by rmk")
(* ; "Edited 16-Jan-2024 11:15 by rmk")
@@ -1238,7 +1246,8 @@
(DEFINEQ
(\TEDIT.GET.UNFORMATTED.FILE.UTF8
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 4-Feb-2024 10:12 by rmk")
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 11-Mar-2024 23:55 by rmk")
(* ; "Edited 4-Feb-2024 10:12 by rmk")
(* ; "Edited 2-Feb-2024 11:24 by rmk")
(* ; "Edited 21-Jan-2024 09:41 by rmk")
(* ; "Edited 12-Jan-2024 13:17 by rmk")
@@ -1257,12 +1266,16 @@
PPARALOOKS _ DEFAULTPARALOOKS))
(NEXTCODESIZE _ 1)
(SBINABLE _ (fetch (STREAM BINABLE) of STRM))
EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF first (SETQ CODESIZE
NEXTCODESIZE)
(* ; "Assume Ascii to start")
(SETQ PREVPC FIRSTPC
)
(* ; "FIRSTPC is a throwaway")
EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF
first (SELECTQ (READBOM STRM)
(:UTF-8 (add NEXTFILEPOS 3))
((:UTF-16BE :UTF-16LE) (* ;
 "Presumably we could create a single piece of the right type")
(ERROR "BOM :UTF-16 not yet implemented")
(add NEXTFILEPOS 2))
NIL)
(SETQ CODESIZE NEXTCODESIZE) (* ; "Assume Ascii to start")
(SETQ PREVPC FIRSTPC) (* ; "FIRSTPC is a throwaway")
do (SETQ FILEPOS NEXTFILEPOS) (* ; "Start of next file piece")
(do
(* ;; "We stop extending if the next character wouold be out of range, go below to wrap up the final piece. ")
@@ -1582,7 +1595,7 @@
)
(DEFINEQ
(TEDIT.GET.OBJECT
(\TEDIT.GET.OBJECT
[LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN) (* ; "Edited 5-Dec-2023 12:28 by rmk")
(* ; "Edited 26-Nov-2023 10:22 by rmk")
(* ; "Edited 21-Nov-2023 17:53 by rmk")
@@ -1638,6 +1651,7 @@
(\TEDIT.PUT.PCTB
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
(* ; "Edited 16-Mar-2024 12:40 by rmk")
(* ; "Edited 11-Mar-2024 00:33 by rmk")
(* ; "Edited 25-Jan-2024 00:00 by rmk")
(* ; "Edited 23-Jan-2024 13:43 by rmk")
@@ -1686,7 +1700,7 @@
(*PRINT-BASE* _ 10)
(EXTFORMAT _ (GETSTREAMPROP CHARSTREAM 'FORMAT))
(EOLC _ (fetch (STREAM EOLCONVENTION) of CHARSTREAM))
(NSHIFTBYTES _ 0) inpieces (\FIRSTPIECE TEXTOBJ)
(NSHIFTBYTES _ 0) inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
first
(* ;; "NSHIFTBYTES is for the continuation, so the new pieces can skip any charset shifting. We can't hide them from the getfunction of version 3, since version 3 assumes that pieces are in contiguous bytes, we can't bump thePFPOS even though we could deal with it here.")
@@ -1713,9 +1727,11 @@
(SETQ CURBYTE# (\GETFILEPTR CHARSTREAM))
(SETQ OLDBYTE# CURBYTE#)
(SETQ NSHIFTBYTES (CL:WHEN (\FIRSTPIECE TEXTOBJ)(* ;
(SETQ NSHIFTBYTES (CL:WHEN (\TEDIT.FIRSTPIECE TEXTOBJ)
(* ;
 "Set up for first piece, possibly hiding shifts.")
(CHARSET CHARSTREAM (CL:IF (THINPIECEP (\FIRSTPIECE TEXTOBJ))
(CHARSET CHARSTREAM (CL:IF (THINPIECEP (\TEDIT.FIRSTPIECE TEXTOBJ)
)
0
T))
(IDIFFERENCE (\GETFILEPTR CHARSTREAM)
@@ -1789,7 +1805,7 @@
(UTF8.PTYPE (for I from 1 to PLEN do (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE))))
(OBJECT.PTYPE (* ;
 "It's an object, use its PUTFN. Byte positions don't matter for continued editing.")
(TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM CURBYTE#)
(\TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM CURBYTE#)
(CL:WHEN NEWPIECES (* ;
 "Link in the object piece, for continued editing")
(SETQ NEXTNEW (FSETPC NEXTNEW NEXTPIECE
@@ -1886,14 +1902,15 @@
(CHARCODE (EOL LF])])
(\TEDIT.PUT.UTF8.SPLITPIECES
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Feb-2024 14:52 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 17-Mar-2024 00:14 by rmk")
(* ; "Edited 3-Feb-2024 14:52 by rmk")
(* ; "Edited 11-Jan-2024 23:29 by rmk")
(* ; "Edited 5-Jan-2024 11:37 by rmk")
(* ; "Edited 30-Dec-2023 11:27 by rmk")
(* ;; "We are putting to a UTF-8 format file. This function splits pieces if necessary to ensure that all the characters in a piece map to Unicode characters with the same-length UTF8 encoding. That length is stored in PUTF8BYTESPERCHAR.")
(for PC inpieces (\FIRSTPIECE TEXTOBJ)
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
do (SELECTC (PTYPE PC)
(UTF8.PTYPE (FSETPC PC PUTF8BYTESPERCHAR (PBYTESPERCHAR PC)))
(STRING.PTYPES (for CH BPC instring (PCONTENTS PC) as I from 1
@@ -1909,7 +1926,7 @@
 "The first character defines the piece")
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH
*XCCSTOUNICODE*)))
else (\SPLITPIECE PC (SUB1 I)
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
(* ;
@@ -1929,7 +1946,7 @@
(FSETPC PC PUTF8BYTESPERCHAR BPC)
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE)
*XCCSTOUNICODE*)))
else (\SPLITPIECE PC (SUB1 I)
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
(FSETPC PC PUTF8BYTESPERCHAR BPC)
@@ -1947,7 +1964,7 @@
)
(FSETPC PC PUTF8BYTESPERCHAR BPC)
elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)))
else (\SPLITPIECE PC (SUB1 I)
else (\TEDIT.SPLITPIECE PC (SUB1 I)
TEXTOBJ)
(SETQ PC (PREVPIECE PC))
(FSETPC PC PUTF8BYTESPERCHAR BPC)
@@ -2011,7 +2028,9 @@
NEXTNEW])
(\TEDIT.INSERT.NEWPIECES
[LAMBDA (STREAM TEXTOBJ NEWPIECES) (* ; "Edited 5-Feb-2024 09:24 by rmk")
[LAMBDA (STREAM TEXTOBJ NEWPIECES) (* ; "Edited 20-Mar-2024 10:59 by rmk")
(* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 5-Feb-2024 09:24 by rmk")
(* ; "Edited 3-Feb-2024 23:59 by rmk")
(* ; "Edited 21-Jan-2024 09:21 by rmk")
(* ; "Edited 12-Jan-2024 21:06 by rmk")
@@ -2021,13 +2040,13 @@
(* ;; "This makes the pieces and BTREE of TEXTOBJ consistent with the NEWPIECES chain and the new STREAM. The character numbers of old and new pieces correspond, so editing can continue without updating panes, lines, or selections (which are all based on character numbers, not particular pieces). This puts STREAM as the PFILE of each new file piece and then installs NEWPIECES in TEXTOBJ, replacing the BTREE and pieces already there.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(* ;; "The \SETFILEPTR translates TSTREAM's buffer parameters to the new file. ")
(LET ((TSTREAM (GETTOBJ TEXTOBJ STREAMHINT))
FILEPTR)
(SETQ FILEPTR (\TEXTGETFILEPTR TSTREAM)) (* ; "Restore the editing parameters")
(SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR TSTREAM)) (* ; "Restore the editing parameters")
(for PC (SBINABLE _ (fetch (STREAM BINABLE) of STREAM)) inpieces NEWPIECES
when (MEMB (PTYPE PC)
FILE.PTYPES) do (FSETPC PC PCONTENTS STREAM)
@@ -2037,13 +2056,13 @@
(* ;; "Here, finally, we toss the out-of-date pieces to install the new ones. For complete safety, the rest should be uninterruptable (although the file has just been saved, so nothing would really be lost)")
(\MAKEPCTB TEXTOBJ)
(\INSERTPIECES NEWPIECES NIL TEXTOBJ) (* ;
(\TEDIT.MAKEPCTB TEXTOBJ)
(\TEDIT.INSERTPIECES NEWPIECES NIL TEXTOBJ) (* ;
 "Build the tree, then fix the stream")
(* ;; "This guards agains the possiblity that a sequence of edits somehow got the positioning parameters cached in the stream out of step with the document. This ensures that they are consistent after all the pieces have been written out.")
(\TEXTSETFILEPTR TSTREAM (IMAX 0 (IMIN FILEPTR (FGETTOBJ TEXTOBJ TEXTLEN])
(\TEDIT.TEXTSETFILEPTR TSTREAM (IMAX 0 (IMIN FILEPTR (FGETTOBJ TEXTOBJ TEXTLEN])
(\TEDIT.PUTRESET
[LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38")
@@ -2238,6 +2257,39 @@
2
0))) (* ; "The index into the list of fonts")
(\WOUT FORMATSTREAM CHARLOOKSINDEX])
(\TEDIT.PUT.OBJECT
[LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "Edited 24-Jan-2024 23:35 by rmk")
(* ; "Edited 13-Jan-2024 12:20 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 26-Aug-2023 15:13 by rmk")
(* ; "Edited 17-Jul-2023 16:39 by rmk")
(* ; "Edited 6-Aug-2022 10:02 by rmk")
(* ; "Edited 12-Jun-90 17:49 by mitani")
(* ;; "Given a piece which describes an object, put the object out there.")
(LET ((OBJECT (PCONTENTS PIECE))
(ORIGFILEPTR (GETFILEPTR FORMATSTREAM))
BYTELEN)
(\DWOUT FORMATSTREAM 0) (* ;
 "Placeholder for byte-length of the object's description")
(\WOUT FORMATSTREAM \PieceDescriptorOBJECT) (* ;
 "Mark this as setting the piece's looks")
(\ATMOUT FORMATSTREAM (IMAGEOBJPROP OBJECT 'GETFN)) (* ;
 "The FN to apply to reconstruct the object")
(APPLY* (IMAGEOBJPROP OBJECT 'PUTFN)
OBJECT CHARSTREAM)
(SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM)
CURFILEBYTE#))
(SETFILEPTR FORMATSTREAM ORIGFILEPTR) (* ;
 "Now go back and fill in the length of the text description of the object.")
(\DWOUT FORMATSTREAM BYTELEN)
(SETFILEPTR FORMATSTREAM -1) (* ;
 "Move back to the end of the looks file")
(CL:WHEN (RANDACCESSP CHARSTREAM) (* ; "And the end of CHARSTREAM")
(SETFILEPTR CHARSTREAM -1))
BYTELEN])
)
(DEFINEQ
@@ -2361,41 +2413,6 @@
(GETHASH (PPARALOOKS PC)
PARAHASH])
)
(DEFINEQ
(TEDIT.PUT.OBJECT
[LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "Edited 24-Jan-2024 23:35 by rmk")
(* ; "Edited 13-Jan-2024 12:20 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 26-Aug-2023 15:13 by rmk")
(* ; "Edited 17-Jul-2023 16:39 by rmk")
(* ; "Edited 6-Aug-2022 10:02 by rmk")
(* ; "Edited 12-Jun-90 17:49 by mitani")
(* ;; "Given a piece which describes an object, put the object out there.")
(LET ((OBJECT (PCONTENTS PIECE))
(ORIGFILEPTR (GETFILEPTR FORMATSTREAM))
BYTELEN)
(\DWOUT FORMATSTREAM 0) (* ;
 "Placeholder for byte-length of the object's description")
(\WOUT FORMATSTREAM \PieceDescriptorOBJECT) (* ;
 "Mark this as setting the piece's looks")
(\ATMOUT FORMATSTREAM (IMAGEOBJPROP OBJECT 'GETFN)) (* ;
 "The FN to apply to reconstruct the object")
(APPLY* (IMAGEOBJPROP OBJECT 'PUTFN)
OBJECT CHARSTREAM)
(SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM)
CURFILEBYTE#))
(SETFILEPTR FORMATSTREAM ORIGFILEPTR) (* ;
 "Now go back and fill in the length of the text description of the object.")
(\DWOUT FORMATSTREAM BYTELEN)
(SETFILEPTR FORMATSTREAM -1) (* ;
 "Move back to the end of the looks file")
(CL:WHEN (RANDACCESSP CHARSTREAM) (* ; "And the end of CHARSTREAM")
(SETFILEPTR CHARSTREAM -1))
BYTELEN])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
@@ -2435,26 +2452,27 @@
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4862 31358 (TEDIT.GET 4872 . 9548) (TEDIT.FORMATTEDFILEP 9550 . 10473) (TEDIT.FILEDATE
10475 . 12059) (\TEDIT.GET.IDATE3 12061 . 13456) (TEDIT.INCLUDE 13458 . 20311) (TEDIT.RAW.INCLUDE
20313 . 21121) (TEDIT.PUT 21123 . 28066) (TEDIT.PUT.STREAM 28068 . 31356)) (31420 49822 (
\TEDIT.GET.FOREIGN.FILE 31430 . 34494) (\TEDIT.GET.UNFORMATTED.FILE 34496 . 38255) (
\TEDIT.GET.FORMATTED.FILE 38257 . 40923) (\TEDIT.FORMATTEDSTREAMP 40925 . 43612) (\ARBIN 43614 . 44334
) (\ATMIN 44336 . 44873) (\DWIN 44875 . 45254) (\STRINGIN 45256 . 45964) (\TEDIT.GET.TRAILER 45966 .
48291) (\TEDIT.CACHEFILE 48293 . 49820)) (49988 61366 (\TEDIT.GET.PIECES3 49998 . 59525) (
\TEDIT.MAKE.STRINGPIECE 59527 . 61364)) (61367 73310 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 61377 . 67493)
(\TEDIT.INTERPRET.XCCS.SHIFTS 67495 . 73308)) (73332 79153 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 73342 .
79151)) (79176 87312 (\TEDIT.GET.CHARLOOKS.LIST 79186 . 79800) (\TEDIT.GET.SINGLE.CHARLOOKS 79802 .
84124) (\TEDIT.GET.CHARLOOKS 84126 . 85456) (\TEDIT.GET.PARALOOKS.INDEX 85458 . 86002) (
\TEDIT.GET.CHARLOOKS.INDEX 86004 . 87310)) (87313 95551 (\TEDIT.GET.PARALOOKS.LIST 87323 . 87945) (
\TEDIT.GET.SINGLE.PARALOOKS 87947 . 94959) (\TEDIT.GET.PARALOOKS 94961 . 95549)) (95552 98950 (
TEDIT.GET.OBJECT 95562 . 98948)) (99012 130967 (\TEDIT.PUT.PCTB 99022 . 112765) (\TEDIT.PUT.TRAILER
112767 . 113534) (\TEDIT.PUT.PCTB.MERGEABLE 113536 . 117054) (\TEDIT.PUT.UTF8.SPLITPIECES 117056 .
122010) (\TEDIT.PUT.PCTB.NEXTNEW 122012 . 125787) (\TEDIT.INSERT.NEWPIECES 125789 . 128565) (
\TEDIT.PUTRESET 128567 . 128809) (\ARBOUT 128811 . 129535) (\ATMOUT 129537 . 130142) (\DWOUT 130144 .
130423) (\STRINGOUT 130425 . 130965)) (130968 140097 (\TEDIT.PUT.CHARLOOKS.LIST 130978 . 132650) (
\TEDIT.PUT.SINGLE.CHARLOOKS 132652 . 137896) (\TEDIT.PUT.CHARLOOKS 137898 . 139042) (
\TEDIT.PUT.CHARLOOKS1 139044 . 140095)) (140098 148136 (\TEDIT.PUT.PARALOOKS.LIST 140108 . 141010) (
\TEDIT.PUT.SINGLE.PARALOOKS 141012 . 147061) (\TEDIT.PUT.PARALOOKS 147063 . 148134)) (148137 150410 (
TEDIT.PUT.OBJECT 148147 . 150408)) (150505 152187 (TEDITFROMLISPSOURCE 150515 . 152185)))))
(FILEMAP (NIL (4828 30439 (TEDIT.GET 4838 . 9680) (TEDIT.FORMATTEDFILEP 9682 . 10998) (TEDIT.FILEDATE
11000 . 12171) (TEDIT.INCLUDE 12173 . 19141) (TEDIT.RAW.INCLUDE 19143 . 19951) (TEDIT.PUT 19953 .
26896) (TEDIT.PUT.STREAM 26898 . 30437)) (30501 49665 (\TEDIT.GET.FOREIGN.FILE 30511 . 33696) (
\TEDIT.GET.UNFORMATTED.FILE 33698 . 37572) (\TEDIT.GET.FORMATTED.FILE 37574 . 40362) (
\TEDIT.FORMATTEDSTREAMP 40364 . 43264) (\ARBIN 43266 . 43986) (\ATMIN 43988 . 44525) (\DWIN 44527 .
44906) (\STRINGIN 44908 . 45616) (\TEDIT.GET.TRAILER 45618 . 48134) (\TEDIT.CACHEFILE 48136 . 49663))
(49831 62818 (\TEDIT.GET.PIECES3 49841 . 59580) (\TEDIT.GET.IDATE3 59582 . 60977) (
\TEDIT.MAKE.STRINGPIECE 60979 . 62816)) (62819 74762 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 62829 . 68945)
(\TEDIT.INTERPRET.XCCS.SHIFTS 68947 . 74760)) (74784 80806 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 74794 .
80804)) (80829 88965 (\TEDIT.GET.CHARLOOKS.LIST 80839 . 81453) (\TEDIT.GET.SINGLE.CHARLOOKS 81455 .
85777) (\TEDIT.GET.CHARLOOKS 85779 . 87109) (\TEDIT.GET.PARALOOKS.INDEX 87111 . 87655) (
\TEDIT.GET.CHARLOOKS.INDEX 87657 . 88963)) (88966 97204 (\TEDIT.GET.PARALOOKS.LIST 88976 . 89598) (
\TEDIT.GET.SINGLE.PARALOOKS 89600 . 96612) (\TEDIT.GET.PARALOOKS 96614 . 97202)) (97205 100604 (
\TEDIT.GET.OBJECT 97215 . 100602)) (100666 133237 (\TEDIT.PUT.PCTB 100676 . 114679) (
\TEDIT.PUT.TRAILER 114681 . 115448) (\TEDIT.PUT.PCTB.MERGEABLE 115450 . 118968) (
\TEDIT.PUT.UTF8.SPLITPIECES 118970 . 124057) (\TEDIT.PUT.PCTB.NEXTNEW 124059 . 127834) (
\TEDIT.INSERT.NEWPIECES 127836 . 130835) (\TEDIT.PUTRESET 130837 . 131079) (\ARBOUT 131081 . 131805) (
\ATMOUT 131807 . 132412) (\DWOUT 132414 . 132693) (\STRINGOUT 132695 . 133235)) (133238 144631 (
\TEDIT.PUT.CHARLOOKS.LIST 133248 . 134920) (\TEDIT.PUT.SINGLE.CHARLOOKS 134922 . 140166) (
\TEDIT.PUT.CHARLOOKS 140168 . 141312) (\TEDIT.PUT.CHARLOOKS1 141314 . 142365) (\TEDIT.PUT.OBJECT
142367 . 144629)) (144632 152670 (\TEDIT.PUT.PARALOOKS.LIST 144642 . 145544) (
\TEDIT.PUT.SINGLE.PARALOOKS 145546 . 151595) (\TEDIT.PUT.PARALOOKS 151597 . 152668)) (152765 154447 (
TEDITFROMLISPSOURCE 152775 . 154445)))))
STOP

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

Binary file not shown.

81
library/tedit/TEDIT-FIND
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}<library>tedit>TEDIT-FIND.;93 29098
(FILECREATED "17-Mar-2024 12:06:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;102 30083
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
:CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD)
:PREVIOUS-DATE " 3-Mar-2024 20:44:51" {WMEDLEY}<library>tedit>TEDIT-FIND.;92)
:PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}<library>tedit>TEDIT-FIND.;98)
(PRETTYCOMPRINT TEDIT-FINDCOMS)
@@ -85,7 +85,9 @@
TARGETSTRING START END)))))])
(TEDIT.SUBSTITUTE
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 3-Mar-2024 12:24 by rmk")
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 15-Mar-2024 14:09 by rmk")
(* ; "Edited 9-Mar-2024 11:36 by rmk")
(* ; "Edited 3-Mar-2024 12:24 by rmk")
(* ; "Edited 29-Feb-2024 17:00 by rmk")
(* ; "Edited 27-Feb-2024 08:20 by rmk")
(* ; "Edited 6-Jan-2024 11:09 by rmk")
@@ -120,7 +122,7 @@
(if (type? SELPIECES REPLACEMENT)
elseif (OR (STRINGP REPLACEMENT)
(LITATOM REPLACEMENT))
then (SETQ REPLACEMENT (\SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
elseif (LISTP REPLACEMENT)
then (HELP "LISTP REPLACEMENT"))
@@ -144,8 +146,9 @@
"ing...")
T)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(\SHOWSEL SEL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "Turn off any blue pending delete")
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(* ; "Turn off any blue pending delete")
(* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")
@@ -163,14 +166,14 @@
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
'RIGHT T))
(\SHOWSEL PENDING.SEL T)
(\TEDIT.SHOWSEL PENDING.SEL T)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
"OK to replace? ['q' quits]" "Yes")
1))
(Q (RETURN))
(Y (* ; "Do this one")
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY REPLACEMENT
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ PENDING.SEL)
(add NREPLACEMENTS 1)
@@ -189,9 +192,8 @@
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
(bind FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0)
(SAVESEL _ (\COPYSEL SEL)) while (SETQ RANGE
(TEDIT.FIND TEXTOBJ SEARCHSTRING
STARTCHAR# ENDCHAR# T))
(SAVESEL _ (\TEDIT.COPYSEL SEL))
while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
collect (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
(SETQ FIRSTHIT (CAR RANGE)))
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
@@ -199,7 +201,8 @@
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
HITLEN
'RIGHT)
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY REPLACEMENT 'COPY TEXTOBJ)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ SEL)
(add NREPLACEMENTS 1)
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
@@ -218,7 +221,7 @@
(* ;; "We want the new selection to begin at the beginning of the original selection, somewhere before the first hit, and end at the position that the prior ending moved to. The text grew or shrank with each hit.")
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#)
(IPLUS (GETSEL SAVESEL DCH)
TOTALDIFF)
@@ -227,10 +230,10 @@
(* ;; "Save the search & replacement strings to offer for next time:")
(\SHOWSEL SEL T)
(\TEDIT.SHOWSEL SEL T)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\SELPIECES.TO.STRING REPLACEMENT
NIL TEXTOBJ))
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
REPLACEMENT NIL TEXTOBJ))
(TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
(0 (CONCAT " No " ACTIONSTRING "ions made"))
(1 (CONCAT " 1 " ACTIONSTRING "ion made"))
@@ -240,7 +243,8 @@
(RETURN NREPLACEMENTS)))])
(TEDIT.NEXT
[LAMBDA (STREAM) (* ; "Edited 16-Feb-2024 23:48 by rmk")
[LAMBDA (STREAM) (* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 16-Feb-2024 23:48 by rmk")
(* ; "Edited 14-Dec-2023 21:20 by rmk")
(* ; "Edited 20-Jun-2023 00:05 by rmk")
(* ; "Edited 3-May-2023 23:47 by rmk")
@@ -269,7 +273,7 @@
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
(* ;
 "Original comment: %"never pending a deletion%", but it is!")
(\SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL) (* ;
 "Set up SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (CAR TARGET)
(IDIFFERENCE (ADD1 (CADR TARGET))
@@ -277,11 +281,11 @@
'RIGHT)
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "Always selected normally")
(TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
(\SHOWSEL SEL T))
(\TEDIT.SHOWSEL SEL T))
(FIELD (* ;
 "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
(\SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL) (* ;
 "Set SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
(GETSEL FIELDSEL DCH)
@@ -340,7 +344,8 @@
(OR HITSTART (CAR RESULT])])
(\TEDIT.BASICFIND
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 20-Jun-2023 00:11 by rmk")
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 20-Jun-2023 00:11 by rmk")
(* ; "Edited 30-May-91 20:56 by jds")
(* ;; "Search thru TEXTOBJ, starting where the caret is, for an exact match of TARGETSTRING. Optionally, start the search at character START. ")
@@ -352,7 +357,7 @@
(ANCHOR _ (SUB1 START)) first [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
ANCHOR
(IDIFFERENCE END NCHARS))]
eachtime (\TEXTSETFILEPTR TSTREAM ANCHOR)
eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
(* ;; "Match failed, bump the start--single char wild-card # always matches")
while [SETQ ANCHOR (find A from (ADD1 ANCHOR) to LASTANCHOR suchthat (EQ CHAR1 (BIN TSTREAM]
@@ -362,14 +367,15 @@
do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
(\TEDIT.WCFIND.BACKWARD
[LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "Edited 20-Jun-2023 13:52 by rmk")
[LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "Edited 17-Mar-2024 11:59 by rmk")
(* ; "Edited 20-Jun-2023 13:52 by rmk")
(* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITEND is the last character of such a match")
(LET (RESULT)
(COND
((NULL TARGETLIST) (* ; "Final match")
(LIST (ADD1 (\TEXTGETFILEPTR TSTREAM))
(LIST (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM))
(OR HITEND END)))
[(EQ '%# (CAR TARGETLIST)) (* ;
 "Single-char wildcard, next segment is anchored ")
@@ -398,7 +404,8 @@
(OR HITEND (CADR RESULT])
(\TEDIT.BASICFIND.BACKWARD
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 12-Jul-2023 08:14 by rmk")
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 12-Jul-2023 08:14 by rmk")
(* ; "Edited 23-Apr-2023 12:42 by rmk")
(* ;; "Returns a (Startmatch Endmatch) pair of character positions in TSTREAM that denote the nearest occurrence of TARGETSTRING whose first character is at or ahead of START and whose last character is at or before END. ")
@@ -421,26 +428,28 @@
(CL:WHEN (ILESSP (IDIFFERENCE END START)
NCHARS1) (* ; "Too few characters")
(RETURN NIL))
(\TEXTSETFILEPTR TSTREAM (SUB1 END))
(CL:WHEN [AND (EQ CHARN (\TEXTPEEKBIN TSTREAM))
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 END))
(CL:WHEN [AND (EQ CHARN (\TEDIT.TEXTPEEKBIN TSTREAM))
(OR (EQ NCHARS1 0)
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
(\TEXTBACKFILEPTR TSTREAM]
(\TEDIT.TEXTBACKFILEPTR
TSTREAM]
(RETURN (LIST (IDIFFERENCE END NCHARS1)
END)))
(CL:WHEN ANCHORED (* ; "Anchored at END, didn't match")
(RETURN NIL))
(SETQ ANCHOR (SUB1 END))
(SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime (\TEXTSETFILEPTR TSTREAM ANCHOR)
(SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
(* ;
 "The filepos one before the last CHARN match")
(ADD ANCHOR -1)
(* ; "For next attempt")
while (find old ANCHOR from ANCHOR to LASTANCHOR by -1 suchthat (EQ CHARN (\TEXTBACKFILEPTR
while (find old ANCHOR from ANCHOR to LASTANCHOR by -1 suchthat (EQ CHARN (
\TEDIT.TEXTBACKFILEPTR
TSTREAM)))
when [OR (EQ NCHARS1 0)
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
(\TEXTBACKFILEPTR TSTREAM]
(\TEDIT.TEXTBACKFILEPTR TSTREAM]
do (ADD ANCHOR 1)
(RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1)
ANCHOR])
@@ -482,8 +491,8 @@
TARGETSTRING)])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (782 18465 (TEDIT.FIND 792 . 2432) (TEDIT.FIND.BACKWARD 2434 . 4247) (TEDIT.SUBSTITUTE
4249 . 14573) (TEDIT.NEXT 14575 . 18463)) (18498 29075 (\TEDIT.WCFIND 18508 . 20509) (\TEDIT.BASICFIND
20511 . 21874) (\TEDIT.WCFIND.BACKWARD 21876 . 23820) (\TEDIT.BASICFIND.BACKWARD 23822 . 27052) (
\TEDIT.PARSE.SEARCHSTRING 27054 . 29073)))))
(FILEMAP (NIL (832 18922 (TEDIT.FIND 842 . 2482) (TEDIT.FIND.BACKWARD 2484 . 4297) (TEDIT.SUBSTITUTE
4299 . 14915) (TEDIT.NEXT 14917 . 18920)) (18955 30060 (\TEDIT.WCFIND 18965 . 20966) (\TEDIT.BASICFIND
20968 . 22446) (\TEDIT.WCFIND.BACKWARD 22448 . 24507) (\TEDIT.BASICFIND.BACKWARD 24509 . 28037) (
\TEDIT.PARSE.SEARCHSTRING 28039 . 30058)))))
STOP

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

Binary file not shown.

67
library/tedit/TEDIT-FNKEYS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;68 32048
(FILECREATED "15-Mar-2024 14:07:55" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;74 32961
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL)
:CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND)
:PREVIOUS-DATE " 3-Mar-2024 20:44:44" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;67)
:PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;69)
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
@@ -164,7 +164,9 @@
NIL TEXTOBJ])
(\TEDIT.KEY.FIND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "Edited 29-Feb-2024 17:06 by rmk")
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 9-Mar-2024 11:36 by rmk")
(* ; "Edited 29-Feb-2024 17:06 by rmk")
(* ; "Edited 27-Feb-2024 00:22 by rmk")
(* ; "Edited 16-Feb-2024 23:43 by rmk")
(* ; "Edited 14-Dec-2023 21:14 by rmk")
@@ -195,7 +197,7 @@
(CL:WHEN TARGET
(CL:UNLESS SEL
(SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
(\SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL) (* ;
 "Save for next search, even if not found")
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING TARGET)
(SETQ CH (if BACKWARD
@@ -211,7 +213,8 @@
(COND
(CH (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" found")
T) (* ; "We found the target text.")
(TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ;
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(* ;
 "Set up SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (CAR CH)
(ADD1 (IDIFFERENCE (CADR CH)
@@ -227,11 +230,11 @@
'WORD
'CHAR]
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
(\FIXSEL SEL TEXTOBJ)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found")
T)))
(\SHOWSEL SEL T))])
(\TEDIT.SHOWSEL SEL T))])
(\TEDIT.GET.TARGET.STRING
[LAMBDA (TEXTOBJ PROP) (* ; "Edited 29-Feb-2024 17:08 by rmk")
@@ -284,13 +287,16 @@
SEL])
(\TEDIT.LCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-Mar-2024 12:28 by rmk")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
(* ; "Edited 3-Mar-2024 12:28 by rmk")
(* ; "Edited 28-May-2023 00:34 by rmk")
(* ; "Edited 24-May-2023 22:46 by rmk")
(* ;; "uppercasifies the selection. This changes the :Replace THACTION to :LowerCase for REDO. That could be stored in another field, in which case undo wouldn't need to know. Or maybe the transformation function should be stored.")
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.CHARTRANSFORM (\SELPIECES.COPY (\SELPIECES SEL))
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
\TEDIT.SELPIECES
SEL))
(FUNCTION L-CASECODE)
NIL TEXTOBJ)
TEXTOBJ SEL)
@@ -339,13 +345,16 @@
SEL])
(\TEDIT.UCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-Mar-2024 12:56 by rmk")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
(* ; "Edited 3-Mar-2024 12:56 by rmk")
(* ; "Edited 28-May-2023 00:33 by rmk")
(* ; "Edited 24-May-2023 22:45 by rmk")
(* ;; "uppercasifies the selection. This changes the :Replace THACTION to :UpperCase for REDO. That could be stored in another field, in which case undo wouldn't need to know.")
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.CHARTRANSFORM (\SELPIECES.COPY (\SELPIECES SEL))
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
\TEDIT.SELPIECES
SEL))
(FUNCTION U-CASECODE)
NIL TEXTOBJ)
TEXTOBJ SEL)
@@ -600,21 +609,21 @@
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY]
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5593 22336 (\TEDIT.BOLD.SEL.OFF 5603 . 5941) (\TEDIT.BOLD.SEL.ON 5943 . 6271) (
\TEDIT.CENTER.SEL 6273 . 7789) (\TEDIT.CENTER.SEL.REV 7791 . 8087) (\TEDIT.DEFAULTS.CARET 8089 . 8582)
(\TEDIT.DEFAULTSSEL 8584 . 9031) (\TEDIT.SETDEFAULT.FROM.SEL 9033 . 9710) (\TEDIT.KEY.FIND 9712 .
14442) (\TEDIT.GET.TARGET.STRING 14444 . 15308) (\TEDIT.KEY.FIND.BACKWARD 15310 . 15615) (
\TEDIT.FINDAGAIN.BACKWARD 15617 . 16028) (\TEDIT.FINDAGAIN 16030 . 16321) (\TEDIT.ITALIC.SEL.OFF 16323
. 16575) (\TEDIT.ITALIC.SEL.ON 16577 . 16770) (\TEDIT.LARGERSEL 16772 . 17060) (\TEDIT.LCASE.SEL
17062 . 17950) (\TEDIT.SHOWCARETLOOKS 17952 . 19552) (\TEDIT.SMALLERSEL 19554 . 19845) (
\TEDIT.SUBSCRIPTSEL 19847 . 20050) (\TEDIT.SUPERSCRIPTSEL 20052 . 20256) (\TEDIT.UCASE.SEL 20258 .
21090) (\TEDIT.UNDERLINE.SEL.OFF 21092 . 21290) (\TEDIT.UNDERLINE.SEL.ON 21292 . 21488) (
\TEDIT.STRIKEOUT.SEL.ON 21490 . 21686) (\TEDIT.STRIKEOUT.SEL.OFF 21688 . 21886) (\TEDIT.SELECT.ALL
21888 . 22111) (\TEDIT.KEY.SUBSTITUTE 22113 . 22334)) (22408 28817 (\TEDIT.BOLD.CARET.OFF 22418 .
22953) (\TEDIT.BOLD.CARET.ON 22955 . 23487) (\TEDIT.ITALIC.CARET.OFF 23489 . 24026) (
\TEDIT.ITALIC.CARET.ON 24028 . 24571) (\TEDIT.LARGER.CARET 24573 . 25108) (\TEDIT.SMALLER.CARET 25110
. 25647) (\TEDIT.SUBSCRIPT.CARET 25649 . 26190) (\TEDIT.SUPERSCRIPT.CARET 26192 . 26734) (
\TEDIT.UNDERLINE.CARET.OFF 26736 . 27276) (\TEDIT.UNDERLINE.CARET.ON 27278 . 27816) (
\TEDIT.STRIKEOUT.CARET.OFF 27818 . 28358) (\TEDIT.STRIKEOUT.CARET.ON 28360 . 28815)) (28886 29588 (
\TK.DESCRIBEFONT 28896 . 29586)))))
(FILEMAP (NIL (5609 23249 (\TEDIT.BOLD.SEL.OFF 5619 . 5957) (\TEDIT.BOLD.SEL.ON 5959 . 6287) (
\TEDIT.CENTER.SEL 6289 . 7805) (\TEDIT.CENTER.SEL.REV 7807 . 8103) (\TEDIT.DEFAULTS.CARET 8105 . 8598)
(\TEDIT.DEFAULTSSEL 8600 . 9047) (\TEDIT.SETDEFAULT.FROM.SEL 9049 . 9726) (\TEDIT.KEY.FIND 9728 .
14757) (\TEDIT.GET.TARGET.STRING 14759 . 15623) (\TEDIT.KEY.FIND.BACKWARD 15625 . 15930) (
\TEDIT.FINDAGAIN.BACKWARD 15932 . 16343) (\TEDIT.FINDAGAIN 16345 . 16636) (\TEDIT.ITALIC.SEL.OFF 16638
. 16890) (\TEDIT.ITALIC.SEL.ON 16892 . 17085) (\TEDIT.LARGERSEL 17087 . 17375) (\TEDIT.LCASE.SEL
17377 . 18564) (\TEDIT.SHOWCARETLOOKS 18566 . 20166) (\TEDIT.SMALLERSEL 20168 . 20459) (
\TEDIT.SUBSCRIPTSEL 20461 . 20664) (\TEDIT.SUPERSCRIPTSEL 20666 . 20870) (\TEDIT.UCASE.SEL 20872 .
22003) (\TEDIT.UNDERLINE.SEL.OFF 22005 . 22203) (\TEDIT.UNDERLINE.SEL.ON 22205 . 22401) (
\TEDIT.STRIKEOUT.SEL.ON 22403 . 22599) (\TEDIT.STRIKEOUT.SEL.OFF 22601 . 22799) (\TEDIT.SELECT.ALL
22801 . 23024) (\TEDIT.KEY.SUBSTITUTE 23026 . 23247)) (23321 29730 (\TEDIT.BOLD.CARET.OFF 23331 .
23866) (\TEDIT.BOLD.CARET.ON 23868 . 24400) (\TEDIT.ITALIC.CARET.OFF 24402 . 24939) (
\TEDIT.ITALIC.CARET.ON 24941 . 25484) (\TEDIT.LARGER.CARET 25486 . 26021) (\TEDIT.SMALLER.CARET 26023
. 26560) (\TEDIT.SUBSCRIPT.CARET 26562 . 27103) (\TEDIT.SUPERSCRIPT.CARET 27105 . 27647) (
\TEDIT.UNDERLINE.CARET.OFF 27649 . 28189) (\TEDIT.UNDERLINE.CARET.ON 28191 . 28729) (
\TEDIT.STRIKEOUT.CARET.OFF 28731 . 29271) (\TEDIT.STRIKEOUT.CARET.ON 29273 . 29728)) (29799 30501 (
\TK.DESCRIBEFONT 29809 . 30499)))))
STOP

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

Binary file not shown.

74
library/tedit/TEDIT-HCPY
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 6-Mar-2024 23:58:11" {WMEDLEY}<library>tedit>TEDIT-HCPY.;145 33076
(FILECREATED "20-Mar-2024 11:05:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;152 33826
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.HARDCOPY)
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
:PREVIOUS-DATE "19-Jan-2024 23:19:53" {WMEDLEY}<library>tedit>TEDIT-HCPY.;144)
:PREVIOUS-DATE "17-Mar-2024 17:24:56" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;149)
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -16,7 +16,7 @@
(* ;; "Generic interface functions and common code")
(FNS TEDIT.HARDCOPY \TEDIT.PRINT.MENU TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE
\HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC
\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC
\TEDIT.INTEGER.IMAGEBOX \TEDIT.DISPLAY.DIACRITIC))
(COMS
(* ;; "Functions for scaling regions as needed during hardcopy.")
@@ -29,17 +29,20 @@
(* ;
 "0.75 inches from bottom, 1 from top"))
[COMS
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY)
(FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.POSTSCRIPT.HARDCOPY
\TEDIT.PRESS.HARDCOPY)
[P (LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
(COND (IPVALUES (* ;
(CL:WHEN IPVALUES
(* ;
 "Only install INTERPRESS printing if INTERPRESS is loaded.")
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.POSTSCRIPT.HARDCOPY)))]
(P (LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
(COND (PRESSVALUES (* ;
(CL:WHEN PRESSVALUES
(* ;
 "Only install PRESS printing if PRESS is loaded.")
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY)))]
[COMS
(* ;; "vars for Japanese Line Break")
@@ -125,7 +128,9 @@
(TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
(\TEDIT.HARDCOPY.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 24-Dec-2023 22:07 by rmk")
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 20-Mar-2024 11:04 by rmk")
(* ; "Edited 15-Mar-2024 19:23 by rmk")
(* ; "Edited 24-Dec-2023 22:07 by rmk")
(* ; "Edited 2-Dec-2023 11:17 by rmk")
(* ; "Edited 28-Oct-2023 23:52 by rmk")
(* ; "Edited 6-May-2023 20:03 by rmk")
@@ -136,7 +141,7 @@
(* ;; "If possible, use the information cached in THISLINE")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(\DTEST LINE 'LINEDESCRIPTOR)
(* ;; "Only display the line if it appears before the end of the text!")
@@ -145,7 +150,7 @@
(FGETTOBJ TEXTOBJ TEXTLEN))
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
(\FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
(\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
LINE REGION PRSTREAM FORMATTINGSTATE))
(* ;; "Use the characters cached in THISLINE.")
@@ -266,8 +271,9 @@
(FGETLD LINE LFMTSPEC)
PRSTREAM LINE))])])
(\HARDCOPY.FORMATLINE.HEADINGS
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
(* ; "Edited 17-Mar-2024 17:22 by rmk")
(* ; "Edited 19-Jan-2024 23:19 by rmk")
(* ; "Edited 3-Oct-2022 13:05 by rmk")
@@ -277,7 +283,7 @@
(PAGEHEADING
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
(TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
(\TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM
FORMATTINGSTATE)
T)
(EVEN (* ; "Skip an odd page.")
@@ -332,7 +338,8 @@
(MOVETO CURX CURY PRSTREAM])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 7-Mar-2023 21:03 by rmk")
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk")
(* ; "Edited 7-Mar-2023 21:03 by rmk")
(* ; "Edited 6-Mar-2023 15:14 by rmk")
(* ; "Edited 20-Oct-2022 22:35 by rmk")
(* ; "Edited 29-Sep-2022 23:32 by rmk")
@@ -349,7 +356,7 @@
RIGHTMAR _ (HCSCALE SCALE (fetch (FMTSPEC RIGHTMAR)
of SPEC))
QUAD _ (fetch (FMTSPEC QUAD) of SPEC)
TABSPEC _ (\FORMATLINE.SCALETABS SPEC SCALE)
TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX)
of SPEC)
(HCSCALE SCALE
@@ -440,12 +447,13 @@
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.")
(* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc. THIS IS SCREWY")
(DEFINEQ
(TEDIT.HARDCOPYFN
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 25-Sep-2023 16:29 by rmk")
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Mar-2024 10:49 by rmk")
(* ; "Edited 25-Sep-2023 16:29 by rmk")
(* ; "Edited 4-Jul-2023 11:16 by rmk")
(* ; "Edited 21-Sep-2021 15:33 by rmk:")
@@ -460,7 +468,7 @@
(CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
(SETQ WINDOW (\TEDIT.MAINW WINDOW))
(SETQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ)))
(SETQ TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)))
(RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
@@ -482,7 +490,7 @@
'BODY
(FULLNAME STRM)))])
(\TEDIT.HARDCOPY
(\TEDIT.POSTSCRIPT.HARDCOPY
[LAMBDA (FILE PFILE) (* ; "Edited 4-Oct-2022 10:40 by rmk")
(* ; "Edited 1-Oct-2022 22:08 by rmk")
(* ; "Edited 12-Jun-90 18:35 by mitani")
@@ -515,16 +523,14 @@
)
[LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES]
(COND
(IPVALUES (* ;
(CL:WHEN IPVALUES (* ;
 "Only install INTERPRESS printing if INTERPRESS is loaded.")
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.HARDCOPY]
(LISTPUT IPVALUES 'TEDIT (FUNCTION \TEDIT.POSTSCRIPT.HARDCOPY)))]
[LET [(PRESSVALUES (ASSOC 'CONVERSION (ASSOC 'PRESS PRINTFILETYPES]
(COND
(PRESSVALUES (* ;
(CL:WHEN PRESSVALUES (* ;
 "Only install PRESS printing if PRESS is loaded.")
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY]
(LISTPUT PRESSVALUES 'TEDIT (FUNCTION \TEDIT.PRESS.HARDCOPY)))]
@@ -561,11 +567,11 @@
(CLOSEF DOC])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3328 26268 (TEDIT.HARDCOPY 3338 . 4471) (\TEDIT.PRINT.MENU 4473 . 5327) (TEDIT.HCPYFILE
5329 . 7269) (\TEDIT.HARDCOPY.DISPLAYLINE 7271 . 17047) (\HARDCOPY.FORMATLINE.HEADINGS 17049 . 18340)
(\TEDIT.HARDCOPY.MODIFYLOOKS 18342 . 20576) (\TEDIT.HCPYFMTSPEC 20578 . 24597) (
\TEDIT.INTEGER.IMAGEBOX 24599 . 25270) (\TEDIT.DISPLAY.DIACRITIC 25272 . 26266)) (26343 27173 (
\TEDIT.SCALEREGION 26353 . 27171)) (27416 30972 (TEDIT.HARDCOPYFN 27426 . 28758) (
\TEDIT.HARDCOPYFILEFN 28760 . 29321) (\TEDIT.HARDCOPY 29323 . 30243) (\TEDIT.PRESS.HARDCOPY 30245 .
30970)) (32252 33053 (TEDIT-BOOK 32262 . 33051)))))
(FILEMAP (NIL (3492 26880 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5491) (TEDIT.HCPYFILE
5493 . 7433) (\TEDIT.HARDCOPY.DISPLAYLINE 7435 . 17428) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17430 .
18837) (\TEDIT.HARDCOPY.MODIFYLOOKS 18839 . 21073) (\TEDIT.HCPYFMTSPEC 21075 . 25209) (
\TEDIT.INTEGER.IMAGEBOX 25211 . 25882) (\TEDIT.DISPLAY.DIACRITIC 25884 . 26878)) (26955 27785 (
\TEDIT.SCALEREGION 26965 . 27783)) (28044 31739 (TEDIT.HARDCOPYFN 28054 . 29514) (
\TEDIT.HARDCOPYFILEFN 29516 . 30077) (\TEDIT.POSTSCRIPT.HARDCOPY 30079 . 31010) (\TEDIT.PRESS.HARDCOPY
31012 . 31737)) (33002 33803 (TEDIT-BOOK 33012 . 33801)))))
STOP

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

Binary file not shown.

95
library/tedit/TEDIT-HISTORY
View File

@@ -1,14 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;147 32593
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154 33348
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.HISTORYEVENT.DEFPRINT \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS
TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.DELETION \TEDIT.UNDO.REPLACE
\TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE)
:CHANGES-TO (FNS TEDIT.UNDO)
:PREVIOUS-DATE " 4-Mar-2024 21:33:56" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;146)
:PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
@@ -208,7 +206,8 @@
EVENT])
(\TEDIT.CUMULATE.EVENTS
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 3-Mar-2024 12:15 by rmk")
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 3-Mar-2024 12:15 by rmk")
(* ; "Edited 3-Jun-2023 17:09 by rmk")
(* ; "Edited 27-May-2023 00:54 by rmk")
(* ; "Edited 25-May-2023 23:58 by rmk")
@@ -220,7 +219,7 @@
(* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.")
(SETTH EVENT1 THDELETEDPIECES (\SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
(SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
(GETTH EVENT2 THDELETEDPIECES)
TEXTOBJ))
(SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES)))
@@ -234,7 +233,10 @@
(DEFINEQ
(TEDIT.UNDO
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 20:02 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 20-Mar-2024 11:04 by rmk")
(* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 7-Mar-2024 12:48 by rmk")
(* ; "Edited 3-Mar-2024 20:02 by rmk")
(* ; "Edited 22-Nov-2023 18:17 by rmk")
(* ; "Edited 27-Sep-2023 00:14 by rmk")
(* ; "Edited 23-Jun-2023 00:19 by rmk")
@@ -244,7 +246,7 @@
(* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
(* ;; "Only undo things if the document is allowed to change.")
@@ -262,17 +264,12 @@
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
(SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UNDO1 TEXTOBJ EVENT)
(* ;;
 "Gather into a single (list) event all the events that were created as part of the undo. .")
(* ;; "Get the event that undid EVENT")
[SETQ UNDOEVENT (for ETAIL on (FGETTOBJ TEXTOBJ TXTHISTORY)
until (EQ ETAIL PREVEVENTS) collect (CAR ETAIL)
finally (RETURN (CL:IF (CDR $$VAL)
$$VAL
(CAR $$VAL))]
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
(FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
(CL:WHEN [OR (NULL PREVEVENTS)
(AND (type? TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
@@ -286,8 +283,8 @@
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
(LIST (CAR PREVEVENTS)
UNDOEVENT EVENT))
(\FIXSEL SEL TEXTOBJ)
(\SHOWSEL SEL T)))])
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T)))])
(\TEDIT.UNDO1
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 14:55 by rmk")
@@ -337,7 +334,8 @@
T])
(TEDIT.REDO
[LAMBDA (TEXTOBJ) (* ; "Edited 4-Mar-2024 21:33 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 4-Mar-2024 21:33 by rmk")
(* ; "Edited 2-Mar-2024 09:41 by rmk")
(* ; "Edited 21-Dec-2023 11:57 by rmk")
(* ; "Edited 27-May-2023 11:19 by rmk")
@@ -358,7 +356,7 @@
(* ;; "There really is something to redo and something to do it to.")
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
(\TEDIT.REDO.INSERTION TEXTOBJ EVENT SEL))
@@ -384,16 +382,17 @@
 WAITINGCURSOR))) (TEDIT.PROMPTPRINT
 TEXTOBJ "Searching..." T)
 (SETQ SEL (fetch (TEXTOBJ SEL) of
 TEXTOBJ)) (\SHOWSEL SEL NIL)
 TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
 (SETQ CH (TEDIT.FIND TEXTOBJ
 (GETTH EVENT THAUXINFO)))
 (COND (CH (TEDIT.PROMPTPRINT TEXTOBJ
 "done.") (\TEDIT.UPDATE.SEL SEL CH
 (NCHARS (GETTH EVENT THAUXINFO))
 (QUOTE RIGHT)) (\FIXSEL SEL TEXTOBJ)
 (TEDIT.NORMALIZECARET TEXTOBJ)
 (\SHOWSEL SEL T)) (T
 (TEDIT.PROMPTPRINT TEXTOBJ "[Not found]"))))
 (QUOTE RIGHT)) (\TEDIT.FIXSEL SEL
 TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
 (\TEDIT.SHOWSEL SEL T))
 (T (TEDIT.PROMPTPRINT TEXTOBJ
 "[Not found]"))))
)
(:Move (* ; "He moved some text")
(\TEDIT.REDO.MOVE TEXTOBJ EVENT (GETTH EVENT THLEN)
@@ -405,7 +404,7 @@
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
" isn't implemented.")
T))
(\SHOWSEL SEL T)))])
(\TEDIT.SHOWSEL SEL T)))])
(\TEDIT.UNDO.UNDO
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 21:27 by rmk")
@@ -458,19 +457,21 @@
EVENT])
(\TEDIT.UNDO.DELETION
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 23:31 by rmk")
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 30-May-2023 23:31 by rmk")
(* ; "Edited 27-May-2023 23:39 by rmk")
(* ; "Edited 21-Apr-93 12:01 by jds")
(* ;; "UNDO a prior deletion ")
(\TEDIT.INSERT.SELPIECES (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
'INSERT TEXTOBJ)
TEXTOBJ
(GETTH EVENT THCH#])
(\TEDIT.UNDO.MOVE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 16:08 by rmk")
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 4-Mar-2024 16:08 by rmk")
(* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense. The deleted string would reappear in some random place.")
@@ -481,7 +482,7 @@
(* ; "Undo the insert in this document")
(CL:WHEN (GETTH EVENT THDELETEDPIECES) (* ;
 ":Move must have started as :Replace")
(\TEDIT.INSERT.SELPIECES (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
'INSERT TEXTOBJ)
TEXTOBJ
(GETTH EVENT THCH#)))
@@ -497,13 +498,14 @@
(\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
(\TEDIT.UNDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 30-May-2023 23:10 by rmk")
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 30-May-2023 23:10 by rmk")
(* ; "Edited 27-May-2023 16:49 by rmk")
(* ; "Edited 24-May-2023 22:43 by rmk")
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.")
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
@@ -514,18 +516,20 @@
(DEFINEQ
(\TEDIT.REDO.INSERTION
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 31-May-2023 10:26 by rmk")
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 31-May-2023 10:26 by rmk")
(* ; "Edited 18-May-2023 19:24 by rmk")
(* ; "Edited 21-Apr-93 01:06 by jds")
(* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret. We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")
(\TEDIT.INSERT.SELPIECES (\SELPIECES.COPY (\SELPIECES EVENT NIL TEXTOBJ)
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
'INSERT TEXTOBJ)
TEXTOBJ SEL])
(\TEDIT.REDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 2-Oct-2023 11:43 by rmk")
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 2-Oct-2023 11:43 by rmk")
(* ; "Edited 31-May-2023 10:25 by rmk")
(* ; "Edited 27-May-2023 11:16 by rmk")
(* ; "Edited 16-May-2023 22:05 by rmk")
@@ -533,7 +537,7 @@
(* ;; "We get the replacement from where EVENT just installed it in the text (assume that it is still there unchanged), and then we use it to replace what is now at the current selection. EVENT's deleted pieces are not relevant.")
(\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY (\SELPIECES EVENT NIL TEXTOBJ)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
@@ -542,7 +546,8 @@
THACTION ACTION])
(\TEDIT.REDO.MOVE
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 16-Feb-2024 23:36 by rmk")
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 16-Feb-2024 23:36 by rmk")
(* ; "Edited 7-Jun-2023 23:19 by rmk")
(* ; "Edited 27-May-2023 11:18 by rmk")
(* ; "Edited 23-May-2023 12:54 by rmk")
@@ -551,15 +556,15 @@
(\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
LEN)
(SETSEL SCR2 SET T)
(\FIXSEL SCR2 TEXTOBJ)
(\TEDIT.FIXSEL SCR2 TEXTOBJ)
(\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
(TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5054 6075 (\TEDIT.HISTORYEVENT.DEFPRINT 5064 . 6073)) (6841 12292 (\TEDIT.HISTORYADD
6851 . 10927) (\TEDIT.CUMULATE.EVENTS 10929 . 12290)) (12345 25970 (TEDIT.UNDO 12355 . 15592) (
\TEDIT.UNDO1 15594 . 18659) (TEDIT.REDO 18661 . 23730) (\TEDIT.UNDO.UNDO 23732 . 25968)) (25971 29764
(\TEDIT.UNDO.INSERTION 25981 . 26738) (\TEDIT.UNDO.DELETION 26740 . 27312) (\TEDIT.UNDO.MOVE 27314 .
28974) (\TEDIT.UNDO.REPLACE 28976 . 29762)) (29765 32570 (\TEDIT.REDO.INSERTION 29775 . 30604) (
\TEDIT.REDO.REPLACE 30606 . 31726) (\TEDIT.REDO.MOVE 31728 . 32568)))))
(FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD
6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162
(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 .
29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
STOP

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

Binary file not shown.

713
library/tedit/TEDIT-LOOKS
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

391
library/tedit/TEDIT-MENU
View File

@@ -1,12 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Mar-2024 20:35:49" {WMEDLEY}<library>tedit>TEDIT-MENU.;150 263731
(FILECREATED "27-Mar-2024 15:21:00" {WMEDLEY}<library>tedit>TEDIT-MENU.;167 268556
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.APPLY.PARALOOKS)
:CHANGES-TO (FNS \TEDIT.SHOW.PAGEFORMATTING \TEDIT.APPLY.PAGEFORMATTING \TEDIT.APPLY.CHARLOOKS
\TEDIT.SHOW.CHARLOOKS MB.SELFN \TEDIT.SHOW.PARALOOKS MB.WHENOPERATEDFN
MB.SHOWSELFN)
:PREVIOUS-DATE "27-Feb-2024 08:13:25" {WMEDLEY}<library>tedit>TEDIT-MENU.;149)
:PREVIOUS-DATE "20-Mar-2024 11:06:06" {WMEDLEY}<library>TEDIT>TEDIT-MENU.;163)
(PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -171,7 +173,7 @@
(PROGN (SETTOBJ TEXTOBJ TXTDON'TUPDATE T) . BODY)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 -1)
(SETTOBJ TEXTOBJ TXTDON'TUPDATE OLD-DON'TUPDATE)
(TEDIT.UPDATE.SCREEN TEXTOBJ))])
(\TEDIT.UPDATE.SCREEN TEXTOBJ))])
)
)
@@ -261,7 +263,8 @@
(RETURN OBJ])
(MB.SELFN
[LAMBDA (OBJ SEL W FN) (* ; "Edited 16-Feb-2024 20:48 by rmk")
[LAMBDA (OBJ SEL W FN) (* ; "Edited 15-Mar-2024 13:38 by rmk")
(* ; "Edited 16-Feb-2024 20:48 by rmk")
(* ; "Edited 24-Jan-2024 10:48 by rmk")
(* ; "Edited 6-Jun-2023 15:31 by rmk")
(* ; "Edited 18-Apr-2023 23:58 by rmk")
@@ -271,7 +274,7 @@
(* ;;
 "Calls a menu-button's associated function, then turns off the highlighting of the menu button.")
(LET [(TSEL (\COPYSEL SEL))
(LET [(TSEL (\TEDIT.COPYSEL SEL))
(BUTTONFN (OR FN (IMAGEOBJPROP OBJ 'MBFN] (* ;
 "Save the selection that points to the menu button.")
(SETSEL SEL SELKIND 'CHAR)
@@ -279,9 +282,9 @@
(CL:UNLESS (EQ (AND BUTTONFN (APPLY* BUTTONFN OBJ SEL W))
'DON'T) (* ;
 "If the button fn left the selection alone,")
(\FIXSEL TSEL) (* ;
(\TEDIT.FIXSEL TSEL) (* ;
 "Turn off the button hilite. Perhaps the function changed something that changed the selection?")
(\SHOWSEL TSEL NIL))
(\TEDIT.SHOWSEL TSEL NIL))
(SETSEL SEL SET NIL])
(MB.SIZEFN
@@ -303,11 +306,12 @@
BOX])
(MB.WHENOPERATEDFN
[LAMBDA (OBJ DS OPERATION SEL) (* jds " 7-Feb-84 14:20")
[LAMBDA (OBJ W OPERATION SEL) (* ; "Edited 27-Mar-2024 13:49 by rmk")
(* jds " 7-Feb-84 14:20")
(SELECTQ OPERATION
(HIGHLIGHTED (MB.SHOWSELFN OBJ SEL T DS))
(UNHIGHLIGHTED (MB.SHOWSELFN OBJ SEL NIL DS))
(SELECTED (MB.SELFN OBJ SEL DS))
(HIGHLIGHTED (MB.SHOWSELFN OBJ SEL T W))
(UNHIGHLIGHTED (MB.SHOWSELFN OBJ SEL NIL W))
(SELECTED (MB.SELFN OBJ SEL W))
(DESELECTED)
NIL])
@@ -350,19 +354,20 @@
(for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR])
(MB.SHOWSELFN
[LAMBDA (OBJ SEL ON DS) (* ; "Edited 20-Nov-2023 20:16 by rmk")
[LAMBDA (OBJ SEL ON W) (* ; "Edited 27-Mar-2024 13:47 by rmk")
(* ; "Edited 20-Nov-2023 20:16 by rmk")
(* ; "Edited 11-Jan-89 16:35 by jds")
(LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX]
(OR (IMAGEOBJPROP OBJ 'BITCACHE)
(MB.DISPLAY OBJ)) (* ; "MAKE SURE THE DISPLAY FORM EXISTS")
(BITBLT (IMAGEOBJPROP OBJ 'BITCACHE)
0 0 DS 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX)
0 0 W 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX)
(fetch (IMAGEBOX YSIZE) of OBJBOX)
'INPUT
'REPLACE)
(CL:WHEN (OR ON (EQ (IMAGEOBJPROP OBJ 'STATE)
'ON))
(BLTSHADE BLACKSHADE DS 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX)
(BLTSHADE BLACKSHADE W 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX)
(fetch (IMAGEBOX YSIZE) of OBJBOX)
'INVERT))])
@@ -399,14 +404,15 @@
(TEDIT.OBJECT.CHANGED TEXTOBJ OBJ])
(MBUTTON.FIND.BUTTON
[LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 16-Sep-2022 21:20 by rmk")
[LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 16-Sep-2022 21:20 by rmk")
(* ; "Edited 22-Aug-2022 15:29 by rmk")
(* ; "Edited 22-Apr-93 15:40 by jds")
(* ; "'27-Sep-84 00:52' gbn")
(* ;; "Returns the piece containing the imageobj with MBTEXT prop LABEL")
(for (PC _ (\CHTOPC (OR CH# 1)
(for (PC _ (\TEDIT.CHTOPC (OR CH# 1)
(TEXTOBJ TEXTSTREAM)))
OBJ
(LABELATOM _ (MKATOM LABEL)) by (NEXTPIECE PC) while PC
@@ -416,7 +422,8 @@
(RETURN PC])
(MBUTTON.FIND.NEXT.BUTTON
[LAMBDA (TEXTOBJ CH#) (* ; "Edited 21-Oct-2023 08:54 by rmk")
[LAMBDA (TEXTOBJ CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 21-Oct-2023 08:54 by rmk")
(* ; "Edited 5-Sep-2022 15:39 by rmk")
(* ; "Edited 22-Aug-2022 13:19 by rmk")
(* ; "Edited 6-Aug-2022 17:36 by rmk")
@@ -424,16 +431,17 @@
(* ;; "Finds the next instance of an OBJECT which looks like a menu button, 3-state button, or menuobj. If none is found, return NIL")
(for (PC _ (\CHTOPC CH# TEXTOBJ))
(for (PC _ (\TEDIT.CHTOPC CH# TEXTOBJ))
OBJ by (NEXTPIECE PC) while PC when (AND (EQ OBJECT.PTYPE (PTYPE PC))
(SETQ OBJ (PCONTENTS PC))
(OR (type? MBUTTON OBJ)
(type? MARGINBAR OBJ)
(type? NWAYBUTTON OBJ)))
do (RETURN (CONS OBJ (\PCTOCH PC TEXTOBJ])
do (RETURN (CONS OBJ (\TEDIT.PCTOCH PC TEXTOBJ])
(MBUTTON.FIND.NEXT.FIELD
[LAMBDA (TEXTOBJ CH# DONTFIX) (* ; "Edited 25-Feb-2024 23:17 by rmk")
[LAMBDA (TEXTOBJ CH# DONTFIX) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 25-Feb-2024 23:17 by rmk")
(* ; "Edited 9-May-2023 12:43 by rmk")
(* ; "Edited 20-Mar-2023 17:33 by rmk")
(* ; "Edited 11-Feb-2023 11:23 by rmk")
@@ -453,8 +461,8 @@
(* ;;
 "Find the start of the field. CLSELHERE is set for the prefix {, since the field may be empty")
(for old PC inpieces (\CHTOPC CH# TEXTOBJ T) until (fetch (CHARLOOKS CLSELHERE)
of (PLOOKS PC))
(for old PC inpieces (\TEDIT.CHTOPC CH# TEXTOBJ T) until (fetch (CHARLOOKS CLSELHERE)
of (PLOOKS PC))
do (add START-OF-PIECE (PLEN PC)))
(CL:UNLESS PC (* ;
 "Ran off the text without finding a fill-in field")
@@ -527,7 +535,9 @@
(MKATOM STR))])
(MBUTTON.SET.FIELD
[LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "Edited 21-Oct-2023 08:55 by rmk")
[LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "Edited 17-Mar-2024 00:25 by rmk")
(* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 21-Oct-2023 08:55 by rmk")
(* ; "Edited 13-Sep-2022 12:24 by rmk")
(* ; "Edited 6-Aug-2022 17:45 by rmk")
(* ; "Edited 22-Apr-93 10:56 by jds")
@@ -538,12 +548,12 @@
OBJ SAVED.SEL FIELD.SEL PC NEW-STRING)
(SETQ PC (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM))
(CL:WHEN (SETQ PC (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM))
(SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (\PCTOCH PC TEXTOBJ)))
(SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (\TEDIT.PCTOCH PC TEXTOBJ)))
(* ;
 "select the field following this button.")
(CL:WHEN FIELD.SEL (* ;
 "there are contents to set for this button")
(\FIXSEL FIELD.SEL TEXTOBJ)
(\TEDIT.FIXSEL FIELD.SEL TEXTOBJ)
(TEDIT.SETSEL TEXTSTREAM (fetch (SELECTION CH#) of FIELD.SEL)
(fetch (SELECTION DCH) of FIELD.SEL)
(fetch (SELECTION POINT) of FIELD.SEL)
@@ -557,7 +567,8 @@
(TEDIT.INSERT TEXTSTREAM (MKSTRING VALUE]))])
(MBUTTON.SET.NEXT.FIELD
[LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "Edited 22-May-2023 10:50 by rmk")
[LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 22-May-2023 10:50 by rmk")
(* ; "Edited 20-Mar-2023 12:40 by rmk")
(* ; "Edited 18-Mar-2023 23:18 by rmk")
(* ; "Edited 11-Feb-2023 09:33 by rmk")
@@ -567,7 +578,7 @@
(LET (FIELDSEL)
(CL:WHEN (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#))
(\FIXSEL FIELDSEL TEXTOBJ) (* ;
(\TEDIT.FIXSEL FIELDSEL TEXTOBJ) (* ;
 "Fix up the SELECTION that describes its contents, so we've got the right screen coordinates &c")
(CL:UNLESS (ZEROP (fetch (SELECTION DCH) of FIELDSEL))
(\TEDIT.DELETE TEXTOBJ FIELDSEL)) (* ; "Delete existing text")
@@ -1904,7 +1915,8 @@
(SETQ OLDX X])
(\TEDIT.TABTYPE.SET
[LAMBDA (OBJ SEL W) (* ; "Edited 21-Oct-2022 18:46 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 21-Oct-2022 18:46 by rmk")
(* ; "Edited 3-Oct-2022 22:16 by rmk")
(* ; "Edited 9-Sep-2022 15:47 by rmk")
(* ; "Edited 6-Aug-2022 17:16 by rmk")
@@ -1928,7 +1940,7 @@
(CL:WHEN (EQ (IMAGEOBJPROP DOTTEDBUTTON 'STATE)
'ON) (* ; "Yes. Make this a DOTTEDxxx tab.")
(SETQ STATE (PACK* 'DOTTED STATE)))
(for (PC _ (\CHTOPC (ADD1 (fetch (SELECTION CH#) of SEL))
(for (PC _ (\TEDIT.CHTOPC (ADD1 (fetch (SELECTION CH#) of SEL))
TEXTOBJ)) by (NEXTPIECE PC) while PC when (type? MARGINBAR (PCONTENTS
PC))
do (replace MARTABTYPE of (IMAGEOBJPROP (PCONTENTS PC)
@@ -2241,30 +2253,29 @@
(\TEXTMENU.SET.TOGGLE "Unformatted" 'ON CHARMENUTEXTSTREAM])
(MB.DEFAULTBUTTON.FN
[LAMBDA (OBJ SEL W) (* ; "Edited 22-Feb-2024 23:26 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 20-Mar-2024 11:03 by rmk")
(* ; "Edited 9-Mar-2024 11:43 by rmk")
(* ; "Edited 22-Feb-2024 23:26 by rmk")
(* ; "Edited 7-Feb-2024 23:07 by rmk")
(* ; "Edited 29-Jan-2024 17:22 by rmk")
(* ; "Edited 21-Oct-2022 18:46 by rmk")
(* ; "Edited 30-Mar-94 15:46 by jds")
(* ;
 "MBFN for TEdit default menu item buttons.")
(PROG* ((TEXTOBJ (\DTEST (GETSEL SEL SELTEXTOBJ)
'TEXTOBJ))
(MAINTEXT (\DTEST (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ)
'TEXTOBJ))
(MAINSEL (FGETTOBJ MAINTEXT SEL))
(PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of W)))
[MAINTEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of (WINDOWPROP W 'MAINWINDOW]
(MAINSEL (FGETTOBJ MAINTEXTOBJ SEL))
PROC)
[COND
((EQ (FGETTOBJ MAINTEXT EDITOPACTIVE)
((EQ (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE)
T)
(TEDIT.PROMPTPRINT MAINTEXT "Edit operation in progress; please wait." T)
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Edit operation in progress; please wait." T)
(RETURN))
((FGETTOBJ MAINTEXT EDITOPACTIVE)
(TEDIT.PROMPTPRINT MAINTEXT (CONCAT (FGETTOBJ MAINTEXT EDITOPACTIVE)
" operation in progress; please wait.")
((FGETTOBJ MAINTEXTOBJ EDITOPACTIVE)
(TEDIT.PROMPTPRINT MAINTEXTOBJ (CONCAT (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE)
" operation in progress; please wait.")
T)
(CL:UNLESS (EQ (FGETTOBJ MAINTEXT EDITOPACTIVE)
(CL:UNLESS (EQ (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE)
(IMAGEOBJPROP OBJ 'MBTEXT))
(RETURN]
[COND
@@ -2272,14 +2283,15 @@
'PROCESS))
(PROCESSP PROC)) (* ;
 "THE MAIN window has a live process behind it; go evaluate the button fn there.")
(PROCESS.EVAL PROC (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL
)))
(PROCESS.EVAL PROC (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL)))
((AND (SETQ PROC (WINDOWPROP W 'PROCESS))
(PROCESSP PROC)) (* ;
 "This window has a live process behind it; go evaluate the button fn there.")
(PROCESS.EVAL PROC (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL
)))
(T (ADD.PROCESS (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL]
(PROCESS.EVAL PROC (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL)))
(T (ADD.PROCESS (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN)
OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL]
(CL:WHEN (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
(GIVE.TTY.PROCESS W)
(DISMISS 20))
@@ -2301,7 +2313,9 @@
(EQ NEWSTATE 'ON])
(MB.DEFAULTBUTTON.ACTIONFN
[LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* ; "Edited 27-Feb-2024 07:54 by rmk")
[LAMBDA (OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL) (* ; "Edited 15-Mar-2024 13:53 by rmk")
(* ; "Edited 9-Mar-2024 11:33 by rmk")
(* ; "Edited 27-Feb-2024 07:54 by rmk")
(* ; "Edited 14-Dec-2023 21:03 by rmk")
(* ; "Edited 22-Sep-2023 20:09 by rmk")
(* ; "Edited 20-Sep-2023 23:14 by rmk")
@@ -2313,15 +2327,16 @@
 "MBFN for TEdit default menu item buttons.")
(PROG (OFILE CH %#COPIES PRINTHOST PRINTOPTIONS %#SIDES MSG)
[ERSETQ (RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE MAINTEXT)
[RESETSAVE (\TEDIT.MARKACTIVE MAINTEXTOBJ)
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
'(AND (\TEDIT.MARKINACTIVE OLDVALUE]
[RESETSAVE (PROG1 OBJ
(IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T))
'(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL]
(SETTOBJ MAINTEXT EDITOPACTIVE (OR (IMAGEOBJPROP OBJ 'MBTEXT)
T)) (* ;
(SETTOBJ MAINTEXTOBJ EDITOPACTIVE (OR (IMAGEOBJPROP OBJ 'MBTEXT)
T))
(* ;
 "So we can tell the guy WHAT op is active.")
(SELECTQ (IMAGEOBJPROP OBJ 'MBTEXT)
(Put [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
@@ -2330,33 +2345,34 @@
[COND
(OFILE (* ;
 "Only try this if he really typed a file name")
(TEDIT.PUT MAINTEXT OFILE NIL (GETTEXTPROP TEXTOBJ
'UNFORMATTEDPUT/GET])
(TEDIT.PUT MAINTEXTOBJ OFILE NIL (GETTEXTPROP TEXTOBJ
'UNFORMATTEDPUT/GET])
(Get [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(GETSEL SEL CH#]
[COND
(OFILE (* ;
 "Only try this if he really typed a file name")
(TEDIT.GET MAINTEXT OFILE (GETTEXTPROP TEXTOBJ
'UNFORMATTEDPUT/GET])
(TEDIT.GET MAINTEXTOBJ OFILE (GETTEXTPROP TEXTOBJ
'UNFORMATTEDPUT/GET])
(Include [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(GETSEL SEL CH#]
(COND
(OFILE (TEDIT.INCLUDE MAINTEXT OFILE))))
(OFILE (TEDIT.INCLUDE MAINTEXTOBJ OFILE))))
(Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (GETSEL SEL CH#)))
[COND
((ZEROP (NCHARS OFILE)) (* ; "NOTHING--HE HIT DEL.")
NIL)
(OFILE (* ;
 "There's something to do. Go do it.")
(TEDIT.PROMPTPRINT MAINTEXT "Searching..." T)
[SETQ CH (CAR (ERSETQ (TEDIT.FIND MAINTEXT OFILE NIL NIL T]
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Searching..." T)
[SETQ CH (CAR (ERSETQ (TEDIT.FIND MAINTEXTOBJ OFILE NIL NIL
T]
(COND
(CH (* ; "We found the target text.")
(TEDIT.PROMPTPRINT MAINTEXT "Done.")
(\SHOWSEL MAINSEL NIL)
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Done.")
(\TEDIT.SHOWSEL MAINSEL NIL)
(SETSEL MAINSEL CH# (CAR CH))
(* ;
 "Set up SELECTION to be the found text")
@@ -2364,17 +2380,19 @@
[SETSEL MAINSEL DCH (ADD1 (IDIFFERENCE (CADR CH)
(CAR CH]
(SETSEL MAINSEL POINT 'RIGHT)
(FSETTOBJ MAINTEXT CARETLOOKS (
(FSETTOBJ MAINTEXTOBJ CARETLOOKS (
\TEDIT.GET.INSERT.CHARLOOKS
MAINTEXT MAINSEL))
MAINTEXTOBJ
MAINSEL))
(* ;
 "Set the caret looks to match those of the new selection")
(TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL
MAINTEXTOBJ)
(* ; "And never pending a deletion.")
(\FIXSEL MAINSEL MAINTEXT)
(TEDIT.NORMALIZECARET MAINTEXT MAINSEL)
(\SHOWSEL MAINSEL T))
(T (TEDIT.PROMPTPRINT MAINTEXT "(Not found)"])
(\TEDIT.FIXSEL MAINSEL MAINTEXTOBJ)
(TEDIT.NORMALIZECARET MAINTEXTOBJ MAINSEL)
(\TEDIT.SHOWSEL MAINSEL T))
(T (TEDIT.PROMPTPRINT MAINTEXTOBJ "(Not found)"])
(Substitute [PROG* ((SAVECH# (GETSEL SEL CH#))
(REPLACEMENT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ
(GETSEL SEL CH#)))
@@ -2409,46 +2427,49 @@
 "Get the replacement out of the menu to copy into the main text.")
(SETQ REPLACEMENT
(\SELPIECES (fetch (TEXTOBJ SCRATCHSEL)
of TEXTOBJ))))
(\TEDIT.SELPIECES (fetch (TEXTOBJ
SCRATCHSEL
)
of TEXTOBJ))))
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(TEDIT.SUBSTITUTE MAINTEXT PATTERN
(TEDIT.SUBSTITUTE MAINTEXTOBJ PATTERN
REPLACEMENT CONFIRM?))])
(Quit (* ; "He wants to QUIT the edit.")
(COND
((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXT)
((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXTOBJ)
T)
(replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T))))
(Page% Layout (* ; "Page layout menu")
(\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T)
(\TEDIT.PRIMARYW MAINTEXT)
(\TEDIT.PRIMARYW MAINTEXTOBJ)
"Page Layout Menu"
(HEIGHTIFWINDOW 135 5)
'PAGE))
(Para% Looks (* ; "Page layout menu")
(\TEDIT.EXPANDEDPARA.MENU MAINTEXT))
(\TEDIT.EXPANDEDPARA.MENU MAINTEXTOBJ))
(Char% Looks (* ; "Page layout menu")
(\TEDIT.EXPANDEDCHARLOOKS.MENU MAINTEXT))
(\TEDIT.EXPANDEDCHARLOOKS.MENU MAINTEXTOBJ))
(All (* ; "Select the entire document.")
(COND
((NOT (ZEROP (TEXTLEN MAINTEXT)))
(\SHOWSEL MAINSEL NIL)
(TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL)
((NOT (ZEROP (TEXTLEN MAINTEXTOBJ)))
(\TEDIT.SHOWSEL MAINSEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL MAINTEXTOBJ)
(SETSEL MAINSEL CH# 1)
(SETSEL MAINSEL CHLIM (ADD1 (TEXTLEN MAINTEXT)))
(SETSEL MAINSEL DCH (TEXTLEN MAINTEXT))
(SETSEL MAINSEL CHLIM (ADD1 (TEXTLEN MAINTEXTOBJ)))
(SETSEL MAINSEL DCH (TEXTLEN MAINTEXTOBJ))
(SETSEL MAINSEL POINT 'LEFT)
(SETSEL MAINSEL SET T)
(\FIXSEL MAINSEL MAINTEXT)
(\SHOWSEL MAINSEL T))))
(\TEDIT.FIXSEL MAINSEL MAINTEXTOBJ)
(\TEDIT.SHOWSEL MAINSEL T))))
(Hardcopy [SETQ PRINTHOST (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT
TEXTOBJ
(GETSEL SEL CH#]
(COND
((NOT PRINTHOST) (* ;
 "If he didn't specify a particular host, defer to his defaults.")
(TEDIT.PROMPTPRINT MAINTEXT "Using default print server.")))
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Using default print server.")
))
(SETQ %#COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER
TEXTOBJ
(GETSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)
@@ -2479,12 +2500,12 @@
[COND
(MSG (push PRINTOPTIONS MSG)
(push PRINTOPTIONS 'MESSAGE]
(TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST PRINTOPTIONS))
(TEDIT.HARDCOPY MAINTEXTOBJ NIL NIL NIL PRINTHOST PRINTOPTIONS))
(ERROR)))]
(SETSEL SEL SET T) (* ;
 "Now turn the menu button highlighting off.")
(SETSEL SEL ONFLG T)
(\SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL) (* ;
 "And forget that anything is selected.")
(SETSEL SEL SET NIL])
)
@@ -2539,7 +2560,9 @@
NEWLOOKS])
(\TEDIT.APPLY.CHARLOOKS
[LAMBDA (OBJ SEL W) (* ; "Edited 16-Feb-2024 21:21 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:12 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 16-Feb-2024 21:21 by rmk")
(* ; "Edited 18-Apr-2023 23:55 by rmk")
(* ; "Edited 21-Oct-2022 18:47 by rmk")
(* ; "Edited 30-May-91 22:17 by jds")
@@ -2547,11 +2570,11 @@
(* ;; "MBFN for TEdit default menu item buttons.")
(LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ))
(MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ))
[MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
of (WINDOWPROP W 'MAINWINDOW]
(CH# (ADD1 (FGETSEL SEL CH#)))
NEWLOOKS)
(\SHOWSEL SEL NIL) (* ; "Turn off the APPLY button.")
(\TEDIT.SHOWSEL SEL NIL) (* ; "Turn off the APPLY button.")
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* ; "Skip over the SHOW button")
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
@@ -2559,7 +2582,7 @@
(SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ CH#))
(* ;
 "Now Parse the menu, to give us a looks spec.")
(TEDIT.LOOKS MAINTEXT NEWLOOKS) (* ; "Make the change in looks")
(TEDIT.LOOKS MAINTEXTOBJ NEWLOOKS) (* ; "Make the change in looks")
(* ;
 "Leave him typing in the real document")
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
@@ -2581,7 +2604,11 @@
NEWLOOKS])
(\TEDIT.SHOW.CHARLOOKS
[LAMBDA (OBJ SEL MENUSTREAM) (* ; "Edited 25-Feb-2024 23:27 by rmk")
[LAMBDA (OBJ SEL MENUSTREAM) (* ; "Edited 27-Mar-2024 15:11 by rmk")
(* ; "Edited 20-Mar-2024 11:03 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 25-Feb-2024 23:27 by rmk")
(* ; "Edited 20-Jul-2023 17:00 by rmk")
(* ; "Edited 3-May-2023 10:40 by rmk")
(* ; "Edited 22-Aug-2022 13:17 by rmk")
@@ -2593,31 +2620,31 @@
(* ;; "Set the CHARLOOKS menu from the looks of the currently selected character.")
(LET* ((TEXTOBJ (\DTEST (GETSEL SEL SELTEXTOBJ)
'TEXTOBJ))
(MAINTEXT (WINDOWPROP (WINDOWPROP MENUSTREAM 'MAINWINDOW)
'TEXTOBJ))
(MAINCH# (GETSEL (GETTOBJ MAINTEXT SEL)
(LET* ((TEXTOBJ (TEXTOBJ! (GETSEL SEL SELTEXTOBJ)))
[MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
of (WINDOWPROP MENUSTREAM 'MAINWINDOW]
(MAINCH# (GETSEL (GETTOBJ MAINTEXTOBJ SEL)
CH#))
(CH# (ADD1 (GETSEL SEL CH#)))
PC OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET)
(CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXT))
PC NEWLOOKS)
(CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXTOBJ))
[SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#]
(* ; "Skip over the NEUTRAL button.")
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(SETSEL SEL SET NIL)
(SETQ PC (\CHTOPC MAINCH# MAINTEXT)) (* ;
(SETQ PC (\TEDIT.CHTOPC MAINCH# MAINTEXTOBJ)) (* ;
 "The PIECE containing the text to describe")
(SETQ NEWLOOKS (PLOOKS PC)) (* ;
 "Get the looks for those characters.")
(* ;
 "Fill in the menu blanks with that info")
(TEDIT.DEFERRED-UPDATES TEXTOBJ (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# NEWLOOKS))
(TTY.PROCESS (WINDOWPROP (\TEDIT.PRIMARYW MAINTEXT)
(TTY.PROCESS (WINDOWPROP (\TEDIT.PRIMARYW MAINTEXTOBJ)
'PROCESS)))])
(\TEDIT.NEUTRALIZE.CHARLOOKS
[LAMBDA (OBJ SEL W) (* ; "Edited 25-Feb-2024 23:30 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 15-Mar-2024 14:23 by rmk")
(* ; "Edited 25-Feb-2024 23:30 by rmk")
(* ; "Edited 19-Dec-2023 13:40 by rmk")
(* ; "Edited 18-Apr-2023 23:55 by rmk")
(* ; "Edited 21-Oct-2022 18:50 by rmk")
@@ -2627,23 +2654,25 @@
(LET [(TEXTOBJ (GETSEL SEL SELTEXTOBJ))
(CH# (ADD1 (FGETSEL SEL CH#]
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(FSETSEL SEL SET NIL)
(\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* ;
 "Fill in the menu blanks with that info and update the menu's screen image")
(TEDIT.UPDATE.SCREEN TEXTOBJ)
(\TEDIT.UPDATE.SCREEN TEXTOBJ)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'PROCESS])
(\TEDIT.FILL.IN.CHARLOOKS.MENU
[LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 13-Nov-2023 09:55 by rmk")
[LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 20-Mar-2024 11:03 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 13-Nov-2023 09:55 by rmk")
(* ; "Edited 24-Jul-2023 21:09 by rmk")
(* ; "Edited 18-Apr-2023 23:55 by rmk")
(* ; "Edited 30-May-91 22:28 by jds")
(* ;; "Given a TEXTOBJ describing a charlooks menu, the CH# of the start of the charlooks menu, and a set of looks, fill in the menu fields.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(LET (PC OFILE CH NEXTB BUTTON TEXT OFFSET (SCRATCHSEL (FGETTOBJ TEXTOBJ SCRATCHSEL)))
(SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKS NIL TEXTOBJ))
@@ -2733,7 +2762,7 @@
(MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB))
(AND OFFSET (IABS OFFSET))) (* ;
 "Now move up to the offset distance fill-in field.")
(\SHOWSEL SCRATCHSEL NIL)
(\TEDIT.SHOWSEL SCRATCHSEL NIL)
(SETSEL SCRATCHSEL SET NIL)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 (GETSEL SCRATCHSEL CH#])
@@ -2940,7 +2969,10 @@
'PARALOOKS])
(\TEDIT.APPLY.PARALOOKS
[LAMBDA (OBJ SEL W) (* ; "Edited 1-Mar-2024 20:33 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 20-Mar-2024 11:04 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 9-Mar-2024 11:54 by rmk")
(* ; "Edited 1-Mar-2024 20:33 by rmk")
(* ; "Edited 26-Feb-2024 11:41 by rmk")
(* ; "Edited 17-Dec-2023 17:04 by rmk")
(* ; "Edited 18-Apr-2023 23:55 by rmk")
@@ -2954,9 +2986,8 @@
(* ;; "Handler for the Paragraph Menu's APPLY button. Collects the specs from the paragraph menu and calls TEDIT.PARALOOKS to effect the change.")
(LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ))
(MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ))
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of W)))
[MAINTEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of (WINDOWPROP W 'MAINWINDOW]
(CH# (ADD1 (FGETSEL SEL CH#)))
SCRATCHSEL QUAD OFILE CH NEWLOOKS SIZE SUPER SUB LINELEAD PARALEAD DEFTAB BUTTON MARUNIT
NEXTB BUTTONDATA L1 LN R PARATYPE SPECIALX SPECIALY)
@@ -3083,16 +3114,18 @@
(FUNCTION (LAMBDA (A B)
(ILEQ (CAR A)
(CAR B])
(TEDIT.PARALOOKS MAINTEXT NEWLOOKS (GETSEL (FGETTOBJ MAINTEXT SEL)
CH#)
(GETSEL (FGETTOBJ MAINTEXT SEL)
(TEDIT.PARALOOKS MAINTEXTOBJ NEWLOOKS (GETSEL (FGETTOBJ MAINTEXTOBJ SEL)
CH#)
(GETSEL (FGETTOBJ MAINTEXTOBJ SEL)
DCH))
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'PROCESS])
(\TEDIT.SHOW.PARALOOKS
[LAMBDA (OBJ SEL W) (* ; "Edited 25-Feb-2024 23:33 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 13:52 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 25-Feb-2024 23:33 by rmk")
(* ; "Edited 20-Jul-2023 17:00 by rmk")
(* ; "Edited 6-Jun-2023 15:10 by rmk")
(* ; "Edited 18-Apr-2023 23:59 by rmk")
@@ -3109,9 +3142,9 @@
(LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ))
(CH# (ADD1 (GETSEL SEL CH#)))
BUTTON NEXTB BUTTONDATA PARALOOKS MARUNIT)
(CL:WHEN [SETQ PARALOOKS (TEDIT.GET.PARALOOKS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ]
(\SHOWSEL SEL NIL)
(CL:WHEN [SETQ PARALOOKS (TEDIT.GET.PARALOOKS (fetch (TEXTWINDOW WTEXTSTREAM)
of (WINDOWPROP W 'MAINWINDOW]
(\TEDIT.SHOWSEL SEL NIL)
(SETSEL SEL SET NIL)
[TEDIT.DEFERRED-UPDATES
TEXTOBJ (* ;
@@ -3305,7 +3338,9 @@
(DEFINEQ
(\TEDIT.SHOW.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* ; "Edited 18-Jan-2024 08:33 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:15 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 18-Jan-2024 08:33 by rmk")
(* ; "Edited 12-Nov-2023 23:40 by rmk")
(* ; "Edited 6-Nov-2023 22:33 by rmk")
(* ; "Edited 20-Jul-2023 17:00 by rmk")
@@ -3317,15 +3352,15 @@
(* ;;; "Take a document's page formatting, and display it in the menu.")
(LET* ((TEXTOBJ (GETSEL SEL SELTEXTOBJ))
(MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ))
[MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
of (WINDOWPROP W 'MAINWINDOW]
(CH# (ADD1 (GETSEL SEL CH#)))
FOLIOINFO NEWLOOKS NEXTB BUTTON PAGEID OPAGEFRAMES FIRST REST PFONT HEADING HEADINGS
PAGEPROPS STARTINGPAGE# PAPERSIZE)
(* ;; "Start by turning off the selection--and leaving it off afterward.")
(\SHOWSEL SEL NIL)
(\TEDIT.SHOWSEL SEL NIL)
(SETSEL SEL SET NIL)
(* ;; "What kind of page are we looking at the specs for?")
@@ -3338,7 +3373,7 @@
'FIRST)
(Other% Left 'LEFT)
(Other% Right 'RIGHT)
(PROGN (TEDIT.PROMPTPRINT MAINTEXT
(PROGN (TEDIT.PROMPTPRINT MAINTEXTOBJ
"First specify which kind of page you want to see." T)
NIL)))
@@ -3349,7 +3384,7 @@
(* ;; "Now replace the button values, fill-in fields, etc.")
(SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXT)
(SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXTOBJ)
TEDIT.PAGE.FRAMES))
(* ;; " LISTP is already just a list of first-recto-verso frames")
@@ -3370,7 +3405,7 @@
(T (SETQ OPAGEFRAMES NIL))))
(CL:UNLESS OPAGEFRAMES (* ;
 "If the formatting isn't in our simplified 3-way format, punt out of this.")
(TEDIT.PROMPTPRINT MAINTEXT "Format too complex to edit." T)
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Format too complex to edit." T)
(SETQ PAGEID NIL))
(SELECTQ PAGEID
(FIRST (SETQ NEWLOOKS (CAR OPAGEFRAMES)))
@@ -3508,7 +3543,8 @@
TEDIT.CHARLOOKSMENU.SPEC])
(\TEDIT.APPLY.PAGEFORMATTING
[LAMBDA (OBJ SEL W) (* ; "Edited 21-Dec-2023 12:31 by rmk")
[LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:20 by rmk")
(* ; "Edited 21-Dec-2023 12:31 by rmk")
(* ; "Edited 8-Aug-2023 00:02 by rmk")
(* ; "Edited 21-Oct-2022 18:51 by rmk")
(* ;
@@ -3517,8 +3553,8 @@
(* ;;; "Change the page formatting for this document")
(PROG ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL))
(MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'TEXTOBJ))
[MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
of (WINDOWPROP W 'MAINWINDOW]
(CH# (ADD1 (fetch (SELECTION CH#) of SEL)))
SCRATCHSEL NEXTB BUTTON OPAGEFRAMES PAGEID PX PY LEFT BOTTOM TOP RIGHT ALIGNMENT PAGENOS
COLS COLWIDTH INTERCOL PFONT NPAGEFORMAT HEADINGTYPE HEADINGX HEADINGY HEADINGS
@@ -3535,7 +3571,7 @@
(SETQ PAGEID 'FIRST))
(Other% Left (SETQ PAGEID 'LEFT))
(Other% Right (SETQ PAGEID 'RIGHT))
(PROGN (TEDIT.PROMPTPRINT MAINTEXT "Set KIND OF PAGE before APPLYing." T)
(PROGN (TEDIT.PROMPTPRINT MAINTEXTOBJ "Set KIND OF PAGE before APPLYing." T)
(RETURN))) (* ; "Find which page, for later.")
(SETQ STARTINGPAGE# (AND (EQ PAGEID 'FIRST)
(MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#)))
@@ -3565,10 +3601,10 @@
 "If he wants page numbers, make sure he said WHERE to put them.")
(COND
((AND PX PY))
(T (TEDIT.PROMPTPRINT MAINTEXT
(T (TEDIT.PROMPTPRINT MAINTEXTOBJ
"Please set the X and Y location for page numbers before APPLYing."
T)
(TEDIT.PROMPTFLASH MAINTEXT)
(TEDIT.PROMPTFLASH MAINTEXTOBJ)
(RETURN]
[SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]
(* ;
@@ -3606,8 +3642,8 @@
of SCRATCHSEL]
(CL:UNLESS [SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#)
of SCRATCHSEL]
(TEDIT.PROMPTPRINT MAINTEXT "Please specify how many columns there should be." T)
(TEDIT.PROMPTFLASH MAINTEXT))
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify how many columns there should be." T)
(TEDIT.PROMPTFLASH MAINTEXTOBJ))
[SETQ COLWIDTH (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#)
of SCRATCHSEL]
[SETQ INTERCOL (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#)
@@ -3625,11 +3661,12 @@
TEXTOBJ
(ADD1 (fetch (SELECTION CH#) of SCRATCHSEL])
collect (CL:UNLESS (AND HEADINGX HEADINGY)
(TEDIT.PROMPTPRINT MAINTEXT (CONCAT "You need to say WHERE "
HEADINGTYPE
" headings go.")
(TEDIT.PROMPTPRINT MAINTEXTOBJ (CONCAT
"You need to say WHERE "
HEADINGTYPE
" headings go.")
T)
(TEDIT.PROMPTFLASH MAINTEXT)
(TEDIT.PROMPTFLASH MAINTEXTOBJ)
(SETQ HEADINGINVALID T))
(LIST HEADINGTYPE HEADINGX HEADINGY)))
(CL:WHEN HEADINGINVALID (* ; "Headings invalid.")
@@ -3650,7 +3687,7 @@
ALIGNMENT)
LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS 'PICAS
PAGEOPTIONS PAPERSIZE))
(SETQ OPAGEFRAMES (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXT))
(SETQ OPAGEFRAMES (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXTOBJ))
(CL:UNLESS (LISTP OPAGEFRAMES)
[COND
((EQ PAGEID 'FIRST) (* ;
@@ -3674,7 +3711,7 @@
(RIGHT (RPLACA (CDDR OPAGEFRAMES)
NPAGEFORMAT))
NIL)
(TEDIT.PAGEFORMAT MAINTEXT OPAGEFRAMES)
(TEDIT.PAGEFORMAT MAINTEXTOBJ OPAGEFRAMES)
(TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW)
'PROCESS])
@@ -4276,41 +4313,41 @@ Tab Type: "
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10426 33961 (MB.BUTTONEVENTINFN 10436 . 11658) (MB.DISPLAY 11660 . 13617) (MB.SETIMAGE
13619 . 14573) (MB.SELFN 14575 . 16197) (MB.SIZEFN 16199 . 17177) (MB.WHENOPERATEDFN 17179 . 17507) (
MB.COPYFN 17509 . 17967) (MB.GETFN 17969 . 18707) (MB.PUTFN 18709 . 19586) (MB.SHOWSELFN 19588 . 20514
) (MBUTTON.CREATE 20516 . 21748) (MBUTTON.CHANGENAME 21750 . 22129) (MBUTTON.FIND.BUTTON 22131 . 23039
) (MBUTTON.FIND.NEXT.BUTTON 23041 . 24263) (MBUTTON.FIND.NEXT.FIELD 24265 . 26678) (MBUTTON.INIT 26680
. 27596) (MBUTTON.NEXT.FIELD.AS.NUMBER 27598 . 28530) (MBUTTON.NEXT.FIELD.AS.TEXT 28532 . 28958) (
MBUTTON.NEXT.FIELD.AS.ATOM 28960 . 29761) (MBUTTON.SET.FIELD 29763 . 31739) (MBUTTON.SET.NEXT.FIELD
31741 . 33023) (MBUTTON.SET.NEXT.BUTTON.STATE 33025 . 33505) (TEDITMENU.STREAM 33507 . 33959)) (34265
44801 (MB.CREATE.THREESTATEBUTTON 34275 . 35442) (MB.THREESTATE.DISPLAY 35444 . 38150) (
MB.THREESTATE.SHOWSELFN 38152 . 41075) (MB.THREESTATE.WHENOPERATEDFN 41077 . 42418) (
MB.THREESTATEBUTTON.FN 42420 . 43739) (THREESTATE.INIT 43741 . 44799)) (44902 64684 (
MB.CREATE.NWAYBUTTON 44912 . 48981) (MB.NB.DISPLAYFN 48983 . 51251) (MB.NB.WHENOPERATEDFN 51253 .
52401) (MB.NB.SIZEFN 52403 . 56031) (MB.NWAYBUTTON.SELFN 56033 . 58141) (MB.NWAYMENU.NEWBUTTON 58143
. 58730) (NWAYBUTTON.INIT 58732 . 59581) (MB.NB.PACKITEMS 59583 . 61562) (MB.NWAYBUTTON.ADDITEM 61564
. 64682)) (64938 73856 (\TEXTMENU.TOGGLE.CREATE 64948 . 66438) (\TEXTMENU.TOGGLE.DISPLAY 66440 .
68873) (\TEXTMENU.TOGGLE.SHOWSELFN 68875 . 69475) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69477 . 70827) (
\TEXTMENU.TOGGLEFN 70829 . 72028) (\TEXTMENU.TOGGLE.INIT 72030 . 72861) (\TEXTMENU.SET.TOGGLE 72863 .
73854)) (74108 110302 (DRAWMARGINSCALE 74118 . 77577) (MARGINBAR 77579 . 84440) (MARGINBAR.CREATE
84442 . 87314) (MB.MARGINBAR.SELFN 87316 . 99332) (MB.MARGINBAR.SIZEFN 99334 . 99692) (
MB.MARGINBAR.DISPLAYFN 99694 . 102496) (MDESCALE 102498 . 103038) (MSCALE 103040 . 103370) (
MB.MARGINBAR.SHOWTAB 103372 . 105695) (MB.MARGINBAR.TABTRACK 105697 . 107082) (\TEDIT.TABTYPE.SET
107084 . 109415) (MARGINBAR.INIT 109417 . 110300)) (111319 126430 (\TEDIT.MENU.START 111329 . 116449)
(\TEDIT.MENU.BUTTONEVENTFN 116451 . 116935) (\TEXTMENU.DOC.CREATE 116937 . 126428)) (126740 146446 (
\TEDITMENU.CREATE 126750 . 127046) (\TEDIT.EXPANDED.MENU 127048 . 128129) (MB.DEFAULTBUTTON.FN 128131
. 131352) (\TEDITMENU.RECORD.UNFORMATTED 131354 . 131687) (MB.DEFAULTBUTTON.ACTIONFN 131689 . 146444)
) (146447 174728 (\TEDIT.CHARLOOKSMENU.CREATE 146457 . 148671) (\TEDIT.EXPANDEDCHARLOOKS.MENU 148673
. 149383) (\TEDIT.APPLY.BOLDNESS 149385 . 149666) (\TEDIT.APPLY.CHARLOOKS 149668 . 151464) (
\TEDIT.APPLY.OLINE 151466 . 151743) (\TEDIT.APPLY.UNBREAKABLE 151745 . 152143) (\TEDIT.SHOW.CHARLOOKS
152145 . 154454) (\TEDIT.NEUTRALIZE.CHARLOOKS 154456 . 155604) (\TEDIT.FILL.IN.CHARLOOKS.MENU 155606
. 163010) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 163012 . 165585) (\TEDIT.PARSE.CHARLOOKS.MENU 165587 .
173879) (\TEDIT.APPLY.SLOPE 173881 . 174160) (\TEDIT.APPLY.STRIKEOUT 174162 . 174445) (
\TEDIT.APPLY.ULINE 174447 . 174726)) (174729 200589 (\TEDITPARAMENU.CREATE 174739 . 175115) (
\TEDIT.EXPANDEDPARA.MENU 175117 . 175679) (\TEDIT.APPLY.PARALOOKS 175681 . 186019) (
\TEDIT.SHOW.PARALOOKS 186021 . 193628) (\TEDIT.NEUTRALIZE.PARALOOKS.MENU 193630 . 199276) (
\TEDIT.RECORD.TABLEADERS 199278 . 200587)) (200590 235299 (\TEDIT.SHOW.PAGEFORMATTING 200600 . 213890)
(\TEDITPAGEMENU.CREATE 213892 . 214931) (\TEDIT.APPLY.PAGEFORMATTING 214933 . 226704) (
TEDIT.UNPARSE.PAGEFORMAT 226706 . 235297)) (235604 263398 (\TEDIT.MENU.INIT 235614 . 263396)))))
(FILEMAP (NIL (10613 35178 (MB.BUTTONEVENTINFN 10623 . 11845) (MB.DISPLAY 11847 . 13804) (MB.SETIMAGE
13806 . 14760) (MB.SELFN 14762 . 16505) (MB.SIZEFN 16507 . 17485) (MB.WHENOPERATEDFN 17487 . 17921) (
MB.COPYFN 17923 . 18381) (MB.GETFN 18383 . 19121) (MB.PUTFN 19123 . 20000) (MB.SHOWSELFN 20002 . 21035
) (MBUTTON.CREATE 21037 . 22269) (MBUTTON.CHANGENAME 22271 . 22650) (MBUTTON.FIND.BUTTON 22652 . 23675
) (MBUTTON.FIND.NEXT.BUTTON 23677 . 25020) (MBUTTON.FIND.NEXT.FIELD 25022 . 27556) (MBUTTON.INIT 27558
. 28474) (MBUTTON.NEXT.FIELD.AS.NUMBER 28476 . 29408) (MBUTTON.NEXT.FIELD.AS.TEXT 29410 . 29836) (
MBUTTON.NEXT.FIELD.AS.ATOM 29838 . 30639) (MBUTTON.SET.FIELD 30641 . 32847) (MBUTTON.SET.NEXT.FIELD
32849 . 34240) (MBUTTON.SET.NEXT.BUTTON.STATE 34242 . 34722) (TEDITMENU.STREAM 34724 . 35176)) (35482
46018 (MB.CREATE.THREESTATEBUTTON 35492 . 36659) (MB.THREESTATE.DISPLAY 36661 . 39367) (
MB.THREESTATE.SHOWSELFN 39369 . 42292) (MB.THREESTATE.WHENOPERATEDFN 42294 . 43635) (
MB.THREESTATEBUTTON.FN 43637 . 44956) (THREESTATE.INIT 44958 . 46016)) (46119 65901 (
MB.CREATE.NWAYBUTTON 46129 . 50198) (MB.NB.DISPLAYFN 50200 . 52468) (MB.NB.WHENOPERATEDFN 52470 .
53618) (MB.NB.SIZEFN 53620 . 57248) (MB.NWAYBUTTON.SELFN 57250 . 59358) (MB.NWAYMENU.NEWBUTTON 59360
. 59947) (NWAYBUTTON.INIT 59949 . 60798) (MB.NB.PACKITEMS 60800 . 62779) (MB.NWAYBUTTON.ADDITEM 62781
. 65899)) (66155 75073 (\TEXTMENU.TOGGLE.CREATE 66165 . 67655) (\TEXTMENU.TOGGLE.DISPLAY 67657 .
70090) (\TEXTMENU.TOGGLE.SHOWSELFN 70092 . 70692) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 70694 . 72044) (
\TEXTMENU.TOGGLEFN 72046 . 73245) (\TEXTMENU.TOGGLE.INIT 73247 . 74078) (\TEXTMENU.SET.TOGGLE 74080 .
75071)) (75325 111634 (DRAWMARGINSCALE 75335 . 78794) (MARGINBAR 78796 . 85657) (MARGINBAR.CREATE
85659 . 88531) (MB.MARGINBAR.SELFN 88533 . 100549) (MB.MARGINBAR.SIZEFN 100551 . 100909) (
MB.MARGINBAR.DISPLAYFN 100911 . 103713) (MDESCALE 103715 . 104255) (MSCALE 104257 . 104587) (
MB.MARGINBAR.SHOWTAB 104589 . 106912) (MB.MARGINBAR.TABTRACK 106914 . 108299) (\TEDIT.TABTYPE.SET
108301 . 110747) (MARGINBAR.INIT 110749 . 111632)) (112651 127762 (\TEDIT.MENU.START 112661 . 117781)
(\TEDIT.MENU.BUTTONEVENTFN 117783 . 118267) (\TEXTMENU.DOC.CREATE 118269 . 127760)) (128072 148897 (
\TEDITMENU.CREATE 128082 . 128378) (\TEDIT.EXPANDED.MENU 128380 . 129461) (MB.DEFAULTBUTTON.FN 129463
. 132929) (\TEDITMENU.RECORD.UNFORMATTED 132931 . 133264) (MB.DEFAULTBUTTON.ACTIONFN 133266 . 148895)
) (148898 178297 (\TEDIT.CHARLOOKSMENU.CREATE 148908 . 151122) (\TEDIT.EXPANDEDCHARLOOKS.MENU 151124
. 151834) (\TEDIT.APPLY.BOLDNESS 151836 . 152117) (\TEDIT.APPLY.CHARLOOKS 152119 . 154225) (
\TEDIT.APPLY.OLINE 154227 . 154504) (\TEDIT.APPLY.UNBREAKABLE 154506 . 154904) (\TEDIT.SHOW.CHARLOOKS
154906 . 157690) (\TEDIT.NEUTRALIZE.CHARLOOKS 157692 . 158956) (\TEDIT.FILL.IN.CHARLOOKS.MENU 158958
. 166579) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166581 . 169154) (\TEDIT.PARSE.CHARLOOKS.MENU 169156 .
177448) (\TEDIT.APPLY.SLOPE 177450 . 177729) (\TEDIT.APPLY.STRIKEOUT 177731 . 178014) (
\TEDIT.APPLY.ULINE 178016 . 178295)) (178298 204777 (\TEDITPARAMENU.CREATE 178308 . 178684) (
\TEDIT.EXPANDEDPARA.MENU 178686 . 179248) (\TEDIT.APPLY.PARALOOKS 179250 . 189966) (
\TEDIT.SHOW.PARALOOKS 189968 . 197816) (\TEDIT.NEUTRALIZE.PARALOOKS.MENU 197818 . 203464) (
\TEDIT.RECORD.TABLEADERS 203466 . 204775)) (204778 240124 (\TEDIT.SHOW.PAGEFORMATTING 204788 . 218403)
(\TEDITPAGEMENU.CREATE 218405 . 219444) (\TEDIT.APPLY.PAGEFORMATTING 219446 . 231529) (
TEDIT.UNPARSE.PAGEFORMAT 231531 . 240122)) (240429 268223 (\TEDIT.MENU.INIT 240439 . 268221)))))
STOP

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

Binary file not shown.

70
library/tedit/TEDIT-OLDFILE
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Jan-2024 10:27:59" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;6 72571
(FILECREATED "20-Mar-2024 11:06:42" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;11 73247
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.GET.PCTB0 \TEDIT.GET.PCTB2 \TEDIT.GET.CHARLOOKS2 \TEDIT.GET.PCTB1
\TEDIT.GET.CHARLOOKS1 TEDIT.GET.CHARLOOKS0)
:CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1)
:PREVIOUS-DATE "16-Jan-2024 23:03:47" {WMEDLEY}<library>TEDIT>TEDIT-OLDFILE.;4)
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;10)
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -33,7 +32,7 @@
(COMS
(* ;; "VERSION 0 Compatibility reading functions")
(FNS TEDIT.GET.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0))))
(FNS \TEDIT.GET.PCTB0 \TEDIT.GET.CHARLOOKS0 \TEDIT.GET.OBJECT0 \TEDIT.GET.PARALOOKS0))))
@@ -47,7 +46,10 @@
(DEFINEQ
(\TEDIT.GET.PCTB2
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:21 by rmk")
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 15-Mar-2024 14:37 by rmk")
(* ; "Edited 21-Jan-2024 10:21 by rmk")
(* ; "Edited 13-Jan-2024 12:09 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:18 by rmk")
@@ -63,7 +65,7 @@
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(LET (PIECEINFOCH# (CURFILECH# (OR START 0))
LOOKSHASH PARAHASH)
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
@@ -165,7 +167,7 @@
PPARALOOKS _ OLDPARALOOKS
PTYPE _ OBJECT.PTYPE
PBYTESPERCHAR _ PCLEN))
(TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT)
(\TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT)
PC TEXT CURFILECH# PCLEN)
(add CURFILECH# PCLEN)
(FSETPC PC PLOOKS (if (ZEROP (BIN TEXT))
@@ -183,7 +185,7 @@
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(CL:WHEN PC (* ;
 "If we created a piece, save it in the table.")
(\INSERTPIECE PC NIL TEXTOBJ)
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
(SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(\TEDIT.GET.PARALOOKS2
@@ -598,7 +600,9 @@
(DEFINEQ
(\TEDIT.GET.PCTB1
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:23 by rmk")
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 21-Jan-2024 10:23 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 8-Nov-2023 13:48 by rmk")
(* ; "Edited 7-Nov-2023 13:17 by rmk")
@@ -615,7 +619,7 @@
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0)))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
@@ -687,7 +691,7 @@
DEFAULTCHARLOOKS])
(SHOULDNT "Impossible piece-type code"))
(CL:WHEN PC
(\INSERTPIECE PC NIL TEXTOBJ)
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
(SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(\TEDIT.GET.PAGEFRAMES1
@@ -898,8 +902,10 @@
(DEFINEQ
(TEDIT.GET.PCTB0
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:27 by rmk")
(\TEDIT.GET.PCTB0
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 15-Mar-2024 14:47 by rmk")
(* ; "Edited 21-Jan-2024 10:27 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 27-Oct-2023 13:47 by rmk")
(* ; "Edited 3-Aug-2023 22:09 by rmk")
@@ -934,29 +940,29 @@
(SETQ TYPECODE (\WIN TEXT))
(SELECTC TYPECODE
(\PieceDescriptorLOOKS
(TEDIT.GET.CHARLOOKS0 PC TEXT)
(\TEDIT.GET.CHARLOOKS0 PC TEXT)
(add CURFILECH# (PLEN PC)))
(\PieceDescriptorOBJECT
(TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT))
(\TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT))
PC TEXT CURFILECH#)
(add CURFILECH# (PLEN PC)) (* ;
 "Only object--can't be followed by either of the others.")
(FSETPC PC PLEN 1))
(\PieceDescriptorPARA
(AND OLDPC (FSETPC OLDPC PPARALAST T))
(TEDIT.GET.PARALOOKS0 PC TEXT)
(\TEDIT.GET.PARALOOKS0 PC TEXT)
(FSETPC PC PLEN (\DWIN TEXT)) (* ;
 "Set this piece's length from the character looks.")
(\WIN TEXT) (* ;
 "Skip the piece-type code, since we know what's next")
(TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .")
(\TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .")
(add CURFILECH# (PLEN PC))
(AND TEXTOBJ (FSETTOBJ TEXTOBJ FORMATTEDP T)))
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(SETQ OLDPC PC)
(\INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(TEDIT.GET.CHARLOOKS0
(\TEDIT.GET.CHARLOOKS0
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 23:03 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
@@ -1020,7 +1026,7 @@
of LOOKS)
'ITALIC])
(TEDIT.GET.OBJECT0
(\TEDIT.GET.OBJECT0
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 6-Aug-2022 15:57 by rmk")
(* ; "Edited 12-Jun-90 18:17 by mitani")
@@ -1050,7 +1056,7 @@
TEXTOBJ]
OBJ])
(TEDIT.GET.PARALOOKS0
(\TEDIT.GET.PARALOOKS0
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:57 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 3-Mar-2023 23:14 by rmk")
@@ -1102,14 +1108,14 @@
(RPLACD TABSPEC TABS])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1765 38438 (\TEDIT.GET.PCTB2 1775 . 11514) (\TEDIT.GET.PARALOOKS2 11516 . 12105) (
\TEDIT.GET.CHARLOOKS2 12107 . 13438) (\TEDIT.PARSE.PAGEFRAMES2 13440 . 16179) (
\TEDIT.GET.CHARLOOKS.LIST2 16181 . 16688) (\TEDIT.GET.SINGLE.CHARLOOKS2 16690 . 20407) (
\TEDIT.PUT.SINGLE.PARALOOKS2 20409 . 25160) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25162 . 29636) (
\TEDIT.GET.PARALOOKS.LIST2 29638 . 30145) (\TEDIT.GET.SINGLE.PARALOOKS2 30147 . 35156) (
\TEDIT.PUT.CHARLOOKS.LIST2 35158 . 37237) (\TEDIT.PUT.PARALOOKS.LIST2 37239 . 38436)) (38515 58558 (
\TEDIT.GET.PCTB1 38525 . 44772) (\TEDIT.GET.PAGEFRAMES1 44774 . 45226) (\TEDIT.PARSE.PAGEFRAMES1 45228
. 47604) (\TEDIT.GET.CHARLOOKS1 47606 . 51978) (\TEDIT.GET.PARALOOKS1 51980 . 57012) (
TEDIT.GET.OBJECT1 57014 . 58556)) (58618 72548 (TEDIT.GET.PCTB0 58628 . 62135) (TEDIT.GET.CHARLOOKS0
62137 . 66723) (TEDIT.GET.OBJECT0 66725 . 68674) (TEDIT.GET.PARALOOKS0 68676 . 72546)))))
(FILEMAP (NIL (1666 38666 (\TEDIT.GET.PCTB2 1676 . 11742) (\TEDIT.GET.PARALOOKS2 11744 . 12333) (
\TEDIT.GET.CHARLOOKS2 12335 . 13666) (\TEDIT.PARSE.PAGEFRAMES2 13668 . 16407) (
\TEDIT.GET.CHARLOOKS.LIST2 16409 . 16916) (\TEDIT.GET.SINGLE.CHARLOOKS2 16918 . 20635) (
\TEDIT.PUT.SINGLE.PARALOOKS2 20637 . 25388) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25390 . 29864) (
\TEDIT.GET.PARALOOKS.LIST2 29866 . 30373) (\TEDIT.GET.SINGLE.PARALOOKS2 30375 . 35384) (
\TEDIT.PUT.CHARLOOKS.LIST2 35386 . 37465) (\TEDIT.PUT.PARALOOKS.LIST2 37467 . 38664)) (38743 59003 (
\TEDIT.GET.PCTB1 38753 . 45217) (\TEDIT.GET.PAGEFRAMES1 45219 . 45671) (\TEDIT.PARSE.PAGEFRAMES1 45673
. 48049) (\TEDIT.GET.CHARLOOKS1 48051 . 52423) (\TEDIT.GET.PARALOOKS1 52425 . 57457) (
TEDIT.GET.OBJECT1 57459 . 59001)) (59063 73224 (\TEDIT.GET.PCTB0 59073 . 62808) (\TEDIT.GET.CHARLOOKS0
62810 . 67397) (\TEDIT.GET.OBJECT0 67399 . 69349) (\TEDIT.GET.PARALOOKS0 69351 . 73222)))))
STOP

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

Binary file not shown.

189
library/tedit/TEDIT-PAGE
View File

@@ -1,14 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Mar-2024 17:12:34" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;163 112427
(FILECREATED "17-Mar-2024 18:15:40" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;173 113461
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.FORMATBOX \TEDIT.FORMAT.FOOTNOTE)
(RECORDS PAGEFORMATTINGSTATE PAGEREGION)
(MACROS GETPFS SETPFS)
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY TEDIT.SKIP.SPECIALCOND \TEDIT.FORMATBOX
\TEDIT.FORMATHEADING \TEDIT.FORMATFOLIO)
:PREVIOUS-DATE "13-Mar-2024 10:28:14" {WMEDLEY}<library>tedit>TEDIT-PAGE.;157)
:PREVIOUS-DATE "17-Mar-2024 00:27:48"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;172)
(PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -50,12 +51,12 @@
(* ;; "Public functions for setting up page layouts")
(FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT))
(FNS TEDIT.FORMAT.HARDCOPY TEDIT.SKIP.SPECIALCOND)
(COMS
(* ;; "Perform page layout, based on a regular expression of typed regions.")
(FNS TEDIT.FORMAT.HARDCOPY TEDIT.FORMATBOX TEDIT.FORMATHEADING TEDIT.FORMATPAGE
TEDIT.FORMATTEXTBOX TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX?
TEDIT.SKIP.SPECIALCOND)
(FNS \TEDIT.FORMATBOX \TEDIT.FORMATHEADING \TEDIT.FORMATPAGE \TEDIT.FORMATTEXTBOX
\TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX?)
(* ;; "Aux function to capture page headings during line formatting:")
@@ -552,16 +553,12 @@
(SETTOBJ TEXTOBJ \DIRTY T)
STREAM])
)
(* ;; "Perform page layout, based on a regular expression of typed regions.")
(DEFINEQ
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
ENDPG) (* ; "Edited 7-Mar-2024 12:34 by rmk")
ENDPG) (* ; "Edited 16-Mar-2024 09:31 by rmk")
(* ; "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")
@@ -662,7 +659,7 @@
do
(* ;; "Format pages according to the existing layout:")
(for PAGEREGION inside PAGEFRAMES do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM
(for PAGEREGION inside PAGEFRAMES do (\TEDIT.FORMATBOX TEXTOBJ PRSTREAM
(GETPFS FORMATTINGSTATE CHNO)
PAGEREGION FORMATTINGSTATE
IMAGETYPE))
@@ -705,7 +702,43 @@
T)
(RETURN NPAGES)))])
(TEDIT.FORMATBOX
(TEDIT.SKIP.SPECIALCOND
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 5-Jul-2023 14:19 by rmk")
(* ; "Edited 15-May-2023 22:36 by rmk")
(* ; "Edited 16-Feb-2023 00:08 by rmk")
(* ;
 "Edited 25-May-93 13:44 by sybalsky:mv:envos")
(* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). This is done by setting LINE:LCHARLIM to the last character of the heading so it will move the document ahead to the next real text.")
(SETLD LINE LMARK 'SPECIAL)
(SETLD LINE 1STLN T)
(SETLD LINE LSTLN T)
(SETLD LINE LHEIGHT 0)
(SETLD LINE ASCENT 0)
(SETLD LINE DESCENT 0)
(SETLD LINE LTRUEASCENT 0)
(SETLD LINE LTRUEDESCENT 0)
(SETLD LINE LCHARLIM (SUB1 (IPLUS CHNO (for PC (HEADINGTYPE _ (fetch (FMTSPEC FMTPARASUBTYPE)
of PARALOOKS))
inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM)
while [AND (EQ 'PAGEHEADING (fetch (FMTSPEC FMTPARATYPE
)
of (PPARALOOKS PC)))
(EQ HEADINGTYPE (fetch (FMTSPEC
FMTPARASUBTYPE
)
of (PPARALOOKS PC]
sum (PLEN PC])
)
(* ;; "Perform page layout, based on a regular expression of typed regions.")
(DEFINEQ
(\TEDIT.FORMATBOX
[LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)
(* ; "Edited 13-Mar-2024 17:09 by rmk")
(* ; "Edited 20-Jan-2024 12:16 by rmk")
@@ -728,20 +761,20 @@
(* ;
 "Only format if we're not looking for something else.")
(TEDIT.SETQS (LINES NIL LAST-CHNO)
(TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION
(\TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION
FORMATTINGSTATE))))
(FOLIO (* ;
 "A Page Number. Fill it in according to the instructions")
(CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(* ;
 "Only format if we're not looking for something else.")
(SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION))))
(SETQ LINES (\TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION))))
(HEADING (* ;
 "A Page heading. Fill it in from a text source we saved for the occasion.")
(CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(* ;
 "Only format if we're not looking for something else.")
(SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE
(SETQ LINES (\TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE
PAGEREGION))))
(PAGE
(* ;; "This box is really a PAGE FRAME, no lines here. Fill it in and do whatever other processing is needful for end of page.")
@@ -749,7 +782,7 @@
(\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(* ;
 "So that if this is the box he's looking for, we'll spot it and stop searching")
(TEDIT.FORMATPAGE TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE))
(\TEDIT.FORMATPAGE TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE))
((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT)
(* ;
 "This box is really a list of boxes. Fill them.")
@@ -783,7 +816,7 @@
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _ SUBREGIONSPEC
)
FORMATTINGSTATE)))
@@ -811,9 +844,9 @@
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS
FORMATTINGSTATE
CHNO)
CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _
SUBREGIONSPEC)
FORMATTINGSTATE))))
@@ -861,8 +894,10 @@
 "Otherwise, use the new char no if we computed one.")
(SETPFS FORMATTINGSTATE CHNO CHNO])
(TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk")
(\TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 17-Mar-2024 00:24 by rmk")
(* ; "Edited 15-Mar-2024 19:23 by rmk")
(* ; "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")
@@ -890,8 +925,8 @@
(* ;; "Insert the heading pieces into HEADINGTEXTOBJ")
(\INSERTPIECES (fetch (SELPIECES SPFIRST) of HEADING)
(\ALIGNEDPIECE 1 HEADINGTEXTOBJ)
(\TEDIT.INSERTPIECES (fetch (SELPIECES SPFIRST) of HEADING)
(\TEDIT.ALIGNEDPIECE 1 HEADINGTEXTOBJ)
HEADINGTEXTOBJ)
(* ;; "")
@@ -905,8 +940,8 @@
(* ;; "Format the next line from HEADINGTEXTOBJ pieces")
(SETQ LINE (\FORMATLINE HEADINGTEXTOBJ CHNO NIL REGION PRSTREAM FORMATTINGSTATE
))
(SETQ LINE (\TEDIT.FORMATLINE HEADINGTEXTOBJ CHNO NIL REGION PRSTREAM
FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
(GETLD LINE FORCED-END)))
[SETQ YBOT (COND
@@ -921,8 +956,9 @@
(* ; "Set the start of the next line")
LINE))])
(TEDIT.FORMATPAGE
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 10:28 by rmk")
(\TEDIT.FORMATPAGE
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 17-Mar-2024 00:24 by rmk")
(* ; "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")
@@ -961,7 +997,7 @@
 "Print in the usual region on the page")
(CL:UNLESS (ILEQ CHNO TEXTLEN)
(RETURN))
(SETQ PC (\ALIGNEDPIECE CHNO TEXTOBJ))
(SETQ PC (\TEDIT.ALIGNEDPIECE CHNO TEXTOBJ))
(SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
PC TEXTOBJ)) (* ;
 "RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?")
@@ -1015,8 +1051,8 @@
(* ;;
 "Now format the subregions of the page. The CHNO field may be updated by each call.")
(TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE
CHNO)
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE
CHNO)
SUBREGION FORMATTINGSTATE))
(* ;; "")
@@ -1056,8 +1092,9 @@
(add (GETPFS FORMATTINGSTATE PAGECOUNT)
1])
(TEDIT.FORMATTEXTBOX
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:37 by rmk")
(\TEDIT.FORMATTEXTBOX
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 15-Mar-2024 19:24 by rmk")
(* ; "Edited 19-Jan-2024 23:37 by rmk")
(* ; "Edited 4-Dec-2023 12:34 by rmk")
(* ; "Edited 4-Jul-2023 08:02 by rmk")
(* ; "Edited 2-Jul-2023 20:49 by rmk")
@@ -1118,7 +1155,7 @@
(SETQ LINE (pop (GETPFS FORMATTINGSTATE PAGELINECACHE)))
(* ;
 "Format the line, noting any form-feeds")
(SETQ LINE (\FORMATLINE TEXTOBJ CHNO LINE REGION PRSTREAM FORMATTINGSTATE))
(SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO LINE REGION PRSTREAM FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (AND (EQ (CHARCODE FORM)
(FGETLD LINE FORCED-END))
'USERBREAK))
@@ -1279,8 +1316,9 @@
(TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION TEXTOBJ
FORMATTINGSTATE FINAL-CHNO)))])
(TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 13-Mar-2024 09:00 by rmk")
(\TEDIT.FORMATFOLIO
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 15-Mar-2024 19:24 by rmk")
(* ; "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")
@@ -1325,8 +1363,8 @@
(bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ))
(BOTTOM _ (fetch (REGION BOTTOM) of REGION))
(CHNO _ 1) while (ILEQ CHNO TEXTLEN) until FORCENEXTPAGE
collect (SETQ LINE (\FORMATLINE FOLIOTEXTOBJ CHNO NIL REGION PRSTREAM FORMATTINGSTATE
))
collect (SETQ LINE (\TEDIT.FORMATLINE FOLIOTEXTOBJ CHNO NIL REGION PRSTREAM
FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (EQ (CHARCODE FORM)
(GETLD LINE FORCED-END)))
(* ; "Format the next possible line")
@@ -1375,35 +1413,6 @@
 "We've formatted enough pages up to now.")
(SETPFS FORMATTINGSTATE STATE 'FORMATTING)))
T])
(TEDIT.SKIP.SPECIALCOND
[LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 5-Jul-2023 14:19 by rmk")
(* ; "Edited 15-May-2023 22:36 by rmk")
(* ; "Edited 16-Feb-2023 00:08 by rmk")
(* ;
 "Edited 25-May-93 13:44 by sybalsky:mv:envos")
(* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). This is done by setting LINE:LCHARLIM to the last character of the heading so it will move the document ahead to the next real text.")
(SETLD LINE LMARK 'SPECIAL)
(SETLD LINE 1STLN T)
(SETLD LINE LSTLN T)
(SETLD LINE LHEIGHT 0)
(SETLD LINE ASCENT 0)
(SETLD LINE DESCENT 0)
(SETLD LINE LTRUEASCENT 0)
(SETLD LINE LTRUEDESCENT 0)
(SETLD LINE LCHARLIM (SUB1 (IPLUS CHNO (for PC (HEADINGTYPE _ (fetch (FMTSPEC FMTPARASUBTYPE)
of PARALOOKS))
inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM)
while [AND (EQ 'PAGEHEADING (fetch (FMTSPEC FMTPARATYPE
)
of (PPARALOOKS PC)))
(EQ HEADINGTYPE (fetch (FMTSPEC
FMTPARASUBTYPE
)
of (PPARALOOKS PC]
sum (PLEN PC])
)
@@ -1413,7 +1422,9 @@
(DEFINEQ
(TEDIT.HARDCOPY.PAGEHEADINGS
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 9-May-2023 17:46 by rmk")
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 9-May-2023 17:46 by rmk")
(* ; "Edited 7-May-2023 23:45 by rmk")
(* ; "Edited 9-Oct-2022 17:12 by rmk")
@@ -1422,9 +1433,8 @@
(CL:UNLESS FORMATTINGSTATE (* ;
 "If it isn't there, we would loose the headings")
(SHOULDNT "NIL FORMATTINGSTATE"))
(bind HEADINGSUBTYPE (PC _ (\CHTOPC CHNO TEXTOBJ)) while [AND PC (EQ 'PAGEHEADING
(fetch FMTPARATYPE
of (PPARALOOKS PC]
(bind HEADINGSUBTYPE (PC _ (\TEDIT.CHTOPC CHNO TEXTOBJ))
while [AND PC (EQ 'PAGEHEADING (fetch FMTPARATYPE of (PPARALOOKS PC]
do (SETQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE of (PPARALOOKS PC)))
(for P (START _ CHNO) inpieces PC while [AND (EQ 'PAGEHEADING (fetch FMTPARATYPE
of (PPARALOOKS P)))
@@ -1435,8 +1445,9 @@
(add CHNO (PLEN P)) finally (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
HEADINGSUBTYPE
(\SELPIECES.COPY (\SELPIECES START CHNO TEXTOBJ)))
(\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES START
CHNO TEXTOBJ)))
(* ;;
 "Set PC to continue looking for the next headingtype.")
@@ -1761,7 +1772,8 @@
(DEFINEQ
(\TEDIT.FORMAT.FOOTNOTE
[LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 13-Mar-2024 17:00 by rmk")
[LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 15-Mar-2024 19:24 by rmk")
(* ; "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")
@@ -1779,7 +1791,7 @@
(* ;; "Grab a line descriptor from the formatting list, or create a new one.")
(SETQ LINE (\FORMATLINE TEXTOBJ CHNO (GETPFS FORMATTINGSTATE PAGELINECACHE)
(SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO (GETPFS FORMATTINGSTATE PAGELINECACHE)
REGION PRSTREAM FORMATTINGSTATE))
(* ;
 "Format the line, noting any form-feeds")
@@ -1795,14 +1807,15 @@
(RETURN (DREMOVE NIL $$VAL])
)
(DECLARE%: DONTCOPY
(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)))))
(FILEMAP (NIL (12106 15439 (\TEDIT.PARSE.PAGEFRAMES 12116 . 13616) (\TEDIT.PUT.PAGEFRAMES 13618 .
14442) (\TEDIT.UNPARSE.PAGEFRAMES 14444 . 15437)) (15502 31964 (TEDIT.SINGLE.PAGEFORMAT 15512 . 25730)
(TEDIT.COMPOUND.PAGEFORMAT 25732 . 26711) (TEDIT.PAGEFORMAT 26713 . 31962)) (31965 45142 (
TEDIT.FORMAT.HARDCOPY 31975 . 43075) (TEDIT.SKIP.SPECIALCOND 43077 . 45140)) (45229 92152 (
\TEDIT.FORMATBOX 45239 . 58019) (\TEDIT.FORMATHEADING 58021 . 62041) (\TEDIT.FORMATPAGE 62043 . 70463)
(\TEDIT.FORMATTEXTBOX 70465 . 85364) (\TEDIT.FORMATFOLIO 85366 . 90109) (\TEDIT.FORMAT.FOUNDBOX?
90111 . 92150)) (92232 94648 (TEDIT.HARDCOPY.PAGEHEADINGS 92242 . 94646)) (94757 101940 (
TEDIT.HARDCOPY-COLUMN-END 94767 . 101938)) (101985 106926 (SCALEPAGEUNITS 101995 . 103136) (
SCALEPAGEXUNITS 103138 . 103908) (SCALEPAGEYUNITS 103910 . 104681) (\TEDIT.PAPERHEIGHT 104683 . 105618
) (\TEDIT.PAPERWIDTH 105620 . 106924)) (107342 110910 (ROMANNUMERALS 107352 . 110908)) (110946 113438
(\TEDIT.FORMAT.FOOTNOTE 110956 . 113436)))))
STOP

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

Binary file not shown.

280
library/tedit/TEDIT-PCTREE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;219 65397
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239 66617
:EDIT-BY rmk
:CHANGES-TO (FNS \DELETEPIECES)
:CHANGES-TO (FNS \TEDIT.INSERTPIECES)
:PREVIOUS-DATE " 3-Mar-2024 08:59:45" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;218)
:PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -33,11 +33,13 @@
(INITVARS (MULTIPLE-PIECE-TABLES T))
(* ; "Experimentation")
(GLOBALVARS MULTIPLE-PIECE-TABLES)
(FNS \MAKEPCTB \UPDATEPCNODES \FIRSTPIECE \DELETETREE \INSERTTREE \LASTPIECE \MATCHPCS
\PCTOCH \CHTOPC \TEDIT.SET-TOTLEN \MAKE.VACANT.BTREESLOT \LINKNEWPIECE \UNLINKPIECE
\SPLITPIECE \INSERTPIECE \INSERTPIECES \DELETEPIECES \ALIGNEDPIECE)
(FNS \TEDIT.MAKEPCTB \TEDIT.UPDATEPCNODES \TEDIT.FIRSTPIECE \TEDIT.DELETETREE
\TEDIT.INSERTTREE \TEDIT.LASTPIECE \TEDIT.PCTOCH \TEDIT.CHTOPC \TEDIT.SET-TOTLEN
\TEDIT.MAKE.VACANT.BTREESLOT \TEDIT.LINKNEWPIECE \TEDIT.UNLINKPIECE \TEDIT.SPLITPIECE
\TEDIT.INSERTPIECE \TEDIT.INSERTPIECES \TEDIT.DELETEPIECES \TEDIT.ALIGNEDPIECE)
(COMS (* ; "Debugging ")
(FNS BTVALIDATE BTVALIDATE.PRINT CHECK-BTREE CHECK-BTREE1 BTFAIL)
(FNS \TEDIT.BTVALIDATE \TEDIT.BTVALIDATE.PRINT \TEDIT.CHECK-BTREE \TEDIT.CHECK-BTREE1
\TEDIT.BTFAIL \TEDIT.MATCHPCS)
(INITVARS (BTVALIDATETAGS 'DONT))
(GLOBALVARS BTVALIDATETAGS))))
@@ -169,7 +171,7 @@
(PUTPROPS \INSURE.VACANT.BTREESLOT MACRO ((BTNODE TEXTOBJ)
(CL:WHEN (EQ \BTREEMAXCOUNT (ffetch (BTREENODE COUNT)
of BTNODE))
(\MAKE.VACANT.BTREESLOT BTNODE TEXTOBJ))))
(\TEDIT.MAKE.VACANT.BTREESLOT BTNODE TEXTOBJ))))
)
@@ -212,7 +214,7 @@
)
(DEFINEQ
(\MAKEPCTB
(\TEDIT.MAKEPCTB
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk")
(* ; "Edited 31-Oct-2023 10:09 by rmk")
(* ; "Edited 8-Sep-2023 16:30 by rmk")
@@ -240,15 +242,16 @@
(FSETTOBJ TEXTOBJ TEXTLEN 0)
(FSETTOBJ TEXTOBJ PCTB (CONS NODE])
(\UPDATEPCNODES
[LAMBDA (PC DELTA TEXTOBJ) (* ; "Edited 10-Jun-2023 00:18 by rmk")
(\TEDIT.UPDATEPCNODES
[LAMBDA (PC DELTA TEXTOBJ) (* ; "Edited 16-Mar-2024 09:57 by rmk")
(* ; "Edited 10-Jun-2023 00:18 by rmk")
(* ; "Edited 8-Jun-2023 23:03 by rmk")
(* ; "Edited 21-Apr-93 16:09 by jds")
(* ;;
 "The size of the text represented by PC has grown by DELTA (negative if text is being deleted).")
(* ;; "For insertions, this is called by either \INSERTPIECE, if a new piece is being inserted, or by \INSERTCH.EXTEND if the insertion is a string insertion physically adjacent to a previous insertion.")
(* ;; "For insertions, this is called by either \TEDIT.INSERTPIECE, if a new piece is being inserted, or by \TEDIT.INSERTCH.EXTEND if the insertion is a string insertion physically adjacent to a previous insertion.")
(* ;; "It is assumed that PC PLEN and the corresponding DLEN in its node are consistent and correct, this updates the local TOTLEN and then propagates the DELTA upwards to all ancestors.")
@@ -268,7 +271,7 @@
finally (add (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)
DELTA])
(\FIRSTPIECE
(\TEDIT.FIRSTPIECE
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
(* ; "Edited 11-Apr-2023 12:54 by rmk")
(* ; "Edited 24-Aug-2022 12:45 by rmk")
@@ -280,8 +283,9 @@
(RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE))
NODE])
(\DELETETREE
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 31-Oct-2023 10:23 by rmk")
(\TEDIT.DELETETREE
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 17-Mar-2024 00:22 by rmk")
(* ; "Edited 31-Oct-2023 10:23 by rmk")
(* ; "Edited 26-Oct-2023 12:50 by rmk")
(* ; "Edited 30-May-2023 08:58 by rmk")
(* ; "Edited 5-Sep-2022 14:24 by rmk")
@@ -298,7 +302,7 @@
then
(* ;; "OLD was the last child, delete the whole node")
(\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE)
(\TEDIT.DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE)
TEXTOBJ)
else
(* ;; "Move each of the downs above OLDSLOT forward one slot")
@@ -327,7 +331,7 @@
(add (ffetch (BTREENODE COUNT) of PCNODE)
-1)))])
(\INSERTTREE
(\TEDIT.INSERTTREE
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk")
(* ; "Edited 25-Nov-2023 12:24 by rmk")
(* ; "Edited 31-Oct-2023 11:04 by rmk")
@@ -372,7 +376,7 @@
NEW])
(\LASTPIECE
(\TEDIT.LASTPIECE
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk")
(* ; "Edited 12-Apr-2023 19:23 by rmk")
(* ; "Edited 21-Aug-2022 17:13 by rmk")
@@ -384,20 +388,7 @@
(bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD)
do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD])
(\MATCHPCS
[LAMBDA (NODE) (* ; "Edited 17-Aug-2022 19:03 by rmk")
(* ; "Edited 15-Aug-2022 23:06 by rmk")
(* ; "Edited 5-May-93 17:57 by jds")
(* ;; "Make sure that any downs pointed to by this node point back to this node.")
(for S DOWN inslots NODE do (SETQ DOWN (ffetch (BTSLOT DOWN) of S))
(if (type? PIECE DOWN)
then (freplace (PIECE PTREENODE) of DOWN with NODE)
elseif (type? BTREENODE DOWN)
then (freplace (BTREENODE UPWARD) of DOWN with NODE])
(\PCTOCH
(\TEDIT.PCTOCH
[LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk")
(* ; "Edited 21-Oct-2023 11:54 by rmk")
(* ; "Edited 19-Aug-2022 22:58 by rmk")
@@ -423,7 +414,7 @@
until (EQ TOPNODE PREV) sum (ffetch (BTREENODE TOTLEN)
of TOPNODE])
(\CHTOPC
(\TEDIT.CHTOPC
[LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk")
(* ; "Edited 1-Nov-2023 23:29 by rmk")
(* ; "Edited 13-Apr-2023 22:22 by rmk")
@@ -523,8 +514,9 @@
(replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN)
of S])
(\MAKE.VACANT.BTREESLOT
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk")
(\TEDIT.MAKE.VACANT.BTREESLOT
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 16-Mar-2024 10:23 by rmk")
(* ; "Edited 7-Dec-2023 21:08 by rmk")
(* ; "Edited 31-Oct-2023 10:32 by rmk")
(* ; "Edited 10-Jun-2023 00:13 by rmk")
(* ; "Edited 30-May-2023 12:11 by rmk")
@@ -536,7 +528,7 @@
(* ;; "The intent here is that the tree is valid whenever the code is interruptable (an interrupt should never leave the tree in a trashed state.)")
(BTVALIDATE '\MAKE.VACANT.BTREESLOT 'START TEXTOBJ)
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'START TEXTOBJ)
(CL:WHEN (EQ \BTREEMAXCOUNT (fetch (BTREENODE COUNT) of BTNODE))
(* ;; "All the slots of BTNODE are full. We create PREFIXNODE to hold the lower lower half of BTNODE's slots, and install that as the left sister of BTNODE in its parent (perhaps first creating empty space in the parent if it is also full). The remaining slots of BTNODE are shifted down to its front. We first have to make sure that the parent has room for PREFIXNODE.")
@@ -621,13 +613,13 @@
(* ;; "Finally, add PREFIXNODE in front of BTNODE in its PARENT.")
(\INSERTTREE PREFIXNODE BTNODE TEXTOBJ))
(\TEDIT.INSERTTREE PREFIXNODE BTNODE TEXTOBJ))
(* ;; "")
(BTVALIDATE '\MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
(\TEDIT.BTVALIDATE '\TEDIT.MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))])
(\LINKNEWPIECE
(\TEDIT.LINKNEWPIECE
[LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk")
(* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.")
@@ -650,7 +642,7 @@
(freplace (PIECE PREVPIECE) of NEXT with NEW))
NEW])
(\UNLINKPIECE
(\TEDIT.UNLINKPIECE
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk")
(* ; "Edited 30-May-2023 00:31 by rmk")
@@ -662,8 +654,9 @@
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
(\SPLITPIECE
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 28-Dec-2023 22:17 by rmk")
(\TEDIT.SPLITPIECE
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
(* ; "Edited 28-Dec-2023 22:17 by rmk")
(* ; "Edited 7-Dec-2023 21:07 by rmk")
(* ; "Edited 25-Nov-2023 11:50 by rmk")
(* ; "Edited 31-Oct-2023 10:42 by rmk")
@@ -677,7 +670,7 @@
(* ;; "")
(BTVALIDATE '\SPLITPIECE 'START TEXTOBJ)
(\TEDIT.BTVALIDATE '\TEDIT.SPLITPIECE 'START TEXTOBJ)
(CL:WHEN (AND PC (IGREATERP CHOFFSET 0)) (* ; "Nothing to do if asking for 0.")
(FSETTOBJ TEXTOBJ HINTPC NIL)
(\INSURE.VACANT.BTREESLOT (FGETPC PC PTREENODE)
@@ -723,13 +716,14 @@
(* ;; "Insert PREVPC into the piece tree in front of PC. ")
(\INSERTTREE PREVPC PC TEXTOBJ)
(\LINKNEWPIECE PREVPC PC))
(BTVALIDATE '\SPLITPIECE 'AFTER-INSERTPIECE TEXTOBJ)))
(\TEDIT.INSERTTREE PREVPC PC TEXTOBJ)
(\TEDIT.LINKNEWPIECE PREVPC PC))
(\TEDIT.BTVALIDATE '\TEDIT.SPLITPIECE 'AFTER-INSERTPIECE TEXTOBJ)))
PC])
(\INSERTPIECE
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Dec-2023 21:07 by rmk")
(\TEDIT.INSERTPIECE
[LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
(* ; "Edited 7-Dec-2023 21:07 by rmk")
(* ; "Edited 31-Oct-2023 23:05 by rmk")
(* ; "Edited 9-Jun-2023 22:40 by rmk")
(* ; "Edited 3-Jun-2023 20:23 by rmk")
@@ -741,7 +735,7 @@
(* ;; "Caller guarantees that the chain links of NEW can be smashed.")
(BTVALIDATE '\INSERTPIECE 'START TEXTOBJ)
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'START TEXTOBJ)
(FSETTOBJ TEXTOBJ HINTPC NIL)
(CL:UNLESS NEXTPC
(SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)))
@@ -759,7 +753,7 @@
(* ;; "Make this uninterruptable. We know that NEXTPC is the zero-PLEN last piece, so no need for \UPDATEPCNODES to fix the lengths.")
(\DELETETREE NEXTPC (FGETPC NEXTPC PTREENODE)
(\TEDIT.DELETETREE NEXTPC (FGETPC NEXTPC PTREENODE)
TEXTOBJ)
[RPLACD LASTTREECONS
(SETQ LASTTREECONS
@@ -773,15 +767,18 @@
(\INSURE.VACANT.BTREESLOT (FGETPC NEXTPC PTREENODE)
TEXTOBJ)
(UNINTERRUPTABLY
(\INSERTTREE NEWPC NEXTPC TEXTOBJ)
(\LINKNEWPIECE NEWPC NEXTPC TEXTOBJ)
(\UPDATEPCNODES NEWPC (PLEN NEWPC)
(\TEDIT.INSERTTREE NEWPC NEXTPC TEXTOBJ)
(\TEDIT.LINKNEWPIECE NEWPC NEXTPC TEXTOBJ)
(\TEDIT.UPDATEPCNODES NEWPC (PLEN NEWPC)
TEXTOBJ))
(BTVALIDATE '\INSERTPIECE 'END TEXTOBJ)
(\TEDIT.BTVALIDATE '\TEDIT.INSERTPIECE 'END TEXTOBJ)
NEWPC])
(\INSERTPIECES
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk")
(\TEDIT.INSERTPIECES
[LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 20-Mar-2024 10:55 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 16-Mar-2024 10:23 by rmk")
(* ; "Edited 7-Dec-2023 21:08 by rmk")
(* ; "Edited 25-Nov-2023 12:03 by rmk")
(* ; "Edited 5-Sep-2023 21:36 by rmk")
(* ; "Edited 29-Aug-2023 11:09 by rmk")
@@ -792,7 +789,7 @@
(* ;; "Inserts the piece-chain PIECES in front of existing NEXTPC in TEXTOBJ. This assumes that the piece-chain is already linked, that the nextpiece of the final piece in the chain is initially NIL but ends up pointing to NEXTPC (or NIL if it is the last piece).")
(CL:WHEN PIECES
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(FSETTOBJ TEXTOBJ HINTPC NIL)
(FSETTOBJ TEXTOBJ \DIRTY T)
(CL:UNLESS NEXTPC
@@ -806,8 +803,8 @@
(UNINTERRUPTABLY
(\INSURE.VACANT.BTREESLOT (FGETPC NEXTPC PTREENODE)
TEXTOBJ)
(\INSERTTREE PC NEXTPC TEXTOBJ)
(\UPDATEPCNODES PC (PLEN PC)
(\TEDIT.INSERTTREE PC NEXTPC TEXTOBJ)
(\TEDIT.UPDATEPCNODES PC (PLEN PC)
TEXTOBJ)) finally
(* ;; "PC is the final piece of the chain")
@@ -819,8 +816,9 @@
(FSETPC PIECES PREVPIECE PREVPC)))
PIECES])
(\DELETEPIECES
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 25-Nov-2023 12:12 by rmk")
(\TEDIT.DELETEPIECES
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk")
(* ; "Edited 25-Nov-2023 12:12 by rmk")
(* ; "Edited 4-Nov-2023 23:03 by rmk")
(* ; "Edited 22-Oct-2023 11:43 by rmk")
(* ; "Edited 5-Sep-2023 22:32 by rmk")
@@ -837,16 +835,16 @@
(* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ")
(BTVALIDATE '\DELETEPIECES 'BEFORE TEXTOBJ)
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
(SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES)))
(* ; "For incremental chain-update")
(SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES))
(FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES
do (UNINTERRUPTABLY
(\UPDATEPCNODES PC (IMINUS (PLEN PC))
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
TEXTOBJ)
(\DELETETREE PC (FGETPC PC PTREENODE)
(\TEDIT.DELETETREE PC (FGETPC PC PTREENODE)
TEXTOBJ)
(* ;; "This piece and its lengths are out of the tree, but its chain-links are still there. To keep the tree valid at each point, we incrementally splice it out.")
@@ -862,10 +860,11 @@
PREVPIECE NIL)
(FSETPC (fetch (SELPIECES SPLAST) of SELPIECES)
NEXTPIECE NIL))
(BTVALIDATE '\DELETEPIECES 'AFTER TEXTOBJ])
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
(\ALIGNEDPIECE
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
(\TEDIT.ALIGNEDPIECE
[LAMBDA (CHNO TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 31-Oct-2023 19:37 by rmk")
(* ; "Edited 29-May-2023 23:48 by rmk")
(* ; "Edited 20-May-2023 13:53 by rmk")
(* ; "Edited 3-May-2023 18:47 by rmk")
@@ -881,13 +880,13 @@
(FGETTOBJ TEXTOBJ LASTPIECE)
elseif (ILEQ CHNO 1)
then (\FIRSTPIECE TEXTOBJ)
then (\TEDIT.FIRSTPIECE TEXTOBJ)
else (LET (PC START-OF-PIECE)
(DECLARE (SPECVARS START-OF-PIECE))
(SETQ PC (\CHTOPC CHNO TEXTOBJ T))
(SETQ PC (\TEDIT.CHTOPC CHNO TEXTOBJ T))
(CL:UNLESS (IEQP CHNO START-OF-PIECE) (* ;
 "There can be no para break before the split, as things now work.")
(\SPLITPIECE PC (IDIFFERENCE CHNO START-OF-PIECE)
(\TEDIT.SPLITPIECE PC (IDIFFERENCE CHNO START-OF-PIECE)
TEXTOBJ))
PC])
)
@@ -898,7 +897,7 @@
(DEFINEQ
(BTVALIDATE
(\TEDIT.BTVALIDATE
[LAMBDA (TAG MSG TOBJ PRINT) (* ; "Edited 8-Jun-2023 22:05 by rmk")
(* ; "Edited 3-Jun-2023 17:14 by rmk")
(* ; "Edited 29-Aug-2022 12:10 by rmk")
@@ -909,20 +908,20 @@
[LET (DEPTHHIST COUNTHIST PLENHIST (NNODES 0)
(NPIECES 0))
(DECLARE (SPECVARS DEPTHHIST COUNTHIST NNODES NPIECES PLENHIST))
(PROG1 [CHECK-BTREE (if TOBJ
then (TEXTOBJ TOBJ)
else (OR (AND (NEQ (GETATOMVAL 'TEXTOBJ)
(EVALV 'TEXTOBJ))
(TEXTOBJ (EVALV 'TEXTOBJ)
T))
(TEXTOBJ (WHICHW)
T)
(TEXTOBJ (EVALV 'LASTTESTSTREAM)
T)
(ERROR "NOT A TEXTOBJ"]
(CL:WHEN PRINT (BTVALIDATE.PRINT)))])])
(PROG1 [\TEDIT.CHECK-BTREE (if TOBJ
then (TEXTOBJ TOBJ)
else (OR (AND (NEQ (GETATOMVAL 'TEXTOBJ)
(EVALV 'TEXTOBJ))
(TEXTOBJ (EVALV 'TEXTOBJ)
T))
(TEXTOBJ (WHICHW)
T)
(TEXTOBJ (EVALV 'LASTTESTSTREAM)
T)
(ERROR "NOT A TEXTOBJ"]
(CL:WHEN PRINT (\TEDIT.BTVALIDATE.PRINT)))])])
(BTVALIDATE.PRINT
(\TEDIT.BTVALIDATE.PRINT
[LAMBDA NIL (* ; "Edited 30-May-2023 09:37 by rmk")
(DECLARE (USEDFREE DEPTHHIST COUNTHIST NNODES NPIECES PLENHIST))
(SETQ DEPTHHIST (SORT DEPTHHIST T))
@@ -944,46 +943,40 @@
T "Maximum PLEN: " .I3 (CAAR (LAST PLENHIST))
T])
(CHECK-BTREE
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 21-Oct-2023 17:33 by rmk")
(\TEDIT.CHECK-BTREE
[LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 17-Mar-2024 00:25 by rmk")
(* ; "Edited 21-Oct-2023 17:33 by rmk")
(* ; "Edited 7-Sep-2022 09:43 by rmk")
(* ; "Edited 4-Sep-2022 16:37 by rmk")
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB)
declare (SPECVARS LASTPIECE) do (CHECK-BTREE1 BT 0 NIL))
(for PC inpieces (\FIRSTPIECE TEXTOBJ) do (SELECTC (PTYPE PC)
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
(BTFAIL
"File piece without a stream"
PC)))
(STRING.PTYPES (CL:UNLESS (STRINGP (PCONTENTS
PC))
(BTFAIL
"String piece without a string"
PC)))
(OBJECT.PTYPE (CL:UNLESS (IMAGEOBJP (PCONTENTS
PC))
(BTFAIL
"Imageobject piece without an object"
PC)))
NIL))
declare (SPECVARS LASTPIECE) do (\TEDIT.CHECK-BTREE1 BT 0 NIL))
(for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
do (SELECTC (PTYPE PC)
(FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC))
(\TEDIT.BTFAIL "File piece without a stream" PC)))
(STRING.PTYPES (CL:UNLESS (STRINGP (PCONTENTS PC))
(\TEDIT.BTFAIL "String piece without a string" PC)))
(OBJECT.PTYPE (CL:UNLESS (IMAGEOBJP (PCONTENTS PC))
(\TEDIT.BTFAIL "Imageobject piece without an object" PC)))
NIL))
(CL:WHEN (AND (FGETTOBJ TEXTOBJ HINTPC)
(FGETTOBJ TEXTOBJ HINTPCSTARTCH#))
(CL:UNLESS (IEQP (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)
(\PCTOCH (FGETTOBJ TEXTOBJ HINTPC)
(\TEDIT.PCTOCH (FGETTOBJ TEXTOBJ HINTPC)
TEXTOBJ))
(BTFAIL "HINTPC is not valid" (LIST (FGETTOBJ TEXTOBJ HINTPC)
(FGETTOBJ TEXTOBJ HINTPCSTARTCH#)
(\PCTOCH (FGETTOBJ TEXTOBJ HINTPC)
TEXTOBJ)))))
(\TEDIT.BTFAIL "HINTPC is not valid" (LIST (FGETTOBJ TEXTOBJ HINTPC)
(FGETTOBJ TEXTOBJ HINTPCSTARTCH#)
(\TEDIT.PCTOCH (FGETTOBJ TEXTOBJ HINTPC)
TEXTOBJ)))))
(CL:WHEN TEXTOBJ
(CL:UNLESS [IEQP (FGETTOBJ TEXTOBJ TEXTLEN)
(for BT inside (GETTOBJ TEXTOBJ PCTB)
sum (for S inslots BT sum (fetch (BTSLOT DLEN) of S]
(BTFAIL "TEXTLEN is inconsistent" TEXTOBJ)))
(\TEDIT.BTFAIL "TEXTLEN is inconsistent" TEXTOBJ)))
'VALID])
(CHECK-BTREE1
(\TEDIT.CHECK-BTREE1
[LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk")
(* ; "Edited 30-May-2023 00:06 by rmk")
(* ; "Edited 27-May-2023 15:00 by rmk")
@@ -1000,25 +993,25 @@
then [if (EQ NODE LASTPIECE)
then (CL:WHEN (AND (PREVPIECE LASTPIECE)
(NEXTPIECE (PREVPIECE LASTPIECE)))
(BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
(\TEDIT.BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE))
else (CL:UNLESS (IGEQ (PLEN NODE)
0)
(BTFAIL "Negative PLEN" NODE))
(\TEDIT.BTFAIL "Negative PLEN" NODE))
(CL:UNLESS (OR (NEXTPIECE NODE)
(EQ NODE (PREVPIECE LASTPIECE)))
(BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
(\TEDIT.BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE))
(CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE))
(BTFAIL "Piece with wrong PTREENODE" NODE))
(\TEDIT.BTFAIL "Piece with wrong PTREENODE" NODE))
(CL:WHEN (PREVPIECE NODE)
(CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE)))
(AND (NULL (NEXTPIECE (PREVPIECE NODE)))
(EQ NODE LASTPIECE)))
(BTFAIL "PREVPIECE is not consistent" NODE)))
(\TEDIT.BTFAIL "PREVPIECE is not consistent" NODE)))
(CL:WHEN (OR (NEXTPIECE NODE)
LASTPIECE)
(CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE)
LASTPIECE)))
(BTFAIL "NEXTPIECE is not consistent" NODE)))]
(\TEDIT.BTFAIL "NEXTPIECE is not consistent" NODE)))]
(add NPIECES 1)
(add [CDR (OR (SASSOC DEPTH DEPTHHIST)
(CAR (PUSH DEPTHHIST (CONS DEPTH 0]
@@ -1030,7 +1023,7 @@
1)
(PLEN NODE)
else (CL:UNLESS (EQ PARENT (fetch (BTREENODE UPWARD) of NODE))
(BTFAIL "NODE with wrong UPWARD" NODE))
(\TEDIT.BTFAIL "NODE with wrong UPWARD" NODE))
(add NNODES 1)
(add [CDR (OR (ASSOC (fetch (BTREENODE COUNT) of NODE)
COUNTHIST)
@@ -1041,28 +1034,28 @@
eachtime (SETQ S (\NTHSLOT NODE I)) unless [AND (NULL (fetch (BTSLOT DOWN) of S))
(MEMB (fetch (BTSLOT DLEN) of S)
'(0 NIL]
do (BTFAIL "Upper node entries are not empty" NODE))
do (\TEDIT.BTFAIL "Upper node entries are not empty" NODE))
(for S DLEN CHECKLEN inslots NODE sum (SETQ DLEN (fetch (BTSLOT DLEN) of S))
(CL:UNLESS (IGEQ DLEN 0)
(BTFAIL "Negative DLEN" NODE))
(\TEDIT.BTFAIL "Negative DLEN" NODE))
(CL:UNLESS (IEQP DLEN 0)
(* ;
 "Could be intermediate in \INSUREVACANT.BTREESLOT")
(SETQ CHECKLEN (CHECK-BTREE1 (fetch (BTSLOT
DOWN)
of S)
DEPTH NODE))
(SETQ CHECKLEN (\TEDIT.CHECK-BTREE1
(fetch (BTSLOT DOWN)
of S)
DEPTH NODE))
(CL:UNLESS (IEQP DLEN CHECKLEN)
(BTFAIL "Mismatching DLEN"
(\TEDIT.BTFAIL "Mismatching DLEN"
(LIST NODE DLEN CHECKLEN))))
DLEN
finally (CL:UNLESS (IEQP (fetch (BTREENODE TOTLEN) of NODE)
$$VAL)
(BTFAIL "Mismatching TOTLEN" (LIST NODE (fetch (BTREENODE TOTLEN)
of NODE)
$$VAL)))])
(\TEDIT.BTFAIL "Mismatching TOTLEN" (LIST NODE (fetch (BTREENODE TOTLEN)
of NODE)
$$VAL)))])
(BTFAIL
(\TEDIT.BTFAIL
[LAMBDA (STRING VAL)
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk")
(HELP (CONCAT (OR TAG "")
@@ -1070,6 +1063,20 @@
(OR MSG "")
": " STRING)
VAL])
(\TEDIT.MATCHPCS
[LAMBDA (NODE) (* ; "Edited 16-Mar-2024 11:07 by rmk")
(* ; "Edited 17-Aug-2022 19:03 by rmk")
(* ; "Edited 15-Aug-2022 23:06 by rmk")
(* ; "Edited 5-May-93 17:57 by jds")
(* ;; "Make sure that any downs pointed to by this node point back to this node. This is for validity testing.")
(for S DOWN inslots NODE do (SETQ DOWN (ffetch (BTSLOT DOWN) of S))
(if (type? PIECE DOWN)
then (freplace (PIECE PTREENODE) of DOWN with NODE)
elseif (type? BTREENODE DOWN)
then (freplace (BTREENODE UPWARD) of DOWN with NODE])
)
(RPAQ? BTVALIDATETAGS 'DONT)
@@ -1078,12 +1085,13 @@
(GLOBALVARS BTVALIDATETAGS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8515 53834 (\MAKEPCTB 8525 . 10070) (\UPDATEPCNODES 10072 . 12239) (\FIRSTPIECE 12241
. 13149) (\DELETETREE 13151 . 16191) (\INSERTTREE 16193 . 18932) (\LASTPIECE 18934 . 19864) (
\MATCHPCS 19866 . 20735) (\PCTOCH 20737 . 22828) (\CHTOPC 22830 . 28886) (\TEDIT.SET-TOTLEN 28888 .
29559) (\MAKE.VACANT.BTREESLOT 29561 . 36027) (\LINKNEWPIECE 36029 . 37516) (\UNLINKPIECE 37518 .
38123) (\SPLITPIECE 38125 . 42515) (\INSERTPIECE 42517 . 45505) (\INSERTPIECES 45507 . 48148) (
\DELETEPIECES 48150 . 51961) (\ALIGNEDPIECE 51963 . 53832)) (53862 65274 (BTVALIDATE 53872 . 55322) (
BTVALIDATE.PRINT 55324 . 56682) (CHECK-BTREE 56684 . 59560) (CHECK-BTREE1 59562 . 64997) (BTFAIL 64999
. 65272)))))
(FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE
35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 .
52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
. 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
STOP

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

Binary file not shown.

302
library/tedit/TEDIT-SCREEN
View File

@@ -1,17 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Mar-2024 12:53:18" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;618 186031
(FILECREATED "20-Mar-2024 11:07:35" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;645 189050
:EDIT-BY rmk
: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)
:CHANGES-TO (FNS \TEDIT.DISPLAYLINE \TEDIT.RAISE.LINES)
:PREVIOUS-DATE "13-Mar-2024 14:40:10" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;613)
:PREVIOUS-DATE "20-Mar-2024 07:27:05" {WMEDLEY}<library>tedit>TEDIT-SCREEN.;644)
(PRETTYCOMPRINT TEDIT-SCREENCOMS)
@@ -46,9 +41,10 @@
(MACROS SPACEBREAK SAVEBREAK DOBREAK FORCEBREAK FORGETHYPHENBREAK FORGETPREVIOUSBREAK)
(RECORDS PENDINGTAB))
(INITRECORDS PENDINGTAB)
(FNS \FORMATLINE \FORMATLINE.SETUP \TEDIT.FORMATLINE.HORIZONTAL \TEDIT.FORMATLINE.VERTICAL
\FORMATLINE.JUSTIFY \FORMATLINE.TABS \FORMATLINE.SCALETABS \FORMATLINE.PURGE.SPACES
\FORMATLINE.EMPTY \FORMATLINE.UPDATELOOKS \FORMATLINE.LASTLEGAL \FORMATBLOCK)
(FNS \TEDIT.FORMATLINE \TEDIT.FORMATLINE.SETUP \TEDIT.FORMATLINE.HORIZONTAL
\TEDIT.FORMATLINE.VERTICAL \TEDIT.FORMATLINE.JUSTIFY \TEDIT.FORMATLINE.TABS
\TEDIT.FORMATLINE.SCALETABS \TEDIT.FORMATLINE.PURGE.SPACES \TEDIT.FORMATLINE.EMPTY
\TEDIT.FORMATLINE.UPDATELOOKS \TEDIT.FORMATLINE.LASTLEGAL \TEDIT.LINES.ABOVE)
(INITVARS (TEDIT.LINELEADING.BELOW NIL))
(GLOBALVARS TEDIT.LINELEADING.BELOW)
(FNS \CLEARTHISLINE \TLVALIDATE)
@@ -56,18 +52,18 @@
(INITVARS *TEDIT-CACHED-FMTSPEC*)
(* ; "Heuristic for \FORMATLINE")
(GLOBALVARS *TEDIT-CACHED-FMTSPEC*)
(FNS \DISPLAYLINE \DISPLAYLINE.TABS \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE \TEDIT.BLTCHAR
\TEDIT.DIACRITIC.SHIFT)
(FNS \TEDIT.DISPLAYLINE \TEDIT.DISPLAYLINE.TABS \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE
\TEDIT.BLTCHAR \TEDIT.DIACRITIC.SHIFT)
(DECLARE%: EVAL@COMPILE DONTCOPY
(* ;; "Machine independent version of \TEDIT.BLTCHAR")
(MACROS MI-TEDIT.BLTCHAR))
(FNS TEDIT.UPDATE.SCREEN \BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \FILLPANE \TEDIT.UPDATE.LINES
\TEDIT.CREATEPLINE \TEDIT.FIND.DIRTYCHARS \TEDIT.FORMATLINES \FORMAT.GAP.LINES
\TEDIT.LOWER.LINES \TEDIT.RAISE.LINES \TEDIT.VALID.LINES \TEDIT.CLEARPANE.BELOW.LINE
\TEDIT.INSERTLINE \TEDIT.INSURE.TRAILING.LINE \TEDIT.MARK.LINES.DIRTY \TEDIT.LINE.BOTTOM
\TEDIT.NCONC.LINES)))
(FNS \TEDIT.UPDATE.SCREEN \TEDIT.BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \TEDIT.FILLPANE
\TEDIT.UPDATE.LINES \TEDIT.CREATEPLINE \TEDIT.FIND.DIRTYCHARS \TEDIT.LINES.BELOW
\FORMAT.GAP.LINES \TEDIT.LOWER.LINES \TEDIT.RAISE.LINES \TEDIT.VALID.LINES
\TEDIT.CLEARPANE.BELOW.LINE \TEDIT.INSERTLINE \TEDIT.INSURE.TRAILING.LINE
\TEDIT.MARK.LINES.DIRTY \TEDIT.LINE.BOTTOM \TEDIT.NCONC.LINES)))
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -550,16 +546,14 @@
(COND
((AND SPACERUN FIRSTWHITESLOT) (* ; "Clear/register the overhangs")
(CL:WHEN PREVSP
(SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP (fetch (CHARSLOT
CHAR)
of FIRSTWHITESLOT))
))
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP
(fetch (CHARSLOT CHAR) of FIRSTWHITESLOT))))
(SETQ SPACELEFT (IDIFFERENCE WIDTH FIRSTWHITEX))
(SETQ OVERHANG (IDIFFERENCE TX FIRSTWHITEX)))
(T (SETQ SPACELEFT (IDIFFERENCE WIDTH TX))
(SETQ OVERHANG 0])
(PUTPROPS FORCEBREAK MACRO [NIL (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP))
(PUTPROPS FORCEBREAK MACRO [NIL (SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
(* ; "All spaces are natural")
(* ;; "If the EOL comes right after a word-character that was preceded by a space run, those earlier spaces don't count in our overhang. INSPACES tracks that. ")
@@ -619,8 +613,10 @@
'12)
(DEFINEQ
(\FORMATLINE
(\TEDIT.FORMATLINE
[LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE)
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 15-Mar-2024 19:43 by rmk")
(* ; "Edited 14-Mar-2024 12:53 by rmk")
(* ; "Edited 2-Mar-2024 07:39 by rmk")
(* ; "Edited 5-Feb-2024 09:35 by rmk")
@@ -735,7 +731,7 @@
(* ;; "")
(SETQ PC (\CHTOPC CH#1 TEXTOBJ T))
(SETQ PC (\TEDIT.CHTOPC CH#1 TEXTOBJ T))
(CL:WHEN (OR (NULL PC)
(EQ PC (FGETTOBJ TEXTOBJ LASTPIECE)))
@@ -751,12 +747,12 @@
(CL:UNLESS (VISIBLEPIECEP PC)
(CL:UNLESS (SETQ PC (\NEXT.VISIBLE.PIECE PC))
(RETURN (\FORMATLINE.EMPTY TEXTOBJ CH#1 LINE)))
(SETQ CH#1 (\PCTOCH PC TEXTOBJ)) (* ;
(RETURN (\TEDIT.FORMATLINE.EMPTY TEXTOBJ CH#1 LINE)))
(SETQ CH#1 (\TEDIT.PCTOCH PC TEXTOBJ)) (* ;
 "Unusual, simpler than keeping track on the fly")
(SETQ START-OF-PIECE CH#1))
(SETQ CHNO CH#1)
(SETQ IMAGESTREAM (\FORMATLINE.SETUP TEXTOBJ PC LINE IMAGESTREAM))
(SETQ IMAGESTREAM (\TEDIT.FORMATLINE.SETUP TEXTOBJ PC LINE IMAGESTREAM))
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
(* ;; "Display stream could have switched for hardcopy font widths.")
@@ -790,7 +786,7 @@
(CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) (* ; "Scale points up to hardcopy")
(SETQ LX1 (HCSCALE SCALE LX1))
(SETQ WIDTH (HCSCALE SCALE WIDTH))
(SETQ TABSPEC (\FORMATLINE.SCALETABS TABSPEC SCALE)))
(SETQ TABSPEC (\TEDIT.FORMATLINE.SCALETABS TABSPEC SCALE)))
(* ;; "")
@@ -798,7 +794,8 @@
(* ;; "The LOOKSUPDATEFN will initialize the character looks of the starting piece PC. It is also called at piece boundaries to reset the character-looks variables when BIN (=\TEXTBIN) moves from piece to piece.")
(freplace (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM with (FUNCTION \FORMATLINE.UPDATELOOKS))
(freplace (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM with (FUNCTION
\TEDIT.FORMATLINE.UPDATELOOKS))
(freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with NIL)
(SETQ CHARSLOT (FIRSTCHARSLOT THISLINE))
(\TEDIT.INSTALL.PIECE TSTREAM PC (- CH#1 START-OF-PIECE))
@@ -921,14 +918,14 @@
(* ;; "Remove all prior candidate break points and expandable spaces")
(FORGETPREVIOUSBREAK)
(SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP))
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
(* ;; "Now for this tab:")
(* ;
 "Start with 0 width, then set up the next tab")
(FILLCHARSLOT CHARSLOT CH 0)
(SETQ TABPENDING (\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX
TABPENDING))
(SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1
TX TABPENDING))
(* ;
 "Proper width is already in CHARSLOT")
(SETQ DX (CL:IF (FIXP TABPENDING)
@@ -995,7 +992,7 @@
(* ;; "We've seen at least one real character, line is not empty, but no good candidate break point. Back up to the last legal break (or add a real hyphenator). ")
(CL:UNLESS (\FORMATLINE.LASTLEGAL)
(CL:UNLESS (\TEDIT.FORMATLINE.LASTLEGAL)
(* ;; "Didn't find one, the offender protrudes on this line")
@@ -1024,8 +1021,8 @@
DX) (* ;
 "Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.")
(SETQ TABPENDING
(\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX
TABPENDING T))
(\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1
TX TABPENDING T))
(* ;
 "Tab over to the LEFT side of the decimal point.")
(add TX (CL:IF (FIXP TABPENDING)
@@ -1033,7 +1030,7 @@
(fetch (PENDINGTAB PTRESOLVEDWIDTH) of
TABPENDING
)))
(SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP))
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
(* ;
 "Spaces before a tab don't take part in later justification.")
(SAVEBREAK)))
@@ -1099,9 +1096,10 @@
(* ;; "Fix up last tab?")
(CL:WHEN TABPENDING
(SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP))(* ; "Don't justify spaces before tabs")
(add TX (\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE (FETCH (PENDINGTAB PTCHARSLOT)
OF TABPENDING)
(SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP))
(* ; "Don't justify spaces before tabs")
(add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE (FETCH (PENDINGTAB PTCHARSLOT)
OF TABPENDING)
LX1
(IDIFFERENCE TX OVERHANG)
TABPENDING T)))
@@ -1117,7 +1115,7 @@
 "Still maybe scaled for hardcopy display")
(FSETLD LINE LXLIM (IPLUS LX1 TX))
(FSETLD LINE 1STLN 1STLN) (* ; "First line of a paragraph")
[FSETLD LINE LSTLN (AND FORCED-END (PPARALAST (\CHTOPC CHNO TEXTOBJ]
[FSETLD LINE LSTLN (AND FORCED-END (PPARALAST (\TEDIT.CHTOPC CHNO TEXTOBJ]
(* ; "Last line of a paragraph")
(* ;; "For display, the value of LMARK (GREY) just causes the little grey box to show up in the left margin, but is not interpreted in any other way. The hardcopy code uses this field for other purposes.")
@@ -1184,7 +1182,7 @@
WMARGIN)
(RETURN LINE])
(\FORMATLINE.SETUP
(\TEDIT.FORMATLINE.SETUP
[LAMBDA (TEXTOBJ PC LINE IMAGESTREAM) (* ; "Edited 16-Dec-2023 23:34 by rmk")
(* ; "Edited 14-Jun-2023 16:43 by rmk")
(* ; "Edited 8-Mar-2023 22:15 by rmk")
@@ -1232,7 +1230,8 @@
IMAGESTREAM])
(\TEDIT.FORMATLINE.HORIZONTAL
[LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 3-Dec-2023 16:49 by rmk")
[LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 15-Mar-2024 19:35 by rmk")
(* ; "Edited 3-Dec-2023 16:49 by rmk")
(* ; "Edited 29-Oct-2023 18:24 by rmk")
(* ; "Edited 2-Jul-2023 15:15 by rmk")
(* ; "Edited 6-Apr-2023 10:13 by rmk")
@@ -1261,8 +1260,8 @@
(freplace (THISLINE TLSPACEFACTOR) of THISLINE with 1)
(CL:WHEN (EQ 'JUSTIFIED (fetch (FMTSPEC QUAD) of FMTSPEC))
(\FORMATLINE.JUSTIFY LINE THISLINE PREVSP SPACELEFT LINETYPE))
(\FORMATLINE.PURGE.SPACES PREVSP)
(\TEDIT.FORMATLINE.JUSTIFY LINE THISLINE PREVSP SPACELEFT LINETYPE))
(\TEDIT.FORMATLINE.PURGE.SPACES PREVSP)
(* ;; "")
@@ -1301,7 +1300,8 @@
NIL])
(\TEDIT.FORMATLINE.VERTICAL
[LAMBDA (LINE TEXTOBJ) (* ; "Edited 17-Dec-2023 00:43 by rmk")
[LAMBDA (LINE TEXTOBJ) (* ; "Edited 20-Mar-2024 07:26 by rmk")
(* ; "Edited 17-Dec-2023 00:43 by rmk")
(* ; "Edited 6-Dec-2023 20:13 by rmk")
(* ; "Edited 4-Dec-2023 12:13 by rmk")
@@ -1317,7 +1317,7 @@
(CL:WHEN (FGETLD LINE LSTLN) (* ; "Set post-paragraph leading")
(add DESCENT (ffetch (FMTSPEC LEADAFTER) of FMTSPEC)))
(* ;; "Documentation says that lineleading goes above, which automatically makes for reasonable selection marking. It went below in the original implementation, selections are very odd if lineleading is big.")
(* ;; "Documentation says that lineleading goes above, which automatically makes for reasonable selection marking. It went below in the original implementation, selections were very odd for large line leadings. This flag is set to T when recently created files are loaded, we try to preserve the old (bad) behavior for older files.")
(CL:IF (FGETTOBJ TEXTOBJ TXTLINELEADINGABOVE)
(add ASCENT (fetch (FMTSPEC LINELEAD) of FMTSPEC))
@@ -1326,7 +1326,7 @@
(FSETLD LINE DESCENT DESCENT)
(FSETLD LINE LHEIGHT (IPLUS ASCENT DESCENT])
(\FORMATLINE.JUSTIFY
(\TEDIT.FORMATLINE.JUSTIFY
[LAMBDA (LINE THISLINE PREVSP SPACELEFT LINETYPE) (* ; "Edited 7-Mar-2023 18:01 by rmk")
(* ; "Edited 2-Mar-2023 22:45 by rmk")
(* ; "Edited 22-Oct-2022 00:06 by rmk")
@@ -1401,7 +1401,7 @@
SPACELEFT)
NATURALWIDTHS))))])
(\FORMATLINE.TABS
(\TEDIT.FORMATLINE.TABS
[LAMBDA (TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP)
(* ; "Edited 17-Dec-2023 12:46 by rmk")
(* ; "Edited 9-Mar-2023 23:25 by rmk")
@@ -1505,7 +1505,7 @@
PTCHARSLOT _ CHARSLOT
PTOLDTX _ TX])
(\FORMATLINE.SCALETABS
(\TEDIT.FORMATLINE.SCALETABS
[LAMBDA (TABSPEC SCALE) (* ; "Edited 7-Mar-2023 21:06 by rmk")
(* ; "Edited 5-Mar-2023 20:39 by rmk")
@@ -1523,7 +1523,7 @@
(fetch (TAB TABX)
of TAB])
(\FORMATLINE.PURGE.SPACES
(\TEDIT.FORMATLINE.PURGE.SPACES
[LAMBDA (PREVSP UNTILSP) (* ; "Edited 29-Oct-2023 19:11 by rmk")
(* ; "Edited 21-Mar-2023 11:28 by rmk")
(* ; "Edited 10-Mar-2023 12:28 by rmk")
@@ -1541,8 +1541,9 @@
with (CHARCODE SPACE))))
PREVSP])
(\FORMATLINE.EMPTY
[LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 26-Jan-2024 11:08 by rmk")
(\TEDIT.FORMATLINE.EMPTY
[LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 15-Mar-2024 22:00 by rmk")
(* ; "Edited 26-Jan-2024 11:08 by rmk")
(* ; "Edited 6-Dec-2023 20:15 by rmk")
(* ; "Edited 3-Dec-2023 19:41 by rmk")
(* ; "Edited 26-Sep-2023 17:32 by rmk")
@@ -1565,8 +1566,8 @@
YBOT _ (SUB1 (FGETTOBJ TEXTOBJ WBOTTOM])
(\DTEST LINE 'LINEDESCRIPTOR)
(LET (CHARSLOT FONT TRUEASCENT TRUEDESCENT LM FMTSPEC (THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
(\FORMATLINE.SETUP TEXTOBJ NIL LINE (WINDOWPROP (CAR (FGETTOBJ TEXTOBJ \WINDOW))
'DSP))
(\TEDIT.FORMATLINE.SETUP TEXTOBJ NIL LINE (WINDOWPROP (CAR (FGETTOBJ TEXTOBJ \WINDOW))
'DSP))
(SETQ FMTSPEC (FGETLD LINE LFMTSPEC))
(SETQ CHARSLOT (FIRSTCHARSLOT THISLINE))
(replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT))
@@ -1618,8 +1619,10 @@
(\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE NIL 0 0)
LINE])
(\FORMATLINE.UPDATELOOKS
[LAMBDA (TSTREAM PC) (* ; "Edited 24-Dec-2023 22:54 by rmk")
(\TEDIT.FORMATLINE.UPDATELOOKS
[LAMBDA (TSTREAM PC) (* ; "Edited 17-Mar-2024 11:08 by rmk")
(* ; "Edited 15-Mar-2024 19:34 by rmk")
(* ; "Edited 24-Dec-2023 22:54 by rmk")
(* ; "Edited 23-Dec-2023 20:37 by rmk")
(* ; "Edited 22-Aug-2023 16:46 by rmk")
(* ; "Edited 24-Jul-2023 16:39 by rmk")
@@ -1638,7 +1641,7 @@
UNBREAKABLE))
(CL:UNLESS PC (* ;
 "Ran off the end ? Skips the ENDOFSTREAMOP")
(RETFROM (FUNCTION \TEXTBIN)
(RETFROM (FUNCTION \TEDIT.TEXTBIN)
NIL))
(LET (PLOOKS INVISIBLERUN SCALE CLOFFSET)
@@ -1706,12 +1709,13 @@
(SETQ FMTSPEC (PPARALOOKS PC))
(SETQ TABSPEC (ffetch (FMTSPEC TABSPEC) of FMTSPEC))
(CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY)
(SETQ TABSPEC (\FORMATLINE.SCALETABS TABSPEC (DSPSCALE NIL IMAGESTREAM)))))
(SETQ TABSPEC (\TEDIT.FORMATLINE.SCALETABS TABSPEC (DSPSCALE NIL
IMAGESTREAM)))))
else (add CHNO INVISIBLERUN)
(\TEDIT.INSTALL.PIECE TSTREAM PC 0))
PC])
(\FORMATLINE.LASTLEGAL
(\TEDIT.FORMATLINE.LASTLEGAL
[LAMBDA NIL (* ; "Edited 1-Feb-2024 16:51 by rmk")
(* ; "Edited 2-Jul-2023 14:39 by rmk")
(* ; "Edited 17-Mar-2023 05:36 by rmk")
@@ -1763,8 +1767,9 @@
repeatuntil (EQ CHARSLOT BESTSLOT))
T)])
(\FORMATBLOCK
[LAMBDA (TEXTOBJ CHN YBOTN) (* ; "Edited 5-Apr-2023 09:13 by rmk")
(\TEDIT.LINES.ABOVE
[LAMBDA (TEXTOBJ CHN YBOTN) (* ; "Edited 15-Mar-2024 19:22 by rmk")
(* ; "Edited 5-Apr-2023 09:13 by rmk")
(* ; "Edited 1-Apr-2023 12:02 by rmk")
(* ; "Edited 30-May-91 23:02 by jds")
@@ -1776,11 +1781,11 @@
(SETQ CHN (TEXTLEN TEXTOBJ)))
(CL:UNLESS YBOTN (SETQ YBOTN 0))
(bind L1 LN LINE HEIGHT (CHNO _ (\TEDIT.PREVIOUS.LINEBREAK TEXTOBJ CHN))
first (SETQ L1 (\FORMATLINE TEXTOBJ CHNO)) (* ;
first (SETQ L1 (\TEDIT.FORMATLINE TEXTOBJ CHNO)) (* ;
 "CHNO is the first char of the top line")
(SETQ LN L1)
(SETQ CHNO (ADD1 (GETLD L1 LCHARLIM))) until (IGREATERP CHNO CHN)
do (SETQ LINE (\FORMATLINE TEXTOBJ CHNO)) (* ;
do (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO)) (* ;
 "The line immediately after a preceding known break")
(LINKLD LN LINE)
(SETQ LN LINE)
@@ -1815,9 +1820,10 @@
THISLINE])
(\TLVALIDATE
[LAMBDA (THISLINE) (* ; "Edited 7-Nov-2022 10:16 by rmk")
[LAMBDA (THISLINE) (* ; "Edited 15-Mar-2024 19:33 by rmk")
(* ; "Edited 7-Nov-2022 10:16 by rmk")
(* ;; "Check validity of THISLINE, either just before or anytime after \FORMATLINE.JUSTIFY")
(* ;; "Check validity of THISLINE, either just before or anytime after \TEDIT.FORMATLINE.JUSTIFY")
[with THISLINE THISLINE (CL:WHEN (EQ DESC 'NODESC)
(HELP "INVALID THISLINE" DESC))
@@ -1859,8 +1865,10 @@
)
(DEFINEQ
(\DISPLAYLINE
[LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 24-Dec-2023 22:05 by rmk")
(\TEDIT.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 20-Mar-2024 10:57 by rmk")
(* ; "Edited 15-Mar-2024 22:04 by rmk")
(* ; "Edited 24-Dec-2023 22:05 by rmk")
(* ; "Edited 2-Dec-2023 11:34 by rmk")
(* ; "Edited 20-Nov-2023 13:57 by rmk")
(* ; "Edited 28-Oct-2023 23:57 by rmk")
@@ -1877,7 +1885,7 @@
(* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(\DTEST LINE 'LINEDESCRIPTOR)
(LET ((WINDOWDS (WINDOWPROP (FGETPANE PANE PWINDOW)
'DSP))
@@ -1920,7 +1928,7 @@
(CL:UNLESS (EQ LINE (fetch (THISLINE DESC) of THISLINE))
(* ;
 "No image cache -- re-format and display")
(\FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
(\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
LINE))
(MOVETO (FGETLD LINE LX1)
(FGETLD LINE DESCENT)
@@ -1959,7 +1967,7 @@
(* ;; "Not just white space, have to fill in with dots.")
(\DISPLAYLINE.TABS CHARW DS TX TERMSA LINE CLOOKS DISPLAYDATA
(\TEDIT.DISPLAYLINE.TABS CHARW DS TX TERMSA LINE CLOOKS DISPLAYDATA
DDPILOTBBT CLIPRIGHT TEXTOBJ))
(add TX CHARW))
(NIL (* ;
@@ -2037,7 +2045,7 @@
(FSETLD LINE LDIRTY NIL)
LINE])
(\DISPLAYLINE.TABS
(\TEDIT.DISPLAYLINE.TABS
[LAMBDA (CW DS TX TERMSA LINE CLOOKS DISPLAYDATA DDPILOTBBT CLIPRIGHT TEXTOBJ)
(* ; "Edited 10-Oct-2023 23:29 by rmk")
(* ; "Edited 4-Oct-2023 21:16 by rmk")
@@ -2100,22 +2108,19 @@
(RETURN CACHES])
(\TEDIT.BLTCHAR
[LAMBDA (CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT)
[LAMBDA (CHARCODE DISPLAYSTREAM CURX DISPLAYDATA DDPILOTBBT CLIPRIGHT)
(* ; "Edited 15-Mar-2024 14:39 by rmk")
(* jds " 9-Jan-86 17:14")
(* Version of BLTCHAR peculiar to TEdit --
 relies on \DISPLAYLINE to make sure things keep working right.)
(* ;; "Version of BLTCHAR peculiar to TEdit -- relies on \TEDIT.DISPLAYLINE to make sure things keep working right.")
(* puts a character on a guaranteed display stream.
 Much of the information needed by the BitBlt microcode is prestored by the
 routines that change it. This is kept in the BitBltTable.)
(* knows about the representation of
 display stream image data)
(* MUST NOT POINT AT A WINDOW'S
 DISPLAYSTREAM!!!)
(* ;; "puts a character on a guaranteed display stream. Much of the information needed by the BitBlt microcode is prestored by the routines that change it. This is kept in the BitBltTable.")
(* ;
 "knows about the representation of display stream image data")
(* ;
 "MUST NOT POINT AT A WINDOW'S DISPLAYSTREAM!!!")
(* ASSUMES THAT WE NEVER WANT TO PRINT TO THE LEFT OF ORIGIN 0 ON THE LINE CACHE
 BITMAP, OR THAT IF WE DO, ALL BETS ARE OFF)
(* ;; "ASSUMES THAT WE NEVER WANT TO PRINT TO THE LEFT OF ORIGIN 0 ON THE LINE CACHE BITMAP, OR THAT IF WE DO, ALL BETS ARE OFF")
(DECLARE (LOCALVARS . T))
(PROG (NEWX LEFT RIGHT IMAGEWIDTH (CHAR8CODE (\CHAR8CODE CHARCODE)))
@@ -2129,11 +2134,12 @@
(SETQ LEFT (IMAX 0 CURX))
(SETQ RIGHT (IMIN CLIPRIGHT NEWX))
(COND
((ILESSP LEFT RIGHT) (* Only print anything if there is a
 place to put it)
((ILESSP LEFT RIGHT) (* ;
 "Only print anything if there is a place to put it")
(UNINTERRUPTABLY
(freplace PBTDESTBIT of DDPILOTBBT with LEFT)
(* Set up the bitblt-table source left)
(* ;
 "Set up the bitblt-table source left")
(freplace PBTWIDTH of DDPILOTBBT with (IMIN IMAGEWIDTH (IDIFFERENCE RIGHT LEFT)))
(freplace PBTSOURCEBIT of DDPILOTBBT with (\GETBASE (fetch DDOFFSETSCACHE
of DISPLAYDATA)
@@ -2165,8 +2171,9 @@
)
(DEFINEQ
(TEDIT.UPDATE.SCREEN
[LAMBDA (TEXTOBJ) (* ; "Edited 16-Dec-2023 23:52 by rmk")
(\TEDIT.UPDATE.SCREEN
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 22:00 by rmk")
(* ; "Edited 16-Dec-2023 23:52 by rmk")
(* ; "Edited 12-Oct-2023 15:27 by rmk")
(* ; "Edited 17-Sep-2023 11:50 by rmk")
(* ; "Edited 22-May-2023 22:19 by rmk")
@@ -2181,12 +2188,15 @@
(\TEDIT.UPDATE.LINES TEXTOBJ 'APPEARANCE (CAR DIRTYCHARS)
(CDR DIRTYCHARS))
else (for PANE inpanes TEXTOBJ do (\FILLPANE (fetch (TEXTWINDOW PLINES) of PANE)
else (for PANE inpanes TEXTOBJ do (\TEDIT.FILLPANE (fetch (TEXTWINDOW PLINES)
of PANE)
TEXTOBJ PANE]
(FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))])
(\BACKFORMAT
[LAMBDA (TEXTOBJ DY CH1 HEIGHT) (* ; "Edited 30-Nov-2023 21:16 by rmk")
(\TEDIT.BACKFORMAT
[LAMBDA (TEXTOBJ DY CH1 HEIGHT) (* ; "Edited 20-Mar-2024 06:46 by rmk")
(* ; "Edited 15-Mar-2024 19:44 by rmk")
(* ; "Edited 30-Nov-2023 21:16 by rmk")
(* ; "Edited 3-Nov-2023 12:02 by rmk")
(* ; "Edited 6-Apr-2023 16:46 by rmk")
(* ; "Edited 5-Apr-2023 09:13 by rmk")
@@ -2199,7 +2209,8 @@
(* ;; "This computes block by block, where the first line of a block either starts a paragraph or comes immediately after a forced break.")
(bind L1 PAIR (CHNO _ CH1) until (IGREATERP HEIGHT DY) while (IGEQ CHNO 1)
do (SETQ PAIR (\FORMATBLOCK TEXTOBJ CHNO HEIGHT)) (* ; "The block may go beyond DY")
do (SETQ PAIR (\TEDIT.LINES.ABOVE TEXTOBJ CHNO HEIGHT))
(* ; "The block may go beyond DY")
(LINKLD (CADR PAIR)
L1) (* ;
 "This block's LN links to previous L1")
@@ -2211,7 +2222,8 @@
DY])
(\TEDIT.PREVIOUS.LINEBREAK
[LAMBDA (TEXTOBJ CHNO) (* ; "Edited 11-Dec-2023 21:59 by rmk")
[LAMBDA (TEXTOBJ CHNO) (* ; "Edited 17-Mar-2024 12:05 by rmk")
(* ; "Edited 11-Dec-2023 21:59 by rmk")
(* ; "Edited 16-Oct-2023 23:19 by rmk")
(* ; "Edited 31-Mar-2023 17:44 by rmk")
(* ; "Edited 28-Mar-2023 09:03 by rmk")
@@ -2233,10 +2245,10 @@
(SETQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN)))
(LET ((TSTREAM (FGETTOBJ TEXTOBJ STREAMHINT))
NCHARS)
(\TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ;
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ;
 "Start at (SUB1 CHNO) because fileptrs are one back from characters")
[SETQ NCHARS (find I from 1
suchthat (MEMB (\TEXTBACKFILEPTR TSTREAM)
suchthat (MEMB (\TEDIT.TEXTBACKFILEPTR TSTREAM)
(CHARCODE (EOL FORM %#EOL Meta,EOL CR LF NIL]
(* ;;
@@ -2246,8 +2258,10 @@
(ADD1 (IDIFFERENCE CHNO NCHARS))
1)])
(\FILLPANE
[LAMBDA (PREVLINE TEXTOBJ PANE) (* ; "Edited 11-Jan-2024 19:32 by rmk")
(\TEDIT.FILLPANE
[LAMBDA (PREVLINE TEXTOBJ PANE) (* ; "Edited 20-Mar-2024 06:43 by rmk")
(* ; "Edited 15-Mar-2024 14:39 by rmk")
(* ; "Edited 11-Jan-2024 19:32 by rmk")
(* ; "Edited 2-Jan-2024 12:45 by rmk")
(* ; "Edited 24-Dec-2023 22:00 by rmk")
(* ; "Edited 2-Dec-2023 23:05 by rmk")
@@ -2278,12 +2292,12 @@
(* ;; "Format and display any lines that are still needed to fill out the pane. ")
(SETQ PREVLINE (\TEDIT.FORMATLINES PREVLINE NIL PANE TEXTOBJ))
(SETQ PREVLINE (\TEDIT.LINES.BELOW PREVLINE NIL PANE TEXTOBJ))
(* ;; "")
(CL:WHEN (\TEDIT.INSURE.TRAILING.LINE TEXTOBJ PREVLINE)
(\DISPLAYLINE TEXTOBJ (GETLD PREVLINE NEXTLINE)
(\TEDIT.DISPLAYLINE TEXTOBJ (GETLD PREVLINE NEXTLINE)
PANE))
(* ;; "")
@@ -2294,6 +2308,7 @@
(\TEDIT.UPDATE.LINES
[LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED DONTDISPLAY)
(* ; "Edited 20-Mar-2024 06:43 by rmk")
(* ; "Edited 24-Dec-2023 22:00 by rmk")
(* ; "Edited 18-Dec-2023 00:12 by rmk")
(* ; "Edited 16-Dec-2023 13:43 by rmk")
@@ -2320,7 +2335,7 @@
(* ;; "Create/format/display new lines between LASTVALID=(CAR VALIDS) and NEXTVALID ")
(SETQ NEXTVALID (CDR VALIDS))
(SETQ LASTGAPLINE (\TEDIT.FORMATLINES (CAR VALIDS)
(SETQ LASTGAPLINE (\TEDIT.LINES.BELOW (CAR VALIDS)
(AND NEXTVALID (SUB1 (FGETLD NEXTVALID LCHAR1)))
PANE TEXTOBJ DONTDISPLAY))
(LINKLD LASTGAPLINE NEXTVALID)
@@ -2426,8 +2441,9 @@
(IDIFFERENCE (ADD1 LASTDIRTYCHAR)
(FGETLD FIRSTDIRTYLINE LCHAR1))))])
(\TEDIT.FORMATLINES
[LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 23-Dec-2023 23:38 by rmk")
(\TEDIT.LINES.BELOW
[LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 15-Mar-2024 19:22 by rmk")
(* ; "Edited 23-Dec-2023 23:38 by rmk")
(* ; "Edited 17-Dec-2023 15:56 by rmk")
(* ; "Edited 14-Dec-2023 12:46 by rmk")
@@ -2456,7 +2472,7 @@
first (CL:WHEN (OR (IGREATERP LCHARLIM LASTCHAR)
(ILEQ YBOT PBOTTOM))
(FSETLD PREVLINE NEXTLINE NIL) (* ; "Eliminate dangling garbage")
(RETURN PREVLINE)) while (SETQ NEXT (\FORMATLINE TEXTOBJ (ADD1 LCHARLIM)))
(RETURN PREVLINE)) while (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (ADD1 LCHARLIM)))
do
(* ;;
 "L is formatted, positioned, linked, displayed. Next is the following line unless at the end.")
@@ -2470,14 +2486,15 @@
(RETURN L))
(CL:UNLESS DONTDISPLAY (* ;
 "Cached formatting is good for display")
(\DISPLAYLINE TEXTOBJ NEXT PANE)) finally
(\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)) finally
(* ;; "Ran out of lines")
(* ;; "Ran out of lines")
(RETURN (OR L PREVLINE))))])
(RETURN (OR L PREVLINE))))])
(\FORMAT.GAP.LINES
[LAMBDA (VALIDS PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 4-Dec-2023 20:42 by rmk")
[LAMBDA (VALIDS PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 15-Mar-2024 19:23 by rmk")
(* ; "Edited 4-Dec-2023 20:42 by rmk")
(* ; "Edited 20-Nov-2023 10:47 by rmk")
(* ; "Edited 3-Nov-2023 12:05 by rmk")
(* ; "Edited 15-May-2023 17:31 by rmk")
@@ -2517,7 +2534,7 @@
(CL:WHEN (IGREATERP (FGETLD NEXTVALID YTOP)
(FGETLD LASTVALID YBOT))
(BITBLT)))
(SETQ LASTVALID (\FORMATLINE TEXTOBJ (ADD1 LCHARLIM)))
(SETQ LASTVALID (\TEDIT.FORMATLINE TEXTOBJ (ADD1 LCHARLIM)))
(LINKLD L LASTVALID)
(SETQ YBOT (\TEDIT.LINE.BOTTOM LASTVALID))
(SETQ LCHARLIM (FGETLD LASTVALID LCHARLIM))
@@ -2525,11 +2542,12 @@
(* ;; "The THISLINE cache for NEXT is good if we display immediately after formatting")
(\DISPLAYLINE TEXTOBJ LASTVALID PANE)) finally (LINKLD LASTVALID NEXTVALID)
(RETURN LASTVALID])
(\TEDIT.DISPLAYLINE TEXTOBJ LASTVALID PANE)) finally (LINKLD LASTVALID NEXTVALID)
(RETURN LASTVALID])
(\TEDIT.LOWER.LINES
[LAMBDA (NEXTVALID LASTVALID PANE TEXTOBJ) (* ; "Edited 20-Jan-2024 23:15 by rmk")
[LAMBDA (NEXTVALID LASTVALID PANE TEXTOBJ) (* ; "Edited 15-Mar-2024 14:40 by rmk")
(* ; "Edited 20-Jan-2024 23:15 by rmk")
(* ; "Edited 2-Jan-2024 00:26 by rmk")
(* ; "Edited 4-Dec-2023 11:25 by rmk")
(* ; "Edited 24-Nov-2023 13:01 by rmk")
@@ -2590,7 +2608,7 @@
(if (IGEQ (FGETLD L YTOP)
NEWTOP)
then (SETYPOS L YBOT)
(\DISPLAYLINE TEXTOBJ L PANE)
(\TEDIT.DISPLAYLINE TEXTOBJ L PANE)
else (SETYPOS L YBOT)))
(* ;; "Clear whatever might be left over below the last visible line")
@@ -2600,7 +2618,8 @@
'REPLACE))])])
(\TEDIT.RAISE.LINES
[LAMBDA (LINE NEWTOP PANE TEXTOBJ) (* ; "Edited 20-Jan-2024 23:14 by rmk")
[LAMBDA (LINE NEWTOP PANE TEXTOBJ) (* ; "Edited 20-Mar-2024 10:57 by rmk")
(* ; "Edited 20-Jan-2024 23:14 by rmk")
(* ; "Edited 2-Jan-2024 00:31 by rmk")
(* ; "Edited 14-Dec-2023 17:20 by rmk")
(* ; "Edited 4-Dec-2023 20:57 by rmk")
@@ -2615,7 +2634,7 @@
(* ;; "If PANE has been moved so that it is not entirely within the screen, then don't try to find the relevant bits, just repaint the whole window.")
(\DTEST TEXTOBJ 'TEXTOBJ)
(TEXTOBJ! TEXTOBJ)
(PROG ((PREG (DSPCLIPPINGREGION NIL PANE))
(LTOP (GETLD LINE YTOP))
RAISE PWIDTH PBOTTOM LASTVISIBLE)
@@ -2652,11 +2671,13 @@
(* ;; "If the last visible line in the pane (whose image is now elevated) is not the last line of the text, we build and display new lines to fill out the pane.")
(\TEDIT.FORMATLINES LASTVISIBLE NIL PANE TEXTOBJ)
(\TEDIT.LINES.BELOW LASTVISIBLE NIL PANE TEXTOBJ)
(RETURN))])
(\TEDIT.VALID.LINES
[LAMBDA (TEXTOBJ FIRSTCHANGEDCHNO NCHARSCHANGED REASON) (* ; "Edited 22-Feb-2024 01:05 by rmk")
[LAMBDA (TEXTOBJ FIRSTCHANGEDCHNO NCHARSCHANGED REASON) (* ; "Edited 20-Mar-2024 06:46 by rmk")
(* ; "Edited 15-Mar-2024 19:44 by rmk")
(* ; "Edited 22-Feb-2024 01:05 by rmk")
(* ; "Edited 3-Nov-2023 12:07 by rmk")
(* ; "Edited 14-Jun-2023 15:55 by rmk")
(* ; "Edited 17-May-2023 09:32 by rmk")
@@ -2735,9 +2756,8 @@
(* ;; "We ran back to the top of the pane without finding a forced-end. If it's not the beginning of the document, we need to insert a new line with the proper LCHARLIM and YBOT just above the pane. ")
[SETQ LASTVALIDLINE (CADR (\FORMATBLOCK TEXTOBJ (SUB1 (FGETLD
FIRSTCHANGEDLINE
LCHAR1))
[SETQ LASTVALIDLINE (CADR (\TEDIT.LINES.ABOVE TEXTOBJ
(SUB1 (FGETLD FIRSTCHANGEDLINE LCHAR1))
(FGETLD FIRSTCHANGEDLINE YTOP]
(\TEDIT.INSERTLINE LASTVALIDLINE PLINES T)))
@@ -2817,19 +2837,20 @@
(SETLD OLDLINE PREVLINE NEWLINE])
(\TEDIT.INSURE.TRAILING.LINE
[LAMBDA (TEXTOBJ LASTLINE) (* ; "Edited 16-Dec-2023 00:12 by rmk")
[LAMBDA (TEXTOBJ LASTLINE) (* ; "Edited 15-Mar-2024 19:31 by rmk")
(* ; "Edited 16-Dec-2023 00:12 by rmk")
(* ; "Edited 15-Jul-2023 13:53 by rmk")
(* ; "Edited 8-May-2023 22:00 by rmk")
(* ; "Edited 5-May-2023 10:54 by rmk")
(* ;; "Fabricates a final line to insure that there is a place for the caret to blink after the last EOL of the text. Something for \FIXSEL to move to.")
(* ;; "\FORMATLINE may be overkill--maybe we really want to construct exactly what we want. But \FORMATLINE does get the LHEIGHT.")
(* ;; "\TEDIT.FORMATLINE may be overkill--maybe we really want to construct exactly what we want. But \TEDIT.FORMATLINE does get the LHEIGHT.")
(CL:WHEN (AND (GETLD LASTLINE FORCED-END)
(IEQP (FGETLD LASTLINE LCHARLIM)
(FGETTOBJ TEXTOBJ TEXTLEN)))
(LET [(LINE (\FORMATLINE.EMPTY TEXTOBJ (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN]
(LET [(LINE (\TEDIT.FORMATLINE.EMPTY TEXTOBJ (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN]
(SETYPOS LINE (IDIFFERENCE (FGETLD LASTLINE YBOT)
(FGETLD LINE LHEIGHT)))
(LINKLD LASTLINE LINE)
@@ -2945,21 +2966,22 @@
(SETQ TAILLINE NIL))))])
)
(DECLARE%: DONTCOPY
(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)))))
(FILEMAP (NIL (24497 25906 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24507 . 25904)) (33264 111915 (
\TEDIT.FORMATLINE 33274 . 68334) (\TEDIT.FORMATLINE.SETUP 68336 . 71727) (\TEDIT.FORMATLINE.HORIZONTAL
71729 . 76125) (\TEDIT.FORMATLINE.VERTICAL 76127 . 78330) (\TEDIT.FORMATLINE.JUSTIFY 78332 . 84272) (
\TEDIT.FORMATLINE.TABS 84274 . 91761) (\TEDIT.FORMATLINE.SCALETABS 91763 . 92766) (
\TEDIT.FORMATLINE.PURGE.SPACES 92768 . 94078) (\TEDIT.FORMATLINE.EMPTY 94080 . 98910) (
\TEDIT.FORMATLINE.UPDATELOOKS 98912 . 106178) (\TEDIT.FORMATLINE.LASTLEGAL 106180 . 109662) (
\TEDIT.LINES.ABOVE 109664 . 111913)) (112032 114453 (\CLEARTHISLINE 112042 . 112711) (\TLVALIDATE
112713 . 114451)) (114647 134704 (\TEDIT.DISPLAYLINE 114657 . 126997) (\TEDIT.DISPLAYLINE.TABS 126999
. 129622) (\TEDIT.LINECACHE 129624 . 130352) (\TEDIT.CREATE.LINECACHE 130354 . 131190) (
\TEDIT.BLTCHAR 131192 . 133819) (\TEDIT.DIACRITIC.SHIFT 133821 . 134702)) (135319 189027 (
\TEDIT.UPDATE.SCREEN 135329 . 137153) (\TEDIT.BACKFORMAT 137155 . 139197) (\TEDIT.PREVIOUS.LINEBREAK
139199 . 141502) (\TEDIT.FILLPANE 141504 . 144053) (\TEDIT.UPDATE.LINES 144055 . 149043) (
\TEDIT.CREATEPLINE 149045 . 150888) (\TEDIT.FIND.DIRTYCHARS 150890 . 152902) (\TEDIT.LINES.BELOW
152904 . 156386) (\FORMAT.GAP.LINES 156388 . 160379) (\TEDIT.LOWER.LINES 160381 . 164748) (
\TEDIT.RAISE.LINES 164750 . 168177) (\TEDIT.VALID.LINES 168179 . 177573) (\TEDIT.CLEARPANE.BELOW.LINE
177575 . 178893) (\TEDIT.INSERTLINE 178895 . 180153) (\TEDIT.INSURE.TRAILING.LINE 180155 . 181470) (
\TEDIT.MARK.LINES.DIRTY 181472 . 184183) (\TEDIT.LINE.BOTTOM 184185 . 187025) (\TEDIT.NCONC.LINES
187027 . 189025)))))
STOP

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

Binary file not shown.

867
library/tedit/TEDIT-SELECTION
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

1022
library/tedit/TEDIT-STREAM
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

171
library/tedit/TEDIT-STRESS
View File

@@ -1,31 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Mar-2024 15:16:05" {WMEDLEY}<library>tedit>TEDIT-STRESS.;49 12388
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70 15296
:EDIT-BY rmk
:CHANGES-TO (FNS STRESSHC)
:CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
(VARS TEDIT-STRESSCOMS)
:PREVIOUS-DATE "13-Mar-2024 00:24:06" {WMEDLEY}<library>tedit>TEDIT-STRESS.;48)
:PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
(RPAQQ TEDIT-STRESSCOMS ( (* ; "Preload typical image objects")
(FILES SKETCH DATEFORMAT-EDITOR)
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD)
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSGREP
STRESSPEEK)
(FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE)))
(* ; "Preload typical image objects")
(FILESLOAD SKETCH DATEFORMAT-EDITOR)
(DEFINEQ
(STRESSHC
[LAMBDA (FILES NSYSOUTS REPS NOERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
[LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
(* ; "Edited 19-Mar-2024 21:33 by rmk")
(* ; "Edited 14-Mar-2024 15:15 by rmk")
(* ; "Edited 13-Mar-2024 00:23 by rmk")
(DECLARE (SPECVARS SINGLESTEP))
@@ -34,10 +34,7 @@
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(NIL MAX.SMALLP)
REPS))
(SETQ NOERROR T)
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(CL:UNLESS NSYSOUTS
(SETQ NSYSOUTS 'SAVEVM))
[SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY
@@ -64,34 +61,35 @@
(if (EQ NSYSOUTS 'SAVEVM)
then (SAVEVM)
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
[for F TS HCFILE inside FILES
[for F TSTRM 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)]
(if [if ERROR
then (SETQ TSTRM (OPENTEXTSTREAM F))
(TEDIT.FORMAT.HARDCOPY TSTRM HCFILE T NIL NIL NIL (CL:IF PDF
'PDF
'POSTSCRIPT))
else (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
(TEDIT.FORMAT.HARDCOPY TSTRM 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)
(CLOSEF? TSTRM)
(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")
[LAMBDA (FILES REPS ERROR PROBESPERFILE) (* ; "Edited 19-Mar-2024 21:33 by rmk")
(* ; "Edited 12-Mar-2024 09:47 by rmk")
(* ;; "Opens, fetches random characters")
@@ -106,21 +104,25 @@
" 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)
(for F TSTRM inside FILES
do (if (if ERROR
then (SETQ TSTRM (OPENTEXTSTREAM F))
(for I (LEN _ (TEDIT.NCHARS TSTRM)) from 1 to PROBESPERFILE
do (TEDIT.NTHCHARCODE TSTRM (RAND 1 LEN)))
T
else (CAR (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
(for I (LEN _ (TEDIT.NCHARS TSTRM)) from 1 to PROBESPERFILE
do (TEDIT.NTHCHARCODE TSTRM (RAND 1 LEN)))
T)))
then (CLOSEF TSTRM)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST R N])
else (PRINTOUT T " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T)) repeatwhile (PROGN (CLOSEF? TSTRM)
T)) finally (RETURN (LIST R N])
(STRESSPUT
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 12-Mar-2024 09:48 by rmk")
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 19-Mar-2024 21:34 by rmk")
(* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ;; "Opens, puts, reopens and tests for equivalence")
@@ -134,27 +136,28 @@
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS TSP inside FILES
(for F TSTRM TSP inside FILES
do (if (if NOERROR
then (NLSETQ (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
then (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
(HELP "Get of put not equivalent" F))
(CLOSEF TSP))
else (SETQ TS (OPENTEXTSTREAM F))
(TEDIT.PUT TS "{CORE}FOO.TEDIT;1")
else (SETQ TSTRM (OPENTEXTSTREAM F))
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TS TSP STOP)))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
(HELP "Get of put not equivalent" F))
(CLOSEF TSP))
then (CLOSEF TS)
then (CLOSEF TSTRM)
(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")
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
(* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ; "Edited 11-Mar-2024 09:15 by rmk")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
@@ -166,18 +169,20 @@
" 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])
(for F TSTRM inside FILES do (if (if NOERROR
then (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F)))
else (SETQ TSTRM (OPENTEXTSTREAM F)))
then (CLOSEF TSTRM)
(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")
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
(* ; "Edited 15-Mar-2024 15:19 by rmk")
(* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ; "Edited 11-Mar-2024 09:13 by rmk")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
@@ -189,16 +194,50 @@
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TS inside FILES
(for F TSTRM 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)
then (NLSETQ (SETQ TSTRM (OPENTEXTSTREAM F))
(for I from 1 while (TEDIT.NTHCHARCODE TSTRM I)))
else (SETQ TSTRM (OPENTEXTSTREAM F))
(for I from 1 while (TEDIT.NTHCHARCODE TSTRM I))
T)
then (CLOSEF TSTRM)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST R N])
T))) finally (RETURN (LIST (SUB1 R)
N])
(STRESSGREP
[LAMBDA (FILES NOERROR TARGET) (* ; "Edited 17-Mar-2024 19:46 by rmk")
(* ;; "GREP does forward bins and peekbins. If it hits on something, it also runs the backfileptr function. FOO appears in quite a few lispusers/ Tedit files.")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(CL:UNLESS TARGET (SETQ TARGET "FOO"))
(FILESLOAD GREP)
(for F inside FILES unless (if NOERROR
then (NLSETQ (GREP TARGET F))
else (GREP TARGET F)
T) do (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL
'DIRECTORY NIL
'BODY F)
T])
(STRESSPEEK
[LAMBDA (FILES ERROR) (* ; "Edited 19-Mar-2024 21:33 by rmk")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(for F TSTRM inside FILES eachtime (SETQ TSTRM (OPENTEXTSTREAM F))
unless [if ERROR
then (bind P while (SETQ P (PEEKCCODE TSTRM T)) always (EQ P (BIN TSTRM)))
else (NLSETQ (bind P while (SETQ P (PEEKCCODE TSTRM T))
always (EQ P (BIN TSTRM] do (PRINTOUT T "Error for "
(PACKFILENAME 'HOST NIL
'DIRECTORY NIL 'BODY F)
T)
repeatwhile (PROGN (CLOSEF? TSTRM)
T])
)
(DEFINEQ
@@ -254,7 +293,7 @@
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)))))
(FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
STOP

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

Binary file not shown.

62
library/tedit/TEDIT-TFBRAVO
View File

@@ -1,12 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jan-2024 12:12:29" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;150 90820
(FILECREATED "17-Mar-2024 18:27:18" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153 91304
:EDIT-BY rmk
:CHANGES-TO (FNS TEDITFROMBRAVO)
:CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
(FNS \TEDIT.NAMEDTAB.INIT)
:PREVIOUS-DATE "16-Jan-2024 18:30:43" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;149)
:PREVIOUS-DATE "17-Mar-2024 12:41:56"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -59,10 +62,10 @@
'BREAKCHAR PROFILE.PARA.RDTBL))
(COMS (* ; "Named tabs. To be removed")
(FNS \TFBRAVO.ADD.NAMEDTAB \TFBRAVO.COPY.NAMEDTAB \TFBRAVO.PUT.NAMEDTAB
\TFBRAVO.GET.NAMEDTAB \NAMEDTABNYET \NAMEDTABSIZE \NAMEDTABPREPRINT \NAMEDTAB.INIT
)
\TFBRAVO.GET.NAMEDTAB \NAMEDTABNYET \NAMEDTABSIZE \NAMEDTABPREPRINT
\TEDIT.NAMEDTAB.INIT)
(GLOBALVARS \NAMEDTAB.IMAGEFNS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND NIL (\NAMEDTAB.INIT])
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND NIL (\TEDIT.NAMEDTAB.INIT])
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD TEDIT-EXPORTS.ALL)
@@ -936,7 +939,8 @@
(\TFBRAVO.INSERT.RUN RUN BSTREAM PFMTSPEC TEXTOBJ])
(\TFBRAVO.INSERT.RUN
[LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "Edited 16-Jan-2024 18:28 by rmk")
[LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 16-Jan-2024 18:28 by rmk")
(* ; "Edited 29-Dec-2023 11:50 by rmk")
(* ; "Edited 23-Sep-2023 12:11 by rmk")
(* ; "Edited 23-Aug-2023 08:31 by rmk")
@@ -980,7 +984,7 @@
(SETQ PBYTESPERCHAR 1)
(SETQ PBYTELEN NCHARS)
(SETQ PUTF8BYTESPERCHAR 2)))
(\INSERTPIECE PC NIL TEXTOBJ)
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
PC))])
(\TFBRAVO.SPLIT.PARA
@@ -1083,7 +1087,8 @@
NEWPARAS])
(\TFBRAVO.RUN.TABSPEC
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 22-Aug-2023 16:54 by rmk")
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 by rmk")
(* ; "Edited 22-Aug-2023 16:54 by rmk")
(* ; "Edited 19-Aug-2023 15:47 by rmk")
(* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.")
@@ -1127,7 +1132,7 @@
(RETURN (CDR (CADR TDTAIL]
else (GO $$ITERATE]
(* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.")
(* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.")
[SETQ TABSPEC (SORT (for TAB in TABDEFS collect (CDR TAB))
(FUNCTION (LAMBDA (T1 T2)
@@ -1419,8 +1424,9 @@
(CONCAT "[TAB" (IMAGEOBJPROP TABOBJ 'TABNAME)
"]"])
(\NAMEDTAB.INIT
[LAMBDA NIL (* ; "Edited 6-Aug-2023 18:59 by rmk")
(\TEDIT.NAMEDTAB.INIT
[LAMBDA NIL (* ; "Edited 17-Mar-2024 18:26 by rmk")
(* ; "Edited 6-Aug-2023 18:59 by rmk")
(* jds "22-Aug-84 14:49")
(SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE 'NILL (FUNCTION \NAMEDTABSIZE)
(FUNCTION \TFBRAVO.PUT.NAMEDTAB)
@@ -1428,7 +1434,7 @@
(FUNCTION \TFBRAVO.COPY.NAMEDTAB)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION MOVE.NAMED.TAB)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
@@ -1441,21 +1447,21 @@
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(AND NIL (\NAMEDTAB.INIT))
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6652 13034 (TEDIT.BRAVOFILE? 6662 . 8392) (TEDITFROMBRAVO 8394 . 13032)) (13145 28131 (
\TFBRAVO.GET.USER.CM 13155 . 15965) (\TFBRAVO.USER.CM.LOOKS 15967 . 17142) (\TFBRAVO.READ.USER.CM
17144 . 21481) (\TFBRAVO.INIT.PARALOOKS 21483 . 23244) (\TFBRAVO.INIT.PAGEFORMAT 23246 . 24126) (
\TFBRAVO.GETPARAMS 24128 . 26982) (\TFBRAVO.FIND.LAST.TRAILER 26984 . 28129)) (28173 48186 (
\TFBRAVO.PARSE.PARA 28183 . 31870) (\TFBRAVO.READ.PARALOOKS 31872 . 38506) (\TFBRAVO.CREATE.RUNS 38508
. 39896) (\TFBRAVO.READ.CHARLOOKS 39898 . 44916) (\TFBRAVO.FONT.FROM.CHARLOOKS 44918 . 46287) (
\TFBRAVO.READNUM? 46289 . 48184)) (48223 58974 (\TFBRAVO.HANDLE.HEADING 48233 . 50865) (
\TFBRAVO.PARSE.PROFILE.PARA 50867 . 58972)) (59017 79934 (\TFBRAVO.INSERT.PARA 59027 . 59680) (
\TFBRAVO.INSERT.RUN 59682 . 62764) (\TFBRAVO.SPLIT.PARA 62766 . 70008) (\TFBRAVO.RUN.TABSPEC 70010 .
74239) (\TFBRAVO.INSTALL.PAGEFORMAT 74241 . 79932)) (79935 83895 (\TFBRAVO.ASSERT 79945 . 80292) (
\TEST.CHARACTER.LOOKS 80294 . 82180) (\TEST.PARAGRAPH.LOOKS 82182 . 83893)) (84380 90660 (
\TFBRAVO.ADD.NAMEDTAB 84390 . 87723) (\TFBRAVO.COPY.NAMEDTAB 87725 . 88173) (\TFBRAVO.PUT.NAMEDTAB
88175 . 88455) (\TFBRAVO.GET.NAMEDTAB 88457 . 88834) (\NAMEDTABNYET 88836 . 88996) (\NAMEDTABSIZE
88998 . 89513) (\NAMEDTABPREPRINT 89515 . 89713) (\NAMEDTAB.INIT 89715 . 90658)))))
(FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 (
\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM
17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) (
\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 (
\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651
. 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) (
\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) (
\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) (
\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 .
74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) (
\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 (
\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB
88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE
89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136)))))
STOP

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

Binary file not shown.

581
library/tedit/TEDIT-WINDOW
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

BIN
library/tedit/TEDIT.LCOM
View File

Binary file not shown.

91
library/tedit/tedit-exports.all
View File

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:49:16" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;111 46338
(FILECREATED "20-Mar-2024 11:16:36" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120 47172
:EDIT-BY rmk
:PREVIOUS-DATE " 3-Mar-2024 08:55:19" {WMEDLEY}<library>tedit>tedit-exports.all;110)
:PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
@@ -17,7 +17,7 @@ HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASS
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
\TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 4-Mar-2024 21:32:36"))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:26"))
(RPAQQ \BTREEWORDSPERSLOT 4)
(RPAQQ \BTREEMAXCOUNT 8)
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -52,7 +52,7 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE " 3-Mar-2024 08:59:45"))
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:07"))
(DATATYPE SELECTION ((* ;;
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
@@ -104,7 +104,7 @@ $$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIR
GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH
(fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE
I.V.))))) T)
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 4-Mar-2024 22:48:20"))
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55"))
(DATATYPE THISLINE ((* ;;
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
@@ -136,8 +136,8 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
(* ; "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.") LFMTSPEC (
@@ -226,7 +226,7 @@ eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLO
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
192) (ILEQ CHAR 207))))
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 2-Mar-2024 07:40:06"))
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35"))
(DATATYPE PIECE ((* ;
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -327,9 +327,10 @@ NEWVALUE)) (* ;
"The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
"Function to be called at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM
F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (CREATE (create STREAM BINABLE _ NIL
BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2
_ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? (AND (type? STREAM DATUM) (type?
TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create STREAM BINABLE _ NIL BOUTABLE _ NIL
ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4
_ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
@@ -364,6 +365,13 @@ VISIBLEPIECEP PPC))))
(PUTPROPS FSETTOBJ MACRO ((TOBJ FIELD NEWVALUE) (freplace (TEXTOBJ FIELD) of TOBJ with NEWVALUE)))
(PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
(PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ)))
(PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE))))
(RPAQQ THINFILE.PTYPE 0)
(RPAQQ FATFILE1.PTYPE 1)
(RPAQQ FATFILE2.PTYPE 2)
@@ -372,18 +380,22 @@ VISIBLEPIECEP PPC))))
(RPAQQ SUBSTREAM.PTYPE 5)
(RPAQQ OBJECT.PTYPE 6)
(RPAQQ LOOKS.PTYPE 7)
(RPAQQ UTF16BE.PTYPE 8)
(RPAQQ UTF16LE.PTYPE 9)
(RPAQQ UTF8.PTYPE 11)
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE))
(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE
UTF16LE.PTYPE))
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF8.PTYPE 11) (FILE.PTYPES (
LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE
FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST
THINFILE.PTYPE THINSTRING.PTYPE)))
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE)))
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 2-Mar-2024 07:10:22"))
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37"))
(RPAQQ NONE.TTC 0)
(RPAQQ CHARDELETE.TTC 1)
(RPAQQ WORDDELETE.TTC 2)
@@ -419,13 +431,13 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16)
(NEWCHAR-IF-SPLIT.LB 32))
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "26-Feb-2024 11:22:29"))
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:16"))
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
\BIN STREAM)) BITSPERWORD)))
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "16-Feb-2024 23:55:44"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "21-Jan-2024 10:27:59"))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:52"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42"))
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;;
"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
@@ -490,7 +502,7 @@ LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL))
)) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
\PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
(PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "24-Feb-2024 12:34:14"))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29"))
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
@@ -503,15 +515,14 @@ eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCC
TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET))
(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP
DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (
PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (GETWINDOWPROP DATUM (QUOTE TEXTOBJ)) (
PUTWINDOWPROP DATUM (QUOTE TEXTOBJ) NEWVALUE)) (PTEXTOBJ (GETWINDOWPROP DATUM (QUOTE TEXTOBJ)) (
PUTWINDOWPROP DATUM (QUOTE TEXTOBJ) NEWVALUE)) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (
PUTWINDOWPROP DATUM (QUOTE LINES) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE
TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP
DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM
(QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (
GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN)) (LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE
TEDIT-WITHIN-SCREEN) NV) NV))))
PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (
TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES
) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (
QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM
(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP
DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN))
(LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV))))
(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER))
(ACCESSFNS (PWINDOW (PROGN DATUM))))
(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P)))
@@ -519,7 +530,7 @@ TEDIT-WITHIN-SCREEN) NV) NV))))
(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE)))
(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE)))
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY))))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE " 4-Mar-2024 15:15:31"))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27"))
(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ;
"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in")
MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ;
@@ -541,10 +552,10 @@ IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY))))))
(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ (
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN)))))
(RECORD TAB (TABX . TABKIND))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 1-Mar-2024 20:35:49"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 3-Mar-2024 20:44:51"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 3-Mar-2024 20:44:44"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Jan-2024 23:19:53"))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37"))
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
@@ -559,7 +570,7 @@ QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QU
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
NEWVALUE)))
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 4-Mar-2024 21:33:56"))
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:20"))
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
"The current page number. Counted from 1") FIRSTPAGE (* ;;
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
@@ -590,9 +601,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
(PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
)
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "16-Feb-2024 23:05:08"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "12-Jun-2023 10:34:12"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Jan-2024 12:12:29"))
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18"))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP