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

Rmk88 split screen updates and color, eliminate reliance on STREAMHINT xpointer (#2119)

Browse Source 
* Tedit window splitting is more robust, interface through menu items instead of split-region on the right of the window.  See TEDIT-RELEASENOTES.TEDIT

* Tedit recognizes color as specfied by DSPCOLOR, passes it to hardcopy

* N-way buttons default to unsorted--new items go at the end. Otherwise keyboard shortcut meta-3 for the 3rd font might pick a different one depending on what went before.

* USER.CM can be specified as an opening property for Bravo conversion.

* Adresses/fixes Tedit issues #2173 #2172 #2171 #2142  #2105 #2062 #2059 #1972 (maybe some others).

* Changes to rationalize internal interfaces and simplify code, and particularly to eliminate internal dependencies on the STREAMHINT Xpointer backlink.  STREAMHINT is only accessed if a client has grabbed the TEXTOBJ and passes it back in.  The stream and window are the safe/reliable way of referencing the Tedit state (and the window and stream know about each other, and know about the TEXTOBJ only through the stream).

* Many changes to TEDIT-STRESS, including new defaults CHECKARRAYS NIL, NSYSOUTS 0, ARRAYBLOCKCHECKING T

* lispusers/EQUATIONS: image object no longer saves state on the stream, not the window (which may not be there).

* Rename CHARNAME to be CHARCODE.ENCODE, parallel to CHARCODE.DECODE
This commit is contained in:
rmkaplan
2025-07-03 00:06:10 -07:00
committed by GitHub
parent d6253dbffd
commit 63d5849a15
47 changed files with 5481 additions and 4204 deletions
Download Patch File Download Diff File Expand all files Collapse all files

560
library/tedit/TEDIT
View File

File diff suppressed because it is too large Load Diff

18
library/tedit/TEDIT-ABBREV
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 10:13:36" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;21 15982
(FILECREATED "24-Apr-2025 23:45:12" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;23 16200
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.ABBREV.PARSE)
:PREVIOUS-DATE "23-Mar-2025 17:09:00" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;20)
:PREVIOUS-DATE "20-Apr-2025 23:30:29" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;22)
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
@@ -63,7 +63,8 @@
(DEFINEQ
(\TEDIT.ABBREV.EXPAND
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Mar-2025 21:52 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Apr-2025 23:30 by rmk")
(* ; "Edited 20-Mar-2025 21:52 by rmk")
(* ; "Edited 30-May-91 19:27 by jds")
(* ; "Expand an abbvreviation")
(LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL))
@@ -92,11 +93,12 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL
(PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND)
TEXTOBJ)))
TEXTOBJ SEL)
TSTREAM SEL)
else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T])
(\TEDIT.ABBREV.PARSE
[LAMBDA (TSTREAM SEL) (* ; "Edited 28-Mar-2025 10:11 by rmk")
[LAMBDA (TSTREAM SEL) (* ; "Edited 24-Apr-2025 23:45 by rmk")
(* ; "Edited 28-Mar-2025 10:11 by rmk")
(* ; "Edited 23-Mar-2025 17:08 by rmk")
(* ; "Edited 20-Mar-2025 22:21 by rmk")
@@ -159,7 +161,7 @@
FIRST# LEN))) (* ; "Extend if a ,")
[for C KEY END in CANDIDATES
do
(* ;; "Comma for XCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")
(* ;; "Comma for MCCS character names, - and / - for internal punctuation (3/4 EM-DASH). Adjacent character must be text")
(if [AND (MEMB (\TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C)))
(CHARCODE (%, / -)))
@@ -306,6 +308,6 @@
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2933 14638 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12340) (
\TEDIT.EXPAND.DATE 12342 . 12975) (\TEDIT.TRY.ABBREV 12977 . 14636)))))
(FILEMAP (NIL (2933 14856 (\TEDIT.ABBREV.EXPAND 2943 . 5163) (\TEDIT.ABBREV.PARSE 5165 . 12558) (
\TEDIT.EXPAND.DATE 12560 . 13193) (\TEDIT.TRY.ABBREV 13195 . 14854)))))
STOP

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

Binary file not shown.

106
library/tedit/TEDIT-BUTTONS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;223 124611
(FILECREATED "30-Apr-2025 14:09:18" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;228 125393
:EDIT-BY rmk
:CHANGES-TO (FNS MB.FIELD.INSURETYPE MB.BUTTONEVENTINFN)
:CHANGES-TO (FNS MB.NWAY.ADDITEM MB.NWAY.CREATE MB.NWAY.SETSTATEFN MB.NWAY.SELECT)
:PREVIOUS-DATE "14-Mar-2025 15:29:51" {WMEDLEY}<library>TEDIT>TEDIT-BUTTONS.;219)
:PREVIOUS-DATE "14-Apr-2025 23:50:23" {WMEDLEY}<library>tedit>TEDIT-BUTTONS.;226)
(PRETTYCOMPRINT TEDIT-BUTTONSCOMS)
@@ -67,7 +67,8 @@
(DEFINEQ
(MB.ADD
[LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 5-Jan-2025 11:36 by rmk")
[LAMBDA (MENUDESC MENUTSTREAM WHERE INCREMENTALUPDATES) (* ; "Edited 6-Apr-2025 14:35 by rmk")
(* ; "Edited 5-Jan-2025 11:36 by rmk")
(* ; "Edited 22-Oct-2024 09:16 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 18-Oct-2024 13:49 by rmk")
@@ -156,10 +157,10 @@
(* ;; "Form to be evaluated")
(add CH# (EVAL TYPE))
else (\ILLEGAL.ARG DESC))) finally (\TEDIT.SHOWSEL NIL NIL MENUTSTREAM)
else (\ILLEGAL.ARG DESC))) finally (\TEDIT.NOSEL MENUTSTREAM)
(* ;
 "User has to click to get a selection")
(SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ))
(SETSEL (TEXTSEL (FTEXTOBJ MENUTSTREAM))
SET NIL)
(RETURN CH#)))])
@@ -753,6 +754,7 @@
(MB.3STATE.BUTTONEVENTINFN
[LAMBDA (OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
(* ; "Edited 14-Apr-2025 23:49 by rmk")
(* ; "Edited 22-Dec-2024 22:45 by rmk")
(* ; "Edited 7-Dec-2024 13:11 by rmk")
(* ; "Edited 5-Dec-2024 21:53 by rmk")
@@ -794,8 +796,7 @@
else (* ; "Buttons came up: do it")
(IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
(CL:WHEN (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
(APPLY* STATECHANGEFN OBJ NEXTSTATE (fetch (TEXTWINDOW WTEXTSTREAM)
of MENUDS)))])
(APPLY* STATECHANGEFN OBJ NEXTSTATE (PANETEXTSTREAM MENUDS)))])
(TEDIT.BACKTOMAIN MENUTSTREAM)))
'DON'T])
)
@@ -816,7 +817,8 @@
(DEFINEQ
(MB.NWAY.CREATE
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Feb-2025 12:08 by rmk")
[LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 30-Apr-2025 14:06 by rmk")
(* ; "Edited 16-Feb-2025 12:08 by rmk")
(* ; "Edited 9-Jan-2025 11:38 by rmk")
(* ; "Edited 4-Jan-2025 21:39 by rmk")
(* ; "Edited 20-Dec-2024 22:17 by rmk")
@@ -833,6 +835,7 @@
(* gbn "24-Sep-84 15:31")
(LET ((IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC)))
(BUTTONS (CADR (ASSOC 'BUTTONS SPEC)))
(SORTBUTTONS (CADR (ASSOC 'SORTBUTTONS SPEC)))
[FONT (FONTCREATE (OR (CADR (ASSOC 'FONT SPEC))
'(HELVETICA 8 BOLD]
(STATECHANGEFN (CADR (ASSOC 'STATECHANGEFN SPEC)))
@@ -876,14 +879,14 @@
(* ;; "At most, we're as wide as the N widest buttons put together. COPY because we want to preserve the original order")
[IMAGEOBJPROP OBJ 'MAXWIDTH (for SOBJ
in [SORT (COPY SUBOBJECTS)
(FUNCTION (LAMBDA (A B)
(IGEQ (fetch XSIZE
of (IMAGEOBJPROP A 'BOUNDBOX))
(fetch XSIZE
of (IMAGEOBJPROP B 'BOUNDBOX]
as I from 1 to MAXITEMS/LINE
(CL:WHEN SORTBUTTONS
(IMAGEOBJPROP OBJ 'SORTBUTTONS T)
[SETQ SUBOBJECTS (SORT SUBOBJECTS (FUNCTION (LAMBDA (A B)
(IGEQ (fetch XSIZE
of (IMAGEOBJPROP A 'BOUNDBOX))
(fetch XSIZE
of (IMAGEOBJPROP B 'BOUNDBOX])
[IMAGEOBJPROP OBJ 'MAXWIDTH (for SOBJ in SUBOBJECTS as I from 1 to MAXITEMS/LINE
sum (fetch XSIZE of (IMAGEOBJPROP SOBJ 'BOUNDBOX))
finally (RETURN (IPLUS $$VAL (ITIMES SPACING (SUB1
MAXITEMS/LINE
@@ -1191,7 +1194,8 @@
(RETURN (DREVERSE LINES])
(MB.NWAY.ADDITEM
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 9-Jan-2025 11:38 by rmk")
[LAMBDA (OBJ NEWBUTTON) (* ; "Edited 30-Apr-2025 14:09 by rmk")
(* ; "Edited 9-Jan-2025 11:38 by rmk")
(* ; "Edited 20-Oct-2024 00:13 by rmk")
(* ; "Edited 29-Sep-2024 12:47 by rmk")
(* ; "Edited 26-Aug-2024 09:36 by rmk")
@@ -1205,15 +1209,17 @@
(* ;; "Given an existing n-way choice menu button, add another choice to the list. The items are arranged in alphabetical order by their labels. MAXITEMS/LINE is goofy: it should flow with reshaping of the window.")
(CL:WHEN NEWBUTTON
(LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS))
[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,NEWBUTTON)
(LET* [[NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,NEWBUTTON)
(LABEL ,NEWBUTTON)
(FONT ,(IMAGEOBJPROP OBJ 'FONT]
(SUBOBJECTS (APPEND (IMAGEOBJPROP OBJ 'SUBOBJECTS)
(CONS NEWSOBJ)))
(MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE]
[SETQ SUBOBJECTS (SORT (CONS NEWSOBJ SUBOBJECTS)
(FUNCTION (LAMBDA (S1 S2)
(ALPHORDER (IMAGEOBJPROP S1 'LABEL)
(IMAGEOBJPROP S2 'LABEL]
(CL:WHEN (IMAGEOBJPROP OBJ 'SORTBUTTONS)
[SETQ SUBOBJECTS (SORT SUBOBJECTS (FUNCTION (LAMBDA (S1 S2)
(ALPHORDER (IMAGEOBJPROP S1
'LABEL)
(IMAGEOBJPROP S2 'LABEL])
(IMAGEOBJPROP OBJ 'SUBOBJECTS SUBOBJECTS)
[IMAGEOBJPROP OBJ 'MINWIDTH (IMAX (IMAGEOBJPROP OBJ 'MINWIDTH)
(fetch XSIZE of (IMAGEOBJPROP NEWSOBJ 'BOUNDBOX]
@@ -1379,6 +1385,7 @@
(MB.TOGGLE.BUTTONEVENTINFN
[LAMBDA (OBJ MENUDS MENUSEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)
(* ; "Edited 14-Apr-2025 23:49 by rmk")
(* ; "Edited 7-Dec-2024 13:11 by rmk")
(* ; "Edited 19-Oct-2024 19:52 by rmk")
(* ; "Edited 5-Oct-2024 22:42 by rmk")
@@ -1422,8 +1429,8 @@
else (* ; "Buttons came up: do it")
(SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN))
(if (OR (NULL STATECHANGEFN)
(NEQ 'DON'T (APPLY* STATECHANGEFN OBJ NEXTSTATE
(fetch (TEXTWINDOW WTEXTSTREAM) of MENUDS)
(NEQ 'DON'T (APPLY* STATECHANGEFN OBJ NEXTSTATE (PANETEXTSTREAM
MENUDS)
MENUSEL)))
then (IMAGEOBJPROP OBJ 'STATE NEXTSTATE)
(* ;
@@ -1774,7 +1781,8 @@
ENDPC])
(MB.FIELD.SETSTATEFN
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 9-Dec-2024 22:14 by rmk")
[LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 6-Apr-2025 12:23 by rmk")
(* ; "Edited 9-Dec-2024 22:14 by rmk")
(* ; "Edited 4-Dec-2024 20:31 by rmk")
(* ; "Edited 20-Oct-2024 17:20 by rmk")
(* ; "Edited 29-Sep-2024 12:46 by rmk")
@@ -1818,7 +1826,7 @@
 "FSEL selects the field to the right of PREFIXPC")
(\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT)
(CL:UNLESS (EQ 0 FIELDLENGTH) (* ; "Clear the old value")
(\TEDIT.DELETE TEXTOBJ FSEL)
(\TEDIT.DELETE TSTREAM FSEL)
(SETQ FIELDLENGTH 0))
(SETQ FIELDLENGTH (if (EQ NEWVALUE '**EMPTY**)
then 0
@@ -1961,25 +1969,25 @@
(MB.FIELD.INIT)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3253 19106 (MB.ADD 3263 . 9692) (MB.DELETE 9694 . 10068) (MB.GET 10070 . 16840) (
MB.GET.MBARG 16842 . 18511) (TEDIT.BACKTOMAIN 18513 . 19104)) (19150 39086 (MB.BUTTONEVENTINFN 19160
. 20728) (MB.DISPLAYFN 20730 . 22789) (MB.SETIMAGE 22791 . 23959) (MB.SIZEFN 23961 . 25509) (
MB.WHENOPERATEDONFN 25511 . 27460) (MB.COPYFN 27462 . 27920) (MB.GETFN 27922 . 28883) (MB.PUTFN 28885
. 29985) (MB.SHOWSELFN 29987 . 31496) (MB.CREATE 31498 . 35521) (MB.CHANGENAME 35523 . 36005) (
MB.INIT 36007 . 37468) (MB.TRACK.UNTIL 37470 . 38165) (MB.DON'T 38167 . 38463) (MB.SPEC.REMAINDER
38465 . 39084)) (39248 49238 (MB.3STATE.CREATE 39258 . 40122) (MB.3STATE.DISPLAYFN 40124 . 41110) (
MB.3STATE.SHOWSELFN 41112 . 43423) (MB.3STATE.INIT 43425 . 44836) (MB.3STATE.SETSTATEFN 44838 . 45496)
(MB.3STATE.BUTTONEVENTINFN 45498 . 49236)) (49393 80061 (MB.NWAY.CREATE 49403 . 55445) (
MB.NWAY.DISPLAYFN 55447 . 56310) (MB.NWAY.WHENOPERATEDONFN 56312 . 58502) (MB.NWAY.SIZEFN 58504 .
62440) (MB.NWAY.SELECT 62442 . 66012) (MB.NWAY.BUTTONEVENTINFN 66014 . 69226) (MB.NWAY.NEWMENUBUTTON
69228 . 69940) (MB.NWAY.COPYFN 69942 . 70909) (MB.NWAY.INIT 70911 . 72402) (MB.NWAY.ARRANGEBUTTONS
72404 . 74375) (MB.NWAY.ADDITEM 74377 . 78239) (MB.NWAY.FINDSUBOBJ 78241 . 78755) (MB.NWAY.SETSTATEFN
78757 . 80059)) (80140 92027 (MB.TOGGLE.CREATE 80150 . 81145) (MB.TOGGLE.DISPLAYFN 81147 . 82630) (
MB.TOGGLE.INIT 82632 . 84431) (MB.SET.TOGGLE 84433 . 85634) (MB.TOGGLE.SETSTATEFN 85636 . 86476) (
MB.TOGGLE.BUTTONEVENTINFN 86478 . 90682) (MB.TOGGLE.WHENOPERATEDONFN 90684 . 92025)) (92108 124532 (
MB.FIELD.CREATE 92118 . 97569) (MB.FIELD.DISPLAYFN 97571 . 98362) (MB.FIELD.IMAGEBOXFN 98364 . 99846)
(MB.FIELD.PREFIXCREATE 99848 . 103784) (MB.FIELD.SUFFIXCREATE 103786 . 105446) (MB.FIELD.INIT 105448
. 107215) (MB.FIELD.WHENOPERATEDONFN 107217 . 108488) (MB.FIELD.GETSTATEFN 108490 . 112424) (
MB.FIELD.SETSTATEFN 112426 . 117121) (MB.FIELD.BUTTONEVENTINFN 117123 . 119428) (MB.FIELD.SIZEFN
119430 . 119670) (MB.FIELD.INSURETYPE 119672 . 124530)))))
(FILEMAP (NIL (3279 19224 (MB.ADD 3289 . 9810) (MB.DELETE 9812 . 10186) (MB.GET 10188 . 16958) (
MB.GET.MBARG 16960 . 18629) (TEDIT.BACKTOMAIN 18631 . 19222)) (19268 39204 (MB.BUTTONEVENTINFN 19278
. 20846) (MB.DISPLAYFN 20848 . 22907) (MB.SETIMAGE 22909 . 24077) (MB.SIZEFN 24079 . 25627) (
MB.WHENOPERATEDONFN 25629 . 27578) (MB.COPYFN 27580 . 28038) (MB.GETFN 28040 . 29001) (MB.PUTFN 29003
. 30103) (MB.SHOWSELFN 30105 . 31614) (MB.CREATE 31616 . 35639) (MB.CHANGENAME 35641 . 36123) (
MB.INIT 36125 . 37586) (MB.TRACK.UNTIL 37588 . 38283) (MB.DON'T 38285 . 38581) (MB.SPEC.REMAINDER
38583 . 39202)) (39366 49371 (MB.3STATE.CREATE 39376 . 40240) (MB.3STATE.DISPLAYFN 40242 . 41228) (
MB.3STATE.SHOWSELFN 41230 . 43541) (MB.3STATE.INIT 43543 . 44954) (MB.3STATE.SETSTATEFN 44956 . 45614)
(MB.3STATE.BUTTONEVENTINFN 45616 . 49369)) (49526 80622 (MB.NWAY.CREATE 49536 . 55719) (
MB.NWAY.DISPLAYFN 55721 . 56584) (MB.NWAY.WHENOPERATEDONFN 56586 . 58776) (MB.NWAY.SIZEFN 58778 .
62714) (MB.NWAY.SELECT 62716 . 66286) (MB.NWAY.BUTTONEVENTINFN 66288 . 69500) (MB.NWAY.NEWMENUBUTTON
69502 . 70214) (MB.NWAY.COPYFN 70216 . 71183) (MB.NWAY.INIT 71185 . 72676) (MB.NWAY.ARRANGEBUTTONS
72678 . 74649) (MB.NWAY.ADDITEM 74651 . 78800) (MB.NWAY.FINDSUBOBJ 78802 . 79316) (MB.NWAY.SETSTATEFN
79318 . 80620)) (80701 92700 (MB.TOGGLE.CREATE 80711 . 81706) (MB.TOGGLE.DISPLAYFN 81708 . 83191) (
MB.TOGGLE.INIT 83193 . 84992) (MB.SET.TOGGLE 84994 . 86195) (MB.TOGGLE.SETSTATEFN 86197 . 87037) (
MB.TOGGLE.BUTTONEVENTINFN 87039 . 91355) (MB.TOGGLE.WHENOPERATEDONFN 91357 . 92698)) (92781 125314 (
MB.FIELD.CREATE 92791 . 98242) (MB.FIELD.DISPLAYFN 98244 . 99035) (MB.FIELD.IMAGEBOXFN 99037 . 100519)
(MB.FIELD.PREFIXCREATE 100521 . 104457) (MB.FIELD.SUFFIXCREATE 104459 . 106119) (MB.FIELD.INIT 106121
. 107888) (MB.FIELD.WHENOPERATEDONFN 107890 . 109161) (MB.FIELD.GETSTATEFN 109163 . 113097) (
MB.FIELD.SETSTATEFN 113099 . 117903) (MB.FIELD.BUTTONEVENTINFN 117905 . 120210) (MB.FIELD.SIZEFN
120212 . 120452) (MB.FIELD.INSURETYPE 120454 . 125312)))))
STOP

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

Binary file not shown.

91
library/tedit/TEDIT-CHAT
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17 12449
(FILECREATED "21-Apr-2025 23:06:01" {WMEDLEY}<library>tedit>TEDIT-CHAT.;20 12175
:EDIT-BY rmk
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
:CHANGES-TO (FNS TEDIT.DISPLAYTEXT)
:PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16)
:PREVIOUS-DATE "11-Mar-2025 15:41:08" {WMEDLEY}<library>tedit>TEDIT-CHAT.;17)
(PRETTYCOMPRINT TEDIT-CHATCOMS)
@@ -92,98 +92,99 @@
(DEFINEQ
(TEDIT.DISPLAYTEXT
[LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 23-Dec-2023 09:15 by rmk")
[LAMBDA (TSTREAM CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 21-Apr-2025 23:05 by rmk")
(* ; "Edited 23-Dec-2023 09:15 by rmk")
(* ; "Edited 6-Apr-2023 21:39 by rmk")
(* ; "Edited 4-Nov-2022 17:18 by rmk")
(* ; "Edited 25-Sep-2022 13:34 by rmk")
(* ; "Edited 6-Aug-2022 13:28 by rmk")
(* ; "Edited 12-Jun-90 18:01 by mitani")
(* ; "Edited 6-Aug-2022 13:28 by rmk")
(* ;
 "This function does the actual displaying of typed-in text on the edit window.")
(* This function does the actual
 displaying of typed-in text on the
 edit window.)
(HELP 'TEDIT.DISPLAYTEXT 'NOTUSED?)
(PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
(LINEDESCRIPTOR! LINE)
(NOTUSED)
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(LOOKS (\TEDIT.APPLY.STYLES (FGETTOBJ TEXTOBJ CARETLOOKS)
(\TEDIT.CARETPIECE TEXTOBJ)
(fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))
(TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ))
TSTREAM))
(TERMSA (FGETTOBJ TEXTOBJ TXTTERMSA))
DY FONT)
(MOVETO XPOINT (IPLUS (fetch YBASE of LINE)
(OR (fetch CLOFFSET of LOOKS)
(MOVETO XPOINT (IPLUS (GETLD LINE YBASE)
(OR (FGETCLOOKS LOOKS CLOFFSET)
0))
DS) (* Set the display stream position)
DS) (* ; "Set the display stream position")
(COND
[TERMSA (* Special terminal table for
 controlling character display.
 Use it.)
[TERMSA (* ;
 "Special terminal table for controlling character display. Use it.")
(RESETLST
(RESETSAVE \PRIMTERMSA TERMSA)
[COND
[(STRINGP CH)
(for CHAR instring CH
do (SELCHARQ CHAR
(TAB (* Put down white)
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(TAB (* ; "Put down white")
(BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
36
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(CR (BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
(IMAX 6 (CHARWIDTH CHAR FONT))
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE))
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
CHAR]
(\DSPPRINTCHAR TSTREAM CHAR]
(T (SELCHARQ CH
(TAB (* Put down white)
(BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(TAB (* ; "Put down white")
(BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
36
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(EOL (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE)
(EOL (BITBLT NIL 0 0 DS XPOINT (FGETLD LINE YBOT)
(IMAX 6 (CHARWIDTH CH FONT))
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE))
(\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
CH])]
(T (* No special handling;
 just use native character codes)
(\DSPPRINTCHAR TSTREAM CH])]
(T (* ;
 "No special handling; just use native character codes")
(COND
[(STRINGP CH)
(for CHAR instring CH do (SELCHARQ CHAR
(TAB (* Put down white)
(TAB (* ; "Put down white")
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(FGETLD LINE YBOT)
36
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(EOL (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(FGETLD LINE YBOT)
(IMAX 6 (CHARWIDTH CHAR FONT))
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE))
(BLTCHAR CHAR DS]
(T (SELCHARQ CH
(TAB (* Put down white)
(TAB (* ; "Put down white")
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(FGETLD LINE YBOT)
36
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE)
(RELMOVETO 36 0 DS))
(EOL (* Blank out the CR's width.)
(EOL (* ; "Blank out the CR's width.")
(BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS)
(fetch YBOT of LINE)
(FGETLD LINE YBOT)
(IMAX 6 (CHARWIDTH CH FONT))
(fetch LHEIGHT of LINE)
(FGETLD LINE LHEIGHT)
'TEXTURE
'REPLACE WHITESHADE))
(BLTCHAR CH DS])
@@ -214,6 +215,6 @@
CHATDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559)))))
(FILEMAP (NIL (887 4631 (TEDITSTREAM.INIT 897 . 1824) (TEDITCHAT.MENUFN 1826 . 3662) (TEDITCHAT.CHARFN
3664 . 4629)) (4678 11287 (TEDIT.DISPLAYTEXT 4688 . 11285)))))
STOP

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

Binary file not shown.

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

Binary file not shown.

259
library/tedit/TEDIT-FILE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 14:24:34" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;608 161966
(FILECREATED "31-May-2025 10:42:55" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;628 165414
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE)
:CHANGES-TO (FNS TEDIT.GET)
:PREVIOUS-DATE "26-Mar-2025 10:02:49" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;607)
:PREVIOUS-DATE "30-May-2025 11:21:42" {WMEDLEY}<library>TEDIT>TEDIT-FILE.;627)
(PRETTYCOMPRINT TEDIT-FILECOMS)
@@ -36,7 +36,8 @@
(P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1]
(FNS \TEDIT.GET.PIECES3 \TEDIT.GET.IDATE3 \TEDIT.MAKE.STRINGPIECE)
(FNS \TEDIT.GET.UNFORMATTED.FILE.XCCS \TEDIT.INTERPRET.XCCS.SHIFTS)
(FNS \TEDIT.GET.UNFORMATTED.FILE.MCCS \TEDIT.INTERPRET.MCCS.SHIFTS
\TEDIT.CONVERT.XCCSTOMCCS)
(* ; "XCCS")
(FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8)
(* ; "UTF-8")
@@ -45,7 +46,7 @@
(FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS)
(FNS \TEDIT.GET.OBJECT))
(COMS
(* ;; "Putting (pageframe functions on TEDIT-PAGE)")
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
(FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER
\TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW
@@ -55,7 +56,8 @@
(FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS))
(GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*)
(FNS TEDITFROMLISPSOURCE SHELLSCRIPTP TEDITFROMSHELLSCRIPT)
(INITVARS (TEDIT.SOURCE.LINELENGTH 110))
(INITVARS (TEDIT.SOURCE.LINELENGTH 110)
(TEDIT.SOURCE.NLINES 30))
(ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT)))
(INITVARS (* ;
@@ -118,7 +120,9 @@
(DEFINEQ
(TEDIT.GET
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 14-Mar-2025 11:52 by rmk")
[LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 19-Apr-2025 10:31 by rmk")
(* ; "Edited 6-Apr-2025 14:26 by rmk")
(* ; "Edited 14-Mar-2025 11:52 by rmk")
(* ; "Edited 26-Aug-2024 16:15 by rmk")
(* ; "Edited 11-Aug-2024 12:13 by rmk")
(* ; "Edited 29-Jun-2024 16:30 by rmk")
@@ -180,8 +184,7 @@
(* ;; "New file is good, clean out the old stuff")
(\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ)
NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.TEXTCLOSEF TEXTOBJ) (* ;
 "Close the old files, still in TXTFILE")
@@ -189,9 +192,10 @@
(* ;; "Open a textstream NTSTREAM on the new file, then reconnect its textobj to the old TSTREAM and window")
(SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
(SETQ BEING-EDITED (GETTEXTPROP TEXTOBJ 'BEING-EDITED))
(SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ))
(CL:WHEN MAINWINDOW
(TEDIT.KILL TEXTOBJ)
(SETQ TEDITCREATED (WINDOWPROP MAINWINDOW 'TEDITCREATED)))
(CL:WHEN UNFORMATTED?
(push PROPS 'CLEARGET T))
@@ -392,7 +396,9 @@
(TEDIT.INCLUDE TSTREAM INFILE START END SAFE T])
(TEDIT.PUT
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "Edited 14-Mar-2025 11:52 by rmk")
[LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "Edited 25-Apr-2025 23:33 by rmk")
(* ; "Edited 22-Apr-2025 15:58 by rmk")
(* ; "Edited 14-Mar-2025 11:52 by rmk")
(* ; "Edited 22-Feb-2025 15:56 by rmk")
(* ; "Edited 23-Dec-2024 23:02 by rmk")
(* ; "Edited 11-Aug-2024 12:30 by rmk")
@@ -496,7 +502,7 @@
(* ;; "We don't know how to decide that the user doesn't want to continue editing and therefore doesn't need the pieces to be updated to the new file. The stream itself may be used in the future, even if right now there is no process or window")
(SETQ CHARSTREAM (TEDIT.PUT.STREAM TSTREAM CHARSTREAM UNFORMATTED? NIL T))
(SETQ CHARSTREAM (TEDIT.PUT.STREAM TSTREAM CHARSTREAM UNFORMATTED? NEWEXTFORMAT T))
(* ;; "The file is written, nothing can be lost. CHARSTREAM isn't closed yet")
@@ -527,6 +533,7 @@
(TEDIT.PUT.STREAM
[LAMBDA (TSTREAM DESTSTREAM UNFORMATTED? EXTERNALFORMAT CONTINUE)
(* ; "Edited 30-May-2025 11:21 by rmk")
(* ; "Edited 20-Nov-2024 16:26 by rmk")
(* ; "Edited 22-Sep-2024 18:40 by rmk")
(* ; "Edited 14-May-2024 17:49 by rmk")
@@ -571,6 +578,7 @@
(FSETTOBJ TEXTOBJ \XDIRTY NIL)
(\TEDIT.UPDATE.TITLE TEXTOBJ DESTSTREAM)
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Put))
(PUTTEXTPROP TEXTOBJ 'CLEARGET UNFORMATTED?)
DESTSTREAM
elseif OPENEDHERE
then (OR (CLOSEF? DESTSTREAM)
@@ -624,7 +632,8 @@
TSTREAM)])
(\TEDIT.GET.UNFORMATTED.FILE
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 8-Feb-2025 20:21 by rmk")
[LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 24-Apr-2025 17:21 by rmk")
(* ; "Edited 8-Feb-2025 20:21 by rmk")
(* ; "Edited 17-Mar-2024 00:21 by rmk")
(* ; "Edited 5-Feb-2024 09:26 by rmk")
(* ; "Edited 21-Jan-2024 09:42 by rmk")
@@ -650,8 +659,9 @@
(SETQ STREAM (COPYFILE STREAM '{NODIRCORE})))
[SETQ PIECES
(SELECTQ FORMAT
(:XCCS (\TEDIT.GET.UNFORMATTED.FILE.XCCS STREAM START END DEFAULTCHARLOOKS
DEFAULTPARALOOKS))
((:MCCS :XCCS) (* ; "XCCS is done later")
(\TEDIT.GET.UNFORMATTED.FILE.MCCS STREAM START END DEFAULTCHARLOOKS
DEFAULTPARALOOKS))
(:UTF-8 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 STREAM START END DEFAULTCHARLOOKS
DEFAULTPARALOOKS))
(:STRING (CL:WHEN (\IOMODEP STREAM 'OUTPUT T)
@@ -904,7 +914,8 @@
(DEFINEQ
(\TEDIT.GET.PIECES3
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 8-Feb-2025 20:21 by rmk")
[LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 24-Apr-2025 17:20 by rmk")
(* ; "Edited 8-Feb-2025 20:21 by rmk")
(* ; "Edited 30-Aug-2024 15:44 by rmk")
(* ; "Edited 11-Jul-2024 13:20 by rmk")
(* ; "Edited 29-Apr-2024 10:37 by rmk")
@@ -1035,9 +1046,14 @@
(change (PPARALOOKS P)
(CL:UNLESS (EQ DATUM 0)
(* ; " For the last piece?")
(ELT PARALOOKSMAP DATUM))))]
(CL:WHEN (EQ :XCCS (STREAMPROP TEXT 'FORMAT))
(\TEDIT.INTERPRET.XCCS.SHIFTS PC TEXT))
(ELT PARALOOKSMAP DATUM))))]
(* ;; "Produce MCCS codes for XCCS files, fix up later")
(SELECTQ (STREAMPROP TEXT 'FORMAT)
((:MCCS :XCCS)
(\TEDIT.INTERPRET.MCCS.SHIFTS PC TEXT))
NIL)
(RETURN PC])
(\TEDIT.GET.IDATE3
@@ -1098,7 +1114,7 @@
)
(DEFINEQ
(\TEDIT.GET.UNFORMATTED.FILE.XCCS
(\TEDIT.GET.UNFORMATTED.FILE.MCCS
[LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 21-Jan-2024 09:40 by rmk")
(* ; "Edited 12-Jan-2024 13:13 by rmk")
(* ; "Edited 10-Jan-2024 11:19 by rmk")
@@ -1201,7 +1217,7 @@
(CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR)))
(SETQ EOLC CR.EOLC])
(\TEDIT.INTERPRET.XCCS.SHIFTS
(\TEDIT.INTERPRET.MCCS.SHIFTS
[LAMBDA (PIECES PFILE) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 14-May-2024 18:39 by rmk")
(* ; "Edited 21-Jan-2024 00:02 by rmk")
@@ -1290,6 +1306,20 @@
(replace (STREAM EOLCONVENTION)
of PFILE with EOLC)))
PIECES])
(\TEDIT.CONVERT.XCCSTOMCCS
[LAMBDA (TSTREAM) (* ; "Edited 24-Apr-2025 17:10 by rmk")
(* ;; "Brute force way of converting a known-to-be MCCS stream into an XCCS stream")
(* ;
 "Don't accumulate history during this transformation;")
(RESETLST
[RESETSAVE (TEXTPROP TSTREAM 'HISTORY 'OFF)
`(PROGN (TEXTPROP ,TSTREAM 'HISTORY OLDVALUE]
(for CHNO CHAR from 1 to (TEDIT.NCHARS TSTREAM) when (SMALLP (SETQ CHAR (TEDIT.NTHCHARCODE
TSTREAM CHNO)))
unless (EQ CHAR (SETQ CHAR (MTOXCODE CHAR))) do (\TEDIT.RPLCHARCODE TSTREAM CHNO CHAR NIL
T)))])
)
@@ -1415,7 +1445,8 @@
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE TEXTOBJ])
(\TEDIT.GET.SINGLE.CHARLOOKS
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 2-Jan-2025 11:08 by rmk")
[LAMBDA (FILE TEXTOBJ) (* ; "Edited 22-Apr-2025 15:20 by rmk")
(* ; "Edited 2-Jan-2025 11:08 by rmk")
(* ; "Edited 11-Dec-2024 22:59 by rmk")
(* ; "Edited 9-Dec-2024 20:11 by rmk")
(* ; "Edited 13-Aug-2024 08:49 by rmk")
@@ -1423,8 +1454,6 @@
(* ; "Edited 7-Apr-2024 17:21 by rmk")
(* ; "Edited 16-Jan-2024 22:46 by rmk")
(* ; "Edited 21-Dec-2023 23:54 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:21 by rmk")
(* ; "Edited 24-Aug-2023 15:05 by rmk")
(* ; "Edited 20-Feb-2022 12:42 by larry")
(* ; "Edited 30-May-91 20:25 by jds")
@@ -1436,15 +1465,22 @@
(PROG* ((LOOKS (create CHARLOOKS))
(FILEPOS (GETFILEPTR FILE))
(LOOKSLEN (\WIN FILE))
FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC)
FONT NAME SIZE SUPER PROPS STYLESTR BOLD ITALIC EXTRAS)
(SETQ NAME (\ARBIN FILE)) (* ; "The font name")
(SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points")
(SETQ SUPER (\SMALLPIN FILE)) (* ;
 "Superscripting distance, could be negative")
(FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE)
0))
(FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE))
(SETQ PROPS (\WIN FILE))
(SETQ EXTRAS (\ARBIN FILE))
(if [AND (EQ '\TEDIT.COLOR (CAR (LISTP (CAR (LISTP EXTRAS]
then (FSETCLOOKS LOOKS CLCOLOR (CADR (ASSOC '\TEDIT.COLOR EXTRAS)))
(* ; "Color tells us it's an alist")
(FSETCLOOKS LOOKS CLUSERINFO (CADR (ASSOC '\TEDIT.USERINFO EXTRAS)))
else (* ; "Pre color, create installed BLACK")
(FSETCLOOKS LOOKS CLCOLOR 'BLACK)
(FSETCLOOKS LOOKS CLUSERINFO EXTRAS))
(SETQ PROPS (\WIN FILE)) (* ; "All the bits")
[SETQ BOLD (NOT (ZEROP (LOGAND 512 PROPS]
[SETQ ITALIC (NOT (ZEROP (LOGAND 256 PROPS]
(with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS]
@@ -1692,12 +1728,13 @@
(* ;; "Putting (pageframe functions on TEDIT-PAGE)")
(* ;; "Putting pageframe functions are on TEDIT-PAGE)")
(DEFINEQ
(\TEDIT.PUT.PCTB
[LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE)
(* ; "Edited 26-Apr-2025 00:11 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 15-May-2024 17:03 by rmk")
(* ; "Edited 16-Mar-2024 12:40 by rmk")
@@ -1784,9 +1821,9 @@
(PPARALAST (PREVPIECE PC)))
(\TEDIT.PUT.PARALOOKS FORMATSTREAM PC PARAHASH)
(add PCCOUNT 1))
(CL:WHEN (EQ EXTFORMAT :XCCS)
(CL:WHEN (MEMB EXTFORMAT '(:MCCS :XCCS))
(* ;; "For XCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
(* ;; "For MCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.")
(CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC)
FAT.PTYPES)
@@ -1896,7 +1933,9 @@
(\WOUT FORMATSTREAM (IPLUS 31415 VERSION])
(\TEDIT.PUT.PCTB.MERGEABLE
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 14-May-2024 11:55 by rmk")
[LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 25-Apr-2025 23:50 by rmk")
(* ; "Edited 24-Apr-2025 16:02 by rmk")
(* ; "Edited 14-May-2024 11:55 by rmk")
(* ; "Edited 12-May-2024 21:57 by rmk")
(* ; "Edited 23-Jan-2024 09:12 by rmk")
(* ; "Edited 12-Jan-2024 09:46 by rmk")
@@ -1921,11 +1960,11 @@
(* ;; "PC cannot merge with PREVPC if PREVPC ends in EOL (even if not PPARALAST). (We assume here that EOL's of interest appear only in last-of-piece position.) For some input piece types we can make the decision without bothering to look at their last character. If the destination EXTFORMAT is :UTF-8, the splitter has presumably arranged it so that EOL's only appear in thin string and file pieces.")
[AND (SELECTQ EXTFORMAT
(:XCCS
(* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ")
((:MCCS :XCCS)
(* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ")
(EQ (THINPIECEP PREVPC)
(THINPIECEP PC)))
(EQ (THINPIECEP PREVPC)
(THINPIECEP PC)))
(:UTF-8
(* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PUTF8BYTESPERCHAR can be merged.")
@@ -1938,7 +1977,7 @@
(NEQ 0 (PCHARSET PREVPC)))
[AND (EQ EXTFORMAT :UTF-8)
(NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE]
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PREVPC (SUB1 (PLEN PREVPC)))
(NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE PREVPC (SUB1 (PLEN PREVPC)))
(CHARCODE (EOL LF])])])
(\TEDIT.PUT.UTF8.SPLITPIECES
@@ -2009,6 +2048,7 @@
(\TEDIT.PUT.PCTB.NEXTNEW
[LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)
(* ; "Edited 25-Apr-2025 08:48 by rmk")
(* ; "Edited 26-Mar-2025 09:27 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 14-May-2024 18:54 by rmk")
@@ -2024,7 +2064,7 @@
(* ;; "Note that the PCONTENTS (= PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level. For the same reason, PBINABLE isn't set here.")
(* ;; "NSHIFTBYTES strips any XCCS charset shifts at the beginning of the new piece.")
(* ;; "NSHIFTBYTES strips any MCCS/XCCS charset shifts at the beginning of the new piece.")
(SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES))
(FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE
@@ -2036,19 +2076,18 @@
THINFILE.PTYPE
UTF8.PTYPE))
(FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PC PUTF8BYTESPERCHAR)))
(:XCCS (* ;
((:MCCS :XCCS) (* ;
 "String pieces can be merged with corresponding file pieces")
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
(THINSTRING.PTYPE
THINFILE.PTYPE)
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
(FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC)
(THINSTRING.PTYPE
THINFILE.PTYPE)
((LIST FATSTRING.PTYPE FATFILE1.PTYPE)
(* ;
 "PCHARSET is not relevant for FILEFILE2")
(FSETPC NEXTNEW PBYTESPERCHAR 2)
FATFILE2.PTYPE)
(PTYPE PC))))
(\TEDIT.THELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT))
(* ;
(FSETPC NEXTNEW PBYTESPERCHAR 2)
FATFILE2.PTYPE)
(PTYPE PC))))
NIL) (* ;
 "Accumulate PLEN across merged pieces. Objects are always 1.")
[FSETPC NEXTNEW PLEN (CL:IF (EQ OBJECT.PTYPE (PTYPE NEXTNEW))
1
@@ -2057,7 +2096,7 @@
 "The file may have LF, but we want to restore EOL internally")
(CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW))
(EQ (CHARCODE EOL)
(\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC (PLEN PC]
(\TEDIT.PIECE.NTHCHARCODE PC (PLEN PC]
(if (EQ 1 (PLEN NEXTNEW))
then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE)
(FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL)))
@@ -2185,11 +2224,11 @@
(PUTHASH LOOKS I LOOKSHASH])
(\TEDIT.PUT.SINGLE.CHARLOOKS
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 2-Jan-2025 10:43 by rmk")
[LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 22-Apr-2025 14:50 by rmk")
(* ; "Edited 2-Jan-2025 10:43 by rmk")
(* ; "Edited 13-Aug-2024 08:47 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:07 by rmk")
(* ; "Edited 21-Dec-2023 23:54 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 26-Aug-2023 11:29 by rmk")
(* ; "Edited 15-Aug-2023 23:17 by rmk")
@@ -2198,40 +2237,43 @@
(* ;; "Put out a single CHARLOOKS description.")
(LET ((FILEPOS (GETFILEPTR FORMATSTREAM))
(FONT (fetch (CHARLOOKS CLFONT) of LOOKS))
(FONT (FGETCLOOKS LOOKS CLFONT))
LEN)
(\WOUT FORMATSTREAM 0) (* ;
 "Reserve space for the length of this looks")
[COND
((type? FONTCLASS FONT) (* ;
[if (type? FONTCLASS FONT)
then (* ;
 "For font classes, we need to save a list of device-FD sets")
(\ARBOUT FORMATSTREAM (FONTCLASSUNPARSE FONT)))
(T (* ;
(\ARBOUT FORMATSTREAM (FONTCLASSUNPARSE FONT))
else (* ;
 "For FONTDESCRIPTORs, do it the easy way")
(\ATMOUT FORMATSTREAM (FONTPROP FONT 'FAMILY] (* ; "The font family")
(\ATMOUT FORMATSTREAM (FONTPROP FONT 'FAMILY](* ; "The font family")
(\WOUT FORMATSTREAM (OR (FONTPROP FONT 'SIZE)
0)) (* ; "Size of the type, in points")
(\SMALLPOUT FORMATSTREAM (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS)
(\SMALLPOUT FORMATSTREAM (OR (FGETCLOOKS LOOKS CLOFFSET)
0)) (* ; "Super/subscripting distance")
(COND
([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS)
(NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS]
(\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLSTYLE) of LOOKS)))
(T (\WOUT FORMATSTREAM 0)))
(COND
((fetch (CHARLOOKS CLUSERINFO) of LOOKS)
(\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLUSERINFO) of LOOKS)))
(T (\WOUT FORMATSTREAM 0)))
(\WOUT FORMATSTREAM (LOGOR (CL:IF (fetch (CHARLOOKS CLSELBEFORE) of LOOKS)
(if [AND (FGETCLOOKS LOOKS CLSTYLE)
(NOT (ZEROP (FGETCLOOKS LOOKS CLSTYLE]
then (\ARBOUT FORMATSTREAM (FGETCLOOKS LOOKS CLSTYLE))
else (\WOUT FORMATSTREAM 0))
(* ;; "Make an ALIST, headed by \TEDIT.COLOR, for future expansion")
[\ARBOUT FORMATSTREAM (CONS (LIST '\TEDIT.COLOR (OR (FGETCLOOKS LOOKS CLCOLOR)
'BLACK))
(CL:IF (FGETCLOOKS LOOKS CLUSERINFO)
(CONS (LIST '\TEDIT.USERINFO (FGETCLOOKS LOOKS CLUSERINFO))))
]
(\WOUT FORMATSTREAM (LOGOR (CL:IF (FGETCLOOKS LOOKS CLSELBEFORE)
8192
0)
(CL:IF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLUNBREAKABLE LOOKS)
4096
0)
(CL:IF (fetch (CHARLOOKS CLLEADER) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLLEADER)
2048
0)
(CL:IF (fetch (CHARLOOKS CLINVERTED) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLINVERTED)
1024
0)
(CL:IF (EQ 'BOLD (FONTPROP FONT 'WEIGHT))
@@ -2240,28 +2282,28 @@
(CL:IF (EQ 'ITALIC (FONTPROP FONT 'SLOPE))
256
0)
(CL:IF (fetch (CHARLOOKS CLULINE) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLULINE)
128
0)
(CL:IF (fetch (CHARLOOKS CLOLINE) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLOLINE)
64
0)
(CL:IF (fetch (CHARLOOKS CLSTRIKE) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLSTRIKE)
32
0)
(CL:IF (fetch (CHARLOOKS CLSMALLCAP) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLSMALLCAP)
16
0)
(CL:IF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLPROTECTED)
8
0)
(CL:IF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLINVISIBLE)
4
0)
(CL:IF (fetch (CHARLOOKS CLSELAFTER) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLSELAFTER)
2
0)
(CL:IF (fetch (CHARLOOKS CLCANCOPY) of LOOKS)
(CL:IF (FGETCLOOKS LOOKS CLCANCOPY)
1
0)))
@@ -2470,7 +2512,9 @@
(DEFINEQ
(TEDITFROMLISPSOURCE
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 26-Mar-2025 10:02 by rmk")
[LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 7-Apr-2025 23:13 by rmk")
(* ; "Edited 1-Apr-2025 12:54 by rmk")
(* ; "Edited 26-Mar-2025 10:02 by rmk")
(* ; "Edited 18-Feb-2025 23:34 by rmk")
(* ; "Edited 17-Nov-2024 10:03 by rmk")
(* ; "Edited 25-Dec-2023 12:28 by rmk")
@@ -2492,12 +2536,15 @@
(* ;; "Estimate 110 characters per line in the default font?")
[PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
(PUTTEXTPROPS TSTREAM `(PARABREAKCHARS NIL OPENWIDTH ,(TIMES TEDIT.SOURCE.LINELENGTH
(CHARWIDTH (CHARCODE SPACE)
DEFAULTFONT))
OPENHEIGHT
,(TIMES TEDIT.SOURCE.NLINES (FONTPROP DEFAULTFONT 'HEIGHT))
BOUNDTABLE
,(TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE)
of USERTEMP]
of USERTEMP))
DEFAULTPUTEXTENSION ""))
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE)
" ...")
T)
@@ -2526,33 +2573,35 @@
(RPAQ? TEDIT.SOURCE.LINELENGTH 110)
(RPAQ? TEDIT.SOURCE.NLINES 30)
(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)
(SHELLSCRIPTP TEDITFROMSHELLSCRIPT))
(RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5064 34612 (TEDIT.GET 5074 . 11194) (TEDIT.FORMATTEDFILEP 11196 . 12512) (
TEDIT.FILEDATE 12514 . 13685) (TEDIT.INCLUDE 13687 . 21716) (TEDIT.RAW.INCLUDE 21718 . 22526) (
TEDIT.PUT 22528 . 30777) (TEDIT.PUT.STREAM 30779 . 34610)) (34613 54492 (\TEDIT.GET.FOREIGN.FILE 34623
. 38048) (\TEDIT.GET.UNFORMATTED.FILE 38050 . 42042) (\TEDIT.GET.FORMATTED.FILE 42044 . 45071) (
\TEDIT.FORMATTEDSTREAMP 45073 . 48091) (\ARBIN 48093 . 48813) (\ATMIN 48815 . 49352) (\DWIN 49354 .
49733) (\STRINGIN 49735 . 50443) (\TEDIT.GET.TRAILER 50445 . 52961) (\TEDIT.CACHEFILE 52963 . 54490))
(54658 68412 (\TEDIT.GET.PIECES3 54668 . 65174) (\TEDIT.GET.IDATE3 65176 . 66571) (
\TEDIT.MAKE.STRINGPIECE 66573 . 68410)) (68413 80788 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68423 . 74539)
(\TEDIT.INTERPRET.XCCS.SHIFTS 74541 . 80786)) (80810 86832 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80820 .
86830)) (86855 95480 (\TEDIT.GET.CHARLOOKS.LIST 86865 . 87596) (\TEDIT.GET.SINGLE.CHARLOOKS 87598 .
92292) (\TEDIT.GET.CHARLOOKS 92294 . 93624) (\TEDIT.GET.PARALOOKS.INDEX 93626 . 94170) (
\TEDIT.GET.CHARLOOKS.INDEX 94172 . 95478)) (95481 103138 (\TEDIT.GET.PARALOOKS.LIST 95491 . 96113) (
\TEDIT.GET.SINGLE.PARALOOKS 96115 . 103136)) (103139 106729 (\TEDIT.GET.OBJECT 103149 . 106727)) (
106791 138872 (\TEDIT.PUT.PCTB 106801 . 116451) (\TEDIT.PUT.PCTB.PIECEDATA 116453 . 119651) (
\TEDIT.PUT.TRAILER 119653 . 120420) (\TEDIT.PUT.PCTB.MERGEABLE 120422 . 123856) (
\TEDIT.PUT.UTF8.SPLITPIECES 123858 . 128560) (\TEDIT.PUT.PCTB.NEXTNEW 128562 . 133033) (
\TEDIT.INSERT.NEWPIECES 133035 . 136470) (\TEDIT.PUTRESET 136472 . 136714) (\ARBOUT 136716 . 137440) (
\ATMOUT 137442 . 138047) (\DWOUT 138049 . 138328) (\STRINGOUT 138330 . 138870)) (138873 150948 (
\TEDIT.PUT.CHARLOOKS.LIST 138883 . 140555) (\TEDIT.PUT.SINGLE.CHARLOOKS 140557 . 146292) (
\TEDIT.PUT.CHARLOOKS 146294 . 147519) (\TEDIT.PUT.CHARLOOKS1 147521 . 148572) (\TEDIT.PUT.OBJECT
148574 . 150946)) (150949 158588 (\TEDIT.PUT.PARALOOKS.LIST 150959 . 151861) (
\TEDIT.PUT.SINGLE.PARALOOKS 151863 . 157447) (\TEDIT.PUT.PARALOOKS 157449 . 158586)) (158683 161695 (
TEDITFROMLISPSOURCE 158693 . 160944) (SHELLSCRIPTP 160946 . 161175) (TEDITFROMSHELLSCRIPT 161177 .
161693)))))
(FILEMAP (NIL (5137 35300 (TEDIT.GET 5147 . 11479) (TEDIT.FORMATTEDFILEP 11481 . 12797) (
TEDIT.FILEDATE 12799 . 13970) (TEDIT.INCLUDE 13972 . 22001) (TEDIT.RAW.INCLUDE 22003 . 22811) (
TEDIT.PUT 22813 . 31289) (TEDIT.PUT.STREAM 31291 . 35298)) (35301 55377 (\TEDIT.GET.FOREIGN.FILE 35311
. 38736) (\TEDIT.GET.UNFORMATTED.FILE 38738 . 42927) (\TEDIT.GET.FORMATTED.FILE 42929 . 45956) (
\TEDIT.FORMATTEDSTREAMP 45958 . 48976) (\ARBIN 48978 . 49698) (\ATMIN 49700 . 50237) (\DWIN 50239 .
50618) (\STRINGIN 50620 . 51328) (\TEDIT.GET.TRAILER 51330 . 53846) (\TEDIT.CACHEFILE 53848 . 55375))
(55543 69604 (\TEDIT.GET.PIECES3 55553 . 66366) (\TEDIT.GET.IDATE3 66368 . 67763) (
\TEDIT.MAKE.STRINGPIECE 67765 . 69602)) (69605 82914 (\TEDIT.GET.UNFORMATTED.FILE.MCCS 69615 . 75731)
(\TEDIT.INTERPRET.MCCS.SHIFTS 75733 . 81978) (\TEDIT.CONVERT.XCCSTOMCCS 81980 . 82912)) (82936 88958 (
\TEDIT.GET.UNFORMATTED.FILE.UTF8 82946 . 88956)) (88981 98110 (\TEDIT.GET.CHARLOOKS.LIST 88991 . 89722
) (\TEDIT.GET.SINGLE.CHARLOOKS 89724 . 94922) (\TEDIT.GET.CHARLOOKS 94924 . 96254) (
\TEDIT.GET.PARALOOKS.INDEX 96256 . 96800) (\TEDIT.GET.CHARLOOKS.INDEX 96802 . 98108)) (98111 105768 (
\TEDIT.GET.PARALOOKS.LIST 98121 . 98743) (\TEDIT.GET.SINGLE.PARALOOKS 98745 . 105766)) (105769 109359
(\TEDIT.GET.OBJECT 105779 . 109357)) (109424 141872 (\TEDIT.PUT.PCTB 109434 . 119204) (
\TEDIT.PUT.PCTB.PIECEDATA 119206 . 122404) (\TEDIT.PUT.TRAILER 122406 . 123173) (
\TEDIT.PUT.PCTB.MERGEABLE 123175 . 126831) (\TEDIT.PUT.UTF8.SPLITPIECES 126833 . 131535) (
\TEDIT.PUT.PCTB.NEXTNEW 131537 . 136033) (\TEDIT.INSERT.NEWPIECES 136035 . 139470) (\TEDIT.PUTRESET
139472 . 139714) (\ARBOUT 139716 . 140440) (\ATMOUT 140442 . 141047) (\DWOUT 141049 . 141328) (
\STRINGOUT 141330 . 141870)) (141873 153943 (\TEDIT.PUT.CHARLOOKS.LIST 141883 . 143555) (
\TEDIT.PUT.SINGLE.CHARLOOKS 143557 . 149287) (\TEDIT.PUT.CHARLOOKS 149289 . 150514) (
\TEDIT.PUT.CHARLOOKS1 150516 . 151567) (\TEDIT.PUT.OBJECT 151569 . 153941)) (153944 161583 (
\TEDIT.PUT.PARALOOKS.LIST 153954 . 154856) (\TEDIT.PUT.SINGLE.PARALOOKS 154858 . 160442) (
\TEDIT.PUT.PARALOOKS 160444 . 161581)) (161678 165107 (TEDITFROMLISPSOURCE 161688 . 164356) (
SHELLSCRIPTP 164358 . 164587) (TEDITFROMSHELLSCRIPT 164589 . 165105)))))
STOP

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

Binary file not shown.

58
library/tedit/TEDIT-FIND
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 14:07:00" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;155 43772
(FILECREATED "21-Apr-2025 22:42:57" {WMEDLEY}<library>tedit>TEDIT-FIND.;165 43576
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.NEXT)
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
:PREVIOUS-DATE "19-Mar-2025 11:25:45" {WMEDLEY}<library>tedit>TEDIT-FIND.;153)
:PREVIOUS-DATE "20-Apr-2025 23:44:49" {WMEDLEY}<library>tedit>TEDIT-FIND.;162)
(PRETTYCOMPRINT TEDIT-FINDCOMS)
@@ -67,15 +67,15 @@
(CAR RESULT)))])
(TEDIT.SUBSTITUTE
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)(* ; "Edited 19-Mar-2025 11:20 by rmk")
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)(* ; "Edited 21-Apr-2025 22:23 by rmk")
(* ; "Edited 6-Apr-2025 14:39 by rmk")
(* ; "Edited 19-Mar-2025 11:20 by rmk")
(* ; "Edited 15-Mar-2025 00:23 by rmk")
(* ; "Edited 6-Mar-2025 20:17 by rmk")
(* ; "Edited 8-Dec-2024 15:47 by rmk")
(* ; "Edited 26-Nov-2024 23:49 by rmk")
(* ; "Edited 15-Aug-2024 09:20 by rmk")
(* ; "Edited 14-Jul-2024 00:24 by rmk")
(* ; "Edited 18-May-2024 23:03 by rmk")
(* ; "Edited 12-May-2024 21:11 by rmk")
(* ; "Edited 15-Mar-2024 14:09 by rmk")
(* ; "Edited 6-Jan-2024 11:09 by rmk")
(* ; "Edited 12-Nov-2023 12:29 by rmk")
@@ -88,7 +88,7 @@
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
(RESETLST
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
(PROG ((TEXTOBJ (FTEXTOBJ TSTREAM))
(NREPLACEMENTS 0)
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING
@@ -159,12 +159,10 @@
ENDCHAR#))
do (* ;
 "Show each substitution site and ask for permission")
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
(\TEDIT.UPDATE.SEL TSTREAM (CAR HIT)
(CADR HIT)
'RIGHT
'PENDINGDEL)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ SEL)
[SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
"OK to replace? ['q' quits]" "Yes")
@@ -175,8 +173,8 @@
(SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT)
TEXTOBJ))))
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ SEL)
'COPY TSTREAM)
TSTREAM SEL)
(\TEDIT.COPYSEL SEL LASTSEL)
(* ; "This may be where we end up")
(add NREPLACEMENTS 1)
@@ -187,7 +185,7 @@
(* ;;
 "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(SETQ STARTCHAR# (ADD1 (CAR HIT]
finally (\TEDIT.COPYSEL LASTSEL SEL))
else
@@ -204,10 +202,10 @@
(\TEDIT.UPDATE.SEL SEL (CAR HIT)
(CADR HIT)
'RIGHT)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.FIXSEL SEL TSTREAM)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ NIL CHARLOOKS)
TEXTOBJ SEL)
'COPY TSTREAM NIL CHARLOOKS)
TSTREAM SEL)
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
(* ;
 "Collect the events for a single composite")
@@ -221,23 +219,22 @@
(* ;; "At least one replacement, update the lines that have changed. We have to calculate how many of the original characters have %"changed%" by adding the TOTALDIFF to the final position of the last character of the last hit. ")
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
(\TEDIT.UPDATE.LINES TSTREAM 'INSERTION FIRSTHIT
(IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM)
TOTALDIFF)
FIRSTHIT))
(* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?")
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
)
'RIGHT)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
(* ;; "Save the search & replacement strings to offer for next time:")
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TSTREAM)
(TEDIT.NORMALIZECARET TSTREAM SEL)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
@@ -251,7 +248,8 @@
(RETURN NREPLACEMENTS))))])
(TEDIT.NEXT
[LAMBDA (TSTREAM) (* ; "Edited 28-Mar-2025 14:06 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 14:40 by rmk")
(* ; "Edited 28-Mar-2025 14:06 by rmk")
(* ; "Edited 14-Mar-2025 23:14 by rmk")
(* ; "Edited 11-Mar-2025 15:35 by rmk")
(* ; "Edited 9-Mar-2025 11:31 by rmk")
@@ -307,11 +305,9 @@
then
(* ;; "CHNO is the beginning of the located blank, DCH is its length")
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL CHNO DCH 'RIGHT 'PENDINGDEL)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL TSTREAM CHNO DCH 'RIGHT 'PENDINGDEL)
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
(TEDIT.NORMALIZECARET TEXTOBJ)
else (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in" T])
@@ -688,10 +684,10 @@
(DREVERSE $$VAL))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (961 20132 (TEDIT.FIND 971 . 1555) (TEDIT.FIND.SETSEL 1557 . 2022) (TEDIT.FIND.BACKWARD
2024 . 2603) (TEDIT.SUBSTITUTE 2605 . 15424) (TEDIT.NEXT 15426 . 20130)) (20133 23562 (
TEDIT.FIND.OBJECT 20143 . 21643) (TEDIT.FIND.OBJECT.BACKWARD 21645 . 23560)) (23595 43749 (\TEDIT.FIND
23605 . 26541) (\TEDIT.FIND.BACKWARD 26543 . 29061) (\TEDIT.WCFIND 29063 . 32582) (\TEDIT.BASICFIND
32584 . 34943) (\TEDIT.WCFIND.BACKWARD 34945 . 38409) (\TEDIT.BASICFIND.BACKWARD 38411 . 40668) (
\TEDIT.PARSE.SEARCHSTRING 40670 . 43747)))))
(FILEMAP (NIL (967 19936 (TEDIT.FIND 977 . 1561) (TEDIT.FIND.SETSEL 1563 . 2028) (TEDIT.FIND.BACKWARD
2030 . 2609) (TEDIT.SUBSTITUTE 2611 . 15222) (TEDIT.NEXT 15224 . 19934)) (19937 23366 (
TEDIT.FIND.OBJECT 19947 . 21447) (TEDIT.FIND.OBJECT.BACKWARD 21449 . 23364)) (23399 43553 (\TEDIT.FIND
23409 . 26345) (\TEDIT.FIND.BACKWARD 26347 . 28865) (\TEDIT.WCFIND 28867 . 32386) (\TEDIT.BASICFIND
32388 . 34747) (\TEDIT.WCFIND.BACKWARD 34749 . 38213) (\TEDIT.BASICFIND.BACKWARD 38215 . 40472) (
\TEDIT.PARSE.SEARCHSTRING 40474 . 43551)))))
STOP

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

Binary file not shown.

697
library/tedit/TEDIT-FNKEYS
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

295
library/tedit/TEDIT-HCPY
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}<library>tedit>TEDIT-HCPY.;170 33842
(FILECREATED "21-Apr-2025 19:07:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;176 32823
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE \TEDIT.HARDCOPY.FORMATLINE.HEADINGS
\TEDIT.HCPYFMTSPEC)
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
:PREVIOUS-DATE " 8-Feb-2025 23:42:18" {WMEDLEY}<library>tedit>TEDIT-HCPY.;169)
:PREVIOUS-DATE "17-Apr-2025 13:35:29" {WMEDLEY}<library>tedit>TEDIT-HCPY.;174)
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -134,7 +133,11 @@
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
(\TEDIT.HARDCOPY.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:34 by rmk")
[LAMBDA (TSTREAM LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 19:02 by rmk")
(* ; "Edited 17-Apr-2025 13:35 by rmk")
(* ; "Edited 15-Apr-2025 15:19 by rmk")
(* ; "Edited 11-Apr-2025 17:30 by rmk")
(* ; "Edited 19-Feb-2025 13:34 by rmk")
(* ; "Edited 8-Feb-2025 23:39 by rmk")
(* ; "Edited 13-Dec-2024 23:49 by rmk")
(* ; "Edited 13-Jun-2024 17:13 by rmk")
@@ -152,131 +155,117 @@
(* ;; "If possible, use the information cached in THISLINE")
(TEXTOBJ! TEXTOBJ)
(\DTEST LINE 'LINEDESCRIPTOR)
(LINEDESCRIPTOR! LINE)
(* ;; "Only display the line if it appears before the end of the text!")
(CL:UNLESS (IGREATERP (FGETLD LINE LCHAR1 LINE)
(FGETTOBJ TEXTOBJ TEXTLEN))
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
(\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
(FGETLD LINE LCHAR1)
LINE REGION PRSTREAM FORMATTINGSTATE))
(PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
(CL:WHEN (IGREATERP (FGETLD LINE LCHAR1 LINE)
(FGETTOBJ TEXTOBJ TEXTLEN))
(RETURN NIL))
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
(\TEDIT.FORMATLINE TSTREAM (FGETLD LINE LCHAR1)
LINE REGION PRSTREAM FORMATTINGSTATE))
(* ;; "Use the characters cached in THISLINE.")
(* ;; "Use the characters cached in THISLINE.")
(for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
TLSPACEFACTOR
)
of THISLINE))
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
(SCALE _ (DSPSCALE NIL PRSTREAM))
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
(DSPXPOSITION TX PRSTREAM)
do
(* ;;
 "Display the line character by character. CHAR and CHARW are bound to CHARSLOT values")
(for CHARSLOT OLDCLOOKS CURY LOOKSTARTX SCALESPACES OLDCOLOR (SPACEFACTOR
_
(fetch (THISLINE
TLSPACEFACTOR)
of THISLINE))
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
(SCALE _ (DSPSCALE NIL PRSTREAM))
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
(DSPXPOSITION TX PRSTREAM)
do
(* ;;
 "Display the line character by character. CHAR, CHARW, and CHARCL are bound to CHARSLOT values")
(SELCHARQ CHAR
(SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT)
(* ; "Time to turn on space scaling.")
(DSPSPACEFACTOR SPACEFACTOR PRSTREAM)
(SETQ SCALESPACES T))
(\OUTCHAR PRSTREAM (CHARCODE SPACE))
(add TX (CL:IF SCALESPACES
(HCSCALE SPACEFACTOR CHARW)
CHARW)))
((TAB Meta,TAB) (* ;
 "Dotted leaders are meta-TAB, or are DOTTEDLEADER.")
(CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB))
(fetch CLLEADER of CLOOKS)
(EQ (fetch CLUSERINFO of CLOOKS)
'DOTTEDLEADER))
(LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
(FONTCOPY (fetch (CHARLOOKS CLFONT)
of CLOOKS)
'DEVICE PRSTREAM)))
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH
(IREMAINDER TX DOTWIDTH]
(DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
PRSTREAM) (* ;
 "Move over to the next even multiple of a dot's width.")
(while (ILEQ TTX (IPLUS TX CHARW))
do (\OUTCHAR PRSTREAM (CHARCODE %.))
(add TTX DOTWIDTH))))
(add TX CHARW)
(DSPXPOSITION TX PRSTREAM))
((EOL LF CR)
NIL)
(NIL
(* ;;
 "LOOKS. Line-start looks are guaranteed to come before any character/object")
(if (type? CHARLOOKS CHARW)
then (CL:WHEN CLOOKS
(* ;;
 "Underline/overline/strike the just-finished looks run")
(* ;; "Underline/overline/strike the just-finished looks run")
(* ; "DISPLAY ALSO PASES LINE DESCENT")
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX
(FGETLD LINE YBASE)
CLOOKS PRSTREAM))
(SETQ CLOOKS CHARW)
(DSPFONT (fetch CLFONT of CLOOKS)
PRSTREAM)
[SETQ CURY (COND
[(AND (fetch (CHARLOOKS CLOFFSET) of CLOOKS)
(NEQ 0 (fetch (CHARLOOKS CLOFFSET)
of CLOOKS)))
(IPLUS (FGETLD LINE YBASE)
(HCSCALE SCALE (fetch (CHARLOOKS CLOFFSET
)
of CLOOKS]
(T (FGETLD LINE YBASE]
(DSPYPOSITION CURY PRSTREAM)
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX OLDCLOOKS PRSTREAM)
(DSPFONT (FGETCLOOKS CHARCL CLFONT)
PRSTREAM)
(CL:UNLESS (EQ OLDCOLOR (SETQ OLDCOLOR (FGETCLOOKS CHARCL CLCOLOR)))
(DSPCOLOR OLDCOLOR PRSTREAM))
[SETQ CURY (COND
[(AND (FGETCLOOKS CHARCL CLOFFSET)
(NEQ 0 (FGETCLOOKS CHARCL CLOFFSET)))
(IPLUS (FGETLD LINE YBASE)
(HCSCALE SCALE (FGETCLOOKS CHARCL CLOFFSET]
(T (FGETLD LINE YBASE]
(DSPYPOSITION CURY PRSTREAM)
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
(SETQ LOOKSTARTX TX)))
(PROGN (if (IMAGEOBJP CHAR)
then
(* ;; "Go to the base line, left edge of the image region.")
(SETQ LOOKSTARTX TX)
(SELCHARQ CHAR
(SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT)
(* ; "Time to turn on space scaling.")
(DSPSPACEFACTOR SPACEFACTOR PRSTREAM)
(SETQ SCALESPACES T))
(\OUTCHAR PRSTREAM (CHARCODE SPACE))
(add TX (CL:IF SCALESPACES
(HCSCALE SPACEFACTOR CHARW)
CHARW)))
((TAB Meta,TAB) (* ;
 "Dotted leaders are meta-TAB, or are DOTTEDLEADER.")
(CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB))
(FGETCLOOKS CHARCL CLLEADER)
(EQ (FGETCLOOKS CHARCL CLUSERINFO)
'DOTTEDLEADER))
(LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.)
(FONTCOPY (FGETCLOOKS CHARCL CLFONT)
'DEVICE PRSTREAM)))
(TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER
TX DOTWIDTH]
(DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH)
PRSTREAM) (* ;
 "Move over to the next even multiple of a dot's width.")
(while (ILEQ TTX (IPLUS TX CHARW))
do (\OUTCHAR PRSTREAM (CHARCODE %.))
(add TTX DOTWIDTH))))
(add TX CHARW)
(DSPXPOSITION TX PRSTREAM))
((EOL LF CR)
NIL)
(PROGN (if (IMAGEOBJP CHAR)
then
(* ;; "Go to the base line, left edge of the image region.")
(SETQ CURY (DSPYPOSITION NIL PRSTREAM))
(APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN)
CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM)
(ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ))
(DSPFONT (fetch CLFONT of CLOOKS)
PRSTREAM) (* ;
(SETQ CURY (DSPYPOSITION NIL PRSTREAM))
(APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN)
CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM)
TSTREAM)
(DSPFONT (FGETCLOOKS CHARCL CLFONT)
PRSTREAM) (* ;
 "Restore the font, move to after the object's image")
(MOVETO (IPLUS TX CHARW)
CURY PRSTREAM)
elseif (DIACRITICP CHAR)
then
(* ;; "Special placement for diacritics")
(MOVETO (IPLUS TX CHARW)
CURY PRSTREAM)
elseif (DIACRITICP CHAR)
then
(* ;; "Special placement for diacritics")
(SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE
PRSTREAM))
elseif (EQ 'KERN CHAR)
then (RELMOVETO 0 CHARW PRSTREAM)
else (\OUTCHAR PRSTREAM CHAR))
(add TX CHARW))) finally
(SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE
PRSTREAM))
elseif (EQ 'KERN CHAR)
then (RELMOVETO 0 CHARW PRSTREAM)
else (\OUTCHAR PRSTREAM CHAR))
(add TX CHARW))) finally
(* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:")
(CL:WHEN CLOOKS
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE
LOOKSTARTX TX (FGETLD LINE YBASE)
CLOOKS PRSTREAM))
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
FMTREVISED)
(\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX
CHARCL PRSTREAM)
(CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS)
FMTREVISED)
(* ;
 "This paragraph has been revised, so mark it.")
(\TEDIT.MARK.REVISION TEXTOBJ
(FGETLD LINE LPARALOOKS)
PRSTREAM LINE))])])
(\TEDIT.MARK.REVISION TEXTOBJ
(FGETLD LINE LPARALOOKS)
PRSTREAM LINE))])
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
[LAMBDA (TEXTOBJ TSTREAM LINE PARALOOKS CHNO IMAGESTREAM FORMATTINGSTATE)
@@ -307,45 +296,41 @@
NIL])
(\TEDIT.HARDCOPY.MODIFYLOOKS
[LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 27-May-2023 12:16 by rmk")
[LAMBDA (LINE STARTX CURX CLOOKS PRSTREAM) (* ; "Edited 11-Apr-2025 17:37 by rmk")
(* ; "Edited 27-May-2023 12:16 by rmk")
(* ; "Edited 30-May-91 21:17 by jds")
(* ;; "Do underlining, overlining, etc. for hardcopy files")
[PROG ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
[RULEWIDTH (FIXR (FTIMES 0.75 (DSPSCALE NIL PRSTREAM]
(ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
YOFFSET)
(COND
((fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.")
(DRAWLINE STARTX (IDIFFERENCE (GETLD LINE YBASE)
(GETLD LINE LTRUEDESCENT LINE))
CURX
(IDIFFERENCE (GETLD LINE YBASE)
(GETLD LINE LTRUEDESCENT LINE))
RULEWIDTH
'PAINT PRSTREAM) (* ; "A 1/2-pt underline")
))
(COND
((fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line")
(DRAWLINE STARTX (IPLUS (GETLD LINE YBASE)
(GETLD LINE LTRUEASCENT LINE))
CURX
(IPLUS (GETLD LINE YBASE LINE)
(GETLD LINE LTRUEASCENT LINE))
RULEWIDTH
'PAINT PRSTREAM)))
(COND
((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struch-thru")
(DRAWLINE STARTX (SETQ YOFFSET (IPLUS (GETLD LINE YBASE LINE)
(IQUOTIENT
[FIXR (FTIMES STREAMSCALE
(FONTPROP (fetch (CHARLOOKS CLFONT)
of LOOKS)
'ASCENT]
3)))
CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM]
(MOVETO CURX CURY PRSTREAM])
(LINEDESCRIPTOR! LINE)
(CL:WHEN CLOOKS
(LET ((STREAMSCALE (DSPSCALE NIL PRSTREAM))
[RULEWIDTH (FIXR (FTIMES 0.75 (DSPSCALE NIL PRSTREAM]
(ONEPOINT (FIXR (DSPSCALE NIL PRSTREAM)))
(YBASE (FGETLD LINE YBASE))
YOFFSET)
(CL:WHEN (FGETCLOOKS CLOOKS CLULINE) (* ; "Underlined")
(DRAWLINE STARTX (IDIFFERENCE YBASE (FGETLD LINE LTRUEDESCENT LINE))
CURX
(IDIFFERENCE YBASE (FGETLD LINE LTRUEDESCENT LINE))
RULEWIDTH
'PAINT PRSTREAM))
(CL:WHEN (FGETCLOOKS CLOOKS CLOLINE) (* ; "Over-line")
(DRAWLINE STARTX (IPLUS YBASE (GETLD LINE LTRUEASCENT LINE))
CURX
(IPLUS YBASE (GETLD LINE LTRUEASCENT LINE))
RULEWIDTH
'PAINT PRSTREAM))
(CL:WHEN (FGETCLOOKS CLOOKS CLSTRIKE) (* ; "Struch-thru")
(DRAWLINE STARTX (SETQ YOFFSET
(IPLUS YBASE (IQUOTIENT [FIXR (FTIMES STREAMSCALE
(FONTPROP (fetch (CHARLOOKS
CLFONT)
of CLOOKS)
'ASCENT]
3)))
CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM))
(MOVETO CURX YBASE PRSTREAM)))])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 19-Feb-2025 13:34 by rmk")
@@ -563,11 +548,11 @@
(CLOSEF DOC])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3554 27051 (TEDIT.HARDCOPY 3564 . 4697) (\TEDIT.PRINT.MENU 4699 . 5665) (TEDIT.HCPYFILE
5667 . 7841) (\TEDIT.HARDCOPY.DISPLAYLINE 7843 . 17953) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17955 .
19684) (\TEDIT.HARDCOPY.MODIFYLOOKS 19686 . 21920) (\TEDIT.HCPYFMTSPEC 21922 . 25380) (
\TEDIT.INTEGER.IMAGEBOX 25382 . 26053) (\TEDIT.DISPLAY.DIACRITIC 26055 . 27049)) (27126 27956 (
\TEDIT.SCALEREGION 27136 . 27954)) (28215 31755 (TEDIT.HARDCOPYFN 28225 . 29530) (
\TEDIT.HARDCOPYFILEFN 29532 . 30093) (\TEDIT.POSTSCRIPT.HARDCOPY 30095 . 31026) (\TEDIT.PRESS.HARDCOPY
31028 . 31753)) (33018 33819 (TEDIT-BOOK 33028 . 33817)))))
(FILEMAP (NIL (3475 26032 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5586) (TEDIT.HCPYFILE
5588 . 7762) (\TEDIT.HARDCOPY.DISPLAYLINE 7764 . 16987) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 16989 .
18718) (\TEDIT.HARDCOPY.MODIFYLOOKS 18720 . 20901) (\TEDIT.HCPYFMTSPEC 20903 . 24361) (
\TEDIT.INTEGER.IMAGEBOX 24363 . 25034) (\TEDIT.DISPLAY.DIACRITIC 25036 . 26030)) (26107 26937 (
\TEDIT.SCALEREGION 26117 . 26935)) (27196 30736 (TEDIT.HARDCOPYFN 27206 . 28511) (
\TEDIT.HARDCOPYFILEFN 28513 . 29074) (\TEDIT.POSTSCRIPT.HARDCOPY 29076 . 30007) (\TEDIT.PRESS.HARDCOPY
30009 . 30734)) (31999 32800 (TEDIT-BOOK 32009 . 32798)))))
STOP

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

Binary file not shown.

558
library/tedit/TEDIT-HISTORY
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 14:23:18" {WMEDLEY}<library>TEDIT>TEDIT-HISTORY.;227 53951
(FILECREATED "21-Apr-2025 22:42:33" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;250 58952
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.UNDO.REPLACECODE \TEDIT.UNDO1)
:CHANGES-TO (FNS \TEDIT.UNDO.DELETE \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.UNDO.REPLACE
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS TEDIT.UNDO)
:PREVIOUS-DATE "16-Mar-2025 18:50:43" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;225)
:PREVIOUS-DATE "20-Apr-2025 23:30:57" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;247)
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
@@ -31,7 +32,7 @@
(FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
(FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS
\TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
\TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE \TEDIT.UNDO.WRAP \TEDIT.UNDO.SEL)
(FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -153,7 +154,8 @@
(DEFINEQ
(\TEDIT.HISTORYADD
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Dec-2024 17:32 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 11:22 by rmk")
(* ; "Edited 8-Dec-2024 17:32 by rmk")
(* ; "Edited 29-Aug-2024 12:30 by rmk")
(* ; "Edited 11-Aug-2024 21:57 by rmk")
(* ; "Edited 30-Apr-2024 22:51 by rmk")
@@ -171,61 +173,64 @@
(* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards. Old code seemed to treat those as separate events, and only the second/right one could be undone.")
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
then
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
[LET [(TEXTOBJ (FTEXTOBJ TSTREAM (type? TEXTOBJ TSTREAM]
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
then
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
else (if (type? TEDITHISTORYEVENT EVENT)
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
(CONSTANT (LIST :Put :Get)))
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
else (if (type? TEDITHISTORYEVENT EVENT)
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
(CONSTANT (LIST :Put :Get)))
(* ;
 "Can't back up over Put/Get, flush the history.")
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
(* ;; "Somebody may have already done there own fixup.")
(* ;; "Somebody may have already done there own fixup.")
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH EVENT THACTION))
(EQ :Delete (GETTH OLDEVENT THACTION)))
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH EVENT THACTION))
(EQ :Delete (GETTH OLDEVENT THACTION)))
(* ;;
(* ;;
 "Repeated successive deletions, we can combine them if they are adjacent.")
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
(GETTH OLDEVENT THCH#))
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
(GETTH OLDEVENT THCH#))
(* ;
 "OLDEVENT is first, EVENT is still delete")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
(\TEDIT.POPEVENT TEXTOBJ)
(* ; "Pop OLDEVENT before repushing")
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH OLDEVENT THACTION))
(IEQP (GETTH OLDEVENT THCHLIM)
(IPLUS (GETTH EVENT THCH#)
(GETTH OLDEVENT THLEN]
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH OLDEVENT THACTION))
(IEQP (GETTH OLDEVENT THCHLIM)
(IPLUS (GETTH EVENT THCH#)
(GETTH OLDEVENT THLEN]
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
(\TEDIT.POPEVENT TEXTOBJ)))
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
elseif (LISTP EVENT)
then
(* ;; "A monolithic sequence of undoable events")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
(\TEDIT.POPEVENT TEXTOBJ)))
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
elseif (LISTP EVENT)
then
(* ;; "A monolithic sequence of undoable events")
(* ;; "SHOULDNT HAPPEN ?")
(* ;; "SHOULDNT HAPPEN ?")
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT]
EVENT])
(\TEDIT.HISTORYADD.COMPOSITE
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 6-Feb-2025 15:31 by rmk")
[LAMBDA (TEXTOBJ EVENTS ACTION EXTRA) (* ; "Edited 1-Apr-2025 17:50 by rmk")
(* ; "Edited 6-Feb-2025 15:31 by rmk")
(* ; "Edited 8-Dec-2024 19:31 by rmk")
(* ; "Edited 22-Sep-2024 18:47 by rmk")
(* ; "Edited 3-Jul-2024 08:02 by rmk")
@@ -233,8 +238,8 @@
(SETQ EVENTS (REMOVE NIL EVENTS))
(CL:WHEN EVENTS
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
EVENTS)
(\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite)
NIL NIL NIL NIL EVENTS EXTRA)
(CAR EVENTS))))])
(\TEDIT.CUMULATE.EVENTS
@@ -294,13 +299,15 @@
(\ILLEGAL.ARG NEWVALUE))))])
(\TEDIT.HISTORY.EVENT
[LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
[LAMBDA (TSTREAM ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
(* ; "Edited 6-Apr-2025 11:20 by rmk")
(* ; "Edited 26-Sep-2024 15:44 by rmk")
(* ; "Edited 23-Sep-2024 16:47 by rmk")
(* ;; "Don't create if it's inactive")
(CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
(CL:UNLESS (GETTOBJ (FTEXTOBJ TSTREAM)
TXTHISTORYINACTIVE)
(CL:WHEN (AND (NULL LEN)
(type? SELPIECES CH#))
(SETQ LEN (fetch (SELPIECES SPLEN) of CH#))
@@ -326,7 +333,10 @@
(DEFINEQ
(TEDIT.UNDO
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 13-Mar-2025 15:47 by rmk")
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 21-Apr-2025 20:16 by rmk")
(* ; "Edited 6-Apr-2025 14:42 by rmk")
(* ; "Edited 5-Apr-2025 13:49 by rmk")
(* ; "Edited 13-Mar-2025 15:47 by rmk")
(* ; "Edited 8-Dec-2024 19:41 by rmk")
(* ; "Edited 25-Nov-2024 13:17 by rmk")
(* ; "Edited 12-Aug-2024 10:49 by rmk")
@@ -362,6 +372,7 @@
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
T)
(RETURN))
(TEDIT.PROMPTCLEAR TEXTOBJ)
(SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ))
(SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ;
 "So we can test for the undoundo event.")
@@ -375,7 +386,7 @@
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(TEDIT.PROMPTCLEAR TSTREAM)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UNDO1 TSTREAM EVENT)
(* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")
@@ -392,11 +403,12 @@
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
(LIST PREVEVENT UNDOEVENT EVENT)))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
(\TEDIT.SHOWSEL SEL T TSTREAM])
(\TEDIT.UNDO1
[LAMBDA (TSTREAM EVENT) (* ; "Edited 28-Mar-2025 14:22 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:42 by rmk")
(* ; "Edited 1-Apr-2025 21:22 by rmk")
(* ; "Edited 28-Mar-2025 14:22 by rmk")
(* ; "Edited 16-Mar-2025 18:46 by rmk")
(* ; "Edited 25-Nov-2024 13:56 by rmk")
(* ; "Edited 29-Sep-2024 13:51 by rmk")
@@ -408,57 +420,55 @@
(* ; "Edited 16-Jul-2023 11:14 by rmk")
(* ; "Edited 30-May-2023 23:50 by rmk")
(* ; "Edited 25-May-2023 00:33 by rmk")
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
(CL:WHEN (GETTH EVENT THCH#)
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT)
(\TEDIT.SHOWSEL NIL T TEXTOBJ)
(\TEDIT.SCROLL.CARET TSTREAM))
(PROG1 (SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy)
(\TEDIT.UNDO.INSERT TEXTOBJ EVENT))
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
(:Delete (* ; "Deletion or case-shift")
(\TEDIT.UNDO.DELETE TEXTOBJ EVENT))
(:CharLooks (* ; "Character-looks change")
(\TEDIT.UNDO.CHARLOOKS TEXTOBJ EVENT))
(:ParaLooks (* ; "PARA looks change")
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
(:PageFormat (* ; "Pageframe change")
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
((LIST :Replace :Transform)
(CL:WHEN (GETTH EVENT THCH#)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL TSTREAM EVENT)
(\TEDIT.SCROLL.CARET TSTREAM))
(PROG1 (SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy)
(\TEDIT.UNDO.INSERT TSTREAM EVENT))
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
(:Delete (* ; "Deletion or case-shift")
(\TEDIT.UNDO.DELETE TSTREAM EVENT))
(:CharLooks (* ; "Character-looks change")
(\TEDIT.UNDO.CHARLOOKS TSTREAM EVENT))
(:ParaLooks (* ; "PARA looks change")
(\TEDIT.UNDO.PARALOOKS TSTREAM EVENT))
(:PageFormat (* ; "Pageframe change")
(\TEDIT.UNDO.PAGELOOKS TSTREAM EVENT))
((LIST :Replace :Transform)
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
(* ;; "He replaced one portion of text with another ; Transforms have the same undo event but different REDO's.")
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TSTREAM EVENT))
(:Closefile (* ; "Closes an included file")
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
(CLOSEF? (GETTH EVENT THOLDINFO))))
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
((LIST :Get :Put) (* ;
(\TEDIT.UNDO.REPLACE TSTREAM EVENT (GETTH EVENT THACTION)))
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TSTREAM EVENT))
(:Closefile (* ; "Closes an included file")
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
(CLOSEF? (GETTH EVENT THOLDINFO))))
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
(:Wrap (\TEDIT.UNDO.WRAP TSTREAM EVENT))
(:Sel (\TEDIT.UNDO.SEL TSTREAM EVENT))
((LIST :Get :Put) (* ;
 "He did a GET or PUT-- not undoable.")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
))
T))
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
TEDIT.HISTORY.TYPELST]
(COND
(UNDOFN
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "You can't undo a " (GETTH EVENT THACTION))
T))
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
TEDIT.HISTORY.TYPELST]
(COND
(UNDOFN
(* ;;
 "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
(GETTH EVENT THCH#)
(GETTH EVENT THFIRSTPIECE)))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
(GETTH EVENT THACTION))
T])
(APPLY* UNDOFN TSTREAM EVENT (GETTH EVENT THLEN)
(GETTH EVENT THCH#)
(GETTH EVENT THFIRSTPIECE)))
(T (TEDIT.PROMPTPRINT TSTREAM (CONCAT "UNDO not implemented for "
(GETTH EVENT THACTION))
T])
(TEDIT.REDO
[LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2025 18:48 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 14:43 by rmk")
(* ; "Edited 1-Apr-2025 21:42 by rmk")
(* ; "Edited 16-Mar-2025 18:48 by rmk")
(* ; "Edited 2-Feb-2025 11:28 by rmk")
(* ; "Edited 8-Dec-2024 17:53 by rmk")
(* ; "Edited 27-Nov-2024 23:11 by rmk")
@@ -478,74 +488,74 @@
(* ;; "REDO the last thing this guy did.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(SEL (GETTOBJ TEXTOBJ SEL))
(PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(SEL (FGETTOBJ TEXTOBJ SEL))
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
CH)
(CL:WHEN (\TEDIT.READONLY TEXTOBJ)
(CL:WHEN (\TEDIT.READONLY TSTREAM)
(RETURN NIL))
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
(TEDIT.PROMPTPRINT TSTREAM "Nothing to redo" T)
(RETURN))
(CL:UNLESS (GETSEL SEL SET)
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
(TEDIT.PROMPTPRINT TSTREAM "Please select a target for the repeated action" T)
(RETURN))
(* ;; "There really is something to redo and something to do it to.")
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
(\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL))
(\TEDIT.REDO.INSERT TSTREAM EVENT SEL))
(:Delete (* ; "It was a deletion")
(\TEDIT.DELETE TEXTOBJ SEL))
(\TEDIT.DELETE TSTREAM SEL))
(:Replace (* ;
 "It was a replacement (a del/insert combo)")
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(\TEDIT.REDO.REPLACE TSTREAM EVENT (GETTH EVENT THACTION)))
(:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO)))
(:LowerCase (* ; "He lower-cased something")
(\TEDIT.LCASE.SEL TSTREAM TEXTOBJ SEL))
(\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION L-CASECODE)))
(:UpperCase (* ; "He upper-cased something")
(\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL))
(:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL))
(\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION U-CASECODE)))
(:InitialCap (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION CAP-CASECODE)))
(:CharLooks (* ; "It was a character looks change")
(\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
SEL))
(:ParaLooks (* ; "It was a Paragraph looks change")
(\TEDIT.CHANGE.PARALOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO))
SEL))
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
(:PageFormat (TEDIT.PROMPTPRINT TSTREAM "You can't redo a page-format change" T T))
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
(* (* ;; "RESTLST ?")
 (AND NIL (RESETSAVE (CURSOR
 WAITINGCURSOR))) (TEDIT.PROMPTPRINT
 TEXTOBJ "Searching..." T)
 (SETQ SEL (fetch (TEXTOBJ SEL) of
 TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL
 TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
 TSTREAM "Searching..." T)
 (SETQ SEL (TEXTSEL TEXTOBJ))
 (\TEDIT.NOSEL TSTREAM)
 (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)) (\TEDIT.FIXSEL SEL
 TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
 (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
 (T (TEDIT.PROMPTPRINT TEXTOBJ
 "[Not found]"))))
 (if CH then (\TEDIT.UPDATE.SEL TSTREAM
 CH (NCHARS (GETTH EVENT THAUXINFO))
 (QUOTE RIGHT)) (TEDIT.NORMALIZECARET
 TSTREAM) (TEDIT.PROMPTPRINT TSTREAM
 "done.") else (TEDIT.PROMPTPRINT
 TSTREAM "[Not found]")))
)
(:Move
(* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place. The insert part is probably OK--that maps to the :Insert clause above.")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "You can't redo a " (GETTH EVENT THACTION))
T T))
(:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL))
(:Composite (\TEDIT.REDO.COMPOSITE TSTREAM EVENT SEL))
(:Wrap (\TEDIT.KEY.WRAP TSTREAM (CAR (GETTH EVENT THDELETEDPIECES))
(CADR (GETTH EVENT THDELETEDPIECES))))
((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "You can't redo a " (GETTH EVENT THACTION))
T T))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
(TEDIT.PROMPTPRINT TSTREAM (CONCAT "Redoing the action " (GETTH EVENT THACTION)
" isn't implemented.")
T))
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
(\TEDIT.SHOWSEL SEL T TSTREAM])
(\TEDIT.UNDO.UNDO
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk")
@@ -591,7 +601,8 @@
(DEFINEQ
(\TEDIT.UNDO.INSERT
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Jul-2024 00:07 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 12:15 by rmk")
(* ; "Edited 8-Jul-2024 00:07 by rmk")
(* ; "Edited 30-May-2023 22:54 by rmk")
(* ; "Edited 26-May-2023 23:49 by rmk")
(* ; "Edited 24-May-2023 23:53 by rmk")
@@ -600,12 +611,16 @@
(* ;; "UNDO a prior Insert, Copy, or Include. ")
(\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
(* ;; "If it is OK to show, we don't need the FIX or the TEXTSEL--use the stream")
(\TEDIT.DELETE TSTREAM (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL (FTEXTOBJ TSTREAM))
EVENT)
TEXTOBJ])
TSTREAM])
(\TEDIT.UNDO.DELETE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 29-Sep-2024 00:23 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 22:22 by rmk")
(* ; "Edited 6-Apr-2025 11:49 by rmk")
(* ; "Edited 29-Sep-2024 00:23 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 30-May-2023 23:31 by rmk")
(* ; "Edited 27-May-2023 23:39 by rmk")
@@ -614,12 +629,13 @@
(* ;; "UNDO a prior deletion ")
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
'INSERT TEXTOBJ)
TEXTOBJ
'INSERT TSTREAM)
TSTREAM
(GETTH EVENT THCH#])
(\TEDIT.UNDO.MOVE
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 19:38 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 11:51 by rmk")
(* ; "Edited 8-Dec-2024 19:38 by rmk")
(* ; "Edited 25-Nov-2024 14:12 by rmk")
(* ; "Edited 29-Sep-2024 00:23 by rmk")
(* ; "Edited 7-Jul-2024 11:50 by rmk")
@@ -629,7 +645,7 @@
(* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(LET* [(TEXTOBJ (FTEXTOBJ TSTREAM))
(SEL (TEXTSEL TEXTOBJ))
(REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
THACTION]
@@ -638,11 +654,12 @@
then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
'PENDINGDEL
else 'NORMAL))
(\TEDIT.FIXSEL SEL TSTREAM)
(\TEDIT.SHOWSEL SEL T TSTREAM])
(\TEDIT.UNDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2025 22:35 by rmk")
[LAMBDA (TSTREAM EVENT ACTION) (* ; "Edited 21-Apr-2025 22:22 by rmk")
(* ; "Edited 6-Apr-2025 11:58 by rmk")
(* ; "Edited 15-Mar-2025 22:35 by rmk")
(* ; "Edited 13-Sep-2024 23:50 by rmk")
(* ; "Edited 7-Jul-2024 11:59 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
@@ -652,16 +669,20 @@
(* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, uppercase, or initialcap.")
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT))
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
NIL TSTREAM)
TSTREAM
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT))
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(\TEDIT.UNDO.CHARLOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 21:59 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 20:31 by rmk")
(* ; "Edited 20-Apr-2025 13:39 by rmk")
(* ; "Edited 6-Apr-2025 14:44 by rmk")
(* ; "Edited 25-Nov-2024 21:59 by rmk")
(* ; "Edited 28-Sep-2024 22:37 by rmk")
(* ; "Edited 26-Sep-2024 16:06 by rmk")
(* ; "Edited 11-Aug-2024 22:11 by rmk")
@@ -675,54 +696,60 @@
(* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed. We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")
(for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL))
(CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL))
(CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")
(* ;; "Perhaps we should also save the CHNO of the CARETPC")
(* ;; "Perhaps we should also save the CHNO of the CARETPC")
(SETQ NEXTCHNO (CAR U))
(SETQ OLDLOOKS (CDR U))
(CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
[push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC]
(SETQ NEXTCHNO (CAR U))
(SETQ OLDLOOKS (CDR U))
(CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
[push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC]
(* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM")
(* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM")
(for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS)
(add CHNO (PLEN P))
(CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")
(SETQ PC P)
(RETURN))) finally
(for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS)
(add CHNO (PLEN P))
(CL:WHEN (IEQP CHNO NEXTCHNO)
(* ; "First piece of the next run")
(SETQ PC P)
(RETURN))) finally
(* ;;
(* ;;
 "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
'NORMAL)
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
(GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.PROMPTPRINT TEXTOBJ
"Character looks restored" T))
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
'NORMAL)
(\TEDIT.UPDATE.LINES TSTREAM
'LOOKS
(GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TSTREAM)
(TEDIT.PROMPTPRINT TEXTOBJ
"Character looks restored" T))
(* ;;
(* ;;
 "Save the event for REDO, even if these pieces didn't change")
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.PARALOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 22:00 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 21-Apr-2025 20:31 by rmk")
(* ; "Edited 20-Apr-2025 13:38 by rmk")
(* ; "Edited 6-Apr-2025 14:44 by rmk")
(* ; "Edited 25-Nov-2024 22:00 by rmk")
(* ; "Edited 28-Sep-2024 22:38 by rmk")
(* ; "Edited 27-Sep-2024 12:23 by rmk")
(* ; "Edited 11-Aug-2024 22:10 by rmk")
@@ -737,60 +764,62 @@
(* ;; "Undo the setting of paragraph looks.")
(for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Find the first piece of the next changed paragraph")
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Find the first piece of the next changed paragraph")
(for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U))
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P)))
(SETQ OLDLOOKS (CDR U))
(push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC))) (* ; "Save for UNDO UNDO")
(for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U))
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P)))
(SETQ OLDLOOKS (CDR U))
(push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC)))
(* ; "Save for UNDO UNDO")
(* ;; "Change all the pieces in this paragraph")
(* ;; "Change all the pieces in this paragraph")
(for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS)
(CL:WHEN (PPARALAST P)
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P))) finally
(for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS)
(CL:WHEN (PPARALAST P)
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P)))
finally
(* ;;
 "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
(* ;;
 "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
'NORMAL)
(\TEDIT.UPDATE.LINES TEXTOBJ
'LOOKS
(GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.PROMPTPRINT TEXTOBJ
"Paragraph looks restored" T))
(* ;;
 "Save the event for REDO, even if these pieces didn't change")
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL 'NORMAL)
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS (GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TSTREAM)
(TEDIT.PROMPTPRINT TEXTOBJ "Paragraph looks restored" T))
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(* ;; "Save the event for REDO, even if these pieces didn't change")
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.PAGELOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 12-Aug-2024 10:28 by rmk")
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 6-Apr-2025 11:49 by rmk")
(* ; "Edited 12-Aug-2024 10:28 by rmk")
(SETQ TEXTOBJ (FTEXTOBJ TEXTOBJ))
[FSETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
(TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.COMPOSITE
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 15:47 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:44 by rmk")
(* ; "Edited 1-Apr-2025 17:34 by rmk")
(* ; "Edited 8-Dec-2024 15:47 by rmk")
(* ; "Edited 25-Nov-2024 22:27 by rmk")
(* ; "Edited 15-Aug-2024 10:14 by rmk")
(* ; "Edited 7-May-2024 23:17 by rmk")
@@ -802,7 +831,9 @@
(\TEDIT.UNDO1 TSTREAM E)
(CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ)))
(\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))
(\TEDIT.NOSEL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS (GETTH EVENT
THACTION)
))
(\TEDIT.SCROLL.CARET TSTREAM])
(\TEDIT.UNDO.REPLACECODE
@@ -810,21 +841,57 @@
(* ; "Edited 23-Sep-2024 00:45 by rmk")
(\TEDIT.RPLCHARCODE TSTREAM (GETTH EVENT THCH#)
(GETTH EVENT THOLDINFO])
(\TEDIT.UNDO.WRAP
[LAMBDA (TSTREAM EVENT) (* ; "Edited 4-Apr-2025 11:01 by rmk")
(* ;; "Undo the deletions and restore the original selection. But also update the undo event so that undo-undo will select the whole span.")
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(SEL (TEXTSEL TEXTOBJ))
(CH# (GETSEL SEL CH#))
(DCH (FGETSEL SEL DCH))
(POINT (FGETSEL SEL POINT))
UNDOEVENT)
(\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)
(SETQ UNDOEVENT (\TEDIT.LASTEVENT TEXTOBJ))
(CL:WHEN (AND UNDOEVENT (EQ :Sel (GETTH (CAR (GETTH UNDOEVENT THOLDINFO))
THACTION)))
(change (GETTH UNDOEVENT THOLDINFO)
(NCONC1 (CDR DATUM)
(\TEDIT.HISTORY.EVENT TEXTOBJ :Sel CH# DCH POINT))))])
(\TEDIT.UNDO.SEL
[LAMBDA (TSTREAM EVENT) (* ; "Edited 6-Apr-2025 14:45 by rmk")
(* ; "Edited 4-Apr-2025 10:55 by rmk")
(LET* ((SEL (TEXTSEL (FTEXTOBJ TSTREAM)))
(CH# (GETSEL SEL CH#))
(DCH (FGETSEL SEL DCH))
(POINT (FGETSEL SEL POINT)))
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.UPDATE.SEL TSTREAM (GETTH EVENT THCH#)
(GETTH EVENT THLEN)
(GETTH EVENT THPOINT))
(\TEDIT.HISTORYADD TSTREAM (\TEDIT.HISTORY.EVENT TSTREAM :Sel CH# DCH POINT])
)
(DEFINEQ
(\TEDIT.REDO.INSERT
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Aug-2024 10:47 by rmk")
[LAMBDA (TSTREAM EVENT SEL) (* ; "Edited 21-Apr-2025 22:19 by rmk")
(* ; "Edited 6-Apr-2025 12:09 by rmk")
(* ; "Edited 15-Aug-2024 10:47 by rmk")
(* ; "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")
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
'INSERT TEXTOBJ)
TEXTOBJ SEL])
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL (FTEXTOBJ TSTREAM))
'INSERT TSTREAM)
TSTREAM SEL])
(\TEDIT.REDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 7-Jul-2024 11:59 by rmk")
[LAMBDA (TSTREAM EVENT ACTION) (* ; "Edited 21-Apr-2025 22:22 by rmk")
(* ; "Edited 6-Apr-2025 12:14 by rmk")
(* ; "Edited 7-Jul-2024 11:59 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 2-Oct-2023 11:43 by rmk")
(* ; "Edited 31-May-2023 10:25 by rmk")
@@ -834,28 +901,31 @@
(* ;; "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 (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
EVENT))
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
NIL TSTREAM)
TSTREAM)
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(\TEDIT.REDO.COMPOSITE
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
[LAMBDA (TSTREAM EVENT SEL) (* ; "Edited 6-Apr-2025 12:12 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 7-May-2024 23:12 by rmk")
(\TEDIT.THELP 'Redo-composite])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4922 5943 (\TEDIT.HISTORYEVENT.DEFPRINT 4932 . 5941)) (7033 17618 (\TEDIT.HISTORYADD
7043 . 11904) (\TEDIT.HISTORYADD.COMPOSITE 11906 . 12812) (\TEDIT.CUMULATE.EVENTS 12814 . 14408) (
\TEDIT.COMPOSITE.EVENT 14410 . 15146) (\TEDIT.HISTORY.PROP 15148 . 16511) (\TEDIT.HISTORY.EVENT 16513
. 17442) (\TEDIT.POPEVENT 17444 . 17616)) (17671 36249 (TEDIT.UNDO 17681 . 22240) (\TEDIT.UNDO1 22242
. 26663) (TEDIT.REDO 26665 . 33403) (\TEDIT.UNDO.UNDO 33405 . 36247)) (36250 51567 (
\TEDIT.UNDO.INSERT 36260 . 37173) (\TEDIT.UNDO.DELETE 37175 . 37969) (\TEDIT.UNDO.MOVE 37971 . 39560)
(\TEDIT.UNDO.REPLACE 39562 . 40779) (\TEDIT.UNDO.CHARLOOKS 40781 . 45355) (\TEDIT.UNDO.PARALOOKS 45357
. 49589) (\TEDIT.UNDO.PAGELOOKS 49591 . 50000) (\TEDIT.UNDO.COMPOSITE 50002 . 51229) (
\TEDIT.UNDO.REPLACECODE 51231 . 51565)) (51568 53928 (\TEDIT.REDO.INSERT 51578 . 52311) (
\TEDIT.REDO.REPLACE 52313 . 53644) (\TEDIT.REDO.COMPOSITE 53646 . 53926)))))
(FILEMAP (NIL (5074 6095 (\TEDIT.HISTORYEVENT.DEFPRINT 5084 . 6093)) (7185 18439 (\TEDIT.HISTORYADD
7195 . 12457) (\TEDIT.HISTORYADD.COMPOSITE 12459 . 13491) (\TEDIT.CUMULATE.EVENTS 13493 . 15087) (
\TEDIT.COMPOSITE.EVENT 15089 . 15825) (\TEDIT.HISTORY.PROP 15827 . 17190) (\TEDIT.HISTORY.EVENT 17192
. 18263) (\TEDIT.POPEVENT 18265 . 18437)) (18492 37479 (TEDIT.UNDO 18502 . 23378) (\TEDIT.UNDO1 23380
. 27718) (TEDIT.REDO 27720 . 34633) (\TEDIT.UNDO.UNDO 34635 . 37477)) (37480 55955 (
\TEDIT.UNDO.INSERT 37490 . 38615) (\TEDIT.UNDO.DELETE 38617 . 39629) (\TEDIT.UNDO.MOVE 39631 . 41284)
(\TEDIT.UNDO.REPLACE 41286 . 42796) (\TEDIT.UNDO.CHARLOOKS 42798 . 48035) (\TEDIT.UNDO.PARALOOKS 48037
. 51866) (\TEDIT.UNDO.PAGELOOKS 51868 . 52426) (\TEDIT.UNDO.COMPOSITE 52428 . 54028) (
\TEDIT.UNDO.REPLACECODE 54030 . 54364) (\TEDIT.UNDO.WRAP 54366 . 55295) (\TEDIT.UNDO.SEL 55297 . 55953
)) (55956 58929 (\TEDIT.REDO.INSERT 55966 . 56928) (\TEDIT.REDO.REPLACE 56930 . 58536) (
\TEDIT.REDO.COMPOSITE 58538 . 58927)))))
STOP

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

Binary file not shown.

351
library/tedit/TEDIT-LOOKS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Mar-2025 22:01:10" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;403 156185
(FILECREATED "24-Apr-2025 23:47:54" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;425 159446
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.TRANSLATE.ASCIICHARS)
:PREVIOUS-DATE "28-Mar-2025 14:24:25" {WMEDLEY}<library>TEDIT>TEDIT-LOOKS.;402)
:PREVIOUS-DATE "24-Apr-2025 16:05:02" {WMEDLEY}<library>tedit>TEDIT-LOOKS.;424)
(PRETTYCOMPRINT TEDIT-LOOKSCOMS)
@@ -42,7 +42,7 @@
(VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC))
(TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU))
(TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU)))
(FNS \TEDIT.CHARLOOK.FEATUREP)
(FNS \TEDIT.CHARLOOKS.FEATURE.CHECK)
(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU
TEDIT.DEFAULT.FMTSPEC)
(ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT)
@@ -145,8 +145,10 @@
(CLSELBEFORE FLAG) (* ;
 "T if TEDIT can put selection before this char (for menu fields).")
)
CLOFFSET _ 0 (INIT (DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)))
CLCOLOR)
CLOFFSET _ 0 CLCOLOR _ 'BLACK (INIT (DEFPRINT 'CHARLOOKS (FUNCTION
\TEDIT.CHARLOOKS.DEFPRINT
)))
(ACCESSFNS (CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM)
(replace (CHARLOOKS CLFONTUNPARSE) of DATUM with NEWVALUE))))
@@ -204,7 +206,7 @@
(/DECLAREDATATYPE 'CHARLOOKS
'(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG
POINTER POINTER POINTER POINTER FLAG FLAG)
POINTER POINTER POINTER POINTER FLAG FLAG POINTER)
'((CHARLOOKS 0 POINTER)
(CHARLOOKS 2 POINTER)
(CHARLOOKS 4 POINTER)
@@ -226,8 +228,9 @@
(CHARLOOKS 12 POINTER)
(CHARLOOKS 14 POINTER)
(CHARLOOKS 14 (FLAGBITS . 0))
(CHARLOOKS 14 (FLAGBITS . 16)))
'16)
(CHARLOOKS 14 (FLAGBITS . 16))
(CHARLOOKS 16 POINTER))
'18)
(DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
@@ -341,7 +344,7 @@
(/DECLAREDATATYPE 'CHARLOOKS
'(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG
POINTER POINTER POINTER POINTER FLAG FLAG)
POINTER POINTER POINTER POINTER FLAG FLAG POINTER)
'((CHARLOOKS 0 POINTER)
(CHARLOOKS 2 POINTER)
(CHARLOOKS 4 POINTER)
@@ -363,8 +366,9 @@
(CHARLOOKS 12 POINTER)
(CHARLOOKS 14 POINTER)
(CHARLOOKS 14 (FLAGBITS . 0))
(CHARLOOKS 14 (FLAGBITS . 16)))
'16)
(CHARLOOKS 14 (FLAGBITS . 16))
(CHARLOOKS 16 POINTER))
'18)
(DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
@@ -505,11 +509,11 @@
(Helvetica 'HELVETICA)
(Times% Roman 'TIMESROMAN)))
(RPAQQ TEDIT.CHARLOOKS.FEATURES (DEVICE FAMILY SIZE FACE ITALIC WEIGHT SLOPE BOLD EXPANSION FONT
INVERTED INVISIBLE OFFSET OFFSETINCREMENT OVERLINE PROTECTED
SELECTPOINT SELAFTER SELBEFORE SIZEINCREMENT SMALLCAPS
STRIKEOUT STYLE SUBSCRIPT SUPERSCRIPT UNBREAKABLE UNDERLINE
USERINFO OFFSETTYPE))
(RPAQQ TEDIT.CHARLOOKS.FEATURES
(DEVICE FAMILY SIZE FACE ITALIC WEIGHT SLOPE BOLD EXPANSION FONT INVERTED INVISIBLE OFFSET
OFFSETINCREMENT OVERLINE PROTECTED SELECTPOINT SELAFTER SELBEFORE SIZEINCREMENT
SMALLCAPS STRIKEOUT STYLE SUBSCRIPT SUPERSCRIPT UNBREAKABLE UNDERLINE USERINFO
OFFSETTYPE COLOR))
(RPAQ TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC))
@@ -518,9 +522,31 @@
(RPAQ TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU))
(DEFINEQ
(\TEDIT.CHARLOOK.FEATUREP
[LAMBDA (P) (* ; "Edited 27-Jul-2024 17:33 by rmk")
(MEMB P TEDIT.CHARLOOKS.FEATURES])
(\TEDIT.CHARLOOKS.FEATURE.CHECK
[LAMBDA (LOOKSLIST TSTREAM) (* ; "Edited 22-Apr-2025 20:38 by rmk")
(* ;; "Checks to see whether LOOKSLIST contains any invalid character properties. If so, then if TSTREAM is provided, prints a message in its prompt window and returns the (non-NIL) list of offenders. Otherwise, causes an error.")
(CL:UNLESS (OR (type? CHARLOOKS LOOKSLIST)
(FONTP LOOKSLIST))
[for FTAIL on (MKLIST LOOKSLIST) by (CDDR FTAIL) unless (MEMB (CAR FTAIL)
TEDIT.CHARLOOKS.FEATURES)
collect (CAR FTAIL) finally (CL:WHEN $$VAL
(if TSTREAM
then (TEDIT.PROMPTPRINT TSTREAM
(CL:IF (CDR $$VAL)
(CONCAT $$VAL
" are not valid character properties--aborted"
)
(CONCAT (CAR $$VAL)
" is not a valid character property--aborted"
))
T)
elseif (CDR $$VAL)
then (ERROR "Invalid character properties" $$VAL)
else (ERROR "Invalid character property" (CAR $$VAL))))])
])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -565,7 +591,8 @@
CLNAME _ (FONTUNPARSE FONT])
(\TEDIT.EQCLOOKS
[LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 2-Jan-2025 21:01 by rmk")
[LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 15-Apr-2025 16:45 by rmk")
(* ; "Edited 2-Jan-2025 21:01 by rmk")
(* ; "Edited 18-Oct-2024 22:29 by rmk")
(* ; "Edited 11-Aug-2024 20:41 by rmk")
(* ; "Edited 31-Jul-2024 00:05 by rmk")
@@ -604,6 +631,8 @@
(FGETCLOOKS CLOOK2 CLOFFSET))
(EQ (FGETCLOOKS CLOOK1 CLSMALLCAP)
(FGETCLOOKS CLOOK2 CLSMALLCAP))
(EQ (FGETCLOOKS CLOOK1 CLCOLOR)
(FGETCLOOKS CLOOK2 CLCOLOR))
(EQUAL (FGETCLOOKS CLOOK1 CLSTYLE)
(FGETCLOOKS CLOOK2 CLSTYLE))
(EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
@@ -612,7 +641,8 @@
(FGETCLOOKS CLOOK2 CLUSERINFO])
(\TEDIT.SAMECLOOKS
[LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 2-Jan-2025 20:31 by rmk")
[LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 15-Apr-2025 16:42 by rmk")
(* ; "Edited 2-Jan-2025 20:31 by rmk")
(* ; "Edited 31-Dec-2024 23:59 by rmk")
(* ; "Edited 31-Jul-2024 00:06 by rmk")
(* ; "Edited 24-Jul-2023 17:17 by rmk")
@@ -649,6 +679,8 @@
(FGETCLOOKS CLOOK2 CLULINE)))
(UNBREAKABLE (FGETCLOOKS CLOOK1 CLUNBREAKABLE)
(FGETCLOOKS CLOOK2 CLUNBREAKABLE))
(COLOR (FGETCLOOKS CLOOK1 CLCOLOR)
(FGETCLOOKS CLOOK2 CLCOLOR))
(FACE (EQUAL (FONTPROP FONT1 'FACE)
(FONTPROP FONT2 'FACE)))
(ERROR (CONCAT F
@@ -727,7 +759,8 @@
DEST])
(\TEDIT.UNPARSE.CHARLOOKS.LIST
[LAMBDA (LOOKS) (* ; "Edited 29-Dec-2024 12:14 by rmk")
[LAMBDA (LOOKS) (* ; "Edited 15-Apr-2025 16:41 by rmk")
(* ; "Edited 29-Dec-2024 12:14 by rmk")
(* ; "Edited 31-Jul-2024 00:06 by rmk")
(* ; "Edited 24-Jul-2023 17:28 by rmk")
(* ; "Edited 11-Feb-2023 14:51 by rmk")
@@ -738,23 +771,31 @@
(\DTEST LOOKS 'CHARLOOKS)
(LET (NEWLOOKS (OFFSET (FGETCLOOKS LOOKS CLOFFSET))
(FONT (FGETCLOOKS LOOKS CLFONT)))
[SETQ NEWLOOKS
(NCONC (if (ILESSP OFFSET 0)
then (LIST 'SUBSCRIPT (IMINUS OFFSET))
else (IGREATERP OFFSET 0)
then (LIST 'SUPERSCRIPT OFFSET))
(for PVAL in (LIST (ONOFF (FGETCLOOKS LOOKS CLINVERTED))
(ONOFF (FGETCLOOKS LOOKS CLULINE))
(ONOFF (FGETCLOOKS LOOKS CLSTRIKE))
(ONOFF (FGETCLOOKS LOOKS CLOLINE))
(ONOFF (FGETCLOOKS LOOKS CLUNBREAKABLE))
(ONOFF (FGETCLOOKS LOOKS CLPROTECTED))
(ONOFF (FGETCLOOKS LOOKS CLSELAFTER))
(ONOFF (FGETCLOOKS LOOKS CLINVISIBLE))
(FGETCLOOKS LOOKS CLSTYLE)
(FGETCLOOKS LOOKS CLUSERINFO LOOKS)) as PNAME
in '(INVERTED UNDERLINE STRIKEOUT OVERLINE UNBREAKABLE PROTECTED SELECTPOINT
INVISIBLE STYLE USERINFO) join (LIST PNAME PVAL]
[SETQ NEWLOOKS (NCONC (if (ILESSP OFFSET 0)
then (LIST 'SUBSCRIPT (IMINUS OFFSET))
else (IGREATERP OFFSET 0)
then (LIST 'SUPERSCRIPT OFFSET))
`(INVERTED ,(ONOFF (FGETCLOOKS LOOKS CLINVERTED))
UNDERLINE
,(ONOFF (FGETCLOOKS LOOKS CLULINE))
STRIKEOUT
,(ONOFF (FGETCLOOKS LOOKS CLSTRIKE))
OVERLINE
,(ONOFF (FGETCLOOKS LOOKS CLOLINE))
UNBREAKABLE
,(ONOFF (FGETCLOOKS LOOKS CLUNBREAKABLE))
COLOR
,(FGETCLOOKS LOOKS CLCOLOR)
STYLE
,(FGETCLOOKS LOOKS CLSTYLE)
INVISIBLE
,(ONOFF (FGETCLOOKS LOOKS CLINVISIBLE))
PROTECTED
,(ONOFF (FGETCLOOKS LOOKS CLPROTECTED))
SELECTPOINT
,(ONOFF (FGETCLOOKS LOOKS CLSELAFTER))
USERINFO
,(FGETCLOOKS LOOKS CLUSERINFO LOOKS]
(* ;; "Font properties. Don't show the separate properties if a font class, just the class. And if not a class, just show the properties, not the font. So there is always a consistent picture.")
@@ -771,39 +812,41 @@
NEWLOOKS])
(\TEDIT.MODIFYLOOKS
[LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* ; "Edited 20-Nov-2023 14:18 by rmk")
[LAMBDA (LINE STARTX DS CLOOKS LINEBASEY) (* ; "Edited 11-Apr-2025 17:32 by rmk")
(* ; "Edited 20-Nov-2023 14:18 by rmk")
(* ; "Edited 27-May-2023 12:11 by rmk")
(* ; "Edited 24-Sep-2022 11:12 by rmk")
(* ; "Edited 30-May-91 21:45 by jds")
(* ;; "Modify the screen to allow for underlining, etc. Also, restore the vertical offset to the baseline.")
(LET ((CURX (DSPXPOSITION NIL DS))
(CURY (DSPYPOSITION NIL DS))
(FONT (fetch (CHARLOOKS CLFONT) of LOOKS)))
(CL:WHEN (fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.")
(MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY)
(GETLD LINE LTRUEDESCENT)))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line")
(MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT]
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struck-thru")
(MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT)
3))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (fetch (CHARLOOKS CLINVERTED) of LOOKS) (* ; "Inverse video")
(BLTSHADE BLACKSHADE DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT))
(IDIFFERENCE CURX STARTX)
(FONTPROP FONT 'HEIGHT)
'INVERT))
(MOVETO CURX LINEBASEY DS])
(CL:WHEN CLOOKS
(LET ((CURX (DSPXPOSITION NIL DS))
(CURY (DSPYPOSITION NIL DS))
(FONT (FGETCLOOKS CLOOKS CLFONT)))
(CL:WHEN (FGETCLOOKS CLOOKS CLULINE) (* ; "Underlined.")
(MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY)
(GETLD LINE LTRUEDESCENT)))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (FGETCLOOKS CLOOKS CLOLINE) (* ; "Over-line")
(MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT]
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (FGETCLOOKS CLOOKS CLSTRIKE) (* ; "Struck-thru")
(MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT)
3))
DS)
(RELDRAWTO (IDIFFERENCE CURX STARTX)
0 1 'PAINT DS))
(CL:WHEN (FGETCLOOKS CLOOKS CLINVERTED) (* ; "Inverse video")
(BLTSHADE BLACKSHADE DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT))
(IDIFFERENCE CURX STARTX)
(FONTPROP FONT 'HEIGHT)
'INVERT))
(MOVETO CURX LINEBASEY DS)))])
(TEDIT.NEW.FONT
[LAMBDA (TEXTOBJ) (* ; "Edited 29-Jun-2024 16:31 by rmk")
@@ -836,7 +879,8 @@
TEXTOBJ])
(\TEDIT.GET.INSERT.CHARLOOKS
[LAMBDA (TEXTOBJ SEL/CHNO) (* ; "Edited 26-Nov-2024 04:58 by rmk")
[LAMBDA (TEXTOBJ SEL/CHNO) (* ; "Edited 22-Apr-2025 10:28 by rmk")
(* ; "Edited 26-Nov-2024 04:58 by rmk")
(* ; "Edited 23-Oct-2024 00:04 by rmk")
(* ; "Edited 31-Jul-2024 12:10 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
@@ -849,8 +893,6 @@
(* ;; "We want to get the looks of a selected character. If point is RIGHT, that's the last character of the selection. If LEFT, the first character of the selection.")
(* ;; "Return the looks at SEL, or defaults. Reset CLPROTECTED if need be.")
(LET ((PC (\TEDIT.CHTOPC (IMAX 1 (IMIN (TEXTLEN TEXTOBJ)
(if (type? SELECTION SEL/CHNO)
then (SELECTQ (GETSEL SEL/CHNO POINT)
@@ -862,6 +904,9 @@
else SEL/CHNO)))
TEXTOBJ))
LOOKS)
(CL:WHEN (AND (PPARALAST PC)
(PREVPIECE PC)) (* ; "Get the looks before the EOL")
(SETQ PC (PREVPIECE PC)))
(SETQ LOOKS (if PC
then (PCHARLOOKS PC)
elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
@@ -901,7 +946,8 @@
(DEFINEQ
(\TEDIT.TRANSLATE.ASCIICHARS
[LAMBDA (TSTREAM NOASCIIFONTS) (* ; "Edited 30-Mar-2025 22:00 by rmk")
[LAMBDA (TSTREAM NOASCIIFONTS) (* ; "Edited 24-Apr-2025 23:47 by rmk")
(* ; "Edited 30-Mar-2025 22:00 by rmk")
(* ; "Edited 28-Mar-2025 14:24 by rmk")
(* ; "Edited 2-Jan-2025 23:30 by rmk")
(* ; "Edited 30-Dec-2024 21:30 by rmk")
@@ -915,7 +961,7 @@
(* ; "Edited 14-Nov-2023 19:21 by rmk")
(* ; "Edited 9-Nov-2023 23:56 by rmk")
(* ;; "Converts characters in Alto/Ascii font pieces to their XCCS character and font (more or less) equivalents. The affected characters are put in their own string pieces with their new CHARLOOKS. Asciifont pieces are completely replaced if NOASCIIFONTS, otherwise untranslated characters remain in their Asciifonts.")
(* ;; "Converts characters in Alto/Ascii font pieces to their MCCS character and font (more or less) equivalents. The affected characters are put in their own string pieces with their new CHARLOOKS. Asciifont pieces are completely replaced if NOASCIIFONTS, otherwise untranslated characters remain in their Asciifonts.")
(* ;; "ASCIITONSTRANSLATIONS and the mapping arrays are from INTERPRESS.")
@@ -970,7 +1016,7 @@
(* ;;
 "Out-of-range alone and zero newcodes alone (some arrays are not filled in).")
(SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC OFFSET))
(SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
(RPLCHARCODE STRING OFFSET
(if [OR (IGREATERP OLDCODE TARRAYLAST)
(ZEROP (SETQ NEWCODE (ELT MAPARRAY OLDCODE]
@@ -998,7 +1044,7 @@
(* ;; "Find the first change quickly, in piece coordinates. Then change whatever else needs it, slowly, in document coordinates. It would be more complicated to do the replacements in piece coordinates, because the pieces would get split on the fly. ")
(for OFFSET OLDCODE NEWLOOKS from 1 to (PLEN PC)
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC OFFSET))
eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE PC OFFSET))
when (ILEQ OLDCODE 255) unless (EQ OLDCODE (ELT \ASCII2MCCS OLDCODE))
do
(* ;; "First hit, scan/change the rest of PC")
@@ -1047,7 +1093,8 @@
(\TEDIT.UNIQUIFY.ALL TEXTOBJ))))])
(\TEDIT.CONVERT.TO.FORMATTED
[LAMBDA (TSTREAM START END) (* ; "Edited 28-Mar-2025 14:11 by rmk")
[LAMBDA (TSTREAM START END) (* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 14:11 by rmk")
(* ; "Edited 7-Jul-2024 09:06 by rmk")
(* ; "Edited 10-May-2024 22:42 by rmk")
(* ; "Edited 6-May-2024 23:49 by rmk")
@@ -1119,9 +1166,10 @@
repeatuntil (IGEQ CHNO END) finally (FSETTOBJ TEXTOBJ FORMATTEDP T)
(CL:WHEN CHANGED
(FSETTOBJ TEXTOBJ \DIRTY T)
(\TEDIT.UPDATE.LINES (CL:IF CRLF
'DELETION
'CHANGED)
(\TEDIT.UPDATE.LINES TSTREAM
(CL:IF CRLF
'DELETION
'CHANGED)
START
(ADD1 (IDIFFERENCE END START))))]))])
)
@@ -1316,22 +1364,27 @@
TEXTOBJ])
(TEDIT.SUBLOOKS
[LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 25-Nov-2024 21:57 by rmk")
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 22-Apr-2025 20:41 by rmk")
(* ; "Edited 20-Apr-2025 13:26 by rmk")
(* ; "Edited 6-Apr-2025 14:27 by rmk")
(* ; "Edited 5-Apr-2025 13:31 by rmk")
(* ; "Edited 25-Nov-2024 21:57 by rmk")
(* ; "Edited 5-Jul-2024 22:54 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 18-May-2024 16:22 by rmk")
(* ; "Edited 10-May-2024 22:42 by rmk")
(* ; "Edited 17-Mar-2024 17:17 by rmk")
(* ; "Edited 6-May-2024 17:27 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
(* ; "Edited 13-Nov-2023 00:26 by rmk")
(* ; "Edited 18-Apr-2023 23:53 by rmk")
(* ; "Edited 22-Aug-2022 13:06 by rmk")
(* ; "Edited 26-Apr-93 14:53 by jds")
(* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.")
(* ;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.")
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ; "Turn off the selection, first.")
(* ;; "")
(* ;; "Note: might be more useful to provide SEL/CH# and LEN arguments, create the selpieces, and do inselpieces.")
(\TEDIT.CHARLOOKS.FEATURE.CHECK OLDLOOKSLIST) (* ; "Error if invalid")
(\TEDIT.CHARLOOKS.FEATURE.CHECK NEWLOOKSLIST)
(LET ((TEXTOBJ (TEXTOBJ TSTREAM)))
(CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
(for PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0)
(OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST NIL TEXTOBJ))
@@ -1341,8 +1394,9 @@
when (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC)
FEATURELIST) do (CL:UNLESS CHANGEMADE
(SETQ CHANGEMADE T)
(SETQ SEL (FGETTOBJ TEXTOBJ SEL))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(SETQ SEL (TEXTSEL TEXTOBJ))
(\TEDIT.NOSEL TSTREAM)
(* ; "Turn off the selection, first.")
(FSETTOBJ TEXTOBJ \DIRTY T))
(* ;;
@@ -1361,8 +1415,8 @@
(add NCHARSCHANGED (PLEN PC))
finally (CL:WHEN (AND CHANGEMADE (\TEDIT.PRIMARYPANE TEXTOBJ))
(* ; "Update the screen image")
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED)
(\TEDIT.SHOWSEL SEL T TSTREAM))
(RETURN CHANGEMADE)))])
(TEDIT.FINDLOOKS
@@ -1409,18 +1463,19 @@
(DEFINEQ
(\TEDIT.CHANGE.CHARLOOKS
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 21-Mar-2025 23:15 by rmk")
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 22-Apr-2025 20:17 by rmk")
(* ; "Edited 21-Apr-2025 20:17 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 16-Apr-2025 09:03 by rmk")
(* ; "Edited 6-Apr-2025 14:28 by rmk")
(* ; "Edited 21-Mar-2025 23:15 by rmk")
(* ; "Edited 19-Mar-2025 12:55 by rmk")
(* ; "Edited 31-Jan-2025 10:31 by rmk")
(* ; "Edited 1-Jan-2025 18:11 by rmk")
(* ; "Edited 29-Dec-2024 20:08 by rmk")
(* ; "Edited 26-Nov-2024 23:50 by rmk")
(* ; "Edited 22-Oct-2024 23:37 by rmk")
(* ; "Edited 2-Oct-2024 14:22 by rmk")
(* ; "Edited 28-Sep-2024 17:58 by rmk")
(* ; "Edited 16-Aug-2024 22:41 by rmk")
(* ; "Edited 11-Aug-2024 21:12 by rmk")
(* ; "Edited 6-Aug-2024 09:33 by rmk")
(* ; "Edited 31-Jul-2024 12:05 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 15-Mar-2024 14:23 by rmk")
@@ -1449,19 +1504,7 @@
elseif (FONTP NEWLOOKS)
then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT NEWLOOKS T)
TEXTOBJ))
elseif (for PTAIL on NEWLOOKS by (CDDR PTAIL) unless (OR (\TEDIT.CHARLOOK.FEATUREP
(CAR PTAIL))
(NULL (CADR PTAIL)))
do
(* ;;
 "OK if a known property or NIL value. Caller can delete temporary properties.")
(TEDIT.PROMPTPRINT TSTREAM (CONCAT (CAR PTAIL)
" is not a valid character property--aborted"
)
T T)
(RETURN T))
elseif (\TEDIT.CHARLOOKS.FEATURE.CHECK NEWLOOKS TSTREAM)
then (RETURN)
elseif (AND (SETQ FONT (LISTGET NEWLOOKS 'FONT))
(for PTAIL on NEWLOOKS by (CDDR PTAIL)
@@ -1510,8 +1553,8 @@
NIL NIL (CONS NEWLOOKS (AND DIRTY (DREVERSE
UNDOLIST]
(CL:WHEN DIRTY (* ; "Something changed")
(CL:WHEN (\TEDIT.PRIMARYPANE TEXTOBJ)
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
(CL:WHEN (\TEDIT.PRIMARYPANE TSTREAM)
(\TEDIT.NOSEL TSTREAM)
(SELECTQ (LISTGET NEWLOOKS 'INVISIBLE)
(ON
(* ;;
@@ -1537,13 +1580,15 @@
TEXTOBJ)))
TEXTOBJ)))
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS SELPIECES)
(\TEDIT.SHOWSEL NIL T TEXTOBJ)
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS (GETSPC SELPIECES SPFIRSTCHAR)
(GETSPC SELPIECES SPLEN))
(\TEDIT.SHOWSEL NIL T TSTREAM)
(\TEDIT.TEXTSETFILEPTR TSTREAM ORIGFILEPTR)))]
(RETURN DIRTY])
(\TEDIT.CHANGE.CHARLOOKS.NEW
[LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 2-Jan-2025 15:49 by rmk")
[LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 15-Apr-2025 16:47 by rmk")
(* ; "Edited 2-Jan-2025 15:49 by rmk")
(* ; "Edited 1-Jan-2025 09:04 by rmk")
(* ; "Edited 2-Dec-2024 23:52 by rmk")
(* ; "Edited 29-Aug-2024 11:12 by rmk")
@@ -1581,6 +1626,7 @@
(UNDERLINE (FSETCLOOKS NEWCHARLOOKS CLULINE VAL))
(STYLE (FSETCLOOKS NEWCHARLOOKS CLSTYLE VAL))
(UNBREAKABLE (FSETCLOOKS NEWCHARLOOKS CLUNBREAKABLE VAL))
(COLOR (FSETCLOOKS NEWCHARLOOKS CLCOLOR VAL))
(STRIKEOUT (FSETCLOOKS NEWCHARLOOKS CLSTRIKE VAL))
(INVERTED (FSETCLOOKS NEWCHARLOOKS CLINVERTED VAL))
((SELECTPOINT SELAFTER)
@@ -2129,20 +2175,17 @@
then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))])
(\TEDIT.CHANGE.PARALOOKS
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 19-Mar-2025 13:09 by rmk")
[LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 21-Apr-2025 23:27 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 16-Apr-2025 09:05 by rmk")
(* ; "Edited 6-Apr-2025 14:29 by rmk")
(* ; "Edited 19-Mar-2025 13:09 by rmk")
(* ; "Edited 8-Feb-2025 22:30 by rmk")
(* ; "Edited 31-Jan-2025 09:45 by rmk")
(* ; "Edited 6-Jan-2025 23:41 by rmk")
(* ; "Edited 5-Jan-2025 16:01 by rmk")
(* ; "Edited 26-Nov-2024 23:51 by rmk")
(* ; "Edited 27-Sep-2024 16:06 by rmk")
(* ; "Edited 16-Aug-2024 14:21 by rmk")
(* ; "Edited 11-Aug-2024 21:59 by rmk")
(* ; "Edited 4-Aug-2024 23:19 by rmk")
(* ; "Edited 2-Aug-2024 00:39 by rmk")
(* ; "Edited 1-Aug-2024 00:12 by rmk")
(* ; "Edited 29-Jul-2024 11:20 by rmk")
(* ; "Edited 26-Jul-2024 16:17 by rmk")
(* ; "Edited 13-Jul-2024 22:55 by rmk")
(* ;; "Apply new looks to the piece that begins the paragraph containing the first selected character, the piece that ends the paragraph containing the last piece of the selection, and all pieces in between. All the pieces within a paragraph have the same looks.")
@@ -2195,7 +2238,7 @@
(* ;; "First piece of a new paragraph, get the NEWFMTSPEC for all its pieces")
(CL:UNLESS UNDOLIST (\TEDIT.SHOWSEL NIL NIL TEXTOBJ))
(CL:UNLESS UNDOLIST (\TEDIT.NOSEL TSTREAM))
(SETQ OLDPARALOOKS (PPARALOOKS PC))
(SETQ NEWPARALOOKS (CL:IF (type? PARALOOKS NEWLOOKS)
NEWLOOKS
@@ -2228,10 +2271,10 @@
(CL:WHEN (\TEDIT.PRIMARYPANE TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS PARAPIECES)
(* ;
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS (GETSPC PARAPIECES SPFIRSTCHAR)
(GETSPC PARAPIECES SPLEN)) (* ;
 "Update the screen image, showing the original selection")
(\TEDIT.SHOWSEL NIL T TEXTOBJ)))
(\TEDIT.SHOWSEL NIL T TSTREAM)))
(\TEDIT.TEXTSETFILEPTR TSTREAM ORIGFILEPTR])
(\TEDIT.CHANGE.PARALOOKS.NEW
@@ -2365,7 +2408,10 @@
(DEFINEQ
(TEDIT.SUBPARALOOKS
[LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 25-Nov-2024 22:00 by rmk")
[LAMBDA (TSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 21-Apr-2025 20:15 by rmk")
(* ; "Edited 20-Apr-2025 13:27 by rmk")
(* ; "Edited 6-Apr-2025 14:31 by rmk")
(* ; "Edited 25-Nov-2024 22:00 by rmk")
(* ; "Edited 5-Jul-2024 22:54 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 18-May-2024 16:22 by rmk")
@@ -2380,7 +2426,8 @@
(* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.")
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)))
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM)))
(for PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0)
(OLDLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST OLDLOOKSLIST))
(NEWLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST NEWLOOKSLIST))
@@ -2391,7 +2438,7 @@
 "First change, turn off the selection")
(SETQ CHANGEMADE T)
(SETQ SEL (FGETTOBJ TEXTOBJ SEL))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(FSETTOBJ TEXTOBJ \DIRTY T))
(FSETPC PC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS
(\TEDIT.PARSE.PARALOOKS.LIST
@@ -2404,10 +2451,10 @@
(CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO CH#))
(add NCHARSCHANGED (PLEN PC))
finally (CL:WHEN (AND CHANGEMADE (\TEDIT.PRIMARYPANE TEXTOBJ))
finally (CL:WHEN (AND CHANGEMADE (\TEDIT.PRIMARYPANE TSTREAM))
(* ; "Update the screen image")
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
(\TEDIT.UPDATE.LINES TSTREAM 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED)
(\TEDIT.SHOWSEL SEL T TSTREAM))
(RETURN CHANGEMADE])
(SAMEPARALOOKS
@@ -2484,26 +2531,26 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22577 24519 (\TEDIT.CHARLOOKS.DEFPRINT 22587 . 23723) (\TEDIT.PARALOOKS.DEFPRINT 23725
. 24517)) (24623 25719 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24633 . 25341) (\TEDIT.CREATE.FACE.MENU 25343
. 25515) (\TEDIT.CREATE.SIZE.MENU 25517 . 25717)) (26620 26809 (\TEDIT.CHARLOOK.FEATUREP 26630 .
26807)) (27111 50383 (\TEDIT.CHARLOOKS.FROM.FONT 27121 . 29334) (\TEDIT.EQCLOOKS 29336 . 31958) (
\TEDIT.SAMECLOOKS 31960 . 34630) (TEDIT.CARETLOOKS 34632 . 36178) (TEDIT.COPY.LOOKS 36180 . 39463) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 39465 . 42432) (\TEDIT.MODIFYLOOKS 42434 . 44428) (TEDIT.NEW.FONT 44430
. 44877) (\TEDIT.CARETLOOKS.VERIFY 44879 . 45716) (\TEDIT.CARETPIECE 45718 . 46023) (
\TEDIT.GET.INSERT.CHARLOOKS 46025 . 48761) (\TEDIT.GET.TERMSA.WIDTHS 48763 . 49179) (
\TEDIT.PARSE.CHARLOOKS.LIST 49181 . 50381)) (50384 67283 (\TEDIT.TRANSLATE.ASCIICHARS 50394 . 61173) (
\TEDIT.CONVERT.TO.FORMATTED 61175 . 67281)) (68295 75406 (\TEDIT.UNIQUIFY.CHARLOOKS 68305 . 69965) (
\TEDIT.UNIQUIFY.PARALOOKS 69967 . 71234) (\TEDIT.UNIQUIFY.ALL 71236 . 73211) (
\TEDIT.FLUSH.UNUSED.LOOKS 73213 . 75404)) (75439 86535 (TEDIT.LOOKS 75449 . 77838) (TEDIT.GET.LOOKS
77840 . 79869) (TEDIT.SUBLOOKS 79871 . 83899) (TEDIT.FINDLOOKS 83901 . 86533)) (86610 116528 (
\TEDIT.CHANGE.CHARLOOKS 86620 . 95856) (\TEDIT.CHANGE.CHARLOOKS.NEW 95858 . 99483) (
\TEDIT.CHARLOOKS.CHANGE.FONT 99485 . 107792) (\TEDIT.FONT.NEXTSIZE 107794 . 109415) (\TEDIT.LOOKS
109417 . 112746) (\TEDIT.FONTCOPY 112748 . 114249) (\TEDIT.COERCE.FONTCLASS 114251 . 115402) (
\TEDIT.FONTCLASS.TO.FONT 115404 . 116526)) (116571 147845 (\TEDIT.EQFMTSPEC 116581 . 119796) (
TEDIT.GET.PARALOOKS 119798 . 123845) (\TEDIT.PARSE.PARALOOKS.LIST 123847 . 131189) (TEDIT.PARALOOKS
131191 . 132231) (\TEDIT.CHANGE.PARALOOKS 132233 . 139518) (\TEDIT.CHANGE.PARALOOKS.NEW 139520 .
143503) (TEDIT.COPY.PARALOOKS 143505 . 146179) (\TEDIT.PARABOUNDS 146181 . 147843)) (147905 155303 (
TEDIT.SUBPARALOOKS 147915 . 151699) (SAMEPARALOOKS 151701 . 155301)) (155304 155991 (
\TEDIT.MARK.REVISION 155314 . 155989)))))
(FILEMAP (NIL (22843 24785 (\TEDIT.CHARLOOKS.DEFPRINT 22853 . 23989) (\TEDIT.PARALOOKS.DEFPRINT 23991
. 24783)) (24889 25985 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24899 . 25607) (\TEDIT.CREATE.FACE.MENU 25609
. 25781) (\TEDIT.CREATE.SIZE.MENU 25783 . 25983)) (26784 28673 (\TEDIT.CHARLOOKS.FEATURE.CHECK 26794
. 28671)) (28975 53558 (\TEDIT.CHARLOOKS.FROM.FONT 28985 . 31198) (\TEDIT.EQCLOOKS 31200 . 34022) (
\TEDIT.SAMECLOOKS 34024 . 36910) (TEDIT.CARETLOOKS 36912 . 38458) (TEDIT.COPY.LOOKS 38460 . 41743) (
\TEDIT.UNPARSE.CHARLOOKS.LIST 41745 . 45239) (\TEDIT.MODIFYLOOKS 45241 . 47401) (TEDIT.NEW.FONT 47403
. 47850) (\TEDIT.CARETLOOKS.VERIFY 47852 . 48689) (\TEDIT.CARETPIECE 48691 . 48996) (
\TEDIT.GET.INSERT.CHARLOOKS 48998 . 51936) (\TEDIT.GET.TERMSA.WIDTHS 51938 . 52354) (
\TEDIT.PARSE.CHARLOOKS.LIST 52356 . 53556)) (53559 70705 (\TEDIT.TRANSLATE.ASCIICHARS 53569 . 64441) (
\TEDIT.CONVERT.TO.FORMATTED 64443 . 70703)) (71717 78828 (\TEDIT.UNIQUIFY.CHARLOOKS 71727 . 73387) (
\TEDIT.UNIQUIFY.PARALOOKS 73389 . 74656) (\TEDIT.UNIQUIFY.ALL 74658 . 76633) (
\TEDIT.FLUSH.UNUSED.LOOKS 76635 . 78826)) (78861 90168 (TEDIT.LOOKS 78871 . 81260) (TEDIT.GET.LOOKS
81262 . 83291) (TEDIT.SUBLOOKS 83293 . 87532) (TEDIT.FINDLOOKS 87534 . 90166)) (90243 119751 (
\TEDIT.CHANGE.CHARLOOKS 90253 . 98910) (\TEDIT.CHANGE.CHARLOOKS.NEW 98912 . 102706) (
\TEDIT.CHARLOOKS.CHANGE.FONT 102708 . 111015) (\TEDIT.FONT.NEXTSIZE 111017 . 112638) (\TEDIT.LOOKS
112640 . 115969) (\TEDIT.FONTCOPY 115971 . 117472) (\TEDIT.COERCE.FONTCLASS 117474 . 118625) (
\TEDIT.FONTCLASS.TO.FONT 118627 . 119749)) (119794 150751 (\TEDIT.EQFMTSPEC 119804 . 123019) (
TEDIT.GET.PARALOOKS 123021 . 127068) (\TEDIT.PARSE.PARALOOKS.LIST 127070 . 134412) (TEDIT.PARALOOKS
134414 . 135454) (\TEDIT.CHANGE.PARALOOKS 135456 . 142424) (\TEDIT.CHANGE.PARALOOKS.NEW 142426 .
146409) (TEDIT.COPY.PARALOOKS 146411 . 149085) (\TEDIT.PARABOUNDS 149087 . 150749)) (150811 158564 (
TEDIT.SUBPARALOOKS 150821 . 154960) (SAMEPARALOOKS 154962 . 158562)) (158565 159252 (
\TEDIT.MARK.REVISION 158575 . 159250)))))
STOP

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

Binary file not shown.

621
library/tedit/TEDIT-MENU
View File

@@ -1,12 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Mar-2025 14:56:57" {WMEDLEY}<library>tedit>TEDIT-MENU.;464 162009
(FILECREATED "29-May-2025 09:31:55" {WMEDLEY}<library>tedit>TEDIT-MENU.;486 179156
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.FILLIN)
:CHANGES-TO (FNS \TEDIT.EXPANDEDMENU.CREATE \TEDIT.EXPANDEDMENU.ACTIONFN TEDIT.DEFAULT.MENUFN
\TEDIT.PAGEMENU.START \TEDIT.EXPANDEDMENU.START \TEDIT.CHARMENU.START
\TEDIT.PARAMENU.START \TEDIT.MENU.OPEN?)
(VARS TEDIT-MENUCOMS)
:PREVIOUS-DATE "19-Mar-2025 10:01:40" {WMEDLEY}<library>tedit>TEDIT-MENU.;461)
:PREVIOUS-DATE "26-May-2025 20:12:04" {WMEDLEY}<library>tedit>TEDIT-MENU.;478)
(PRETTYCOMPRINT TEDIT-MENUCOMS)
@@ -26,6 +29,16 @@
(* ;; "")
(* ; "Middle button in title")
[COMS (* ; "Menu interfacing")
(FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU
\TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN)
(GLOBALVARS TEDIT.DEFAULT.MENU)
(VARS \TEDIT.DEFAULTMENU.ITEMS)
(DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.DEFAULT.MENU (\TEDIT.CREATEMENU
(COPY
\TEDIT.DEFAULTMENU.ITEMS
]
[COMS (* ; "MARGINBAR")
(FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.BUTTONEVENTINFN
MB.MARGINBAR.SELFN.TABS MB.MARGINBAR.SELFN.TABS.KIND MARGINBAR.GETSTATEFN
@@ -36,7 +49,8 @@
\TEDIT.DOTTED.LEFTTAB \TEDIT.DOTTED.CENTERTAB \TEDIT.DOTTED.RIGHTTAB
\TEDIT.DOTTED.DECIMALTAB TEDIT.EXTENDEDRIGHTMARK)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT]
(COMS (FNS TEDIT.MENUSTREAM TEDITMENUP \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN)
(COMS (FNS TEDIT.MENUSTREAM TEDITMENUP \TEDIT.MENU.START \TEDIT.MENU.OPEN?
\TEDIT.MENU.BUTTONEVENTFN)
(BITMAPS TEXTMENUICON TEXTMENUICONMASK))
(* ; "Generic support for Tedit menus")
(FNS \TEDIT.MENU.CREATE \TEDIT.MENU.PARSE \TEDIT.MENU.NEUTRALIZE
@@ -78,9 +92,9 @@
(* ;; "")
(* ; "PAGEMENU")
(FNS \TEDIT.PAGEMENU.CREATE \TEDIT.SHOW.PAGELOOKS \TEDIT.PAGEMENU.FILLIN
\TEDIT.PAGEREGION.UNPARSE \TEDIT.APPLY.PAGELOOKS \TEDIT.CHANGE.PAGELOOKS
\TEDIT.PAGEMENU.CHARLOOKS.STATEFN)
(FNS \TEDIT.PAGEMENU.CREATE \TEDIT.PAGEMENU.START \TEDIT.SHOW.PAGELOOKS
\TEDIT.PAGEMENU.FILLIN \TEDIT.PAGEREGION.UNPARSE \TEDIT.APPLY.PAGELOOKS
\TEDIT.CHANGE.PAGELOOKS \TEDIT.PAGEMENU.CHARLOOKS.STATEFN)
(FNS \TEDIT.PAGEMENU.CREATE.HEADINGS \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN
\TEDIT.PAGEMENU.HEADINGS.STATEFN)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
@@ -137,6 +151,212 @@
(* ; "Middle button in title")
(* ; "Menu interfacing")
(DEFINEQ
(TEDIT.ADD.MENUITEM
[LAMBDA (MENU ITEM) (* ; "Edited 13-Apr-2025 19:53 by rmk")
(* jds " 9-AUG-83 09:55")
(CL:UNLESS (MEMBER ITEM (fetch ITEMS of MENU)) (* ; "Do nothing--it's already there ")
(LET (OLDITM)
(if [AND (LISTP ITEM)
(SETQ OLDITM (SASSOC (CAR ITEM)
(fetch ITEMS of MENU]
then (* ;
 "The menu item exists. Make sure the thing behind it is right.")
(RPLACD OLDITM (CDR ITEM))
else (* ; "Not there, add it")
(replace ITEMS of MENU with (NCONC1 (fetch ITEMS of MENU)
ITEM))
(if (EQ (fetch MENUCOLUMNS of MENU)
1)
then (* ;
 "If there is only one column, force a re-figuring of the number of rows")
(replace MENUROWS of MENU with NIL)
elseif (EQ (fetch MENUROWS of MENU)
1)
then (* ;
 "There's only one row, so recompute # of columns.")
(replace MENUCOLUMNS of MENU with NIL))
(replace ITEMWIDTH of MENU with 10000)
(replace ITEMHEIGHT of MENU with 10000)
(replace IMAGE of MENU with NIL) (* ;
 "Force it to create a new menu image.")
(UPDATE/MENU/IMAGE MENU))))])
(TEDIT.DEFAULT.MENUFN
[LAMBDA (PANE) (* ; "Edited 28-May-2025 23:54 by rmk")
(* ; "Edited 14-Apr-2025 22:09 by rmk")
(* ; "Edited 13-Apr-2025 13:28 by rmk")
(* ; "Edited 17-Mar-2025 17:28 by rmk")
(* ; "Edited 14-Mar-2025 16:40 by rmk")
(* ; "Edited 12-Feb-2025 16:26 by rmk")
(* ; "Edited 9-Feb-2025 21:28 by rmk")
(* ; "Edited 7-Jan-2025 23:46 by rmk")
(* ; "Edited 27-Jul-2024 20:24 by rmk")
(* ; "Edited 30-Jun-2024 12:38 by rmk")
(* ; "Edited 18-May-2024 16:50 by rmk")
(* ; "Edited 24-Apr-2024 09:47 by rmk")
(* ; "Edited 15-Mar-2024 18:35 by rmk")
(* ; "Edited 22-Sep-2023 20:14 by rmk")
(* ; "Edited 6-May-2023 17:28 by rmk")
(* ; "Edited 30-May-91 23:35 by jds")
(* ;;
 "Default MENU Fn for editor windows--displays a menu of items & acts on the commands received.")
(PROG* ((TSTREAM (TEXTSTREAM PANE))
(TEXTOBJ (FTEXTOBJ TSTREAM))
(WMENU (WINDOWPROP PANE 'TEDIT.MENU))
THISMENU ITEM)
(CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE)
(* ;; "We're busy doing something, tell him to wait. Unfortunately, this string will overwrite whatever may be in the Tedit promptwindow (e.g. a GETINPUT calling TTYINPROMPTFORWORD for a meta-F command), obscuring what the user has already typed. Maybe an interface that tests to see if the promptwindow is in use, and enlarges it with an extra line above the current type-in?")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE))
"Edit"
(FGETTOBJ TEXTOBJ EDITOPACTIVE))
" operation in progress; please wait")
T)
(RETURN NIL))
(SETQ THISMENU (if WMENU
elseif (SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS))
then (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU WMENU))
(WINDOWPROP PANE 'TEDIT.MENU WMENU))
else TEDIT.DEFAULT.MENU))
(SETQ ITEM (CAR (MENU THISMENU)))
(ERSETQ (RESETLST
[SELECTQ ITEM
((Put |Put Formatted Document|)
(TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT)))
(Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T))
((Get |Get Formatted Document|) (* ;
 "Get a new file (overwriting the one being edited.)")
(TEDIT.GET TEXTOBJ NIL (GETTEXTPROP TEXTOBJ 'CLEARGET)))
(Unformatted% Get
(TEDIT.GET TEXTOBJ NIL T))
(Include (* ; "Insert a file where the caret is")
(TEDIT.INCLUDE TEXTOBJ))
(Quit (* ; "OK to stop this session?")
(\TEDIT.FINISHEDIT? TEXTOBJ))
(Substitute (* ; "Search-and-replace")
(RESETLST
(RESETSAVE (CURSOR WAITINGCURSOR))
(TEDIT.SUBSTITUTE TEXTOBJ)))
(Find (* ;
 "Case sensitive search, with * and # wildcards")
(\TEDIT.KEY.FIND TSTREAM))
(Hardcopy (* ; "Print this document")
(TEDIT.HARDCOPY TEXTOBJ))
(Expanded% Menu (* ;
 "Open the expanded operations menu.")
(\TEDIT.EXPANDEDMENU.START TSTREAM))
(Character% Looks (* ;
 "Open the menu for setting character looks")
(\TEDIT.CHARMENU.START TSTREAM))
(Paragraph% Formatting (* ;
 "Open the paragraph formatting menu")
(\TEDIT.PARAMENU.START TSTREAM))
(Page% Layout (* ; "Open the page-layout menu")
(\TEDIT.PAGEMENU.START TSTREAM))
(Buttons (TEDIT.BUTTONS.BUILD))
(Split% Window (\TEDIT.SPLITW (OR (GETTOBJ TEXTOBJ SELPANE)
PANE)
T))
(Unsplit% Window
(\TEDIT.UNSPLITW (OR (GETTOBJ TEXTOBJ SELPANE)
PANE)))
(CL:WHEN ITEM (* ;
 "Apply a user-supplied function to the text stream")
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T)
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(APPLY* ITEM (TEXTSTREAM PANE)))])])
(TEDIT.REMOVE.MENUITEM
[LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06")
(PROG (ITEMLIST)
[COND
((OR (LITATOM ITEM)
(STRINGP ITEM))
(for X in (fetch ITEMS of MENU) do (COND
((AND (LISTP X)
(EQUAL (CAR X)
ITEM))
(RETURN (SETQ ITEM X]
(RETURN (COND
((MEMBER ITEM (SETQ ITEMLIST (fetch ITEMS of MENU)))
(replace ITEMS of MENU with (REMOVE ITEM ITEMLIST))
(replace MENUCOLUMNS of MENU with NIL)
(replace MENUROWS of MENU with NIL)
(UPDATE/MENU/IMAGE MENU))
(T NIL])
(\TEDIT.CREATEMENU
[LAMBDA (ITEMS) (* ; "Edited 3-Apr-2024 13:30 by rmk")
(* ; "Edited 16-Oct-87 14:21 by jds")
(* ;; "Create a TEdit command menu, given a list of menu items.")
(create MENU
ITEMS _ ITEMS
CENTERFLG _ T
MENUFONT _ (FONTCREATE 'HELVETICA 10 'BOLD)
WHENHELDFN _ (FUNCTION \TEDIT.MENU.WHENHELDFN)
WHENSELECTEDFN _ (FUNCTION \TEDIT.MENU.WHENSELECTEDFN])
(\TEDIT.MENU.WHENHELDFN
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 4-Oct-2022 09:17 by rmk")
(* jds "10-Apr-84 15:14")
(COND
((ATOM ITEM)
(CLRPROMPT)
(PROMPTPRINT (SELECTQ ITEM
(Put "Sends the document to a file")
(Get "Gets a new file as the document to edit.")
(Looks "Changes the font/size/etc. of characters")
(Find "Searches for a string")
(Quit "Ends the edit session")
(Hardcopy "Formats and sends the file to a printer.")
(Hardcopy% File
"Creates a hardcopy-format file of the document.")
"")))
(T (DEFAULTMENUHELDFN ITEM])
(\TEDIT.MENU.WHENSELECTEDFN
[LAMBDA (ITEM MENU BUTTON) (* ; "Edited 16-Oct-87 14:21 by jds")
(* ;; "A Selection fn for preserving the button pressed, for special handling in PUT, e.g.")
(CONS (DEFAULTWHENSELECTEDFN ITEM MENU BUTTON)
BUTTON])
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS TEDIT.DEFAULT.MENU)
)
(RPAQQ \TEDIT.DEFAULTMENU.ITEMS
((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text))
(Get 'Get NIL (SUBITEMS |Get Formatted Document| Unformatted% Get))
Include Find Substitute (Buttons 'Buttons "Display action buttons")
(Split% Window 'Split% Window "Split the last-selected window")
(Unsplit% Window 'Unsplit% Window "Unsplit the last-selected window")
Quit
(Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu Character% Looks
Paragraph% Formatting Page% Layout))))
(DECLARE%: DONTEVAL@LOAD DOCOPY
(RPAQ TEDIT.DEFAULT.MENU (\TEDIT.CREATEMENU (COPY \TEDIT.DEFAULTMENU.ITEMS)))
)
(* ; "MARGINBAR")
(DEFINEQ
@@ -396,7 +616,8 @@
(RETURN OBJ])
(MB.MARGINBAR.BUTTONEVENTINFN
[LAMBDA (OBJ MENUDS SEL RELX RELY MENUTSTREAM) (* ; "Edited 11-Jan-2025 21:28 by rmk")
[LAMBDA (OBJ MENUDS SEL RELX RELY MENUTSTREAM) (* ; "Edited 26-Apr-2025 11:52 by rmk")
(* ; "Edited 11-Jan-2025 21:28 by rmk")
(* ; "Edited 7-Dec-2024 21:21 by rmk")
(* ; "Edited 25-Aug-2024 09:12 by rmk")
(* ; "Edited 1-Aug-2024 22:56 by rmk")
@@ -504,7 +725,8 @@
HEIGHT _ 16)
RELX RELY)
then (* ; "We're in the tab ruler region")
(if (EQ 'OFF (MB.GET 'TABTYPE MENUTSTREAM 'STATE NIL T))
(if (AND (MOUSESTATE MIDDLE)
(EQ 'OFF (MB.GET 'TABTYPE MENUTSTREAM 'STATE NIL T)))
then (TEDIT.PROMPTPRINT MENUTSTREAM "Please choose one of the tab types" T)
else (replace MARTABS of OBJDATUM with (MB.MARGINBAR.SELFN.TABS OBJDATUM MENUDS
MENUTSTREAM]
@@ -605,7 +827,8 @@
TABTYPE)])
(MARGINBAR.GETSTATEFN
[LAMBDA (PC OBJ TEXTOBJ) (* ; "Edited 22-Oct-2024 12:26 by rmk")
[LAMBDA (PC OBJ TEXTOBJ) (* ; "Edited 26-May-2025 20:10 by rmk")
(* ; "Edited 22-Oct-2024 12:26 by rmk")
(* ; "Edited 20-Oct-2024 11:39 by rmk")
(* ; "Edited 29-Aug-2024 09:32 by rmk")
(* ; "Edited 12-Aug-2024 10:43 by rmk")
@@ -635,7 +858,7 @@
(CL:WHEN (IGEQ R 0) (* ;
 "The RIGHTMARGIN is set, and non-neutral.")
(push LOOKS 'RIGHTMARGIN R))
(CL:UNLESS (MEMB MARTABS '(NIL NEUTRAL)) (* ;
(CL:UNLESS (EQ MARTABS 'NEUTRAL) (* ;
 "If the tab settings are neutral, don't change anything.")
(* ;;
@@ -1038,6 +1261,15 @@
(TEDIT.BACKTOMAIN MENUSTREAM)
MENUW))])
(\TEDIT.MENU.OPEN?
[LAMBDA (MENUTITLE MAINSTREAM) (* ; "Edited 28-May-2025 23:40 by rmk")
(* ;; "True if a menu with MENUTITLE is already open")
(find W in (ATTACHEDWINDOWS (\TEDIT.PRIMARYPANE MAINSTREAM))
suchthat (AND (STREQUAL MENUTITLE (WINDOWPROP W 'TEDITMENU))
(OPENWP W])
(\TEDIT.MENU.BUTTONEVENTFN
[LAMBDA (MENUW) (* ; "Edited 28-Jun-2024 23:09 by rmk")
(* ; "Edited 25-Sep-2023 12:53 by rmk")
@@ -1181,7 +1413,8 @@
(DEFINEQ
(\TEDIT.EXPANDEDMENU.CREATE
[LAMBDA NIL (* ; "Edited 8-Mar-2025 12:27 by rmk")
[LAMBDA NIL (* ; "Edited 29-May-2025 09:31 by rmk")
(* ; "Edited 8-Mar-2025 12:27 by rmk")
(* ; "Edited 7-Jan-2025 16:05 by rmk")
(* ; "Edited 8-Nov-2024 08:35 by rmk")
(* ; "Edited 22-Oct-2024 10:48 by rmk")
@@ -1203,7 +1436,7 @@
(FUNCTION \TEDIT.EXPANDEDMENU.FN))
(\TEDIT.MENU.CREATE `((ACTION (LABEL "Quit")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
5
12
(ACTION (IDENTIFIER PAGELAYOUT)
(LABEL "Page layout")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
@@ -1215,11 +1448,9 @@
(ACTION (IDENTIFIER PARALOOKS)
(LABEL "Para looks")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
5
(ACTION (LABEL "All")
(SELECTFN \TEDIT.EXPANDEDMENU.FN)
(ACTION (LABEL "Unformatted")
(SELECTFN \TEDIT.EXPANDEDMENU.FN)))
12
(ACTION (LABEL "Select All")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
EOL
(ACTION (LABEL "Get")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
@@ -1238,6 +1469,8 @@
(FIELD (IDENTIFIER INCLUDEFILE)
(FIELDTYPE SYMBOL)
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
5
(TOGGLE (LABEL "Unformatted"))
EOL
(ACTION (LABEL "Find")
(SELECTFN \TEDIT.EXPANDEDMENU.FN))
@@ -1274,7 +1507,8 @@
(FIELDTYPE STRING])
(\TEDIT.EXPANDEDMENU.START
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 28-May-2025 23:44 by rmk")
(* ; "Edited 14-Mar-2025 15:41 by rmk")
(* ; "Edited 7-Jan-2025 16:43 by rmk")
(* ; "Edited 20-Aug-2024 15:46 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
@@ -1283,13 +1517,14 @@
(* ; "Edited 19-Sep-2023 08:51 by rmk")
(* ; "Edited 20-Aug-87 16:51 by jds")
(* ; "'27-Sep-84 01:04' gbn")
(LET (EXPANDEDMENU (TEXTOBJ (TEXTOBJ TSTREAM)))
(\TEDIT.MENU.START (SETQ EXPANDEDMENU (\TEDIT.EXPANDEDMENU.CREATE))
TSTREAM "TEdit Menu" (HEIGHTIFWINDOW 60 T)
'EXPANDED)
(CL:WHEN (OR (GETTEXTPROP TEXTOBJ 'CLEARGET)
(GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialize the button")
(MB.SET.TOGGLE "Unformatted" 'ON EXPANDEDMENU))])
(CL:UNLESS (\TEDIT.MENU.OPEN? "TEdit Menu" TSTREAM)
(LET (EXPANDEDMENU (TEXTOBJ (TEXTOBJ TSTREAM)))
(\TEDIT.MENU.START (SETQ EXPANDEDMENU (\TEDIT.EXPANDEDMENU.CREATE))
TSTREAM "TEdit Menu" (HEIGHTIFWINDOW 60 T)
'EXPANDED)
(CL:WHEN (OR (GETTEXTPROP TEXTOBJ 'CLEARGET)
(GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialize the button")
(MB.SET.TOGGLE 'UNFORMATTED 'ON EXPANDEDMENU))))])
(\TEDIT.EXPANDEDMENU.FN
[LAMBDA (OBJ MENUSEL MENUW MENUSTREAM) (* ; "Edited 7-Jan-2025 17:44 by rmk")
@@ -1343,23 +1578,14 @@
(RETURN 'DON'T])
(\TEDIT.EXPANDEDMENU.ACTIONFN
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 18-Mar-2025 23:54 by rmk")
(* ; "Edited 16-Mar-2025 21:43 by rmk")
(* ; "Edited 14-Mar-2025 15:43 by rmk")
(* ; "Edited 5-Mar-2025 20:51 by rmk")
(* ; "Edited 7-Jan-2025 22:36 by rmk")
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 29-May-2025 09:29 by rmk")
(* ; "Edited 11-May-2025 15:01 by rmk")
(* ; "Edited 6-Apr-2025 14:39 by rmk")
(* ; "Edited 18-Mar-2025 23:54 by rmk")
(* ; "Edited 26-Nov-2024 23:30 by rmk")
(* ; "Edited 22-Oct-2024 10:54 by rmk")
(* ; "Edited 20-Oct-2024 15:40 by rmk")
(* ; "Edited 29-Sep-2024 12:53 by rmk")
(* ; "Edited 2-Sep-2024 23:29 by rmk")
(* ; "Edited 28-Aug-2024 19:19 by rmk")
(* ; "Edited 12-Aug-2024 10:23 by rmk")
(* ; "Edited 9-Aug-2024 22:43 by rmk")
(* ; "Edited 27-Jul-2024 21:35 by rmk")
(* ; "Edited 7-Jul-2024 00:01 by rmk")
(* ; "Edited 30-Jun-2024 12:39 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 2-May-2024 13:48 by rmk")
(* ; "Edited 27-Feb-2024 07:54 by rmk")
(* ; "Edited 14-Dec-2023 21:03 by rmk")
@@ -1369,95 +1595,102 @@
(* ; "Edited 30-Mar-94 16:04 by jds")
(* ;
 "MBFN for TEdit default menu item buttons.")
(LET ((MENUTEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM)))
STATE)
[ERSETQ (RESETLST
(ERSETQ (RESETLST
(LET ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM))
STATES STATE)
[RESETSAVE (PROG1 OBJ
(IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T))
'(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL]
(SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER)
(QUIT (* ; "Is it OK to quit the main edit?")
(\TEDIT.FINISHEDIT? MAINSTREAM))
(PAGELAYOUT (* ; "Page layout menu")
(\TEDIT.PAGEMENU.START MAINSTREAM))
(PARALOOKS (* ; "Page layout menu")
(\TEDIT.PARAMENU.START MAINSTREAM))
(CHARLOOKS (* ; "Page layout menu")
(\TEDIT.CHARMENU.START MAINSTREAM))
(SELECT% ALL (* ; "Select the entire document.")
(TEDIT.SETSEL MAINSTREAM 1 (TEXTLEN (TEXTOBJ MAINSTREAM))
'LEFT))
(PUT (* ;
 "Only try this if he really typed a file name")
(SETQ STATE (MB.GET 'PUTFILE MENUTEXTOBJ 'STATE MENUSEL))
(SETQ STATES (MB.GET '(PUTFILE UNFORMATTED)
MENUSTREAM
'STATE MENUSEL))
(SETQ STATE (LISTGET STATES 'PUTFILE))
(* ; "STATE is the file name")
(if STATE
then (TEDIT.PUT MAINSTREAM STATE NIL (GETTEXTPROP MAINSTREAM
'UNFORMATTEDPUT/GET))
then [TEDIT.PUT MAINSTREAM STATE NIL
(OR (EQ 'ON (LISTGET STATES 'UNFORMATTED))
(GETTEXTPROP MAINSTREAM 'UNFORMATTEDPUT/GET]
else (TEDIT.PROMPTPRINT MAINSTREAM "Put file not specified" T)))
(GET (SETQ STATE (MB.GET 'GETFILE MENUTEXTOBJ 'STATE MENUSEL))
(GET (SETQ STATES (MB.GET '(GETFILE UNFORMATTED)
MENUSTREAM
'STATE MENUSEL))
(SETQ STATE (LISTGET STATES 'GETFILE))
(if STATE
then (TEDIT.GET MAINSTREAM STATE (GETTEXTPROP MAINSTREAM
'UNFORMATTEDPUT/GET))
then [TEDIT.GET MAINSTREAM STATE (OR (EQ 'ON (LISTGET STATES
'UNFORMATTED))
(GETTEXTPROP MAINSTREAM
'UNFORMATTEDPUT/GET]
else (TEDIT.PROMPTPRINT MAINSTREAM "Get file not specified" T)))
(INCLUDE (SETQ STATE (MB.GET 'INCLUDEFILE MENUTEXTOBJ 'STATE MENUSEL))
(INCLUDE (SETQ STATES (MB.GET '(PUTFILE UNFORMATTED)
MENUSTREAM
'STATE MENUSEL))
(SETQ STATE (LISTGET STATES 'PUTFILE))
(if STATE
then (TEDIT.INCLUDE MAINSTREAM STATE)
then [TEDIT.INCLUDE MAINSTREAM STATE NIL NIL NIL
(OR (EQ 'ON (LISTGET STATES 'UNFORMATTED))
(GETTEXTPROP MAINSTREAM 'UNFORMATTEDPUT/GET]
else (TEDIT.PROMPTPRINT MAINSTREAM "Include file not specified" T
)))
(FIND (SETQ STATE (MB.GET 'FINDPATTERN MENUTEXTOBJ 'STATE MENUSEL))
(FIND (SETQ STATE (MB.GET 'FINDPATTERN MENUSTREAM 'STATE MENUSEL))
(if (IGEQ (NCHARS STATE)
1)
then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL STATE)
else (TEDIT.PROMPTPRINT MAINSTREAM "Search pattern not specified" T)
))
(SUBSTITUTE [LET* [(STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS
)
MENUTEXTOBJ
'STATE MENUSEL))
(REPLACEMENT (LISTGET STATES 'REPLACEMENT))
(PATTERN (LISTGET STATES 'PATTERN]
(CL:UNLESS (ZEROP (NCHARS PATTERN))
(SETQ REPLACEMENT (CL:IF (EQ 'ON (LISTGET STATES
'USENEWLOOKS))
(\TEDIT.SELPIECES REPLACEMENT
NIL MENUTEXTOBJ)
(TEDIT.SEL.AS.STRING MENUSTREAM
REPLACEMENT)))
[TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT
"")
(EQ 'ON (LISTGET STATES 'CONFIRM))
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
(QUIT (* ; "Is it OK to quit the main edit?")
(\TEDIT.FINISHEDIT? MAINSTREAM))
(PAGELAYOUT (* ; "Page layout menu")
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
MAINSTREAM "Page Layout Menu" (HEIGHTIFWINDOW 135 5)
'PAGE))
(PARALOOKS (* ; "Page layout menu")
(\TEDIT.PARAMENU.START MAINSTREAM))
(CHARLOOKS (* ; "Page layout menu")
(\TEDIT.CHARMENU.START MAINSTREAM))
(ALL (* ; "Select the entire document.")
(TEDIT.SETSEL MAINSTREAM 1 (TEXTLEN (TEXTOBJ MAINSTREAM))
'LEFT))
(HARDCOPY (LET* ((STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#)
MENUTEXTOBJ
(SUBSTITUTE (SETQ STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS)
MENUSTREAM
'STATE MENUSEL))
(SERVER (LISTGET STATES 'SERVER))
(COPIES (LISTGET STATES 'COPIES))
(SIDES (LISTGET STATES 'SIDES))
(MSG (LISTGET STATES 'MESSAGE/PHONE#))
PRINTOPTIONS)
(CL:UNLESS (AND SERVER (SETQ SERVER (\TEDIT.MAKEFILENAME
SERVER)))
(TEDIT.PROMPTPRINT MAINSTREAM
"Using default print server."))
(CL:WHEN COPIES
(SETQ PRINTOPTIONS (LIST '%#COPIES COPIES)))
(CL:WHEN SIDES
(push PRINTOPTIONS '%#SIDES (SELECTQ SIDES
(One% Side 1)
(Duplex 2)
NIL)))
(CL:WHEN MSG
(push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG)))
(TEDIT.HARDCOPY MAINSTREAM NIL NIL NIL SERVER PRINTOPTIONS)))
(ERROR)))]
(SETSEL MENUSEL SET T) (* ;
 "Now turn the menu button highlighting off.")
(SETSEL MENUSEL ONFLG T)
(\TEDIT.SHOWSEL MENUSEL NIL MENUTEXTOBJ) (* ;
 "And forget that anything is selected.")
(SETSEL MENUSEL SET NIL])
[LET [(REPLACEMENT (LISTGET STATES 'REPLACEMENT))
(PATTERN (LISTGET STATES 'PATTERN]
(CL:UNLESS (ZEROP (NCHARS PATTERN))
(SETQ REPLACEMENT (CL:IF (EQ 'ON (LISTGET STATES
'USENEWLOOKS))
(\TEDIT.SELPIECES MENUTEXTOBJ
REPLACEMENT NIL
MENUTEXTOBJ)
(TEDIT.SEL.AS.STRING MENUSTREAM
REPLACEMENT)))
[TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT ""
)
(EQ 'ON (LISTGET STATES 'CONFIRM))
(EQ 'ON (LISTGET STATES 'USENEWLOOKS])])
(HARDCOPY (SETQ STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#)
MENUSTREAM
'STATE MENUSEL))
(LET ((SERVER (LISTGET STATES 'SERVER))
(COPIES (LISTGET STATES 'COPIES))
(SIDES (LISTGET STATES 'SIDES))
(MSG (LISTGET STATES 'MESSAGE/PHONE#))
PRINTOPTIONS)
(CL:UNLESS (AND SERVER (SETQ SERVER (\TEDIT.MAKEFILENAME
SERVER)))
(TEDIT.PROMPTPRINT MAINSTREAM
"Using default print server."))
(CL:WHEN COPIES
(SETQ PRINTOPTIONS (LIST '%#COPIES COPIES)))
(CL:WHEN SIDES
(push PRINTOPTIONS '%#SIDES (SELECTQ SIDES
(One% Side 1)
(Duplex 2)
NIL)))
(CL:WHEN MSG
(push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG)))
(TEDIT.HARDCOPY MAINSTREAM NIL NIL NIL SERVER PRINTOPTIONS)))
(ERROR))))])
)
@@ -1580,16 +1813,18 @@
EOL])
(\TEDIT.PARAMENU.START
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:42 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 28-May-2025 23:45 by rmk")
(* ; "Edited 14-Mar-2025 15:42 by rmk")
(* ; "Edited 7-Jan-2025 15:36 by rmk")
(* ; "Edited 27-Jul-2024 00:06 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 27-Feb-2024 07:53 by rmk")
(* ; "Edited 19-Sep-2023 08:51 by rmk")
(* ; "Edited 20-Aug-87 16:51 by jds")
(\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE)
TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T)
'PARALOOKS])
(CL:UNLESS (\TEDIT.MENU.OPEN? "Paragraph-Looks Menu" TSTREAM)
(\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE)
TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T)
'PARALOOKS))])
(\TEDIT.APPLY.PARALOOKS
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 29-Dec-2024 20:16 by rmk")
@@ -1608,7 +1843,8 @@
(TEDIT.BACKTOMAIN MENUSTREAM])
(\TEDIT.SHOW.PARALOOKS
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Oct-2024 11:11 by rmk")
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Apr-2025 23:40 by rmk")
(* ; "Edited 20-Oct-2024 11:11 by rmk")
(* ; "Edited 29-Sep-2024 14:59 by rmk")
(* ; "Edited 25-Aug-2024 09:15 by rmk")
(* ; "Edited 3-Aug-2024 19:05 by rmk")
@@ -1642,7 +1878,7 @@
(\TEDIT.UPDATE.SEL (TEXTSEL MENUTEXTOBJ)
1 0 'LEFT)
(\TEDIT.FIXSEL (TEXTSEL MENUTEXTOBJ)
MENUTEXTOBJ)
MENUSTREAM)
(TEDIT.BACKTOMAIN MENUSTREAM))])
(\TEDIT.PARAMENU.FILLIN
@@ -1771,7 +2007,8 @@
,@(\TEDIT.CHARMENU.SPEC TSTREAM])
(\TEDIT.CHARMENU.START
[LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 28-May-2025 23:41 by rmk")
(* ; "Edited 14-Mar-2025 15:41 by rmk")
(* ; "Edited 7-Jan-2025 22:37 by rmk")
(* ; "Edited 17-Dec-2024 00:04 by rmk")
(* ; "Edited 25-Jun-2024 11:59 by rmk")
@@ -1782,9 +2019,10 @@
(* ;; "Open a character-looks menu.")
(\TEDIT.MENU.START (\TEDIT.CHARMENU.CREATE TSTREAM)
TSTREAM "Character Looks Menu" (HEIGHTIFWINDOW 100 T)
'CHARLOOKS])
(CL:UNLESS (\TEDIT.MENU.OPEN? "Character Looks Menu" TSTREAM)
(\TEDIT.MENU.START (\TEDIT.CHARMENU.CREATE TSTREAM)
TSTREAM "Character Looks Menu" (HEIGHTIFWINDOW 100 T)
'CHARLOOKS))])
(\TEDIT.CHARMENU.SPEC
[LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 14:48 by rmk")
@@ -1910,7 +2148,8 @@
NEWLOOKS])
(\TEDIT.CHARMENU.FILLIN
[LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 22-Mar-2025 23:27 by rmk")
[LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 15-Apr-2025 16:47 by rmk")
(* ; "Edited 22-Mar-2025 23:27 by rmk")
(* ; "Edited 1-Jan-2025 15:24 by rmk")
(* ; "Edited 28-Dec-2024 12:48 by rmk")
(* ; "Edited 20-Dec-2024 12:18 by rmk")
@@ -1953,6 +2192,7 @@
(STRIKEOUT (FGETCLOOKS CHARLOOKS CLSTRIKE))
(OVERLINE (FGETCLOOKS CHARLOOKS CLOLINE))
(UNBREAKABLE (FGETCLOOKS CHARLOOKS CLUNBREAKABLE))
(COLOR (FGETCLOOKS CHARLOOKS CLCOLOR))
(OFFSETTYPE (CL:WHEN (SETQ VAL (FGETCLOOKS CHARLOOKS CLOFFSET))
(if (IGREATERP VAL 0)
then 'SUPERSCRIPT
@@ -1973,7 +2213,8 @@
(TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC)))) finally (RETURN PC)))])
(\TEDIT.SHOW.CHARLOOKS
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 31-Dec-2024 21:25 by rmk")
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Apr-2025 23:40 by rmk")
(* ; "Edited 31-Dec-2024 21:25 by rmk")
(* ; "Edited 2-Nov-2024 20:16 by rmk")
(* ; "Edited 20-Oct-2024 09:55 by rmk")
(* ; "Edited 29-Sep-2024 14:59 by rmk")
@@ -1996,7 +2237,7 @@
(* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.")
(LET* ((MENUTEXTOBJ (GETTSTR MENUSTREAM TEXTOBJ))
(LET* ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM))
(MAINTEXTOBJ (GETTSTR (\TEDIT.MAINSTREAM MENUSTREAM)
TEXTOBJ))
(MAINCH# (GETSEL (TEXTSEL MAINTEXTOBJ)
@@ -2011,7 +2252,7 @@
MENUSTREAM))
(FSETSEL MENUSEL ONFLG T)
(\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
(\TEDIT.FIXSEL MENUSEL MENUTEXTOBJ))
(\TEDIT.FIXSEL MENUSEL MENUSTREAM))
(TEDIT.BACKTOMAIN MENUSTREAM])
(\TEDIT.APPLY.CHARLOOKS
@@ -2138,7 +2379,8 @@
(DEFINEQ
(\TEDIT.PAGEMENU.CREATE
[LAMBDA (TSTREAM) (* ; "Edited 27-Jan-2025 08:51 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 11-May-2025 14:40 by rmk")
(* ; "Edited 27-Jan-2025 08:51 by rmk")
(* ; "Edited 7-Jan-2025 15:47 by rmk")
(* ; "Edited 5-Jan-2025 16:02 by rmk")
(* ; "Edited 4-Jan-2025 00:34 by rmk")
@@ -2199,8 +2441,27 @@
(TEXT (STRING "Page numbers: ")
(FONT (HELVETICA 10)))
(NWAY (IDENTIFIER PAGENOS)
(BUTTONS (No Yes))
(BUTTONS (No Yes Heading))
(INITSTATE Yes))
EOL TAB (FIELD (IDENTIFIER PAGENUMBERX)
(PRELABEL "X:")
(INITSTATE 25.5)
(FIELDTYPE NUMBER))
(FIELD (IDENTIFIER PAGENUMBERY)
(PRELABEL " Y:")
(INITSTATE 3)
(FIELDTYPE NUMBER))
" Format: "
(NWAY (IDENTIFIER FOLIOFORMAT)
(BUTTONS (|123| xiv XIV))
INITSTATE |123|)
EOL TAB (FIELD (IDENTIFIER STARTINGPAGE#)
(PRELABEL "Starting page #:")
(INITSTATE 1)
(FIELDTYPE POSITIVENUMBER))
3 "Alignment:" 2 (NWAY (IDENTIFIER QUAD)
(BUTTONS (Left Centered Right))
(INITSTATE Centered))
EOL
(* ;; "")
@@ -2270,8 +2531,16 @@
EOL
,@(\TEDIT.CHARMENU.SPEC TSTREAM])
(\TEDIT.PAGEMENU.START
[LAMBDA (TSTREAM) (* ; "Edited 28-May-2025 23:50 by rmk")
(CL:UNLESS (\TEDIT.MENU.OPEN? "Page Layout Menu" TSTREAM)
(\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE)
TSTREAM "Page Layout Menu" (HEIGHTIFWINDOW 135 5)
'PAGE))])
(\TEDIT.SHOW.PAGELOOKS
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 22-Oct-2024 11:04 by rmk")
[LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Apr-2025 23:41 by rmk")
(* ; "Edited 22-Oct-2024 11:04 by rmk")
(* ; "Edited 20-Oct-2024 17:32 by rmk")
(* ; "Edited 29-Sep-2024 15:10 by rmk")
(* ; "Edited 30-Aug-2024 23:58 by rmk")
@@ -2294,7 +2563,7 @@
PAGEID)))
(FSETSEL MENUSEL ONFLG T)
(\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT)
(\TEDIT.FIXSEL MENUSEL (GETTSTR MENUSTREAM TEXTOBJ))
(\TEDIT.FIXSEL MENUSEL MENUSTREAM)
(TEDIT.BACKTOMAIN MENUSTREAM])
(\TEDIT.PAGEMENU.FILLIN
@@ -2471,7 +2740,8 @@
(TEDIT.BACKTOMAIN MENUSTREAM])
(\TEDIT.CHANGE.PAGELOOKS
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 24-Dec-2024 21:28 by rmk")
[LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 11-May-2025 15:04 by rmk")
(* ; "Edited 24-Dec-2024 21:28 by rmk")
(* ; "Edited 20-Oct-2024 17:17 by rmk")
(* ; "Edited 30-Aug-2024 23:43 by rmk")
(* ; "Edited 15-Aug-2024 14:48 by rmk")
@@ -2479,7 +2749,7 @@
(* ; "Edited 10-Aug-2024 12:11 by rmk")
(PROG ((MAINTEXTOBJ (TEXTOBJ MAINTEXTSTREAM))
(PAGEID (LISTGET PAGELOOKS 'PAGEID))
[PAGENOS (STRING.EQUAL 'Yes (LISTGET PAGELOOKS 'PAGENOS]
(PAGENOS (LISTGET PAGELOOKS 'PAGENOS))
PAGEPROPS)
(CL:WHEN (EQ 'OFF PAGEID)
(TEDIT.PROMPTPRINT MAINTEXTSTREAM "Please specify a page type" T T)
@@ -2489,11 +2759,29 @@
((OFF NEUTRAL)
(RPLACA PLTAIL NIL))
NIL))
(CL:WHEN [AND PAGENOS (NOT (AND (LISTGET PAGELOOKS 'PAGENUMBERX)
(LISTGET PAGELOOKS 'PAGENUMBERY]
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please set both X and Y locations for page numbers" T T
)
(RETURN))
(SELECTQ PAGENOS
(Yes (* ;
 "Page number format specfified in pagelooks menu")
(CL:UNLESS (AND (LISTGET PAGELOOKS 'PAGENUMBERX)
(LISTGET PAGELOOKS 'PAGENUMBERY))
(TEDIT.PROMPTPRINT MAINTEXTOBJ
"Please set both X and Y locations for page numbers" T T)
(RETURN))
[push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)
'FOLIOINFO
(LIST (SELECTQ (LISTGET PAGELOOKS 'FOLIOFORMAT)
(|123| 'ARABIC)
(xiv 'LOWERROMAN)
(XIV 'UPPERROMAN)
'ARABIC)
(LISTGET PAGELOOKS 'FOLIOPRETEXT)
(LISTGET PAGELOOKS 'FOLIOPOSTTEXT])
(No)
(Header
(* ;; "Page numbers formatted/printed by image object in header paragraphs")
(push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)))
NIL)
(CL:UNLESS (LISTGET PAGELOOKS 'COLUMNS)
(LISTPUT PAGELOOKS 'COLUMNS 1)
(RETURN))
@@ -2502,17 +2790,7 @@
(LISTGET PAGELOOKS 'SPACEBETWEENCOLUMNS))
(TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify the space between columns" T T)
(RETURN))
[push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#)
'LANDSCAPE?
(EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE))
'FOLIOINFO
(LIST (SELECTQ (LISTGET PAGELOOKS 'FOLIOFORMAT)
(|123| 'ARABIC)
(xiv 'LOWERROMAN)
(XIV 'UPPERROMAN)
'ARABIC)
(LISTGET PAGELOOKS 'FOLIOPRETEXT)
(LISTGET PAGELOOKS 'FOLIOPOSTTEXT]
[push PAGEPROPS 'LANDSCAPE? (EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE]
(* ;; "**EMPTY** may come from field values in the pagelooks menue")
@@ -2634,29 +2912,32 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5138 51509 (DRAWMARGINSCALE 5148 . 8607) (MARGINBAR 8609 . 15734) (MARGINBAR.CREATE
15736 . 19155) (MB.MARGINBAR.BUTTONEVENTINFN 19157 . 26796) (MB.MARGINBAR.SELFN.TABS 26798 . 32038) (
MB.MARGINBAR.SELFN.TABS.KIND 32040 . 32975) (MARGINBAR.GETSTATEFN 32977 . 36855) (MARGINBAR.SETSTATEFN
36857 . 37067) (MARGINBAR.NEUTRALIZE 37069 . 37482) (MARGINBAR.LOOKS 37484 . 40590) (
MB.MARGINBAR.SIZEFN 40592 . 41195) (MB.MARGINBAR.DISPLAYFN 41197 . 44258) (MDESCALE 44260 . 44800) (
MSCALE 44802 . 45132) (MB.MARGINBAR.SHOWTAB 45134 . 47457) (MB.MARGINBAR.TABTRACK 47459 . 48844) (
MARGINBAR.INIT 48846 . 50239) (\TEDIT.PARALOOKS.TO.MARBAR 50241 . 51507)) (52334 59240 (
TEDIT.MENUSTREAM 52344 . 53344) (TEDITMENUP 53346 . 54315) (\TEDIT.MENU.START 54317 . 58664) (
\TEDIT.MENU.BUTTONEVENTFN 58666 . 59238)) (59559 67481 (\TEDIT.MENU.CREATE 59569 . 61380) (
\TEDIT.MENU.PARSE 61382 . 65071) (\TEDIT.MENU.NEUTRALIZE 65073 . 67144) (\TEDITMENU.RECORD.UNFORMATTED
67146 . 67479)) (67547 87539 (\TEDIT.EXPANDEDMENU.CREATE 67557 . 72959) (\TEDIT.EXPANDEDMENU.START
72961 . 74391) (\TEDIT.EXPANDEDMENU.FN 74393 . 77648) (\TEDIT.EXPANDEDMENU.ACTIONFN 77650 . 87537)) (
87601 103158 (\TEDIT.PARAMENU.CREATE 87611 . 93632) (\TEDIT.PARAMENU.START 93634 . 94566) (
\TEDIT.APPLY.PARALOOKS 94568 . 95620) (\TEDIT.SHOW.PARALOOKS 95622 . 98405) (\TEDIT.PARAMENU.FILLIN
98407 . 103156)) (103363 129548 (\TEDIT.CHARMENU.CREATE 103373 . 105977) (\TEDIT.CHARMENU.START 105979
. 107076) (\TEDIT.CHARMENU.SPEC 107078 . 111761) (\TEDIT.CHARMENU.PARSE 111763 . 114931) (
\TEDIT.CHARMENU.FILLIN 114933 . 119387) (\TEDIT.SHOW.CHARLOOKS 119389 . 122646) (
\TEDIT.APPLY.CHARLOOKS 122648 . 123809) (\TEDIT.OFFSETTYPE.STATEFN 123811 . 125774) (
\TEDIT.OTHER.STATECHANGEFN 125776 . 127421) (\TEDIT.OTHER.SELECTFN 127423 . 129546)) (129610 156049 (
\TEDIT.PAGEMENU.CREATE 129620 . 136814) (\TEDIT.SHOW.PAGELOOKS 136816 . 138611) (
\TEDIT.PAGEMENU.FILLIN 138613 . 140163) (\TEDIT.PAGEREGION.UNPARSE 140165 . 149355) (
\TEDIT.APPLY.PAGELOOKS 149357 . 151284) (\TEDIT.CHANGE.PAGELOOKS 151286 . 155205) (
\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 155207 . 156047)) (156050 161853 (\TEDIT.PAGEMENU.CREATE.HEADINGS
156060 . 158872) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 158874 . 160299) (
\TEDIT.PAGEMENU.HEADINGS.STATEFN 160301 . 161851)))))
(FILEMAP (NIL (6277 17915 (TEDIT.ADD.MENUITEM 6287 . 8404) (TEDIT.DEFAULT.MENUFN 8406 . 15127) (
TEDIT.REMOVE.MENUITEM 15129 . 16126) (\TEDIT.CREATEMENU 16128 . 16693) (\TEDIT.MENU.WHENHELDFN 16695
. 17600) (\TEDIT.MENU.WHENSELECTEDFN 17602 . 17913)) (18729 65372 (DRAWMARGINSCALE 18739 . 22198) (
MARGINBAR 22200 . 29325) (MARGINBAR.CREATE 29327 . 32746) (MB.MARGINBAR.BUTTONEVENTINFN 32748 . 40550)
(MB.MARGINBAR.SELFN.TABS 40552 . 45792) (MB.MARGINBAR.SELFN.TABS.KIND 45794 . 46729) (
MARGINBAR.GETSTATEFN 46731 . 50718) (MARGINBAR.SETSTATEFN 50720 . 50930) (MARGINBAR.NEUTRALIZE 50932
. 51345) (MARGINBAR.LOOKS 51347 . 54453) (MB.MARGINBAR.SIZEFN 54455 . 55058) (MB.MARGINBAR.DISPLAYFN
55060 . 58121) (MDESCALE 58123 . 58663) (MSCALE 58665 . 58995) (MB.MARGINBAR.SHOWTAB 58997 . 61320) (
MB.MARGINBAR.TABTRACK 61322 . 62707) (MARGINBAR.INIT 62709 . 64102) (\TEDIT.PARALOOKS.TO.MARBAR 64104
. 65370)) (66197 73479 (TEDIT.MENUSTREAM 66207 . 67207) (TEDITMENUP 67209 . 68178) (\TEDIT.MENU.START
68180 . 72527) (\TEDIT.MENU.OPEN? 72529 . 72903) (\TEDIT.MENU.BUTTONEVENTFN 72905 . 73477)) (73798
81720 (\TEDIT.MENU.CREATE 73808 . 75619) (\TEDIT.MENU.PARSE 75621 . 79310) (\TEDIT.MENU.NEUTRALIZE
79312 . 81383) (\TEDITMENU.RECORD.UNFORMATTED 81385 . 81718)) (81786 101567 (
\TEDIT.EXPANDEDMENU.CREATE 81796 . 87263) (\TEDIT.EXPANDEDMENU.START 87265 . 88889) (
\TEDIT.EXPANDEDMENU.FN 88891 . 92146) (\TEDIT.EXPANDEDMENU.ACTIONFN 92148 . 101565)) (101629 117487 (
\TEDIT.PARAMENU.CREATE 101639 . 107660) (\TEDIT.PARAMENU.START 107662 . 108787) (
\TEDIT.APPLY.PARALOOKS 108789 . 109841) (\TEDIT.SHOW.PARALOOKS 109843 . 112734) (
\TEDIT.PARAMENU.FILLIN 112736 . 117485)) (117692 144347 (\TEDIT.CHARMENU.CREATE 117702 . 120306) (
\TEDIT.CHARMENU.START 120308 . 121598) (\TEDIT.CHARMENU.SPEC 121600 . 126283) (\TEDIT.CHARMENU.PARSE
126285 . 129453) (\TEDIT.CHARMENU.FILLIN 129455 . 134085) (\TEDIT.SHOW.CHARLOOKS 134087 . 137445) (
\TEDIT.APPLY.CHARLOOKS 137447 . 138608) (\TEDIT.OFFSETTYPE.STATEFN 138610 . 140573) (
\TEDIT.OTHER.STATECHANGEFN 140575 . 142220) (\TEDIT.OTHER.SELECTFN 142222 . 144345)) (144409 173196 (
\TEDIT.PAGEMENU.CREATE 144419 . 152869) (\TEDIT.PAGEMENU.START 152871 . 153222) (\TEDIT.SHOW.PAGELOOKS
153224 . 155110) (\TEDIT.PAGEMENU.FILLIN 155112 . 156662) (\TEDIT.PAGEREGION.UNPARSE 156664 . 165854)
(\TEDIT.APPLY.PAGELOOKS 165856 . 167783) (\TEDIT.CHANGE.PAGELOOKS 167785 . 172352) (
\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 172354 . 173194)) (173197 179000 (\TEDIT.PAGEMENU.CREATE.HEADINGS
173207 . 176019) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 176021 . 177446) (
\TEDIT.PAGEMENU.HEADINGS.STATEFN 177448 . 178998)))))
STOP

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

Binary file not shown.

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

Binary file not shown.

485
library/tedit/TEDIT-PAGE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Feb-2025 10:06:16" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;208 133418
(FILECREATED "11-May-2025 15:03:00" {WMEDLEY}<library>tedit>TEDIT-PAGE.;221 134841
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY)
:CHANGES-TO (FNS TEDIT.SINGLE.PAGEFORMAT)
:PREVIOUS-DATE "19-Feb-2025 13:33:12" {WMEDLEY}<library>TEDIT>TEDIT-PAGE.;207)
:PREVIOUS-DATE "22-Apr-2025 08:12:43" {WMEDLEY}<library>tedit>TEDIT-PAGE.;220)
(PRETTYCOMPRINT TEDIT-PAGECOMS)
@@ -19,7 +19,7 @@
(* ;; "Replaces CL:MULTIPLE-VALUE-SETQ, to avoid CL:VALUES")
(MACROS TEDIT.SETQS TEDIT.VALUES))
(EXPORT (MACROS TEDIT.SETQS TEDIT.VALUES)))
(INITRECORDS PAGEREGION)
[COMS
(* ;; "Page-numbering font specification/default. ")
@@ -190,11 +190,10 @@
(EQ 'FIRST (FGETPLOOKS PARALOOKS FMTCOLUMN])
)
(DECLARE%: EVAL@COMPILE
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(PUTPROPS TEDIT.SETQS MACRO
[ARGS `(LET (($$VALUES ,(CADR ARGS))
($$PRIMARY))
[ARGS `(LET [($$VALUES ,(CADR ARGS]
(DECLARE (LOCALVARS $$VALUES))
(PROG1 (CAR $$VALUES)
,@[FOR V IN (CAR ARGS) collect (COND
@@ -203,6 +202,9 @@
(PUTPROPS TEDIT.VALUES MACRO [ARGS `(LIST ,@ARGS])
)
(* "END EXPORTED DEFINITIONS")
)
(/DECLAREDATATYPE 'PAGEREGION '(POINTER POINTER POINTER FULLXPOINTER POINTER POINTER)
@@ -311,7 +313,8 @@
(TEDIT.SINGLE.PAGEFORMAT
[LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS
PAGEPROPS PAPERSIZE) (* ; "Edited 10-Jan-2025 11:41 by rmk")
PAGEPROPS PAPERSIZE) (* ; "Edited 11-May-2025 14:59 by rmk")
(* ; "Edited 10-Jan-2025 11:41 by rmk")
(* ; "Edited 24-Dec-2024 21:20 by rmk")
(* ; "Edited 15-Aug-2024 23:01 by rmk")
(* ; "Edited 6-Aug-2024 12:06 by rmk")
@@ -353,7 +356,7 @@
(AND INTERCOL (SETQ INTERCOL (HCSCALE SCALEFACTOR INTERCOL)))
(SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT)
LEFT))
(CL:WHEN PAGE#S?
(CL:WHEN (EQ PAGE#S? 'Yes)
(* ;; "This asserts that the page number's region is 4 inches wide. Why? What if the pretext/posttext is longer?")
@@ -630,7 +633,8 @@
(TEDIT.FORMAT.HARDCOPY
[LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG
ENDPG QUIET) (* ; "Edited 23-Feb-2025 09:59 by rmk")
ENDPG QUIET) (* ; "Edited 22-Apr-2025 08:12 by rmk")
(* ; "Edited 23-Feb-2025 09:59 by rmk")
(* ; "Edited 30-Aug-2024 15:45 by rmk")
(* ; "Edited 10-Jul-2024 23:34 by rmk")
(* ; "Edited 29-Jun-2024 10:32 by rmk")
@@ -658,7 +662,7 @@
`(PROGN (CLOSEF? OLDVALUE])
TEXTSTREAM
else (ERROR TEXTSTREAM "is not a Tedit stream")))
(PROG ((TEXTOBJ (FGETTSTR TEXTSTREAM TEXTOBJ))
(PROG ((TEXTOBJ (FTEXTOBJ TEXTSTREAM))
[FORMATTINGSTATE (create PAGEFORMATTINGSTATE
PAGE# _ (FIXP FIRSTPG#)
FIRSTPAGE _ T
@@ -730,7 +734,7 @@
do
(* ;; "Format pages according to the existing layout:")
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
(\TEDIT.FORMATBOX TEXTSTREAM PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
PAGEREGION FORMATTINGSTATE IMAGETYPE)
(CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT)
@@ -778,7 +782,8 @@
(DEFINEQ
(\TEDIT.FORMATBOX
[LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)
[LAMBDA (TSTREAM PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)
(* ; "Edited 21-Apr-2025 18:50 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 17-Nov-2024 19:10 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
@@ -790,151 +795,155 @@
(* ; "Edited 15-Feb-2023 23:47 by rmk")
(* ; "Edited 30-May-91 12:51 by jds")
(* ;; "Grab text from the TEXTOBJ, starting with STARTINGCHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
(* ;; "Grab text from the TSTREAM, starting with STARTINGCHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
(* ;; "This updates the CHNO field of the PAGEFORMATTINGSTATE")
(LET ((REGION (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))
CHNO LINES LAST-CHNO SUBREGIONSPEC (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)))
(SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION)
(TEXT (* ;
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(REGION (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))
(TEXTLEN (TEXTLEN TEXTOBJ))
CHNO LINES LAST-CHNO SUBREGIONSPEC)
(SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION)
(TEXT (* ;
 "A normal text region. Fill it with text formatted the usual way.")
(CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(* ;
 "Only format if we're not looking for something else.")
(TEDIT.SETQS (LINES NIL LAST-CHNO)
(\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))))
(HEADING (* ;
 "A Page heading. Fill it in from a text source we saved for the occasion.")
(CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(TEDIT.SETQS (LINES NIL LAST-CHNO)
(\TEDIT.FORMATTEXTBOX TSTREAM 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.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.")
(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
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.")
(\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 TSTREAM PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE))
((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT)
(* ;
 "This box is really a list of boxes. Fill them.")
(\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))
((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT)
(* ;
 "This box is really a list of boxes. Fill them.")
(\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE)
(* ;
 "So that if this is the box he's looking for, we'll spot it and stop searching")
(SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION)
((SEQUENCE RECURSIVE) (* ;
(SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION)
((SEQUENCE RECURSIVE) (* ;
 "Just run thru filling in the sub-boxes in order.")
(bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES)
of PAGEREGION)
while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(OR (NOT (GETPFS FORMATTINGSTATE PAGE#))
(NOT (GETPFS FORMATTINGSTATE MAXPAGE#))
(ILEQ (GETPFS FORMATTINGSTATE PAGE#)
(GETPFS FORMATTINGSTATE MAXPAGE#)))
(NEQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT))
do [SETQ SUBREGIONSPEC (create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT _
(IPLUS (fetch (REGION LEFT)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION LEFT)
of REGION))
BOTTOM _
(IPLUS (fetch (REGION BOTTOM)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _ SUBREGIONSPEC
)
FORMATTINGSTATE)))
(ALTERNATE (* ;
(bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES)
of PAGEREGION)
while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(OR (NOT (GETPFS FORMATTINGSTATE PAGE#))
(NOT (GETPFS FORMATTINGSTATE MAXPAGE#))
(ILEQ (GETPFS FORMATTINGSTATE PAGE#)
(GETPFS FORMATTINGSTATE MAXPAGE#)))
(NEQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT))
do [SETQ SUBREGIONSPEC (create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT _
(IPLUS (fetch (REGION LEFT)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION LEFT)
of REGION))
BOTTOM _
(IPLUS (fetch (REGION BOTTOM)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(\TEDIT.FORMATBOX TSTREAM PRSTREAM (GETPFS FORMATTINGSTATE CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _
SUBREGIONSPEC)
FORMATTINGSTATE)))
(ALTERNATE (* ;
 "Run through the sub-boxes repeatedly in sequence.")
(while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(NEQ :NEW-PAGE-LAYOUT (GETPFS FORMATTINGSTATE STATE)))
do (bind SUBREGIONSPEC for SUBREGION
in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(NEQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT))
do [SETQ SUBREGIONSPEC
(create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT _ (IPLUS (fetch (REGION LEFT)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION LEFT)
of REGION))
BOTTOM _ (IPLUS (fetch (REGION BOTTOM)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS
(while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(NEQ :NEW-PAGE-LAYOUT (GETPFS FORMATTINGSTATE STATE)))
do (bind SUBREGIONSPEC for SUBREGION
in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
(NEQ (GETPFS FORMATTINGSTATE STATE)
:NEW-PAGE-LAYOUT))
do [SETQ SUBREGIONSPEC
(create REGION
using (fetch REGIONSPEC of SUBREGION)
LEFT _ (IPLUS (fetch (REGION LEFT)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION LEFT)
of REGION))
BOTTOM _ (IPLUS (fetch (REGION BOTTOM)
of (fetch REGIONSPEC
of SUBREGION))
(fetch (REGION BOTTOM)
of REGION]
(\TEDIT.FORMATBOX TSTREAM PRSTREAM (GETPFS
FORMATTINGSTATE
CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _
SUBREGIONSPEC)
FORMATTINGSTATE))))
(SELECTION (* ;
CHNO)
(create PAGEREGION using SUBREGION REGIONSPEC _
SUBREGIONSPEC)
FORMATTINGSTATE))))
(SELECTION (* ;
 "Do one or another box, depending on some criterion."))
(\TEDIT.THELP)) (* ;
 "For now, draw a box around it, too.")
)
NIL)
(for LINE LTEXTOBJ in LINES when LINE do (* ;
(\TEDIT.THELP)))
NIL)
(for LINE LTEXTSTREAM in LINES when LINE do (* ;
 "Run thru the lines displaying them all.")
(BLOCK)
(SETQ LTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
of (FGETLD LINE LTEXTSTREAM)))
(CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#)
)
(IGEQ (GETPFS FORMATTINGSTATE PAGE#)
(GETPFS FORMATTINGSTATE MINPAGE#
)))
(BLOCK)
(CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE
MINPAGE#))
(IGEQ (GETPFS FORMATTINGSTATE
PAGE#)
(GETPFS FORMATTINGSTATE
MINPAGE#)))
(* ;
 "We're beyond the min page number -- go ahead and print the line")
(\TEDIT.HARDCOPY.DISPLAYLINE
LTEXTOBJ LINE (SCALEREGION (DSPSCALE NIL
PRSTREAM)
REGION)
PRSTREAM FORMATTINGSTATE))
(CL:WHEN (EQ TEXTOBJ LTEXTOBJ)
(SETQ LTEXTSTREAM (FGETLD LINE LTEXTSTREAM)
)
(\TEDIT.HARDCOPY.DISPLAYLINE
(FGETLD LINE LTEXTSTREAM)
LINE
(SCALEREGION (DSPSCALE NIL PRSTREAM)
REGION)
PRSTREAM FORMATTINGSTATE))
(CL:WHEN (EQ TSTREAM LTEXTSTREAM)
(* ;;
(* ;;
 "This line refers back to the main text, so update the current-char pointer.")
(* ;;
(* ;;
 "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]")
(SETQ CHNO (IMAX (OR CHNO 0)
(FGETLD LINE LCHARLIM))))
(push (GETPFS FORMATTINGSTATE PAGELINECACHE)
LINE)
(FSETLD LINE LTEXTSTREAM NIL))
(COND
(LAST-CHNO (* ;
(SETQ CHNO (IMAX (OR CHNO 0)
(FGETLD LINE LCHARLIM))))
(push (GETPFS FORMATTINGSTATE PAGELINECACHE)
LINE)
(FSETLD LINE LTEXTSTREAM NIL))
(if LAST-CHNO
then (* ;
 "We got a definite last chno from FORMATTEXTBOX.")
(SETPFS FORMATTINGSTATE CHNO LAST-CHNO))
(CHNO (* ;
(SETPFS FORMATTINGSTATE CHNO LAST-CHNO)
elseif CHNO
then (* ;
 "Otherwise, use the new char no if we computed one.")
(SETPFS FORMATTINGSTATE CHNO CHNO])
(SETPFS FORMATTINGSTATE CHNO CHNO])
(\TEDIT.FORMATHEADING
[LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 9-Jan-2025 22:27 by rmk")
@@ -1005,7 +1014,8 @@
LINE))])
(\TEDIT.FORMATPAGE
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
[LAMBDA (TSTREAM PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 22:41 by rmk")
(* ; "Edited 19-Feb-2025 13:32 by rmk")
(* ; "Edited 8-Feb-2025 21:13 by rmk")
(* ; "Edited 11-Dec-2024 22:39 by rmk")
(* ; "Edited 17-Mar-2024 00:24 by rmk")
@@ -1034,110 +1044,112 @@
(* ;; "Only do real page formatting work if we're not trying to get ourselves to an equivalent page frame spec (having switched page layouts in mid-document).")
[PROG ((PAGE# (GETPFS FORMATTINGSTATE PAGE#))
(PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
(REGION (\TEDIT.SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(END-OF-PAGE-FN (GETTEXTPROP TEXTOBJ 'END-OF-PAGE-FN))
(PRE-EXISTING-FONT (DSPFONT NIL PRSTREAM))
(TEXTLEN (TEXTLEN TEXTOBJ))
END-OF-PAGE-MARKER STARTING-FILEPTR PC NEWPARALOOKS)
[PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(PAGE# (GETPFS FORMATTINGSTATE PAGE#))
(PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION))
(REGION (\TEDIT.SCALEREGION (DSPSCALE NIL PRSTREAM)
(fetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(END-OF-PAGE-FN (GETTEXTPROP TEXTOBJ 'END-OF-PAGE-FN))
(PRE-EXISTING-FONT (DSPFONT NIL PRSTREAM))
(TEXTLEN (TEXTLEN TEXTOBJ))
END-OF-PAGE-MARKER STARTING-FILEPTR PC NEWPARALOOKS)
(* ;; "For real page independence, we need to reset the font to where it was as of the beginning of the page before calling DSPNEWPAGE. This avoids font creation in a page prolog, which might get missed otherwise.")
(* ;
 "Print in the usual region on the page")
(CL:UNLESS (ILEQ CHNO TEXTLEN)
(RETURN))
(SETQ PC (\TEDIT.ALIGNEDPIECE CHNO TEXTOBJ))
(SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
PC TEXTOBJ)) (* ;
(CL:UNLESS (ILEQ CHNO TEXTLEN)
(RETURN))
(SETQ PC (\TEDIT.ALIGNEDPIECE CHNO TEXTOBJ))
(SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC)
PC TEXTOBJ)) (* ;
 "RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?")
(CL:WHEN (EQ 'NEWPAGELAYOUT (GETPLOOKS NEWPARALOOKS FMTPARATYPE))
(CL:WHEN (EQ 'NEWPAGELAYOUT (GETPLOOKS NEWPARALOOKS FMTPARATYPE))
(* ;; "The first paragra ph on this page starts a new page layout.")
(* ;; "The first paragra ph on this page starts a new page layout.")
(SETPFS FORMATTINGSTATE STATE :NEW-PAGE-LAYOUT)
(SETPFS FORMATTINGSTATE STATE :NEW-PAGE-LAYOUT)
(* ;; "The first character of the paragraph after the one containing PC:")
(* ;; "The first character of the paragraph after the one containing PC:")
[SETPFS FORMATTINGSTATE CHNO (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ PC]
[SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES (LISTGET
(GETPLOOKS
[SETPFS FORMATTINGSTATE CHNO (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ PC]
[SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES (LISTGET
(GETPLOOKS
NEWPARALOOKS
FMTUSERINFO)
'NEWPAGELAYOUT]
(RETURN))
FMTUSERINFO
)
'NEWPAGELAYOUT]
(RETURN))
(* ;; "")
(CL:UNLESS PAGE#
(CL:UNLESS PAGE#
(* ;; "If this page template specifies a starting page number, use it.")
(* ;; "If this page template specifies a starting page number, use it.")
(SETQ PAGE# (OR (LISTGET PAGEPROPS 'STARTINGPAGE#)
1))
(SETPFS FORMATTINGSTATE PAGE# PAGE#))
(CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.")
(STREAMPROP PRSTREAM 'PRINTERMODE 'LANDSCAPE)
(SETQ PAGE# (OR (LISTGET PAGEPROPS 'STARTINGPAGE#)
1))
(SETPFS FORMATTINGSTATE PAGE# PAGE#))
(CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.")
(STREAMPROP PRSTREAM 'PRINTERMODE 'LANDSCAPE)
(* ; "Put the info. into stream ")
(DSPPUSHSTATE PRSTREAM)
(DSPROTATE 90 PRSTREAM)
(DSPTRANSLATE 0 (IMINUS (ffetch (REGION HEIGHT) of REGION))
PRSTREAM))
(DSPCLIPPINGREGION REGION PRSTREAM) (* ; "Clip to the whole sheet.")
(DSPRIGHTMARGIN (fetch (REGION WIDTH) of REGION)
PRSTREAM)
(DSPPUSHSTATE PRSTREAM)
(DSPROTATE 90 PRSTREAM)
(DSPTRANSLATE 0 (IMINUS (ffetch (REGION HEIGHT) of REGION))
PRSTREAM))
(DSPCLIPPINGREGION REGION PRSTREAM) (* ; "Clip to the whole sheet.")
(DSPRIGHTMARGIN (fetch (REGION WIDTH) of REGION)
PRSTREAM)
(* ;; "Go thru any leading page heading paras on the page, collecting copies of those pieces in the FORMATTINGSTATE. The value is the first CHNO of the start of the first non-heading piece.")
(SETQ CHNO (\TEDIT.HARDCOPY.PAGEHEADINGS TEXTOBJ CHNO FORMATTINGSTATE))
(SETQ CHNO (\TEDIT.HARDCOPY.PAGEHEADINGS TSTREAM CHNO FORMATTINGSTATE PAGEREGION))
(* ;; "")
(* ;; "We now fill up the next complete page. Afterwards, we either continue to the next page (DPSNEWPAGE) or finish up. TEDIT.FORMATBOX is responsible for setting up NEWPAGEBEFORFE and NEWPAGEAFTER")
(SETPFS FORMATTINGSTATE CHNO CHNO)
(for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN) do
(* ;;
(SETPFS FORMATTINGSTATE CHNO CHNO)
(for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)
while (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN) do
(* ;;
 "Now format the subregions of the page. The CHNO field may be updated by each call.")
(\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE
CHNO)
SUBREGION FORMATTINGSTATE))
(\TEDIT.FORMATBOX TSTREAM PRSTREAM (GETPFS FORMATTINGSTATE
CHNO)
SUBREGION FORMATTINGSTATE))
(* ;; "")
(DSPFONT PRE-EXISTING-FONT PRSTREAM)
(CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.")
(STREAMPROP PRSTREAM 'PRINTERMODE NIL)
(DSPTRANSLATE 0 (ffetch (REGION HEIGHT) of REGION)
PRSTREAM)
(DSPROTATE 0 PRSTREAM)
(DSPPOPSTATE PRSTREAM))
[COND
([AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
[NOT (AND END-OF-PAGE-FN (EQ 'DON'T (SETQ END-OF-PAGE-MARKER
(APPLY* END-OF-PAGE-FN TEXTOBJ
FORMATTINGSTATE]
[NOT (AND (GETPFS FORMATTINGSTATE MINPAGE#)
(ILESSP PAGE# (GETPFS FORMATTINGSTATE MINPAGE#]
(NOT (AND (GETPFS FORMATTINGSTATE MAXPAGE#)
(IEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#]
(DSPFONT PRE-EXISTING-FONT PRSTREAM)
(CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.")
(STREAMPROP PRSTREAM 'PRINTERMODE NIL)
(DSPTRANSLATE 0 (ffetch (REGION HEIGHT) of REGION)
PRSTREAM)
(DSPROTATE 0 PRSTREAM)
(DSPPOPSTATE PRSTREAM))
[COND
([AND (ILEQ (GETPFS FORMATTINGSTATE CHNO)
TEXTLEN)
[NOT (AND END-OF-PAGE-FN (EQ 'DON'T (SETQ END-OF-PAGE-MARKER
(APPLY* END-OF-PAGE-FN TEXTOBJ
FORMATTINGSTATE]
[NOT (AND (GETPFS FORMATTINGSTATE MINPAGE#)
(ILESSP PAGE# (GETPFS FORMATTINGSTATE MINPAGE#]
(NOT (AND (GETPFS FORMATTINGSTATE MAXPAGE#)
(IEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#]
(* ; "There is more to print....")
(* ; "Force the new page")
(DSPNEWPAGE PRSTREAM))
((OR (AND (GETPFS FORMATTINGSTATE MAXPAGE#)
(IGEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#)))
(EQ END-OF-PAGE-MARKER 'DON'T)) (* ;
(DSPNEWPAGE PRSTREAM))
((OR (AND (GETPFS FORMATTINGSTATE MAXPAGE#)
(IGEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#)))
(EQ END-OF-PAGE-MARKER 'DON'T)) (* ;
 "We've run past the last page to be formatted. or were told to stop. .")
(SETPFS FORMATTINGSTATE CHNO (ADD1 TEXTLEN]
(add (GETPFS FORMATTINGSTATE PAGE#)
1)
(SETPFS FORMATTINGSTATE FIRSTPAGE NIL)
(SETPFS FORMATTINGSTATE PAGE#TEXT (pop (GETPFS FORMATTINGSTATE PAGE#GENERATOR])
(SETPFS FORMATTINGSTATE CHNO (ADD1 TEXTLEN]
(add (GETPFS FORMATTINGSTATE PAGE#)
1)
(SETPFS FORMATTINGSTATE FIRSTPAGE NIL)
(SETPFS FORMATTINGSTATE PAGE#TEXT (pop (GETPFS FORMATTINGSTATE PAGE#GENERATOR])
(* ;; "Some things happen regardless of whether we're searching or not: Need to count pages we pass over to find an equivalent page in the new layout:")
@@ -1145,7 +1157,8 @@
1])
(\TEDIT.FORMATTEXTBOX
[LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
[LAMBDA (TSTREAM PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 14:05 by rmk")
(* ; "Edited 19-Feb-2025 13:32 by rmk")
(* ; "Edited 8-Feb-2025 23:39 by rmk")
(* ; "Edited 11-Dec-2024 22:37 by rmk")
(* ; "Edited 24-Nov-2024 11:46 by rmk")
@@ -1173,7 +1186,8 @@
(* ;; "Only format text if we're really formatting.")
(LET* ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(REGION (SCALEREGION (DSPSCALE NIL PRSTREAM)
(ffetch (PAGEREGION REGIONSPEC) of PAGEREGION)))
(COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION))
(RTOP (fetch (REGION TOP) of REGION))
@@ -1216,8 +1230,8 @@
(SETQ LINE (pop (GETPFS FORMATTINGSTATE PAGELINECACHE)))
(* ;
 "Format the line, noting any form-feeds")
(SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
CHNO LINE REGION PRSTREAM FORMATTINGSTATE))
(SETQ LINE (\TEDIT.FORMATLINE TSTREAM CHNO LINE REGION PRSTREAM
FORMATTINGSTATE))
(SETQ FORCENEXTPAGE (AND (EQ (CHARCODE FORM)
(FGETLD LINE FORCED-END))
'USERBREAK))
@@ -1238,7 +1252,7 @@
(CL:WHEN FORCENEXTPAGE (* ;
 "HELP in original code. SHOULDNT ?")
(\TEDIT.THELP))
(SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION
(SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TSTREAM PRSTREAM LINE REGION
FORMATTINGSTATE))
(SETQ CHNO (FGETLD (CAR (FLAST FOOTNOTELINES))
LCHARLIM)) (* ; "Grab the lines of this footnote")
@@ -1517,7 +1531,8 @@
(DEFINEQ
(\TEDIT.HARDCOPY.PAGEHEADINGS
[LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 19-Feb-2025 13:32 by rmk")
[LAMBDA (TSTREAM CHNO FORMATTINGSTATE PAGEREGION) (* ; "Edited 22-Apr-2025 08:11 by rmk")
(* ; "Edited 19-Feb-2025 13:32 by rmk")
(* ; "Edited 12-Jan-2025 17:31 by rmk")
(* ; "Edited 10-Jan-2025 15:42 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
@@ -1532,7 +1547,8 @@
(CL:UNLESS FORMATTINGSTATE (* ;
 "If it isn't there, we would loose the headings")
(\TEDIT.THELP "NIL FORMATTINGSTATE"))
(bind HEADINGSUBTYPE (PC _ (\TEDIT.CHTOPC CHNO TEXTOBJ))
(bind HEADINGSUBTYPE PC (TEXTOBJ _ (FTEXTOBJ TSTREAM)) first (SETQ PC (\TEDIT.CHTOPC CHNO TEXTOBJ
))
while (AND PC (EQ 'PAGEHEADING (GETPLOOKS (PPARALOOKS PC)
FMTPARATYPE)))
do (SETQ HEADINGSUBTYPE (GETPLOOKS (PPARALOOKS PC)
@@ -1548,7 +1564,8 @@
(add CHNO (PLEN P)) finally (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
HEADINGSUBTYPE
(\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES START
CHNO TEXTOBJ)))
CHNO TEXTOBJ)
NIL TSTREAM))
(* ;;
 "Set PC to continue looking for the next headingtype.")
@@ -1567,7 +1584,7 @@
[SETQ FOLIOSTREAM (OPENTEXTSTREAM NIL NIL `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS)
LOOKS
,(LISTGET FOLIOINFO 'CHARLOOKS]
(SETQ FOLIOTEXTOBJ (GETTSTR FOLIOSTREAM TEXTOBJ))
(SETQ FOLIOTEXTOBJ (FTEXTOBJ FOLIOSTREAM))
(CL:WHEN (CADR INFOLIST)
(TEDIT.INSERT FOLIOSTREAM (MKSTRING (CADR INFOLIST))))
(TEDIT.INSERT.OBJECT (TEDIT.PAGENO.CREATE (CAR INFOLIST))
@@ -1577,7 +1594,8 @@
(LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE)
'\TEDIT.PAGENO
(\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES 1 (TEXTLEN FOLIOTEXTOBJ)
FOLIOTEXTOBJ))))]
(FTEXTOBJ TSTREAM))
NIL TSTREAM)))]
CHNO])
)
@@ -2044,7 +2062,8 @@
(DEFINEQ
(\TEDIT.FORMAT.FOOTNOTE
[LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 20-Nov-2024 12:37 by rmk")
[LAMBDA (TSTREAM PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 21-Apr-2025 14:03 by rmk")
(* ; "Edited 20-Nov-2024 12:37 by rmk")
(* ; "Edited 17-Nov-2024 19:22 by rmk")
(* ; "Edited 13-Jun-2024 17:13 by rmk")
(* ; "Edited 15-Mar-2024 19:24 by rmk")
@@ -2054,21 +2073,19 @@
(* ; "Edited 7-Mar-2023 13:11 by rmk")
(* ; "Edited 30-May-91 12:52 by jds")
(* ;; "Grab text from the TEXTOBJ, starting with CHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
(* ;; "Grab text from the TSTREAM, starting with CHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.")
(BLOCK) (* ;
 "Footnotes aren't so long, but why not?")
(bind PREVLINE (LEFT _ (fetch (REGION LEFT) of REGION))
(TEXTLEN _ (TEXTLEN TEXTOBJ))
(TEXTLEN _ (TEXTLEN (FTEXTOBJ TSTREAM)))
(CHNO _ (GETLD LINE LCHAR1)) while (ILEQ CHNO TEXTLEN) until (AND PREVLINE (GETLD PREVLINE
LSTLN))
collect
(* ;; "Grab a line descriptor from the formatting list, or create a new one.")
(SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
CHNO
(GETPFS FORMATTINGSTATE PAGELINECACHE)
(SETQ LINE (\TEDIT.FORMATLINE TSTREAM CHNO (GETPFS FORMATTINGSTATE PAGELINECACHE)
REGION PRSTREAM FORMATTINGSTATE))
(* ;
 "Format the line, noting any form-feeds")
@@ -2084,18 +2101,18 @@
(RETURN (DREMOVE NIL $$VAL])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (12098 15710 (\TEDIT.PARSE.PAGEFRAMES 12108 . 13887) (\TEDIT.PUT.PAGEFRAMES 13889 .
14713) (\TEDIT.UNPARSE.PAGEFRAMES 14715 . 15708)) (15773 37671 (TEDIT.SINGLE.PAGEFORMAT 15783 . 26657)
(TEDIT.COMPOUND.PAGEFORMAT 26659 . 27638) (TEDIT.PAGEFORMAT 27640 . 34929) (TEDIT.GET.PAGEFORMAT
34931 . 37669)) (37958 48639 (TEDIT.FORMAT.HARDCOPY 37968 . 48637)) (48726 101203 (\TEDIT.FORMATBOX
48736 . 61839) (\TEDIT.FORMATHEADING 61841 . 66487) (\TEDIT.FORMATPAGE 66489 . 75356) (
\TEDIT.FORMATTEXTBOX 75358 . 91739) (\TEDIT.FORMATFOLIO 91741 . 97058) (\TEDIT.FORMAT.FOUNDBOX? 97060
. 99099) (\TEDIT.SKIP.SPECIALCOND 99101 . 101201)) (101283 105992 (\TEDIT.HARDCOPY.PAGEHEADINGS
101293 . 105990)) (106101 114152 (\TEDIT.HARDCOPY-COLUMN-END 106111 . 114150)) (114197 119138 (
SCALEPAGEUNITS 114207 . 115348) (SCALEPAGEXUNITS 115350 . 116120) (SCALEPAGEYUNITS 116122 . 116893) (
\TEDIT.PAPERHEIGHT 116895 . 117830) (\TEDIT.PAPERWIDTH 117832 . 119136)) (119554 123122 (ROMANNUMERALS
119564 . 123120)) (123161 130427 (TEDIT.PAGENO.CREATE 123171 . 123547) (\TEDIT.PAGENO.OBJINIT 123549
. 124832) (\TEDIT.PAGENO.BUTTONEVENTINFN 124834 . 125900) (\TEDIT.PAGENO.IMAGEBOXFN 125902 . 128052)
(\TEDIT.PAGENO.DISPLAYFN 128054 . 129704) (\TEDIT.PAGENO.GETFN 129706 . 130098) (\TEDIT.PAGENO.PUTFN
130100 . 130425)) (130492 133395 (\TEDIT.FORMAT.FOOTNOTE 130502 . 133393)))))
(FILEMAP (NIL (12141 15753 (\TEDIT.PARSE.PAGEFRAMES 12151 . 13930) (\TEDIT.PUT.PAGEFRAMES 13932 .
14756) (\TEDIT.UNPARSE.PAGEFRAMES 14758 . 15751)) (15816 37833 (TEDIT.SINGLE.PAGEFORMAT 15826 . 26819)
(TEDIT.COMPOUND.PAGEFORMAT 26821 . 27800) (TEDIT.PAGEFORMAT 27802 . 35091) (TEDIT.GET.PAGEFORMAT
35093 . 37831)) (38120 48905 (TEDIT.FORMAT.HARDCOPY 38130 . 48903)) (48992 102244 (\TEDIT.FORMATBOX
49002 . 62426) (\TEDIT.FORMATHEADING 62428 . 67074) (\TEDIT.FORMATPAGE 67076 . 76265) (
\TEDIT.FORMATTEXTBOX 76267 . 92780) (\TEDIT.FORMATFOLIO 92782 . 98099) (\TEDIT.FORMAT.FOUNDBOX? 98101
. 100140) (\TEDIT.SKIP.SPECIALCOND 100142 . 102242)) (102324 107379 (\TEDIT.HARDCOPY.PAGEHEADINGS
102334 . 107377)) (107488 115539 (\TEDIT.HARDCOPY-COLUMN-END 107498 . 115537)) (115584 120525 (
SCALEPAGEUNITS 115594 . 116735) (SCALEPAGEXUNITS 116737 . 117507) (SCALEPAGEYUNITS 117509 . 118280) (
\TEDIT.PAPERHEIGHT 118282 . 119217) (\TEDIT.PAPERWIDTH 119219 . 120523)) (120941 124509 (ROMANNUMERALS
120951 . 124507)) (124548 131814 (TEDIT.PAGENO.CREATE 124558 . 124934) (\TEDIT.PAGENO.OBJINIT 124936
. 126219) (\TEDIT.PAGENO.BUTTONEVENTINFN 126221 . 127287) (\TEDIT.PAGENO.IMAGEBOXFN 127289 . 129439)
(\TEDIT.PAGENO.DISPLAYFN 129441 . 131091) (\TEDIT.PAGENO.GETFN 131093 . 131485) (\TEDIT.PAGENO.PUTFN
131487 . 131812)) (131879 134818 (\TEDIT.FORMAT.FOOTNOTE 131889 . 134816)))))
STOP

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

Binary file not shown.

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

Binary file not shown.

BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT
View File

Binary file not shown.

1058
library/tedit/TEDIT-SCREEN
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

859
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.

621
library/tedit/TEDIT-STREAM
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 18:32:27" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;872 187180
(FILECREATED "29-May-2025 19:06:45" {WMEDLEY}<library>tedit>TEDIT-STREAM.;901 191318
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.NTHCHARCODE \TEDIT.TEXTBOUT \TEDIT.RPLCHARCODE)
(VARS TEDIT-STREAMCOMS)
:CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.PIECES)
:PREVIOUS-DATE "26-Mar-2025 00:29:46" {WMEDLEY}<library>TEDIT>TEDIT-STREAM.;865)
:PREVIOUS-DATE "26-Apr-2025 12:59:53" {WMEDLEY}<library>tedit>TEDIT-STREAM.;900)
(PRETTYCOMPRINT TEDIT-STREAMCOMS)
@@ -56,12 +55,13 @@
(FNS \TEDIT.TEXTCLOSEF \TEDIT.TEXTDSPFONT \TEDIT.TEXTEOFP \TEDIT.TEXTGETEOFPTR
\TEDIT.TEXTSETEOFPTR \TEDIT.TEXTGETFILEPTR \TEDIT.TEXTSETFILEINFO \TEDIT.TEXTOPENF
\TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION
\TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH
\TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTCOLOR \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH
\TEDIT.TEXTDSPSTRINGWIDTH \TEDIT.TEXTDSPLINEFEED)
(* ;; "Access by character")
(FNS \TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE \TEDIT.RPLCHARCODE)
(FNS \TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE \TEDIT.RPLCHARCODE \TEDIT.PIECE.RPLCHARCODE
\TEDIT.NTHCHARLOOKS)
(COMS
(* ;; "Editing support")
@@ -75,7 +75,8 @@
 "Deprecated, maybe still external callers")
(FNS \TEDIT.INSTALL.PIECE)
[COMS (* ; "Support for TEXTPROP")
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS \TEDIT.TEXTPROP)
(FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS TEXTPROP.ADD
\TEDIT.TEXTPROP)
(FNS \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN \TEDIT.TEXTOBJ.PROPSTOREFN)
(* ; "For TEXTOBJ inspection")
(DECLARE%: DONTCOPY (* ; "Only if the declaration is loaded")
@@ -134,124 +135,125 @@
(freplace (PIECE PCHARLOOKS) of DATUM with NEWVALUE]
PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ
(
(* ;;
(DATATYPE TEXTOBJ (
(* ;;
 "This is where TEdit stores its state information, and internal data about the text being edited.")
PCTB (* ; "The piece table")
TEXTLEN (* ; "# of chars in the text")
PRIMARYPANE (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC")
SUFFIXPIECE (* ;
PCTB (* ; "The piece table")
TEXTLEN (* ; "# of chars in the text")
PRIMARYPANE (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC")
SUFFIXPIECE (* ;
 "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
CHARFN (* ;
CHARFN (* ;
 "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
HINTPC (* ;
HINTPC (* ;
 "Was: Space left in the type-in piece")
HINTPCSTARTCH# (* ;
HINTPCSTARTCH# (* ;
 "Was # of characters already in the piece.")
INSERTSTRING (* ;
INSERTSTRING (* ;
 "A substring of storage that is available for an insertion.")
TXTHISTORYUNDONE (* ; "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece.")
(NIL FLAG) (* ; " Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL.")
(TXTREADONLYQUIET FLAG) (* ;
TXTHISTORYUNDONE (* ; "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece.")
(NIL FLAG) (* ; " Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL.")
(TXTREADONLYQUIET FLAG) (* ;
 "T => don't print READONLY abort messages")
PARABREAKCHARS (* ; "Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE")
MOUSEREGION (* ;
PARABREAKCHARS (* ; "Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE")
MOUSEREGION (* ;
 "Section of the window the mouse is in.")
LOOPFN (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES.")
DS (* ;
LOOPFN (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES.")
DS (* ;
 "NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
SEL (* ;
SEL (* ;
 "The current selection within the text")
LASTARROWX (* ;
LASTARROWX (* ;
 "X for next arrow up or arrow down. Was: Scratch space for the selection code")
NIL (* ;
NIL (* ;
 "Was MOVESEL: Source for the next MOVE of text")
NIL (* ;
NIL (* ;
 "Was SHIFTEDSEL: Source for the next COPY")
NIL (* ;
NIL (* ;
 "Was DELETESEL: Text to be deleted imminently")
WRIGHT (* ;
 "Right edge of the window (or subregion) where this is displayed")
WTOP (* ; "Top of the window/region")
WBOTTOM (* ; "Bottom of the window/region")
WLEFT (* ; "Left edge of the window/region")
TXTFILE (* ;
NIL (* ;
 "Was WRIGHT: Right edge of the window (or subregion) where this is displayed")
WTOP (* ; "Top of the window/region")
NIL (* ;
 "Was WBOTTOM: Bottom of the window/region")
NIL (* ;
 "Was WLEFT: Left edge of the window/region")
TXTFILE (* ;
 "The original text file we're editing")
(\XDIRTY FLAG) (* ; "T => changed since last saved.")
(STREAMHINT FULLXPOINTER) (* ;
(\XDIRTY FLAG) (* ; "T => changed since last saved.")
(STREAMHINT FULLXPOINTER) (* ;
 "-> the TEXTOFD stream which gives access to this textobj")
EDITFINISHEDFLG (* ;
EDITFINISHEDFLG (* ;
 "T => The guy has asked the editor to go way")
NIL (* ;
NIL (* ;
 "Was CARET: Describes the flashing caret for the editing window")
CARETLOOKS (* ;
CARETLOOKS (* ;
 "Font to be used for inserted text.")
WINDOWTITLE (* ;
WINDOWTITLE (* ;
 "Original title for this window, of there was one.")
THISLINE (* ;
THISLINE (* ;
 "Cache of line-related info, to speed up selection &c")
(MENUFLG FLAG) (* ;
(MENUFLG FLAG) (* ;
 "T if this TEXTOBJ is a tedit-style menu")
DEFAULTPARALOOKS (* ;
DEFAULTPARALOOKS (* ;
 "Default Formatting Spec to be used when formatting paragraphs")
(FORMATTEDP FLAG) (* ;
(FORMATTEDP FLAG) (* ;
 "Flag for paragraph formatting. T if this document is to contain paragraph formatting information.")
(TXTREADONLY FLAG) (* ;
(TXTREADONLY FLAG) (* ;
 "This is only available for shift selection.")
(TXTEDITING FLAG) (* ; "T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing.")
(TXTNOTSPLITTABLE FLAG) (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation.")
TXTTERMSA (* ;
(TXTEDITING FLAG) (* ; "T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing.")
(TXTNOTSPLITTABLE FLAG) (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation.")
TXTTERMSA (* ;
 "Special instructions for displaying characters on the screen")
EDITOPACTIVE (* ;
EDITOPACTIVE (* ;
 "T if there is an editing operation in progress. Used to interlock the TEdit menu")
DEFAULTCHARLOOKS (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.")
TXTRTBL (* ;
DEFAULTCHARLOOKS (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.")
TXTRTBL (* ;
 "The READTABLE to be used by the command loop for command dispatch")
TXTWTBL (* ;
TXTWTBL (* ;
 "The READTABLE to be used to decide on word breaks")
EDITPROPS (* ;
EDITPROPS (* ;
 "The PROPS that were passed into this edit session")
(BLUEPENDINGDELETE FLAG) (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection")
(TXTHISTORYINACTIVE FLAG) (* ;
(BLUEPENDINGDELETE FLAG) (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection")
(TXTHISTORYINACTIVE FLAG) (* ;
 "T if history events are not recorded (e.g. for transcript files)")
TXTHISTORY (* ;
TXTHISTORY (* ;
 "The history list for this edit session.")
(SELPANE FULLXPOINTER) (* ;
(SELPANE FULLXPOINTER) (* ;
 "The pane in which the last 'real' selection got made for this edit; used by TEDIT.NORMALIZECAREET")
PROMPTWINDOW (* ;
PROMPTWINDOW (* ;
 "A window to be used for unscheduled interactions; normally a small window above the edit window")
DISPLAYCACHE (* ;
DISPLAYCACHE (* ;
 "The bitmap to be used when building the image of a line for display")
DISPLAYCACHEDS (* ;
DISPLAYCACHEDS (* ;
 "The DISPLAYSTREAM that is used to build line images")
DISPLAYHCPYDS (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode")
TXTPAGEFRAMES (* ;
DISPLAYHCPYDS (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode")
TXTPAGEFRAMES (* ;
 "A tree of page frames, specifying how the document is to be laid out.")
TXTCHARLOOKSLIST (* ;
TXTCHARLOOKSLIST (* ;
 "List of all the CHARLOOKSs in the document, so they can be kept unique")
TXTPARALOOKSLIST (* ;
TXTPARALOOKSLIST (* ;
 "List of all the PARALOOKS in the document, so they can be kept unique")
(TXTAPPENDONLY FLAG) (* ; "Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater")
(TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.")
TXTRAWINCLUDESTREAM (* ;
(TXTAPPENDONLY FLAG) (* ; "Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater")
(TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.")
TXTRAWINCLUDESTREAM (* ;
 "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)")
DOCPROPS (* ;
DOCPROPS (* ;
 "Document properties that are stored with the document (not used yet)")
TXTSTYLESHEET (* ;
TXTSTYLESHEET (* ;
 "Style sheet local to this document. Not currently saved as part of the file.")
)
[ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM)
(PROGN (FSETTOBJ DATUM LASTARROWX NIL)
(CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY)
of DATUM))
(\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
(freplace \XDIRTY OF DATUM WITH NEWVALUE))]
SEL _ (create SELECTION)
TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ 'TEXT THISLINE _
(create THISLINE)
DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
)
[ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM)
(PROGN (FSETTOBJ DATUM LASTARROWX NIL)
(CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY)
of DATUM))
(\TEDIT.WINDOW.TITLE DATUM NEWVALUE)
(freplace \XDIRTY OF DATUM WITH NEWVALUE))]
SEL _ (create SELECTION)
TEXTLEN _ 0 WTOP _ 0 MOUSEREGION _ 'TEXT THISLINE _ (create THISLINE)
DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _
(CHARCODE (EOL FORM LF CR)))
(ACCESSFNS TEXTSTREAM
(
@@ -498,8 +500,8 @@
(PUTPROPS TEXTLEN MACRO ((TOBJ)
(ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
(PUTPROPS TEXTSEL MACRO ((TOBJ)
(fetch (TEXTOBJ SEL) of TOBJ)))
(PUTPROPS TEXTSEL MACRO ((TEXTOBJ)
(SELECTION! (GETTOBJ TEXTOBJ SEL))))
(PUTPROPS TEXTOBJ! MACRO ((TOBJ)
(\DTEST TOBJ 'TEXTOBJ)))
@@ -1024,7 +1026,8 @@
(\TEDIT.THELP "UNKNOWN PIECE TYPE")))])
(\TEDIT.TEXTBOUT
[LAMBDA (TSTREAM CHAR) (* ; "Edited 28-Mar-2025 10:13 by rmk")
[LAMBDA (TSTREAM CHAR) (* ; "Edited 20-Apr-2025 13:24 by rmk")
(* ; "Edited 28-Mar-2025 10:13 by rmk")
(* ; "Edited 17-Nov-2024 10:05 by rmk")
(* ; "Edited 6-Sep-2024 13:06 by rmk")
(* ; "Edited 27-Aug-2024 14:50 by rmk")
@@ -1057,7 +1060,7 @@
(CL:UNLESS (OR (\CHARCODEP CHAR)
(IMAGEOBJP CHAR))
(\ILLEGAL.ARG CHAR))
(PROG [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(PROG [(TEXTOBJ (FTEXTOBJ TSTREAM))
(CHNO (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM]
(CL:WHEN [OR (FGETTOBJ TEXTOBJ TXTREADONLY)
(AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
@@ -1071,7 +1074,7 @@
elseif (AND (\TEDIT.INSERTCH CHAR CHNO TEXTOBJ (MEMB CHAR (FGETTOBJ TEXTOBJ
PARABREAKCHARS)))
(\TEDIT.PRIMARYPANE TEXTOBJ))
then (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CHNO 1))
then (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION CHNO 1))
(* ;; ";; We inserted 1 char. Whether or not we introduced a new piece or extended an old one, we want to be positioned so that the next BOUT will insert after this one (if nothing else is changed). Do this after potential redisplay, in case the BINS in reformatting change the position.")
@@ -1211,19 +1214,21 @@
(\TEDIT.TEXTBACKFILEPTR STREAM])
(\TEDIT.TEXTFORMATBYTESTREAM
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 21-Oct-2024 00:26 by rmk")
[LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Apr-2025 23:49 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 19-Mar-2024 16:13 by rmk")
(* ; "Edited 24-Jun-2021 16:47 by rmk:")
(* ;; "BYTESTREAM might come in with a textstream external format, but that's presumably a mistake. If STREAM is a text stream, then it traffics in XCCS characters, it's format should be relatively vanilla.")
(* ;; "BYTESTREAM might come in with a textstream external format, but that's presumably a mistake. If STREAM is a text stream, then it traffics in MCCS characters, it's format should be relatively vanilla.")
(\TEDIT.THELP)
(\TEDIT.THELP "TEXT FORMATBYTESTREAM?")
(REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF STREAM])
(\TEDIT.TEXTFORMATBYTESTRING
[LAMBDA (TSTREAM STRING SCRATCHSTREAM) (* ; "Edited 19-Mar-2024 18:22 by rmk")
[LAMBDA (TSTREAM STRING SCRATCHSTREAM) (* ; "Edited 24-Apr-2025 23:50 by rmk")
(* ; "Edited 19-Mar-2024 18:22 by rmk")
(* ;; "The FORMATBYTESTRINGFN for Text streams. STRING is presumably in internal XCCS character codes, and those are the codes that TSTREAM will match against, independent of however its backing stream characters might be encoded. So we can just return STRING")
(* ;; "The FORMATBYTESTRINGFN for Text streams. STRING is presumably in internal MCCS character codes, and those are the codes that TSTREAM will match against, independent of however its backing stream characters might be encoded. So we can just return STRING")
(MKSTRING STRING])
)
@@ -1366,7 +1371,8 @@
TSTREAM))])
(COPYTEXTSTREAM
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 8-Feb-2025 20:10 by rmk")
[LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 21-Apr-2025 23:48 by rmk")
(* ; "Edited 8-Feb-2025 20:10 by rmk")
(* ; "Edited 12-Jan-2025 12:16 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 16-Mar-2024 10:03 by rmk")
@@ -1383,29 +1389,29 @@
(* ;; "Given a stream, textobj or window, returns a new textstream with the same contents. CROSSCOPY is a documented argument, but it doesn't control what happens. It is supposed to force a copy of a file piece to a new underlying source (a string or nodircore piece), so that there is no sharing between the original and the copy so that future edits in one stream are independent and safe even if the original file is deleted or modified by operations on the other stream. But edit operations don't change the source file until the file is saved, and tne you get a new version anyway. In any event, CROSSCOPY is T in all calls within TEDIT (e.g. for installing edit menus).")
(LET ((TEXTOBJ (TEXTOBJ ORIGINAL))
NEWSTREAM NEWTEXTOBJ) (* ;
(LET* ((TSTREAM (TEXTSTREAM ORIGINAL))
(TEXTOBJ (FTEXTOBJ TSTREAM))
[NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
(NEWTEXTOBJ (FTEXTOBJ NEWSTREAM))) (* ;
 "Create an empty textstream into which the pieces can be hammered")
[SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS]
(SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM))
(for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
do (SETQ NEWPC (\TEDIT.COPYPIECE PC TEXTOBJ NEWTEXTOBJ NIL 'COPY))
(CL:UNLESS NEWPC
(CL:IF (EQ OBJECT.PTYPE (PTYPE PC))
(ERROR "Image object does not allow copying" (POBJ PC))
(ERROR "Piece cannot be copied " PC)))
(\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
(FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
(FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
(FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
(FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
(FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
(FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
(FSETTOBJ NEWTEXTOBJ TXTPAGEFRAMES (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
(FSETTOBJ NEWTEXTOBJ TXTPARALOOKSLIST (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST))
(FSETTOBJ NEWTEXTOBJ TXTCHARLOOKSLIST (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST))
(FSETTOBJ NEWTEXTOBJ MENUFLG (FGETTOBJ TEXTOBJ MENUFLG))
NEWSTREAM])
(for PC NEWPC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ)
do (SETQ NEWPC (\TEDIT.COPYPIECE PC TSTREAM NEWSTREAM NIL 'COPY))
(CL:UNLESS NEWPC
(CL:IF (EQ OBJECT.PTYPE (PTYPE PC))
(ERROR "Image object does not allow copying" (POBJ PC))
(ERROR "Piece cannot be copied " PC)))
(\TEDIT.INSERTPIECE NEWPC NIL NEWTEXTOBJ))
(FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP))
(FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))
(FSETTOBJ NEWTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ TEXTOBJ DEFAULTPARALOOKS))
(FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL))
(FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL))
(FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET))
(FSETTOBJ NEWTEXTOBJ TXTPAGEFRAMES (FGETTOBJ TEXTOBJ TXTPAGEFRAMES))
(FSETTOBJ NEWTEXTOBJ TXTPARALOOKSLIST (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST))
(FSETTOBJ NEWTEXTOBJ TXTCHARLOOKSLIST (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST))
(FSETTOBJ NEWTEXTOBJ MENUFLG (FGETTOBJ TEXTOBJ MENUFLG))
NEWSTREAM])
(TEDIT.STREAMCHANGEDP
[LAMBDA (STREAM RESET?) (* ; "Edited 31-May-91 13:57 by jds")
@@ -1445,7 +1451,10 @@
TSTREAM])
(\TEDIT.OPENTEXTSTREAM.PIECES
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 26-Sep-2024 22:27 by rmk")
[LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 29-May-2025 19:02 by rmk")
(* ; "Edited 26-Apr-2025 12:59 by rmk")
(* ; "Edited 24-Apr-2025 17:09 by rmk")
(* ; "Edited 26-Sep-2024 22:27 by rmk")
(* ; "Edited 20-Mar-2024 10:58 by rmk")
(* ; "Edited 27-Dec-2023 13:33 by rmk")
(* ; "Edited 23-Oct-2023 13:47 by rmk")
@@ -1494,6 +1503,9 @@
elseif (\TEDIT.GET.FORMATTED.FILE TEXT TSTREAM START END PROPS)
elseif (\TEDIT.GET.FOREIGN.FILE TEXT TSTREAM START END PROPS)
else (\TEDIT.GET.UNFORMATTED.FILE TEXT TSTREAM START END))
(CL:WHEN NIL
(EQ :XCCS (STREAMPROP TEXT 'FORMAT)) (* ; "XCCS was read as MCCS")
(\TEDIT.CONVERT.MCCSTOXCCS TSTREAM))
(FSETTOBJ TEXTOBJ TXTREADONLY READONLY)
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
@@ -1518,7 +1530,9 @@
(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ])
(\TEDIT.OPENTEXTSTREAM.SETUP.SEL
[LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 08:56 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 21-Apr-2025 20:14 by rmk")
(* ; "Edited 6-Apr-2025 14:24 by rmk")
(* ; "Edited 17-Feb-2025 08:56 by rmk")
(* ; "Edited 25-Nov-2024 14:33 by rmk")
(* ; "Edited 20-Nov-2024 23:56 by rmk")
(* ; "Edited 29-Sep-2024 10:51 by rmk")
@@ -1537,13 +1551,13 @@
(* ;; "This sets up the initial SEL for TEXTOBJ according to the SEL PROPS entry. If SELPROP is NIL, the default is 1-0-LEFT--just before the first character. This doesn't show the selection--this stream may not yet have a window.")
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(SEL (TEXTSEL TEXTOBJ))
SELPROP)
(CL:UNLESS (AND SEL (GETSEL SEL SET))
(SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL))
(FSETSEL SEL SET T)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(CL:UNLESS (EQ SELPROP 'DON'T)
(FSETSEL SEL SELKIND 'CHAR) (* ; "Default, maybe reset below")
(if (type? SELECTION SELPROP)
@@ -1554,12 +1568,12 @@
then
(* ;; "Default to POINT selection")
(FSETSEL SEL SELKIND 'CHAR)
(\TEDIT.UPDATE.SEL SEL (CAR SELPROP)
(OR (CADR SELPROP)
0)
(OR (CADDR SELPROP)
'LEFT))
(FSETSEL SEL SELKIND 'CHAR)
elseif (FIXP SELPROP)
then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT)
elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY)
@@ -1585,12 +1599,14 @@
(* ;
 "Don't blink for read-only, but do highlighting")
(FSETSEL SEL HASCARET NIL))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ)))
(\TEDIT.SHOWSEL SEL T TSTREAM)))
SEL])
(\TEDIT.OPENTEXTSTREAM.WINDOW
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 21-Nov-2024 00:18 by rmk")
[LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 21-Apr-2025 20:14 by rmk")
(* ; "Edited 6-Apr-2025 14:25 by rmk")
(* ; "Edited 5-Apr-2025 13:10 by rmk")
(* ; "Edited 21-Nov-2024 00:18 by rmk")
(* ; "Edited 1-Sep-2024 09:06 by rmk")
(* ; "Edited 28-Jun-2024 23:06 by rmk")
(* ; "Edited 16-Jun-2024 15:40 by rmk")
@@ -1605,16 +1621,12 @@
(* ;; "Associates WINDOW with TSTREAM. Brute force, doesn't let this window stuff change the fileptr. Maybe should unsplit all panes if WINDOW is split.")
(LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
(FILEPTR (\TEDIT.TEXTGETFILEPTR TSTREAM)))
[if WINDOW
then (\TEDIT.WINDOW.SETUP WINDOW TSTREAM PROPS)
(\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL)
NIL TEXTOBJ)
(\TEDIT.FIXSEL (FGETTOBJ TEXTOBJ SEL)
TEXTOBJ)
(\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL)
T TEXTOBJ)
(\TEDIT.NOSEL TSTREAM)
(\TEDIT.SHOWSEL NIL T TSTREAM)
(CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
(for PANE inpanes TEXTOBJ do (\TEDIT.UPCARET (GETPANEPROP (PANEPROPS PANE)
PCARET))))
@@ -1754,7 +1766,8 @@
NEWSTREAM])
(\TEDIT.TEXTINIT
[LAMBDA NIL (* ; "Edited 4-Sep-2024 22:05 by rmk")
[LAMBDA NIL (* ; "Edited 15-Apr-2025 23:10 by rmk")
(* ; "Edited 4-Sep-2024 22:05 by rmk")
(* ; "Edited 22-May-2024 14:53 by rmk")
(* ; "Edited 19-Mar-2024 18:16 by rmk")
(* ; "Edited 17-Mar-2024 12:25 by rmk")
@@ -1788,7 +1801,7 @@
(* ;; "(FW8 WORD)")
[SETQ \TEXTIMAGEOPS (create IMAGEOPS
(SETQ \TEXTIMAGEOPS (create IMAGEOPS
IMAGETYPE _ 'TEXT
IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION)
IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION)
@@ -1800,7 +1813,8 @@
IMLINEFEED _ (FUNCTION \TEDIT.TEXTDSPLINEFEED)
IMCHARWIDTH _ (FUNCTION \TEDIT.TEXTDSPCHARWIDTH)
IMSTRINGWIDTH _ (FUNCTION \TEDIT.TEXTDSPSTRINGWIDTH)
IMSCALE _ (FUNCTION (LAMBDA NIL 1]
IMSCALE _ [FUNCTION (LAMBDA NIL 1]
IMCOLOR _ (FUNCTION \TEDIT.TEXTCOLOR)))
(FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY)
(ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT)
(FONTSAVAILABLE \SEARCHDISPLAYFONTFILES)
@@ -1965,15 +1979,17 @@
TEXTLEN])
(\TEDIT.TEXTSETEOFPTR
[LAMBDA (TSTREAM LEN) (* ; "Edited 25-Nov-2024 20:13 by rmk")
[LAMBDA (TSTREAM LEN) (* ; "Edited 20-Apr-2025 23:44 by rmk")
(* ; "Edited 6-Apr-2025 12:29 by rmk")
(* ; "Edited 25-Nov-2024 20:13 by rmk")
(* ; "Edited 7-Jul-2024 11:43 by rmk")
(* ; "Edited 23-May-2024 08:33 by rmk")
(* ;; "Eliminate all trailing bytes so the file contains the first LEN characters")
(LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN))
(SEL (FGETTOBJ TEXTOBJ SEL))
(LET* ((TEXTOBJ (FTEXTOBJ TSTREAM))
(TEXTLEN (TEXTLEN TEXTOBJ))
(SEL (TEXTSEL TEXTOBJ))
(TAILSEL (\TEDIT.COPYSEL SEL)))
(CL:UNLESS (IGEQ LEN TEXTLEN)
(RESETLST
@@ -1982,8 +1998,8 @@
(FSETTOBJ TEXTOBJ TXTAPPENDONLY NIL)
(\TEDIT.UPDATE.SEL TAILSEL (ADD1 LEN)
(IDIFFERENCE TEXTLEN LEN))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.DELETE TEXTOBJ TAILSEL)))])
(\TEDIT.FIXSEL SEL TSTREAM)
(\TEDIT.DELETE TSTREAM TAILSEL)))])
(\TEDIT.TEXTGETFILEPTR
[LAMBDA (TSTREAM) (* ; "Edited 7-Feb-2025 08:12 by rmk")
@@ -2063,7 +2079,8 @@
(replace (STREAM EOFFSET) of TSTREAM with (fetch (BYTEPTR OFFSET) of EOFPTR])
(\TEDIT.TEXTSETFILEPTR
[LAMBDA (TSTREAM FILEPOS) (* ; "Edited 20-Mar-2024 10:58 by rmk")
[LAMBDA (TSTREAM FILEPOS) (* ; "Edited 20-Apr-2025 00:02 by rmk")
(* ; "Edited 20-Mar-2024 10:58 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
(* ; "Edited 23-Dec-2023 12:14 by rmk")
(* ; "Edited 22-Oct-2023 16:14 by rmk")
@@ -2075,7 +2092,7 @@
(* ;; "FILEPOS is known to be a positive number. For other filedevices there is no error if the ptr is set beyond the EOF, and GETFILEPTR will return the new position. But the length of an input file doesn't change and a BIN at any position after the EOF causes the error. An output file grows. Filepos is a %"byte%" position, have to add 1 to get to the notion of character in a Tedit selection.")
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
START-OF-PIECE PC CH#)
(DECLARE (SPECVARS START-OF-PIECE))
(CL:WHEN (IGREATERP FILEPOS (FGETTOBJ TEXTOBJ TEXTLEN))
@@ -2128,8 +2145,21 @@
DEFAULTPARALOOKS)
LEFTMAR])
(\TEDIT.TEXTCOLOR
[LAMBDA (TSTREAM VALUE) (* ; "Edited 22-Apr-2025 15:48 by rmk")
(* ; "Edited 15-Apr-2025 16:59 by rmk")
(* ;; "Changes the caret looks, not the document")
(LET ((CARETLOOKS (FGETTOBJ (FTEXTOBJ TSTREAM)
CARETLOOKS)))
(PROG1 (FGETCLOOKS CARETLOOKS CLCOLOR)
(CL:WHEN (AND VALUE (NEQ VALUE (FGETCLOOKS CARETLOOKS CLCOLOR)))
[TEDIT.CARETLOOKS TSTREAM `(COLOR ,VALUE]))])
(\TEDIT.TEXTRIGHTMARGIN
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 19-Feb-2025 13:39 by rmk")
[LAMBDA (TSTREAM XPOSITION) (* ; "Edited 19-Apr-2025 22:24 by rmk")
(* ; "Edited 19-Feb-2025 13:39 by rmk")
(* ; "Edited 8-Feb-2025 22:35 by rmk")
(* ; "Edited 28-Jun-2024 22:07 by rmk")
(* ; "Edited 21-Sep-2023 12:38 by rmk")
@@ -2151,7 +2181,7 @@
(RIGHTMAR (FGETPLOOKS PARALOOKS RIGHTMAR))
LEFTMAR NEWPOS)
(CL:WHEN (ZEROP RIGHTMAR)
(SETQ RIGHTMAR (FGETTOBJ TEXTOBJ WRIGHT)))
(SETQ RIGHTMAR (PANERIGHT (FGETTOBJ TEXTOBJ PRIMARYPANE))))
(CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR))
(* ; "Changing the default PARALOOKS")
(SETQ LEFTMAR (FGETPLOOKS PARALOOKS LEFTMAR))
@@ -2204,7 +2234,8 @@
(DEFINEQ
(\TEDIT.NTHCHARCODE
[LAMBDA (TSTREAM N) (* ; "Edited 28-Mar-2025 18:31 by rmk")
[LAMBDA (TSTREAM N) (* ; "Edited 24-Apr-2025 16:03 by rmk")
(* ; "Edited 28-Mar-2025 18:31 by rmk")
(* ; "Edited 7-Jul-2024 11:09 by rmk")
(* ; "Edited 29-Apr-2024 13:06 by rmk")
(* ; "Edited 17-Mar-2024 00:27 by rmk")
@@ -2219,12 +2250,13 @@
(DECLARE (SPECVARS START-OF-PIECE))
(CL:WHEN (AND (IGEQ N 1)
(ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN)))
(\TEDIT.PIECE.NTHCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
(\TEDIT.PIECE.NTHCHARCODE (\TEDIT.CHTOPC N TEXTOBJ T)
(IDIFFERENCE (ADD1 N)
START-OF-PIECE)))])
(\TEDIT.PIECE.NTHCHARCODE
[LAMBDA (TEXTOBJ PC OFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk")
[LAMBDA (PC OFFSET) (* ; "Edited 24-Apr-2025 16:04 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 29-Apr-2024 08:46 by rmk")
(* ; "Edited 22-Mar-2024 00:02 by rmk")
(* ; "Edited 1-Feb-2024 09:55 by rmk")
@@ -2280,105 +2312,128 @@
(\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])])
(\TEDIT.RPLCHARCODE
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 28-Mar-2025 10:04 by rmk")
[LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:24 by rmk")
(* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 10:04 by rmk")
(* ;; "Replaces the Nth charcode (or object) in TSTREAM with NEWCHARCODE (or object) with NEWCHARLOOKS. This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.")
(* ;; "Replaces the Nth charcode (or object) in TSTREAM with NEWCHARCODE (or object) with NEWCHARLOOKS. ")
(* ;; "If DONTDISPLAY, this doesn't update the display. ")
(* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
(PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ)))
PC OFFSET START-OF-PIECE OLDCHAR PARALAST)
(DECLARE (SPECVARS START-OF-PIECE))
(replace (STREAM BINABLE) of TSTREAM with NIL)
(SETQ PC (\TEDIT.CHTOPC N TEXTOBJ T))
(SETQ OFFSET (ADD1 (IDIFFERENCE N START-OF-PIECE)))
(* ; "Change is at OFFSET 1")
(SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
[if (AND (SMALLP NEWCHARCODE)
(MEMB (PTYPE PC)
STRING.PTYPES)
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC)))
(NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
(NOT PARALAST))
then
(* ;;
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
START-OF-PIECE OLDCHAR)
(DECLARE (SPECVARS START-OF-PIECE))
(replace (STREAM BINABLE) of TSTREAM with NIL)
(SETQ OLDCHAR (\TEDIT.PIECE.RPLCHARCODE TEXTOBJ (\TEDIT.CHTOPC N TEXTOBJ T)
(ADD1 (IDIFFERENCE N START-OF-PIECE))
NEWCHARCODE NEWCHARLOOKS))
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
OLDCHAR))
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
(\TEDIT.UPDATE.LINES TSTREAM 'CHANGED N 1))
TSTREAM))])
(\TEDIT.PIECE.RPLCHARCODE
[LAMBDA (TEXTOBJ PC OFFSET NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 24-Apr-2025 16:30 by rmk")
(* ; "Edited 20-Apr-2025 13:25 by rmk")
(* ; "Edited 28-Mar-2025 10:04 by rmk")
(* ;; "Replaces the charcode (or object) at OFFSET in PC with NEWCHARCODE (or object) with NEWCHARLOOKS. This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.")
(* ;; "Returns OLDCHAR so caller and update history")
(* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.")
(LET (OLDCHAR PARALAST)
(SETQ PARALAST (MEMB NEWCHARCODE (FGETTOBJ TEXTOBJ PARABREAKCHARS)))
[if (AND (SMALLP NEWCHARCODE)
(MEMB (PTYPE PC)
STRING.PTYPES)
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC)))
(NEQ PC (FGETTOBJ TEXTOBJ SUFFIXPIECE))
(NOT PARALAST))
then
(* ;;
 "Fast case: Smash a new character code into an existing string piece with same looks. ")
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
OFFSET))
(RPLCHARCODE (PCONTENTS PC)
OFFSET NEWCHARCODE) (* ;
(SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC)
OFFSET))
(RPLCHARCODE (PCONTENTS PC)
OFFSET NEWCHARCODE) (* ;
 "May upgrade string from thin to fat")
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
(IGREATERP NEWCHARCODE 255))
(FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
(FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
2)))
elseif [AND (IMAGEOBJP NEWCHARCODE)
(EQ OBJECT.PTYPE (PTYPE PC))
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC]
then (SETQ OLDCHAR (POBJ PC)) (* ; "We know PLEN is 1")
(FSETPC PC PCONTENTS NEWCHARCODE)
else
(* ;;
 "The PC that contained character N becomes the suffix of characters after N, ")
(CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC))
(IGREATERP NEWCHARCODE 255))
(FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
(FSETPC PC PBYTELEN (UNFOLD (PLEN PC)
2)))
elseif [AND (IMAGEOBJP NEWCHARCODE)
(EQ OBJECT.PTYPE (PTYPE PC))
(OR (NULL NEWCHARLOOKS)
(EQ NEWCHARLOOKS (PLOOKS PC]
then (SETQ OLDCHAR (POBJ PC)) (* ; "We know PLEN is 1")
(FSETPC PC PCONTENTS NEWCHARCODE)
else
(* ;;
 "PC contained character OFFSET now becomes the suffix of characters after offset.")
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
(CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character")
(* ;;
(* ;;
 "Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece")
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
(SETQ PC (PREVPIECE PC))) (* ;
(\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ)
(SETQ PC (PREVPIECE PC))) (* ;
 "Original PC holds the suffix, new PC ends with change position.")
(CL:UNLESS (EQ OFFSET 1)
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
TEXTOBJ))) (* ;
(CL:UNLESS (EQ OFFSET 1)
(SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET)
TEXTOBJ))) (* ;
 "Chop off the prefix. PC is now the singleton target ")
(* ;; "N is now isolated into a one-character new piece which we smash. ")
(* ;; "OFFSET is now isolated into a one-character new piece which we smash. ")
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC 1))
(if (IMAGEOBJP NEWCHARCODE)
then (FSETPC PC PBINABLE NIL)
(FSETPC PC PCONTENTS NEWCHARCODE)
(FSETPC PC PTYPE OBJECT.PTYPE)
(FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects")
(FSETPC PC PBYTELEN NIL)
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
(SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE PC 1))
(if (IMAGEOBJP NEWCHARCODE)
then (FSETPC PC PBINABLE NIL)
(FSETPC PC PCONTENTS NEWCHARCODE)
(FSETPC PC PTYPE OBJECT.PTYPE)
(FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects")
(FSETPC PC PBYTELEN NIL)
else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE)))
(* ;
 "Use the extend-string in INSERTCH for repeated calls?")
(if (IGREATERP NEWCHARCODE 255)
then (FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
(FSETPC PC PBYTELEN 2)
else (FSETPC PC PTYPE THINSTRING.PTYPE)
(FSETPC PC PBINABLE T)
(FSETPC PC PBYTESPERCHAR 1)
(FSETPC PC PBYTELEN 1)
(FSETPC PC PCHARSET 0)))
(FSETPC PC PFPOS NIL)
(CL:WHEN NEWCHARLOOKS
(FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
NEWCHARLOOKS)
TEXTOBJ)
NEWCHARLOOKS)))]
(CL:WHEN PARALAST (FSETPC PC PPARALAST T))
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL
OLDCHAR))
(CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ)))
(\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED N 1))
(RETURN TSTREAM)))])
(if (IGREATERP NEWCHARCODE 255)
then (FSETPC PC PTYPE FATSTRING.PTYPE)
(FSETPC PC PBINABLE NIL)
(FSETPC PC PBYTESPERCHAR 2)
(FSETPC PC PBYTELEN 2)
else (FSETPC PC PTYPE THINSTRING.PTYPE)
(FSETPC PC PBINABLE T)
(FSETPC PC PBYTESPERCHAR 1)
(FSETPC PC PBYTELEN 1)
(FSETPC PC PCHARSET 0)))
(FSETPC PC PFPOS NIL)
(CL:WHEN NEWCHARLOOKS
(FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS)
(\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
NEWCHARLOOKS)
TEXTOBJ)
NEWCHARLOOKS)))]
(CL:WHEN PARALAST (FSETPC PC PPARALAST T))
OLDCHAR])
(\TEDIT.NTHCHARLOOKS
[LAMBDA (TSTREAM N) (* ; "Edited 6-Apr-2025 23:36 by rmk")
(* ; "Edited 4-Apr-2025 11:11 by rmk")
(* ;; "Returns the charlooks of character N")
(PCHARLOOKS (\TEDIT.CHTOPC N (FTEXTOBJ TSTREAM])
)
@@ -2413,7 +2468,8 @@
(DEFINEQ
(\TEDIT.DELETE.SELPIECES
[LAMBDA (TEXTOBJ FIRSTCHAR LEN DONTCHECK) (* ; "Edited 5-Feb-2025 23:33 by rmk")
[LAMBDA (TSTREAM FIRSTCHAR LEN DONTCHECK) (* ; "Edited 22-Apr-2025 09:17 by rmk")
(* ; "Edited 5-Feb-2025 23:33 by rmk")
(* ; "Edited 26-Nov-2024 22:31 by rmk")
(* ; "Edited 22-Sep-2024 18:34 by rmk")
(* ; "Edited 7-Jul-2024 09:09 by rmk")
@@ -2431,36 +2487,37 @@
(CL:UNLESS LEN
(SETQ LEN (FGETSEL FIRSTCHAR DCH)))
(SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#)))
(CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
(\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'START TEXTOBJ)
(LET (SELPIECES PREVPC)
(CL:WHEN [AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
TEXTOBJ))
(OR DONTCHECK (for PC inselpieces (PROGN SELPIECES)
always (OBJECT.ALLOWS PC 'DELETE TEXTOBJ]
(SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
(\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)
(LET ((TEXTOBJ (FTEXTOBJ TSTREAM))
SELPIECES PREVPC)
(CL:WHEN [AND (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))
(SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1)
TEXTOBJ))
(OR DONTCHECK (for PC inselpieces (PROGN SELPIECES)
always (OR (NEQ OBJECT.PTYPE (PTYPE PC))
(\TEDIT.APPLY.OBJFN (PCONTENTS PC)
'DELETE TSTREAM]
(SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST)))
(\TEDIT.DELETEPIECES SELPIECES TEXTOBJ)
(* ;; "If the the effect of the deletion is to concatenate a (non-empty) prefix of one paragraph with a (non-empty) suffix of another, propagate the prefix PARALOOKS all the way through to the end of the newly combined paragraph. All the pieces of a paragraph must have the same PARALOOKS.")
(* ;; "If the the effect of the deletion is to concatenate a (non-empty) prefix of one paragraph with a (non-empty) suffix of another, propagate the prefix PARALOOKS all the way through to the end of the newly combined paragraph. All the pieces of a paragraph must have the same PARALOOKS.")
(CL:WHEN (AND PREVPC (NOT (PPARALAST PREVPC)))
(* ; "Retained a non-empty prefix")
(for PC (PARALOOKS _ (PPARALOOKS PREVPC)) inpieces (NEXTPIECE PREVPC)
do
(* ;;
 "(NEXTPIECE PREVPC) is the first retained piece linked in after the deletion")
(CL:WHEN (AND PREVPC (NOT (PPARALAST PREVPC))) (* ; "Retained a non-empty prefix")
(for PC (PARALOOKS _ (PPARALOOKS PREVPC)) inpieces (NEXTPIECE PREVPC)
do
(* ;;
 "(NEXTPIECE PREVPC) is the first retained piece linked in after the deletion")
(FSETPC PC PPARALOOKS PARALOOKS) repeatuntil (PPARALAST PC)))
(\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'END TEXTOBJ)
(FSETPC PC PPARALOOKS PARALOOKS) repeatuntil (PPARALAST PC)))
(\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'END TEXTOBJ)
(* ;; "")
(* ;; "")
(* ;; "The pieces are now properly linked with the proper looks. SELPIECE holds the deleted pieces needed for undoing.")
(* ;; "The pieces are now properly linked with the proper looks. SELPIECE holds the deleted pieces needed for undoing.")
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Delete FIRSTCHAR
(FGETSPC SELPIECES SPLEN)
NIL NIL NIL SELPIECES))
T)))])
(\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Delete FIRSTCHAR
(FGETSPC SELPIECES SPLEN)
NIL NIL NIL SELPIECES))
T)])
(\TEDIT.INSERTCH
[LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 26-Mar-2025 00:29 by rmk")
@@ -2903,6 +2960,12 @@
T
(CADR PTAIL])
(TEXTPROP.ADD
[LAMBDA (TSTREAM PROP NEWITEM) (* ; "Edited 17-Apr-2025 13:24 by rmk")
(LET ((OLDITEMS (GETTEXTPROP TSTREAM PROP)))
(PUTTEXTPROP TSTREAM PROP (CONS NEWITEM OLDITEMS))
OLDITEMS])
(\TEDIT.TEXTPROP
[LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 16-Feb-2025 23:27 by rmk")
(* ; "Edited 15-Feb-2025 14:02 by rmk")
@@ -3069,32 +3132,34 @@
(ADDTOVAR LAMA TEXTPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (37315 68029 (\TEDIT.TEXTBIN 37325 . 48075) (\TEDIT.TEXTPEEKBIN 48077 . 53627) (
\TEDIT.TEXTBACKFILEPTR 53629 . 59302) (\TEDIT.TEXTBOUT 59304 . 63819) (\TEDIT.INSTALL.FILEBUFFER 63821
. 68027)) (68927 72975 (\TEDIT.TEXTOUTCHARFN 68937 . 70493) (\TEDIT.TEXTINCCODEFN 70495 . 71234) (
\TEDIT.TEXTBACKCCODEFN 71236 . 71828) (\TEDIT.TEXTFORMATBYTESTREAM 71830 . 72533) (
\TEDIT.TEXTFORMATBYTESTRING 72535 . 72973)) (73022 84543 (OPENTEXTSTREAM 73032 . 79984) (
COPYTEXTSTREAM 79986 . 83766) (TEDIT.STREAMCHANGEDP 83768 . 84070) (TXTFILE 84072 . 84541)) (84544
114404 (\TEDIT.REOPENTEXTSTREAM 84554 . 85906) (\TEDIT.OPENTEXTSTREAM.PIECES 85908 . 90338) (
\TEDIT.OPENTEXTSTREAM.PROPS 90340 . 91442) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91444 . 96530) (
\TEDIT.OPENTEXTSTREAM.WINDOW 96532 . 99213) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 99215 . 102185) (
\TEDIT.OPENTEXTFILE 102187 . 103900) (\TEDIT.CREATE.TEXTSTREAM 103902 . 104947) (\TEDIT.REOPEN.STREAM
104949 . 107285) (\TEDIT.TEXTINIT 107287 . 114402)) (114442 115630 (\TEDIT.TTYBOUT 114452 . 115628)) (
115748 134540 (\TEDIT.TEXTCLOSEF 115758 . 117082) (\TEDIT.TEXTDSPFONT 117084 . 118054) (
\TEDIT.TEXTEOFP 118056 . 119811) (\TEDIT.TEXTGETEOFPTR 119813 . 120136) (\TEDIT.TEXTSETEOFPTR 120138
. 121228) (\TEDIT.TEXTGETFILEPTR 121230 . 124065) (\TEDIT.TEXTSETFILEINFO 124067 . 124575) (
\TEDIT.TEXTOPENF 124577 . 125508) (\TEDIT.TEXTSETEOF 125510 . 126126) (\TEDIT.TEXTSETFILEPTR 126128 .
128169) (\TEDIT.TEXTDSPXPOSITION 128171 . 129188) (\TEDIT.TEXTDSPYPOSITION 129190 . 129931) (
\TEDIT.TEXTLEFTMARGIN 129933 . 130524) (\TEDIT.TEXTRIGHTMARGIN 130526 . 133689) (
\TEDIT.TEXTDSPCHARWIDTH 133691 . 133995) (\TEDIT.TEXTDSPSTRINGWIDTH 133997 . 134303) (
\TEDIT.TEXTDSPLINEFEED 134305 . 134538)) (134578 145928 (\TEDIT.NTHCHARCODE 134588 . 135938) (
\TEDIT.PIECE.NTHCHARCODE 135940 . 139741) (\TEDIT.RPLCHARCODE 139743 . 145926)) (146975 167848 (
\TEDIT.DELETE.SELPIECES 146985 . 150498) (\TEDIT.INSERTCH 150500 . 158430) (\TEDIT.INSERTCH.HISTORY
158432 . 161896) (\TEDIT.INSERTEOL 161898 . 163723) (\TEDIT.INSERTCH.INSERTION 163725 . 166562) (
\TEDIT.INSERTCH.EXTEND 166564 . 167846)) (167849 169353 (\TEDIT.NEXTCHANGEABLE.CHNO 167859 . 168574) (
\TEDIT.LASTCHANGEABLE.CHNO 168576 . 169351)) (169354 171058 (\SETUPGETCH 169364 . 171056)) (171116
175574 (\TEDIT.INSTALL.PIECE 171126 . 175572)) (175612 184361 (TEXTPROP 175622 . 175969) (GETTEXTPROP
175971 . 176215) (PUTTEXTPROP 176217 . 176474) (GETTEXTPROPS 176476 . 176920) (PUTTEXTPROPS 176922 .
177826) (\TEDIT.TEXTPROP 177828 . 184359)) (184362 186432 (\TEDIT.TEXTOBJ.PROPNAMES 184372 . 185324) (
\TEDIT.TEXTOBJ.PROPFETCHFN 185326 . 185842) (\TEDIT.TEXTOBJ.PROPSTOREFN 185844 . 186430)))))
(FILEMAP (NIL (37559 68375 (\TEDIT.TEXTBIN 37569 . 48319) (\TEDIT.TEXTPEEKBIN 48321 . 53871) (
\TEDIT.TEXTBACKFILEPTR 53873 . 59546) (\TEDIT.TEXTBOUT 59548 . 64165) (\TEDIT.INSTALL.FILEBUFFER 64167
. 68373)) (69273 73564 (\TEDIT.TEXTOUTCHARFN 69283 . 70839) (\TEDIT.TEXTINCCODEFN 70841 . 71580) (
\TEDIT.TEXTBACKCCODEFN 71582 . 72174) (\TEDIT.TEXTFORMATBYTESTREAM 72176 . 73013) (
\TEDIT.TEXTFORMATBYTESTRING 73015 . 73562)) (73611 85252 (OPENTEXTSTREAM 73621 . 80573) (
COPYTEXTSTREAM 80575 . 84475) (TEDIT.STREAMCHANGEDP 84477 . 84779) (TXTFILE 84781 . 85250)) (85253
116062 (\TEDIT.REOPENTEXTSTREAM 85263 . 86615) (\TEDIT.OPENTEXTSTREAM.PIECES 86617 . 91551) (
\TEDIT.OPENTEXTSTREAM.PROPS 91553 . 92655) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92657 . 97898) (
\TEDIT.OPENTEXTSTREAM.WINDOW 97900 . 100691) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100693 . 103663) (
\TEDIT.OPENTEXTFILE 103665 . 105378) (\TEDIT.CREATE.TEXTSTREAM 105380 . 106425) (\TEDIT.REOPEN.STREAM
106427 . 108763) (\TEDIT.TEXTINIT 108765 . 116060)) (116100 117288 (\TEDIT.TTYBOUT 116110 . 117286)) (
117406 137175 (\TEDIT.TEXTCLOSEF 117416 . 118740) (\TEDIT.TEXTDSPFONT 118742 . 119712) (
\TEDIT.TEXTEOFP 119714 . 121469) (\TEDIT.TEXTGETEOFPTR 121471 . 121794) (\TEDIT.TEXTSETEOFPTR 121796
. 123083) (\TEDIT.TEXTGETFILEPTR 123085 . 125920) (\TEDIT.TEXTSETFILEINFO 125922 . 126430) (
\TEDIT.TEXTOPENF 126432 . 127363) (\TEDIT.TEXTSETEOF 127365 . 127981) (\TEDIT.TEXTSETFILEPTR 127983 .
130093) (\TEDIT.TEXTDSPXPOSITION 130095 . 131112) (\TEDIT.TEXTDSPYPOSITION 131114 . 131855) (
\TEDIT.TEXTLEFTMARGIN 131857 . 132448) (\TEDIT.TEXTCOLOR 132450 . 133033) (\TEDIT.TEXTRIGHTMARGIN
133035 . 136324) (\TEDIT.TEXTDSPCHARWIDTH 136326 . 136630) (\TEDIT.TEXTDSPSTRINGWIDTH 136632 . 136938)
(\TEDIT.TEXTDSPLINEFEED 136940 . 137173)) (137213 149689 (\TEDIT.NTHCHARCODE 137223 . 138674) (
\TEDIT.PIECE.NTHCHARCODE 138676 . 142586) (\TEDIT.RPLCHARCODE 142588 . 144046) (
\TEDIT.PIECE.RPLCHARCODE 144048 . 149334) (\TEDIT.NTHCHARLOOKS 149336 . 149687)) (150736 171721 (
\TEDIT.DELETE.SELPIECES 150746 . 154371) (\TEDIT.INSERTCH 154373 . 162303) (\TEDIT.INSERTCH.HISTORY
162305 . 165769) (\TEDIT.INSERTEOL 165771 . 167596) (\TEDIT.INSERTCH.INSERTION 167598 . 170435) (
\TEDIT.INSERTCH.EXTEND 170437 . 171719)) (171722 173226 (\TEDIT.NEXTCHANGEABLE.CHNO 171732 . 172447) (
\TEDIT.LASTCHANGEABLE.CHNO 172449 . 173224)) (173227 174931 (\SETUPGETCH 173237 . 174929)) (174989
179447 (\TEDIT.INSTALL.PIECE 174999 . 179445)) (179485 188499 (TEXTPROP 179495 . 179842) (GETTEXTPROP
179844 . 180088) (PUTTEXTPROP 180090 . 180347) (GETTEXTPROPS 180349 . 180793) (PUTTEXTPROPS 180795 .
181699) (TEXTPROP.ADD 181701 . 181964) (\TEDIT.TEXTPROP 181966 . 188497)) (188500 190570 (
\TEDIT.TEXTOBJ.PROPNAMES 188510 . 189462) (\TEDIT.TEXTOBJ.PROPFETCHFN 189464 . 189980) (
\TEDIT.TEXTOBJ.PROPSTOREFN 189982 . 190568)))))
STOP

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

Binary file not shown.

772
library/tedit/TEDIT-STRESS
View File

@@ -1,20 +1,36 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71 15583
(FILECREATED "29-Jun-2025 21:59:18" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-STRESS.;125 42815
:EDIT-BY rmk
:CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
:CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSFORMAT STRESSSCROLL
STRESSDELETE STRESSDELETEWINDOW STRESSINSERTWINDOW STRESSGREP STRESSPEEK
STRESSINSERT STRESS-SETUP STRESS-SYSOUT SYSOUTRING STRESSDISPLAY)
(VARS TEDIT-STRESSCOMS)
:PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
:PREVIOUS-DATE "26-Jun-2025 20:58:11" {WMEDLEY}<library>tedit>TEDIT-STRESS.;120)
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
(RPAQQ TEDIT-STRESSCOMS ( (* ; "Preload typical image objects")
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSGREP
STRESSPEEK)
(FNS EQTEXTSTREAM SYSOUTRING COPYTOCORE)))
(RPAQQ TEDIT-STRESSCOMS
( (* ; "Preload typical image objects")
(FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSFORMAT STRESSDISPLAY
STRESSSCROLL STRESSDELETE STRESSDELETEWINDOW STRESSINSERT STRESSINSERTWINDOW STRESSGREP
STRESSPEEK)
(FNS STRESS-SETUP STRESS-SYSOUT STRESS-AFTERSYSOUT SYSOUTRING SYSOUTNAME SYSOUTRING
SYSOUTNAME)
(FNS EQTEXTSTREAM COPYTOCORE CHECKARRAYS SAVERANDSTATE)
(INITVARS (CHECKARRAYS NIL)
(USELASTRANDSTATE NIL)
(SYSOUTLEVEL NIL)
(NSYSOUTS 0))
(VARS (ARRAYBLOCKCHECKING T))
(APPENDVARS (AFTERSYSOUTFORMS (STRESS-AFTERSYSOUT)))
(FILES TEDIT-DEBUG)
(MACROS STRESS)))
@@ -23,7 +39,9 @@
(DEFINEQ
(STRESSHC
[LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
[LAMBDA (FILES REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
(* ; "Edited 29-Jun-2025 21:58 by rmk")
(* ; "Edited 2-Jun-2025 21:27 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 19-Mar-2024 21:33 by rmk")
(* ; "Edited 14-Mar-2024 15:15 by rmk")
@@ -32,11 +50,8 @@
(* ;; "If all arguments are defaulted, runs through all TEDIT files in the current directory until it fails, doing SAVEVM before each file. The HC files are made as {CORE}FOO.PS.")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ FILES (STRESS-SETUP FILES 'STRESSHC))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(CL:UNLESS NSYSOUTS
(SETQ NSYSOUTS 'SAVEVM))
[SETQ SYSOUTNAME (PACKFILENAME 'VERSION NIL 'BODY (OR SYSOUTNAME (PACKFILENAME 'DIRECTORY
MEDLEYDIR 'NAME
"STRESSHC" 'EXTENSION
@@ -56,189 +71,559 @@
(for R SYSOUTS (ITYPE _ (CL:IF PDF
'pdf
'ps))
(N _ 0) from 1 to REPS
do (PRINTOUT T "Rep " R T)
(if (EQ NSYSOUTS 'SAVEVM)
then (SAVEVM)
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
[for F 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 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? TSTRM)
(CL:WHEN SINGLESTEP
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
(PRINTOUT T " Hardcopied " N " files without failure" T)
(N _ 0) from 1 to REPS do (PRINTOUT T "Rep " R T)
(if (EQ NSYSOUTS 'SAVEVM)
then (SAVEVM)
else (SETQ SYSOUTS (SYSOUTRING NSYSOUTS SYSOUTNAME SYSOUTS)))
[for F TSTREAM HCFILE in FILES unless (DIRECTORYNAMEP F)
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")))
[STRESS (NOT ERROR)
(SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(TEDIT.FORMAT.HARDCOPY TSTREAM HCFILE T NIL NIL NIL
(CL:IF PDF
'PDF
'POSTSCRIPT)]
(CL:WHEN SINGLESTEP
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE
)))]
(PRINTOUT T " Hardcopied " N " files without failure" T)
finally (RETURN (LIST R N])
(STRESSRAND
[LAMBDA (FILES REPS ERROR PROBESPERFILE) (* ; "Edited 19-Mar-2024 21:33 by rmk")
[LAMBDA (FILES REPS ERROR PROBESPERFILE) (* ; "Edited 29-Jun-2025 21:58 by rmk")
(* ; "Edited 5-Jun-2025 21:10 by rmk")
(* ; "Edited 2-Jun-2025 21:27 by rmk")
(* ; "Edited 31-May-2025 09:10 by rmk")
(* ; "Edited 19-Mar-2024 21:33 by rmk")
(* ; "Edited 12-Mar-2024 09:47 by rmk")
(* ;; "Opens, fetches random characters")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(SETQ FILES (STRESS-SETUP FILES 'STRESSRAND))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(CL:UNLESS PROBESPERFILE (SETQ PROBESPERFILE 100))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files with " PROBESPERFILE " probes per file" T)
(SAVERANDSTATE)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(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 " Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T)) repeatwhile (PROGN (CLOSEF? TSTRM)
T)) finally (RETURN (LIST R N])
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
do (STRESS (NOT ERROR)
(SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(for I (LEN _ (TEDIT.NCHARS TSTREAM)) from 1 to PROBESPERFILE
do (TEDIT.NTHCHARCODE TSTREAM (RAND 1 LEN]
finally (RETURN (LIST R N])
(STRESSPUT
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 29-Jun-2025 21:58 by rmk")
(* ; "Edited 2-Jun-2025 21:28 by rmk")
(* ; "Edited 31-May-2025 09:10 by rmk")
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 19-Mar-2024 21:34 by rmk")
(* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ;; "Opens, puts, reopens and tests for equivalence")
(CL:UNLESS FILES
(SETQ FILES (FILDIR '*.TEDIT;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(SETQ FILES (STRESS-SETUP FILES 'STRESSPUT))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTRM TSP inside FILES
do (if (if NOERROR
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 TSTRM TSP STOP)))
(\TEDIT.THELP "Get of put not equivalent" F))
(CLOSEF TSP))
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 TSTRM TSP STOP)))
(\TEDIT.THELP "Get of put not equivalent" F))
(CLOSEF TSP))
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])
(for F TSTREAM TSP in FILES unless (DIRECTORYNAMEP F)
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(TEDIT.PUT TSTREAM "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTREAM TSP STOP)))
(\TEDIT.THELP "Get of put not equivalent" F))
(CLOSEF TSP))) finally (RETURN (LIST R N])
(STRESSOPEN
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:55 by rmk")
(* ; "Edited 2-Jun-2025 21:28 by rmk")
(* ; "Edited 31-May-2025 09:12 by rmk")
(* ; "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;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(SETQ FILES (STRESS-SETUP FILES 'STRESSOPEN))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(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])
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F]
finally (RETURN (LIST R N])
(STRESSREAD
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 19-Mar-2024 21:34 by rmk")
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
(* ; "Edited 2-Jun-2025 21:28 by rmk")
(* ; "Edited 31-May-2025 09:13 by rmk")
(* ; "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;)))
(SETQ REPS (SELECTQ REPS
(T MAX.SMALLP)
(NIL 1)
REPS))
(SETQ FILES (STRESS-SETUP FILES 'STRESSREAD))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
[for F TSTREAM in FILES unless (DIRECTORYNAMEP F)
do (STRESS NOERROR (SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(for I from 1 while (TEDIT.NTHCHARCODE TSTREAM I]
finally (RETURN (LIST (SUB1 R)
N])
(STRESSFORMAT
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
(* ; "Edited 23-Jun-2025 12:34 by rmk")
(* ; "Edited 2-Jun-2025 21:28 by rmk")
(* ; "Edited 31-May-2025 09:19 by rmk")
(* ; "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")
(* ;; "Calls FORMATLINE from beginning to end of each file")
(SETQ FILES (STRESS-SETUP FILES 'STRESSFORMAT))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R (N _ 0) from 1 to REPS do (PRINTOUT T R " ")
[for F TSTREAM TEXTOBJ in FILES unless (DIRECTORYNAMEP F)
do (SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(STRESS NOERROR (bind LINE (NCHARS _ (TEDIT.NCHARS TSTREAM
))
(CHNO _ 1)
while (ILESSP CHNO NCHARS)
do (CHECKARRAYS 'BEFORE)
(SETQ LINE (\TEDIT.FORMATLINE
TSTREAM CHNO))
(CHECKARRAYS 'AFTER)
(SETQ CHNO (GETLD LINE LCHARLIM]
finally (RETURN (LIST (SUB1 R)
N])
(STRESSDISPLAY
[LAMBDA (FILES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:14 by rmk")
(* ; "Edited 23-Jun-2025 12:34 by rmk")
(* ; "Edited 2-Jun-2025 21:29 by rmk")
(* ; "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")
(* ;; "Creates a single empty window, gets each file into that window without a process, and then displays every line there")
[SETQ FILES (OR (MKLIST FILES)
(FILDIR '*.TEDIT;]
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T REPS " reps of " (LENGTH FILES)
" files" T)
(for R [WINDOW _ (CREATEW '(600 800 800 150]
(N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTREAM TEXTOBJ in FILES unless (DIRECTORYNAMEP F)
do (* ; "No process")
(STRESS NOERROR (WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
[SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(READONLY T LEAVETTY T]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(bind LINE (NCHARS _ (TEDIT.NCHARS TSTREAM))
(CHNO _ 1) while (ILESSP CHNO NCHARS) do (CHECKARRAYS 'BEFOREFORMAT)
(SETQ LINE (\TEDIT.FORMATLINE
TSTREAM CHNO))
(CHECKARRAYS 'BEFOREDISPLAY)
(\TEDIT.DISPLAYLINE TSTREAM
LINE WINDOW)
(CHECKARRAYS 'AFTERDISPLAY)
(SETQ CHNO (GETLD LINE LCHARLIM
)))
(CHECKARRAYS 'BEFOREDEACTIVATE)
(TEDIT.DEACTIVATE.WINDOW WINDOW)
(CHECKARRAYS 'AFTERDEACTIVATE)
(CLEARW WINDOW))) finally (RETURN (LIST (SUB1 R)
N])
(STRESSSCROLL
[LAMBDA (FILES NSCROLLS REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
(* ; "Edited 5-Jun-2025 21:11 by rmk")
(* ; "Edited 2-Jun-2025 21:29 by rmk")
(* ; "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")
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NSCROLLS random scrolls before moving on to the next file.")
(SETQ FILES (STRESS-SETUP FILES 'STRESSSCROLL))
(CL:UNLESS NSCROLLS (SETQ NSCROLLS 10))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T "STRESS SCROLL: " REPS " reps randomly scrolling " NSCROLLS " times in " (LENGTH
FILES)
" files" T)
(SAVERANDSTATE)
(for R [WINDOW _ (CREATEW '(600 500 750 400]
(N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
do (* ; "No process")
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
[STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(READONLY T LEAVETTY T]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(SETQ LEN (TEDIT.NCHARS TSTREAM))
(for I from 1 to NSCROLLS do (CHECKARRAYS 'BEFORE)
(TEDIT.SETSEL TSTREAM (RAND 1 LEN)
1)
(TEDIT.NORMALIZECARET TSTREAM NIL T)
(CHECKARRAYS 'AFTER]
(TEDIT.DEACTIVATE.WINDOW WINDOW)
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
N])
(STRESSDELETE
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
(* ; "Edited 5-Jun-2025 21:11 by rmk")
(* ; "Edited 4-Jun-2025 09:20 by rmk")
(* ; "Edited 2-Jun-2025 21:29 by rmk")
(* ; "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")
(* ;;
 "For each file does NDELETES random single-character deletes before moving on to the next file.")
(SETQ FILES (STRESS-SETUP FILES 'STRESSDELETE))
(CL:UNLESS NTIMES (SETQ NTIMES 10))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T "STRESS DELETE: " REPS " reps randomly deleting 1 character " NTIMES " times in "
(LENGTH FILES)
" files" T)
(SAVERANDSTATE)
(for R (N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTRM inside FILES
do (if (if NOERROR
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))
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
do (* ; "No process")
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F NIL '(LEAVETTY T HISTORY OFF]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(SETQ LEN (TEDIT.NCHARS TSTREAM))
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
(TEDIT.DELETE TSTREAM (RAND 1 LEN)
1)
(CHECKARRAYS 'AFTER)
(add LEN -1))
(CLOSEF? TSTREAM))) finally (RETURN (LIST (SUB1 R)
N])
(STRESSDELETEWINDOW
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:56 by rmk")
(* ; "Edited 5-Jun-2025 21:11 by rmk")
(* ; "Edited 4-Jun-2025 09:19 by rmk")
(* ; "Edited 2-Jun-2025 22:35 by rmk")
(* ; "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")
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NTIMES random 1-character deletions before moving on to the next file.")
(SETQ FILES (STRESS-SETUP FILES 'STRESSDELETEWINDOW))
(CL:UNLESS NTIMES (SETQ NTIMES 10))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T "STRESS INSERT: " REPS " reps randomly inserting 3 characters " NTIMES " times in "
(LENGTH FILES)
" files" T)
(SAVERANDSTATE)
(for R [WINDOW _ (CREATEW '(550 800 750 150]
(N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
do (* ; "No process")
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(LEAVETTY T HISTORY OFF]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(SETQ LEN (TEDIT.NCHARS TSTREAM))
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
(TEDIT.DELETE TSTREAM (RAND 1 LEN))
(CHECKARRAYS 'AFTER)
(add LEN -1)))
(PUTTEXTPROP TSTREAM 'DIRTY NIL)
(TEDIT.DEACTIVATE.WINDOW WINDOW)
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
N])
(STRESSINSERT
[LAMBDA (FILES NTIMES REPS NOERROR SYSOUTNAME) (* ; "Edited 29-Jun-2025 21:18 by rmk")
(* ; "Edited 26-Jun-2025 20:19 by rmk")
(* ; "Edited 5-Jun-2025 21:11 by rmk")
(* ; "Edited 4-Jun-2025 09:18 by rmk")
(* ; "Edited 2-Jun-2025 22:34 by rmk")
(* ; "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")
(* ;; "Does random inserts in the tstreams without a window or process")
(DECLARE (SPECVARS SYSOUTNAME))
(SETQ FILES (STRESS-SETUP FILES 'STRESSINSERT))
(CL:UNLESS NTIMES (SETQ NTIMES 10))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(PRINTOUT T T "STRESSINSERT: " T 2 REPS " reps randomly inserting 3 characters " NTIMES
" times in " (LENGTH FILES)
" files" T)
(PRINTOUT T 2 "Saving " (if (EQ NSYSOUTS 0)
then "no sysouts"
elseif (EQ NSYSOUTS 'SAVEVM)
then " the virtual memory"
else (PRINTOUT NIL NSYSOUTS " sysouts on ")
(PSEUDOFILENAME SYSOUTNAME))
T)
(SAVERANDSTATE)
(for REP SYSOUTS AFTERCRASH (N _ 0) from 1 to REPS declare (SPECVARS SYSOUTS AFTERCRASH)
do (CL:WHEN AFTERCRASH (TERPRI T))
(PRINTOUT T REP " ")
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
do (CL:WHEN AFTERCRASH
(PRINTOUT T T [if (EQ 'TEDIT (FILENAMEFIELD F 'EXTENSION))
then (FILENAMEFIELD F 'NAME)
else (PACKFILENAME 'NAME (FILENAMEFIELD F 'NAME)
'EXTENSION
(FILENAMEFIELD F 'EXTENSION]
T)
then (CLOSEF TSTRM)
(add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL 'BODY F)
T))) finally (RETURN (LIST (SUB1 R)
N])
'FILE)
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F NIL '(LEAVETTY T HISTORY OFF]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(SETQ LEN (TEDIT.NCHARS TSTREAM))
(for I RAND from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
(SETQ RAND (RAND 1 LEN))
(CL:WHEN AFTERCRASH (PRINTOUT T RAND " "))
(SETQ SYSOUTS (STRESS-SYSOUT SYSOUTS
SYSOUTNAME))
(TEDIT.INSERT TSTREAM "aaa" RAND)
(CHECKARRAYS 'AFTER)
(add LEN 3))
(CLOSEF? TSTREAM))) finally (RETURN (LIST (SUB1 REP)
N])
(STRESSINSERTWINDOW
[LAMBDA (FILES NTIMES REPS NOERROR) (* ; "Edited 29-Jun-2025 21:57 by rmk")
(* ; "Edited 5-Jun-2025 21:12 by rmk")
(* ; "Edited 2-Jun-2025 22:35 by rmk")
(* ; "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")
(* ;; "Creates a single empty window, gets each file into that window without a process, and then does NTIMES random 3-character inserts before moving on to the next file.")
(SETQ FILES (STRESS-SETUP FILES 'STRESSINSERTWINDOW))
(CL:UNLESS NTIMES (SETQ NTIMES 10))
(CL:UNLESS REPS (SETQ REPS MAX.SMALLP))
(BKSYSBUF " ")
(PRINTOUT T "STRESS INSERT: " REPS " reps randomly inserting 3 characters " NTIMES " times in "
(LENGTH FILES)
" files" T)
(SAVERANDSTATE)
(for R [WINDOW _ (CREATEW '(550 800 750 150]
(N _ 0) from 1 to REPS
do (PRINTOUT T R " ")
(for F TSTREAM TEXTOBJ LEN in FILES unless (DIRECTORYNAMEP F)
do (* ; "No process")
(WINDOWPROP WINDOW 'TITLE (CONCAT "Fetching " F))
(STRESS NOERROR [SETQ TSTREAM (OPENTEXTSTREAM F WINDOW '(LEAVETTY T HISTORY OFF]
(CHECKARRAYS 'AFTEROPEN)
(SETQ TEXTOBJ (TEXTOBJ TSTREAM))
(SETQ LEN (TEDIT.NCHARS TSTREAM))
(for I from 1 to NTIMES do (CHECKARRAYS 'BEFORE)
(TEDIT.INSERT TSTREAM "aaa" (RAND 1 LEN))
(CHECKARRAYS 'AFTER)
(add LEN 3)))
(PUTTEXTPROP TSTREAM 'DIRTY NIL)
(TEDIT.DEACTIVATE.WINDOW WINDOW)
(CLEARW WINDOW)) finally (RETURN (LIST (SUB1 R)
N])
(STRESSGREP
[LAMBDA (FILES NOERROR TARGET) (* ; "Edited 17-Mar-2024 19:46 by rmk")
[LAMBDA (FILES NOERROR TARGET) (* ; "Edited 29-Jun-2025 21:57 by rmk")
(* ; "Edited 2-Jun-2025 21:30 by rmk")
(* ; "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;)))
(SETQ FILES (STRESS-SETUP FILES 'STRESSGREP))
(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])
(for F in FILES unless (DIRECTEORYNAMEP F) unless (if NOERROR
then (NLSETQ (GREP TARGET F))
else (PROGN (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])
[LAMBDA (FILES ERROR) (* ; "Edited 29-Jun-2025 21:57 by rmk")
(* ; "Edited 2-Jun-2025 21:30 by rmk")
(* ; "Edited 19-Mar-2024 21:33 by rmk")
(SETQ FILES (STRESS-SETUP FILES 'STRESSPEEK))
(for F TSTREAM (N _ 0) in FILES unless (DIRECTORYNAMEP F)
do (STRESS (NOT ERROR)
(SETQ TSTREAM (OPENTEXTSTREAM F))
(CHECKARRAYS 'AFTEROPEN)
(bind P while (SETQ P (PEEKCCODE TSTREAM T)) always (EQ P (BIN TSTREAM])
)
(DEFINEQ
(STRESS-SETUP
[LAMBDA (FILES SUBDIR) (* ; "Edited 29-Jun-2025 21:18 by rmk")
(* ; "Edited 26-Jun-2025 20:18 by rmk")
(* ;; "Copy the files to CORE, defaulting to TEDIT files in connected directory, and load all the image object functions.")
(DECLARE (USEDFREE SYSOUTNAME))
(BKSYSBUF " ")
(CL:UNLESS SYSOUTNAME (SETQ SYSOUTNAME SUBDIR))
(LET ((COREDIR (PACKFILENAME 'HOST 'CORE 'DIRECTORY SUBDIR))
TOCOPY)
(if (EQ FILES T)
then (CL:UNLESS [SETQ FILES (FILDIR (PACKFILENAME 'BODY COREDIR 'BODY '*]
(ERROR "No stress files in " COREDIR))
(PRINTOUT T "Stress files in " COREDIR T)
else [SETQ FILES (OR (MKLIST FILES)
(FILDIR '*.TEDIT;]
(SETQ TOCOPY (for F in FILES unless (INFILEP (PACKFILENAME 'BODY COREDIR 'BODY F))
collect F))
(if TOCOPY
then (PRINTOUT T "Copying " (LENGTH TOCOPY)
" files to " COREDIR T)
(for F CF in TOCOPY collect (SETQ CF (COPYFILE F (PACKFILENAME 'BODY COREDIR
'BODY F)))
(CLOSEF? (OPENTEXTSTREAM CF))
CF)
else (PRINTOUT T (LENGTH FILES)
" files already copied to " COREDIR T))
(FILDIR (PACKFILENAME 'BODY COREDIR 'BODY '*])
(STRESS-SYSOUT
[LAMBDA (SYSOUTS SYSOUTNAME) (* ; "Edited 29-Jun-2025 21:18 by rmk")
(* ; "Edited 26-Jun-2025 20:57 by rmk")
(DECLARE (USEDFREE NSYSOUTS))
(if (EQ NSYSOUTS 'SAVEVM)
then (SAVEVM)
elseif (IGREATERP NSYSOUTS 0)
then
(* ;; "Keep NSYSOUT sysouts with increasing versions")
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
NSYSOUTS)
(DELFILE (pop SYSOUTS))) (* ;
 "Drop the oldest, put out the newest")
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
[if (LISTP SYSOUTNAME)
then (* ;
 "Restarting presumab ly after crash")
(SETQ AFTERCRASH T)
else
(* ;; "Newest goes at the end of the ring")
(SETQ SYSOUTS (NCONC1 SYSOUTS SYSOUTNAME))
(CL:WHEN (IGREATERP (FILENAMEFIELD SYSOUTNAME 'VERSION)
1000) (* ; "Restart the versions at one")
[SETQ SYSOUTS (for S in SYSOUTS as V from 1
collect (RENAMEFILE S (PACKFILENAME 'VERSION V 'BODY S])]
SYSOUTS])
(STRESS-AFTERSYSOUT
[LAMBDA NIL (* ; "Edited 26-Jun-2025 09:18 by rmk")
(DECLARE (USEDFREE SYSOUTLEVEL)) (* ;
 "Bound at the stress-test entry, or top-level NIL")
(BKSYSBUF " ")
(CL:WHEN SYSOUTLEVEL
(CL:WHEN (OR (UNIX-GETENV "STRESSHELP")
(EQ SYSOUTLEVEL 'EVENT))
(HELP "STRESS SYSOUT"))
(SETQ SYSOUTLEVEL (SELECTQ SYSOUTLEVEL
(REPS 'FILE)
(FILE 'EVENT)
NIL)))])
(SYSOUTRING
[LAMBDA (SYSOUTNAME SYSOUTS) (* ; "Edited 29-Jun-2025 21:19 by rmk")
(* ; "Edited 26-Jun-2025 20:06 by rmk")
(* ; "Edited 12-Mar-2024 17:52 by rmk")
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
(DECLARE (USEDFREE NSYSOUTS AFTERCRASH))
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
 "Keep NSYSOUT sysouts with increasing versions")
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
NSYSOUTS)
(DELFILE (pop SYSOUTS))) (* ;
 "Drop the oldest, put out the newest")
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
(SETQ AFTERCRASH T))
(NCONC1 SYSOUTS SYSOUTNAME))])
(SYSOUTNAME
[LAMBDA (SYSOUTNAME) (* ; "Edited 26-Jun-2025 00:12 by rmk")
(* ;; "Doesn't work with PSEUDOFILENAME ??")
(PACKFILENAME 'VERSION NIL 'DIRECTORY MEDLEYDIR 'NAME SYSOUTNAME 'EXTENSION 'SYSOUT])
(SYSOUTRING
[LAMBDA (SYSOUTNAME SYSOUTS) (* ; "Edited 29-Jun-2025 21:19 by rmk")
(* ; "Edited 26-Jun-2025 20:06 by rmk")
(* ; "Edited 12-Mar-2024 17:52 by rmk")
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
(DECLARE (USEDFREE NSYSOUTS AFTERCRASH))
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
 "Keep NSYSOUT sysouts with increasing versions")
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
NSYSOUTS)
(DELFILE (pop SYSOUTS))) (* ;
 "Drop the oldest, put out the newest")
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
(SETQ AFTERCRASH T))
(NCONC1 SYSOUTS SYSOUTNAME))])
(SYSOUTNAME
[LAMBDA (SYSOUTNAME) (* ; "Edited 26-Jun-2025 00:12 by rmk")
(* ;; "Doesn't work with PSEUDOFILENAME ??")
(PACKFILENAME 'VERSION NIL 'DIRECTORY MEDLEYDIR 'NAME SYSOUTNAME 'EXTENSION 'SYSOUT])
)
(DEFINEQ
@@ -261,41 +646,84 @@
(LIST I C1 C2)))
(RETURN NIL) finally (RETURN T])
(SYSOUTRING
[LAMBDA (NSYSOUTS SYSOUTNAME SYSOUTS) (* ; "Edited 12-Mar-2024 17:52 by rmk")
(* ;; "SYSOUTS is the list of names of sysouts that currently exist.")
(DECLARE (USEDFREE SINGLESTEP))
(CL:WHEN (IGREATERP NSYSOUTS 0) (* ;
 "Keep NSYSOUT sysouts with increasing versions")
(CL:WHEN (IGEQ (LENGTH SYSOUTS)
NSYSOUTS)
(DELFILE (pop SYSOUTS))) (* ;
 "Drop the firstr (oldest), new one goes at the end")
(SETQ SYSOUTNAME (SYSOUT SYSOUTNAME))
(CL:WHEN (LISTP SYSOUTNAME) (* ; "Restarting")
(SETQ SINGLESTEP T))
(NCONC1 SYSOUTS SYSOUTNAME))])
(COPYTOCORE
[LAMBDA (FILES NORECLAIM) (* ; "Edited 12-Mar-2024 22:45 by rmk")
[LAMBDA (FILES SUBDIR NORECLAIM) (* ; "Edited 25-Jun-2025 23:41 by rmk")
(* ; "Edited 2-Jun-2025 21:30 by rmk")
(* ; "Edited 12-Mar-2024 22:45 by rmk")
(* ;; "Copy FILES to {CORE}, defaulting to TEDIT files in connected directory")
(CL:UNLESS (LISTP FILES)
(SETQ FILES (FILDIR (OR FILES "*.TEDIT;"))))
[SETQ FILES (OR (MKLIST FILES)
(FILDIR '*.TEDIT;]
(PRINTOUT T "Copying " (LENGTH FILES)
" files to {CORE} "
(CL:IF NORECLAIM
"without "
"with ")
"reclaiming" T)
(for F in FILES collect (COPYFILE F (PACKFILENAME 'HOST 'CORE 'DIRECTORY NIL 'BODY F))
finally (CL:UNLESS NORECLAIM (RECLAIM])
(for F CF in FILES collect (SETQ CF (PACKFILENAME 'HOST 'CORE 'DIRECTORY SUBDIR 'BODY F))
(OR (INFILEP CF)
(COPYFILE F CF)) finally (CL:UNLESS NORECLAIM (RECLAIM])
(CHECKARRAYS
[LAMBDA (TAG)
(DECLARE (SPECVARS TAG)) (* ; "Edited 2-Jun-2025 21:11 by rmk")
(* ;; "TAG is visible as an argument in URAID")
(CL:WHEN CHECKARRAYS
(CL:WHEN (EQ CHECKARRAYS 'RECLAIM)
(RECLAIM))
(\PARSEARRAYSPACE))])
(SAVERANDSTATE
[LAMBDA NIL (* ; "Edited 5-Jun-2025 21:20 by rmk")
(DECLARE (USEDFREE USELASTRANDSTATE))
(LET (RSTREAM)
(if USELASTRANDSTATE
then (SETQ RSTREAM (OPENSTREAM 'RANDSTATE 'INPUT))
(RANDSET (READ RSTREAM))
else (SETQ RSTREAM (OPENSTREAM 'RANDSTATE 'OUTPUT))
(PRINTOUT RSTREAM (RANDSET T)
T))
(CLOSEF RSTREAM])
)
(RPAQ? CHECKARRAYS NIL)
(RPAQ? USELASTRANDSTATE NIL)
(RPAQ? SYSOUTLEVEL NIL)
(RPAQ? NSYSOUTS 0)
(RPAQQ ARRAYBLOCKCHECKING T)
(APPENDTOVAR AFTERSYSOUTFORMS (STRESS-AFTERSYSOUT))
(FILESLOAD TEDIT-DEBUG)
(DECLARE%: EVAL@COMPILE
(PUTPROPS STRESS MACRO ((NOERROR . FORMS)
(CHECKARRAYS 'BEFORESTRESS)
(if (if NOERROR
then (NLSETQ . FORMS)
else (PROGN . FORMS)
T)
then (add N 1)
else (PRINTOUT T T "Error for " (PACKFILENAME 'HOST NIL 'DIRECTORY NIL
'BODY F)
T))
(CHECKARRAYS 'AFTERSTRESS)
(CLOSEF? TSTREAM)))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
(FILEMAP (NIL (1548 32125 (STRESSHC 1558 . 5389) (STRESSRAND 5391 . 6927) (STRESSPUT 6929 . 8498) (
STRESSOPEN 8500 . 9663) (STRESSREAD 9665 . 11165) (STRESSFORMAT 11167 . 13642) (STRESSDISPLAY 13644 .
16623) (STRESSSCROLL 16625 . 19193) (STRESSDELETE 19195 . 21574) (STRESSDELETEWINDOW 21576 . 24168) (
STRESSINSERT 24170 . 27854) (STRESSINSERTWINDOW 27856 . 30342) (STRESSGREP 30344 . 31418) (STRESSPEEK
31420 . 32123)) (32126 38911 (STRESS-SETUP 32136 . 33889) (STRESS-SYSOUT 33891 . 35473) (
STRESS-AFTERSYSOUT 35475 . 36139) (SYSOUTRING 36141 . 37249) (SYSOUTNAME 37251 . 37524) (SYSOUTRING
37526 . 38634) (SYSOUTNAME 38636 . 38909)) (38912 41860 (EQTEXTSTREAM 38922 . 40091) (COPYTOCORE 40093
. 41023) (CHECKARRAYS 41025 . 41352) (SAVERANDSTATE 41354 . 41858)))))
STOP

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

Binary file not shown.

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

Binary file not shown.

163
library/tedit/TEDIT-TFBRAVO
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 14:23:07" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;176 94631
(FILECREATED "10-May-2025 12:53:24" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;183 97073
:EDIT-BY rmk
:CHANGES-TO (FNS TEDITFROMBRAVO)
:CHANGES-TO (FNS \TFBRAVO.GET.USER.CM TEDITFROMBRAVO \TFBRAVO.USER.CM.LOOKS)
(VARS TEDIT-TFBRAVOCOMS)
:PREVIOUS-DATE "19-Feb-2025 12:18:40" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;175)
:PREVIOUS-DATE " 9-May-2025 09:51:51" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;178)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -44,7 +45,22 @@
(FNS \TFBRAVO.INSERT.PARA \TFBRAVO.INSERT.RUN \TFBRAVO.SPLIT.PARA \TFBRAVO.RUN.TABSPEC
\TFBRAVO.INSTALL.PAGEFORMAT)
(FNS \TFBRAVO.ASSERT \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS)
(INITVARS (TEDIT-DEFAULT-USER.CM "TEDIT-DEFAULT-USER.CM")
(INITVARS [TEDIT.DEFAULT.USER.CM '((ParagraphLeading 12)
(LineLeading 6)
(FirstLineLeftMargin 84)
(LeftMargin 84)
(RightMargin 528)
(DefaultTab 36)
(Font (0 TIMESROMAN 10 NIL NIL)
(1 TIMESROMAN 8 NIL NIL)
(2 HIPPO 8 NIL NIL)
(3 GACHA 8 NIL NIL)
(4 MATH 8 NIL NIL)
(5 HELVETICA 12 NIL NIL)
(6 GACHA 6 NIL NIL)
(7 TIMESROMAN 9 NIL NIL)
(8 HELVETICA 10 NIL NIL)
(9 HELVETICA 11 NIL NIL]
(USER.CM.RDTBL (COPYREADTABLE))
(PROFILE.PARA.RDTBL (COPYREADTABLE)))
(P (SETBRK (CHARCODE (%, %: = CR))
@@ -170,7 +186,8 @@
(RETURN T])
(TEDITFROMBRAVO
[LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 28-Mar-2025 14:16 by rmk")
[LAMBDA (BFILE TSTREAM PROPS USER.CM) (* ; "Edited 9-May-2025 09:18 by rmk")
(* ; "Edited 28-Mar-2025 14:16 by rmk")
(* ; "Edited 19-Feb-2025 12:13 by rmk")
(* ; "Edited 8-Feb-2025 23:03 by rmk")
(* ; "Edited 2-Jan-2025 22:22 by rmk")
@@ -193,7 +210,7 @@
(BSTREAM _ BFILE)
(TEXTOBJ _ (TEXTOBJ TSTREAM)) declare (SPECVARS USER.CM.PARALOOKS USER.CM.CHARLOOKS
USER.CM.ALIST)
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ))
first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ PROPS))
(* ; "Go for plain text")
(RETURN))
(SETTOBJ TEXTOBJ FORMATTEDP T)
@@ -245,11 +262,14 @@
(DEFINEQ
(\TFBRAVO.GET.USER.CM
[LAMBDA (BFILE CANDIDATE TEXTOBJ) (* ; "Edited 28-Nov-2023 17:38 by rmk")
[LAMBDA (BFILE CANDIDATE TEXTOBJ PROPS) (* ; "Edited 10-May-2025 12:53 by rmk")
(* ; "Edited 28-Nov-2023 17:38 by rmk")
(* ; "Edited 11-Sep-2023 13:15 by rmk")
(* ; "Edited 19-Aug-2023 23:24 by rmk")
(* ; "Edited 17-Aug-2023 09:46 by rmk")
(* ;; "Returns the name of the user.cm file to be used in the conversion of Bravo BFILE. If CANDIDATE can't be found, the heuristic search is to search in the following order: ")
(* ;; " BFILE's directory, connected directory, logindirectory, DIRECTORIES")
(DECLARE (USEDFREE TEDIT-DEFAULT-USER.CM))
@@ -258,45 +278,58 @@
(CL:WHEN (EQ CANDIDATE T) (* ;
 "Because the test function's non-NIL value is passed in as CANDIDATE.")
(SETQ CANDIDATE NIL))
(CL:UNLESS CANDIDATE
(SETQ CANDIDATE 'USER.CM))
(OR (STREAMP CANDIDATE)
(PROG [USER.CM (PROP (LISTGET PROPS 'USER.CM))
(DIRS `(,(PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY BFILE)
T NIL ,@DIRECTORIES]
(* ;; "Returns the name of the user.cm file to be used in the conversion of Bravo BFILE. If CANDIDATE can't be found, the heuristic search is to search in the following order:")
(* ;;
 "If we find CANDIDATE in the same directory, just notify without asking for confirmation")
(PROG [USER.CM (DIRS `(,(PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY BFILE)
T NIL ,@DIRECTORIES]
(CL:WHEN [AND CANDIDATE (SETQ USER.CM (CL:IF (STREAMP CANDIDATE)
(FULLNAME CANDIDATE)
(FINDFILE CANDIDATE T DIRS))]
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM)
T)
(RETURN USER.CM))
[SETQ USER.CM (OR (FINDFILE 'USER.CM T DIRS)
(AND TEDIT-DEFAULT-USER.CM (FINDFILE TEDIT-DEFAULT-USER.CM T DIRS]
(* (SELECTQ (MKATOM (U-CASE
 (TEDIT.GETINPUT TEXTOBJ
 (CONCAT "USER.CM = " USER.CM " ? "))))
 (NIL (TEDIT.PROMPTPRINT TEXTOBJ "Yes")
 T) ((Y YES T) T) NIL))
(if USER.CM
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM)
T)
else (do (SETQ USER.CM (TEDIT.GETINPUT TEXTOBJ
"USER.CM file: (CR suppresses BRAVO conversion) "))
(CL:WHEN (OR (NULL USER.CM)
(INFILEP USER.CM))
(RETURN))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT USER.CM " not found")
T T)
(DISMISS 3000)))
(RETURN USER.CM])
(CL:WHEN (SETQ USER.CM (INFILEP (PACKFILENAME 'BODY CANDIDATE 'BODY BFILE)))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM)
T T)
(RETURN USER.CM))
(* ;; "Search more broadly for PROP before asking--comes after CANDIDATE because it could be an HCFILES default. BFILE's directory has priority")
(CL:WHEN [AND PROP (SETQ USER.CM (OR (LISTP PROP)
(FINDFILE PROP T DIRS]
(RETURN USER.CM))
(* ;; "Search and confirm")
(CL:WHEN (SETQ USER.CM (FINDFILE CANDIDATE T DIRS))
(SELECTQ [MKATOM (U-CASE (TEDIT.GETINPUT TEXTOBJ (CONCAT "USER.CM = " USER.CM " ? "
]
((Y YES)
(RETURN USER.CM))
(NIL (* ; "CR response")
(TEDIT.PROMPTPRINT TEXTOBJ "Yes")
(RETURN USER.CM))
NIL))
(* ;; "Ask for a file name")
(CL:WHEN (SETQ USER.CM (FINDFILE (TEDIT.GETINPUT TEXTOBJ
"Please enter the USER.CM file (CR for TEDIT default): "
"TEDIT.DEFAULT.USER.CM")
T DIRS))
(RETURN USER.CM))
(RETURN TEDIT.DEFAULT.USER.CM])
(\TFBRAVO.USER.CM.LOOKS
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 8-Feb-2025 22:13 by rmk")
[LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 10-May-2025 08:10 by rmk")
(* ; "Edited 8-Feb-2025 22:13 by rmk")
(* ; "Edited 2-Jan-2025 11:06 by rmk")
(* ; "Edited 18-Aug-2023 18:47 by rmk")
(* ; "Edited 16-Aug-2023 21:33 by rmk")
(* ; "Edited 5-Aug-2023 17:15 by rmk")
(DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.PARALOOKS USER.CM.ALIST))
(SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM))
(SETQ USER.CM.ALIST (OR (LISTP USER.CM)
(\TFBRAVO.READ.USER.CM USER.CM)))
(SETQ USER.CM.CHARLOOKS (create CHARLOOKS
CLOFFSET _ 0))
(\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS (\TFBRAVO.GETFONT 0 BRFAMILY)
@@ -309,15 +342,14 @@
(SETTOBJ TEXTOBJ DEFAULTPARALOOKS USER.CM.PARALOOKS])
(\TFBRAVO.READ.USER.CM
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
[LAMBDA (USER.CM) (* ; "Edited 9-May-2025 00:54 by rmk")
(* ; "Edited 27-Aug-2024 18:12 by rmk")
(* ; "Edited 18-Aug-2023 22:26 by rmk")
(* ; "Edited 10-Aug-2023 13:02 by rmk")
(* ; "Edited 7-Aug-2023 12:52 by rmk")
(* ; "Edited 1-Aug-2023 22:11 by rmk")
(* ; "Edited 30-Jul-2023 18:57 by rmk")
(* gbn "17-Sep-84 18:53")
(CL:UNLESS USER.CM
(SETQ USER.CM 'USER.CM))
(* ;; "digests a user.cm file returning an alist of contents. Returns ((Font)) if no bravo section of user.cm file")
@@ -1028,7 +1060,8 @@
PC))])
(\TFBRAVO.SPLIT.PARA
[LAMBDA (PARA) (* ; "Edited 19-Feb-2025 12:15 by rmk")
[LAMBDA (PARA) (* ; "Edited 24-Apr-2025 23:45 by rmk")
(* ; "Edited 19-Feb-2025 12:15 by rmk")
(* ; "Edited 8-Feb-2025 23:12 by rmk")
(* ; "Edited 9-Sep-2023 21:35 by rmk")
(* ; "Edited 22-Aug-2023 23:45 by rmk")
@@ -1045,7 +1078,7 @@
NEWPARAS)
(* ;;
 "RUNSTART is STRINGP for a math/hippo or other character that has been translated to XCCS")
 "RUNSTART is STRINGP for a math/hippo or other character that has been translated to MCCS")
(SETQ NEWPARAS
(if [AND (fetch (PARA FORMATPTRS) of PARA)
@@ -1353,7 +1386,23 @@
(RETURN (AND NONEMPTY CHAR])
)
(RPAQ? TEDIT-DEFAULT-USER.CM "TEDIT-DEFAULT-USER.CM")
(RPAQ? TEDIT.DEFAULT.USER.CM
'((ParagraphLeading 12)
(LineLeading 6)
(FirstLineLeftMargin 84)
(LeftMargin 84)
(RightMargin 528)
(DefaultTab 36)
(Font (0 TIMESROMAN 10 NIL NIL)
(1 TIMESROMAN 8 NIL NIL)
(2 HIPPO 8 NIL NIL)
(3 GACHA 8 NIL NIL)
(4 MATH 8 NIL NIL)
(5 HELVETICA 12 NIL NIL)
(6 GACHA 6 NIL NIL)
(7 TIMESROMAN 9 NIL NIL)
(8 HELVETICA 10 NIL NIL)
(9 HELVETICA 11 NIL NIL))))
(RPAQ? USER.CM.RDTBL (COPYREADTABLE))
@@ -1503,18 +1552,18 @@
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6570 13446 (TEDIT.BRAVOFILE? 6580 . 8310) (TEDITFROMBRAVO 8312 . 13444)) (13557 29284 (
\TFBRAVO.GET.USER.CM 13567 . 16377) (\TFBRAVO.USER.CM.LOOKS 16379 . 17714) (\TFBRAVO.READ.USER.CM
17716 . 22286) (\TFBRAVO.INIT.PARALOOKS 22288 . 24397) (\TFBRAVO.INIT.PAGEFORMAT 24399 . 25279) (
\TFBRAVO.GETPARAMS 25281 . 28135) (\TFBRAVO.FIND.LAST.TRAILER 28137 . 29282)) (29326 50024 (
\TFBRAVO.PARSE.PARA 29336 . 33263) (\TFBRAVO.READ.PARALOOKS 33265 . 40155) (\TFBRAVO.CREATE.RUNS 40157
. 41545) (\TFBRAVO.READ.CHARLOOKS 41547 . 46576) (\TFBRAVO.FONT.FROM.CHARLOOKS 46578 . 48125) (
\TFBRAVO.READNUM? 48127 . 50022)) (50061 61102 (\TFBRAVO.HANDLE.HEADING 50071 . 52798) (
\TFBRAVO.PARSE.PROFILE.PARA 52800 . 61100)) (61145 83181 (\TFBRAVO.INSERT.PARA 61155 . 61996) (
\TFBRAVO.INSERT.RUN 61998 . 65300) (\TFBRAVO.SPLIT.PARA 65302 . 72617) (\TFBRAVO.RUN.TABSPEC 72619 .
77486) (\TFBRAVO.INSTALL.PAGEFORMAT 77488 . 83179)) (83182 87325 (\TFBRAVO.ASSERT 83192 . 83722) (
\TEST.CHARACTER.LOOKS 83724 . 85610) (\TEST.PARAGRAPH.LOOKS 85612 . 87323)) (87810 94465 (
\TFBRAVO.ADD.NAMEDTAB 87820 . 91423) (\TFBRAVO.COPY.NAMEDTAB 91425 . 91873) (\TFBRAVO.PUT.NAMEDTAB
91875 . 92155) (\TFBRAVO.GET.NAMEDTAB 92157 . 92534) (\NAMEDTABNYET 92536 . 92696) (\NAMEDTABSIZE
92698 . 93213) (\NAMEDTABPREPRINT 93215 . 93413) (\TEDIT.NAMEDTAB.INIT 93415 . 94463)))))
(FILEMAP (NIL (7682 14673 (TEDIT.BRAVOFILE? 7692 . 9422) (TEDITFROMBRAVO 9424 . 14671)) (14784 31092 (
\TFBRAVO.GET.USER.CM 14794 . 17974) (\TFBRAVO.USER.CM.LOOKS 17976 . 19469) (\TFBRAVO.READ.USER.CM
19471 . 24094) (\TFBRAVO.INIT.PARALOOKS 24096 . 26205) (\TFBRAVO.INIT.PAGEFORMAT 26207 . 27087) (
\TFBRAVO.GETPARAMS 27089 . 29943) (\TFBRAVO.FIND.LAST.TRAILER 29945 . 31090)) (31134 51832 (
\TFBRAVO.PARSE.PARA 31144 . 35071) (\TFBRAVO.READ.PARALOOKS 35073 . 41963) (\TFBRAVO.CREATE.RUNS 41965
. 43353) (\TFBRAVO.READ.CHARLOOKS 43355 . 48384) (\TFBRAVO.FONT.FROM.CHARLOOKS 48386 . 49933) (
\TFBRAVO.READNUM? 49935 . 51830)) (51869 62910 (\TFBRAVO.HANDLE.HEADING 51879 . 54606) (
\TFBRAVO.PARSE.PROFILE.PARA 54608 . 62908)) (62953 85098 (\TFBRAVO.INSERT.PARA 62963 . 63804) (
\TFBRAVO.INSERT.RUN 63806 . 67108) (\TFBRAVO.SPLIT.PARA 67110 . 74534) (\TFBRAVO.RUN.TABSPEC 74536 .
79403) (\TFBRAVO.INSTALL.PAGEFORMAT 79405 . 85096)) (85099 89242 (\TFBRAVO.ASSERT 85109 . 85639) (
\TEST.CHARACTER.LOOKS 85641 . 87527) (\TEST.PARAGRAPH.LOOKS 87529 . 89240)) (90252 96907 (
\TFBRAVO.ADD.NAMEDTAB 90262 . 93865) (\TFBRAVO.COPY.NAMEDTAB 93867 . 94315) (\TFBRAVO.PUT.NAMEDTAB
94317 . 94597) (\TFBRAVO.GET.NAMEDTAB 94599 . 94976) (\NAMEDTABNYET 94978 . 95138) (\NAMEDTABSIZE
95140 . 95655) (\NAMEDTABPREPRINT 95657 . 95855) (\TEDIT.NAMEDTAB.INIT 95857 . 96905)))))
STOP

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

Binary file not shown.

1606
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.

BIN
library/tedit/TOPLINE.TEDIT Normal file
View File

Binary file not shown.

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

@@ -1,11 +1,11 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Mar-2025 17:12:59" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;209 53312
(FILECREATED "21-Apr-2025 23:06:12" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;228 53892
:EDIT-BY rmk
:PREVIOUS-DATE "16-Mar-2025 00:20:08" {WMEDLEY}<library>TEDIT>tedit-exports.all;208)
:PREVIOUS-DATE "20-Apr-2025 00:13:59" {WMEDLEY}<library>TEDIT>tedit-exports.all;227)
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
@@ -14,11 +14,10 @@ PRINT))))))))
(PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) (
\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)
)))))))
(PUTPROPS FTEXTOBJ MACRO ((X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ)))))
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
(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 "28-Mar-2025 14:10:12"))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:54:33"))
(RPAQQ \BTREEWORDSPERSLOT 4)
(RPAQQ \BTREEMAXCOUNT 8)
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -98,7 +97,8 @@ FGETLD L LCHAR1) CHLAST))))
(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ;
"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ (
FGETLD L LCHAR1) CHLAST))))
(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH))))
(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (* ; "within the closed interval") (AND (IGEQ X LOW
) (ILEQ X HIGH))))
(PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S)))
(PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE)))
(PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S)))
@@ -118,7 +118,10 @@ $$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
TEDIT.DELETESELECTION)
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "19-Mar-2025 16:27:02"))
(PUTPROPS \TEDIT.NOSEL MACRO ((TSTREAM SEL ONLYPANE) (* ;
"Takes down SEL in TSTREAM, where SEL defaults to the current selection") (\TEDIT.SHOWSEL SEL NIL
TSTREAM ONLYPANE)))
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:52:26"))
(RECORD TAB (TABX . TABKIND))
(RECORD TABSPEC (DEFAULTTAB . TABS))
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
@@ -215,54 +218,49 @@ FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFAC
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.")))
(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.") CHARCL))
(PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT)))
(PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT)))
(PUTPROPS CHARCL MACRO ((CSLOT) (ffetch (CHARSLOT CHARCL) of CSLOT)))
(PUTPROPS PREVCHARSLOT MACRO ((CSLOT) (\ADDBASE CSLOT (IMINUS WORDSPERCHARSLOT))))
(PUTPROPS PREVCHARSLOT! MACRO ((CSLOT) (* ;;
"Backs over looks and invisibles to the last character slot") (find CS _ (PREVCHARSLOT CSLOT) by (
PREVCHARSLOT CS) while CS suchthat (CHAR CS))))
(PUTPROPS NEXTCHARSLOT MACRO ((CSLOT) (\ADDBASE CSLOT WORDSPERCHARSLOT)))
(PUTPROPS FIRSTCHARSLOT MACRO ((TLINE) (fetch (THISLINE CHARSLOTS) of TLINE)))
(PUTPROPS NTHCHARSLOT MACRO ((TLINE N) (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) (ITIMES N
WORDSPERCHARSLOT))))
(PUTPROPS LASTCHARSLOT MACRO ((TLINE) (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) (TIMES (SUB1
MAXCHARSLOTS) WORDSPERCHARSLOT))))
(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W) (freplace (CHARSLOT CHAR) of CSLOT with C) (freplace (
CHARSLOT CHARW) of CSLOT with W)))
(PUTPROPS BACKCHARS MACRO ((CSLOTVAR CHARVAR WIDTHVAR) (SETQ CSLOTVAR (PREVCHARSLOT CSLOTVAR)) (SETQ
CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR)) (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR))))
(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W) (FILLCHARSLOT CSLOTVAR C W) (SETQ CSLOTVAR (NEXTCHARSLOT
CSLOTVAR))))
(PUTPROPS POPCHAR MACRO ((CSLOTVAR CHARVAR WIDTHVAR) (SETQ CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR)
) (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR)) (SETQ CSLOTVAR (NEXTCHARSLOT CSLOTVAR))))
(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W R) (freplace (CHARSLOT CHAR) of CSLOT with C) (freplace (
CHARSLOT CHARW) of CSLOT with W) (freplace (CHARSLOT CHARCL) of CSLOT with R)))
(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W CL) (FILLCHARSLOT CSLOTVAR C W CL) (SETQ CSLOTVAR (
NEXTCHARSLOT CSLOTVAR))))
(PUTPROPS CHARSLOTP MACRO (OPENLAMBDA (X TL) (* ;;
"True if TL is a THISLINE and X is a pointer into its CHARSLOTS block. A tool for consistency assertions."
) (CL:WHEN (TYPE? THISLINE TL) (LET ((FIRSTSLOT (FIRSTCHARSLOT TL)) (LASTSLOT (LASTCHARSLOT TL))) (AND
(OR (IGREATERP (\HILOC X) (\HILOC FIRSTSLOT)) (AND (EQ (\HILOC X) (\HILOC FIRSTSLOT)) (IGEQ (\LOLOC X
) (\LOLOC FIRSTSLOT)))) (OR (ILESSP (\HILOC X) (\HILOC LASTSLOT)) (AND (EQ (\HILOC X) (\HILOC LASTSLOT
)) (ILEQ (\LOLOC X) (\LOLOC LASTSLOT)))))))))
(RPAQQ CELLSPERCHARSLOT 2)
(RPAQQ CELLSPERCHARSLOT 3)
(RPAQ WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL))
(RPAQQ MAXCHARSLOTS 256)
(CONSTANTS (CELLSPERCHARSLOT 2) (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (MAXCHARSLOTS
(CONSTANTS (CELLSPERCHARSLOT 3) (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (MAXCHARSLOTS
256))
(* ;;
"incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards."
)
(I.S.OPR (QUOTE incharslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$STARTSLOT) (QUOTE (bind
$$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first (
SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (FIRSTCHARSLOT $$STARTSLOT)) (T $$STARTSLOT))) (SETQ
$$CHARSLOTLIMIT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)) by (NEXTCHARSLOT I.V.) until (EQ
I.V. $$CHARSLOTLIMIT) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
CHARSLOT CHARW) of I.V.)))))) T)
$$STARTSLOT _ BODY CHAR CHARW CHARCL $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT)
first (SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (FIRSTCHARSLOT $$STARTSLOT)) (T $$STARTSLOT))) (
SETQ $$CHARSLOTLIMIT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)) by (NEXTCHARSLOT I.V.)
until (EQ I.V. $$CHARSLOTLIMIT) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (
fetch (CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)))))) T)
(I.S.OPR (QUOTE backcharslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$STARTSLOT) (QUOTE (bind
$$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first (
SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 17:12:44"))
$$STARTSLOT _ BODY CHAR CHARW CHARCL $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT)
first (SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE
NEXTAVAILABLECHARSLOT) of THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)
) by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (
CHARSLOT CHARW) of I.V.)) (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.)) repeatuntil (EQ I.V.
$$CHARSLOTLIMIT))))) T)
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 20:34:16"))
(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)."
@@ -305,11 +303,11 @@ HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
SEL (* ; "The current selection within the text") LASTARROWX (* ;
"X for next arrow up or arrow down. Was: Scratch space for the selection code") NIL (* ;
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
"Right edge of the window (or subregion) where this is displayed") WTOP (* ;
"Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ;
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
NIL (* ; "Was DELETESEL: Text to be deleted imminently") NIL (* ;
"Was WRIGHT: Right edge of the window (or subregion) where this is displayed") WTOP (* ;
"Top of the window/region") NIL (* ; "Was WBOTTOM: Bottom of the window/region") NIL (* ;
"Was WLEFT: Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (
\XDIRTY FLAG) (* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
"-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ;
"T => The guy has asked the editor to go way") NIL (* ;
"Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ;
@@ -352,9 +350,9 @@ TXTAPPENDONLY FLAG) (* ;
"Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (FSETTOBJ DATUM LASTARROWX NIL) (CL:UNLESS (EQ
NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY
OF DATUM WITH NEWVALUE)))))) SEL _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0
WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _ (create THISLINE) DEFAULTPARALOOKS _
TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
OF DATUM WITH NEWVALUE)))))) SEL _ (create SELECTION) TEXTLEN _ 0 WTOP _ 0 MOUSEREGION _ (QUOTE TEXT)
THISLINE _ (create THISLINE) DEFAULTPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL
FORM LF CR)))
(ACCESSFNS TEXTSTREAM ((* ;;
"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;;
"The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3)
@@ -408,7 +406,7 @@ VISIBLEPIECEP PPC))))
(PUTPROPS FGETTOBJ MACRO ((TOBJ FIELD) (ffetch (TEXTOBJ FIELD) of TOBJ)))
(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 TEXTSEL MACRO ((TEXTOBJ) (SELECTION! (GETTOBJ TEXTOBJ SEL))))
(PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR)))
(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
@@ -446,7 +444,7 @@ UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE F
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:26:47"))
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:45:03"))
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
@@ -460,7 +458,7 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
\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 "28-Mar-2025 14:24:34"))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "19-Apr-2025 22:29:28"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:09:40"))
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
@@ -487,10 +485,10 @@ LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
"For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs."
) (CLMARK FLAG) (* ;;
"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (
CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (CHARLOOKS CLFONTUNPARSE) of DATUM with
NEWVALUE))))
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields).") CLCOLOR)
CLOFFSET _ 0 CLCOLOR _ (QUOTE BLACK) (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION
\TEDIT.CHARLOOKS.DEFPRINT))) (ACCESSFNS (CLNAME (fetch (CHARLOOKS CLFONTUNPARSE) of DATUM) (replace (
CHARLOOKS CLFONTUNPARSE) of DATUM with NEWVALUE))))
(DATATYPE PARALOOKS ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ;
"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ;
@@ -549,7 +547,7 @@ NEWVALUE)))
(PUTPROPS FGETPARA MACRO ((PLOOKS FIELD) (ffetch (PARALOOKS FIELD) of PLOOKS)))
(PUTPROPS GETPARA MACRO ((PLOOKS FIELD) (fetch (PARALOOKS FIELD) of PLOOKS)))
(PUTPROPS SETPARA MACRO ((PLOOKS FIELD NEWVALUE) (replace (PARALOOKS FIELD) of PLOOKS with NEWVALUE)))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:24:25"))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 20:28:55"))
(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:31:28"))
(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
@@ -572,22 +570,29 @@ TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ)))))
(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ;
"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ;
"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE
XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION))
XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION OTHERPAMEPROPS)
PANELEFT _ 0 PANERIGHT _ 0 PANEBOTTOM _ 0 PANETOP _ 0 PANEWIDTH _ 0 PANEHEIGHT _ 0 PANEREGION _ (
CREATEREGION 0 0 0 0))
(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P)))
(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P)))
(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE)))
(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE)))
(PUTPROPS PANEWINDOW MACRO ((PANE) PANE))
(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE)))
(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE))))
(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE)))
(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE)))
(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET))))
(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
WTEXTSTREAM) of PANE)))))
(PUTPROPS PANECARETY MACRO ((PANE) (fetch (TEDITCARET TCCARETY) of (GETPANEPROP (PANEPROPS PANE)
PCARET))))
(PUTPROPS PANETEXTSTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
(PUTPROPS PANETEXTOBJ MACRO ((PANE) (FTEXTOBJ (PANETEXTSTREAM PANE))))
(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE)))
(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO)))
(PUTPROPS NEXTPANE MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) NEXTPANE)))
(PUTPROPS PREVPANE MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) PREVPANE)))
(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))))
(PUTPROPS PANEPTOP MACRO ((PANE PREG) (fetch (REGION PTOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
)
(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
)))
(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
@@ -596,9 +601,9 @@ WTEXTSTREAM) of PANE)))))
)))
(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
)))))
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
)))))
(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE))))
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (GETPANEPROP (PANEPROPS PANE) PANEHEIGHT)))
(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (GETPANEPROP (PANEPROPS PANE) PANEREGION) (
DSPCLIPPINGREGION NIL (PANEWINDOW PANE)))))
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. (
OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR
(GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT)))))
@@ -606,8 +611,8 @@ OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BOD
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
$$OUT)))))
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:08"))
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "24-Mar-2025 09:26:13"))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 20:34:07"))
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "14-Apr-2025 23:50:23"))
(RPAQQ PTSPERPICA 12)
(RPAQQ PTSPERINCH 72)
(RPAQQ PICASPERINCH 6)
@@ -618,15 +623,15 @@ $$OUT)))))
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
MICASPERINCH PTSPERINCH)))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "23-Mar-2025 14:56:57"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:07:00"))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Apr-2025 23:44:59"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:57"))
(RPAQQ \TEDIT.TTCCODES ((NONE 0) (CHARDELETE 1) (WORDDELETE 2) (DELETE 3) (FUNCTIONCALL 4) (REDO 5) (
UNDO 6) (CMD 7) (NEXT 8) (EXPAND 9) (CHARDELETE.FORWARD 10) (WORDDELETE.FORWARD 11) (PUNCT 20) (TEXT
21) (WHITESPACE 22)))
(CONSTANTS \TEDIT.TTCCODES)
(PUTPROPS \TEDIT.TTC MACRO ((CLASS) (CONSTANT (CADR (ASSOC (QUOTE CLASS) \TEDIT.TTCCODES)))))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:53"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:44"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 19:07:23"))
(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 (* ;
@@ -640,7 +645,7 @@ TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVE
(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 "28-Mar-2025 14:23:18"))
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:33"))
(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."
@@ -671,8 +676,12 @@ 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 "23-Feb-2025 10:06:16"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 10:13:36"))
(PUTPROPS TEDIT.SETQS MACRO (ARGS (BQUOTE (LET (($$VALUES (\, (CADR ARGS)))) (DECLARE (LOCALVARS
$$VALUES)) (PROG1 (CAR $$VALUES) (\,@ (FOR V IN (CAR ARGS) collect (COND (V (BQUOTE (SETQ (\, V) (POP
$$VALUES)))) (T (BQUOTE (SETQ $$VALUES (CDR $$VALUES))))))))))))
(PUTPROPS TEDIT.VALUES MACRO (ARGS (BQUOTE (LIST (\,@ ARGS)))))
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "21-Apr-2025 22:42:22"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "20-Apr-2025 23:30:30"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "28-Mar-2025 14:23:07"))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))