diff --git a/internal/TEDIT-DEBUG b/internal/TEDIT-DEBUG index f89323284..801682dc7 100644 --- a/internal/TEDIT-DEBUG +++ b/internal/TEDIT-DEBUG @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "29-Mar-2025 22:37:05" {WMEDLEY}TEDIT-DEBUG.;143 131559 +(FILECREATED "25-Apr-2025 09:11:44" {WMEDLEY}TEDIT-DEBUG.;159 134544 :EDIT-BY rmk - :CHANGES-TO (MACROS DEBUGOUTPUT) - (FNS SP SL SSP SPF STL TEST.TEMPLATE) + :CHANGES-TO (FNS DEBUGOUTPUT.STREAM) - :PREVIOUS-DATE "28-Mar-2025 20:51:43" {WMEDLEY}TEDIT-DEBUG.;141) + :PREVIOUS-DATE "24-Apr-2025 16:05:31" {WMEDLEY}TEDIT-DEBUG.;158) (PRETTYCOMPRINT TEDIT-DEBUGCOMS) @@ -23,7 +22,8 @@ (* ;;  "This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.") - (VARS (\TEDIT.THELPFLG T)) + (VARS (\TEDIT.THELPFLG T) + (TFILES (CONS 'TEDIT-DEBUG TEDITFILES))) (COMS (* ;  "Get/set (default) object, stream, window, selection") (FNS GTO GTS GTW GSEL) @@ -68,7 +68,8 @@ (FNS DFVENUE VSEE) (FNS PTT) (* ; "Plain text") - (MACROS DEBUGOUTPUT) + (COMS (MACROS DEBUGOUTPUT) + (FNS DEBUGOUTPUT.STREAM)) (FNS TEDIT-DEBUG) (FNS TRENAME) (FILES (NOERROR) @@ -100,6 +101,8 @@ (RPAQQ \TEDIT.THELPFLG T) +(RPAQ TFILES (CONS 'TEDIT-DEBUG TEDITFILES)) + (* ; "Get/set (default) object, stream, window, selection") @@ -157,11 +160,18 @@ (DEFINEQ (TEST.TEMPLATE - [LAMBDA (FILE) (* ; "Edited 29-Mar-2025 09:51 by rmk") - (CL:WHEN (AND (TEXTSTREAM LASTTEXTSTREAM) + [LAMBDA (FILE) (* ; "Edited 17-Apr-2025 19:41 by rmk") + (* ; "Edited 29-Mar-2025 09:51 by rmk") + (CL:WHEN (AND (TEXTSTREAM LASTTEXTSTREAM T) (TEDITWINDOWP LASTTEXTSTREAM) (OPENWP (TEDITWINDOWP LASTTEXTSTREAM))) - (TEXTPROP LASTTEXTSTREAM 'DIRTY NIL) + (for ST SW in (GETTEXTPROP LASTTEXTSTREAM 'SHOWSTREAMS) when (AND (SETQ SW ( + \TEDIT.PRIMARYPANE + ST)) + (OPENWP SW)) + do (PUTTEXTPROP ST 'DIRTY NIL) + (CLOSEW SW)) + (PUTTEXTPROP LASTTEXTSTREAM 'DIRTY NIL) (CLOSEW (TEDITWINDOWP LASTTEXTSTREAM))) (LET [(TSTREAM (TEXTSTREAM (TEDIT FILE NIL NIL '(LEAVETTY T] (SETQ LASTTEXTSTREAM TSTREAM) @@ -444,7 +454,10 @@ (DEFINEQ (SP - [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 29-Mar-2025 22:34 by rmk") + [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 17-Apr-2025 13:37 by rmk") + (* ; "Edited 15-Apr-2025 13:53 by rmk") + (* ; "Edited 11-Apr-2025 12:15 by rmk") + (* ; "Edited 29-Mar-2025 22:34 by rmk") (* ; "Edited 6-Jan-2025 22:18 by rmk") (* ; "Edited 16-Dec-2024 15:50 by rmk") (* ; "Edited 30-Nov-2024 19:34 by rmk") @@ -502,8 +515,7 @@ (SETQ NP (CL:IF NP 20 MAX.SMALLP))) - (DEBUGOUTPUT OFILE WTYPE TITLE (DSPFONT (OR FONT '(TERMINAL 8)) - OFILE) + (DEBUGOUTPUT [DEBUGOUTPUT.STREAM OFILE WTYPE TITLE 120 (OR FONT '(TERMINAL 8] (for P PFILES inpieces PC as I from 1 to NP as PCNO from (OR (PIECENUM PC TEXTOBJ) 1) do @@ -521,11 +533,16 @@ OLDVALUE]) (PRINTOUT OFILE .I3 PCNO "/") (SPPRINT P OFILE TEXTOBJ NOCR)) - (TERPRI OFILE)) + (TERPRI OFILE) + (CL:WHEN (TEXTSTREAMP OFILE) + (TEXTPROP.ADD TEXTOBJ 'SHOWSTREAMS OFILE))) (RETURN PC]) (SL - [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 29-Mar-2025 20:27 by rmk") + [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 17-Apr-2025 13:36 by rmk") + (* ; "Edited 15-Apr-2025 13:57 by rmk") + (* ; "Edited 11-Apr-2025 12:15 by rmk") + (* ; "Edited 29-Mar-2025 20:27 by rmk") (* ; "Edited 21-Jan-2025 15:39 by rmk") (* ; "Edited 6-Jan-2025 22:58 by rmk") (* ; "Edited 7-Dec-2024 16:34 by rmk") @@ -537,9 +554,6 @@ (* ; "Edited 27-Oct-2024 18:38 by rmk") (* ; "Edited 25-Oct-2024 22:25 by rmk") (* ; "Edited 21-Oct-2024 23:08 by rmk") - - (* ;; "Shows a selection of the lines backing the display in PANE") - (LET (LINES WTYPE PNO TITLE) (if OFILE then (CL:WHEN (MEMB OFILE '(T TEDIT)) @@ -564,8 +578,9 @@ (SETQ TOBJ (pop LINES)) (SETQ PANE (pop LINES)) (SETQ PNO (pop LINES)) - (DEBUGOUTPUT OFILE WTYPE TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8) - "Pane " PNO " = " PANE T) + (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE WTYPE TITLE NIL '(TERMINAL 8)) + (PRINTOUT OFILE .FONT '(TERMINAL 8) + "Pane " PNO " = " PANE T) (PRINTOUT OFILE .FONT '(TERMINAL 8) 15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD) "C1" 36 "CN" .FONT '(TERMINAL 8) @@ -577,11 +592,14 @@ (TERPRI OFILE) (CL:WHEN (EQ FIRSTLINE LASTLINE) (printout OFILE (for L inlines (FGETLD LASTLINE NEXTLINE) sum 1) - " lines below LASTLINE" T T))) + " lines below LASTLINE" T T)) + (CL:WHEN (TEXTSTREAMP OFILE) + (TEXTPROP.ADD TOBJ 'SHOWSTREAMS OFILE))) FIRSTLINE]) (SSP - [LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 29-Mar-2025 22:35 by rmk") + [LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 11-Apr-2025 12:16 by rmk") + (* ; "Edited 29-Mar-2025 22:35 by rmk") (* ; "Edited 30-Jan-2025 11:25 by rmk") (* ; "Edited 26-Nov-2024 20:54 by rmk") (* ; "Edited 3-Mar-2024 12:58 by rmk") @@ -600,15 +618,16 @@ then (SETQ TEXTOBJ (TEXTOBJ OFILE)) (SETQ OFILE NIL) else (GTO TEXTOBJ)) - (DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP) - NIL + (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE (CL:UNLESS OFILE 'SSP) + NIL) (for PC inselpieces SELPIECES as I from 1 to (OR NP 50) do (PRINTOUT OFILE .I3 I "/") (SPPRINT PC OFILE TEXTOBJ))) SELPIECES]) (SPF - [LAMBDA (ARG TITLE OFILE) (* ; "Edited 29-Mar-2025 22:36 by rmk") + [LAMBDA (ARG TITLE OFILE) (* ; "Edited 11-Apr-2025 12:16 by rmk") + (* ; "Edited 29-Mar-2025 22:36 by rmk") (* ; "Edited 30-Aug-2024 21:25 by rmk") (* ; "Edited 15-Aug-2024 22:39 by rmk") (* ; "Edited 13-Aug-2024 10:45 by rmk") @@ -627,9 +646,10 @@ (SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ)))) (SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES))) (SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS))) - (DEBUGOUTPUT OFILE 'SPF TITLE (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD) - TITLE .FONT '(TERMINAL 8) - T) + (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE 'SPF TITLE) + (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD) + TITLE .FONT '(TERMINAL 8) + T) (for TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT)) in '(FIRST/DEFAULT LEFT RIGHT) collect (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE)) @@ -912,7 +932,8 @@ (DEFINEQ (STL - [LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 29-Mar-2025 22:36 by rmk") + [LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 11-Apr-2025 13:02 by rmk") + (* ; "Edited 29-Mar-2025 22:36 by rmk") (* ; "Edited 22-Aug-2024 23:51 by rmk") (* ; "Edited 4-Aug-2024 12:08 by rmk") (* ; "Edited 31-Jul-2024 19:55 by rmk") @@ -933,12 +954,13 @@ (SETQ LASTCS CHARSLOT)) (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) (\DTEST THISLINE 'THISLINE) - (DEBUGOUTPUT OFILE (CL:IF OFILE - NIL - 'STL) - NIL - (for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR - OF THISLINE)) + (DEBUGOUTPUT (DEBUGOUTPUT.STREAM OFILE (CL:IF OFILE + NIL + 'STL) + NIL 80) + (for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW CHARCL (SPACEFACTOR _ + (FETCH TLSPACEFACTOR + OF THISLINE)) (FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE)) (LINE _ (fetch (THISLINE DESC) of THISLINE)) (NSPACES _ 0) @@ -963,6 +985,7 @@ (SETQ LENGTH TX) (printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT)) (SETQ CHARW (CHARW CSLOT)) + (SETQ CHARCL (CHARCL CSLOT)) (CL:UNLESS (CHARSLOTP CSLOT THISLINE) (HELP "THISLINE RUNS OFF THE EDGE" THISLINE)) @@ -1004,7 +1027,7 @@ (PROGN (add LENGTH CHARW) (add TX CHARW) (CHARACTER CHAR))) - .FR 28 CHARW " " .I4 TX 35 CSLOT) + .FR 28 CHARW " " .I4 TX 35 CHARCL 64 CSLOT) (ADD CHNO 1) elseif [AND [OR (CHARSLOTP CHAR THISLINE) (AND (NULL CHAR) @@ -1048,11 +1071,12 @@ T]) (CLEARTHISLINE - [LAMBDA (TSTREAM) (* ; "Edited 6-Mar-2025 11:28 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 11-Apr-2025 11:04 by rmk") + (* ; "Edited 6-Mar-2025 11:28 by rmk") (LET ((THISLINE (GETTOBJ (GTO TSTREAM) THISLINE))) (replace (THISLINE DESC) of THISLINE with NIL) - (for CSLOT incharslots THISLINE do (FILLCHARSLOT CSLOT NIL NIL]) + (for CSLOT incharslots THISLINE do (FILLCHARSLOT CSLOT NIL NIL NIL]) ) (DEFINEQ @@ -1290,7 +1314,8 @@ (DEFINEQ (SPPRINT - [LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 19-Feb-2025 12:21 by rmk") + [LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 24-Apr-2025 16:04 by rmk") + (* ; "Edited 19-Feb-2025 12:21 by rmk") (* ; "Edited 8-Feb-2025 22:41 by rmk") (* ; "Edited 5-Aug-2024 00:30 by rmk") (* ; "Edited 5-May-2024 12:55 by rmk") @@ -1379,7 +1404,7 @@ (PRIN1 "i " OSTREAM)) (PRIN1 "%"" OSTREAM) (for I C from 1 to PLEN - do (SETQ C (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ P I)) + do (SETQ C (\TEDIT.PIECE.NTHCHARCODE P I)) (PRIN1 (SELCHARQ C ((EOL CR) "[EOL]") @@ -2360,29 +2385,41 @@ (DECLARE%: EVAL@COMPILE -(PUTPROPS DEBUGOUTPUT MACRO - [ARGS - `(LET - [(OFILE ,(CAR ARGS)) - (WTYPE ,(CADR ARGS)) - (TITLE ,(CADDR ARGS] - (RESETLST - [if WTYPE - then [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE) - NIL NIL '(FONT DEFAULTFONT] - [RESETSAVE NIL - `(PROGN (CL:UNLESS RESETSTATE - [TEDIT OFILE WTYPE NIL - `(READONLY QUIET LEAVETTY T TITLE - ,(OR TITLE WTYPE] - (WINDOWPROP (WFROMDS OFILE) - 'TEDIT-DEBUG T))] - elseif OFILE - then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW)) - '(PROGN (CLOSEF? OLDVALUE] - [RESETSAVE (DSPFONT NIL OFILE) - '(PROGN (DSPFONT OLDVALUE OFILE] - ,@(CDDDR ARGS))]) +(PUTPROPS DEBUGOUTPUT MACRO [(FILE . FORMS) + (RESETLST + [LET ((OFILE FILE)) + [RESETSAVE (DSPFONT NIL OFILE) + '(PROGN (DSPFONT OLDVALUE OFILE] . FORMS])]) +) +(DEFINEQ + +(DEBUGOUTPUT.STREAM + [LAMBDA (OFILE WTYPE TITLE WIDTH FONT) (* ; "Edited 25-Apr-2025 09:11 by rmk") + (* ; "Edited 15-Apr-2025 13:55 by rmk") + (* ; "Edited 11-Apr-2025 12:13 by rmk") + + (* ;; "Passed as the first argument in a call to DEBUGOUTPUT") + + (CL:UNLESS FONT (SETQ FONT DEFAULTFONT)) + [if WTYPE + then [SETQ OFILE (OPENTEXTSTREAM + NIL + (REGIONP OFILE) + NIL NIL `(FONT ,FONT PARALOOKS + (RIGHTMARGIN ,(AND WIDTH (ITIMES WIDTH (CHARWIDTH + (CHARCODE SPACE) + FONT] + (CL:WHEN WIDTH (LINELENGTH WIDTH OFILE)) + (CL:UNLESS TITLE (SETQ TITLE WTYPE)) + [RESETSAVE NIL `(PROGN (CL:UNLESS RESETSTATE + [TEDIT ,OFILE ',WTYPE NIL '(READONLY QUIET LEAVETTY T TITLE + ,TITLE] + (WINDOWPROP (WFROMDS ,OFILE) + 'TEDIT-DEBUG T))] + elseif OFILE + then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW)) + '(PROGN (CLOSEF? OLDVALUE] + OFILE]) ) (DEFINEQ @@ -2469,30 +2506,31 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4984 7543 (GTO 4994 . 5244) (GTS 5246 . 7017) (GTW 7019 . 7175) (GSEL 7177 . 7541)) ( -7576 8135 (TEST.TEMPLATE 7586 . 8133)) (8136 9071 (TESTACTION 8146 . 9069)) (9096 22911 (IPC 9106 . -10610) (ILINES 10612 . 13153) (ISEL 13155 . 13766) (ITS 13768 . 15492) (IPANES 15494 . 15729) (ITL -15731 . 16150) (IHIST 16152 . 18814) (IPCTB 18816 . 19242) (IMB 19244 . 20003) (ICL 20005 . 20706) ( -IPL 20708 . 21248) (ICARET 21250 . 21777) (INSPECTPIECES 21779 . 22909)) (22933 50561 (SP 22943 . -27587) (SL 27589 . 31035) (SSP 31037 . 32592) (SPF 32594 . 35020) (SLF 35022 . 44155) (SHOWLINE 44157 - . 47719) (SLL 47721 . 48468) (STBYTES 48470 . 50196) (SSEL 50198 . 50559)) (50562 59579 (STL 50572 . -59208) (CLEARTHISLINE 59210 . 59577)) (59580 64953 (NTHPIECE 59590 . 60722) (NPIECES 60724 . 61589) ( -NTHPIECECHAR 61591 . 62899) (SELPIECE 62901 . 63343) (PIECENUM 63345 . 64064) (PCBYTES 64066 . 64951)) - (64954 67428 (FILEBYTES 64964 . 66388) (TFILEBYTES 66390 . 67426)) (67429 68751 (TRELMOVE 67439 . -67682) (TSCROLL 67684 . 67850) (TSCROLL* 67852 . 68749)) (68752 71801 (TRY 68762 . 70031) (TEDITCLOSEW - 70033 . 70376) (PARALASTWITHOUTEOL 70378 . 71263) (FIXPARALAST 71265 . 71799)) (71802 86449 (SPPRINT -71812 . 78397) (SPPRINT.CHAR 78399 . 79383) (SPPRINT.OBJ 79385 . 82443) (SHOWPIECEBYTES 82445 . 84001) - (CHECKPLENGTHS 84003 . 84460) (SBT 84462 . 85599) (COPYPCHAIN 85601 . 86447)) (86450 88511 (POSLINE -86460 . 88509)) (88512 89395 (PRESPLIT 88522 . 89393)) (89396 91109 (ALLTL 89406 . 90659) (NTHCHARSLOT - 90661 . 91107)) (91135 101348 (PLCHAIN 91145 . 91673) (PRINTLINE 91675 . 94665) (SL.GETLINES 94667 . -97960) (CHECKLINES 97962 . 98942) (COLLECTLINES 98944 . 99196) (NTHLINE 99198 . 100203) (HEIGHT 100205 - . 100493) (LINEBOTS 100495 . 101346)) (101349 103797 (IPC.DECODEARGS 101359 . 103795)) (103798 104391 - (SPF1 103808 . 104389)) (104420 106798 (SLF.FATPLEN 104430 . 105289) (FILEPIECE 105291 . 106796)) ( -106831 107599 (SELTEDIT 106841 . 107597)) (107669 113281 (PPARA 107679 . 108101) (PRUN 108103 . 109579 -) (ADDLINEPOSITIONS 109581 . 111008) (SBR 111010 . 111664) (SBC 111666 . 113279)) (113338 115114 ( -OLDWI 113348 . 113723) (COMP 113725 . 113920) (DFR 113922 . 115112)) (115115 116148 (DFGV 115125 . -115651) (GDIRECTORIES 115653 . 116146)) (116149 122714 (TTEST 116159 . 120691) (LTEST 120693 . 122058) - (THC 122060 . 122712)) (123028 123720 (SHOWSAFE 123038 . 123718)) (123773 124220 (MYH 123783 . 124218 -)) (124465 125560 (DFVENUE 124475 . 125354) (VSEE 125356 . 125558)) (125561 126015 (PTT 125571 . -126013)) (127250 129566 (TEDIT-DEBUG 127260 . 129564)) (129567 131303 (TRENAME 129577 . 131301))))) + (FILEMAP (NIL (5082 7641 (GTO 5092 . 5342) (GTS 5344 . 7115) (GTW 7117 . 7273) (GSEL 7275 . 7639)) ( +7674 8795 (TEST.TEMPLATE 7684 . 8793)) (8796 9731 (TESTACTION 8806 . 9729)) (9756 23571 (IPC 9766 . +11270) (ILINES 11272 . 13813) (ISEL 13815 . 14426) (ITS 14428 . 16152) (IPANES 16154 . 16389) (ITL +16391 . 16810) (IHIST 16812 . 19474) (IPCTB 19476 . 19902) (IMB 19904 . 20663) (ICL 20665 . 21366) ( +IPL 21368 . 21908) (ICARET 21910 . 22437) (INSPECTPIECES 22439 . 23569)) (23593 52261 (SP 23603 . +28647) (SL 28649 . 32484) (SSP 32486 . 34188) (SPF 34190 . 36720) (SLF 36722 . 45855) (SHOWLINE 45857 + . 49419) (SLL 49421 . 50168) (STBYTES 50170 . 51896) (SSEL 51898 . 52259)) (52262 61757 (STL 52272 . +61273) (CLEARTHISLINE 61275 . 61755)) (61758 67131 (NTHPIECE 61768 . 62900) (NPIECES 62902 . 63767) ( +NTHPIECECHAR 63769 . 65077) (SELPIECE 65079 . 65521) (PIECENUM 65523 . 66242) (PCBYTES 66244 . 67129)) + (67132 69606 (FILEBYTES 67142 . 68566) (TFILEBYTES 68568 . 69604)) (69607 70929 (TRELMOVE 69617 . +69860) (TSCROLL 69862 . 70028) (TSCROLL* 70030 . 70927)) (70930 73979 (TRY 70940 . 72209) (TEDITCLOSEW + 72211 . 72554) (PARALASTWITHOUTEOL 72556 . 73441) (FIXPARALAST 73443 . 73977)) (73980 88728 (SPPRINT +73990 . 80676) (SPPRINT.CHAR 80678 . 81662) (SPPRINT.OBJ 81664 . 84722) (SHOWPIECEBYTES 84724 . 86280) + (CHECKPLENGTHS 86282 . 86739) (SBT 86741 . 87878) (COPYPCHAIN 87880 . 88726)) (88729 90790 (POSLINE +88739 . 90788)) (90791 91674 (PRESPLIT 90801 . 91672)) (91675 93388 (ALLTL 91685 . 92938) (NTHCHARSLOT + 92940 . 93386)) (93414 103627 (PLCHAIN 93424 . 93952) (PRINTLINE 93954 . 96944) (SL.GETLINES 96946 . +100239) (CHECKLINES 100241 . 101221) (COLLECTLINES 101223 . 101475) (NTHLINE 101477 . 102482) (HEIGHT +102484 . 102772) (LINEBOTS 102774 . 103625)) (103628 106076 (IPC.DECODEARGS 103638 . 106074)) (106077 +106670 (SPF1 106087 . 106668)) (106699 109077 (SLF.FATPLEN 106709 . 107568) (FILEPIECE 107570 . 109075 +)) (109110 109878 (SELTEDIT 109120 . 109876)) (109948 115560 (PPARA 109958 . 110380) (PRUN 110382 . +111858) (ADDLINEPOSITIONS 111860 . 113287) (SBR 113289 . 113943) (SBC 113945 . 115558)) (115617 117393 + (OLDWI 115627 . 116002) (COMP 116004 . 116199) (DFR 116201 . 117391)) (117394 118427 (DFGV 117404 . +117930) (GDIRECTORIES 117932 . 118425)) (118428 124993 (TTEST 118438 . 122970) (LTEST 122972 . 124337) + (THC 124339 . 124991)) (125307 125999 (SHOWSAFE 125317 . 125997)) (126052 126499 (MYH 126062 . 126497 +)) (126744 127839 (DFVENUE 126754 . 127633) (VSEE 127635 . 127837)) (127840 128294 (PTT 127850 . +128292)) (128653 130234 (DEBUGOUTPUT.STREAM 128663 . 130232)) (130235 132551 (TEDIT-DEBUG 130245 . +132549)) (132552 134288 (TRENAME 132562 . 134286))))) STOP diff --git a/internal/TEDIT-DEBUG.LCOM b/internal/TEDIT-DEBUG.LCOM index 7d2900241..09a2f7afc 100644 Binary files a/internal/TEDIT-DEBUG.LCOM and b/internal/TEDIT-DEBUG.LCOM differ diff --git a/library/tedit/TEDIT b/library/tedit/TEDIT index a22f9a7e6..3715f30fe 100644 --- a/library/tedit/TEDIT +++ b/library/tedit/TEDIT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Mar-2025 12:04:22" {WMEDLEY}TEDIT>TEDIT.;792 141883 +(FILECREATED "27-Apr-2025 23:54:08" {WMEDLEY}tedit>TEDIT.;828 145045 :EDIT-BY rmk - :CHANGES-TO (FNS TDRIBBLE) + :CHANGES-TO (FNS \TEDIT.FINISHEDIT?) - :PREVIOUS-DATE "28-Mar-2025 14:10:12" {WMEDLEY}TEDIT>TEDIT.;791) + :PREVIOUS-DATE "26-Apr-2025 11:46:44" {WMEDLEY}tedit>TEDIT.;827) (PRETTYCOMPRINT TEDITCOMS) @@ -19,8 +19,8 @@ (* ;; "Would be nice to just do (DOFILESLOAD (CDR TEDITFILES)). But the order for exports.all and the order for loading have to be aligned.") (VARS TEDITFILES) - (FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS - TEDIT-STYLES) + (FILES TEDIT-PCTREE TEDIT-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND + TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES) (FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT) (DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE @@ -31,14 +31,14 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) UNICODE))) - (DECLARE%: EVAL@COMPILE DONTCOPY + [DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "Assertions go to comments if not being checked, so we see value-warnings") (EXPORT (COMS (MACROS TEDIT-ASSERT) + (MACROS FTEXTOBJ) (GLOBALVARS CHECK-TEDIT-ASSERTIONS) - (INITVARS (CHECK-TEDIT-ASSERTIONS T))) - (MACROS OBJECT.ALLOWS))) + (INITVARS (CHECK-TEDIT-ASSERTIONS T] (INITVARS (TEDIT.TENTATIVE NIL) (TEDIT.DEFAULT.PROPS NIL)) (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) @@ -69,8 +69,8 @@ (INITVARS (\TEDIT.THELPFLG NIL))) (FNS \TEDIT.PARAPIECES \TEDIT.PARACHNOS \TEDIT.PARA.FIRST \TEDIT.PARA.LAST) (FNS \TEDIT.WORD.FIRST \TEDIT.WORD.LAST) - (FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-SELECTION - TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) + (FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-TFBRAVO + TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) (COMS (* ; "TEDIT Support information") (E (SETQ TEDITSYSTEMDATE (DATE))) (VARS TEDITSYSTEMDATE)) @@ -99,8 +99,8 @@ TEDIT-MENU TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-PAGE TEDIT-ABBREV TEDIT-TFBRAVO)) -(FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES - ) +(FILESLOAD TEDIT-PCTREE TEDIT-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND TEDIT-ABBREV + TEDIT-LOOKS TEDIT-STYLES) (DEFINEQ (MAKE-TEDIT-EXPORTS.ALL @@ -170,19 +170,19 @@ ,(KWOTE (CAR ARGS])] (T ` (* (TEDIT-ASSERT (\,@ ARGS)))]) ) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS FTEXTOBJ MACRO [(X) + (TEXTOBJ! (CL:IF (type? TEXTOBJ X) + X + (GETTSTR X TEXTOBJ))]) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS CHECK-TEDIT-ASSERTIONS) ) (RPAQ? CHECK-TEDIT-ASSERTIONS T) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) - (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) - (\TEDIT.APPLY.OBJFN (PCONTENTS PC) - OPERATION FROMTOBJ TOTOBJ)))) -) (* "END EXPORTED DEFINITIONS") @@ -260,7 +260,8 @@ PROC]) (TEXTSTREAM - [LAMBDA (TSTREAM? NOERROR) (* ; "Edited 29-Apr-2024 12:50 by rmk") + [LAMBDA (TSTREAM? NOERROR) (* ; "Edited 25-Apr-2025 18:07 by rmk") + (* ; "Edited 29-Apr-2024 12:50 by rmk") (* ; "Edited 20-Mar-2024 08:51 by rmk") (* ; "Edited 24-Mar-2023 18:01 by rmk") (* jds "11-Jul-85 12:06") @@ -277,14 +278,13 @@ then (PROCESS.WINDOW TSTREAM?) elseif (DISPLAYSTREAMP TSTREAM?) then (WFROMDS TSTREAM?))) - then (if (type? TEXTSTREAM (SETQ X (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW))) - then X - elseif (type? TEXTOBJ (SETQ X (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW))) - then (FGETTOBJ X STREAMHINT)) + then (CL:WHEN (type? TEXTSTREAM (SETQ X (fetch (TEXTWINDOW WTEXTSTREAM) + of WINDOW))) + X) elseif (AND (type? SELECTION TSTREAM?) (FGETSEL TSTREAM? SET)) - then (CL:WHEN [type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) - of (SETQ X (FGETSEL TSTREAM? SELTEXTSTREAM] + then (CL:WHEN (type? TEXTOBJ (GETTSTR (SETQ X (FGETSEL TSTREAM? SELTEXTSTREAM)) + TEXTOBJ)) X))) (OR TS (CL:UNLESS NOERROR (ERROR TSTREAM? "is not a Tedit document"]) @@ -359,7 +359,8 @@ NIL]) (TEDIT.CONCAT - [LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 8-Feb-2025 20:58 by rmk") + [LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 21-Apr-2025 22:28 by rmk") + (* ; "Edited 8-Feb-2025 20:58 by rmk") (* ; "Edited 17-Mar-2024 00:21 by rmk") (* ; "Edited 18-Jan-2024 00:03 by rmk") @@ -369,12 +370,13 @@ (CL:UNLESS (CHARCODEP SEPARATOR) (SETQ SEPARATOR (OR (CHARCODE.DECODE SEPARATOR T) (MKSTRING SEPARATOR))))) + [SETQ TSTREAMS (for TS inside TSTREAMS collect (OR (TEXTSTREAM TS T) + (OPENTEXTSTREAM TS] (LET* ((CSTREAM (OPENTEXTSTREAM)) (CTEXTOBJ (TEXTOBJ CSTREAM)) - [TSTEXTOBJECTS (for TS inside TSTREAMS collect (OR (TEXTOBJ TS T) - (TEXTOBJ (OPENTEXTSTREAM TS] + (TSTEXTOBJECTS (for TS in TSTREAMS collect (FTEXTOBJ TS))) FIRSTTOBJ INITIALFILEPIECES) - (CL:WHEN TSTEXTOBJECTS + (CL:WHEN TSTREAMS (SETQ FIRSTTOBJ (CAR TSTEXTOBJECTS)) (* ;; "Take overall parameters from the first stream. ") @@ -384,17 +386,16 @@ (FSETTOBJ CTEXTOBJ TXTRTBL (FGETTOBJ FIRSTTOBJ TXTRTBL)) (FSETTOBJ CTEXTOBJ TXTWTBL (FGETTOBJ FIRSTTOBJ TXTWTBL)) (FSETTOBJ CTEXTOBJ TXTSTYLESHEET (FGETTOBJ FIRSTTOBJ TXTSTYLESHEET)) - (for TSOBJ PREVPC (LASTTOBJ _ (CAR (LAST TSTEXTOBJECTS))) - (FIRSTPC _ (create PIECE)) in TSTEXTOBJECTS first - (* ;; - "LASTTOBJ to suppress final separator") + (for TS PREVPC (LASTTOBJ _ (CAR (LAST TSTEXTOBJECTS))) + (FIRSTPC _ (create PIECE)) in TSTREAMS as TSOBJ in TSTEXTOBJECTS + first + (* ;; "LASTTOBJ to suppress final separator") - (SETQ PREVPC FIRSTPC) - (* ; "Dummy") + (SETQ PREVPC FIRSTPC) (* ; "Dummy") do (CL:WHEN (FGETTOBJ TSOBJ FORMATTEDP) (FSETTOBJ CTEXTOBJ FORMATTEDP T)) (for PC NEWPIECE inpieces (\TEDIT.FIRSTPIECE TSOBJ) - do (SETQ NEWPIECE (\TEDIT.COPYPIECE PC TSOBJ CTEXTOBJ NIL 'COPY)) + do (SETQ NEWPIECE (\TEDIT.COPYPIECE PC TS CTEXTOBJ NIL 'COPY)) (FSETPC PREVPC NEXTPIECE NEWPIECE) (FSETPC NEWPIECE PREVPIECE PREVPC) (SETQ PREVPC NEWPIECE)) @@ -480,7 +481,8 @@ (\TEDIT.COPY FROM TO FROMSTREAM TOSTREAM]) (TEDIT.DELETE - [LAMBDA (TSTREAM SEL LEN LEAVECARETLOOKS) (* ; "Edited 22-Jun-2024 00:06 by rmk") + [LAMBDA (TSTREAM SEL LEN LEAVECARETLOOKS) (* ; "Edited 6-Apr-2025 12:31 by rmk") + (* ; "Edited 22-Jun-2024 00:06 by rmk") (* ; "Edited 22-May-2024 09:44 by rmk") (* ; "Edited 23-May-2023 12:57 by rmk") (* ; "Edited 22-May-2023 10:54 by rmk") @@ -498,10 +500,11 @@ elseif (NULL SEL) then (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) (SELECTION! SEL) - (\TEDIT.DELETE TEXTOBJ SEL]) + (\TEDIT.DELETE TSTREAM SEL]) (TEDIT.INSERT - [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 2-Aug-2024 22:17 by rmk") + [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 4-Apr-2025 11:22 by rmk") + (* ; "Edited 2-Aug-2024 22:17 by rmk") (* ; "Edited 31-Jul-2024 12:13 by rmk") (* ; "Edited 23-Jul-2024 16:35 by rmk") (* ; "Edited 7-Jul-2024 12:33 by rmk") @@ -535,9 +538,13 @@ (SELECTION! CH#ORSEL) (if (FGETSEL CH#ORSEL SET) then (\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL) - (CL:WHEN LOOKS (* ; - "TEXTSEL now selects the insertion, apply the looks.") - (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS)) + (CL:WHEN LOOKS + + (* ;; "TEXTSEL now selects the insertion, apply the looks, but don't keep the looks-change as a separate event. We want it to behave as if the looks had been applied to the TEXT before the insertion (e.g. converting first to SELPIECES).") + + (LET ((HISTORY (FGETTOBJ TEXTOBJ TXTHISTORY))) + (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS) + (FSETTOBJ TEXTOBJ TXTHISTORY HISTORY))) else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T)))) ]) @@ -750,7 +757,9 @@ (DEFINEQ (TEDIT.INSERT.OBJECT - [LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 25-Feb-2025 11:18 by rmk") + [LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 21-Apr-2025 22:17 by rmk") + (* ; "Edited 6-Apr-2025 14:10 by rmk") + (* ; "Edited 25-Feb-2025 11:18 by rmk") (* ; "Edited 2-Feb-2025 11:37 by rmk") (* ; "Edited 26-Dec-2024 10:13 by rmk") (* ; "Edited 21-Oct-2024 00:26 by rmk") @@ -795,7 +804,7 @@  "If this is computed text in bulk, fix the length.") (\TEDIT.THELP "SUBSTREAM NOT IMPLEMENTED") (FSETPC OBJPC PTYPE SUBSTREAM.PTYPE) - (FSETPC OBJPC PLEN (TEXTLEN (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM)))) + (FSETPC OBJPC PLEN (TEXTLEN (FTEXTOBJ SUBSTREAM)))) (SETQ OBJSELPIECES (\TEDIT.SELPIECES.COPY (create SELPIECES SPLEN _ 1 @@ -803,7 +812,7 @@ SPLAST _ OBJPC SPFIRSTCHAR _ CH# SPLASTCHAR _ CH#) - 'INSERT TEXTOBJ)) + 'INSERT TSTREAM)) (CL:UNLESS OBJSELPIECES (* ; "Copy may not be allowed") (RETURN)) @@ -813,57 +822,69 @@  " OBJSELPIECES contains (a copy of) the object piece, and the object approved of insertion.") (SETQ SEL (TEXTSEL TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (CL:WHEN (type? SELECTION CH#) (SETQ CH# (GETSEL CH# CH#))) (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) - (\TEDIT.DELETE TEXTOBJ SEL)) + (\TEDIT.DELETE TSTREAM SEL)) (CL:WHEN CH# (\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ))) 0 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ)) + (\TEDIT.FIXSEL SEL TSTREAM)) (\TEDIT.INSERT.SELPIECES OBJSELPIECES TEXTOBJ SEL) (CL:WHEN LOOKS (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS SEL)) (\TEDIT.SCROLL.CARET TSTREAM) - (\TEDIT.SHOWSEL SEL T TEXTOBJ]) + (\TEDIT.SHOWSEL SEL T TSTREAM]) (TEDIT.EDIT.OBJECT - [LAMBDA (TSTREAM OBJ) (* ; "Edited 3-Oct-2024 22:08 by rmk") + [LAMBDA (TSTREAM OBJ) (* ; "Edited 6-Apr-2025 23:14 by rmk") + (* ; "Edited 3-Oct-2024 22:08 by rmk") (* ; "Edited 10-May-2024 22:42 by rmk") - (* ; "Edited 7-May-2024 08:18 by rmk") - (* ; "Edited 29-Apr-2024 12:41 by rmk") (* ; "Edited 15-Mar-2024 14:23 by rmk") (* ; "Edited 2-Dec-2023 09:57 by rmk") (* ; "Edited 19-May-2023 21:35 by rmk") (* ; "Edited 27-Apr-2023 00:14 by rmk") (* ; "Edited 21-Oct-2022 18:37 by rmk") (* ; "Edited 29-May-91 18:23 by jds") + + (* ;; "If OBJ, makes it be the selection and SELOBJ. Then edits SELOBJ") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (LET ((TEXTOBJ (TEXTOBJ! (FGETTSTR TSTREAM TEXTOBJ))) - SEL CH# EDITFN) - [COND - [(AND OBJ (IMAGEOBJP OBJ)) - (SETQ CH# (TEDIT.FIND.OBJECT TEXTOBJ OBJ)) - (COND - (CH# (SETQ SEL (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL))) - (\TEDIT.UPDATE.SEL SEL CH# 1) - (SETSEL SEL SELOBJ OBJ) - (\TEDIT.FIXSEL SEL TEXTOBJ)) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Can't find specified object." T] - (T (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (SETQ OBJ (GETSEL SEL SELOBJ] - (COND - (CH# (* ; + (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) + CH# EDITFN) + (if (IMAGEOBJP OBJ) + then (SETQ CH# (TEDIT.FIND.OBJECT TSTREAM OBJ)) + (if CH# + then (\TEDIT.NOSEL TSTREAM) + (\TEDIT.UPDATE.SEL TSTREAM CH# 1) + (\TEDIT.FIXSEL NIL TSTREAM) + (SETSEL (TEXTSEL TEXTOBJ) + SELOBJ OBJ) + (TEDIT.NORMALIZECARET TSTREAM) + else (TEDIT.PROMPTPRINT TSTREAM "Can't find the specified object" T T) + (RETURN)) + elseif OBJ + then (TEDIT.PROMPTPRINT TSTREAM (CONCAT OBJ " is not an image object") + T T) + (RETURN) + elseif (SETQ OBJ (GETSEL (TEXTSEL TEXTOBJ) + SELOBJ)) + else (TEDIT.PROMPTPRINT TSTREAM "Please select an editable object" T T) + (RETURN)) + (if (SETQ EDITFN (IMAGEOBJPROP OBJ 'EDITFN)) + then (* ;  "OK There's an object selected. Edit it.") - (SETQ EDITFN (IMAGEOBJPROP OBJ 'EDITFN)) - (CL:UNLESS (AND EDITFN (APPLY* EDITFN OBJ)) (* ; + (CL:UNLESS (AND EDITFN (APPLY* EDITFN OBJ)) + (* ;  "If the editfn makes a change, update the screen.") - (TEDIT.OBJECT.CHANGED TSTREAM OBJ))) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select an editable object" T T]) + (TEDIT.OBJECT.CHANGED TSTREAM OBJ)) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT OBJ " does not have an edit function" T]) (TEDIT.OBJECT.CHANGED - [LAMBDA (TSTREAM OBJECT PIECE/CH#/SEL) (* ; "Edited 26-Nov-2024 03:52 by rmk") + [LAMBDA (TSTREAM OBJECT PIECE/CH#/SEL) (* ; "Edited 21-Apr-2025 20:16 by rmk") + (* ; "Edited 20-Apr-2025 13:24 by rmk") + (* ; "Edited 26-Nov-2024 03:52 by rmk") (* ; "Edited 20-Oct-2024 12:08 by rmk") (* ; "Edited 19-Oct-2024 10:03 by rmk") (* ; "Edited 3-Oct-2024 22:58 by rmk") @@ -890,11 +911,11 @@ elseif (AND (type? SELECTION PIECE/CH#/SEL) (EQ OBJECT (FGETSEL PIECE/CH#/SEL SELOBJ))) then (FGETSEL PIECE/CH#/SEL CH#) - else (TEDIT.FIND.OBJECT TSTREAM OBJECT 1))) + else (TEDIT.FIND.OBJECT TSTREAM OBJECT 1))) (if CH# then (* ; "Change affected lines") - (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED CH# 1) - (\TEDIT.SHOWSEL NIL T TEXTOBJ) (* ; "And mark the document dirty.") + (\TEDIT.UPDATE.LINES TSTREAM 'CHANGED CH# 1) + (\TEDIT.SHOWSEL NIL T TSTREAM) (* ; "And mark the document dirty.") (FSETTOBJ TEXTOBJ \DIRTY T) else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T]) @@ -1075,26 +1096,27 @@ T]) (\TEDIT.READONLY - [LAMBDA (TEXTOBJ TYPE CHNO) (* ; "Edited 4-Jul-2024 13:40 by rmk") + [LAMBDA (TSTREAM TYPE CHNO) (* ; "Edited 20-Apr-2025 23:12 by rmk") + (* ; "Edited 4-Jul-2024 13:40 by rmk") (* ; "Edited 25-May-2024 10:01 by rmk") (* ; "Edited 22-May-2024 13:00 by rmk") (* ; "Edited 1-Feb-2024 17:33 by rmk") (* ; "Edited 13-Nov-2023 11:26 by rmk") - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (if (FGETTOBJ TEXTOBJ TXTREADONLY) - then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") - " is read only--aborted") - T T)) - 'READONLY - elseif [AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY) - (OR (NULL CHNO) - (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN] - then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") - " is append only--aborted") - T T)) - 'APPENDONLY]) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) + (if (FGETTOBJ TEXTOBJ TXTREADONLY) + then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") + " is read only--aborted") + T T)) + 'READONLY + elseif [AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + (OR (NULL CHNO) + (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN] + then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") + " is append only--aborted") + T T)) + 'APPENDONLY]) ) (DEFINEQ @@ -1107,7 +1129,8 @@ TEXTLEN))]) (TEDIT.RPLCHARCODE - [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 28-Mar-2025 09:58 by rmk") + [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:26 by rmk") + (* ; "Edited 28-Mar-2025 09:58 by rmk") (* ; "Edited 9-Feb-2025 12:21 by rmk") (* ; "Edited 7-Feb-2025 08:02 by rmk") (* ; "Edited 23-Sep-2024 00:36 by rmk") @@ -1143,7 +1166,7 @@ (CL:WHEN [AND NEWCHARLOOKS (NOT (OR (FONTP NEWCHARLOOKS) (type? CHARLOOKS NEWCHARLOOKS] (\ILLEGAL.ARG NEWCHARLOOKS)) - (\TEDIT.RPLCHARCODE TSTREAM NEWCHARCODE NEWCHARLOOKS DONTDISPLAY]) + (\TEDIT.RPLCHARCODE TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY]) (TEDIT.NTHCHARCODE [LAMBDA (TSTREAM N) (* ; "Edited 28-Mar-2025 14:10 by rmk") @@ -1223,7 +1246,10 @@ (T TSTREAM)))]) (\TEDIT.INSERT - [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 5-Jan-2025 23:01 by rmk") + [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 21-Apr-2025 20:16 by rmk") + (* ; "Edited 20-Apr-2025 13:26 by rmk") + (* ; "Edited 6-Apr-2025 14:12 by rmk") + (* ; "Edited 5-Jan-2025 23:01 by rmk") (* ; "Edited 28-Nov-2024 09:53 by rmk") (* ; "Edited 25-Nov-2024 22:05 by rmk") (* ; "Edited 18-Nov-2024 15:53 by rmk") @@ -1254,7 +1280,7 @@ (CL:WHEN [AND (GETSEL SEL SET) (OR (CHARCODEP INSERT) (NEQ 0 (NCHARS INSERT] - [PROG* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + [PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PARACHARS (FGETTOBJ TEXTOBJ PARABREAKCHARS)) NCHARSADDED CARETCHNO) @@ -1263,7 +1289,7 @@ (CL:WHEN (\TEDIT.READONLY TEXTOBJ NIL CARETCHNO) (RETURN NIL)) (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) (* ; "Blue pending delete?") - (\TEDIT.DELETE TEXTOBJ SEL)) + (\TEDIT.DELETE TSTREAM SEL)) (SETQ CARETCHNO (TEDIT.GETPOINT TEXTOBJ SEL)) (if (CHARCODEP INSERT) then @@ -1286,7 +1312,7 @@ (* ;; "The piece table is now correct: NCHARSADDED new characters have been been added in front of CARETCHNO. ") - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.") @@ -1302,13 +1328,17 @@ (* ;; "All the panes must be updated. SELPANE mayalso need to be scrolled to make the caret visible for the next input.") - (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CARETCHNO NCHARSADDED) + (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION CARETCHNO NCHARSADDED) (CL:WHEN (EQ SEL (TEXTSEL TEXTOBJ)) - (\TEDIT.SHOWSEL SEL T TEXTOBJ)) + (\TEDIT.SHOWSEL SEL T TSTREAM)) (CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])]) (\TEDIT.MOVE - [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 6-Feb-2025 16:17 by rmk") + [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 22-Apr-2025 09:21 by rmk") + (* ; "Edited 16-Apr-2025 09:01 by rmk") + (* ; "Edited 6-Apr-2025 14:14 by rmk") + (* ; "Edited 5-Apr-2025 13:18 by rmk") + (* ; "Edited 6-Feb-2025 16:17 by rmk") (* ; "Edited 8-Dec-2024 21:37 by rmk") (* ; "Edited 26-Nov-2024 22:34 by rmk") (* ; "Edited 22-Nov-2024 15:42 by rmk") @@ -1337,8 +1367,8 @@ (* ;; "If they are in separate texts, then the modifcations to TO go into TO's history (pending delete and insert), the deletion of FROM is an event in its object. In that case it will require undos in both objects to get them both back to the original state.") (CL:UNLESS (EQ 0 (GETSEL FROMSEL DCH)) - [PROG* ((FROMOBJ (GETTSTR FROMTSTREAM TEXTOBJ)) - (TOOBJ (GETTSTR TOTSTREAM TEXTOBJ)) + [PROG* ((FROMOBJ (FTEXTOBJ FROMTSTREAM)) + (TOOBJ (FTEXTOBJ TOTSTREAM)) (TOCH# (FGETSEL TOSEL CH#)) (TODCH (FGETSEL TOSEL DCH)) (TOPOINT (FGETSEL TOSEL POINT)) @@ -1376,14 +1406,14 @@ (* ;; "Grab (a copy of) the source pieces, if image objects allow copying. FROMPIECES is essentially a clipboard for extract/insert--the FROMOBJ has not yet been changed.") (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROMSEL NIL FROMOBJ) - 'MOVE TOOBJ FROMOBJ)) + 'MOVE TOTSTREAM FROMTSTREAM)) (CL:UNLESS FROMPIECES (* ;; "If bailing, should we undo the BPDEVENT (if history is ON)?") (RETURN)) - (\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ) - (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) + (\TEDIT.NOSEL FROMTSTREAM) + (\TEDIT.NOSEL TOTSTREAM) (* ;; "No need to recheck allowance") @@ -1392,9 +1422,10 @@ (* ;;  "Can't call \TEDIT.DELETE because we don't want to implicitly update the TOSEL for the insert.") - (\TEDIT.DELETE.SELPIECES FROMOBJ FROMSEL NIL T) + (\TEDIT.DELETE.SELPIECES FROMTSTREAM FROMSEL NIL T) (\TEDIT.SEL.DELETEDCHARS TOSEL FROMSEL) - (\TEDIT.UPDATE.LINES FROMOBJ 'DELETION FROMSEL) + (\TEDIT.UPDATE.LINES FROMTSTREAM 'DELETION (FGETSEL FROMSEL CH#) + (FGETSEL FROMSEL DCH)) (* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).") @@ -1411,10 +1442,9 @@ (\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ) (\TEDIT.POPEVENT TOOBJ)))) (RETURN)) - (\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL) + (\TEDIT.INSERT.SELPIECES FROMPIECES TOTSTREAM TOSEL) (\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL) - (\TEDIT.FIXSEL TOSEL TOOBJ) - (\TEDIT.SHOWSEL TOSEL T TOOBJ) + (\TEDIT.SHOWSEL TOSEL T TOTSTREAM) (* ;; "") @@ -1426,7 +1456,10 @@ (CL:IF BPD (\TEDIT.POPEVENT TOOBJ])]) (\TEDIT.COPY - [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 18-Mar-2025 23:13 by rmk") + [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 22-Apr-2025 09:12 by rmk") + (* ; "Edited 6-Apr-2025 14:16 by rmk") + (* ; "Edited 5-Apr-2025 13:19 by rmk") + (* ; "Edited 18-Mar-2025 23:13 by rmk") (* ; "Edited 23-Nov-2024 22:45 by rmk") (* ; "Edited 22-Nov-2024 15:44 by rmk") (* ; "Edited 13-Sep-2024 22:28 by rmk") @@ -1460,13 +1493,13 @@ (* ;; "Grab (a copy of) the source pieces, if image object allows") (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROMSEL NIL FROMOBJ) - 'COPY TOOBJ FROMOBJ)) + 'COPY TOTSTREAM FROMTSTREAM)) (CL:UNLESS FROMPIECES (RETURN)) (* ;; "No object objected") - (\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ) (* ; "Turn off any current highlighting") - (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) + (\TEDIT.NOSEL FROMTSTREAM) (* ; "Turn off any current highlighting") + (\TEDIT.NOSEL TOTSTREAM) (* ;; "") @@ -1482,8 +1515,8 @@ (if (FGETTOBJ TOOBJ BLUEPENDINGDELETE) then (FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL) - (\TEDIT.REPLACE.SELPIECES FROMPIECES TOOBJ TOSEL) - else (\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL)) + (\TEDIT.REPLACE.SELPIECES FROMPIECES TOTSTREAM TOSEL) + else (\TEDIT.INSERT.SELPIECES FROMPIECES TOTSTREAM TOSEL)) (* ;; "") @@ -1491,14 +1524,14 @@ (* ;; "") - (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) (* ; + (\TEDIT.NOSEL TOTSTREAM) (* ;  "Take down anything that might thave appeared") - (\TEDIT.FIXSEL TOSEL TOOBJ) - (\TEDIT.SHOWSEL TOSEL T TOOBJ) + (\TEDIT.SHOWSEL TOSEL T TOTSTREAM) (\TEDIT.SCROLL.CARET TOTSTREAM)))]) (\TEDIT.REPLACE.SELPIECES - [LAMBDA (INSERTSELPIECES TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 15:46 by rmk") + [LAMBDA (INSERTSELPIECES TSTREAM SEL) (* ; "Edited 21-Apr-2025 22:29 by rmk") + (* ; "Edited 19-Mar-2025 15:46 by rmk") (* ; "Edited 8-Dec-2024 13:46 by rmk") (* ; "Edited 26-Nov-2024 17:37 by rmk") (* ; "Edited 29-Sep-2024 00:24 by rmk") @@ -1520,16 +1553,17 @@ (* ;;  "On return, the pieces, lines, selection, and display are complete, correct, and consistent ") - (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) - [PROG ((POINT (GETSEL SEL POINT)) + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + [PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (POINT (GETSEL SEL POINT)) (CH# (FGETSEL SEL CH#)) (DCH (FGETSEL SEL DCH)) DELEVENT ILEN) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.SHOWSEL SEL NIL TSTREAM) (* ;; "We first delete, then insert, updating the display after the second operation.") - (CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ CH# DCH) + (CL:WHEN (\TEDIT.DELETE.SELPIECES TSTREAM CH# DCH) (* ;; "Reduce to a point to the right of the last remaining character so that FIXSEL sees starting character in its proper line.") @@ -1537,7 +1571,7 @@ 0 'RIGHT 'NORMAL) - (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.FIXSEL SEL TSTREAM) (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) (SETQ DELEVENT (\TEDIT.LASTEVENT TEXTOBJ T))) (* ; "Catch the deletion event") @@ -1557,13 +1591,14 @@ (SETTH DELEVENT THPOINT POINT)) (\TEDIT.UPDATE.SEL SEL CH# ILEN POINT) (if (IGREATERP ILEN DCH) - then (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CH# (IDIFFERENCE ILEN DCH)) + then (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION CH# (IDIFFERENCE ILEN DCH)) elseif (ILESSP ILEN DCH) - then (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION CH# (IDIFFERENCE DCH ILEN)) - else (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS CH# DCH)))])]) + then (\TEDIT.UPDATE.LINES TSTREAM 'DELETION CH# (IDIFFERENCE DCH ILEN)) + else (\TEDIT.UPDATE.LINES TSTREAM 'LOOKS CH# DCH)))])]) (\TEDIT.INSERT.SELPIECES - [LAMBDA (SELPIECES TEXTOBJ TARGETSEL DONTUPDATE) (* ; "Edited 26-Nov-2024 11:04 by rmk") + [LAMBDA (SELPIECES TSTREAM TARGETSEL DONTUPDATE) (* ; "Edited 20-Apr-2025 23:19 by rmk") + (* ; "Edited 26-Nov-2024 11:04 by rmk") (* ; "Edited 31-Oct-2024 18:01 by rmk") (* ; "Edited 22-Sep-2024 18:37 by rmk") (* ; "Edited 15-Aug-2024 10:49 by rmk") @@ -1585,9 +1620,10 @@ (* ;; "\TEDIT.INSERTCH.HISTORY uses the first piece to decide whether it is in a consecutive run of insertions.") (CL:WHEN SELPIECES - (LET ((INSCH# (TEDIT.GETPOINT TEXTOBJ TARGETSEL)) - (SPLEN (fetch (SELPIECES SPLEN) of SELPIECES)) - (SPFIRST (fetch (SELPIECES SPFIRST) of SELPIECES)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (INSCH# (TEDIT.GETPOINT TSTREAM TARGETSEL)) + (SPLEN (GETSPC SELPIECES SPLEN)) + (SPFIRST (GETSPC SELPIECES SPFIRST)) NEXTPC) (SETQ NEXTPC (\TEDIT.ALIGNEDPIECE INSCH# TEXTOBJ)) (\TEDIT.INSERTPIECES SPFIRST NEXTPC TEXTOBJ) @@ -1599,7 +1635,7 @@ (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) INSCH# SPLEN 'RIGHT) - (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION INSCH# SPLEN)) + (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION INSCH# SPLEN)) (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Insert INSCH# SPLEN NIL SPFIRST))))]) @@ -1636,7 +1672,8 @@ WINDOW TSTREAM))]) (\TEDIT.CHARDELETE - [LAMBDA (TSTREAM FORWARD) (* ; "Edited 28-Nov-2024 10:14 by rmk") + [LAMBDA (TSTREAM FORWARD) (* ; "Edited 6-Apr-2025 12:28 by rmk") + (* ; "Edited 28-Nov-2024 10:14 by rmk") (* ; "Edited 27-Nov-2024 09:18 by rmk") (* ; "Edited 29-Sep-2024 21:04 by rmk") (* ; "Edited 22-Sep-2024 18:56 by rmk") @@ -1651,7 +1688,7 @@ (* ;; "This identifies the character before or after the current caret position, and deletes it.") (CL:UNLESS (\TEDIT.READONLY TSTREAM) - (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (SEL (TEXTSEL TEXTOBJ)) (DCH (GETSEL SEL DCH)) CH#) @@ -1673,13 +1710,14 @@ (SETQ DCH 1) else (RETURN)) - (\TEDIT.DELETE TEXTOBJ CH# DCH (CL:IF FORWARD + (\TEDIT.DELETE TSTREAM CH# DCH (CL:IF FORWARD 'RIGHT 'LEFT)) (\TEDIT.SCROLL.CARET TSTREAM)))]) (\TEDIT.COPYPIECE - [LAMBDA (PC FROMOBJ TOOBJ UNPROTECT OPERATION PROMPTTEXTOBJ) + [LAMBDA (PC FROMTSTREAM TOTSTREAM UNPROTECT OPERATION PROMPTTEXTOBJ) + (* ; "Edited 22-Apr-2025 00:12 by rmk") (* ; "Edited 3-Aug-2024 12:40 by rmk") (* ; "Edited 15-Oct-2023 20:14 by rmk") (* ; "Edited 30-Jul-2023 22:44 by rmk") @@ -1688,14 +1726,15 @@ (* ; "Edited 7-May-2023 11:46 by rmk") (* ; "Edited 12-Jun-90 17:50 by mitani") - (* ;; "TEXTOBJ's prompt gets the message that a copy is not allowed, the FROMOBJ and TOOBJ provide the streams for the object's copy function. The copy is disconnected from PC's original connections.") + (* ;; "PROMPTTEXTOBJ's prompt gets the message that a copy is not allowed, the FROMOBJ and TOOBJ provide the streams for the object's copy function. The copy is disconnected from PC's original connections.") (* ;; "If UNPROTECT, the copies of protected pieces are unprotected") (* ;; "OPERATION keys which imageobject function to apply, if any") - (PROG (NEWPC SRCPFILE (CROSSCOPY (NEQ FROMOBJ TOOBJ))) (* ; - "No matter what, we need a fresh copy.") + (PROG ((TOOBJ (FTEXTOBJ TOTSTREAM)) + (CROSSCOPY (NEQ FROMTSTREAM TOTSTREAM)) + NEWPC SRCPFILE) (SETQ NEWPC (create PIECE using PC PNEW _ T PREVPIECE _ NIL NEXTPIECE _ NIL PTREENODE _ NIL)) (SELECTC (PTYPE PC) @@ -1727,13 +1766,15 @@ (OBJECT.PTYPE (* ;  "No copy if object doesn't allow it. Caller must be prepared for NIL?") (FSETPC NEWPC PCONTENTS (OR (\TEDIT.APPLY.OBJFN (PCONTENTS NEWPC) - OPERATION FROMOBJ TOOBJ PROMPTTEXTOBJ) + OPERATION FROMTSTREAM TOTSTREAM + PROMPTTEXTOBJ) (RETURN NIL)))) NIL) (* ;; "If moving from one text to another, we have to register the looks.") - (if (AND UNPROTECT (ffetch CLPROTECTED of (PLOOKS NEWPC))) + (if (AND UNPROTECT (FGETCLOOKS (PLOOKS NEWPC) + CLPROTECTED)) then (FSETPC NEWPC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS using (PLOOKS PC) CLPROTECTED _ NIL @@ -1747,7 +1788,8 @@ (RETURN NEWPC]) (\TEDIT.APPLY.OBJFN - [LAMBDA (OBJ OPERATION FROMTOBJ TOTOBJ PROMPTTEXTOBJ) (* ; "Edited 25-Jun-2024 11:59 by rmk") + [LAMBDA (OBJ OPERATION FROMTSTREAM TOTSTREAM PROMPTTEXTOBJ)(* ; "Edited 21-Apr-2025 21:07 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 15-Mar-2024 15:38 by rmk") (* ; "Edited 15-Jul-2023 10:43 by rmk") (* ; "Edited 9-Jul-2023 16:24 by rmk") @@ -1758,24 +1800,24 @@ (* ;; "As part of an OPERATION on an image object piece, we execute the appropriate object functions. If any of them returns DONT, we print a message in the prompt window of PROMPTTEXTOBJ or FROMTOBJ, and return NIL. Otherwise, we return an object, either OBJ or a copy.") - (CL:UNLESS TOTOBJ (SETQ TOTOBJ FROMTOBJ)) - (PROG [NEWOBJ (OBJFN (IMAGEOBJPROP OBJ (SELECTQ OPERATION - (COPY 'COPYFN) - (MOVE 'WHENMOVEDFN) - (INSERT 'WHENINSERTEDFN) - (DELETE (* ; + (CL:UNLESS TOTSTREAM (SETQ TOTSTREAM FROMTSTREAM)) + (PROG ((OBJFN (IMAGEOBJPROP OBJ (SELECTQ OPERATION + (COPY 'COPYFN) + (MOVE 'WHENMOVEDFN) + (INSERT 'WHENINSERTEDFN) + (DELETE (* ;  "This may want to apply to the first pane?") - 'WHENDELETEDFN) - NIL] + 'WHENDELETEDFN) + NIL))) + NEWOBJ) (SETQ NEWOBJ (if OBJFN - then (APPLY* OBJFN OBJ (fetch (TEXTOBJ STREAMHINT) of FROMTOBJ) - (CL:UNLESS (EQ OPERATION 'DELETE) - (fetch (TEXTOBJ STREAMHINT) of TOTOBJ))) + then (APPLY* OBJFN OBJ FROMTSTREAM (CL:UNLESS (EQ OPERATION 'DELETE) + TOTSTREAM)) elseif (EQ OPERATION 'COPY) then (COPYALL OBJ) else OBJ)) (CL:WHEN (MEMB NEWOBJ '(DON'T DONT)) - (TEDIT.PROMPTPRINT (OR PROMPTTEXTOBJ FROMTOBJ) + (TEDIT.PROMPTPRINT (OR PROMPTTEXTOBJ FROMTSTREAM) (CONCAT (L-CASE OPERATION T) " of this object not allowed.") T) @@ -1785,36 +1827,29 @@ (CL:WHEN [AND (EQ OPERATION 'COPY) (SETQ OBJFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (\TEDIT.PRIMARYPANE TOTOBJ) + (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (\TEDIT.PRIMARYPANE TOTSTREAM) 'DSP) - (fetch (TEXTOBJ STREAMHINT) of FROMTOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOTOBJ)) + FROMTSTREAM TOTSTREAM) '(DON'T DONT] (RETURN NIL)) (RETURN (OR (IMAGEOBJP NEWOBJ) OBJ]) (\TEDIT.DELETE - [LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "Edited 19-Mar-2025 11:22 by rmk") + [LAMBDA (TSTREAM TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "Edited 22-Apr-2025 09:58 by rmk") + (* ; "Edited 20-Apr-2025 13:27 by rmk") + (* ; "Edited 6-Apr-2025 12:03 by rmk") + (* ; "Edited 19-Mar-2025 11:22 by rmk") (* ; "Edited 6-Feb-2025 00:14 by rmk") (* ; "Edited 8-Dec-2024 21:39 by rmk") - (* ; "Edited 28-Nov-2024 10:13 by rmk") - (* ; "Edited 27-Nov-2024 09:18 by rmk") (* ; "Edited 13-Sep-2024 22:30 by rmk") - (* ; "Edited 8-Sep-2024 00:07 by rmk") (* ; "Edited 7-Jul-2024 12:07 by rmk") (* ; "Edited 23-Jun-2024 19:27 by rmk") (* ; "Edited 18-May-2024 16:20 by rmk") - (* ; "Edited 12-May-2024 20:51 by rmk") - (* ; "Edited 23-Apr-2024 07:35 by rmk") (* ; "Edited 24-Apr-2024 10:42 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 21-Feb-2024 20:40 by rmk") - (* ; "Edited 20-Feb-2024 20:09 by rmk") - (* ; "Edited 19-Feb-2024 11:48 by rmk") - (* ; "Edited 16-Feb-2024 08:46 by rmk") (* ; "Edited 12-Nov-2023 12:14 by rmk") - (* ; "Edited 29-Oct-2023 00:19 by rmk") (* ; "Edited 6-Jun-2023 12:48 by rmk") (* ; "Edited 29-May-91 18:22 by jds") @@ -1827,46 +1862,45 @@ (* ;; "If this is called as part of a move, SEL should end up at the location of the insert, adjusted if the TARGETSEL comes earlier. If this is just a delete, SEL should end up as a point selection at TARGETSEL's CH#.") - (CL:UNLESS TARGETSEL/CHAR - (SETQ TARGETSEL/CHAR (TEXTSEL TEXTOBJ))) - (LET ((SEL (TEXTSEL TEXTOBJ)) - CLOOKS FIRSTCHAR) - [if (type? SELECTION TARGETSEL/CHAR) - then (SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL/CHAR)) - (SETQ FIRSTCHAR (FGETSEL TARGETSEL/CHAR CH#)) - (CL:UNLESS LEN - (SETQ LEN (FGETSEL TARGETSEL/CHAR DCH))) - (SETQ POINT (FGETSEL TARGETSEL/CHAR POINT)) - else (SETQ FIRSTCHAR TARGETSEL/CHAR) - (CL:UNLESS POINT - (SETQ POINT 'LEFT))] - [SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ (CL:IF (EQ POINT 'LEFT) - (SUB1 FIRSTCHAR) - (IPLUS FIRSTCHAR LEN))] - (CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ FIRSTCHAR LEN DONTCHECK) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (SEL (TEXTSEL TEXTOBJ)) + CLOOKS FIRSTCHAR) + (CL:UNLESS TARGETSEL/CHAR (SETQ TARGETSEL/CHAR SEL)) + [if (type? SELECTION TARGETSEL/CHAR) + then (SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL/CHAR)) + (SETQ FIRSTCHAR (FGETSEL TARGETSEL/CHAR CH#)) + (CL:UNLESS LEN + (SETQ LEN (FGETSEL TARGETSEL/CHAR DCH))) + (SETQ POINT (FGETSEL TARGETSEL/CHAR POINT)) + else (SETQ FIRSTCHAR TARGETSEL/CHAR) + (CL:UNLESS POINT + (SETQ POINT 'LEFT))] + [SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ (CL:IF (EQ POINT 'LEFT) + FIRSTCHAR + (IPLUS -1 FIRSTCHAR LEN))] + (CL:WHEN (\TEDIT.DELETE.SELPIECES TSTREAM FIRSTCHAR LEN DONTCHECK) (* ;  "Delete the selected characters (if objects allow)") - (* ;; "Pieces are gone, make lines, SEL, and caret looks consistent with current text.") + (* ;; + "Pieces are gone, make lines, SEL, and caret looks consistent with current text.") - (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION FIRSTCHAR LEN) - (FSETTOBJ TEXTOBJ CARETLOOKS CLOOKS) + (\TEDIT.UPDATE.LINES TSTREAM 'DELETION FIRSTCHAR LEN) + (FSETTOBJ TEXTOBJ CARETLOOKS CLOOKS) - (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") + (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") - (\TEDIT.SEL.DELETEDCHARS SEL FIRSTCHAR LEN) + (\TEDIT.SEL.DELETEDCHARS SEL FIRSTCHAR LEN) - (* ;; "In any event, TARGETSEL's characters are all gone, reduce it to a point selection in case it is still in use. And then SEL moves to the position of the deletion.") + (* ;; "In any event, TARGETSEL's characters are all gone, reduce it to a point selection in case it is still in use. And then SEL moves to the position of the deletion.") - (* ;; "This is to the right of the last remaining character so that FIXSEL sees starting character in its proper line.") + (* ;; "This is to the right of the last remaining character so that FIXSEL sees starting character in its proper line.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL (SUB1 FIRSTCHAR) - 0 - 'RIGHT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) - T)]) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.UPDATE.SEL TSTREAM (SUB1 FIRSTCHAR) + 0 + 'RIGHT) + T)]) (\TEDIT.DIFFUSE.PARALOOKS [LAMBDA (PRIORPC SUCCEEDINGPC) (* ; "Edited 16-Feb-2024 00:07 by rmk") @@ -1894,7 +1928,8 @@ (PPARALAST PC)) do (FSETPC PC PPARALOOKS PPLOOKS)))]) (\TEDIT.WORDDELETE - [LAMBDA (TSTREAM) (* ; "Edited 27-Nov-2024 23:21 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 12:31 by rmk") + (* ; "Edited 27-Nov-2024 23:21 by rmk") (* ; "Edited 31-Oct-2024 17:47 by rmk") (* ; "Edited 7-Jul-2024 11:35 by rmk") (* ; "Edited 29-Apr-2024 11:01 by rmk") @@ -1903,8 +1938,7 @@ (* ; "Edited 23-May-2023 16:37 by rmk") (* ; "Edited 22-May-2023 10:52 by rmk") (* ; "Edited 29-May-91 18:22 by jds") - (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) - LASTNO FIRSTNO) + (LET (LASTNO FIRSTNO) (SETQ LASTNO (SUB1 (TEDIT.GETPOINT TSTREAM))) (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") @@ -1912,10 +1946,11 @@ (CL:UNLESS (ILEQ LASTNO 0) (* ;  "Nothing to delete at start of file.") (SETQ FIRSTNO (\TEDIT.WORD.FIRST TSTREAM LASTNO)) - (\TEDIT.DELETE TEXTOBJ FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) + (\TEDIT.DELETE TSTREAM FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) (\TEDIT.WORDDELETE.FORWARD - [LAMBDA (TSTREAM) (* ; "Edited 27-Nov-2024 20:31 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 12:30 by rmk") + (* ; "Edited 27-Nov-2024 20:31 by rmk") (* ; "Edited 31-Oct-2024 17:47 by rmk") (* ; "Edited 7-Jul-2024 11:35 by rmk") (* ; "Edited 29-Apr-2024 10:59 by rmk") @@ -1927,18 +1962,20 @@ (* ;; "This deletes all characters from the character just after the caret to the end of the following word, skipping over separators to reach the target word.") - (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) - FIRSTNO LASTNO) + (LET (FIRSTNO LASTNO) (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") (SETQ FIRSTNO (TEDIT.GETPOINT TSTREAM)) - (CL:UNLESS (IGREATERP FIRSTNO (TEXTLEN TEXTOBJ)) (* ; "Nothing to delete at end of file.") + (CL:UNLESS (IGREATERP FIRSTNO (TEXTLEN (FTEXTOBJ TSTREAM))) + (* ; "Nothing to delete at end of file.") (SETQ LASTNO (\TEDIT.WORD.LAST TSTREAM FIRSTNO)) - (\TEDIT.DELETE TEXTOBJ FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) + (\TEDIT.DELETE TSTREAM FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) (\TEDIT.FINISHEDIT? - [LAMBDA (TSTREAM NOFORCE) (* ; "Edited 14-Jul-2024 12:25 by rmk") + [LAMBDA (TSTREAM NOFORCE) (* ; "Edited 27-Apr-2025 23:53 by rmk") + (* ; "Edited 19-Apr-2025 10:47 by rmk") + (* ; "Edited 14-Jul-2024 12:25 by rmk") (* ; "Edited 1-Jul-2024 16:11 by rmk") (* ; "Edited 30-Jun-2024 12:36 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") @@ -1949,9 +1986,9 @@ (* ; "Edited 20-Sep-2023 23:24 by rmk") (* ; "Edited 12-Jun-90 17:50 by mitani") - (* ;; "Called to determine whether the edit in TSTREAM can be terminated. If there are no active operations and non of the QUITFNS (if any) returns DON'T, then the stream EDITFINISHEDFLG is set to T and NIL is returned. Setting the flag to T will allow the edit process to terminate.") + (* ;; "Called to determine whether the edit in TSTREAM can be terminated. If there are no active operations and non of the QUITFNS (if any) returns DON'T, then the stream EDITFINISHEDFLG is set to T and T is returned. Setting the flag to T allows the edit process to terminate.") - (* ;; "Otherwise, the return value is DON'T, so that this can be used by itself to guard closing as a CLOSEWFN.") + (* ;; "Otherwise, the return value is DON'T, so that this can be used by itself to guard closing as a window CLOSEFN.") (* ;; "Menus can always be closed.") @@ -1963,12 +2000,15 @@ (* ;; "We're busy doing something, don't close with a message") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Not closed: " (CL:IF (EQ T (FGETTOBJ TEXTOBJ - EDITOPACTIVE)) - "Edit" - (FGETTOBJ TEXTOBJ EDITOPACTIVE)) - " operation in progress") - T) + (CL:UNLESS (STRING.EQUAL "Get" (FGETTOBJ TEXTOBJ EDITOPACTIVE)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Not closed: " (CL:IF (EQ T (FGETTOBJ TEXTOBJ + EDITOPACTIVE + )) + "Edit" + (FGETTOBJ TEXTOBJ + EDITOPACTIVE)) + " operation in progress") + T)) (RETURN 'DON'T)) [for QUITFN (PRIMPANE _ (FGETTOBJ TEXTOBJ PRIMARYPANE)) inside QUITFNS until (OR (EQ QUITFLG 'DON'T) @@ -2003,7 +2043,7 @@ 'WINDOW] (TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS))) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T) - (RETURN NIL]) + (RETURN T]) ) (DEFINEQ @@ -2067,7 +2107,8 @@ when (PPARALAST PC) collect CHNO repeatuntil (EQ PC LASTPARAPC]) (\TEDIT.PARA.FIRST - [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 30-Jan-2025 12:02 by rmk") + [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 26-Apr-2025 11:33 by rmk") + (* ; "Edited 30-Jan-2025 12:02 by rmk") (* ; "Edited 11-Jan-2025 00:08 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 19-Jan-2024 10:10 by rmk") @@ -2105,7 +2146,7 @@ (* ;; "If the iteration reached the beginning, there is no PREVPIECE. Otherwise, PC is the previous PARALAST, and we have to take its next") (RETURN (CONS (IDIFFERENCE START PLENTOT) - (CL:IF PC + (CL:IF (PREVPIECE PC) (NEXTPIECE PC) (\TEDIT.FIRSTPIECE TEXTOBJ))]) @@ -2258,15 +2299,15 @@ else CHNO]) ) -(FILESLOAD TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-SELECTION - TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) +(FILESLOAD TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-TFBRAVO TEDIT-HCPY + TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE "31-Mar-2025 12:04:23") +(RPAQQ TEDITSYSTEMDATE "27-Apr-2025 23:54:08") @@ -2276,26 +2317,26 @@ (ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) (EXTENSION (TEDIT)))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4795 7189 (MAKE-TEDIT-EXPORTS.ALL 4805 . 5351) (UPDATE-TEDIT 5353 . 6282) (EDIT-TEDIT -6284 . 7187)) (8697 36163 (TEDIT 8707 . 11285) (TEXTSTREAM 11287 . 13207) (TEXTSTREAMP 13209 . 13593) -(COERCETEXTSTREAM 13595 . 17806) (TEDIT.CONCAT 17808 . 21114) (TEDITSTRING 21116 . 22030) (TEDIT-SEE -22032 . 22591) (TEDIT.COPY 22593 . 24738) (TEDIT.DELETE 24740 . 25992) (TEDIT.INSERT 25994 . 28952) ( -TEDIT.TERPRI 28954 . 30068) (TEDIT.KILL 30070 . 30986) (TEDIT.QUIT 30988 . 32354) (TEDIT.MOVE 32356 . -33244) (TEDIT.STRINGWIDTH 33246 . 33917) (TEDIT.CHARWIDTH 33919 . 36161)) (36164 38105 (TEXTOBJ 36174 - . 36639) (COERCETEXTOBJ 36641 . 38103)) (39505 41155 (TDRIBBLE 39515 . 41153)) (41196 53304 ( -TEDIT.INSERT.OBJECT 41206 . 46047) (TEDIT.EDIT.OBJECT 46049 . 48390) (TEDIT.OBJECT.CHANGED 48392 . -51259) (TEDIT.MAP.OBJECTS 51261 . 52832) (\TEDIT.FIRST.OBJPIECE 52834 . 53067) (\TEDIT.NEXT.OBJPIECE -53069 . 53302)) (53327 60770 (\TEDIT.CONCAT.PAGEFRAMES 53337 . 58404) (\TEDIT.GET.PAGE.HEADINGS 58406 - . 59435) (\TEDIT.CONCAT.INSTALL.HEADINGS 59437 . 60768)) (60771 64200 (\TEDIT.MOVE.MSG 60781 . 62862) - (\TEDIT.READONLY 62864 . 64198)) (64201 69865 (TEDIT.NCHARS 64211 . 64584) (TEDIT.RPLCHARCODE 64586 - . 67465) (TEDIT.NTHCHARCODE 67467 . 69394) (TEDIT.NTHCHAR 69396 . 69863)) (69911 124812 (\TEDIT1 -69921 . 71998) (\TEDIT.INSERT 72000 . 77977) (\TEDIT.MOVE 77979 . 85329) (\TEDIT.COPY 85331 . 89464) ( -\TEDIT.REPLACE.SELPIECES 89466 . 93631) (\TEDIT.INSERT.SELPIECES 93633 . 96518) (\TEDIT.RESTARTFN -96520 . 99025) (\TEDIT.CHARDELETE 99027 . 101854) (\TEDIT.COPYPIECE 101856 . 106704) ( -\TEDIT.APPLY.OBJFN 106706 . 109903) (\TEDIT.DELETE 109905 . 114942) (\TEDIT.DIFFUSE.PARALOOKS 114944 - . 117215) (\TEDIT.WORDDELETE 117217 . 118773) (\TEDIT.WORDDELETE.FORWARD 118775 . 120447) ( -\TEDIT.FINISHEDIT? 120449 . 124810)) (124813 125472 (\TEDIT.THELP 124823 . 125470)) (125506 134290 ( -\TEDIT.PARAPIECES 125516 . 127490) (\TEDIT.PARACHNOS 127492 . 128384) (\TEDIT.PARA.FIRST 128386 . -131253) (\TEDIT.PARA.LAST 131255 . 134288)) (134291 141386 (\TEDIT.WORD.FIRST 134301 . 138305) ( -\TEDIT.WORD.LAST 138307 . 141384))))) + (FILEMAP (NIL (4819 7213 (MAKE-TEDIT-EXPORTS.ALL 4829 . 5375) (UPDATE-TEDIT 5377 . 6306) (EDIT-TEDIT +6308 . 7211)) (8643 36599 (TEDIT 8653 . 11231) (TEXTSTREAM 11233 . 13122) (TEXTSTREAMP 13124 . 13508) +(COERCETEXTSTREAM 13510 . 17721) (TEDIT.CONCAT 17723 . 21025) (TEDITSTRING 21027 . 21941) (TEDIT-SEE +21943 . 22502) (TEDIT.COPY 22504 . 24649) (TEDIT.DELETE 24651 . 26012) (TEDIT.INSERT 26014 . 29388) ( +TEDIT.TERPRI 29390 . 30504) (TEDIT.KILL 30506 . 31422) (TEDIT.QUIT 31424 . 32790) (TEDIT.MOVE 32792 . +33680) (TEDIT.STRINGWIDTH 33682 . 34353) (TEDIT.CHARWIDTH 34355 . 36597)) (36600 38541 (TEXTOBJ 36610 + . 37075) (COERCETEXTOBJ 37077 . 38539)) (39941 41591 (TDRIBBLE 39951 . 41589)) (41632 54617 ( +TEDIT.INSERT.OBJECT 41642 . 46658) (TEDIT.EDIT.OBJECT 46660 . 49489) (TEDIT.OBJECT.CHANGED 49491 . +52572) (TEDIT.MAP.OBJECTS 52574 . 54145) (\TEDIT.FIRST.OBJPIECE 54147 . 54380) (\TEDIT.NEXT.OBJPIECE +54382 . 54615)) (54640 62083 (\TEDIT.CONCAT.PAGEFRAMES 54650 . 59717) (\TEDIT.GET.PAGE.HEADINGS 59719 + . 60748) (\TEDIT.CONCAT.INSTALL.HEADINGS 60750 . 62081)) (62084 65691 (\TEDIT.MOVE.MSG 62094 . 64175) + (\TEDIT.READONLY 64177 . 65689)) (65692 71467 (TEDIT.NCHARS 65702 . 66075) (TEDIT.RPLCHARCODE 66077 + . 69067) (TEDIT.NTHCHARCODE 69069 . 70996) (TEDIT.NTHCHAR 70998 . 71465)) (71513 127869 (\TEDIT1 +71523 . 73600) (\TEDIT.INSERT 73602 . 79863) (\TEDIT.MOVE 79865 . 87667) (\TEDIT.COPY 87669 . 92098) ( +\TEDIT.REPLACE.SELPIECES 92100 . 96422) (\TEDIT.INSERT.SELPIECES 96424 . 99421) (\TEDIT.RESTARTFN +99423 . 101928) (\TEDIT.CHARDELETE 101930 . 104859) (\TEDIT.COPYPIECE 104861 . 109874) ( +\TEDIT.APPLY.OBJFN 109876 . 112962) (\TEDIT.DELETE 112964 . 117332) (\TEDIT.DIFFUSE.PARALOOKS 117334 + . 119605) (\TEDIT.WORDDELETE 119607 . 121222) (\TEDIT.WORDDELETE.FORWARD 121224 . 123013) ( +\TEDIT.FINISHEDIT? 123015 . 127867)) (127870 128529 (\TEDIT.THELP 127880 . 128527)) (128563 137468 ( +\TEDIT.PARAPIECES 128573 . 130547) (\TEDIT.PARACHNOS 130549 . 131441) (\TEDIT.PARA.FIRST 131443 . +134431) (\TEDIT.PARA.LAST 134433 . 137466)) (137469 144564 (\TEDIT.WORD.FIRST 137479 . 141483) ( +\TEDIT.WORD.LAST 141485 . 144562))))) STOP diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV index 88b76fa5f..9098e61dc 100644 --- a/library/tedit/TEDIT-ABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 10:13:36" {WMEDLEY}tedit>TEDIT-ABBREV.;21 15982 +(FILECREATED "24-Apr-2025 23:45:12" {WMEDLEY}tedit>TEDIT-ABBREV.;23 16200 :EDIT-BY rmk :CHANGES-TO (FNS \TEDIT.ABBREV.PARSE) - :PREVIOUS-DATE "23-Mar-2025 17:09:00" {WMEDLEY}tedit>TEDIT-ABBREV.;20) + :PREVIOUS-DATE "20-Apr-2025 23:30:29" {WMEDLEY}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 diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM index b01804eed..b3b73af92 100644 Binary files a/library/tedit/TEDIT-ABBREV.LCOM and b/library/tedit/TEDIT-ABBREV.LCOM differ diff --git a/library/tedit/TEDIT-BUTTONS b/library/tedit/TEDIT-BUTTONS index 69d60bf84..2f00fe35a 100644 --- a/library/tedit/TEDIT-BUTTONS +++ b/library/tedit/TEDIT-BUTTONS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}tedit>TEDIT-BUTTONS.;223 124611 +(FILECREATED "30-Apr-2025 14:09:18" {WMEDLEY}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}TEDIT>TEDIT-BUTTONS.;219) + :PREVIOUS-DATE "14-Apr-2025 23:50:23" {WMEDLEY}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 diff --git a/library/tedit/TEDIT-BUTTONS.LCOM b/library/tedit/TEDIT-BUTTONS.LCOM index 5bc86b10f..a863e3c50 100644 Binary files a/library/tedit/TEDIT-BUTTONS.LCOM and b/library/tedit/TEDIT-BUTTONS.LCOM differ diff --git a/library/tedit/TEDIT-CHAT b/library/tedit/TEDIT-CHAT index 1027f5340..6f220118f 100644 --- a/library/tedit/TEDIT-CHAT +++ b/library/tedit/TEDIT-CHAT @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}tedit>TEDIT-CHAT.;17 12449 +(FILECREATED "21-Apr-2025 23:06:01" {WMEDLEY}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}tedit>TEDIT-CHAT.;16) + :PREVIOUS-DATE "11-Mar-2025 15:41:08" {WMEDLEY}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 diff --git a/library/tedit/TEDIT-CHAT.LCOM b/library/tedit/TEDIT-CHAT.LCOM index 8d82ab38d..aaad4d44d 100644 Binary files a/library/tedit/TEDIT-CHAT.LCOM and b/library/tedit/TEDIT-CHAT.LCOM differ diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE index ab84851d3..b8c469b5a 100644 --- a/library/tedit/TEDIT-FILE +++ b/library/tedit/TEDIT-FILE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 14:24:34" {WMEDLEY}TEDIT>TEDIT-FILE.;608 161966 +(FILECREATED "26-Apr-2025 12:53:23" {MEDLEY}tedit>TEDIT-FILE.;38 163507 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.GET.FORMATTED.FILE) + :CHANGES-TO (FNS \TEDIT.PUT.PCTB.NEXTNEW \TEDIT.PUT.PCTB.MERGEABLE) - :PREVIOUS-DATE "26-Mar-2025 10:02:49" {WMEDLEY}TEDIT>TEDIT-FILE.;607) + :PREVIOUS-DATE "22-Apr-2025 15:58:21" {MEDLEY}tedit>TEDIT-FILE.;37) (PRETTYCOMPRINT TEDIT-FILECOMS) @@ -45,7 +45,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 +55,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 +119,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 +183,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 +191,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 +395,8 @@ (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 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") @@ -1415,7 +1419,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 +1428,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 +1439,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,7 +1702,7 @@ -(* ;; "Putting (pageframe functions on TEDIT-PAGE)") +(* ;; "Putting pageframe functions are on TEDIT-PAGE)") (DEFINEQ @@ -1896,7 +1906,8 @@ (\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 26-Apr-2025 12:53 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") @@ -1938,7 +1949,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 +2020,7 @@ (\TEDIT.PUT.PCTB.NEXTNEW [LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES) + (* ; "Edited 26-Apr-2025 12:52 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") @@ -2057,7 +2069,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 +2197,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 +2210,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 +2255,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 +2485,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 +2509,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 +2546,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 (5127 34996 (TEDIT.GET 5137 . 11469) (TEDIT.FORMATTEDFILEP 11471 . 12787) ( +TEDIT.FILEDATE 12789 . 13960) (TEDIT.INCLUDE 13962 . 21991) (TEDIT.RAW.INCLUDE 21993 . 22801) ( +TEDIT.PUT 22803 . 31161) (TEDIT.PUT.STREAM 31163 . 34994)) (34997 54876 (\TEDIT.GET.FOREIGN.FILE 35007 + . 38432) (\TEDIT.GET.UNFORMATTED.FILE 38434 . 42426) (\TEDIT.GET.FORMATTED.FILE 42428 . 45455) ( +\TEDIT.FORMATTEDSTREAMP 45457 . 48475) (\ARBIN 48477 . 49197) (\ATMIN 49199 . 49736) (\DWIN 49738 . +50117) (\STRINGIN 50119 . 50827) (\TEDIT.GET.TRAILER 50829 . 53345) (\TEDIT.CACHEFILE 53347 . 54874)) +(55042 68796 (\TEDIT.GET.PIECES3 55052 . 65558) (\TEDIT.GET.IDATE3 65560 . 66955) ( +\TEDIT.MAKE.STRINGPIECE 66957 . 68794)) (68797 81172 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68807 . 74923) +(\TEDIT.INTERPRET.XCCS.SHIFTS 74925 . 81170)) (81194 87216 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 81204 . +87214)) (87239 96368 (\TEDIT.GET.CHARLOOKS.LIST 87249 . 87980) (\TEDIT.GET.SINGLE.CHARLOOKS 87982 . +93180) (\TEDIT.GET.CHARLOOKS 93182 . 94512) (\TEDIT.GET.PARALOOKS.INDEX 94514 . 95058) ( +\TEDIT.GET.CHARLOOKS.INDEX 95060 . 96366)) (96369 104026 (\TEDIT.GET.PARALOOKS.LIST 96379 . 97001) ( +\TEDIT.GET.SINGLE.PARALOOKS 97003 . 104024)) (104027 107617 (\TEDIT.GET.OBJECT 104037 . 107615)) ( +107682 139965 (\TEDIT.PUT.PCTB 107692 . 117342) (\TEDIT.PUT.PCTB.PIECEDATA 117344 . 120542) ( +\TEDIT.PUT.TRAILER 120544 . 121311) (\TEDIT.PUT.PCTB.MERGEABLE 121313 . 124848) ( +\TEDIT.PUT.UTF8.SPLITPIECES 124850 . 129552) (\TEDIT.PUT.PCTB.NEXTNEW 129554 . 134126) ( +\TEDIT.INSERT.NEWPIECES 134128 . 137563) (\TEDIT.PUTRESET 137565 . 137807) (\ARBOUT 137809 . 138533) ( +\ATMOUT 138535 . 139140) (\DWOUT 139142 . 139421) (\STRINGOUT 139423 . 139963)) (139966 152036 ( +\TEDIT.PUT.CHARLOOKS.LIST 139976 . 141648) (\TEDIT.PUT.SINGLE.CHARLOOKS 141650 . 147380) ( +\TEDIT.PUT.CHARLOOKS 147382 . 148607) (\TEDIT.PUT.CHARLOOKS1 148609 . 149660) (\TEDIT.PUT.OBJECT +149662 . 152034)) (152037 159676 (\TEDIT.PUT.PARALOOKS.LIST 152047 . 152949) ( +\TEDIT.PUT.SINGLE.PARALOOKS 152951 . 158535) (\TEDIT.PUT.PARALOOKS 158537 . 159674)) (159771 163200 ( +TEDITFROMLISPSOURCE 159781 . 162449) (SHELLSCRIPTP 162451 . 162680) (TEDITFROMSHELLSCRIPT 162682 . +163198))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index 2ea4564e2..0312bcceb 100644 Binary files a/library/tedit/TEDIT-FILE.LCOM and b/library/tedit/TEDIT-FILE.LCOM differ diff --git a/library/tedit/TEDIT-FIND b/library/tedit/TEDIT-FIND index d1ea80078..ffbd94c4e 100644 --- a/library/tedit/TEDIT-FIND +++ b/library/tedit/TEDIT-FIND @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 14:07:00" {WMEDLEY}TEDIT>TEDIT-FIND.;155 43772 +(FILECREATED "21-Apr-2025 22:42:57" {WMEDLEY}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}tedit>TEDIT-FIND.;153) + :PREVIOUS-DATE "20-Apr-2025 23:44:49" {WMEDLEY}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 diff --git a/library/tedit/TEDIT-FIND.LCOM b/library/tedit/TEDIT-FIND.LCOM index ab0bf432b..a66c35609 100644 Binary files a/library/tedit/TEDIT-FIND.LCOM and b/library/tedit/TEDIT-FIND.LCOM differ diff --git a/library/tedit/TEDIT-FIXFILES b/library/tedit/TEDIT-FIXFILES new file mode 100644 index 000000000..495db7813 --- /dev/null +++ b/library/tedit/TEDIT-FIXFILES @@ -0,0 +1,183 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "14-Dec-2024 16:53:27" {WMEDLEY}TEDIT>TEDIT-FIXFILES.;14 9776 + + :EDIT-BY rmk + + :CHANGES-TO (FNS CR-LF-FONTFIX) + (VARS TEDIT-FIXFILESCOMS) + (ADVICE ELT) + + :PREVIOUS-DATE "12-Dec-2024 21:50:29" {WMEDLEY}TEDIT>TEDIT-FIXFILES.;10) + + +(PRETTYCOMPRINT TEDIT-FIXFILESCOMS) + +(RPAQQ TEDIT-FIXFILESCOMS ( + (* ;; "Hacks that may help in fixing broken Tedit files") + + (FILES TEDIT-DEBUG) + (FNS CRLFSWAP CHANGEPLEN) + (FNS CR-LF-FONTFIX) + (P (MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS)) + (ADVISE ELT))) + + + +(* ;; "Hacks that may help in fixing broken Tedit files") + + +(FILESLOAD TEDIT-DEBUG) +(DEFINEQ + +(CRLFSWAP + [LAMBDA (INFILE OUTFILE) (* ; "Edited 12-Dec-2024 08:25 by rmk") + (* ; "Edited 9-Dec-2024 13:33 by rmk") + (CL:WITH-OPEN-FILE (INSTREAM INFILE :DIRECTION :INPUT) + (CL:UNLESS OUTFILE + (SETQ OUTFILE (PACKFILENAME 'VERSION NIL 'NAME (CONCAT (FILENAMEFIELD INSTREAM + 'NAME) + "-SWAPPED") + 'BODY INSTREAM))) + (CL:WITH-OPEN-FILE (OUTSTREAM OUTFILE :DIRECTION :OUTPUT) + (for I B from 1 to (GETEOFPTR INSTREAM) + do (BOUT OUTSTREAM (SELCHARQ (SETQ B (BIN INSTREAM)) + (LF (CHARCODE CR)) + (CR (CHARCODE LF)) + B))) + (FULLNAME OUTSTREAM]) + +(CHANGEPLEN + [LAMBDA (PC DELTA ARG) (* ; "Edited 11-Dec-2024 15:18 by rmk") + + (* ;; "Change the length of piece PC by DELTA (negative = shorter).") + + (LET [(PC (SP PC 1 NIL (GTO ARG] + (CL:WHEN (EQ 'Y (ASKUSER NIL NIL (CONCAT "Confirm changing PLEN by " DELTA " from " + (PLEN PC) + " to " + (IPLUS (PLEN PC) + DELTA) + " ? "))) + (FSETPC PC PLEN (IPLUS (PLEN PC) + DELTA)) + (SP PC 1 NIL (GTO ARG)))]) +) +(DEFINEQ + +(CR-LF-FONTFIX + [LAMBDA (FILE TEXTOBJ) (* ; "Edited 14-Dec-2024 14:31 by rmk") + (* ; "Edited 12-Dec-2024 21:50 by rmk") + (SI::%%WITH-CHANGED-CALLS + ((|TEXTPROP in INTERLISP::\TEDIT.GET.SINGLE.CHARLOOKS| . TEXTPROP)) + (* ; "Edited 12-Dec-2024 20:51 by rmk") + (* ; "Edited 11-Dec-2024 17:11 by rmk") + (* ; "Edited 9-Dec-2024 20:11 by rmk") + (* ; "Edited 13-Aug-2024 08:49 by rmk") + (* ; "Edited 31-Jul-2024 00:04 by rmk") + (* ; "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") + + (* ;; "Read one CHARLOOKS from FILE. This gets and then sets the file pointer, based on the stored length. But that won't work if the file is not random access. Maybe that's not necessary?") + + (* ;; "TEXTOBJ only for printing in the local promptwindow, if necessary.") + + (PROG* ((LOOKS (create CHARLOOKS)) + (FILEPOS (GETFILEPTR FILE)) + (LOOKSLEN (\WIN FILE)) + FONT NAME FACE SIZE SUPER PROPS STYLESTR) + (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)) + (with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS] + [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS] + [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] + [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] + [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + (SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD) + 'B + 'M) + (CL:IF (FGETCLOOKS LOOKS CLITAL) + 'I + 'R) + 'R)) + (if (LISTP NAME) + then (* ; + "This was a font class. Restore it.") + (SETQ FONT (FONTCLASS (pop NAME) + NAME)) + elseif (OR (NOT NAME) + (ZEROP SIZE)) + then + (* ;; "This was a test in the original, seems bogus") + + elseif (SETQ FONT (FONTCREATE NAME SIZE FACE NIL NIL T)) + elseif [AND (EQ SIZE 13) + (SETQ FONT (FONTCREATE NAME 10 FACE NIL NIL T)) + (SELECTQ (STREAMPROP FILE 'COERCEFONT) + (YES T) + (NO NIL) + (SELECTQ [U-CASE (MKATOM (CL:IF TEXTOBJ + (TEDIT.GETINPUT TEXTOBJ + "Change font size 13 to 10 ? ") + (ASKUSER NIL NIL + "Change font size 13 to 10 ? "))] + ((Y YES) + (STREAMPROP FILE 'COERCEFONT 'YES) + T) + (PROGN (STREAMPROP FILE 'COERCEFONT 'NO) + NIL] + then + (* ;; "A hack to deal with files that have CR-LF corruption") + + (SETQ SIZE 10) + (FSETCLOOKS LOOKS CLSIZE 10) + else (SETQ FONT (FONTCREATE NAME SIZE FACE))) + (FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT) + then + (* ;; + "Put the display family in the CLNAME spot. Better than NIL.") + + (CL:WHEN [SETQ NAME (FONTCOPY FONT + '(DEVICE DISPLAY NOERROR T] + (FONTPROP NAME 'FAMILY)) + else NAME)) + (FSETCLOOKS LOOKS CLFONT FONT) + (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) + (RETURN LOOKS]) +) + +(MOVD 'CR-LF-FONTFIX '\TEDIT.GET.SINGLE.CHARLOOKS) + +[XCL:REINSTALL-ADVICE 'ELT :BEFORE '((:LAST (CL:WHEN (AND (EQ N 13) + (ILESSP (ARRAYSIZE A) + 13)) + (SETQ N 10] + +(READVISE ELT) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (912 2760 (CRLFSWAP 922 . 1990) (CHANGEPLEN 1992 . 2758)) (2761 9403 (CR-LF-FONTFIX 2771 + . 9401))))) +STOP diff --git a/library/tedit/TEDIT-FIXFILES.LCOM b/library/tedit/TEDIT-FIXFILES.LCOM new file mode 100644 index 000000000..c8396a9ff Binary files /dev/null and b/library/tedit/TEDIT-FIXFILES.LCOM differ diff --git a/library/tedit/TEDIT-FNKEYS b/library/tedit/TEDIT-FNKEYS index 8b1b8553d..e15431f7d 100644 --- a/library/tedit/TEDIT-FNKEYS +++ b/library/tedit/TEDIT-FNKEYS @@ -1,22 +1,23 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 10:13:53" {WMEDLEY}tedit>TEDIT-FNKEYS.;250 100100 +(FILECREATED "23-Apr-2025 19:09:21" {WMEDLEY}tedit>TEDIT-FNKEYS.;288 110287 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WRITE.SEL \TEDIT.SHOWCARETLOOKS) + :CHANGES-TO (FNS CHARCODE.ENCODE) - :PREVIOUS-DATE "26-Mar-2025 10:37:43" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;248) + :PREVIOUS-DATE "23-Apr-2025 10:20:47" {WMEDLEY}tedit>TEDIT-FNKEYS.;287) (PRETTYCOMPRINT TEDIT-FNKEYSCOMS) (RPAQQ TEDIT-FNKEYSCOMS - ((FNS CHARNAME) + ((FNS CHARCODE.ENCODE) (COMS (* ;  "Public functions (binding data below)") (FNS TEDIT.INSTALL.CHARBINDINGS TEDIT.CLEAR.CHARBINDINGS TEDIT.GET.CHARACTION - TEDIT.GET.CHARBINDING TEDIT.GET.ALL.CHARBINDINGS TEDIT.GET.ALL.CHARACTIONS)) + TEDIT.GET.CHARBINDING TEDIT.GET.ALL.CHARBINDINGS TEDIT.CHARBINDINGS.INVERT + TEDIT.GET.ALL.CHARACTIONS TEDIT.CONFLICTING.CHARBINDINGS)) (COMS (* ;; "Functions that implement the key actions:") @@ -32,6 +33,8 @@ \TEDIT.LINE.END \TEDIT.DOCUMENT.BEGIN \TEDIT.DOCUMENT.END) (FNS \TEDIT.LINEDELETE.FORWARD \TEDIT.LINEDELETE.BACKWARD) (FNS \TEDIT.KEY.NEST) + (FNS \TEDIT.KEY.WRAP) + (* ; "From TEDITDORADOKEYS") (INITVARS (TEDIT.NESTWIDTH 36)) (* ; "Find") (FNS \TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING) @@ -42,14 +45,16 @@ (VARS (TEDIT.FNKEY.VERBOSE T)) (COMS (* ; "Read-table Utilities") (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) - (ALISTS (CHARACTERNAMES EMQUAD ENQUAD THINSPACE FIGURESPACE)) + (ALISTS (CHARACTERNAMES EMQUAD ENQUAD THINSPACE FIGURESPACE LEFT-DOUBLEQUOTE + RIGHT-DOUBLEQUOTE)) (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET TEDIT.ATOMBOUND.READTABLE)) (* ; "Keybindings") (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (CONSTANTS \TEDIT.TTCCODES) (MACROS \TEDIT.TTC))) - (VARS TEDIT.CHARACTIONS TEDIT.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS) + (VARS TEDIT.CHARACTIONS TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS + (TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS))) (* ; "Installation") [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) (TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE] @@ -62,8 +67,9 @@ (VARS TEDIT.BUTTONBITMAP))) (DEFINEQ -(CHARNAME - [LAMBDA (CODE OCTALCHARS) (* ; "Edited 26-Mar-2025 10:37 by rmk") +(CHARCODE.ENCODE + [LAMBDA (CODE OCTALCHARS NONCHARIDENTITY) (* ; "Edited 23-Apr-2025 19:08 by rmk") + (* ; "Edited 26-Mar-2025 10:37 by rmk") (* ; "Edited 23-Mar-2025 14:57 by rmk") (* ; "Edited 18-Mar-2025 20:55 by rmk") (* ; "Edited 6-Dec-2023 20:30 by rmk") @@ -75,23 +81,27 @@ (* ;; "If not OCTALCHARS, the character-name part is constructed from the name of its Ascii equivalent, modified by ^ or #. %"0,%" is suppressed in front of the names for character-set 0.") + (* ;; "If NONCHARIDENTITY, returns CODE if it isn't something that can be interpreted as a character code.") + (DECLARE (USEDFREE CHARACTERSETNAMES CHARACTERNAMES)) (* ;; "") (if (LISTP CODE) - then (CONS (CHARNAME (CAR CODE) - OCTALCHARS) + then (CONS (CHARCODE.ENCODE (CAR CODE) + OCTALCHARS NONCHARIDENTITY) (AND (CDR CODE) - (CHARNAME (CDR CODE) - OCTALCHARS))) + (CHARCODE.ENCODE (CDR CODE) + OCTALCHARS NONCHARIDENTITY))) elseif (CL:CHARACTERP CODE) - then (CHARNAME (CL:CHAR-CODE CODE) - OCTALCHARS) + then (CHARCODE.ENCODE (CL:CHAR-CODE CODE) + OCTALCHARS NONCHARIDENTITY) elseif (NULL CODE) then NIL elseif (NOT (CHARCODEP CODE)) - then (\ILLEGAL.ARG CODE) + then (CL:IF NONCHARIDENTITY + CODE + (\ILLEGAL.ARG CODE)) elseif [CAR (find CN in CHARACTERNAMES suchthat (if (CHARCODEP (CADR CN)) then (IEQP CODE (CADR CN)) else (IEQP CODE (CHARCODE.DECODE (CADR CN] @@ -138,7 +148,10 @@ (DEFINEQ (TEDIT.INSTALL.CHARBINDINGS - [LAMBDA (CHARBINDINGS RDTBL CHARACTIONS) (* ; "Edited 18-Mar-2025 11:15 by rmk") + [LAMBDA (CHARBINDINGS RDTBL CHARACTIONS) (* ; "Edited 7-Apr-2025 20:01 by rmk") + (* ; "Edited 5-Apr-2025 11:36 by rmk") + (* ; "Edited 1-Apr-2025 00:19 by rmk") + (* ; "Edited 18-Mar-2025 11:15 by rmk") (* ; "Edited 17-Mar-2025 09:34 by rmk") (* ; "Edited 15-Mar-2025 15:20 by rmk") (* ; "Edited 13-Mar-2025 23:25 by rmk") @@ -149,55 +162,60 @@ (* ;; "This will overwrite previous assignments in RDTBL, possibly add new ones. ") (CL:UNLESS CHARBINDINGS (SETQ CHARBINDINGS TEDIT.CHARBINDINGS)) - (SETQ RDTBL (if (NULL RDTBL) - then TEDIT.READTABLE - elseif (TEXTSTREAM RDTBL T) - then (OR (GETTOBJ (TEXTOBJ RDTBL) - TXTRTBL) - TEDIT.READTABLE) - elseif (type? READTABLEP RDTBL) - then RDTBL - else (\ILLEGAL.ARG RDTBL))) + (CL:UNLESS (LISTP CHARBINDINGS) + (\ILLEGAL.ARG CHARBINDINGS)) + (CL:UNLESS (READTABLEP RDTBL) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) + TXTRTBL) + TEDIT.READTABLE) + else (\ILLEGAL.ARG RDTBL)))) (CL:UNLESS CHARACTIONS (SETQ CHARACTIONS TEDIT.CHARACTIONS)) - [for CB A ACTION in CHARBINDINGS when (LISTP CB) unless (EQ '* (CAR CB)) - when (AND [SETQ ACTION (find PAIR in CHARACTIONS suchthat - - (* ;; - "An ASSOC that allows synonym keys") - - (EQMEMB (CAR CB) - (CAR PAIR] - (SETQ A (CADR ACTION))) do (for CHAR in (CDR CB) - do (CL:UNLESS (CHARCODEP CHAR) - (SETQ CHAR (CHARCODE.DECODE CHAR))) - (CL:WHEN (EQ (CAR ACTION) - 'CHARDELETE.FORWARD)) - (TEDIT.SETFUNCTION CHAR A RDTBL) + (TEDIT.CONFLICTING.CHARBINDINGS (APPEND CHARBINDINGS (TEDIT.GET.ALL.CHARBINDINGS RDTBL))) + [for CB A ACTION in CHARBINDINGS first (TEDIT.CONFLICTING.CHARBINDINGS (APPEND CHARBINDINGS + ( + TEDIT.GET.ALL.CHARBINDINGS + RDTBL))) + when (LISTP CB) unless (EQ '* (CAR CB)) when (AND [SETQ ACTION + (find PAIR in CHARACTIONS + suchthat + + (* ;; + "An ASSOC that allows synonym keys") + + (EQMEMB (CAR CB) + (CAR PAIR] + (SETQ A (CADR ACTION))) + do (for CHAR in (CDR CB) do (CL:UNLESS (CHARCODEP CHAR) + (SETQ CHAR (CHARCODE.DECODE CHAR))) + (TEDIT.SETFUNCTION CHAR A RDTBL) (* ; "Set the method") - (CL:WHEN NIL - (ASSOC (CAR ACTION) - \TEDIT.TTCCODES) + (CL:WHEN NIL + (ASSOC (CAR ACTION) + \TEDIT.TTCCODES) (* ;  "A tag like NEXT, UNDO. Setup the termtable FWIW ") - (TEDIT.SETSYNTAX CHAR (CAR ACTION) - RDTBL))] + (TEDIT.SETSYNTAX CHAR (CAR ACTION) + RDTBL))] RDTBL]) (TEDIT.CLEAR.CHARBINDINGS - [LAMBDA (RDTBL BINDINGS) (* ; "Edited 18-Mar-2025 11:10 by rmk") + [LAMBDA (RDTBL BINDINGS) (* ; "Edited 5-Apr-2025 11:36 by rmk") + (* ; "Edited 18-Mar-2025 11:10 by rmk") (* ; "Edited 15-Mar-2025 12:02 by rmk") (* ;; "Removes the Tedit function bindings to the characters in BINDINGS, or all current bindings if BINDINGS is NIL") - (SETQ RDTBL (if (NULL RDTBL) - then TEDIT.READTABLE - elseif (TEXTSTREAM RDTBL T) - then (OR (GETTOBJ (TEXTOBJ RDTBL) - TXTRTBL) - TEDIT.READTABLE) - elseif (type? READTABLEP RDTBL) - then RDTBL - else (\ILLEGAL.ARG RDTBL))) + (CL:UNLESS (READTABLEP RDTBL) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) + TXTRTBL) + TEDIT.READTABLE) + else (\ILLEGAL.ARG RDTBL)))) (CL:WHEN (fetch READMACRODEFS of RDTBL) [if (EQ BINDINGS T) then [MAPHASH (fetch READMACRODEFS of RDTBL) @@ -223,7 +241,8 @@ RDTBL))])]) (TEDIT.GET.CHARACTION - [LAMBDA (CHARCODE BINDINGS) (* ; "Edited 19-Mar-2025 14:51 by rmk") + [LAMBDA (CHARCODE BINDINGS) (* ; "Edited 5-Apr-2025 11:36 by rmk") + (* ; "Edited 19-Mar-2025 14:51 by rmk") (* ; "Edited 18-Mar-2025 11:07 by rmk") (* ; "Edited 17-Mar-2025 09:43 by rmk") @@ -249,7 +268,7 @@ then (OR (GETTOBJ (TEXTOBJ BINDINGS) TXTRTBL) TEDIT.READTABLE) - elseif (type? READTABLEP BINDINGS) + elseif (READTABLEP BINDINGS) else (\ILLEGAL.ARG BINDINGS] [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) @@ -264,7 +283,9 @@ NIL]) (TEDIT.GET.CHARBINDING - [LAMBDA (ACTION BINDINGS RETURNCODES) (* ; "Edited 18-Mar-2025 20:40 by rmk") + [LAMBDA (ACTION BINDINGS RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + (* ; "Edited 5-Apr-2025 11:37 by rmk") + (* ; "Edited 18-Mar-2025 20:40 by rmk") (* ;; "Returns the bindings for ACTION in BINDINGS, a binding list or a read-table specification. If BINDINGS is a readtable, looks at all currently installed bindings in that readtable. If NIL, uses TEDIT.READTABLE.") @@ -280,7 +301,7 @@ then (OR (GETTOBJ (TEXTOBJ BINDINGS) TXTRTBL) TEDIT.READTABLE) - elseif (type? READTABLEP BINDINGS) + elseif (READTABLEP BINDINGS) else (\ILLEGAL.ARG BINDINGS))) [IMPL (CADR (find CA in TEDIT.CHARACTIONS suchthat (EQMEMB ACTION (CAR CA] CHARS) @@ -291,47 +312,83 @@ (* ; "charcode, not charname") (push CHARS (CL:IF RETURNCODES CCODE - (CHARNAME CCODE))))] + (CHARCODE.ENCODE CCODE))))] CHARS)]) (TEDIT.GET.ALL.CHARBINDINGS - [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 18-Mar-2025 20:41 by rmk") - (SETQ RDTBL (if (NULL RDTBL) - then TEDIT.READTABLE - elseif (TEXTSTREAM RDTBL T) - then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) - TXTRTBL) - TEDIT.READTABLE) - elseif (type? READTABLEP RDTBL) - else (\ILLEGAL.ARG RDTBL))) - (LET (BINDINGS) + [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + (* ; "Edited 7-Apr-2025 22:11 by rmk") + (* ; "Edited 5-Apr-2025 11:37 by rmk") + (* ; "Edited 18-Mar-2025 20:51 by rmk") + + (* ;; "Returns the charbindings instantiated in RDTBL, in the form of TEDIT.CHARBINDINGS: (action . chars)") + + (CL:UNLESS (READTABLEP RDTBL) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) + TXTRTBL) + TEDIT.READTABLE) + else (\ILLEGAL.ARG RDTBL)))) + (LET (ACTIONS) [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) (CL:WHEN (EQ (\TEDIT.TTC FUNCTIONCALL) (\SYNCODE (fetch READSA of RDTBL) CCODE)) - [for CA in TEDIT.CHARACTIONS when (LISTP CA) + (for CA ANAME in TEDIT.CHARACTIONS when (LISTP CA) unless (EQ '* (CAR CA)) when (EQUAL (CADR CA) (CADR VAL)) - do (PUSH BINDINGS (LIST (CL:IF RETURNCODES - CCODE - (CHARNAME CCODE)) - (CAR (CL:IF (LISTP (CAR CA)) - (CAR CA) - CA)])] - (SORT BINDINGS T) - BINDINGS]) + do (SETQ ANAME (CAR (CL:IF (LISTP (CAR CA)) + (CAR CA) + CA))) + (PUSH [CDR (OR (ASSOC ANAME ACTIONS) + (CAR (PUSH ACTIONS (CONS ANAME] + CCODE)))] + (SORT ACTIONS T) + [for A S in ACTIONS do (SETQ S (SORT (CDR A))) + (RPLACD A (CL:IF RETURNCODES + S + (CHARCODE.ENCODE S))] + ACTIONS]) + +(TEDIT.CHARBINDINGS.INVERT + [LAMBDA (CHARBINDINGS RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + (* ; "Edited 7-Apr-2025 22:39 by rmk") + (* ; "Edited 4-Apr-2025 09:58 by rmk") + (* ; "Edited 1-Apr-2025 15:09 by rmk") + + (* ;; "Inverts CHARBINDINGS to return a list of (char/code . actions), usually a single action unless there is a conflict.. ") + + (for CB ACTIONSPERCHAR CA in CHARBINDINGS when (CDR (LISTP CB)) unless (EQ '* (CAR CB)) + do [for CHAR CODE CACTIONS in (CDR CB) do (SETQ CODE (CHARCODE.DECODE CHAR)) + (SETQ CACTIONS (ASSOC CODE ACTIONSPERCHAR)) + (CL:UNLESS CACTIONS + (push ACTIONSPERCHAR (SETQ CACTIONS (CONS CODE)) + )) + (CL:UNLESS (MEMB (CAR CB) + (CDR CACTIONS)) + (push (CDR CACTIONS) + (CAR CB)))] + finally (SORT ACTIONSPERCHAR T) + (CL:UNLESS RETURNCODES + (for APC in ACTIONSPERCHAR do (change (CAR APC) + (CHARCODE.ENCODE DATUM)))) + (RETURN ACTIONSPERCHAR]) (TEDIT.GET.ALL.CHARACTIONS - [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 18-Mar-2025 20:51 by rmk") - (SETQ RDTBL (if (NULL RDTBL) - then TEDIT.READTABLE - elseif (TEXTSTREAM RDTBL T) - then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) - TXTRTBL) - TEDIT.READTABLE) - elseif (type? READTABLEP RDTBL) - else (\ILLEGAL.ARG RDTBL))) + [LAMBDA (RDTBL RETURNCODES) (* ; "Edited 23-Apr-2025 10:11 by rmk") + (* ; "Edited 5-Apr-2025 11:37 by rmk") + (* ; "Edited 18-Mar-2025 20:51 by rmk") + (CL:UNLESS (READTABLEP RDTBL) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (GETTSTR RDTBL TEXTOBJ) + TXTRTBL) + TEDIT.READTABLE) + else (\ILLEGAL.ARG RDTBL)))) (LET (ACTIONS) [MAPHASH (fetch READMACRODEFS of RDTBL) (FUNCTION (LAMBDA (VAL CCODE) @@ -351,8 +408,26 @@ [for A S in ACTIONS do (SETQ S (SORT (CDR A))) (RPLACD A (CL:IF RETURNCODES S - (CHARNAME S))] + (CHARCODE.ENCODE S))] ACTIONS]) + +(TEDIT.CONFLICTING.CHARBINDINGS + [LAMBDA (CHARBINDINGS NOERROR) (* ; "Edited 7-Apr-2025 22:40 by rmk") + (* ; "Edited 4-Apr-2025 09:58 by rmk") + (* ; "Edited 1-Apr-2025 15:09 by rmk") + + (* ;; "Returns a list of the character names that bind to conflicting actions. Each element in the return is of the form") + + (* ;; " (CHARNAMES . ACTIONAMES) where CHARNAMES is a list of different synonyms for a given charcode, or a single code if they are all the same, and ACTIONNAMES are the names of the different actions assigned to those characters. ") + + (* ;; "where CHARNAME is the result of APPP") + + (for CA in (TEDIT.CHARBINDINGS.INVERT CHARBINDINGS) when (CDDR CA) collect + (* ; "Multiple actions") + CA + finally (CL:WHEN (AND $$VAL (NOT NOERROR)) (* ; + "RETURN from error break returns conflicts") + (ERROR "Conflicting key bindings" $$VAL))]) ) @@ -362,25 +437,27 @@ (DEFINEQ (\TEDIT.KEY.CHARLOOKS - [LAMBDA (TSTREAM PROP NEWVALUE) (* ; "Edited 15-Mar-2025 15:40 by rmk") + [LAMBDA (TSTREAM PROP NEWVALUE) (* ; "Edited 5-Apr-2025 17:26 by rmk") + (* ; "Edited 15-Mar-2025 15:40 by rmk") (* ; "Edited 13-Mar-2025 23:58 by rmk") (* ;; "Generic key action function for changing individual character looks. ") - (* ;; "Example actions:") - (* ;; " (BOLD-ON (\TEDIT.CHANGE.CHARLOOKS 'BOLD 'ON) ") (* ;; " (BOLD-OFF (\TEDIT.CHANGE.CHARLOOKS 'BOLD 'OFF") - (* ; "Bound in COMMAND.LOOP") - (CL:WHEN (EQ NEWVALUE 'TOGGLE) - (SETQ NEWVALUE (CL:IF (EQ 'ON) - (LISTGET (TEDIT.GET.LOOKS TSTREAM) - PROP) - 'OFF - 'ON))) - (\TEDIT.CHANGE.CHARLOOKS TSTREAM (LIST PROP NEWVALUE)) - (\TEDIT.SHOWCARETLOOKS TSTREAM]) + + (LET ((CURLOOKS (TEDIT.GET.LOOKS TSTREAM))) + (CL:WHEN (EQ NEWVALUE 'TOGGLE) + (SETQ NEWVALUE (CL:IF (EQ 'ON (LISTGET CURLOOKS PROP)) + 'OFF + 'ON))) + (if (EQ 0 (GETSEL (TEXTSEL (GETTSTR TSTREAM TEXTOBJ)) + DCH)) + then (* ; "Point selection") + (TEDIT.CARETLOOKS TSTREAM (LIST PROP NEWVALUE)) + else (\TEDIT.CHANGE.CHARLOOKS TSTREAM (LIST PROP NEWVALUE))) + (\TEDIT.SHOWCARETLOOKS TSTREAM]) (\TEDIT.KEY.QUAD [LAMBDA (TSTREAM REVERSE) (* ; "Edited 16-Mar-2025 00:03 by rmk") @@ -458,7 +535,8 @@ SEL]) (\TEDIT.KEY.TRANSFORM - [LAMBDA (TSTREAM CHARFN) (* ; "Edited 19-Mar-2025 14:57 by rmk") + [LAMBDA (TSTREAM CHARFN) (* ; "Edited 22-Apr-2025 00:07 by rmk") + (* ; "Edited 19-Mar-2025 14:57 by rmk") (* ; "Edited 16-Mar-2025 18:49 by rmk") (* ; "Edited 7-Jul-2024 09:04 by rmk") (* ; "Edited 15-Mar-2024 13:57 by rmk") @@ -469,17 +547,18 @@ (* ;; "This changes the :Replace THACTION to :Transform and adds CHARFN to the event, so that REDO can perform the action again. ") - (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (SEL (TEXTSEL TEXTOBJ))) (CL:WHEN (IGREATERP (TEXTLEN TEXTOBJ) 0) (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES SEL NIL - TEXTOBJ)) - CHARFN NIL TEXTOBJ) - TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) + TEXTOBJ) + NIL TSTREAM) + CHARFN NIL TSTREAM) + TSTREAM SEL) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TSTREAM) + (\TEDIT.SHOWSEL SEL T TSTREAM) (CL:UNLESS (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE) (SETTH (\TEDIT.LASTEVENT TEXTOBJ) THACTION :Transform) @@ -535,7 +614,9 @@ (DEFINEQ (\TEDIT.SHOWCARETLOOKS - [LAMBDA (TSTREAM) (* ; "Edited 27-Mar-2025 08:04 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 23-Apr-2025 10:20 by rmk") + (* ; "Edited 15-Apr-2025 16:44 by rmk") + (* ; "Edited 27-Mar-2025 08:04 by rmk") (* ; "Edited 15-Mar-2025 20:40 by rmk") (* ; "Edited 13-Mar-2025 23:52 by rmk") (* ; "Edited 5-Mar-2025 14:55 by rmk") @@ -543,7 +624,7 @@ (* ; "Edited 30-May-91 21:09 by jds") (LET ((LOOKS (FGETTOBJ (TEXTOBJ TSTREAM) CARETLOOKS))) - (TEDIT.PROMPTPRINT TSTREAM (CONCAT (\TEDIT.DESCRIBEFONT (GETCLOOKS LOOKS CLFONT)) + (TEDIT.PROMPTPRINT TSTREAM [CONCAT (\TEDIT.DESCRIBEFONT (GETCLOOKS LOOKS CLFONT)) (CL:IF (AND (GETCLOOKS LOOKS CLOFFSET) (NEQ (GETCLOOKS LOOKS CLOFFSET) 0)) @@ -560,7 +641,11 @@ "") (CL:IF (GETCLOOKS LOOKS CLUNBREAKABLE) " unbreakable" - "")) + "") + (CL:IF (EQ 'BLACK (GETCLOOKS LOOKS CLCOLOR)) + "" + (CONCAT " color " (L-CASE (GETCLOOKS LOOKS CLCOLOR)))) + ] T]) (\TEDIT.DESCRIBEFONT @@ -592,7 +677,8 @@ (DEFINEQ (\TEDIT.ONECHAR.BACKWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:12 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:46 by rmk") + (* ; "Edited 17-Feb-2025 09:12 by rmk") (* ; "Edited 24-Jan-2025 15:25 by rmk") (* ; "Edited 21-Nov-2024 20:31 by rmk") (* ; "Edited 1-Sep-2024 10:39 by rmk") @@ -606,15 +692,14 @@ TEXTOBJ))) (IMAGEOBJPROP OBJ 'FIELDPREFIX] (FSETTOBJ TEXTOBJ LASTARROWX NIL) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL (SUB1 PT) + (\TEDIT.NOSEL TSTREAM) + (\TEDIT.UPDATE.SEL TSTREAM (SUB1 PT) 0 - 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + 'LEFT))]) (\TEDIT.ONECHAR.FORWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 17-Feb-2025 09:11 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:40 by rmk") + (* ; "Edited 17-Feb-2025 09:11 by rmk") (* ; "Edited 15-Feb-2025 08:50 by rmk") (* ; "Edited 24-Jan-2025 15:27 by rmk") (* ; "Edited 21-Nov-2024 20:31 by rmk") @@ -631,10 +716,8 @@ (SETQ OBJ (POBJ (\TEDIT.CHTOPC PT TEXTOBJ))) (IMAGEOBJPROP OBJ 'FIELDSUFFIX] (FSETTOBJ TEXTOBJ LASTARROWX NIL) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL PT 0 'RIGHT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + (\TEDIT.NOSEL TSTREAM) + (\TEDIT.UPDATE.SEL TSTREAM PT 0 'RIGHT))]) (\TEDIT.ONELINE.UP [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 13-Feb-2025 22:04 by rmk") @@ -702,7 +785,8 @@ TSTREAM))]) (\TEDIT.ONELINE.MOVE - [LAMBDA (SEL CHNO TSTREAM) (* ; "Edited 16-Feb-2025 16:20 by rmk") + [LAMBDA (SEL CHNO TSTREAM) (* ; "Edited 6-Apr-2025 11:04 by rmk") + (* ; "Edited 16-Feb-2025 16:20 by rmk") (* ; "Edited 14-Feb-2025 09:49 by rmk") (* ;; @@ -731,14 +815,13 @@ (add CHNO 1) finally (* ;  "TARGETLINE must have been shorter than X") (SETQ CHNO (FGETLD TARGETLINE LCHARLAST))) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL CHNO 0 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (\TEDIT.SHOWSEL SEL NIL TSTREAM) + (\TEDIT.UPDATE.SEL TSTREAM CHNO 0 'LEFT) (\TEDIT.SCROLL.CARET TSTREAM))]) (\TEDIT.ONEWORD.BACKWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:47 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 11:03 by rmk") + (* ; "Edited 19-Mar-2025 13:47 by rmk") (* ; "Edited 5-Mar-2025 17:37 by rmk") (* gbn "20-Mar-85 00:49") @@ -751,14 +834,13 @@  "End of word, maybe after whitespace") (SETQ LAST (IMIN HERE (\TEDIT.WORD.LAST TSTREAM FIRST))) (* ; "In case we started in white space") - (\TEDIT.UPDATE.SEL SEL FIRST (ADD1 (IDIFFERENCE LAST FIRST)) + (\TEDIT.UPDATE.SEL TSTREAM FIRST (ADD1 (IDIFFERENCE LAST FIRST)) 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ]) (\TEDIT.ONEWORD.FORWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:47 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 10:59 by rmk") + (* ; "Edited 19-Mar-2025 13:47 by rmk") (* ; "Edited 5-Mar-2025 17:33 by rmk") (* gbn "20-Mar-85 00:48") @@ -771,14 +853,13 @@  "End of word, maybe after whitespace") (SETQ FIRST (IMAX HERE (\TEDIT.WORD.FIRST TSTREAM LAST))) (* ; "In case we started in white space") - (\TEDIT.UPDATE.SEL SEL FIRST (ADD1 (IDIFFERENCE LAST FIRST)) + (\TEDIT.UPDATE.SEL TSTREAM FIRST (ADD1 (IDIFFERENCE LAST FIRST)) 'RIGHT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ]) (\TEDIT.LINE.BEGIN - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:16 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 10:58 by rmk") + (* ; "Edited 19-Mar-2025 13:16 by rmk") (* ; "Edited 15-Mar-2025 22:55 by rmk") (* ; "Edited 9-Mar-2025 19:50 by rmk") (* ; "Edited 5-Mar-2025 00:05 by rmk") @@ -790,14 +871,13 @@ TEXTOBJ))) (CL:WHEN L1 (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL (FGETLD L1 LCHAR1) + (\TEDIT.UPDATE.SEL TSTREAM (FGETLD L1 LCHAR1) 0 - 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + 'LEFT))]) (\TEDIT.LINE.END - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:16 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 10:59 by rmk") + (* ; "Edited 19-Mar-2025 13:16 by rmk") (* ; "Edited 15-Mar-2025 22:54 by rmk") (* ; "Edited 9-Mar-2025 19:49 by rmk") (* ; "Edited 5-Mar-2025 14:07 by rmk") @@ -811,13 +891,11 @@ (* ;; "Put the caret in front of the terminating EOL so it stays on LN.") - (\TEDIT.UPDATE.SEL SEL (FGETLD LN LCHARLAST) + (\TEDIT.UPDATE.SEL TSTREAM (FGETLD LN LCHARLAST) 0 (CL:IF (FGETLD LN FORCED-END) 'LEFT - 'RIGHT)) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + 'RIGHT)))]) (\TEDIT.DOCUMENT.BEGIN [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2025 23:08 by rmk") @@ -845,7 +923,8 @@ (DEFINEQ (\TEDIT.LINEDELETE.FORWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2025 23:02 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:41 by rmk") + (* ; "Edited 15-Mar-2025 23:02 by rmk") (* ; "Edited 9-Mar-2025 22:11 by rmk") (* ; "Edited 4-Mar-2025 17:22 by rmk") (* gbn "13-Dec-84 11:56") @@ -856,13 +935,14 @@ HERE) (CL:WHEN LINE (SETQ HERE (TEDIT.GETPOINT TSTREAM)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHARLIM) HERE)) - (TEDIT.DELETE TEXTOBJ SEL))]) + (TEDIT.DELETE TSTREAM SEL))]) (\TEDIT.LINEDELETE.BACKWARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2025 23:02 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 6-Apr-2025 14:41 by rmk") + (* ; "Edited 15-Mar-2025 23:02 by rmk") (* ; "Edited 9-Mar-2025 22:11 by rmk") (* ; "Edited 4-Mar-2025 17:22 by rmk") (* gbn "13-Dec-84 11:56") @@ -874,7 +954,7 @@ HERE) (CL:WHEN LINE (SETQ HERE (TEDIT.GETPOINT TSTREAM)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHAR1) HERE)) (TEDIT.DELETE TEXTOBJ SEL))]) @@ -882,7 +962,10 @@ (DEFINEQ (\TEDIT.KEY.NEST - [LAMBDA (TSTREAM OUTFLAG) (* ; "Edited 16-Mar-2025 13:06 by rmk") + [LAMBDA (TSTREAM OUTFLAG) (* ; "Edited 21-Apr-2025 20:18 by rmk") + (* ; "Edited 6-Apr-2025 14:42 by rmk") + (* ; "Edited 5-Apr-2025 13:16 by rmk") + (* ; "Edited 16-Mar-2025 13:06 by rmk") (* ; "Edited 7-Mar-2025 22:18 by rmk") (* ;; "This moves the left margin of each selected paragraph in TEDITKEY.NESTWIDTH points. It has to go paragraph by paragraph because the paragraphs may have different margins to begin with.") @@ -894,7 +977,7 @@ (TARGETSEL _ (\TEDIT.COPYSEL SEL)) in (\TEDIT.PARACHNOS SEL NIL TEXTOBJ) first (CL:WHEN OUTFLAG (SETQ DELTA (IMINUS DELTA))) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (FSETSEL SEL SET NIL) do (SETQ LOOKS (TEDIT.GET.PARALOOKS TSTREAM CHNO)) (LISTPUT LOOKS 'LEFTMARGIN (IPLUS (LISTGET LOOKS 'LEFTMARGIN) @@ -909,10 +992,41 @@ (\TEDIT.UPDATE.SEL TARGETSEL CHNO 1) (\TEDIT.CHANGE.PARALOOKS TSTREAM LOOKS TARGETSEL) finally (FSETSEL SEL SET T) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TSTREAM) (TEDIT.PROMPTCLEAR TSTREAM]) ) +(DEFINEQ + +(\TEDIT.KEY.WRAP + [LAMBDA (TSTREAM LEFT RIGHT) (* ; "Edited 4-Apr-2025 11:12 by rmk") + (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ)) + (CH# (FGETSEL SEL CH#)) + (DCH (FGETSEL SEL DCH)) + (POINT (FGETSEL SEL POINT)) + UNDOEVENT) + + (* ;; "The wrap event includes the 2 insert-events and the original selection, undo just undoes them all. But it als has the LEFT and RIGHT so that Redo knows what to do.") + + (TEDIT.INSERT TSTREAM RIGHT (FGETSEL SEL CHLIM) + (\TEDIT.NTHCHARLOOKS TSTREAM (FGETSEL SEL CHLAST))) + (TEDIT.INSERT TSTREAM LEFT CH#) + (TEDIT.SETSEL TSTREAM CH# (IPLUS (NCHARS LEFT) + DCH + (NCHARS RIGHT)) + POINT) + (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ (LIST (\TEDIT.POPEVENT TEXTOBJ) + (\TEDIT.POPEVENT TEXTOBJ) + (\TEDIT.HISTORY.EVENT TEXTOBJ :Sel CH# DCH POINT + )) + :Wrap + (LIST LEFT RIGHT]) +) + + + +(* ; "From TEDITDORADOKEYS") + (RPAQ? TEDIT.NESTWIDTH 36) @@ -923,7 +1037,9 @@ (DEFINEQ (\TEDIT.KEY.FIND - [LAMBDA (TSTREAM AGAIN BACKWARD SEARCHSTRING) (* ; "Edited 19-Mar-2025 11:20 by rmk") + [LAMBDA (TSTREAM AGAIN BACKWARD SEARCHSTRING) (* ; "Edited 21-Apr-2025 13:58 by rmk") + (* ; "Edited 6-Apr-2025 14:42 by rmk") + (* ; "Edited 19-Mar-2025 11:20 by rmk") (* ; "Edited 16-Mar-2025 21:42 by rmk") (* ; "Edited 11-Mar-2025 15:09 by rmk") (* ; "Edited 26-Nov-2024 23:47 by rmk") @@ -947,52 +1063,49 @@ (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (RESETLST - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - (SEL (TEXTSEL TEXTOBJ)) - CH) - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find") - '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] - (CL:UNLESS SEARCHSTRING - (SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING TEXTOBJ AGAIN BACKWARD))) - (CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING) - 1)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (SETQ CH (if BACKWARD - then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" - SEARCHSTRING "%"") - T) - (\TEDIT.FIND.BACKWARD TSTREAM (MKSTRING SEARCHSTRING) - T) - else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" SEARCHSTRING - "%"") - T) - (\TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING) - T))) - (if CH - then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found") - T) (* ; "We found the target text.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + [LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (SEL (TEXTSEL TEXTOBJ)) + CH) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find") + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (CL:UNLESS SEARCHSTRING + (SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING TEXTOBJ AGAIN BACKWARD))) + (CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING) + 1)) + (\TEDIT.NOSEL TSTREAM) + (SETQ CH (if BACKWARD + then (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Searching backward for %"" + SEARCHSTRING "%"") + T) + (\TEDIT.FIND.BACKWARD TSTREAM (MKSTRING SEARCHSTRING) + T) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Searching for %"" SEARCHSTRING + "%"") + T) + (\TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING) + T))) + (if CH + then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found") + T) (* ; "We found the target text.") + (\TEDIT.RESET.EXTEND.PENDING.DELETE TSTREAM) (* ;  "Set up SELECTION to be the found text") - (\TEDIT.UPDATE.SEL SEL (CAR CH) - (CADR CH) - (CL:IF BACKWARD - 'LEFT - 'RIGHT) - (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) - 'PENDINGDEL - 'NORMAL)) - (SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH) - 1) - 'WORD - 'CHAR)) - (\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 (CONCAT "%"" SEARCHSTRING "%" not found") - T)) - (\TEDIT.SHOWSEL SEL T TEXTOBJ))))]) + (SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH) + 1) + 'WORD + 'CHAR)) + (\TEDIT.UPDATE.SEL TSTREAM (CAR CH) + (CADR CH) + (CL:IF BACKWARD + 'LEFT + 'RIGHT) + (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) + 'PENDINGDEL + 'NORMAL)) + (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) + (TEDIT.NORMALIZECARET TSTREAM) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT "%"" SEARCHSTRING "%" not found") + T)))])]) (\TEDIT.KEY.FIND.SEARCHSTRING [LAMBDA (TEXTOBJ AGAIN BACKWARD) (* ; "Edited 22-Jun-2024 10:17 by rmk") @@ -1218,7 +1331,9 @@ (ADDTOVAR CHARACTERNAMES (EMQUAD "357,55") (ENQUAD "357,54") (THINSPACE "357,57") - (FIGURESPACE "357,56")) + (FIGURESPACE "357,56") + (LEFT-DOUBLEQUOTE "0,252") + (RIGHT-DOUBLEQUOTE "0,272")) (DEFINEQ (\TEDIT.READTABLE @@ -1333,7 +1448,8 @@ (\TEDIT.TTC NONE))))]) (TEDIT.GETFUNCTION - [LAMBDA (CHARCODE RDTBL) (* ; "Edited 13-Mar-2025 22:56 by rmk") + [LAMBDA (CHARCODE RDTBL) (* ; "Edited 5-Apr-2025 11:37 by rmk") + (* ; "Edited 13-Mar-2025 22:56 by rmk") (* ; "Edited 7-Mar-2025 12:02 by rmk") (* jds "19-Sep-85 17:06") @@ -1348,7 +1464,7 @@ TXTRTBL) TEDIT.READTABLE) else RDTBL)) - (CL:WHEN (AND RDTBL (type? READTABLEP RDTBL) + (CL:WHEN (AND (READTABLEP RDTBL) (EQ (\TEDIT.TTC FUNCTIONCALL) (\SYNCODE (fetch READSA of RDTBL) CHARCODE)) @@ -1410,7 +1526,8 @@ (\TEDIT.TTC TEXT]) (TEDIT.ATOMBOUND.READTABLE - [LAMBDA (READTABLE) (* ; "Edited 14-Mar-2025 18:13 by rmk") + [LAMBDA (READTABLE) (* ; "Edited 5-Apr-2025 11:47 by rmk") + (* ; "Edited 14-Mar-2025 18:13 by rmk") (* ; "Edited 25-Dec-2023 13:10 by rmk") (* ; "Edited 5-Dec-2023 23:47 by rmk") @@ -1418,12 +1535,11 @@ (* ;; "Could cache this for common readtables (interlisp, commonlisp)") + (CL:UNLESS READTABLE (SETQ READTABLE *READTABLE*)) (LET ((TABLE (\TEDIT.WORDBOUND.READTABLE))) (* ;  "\TEDIT.WORDBOUND.READTABLE creates a new one each time.") - (for CODE IN (GETSYNTAX 'OTHER (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE - 'TEXT TABLE)) - (for CODE IN (GETSYNTAX 'BREAK (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE - 'PUNCT TABLE)) + (for CODE IN (GETSYNTAX 'OTHER READTABLE) do (TEDIT.WORDSET CODE 'TEXT TABLE)) + (for CODE IN (GETSYNTAX 'BREAK READTABLE) do (TEDIT.WORDSET CODE 'PUNCT TABLE)) (TEDIT.WORDSET (CHARCODE %:) 'TEXT TABLE) TABLE]) @@ -1467,7 +1583,8 @@ ) (RPAQQ TEDIT.CHARACTIONS - ( + ((TEDIT-PF PF-TEDIT-FROM-TEXT) + (* ;; "This defines the implementation of the named actions. They are activated by keybinding specifications given to TEDIT.INSTALL.KEYBINDINGS.") @@ -1584,6 +1701,16 @@ (* ;; "") + (* ;; "From TEDITDORADOKEYS") + + (WRAP.PARENS (\TEDIT.KEY.WRAP TSTREAM "(" ")")) + (WRAP.NEUTRAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM "%"" "%"")) + [WRAP.REAL.DOUBLEQUOTES (\TEDIT.KEY.WRAP TSTREAM (CHARACTER (CHARCODE LEFT-DOUBLEQUOTE)) + (CHARACTER (CHARCODE RIGHT-DOUBLEQUOTE] + + (* ;; "") + + (* ;; "Clipboard") (CLIPBOARD-PASTE PASTEFROMCLIPBOARD) @@ -1600,7 +1727,7 @@ (WHEELSCROLL-LEFT (WHEELSCROLL 'HORIZONTAL)) (WHEELSCROLL-RIGHT (WHEELSCROLL 'HORIZONTAL T)))) -(RPAQQ TEDIT.CHARBINDINGS +(RPAQQ TEDIT.BASIC.CHARBINDINGS ( (* ;; "Establishes key bindings for particular Tedit key actions. Function,xxx roughly correspond to Koto release notes, but this preserves the immediately preceding assignments if those drifted away from the Koto notes. There is no obvious way of typing Function. Maybe Meta,^xxx instead, as in DORADO.KEYBINDINGS. (But CTRL collapses upper and lower case).") @@ -1728,24 +1855,48 @@ (RPAQQ TEDIT.DORADO.CHARBINDINGS ( - (* ;; "Taken from lispusers>TKDORADO, these make the indicatedd Tedit commands available from the Dorado keyboard.") + (* ;; "Taken from lispusers>TKDORADO, these make the indicated Tedit commands available from the Dorado keyboard.") (DEFAULTS "Meta,^V") - (BOLD.ON "Meta,^B") - (BOLD.OFF "Meta,^N") + (BOLD.ON "Meta,^B" "Meta,b") + (BOLD.OFF "Meta,^N" "Meta,B") (ITALIC.ON "Meta,^I") (ITALIC.OFF "Meta,^O") (OVERLINE.ON "Meta,^D") (OVERLINE.OFF "Meta,^F") (STRIKEOUT.ON "Meta,^G") (STRIKEOUT.OFF "Meta,^H") - (UNDERLINE.ON "Meta,^J") + (* (UNDERLINE.ON "Meta,^J") + conflicts with LINE.DOWN) (UNDERLINE.OFF "Meta,^K") (SMALLER "Meta,^[") (LARGER "Meta,^^]") (SUBSCRIPT "Meta,^^") (SUPERSCRIPT "Meta,^_") - (QUAD "Meta,^C"))) + (QUAD "Meta,^C") + + (* ;; "Mappings from lispusers>TEDITDORADOKEYS") + + (* ("Meta,c" QUAD) + ("Meta,C" QUAD) + ("Meta,x" EXPAND) + ("Meta,X" EXPAND) + conflict with clipboard) + (* ("Meta,^" SUBSCRIPT) + conflicts with LINE.UP) + (BOLD.ON "Meta,b") + (BOLD.OFF "Meta,B") + (ITALIC.ON "Meta,i") + (ITALIC.OFF "Meta,I") + (STRIKEOUT.ON "Meta,=") + (STRIKEOUT.OFF "Meta,+") + (UNDERLINE.ON "Meta,-") + (UNDERLINE.OFF "Meta,_") + (WRAP.PARENS "Meta,(" "Meta,Nine") + (WRAP.NEUTRAL.DOUBLEQUOTES "Meta,%"") + (WRAP.REAL.DOUBLEQUOTES "Meta,'"))) + +(RPAQ TEDIT.CHARBINDINGS (APPEND TEDIT.BASIC.CHARBINDINGS TEDIT.DORADO.CHARBINDINGS)) @@ -1880,27 +2031,30 @@ (RPAQQ TEDIT.BUTTONBITMAP #*(78 48)OOOOOOOOOOOOOOOOOOOLON@@@@@@@@@@@@@@@AOLO@@@@@@@@@@@@@@@@@CLO@@@@@@@@@@@@@@@@@CLMH@@@@@@@@@@@@@@@@DLNLGOOOOOOOOOOOOOOHHLMFL@@@@@@@@@@@@@@M@LJK@@@@@@@@@@@@@@@B@DMF@@@@@@@@@@@@@@@A@DJN@@@@@@@@@@@@@@@AHDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMD@@@@@@@@@@@@@@@@HDJL@@@@@@@@@@@@@@@@HDMF@@@@@@@@@@@@@@@AHDJJ@@@@@@@@@@@@@@@A@DMG@@@@@@@@@@@@@@@B@DNEL@@@@@@@@@@@@@@O@LLIGOOOOOOOOOOOOOOMHLOBBJJJJJJJJJJJJJJJLLNDEEEEEEEEEEEEEEEEGLOHJJJJJJJJJJJJJJJJKLOLEEEEEEEEEEEEEEEEOLOOOOOOOOOOOOOOOOOOOL ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3704 7717 (CHARNAME 3714 . 7715)) (7773 21650 (TEDIT.INSTALL.CHARBINDINGS 7783 . 10966) - (TEDIT.CLEAR.CHARBINDINGS 10968 . 13559) (TEDIT.GET.CHARACTION 13561 . 16208) (TEDIT.GET.CHARBINDING -16210 . 18134) (TEDIT.GET.ALL.CHARBINDINGS 18136 . 19790) (TEDIT.GET.ALL.CHARACTIONS 19792 . 21648)) ( -21710 31328 (\TEDIT.KEY.CHARLOOKS 21720 . 22662) (\TEDIT.KEY.QUAD 22664 . 24757) (\TEDIT.DEFAULTSSEL -24759 . 25370) (\TEDIT.SETDEFAULT.FROM.SEL 25372 . 26049) (\TEDIT.KEY.SIZE 26051 . 27247) ( -\TEDIT.SUBSCRIPTSEL 27249 . 27452) (\TEDIT.SUPERSCRIPTSEL 27454 . 27658) (\TEDIT.KEY.TRANSFORM 27660 - . 29470) (\TEDIT.KEY.OPENLINE 29472 . 29926) (\TEDIT.KEY.FAMILYN 29928 . 31326)) (31329 31618 ( -CAP-CASECODE 31339 . 31616)) (31652 34582 (\TEDIT.SHOWCARETLOOKS 31662 . 33675) (\TEDIT.DESCRIBEFONT -33677 . 34580)) (34613 49349 (\TEDIT.ONECHAR.BACKWARD 34623 . 35752) (\TEDIT.ONECHAR.FORWARD 35754 . -36972) (\TEDIT.ONELINE.UP 36974 . 39935) (\TEDIT.ONELINE.DOWN 39937 . 41594) (\TEDIT.ONELINE.MOVE -41596 . 43810) (\TEDIT.ONEWORD.BACKWARD 43812 . 44964) (\TEDIT.ONEWORD.FORWARD 44966 . 46117) ( -\TEDIT.LINE.BEGIN 46119 . 47170) (\TEDIT.LINE.END 47172 . 48381) (\TEDIT.DOCUMENT.BEGIN 48383 . 48742) - (\TEDIT.DOCUMENT.END 48744 . 49347)) (49350 51194 (\TEDIT.LINEDELETE.FORWARD 49360 . 50260) ( -\TEDIT.LINEDELETE.BACKWARD 50262 . 51192)) (51195 53453 (\TEDIT.KEY.NEST 51205 . 53451)) (53507 61462 -(\TEDIT.KEY.FIND 53517 . 58602) (\TEDIT.KEY.FIND.SEARCHSTRING 58604 . 59744) (\TEDIT.GET.TARGET.STRING - 59746 . 61460)) (61493 64125 (\TEDIT.KEY.SUBSTITUTE 61503 . 61724) (\TEDIT.MANPAGE 61726 . 62973) ( -\TEDIT.CALL.ED 62975 . 63805) (\TEDIT.SELECT.ALL 63807 . 64123)) (64152 69842 (\TEDIT.CLIPBOARD 64162 - . 65917) (\TEDIT.COPYTOCLIPBOARD 65919 . 66699) (\TEDIT.EXTRACTTOCLIPBOARD 66701 . 66896) ( -\TEDIT.WRITE.SEL 66898 . 69840)) (70194 81909 (\TEDIT.READTABLE 70204 . 71140) ( -\TEDIT.WORDBOUND.READTABLE 71142 . 73771) (TEDIT.GETSYNTAX 73773 . 75292) (TEDIT.SETSYNTAX 75294 . -76499) (TEDIT.GETFUNCTION 76501 . 77673) (TEDIT.SETFUNCTION 77675 . 79661) (TEDIT.WORDGET 79663 . -79924) (TEDIT.WORDSET 79926 . 80557) (TEDIT.ATOMBOUND.READTABLE 80559 . 81907)) (92497 99036 ( -TEDIT.BUTTONS.BUILD 92507 . 97304) (TEDIT.BUTTONBITMAP.FILL 97306 . 99034))))) + (FILEMAP (NIL (4055 8434 (CHARCODE.ENCODE 4065 . 8432)) (8490 27412 (TEDIT.INSTALL.CHARBINDINGS 8500 + . 12391) (TEDIT.CLEAR.CHARBINDINGS 12393 . 15071) (TEDIT.GET.CHARACTION 15073 . 17819) ( +TEDIT.GET.CHARBINDING 17821 . 19960) (TEDIT.GET.ALL.CHARBINDINGS 19962 . 22278) ( +TEDIT.CHARBINDINGS.INVERT 22280 . 24010) (TEDIT.GET.ALL.CHARACTIONS 24012 . 26098) ( +TEDIT.CONFLICTING.CHARBINDINGS 26100 . 27410)) (27472 37527 (\TEDIT.KEY.CHARLOOKS 27482 . 28674) ( +\TEDIT.KEY.QUAD 28676 . 30769) (\TEDIT.DEFAULTSSEL 30771 . 31382) (\TEDIT.SETDEFAULT.FROM.SEL 31384 . +32061) (\TEDIT.KEY.SIZE 32063 . 33259) (\TEDIT.SUBSCRIPTSEL 33261 . 33464) (\TEDIT.SUPERSCRIPTSEL +33466 . 33670) (\TEDIT.KEY.TRANSFORM 33672 . 35669) (\TEDIT.KEY.OPENLINE 35671 . 36125) ( +\TEDIT.KEY.FAMILYN 36127 . 37525)) (37528 37817 (CAP-CASECODE 37538 . 37815)) (37851 41283 ( +\TEDIT.SHOWCARETLOOKS 37861 . 40376) (\TEDIT.DESCRIBEFONT 40378 . 41281)) (41314 56242 ( +\TEDIT.ONECHAR.BACKWARD 41324 . 42471) (\TEDIT.ONECHAR.FORWARD 42473 . 43709) (\TEDIT.ONELINE.UP 43711 + . 46672) (\TEDIT.ONELINE.DOWN 46674 . 48331) (\TEDIT.ONELINE.MOVE 48333 . 50575) ( +\TEDIT.ONEWORD.BACKWARD 50577 . 51765) (\TEDIT.ONEWORD.FORWARD 51767 . 52954) (\TEDIT.LINE.BEGIN 52956 + . 54035) (\TEDIT.LINE.END 54037 . 55274) (\TEDIT.DOCUMENT.BEGIN 55276 . 55635) (\TEDIT.DOCUMENT.END +55637 . 56240)) (56243 58285 (\TEDIT.LINEDELETE.FORWARD 56253 . 57252) (\TEDIT.LINEDELETE.BACKWARD +57254 . 58283)) (58286 60814 (\TEDIT.KEY.NEST 58296 . 60812)) (60815 62097 (\TEDIT.KEY.WRAP 60825 . +62095)) (62188 70236 (\TEDIT.KEY.FIND 62198 . 67376) (\TEDIT.KEY.FIND.SEARCHSTRING 67378 . 68518) ( +\TEDIT.GET.TARGET.STRING 68520 . 70234)) (70267 72899 (\TEDIT.KEY.SUBSTITUTE 70277 . 70498) ( +\TEDIT.MANPAGE 70500 . 71747) (\TEDIT.CALL.ED 71749 . 72579) (\TEDIT.SELECT.ALL 72581 . 72897)) (72926 + 78616 (\TEDIT.CLIPBOARD 72936 . 74691) (\TEDIT.COPYTOCLIPBOARD 74693 . 75473) ( +\TEDIT.EXTRACTTOCLIPBOARD 75475 . 75670) (\TEDIT.WRITE.SEL 75672 . 78614)) (79073 90855 ( +\TEDIT.READTABLE 79083 . 80019) (\TEDIT.WORDBOUND.READTABLE 80021 . 82650) (TEDIT.GETSYNTAX 82652 . +84171) (TEDIT.SETSYNTAX 84173 . 85378) (TEDIT.GETFUNCTION 85380 . 86645) (TEDIT.SETFUNCTION 86647 . +88633) (TEDIT.WORDGET 88635 . 88896) (TEDIT.WORDSET 88898 . 89529) (TEDIT.ATOMBOUND.READTABLE 89531 . +90853)) (102684 109223 (TEDIT.BUTTONS.BUILD 102694 . 107491) (TEDIT.BUTTONBITMAP.FILL 107493 . 109221) +)))) STOP diff --git a/library/tedit/TEDIT-FNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM index dc1f405fa..729a1cd24 100644 Binary files a/library/tedit/TEDIT-FNKEYS.LCOM and b/library/tedit/TEDIT-FNKEYS.LCOM differ diff --git a/library/tedit/TEDIT-HCPY b/library/tedit/TEDIT-HCPY index 02138ba61..094b520cf 100644 --- a/library/tedit/TEDIT-HCPY +++ b/library/tedit/TEDIT-HCPY @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Feb-2025 13:34:37" {WMEDLEY}tedit>TEDIT-HCPY.;170 33842 +(FILECREATED "21-Apr-2025 19:07:23" {WMEDLEY}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}tedit>TEDIT-HCPY.;169) + :PREVIOUS-DATE "17-Apr-2025 13:35:29" {WMEDLEY}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)) - - (* ;; "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") - - (SELCHARQ CHAR - (SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT) + (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.") + + (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") + + (* ;; "Underline/overline/strike the just-finished looks run") + (* ; "DISPLAY ALSO PASES LINE DESCENT") + (\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.") + + (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) (* ; + (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) (* ; + (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) - (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") - (* ; "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) - - (* ;; "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 CURY (DSPYPOSITION NIL PRSTREAM)) - (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) - CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM) - (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (DSPFONT (fetch CLFONT of CLOOKS) - PRSTREAM) (* ; + (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) + 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") - - (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 + (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 (* ;; "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 diff --git a/library/tedit/TEDIT-HCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM index 62c40ed7f..f9405b1f3 100644 Binary files a/library/tedit/TEDIT-HCPY.LCOM and b/library/tedit/TEDIT-HCPY.LCOM differ diff --git a/library/tedit/TEDIT-HISTORY b/library/tedit/TEDIT-HISTORY index 1d249bbbe..203f5572b 100644 --- a/library/tedit/TEDIT-HISTORY +++ b/library/tedit/TEDIT-HISTORY @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 14:23:18" {WMEDLEY}TEDIT>TEDIT-HISTORY.;227 53951 +(FILECREATED "21-Apr-2025 22:42:33" {WMEDLEY}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}tedit>TEDIT-HISTORY.;225) + :PREVIOUS-DATE "20-Apr-2025 23:30:57" {WMEDLEY}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) - - (* ;; "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) (* ; + (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.") + + (\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.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]) + (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 + + (* ;; "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") + + (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 ") - - (* ;; "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] - - (* ;; "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 - - (* ;; + (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") + + (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") + + (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") - - (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") - - (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.") - - (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") - - (\TEDIT.HISTORYADD TEXTOBJ EVENT]) + (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") + + (* ;; "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 + + (* ;; + "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.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)) + + (* ;; "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 diff --git a/library/tedit/TEDIT-HISTORY.LCOM b/library/tedit/TEDIT-HISTORY.LCOM index 58449eb91..87faaa78c 100644 Binary files a/library/tedit/TEDIT-HISTORY.LCOM and b/library/tedit/TEDIT-HISTORY.LCOM differ diff --git a/library/tedit/TEDIT-LOOKS b/library/tedit/TEDIT-LOOKS index efa2ec25a..c4512622a 100644 --- a/library/tedit/TEDIT-LOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2025 22:01:10" {WMEDLEY}TEDIT>TEDIT-LOOKS.;403 156185 +(FILECREATED "24-Apr-2025 23:47:54" {WMEDLEY}tedit>TEDIT-LOOKS.;425 159446 :EDIT-BY rmk :CHANGES-TO (FNS \TEDIT.TRANSLATE.ASCIICHARS) - :PREVIOUS-DATE "28-Mar-2025 14:24:25" {WMEDLEY}TEDIT>TEDIT-LOOKS.;402) + :PREVIOUS-DATE "24-Apr-2025 16:05:02" {WMEDLEY}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 diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM index 7830009dc..4dbf3fdfe 100644 Binary files a/library/tedit/TEDIT-LOOKS.LCOM and b/library/tedit/TEDIT-LOOKS.LCOM differ diff --git a/library/tedit/TEDIT-MENU b/library/tedit/TEDIT-MENU index 69c71b061..00f19f5fb 100644 --- a/library/tedit/TEDIT-MENU +++ b/library/tedit/TEDIT-MENU @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Mar-2025 14:56:57" {WMEDLEY}tedit>TEDIT-MENU.;464 162009 +(FILECREATED "26-Apr-2025 11:53:00" {WMEDLEY}TEDIT>TEDIT-MENU.;474 176155 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.FILLIN) + :CHANGES-TO (FNS MB.MARGINBAR.BUTTONEVENTINFN MB.MARGINBAR.SELFN.TABS + \TEDIT.EXPANDEDMENU.ACTIONFN) - :PREVIOUS-DATE "19-Mar-2025 10:01:40" {WMEDLEY}tedit>TEDIT-MENU.;461) + :PREVIOUS-DATE "20-Apr-2025 23:44:58" {WMEDLEY}TEDIT>TEDIT-MENU.;471) (PRETTYCOMPRINT TEDIT-MENUCOMS) @@ -26,6 +27,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 @@ -137,6 +148,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 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 TEXTOBJ)) + (Character% Looks (* ; + "Open the menu for setting character looks") + (\TEDIT.CHARMENU.START TEXTOBJ)) + (Paragraph% Formatting (* ; + "Open the paragraph formatting menu") + (\TEDIT.PARAMENU.START TEXTOBJ)) + (Page% Layout (* ; "Open the page-layout menu") + (\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE) + TSTREAM "Page Layout Menu" 150 'PAGE)) + (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 +613,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 +722,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] @@ -1343,7 +1562,8 @@ (RETURN 'DON'T]) (\TEDIT.EXPANDEDMENU.ACTIONFN - [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 18-Mar-2025 23:54 by rmk") + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 6-Apr-2025 14:39 by rmk") + (* ; "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") @@ -1369,7 +1589,7 @@ (* ; "Edited 30-Mar-94 16:04 by jds") (* ;  "MBFN for TEdit default menu item buttons.") - (LET ((MENUTEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM))) + (LET ((MENUTEXTOBJ (FTEXTOBJ MENUSTREAM)) STATE) [ERSETQ (RESETLST [RESETSAVE (PROG1 OBJ @@ -1378,22 +1598,22 @@ (SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER) (PUT (* ;  "Only try this if he really typed a file name") - (SETQ STATE (MB.GET 'PUTFILE MENUTEXTOBJ 'STATE MENUSEL)) + (SETQ STATE (MB.GET 'PUTFILE MENUSTREAM 'STATE MENUSEL)) (if STATE then (TEDIT.PUT MAINSTREAM STATE NIL (GETTEXTPROP MAINSTREAM 'UNFORMATTEDPUT/GET)) else (TEDIT.PROMPTPRINT MAINSTREAM "Put file not specified" T))) - (GET (SETQ STATE (MB.GET 'GETFILE MENUTEXTOBJ 'STATE MENUSEL)) + (GET (SETQ STATE (MB.GET 'GETFILE MAINSTREAM 'STATE MENUSEL)) (if STATE then (TEDIT.GET MAINSTREAM STATE (GETTEXTPROP MAINSTREAM 'UNFORMATTEDPUT/GET)) else (TEDIT.PROMPTPRINT MAINSTREAM "Get file not specified" T))) - (INCLUDE (SETQ STATE (MB.GET 'INCLUDEFILE MENUTEXTOBJ 'STATE MENUSEL)) + (INCLUDE (SETQ STATE (MB.GET 'INCLUDEFILE MENUSTREAM 'STATE MENUSEL)) (if STATE then (TEDIT.INCLUDE MAINSTREAM STATE) 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) @@ -1401,15 +1621,16 @@ )) (SUBSTITUTE [LET* [(STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS ) - MENUTEXTOBJ + MENUSTREAM '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.SELPIECES MENUTEXTOBJ + REPLACEMENT NIL + MENUTEXTOBJ) (TEDIT.SEL.AS.STRING MENUSTREAM REPLACEMENT))) [TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT @@ -1430,7 +1651,7 @@ (TEDIT.SETSEL MAINSTREAM 1 (TEXTLEN (TEXTOBJ MAINSTREAM)) 'LEFT)) (HARDCOPY (LET* ((STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#) - MENUTEXTOBJ + MENUSTREAM 'STATE MENUSEL)) (SERVER (LISTGET STATES 'SERVER)) (COPIES (LISTGET STATES 'COPIES)) @@ -1455,7 +1676,7 @@ (SETSEL MENUSEL SET T) (* ;  "Now turn the menu button highlighting off.") (SETSEL MENUSEL ONFLG T) - (\TEDIT.SHOWSEL MENUSEL NIL MENUTEXTOBJ) (* ; + (\TEDIT.NOSEL MENUSTREAM) (* ;  "And forget that anything is selected.") (SETSEL MENUSEL SET NIL]) ) @@ -1608,7 +1829,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 +1864,7 @@ (\TEDIT.UPDATE.SEL (TEXTSEL MENUTEXTOBJ) 1 0 'LEFT) (\TEDIT.FIXSEL (TEXTSEL MENUTEXTOBJ) - MENUTEXTOBJ) + MENUSTREAM) (TEDIT.BACKTOMAIN MENUSTREAM))]) (\TEDIT.PARAMENU.FILLIN @@ -1910,7 +2132,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 +2176,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 +2197,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 +2221,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 +2236,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 @@ -2271,7 +2496,8 @@ ,@(\TEDIT.CHARMENU.SPEC TSTREAM]) (\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 +2520,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 @@ -2634,29 +2860,31 @@ (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 (6048 17679 (TEDIT.ADD.MENUITEM 6058 . 8175) (TEDIT.DEFAULT.MENUFN 8177 . 14891) ( +TEDIT.REMOVE.MENUITEM 14893 . 15890) (\TEDIT.CREATEMENU 15892 . 16457) (\TEDIT.MENU.WHENHELDFN 16459 + . 17364) (\TEDIT.MENU.WHENSELECTEDFN 17366 . 17677)) (18493 65027 (DRAWMARGINSCALE 18503 . 21962) ( +MARGINBAR 21964 . 29089) (MARGINBAR.CREATE 29091 . 32510) (MB.MARGINBAR.BUTTONEVENTINFN 32512 . 40314) + (MB.MARGINBAR.SELFN.TABS 40316 . 45556) (MB.MARGINBAR.SELFN.TABS.KIND 45558 . 46493) ( +MARGINBAR.GETSTATEFN 46495 . 50373) (MARGINBAR.SETSTATEFN 50375 . 50585) (MARGINBAR.NEUTRALIZE 50587 + . 51000) (MARGINBAR.LOOKS 51002 . 54108) (MB.MARGINBAR.SIZEFN 54110 . 54713) (MB.MARGINBAR.DISPLAYFN +54715 . 57776) (MDESCALE 57778 . 58318) (MSCALE 58320 . 58650) (MB.MARGINBAR.SHOWTAB 58652 . 60975) ( +MB.MARGINBAR.TABTRACK 60977 . 62362) (MARGINBAR.INIT 62364 . 63757) (\TEDIT.PARALOOKS.TO.MARBAR 63759 + . 65025)) (65852 72758 (TEDIT.MENUSTREAM 65862 . 66862) (TEDITMENUP 66864 . 67833) (\TEDIT.MENU.START + 67835 . 72182) (\TEDIT.MENU.BUTTONEVENTFN 72184 . 72756)) (73077 80999 (\TEDIT.MENU.CREATE 73087 . +74898) (\TEDIT.MENU.PARSE 74900 . 78589) (\TEDIT.MENU.NEUTRALIZE 78591 . 80662) ( +\TEDITMENU.RECORD.UNFORMATTED 80664 . 80997)) (81065 101209 (\TEDIT.EXPANDEDMENU.CREATE 81075 . 86477) + (\TEDIT.EXPANDEDMENU.START 86479 . 87909) (\TEDIT.EXPANDEDMENU.FN 87911 . 91166) ( +\TEDIT.EXPANDEDMENU.ACTIONFN 91168 . 101207)) (101271 116936 (\TEDIT.PARAMENU.CREATE 101281 . 107302) +(\TEDIT.PARAMENU.START 107304 . 108236) (\TEDIT.APPLY.PARALOOKS 108238 . 109290) ( +\TEDIT.SHOW.PARALOOKS 109292 . 112183) (\TEDIT.PARAMENU.FILLIN 112185 . 116934)) (117141 143603 ( +\TEDIT.CHARMENU.CREATE 117151 . 119755) (\TEDIT.CHARMENU.START 119757 . 120854) (\TEDIT.CHARMENU.SPEC +120856 . 125539) (\TEDIT.CHARMENU.PARSE 125541 . 128709) (\TEDIT.CHARMENU.FILLIN 128711 . 133341) ( +\TEDIT.SHOW.CHARLOOKS 133343 . 136701) (\TEDIT.APPLY.CHARLOOKS 136703 . 137864) ( +\TEDIT.OFFSETTYPE.STATEFN 137866 . 139829) (\TEDIT.OTHER.STATECHANGEFN 139831 . 141476) ( +\TEDIT.OTHER.SELECTFN 141478 . 143601)) (143665 170195 (\TEDIT.PAGEMENU.CREATE 143675 . 150869) ( +\TEDIT.SHOW.PAGELOOKS 150871 . 152757) (\TEDIT.PAGEMENU.FILLIN 152759 . 154309) ( +\TEDIT.PAGEREGION.UNPARSE 154311 . 163501) (\TEDIT.APPLY.PAGELOOKS 163503 . 165430) ( +\TEDIT.CHANGE.PAGELOOKS 165432 . 169351) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 169353 . 170193)) (170196 +175999 (\TEDIT.PAGEMENU.CREATE.HEADINGS 170206 . 173018) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 173020 + . 174445) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 174447 . 175997))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index b5d582188..482dcddc1 100644 Binary files a/library/tedit/TEDIT-MENU.LCOM and b/library/tedit/TEDIT-MENU.LCOM differ diff --git a/library/tedit/TEDIT-OLDFILE.LCOM b/library/tedit/TEDIT-OLDFILE.LCOM index a54a54805..78f43dcdf 100644 Binary files a/library/tedit/TEDIT-OLDFILE.LCOM and b/library/tedit/TEDIT-OLDFILE.LCOM differ diff --git a/library/tedit/TEDIT-PAGE b/library/tedit/TEDIT-PAGE index 06aae89f5..3c9b26b82 100644 --- a/library/tedit/TEDIT-PAGE +++ b/library/tedit/TEDIT-PAGE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "23-Feb-2025 10:06:16" {WMEDLEY}TEDIT>TEDIT-PAGE.;208 133418 +(FILECREATED "22-Apr-2025 08:12:43" {WMEDLEY}tedit>TEDIT-PAGE.;220 134749 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY) + :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY \TEDIT.HARDCOPY.PAGEHEADINGS) - :PREVIOUS-DATE "19-Feb-2025 13:33:12" {WMEDLEY}TEDIT>TEDIT-PAGE.;207) + :PREVIOUS-DATE "21-Apr-2025 22:42:22" {WMEDLEY}tedit>TEDIT-PAGE.;216) (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) @@ -630,7 +632,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 +661,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 +733,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 +781,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 +794,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) + (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 (* ; + (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) + (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 (* ; + (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) + (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.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) + (\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) + (\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) + (\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 +1013,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 +1043,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 +1156,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 +1185,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 +1229,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 +1251,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 +1530,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 +1546,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 +1563,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 +1583,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 +1593,8 @@ (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE) '\TEDIT.PAGENO (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES 1 (TEXTLEN FOLIOTEXTOBJ) - FOLIOTEXTOBJ))))] + (FTEXTOBJ TSTREAM)) + NIL TSTREAM)))] CHNO]) ) @@ -2044,7 +2061,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 +2072,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 +2100,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 (12168 15780 (\TEDIT.PARSE.PAGEFRAMES 12178 . 13957) (\TEDIT.PUT.PAGEFRAMES 13959 . +14783) (\TEDIT.UNPARSE.PAGEFRAMES 14785 . 15778)) (15843 37741 (TEDIT.SINGLE.PAGEFORMAT 15853 . 26727) + (TEDIT.COMPOUND.PAGEFORMAT 26729 . 27708) (TEDIT.PAGEFORMAT 27710 . 34999) (TEDIT.GET.PAGEFORMAT +35001 . 37739)) (38028 48813 (TEDIT.FORMAT.HARDCOPY 38038 . 48811)) (48900 102152 (\TEDIT.FORMATBOX +48910 . 62334) (\TEDIT.FORMATHEADING 62336 . 66982) (\TEDIT.FORMATPAGE 66984 . 76173) ( +\TEDIT.FORMATTEXTBOX 76175 . 92688) (\TEDIT.FORMATFOLIO 92690 . 98007) (\TEDIT.FORMAT.FOUNDBOX? 98009 + . 100048) (\TEDIT.SKIP.SPECIALCOND 100050 . 102150)) (102232 107287 (\TEDIT.HARDCOPY.PAGEHEADINGS +102242 . 107285)) (107396 115447 (\TEDIT.HARDCOPY-COLUMN-END 107406 . 115445)) (115492 120433 ( +SCALEPAGEUNITS 115502 . 116643) (SCALEPAGEXUNITS 116645 . 117415) (SCALEPAGEYUNITS 117417 . 118188) ( +\TEDIT.PAPERHEIGHT 118190 . 119125) (\TEDIT.PAPERWIDTH 119127 . 120431)) (120849 124417 (ROMANNUMERALS + 120859 . 124415)) (124456 131722 (TEDIT.PAGENO.CREATE 124466 . 124842) (\TEDIT.PAGENO.OBJINIT 124844 + . 126127) (\TEDIT.PAGENO.BUTTONEVENTINFN 126129 . 127195) (\TEDIT.PAGENO.IMAGEBOXFN 127197 . 129347) +(\TEDIT.PAGENO.DISPLAYFN 129349 . 130999) (\TEDIT.PAGENO.GETFN 131001 . 131393) (\TEDIT.PAGENO.PUTFN +131395 . 131720)) (131787 134726 (\TEDIT.FORMAT.FOOTNOTE 131797 . 134724))))) STOP diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM index 13556b021..d5d2c2f09 100644 Binary files a/library/tedit/TEDIT-PAGE.LCOM and b/library/tedit/TEDIT-PAGE.LCOM differ diff --git a/library/tedit/TEDIT-RELEASENOTES.TEDIT b/library/tedit/TEDIT-RELEASENOTES.TEDIT index 6c552e3d0..e2a320518 100644 Binary files a/library/tedit/TEDIT-RELEASENOTES.TEDIT and b/library/tedit/TEDIT-RELEASENOTES.TEDIT differ diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN index 6811c065f..8e13bfe10 100644 --- a/library/tedit/TEDIT-SCREEN +++ b/library/tedit/TEDIT-SCREEN @@ -1,14 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "30-Mar-2025 10:02:52" {WMEDLEY}TEDIT>TEDIT-SCREEN.;871 189269 +(FILECREATED "27-Apr-2025 11:30:10" {WMEDLEY}tedit>TEDIT-SCREEN.;902 190000 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.VALID.LINES \TEDIT.PANE.CREATELINES \TEDIT.SUFFIXLINE.CREATE - \TEDIT.LASTVALIDLINE \TEDIT.LINES.ABOVE \TEDIT.UPDATE.LINES \TEDIT.FORMATLINE) - (RECORDS LINEDESCRIPTOR) + :CHANGES-TO (FNS \TEDIT.FORMATLINE \TEDIT.FORMATLINE.EMPTY \TEDIT.UPDATE.LINES + \TEDIT.LASTVALIDLINE) - :PREVIOUS-DATE " 6-Mar-2025 11:42:48" {WMEDLEY}TEDIT>TEDIT-SCREEN.;867) + :PREVIOUS-DATE "21-Apr-2025 20:34:16" {WMEDLEY}tedit>TEDIT-SCREEN.;900) (PRETTYCOMPRINT TEDIT-SCREENCOMS) @@ -30,10 +29,9 @@ (MACROS \TEDIT.LINE.TALLP) (COMS (* ; "Formatting slots held by THISLINE") (RECORDS THISLINE CHARSLOT) - (MACROS CHAR CHARW PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT - NTHCHARSLOT LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR - CHARSLOTP) - (CONSTANTS (CELLSPERCHARSLOT 2) + (MACROS CHAR CHARW CHARCL PREVCHARSLOT NEXTCHARSLOT FIRSTCHARSLOT + NTHCHARSLOT LASTCHARSLOT FILLCHARSLOT PUSHCHAR CHARSLOTP) + (CONSTANTS (CELLSPERCHARSLOT 3) (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (MAXCHARSLOTS 256)) @@ -50,7 +48,7 @@ \TEDIT.FORMATLINE.VERTICAL \TEDIT.FORMATLINE.JUSTIFY \TEDIT.FORMATLINE.TABS \TEDIT.SCALE.TABS \TEDIT.FORMATLINE.PURGE.SPACES \TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN \TEDIT.FORMATLINE.EMPTY \TEDIT.FORMATLINE.UPDATELOOKS \TEDIT.FORMATLINE.LASTLEGAL - \TEDIT.LINES.ABOVE) + \TEDIT.LINES.ABOVE \TEDIT.CHNO.TO.YTOP) (INITVARS (TEDIT.LINELEADING.BELOW NIL)) (GLOBALVARS TEDIT.LINELEADING.BELOW) (FNS \TLVALIDATE) @@ -66,9 +64,10 @@ (MACROS MI-TEDIT.BLTCHAR)) (FNS \TEDIT.BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \TEDIT.UPDATE.LINES \TEDIT.PANE.CREATELINES - \TEDIT.SUFFIXLINE.CREATE \TEDIT.LINES.BELOW \TEDIT.MEASURED.LINES \TEDIT.VALID.LINES - \TEDIT.LASTVALIDLINE \TEDIT.NEXTVALIDLINE \TEDIT.CLEARPANE.BELOW.LINE \TEDIT.INSERTLINE - \TEDIT.LINE.BOTTOM \TEDIT.SHOW.AT.BOTTOMP \TEDIT.SHOW.AT.TOPP))) + \TEDIT.SUFFIXLINE.CREATE \TEDIT.LINES.BELOW \TEDIT.MEASURED.LINES \TEDIT.VALID.LASTCHNOS + \TEDIT.VALID.NEXTCHNOS \TEDIT.LASTVALIDLINE \TEDIT.NEXTVALIDLINE + \TEDIT.CLEARPANE.BELOW.LINE \TEDIT.INSERTLINE \TEDIT.LINE.BOTTOM \TEDIT.SHOW.AT.BOTTOMP + \TEDIT.SHOW.AT.TOPP))) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -351,7 +350,7 @@ (BLOCKRECORD CHARSLOT (CHAR CHARW (* ;  "If CHAR is NIL, then CHARW is CHARLOOKS.") - )) + CHARCL)) ) (/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER) @@ -369,16 +368,12 @@ (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))) @@ -394,24 +389,15 @@ (TIMES (SUB1 MAXCHARSLOTS) WORDSPERCHARSLOT)))) -(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W) +(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W R) (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)))) + (freplace (CHARSLOT CHARW) of CSLOT with W) + (freplace (CHARSLOT CHARCL) of CSLOT with R))) -(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W) - (FILLCHARSLOT CSLOTVAR C W) +(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W CL) + (FILLCHARSLOT CSLOTVAR C W CL) (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 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.") @@ -434,14 +420,14 @@ ) (DECLARE%: EVAL@COMPILE -(RPAQQ CELLSPERCHARSLOT 2) +(RPAQQ CELLSPERCHARSLOT 3) (RPAQ WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (RPAQQ MAXCHARSLOTS 256) -(CONSTANTS (CELLSPERCHARSLOT 2) +(CONSTANTS (CELLSPERCHARSLOT 3) (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (MAXCHARSLOTS 256)) ) @@ -456,7 +442,7 @@ (I.S.OPR 'incharslots NIL '[SUBST (GETDUMMYVAR) '$$STARTSLOT - '(bind $$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT + '(bind $$STARTSLOT _ BODY CHAR CHARW CHARCL $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first (SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) @@ -467,12 +453,13 @@ ) 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 CHARW (fetch (CHARSLOT CHARW) of I.V.)) + (SETQ CHARCL (fetch (CHARSLOT CHARCL) of I.V.] T) (I.S.OPR 'backcharslots NIL '[SUBST (GETDUMMYVAR) '$$STARTSLOT - '(bind $$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT + '(bind $$STARTSLOT _ BODY CHAR CHARW CHARCL $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first (SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) @@ -488,6 +475,9 @@ (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.)) + (SETQ CHARCL (fetch (CHARSLOT + CHARCL) + of I.V.)) repeatuntil (EQ I.V. $$CHARSLOTLIMIT] T) ) @@ -689,26 +679,19 @@ (\TEDIT.FORMATLINE [LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 27-Apr-2025 11:24 by rmk") + (* ; "Edited 21-Apr-2025 19:03 by rmk") + (* ; "Edited 11-Apr-2025 20:18 by rmk") (* ; "Edited 29-Mar-2025 11:39 by rmk") (* ; "Edited 6-Mar-2025 11:42 by rmk") - (* ; "Edited 25-Feb-2025 10:39 by rmk") - (* ; "Edited 19-Feb-2025 13:36 by rmk") - (* ; "Edited 10-Feb-2025 09:59 by rmk") (* ; "Edited 8-Feb-2025 23:36 by rmk") (* ; "Edited 24-Dec-2024 22:15 by rmk") - (* ; "Edited 23-Dec-2024 19:47 by rmk") - (* ; "Edited 13-Dec-2024 23:46 by rmk") - (* ; "Edited 12-Dec-2024 15:20 by rmk") - (* ; "Edited 9-Dec-2024 21:05 by rmk") (* ; "Edited 23-Nov-2024 00:03 by rmk") - (* ; "Edited 17-Nov-2024 19:56 by rmk") (* ; "Edited 31-Oct-2024 15:32 by rmk") (* ; "Edited 26-Oct-2024 10:51 by rmk") (* ; "Edited 2-Sep-2024 16:06 by rmk") - (* ; "Edited 27-Aug-2024 18:29 by rmk") (* ; "Edited 4-Aug-2024 18:07 by rmk") (* ; "Edited 21-May-2024 14:45 by rmk") - (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 5-Feb-2024 09:35 by rmk") (* ; "Edited 3-Dec-2023 16:48 by rmk") (* ; "Edited 28-Oct-2023 13:14 by rmk") @@ -748,10 +731,7 @@ (CL:UNLESS IMAGESTREAM (SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) 'DSP))) (* ; "For lower image objects?") - (CL:WHEN (type? TEXTOBJ TSTREAM) (* ; - "Still confused about textobj/stream. Not sure who uses TSTREAM freely ") - (SETQ TSTREAM (FGETTOBJ TSTREAM STREAMHINT))) - (PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) (OFFSET 0) (TRUEASCENT -1) (TRUEDESCENT -1) @@ -763,10 +743,10 @@ (SPACELEFT 0) (TX 0) (BOXSTREAM IMAGESTREAM) - THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT PREVSP - 1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH + CHARLOOKS THISLINE LINETYPE WIDTH WMARGIN SCALE PARALOOKS RIGHTMARGIN HASKERN PC CHARSLOT + PREVSP 1STLN CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS FIRSTSEPR) - (DECLARE (SPECVARS TEXTOBJ LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT + (DECLARE (SPECVARS TEXTOBJ LINETYPE CHARLOOKS CHNO OFFSET ASCENTC DESCENTC FONT START-OF-PIECE HASKERN UNBREAKABLE)) (CL:UNLESS LINE @@ -800,8 +780,8 @@ (SETQ OLDCARETLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)) (* ;  "Restore at end--BIN changes things") - (SETQ OLDPIECE (ffetch (TEXTSTREAM PIECE) of TSTREAM)) - (SETQ OLDPCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)) + (SETQ OLDPIECE (FGETTSTR TSTREAM PIECE)) + (SETQ OLDPCCHARSLEFT (FGETTSTR TSTREAM PCCHARSLEFT)) (* ;; "") @@ -842,7 +822,10 @@ (SETQ WIDTH (ffetch (REGION WIDTH) of REGION)) else (SETQ WMARGIN \TEDIT.LINEREGION.WIDTH) (* ;  "A little more display margin on both sides") - (SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) + (SETQ WIDTH (IDIFFERENCE (CL:IF (FGETTOBJ TEXTOBJ PRIMARYPANE) + (PANERIGHT (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (FGETPLOOKS (FGETLD LINE LPARALOOKS) + RIGHTMAR)) (UNFOLD WMARGIN 2] (SETQ RIGHTMARGIN (if (ZEROP (FGETPLOOKS PARALOOKS RIGHTMAR)) then @@ -914,7 +897,7 @@ (FILLCHARSLOT CHARSLOT (CL:IF (EQ CH (CHARCODE FORM)) (CHARCODE FORM) (CHARCODE EOL)) - DX) + DX CHARLOOKS) (SETQ FORCED-END (CL:IF (MEMB CH (CHARCODE (LF CR))) (CHARCODE EOL) CH)) @@ -931,7 +914,7 @@ (* ;; "Unlikely for display--probably backs it up. The idea is to back up the starting point of CH by backing off the end of the previous character. We stick the kern inline so that various consumers (displayline, scanline...) can make the adjustments.") (SETQ KERN (\FGETLEFTKERN FONT PREVCH CH)) - (PUSHCHAR CHARSLOT 'KERN KERN) + (PUSHCHAR CHARSLOT 'KERN KERN CHARLOOKS) (add DX KERN)) (SETQ DX (\FGETCHARWIDTH FONT CH)) (SETQ PREVCH CH) @@ -972,7 +955,7 @@ (* ;; "Not including this space in the justifying chain, so it won't expand. If that looks odd, let it fall through to the PUSHCHAR below.") - (PUSHCHAR CHARSLOT CH DX) + (PUSHCHAR CHARSLOT CH DX CHARLOOKS) else (CL:UNLESS FIRSTSEPR (SETQ FIRSTSEPR CHNO)) (SPACEBREAK) (add TX DX) @@ -983,7 +966,7 @@ (PUSHCHAR CHARSLOT (CL:IF JUSTIFIED (PROG1 PREVSP (SETQ PREVSP CHARSLOT)) CH) - DX))) + DX CHARLOOKS))) (TAB (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") @@ -997,7 +980,7 @@ (* ;; "Now for this tab:") (* ;  "Start with 0 width, then set up the next tab") - (FILLCHARSLOT CHARSLOT CH 0) + (FILLCHARSLOT CHARSLOT CH 0 CHARLOOKS) (SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ PARALOOKS SCALE CHARSLOT LX1 TX TABPENDING)) (* ; @@ -1035,7 +1018,7 @@ (* ;;  "A good break-point not followed by spaces. NOTE: Even pending tabs go on the next line.") - (CL:UNLESS TXB (FILLCHARSLOT CH DX)) + (CL:UNLESS TXB (FILLCHARSLOT CH DX CHARLOOKS)) (DOBREAK) (RETURN)) (CL:WHEN (IGREATERP DX WIDTH) @@ -1049,7 +1032,7 @@ (add TX (IMINUS DX)) (add CHNO -1) (* ; "back up to preceding character") - (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT)) + (SETQ CHARSLOT (PREVCHARSLOT CHARSLOT)) (SETQ CH (CHAR CHARSLOT)) (SETQ DX (CHARW CHARSLOT)) @@ -1060,7 +1043,7 @@ else (* ;; "Dump it here") - (FILLCHARSLOT CHARSLOT CH DX)) + (FILLCHARSLOT CHARSLOT CH DX CHARLOOKS)) (SETQ OVERHANG 0) (SETQ SPACELEFT 0) (RETURN)) @@ -1073,12 +1056,12 @@ (* ;; "Didn't find one, the offender protrudes on this line") - (FILLCHARSLOT CHARSLOT CH DX)) + (FILLCHARSLOT CHARSLOT CH DX CHARLOOKS)) (RETURN)) (* ;; "Don't break: can't split before the first thing on the line!") - (PUSHCHAR CHARSLOT CH DX) + (PUSHCHAR CHARSLOT CH DX CHARLOOKS) (RETURN)) (* ;; "") @@ -1089,7 +1072,7 @@ (SELCHARQ CH (%. (* ;  "Check for decimal tabs, immediately after TAB") - (PUSHCHAR CHARSLOT CH DX) + (PUSHCHAR CHARSLOT CH DX CHARLOOKS) (CL:WHEN (AND TABPENDING (EQ (fetch PTTYPE of TABPENDING) 'DECIMAL)) (* ; @@ -1126,18 +1109,19 @@ (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE "-")))) (SAVEBREAK)) (* ;  "Save the hyphen slot, then fill it") - (PUSHCHAR CHARSLOT CH DX)) + (PUSHCHAR CHARSLOT CH DX CHARLOOKS)) (NONBREAKING-HYPHEN (* ;;  "Switch the character code and width in case font doesn't have a glyph??") (PUSHCHAR CHARSLOT (CHARCODE -) - (\FGETCHARWIDTH FONT (CHARCODE "-")))) + (\FGETCHARWIDTH FONT (CHARCODE "-")) + CHARLOOKS)) (NONBREAKING-SPACE (* ;  "This will eventually convert to SPACE") (PUSHCHAR CHARSLOT (PROG1 PREVSP (SETQ PREVSP CHARSLOT)) - DX)) - (PUSHCHAR CHARSLOT CH DX] + DX CHARLOOKS)) + (PUSHCHAR CHARSLOT CH DX CHARLOOKS] (* ;; "BOUNDS CHECKING!") @@ -1158,9 +1142,10 @@ (* ;; "The line ended in a space that needs to be resolved. If we coded the end of a space-chain as (CHARCODE SPACE) instead of NIL, maybe this wouldn't be necessary.") (FILLCHARSLOT PREVSP (CHARCODE SPACE) - (CHARW PREVSP)) + (CHARW PREVSP) + CHARLOOKS) (SETQ PREVSP NIL)) - (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT)) + (SETQ CHARSLOT (PREVCHARSLOT CHARSLOT)) (add CHNO -1) (SETQ DX 0) (* ; "TX is already correct") (FORCEBREAK)) @@ -1650,7 +1635,8 @@ PREVSP]) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN - [LAMBDA (THISLINE PREVDHYPH CHARSLOT) (* ; "Edited 2-Sep-2024 16:09 by rmk") + [LAMBDA (THISLINE PREVDHYPH CHARSLOT) (* ; "Edited 11-Apr-2025 11:04 by rmk") + (* ; "Edited 2-Sep-2024 16:09 by rmk") (* ;; "PREVDHYPH is the THISLINE character slot of a preceding soft hyphen that is now being discarded in favor of a later potential linebreak. This function purges it from THISLINE by moving the contents of all of the slots from the one after PREDVDHYPH backwards by one slot. The value is the new (one-back) last slot") @@ -1659,37 +1645,36 @@ (CL:WHEN PREVDHYPH (for CS NEXT incharslots PREVDHYPH do (SETQ NEXT (NEXTCHARSLOT CS)) (FILLCHARSLOT CS (CHAR NEXT) - (CHARW NEXT)) repeatuntil (EQ NEXT CHARSLOT) + (CHARW NEXT) + (CHARCL NEXT)) repeatuntil (EQ NEXT CHARSLOT) finally (RETURN CS)))]) (\TEDIT.FORMATLINE.EMPTY - [LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 19-Feb-2025 13:37 by rmk") + [LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 27-Apr-2025 11:28 by rmk") + (* ; "Edited 19-Apr-2025 22:25 by rmk") + (* ; "Edited 13-Apr-2025 23:56 by rmk") + (* ; "Edited 9-Apr-2025 19:39 by rmk") + (* ; "Edited 19-Feb-2025 13:37 by rmk") (* ; "Edited 8-Feb-2025 23:37 by rmk") - (* ; "Edited 7-Feb-2025 08:09 by rmk") (* ; "Edited 22-Nov-2024 22:29 by rmk") - (* ; "Edited 17-Nov-2024 16:00 by rmk") (* ; "Edited 4-Aug-2024 14:51 by rmk") (* ; "Edited 25-Jun-2024 14:51 by rmk") (* ; "Edited 10-May-2024 00:24 by rmk") (* ; "Edited 15-Mar-2024 22:00 by rmk") (* ; "Edited 26-Jan-2024 11:08 by rmk") (* ; "Edited 6-Dec-2023 20:15 by rmk") - (* ; "Edited 3-Dec-2023 19:41 by rmk") (* ; "Edited 26-Sep-2023 17:32 by rmk") (* ; "Edited 15-Jul-2023 13:52 by rmk") (* ; "Edited 2-Jul-2023 15:20 by rmk") (* ; "Edited 7-Mar-2023 23:11 by rmk") - (* ; "Edited 5-Mar-2023 22:57 by rmk") (* ; "Edited 4-Mar-2023 21:40 by rmk") - (* ; "") (* ;; "NOTE: this follows the original in not distinguishing hardcopy-display mode. Presumably empty is empty, even thought the ASCENT/DESCENT/LHEIGHT are not scaled.") (* ;; "Original code asked for the piece at TEXTLEN (last piece?) to get its looks, but those looks would be the TEXTOBJ default looks anyway. But it really wants to the looks of the preceding piece.") (LINEDESCRIPTOR! LINE) - (LET (CHARSLOT FONT CLOOKS TRUEASCENT TRUEDESCENT LM PLOOKS (THISLINE (FGETTOBJ TEXTOBJ THISLINE) - )) + (LET (FONT CLOOKS TRUEASCENT TRUEDESCENT LM PLOOKS (THISLINE (FGETTOBJ TEXTOBJ THISLINE))) (\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ NIL LINE (WINDOWPROP (\TEDIT.PRIMARYPANE TEXTOBJ) 'DSP) 'TRUEDISPLAY) @@ -1702,7 +1687,7 @@ (SETQ FONT (GETCLOOKS CLOOKS CLFONT)) (SETQ TRUEASCENT (FONTPROP FONT 'ASCENT)) (SETQ TRUEDESCENT (FONTPROP FONT 'DESCENT)) - (SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (FGETTOBJ TEXTOBJ WLEFT) + (SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (PANELEFT (FGETTOBJ TEXTOBJ PRIMARYPANE)) (FGETPLOOKS PLOOKS 1STLEFTMAR))) (with LINEDESCRIPTOR LINE (SETQ LDUMMY T) (SETQ LCHAR1 CH#1) @@ -1713,19 +1698,17 @@ (SETQ LX1 LM) (SETQ LXLIM LM) (SETQ FORCED-END (CHARCODE EOL)) - (SETQ LHASPROT NIL) (SETQ LPARALOOKS PLOOKS) (SETQ LEFTMARGIN LM) (SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPLOOKS PLOOKS RIGHTMAR)) - (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) + (IDIFFERENCE (PANERIGHT (FGETTOBJ TEXTOBJ PRIMARYPANE)) \TEDIT.LINEREGION.WIDTH) (FGETPLOOKS PLOOKS RIGHTMAR))) (SETQ LTRUEASCENT TRUEASCENT) (SETQ LTRUEDESCENT TRUEDESCENT) - (SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT))) - (SETQ CHARSLOT (FIRSTCHARSLOT THISLINE)) - (FILLCHARSLOT CHARSLOT NIL CLOOKS) - (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT)) + (SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT)) + (SETQ LFIRSTSEPR MAX.FIXP)) + (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (FIRSTCHARSLOT THISLINE)) (freplace (THISLINE DESC) of THISLINE with LINE) (* ;; "Just to initialize the rest of the fields--no intended transformations.") @@ -1735,7 +1718,8 @@ LINE]) (\TEDIT.FORMATLINE.UPDATELOOKS - [LAMBDA (TSTREAM PC) (* ; "Edited 19-Dec-2024 11:50 by rmk") + [LAMBDA (TSTREAM PC) (* ; "Edited 11-Apr-2025 09:43 by rmk") + (* ; "Edited 19-Dec-2024 11:50 by rmk") (* ; "Edited 13-Dec-2024 17:09 by rmk") (* ; "Edited 4-Aug-2024 15:09 by rmk") (* ; "Edited 28-Jul-2024 20:52 by rmk") @@ -1757,30 +1741,31 @@ (* ;; "Style sheets are undocumented, I suspect that this was never really thought through.") - (DECLARE (USEDFREE LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT IMAGESTREAM HASKERN + (DECLARE (USEDFREE LINETYPE CHARLOOKS CHNO OFFSET ASCENTC DESCENTC FONT IMAGESTREAM HASKERN UNBREAKABLE)) (CL:UNLESS PC (* ;  "Ran off the end ? Skips the ENDOFSTREAMOP") (RETFROM (FUNCTION \TEDIT.TEXTBIN) NIL)) - (LET (PLOOKS INVISIBLERUN CLOFFSET) + (LET (INVISIBLERUN CLOFFSET) (SETQ INVISIBLERUN (for old PC inpieces PC until (VISIBLEPIECEP PC) sum (PLEN PC))) (if (EQ 0 INVISIBLERUN) - then + then (SETQ CHARLOOKS (PCHARLOOKS PC)) + (* ;; "If the looks are the same as current looks, we don't need to change anything. APPLY STYLES AT PIECE CREATION??") - (SETQ PLOOKS (PLOOKS PC)) - (CL:UNLESS (EQ PLOOKS (FGETTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) - CARETLOOKS)) - (FSETTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) - CARETLOOKS PLOOKS) + (CL:UNLESS (EQ CHARLOOKS (FGETTOBJ (FTEXTOBJ TSTREAM) + CARETLOOKS)) + (FSETTOBJ (FTEXTOBJ TSTREAM) + CARETLOOKS CHARLOOKS) (* ;; "") - (SETQ OFFSET (OR (FGETCLOOKS PLOOKS CLOFFSET) + (SETQ OFFSET (OR (FGETCLOOKS CHARLOOKS CLOFFSET) 0)) - (SETQ FONT (FGETCLOOKS PLOOKS CLFONT)) (* ; + (SETQ FONT (FGETCLOOKS CHARLOOKS CLFONT)) + (* ;  "CLFONT is a display font or a class") [if (EQ LINETYPE 'TRUEHARDCOPY) then (SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)) @@ -1798,11 +1783,10 @@ (CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) (* ; "Switch widths to hardcopy") (SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)))] - (SETQ HASKERN (FFETCH (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT)) + (SETQ HASKERN (ffetch (FONTDESCRIPTOR FONTHASLEFTKERNS) of FONT)) (* ;  "T if FONT contains left-kern information") - (SETQ UNBREAKABLE (FGETCLOOKS PLOOKS CLUNBREAKABLE)) - (PUSHCHAR CHARSLOT NIL PLOOKS)) + (SETQ UNBREAKABLE (FGETCLOOKS CHARLOOKS CLUNBREAKABLE))) else (* ;; "Adjust the CHNO to pass over invisible pieces--they don't show up in the THISLINE vector or on the screen. Then recurse to here for the next visible piece.") @@ -1811,7 +1795,8 @@ PC]) (\TEDIT.FORMATLINE.LASTLEGAL - [LAMBDA (THISLINE CH#1 LINETYPE IMAGESTREAM) (* ; "Edited 25-Jun-2024 15:44 by rmk") + [LAMBDA (THISLINE CH#1 LINETYPE IMAGESTREAM) (* ; "Edited 11-Apr-2025 11:24 by rmk") + (* ; "Edited 25-Jun-2024 15:44 by rmk") (* ; "Edited 1-Feb-2024 16:51 by rmk") (* ; "Edited 2-Jul-2023 14:39 by rmk") (* ; "Edited 17-Mar-2023 05:36 by rmk") @@ -1826,12 +1811,12 @@ (* ;; "Once we find the break point, we have to sweep through from the beginning in order to accurately know the lines ascent and descent at the break point.") (DECLARE (USEDFREE TX CHNO CHARSLOT TRUEASCENT TRUEDESCENT TABPENDING)) - (LET [(BESTSLOT (find SLOT PCS backcharslots (PREVCHARSLOT! CHARSLOT) + (LET [(BESTSLOT (find SLOT PCS backcharslots (PREVCHARSLOT CHARSLOT) suchthat (CL:WHEN (AND TABPENDING (EQ SLOT (fetch (PENDINGTAB PTCHARSLOT) of TABPENDING))) (SETQ TABPENDING NIL)) (OR (MEMB CHAR TEDIT.DONT.BREAK.CHARS) - (AND (SETQ PCS (PREVCHARSLOT! SLOT)) + (AND (SETQ PCS (PREVCHARSLOT SLOT)) (MEMB (CHAR PCS) TEDIT.DONT.LAST.CHARS] @@ -1863,7 +1848,8 @@ T)]) (\TEDIT.LINES.ABOVE - [LAMBDA (TSTREAM CHN BOTTOMY) (* ; "Edited 30-Mar-2025 09:09 by rmk") + [LAMBDA (TSTREAM CHN BOTTOMY) (* ; "Edited 19-Apr-2025 23:55 by rmk") + (* ; "Edited 30-Mar-2025 09:09 by rmk") (* ; "Edited 24-Nov-2024 11:47 by rmk") (* ; "Edited 20-Nov-2024 12:37 by rmk") (* ; "Edited 17-Nov-2024 16:02 by rmk") @@ -1887,7 +1873,7 @@ (CL:WHEN (type? LINEDESCRIPTOR CHN) (SETQ BOTTOMY (FGETLD CHN YTOP)) (SETQ CHN (SUB1 (FGETLD CHN LCHAR1)))) - (bind LTOP LBOT LINE HEIGHT CHNO (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) + (bind LTOP LBOT LINE HEIGHT CHNO (TEXTOBJ _ (FTEXTOBJ TSTREAM)) first (CL:WHEN (IGREATERP CHN (TEXTLEN TEXTOBJ)) (SETQ CHN (TEXTLEN TEXTOBJ))) (SETQ CHNO (\TEDIT.PREVIOUS.LINEBREAK TSTREAM CHN)) @@ -1908,6 +1894,20 @@ (for L (YB _ BOTTOMY) backlines LBOT do (SETYBOT L YB) (add YB (FGETLD L LHEIGHT)))) (RETURN (CONS LTOP LBOT]) + +(\TEDIT.CHNO.TO.YTOP + [LAMBDA (PANE CHNO) (* ; "Edited 18-Apr-2025 14:56 by rmk") + + (* ;; "Returns the YTOP of the line containing character CHNO in PANE, NIL if CHNO is not visible in PANE.") + + (CL:UNLESS (WINDOWP PANE) + (SETQ PANE (\TEDIT.PRIMARYPANE PANE))) + (CL:UNLESS CHNO + (SETQ CHNO (TEXTSEL (TEXTOBJ PANE)))) + (CL:WHEN (type? SELECTION CHNO) + (SETQ CHNO (FGETSEL CHNO CH#))) + (for L inlines (PANETOPLINE PANE) when (FWITHINLINEP CHNO L) unless (FGETLD L LDUMMY) + do (RETURN (FGETLD L YTOP]) ) (RPAQ? TEDIT.LINELEADING.BELOW NIL) @@ -1965,194 +1965,184 @@ (DEFINEQ (\TEDIT.DISPLAYLINE - [LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 19-Feb-2025 13:35 by rmk") + [LAMBDA (TSTREAM LINE PANE) (* ; "Edited 21-Apr-2025 12:14 by rmk") + (* ; "Edited 19-Apr-2025 22:06 by rmk") + (* ; "Edited 17-Apr-2025 13:33 by rmk") + (* ; "Edited 15-Apr-2025 15:17 by rmk") + (* ; "Edited 11-Apr-2025 20:20 by rmk") + (* ; "Edited 19-Feb-2025 13:35 by rmk") (* ; "Edited 8-Feb-2025 23:37 by rmk") (* ; "Edited 13-Dec-2024 23:51 by rmk") - (* ; "Edited 11-Dec-2024 23:14 by rmk") (* ; "Edited 31-Oct-2024 09:56 by rmk") - (* ; "Edited 26-Oct-2024 10:43 by rmk") (* ; "Edited 25-Aug-2024 23:18 by rmk") - (* ; "Edited 23-Aug-2024 22:52 by rmk") (* ; "Edited 19-Jul-2024 23:17 by rmk") - (* ; "Edited 28-Jun-2024 11:43 by rmk") - (* ; "Edited 13-Jun-2024 17:08 by rmk") (* ; "Edited 10-May-2024 00:24 by rmk") (* ; "Edited 20-Mar-2024 10:57 by rmk") - (* ; "Edited 15-Mar-2024 22:04 by rmk") (* ; "Edited 24-Dec-2023 22:05 by rmk") (* ; "Edited 2-Dec-2023 11:34 by rmk") - (* ; "Edited 20-Nov-2023 13:57 by rmk") (* ; "Edited 28-Oct-2023 23:57 by rmk") - (* ; "Edited 11-Oct-2023 10:47 by rmk") (* ; "Edited 2-Aug-2023 12:50 by rmk") (* ; "Edited 22-Jun-2023 17:37 by rmk") (* ; "Edited 24-Apr-2023 00:08 by rmk") - (* ; "Edited 10-Apr-2023 12:41 by rmk") (* ; "Edited 16-Mar-2023 23:30 by rmk") - (* ; "Edited 9-Mar-2023 14:06 by rmk") (* ; "Edited 7-Mar-2023 23:11 by rmk") (* ;; "Display the line of text LINE in the edit window where it belongs. This constructs the line image in a scratch bitmap then copies it to PANE. Presumably this is to avoid the flicker of incremental updates.") (* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.") - (TEXTOBJ! TEXTOBJ) - (\DTEST LINE 'LINEDESCRIPTOR) - (LET ((WINDOWDS (WINDOWPROP PANE 'DSP)) - (THISLINE (\DTEST (FGETTOBJ TEXTOBJ THISLINE) - 'THISLINE)) - (OLDCACHE (fetch (LINECACHE LCBITMAP) of (FGETTOBJ TEXTOBJ DISPLAYCACHE))) - (DS (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) - CACHE XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT CURY LHEIGHT) - [SETQ LHEIGHT (COND - ((FGETLD LINE PREVLINE) (* ; + (LINEDESCRIPTOR! LINE) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (WINDOWDS (WINDOWPROP PANE 'DSP)) + (THISLINE (\DTEST (FGETTOBJ TEXTOBJ THISLINE) + 'THISLINE)) + (OLDCACHE (fetch (LINECACHE LCBITMAP) of (FGETTOBJ TEXTOBJ DISPLAYCACHE))) + (DS (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) + CACHE XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT CURY LHEIGHT) + (SETQ LHEIGHT (if (FGETLD LINE PREVLINE) + then (* ;  "So if theres a base-to-base measure, we clear everything right.") - (IMAX (IDIFFERENCE (FGETLD (FGETLD LINE PREVLINE) - YBOT) - (FGETLD LINE YBOT)) - (FGETLD LINE LHEIGHT))) - (T (FGETLD LINE LHEIGHT] - (SETQ CACHE (\TEDIT.LINECACHE (FGETTOBJ TEXTOBJ DISPLAYCACHE) - (FGETLD LINE LXLIM) - LHEIGHT)) - (CL:UNLESS (EQ CACHE OLDCACHE) (* ; + (IMAX (IDIFFERENCE (FGETLD (FGETLD LINE PREVLINE) + YBOT) + (FGETLD LINE YBOT)) + (FGETLD LINE LHEIGHT)) + else (FGETLD LINE LHEIGHT))) + (SETQ CACHE (\TEDIT.LINECACHE (FGETTOBJ TEXTOBJ DISPLAYCACHE) + (FGETLD LINE LXLIM) + LHEIGHT)) + (CL:UNLESS (EQ CACHE OLDCACHE) (* ;  "We changed the bitmaps because this line was bigger--update the displaystream, too") - (DSPDESTINATION CACHE DS) - (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch BITMAPWIDTH of CACHE) - HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) - DS)) - (BLTSHADE WHITESHADE CACHE 0 0 NIL NIL 'REPLACE) (* ; "Clear the line cache") - (CL:WHEN (AND (IGEQ (FGETLD LINE LCHAR1) - 1) - (ILEQ (FGETLD LINE LCHAR1) - (FGETTOBJ TEXTOBJ TEXTLEN))) - - (* ;; "Only display the line if it contains text (CHAR1 > 0), appears before the end of the text. Original code also suppressed lines that were partially off-screen, which meant that large bitmaps wouldn't show.") - - (CL:UNLESS (EQ LINE (fetch (THISLINE DESC) of THISLINE)) + (DSPDESTINATION CACHE DS) + (DSPCLIPPINGREGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch BITMAPWIDTH of CACHE) + HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) + DS)) + (BLTSHADE WHITESHADE CACHE 0 0 NIL NIL 'REPLACE) (* ; "Clear the line cache") + (CL:WHEN (AND (IGEQ (FGETLD LINE LCHAR1) + 1) + (ILEQ (FGETLD LINE LCHAR1) + (FGETTOBJ TEXTOBJ TEXTLEN))) + + (* ;; "Only display the line if it contains text (CHAR1 > 0), appears before the end of the text. Original code also suppressed lines that were partially off-screen, which meant that large bitmaps wouldn't show.") + + (CL:UNLESS (EQ LINE (fetch (THISLINE DESC) of THISLINE)) (* ;  "No image cache -- re-format and display") - (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) - (FGETLD LINE LCHAR1) - LINE)) - (MOVETO (FGETLD LINE LX1) - (FGETLD LINE LDESCENT) - DS) - (SETQ DISPLAYDATA (ffetch (STREAM IMAGEDATA) of DS)) + (\TEDIT.FORMATLINE TSTREAM (FGETLD LINE LCHAR1) + LINE)) + (MOVETO (FGETLD LINE LX1) + (FGETLD LINE LDESCENT) + DS) + (SETQ DISPLAYDATA (ffetch (STREAM IMAGEDATA) of DS)) (* ;  "IMAGEDATA of the display stream, not textstream") - (SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA)) - (SETQ XOFFSET (ffetch DDXOFFSET of DISPLAYDATA)) + (SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA)) + (SETQ XOFFSET (ffetch DDXOFFSET of DISPLAYDATA)) - (* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.") + (* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.") - (SETQ CLIPLEFT (ffetch DDClippingLeft of DISPLAYDATA)) + (SETQ CLIPLEFT (ffetch DDClippingLeft of DISPLAYDATA)) (* ;  "The left and right edges of the clipping region for the text display window.") - (SETQ CLIPRIGHT (ffetch DDClippingRight of DISPLAYDATA)) + (SETQ CLIPRIGHT (ffetch DDClippingRight of DISPLAYDATA)) - (* ;; "We know that the line's first CLOOKS comes before the first CHAR") + (* ;; "We know that the line's first CLOOKS comes before the first CHAR") - [for CHARSLOT CLOOKS LOOKSTARTX (TX _ (IPLUS XOFFSET (FGETLD LINE LX1))) - (TERMSA _ (FGETTOBJ TEXTOBJ TXTTERMSA)) incharslots THISLINE - do - (* ;; - "Display the line character by character. CHAR and CHARW are bound to CHARSLOT values") + (for CHARSLOT LOOKSTARTX OLDCLOOKS OLDCOLOR (TX _ (IPLUS XOFFSET (FGETLD LINE LX1))) + (TERMSA _ (FGETTOBJ TEXTOBJ TXTTERMSA)) incharslots THISLINE + do + (* ;; + "Display the line character by character. CHAR, CHARW, and CHARCL are bound to CHARSLOT values") - (CL:WHEN (FMEMB CHAR (CHARCODE (EOL FORM))) + (CL:UNLESS (EQ OLDCLOOKS CHARCL) (* ; "New looks") + (CL:UNLESS LOOKSTARTX (* ; + "LOOKSTARTX: Starting X position for the current-looks text.") + (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))) + (freplace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE TX XOFFSET)) + (* ; + "Make the displaystream reflect our current X position") + (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLDCLOOKS (FGETLD LINE LDESCENT)) + (DSPFONT (FGETCLOOKS CHARCL CLFONT) + DS) + (CL:UNLESS (EQ OLDCOLOR (SETQ OLDCOLOR (FGETCLOOKS CHARCL CLCOLOR))) + (DSPCOLOR OLDCOLOR DS)) + (CL:UNLESS (EQ 0 (FGETCLOOKS CHARCL CLOFFSET)) + (* ; "Account for super/subscripting") + (RELMOVETO 0 (FGETCLOOKS CHARCL CLOFFSET) + DS)) + (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)) + (SETQ OLDCLOOKS CHARCL)) + (CL:WHEN (FMEMB CHAR (CHARCODE (EOL FORM))) (* ;  "\FORMATLINE used space-width for EOL and FORM. Display them that way.") - (SETQ CHAR (CHARCODE SPACE))) - (SELCHARQ CHAR - ((TAB Meta,TAB) - (CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB)) - (FGETCLOOKS CLOOKS CLLEADER) - (EQ (FGETCLOOKS CLOOKS CLUSERINFO) + (SETQ CHAR (CHARCODE SPACE))) + (if (MEMB CHAR (CHARCODE (TAB Meta,TAB))) + then (CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB)) + (FGETCLOOKS CHARCL CLLEADER) + (EQ (FGETCLOOKS CHARCL CLUSERINFO) 'DOTTEDLEADER)) (* ;; "Not just white space, have to fill in with dots.") - (\TEDIT.DISPLAYLINE.TABS CHARW DS TX TERMSA LINE CLOOKS DISPLAYDATA + (\TEDIT.DISPLAYLINE.TABS CHARW DS TX TERMSA LINE CHARCL DISPLAYDATA DDPILOTBBT CLIPRIGHT TEXTOBJ)) - (add TX CHARW)) - (NIL (* ; - "Must be looks. Line-start looks are guaranteed to come before any character/object") - (CL:WHEN (type? CHARLOOKS CHARW) - (CL:UNLESS LOOKSTARTX (* ; - "LOOKSTARTX: Starting X position for the current-looks text.") - (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))) - (freplace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE TX XOFFSET)) - (* ; - "Make the displaystream reflect our current X position") - (CL:WHEN CLOOKS (* ; - "Underline/overline/strike the just-finished looks run") - (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS CLOOKS (FGETLD LINE - LDESCENT))) - (SETQ CLOOKS CHARW) - (DSPFONT (FGETCLOOKS CLOOKS CLFONT) - DS) - (CL:UNLESS (EQ 0 (FGETCLOOKS CLOOKS CLOFFSET)) - (* ; "Account for super/subscripting") - (RELMOVETO 0 (FGETCLOOKS CLOOKS CLOFFSET) - DS)) - (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)))) - (PROGN (if (IMAGEOBJP CHAR) - then - (* ;; "Go to the base line, left edge of the image region.") - - (SETQ CURY (DSPYPOSITION NIL DS)) - (MOVETO (IDIFFERENCE TX XOFFSET) - CURY DS) - (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) - CHAR DS 'DISPLAY (FGETTOBJ TEXTOBJ STREAMHINT)) - (DSPFONT (FGETCLOOKS CLOOKS CLFONT) - DS) (* ; + (add TX CHARW) + elseif (IMAGEOBJP CHAR) + then + (* ;; "Go to the base line, left edge of the image region.") + + (SETQ CURY (DSPYPOSITION NIL DS)) + (MOVETO (IDIFFERENCE TX XOFFSET) + CURY DS) + (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) + CHAR DS 'DISPLAY TSTREAM) + (DSPFONT (FGETCLOOKS CHARCL CLFONT) + DS) (* ;  "Restore the character font, move to just after the object.") - (MOVETO (IDIFFERENCE TX XOFFSET) - CURY DS) - elseif TERMSA - then (* ; "Using special instrns from TERMSA") - (\DSPPRINTCHAR DS CHAR) - elseif (DIACRITICP CHAR) - then (MI-TEDIT.BLTCHAR CHAR DS (IPLUS TX (\TEDIT.DIACRITIC.SHIFT - CHARSLOT THISLINE DS)) - DISPLAYDATA DDPILOTBBT CLIPRIGHT) - (SETQ CHARW 0) - elseif (EQ 'KERN CHAR) - then (RELMOVETO CHARW 0) - else (* ; "Native charcodes") - (MI-TEDIT.BLTCHAR CHAR DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT)) - (add TX CHARW))) finally (replace DDXPOSITION of DISPLAYDATA - with (IDIFFERENCE TX XOFFSET)) + (MOVETO (IDIFFERENCE TX XOFFSET) + CURY DS) + (add TX CHARW) + elseif TERMSA + then (* ; "Using special instrns from TERMSA") + (\DSPPRINTCHAR DS CHAR) + elseif (DIACRITICP CHAR) + then (MI-TEDIT.BLTCHAR CHAR DS (IPLUS TX (\TEDIT.DIACRITIC.SHIFT CHARSLOT + THISLINE DS)) + DISPLAYDATA DDPILOTBBT CLIPRIGHT) + (SETQ CHARW 0) + elseif (EQ 'KERN CHAR) + then (RELMOVETO CHARW 0) + else (* ; "Native charcodes") + (MI-TEDIT.BLTCHAR CHAR DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT) + (add TX CHARW)) finally (replace DDXPOSITION of DISPLAYDATA + with (IDIFFERENCE TX XOFFSET)) (* ;  "Make any necessary looks mods to the last run of characters") - (CL:WHEN CLOOKS - (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS - CLOOKS (FGETLD LINE LDESCENT)))]) - (BITBLT CACHE 0 0 WINDOWDS 0 (FGETLD LINE YBOT) - (FGETTOBJ TEXTOBJ WRIGHT) - LHEIGHT - 'INPUT - 'REPLACE) (* ; + (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLDCLOOKS + (FGETLD LINE LDESCENT)))) + (BITBLT CACHE 0 0 WINDOWDS 0 (FGETLD LINE YBOT) + (PANERIGHT PANE) + LHEIGHT + 'INPUT + 'REPLACE) (* ;  "Paint the cached image on the screen (this lessens flicker during update)") - (CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS) - FMTREVISED) (* ; + (CL:WHEN (GETPLOOKS (FGETLD LINE LPARALOOKS) + FMTREVISED) (* ;  "This paragraph has been revised, so mark it.") - (\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LPARALOOKS) - WINDOWDS LINE)) - (SELECTQ (FGETLD LINE LMARK) - (GREY (* ; + (\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LPARALOOKS) + WINDOWDS LINE)) + (SELECTQ (FGETLD LINE LMARK) + (GREY (* ;  "This line has some property that isn't visible to the user. Tell him to be careful") - (BLTSHADE 42405 WINDOWDS 0 (FGETLD LINE YBASE) - 6 6 'PAINT)) - (SOLID (BLTSHADE BLACKSHADE WINDOWDS 0 (FGETLD LINE YBASE) + (BLTSHADE 42405 WINDOWDS 0 (FGETLD LINE YBASE) 6 6 'PAINT)) - (BLTSHADE WHITESHADE WINDOWDS 0 (FGETLD LINE YBASE) - 6 6 'PAINT)) - LINE]) + (SOLID (BLTSHADE BLACKSHADE WINDOWDS 0 (FGETLD LINE YBASE) + 6 6 'PAINT)) + (BLTSHADE WHITESHADE WINDOWDS 0 (FGETLD LINE YBASE) + 6 6 'PAINT)) + LINE]) (\TEDIT.DISPLAYLINE.TABS [LAMBDA (CW DS TX TERMSA LINE CLOOKS DISPLAYDATA DDPILOTBBT CLIPRIGHT TEXTOBJ) @@ -2319,7 +2309,8 @@ BOTTOMNEWLINE]) (\TEDIT.PREVIOUS.LINEBREAK - [LAMBDA (TSTREAM CHNO) (* ; "Edited 18-May-2024 18:53 by rmk") + [LAMBDA (TSTREAM CHNO) (* ; "Edited 19-Apr-2025 23:58 by rmk") + (* ; "Edited 18-May-2024 18:53 by rmk") (* ; "Edited 3-May-2024 23:33 by rmk") (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 11-Dec-2023 21:59 by rmk") @@ -2335,7 +2326,7 @@ else (* ;; "Otherwise, move back thru the text until we find a for-sure line break. ") - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) NCHARS) (if (AND NIL (FGETTOBJ TEXTOBJ FORMATTEDP)) then @@ -2359,18 +2350,15 @@ 1)]) (\TEDIT.UPDATE.LINES - [LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 30-Mar-2025 10:02 by rmk") + [LAMBDA (TSTREAM REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 26-Apr-2025 19:19 by rmk") + (* ; "Edited 21-Apr-2025 20:30 by rmk") + (* ; "Edited 9-Apr-2025 12:59 by rmk") + (* ; "Edited 6-Apr-2025 14:23 by rmk") + (* ; "Edited 30-Mar-2025 10:02 by rmk") (* ; "Edited 1-Feb-2025 10:34 by rmk") (* ; "Edited 21-Jan-2025 13:25 by rmk") (* ; "Edited 7-Jan-2025 11:55 by rmk") (* ; "Edited 7-Dec-2024 21:52 by rmk") - (* ; "Edited 29-Nov-2024 22:56 by rmk") - (* ; "Edited 26-Nov-2024 03:35 by rmk") - (* ; "Edited 22-Nov-2024 17:57 by rmk") - (* ; "Edited 20-Nov-2024 14:52 by rmk") - (* ; "Edited 17-Nov-2024 19:52 by rmk") - (* ; "Edited 11-Nov-2024 23:51 by rmk") - (* ; "Edited 1-Nov-2024 22:05 by rmk") (* ; "Edited 13-Sep-2024 22:27 by rmk") (* ; "Edited 3-Jul-2024 15:42 by rmk") (* ; "Edited 7-May-2024 10:41 by rmk") @@ -2379,50 +2367,66 @@ (* ; "Edited 22-Jun-2023 15:50 by rmk") (* ; "Edited 4-May-2023 10:29 by rmk") - (* ;; "This updates the lines in each pane given that NCHARSCHANGED characters with respect to FIRSTCHANGEDCHNO have been modified. It tries to reuse formatting information and screen bitmap images that are valid after the change.") + (* ;; " ") + + (* ;; "The last valid line for each pane is a line above the change whose layout is not affected by the change--either because it is forced-end, or we can tell that a change in the after it does not propagate further back. If the pane would not be affected, its last valid line is NIL and the pane is not further processed.") + + (* ;; "For a pane with a last valid line, the next valid line is the line somewhere after the last valid that is also not affected by the change--either because the line before it is a forced-end or we can tell that the change stops propagating at the line before it. The next value line is NIL if the change propagates through the bottom of the pane--all lower lines must be reformatted.") + + (* ;; "The character numbers of NEXTVALIDLINE and all lines below it have been adjusted to reflect the NCHARSADDED (positive or negative), but their Y positions have not yet been adjusted. The lines in the gap between the last valid and next valid have also been chopped out.") (* ;; "See line-segmentation comments in \TEDIT.VALID.LINES.") - (CL:UNLESS (GETTOBJ TEXTOBJ TXTDON'TUPDATE) - [if (type? SELECTION FIRSTCHANGEDCHNO) - then (SETQ NCHARSCHANGED (FGETSEL FIRSTCHANGEDCHNO DCH)) - (SETQ FIRSTCHANGEDCHNO (FGETSEL FIRSTCHANGEDCHNO CH#)) - elseif (type? SELPIECES FIRSTCHANGEDCHNO) - then [SETQ NCHARSCHANGED (ADD1 (IDIFFERENCE (FGETSPC FIRSTCHANGEDCHNO SPLASTCHAR) - (FGETSPC FIRSTCHANGEDCHNO SPFIRSTCHAR] - (SETQ FIRSTCHANGEDCHNO (FGETSPC FIRSTCHANGEDCHNO SPFIRSTCHAR)) - else (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO 1)) - (CL:UNLESS NCHARSCHANGED - (SETQ NCHARSCHANGED (FGETTOBJ TEXTOBJ TEXTLEN)))] - (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) - (for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES inpanes TEXTOBJ - when (SETQ VALIDS (\TEDIT.VALID.LINES PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON - (FGETTOBJ TEXTOBJ STREAMHINT))) - do - (* ;; - "Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive") - - (SETQ LASTVALID (CAR VALIDS)) - (SETQ NEXTVALID (CDR VALIDS)) (* ; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.") - [SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TEXTOBJ - (CL:IF NEXTVALID - (SUB1 (FGETLD NEXTVALID LCHAR1)) - (TEXTLEN TEXTOBJ))] - - (* ;; + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTDON'TUPDATE) + (\TEDIT.NOSEL TSTREAM) + (for PANE LASTVALID NEXTVALID LASTGAPLINE BITMAPLINES (LASTCHANGEDCHNO + _ + (SUB1 (IPLUS FIRSTCHANGEDCHNO + NCHARSCHANGED))) + (DELTA _ (SELECTQ REASON + (INSERTION NCHARSCHANGED) + (DELETION (IMINUS NCHARSCHANGED)) + ((CHANGED LOOKS) + 0) + (\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) inpanes TEXTOBJ + when (SETQ LASTVALID (\TEDIT.LASTVALIDLINE FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE + TSTREAM)) + do + (* ;; + "Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive") + + (SETQ NEXTVALID (\TEDIT.NEXTVALIDLINE LASTCHANGEDCHNO PANE TSTREAM)) + (CL:UNLESS (ZEROP DELTA) (* ; + "Adjust the character numbers of the lower valid lines") + (for L inlines NEXTVALID do (add (FGETLD L LCHAR1) + DELTA) + (add (FGETLD L LCHARLAST) + DELTA))) + + (* ;; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.") + + [SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID PANE TSTREAM + (CL:IF NEXTVALID + (SUB1 (FGETLD NEXTVALID LCHAR1)) + (TEXTLEN TEXTOBJ))] + + (* ;;  "The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.") - (LINKLD LASTGAPLINE NEXTVALID) - (if NEXTVALID - then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID)) - else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE)) + (LINKLD LASTGAPLINE NEXTVALID) + (if NEXTVALID + then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID)) + else (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTGAPLINE)) - (* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix") + (* ;; "If LASTVALID is not visible (above the pane), make sure that its NEXT is linked to the PANE's prefix") - (\TEDIT.SHIFTLINES LASTVALID PANE TEXTOBJ BITMAPLINES)))]) + (\TEDIT.SHIFTLINES LASTVALID PANE TSTREAM BITMAPLINES)))]) (\TEDIT.PANE.CREATELINES - [LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 28-Mar-2025 20:55 by rmk") + [LAMBDA (TSTREAM PANE LCHARLAST YBOT) (* ; "Edited 21-Apr-2025 12:02 by rmk") + (* ; "Edited 19-Apr-2025 22:07 by rmk") + (* ; "Edited 28-Mar-2025 20:55 by rmk") (* ; "Edited 8-Feb-2025 23:52 by rmk") (* ; "Edited 29-Nov-2024 09:14 by rmk") (* ; "Edited 20-Nov-2024 14:26 by rmk") @@ -2455,10 +2459,10 @@ LDUMMY _ T LCHAR1 _ 0 LCHARLAST _ (OR LCHARLAST 0) - RIGHTMARGIN _ (SUB1 (FGETTOBJ TEXTOBJ WRIGHT)) + RIGHTMARGIN _ (SUB1 (PANERIGHT PANE)) LHEIGHT _ 0 LX1 _ 0 - LXLIM _ (FGETTOBJ TEXTOBJ WRIGHT) + LXLIM _ (PANERIGHT PANE) FORCED-END _ (CHARCODE EOL) LASCENT _ 0 LDESCENT _ 0 @@ -2471,18 +2475,19 @@ (SETYBOT PREFIX (OR YBOT (PANEHEIGHT PANE))) (FSETPANEPROP (PANEPROPS PANE) PREFIXLINE PREFIX) - (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ PREFIX) + (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM PREFIX) PREFIX]) (\TEDIT.SUFFIXLINE.CREATE - [LAMBDA (PANE TEXTOBJ PREVLINE) (* ; "Edited 28-Mar-2025 20:56 by rmk") + [LAMBDA (PANE TSTREAM PREVLINE) (* ; "Edited 21-Apr-2025 12:00 by rmk") + (* ; "Edited 28-Mar-2025 20:56 by rmk") (* ; "Edited 29-Nov-2024 10:54 by rmk") (* ; "Edited 22-Nov-2024 10:22 by rmk") (* ; "Edited 20-Nov-2024 14:25 by rmk") (* ;; "A new suffix line is created, if needed, and linked whenever the bottom is reached. This gets the paragraph leading and height parameters from the previous line. This may already be formatted as a dummy, if LCHARLIM is past the end.") - (LET ([SUFFIX (LINEDESCRIPTOR! (\TEDIT.FORMATLINE TEXTOBJ (GETLD PREVLINE LCHARLIM) + (LET ([SUFFIX (LINEDESCRIPTOR! (\TEDIT.FORMATLINE TSTREAM (GETLD PREVLINE LCHARLIM) (PANESUFFIX PANE] EMPTYLINE) (FSETLD SUFFIX LDUMMY T) @@ -2499,7 +2504,8 @@ SUFFIX]) (\TEDIT.LINES.BELOW - [LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 21-Jan-2025 13:31 by rmk") + [LAMBDA (PREVLINE PANE TSTREAM) (* ; "Edited 21-Apr-2025 11:53 by rmk") + (* ; "Edited 21-Jan-2025 13:31 by rmk") (* ; "Edited 24-Nov-2024 14:57 by rmk") (* ; "Edited 22-Nov-2024 00:53 by rmk") (* ; "Edited 20-Nov-2024 12:37 by rmk") @@ -2525,14 +2531,15 @@ (* ;; "Formats and displays lines after PREVLINE down to the one is at least partially visible at the bottom of PANE. Each line is positioned with respect to its predecessor and linked to it. The last visible line is set as the BOTTOMLINE of PANE, PANE's suffix is adjusted to cover the bitmap and all the unseen later characters. Returns the last displayed line.") - (for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines PREVLINE - eachtime (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (FGETLD L LCHARLIM))) + (for L NEXT YBOT (TEXTOBJ _ (FTEXTOBJ TSTREAM)) + (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines PREVLINE + eachtime (SETQ NEXT (\TEDIT.FORMATLINE TSTREAM (FGETLD L LCHARLIM))) until (FGETLD NEXT LDUMMY) do (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT)) (SETYBOT NEXT YBOT) (CL:WHEN (ILESSP YBOT BOTTOM) (* ; "Ran off the bottom") (RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE) - then (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE) + then (\TEDIT.DISPLAYLINE TSTREAM NEXT PANE) (LINKLD L NEXT) (* ; "Keep NEXT with partial display") NEXT @@ -2542,7 +2549,7 @@ (CL:WHEN (FGETLD NEXT LDUMMY) (* ; "Suffix line: end of pane") (RETURN L)) - (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE) + (\TEDIT.DISPLAYLINE TSTREAM NEXT PANE) (* ;  "Cached formatting is good for display") finally @@ -2552,7 +2559,8 @@ (RETURN L]) (\TEDIT.MEASURED.LINES - [LAMBDA (PREVLINE PANE TEXTOBJ LASTCHAR) (* ; "Edited 21-Jan-2025 13:30 by rmk") + [LAMBDA (PREVLINE PANE TSTREAM LASTCHAR) (* ; "Edited 21-Apr-2025 12:05 by rmk") + (* ; "Edited 21-Jan-2025 13:30 by rmk") (* ; "Edited 7-Dec-2024 16:55 by rmk") (* ; "Edited 1-Dec-2024 11:26 by rmk") (* ; "Edited 20-Nov-2024 12:37 by rmk") @@ -2562,7 +2570,7 @@ (for L NEXT NEXTCHAR1 YBOT (PBOTTOM _ (PANEBOTTOM PANE)) inlines PREVLINE eachtime (SETQ NEXTCHAR1 (FGETLD L LCHARLIM)) while (ILEQ NEXTCHAR1 LASTCHAR) - do (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ NEXTCHAR1)) (* ; + do (SETQ NEXT (\TEDIT.FORMATLINE TSTREAM NEXTCHAR1)) (* ;  "Always a next if the while succeeds") (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT)) (SETYBOT NEXT YBOT) @@ -2579,166 +2587,193 @@ (RETURN L]) -(\TEDIT.VALID.LINES - [LAMBDA (PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON TSTREAM) - (* ; "Edited 30-Mar-2025 09:12 by rmk") - (* ; "Edited 27-Mar-2025 12:40 by rmk") - (* ; "Edited 21-Jan-2025 15:22 by rmk") - (* ; "Edited 6-Jan-2025 15:19 by rmk") - (* ; "Edited 22-Nov-2024 16:54 by rmk") - (* ; "Edited 20-Nov-2024 12:37 by rmk") - (* ; "Edited 21-Oct-2024 00:33 by rmk") - (* ; "Edited 5-Jul-2024 22:58 by rmk") - (* ; "Edited 4-Jul-2024 10:48 by rmk") - (* ; "Edited 23-May-2024 12:48 by rmk") - (* ; "Edited 22-Feb-2024 01:05 by rmk") - (* ; "Edited 3-Nov-2023 12:07 by rmk") - (* ; "Edited 14-Jun-2023 15:55 by rmk") - (* ; "Edited 17-May-2023 09:32 by rmk") - (* ; "Edited 15-May-2023 17:51 by rmk") +(\TEDIT.VALID.LASTCHNOS + [LAMBDA (FIRSTCHANGEDCHNO TSTREAM) (* ; "Edited 18-Apr-2025 09:35 by rmk") - (* ;; "Called when changes have been made to the document that affect the lines displayed in PANE. Return NIL if the change is not visible in PANE. Otherwise, this divides the lines in PANE into 3 segments:") + (* ;; "This returns the number of the last-visible valid character in the pane that contains the change and has the most visible lines above it. If the last valid character is not visible, returns the cons of the shortest list of valid-lines ending above the topline. (We might search that backwards, but the CAR is needed to avoid collection.) ") - (* ;; " 1. a prefix of lines from the top visible line (next of PANEPREFIX) to the LASTVALID line, the line just before the first changed line.") + (* ;; " Note that all character numbers above FIRSTCHANGEDCHNO are pre-change, so it is OK to look backwards.") - (* ;; " 2. an intermediate sequence of lines that are (or may be) no longer valid because of the change.") + (LET (MOSTVISIBLE FIRSTCHANGEDLINE LASTVALIDLINE) + (CL:WHEN [SETQ MOSTVISIBLE (for PANE inpanes (FTEXTOBJ TSTREAM) + when (IBETWEENP FIRSTCHANGEDCHNO (FGETLD (PANEPREFIX PANE) + LCHARLIM) + (SUB1 (FGETLD (PANESUFFIX PANE) + LCHAR1))) + largest (IDIFFERENCE FIRSTCHANGEDCHNO (FGETLD (PANEPREFIX + PANE) + LCHARLIM] + (SETQ FIRSTCHANGEDLINE (find L inlines (PANEPREFIX MOSTVISIBLE) + suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L))) - (* ;; - " 3. a suffix of post-change lines, starting with NEXTVALID, that are known still to be valid.") + (* ;; "There is a single last valid above the first change that applies to every pane. If the global lastvalid corresponds to a line in a particular pane, then that existing line is the last valid for that pane.;;\") - (* ;; "A line is %"valid%" if its line breaking is unaffected by the change and the bits in the screen bitmap that represented it before the change are still correct.") + (* ;; "We want to return a chain of lines that runs upwards from just before the changeline to the last valid. With luck, the last valid is one of the lines above the change line in the pane that has the most above-change lines.") - (* ;; "") + (* ;; "If not, then the lines of the most visible pane are totally irrelevant. We have to compute the lines from the top of the most visible pane (it's lines are totally irrelevant)") - (* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from the prefix line to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID and PREVLINE of NEXTVALID).") + (* ;; "If we can't") - (* ;; "") + [if (ILESSP (FGETLD FIRSTCHANGEDLINE LFIRSTSEPR) + FIRSTCHANGEDCHNO) + then + (* ;; "The prev of a line containing an internal sepr is valid") - (* ;; "This assumes that the change has already been installed in the piece table after character FIRSTCHANGEDCHNO. The LCHAR1/LAST valus for lines through LASTVALID are unaffected by the change, the values for all later lines are off by NCHARSCHANGED (negative for deletions, positive for insertions). The positions for NEXTVALID and beyond are adjusted so that they are correct with respect to the revised piece table. Note that this only deals with the character numbers of lines that will persist. Although the Y positions for segment 1 lines are good,segment 3 positions cannot be adjusted until the replacements for segment 2 lines have been calculated.") + (FGETLD FIRSTCHANGEDLINE PREVLINE) + elseif (for L backlines (FGETLD FIRSTCHANGEDLINE PREVLINE) + do + (* ;; "Line with a forced end is valid") - (* ;; "") + (CL:WHEN (FGETLD L FORCED-END) + (RETURN L)) - (* ;; "Edge conditions:") + (* ;; "The prev of a line containing an internal sepr is valid") - (* ;; "If the first visible line is changed, then there are no existing segment 1 lines and no existing LASTVALID line to return. If the first changed line is also the first line of the document, then LASTVALID is NIL. Otherwise, we fabricate a new line with LCHARLAST and YBOT just above the changed top line and returned it as LASTVALID. Either way, the next of PREFIXLINE is set to NIL to indicate that there is no chain of real segment 1 lines with valid formatting and reusable bitmaps. ") + (CL:WHEN (ILESSP (FGETLD L LFIRSTSEPR) + (FGETLD L LCHARLAST)) + (RETURN (FGETLD L PREVLINE))) finally - (* ;; "") + (* ;; "We create a chain of last-valid character numbers corresponding to a chain of valid lines that descends from the latest previous forced-end to the topline of MOSTVISIBLE.") - (* ;; "If the last visible line is changed, then there is no NEXTVALID line, indicated by NEXTVALID=NIL. The next valid could be a currently non-existent line just below the pane if we are not at the end of the document. If LCHARLAST of the last visible line is TEXTLEN, there is at best a trailing line.") + (RETURN (\TEDIT.LINES.ABOVE + TSTREAM + (PANETOPLINE MOSTVISIBLE + ])]) - (* ;; "") +(\TEDIT.VALID.NEXTCHNOS + [LAMBDA (LASTCHANGEDCHNO TSTREAM DELTA) (* ; "Edited 17-Apr-2025 11:33 by rmk") - (* ;; "Note that this is mostly an optimization to avoid unnecessary reformatting and redisplaying of still-valid lines in favor of bitbltting a block of their currently visible images. Smashing all lines to NIL and refilling each pane would also give the correct behavior, but slower. Intermediate would be smashing all lines below the last valid.") - - (* ;; "LASTCHANGEDCHNO is in the before-change sequence. I.e., if FIRST is 5 and 6 were being deleted, then it is 10. But it doesn't correspond to the surviving line positions after they have been adjusted. It would have to be adjusted too.") - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) - (LASTCHANGEDCHNO (SUB1 (IPLUS FIRSTCHANGEDCHNO NCHARSCHANGED))) - (SUFFIXLINE (PANESUFFIX PANE)) - (DELTA (SELECTQ REASON - (INSERTION NCHARSCHANGED) - (DELETION (IMINUS NCHARSCHANGED)) - ((CHANGED LOOKS) - NIL) - (\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) - FIRSTCHANGEDLINE LASTCHANGEDLINE LASTVALIDLINE NEXTVALIDLINE LINESABOVE) - (CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ)) (* ; "Empty document") - (RETURN (CONS (PANEPREFIX PANE)))) - (CL:WHEN (IGEQ FIRSTCHANGEDCHNO (FGETLD SUFFIXLINE LCHAR1)) - (* ; - "Change after previously visible lines") - (CL:UNLESS (ILEQ LASTCHANGEDCHNO (TEXTLEN TEXTOBJ)) - (* ; - "Change is after PANE, nothing to do") - (RETURN NIL)) + (* ;; "This returns the number of the next-visible valid character in the pane that has the most visible lines below the change. If the last valid character is not visible, could return the shortest list of valid-lines starting below the bottomline. ") - (* ;; "Adding at the end of the document: insert a new line") + (* ;; " ") - (\TEDIT.INSERTLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO) - SUFFIXLINE)) - (SETQ FIRSTCHANGEDLINE (find L inlines (PANEPREFIX PANE) suchthat (FWITHINLINEP - FIRSTCHANGEDCHNO L - ))) - (CL:UNLESS FIRSTCHANGEDLINE (* ; "Change is below PANE") - (RETURN NIL)) + (* ;; "We can stop when we see a forced end-- characters won't move around after that. In the usual case, the forced-end is a also the last line of a paragraph, but we can't just take the first line of the next paragraph because we can't deal here with whatever paragraph leading it might have (and the venue sysout also screwed up in that case).") - (* ;; "Change starts above or inside PANE, Where does it end?") + (* ;; "So we go for the second line of the next paragraph, if there is one") - (SETQ LASTCHANGEDLINE (find L inlines FIRSTCHANGEDLINE suchthat (FWITHINLINEP - LASTCHANGEDCHNO L))) - (CL:WHEN LASTCHANGEDLINE + (* ;; " Note that all character numbers below LASTCHANGEDCHNO are pre-change, so it is OK to look forward in the lines") + (* ; "") + (LET (MOSTVISIBLE LASTCHANGEDLINE LASTVALIDLINE) + (CL:WHEN (SETQ MOSTVISIBLE (for PANE inpanes (FTEXTOBJ TSTREAM) + when (IBETWEENP LASTCHANGEDCHNO (FGETLD (PANEPREFIX PANE) + LCHARLIM) + (SUB1 (FGETLD (PANESUFFIX PANE) + LCHAR1))) + largest (IDIFFERENCE (SUB1 (FGETLD (PANESUFFIX PANE) + LCHAR1)) + LASTCHANGEDCHNO))) + (SETQ LASTCHANGEDLINE (find L inlines (PANEPREFIX MOSTVISIBLE) + suchthat (FWITHINLINEP LASTCHANGEDCHNO L))) + + (* ;; "So we go for the second line of the next paragraph, if there is one") - (* ;; - "Last changed line is visible, its changes may cause character to shift to or from lower lines.") + (* ;; + "The line after a forced end is valid. But maybe we can figure out how to stop sooner?") - (SETQ NEXTVALIDLINE (\TEDIT.NEXTVALIDLINE LASTCHANGEDLINE TSTREAM))) + (for L inlines LASTCHANGEDLINE when (FGETLD L FORCED-END) + do + (* ;; "A forced end is usually the last line of a paragraph, and its next line is probably valid. But we skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading to worry about.") - (* ;; "") + (CL:WHEN (FGETLD L LSTLN) + (SETQ L (FGETLD L NEXTLINE))) + (RETURN (CL:WHEN (AND L (FGETLD L NEXTLINE)) + (FGETLD (FGETLD L NEXTLINE) + LCHAR1))) finally - (SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM)) - (CL:WHEN NEXTVALIDLINE - (FSETLD NEXTVALIDLINE PREVLINE NIL) - (CL:WHEN DELTA + (* ;; "Ran off the bottom. Should we build lines down until we fine a true valid character? Or maybe wait to see whether there is another pane that starts in a suffix of the paragraph for which this ends in a prefix.") - (* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ") + (* ;; "") + + (* ;; "We would have to add DELTA to build new lines consistent with the document, then subtract DELTA to get consistent with the current lines.") + + NIL))]) + +(\TEDIT.LASTVALIDLINE + [LAMBDA (FIRSTCHANGEDCHNO LASTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 26-Apr-2025 22:57 by rmk") + (* ; "Edited 20-Apr-2025 00:08 by rmk") - (for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1) - DELTA) - (add (FGETLD L LCHARLAST) - DELTA)))) + (* ;; "Return NIL if this change has no visible consequences for PANE. Otherwise, find or create the lowest line in PANE that is impervious to the change at FIRSTCHARCHANGECHNO. That line is valid: it and lines above it do not need reformatting or redisplay. ") + + (* ;; "Note that all character numbers above FIRSTCHANGEDCHNO are pre-change, so it is OK to look backwards.") + + (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) + FIRSTCHANGEDLINE) + (if (<= (FGETLD (PANETOPLINE PANE) + LCHARLIM) + FIRSTCHANGEDCHNO + (SUB1 (FGETLD (PANESUFFIX PANE) + LCHAR1))) + then + (* ;; + "Change is within the second line of PANE or later, find the line that contains FIRSTCHANGEDCHNO") + + (SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD (PANETOPLINE PANE) + NEXTLINE) + suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L))) + elseif (OR (ILEQ FIRSTCHANGEDCHNO (FGETLD (PANETOPLINE PANE) + LCHARLAST)) + (ZEROP (FGETLD (PANETOPLINE PANE) + LCHARLAST))) + then + (* ;; "Change is in first line or before PANE--does it impinge?") + + (RETURN (CL:WHEN (OR (FWITHINLINEP FIRSTCHANGEDCHNO (PANETOPLINE PANE)) + (IGEQ (CAR (\TEDIT.PARA.LAST TEXTOBJ LASTCHANGEDCHNO)) + (FGETLD (PANEPREFIX PANE) + LCHARLIM))) + + (* ;; "The changed paragraph doesn't end above PANE there is at least one affected line. Build and return the prefix for the lowest such line.") + + (FSETLD (PANEPREFIX PANE) + LCHARLIM + (FGETLD (CDR (OR (\TEDIT.LINES.ABOVE TSTREAM (PANETOPLINE + PANE)) + (RETURN NIL))) + LCHAR1)) + (PANEPREFIX PANE))) + elseif (IGEQ FIRSTCHANGEDCHNO (FGETLD (PANESUFFIX PANE) + LCHAR1)) + then + (* ;; "Change starts below PANE--does it propagate back into PANE?") + + (CL:WHEN (ILESSP (FGETLD (PANEBOTTOMLINE PANE) + LCHARLIM) + (CAR (\TEDIT.PARA.FIRST TEXTOBJ LASTCHANGEDCHNO))) + + (* ;; "The changed paragraph starts before PANE--doesn't impinge") + + (RETURN NIL)) + (SETQ FIRSTCHANGEDLINE (PANEBOTTOMLINE PANE)) + (* ; "LCHAR1 forces the backward scan") + (SETQ FIRSTCHANGEDCHNO (FGETLD FIRSTCHANGEDLINE LCHAR1))) (* ;; "") - (CL:WHEN LASTVALIDLINE - (FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop out the now useless lines") - (RETURN (CONS LASTVALIDLINE NEXTVALIDLINE)))]) + (* ;; "FIRSTCHANGEDLINE is in the pane and is affected.") -(\TEDIT.LASTVALIDLINE - [LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 30-Mar-2025 10:00 by rmk") - (* ; "Edited 18-Feb-2025 12:45 by rmk") - (* ; "Edited 29-Nov-2024 09:14 by rmk") - (* ; "Edited 20-Nov-2024 12:37 by rmk") - (* ; "Edited 18-Nov-2024 23:16 by rmk") - (* ; "Edited 17-Nov-2024 19:08 by rmk") - (* ; "Edited 16-Nov-2024 13:25 by rmk") - (* ; "Edited 28-Oct-2024 16:05 by rmk") - (* ; "Edited 28-Jun-2024 15:22 by rmk") - (* ; "Edited 16-Jun-2024 08:27 by rmk") - (* ; "Edited 13-Jun-2024 22:09 by rmk") - (* ; "Edited 25-May-2024 00:28 by rmk") - (* ; "Edited 23-May-2024 12:47 by rmk") - (* ; "Edited 18-May-2024 10:13 by rmk") - - (* ;; "We hope to return an existing line in PANE that is impervious to the change at FIRSTCHARCHANGECHNO. This would be the impervious line closest to FIRSTCHANGEDLINE, usually the immediately preceding line. That line is valid: it and lines above it do not need reformatting or redisplay. But if PANE does not contain an impervious line, and we are not at the beginning of the document, we have to construct lines above PANE until we get to an impervious line, so that we can format forwards.") - - (* ;; "A line L is impervious to a change in L+1 if it has a forced end, or if L has at least one separator (space, tab) prior to its change point. The change point is FIRSTCHANGEDCHNO for the first line. If we have to go to earlier lines, then any separator anywhere on the line (at or before LCHARLAST) will stop the back-propagation.") - - (if (ILESSP (FGETLD FIRSTCHANGEDLINE LFIRSTSEPR) - FIRSTCHANGEDCHNO) - then (FGETLD FIRSTCHANGEDLINE PREVLINE) - elseif (for L (TOPLINE _ (PANETOPLINE PANE)) backlines (FGETLD FIRSTCHANGEDLINE PREVLINE) - do - (* ;; "Line with a forced end is valid") + (RETURN (if (ILESSP (FGETLD FIRSTCHANGEDLINE LFIRSTSEPR) + FIRSTCHANGEDCHNO) + then (FGETLD FIRSTCHANGEDLINE PREVLINE) + elseif [for L backlines (FGETLD FIRSTCHANGEDLINE PREVLINE) + do + (* ;; "Line with a forced end is valid") - (CL:WHEN (FGETLD L FORCED-END) - (RETURN L)) + (CL:WHEN (FGETLD L FORCED-END) + (RETURN L)) - (* ;; "The prev of a line containing an internal sepr is valid") + (* ;; "The prev of a line containing an internal sepr is valid") - (CL:WHEN (ILESSP (FGETLD L LFIRSTSEPR) - (FGETLD L LCHARLAST)) - (RETURN (FGETLD L PREVLINE))) finally (CL:WHEN (SETQ TOPLINE - (CDR (\TEDIT.LINES.ABOVE - TSTREAM TOPLINE))) - (FSETLD (PANEPREFIX PANE) - LCHARLIM - (FGETLD TOPLINE LCHAR1)) - (LINKLD (PANEPREFIX PANE) - TOPLINE) - (RETURN (PANEPREFIX PANE)))]) + (CL:WHEN (ILESSP (FGETLD L LFIRSTSEPR) + (FGETLD L LCHARLAST)) + (RETURN (FGETLD L PREVLINE)))] + else [\TEDIT.SETPANE.TOPLINE PANE (CDR (\TEDIT.LINES.ABOVE TSTREAM (PANETOPLINE + PANE] + (PANEPREFIX PANE]) (\TEDIT.NEXTVALIDLINE - [LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 21-Jan-2025 15:27 by rmk") + [LAMBDA (LASTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 19-Apr-2025 23:52 by rmk") + (* ; "Edited 18-Apr-2025 12:48 by rmk") + (* ; "Edited 21-Jan-2025 15:27 by rmk") (* ; "Edited 29-Nov-2024 23:31 by rmk") (* ; "Edited 16-Nov-2024 11:00 by rmk") @@ -2748,13 +2783,20 @@ (* ;; "The line after a forced end is valid. But maybe we can figure out how to stop sooner?") - (for L inlines LASTCHANGEDLINE when (FGETLD L FORCED-END) - do - (* ;; "A forced end is usually the last line of a paragraph, and its next line is probably valid. But we skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading to worry about.") + (for L NEXTVALID inlines (find L inlines (PANETOPLINE PANE) suchthat (FWITHINLINEP + LASTCHANGEDCHNO L)) + when (FGETLD L FORCED-END) do + + (* ;; "A forced end is usually the last line of a paragraph, and its next line is probably valid. But we skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading to worry about.") - (CL:WHEN (FGETLD L LSTLN) - (SETQ L (FGETLD L NEXTLINE))) - (RETURN (AND L (FGETLD L NEXTLINE]) + (CL:WHEN (FGETLD L LSTLN) + (SETQ L (FGETLD L NEXTLINE))) + (CL:WHEN L + (SETQ NEXTVALID (FGETLD L NEXTLINE)) + (FSETLD NEXTVALID PREVLINE NIL) + (* ; "Disconnect from above") + ) + (RETURN NEXTVALID]) (\TEDIT.CLEARPANE.BELOW.LINE [LAMBDA (LINE PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 11:27 by rmk") @@ -2885,21 +2927,22 @@ (\TEDIT.LINE.TALLP LINE PHEIGHT))))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (28178 30394 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 28188 . 30392)) (37799 121333 ( -\TEDIT.FORMATLINE 37809 . 73751) (\TEDIT.FORMATLINE.SETUP.PARA 73753 . 78919) ( -\TEDIT.FORMATLINE.HORIZONTAL 78921 . 83494) (\TEDIT.FORMATLINE.VERTICAL 83496 . 85947) ( -\TEDIT.FORMATLINE.JUSTIFY 85949 . 91970) (\TEDIT.FORMATLINE.TABS 91972 . 100000) (\TEDIT.SCALE.TABS -100002 . 100793) (\TEDIT.FORMATLINE.PURGE.SPACES 100795 . 102222) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN -102224 . 103125) (\TEDIT.FORMATLINE.EMPTY 103127 . 108154) (\TEDIT.FORMATLINE.UPDATELOOKS 108156 . -114278) (\TEDIT.FORMATLINE.LASTLEGAL 114280 . 117820) (\TEDIT.LINES.ABOVE 117822 . 121331)) (121450 -123365 (\TLVALIDATE 121460 . 123363)) (123563 145101 (\TEDIT.DISPLAYLINE 123573 . 137213) ( -\TEDIT.DISPLAYLINE.TABS 137215 . 140019) (\TEDIT.LINECACHE 140021 . 140749) (\TEDIT.CREATE.LINECACHE -140751 . 141587) (\TEDIT.BLTCHAR 141589 . 144216) (\TEDIT.DIACRITIC.SHIFT 144218 . 145099)) (145716 -189246 (\TEDIT.BACKFORMAT 145726 . 148280) (\TEDIT.PREVIOUS.LINEBREAK 148282 . 151005) ( -\TEDIT.UPDATE.LINES 151007 . 155755) (\TEDIT.PANE.CREATELINES 155757 . 159008) ( -\TEDIT.SUFFIXLINE.CREATE 159010 . 160516) (\TEDIT.LINES.BELOW 160518 . 164979) (\TEDIT.MEASURED.LINES -164981 . 166881) (\TEDIT.VALID.LINES 166883 . 175396) (\TEDIT.LASTVALIDLINE 175398 . 179261) ( -\TEDIT.NEXTVALIDLINE 179263 . 180693) (\TEDIT.CLEARPANE.BELOW.LINE 180695 . 182801) (\TEDIT.INSERTLINE - 182803 . 184189) (\TEDIT.LINE.BOTTOM 184191 . 187421) (\TEDIT.SHOW.AT.BOTTOMP 187423 . 188533) ( -\TEDIT.SHOW.AT.TOPP 188535 . 189244))))) + (FILEMAP (NIL (27774 29990 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 27784 . 29988)) (37395 121224 ( +\TEDIT.FORMATLINE 37405 . 72783) (\TEDIT.FORMATLINE.SETUP.PARA 72785 . 77951) ( +\TEDIT.FORMATLINE.HORIZONTAL 77953 . 82526) (\TEDIT.FORMATLINE.VERTICAL 82528 . 84979) ( +\TEDIT.FORMATLINE.JUSTIFY 84981 . 91002) (\TEDIT.FORMATLINE.TABS 91004 . 99032) (\TEDIT.SCALE.TABS +99034 . 99825) (\TEDIT.FORMATLINE.PURGE.SPACES 99827 . 101254) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN +101256 . 102333) (\TEDIT.FORMATLINE.EMPTY 102335 . 107155) (\TEDIT.FORMATLINE.UPDATELOOKS 107157 . +113338) (\TEDIT.FORMATLINE.LASTLEGAL 113340 . 116987) (\TEDIT.LINES.ABOVE 116989 . 120600) ( +\TEDIT.CHNO.TO.YTOP 120602 . 121222)) (121341 123256 (\TLVALIDATE 121351 . 123254)) (123454 143862 ( +\TEDIT.DISPLAYLINE 123464 . 135974) (\TEDIT.DISPLAYLINE.TABS 135976 . 138780) (\TEDIT.LINECACHE 138782 + . 139510) (\TEDIT.CREATE.LINECACHE 139512 . 140348) (\TEDIT.BLTCHAR 140350 . 142977) ( +\TEDIT.DIACRITIC.SHIFT 142979 . 143860)) (144477 189977 (\TEDIT.BACKFORMAT 144487 . 147041) ( +\TEDIT.PREVIOUS.LINEBREAK 147043 . 149846) (\TEDIT.UPDATE.LINES 149848 . 155563) ( +\TEDIT.PANE.CREATELINES 155565 . 159016) (\TEDIT.SUFFIXLINE.CREATE 159018 . 160633) ( +\TEDIT.LINES.BELOW 160635 . 165245) (\TEDIT.MEASURED.LINES 165247 . 167256) (\TEDIT.VALID.LASTCHNOS +167258 . 171034) (\TEDIT.VALID.NEXTCHNOS 171036 . 174510) (\TEDIT.LASTVALIDLINE 174512 . 179183) ( +\TEDIT.NEXTVALIDLINE 179185 . 181424) (\TEDIT.CLEARPANE.BELOW.LINE 181426 . 183532) (\TEDIT.INSERTLINE + 183534 . 184920) (\TEDIT.LINE.BOTTOM 184922 . 188152) (\TEDIT.SHOW.AT.BOTTOMP 188154 . 189264) ( +\TEDIT.SHOW.AT.TOPP 189266 . 189975))))) STOP diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM index 92f637434..70a11e0e0 100644 Binary files a/library/tedit/TEDIT-SCREEN.LCOM and b/library/tedit/TEDIT-SCREEN.LCOM differ diff --git a/library/tedit/TEDIT-SELECTION b/library/tedit/TEDIT-SELECTION index c7f1e5592..052d11aef 100644 --- a/library/tedit/TEDIT-SELECTION +++ b/library/tedit/TEDIT-SELECTION @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Mar-2025 16:27:02" {WMEDLEY}tedit>TEDIT-SELECTION.;674 154655 +(FILECREATED "24-Apr-2025 16:05:22" {WMEDLEY}TEDIT>TEDIT-SELECTION.;719 158243 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.SELPIECES.COPY \TEDIT.SELPIECES \TEDIT.RESET.EXTEND.PENDING.DELETE) - (I.S.OPRS inselpieces) + :CHANGES-TO (FNS \TEDIT.SELPIECES.CHARTRANSFORM) - :PREVIOUS-DATE "16-Mar-2025 10:06:15" {WMEDLEY}tedit>TEDIT-SELECTION.;665) + :PREVIOUS-DATE "22-Apr-2025 08:26:07" {WMEDLEY}TEDIT>TEDIT-SELECTION.;718) (PRETTYCOMPRINT TEDIT-SELECTIONCOMS) @@ -40,8 +39,9 @@ \TEDIT.REGIONTYPE \TEDIT.XYTOSEL.INLINEP \TEDIT.XYTOSEL.LINE) (FNS \TEDIT.FIXSEL \TEDIT.CHTOLINEX) (FNS \TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS) - (FNS \TEDIT.SHOWSEL \TEDIT.SHOWSEL.HILIGHT \TEDIT.UPDATE.SEL \TEDIT.CARETLINE - \TEDIT.SEL.L1 \TEDIT.SEL.LN \TEDIT.SEL.DELETEDCHARS) + (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS \TEDIT.NOSEL))) + (FNS \TEDIT.SHOWSEL \TEDIT.NOSEL \TEDIT.SHOWSEL.HILIGHT \TEDIT.UPDATE.SEL + \TEDIT.CARETLINE \TEDIT.SEL.L1 \TEDIT.SEL.LN \TEDIT.SEL.DELETEDCHARS) (FNS \TEDIT.COPYSEL \TEDIT.SEL.CHANGED?)) (COMS (* ; "Image objects") (FNS \TEDIT.SELECT.OBJECT \TEDIT.SHOWSEL.OBJECT \TEDIT.CLIP.OBJECT @@ -198,7 +198,7 @@ (ILEQ (FGETLD L LCHAR1) CHLAST)))) -(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) +(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (* ; "within the closed interval") (AND (IGEQ X LOW) (ILEQ X HIGH)))) ) @@ -368,7 +368,8 @@ (DEFINEQ (\TEDIT.SELECTED.PIECES - [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 26-Nov-2024 10:54 by rmk") + [LAMBDA (TSTREAM SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 21-Apr-2025 22:45 by rmk") + (* ; "Edited 26-Nov-2024 10:54 by rmk") (* ; "Edited 15-Mar-2024 14:15 by rmk") (* ; "Edited 28-Nov-2023 23:14 by rmk") (* ; "Edited 21-Jun-2023 20:30 by rmk") @@ -381,14 +382,14 @@ (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result instead of the piece") (NOTUSED) - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (LET ((SELPIECES (\TEDIT.SELPIECES (OR SEL (TEXTSEL TEXTOBJ)) - NIL TEXTOBJ))) - (for PC inselpieces (CL:IF CROSSCOPY - (\TEDIT.SELPIECES.COPY SELPIECES 'COPY TEXTOBJ) - SELPIECES) collect (CL:IF PIECEMAPFN - (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 FNARG2) - PC)]) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (SELPIECES (\TEDIT.SELPIECES (OR SEL (TEXTSEL TEXTOBJ)) + NIL TEXTOBJ))) + (for PC inselpieces (CL:IF CROSSCOPY + (\TEDIT.SELPIECES.COPY SELPIECES 'COPY TSTREAM) + SELPIECES) collect (CL:IF PIECEMAPFN + (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 FNARG2) + PC)]) (\TEDIT.FIND.PROTECTED.END [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 9-Jul-2024 18:19 by rmk") @@ -470,7 +471,8 @@ (DEFINEQ (\TEDIT.EXTEND.SEL - [LAMBDA (NEWSEL CURSEL TEXTOBJ EVENIFPROTECTED) (* ; "Edited 11-Sep-2024 23:44 by rmk") + [LAMBDA (NEWSEL CURSEL TSTREAM EVENIFPROTECTED) (* ; "Edited 21-Apr-2025 20:10 by rmk") + (* ; "Edited 11-Sep-2024 23:44 by rmk") (* ; "Edited 9-Sep-2024 09:28 by rmk") (* ; "Edited 28-Aug-2024 09:49 by rmk") (* ; "Edited 22-Aug-2024 16:06 by rmk") @@ -495,7 +497,8 @@ (CL:WHEN (AND (FGETSEL NEWSEL SET) (FGETSEL CURSEL SET)) - (LET ((CCH# (FGETSEL CURSEL CH#)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (CCH# (FGETSEL CURSEL CH#)) (CCHLIM (FGETSEL CURSEL CHLIM)) (NCH# (FGETSEL NEWSEL CH#)) (NCHLIM (FGETSEL NEWSEL CHLIM)) @@ -563,14 +566,19 @@ (* ;; "NEWSEL now describes the difference between the highlighting of the original CURSEL to the highlighting of the extended CURSEL, either putting up new highlighting or taking down old highlighting. ") - (\TEDIT.FIXSEL NEWSEL TEXTOBJ) + (\TEDIT.FIXSEL NEWSEL TSTREAM) (\TEDIT.SHOWSEL NEWSEL (NOT (FGETSEL NEWSEL ONFLG)) - TEXTOBJ) + TSTREAM) (FSETSEL NEWSEL ONFLG NIL) (* ; "Restore its generally off state.") - (\TEDIT.FIXSEL CURSEL TEXTOBJ)))]) + (\TEDIT.FIXSEL CURSEL TSTREAM)))]) (\TEDIT.SCAN.LINE - [LAMBDA (LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON WORDSELFLG) + [LAMBDA (LINE X NEWSEL SELOPERATION TSTREAM BUTTON WORDSELFLG) + (* ; "Edited 21-Apr-2025 12:11 by rmk") + (* ; "Edited 13-Apr-2025 15:17 by rmk") + (* ; "Edited 11-Apr-2025 22:38 by rmk") + (* ; "Edited 10-Apr-2025 21:08 by rmk") + (* ; "Edited 5-Apr-2025 17:29 by rmk") (* ; "Edited 18-Feb-2025 22:04 by rmk") (* ; "Edited 14-Feb-2025 09:47 by rmk") (* ; "Edited 3-Feb-2025 09:31 by rmk") @@ -591,17 +599,26 @@ (* ;; "") + (* ;; "") + + (* ;; "Newer implementation (April 2025) aims for a point selection (DCH=0) between characters , at least for NORMAL operations. Thus, X0 and XLIM specify the intended caret position, to the right of the selected character if pointing to its right half, to the left if pointing to its left half.") + + (* ;; "Then, If the mouse is not pointing to or beyond the last character on the line, CH# is the character AFTER the intended caret position, CHLIM is CH#, and POINT is LEFT.") + + (* ;; "If pointing at or beyond the last line character, CH# is the last character, CHLIM is (ADD1 CH#), and POINT is RIGHT. We don't have to worry here about TEXTLEN--it's covered by LCHARLIM.") + (* ;; "Earlier versions had more complexity because it not ony figured out the character pointed at but also %"fixed%" the selection on the fly to avoid the more generic \TEDIT.FIXLINE.The generic fixline would scan through the lines of a tall window to find the line containing the selected CH#, and then apply \TEDIT.CHTOX to scan its (presumably cached) THISLINE to set up the X0 and XLIM. But not a noticeable delay for user interaction--not worth the complexity.") (LINEDESCRIPTOR! LINE) - (TEXTOBJ! TEXTOBJ) (SELECTION! NEWSEL) - (FSETSEL NEWSEL SET NIL) - (PROG (CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED) + (FSETSEL NEWSEL SELKIND 'CHAR) (* ; + " The caller's HOW and HOWHEIGHT fields are preserved") + (PROG (CHARSLOT CLOOKS CHNO X0 XLIM DCH SELCHAR PASTRIGHT THISLINE (TEXTOBJ (FTEXTOBJ TSTREAM)) + RIGHTHALF) (SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE)) (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) (* ;  "Make sure the cache describes this line") - (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + (SETQ LINE (\TEDIT.FORMATLINE TSTREAM (FGETLD LINE LCHAR1) LINE))) (* ;  "Convert X's display units to LINE's scale") (SETQ XLIM (FGETLD LINE LX1)) (* ; @@ -620,15 +637,17 @@  (FGETLD LINE LXLIM)) 30)  (RETURN NIL))) (SETQ X (SUB1 (FGETLD LINE LXLIM)))) - [SETQ CHARSLOT (for CS incharslots THISLINE - do (if CHAR - then (add XLIM CHARW) (* ; "Start of the next character ") - (CL:WHEN (IGEQ XLIM X) - (RETURN CS)) - (add CHNO 1) - else (SETQ CLOOKS CHARW] (* ; "The running CHARLOOKS") + (SETQ CHARSLOT (for CS incharslots THISLINE do (add XLIM CHARW) + (* ; "Start of the next character ") + (CL:WHEN (IGEQ XLIM X) + (RETURN CS)) + (add CHNO 1))) + (* ; "The running CHARLOOKS") (CL:UNLESS CHARSLOT (* ; "Guardrail") (RETURN)) + [SETQ RIGHTHALF (OR PASTRIGHT (IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT) + 2] + (SETQ CLOOKS (CHARCL CHARSLOT)) (CL:WHEN (FGETCLOOKS CLOOKS CLPROTECTED) (* ;; "Extensions can't run through protected characters, and they can't be deleted.") @@ -640,91 +659,71 @@ (* ;; "Otherwise, if either CLSELAFTER or CLSELBEFORE, we move CHARSLOT, CHNO, XLIM,CLOOKS to the closest unprotected one. ") [SETQ CHARSLOT (if (FGETCLOOKS CLOOKS CLSELAFTER) - then (SETQ MOVED 'FORWARD) - (for CS incharslots (NEXTCHARSLOT CHARSLOT) - do (if CHAR - then (add XLIM CHARW) - (add CHNO 1) - (CL:UNLESS (FGETCLOOKS CLOOKS CLSELAFTER) - (RETURN CS)) - else (SETQ CLOOKS CHARW))) + then (SETQ RIGHTHALF NIL) + (find CS incharslots (NEXTCHARSLOT CHARSLOT) + suchthat (add XLIM CHARW) + (add CHNO 1) + (NOT (FGETCLOOKS CHARCL CLSELAFTER))) elseif (FGETCLOOKS CLOOKS CLSELBEFORE) then - (* ;; "We back up through the charlooks keeping track of the next previous CLSELBEFORE (BEFORESLOT) while we look for the first one that is not CLSELBEFORE. When we find that one, we know that the PREVSLOT of BEFORESLOT is the one we want.") - - (SETQ MOVED 'BACKWARD) - (for CS (BEFORECHNO _ CHNO) - (BEFOREX _ XLIM) - (BEFORELOOKSLOT _ CHARSLOT) backcharslots (PREVCHARSLOT - CHARSLOT) - do (if CHAR - then (add XLIM (IMINUS CHARW)) - (add CHNO -1) - elseif (FGETCLOOKS CHARW CLSELBEFORE) - then (SETQ BEFORECHNO CHNO) - (SETQ BEFORELOOKSLOT CS) - (SETQ BEFOREX XLIM) - elseif BEFORELOOKSLOT - then (SETQ XLIM BEFOREX) - (SETQ CHNO BEFORECHNO) - (RETURN (PREVCHARSLOT BEFORELOOKSLOT]) - (CL:UNLESS CHARSLOT (* ; "Everything was protected.") - (RETURN)) + (* ;; "We back up through the charslots looking for the first one that is not CLSELBEFORE. When we find that one, we know that the PREVSLOT of BEFORESLOT is the one we want.") + + (SETQ RIGHTHALF T) + (for CS backcharslots (PREVCHARSLOT CHARSLOT) + do (add XLIM (IMINUS CHARW)) + (add CHNO -1) + (CL:UNLESS (FGETCLOOKS CHARCL CLSELBEFORE) + (RETURN (NEXTCHARSLOT CHARSLOT)))] + (CL:UNLESS CHARSLOT (* ; "Everything was protected.") + (RETURN)) + (SETQ CLOOKS (CHARCL CHARSLOT))) (* ;; "CHNO and CHARSLOT: the character pointed to, X0 is the beginning of CHNO, XLIM the point after CHNO.") (SETQ SELCHAR (CHAR CHARSLOT)) - (* ;; "NOTE: This preserves the HOW and HOWHEIGHT fields as set by the caller") - - (FSETSEL NEWSEL SELKIND 'CHAR) - (FSETSEL NEWSEL X0 (IDIFFERENCE XLIM (CHARW CHARSLOT))) - (* ; - "Setting X0 suppresses an extra scan in FIXSEL") - (FSETSEL NEWSEL XLIM XLIM) - (FSETSEL NEWSEL CH# CHNO) - (FSETSEL NEWSEL SELOBJ NIL) - (* ;; "DCH=0 makes it a point selection, 1 picks out a single char. Original code produced 0 only for protected text and dummy lines. For copy/delete selections, it's more convenient still to select at least one character, at least until modern one-button swiping is implemented. ") (* ;; "If we end up in a protected piece, we want DCH=0. We then want to flash the caret iff we moved forward or backward") [if (FGETCLOOKS CLOOKS CLPROTECTED) - then (FSETSEL NEWSEL DCH 0) (* ; "Protected: nothing shows") - [FSETSEL NEWSEL HASCARET (AND MOVED (EQ SELOPERATION 'NORMAL] - else (FSETSEL NEWSEL DCH (if (EQ 0 (TEXTLEN TEXTOBJ)) - then 0 - elseif (OR WORDSELFLG (NEQ SELOPERATION 'NORMAL) - (FGETTOBJ TEXTOBJ TXTREADONLY) - (type? IMAGEOBJ SELCHAR)) - then 1 - else 0 (* ; - "0 = point selection, character not underlined. But extension is confusing") - 1)) + then (SETQ DCH 0) (* ; "Protected: nothing shows") + (FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL)) + else (SETQ DCH (if (EQ 0 (TEXTLEN TEXTOBJ)) + then 0 + elseif (OR WORDSELFLG (NEQ SELOPERATION 'NORMAL) + (FGETTOBJ TEXTOBJ TXTREADONLY) + (type? IMAGEOBJ SELCHAR)) + then 1 + else + (* ;; "0 = point selection, character not underlined, good for changing caret looks. But if extension is confusing, use 1") + + 0 1)) (FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL] - (FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#) - (FGETSEL NEWSEL DCH))) - (FSETSEL NEWSEL POINT (if (EQ (CHARCODE EOL) - (CHAR CHARSLOT)) + (FSETSEL NEWSEL POINT (if (AND (EQ CHNO (FGETLD LINE LCHARLAST)) + (FGETLD LINE FORCED-END)) then (* ;;  "Always go to the left of an EOL, so caret stays on its line") 'LEFT - elseif [OR PASTRIGHT (EQ MOVED 'BACKWARD) - (AND (IGEQ (CHARW CHARSLOT) - 3) - (IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT) - 2] - then - (* ;; - "Beyond the line, or towards the end of a character that is at least 3 points wide.") + elseif RIGHTHALF + then 'RIGHT + else 'LEFT)) + + (* ;; " X0 and XLIM are used in word selection, also make it unecessary for subsequenct FIXSEL.") - 'RIGHT - else 'LEFT)) (* ; - "Don't recognize an object that wasn't directly pointed at") - (FSETSEL NEWSEL SELOBJ (CL:UNLESS PASTRIGHT (IMAGEOBJP SELCHAR))) + [FSETSEL NEWSEL X0 (CL:IF (EQ DCH 0) + XLIM + (IDIFFERENCE XLIM (CHARW CHARSLOT)))] + (FSETSEL NEWSEL XLIM XLIM) + (FSETSEL NEWSEL CH# CHNO) + (FSETSEL NEWSEL DCH DCH) + (FSETSEL NEWSEL CHLIM (IPLUS DCH (FGETSEL NEWSEL CH#))) + (FSETSEL NEWSEL SELOBJ (CL:UNLESS PASTRIGHT (* ; "Must directly point to the object") + (IMAGEOBJP SELCHAR))) + (FSETSEL NEWSEL SELKIND 'CHAR) (FSETSEL NEWSEL SET T) (* ;; "Single-char selection is good") @@ -738,13 +737,14 @@ (CL:UNLESS (OR (FGETSEL NEWSEL SELOBJ) (FGETLD LINE LDUMMY) (FGETCLOOKS CLOOKS CLPROTECTED)) - (\TEDIT.SCAN.LINE.WORD X TEXTOBJ THISLINE NEWSEL CHARSLOT CLOOKS))) + (\TEDIT.SCAN.LINE.WORD X TEXTOBJ THISLINE NEWSEL CHARSLOT))) (* ;  "We now have a complete char/caret selection") (RETURN NEWSEL]) (\TEDIT.SCAN.LINE.WORD - [LAMBDA (X TEXTOBJ THISLINE NEWSEL CHARSLOT SELLOOKS) (* ; "Edited 7-Nov-2024 21:50 by rmk") + [LAMBDA (X TEXTOBJ THISLINE NEWSEL CHARSLOT) (* ; "Edited 11-Apr-2025 22:35 by rmk") + (* ; "Edited 7-Nov-2024 21:50 by rmk") (* ; "Edited 4-Oct-2024 08:39 by rmk") (* ; "Edited 28-Aug-2024 10:22 by rmk") (* ; "Edited 3-Aug-2024 12:41 by rmk") @@ -780,42 +780,22 @@ (* ;; "XLIM will become the X at the end of last char") (* ; "") - (for CSLOT (CLOOKS _ SELLOOKS) - (LASTCHAR _ (CHAR CHARSLOT)) backcharslots (PREVCHARSLOT CHARSLOT) - do (CL:UNLESS CHAR - - (* ;; "CLOOKS is the looks AFTER the preceding char. We have to go back further to see if the current char is protected.") - - (SETQ CLOOKS CHARW) - (GO $$ITERATE)) - (CL:WHEN (OR (type? IMAGEOBJ CHAR) - (\TEDIT.WORD.BOUND TEXTOBJ CHAR LASTCHAR) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - (* ; "Stop at a protection bounary") - (RETURN)) - (SETQ LASTCHAR CHAR) - (ADD X0 (IMINUS CHARW)) - (ADD CH# -1)) - - (* ;; "And search forward for the end of the word") - - (for CSLOT (CLOOKS _ SELLOOKS) - (PREVCHAR _ (CHAR CHARSLOT)) incharslots (NEXTCHARSLOT CHARSLOT) - do (CL:UNLESS CHAR - (SETQ CLOOKS CHARW) - (GO $$ITERATE)) - (CL:WHEN (OR (type? IMAGEOBJ CHAR) - (\TEDIT.WORD.BOUND TEXTOBJ PREVCHAR CHAR) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - - (* ;; "XLIM is now the end of the last character of the word.") - - (* ;; "CHLIM and XLIM should be OK if we run off the end.") - - (RETURN)) - (add XLIM CHARW) - (add CHLIM 1) - (SETQ PREVCHAR CHAR)) + (for CSLOT (LASTCHAR _ (CHAR CHARSLOT)) backcharslots (PREVCHARSLOT CHARSLOT) + until (OR (type? IMAGEOBJ CHAR) + (\TEDIT.WORD.BOUND TEXTOBJ CHAR LASTCHAR) + (FGETCLOOKS CHARCL CLPROTECTED)) do (* ; "Stop at a protection bounary") + (ADD X0 (IMINUS CHARW)) + (ADD CH# -1) + (SETQ LASTCHAR CHAR)) + + (* ;; "And search forward for the end of the word: XLIM is the end of the last character, CHLIM is one beyond") + + (for CSLOT (PREVCHAR _ (CHAR CHARSLOT)) incharslots (NEXTCHARSLOT CHARSLOT) + until (OR (type? IMAGEOBJ CHAR) + (\TEDIT.WORD.BOUND TEXTOBJ PREVCHAR CHAR) + (FGETCLOOKS CHARCL CLPROTECTED)) do (add XLIM CHARW) + (add CHLIM 1) + (SETQ PREVCHAR CHAR)) (FSETSEL NEWSEL SELKIND 'WORD) (FSETSEL NEWSEL CH# CH#) (FSETSEL NEWSEL CHLIM CHLIM) @@ -825,7 +805,8 @@ (* ;; "Move the point to the intended side of the word: To the right of an otherwise-protected insertion, past the middle of a selection that is wide enough to discriminate, and not at the end of an EOL-terminated line. 3 is points.") - (FSETSEL NEWSEL POINT (if [OR (fetch (CHARLOOKS CLSELAFTER) of SELLOOKS) + (FSETSEL NEWSEL POINT (if [OR (FGETCLOOKS (CHARCL CHARSLOT) + CLSELAFTER) (AND (IGEQ (IDIFFERENCE XLIM X0) 3) (IGEQ X (FOLDLO (IPLUS XLIM X0) @@ -834,7 +815,9 @@ else 'LEFT]) (\TEDIT.XYTOSEL - [LAMBDA (X Y NEWSEL TEXTOBJ SELOPERATION PANE BUTTON CURSEL REGIONTYPE) + [LAMBDA (X Y NEWSEL TSTREAM SELOPERATION PANE BUTTON CURSEL REGIONTYPE) + (* ; "Edited 21-Apr-2025 20:33 by rmk") + (* ; "Edited 6-Apr-2025 18:57 by rmk") (* ; "Edited 13-Feb-2025 11:03 by rmk") (* ; "Edited 17-Dec-2024 10:10 by rmk") (* ; "Edited 6-Dec-2024 12:00 by rmk") @@ -855,9 +838,9 @@ (* ;; "CURSEL is used to decide whether extensions go to words or paragraphs (and to turn off highlighting for objects).") (SELECTION! NEWSEL) - (TEXTOBJ! TEXTOBJ) (FSETSEL NEWSEL SET NIL) - (PROG (LINE PARAFIRSTCHNO PARALASTCHNO SELFN) + (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) + LINE PARAFIRSTCHNO PARALASTCHNO SELFN) (CL:UNLESS (SETQ LINE (\TEDIT.XYTOSEL.LINE X Y PANE TEXTOBJ)) (RETURN)) (SELECTQ (\TEDIT.REGIONTYPE BUTTON CURSEL TEXTOBJ REGIONTYPE) @@ -872,7 +855,7 @@  "Y is below the last line of the text: force selection past the very end of that line.") (SETQ X (ADD1 (GETLD LINE LXLIM)))) - (CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X NEWSEL SELOPERATION TEXTOBJ BUTTON + (CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X NEWSEL SELOPERATION TSTREAM BUTTON (SELECTQ BUTTON (RIGHT (MEMB (FGETSEL CURSEL SELKIND) '(WORD PARA))) @@ -883,8 +866,8 @@ (* ;; "Run the buttonin function with CURSEL's highlighting turned off--its highlighting may be somewhere else ") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) - (\TEDIT.SELECT.OBJECT TEXTOBJ NEWSEL LINE X Y PANE SELOPERATION BUTTON))) + (\TEDIT.NOSEL TSTREAM CURSEL) + (\TEDIT.SELECT.OBJECT TSTREAM NEWSEL LINE X Y PANE SELOPERATION BUTTON))) (LINE (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) (* ;; "Except for fields, menus are completely protected. Confusing to deal with a field that spreads across several lines, so essentially disable the line region") @@ -941,7 +924,7 @@ (FSETSEL NEWSEL SET NIL) (RETURN)) (FSETSEL NEWSEL ONFLG NIL) (* ; "New selection not yet displayed") - (\TEDIT.FIXSEL NEWSEL TEXTOBJ) + (\TEDIT.FIXSEL NEWSEL TSTREAM) (RETURN NEWSEL]) (\TEDIT.REGIONTYPE @@ -1001,29 +984,20 @@ (DEFINEQ (\TEDIT.FIXSEL - [LAMBDA (SEL TEXTOBJ AVOIDPANE ONLYPANE) (* ; "Edited 1-Dec-2024 11:28 by rmk") - (* ; "Edited 28-Nov-2024 14:30 by rmk") - (* ; "Edited 25-Nov-2024 12:57 by rmk") - (* ; "Edited 19-Nov-2024 15:52 by rmk") - (* ; "Edited 17-Nov-2024 15:58 by rmk") + [LAMBDA (SEL TSTREAM ONLYPANE) (* ; "Edited 21-Apr-2025 20:12 by rmk") + (* ; "Edited 10-Apr-2025 21:19 by rmk") + (* ; "Edited 5-Apr-2025 11:33 by rmk") + (* ; "Edited 1-Dec-2024 11:28 by rmk") (* ; "Edited 3-Oct-2024 18:47 by rmk") (* ; "Edited 9-Sep-2024 09:26 by rmk") - (* ; "Edited 3-Sep-2024 13:16 by rmk") (* ; "Edited 6-Jul-2024 22:36 by rmk") - (* ; "Edited 4-Jul-2024 15:45 by rmk") (* ; "Edited 28-Jun-2024 21:50 by rmk") - (* ; "Edited 24-Jun-2024 23:57 by rmk") - (* ; "Edited 16-Jun-2024 22:02 by rmk") (* ; "Edited 21-May-2024 09:01 by rmk") - (* ; "Edited 29-Apr-2024 12:56 by rmk") - (* ; "Edited 26-Apr-2024 00:23 by rmk") (* ; "Edited 20-Mar-2024 10:55 by rmk") - (* ; "Edited 2-Mar-2024 23:38 by rmk") (* ; "Edited 16-Dec-2023 11:44 by rmk") (* ; "Edited 3-Nov-2023 12:01 by rmk") (* ; "Edited 28-Jul-2023 15:58 by rmk") (* ; "Edited 22-Jun-2023 16:05 by rmk") - (* ; "Edited 6-Jun-2023 13:26 by rmk") (* ; "Edited 1-Jun-2023 17:41 by rmk") (* ; "Edited 31-May-91 12:26 by jds") @@ -1039,8 +1013,6 @@ (* ;; "") - (* ;; "AVOIDPANE is provided for a pane that may be skipped, e.g. the current selection pane. Its properties are already known, no point in doing extra work.") - (* ;; "ONLYPANE is specified in scrolling. to avoid disturbing and redisplaying panes that are not being scrolled.") (* ;; "") @@ -1060,80 +1032,86 @@ (* ;;  "If TXTDON'TUPDATE, the lines may not correspond to anything reasonable, don't try to find X.") - (CL:UNLESS (type? TEXTOBJ TEXTOBJ) - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (SELECTION! SEL) - (CL:WHEN (AND (FGETTOBJ TEXTOBJ PRIMARYPANE) - (FGETSEL SEL SET) - (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE))) - - (* ;; "CH# is the first selected character, CHLIM is the character just after the last one, hence the SUB1. ") - - (* ;; "For a point selection, CHLIM=(ADD1 CH#) so CHNO=LASTCHNO, and the caret position is determined by POINT. Highlighting is determined separately by DCH, which is 0 for point selections.") - - (for PANE PSTARTLINE PENDLINE X0 XLIM (FIRSTCHNO _ (IMAX 1 (FGETSEL SEL CH#))) - [LASTCHNO _ (IMAX 1 (SUB1 (FGETSEL SEL CHLIM] inpanes TEXTOBJ as L1 - on (FGETSEL SEL L1) as LN on (FGETSEL SEL LN) unless (EQ PANE AVOIDPANE) - when (OR (NULL ONLYPANE) - (EQ PANE ONLYPANE)) when (SETQ PSTARTLINE (find L inlines (PANETOPLINE PANE) - first (RPLACA L1 NIL) - (RPLACA LN NIL) - suchthat - - (* ;; + [LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (SELECTION! SEL) + (CL:WHEN (AND (FGETTOBJ TEXTOBJ PRIMARYPANE) + (FGETSEL SEL SET) + (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE))) + + (* ;; "CH# is the first selected character, CHLIM is the character just after the last one, hence the SUB1. ") + + (* ;; "For a point selection, CHLIM=(ADD1 CH#) so CHNO=LASTCHNO, and the caret position is determined by POINT. Highlighting is determined separately by DCH, which is 0 for point selections.") + + (for PANE PSTARTLINE PENDLINE X0 XLIM (FIRSTCHNO _ (IMAX 1 (FGETSEL SEL CH#))) + [LASTCHNO _ (IMAX 1 (SUB1 (FGETSEL SEL CHLIM] inpanes TEXTOBJ as L1 + on (FGETSEL SEL L1) as LN on (FGETSEL SEL LN) when (OR (NULL ONLYPANE) + (EQ PANE ONLYPANE)) + when (SETQ PSTARTLINE (find L inlines (PANETOPLINE PANE) + first (RPLACA L1 NIL) + (RPLACA LN NIL) suchthat + + (* ;;  "The first visible line in PANE that SEL selects. ") - (FLINESELECTEDP L FIRSTCHNO - LASTCHNO))) - do - (* ;; "For highlighting, if the PSTARTLINE for PANE is also the first line of the selection, then update the selection's X0. Similarly for XLIM and PENDLINE. For interior lines, SHOWSEL.HILIGHT uses their LX1 and LXLIM values. ") + (FLINESELECTEDP L FIRSTCHNO + LASTCHNO))) + do + (* ;; "For highlighting, if the PSTARTLINE for PANE is also the first line of the selection, then update the selection's X0. Similarly for XLIM and PENDLINE. For interior lines, SHOWSEL.HILIGHT uses their LX1 and LXLIM values. ") - (* ;; + (* ;;  "IMAX to use the first character of PSTARTLINE if it is not the first line of the selection ") - (CL:UNLESS X0 (* ; + (CL:UNLESS X0 (* ;  "May have been computed for a prior pane") - (CL:WHEN (FWITHINLINEP FIRSTCHNO PSTARTLINE) - [SETQ X0 (\TEDIT.CHTOLINEX TEXTOBJ PSTARTLINE (IMAX FIRSTCHNO (FGETLD - PSTARTLINE - LCHAR1)) - (AND (IGREATERP FIRSTCHNO (TEXTLEN TEXTOBJ)) - (GETLD (FGETLD PSTARTLINE PREVLINE) - FORCED-END] - (FSETSEL SEL X0 X0))) - [SETQ PENDLINE (for L (PBOTTOM _ (PANEBOTTOM PANE)) inlines PSTARTLINE - do - (* ;; "Stop when L is beyond the selection or below the screen. ") - - (CL:WHEN (ILESSP LASTCHNO (FGETLD L LCHARLIM)) - (RETURN L)) - (CL:WHEN (ILEQ (FGETLD L YBOT) - PBOTTOM) (* ; + (CL:WHEN (FWITHINLINEP FIRSTCHNO PSTARTLINE) + [SETQ X0 (\TEDIT.CHTOLINEX TSTREAM PSTARTLINE (IMAX FIRSTCHNO + (FGETLD PSTARTLINE + LCHAR1)) + (CL:IF (EQ 0 (FGETSEL SEL DCH)) + (EQ 'RIGHT (FGETSEL SEL POINT)) + (AND (IGREATERP FIRSTCHNO (TEXTLEN TEXTOBJ)) + (FGETLD (FGETLD PSTARTLINE PREVLINE) + FORCED-END)))] + (FSETSEL SEL X0 X0))) + [SETQ PENDLINE (for L (PBOTTOM _ (PANEBOTTOM PANE)) inlines PSTARTLINE + do + (* ;; + "Stop when L is beyond the selection or below the screen. ") + + (CL:WHEN (ILESSP LASTCHNO (FGETLD L LCHARLIM)) + (RETURN L)) + (CL:WHEN (ILEQ (FGETLD L YBOT) + PBOTTOM) + (* ;  "This can happen if LASTCHAR is not visible on the screen") - (RETURN $$PREVLINE)) finally + (RETURN $$PREVLINE)) finally (* ;;  "If $$PREVLINE is NIL, we didn't advance--so we must have ended at the start") - (RETURN (OR $$PREVLINE PSTARTLINE] - (CL:UNLESS PENDLINE (* ; + (RETURN (OR $$PREVLINE + PSTARTLINE] + (CL:UNLESS PENDLINE (* ;  "Start could be the last line in the window, it ends there too.") - (SETQ PENDLINE PSTARTLINE)) - (CL:UNLESS XLIM - (CL:WHEN (FWITHINLINEP LASTCHNO PENDLINE) - (SETQ XLIM (\TEDIT.CHTOLINEX TEXTOBJ PENDLINE LASTCHNO T)) - (FSETSEL SEL XLIM XLIM))) - - (* ;; "Fill in the selected lines that are visible in this pane") - - (RPLACA L1 PSTARTLINE) - (RPLACA LN PENDLINE))) + (SETQ PENDLINE PSTARTLINE)) + (CL:UNLESS XLIM + (CL:WHEN (FWITHINLINEP LASTCHNO PENDLINE) + (SETQ XLIM (CL:IF (EQ 0 (FGETSEL SEL DCH)) + X0 + (\TEDIT.CHTOLINEX TSTREAM PENDLINE LASTCHNO T))) + (FSETSEL SEL XLIM XLIM))) + + (* ;; "Fill in the selected lines that are visible in this pane") + + (RPLACA L1 PSTARTLINE) + (RPLACA LN PENDLINE)))] SEL]) (\TEDIT.CHTOLINEX - [LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 6-Mar-2025 11:57 by rmk") + [LAMBDA (TSTREAM LINE CH# AFTER) (* ; "Edited 20-Apr-2025 23:47 by rmk") + (* ; "Edited 6-Mar-2025 11:57 by rmk") (* ; "Edited 28-Nov-2024 14:41 by rmk") (* ; "Edited 17-Nov-2024 15:58 by rmk") (* ; "Edited 13-Jun-2024 17:12 by rmk") @@ -1150,61 +1128,63 @@ (* ;; "it is an error if CH# is before LCHAR1 or after LCHARLIM.") - (\DTEST LINE 'LINEDESCRIPTOR) - (LET (X (THISLINE (GETTOBJ TEXTOBJ THISLINE))) - (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) + (LINEDESCRIPTOR! LINE) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (THISLINE (GETTOBJ TEXTOBJ THISLINE)) + X) + (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) - (* ;; "Reformat if LINE is not cached in THISLINE. ") + (* ;; "Reformat if LINE is not cached in THISLINE. ") - (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) - (FGETLD LINE LCHAR1) - LINE)) + (\TEDIT.FORMATLINE TSTREAM (FGETLD LINE LCHAR1) + LINE)) - (* ;; "Can avoid another loop if we are asking about the first or last characters.") + (* ;; "Can avoid another loop if we are asking about the first or last characters.") - (if (AND AFTER (IEQP CH# (FGETLD LINE LCHARLAST))) - then (FGETLD LINE LXLIM) - elseif (AND (NOT AFTER) - (IEQP CH# (FGETLD LINE LCHAR1))) - then (FGETLD LINE LX1) - else (for CHARSLOT (X _ (FGETLD LINE LX1)) - (CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE - eachtime (CL:WHEN (AND CHAR (DIACRITICP CHAR)) + (if (AND AFTER (IEQP CH# (FGETLD LINE LCHARLAST))) + then (FGETLD LINE LXLIM) + elseif (AND (NOT AFTER) + (IEQP CH# (FGETLD LINE LCHAR1))) + then (FGETLD LINE LX1) + else (for CHARSLOT (X _ (FGETLD LINE LX1)) + (CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE + eachtime (CL:WHEN (AND CHAR (DIACRITICP CHAR)) - (* ;; "If the diacritic CHARW is greater than the CHARW of the next slot, we should set the diacritic CHARW to (IDIFFERENCE CHARW (NEXT CHARW)). ") + (* ;; "If the diacritic CHARW is greater than the CHARW of the next slot, we should set the diacritic CHARW to (IDIFFERENCE CHARW (NEXT CHARW)). ") - (* ;; "i.e. (IMAX 0 (IDIFFERENCE CHARW (NEXT CHARW))") + (* ;; "i.e. (IMAX 0 (IDIFFERENCE CHARW (NEXT CHARW))") - (SETQ CHARW 0)) unless (type? CHARLOOKS CHARW) - do - (* ;; + (SETQ CHARW 0)) unless (type? CHARLOOKS CHARW) + do + (* ;;  "Update the running X-position in the line, skiping look-slots and skipping diacritics") - (CL:WHEN (IEQP CHNO CH#) - (if AFTER - then (add X (CHARW CHARSLOT))) + (CL:WHEN (IEQP CHNO CH#) + (if AFTER + then (add X (CHARW CHARSLOT))) - (* ;; - "Scale selection X down to points for lines in hardcopy-display mode.") + (* ;; + "Scale selection X down to points for lines in hardcopy-display mode.") - (RETURN X)) - (CL:WHEN CHAR (* ; "Ignore CHARLOOKS") - (add CHNO 1) - (add X CHARW)) finally (CL:WHEN (AND (IEQP CH# (FGETLD LINE LCHAR1)) - (IGREATERP (FGETLD LINE LCHARLIM) - (FGETTOBJ TEXTOBJ TEXTLEN)) - (EQ (FGETLD LINE LXLIM) - (FGETLD LINE LX1))) + (RETURN X)) + (CL:WHEN CHAR (* ; "Ignore CHARLOOKS") + (add CHNO 1) + (add X CHARW)) finally (CL:WHEN (AND (IEQP CH# (FGETLD LINE LCHAR1)) + (IGREATERP (FGETLD LINE LCHARLIM) + (FGETTOBJ TEXTOBJ TEXTLEN)) + (EQ (FGETLD LINE LXLIM) + (FGETLD LINE LX1))) - (* ;; + (* ;;  "CH# not found in empty final line, return left margin") - (RETURN (FGETLD LINE LX1)))]) + (RETURN (FGETLD LINE LX1)))]) ) (DEFINEQ (\TEDIT.RESET.EXTEND.PENDING.DELETE - [LAMBDA (TSTREAM) (* ; "Edited 19-Mar-2025 13:24 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 14:19 by rmk") + (* ; "Edited 19-Mar-2025 13:24 by rmk") (* ; "Edited 26-Nov-2024 23:44 by rmk") (* ; "Edited 9-Mar-2024 11:37 by rmk") (* ; "Edited 19-Feb-2024 23:10 by rmk") @@ -1215,11 +1195,8 @@ (* ;; "Reset the 'Extend Pending Delete' status") - (LET [(TEXTOBJ (CL:IF (type? TEXTOBJ TSTREAM) - TSTREAM - (GETTSTR TSTREAM TEXTOBJ))] - (\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ) - NIL TEXTOBJ) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) + (\TEDIT.NOSEL TSTREAM) (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) 'NORMAL) (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL]) @@ -1271,11 +1248,25 @@ (NIL) (\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION)) SEL]) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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))) +) + +(* "END EXPORTED DEFINITIONS") + ) (DEFINEQ (\TEDIT.SHOWSEL - [LAMBDA (SEL ON TEXTOBJ ONLYPANE) (* ; "Edited 4-Oct-2024 10:29 by rmk") + [LAMBDA (SEL ON TSTREAM ONLYPANE DONTFIX) (* ; "Edited 21-Apr-2025 20:35 by rmk") + (* ; "Edited 6-Apr-2025 13:55 by rmk") + (* ; "Edited 5-Apr-2025 13:00 by rmk") + (* ; "Edited 4-Oct-2024 10:29 by rmk") (* ; "Edited 2-Oct-2024 14:20 by rmk") (* ; "Edited 21-Aug-2024 16:11 by rmk") (* ; "Edited 19-Jul-2024 23:46 by rmk") @@ -1292,44 +1283,51 @@ (* ; "Edited 14-Oct-2023 12:10 by rmk") (* ; "Edited 5-Apr-2023 09:13 by rmk") (* ; "Edited 22-May-92 16:11 by jds") - (CL:WHEN (TEXTSTREAMP TEXTOBJ) - (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ))) - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (SELECTION! SEL) (* ;; "Highlight the selection SEL, according to HOW, turning it on or off according to ON. ONLYPANE is specified in calls from \TEDIT.SCROLLFN to confine operations to only the pane currently being scrolled. Other panes are neither unhighlighted or rehighlighted.") (* ;; "The selection's lines [L1...LN] are the subset of lines selected globally by CH# to CHLIM that are visible within each pane.") - (CL:WHEN (AND (FGETSEL SEL SET) - (NEQ ON (FGETSEL SEL ONFLG)) - (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)) - (FGETTOBJ TEXTOBJ PRIMARYPANE)) - - (* ;; "This operation only makes sense if the selection is set, it is not currently in the intended ON state, we are allowed to update, and there is at least one pane to highlight in.") - - (if (FGETSEL SEL SELOBJ) - then - (* ;; "SELOBJ if the selection consisted only of a single image object. It presumably did its own buttonevent operations when it was selected, but is otherwise immune to normal highlighting. But it acts just as a normal character in all panes if it is part of a longer selection. ") - - (* ;; "This does the WHENOPERATEDONFN once no matter how many panes the object appears in, and that function controls the highlighting. Not sure what happens in other panes. If we do the ordinary highlighting, then e.g. a whole NWAY image object gets underlines, even though only one toggle was selected.") - - (\TEDIT.OPERATE.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT) - SEL - (FGETTOBJ TEXTOBJ SELPANE) - (CL:IF ON - 'HIGHLIGHTED - 'UNHIGHLIGHTED)) - else (for PANE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN - in (FGETSEL SEL LN) when (OR (NULL ONLYPANE) - (EQ PANE ONLYPANE)) - do (CL:WHEN (AND L1 LN (NEQ 0 (FGETSEL SEL DCH))) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (SELECTION! SEL) + (CL:WHEN (AND (FGETSEL SEL SET) + (NEQ ON (FGETSEL SEL ONFLG)) + (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)) + (FGETTOBJ TEXTOBJ PRIMARYPANE)) + + (* ;; "This operation only makes sense if the selection is set, it is not currently in the intended ON state, we are allowed to update, and there is at least one pane to highlight in.") + + (CL:WHEN (AND ON (NOT DONTFIX)) (* ; + "If we're ON, make sure we're fixed.") + (\TEDIT.FIXSEL SEL TSTREAM ONLYPANE)) + (if (FGETSEL SEL SELOBJ) + then + (* ;; "SELOBJ if the selection consisted only of a single image object. It presumably did its own buttonevent operations when it was selected, but is otherwise immune to normal highlighting. But it acts just as a normal character in all panes if it is part of a longer selection. ") + + (* ;; "This does the WHENOPERATEDONFN once no matter how many panes the object appears in, and that function controls the highlighting. Not sure what happens in other panes. If we do the ordinary highlighting, then e.g. a whole NWAY image object gets underlines, even though only one toggle was selected.") + + (\TEDIT.OPERATE.OBJECT TSTREAM SEL (FGETTOBJ TEXTOBJ SELPANE) + (CL:IF ON + 'HIGHLIGHTED + 'UNHIGHLIGHTED)) + else (for PANE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN + in (FGETSEL SEL LN) when (OR (NULL ONLYPANE) + (EQ PANE ONLYPANE)) + do (CL:WHEN (AND L1 LN (NEQ 0 (FGETSEL SEL DCH))) (* ; "Hilight if not a point selection") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 LN PANE SEL)) - (\TEDIT.SETCARET SEL PANE TEXTOBJ ON))) - (FSETSEL SEL ONFLG ON))]) + (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 LN PANE SEL)) + (\TEDIT.SETCARET SEL PANE TEXTOBJ ON))) + (FSETSEL SEL ONFLG ON))]) + +(\TEDIT.NOSEL + [LAMBDA (TSTREAM SEL ONLYPANE) (* ; "Edited 15-Apr-2025 15:20 by rmk") + + (* ;; + "A function along side the macro so Masterscope doesn't show NOSEL and SHOWSEL at the same time.") + + (\TEDIT.SHOWSEL SEL NIL TSTREAM ONLYPANE]) (\TEDIT.SHOWSEL.HILIGHT [LAMBDA (TEXTOBJ L1 LN PANE SEL) (* ; "Edited 1-Dec-2024 11:28 by rmk") @@ -1384,64 +1382,76 @@ 'INVERT) repeatuntil (EQ L LN]) (\TEDIT.UPDATE.SEL - [LAMBDA (SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 10-Jul-2024 17:25 by rmk") + [LAMBDA (TSTREAM/SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 21-Apr-2025 22:50 by rmk") + (* ; "Edited 6-Apr-2025 11:47 by rmk") + (* ; "Edited 10-Jul-2024 17:25 by rmk") (* ; "Edited 8-Jul-2024 00:11 by rmk") - (* ; "Edited 21-Jun-2024 14:21 by rmk") (* ; "Edited 29-Apr-2024 13:28 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 5-Mar-2024 14:45 by rmk") - (* ; "Edited 25-Feb-2024 17:30 by rmk") - (* ; "Edited 16-Feb-2024 23:49 by rmk") (* ; "Edited 17-Sep-2023 00:05 by rmk") - (* ; "Edited 12-Aug-2023 08:27 by rmk") (* ; "Edited 6-Jun-2023 13:24 by rmk") (* ; "Edited 7-May-2023 19:03 by rmk") - (* ;; "Translates the selection SEL to new positions. DCH=0 means point selection with caret blinking either before or after CH#, depending on POINT. If CH# is a history event, that defines the new selection parameters. Otherwise, if any of the variables are NIL, the value for that field in SEL is not changed.") + (* ;; "Translates a selection to new positions. If TSTREAM/SEL is a stream, then its selection is the target SEL. And in that case the selection is fixed and shown after the adjustment.") + + (* ;; " DCH=0 means point selection with caret blinking either before or after CH#, depending on POINT. If CH# is a history event, that defines the new selection parameters. Otherwise, if any of the variables are NIL, the value for that field in SEL is not changed.") (* ;; "For convenience, If DCH is NIL and CHLIM is provided, DCH is computed from CH# and CHLIM instead of being left alone.") - [if (type? TEDITHISTORYEVENT CH#) - then (* ; "History is a pseudo-selection") - (CL:UNLESS DCH - (SETQ DCH (GETTH CH# THLEN))) - (CL:UNLESS POINT - (SETQ POINT (GETTH CH# THPOINT CH#))) - (SETQ CH# (GETTH CH# THCH#)) - else - (* ;; "Get defaults from SEL (either a selection or a textobj whose SEL is indicated)") - - (CL:WHEN (type? TEXTOBJ SEL) - (SETQ SEL (TEXTSEL SEL))) - (CL:UNLESS CH# - (SETQ CH# (GETSEL SEL CH#))) - (CL:UNLESS DCH - (SETQ DCH (if CHLIM - then (IDIFFERENCE CHLIM CH#) - else (FGETSEL SEL DCH)))) - (CL:UNLESS POINT - (SETQ POINT (FGETSEL SEL POINT)))] + (LET (TSTREAM SEL) + (if (type? TEXTSTREAM TSTREAM/SEL) + then (SETQ TSTREAM TSTREAM/SEL) + (SETQ SEL (TEXTSEL (FTEXTOBJ TSTREAM))) + elseif (type? SELECTION TSTREAM/SEL) + then (SETQ SEL TSTREAM/SEL) + elseif (type? TEXTOBJ TSTREAM/SEL) + then (SETQ TSTREAM TSTREAM/SEL) (* ; "Maybe not allow this") + (SETQ SEL (TEXTSEL TSTREAM/SEL)) + else (\TEDIT.THELP "Not a text stream or selection" SEL)) + + (* ;; "We now have a selection SEL, maybe also have a TSTREAM") + + [if (type? TEDITHISTORYEVENT CH#) + then (* ; "History is a pseudo-selection") + (CL:UNLESS DCH + (SETQ DCH (GETTH CH# THLEN))) + (CL:UNLESS POINT + (SETQ POINT (GETTH CH# THPOINT CH#))) + (SETQ CH# (GETTH CH# THCH#)) + else + (* ;; + "Get defaults from SEL (either a selection or a textobj whose SEL is indicated)") + + (CL:UNLESS CH# + (SETQ CH# (GETSEL SEL CH#))) + (CL:UNLESS DCH + (SETQ DCH (if CHLIM + then (IDIFFERENCE CHLIM CH#) + else (FGETSEL SEL DCH)))) + (CL:UNLESS POINT + (SETQ POINT (FGETSEL SEL POINT)))] - (* ;; + (* ;;  "If below 1, left of 1. We don't know TEXTLEN without the TEXTOBJ, so we can't test the length.") - (CL:WHEN (ILESSP CH# 1) - (SETQ CH# 1) - (SETQ POINT 'LEFT)) + (CL:WHEN (ILESSP CH# 1) + (SETQ CH# 1) + (SETQ POINT 'LEFT)) - (* ;; "POINT=LEFT means before CH#, POINT=RIGHT means before CHLIM. If DCH=0, caret is between (and CHLIM - CH# is not DCH=0).") + (* ;; "POINT=LEFT means before CH#, POINT=RIGHT means before CHLIM. If DCH=0, caret is between (and CHLIM - CH# is not DCH=0).") - (SETSEL SEL CH# CH#) - (FSETSEL SEL DCH DCH) - (FSETSEL SEL CHLIM (CL:IF (EQ DCH 0) - (ADD1 CH#) - (IPLUS CH# DCH))) - (FSETSEL SEL POINT POINT) - (FSETSEL SEL SELOBJ NIL) (* ; + (SETSEL SEL CH# CH#) + (FSETSEL SEL DCH DCH) + (FSETSEL SEL CHLIM (CL:IF (EQ DCH 0) + (ADD1 CH#) + (IPLUS CH# DCH))) + (FSETSEL SEL POINT POINT) + (FSETSEL SEL SELOBJ NIL) (* ;  "If we are moving around, we are moving away from any old object") - (FSETSEL SEL SET T) - (CL:WHEN LOOKS (\TEDIT.SET.SEL.LOOKS SEL LOOKS)) - SEL]) + (FSETSEL SEL SET T) + (CL:WHEN LOOKS (\TEDIT.SET.SEL.LOOKS SEL LOOKS)) + (CL:WHEN TSTREAM (\TEDIT.SHOWSEL SEL T TSTREAM)) + SEL]) (\TEDIT.CARETLINE [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 7-Nov-2024 21:50 by rmk") @@ -1644,7 +1654,10 @@ (DEFINEQ (\TEDIT.SELECT.OBJECT - [LAMBDA (TEXTOBJ NEWSEL LINE X Y SELPANE SELOPERATION BUTTON) + [LAMBDA (TSTREAM NEWSEL LINE X Y SELPANE SELOPERATION BUTTON) + (* ; "Edited 21-Apr-2025 20:16 by rmk") + (* ; "Edited 14-Apr-2025 23:47 by rmk") + (* ; "Edited 5-Apr-2025 13:05 by rmk") (* ; "Edited 6-Dec-2024 11:09 by rmk") (* ; "Edited 30-Nov-2024 00:01 by rmk") (* ; "Edited 26-Nov-2024 03:45 by rmk") @@ -1662,7 +1675,8 @@ (* ; "Edited 14-Oct-2023 11:38 by rmk") (* ; "Edited 10-Apr-2023 08:38 by rmk") (* ; "Edited 29-Mar-94 13:28 by jds") - (LET ((OBJ (FGETSEL NEWSEL SELOBJ)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (OBJ (FGETSEL NEWSEL SELOBJ)) RESULT) (RESETLST (\TEDIT.CLIP.OBJECT OBJ (FGETSEL NEWSEL X0) @@ -1677,7 +1691,7 @@ (IDIFFERENCE X (FGETSEL NEWSEL X0)) (IDIFFERENCE Y (FGETLD LINE YBASE)) SELPANE - (fetch (TEXTWINDOW WTEXTSTREAM) of SELPANE) + (PANETEXTSTREAM SELPANE) BUTTON SELOPERATION)))) (* ;; "The clipping region is now restored.") @@ -1696,9 +1710,9 @@ then (* ;; "The object may have updated its own image, within its coordinate system. But its box may have changed, and if so, the document also needs to reformat and the selection has to be adjusted. We know that CURSEL is currently displayed, we get it out of the way here, expecting that \TEDIT.BUTTONEVENTFN will synchronize CURSEL with NEWSEL.") - (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED (FGETSEL NEWSEL CH#) + (\TEDIT.UPDATE.LINES TSTREAM 'CHANGED (FGETSEL NEWSEL CH#) 1) - (\TEDIT.SHOWSEL NIL T TEXTOBJ) + (\TEDIT.SHOWSEL NIL T TSTREAM NIL T) (FSETTOBJ TEXTOBJ \DIRTY T) elseif (NULL (CAR RESULT)) then @@ -1712,7 +1726,8 @@ (CAR RESULT]) (\TEDIT.SHOWSEL.OBJECT - [LAMBDA (TEXTOBJ SEL L1 ON PANE) (* ; "Edited 1-Dec-2024 11:52 by rmk") + [LAMBDA (TSTREAM SEL L1 ON PANE) (* ; "Edited 21-Apr-2025 19:07 by rmk") + (* ; "Edited 1-Dec-2024 11:52 by rmk") (* ; "Edited 21-Aug-2024 15:31 by rmk") (* ; "Edited 19-Jul-2024 23:15 by rmk") (* ; "Edited 18-Jul-2024 12:19 by rmk") @@ -1726,6 +1741,7 @@ (* ;; "We are hilighting (or dehilighting) a selection containing only a single image object if it appears in PANE ") + (NOTUSED) (LET [(OBJ (FGETSEL SEL SELOBJ)) (IMAGEFN (IMAGEOBJPROP (FGETSEL SEL SELOBJ) 'WHENOPERATEDONFN] @@ -1741,8 +1757,7 @@ (ERSETQ (APPLY* IMAGEFN OBJ PANE (CL:IF ON 'HIGHLIGHTED 'UNHIGHLIGHTED) - SEL - (FGETTOBJ TEXTOBJ STREAMHINT)))))]) + SEL TSTREAM))))]) (\TEDIT.CLIP.OBJECT [LAMBDA (OBJ X LINE PANE) (* ; "Edited 1-Dec-2024 11:54 by rmk") @@ -1778,7 +1793,10 @@ `(PROGN (DSPCLIPPINGREGION OLDVALUE ,DS]) (\TEDIT.OPERATE.OBJECT - [LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 31-Dec-2024 17:24 by rmk") + [LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 21-Apr-2025 20:22 by rmk") + (* ; "Edited 6-Apr-2025 14:21 by rmk") + (* ; "Edited 5-Apr-2025 13:13 by rmk") + (* ; "Edited 31-Dec-2024 17:24 by rmk") (* ; "Edited 1-Dec-2024 11:55 by rmk") (* ; "Edited 18-Oct-2024 13:44 by rmk") (* ; "Edited 6-Oct-2024 23:09 by rmk") @@ -1799,7 +1817,7 @@ (LET* ((OBJ (FGETSEL SEL SELOBJ)) (WHENOPERATEDONFN (IMAGEOBJPROP OBJ 'WHENOPERATEDONFN)) - (TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (TEXTOBJ (FTEXTOBJ TSTREAM)) LINE) (CL:WHEN WHENOPERATEDONFN (SELECTQ OPERATION @@ -1807,14 +1825,14 @@ (* ;; "Called from BUTTONEVENTFN.DOOPERATION. Execute once, in PANE. SHOWSEL and FIXSEL do the updates across other panes. This runs in PANE's coordinate system. We can't do it if we can't determine from SEL where OBJ is located in PANE.") (CL:WHEN (SETQ LINE (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM) (MOVETO (FGETSEL SEL X0) (FGETLD LINE YBASE) PANE) (ERSETQ (APPLY* WHENOPERATEDONFN OBJ (WINDOWPROP PANE 'DSP) OPERATION SEL TSTREAM)) - (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Restore highlighting") - (\TEDIT.SHOWSEL SEL T TEXTOBJ))) + (* ; "Restore highlighting") + (\TEDIT.SHOWSEL SEL T TSTREAM))) ((HIGHLIGHTED UNHIGHLIGHTED DESELECTED) (* ;; "Execute in each pane where OBJ is visible, in OBJ's coordinate system. This may be duplicating the pane iteration in SHOWSEL?") @@ -1907,7 +1925,8 @@ SPLASTCHAR _ LASTCHAR))]) (\TEDIT.SELPIECES.COPY - [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ CHARLOOKS) + [LAMBDA (SELPIECES OPERATION TOTSTREAM FROMTSTREAM CHARLOOKS) + (* ; "Edited 22-Apr-2025 08:26 by rmk") (* ; "Edited 19-Mar-2025 16:26 by rmk") (* ; "Edited 26-Nov-2024 23:31 by rmk") (* ; "Edited 22-Nov-2024 15:38 by rmk") @@ -1919,18 +1938,20 @@ (* ;; "Produces a copy of SELPIECES where the pieces from first to last are chained-together copies of the original pieces so that later inpieces can run from first to last. OPERATION determines which imageobject functions will be invoked, if any.") - (* ;; "FROMTEXTOBJ is optional. Providing a FROMTEXTOBJ that is different from TOTEXTOBJ is a signal that this is a cross-copy needing to create private copies of strings and files. ") + (* ;; "FROMTEXTOBJ is optional. Providing a FROMTSTREAM that is different from TOTSTREAM is a signal that this is a cross-copy needing to create private copies of strings and files. ") + + (* ;; "DO NOT RUN THIS INTERPRETED: DWIM SOMEHOW SCREWS UP THIS INSELPIECES LOOP") (CL:WHEN SELPIECES - (CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ)) + (CL:UNLESS FROMTSTREAM (SETQ FROMTSTREAM TOTSTREAM)) (for PC NPC PREVPC NEWFIRSTPIECE inselpieces (PROGN SELPIECES) - do (SETQ NPC (\TEDIT.COPYPIECE PC FROMTEXTOBJ TOTEXTOBJ NIL OPERATION)) + do (SETQ NPC (\TEDIT.COPYPIECE PC FROMTSTREAM TOTSTREAM NIL OPERATION)) (CL:UNLESS NPC (* ; "Was an object-copy disallowed?") - (RETURN)) + (RETURN)) + (CL:WHEN CHARLOOKS (FSETPC NPC PCHARLOOKS CHARLOOKS)) (* ;; "Linke the new pieces together") - (CL:WHEN CHARLOOKS (FSETPC NPC PCHARLOOKS CHARLOOKS)) (if PREVPC then (SETPC PREVPC NEXTPIECE NPC) else (SETQ NEWFIRSTPIECE NPC)) @@ -1967,7 +1988,9 @@ SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2]) (\TEDIT.SELPIECES.CHARTRANSFORM - [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 16-Mar-2025 10:03 by rmk") + [LAMBDA (SELPIECES CHARFN OBJECTSTOO TSTREAM) (* ; "Edited 24-Apr-2025 16:02 by rmk") + (* ; "Edited 20-Apr-2025 23:23 by rmk") + (* ; "Edited 16-Mar-2025 10:03 by rmk") (* ; "Edited 7-Nov-2024 21:50 by rmk") (* ; "Edited 4-Oct-2024 08:41 by rmk") (* ; "Edited 28-Apr-2024 08:52 by rmk") @@ -1979,7 +2002,8 @@ (* ;;  "This smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.") - [for PC PCONTENTS (INDEX _ 0) inselpieces SELPIECES + [for PC PCONTENTS (TEXTOBJ _ (FTEXTOBJ TSTREAM)) + (INDEX _ 0) inselpieces SELPIECES do (SETQ PCONTENTS (PCONTENTS PC)) (SELECTC (PTYPE PC) (STRING.PTYPES (for I CH (STR _ PCONTENTS) from 1 while (SETQ CH (NTHCHARCODE STR I)) @@ -1991,7 +2015,7 @@ [for I from 1 to (PLEN PC) do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE - TEXTOBJ PC I) + PC I) (add INDEX 1] (if (fetch (STRINGP FATSTRINGP) of STR) then (FSETPC PC PTYPE FATSTRING.PTYPE) @@ -2132,7 +2156,9 @@ (DEFINEQ (TEDIT.XYTOCH - [LAMBDA (X Y PANE) (* ; "Edited 6-Dec-2024 11:55 by rmk") + [LAMBDA (X Y PANE) (* ; "Edited 20-Apr-2025 13:43 by rmk") + (* ; "Edited 18-Apr-2025 15:07 by rmk") + (* ; "Edited 6-Dec-2024 11:55 by rmk") (* ; "Edited 1-Dec-2024 11:28 by rmk") (* ; "Edited 29-Nov-2024 09:14 by rmk") (* ; "Edited 20-Nov-2024 11:27 by rmk") @@ -2162,10 +2188,8 @@ (SUB1 (PANEHEIGHT PANE))) (BOTTOM (PANEBOTTOM PANE)) Y)) - (\TEDIT.XYTOSEL X Y SCRSEL (PANETOBJ PANE) - PANE - 'NORMAL - 'LEFT NIL 'TEXT) + (\TEDIT.XYTOSEL X Y SCRSEL (PANETEXTSTREAM PANE) + 'NORMAL PANE 'LEFT NIL 'TEXT) (CL:WHEN (FGETSEL SCRSEL SET) (FGETSEL SCRSEL CH#]) @@ -2308,7 +2332,8 @@ (FGETSEL SEL DCH))]) (TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 18-May-2024 16:20 by rmk") + [LAMBDA (SEL OPERATION) (* ; "Edited 21-Apr-2025 20:27 by rmk") + (* ; "Edited 18-May-2024 16:20 by rmk") (* ; "Edited 29-Apr-2024 13:03 by rmk") (* ; "Edited 9-Mar-2024 12:04 by rmk") (* ; "Edited 15-Mar-2024 13:34 by rmk") @@ -2321,14 +2346,16 @@ (* ;; "Set what the selection should be displayed like, given what it's for (NORMAL, COPY, MOVE, etc.). This is a documented entry.") (LET ((WASON (GETSEL SEL ONFLG)) - (TEXTOBJ (TEXTOBJ SEL))) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (TSTREAM (TEXTSTREAM SEL))) + (\TEDIT.NOSEL TSTREAM SEL) (\TEDIT.SET.SEL.LOOKS SEL OPERATION) - (\TEDIT.SHOWSEL SEL WASON TEXTOBJ) + (\TEDIT.SHOWSEL SEL WASON TSTREAM) SEL]) (TEDIT.SETSEL [LAMBDA (TSTREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) + (* ; "Edited 6-Apr-2025 17:52 by rmk") + (* ; "Edited 5-Apr-2025 13:43 by rmk") (* ; "Edited 17-Feb-2025 12:26 by rmk") (* ; "Edited 31-Jan-2025 12:43 by rmk") (* ; "Edited 19-Jan-2025 08:32 by rmk") @@ -2352,11 +2379,11 @@ (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (CL:WHEN (AND LEN (ILESSP LEN 0)) (ERROR "Selection length cannot be negative" LEN)) - (LET* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (SEL (TEXTSEL TEXTOBJ)) (TEXTLEN (TEXTLEN TEXTOBJ)) PC) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; "First turn the old sel off.") + (\TEDIT.NOSEL TSTREAM) (* ; "First turn the old sel off.") [if (type? SELECTION CH#) then (* ;  "He gave us a selection; just plug it in") @@ -2388,13 +2415,13 @@ (CL:UNLESS LEAVECARETLOOKS (* ;  "Set the insertion looks to follow.") (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TSTREAM) (FSETTOBJ TEXTOBJ LASTARROWX NIL) (TEDIT.GETSEL TSTREAM]) (TEDIT.SHOWSEL - [LAMBDA (TSTREAM ONFLG SEL) (* ; "Edited 7-Jul-2024 11:25 by rmk") + [LAMBDA (TSTREAM ONFLG SEL) (* ; "Edited 6-Apr-2025 23:31 by rmk") + (* ; "Edited 7-Jul-2024 11:25 by rmk") (* ; "Edited 18-May-2024 16:28 by rmk") (* ; "Edited 29-Apr-2024 12:27 by rmk") (* ; "Edited 9-Mar-2024 12:06 by rmk") @@ -2404,14 +2431,14 @@ (* ;  "Edited 21-Oct-2022 18:36 by rmk; Edited 30-May-91 23:04 by jds") - (* ;; "He's giving us a selection to highlight and to connect it to this textobj.") + (* ;; "He's giving us a selection to highligh. Original comment said that it would :connect%" SEL to this stream. But that didn't mean making installing the indicated selection into the stream, it meant adding the stream to the selection (now the SELTEXTSTREAM field). The old code did not take down the current selection, so you could end up with highlighting in 2 places. Her at least we take it down.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (CL:WHEN SEL - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL ONFLG TEXTOBJ))]) + (* ;; "But generally, this is a bogus interface, should be dedocumented and removed. TEDIT.SETSEL is more reasonable") + + (CL:WHEN ONFLG (* ; + "If SEL is going on, we better take down what's there") + (\TEDIT.NOSEL TSTREAM)) + (\TEDIT.SHOWSEL SEL ONFLG TSTREAM]) (TEDIT.SEL.AS.STRING [LAMBDA (TSTREAM SEL/CH# LEN CODEFOROBJECT) (* ; "Edited 15-Feb-2025 12:47 by rmk") @@ -2485,25 +2512,25 @@ (ADDTOVAR LAMA TEDIT.SELPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (15676 17497 (\TEDIT.SELECTION.DEFPRINT 15686 . 17495)) (17534 19039 ( -\TEDIT.SET.GLOBAL.SELECTIONS 17544 . 19037)) (19040 24892 (\TEDIT.SELECTED.PIECES 19050 . 20570) ( -\TEDIT.FIND.PROTECTED.END 20572 . 22241) (\TEDIT.FIND.PROTECTED.START 22243 . 24101) ( -\TEDIT.WORD.BOUND 24103 . 24890)) (25026 59225 (\TEDIT.EXTEND.SEL 25036 . 32124) (\TEDIT.SCAN.LINE -32126 . 43904) (\TEDIT.SCAN.LINE.WORD 43906 . 49267) (\TEDIT.XYTOSEL 49269 . 56378) (\TEDIT.REGIONTYPE - 56380 . 57399) (\TEDIT.XYTOSEL.INLINEP 57401 . 57856) (\TEDIT.XYTOSEL.LINE 57858 . 59223)) (59226 -72850 (\TEDIT.FIXSEL 59236 . 68849) (\TEDIT.CHTOLINEX 68851 . 72848)) (72851 76834 ( -\TEDIT.RESET.EXTEND.PENDING.DELETE 72861 . 74170) (\TEDIT.SET.SEL.LOOKS 74172 . 76832)) (76835 95235 ( -\TEDIT.SHOWSEL 76845 . 81305) (\TEDIT.SHOWSEL.HILIGHT 81307 . 85928) (\TEDIT.UPDATE.SEL 85930 . 89429) - (\TEDIT.CARETLINE 89431 . 90145) (\TEDIT.SEL.L1 90147 . 90830) (\TEDIT.SEL.LN 90832 . 91515) ( -\TEDIT.SEL.DELETEDCHARS 91517 . 95233)) (95236 99942 (\TEDIT.COPYSEL 95246 . 97712) ( -\TEDIT.SEL.CHANGED? 97714 . 99940)) (99973 112702 (\TEDIT.SELECT.OBJECT 99983 . 104489) ( -\TEDIT.SHOWSEL.OBJECT 104491 . 106653) (\TEDIT.CLIP.OBJECT 106655 . 108659) (\TEDIT.OPERATE.OBJECT -108661 . 112700)) (112730 131910 (\TEDIT.SELPIECES 112740 . 117021) (\TEDIT.SELPIECES.COPY 117023 . -119310) (\TEDIT.SELPIECES.CONCAT 119312 . 121191) (\TEDIT.SELPIECES.CHARTRANSFORM 121193 . 124402) ( -\TEDIT.SELPIECES.FROM.STRING 124404 . 129545) (\TEDIT.SELPIECES.TO.STRING 129547 . 131908)) (131963 -154486 (TEDIT.XYTOCH 131973 . 134357) (TEDIT.SELPROP 134359 . 138389) (TEDIT.GETPOINT 138391 . 140311) - (TEDIT.GETSEL 140313 . 141047) (TEDIT.GETSEL.PARA 141049 . 141998) (TEDIT.SCANSEL 142000 . 142948) ( -TEDIT.SET.SEL.LOOKS 142950 . 144329) (TEDIT.SETSEL 144331 . 149095) (TEDIT.SHOWSEL 149097 . 150377) ( -TEDIT.SEL.AS.STRING 150379 . 152864) (TEDIT.SEL.AS.SEXPR 152866 . 154152) (TEDIT.SELECTALL 154154 . -154484))))) + (FILEMAP (NIL (15733 17554 (\TEDIT.SELECTION.DEFPRINT 15743 . 17552)) (17591 19096 ( +\TEDIT.SET.GLOBAL.SELECTIONS 17601 . 19094)) (19097 25068 (\TEDIT.SELECTED.PIECES 19107 . 20746) ( +\TEDIT.FIND.PROTECTED.END 20748 . 22417) (\TEDIT.FIND.PROTECTED.START 22419 . 24277) ( +\TEDIT.WORD.BOUND 24279 . 25066)) (25202 59309 (\TEDIT.EXTEND.SEL 25212 . 32452) (\TEDIT.SCAN.LINE +32454 . 44127) (\TEDIT.SCAN.LINE.WORD 44129 . 49122) (\TEDIT.XYTOSEL 49124 . 56462) (\TEDIT.REGIONTYPE + 56464 . 57483) (\TEDIT.XYTOSEL.INLINEP 57485 . 57940) (\TEDIT.XYTOSEL.LINE 57942 . 59307)) (59310 +72435 (\TEDIT.FIXSEL 59320 . 68290) (\TEDIT.CHTOLINEX 68292 . 72433)) (72436 76388 ( +\TEDIT.RESET.EXTEND.PENDING.DELETE 72446 . 73724) (\TEDIT.SET.SEL.LOOKS 73726 . 76386)) (76786 96615 ( +\TEDIT.SHOWSEL 76796 . 81772) (\TEDIT.NOSEL 81774 . 82075) (\TEDIT.SHOWSEL.HILIGHT 82077 . 86698) ( +\TEDIT.UPDATE.SEL 86700 . 90809) (\TEDIT.CARETLINE 90811 . 91525) (\TEDIT.SEL.L1 91527 . 92210) ( +\TEDIT.SEL.LN 92212 . 92895) (\TEDIT.SEL.DELETEDCHARS 92897 . 96613)) (96616 101322 (\TEDIT.COPYSEL +96626 . 99092) (\TEDIT.SEL.CHANGED? 99094 . 101320)) (101353 114802 (\TEDIT.SELECT.OBJECT 101363 . +106214) (\TEDIT.SHOWSEL.OBJECT 106216 . 108447) (\TEDIT.CLIP.OBJECT 108449 . 110453) ( +\TEDIT.OPERATE.OBJECT 110455 . 114800)) (114830 134462 (\TEDIT.SELPIECES 114840 . 119121) ( +\TEDIT.SELPIECES.COPY 119123 . 121612) (\TEDIT.SELPIECES.CONCAT 121614 . 123493) ( +\TEDIT.SELPIECES.CHARTRANSFORM 123495 . 126954) (\TEDIT.SELPIECES.FROM.STRING 126956 . 132097) ( +\TEDIT.SELPIECES.TO.STRING 132099 . 134460)) (134515 158074 (TEDIT.XYTOCH 134525 . 137101) ( +TEDIT.SELPROP 137103 . 141133) (TEDIT.GETPOINT 141135 . 143055) (TEDIT.GETSEL 143057 . 143791) ( +TEDIT.GETSEL.PARA 143793 . 144742) (TEDIT.SCANSEL 144744 . 145692) (TEDIT.SET.SEL.LOOKS 145694 . +147179) (TEDIT.SETSEL 147181 . 152099) (TEDIT.SHOWSEL 152101 . 153965) (TEDIT.SEL.AS.STRING 153967 . +156452) (TEDIT.SEL.AS.SEXPR 156454 . 157740) (TEDIT.SELECTALL 157742 . 158072))))) STOP diff --git a/library/tedit/TEDIT-SELECTION.LCOM b/library/tedit/TEDIT-SELECTION.LCOM index 2fb5bba02..9502b28aa 100644 Binary files a/library/tedit/TEDIT-SELECTION.LCOM and b/library/tedit/TEDIT-SELECTION.LCOM differ diff --git a/library/tedit/TEDIT-STREAM b/library/tedit/TEDIT-STREAM index 6134bd72a..2c34e46e1 100644 --- a/library/tedit/TEDIT-STREAM +++ b/library/tedit/TEDIT-STREAM @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 18:32:27" {WMEDLEY}TEDIT>TEDIT-STREAM.;872 187180 +(FILECREATED "26-Apr-2025 12:47:53" {WMEDLEY}tedit>TEDIT-STREAM.;899 191250 :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}TEDIT>TEDIT-STREAM.;865) + :PREVIOUS-DATE "24-Apr-2025 23:51:12" {WMEDLEY}tedit>TEDIT-STREAM.;898) (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 where this textobj is displayed. Now chained through PRIMARYPANE") - MOUSEREGION (* ; + PARABREAKCHARS (* ; "Characters that cause a paragraph break.Was \WINDOW. The window-pane 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,9 @@ 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 26-Apr-2025 12:47 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 +1502,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 [AND 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 +1529,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 +1550,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 +1567,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 +1598,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 +1620,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 +1765,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 +1800,7 @@ (* ;; "(FW8 WORD)") - [SETQ \TEXTIMAGEOPS (create IMAGEOPS + (SETQ \TEXTIMAGEOPS (create IMAGEOPS IMAGETYPE _ 'TEXT IMXPOSITION _ (FUNCTION \TEDIT.TEXTDSPXPOSITION) IMYPOSITION _ (FUNCTION \TEDIT.TEXTDSPYPOSITION) @@ -1800,7 +1812,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 +1978,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 +1997,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 +2078,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 +2091,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 +2144,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 +2180,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 +2233,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 +2249,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 +2311,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:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character") + (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") + + (* ;;  "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 +2467,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 +2486,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) - - (* ;; "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") + (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.") + + (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 +2959,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 +3131,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 +115994 (\TEDIT.REOPENTEXTSTREAM 85263 . 86615) (\TEDIT.OPENTEXTSTREAM.PIECES 86617 . 91483) ( +\TEDIT.OPENTEXTSTREAM.PROPS 91485 . 92587) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 92589 . 97830) ( +\TEDIT.OPENTEXTSTREAM.WINDOW 97832 . 100623) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 100625 . 103595) ( +\TEDIT.OPENTEXTFILE 103597 . 105310) (\TEDIT.CREATE.TEXTSTREAM 105312 . 106357) (\TEDIT.REOPEN.STREAM +106359 . 108695) (\TEDIT.TEXTINIT 108697 . 115992)) (116032 117220 (\TEDIT.TTYBOUT 116042 . 117218)) ( +117338 137107 (\TEDIT.TEXTCLOSEF 117348 . 118672) (\TEDIT.TEXTDSPFONT 118674 . 119644) ( +\TEDIT.TEXTEOFP 119646 . 121401) (\TEDIT.TEXTGETEOFPTR 121403 . 121726) (\TEDIT.TEXTSETEOFPTR 121728 + . 123015) (\TEDIT.TEXTGETFILEPTR 123017 . 125852) (\TEDIT.TEXTSETFILEINFO 125854 . 126362) ( +\TEDIT.TEXTOPENF 126364 . 127295) (\TEDIT.TEXTSETEOF 127297 . 127913) (\TEDIT.TEXTSETFILEPTR 127915 . +130025) (\TEDIT.TEXTDSPXPOSITION 130027 . 131044) (\TEDIT.TEXTDSPYPOSITION 131046 . 131787) ( +\TEDIT.TEXTLEFTMARGIN 131789 . 132380) (\TEDIT.TEXTCOLOR 132382 . 132965) (\TEDIT.TEXTRIGHTMARGIN +132967 . 136256) (\TEDIT.TEXTDSPCHARWIDTH 136258 . 136562) (\TEDIT.TEXTDSPSTRINGWIDTH 136564 . 136870) + (\TEDIT.TEXTDSPLINEFEED 136872 . 137105)) (137145 149621 (\TEDIT.NTHCHARCODE 137155 . 138606) ( +\TEDIT.PIECE.NTHCHARCODE 138608 . 142518) (\TEDIT.RPLCHARCODE 142520 . 143978) ( +\TEDIT.PIECE.RPLCHARCODE 143980 . 149266) (\TEDIT.NTHCHARLOOKS 149268 . 149619)) (150668 171653 ( +\TEDIT.DELETE.SELPIECES 150678 . 154303) (\TEDIT.INSERTCH 154305 . 162235) (\TEDIT.INSERTCH.HISTORY +162237 . 165701) (\TEDIT.INSERTEOL 165703 . 167528) (\TEDIT.INSERTCH.INSERTION 167530 . 170367) ( +\TEDIT.INSERTCH.EXTEND 170369 . 171651)) (171654 173158 (\TEDIT.NEXTCHANGEABLE.CHNO 171664 . 172379) ( +\TEDIT.LASTCHANGEABLE.CHNO 172381 . 173156)) (173159 174863 (\SETUPGETCH 173169 . 174861)) (174921 +179379 (\TEDIT.INSTALL.PIECE 174931 . 179377)) (179417 188431 (TEXTPROP 179427 . 179774) (GETTEXTPROP +179776 . 180020) (PUTTEXTPROP 180022 . 180279) (GETTEXTPROPS 180281 . 180725) (PUTTEXTPROPS 180727 . +181631) (TEXTPROP.ADD 181633 . 181896) (\TEDIT.TEXTPROP 181898 . 188429)) (188432 190502 ( +\TEDIT.TEXTOBJ.PROPNAMES 188442 . 189394) (\TEDIT.TEXTOBJ.PROPFETCHFN 189396 . 189912) ( +\TEDIT.TEXTOBJ.PROPSTOREFN 189914 . 190500))))) STOP diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM index 27e64ff2f..e95f527b0 100644 Binary files a/library/tedit/TEDIT-STREAM.LCOM and b/library/tedit/TEDIT-STREAM.LCOM differ diff --git a/library/tedit/TEDIT-TFBRAVO b/library/tedit/TEDIT-TFBRAVO index 96cd0a71b..2e5f0f71c 100644 --- a/library/tedit/TEDIT-TFBRAVO +++ b/library/tedit/TEDIT-TFBRAVO @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 14:23:07" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;176 94631 +(FILECREATED "24-Apr-2025 23:46:10" {WMEDLEY}tedit>TEDIT-TFBRAVO.;177 94745 :EDIT-BY rmk - :CHANGES-TO (FNS TEDITFROMBRAVO) + :CHANGES-TO (FNS \TFBRAVO.SPLIT.PARA) - :PREVIOUS-DATE "19-Feb-2025 12:18:40" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;175) + :PREVIOUS-DATE "28-Mar-2025 14:23:07" {WMEDLEY}tedit>TEDIT-TFBRAVO.;176) (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) @@ -1028,7 +1028,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 +1046,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) @@ -1503,18 +1504,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 (6575 13451 (TEDIT.BRAVOFILE? 6585 . 8315) (TEDITFROMBRAVO 8317 . 13449)) (13562 29289 ( +\TFBRAVO.GET.USER.CM 13572 . 16382) (\TFBRAVO.USER.CM.LOOKS 16384 . 17719) (\TFBRAVO.READ.USER.CM +17721 . 22291) (\TFBRAVO.INIT.PARALOOKS 22293 . 24402) (\TFBRAVO.INIT.PAGEFORMAT 24404 . 25284) ( +\TFBRAVO.GETPARAMS 25286 . 28140) (\TFBRAVO.FIND.LAST.TRAILER 28142 . 29287)) (29331 50029 ( +\TFBRAVO.PARSE.PARA 29341 . 33268) (\TFBRAVO.READ.PARALOOKS 33270 . 40160) (\TFBRAVO.CREATE.RUNS 40162 + . 41550) (\TFBRAVO.READ.CHARLOOKS 41552 . 46581) (\TFBRAVO.FONT.FROM.CHARLOOKS 46583 . 48130) ( +\TFBRAVO.READNUM? 48132 . 50027)) (50066 61107 (\TFBRAVO.HANDLE.HEADING 50076 . 52803) ( +\TFBRAVO.PARSE.PROFILE.PARA 52805 . 61105)) (61150 83295 (\TFBRAVO.INSERT.PARA 61160 . 62001) ( +\TFBRAVO.INSERT.RUN 62003 . 65305) (\TFBRAVO.SPLIT.PARA 65307 . 72731) (\TFBRAVO.RUN.TABSPEC 72733 . +77600) (\TFBRAVO.INSTALL.PAGEFORMAT 77602 . 83293)) (83296 87439 (\TFBRAVO.ASSERT 83306 . 83836) ( +\TEST.CHARACTER.LOOKS 83838 . 85724) (\TEST.PARAGRAPH.LOOKS 85726 . 87437)) (87924 94579 ( +\TFBRAVO.ADD.NAMEDTAB 87934 . 91537) (\TFBRAVO.COPY.NAMEDTAB 91539 . 91987) (\TFBRAVO.PUT.NAMEDTAB +91989 . 92269) (\TFBRAVO.GET.NAMEDTAB 92271 . 92648) (\NAMEDTABNYET 92650 . 92810) (\NAMEDTABSIZE +92812 . 93327) (\NAMEDTABPREPRINT 93329 . 93527) (\TEDIT.NAMEDTAB.INIT 93529 . 94577))))) STOP diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM index 95bbb468e..7e1b3ecb7 100644 Binary files a/library/tedit/TEDIT-TFBRAVO.LCOM and b/library/tedit/TEDIT-TFBRAVO.LCOM differ diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 1ac472f13..70a2f3b01 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,27 +1,26 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Mar-2025 22:43:28" {WMEDLEY}tedit>TEDIT-WINDOW.;790 237200 +(FILECREATED " 4-May-2025 14:28:08" {WMEDLEY}tedit>TEDIT-WINDOW.;839 227034 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION) + :CHANGES-TO (FNS \TEDIT.CURSOROUTFN \TEDIT.SPLITW \TEDIT.UNSPLITW) - :PREVIOUS-DATE "31-Mar-2025 12:04:14" {WMEDLEY}tedit>TEDIT-WINDOW.;789) + :PREVIOUS-DATE "28-Apr-2025 15:40:33" {WMEDLEY}tedit>TEDIT-WINDOW.;836) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) (RPAQQ TEDIT-WINDOWCOMS - [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITCARET TEXTWINDOW PANEPROPS) - (MACROS FGETPANEPROP GETPANEPROP SETPANEPROP - FSETPANEPROP) - (MACROS PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE - PANECARET PANESTREAM PANETOBJ PANEBOTTOMLINE - \TEDIT.PREFIX.LCHARLIM) - (MACROS PANETOP PANEWIDTH PANELEFT PANERIGHT - PANEBOTTOM PANEHEIGHT PANEREGION) - (I.S.OPRS inpanes backpanes) - (MACROS ALLBUTTONSUP))) + [(DECLARE%: EVAL@COMPILE DONTCOPY + (EXPORT (RECORDS TEDITCARET TEXTWINDOW PANEPROPS) + (MACROS FGETPANEPROP GETPANEPROP SETPANEPROP FSETPANEPROP) + (MACROS PANEWINDOW PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE PANECARET + PANECARETY PANETEXTSTREAM PANETEXTOBJ PANEBOTTOMLINE NEXTPANE PREVPANE) + (MACROS PANETOP PANEPTOP PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANEHEIGHT + PANEREGION) + (I.S.OPRS inpanes backpanes) + (MACROS ALLBUTTONSUP))) (INITRECORDS TEDITCARET PANEPROPS) (FILES ATTACHEDWINDOW) (FNS TEDIT.DEFER.UPDATES) @@ -39,11 +38,11 @@ (FNS \TEDIT.PANE.SPLIT \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.LINKPANES \TEDIT.UNLINKPANE) (P (MOVD? 'NILL 'GRAB-TYPED-REGION) (MOVD? 'NILL 'REGISTER-TYPED-REGION)) - (INITVARS (\TEDIT.OP.WIDTH 12) - (\TEDIT.OP.BOTTOM 12) - (\TEDIT.LINEREGION.WIDTH 12)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM - \TEDIT.LINEREGION.WIDTH)) + (INITVARS (\TEDIT.OP.WIDTH -1) + (\TEDIT.OP.BOTTOM 14) + (\TEDIT.LINEREGION.WIDTH 16)) + (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM \TEDIT.LINEREGION.WIDTH \TEDIT.SPLITCURSOR + \TEDIT.LINECURSOR \TEDIT.MOVESPLITCURSOR \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR) (CURSORS BXCARET BXHICARET \TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR) (COMS (* ; @@ -61,7 +60,7 @@ (FNS \TEDIT.FILENAME \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEDIT.LIKELY.FILENAME \TEDIT.UPDATE.TITLE)) (COMS (* ; "Screen updating utilities") - (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN) + (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN \TEDIT.CLOSESPLITS) (FNS \TEDIT.SCROLLFN \TEDIT.SCROLLCH.TOP \TEDIT.SCROLLCH.BOTTOM \TEDIT.SCROLLUP \TEDIT.TOPLINE.YTOP \TEDIT.SCROLLDOWN \TEDIT.SCROLL.CARET \TEDIT.VISIBLECARETP \TEDIT.VISIBLECHARP \TEDIT.BITMAPLINES \TEDIT.SETPANE.TOPLINE \TEDIT.SHIFTLINES) @@ -72,33 +71,11 @@ (* ; "Caret handler; stolen from CHAT.") (FNS \TEDIT.DOWNCARET \TEDIT.FLASHCARET \TEDIT.UPCARET TEDIT.NORMALIZECARET \TEDIT.SETCARET \TEDIT.CARET)) - [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) - [DECLARE%: DONTEVAL@LOAD DOCOPY - (VARS (TEDIT.DEFAULT.MENU (\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS - |Put Formatted Document| - Plain-Text)) - (Get 'Get NIL (SUBITEMS - |Get Formatted Document| - - Unformatted% Get - )) - Include Find Looks Substitute - (Buttons 'Buttons - "Display action buttons") - Quit - (Expanded% Menu 'Expanded% Menu - NIL - (SUBITEMS Expanded% Menu - Character% Looks - Paragraph% Formatting - Page% Layout] + [COMS (* ; "Background menu") (DECLARE%: DONTEVAL@LOAD DOCOPY (P [OR (SASSOC 'TEdit BackgroundMenuCommands) (NCONC1 BackgroundMenuCommands '(TEdit '(TEDIT) - "Opens a TEdit window for use."] + "Opens an empty TEdit window"] (SETQ BackgroundMenu NIL] (COMS (* ; "titled icon info, ") (FILES ICONW) @@ -148,8 +125,6 @@ (ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM 'TEXTSTREAM) (PUTWINDOWPROP DATUM 'TEXTSTREAM NEWVALUE)) - (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) - of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (CURSORREGION (GETWINDOWPROP DATUM 'TEDIT.CURSORREGION) @@ -162,13 +137,16 @@ (TYPENAMEP (fetch (TEXTWINDOW PTEXTOBJ) of DATUM) 'TEXTOBJ]) -(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") - PREFIXLINE (* ; +(DATATYPE PANEPROPS + ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") + PREFIXLINE (* ;  "Dummy line that covers all the characters above the first visible line") - SUFFIXLINE (* ; + SUFFIXLINE (* ;  "Dummy line that covers all the characters below the last visible line") - PCARET NEXTPANE (PREVPANE XPOINTER) - PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION)) + PCARET NEXTPANE (PREVPANE 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)) ) (/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER @@ -188,7 +166,7 @@ (/DECLAREDATATYPE 'PANEPROPS '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER) + POINTER POINTER POINTER POINTER) '((PANEPROPS 0 FULLXPOINTER) (PANEPROPS 2 POINTER) (PANEPROPS 4 POINTER) @@ -201,8 +179,9 @@ (PANEPROPS 18 POINTER) (PANEPROPS 20 POINTER) (PANEPROPS 22 POINTER) - (PANEPROPS 24 POINTER)) - '26) + (PANEPROPS 24 POINTER) + (PANEPROPS 26 POINTER)) + '28) (DECLARE%: EVAL@COMPILE (PUTPROPS FGETPANEPROP MACRO ((P FIELD) @@ -219,6 +198,9 @@ ) (DECLARE%: EVAL@COMPILE +(PUTPROPS PANEWINDOW MACRO ((PANE) + PANE)) + (PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE))) @@ -239,26 +221,36 @@ PCARET) 'TEDITCARET))) -(PUTPROPS PANESTREAM MACRO ((PANE) - (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 PANETOBJ MACRO [(PANE) - (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (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))) ) (DECLARE%: EVAL@COMPILE (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]) @@ -271,11 +263,14 @@ (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 PANEHEIGHT MACRO ((PANE PREG) + (GETPANEPROP (PANEPROPS PANE) + PANEHEIGHT))) -(PUTPROPS PANEREGION MACRO ((PANE PREG) - (OR PREG (DSPCLIPPINGREGION NIL PANE)))) +(PUTPROPS PANEREGION MACRO [(PANE PREG) + (OR PREG (GETPANEPROP (PANEPROPS PANE) + PANEREGION) + (DSPCLIPPINGREGION NIL (PANEWINDOW PANE]) ) (DECLARE%: EVAL@COMPILE @@ -320,7 +315,7 @@ (/DECLAREDATATYPE 'PANEPROPS '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER) + POINTER POINTER POINTER POINTER) '((PANEPROPS 0 FULLXPOINTER) (PANEPROPS 2 POINTER) (PANEPROPS 4 POINTER) @@ -333,8 +328,9 @@ (PANEPROPS 18 POINTER) (PANEPROPS 20 POINTER) (PANEPROPS 22 POINTER) - (PANEPROPS 24 POINTER)) - '26) + (PANEPROPS 24 POINTER) + (PANEPROPS 26 POINTER)) + '28) (FILESLOAD ATTACHEDWINDOW) (DEFINEQ @@ -357,7 +353,9 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 18-Feb-2025 09:49 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 25-Apr-2025 21:24 by rmk") + (* ; "Edited 20-Apr-2025 15:21 by rmk") + (* ; "Edited 18-Feb-2025 09:49 by rmk") (* ; "Edited 1-Jul-2024 22:55 by rmk") (* ; "Edited 29-Jun-2024 23:16 by rmk") (* ; "Edited 5-May-2024 21:54 by rmk") @@ -380,11 +378,12 @@ (* ;; "If the region/window is typed, we grab (or create) a region of that type. The usual entry (TEDIT) defaults to type Tedit, giving a stack of regions in TYPED-REGIONS. The effect is that the next (Tedit) window will open where the last Tedit window closed. It's a little tricky for REGIONMANAGER to compensate for the prompt window, but it means that the user can reshape what is initially offered.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PHEIGHT 0) TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) (CL:WHEN (WINDOWP WINDOW) - (CL:WHEN (SETQ WTEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)) + (CL:WHEN (SETQ WTEXTOBJ (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW) + TEXTOBJ)) (* ;; "Reusing an existing Tedit window, undo its splits.") @@ -452,12 +451,14 @@ (* ;; "Make the window's dimensions available thru TSTREAM even though it hasn't yet been configured for the text") - (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS) + (FSETTOBJ TEXTOBJ PRIMARYPANE (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS)) + (* ; "This should be PANE") (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) (\TEDIT.WINDOW.GETREGION - [LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 31-Mar-2025 22:43 by rmk") + [LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 14-Apr-2025 00:05 by rmk") + (* ; "Edited 31-Mar-2025 22:43 by rmk") (* ; "Edited 24-Mar-2025 11:29 by rmk") (* ; "Edited 18-Mar-2025 21:52 by rmk") (* ; "Edited 19-Feb-2025 16:48 by rmk") @@ -473,20 +474,24 @@ (if (IGREATERP (TEXTLEN TEXTOBJ) 0) then - (* ;; "Explict user properties cover everything, otherwise allow for extra stuff") + (* ;; "Explict user properties covers content") [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH) (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) largest (GETPLOOKS PARALOOKS RIGHTMAR) finally (CL:UNLESS (AND $$EXTREME (IGREATERP $$EXTREME 0)) - (SETQ $$EXTREME (TIMES 6 PTSPERINCH))) - (* ; "36 for right margin selection") - (RETURN (IPLUS $$EXTREME \TEDIT.LINEREGION.WIDTH 36 - (ADD1 (TIMES 2 WBorder) - 1) - (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) - 0 - \TEDIT.OP.WIDTH)] + (SETQ $$EXTREME (TIMES 6 PTSPERINCH))) + (RETURN $$EXTREME] + + (* ;; "Allow for extra stuff. 36 to allow for some spacing.") + + [add WIDTH (IPLUS \TEDIT.LINEREGION.WIDTH (ADD1 (TIMES 2 WBorder) + 1) + (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) + 0 + (CL:IF (EQ 0 \TEDIT.OP.WIDTH) + \TEDIT.LINEREGION.WIDTH + (IPLUS \TEDIT.OP.WIDTH 36)))] [SETQ HEIGHT (if (GETTEXTPROP TEXTOBJ 'OPENHEIGHT) elseif (ZEROP (TEXTLEN TEXTOBJ)) then 50 @@ -504,11 +509,11 @@ (IMAX 100 (ADD1 (TIMES 2 WBorder]) (\TEDIT.WINDOW.SETUP - [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 25-Nov-2024 20:10 by rmk") + [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 21-Apr-2025 12:02 by rmk") + (* ; "Edited 6-Apr-2025 18:56 by rmk") + (* ; "Edited 5-Apr-2025 14:07 by rmk") + (* ; "Edited 25-Nov-2024 20:10 by rmk") (* ; "Edited 21-Nov-2024 21:12 by rmk") - (* ; "Edited 18-Nov-2024 21:14 by rmk") - (* ; "Edited 4-Nov-2024 19:47 by rmk") - (* ; "Edited 3-Nov-2024 07:49 by rmk") (* ; "Edited 5-Jul-2024 11:38 by rmk") (* ; "Edited 18-May-2024 16:50 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") @@ -540,17 +545,17 @@ (* ;; "") - (\TEDIT.PANE.CREATELINES TEXTOBJ PANE (AND LCHAR1 (SUB1 LCHAR1))) + (\TEDIT.PANE.CREATELINES TSTREAM PANE (AND LCHAR1 (SUB1 LCHAR1))) (CL:UNLESS (OR LCHAR1 (EQ 0 (TEXTLEN TEXTOBJ))) (LINKLD (PANEPREFIX PANE) - (\TEDIT.FORMATLINE TEXTOBJ 1))) + (\TEDIT.FORMATLINE TSTREAM 1))) (CL:WHEN (PANETOPLINE PANE) [SETYBOT (PANEPREFIX PANE) (IPLUS (FGETLD (PANETOPLINE PANE) LLEADBEFORE) (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL PANE]) (\TEDIT.CLEARPANE PANE) - (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ (\TEDIT.LINES.BELOW NIL PANE TEXTOBJ)) + (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM (\TEDIT.LINES.BELOW NIL PANE TSTREAM)) (CL:WHEN AFTERPANE (for PANE inpanes (PROGN TEXTOBJ) as L1 on (GETSEL SEL L1) as LN on (GETSEL SEL LN) when (EQ PANE AFTERPANE) do (push (CDR L1) @@ -558,13 +563,15 @@ (push (CDR LN) NIL))) (FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL (AND AFTERPANE PANE)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ (AND AFTERPANE PANE)) - (\TEDIT.SHOWSEL SEL T TEXTOBJ (AND AFTERPANE PANE)) + (\TEDIT.FIXSEL SEL TSTREAM (AND AFTERPANE PANE)) (* ; + "If not fixed, the highlight in the lower pane will disappear") + (\TEDIT.NOSEL TSTREAM NIL (AND AFTERPANE PANE)) + (\TEDIT.SHOWSEL SEL T TSTREAM (AND AFTERPANE PANE)) (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) (\TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (PANE TSTREAM PROPS AFTERPANE) (* ; "Edited 30-Nov-2024 13:32 by rmk") + [LAMBDA (PANEWINDOW TSTREAM PROPS) (* ; "Edited 20-Apr-2025 15:19 by rmk") + (* ; "Edited 30-Nov-2024 13:32 by rmk") (* ; "Edited 4-Nov-2024 19:46 by rmk") (* ; "Edited 26-Oct-2024 11:10 by rmk") (* ; "Edited 27-Aug-2024 10:11 by rmk") @@ -583,34 +590,36 @@ (* ; "Edited 18-Sep-2023 23:44 by rmk") (* ; "Edited 30-May-91 23:33 by jds") - (* ;; "Do the minimum setup so that the window PANE becomes a pane of TSTREAM and TSTREAM and PANE know about each other. Does NOT include mouse interface or scrolling/lines") + (* ;; "Do the minimum setup so that the window PANEWINDOW becomes the window of a pane of TSTREAM and TSTREAM and PANE know about each other. Does NOT include mouse interface or scrolling/lines.") - (* ;; "If AFTERPANE is non-NIL, the new pnae will be placed after AFTERPANE in the TEXTOBJ's pane list. This maintains an ordering of panes, for splitting and unsplitting.") + (* ;; "") - (\DTEST PANE 'WINDOW) - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (* ;; "THIS SHOULD RETURN A PANE, NOT PANEWINDOW") + + (\DTEST PANEWINDOW 'WINDOW) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) [PANEPROPS (create PANEPROPS - PWINDOW _ PANE + PWINDOW _ PANEWINDOW PCARET _ (create TEDITCARET TCFORCEUP _ T - TCCARETDS _ (WINDOWPROP PANE 'DSP] - DS PREG OLDPANES) (* ; "The displaystream for flashing the caret. Caret starts off, so it doesn't flash before its position is known") - (replace (TEXTWINDOW PANEPROPS) of PANE with PANEPROPS) - (SETQ DS (WINDOWPROP PANE 'DSP)) - (FSETTOBJ TEXTOBJ SELPANE PANE) - (WINDOWPROP PANE 'PROCESS NIL) (* ; + TCCARETDS _ (WINDOWPROP PANEWINDOW 'DSP] + DS PREG) (* ; "The displaystream for flashing the caret. Caret starts off, so it doesn't flash before its position is known") + (replace (TEXTWINDOW PANEPROPS) of PANEWINDOW with PANEPROPS) + (SETQ DS (WINDOWPROP PANEWINDOW 'DSP)) + (FSETTOBJ TEXTOBJ SELPANE PANEWINDOW) + (WINDOWPROP PANEWINDOW 'PROCESS NIL) (* ;  "For the moment, this pane has no process") - (replace (TEXTWINDOW WTEXTSTREAM) of PANE with TSTREAM) + (replace (TEXTWINDOW WTEXTSTREAM) of PANEWINDOW with TSTREAM) (* ; "TSTREAM is accessible from WINDOW") - (replace (TEXTWINDOW CURSORREGION) of PANE with (CREATEREGION 0 0 0 0)) + (replace (TEXTWINDOW CURSORREGION) of PANEWINDOW with (CREATEREGION 0 0 0 0)) (* ; "Used by CursorMovedFn") (DSPRIGHTMARGIN 32767 DS) (* ;  "So we don't get spurious RETURNs printed out by the system") (FSETTOBJ TEXTOBJ DISPLAYCACHE (CAR (\TEDIT.CREATE.LINECACHE 1))) (* ;  "A CACHE for creating line images for display") - [FSETTOBJ TEXTOBJ DISPLAYCACHEDS (DSPCREATE (fetch LCBITMAP of (GETTOBJ TEXTOBJ DISPLAYCACHE - ] + [FSETTOBJ TEXTOBJ DISPLAYCACHEDS (DSPCREATE (fetch LCBITMAP of (FGETTOBJ TEXTOBJ + DISPLAYCACHE] (* ;  "A displaystream for changing the image caches") (DSPOPERATION 'PAINT (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) @@ -632,51 +641,37 @@ (SETQ PANEBOTTOM (fetch (REGION BOTTOM) of PREG)) (SETQ PANETOP (fetch (REGION TOP) of PREG)) (SETQ PANEREGION PREG)) - (WITH TEXTOBJ TEXTOBJ (SETQ WTOP (fetch (REGION PTOP) of PREG)) - (SETQ WRIGHT (fetch (REGION RIGHT) of PREG)) - (SETQ WBOTTOM (fetch (REGION BOTTOM) of PREG)) - (SETQ WLEFT (fetch (REGION LEFT) of PREG))) (* ;; "") - (WINDOWPROP PANE 'CURSORMOVEDFN (FUNCTION \TEDIT.CURSORMOVEDFN)) - (WINDOWPROP PANE 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN)) - (WINDOWPROP PANE 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP PANE 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP PANE 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) - (WINDOWPROP PANE 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN)) - (WINDOWPROP PANE 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) - (WINDOWPROP PANE 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) - (WINDOWPROP PANE 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN)) - (WINDOWPROP PANE 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) - (WINDOWPROP PANE 'OFFSCREEN (OFFSCREENP PANE)) - (WINDOWPROP PANE 'SCROLLFN (OR (WINDOWPROP PANE 'SCROLLFN) - (FUNCTION \TEDIT.SCROLLFN))) - (WINDOWPROP PANE 'ICONFN (OR (WINDOWPROP PANE 'ICONFN) - (FUNCTION \TEDIT.SHRINK.ICONCREATE))) - (WINDOWPROP PANE 'TEDIT.TITLEMENUFN (OR (WINDOWPROP PANE 'TEDIT.TITLEMENUFN) - (LISTGET PROPS 'TITLEMENUFN) - (FUNCTION TEDIT.DEFAULT.MENUFN))) - (WINDOWADDPROP PANE 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) - (WINDOWADDPROP PANE 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) - (WINDOWADDPROP PANE 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) - (WINDOWADDPROP PANE 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) + (WINDOWPROP PANEWINDOW 'CURSORMOVEDFN (FUNCTION \TEDIT.CURSORMOVEDFN)) + (WINDOWPROP PANEWINDOW 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN)) + (WINDOWPROP PANEWINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) + (WINDOWPROP PANEWINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) + (WINDOWPROP PANEWINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) + (WINDOWPROP PANEWINDOW 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN)) + (WINDOWPROP PANEWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) + (WINDOWPROP PANEWINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) + (WINDOWPROP PANEWINDOW 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN)) + (WINDOWPROP PANEWINDOW 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) + (WINDOWPROP PANEWINDOW 'OFFSCREEN (OFFSCREENP PANEWINDOW)) + (WINDOWPROP PANEWINDOW 'SCROLLFN (OR (WINDOWPROP PANEWINDOW 'SCROLLFN) + (FUNCTION \TEDIT.SCROLLFN))) + (WINDOWPROP PANEWINDOW 'ICONFN (OR (WINDOWPROP PANEWINDOW 'ICONFN) + (FUNCTION \TEDIT.SHRINK.ICONCREATE))) + (WINDOWPROP PANEWINDOW 'TEDIT.TITLEMENUFN (OR (WINDOWPROP PANEWINDOW 'TEDIT.TITLEMENUFN) + (LISTGET PROPS 'TITLEMENUFN) + (FUNCTION TEDIT.DEFAULT.MENUFN))) + (WINDOWADDPROP PANEWINDOW 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) + (WINDOWADDPROP PANEWINDOW 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) + (WINDOWADDPROP PANEWINDOW 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) + (WINDOWADDPROP PANEWINDOW 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) (* ;; "Our CLOSEFN must be first in order to stop closing if the stream is busy.") - (WINDOWADDPROP PANE 'CLOSEFN (CL:IF AFTERPANE - [FUNCTION (LAMBDA (P) - (PUTWINDOWPROP P 'CLOSEFN NIL) - (\TEDIT.UNSPLITW P] - (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + (WINDOWADDPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW) T) - (CL:UNLESS (thereis P inpanes TEXTOBJ suchthat (EQ P PANE)) - (* ; "Don't re-add ") - (if AFTERPANE - then (* ; "Link it in after AFTERPANE ") - (\TEDIT.LINKPANES AFTERPANE PANE) - else (FSETTOBJ TEXTOBJ PRIMARYPANE PANE))) - PANE]) + PANEWINDOW]) (\TEDIT.CLEARPANE [LAMBDA (PANE PBOTTOM) (* ; "Edited 1-Dec-2024 11:43 by rmk") @@ -694,17 +689,11 @@ 'REPLACE]) (\TEDIT.FILL.PANES - [LAMBDA (TSTREAM ONLYPANE) (* ; "Edited 29-Nov-2024 13:29 by rmk") - (* ; "Edited 27-Nov-2024 13:51 by rmk") - (* ; "Edited 21-Nov-2024 21:10 by rmk") - (* ; "Edited 19-Nov-2024 23:27 by rmk") - (* ; "Edited 18-Nov-2024 21:14 by rmk") + [LAMBDA (TSTREAM ONLYPANE) (* ; "Edited 21-Apr-2025 20:22 by rmk") + (* ; "Edited 5-Apr-2025 13:40 by rmk") + (* ; "Edited 29-Nov-2024 13:29 by rmk") (* ; "Edited 28-Oct-2024 16:29 by rmk") - (* ; "Edited 26-Oct-2024 15:38 by rmk") (* ; "Edited 6-Jul-2024 16:57 by rmk") - (* ; "Edited 30-Jun-2024 17:12 by rmk") - (* ; "Edited 25-Jun-2024 08:53 by rmk") - (* ; "Edited 17-Jun-2024 09:36 by rmk") (* ; "Edited 12-May-2024 21:36 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 30-Nov-2023 10:02 by rmk") @@ -717,7 +706,7 @@  "If called with a pane, the window system has cleared the bitmap, but we don't count on that.") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) SEL WASON) (CL:WHEN TEXTOBJ (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) @@ -733,15 +722,17 @@ (\TEDIT.SETCARET SEL P TEXTOBJ 'OFF) (\TEDIT.CLEARPANE P) - (\TEDIT.SUFFIXLINE.CREATE P TEXTOBJ (\TEDIT.LINES.BELOW NIL P TEXTOBJ)) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL P) + (\TEDIT.SUFFIXLINE.CREATE P TSTREAM (\TEDIT.LINES.BELOW NIL P TSTREAM)) (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ P)) - (CL:WHEN WASON (\TEDIT.SHOWSEL SEL T TEXTOBJ ONLYPANE)))]) + (CL:WHEN WASON (\TEDIT.SHOWSEL SEL T TSTREAM ONLYPANE)))]) ) (DEFINEQ (\TEDIT.CURSORMOVEDFN - [LAMBDA (PANE) (* ; "Edited 1-Dec-2024 11:55 by rmk") + [LAMBDA (PANE) (* ; "Edited 27-Apr-2025 23:43 by rmk") + (* ; "Edited 24-Apr-2025 10:35 by rmk") + (* ; "Edited 19-Apr-2025 22:22 by rmk") + (* ; "Edited 1-Dec-2024 11:55 by rmk") (* ; "Edited 22-Nov-2024 23:53 by rmk") (* ; "Edited 16-Nov-2024 20:18 by rmk") (* ; "Edited 28-Jun-2024 15:07 by rmk") @@ -753,89 +744,97 @@ (* ;; "Watch the mouse and change the cursor to reflect the region of the pane it's in (line select, pane split eventually?)") - (PROG ((X (LASTMOUSEX PANE)) - (Y (LASTMOUSEY PANE)) - (TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of PANE))) - (CURSORREG (fetch (TEXTWINDOW CURSORREGION) of PANE)) - LINE LEFT) - (CL:UNLESS (INSIDE? (PANEREGION PANE) - X Y) - (CURSOR T) - (RETURN)) - (CL:UNLESS (INSIDE? CURSORREG X Y) - [if (AND (IGEQ X (SETQ LEFT (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) - \TEDIT.OP.WIDTH))) - (IGEQ Y (IPLUS (PANEBOTTOM PANE) - \TEDIT.OP.BOTTOM)) - (NOT (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE))) - then - (* ;; "We're in the split region on the right") - - (CURSOR \TEDIT.SPLITCURSOR) - (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) (* ; - "PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.") - (replace (REGION LEFT) of CURSORREG with LEFT) - (replace (REGION WIDTH) of CURSORREG with \TEDIT.OP.WIDTH) - else - (* ;; "Not in the split region. Are we in the line-select region on the left? Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR") - - (SETQ LINE (find L inlines (GETPANEPROP (PANEPROPS PANE) - PREFIXLINE) - suchthat (ILEQ (FGETLD L YBOT) - Y))) - (CL:WHEN LINE (* ; - "The CURSORREGION picks out just LINE") - (replace BOTTOM of CURSORREG with (FGETLD LINE YBOT)) - (replace HEIGHT of CURSORREG with (FGETLD LINE LHEIGHT))) - - (* ;; "The line region gets wider if the paragraph is indented") + (CL:WHEN (fetch (TEXTWINDOW WTEXTSTREAM) of (OR (WINDOWP PANE) + (PANEWINDOW PANE))) + [PROG ((X (LASTMOUSEX PANE)) + (Y (LASTMOUSEY PANE)) + (TEXTOBJ (PANETEXTOBJ PANE)) + (CURSORREG (fetch (TEXTWINDOW CURSORREGION) of (PANEWINDOW PANE))) + LINE LEFT) + (CL:UNLESS (INSIDE? (PANEREGION PANE) + X Y) + (CURSOR T) + (RETURN)) + (CL:UNLESS (INSIDE? CURSORREG X Y) + [if [AND (IGEQ X (SETQ LEFT (IDIFFERENCE (PANERIGHT PANE) + \TEDIT.OP.WIDTH))) + (IGEQ Y (IPLUS (PANEBOTTOM PANE) + \TEDIT.OP.BOTTOM)) + (NOT (OR (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) + (EQ \TEDIT.OP.WIDTH -1] + then + (* ;; "We're in the split region on the right") - (SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN)) - (IPLUS (FGETTOBJ TEXTOBJ WLEFT) - \TEDIT.LINEREGION.WIDTH))) - (if (ILESSP X LEFT) - then - (* ;; "In left margin; switch to the line-select cursor") + (CURSOR \TEDIT.SPLITCURSOR) + (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) + (* ; + "PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.") + (replace (REGION LEFT) of CURSORREG with LEFT) + (replace (REGION WIDTH) of CURSORREG with \TEDIT.OP.WIDTH) + else + (* ;; "Not in the split region. Are we in the line-select region on the left? Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR") - (CURSOR \TEDIT.LINECURSOR) - (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE) - (replace (REGION LEFT) of CURSORREG with 0) - (replace (REGION WIDTH) of CURSORREG with LEFT) - else - (* ;; + (SETQ LINE (find L inlines (GETPANEPROP (PANEPROPS PANE) + PREFIXLINE) + suchthat (ILEQ (FGETLD L YBOT) + Y))) + (CL:WHEN LINE (* ; + "The CURSORREGION picks out just LINE") + (replace BOTTOM of CURSORREG with (FGETLD LINE YBOT)) + (replace HEIGHT of CURSORREG with (FGETLD LINE LHEIGHT))) + + (* ;; "The line region gets wider if the paragraph is indented") + + (SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN)) + (IPLUS (PANELEFT PANE) + \TEDIT.LINEREGION.WIDTH))) + (if (ILESSP X LEFT) + then + (* ;; "In left margin; switch to the line-select cursor") + + (CURSOR \TEDIT.LINECURSOR) + (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE) + (replace (REGION LEFT) of CURSORREG with 0) + (replace (REGION WIDTH) of CURSORREG with LEFT) + else + (* ;;  "Not in the line-select region, not in the split region, must be the main text. ") - (CURSOR T) - (FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT) - (replace (REGION LEFT) of CURSORREG with LEFT) - (replace (REGION WIDTH) of CURSORREG with (IDIFFERENCE (FGETTOBJ TEXTOBJ - WRIGHT) - (IPLUS LEFT + (CURSOR T) + (FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT) + (replace (REGION LEFT) of CURSORREG with LEFT) + (replace (REGION WIDTH) of CURSORREG with (IDIFFERENCE (PANERIGHT + PANE) + (IPLUS LEFT \TEDIT.LINEREGION.WIDTH - ])]) + ])])]) (\TEDIT.CURSOROUTFN - [LAMBDA (PANE) (* ; "Edited 20-Jul-2023 20:32 by rmk") + [LAMBDA (PANE) (* ; "Edited 4-May-2025 14:27 by rmk") + (* ; "Edited 20-Jul-2023 20:32 by rmk") (* ; "Edited 30-May-91 23:32 by jds") (* ;; "Cursor leaves edit pane; make sure we think we're in the text region.") (CURSOR T) - (SETTOBJ (fetch (TEXTWINDOW PTEXTOBJ) of PANE) - MOUSEREGION - 'TEXT]) + (CL:WHEN (fetch (TEXTWINDOW WTEXTSTREAM) of (OR (WINDOWP PANE) + (PANEWINDOW PANE))) + (SETTOBJ (PANETEXTOBJ PANE) + MOUSEREGION + 'TEXT))]) (\TEDIT.ACTIVE.WINDOWP - [LAMBDA (W) (* ; "Edited 20-Mar-2024 09:38 by rmk") + [LAMBDA (W) (* ; "Edited 27-Apr-2025 13:07 by rmk") + (* ; "Edited 20-Mar-2024 09:38 by rmk") (* ; "Edited 15-Mar-2024 18:37 by rmk") (* ; "Edited 11-Sep-2023 00:22 by rmk") (* ; "Edited 30-May-91 23:33 by jds") - (* ;; "RMK: Not sure that TEXTOBJ is ever T. Or that windows ever have a TEXTSTREAM property (vs TEXTOBJ).") + (* ;; "This is called by TEDIT-PROCESS-KILLER.") (* ;; "Decides whether a TEdit window is really in use. The function TEDIT will set the TEXTOBJ prop of the window to T pro tem, to reserve a window. Once the TEdit has really started, the TEXTOBJ property will be a real textobj.") - (LET ((TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of W))) + (LET ((TEXTOBJ (TEXTOBJ W T))) (AND (type? TEXTOBJ TEXTOBJ) (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) (PROCESSP (WINDOWPROP W 'PROCESS]) @@ -867,10 +866,10 @@ PRIM]) (\TEDIT.MAINSTREAM - [LAMBDA (TSTREAM) (* ; "Edited 20-Oct-2024 09:31 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 18-Apr-2025 15:02 by rmk") + (* ; "Edited 20-Oct-2024 09:31 by rmk") (LET ((MAINW (\TEDIT.MAINW TSTREAM))) - (CL:WHEN MAINW - (fetch (TEXTWINDOW WTEXTSTREAM) of MAINW))]) + (CL:WHEN MAINW (PANETEXTSTREAM MAINW]) (\TEDIT.PRIMARYPANE [LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 21:36 by rmk") @@ -1112,7 +1111,10 @@ (DEFINEQ (\TEDIT.BUTTONEVENTFN - [LAMBDA (PANE) (* ; "Edited 13-Feb-2025 11:53 by rmk") + [LAMBDA (PANE) (* ; "Edited 21-Apr-2025 20:19 by rmk") + (* ; "Edited 13-Apr-2025 13:33 by rmk") + (* ; "Edited 6-Apr-2025 18:59 by rmk") + (* ; "Edited 13-Feb-2025 11:53 by rmk") (* ; "Edited 6-Dec-2024 11:33 by rmk") (* ; "Edited 1-Dec-2024 12:03 by rmk") (* ; "Edited 27-Nov-2024 20:21 by rmk") @@ -1141,7 +1143,7 @@ (RESETLST (* ;  "Getting TTYPROC here allows HELP in debugging") (bind (TTYPROC _ (TTY.PROCESS)) - (TSTREAM _ (PANESTREAM PANE)) + (TSTREAM _ (PANETEXTSTREAM PANE)) (X _ (LASTMOUSEX PANE)) (Y _ (LASTMOUSEY PANE)) (DS _ (WINDOWPROP PANE 'DSP)) @@ -1181,7 +1183,7 @@ READONLY NIL)) (CL:UNLESS (SETQ CURSEL (  \TEDIT.BUTTONEVENTFN.CURSEL.INIT - NEWOPERATION TEXTOBJ)) + NEWOPERATION TSTREAM)) (RETURN)) (SETQ NEWSEL (\TEDIT.COPYSEL CURSEL)) (* ; @@ -1208,8 +1210,8 @@  "The mouse left the window: cleanup and leave. ") (CL:UNLESS (EQ CUROPERATION 'NORMAL) (* ;  "Take down the copy/delete/copylooks highlight") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) - (\TEDIT.SHOWSEL NIL T TEXTOBJ)) (* ; "Go back to original selection?") + (\TEDIT.NOSEL TSTREAM CURSEL) + (\TEDIT.SHOWSEL NIL T TSTREAM)) (* ; "Go back to original selection?") (* ;;  "Scroll if mouse moved to scroll bar (and scroll bar doesn't overlap the window)") @@ -1225,16 +1227,16 @@ (SETQ OLDX X) (SETQ OLDY Y) (CL:UNLESS (EQ NEWOPERATION CUROPERATION) (* ; "Keys changed ") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Switch to new highlighting") + (\TEDIT.NOSEL TSTREAM CURSEL) (* ; "Switch to new highlighting") (\TEDIT.SET.SEL.LOOKS CURSEL NEWOPERATION) (\TEDIT.SET.SEL.LOOKS NEWSEL NEWOPERATION) (CL:WHEN (EQ NEWOPERATION 'NORMAL) (* ;; "Switching from e.g. COPY to NORMAL with button down. Since we didn't start out NORMAL, the original normal selection is still on the screen. We take it down here, and establish the current (off) CURSEL as the new restoration selection") - (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM CURSEL) (\TEDIT.COPYSEL CURSEL (TEXTSEL TEXTOBJ))) - (\TEDIT.SHOWSEL CURSEL T TEXTOBJ) + (\TEDIT.SHOWSEL CURSEL T TSTREAM) (SETQ CUROPERATION NEWOPERATION)) (* ;; "Update NEWSEL each time around. Note that \TEDIT.XYTOSEL fixes but doesn't show the selection, we do that here. MOUSEREGION is set by \TEDITCURSORMOVEDFN, below.") @@ -1242,7 +1244,7 @@ (if (\TEDIT.MOUSESTATE RIGHT) then (* ;  "Right button: NEWSEL extends last CURSEL") - (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'RIGHT CURSEL) + (\TEDIT.XYTOSEL X Y NEWSEL TSTREAM CUROPERATION PANE 'RIGHT CURSEL) (CL:WHEN (FGETSEL NEWSEL SET) (CL:WHEN (AND TEDIT.EXTEND.PENDING.DELETE (NOT PENDINGDEL) (EQ CUROPERATION 'NORMAL) @@ -1250,22 +1252,22 @@ (* ;; "Switch to simulation of Laurel bluependingdelete: Black, deletes on type-in. Coerce CURSEL and display for pending looks. Otherwise, CURSEL is already BPD and stays on to avoid flicker in extending") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM CURSEL) (* ;  "Take down old looks, change, re-show") (\TEDIT.SET.SEL.LOOKS CURSEL 'PENDINGDEL) (\TEDIT.SET.SEL.LOOKS NEWSEL 'PENDINGDEL) - (\TEDIT.SHOWSEL CURSEL T TEXTOBJ) + (\TEDIT.SHOWSEL CURSEL T TSTREAM) (SETQ PENDINGDEL T)) - [\TEDIT.EXTEND.SEL NEWSEL CURSEL TEXTOBJ (MEMB CUROPERATION + [\TEDIT.EXTEND.SEL NEWSEL CURSEL TSTREAM (MEMB CUROPERATION '(COPY COPYLOOKS]) (* ; "No valid selection, go to cleanup") else (if (\TEDIT.MOUSESTATE LEFT) then (* ; "Left selects char/point. ") - (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'LEFT CURSEL) + (\TEDIT.XYTOSEL X Y NEWSEL TSTREAM CUROPERATION PANE 'LEFT CURSEL) elseif (\TEDIT.MOUSESTATE MIDDLE) then (* ; "Middle selects word/line") - (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'MIDDLE CURSEL + (\TEDIT.XYTOSEL X Y NEWSEL TSTREAM CUROPERATION PANE 'MIDDLE CURSEL )) (CL:WHEN (AND (FGETSEL NEWSEL SET) (\TEDIT.SEL.CHANGED? NEWSEL CURSEL) @@ -1274,9 +1276,9 @@ (* ;; "Selection has changed while at least one button is down. Take down current CURSEL highlighting, switch to NEWSEL. If the mouse condition is removed, the secondary selection can be lost if the mouse moves while the operation keys are still down. But if the copy isn't done when NEWSEL picks out an object, the object will be lost. ") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM CURSEL) (\TEDIT.COPYSEL NEWSEL CURSEL) - (\TEDIT.SHOWSEL CURSEL T TEXTOBJ))) + (\TEDIT.SHOWSEL CURSEL T TSTREAM))) (* ;; "CURSEL now matches the display and CUROPERATION.") finally @@ -1287,15 +1289,19 @@ (* ;; ".Here to restore when no valid selection, maybe an unhappy image object?") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Turn off CURSEL") + (\TEDIT.SHOWSEL CURSEL NIL TSTREAM) (* ; "Turn off CURSEL") (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) 'NORMAL) (* ; "Restore TEXTSEL") - (\TEDIT.SHOWSEL NIL T TEXTOBJ) + (\TEDIT.SHOWSEL NIL T TSTREAM) (RETURN)) (\TEDIT.BUTTONEVENTFN.DOOPERATION CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC))))]) (\TEDIT.BUTTONEVENTFN.DOOPERATION [LAMBDA (CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC) + (* ; "Edited 27-Apr-2025 22:26 by rmk") + (* ; "Edited 21-Apr-2025 20:32 by rmk") + (* ; "Edited 8-Apr-2025 10:03 by rmk") + (* ; "Edited 6-Apr-2025 18:02 by rmk") (* ; "Edited 25-Nov-2024 22:22 by rmk") (* ; "Edited 4-Nov-2024 13:09 by rmk") (* ; "Edited 3-Nov-2024 07:20 by rmk") @@ -1318,10 +1324,10 @@ (* ;; "On entry, CURSEL's highlighting is on the screen") (CL:WHEN (FGETSEL CURSEL SET) - (LET* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (TTYW (PROCESSPROP TTYPROC 'WINDOW)) (TTYSTREAM (AND TTYW (fetch (TEXTWINDOW WTEXTSTREAM) of TTYW))) - [TTYSEL (AND TTYSTREAM (TEXTSEL (GETTSTR TTYSTREAM TEXTOBJ] + [TTYSEL (AND TTYSTREAM (TEXTSEL (FTEXTOBJ TTYSTREAM] (SELFN (GETTEXTPROP TEXTOBJ 'SELFN)) (TEXTSEL (TEXTSEL TEXTOBJ))) @@ -1339,7 +1345,7 @@ (* ;; "\TEDIT.DELETE converts TTYSEL (= TEXTSEL) to a point-caret.") (\TEDIT.COPYSEL CURSEL TEXTSEL) - (CL:WHEN (\TEDIT.DELETE TEXTOBJ TEXTSEL) + (CL:WHEN (\TEDIT.DELETE TSTREAM TEXTSEL) (* ;  "Make sure the caret blinks in the position of a successful deletion") (FSETSEL TEXTSEL HASCARET T)) @@ -1347,8 +1353,8 @@ (COPY (CL:IF TTYSEL (\TEDIT.COPY CURSEL TTYSEL TSTREAM TTYSTREAM) (\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM)) - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ)) - (MOVE (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.NOSEL TSTREAM CURSEL)) + (MOVE (\TEDIT.NOSEL TSTREAM CURSEL) (if TTYSEL then (\TEDIT.MOVE CURSEL TTYSEL TSTREAM TTYSTREAM) else (\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM) @@ -1356,9 +1362,9 @@ (\TEDIT.UPDATE.SEL TEXTSEL (FGETSEL CURSEL CH#) 0 'RIGHT) - (\TEDIT.DELETE TEXTOBJ CURSEL) - (\TEDIT.SHOWSEL TEXTSEL T TEXTOBJ))) - (COPYLOOKS (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.DELETE TSTREAM CURSEL) + (\TEDIT.SHOWSEL TEXTSEL T TSTREAM))) + (COPYLOOKS (\TEDIT.NOSEL TSTREAM CURSEL) (if TTYSEL then (if (EQ 'PARA (FGETSEL CURSEL SELKIND)) then (\TEDIT.CHANGE.PARALOOKS TTYSTREAM @@ -1379,6 +1385,7 @@ TEXTOBJ)) CURSEL)))) (\TEDIT.THELP "Bad selection operation" CUROPERATION)) + (FSETTOBJ TEXTOBJ SELPANE PANE) (CL:UNLESS PENDINGDEL (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) 'NORMAL)) @@ -1424,7 +1431,10 @@ 'NORMAL]) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT - [LAMBDA (NEWOPERATION TEXTOBJ) (* ; "Edited 30-Nov-2024 15:45 by rmk") + [LAMBDA (NEWOPERATION TSTREAM) (* ; "Edited 21-Apr-2025 20:01 by rmk") + (* ; "Edited 6-Apr-2025 18:57 by rmk") + (* ; "Edited 5-Apr-2025 13:20 by rmk") + (* ; "Edited 30-Nov-2024 15:45 by rmk") (* ; "Edited 27-Nov-2024 20:23 by rmk") (* ; "Edited 22-Oct-2024 23:10 by rmk") (* ; "Edited 20-Oct-2024 23:38 by rmk") @@ -1435,50 +1445,51 @@ (* ;; "NILvalue signals abort") - (PROG [(CURSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ] - (SELECTQ NEWOPERATION - (NORMAL - (* ;; + (PROG* [(TEXTOBJ (FTEXTOBJ TSTREAM)) + (CURSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ] + (SELECTQ NEWOPERATION + (NORMAL + (* ;;  "Operating in this document. Our initial CURSEL is consistent with TEXTSEL and display.") - (FSETSEL (TEXTSEL TEXTOBJ) - ONFLG NIL) (* ; + (FSETSEL (TEXTSEL TEXTOBJ) + ONFLG NIL) (* ;  "Transferred display status to CURSEL, restore later if needed") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Take down current hilight") - (if (\TEDIT.MOUSESTATE RIGHT) - then - (* ;; "Extending the current selection: coerce to PENDINGDEL/black") - - (\TEDIT.SET.SEL.LOOKS CURSEL 'PENDINGDEL) - elseif (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) - then - (* ;; + (\TEDIT.NOSEL TSTREAM CURSEL) (* ; "Take down current hilight") + (if (\TEDIT.MOUSESTATE RIGHT) + then + (* ;; "Extending the current selection: coerce to PENDINGDEL/black") + + (\TEDIT.SET.SEL.LOOKS CURSEL 'PENDINGDEL) + elseif (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) + then + (* ;;  "Not extending: turn off BPD highlighting and reduce to a point selection at the caret.") - (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL) - (\TEDIT.UPDATE.SEL CURSEL (TEDIT.GETPOINT TEXTOBJ CURSEL) - 0 NIL 'NORMAL) - (\TEDIT.FIXSEL CURSEL TEXTOBJ) - (\TEDIT.SHOWSEL CURSEL T TEXTOBJ)) - (\TEDIT.SHOWSEL CURSEL T TEXTOBJ)) - (DELETE - (* ;; + (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL) + (\TEDIT.UPDATE.SEL CURSEL (TEDIT.GETPOINT TEXTOBJ CURSEL) + 0 NIL 'NORMAL) + (\TEDIT.SHOWSEL CURSEL T TSTREAM)) + (\TEDIT.SHOWSEL CURSEL T TSTREAM)) + (DELETE + (* ;;  "Deleting (CTRL) somewhere else. Turn off CURSEL's highlighting, which was transferred from TEXTSEL") - (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS CURSEL 'DELETE)) - ((MOVE COPY COPYLOOKS) - (* ;; "Source text from here, TTY target maythat be here, another Tedit, or foreign. TEXTSEL remains visible ") + (\TEDIT.NOSEL TSTREAM CURSEL) + (\TEDIT.SET.SEL.LOOKS CURSEL 'DELETE)) + ((MOVE COPY COPYLOOKS) + (* ;; "Source text from here, TTY target maythat be here, another Tedit, or foreign. TEXTSEL remains visible ") - (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; "Funny to copy while extending") - (RETURN)) - (\TEDIT.SET.SEL.LOOKS CURSEL NEWOPERATION) - (FSETSEL CURSEL SET NIL)) - (FSETSEL CURSEL SET NIL)) - (RETURN CURSEL]) + (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; "Funny to copy while extending") + (RETURN)) + (\TEDIT.SET.SEL.LOOKS CURSEL NEWOPERATION) + (FSETSEL CURSEL SET NIL)) + (FSETSEL CURSEL SET NIL)) + (RETURN CURSEL]) (\TEDIT.BUTTONEVENTFN.INACTIVE - [LAMBDA (TEXTOBJ PANE) (* ; "Edited 24-Apr-2024 09:45 by rmk") + [LAMBDA (TEXTOBJ PANE) (* ; "Edited 18-Apr-2025 15:14 by rmk") + (* ; "Edited 24-Apr-2024 09:45 by rmk") (* ; "Edited 16-Mar-2024 00:22 by rmk") (* ; "Edited 9-Feb-2024 00:00 by rmk") (* ; "Edited 27-Jan-2024 11:40 by rmk") @@ -1514,7 +1525,7 @@ (* ;; "Why do we need a Middle-button menu to restart a dead window. If it's clicked in, just restart it.") (SETTOBJ TEXTOBJ EDITOPACTIVE NIL) - (TEDIT (fetch (TEXTWINDOW WTEXTSTREAM) of PANE) + (TEDIT (PANETEXTSTREAM PANE) PANE) NIL]) @@ -1601,7 +1612,8 @@ (DEFINEQ (\TEDIT.PANE.SPLIT - [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 23-Oct-2024 09:50 by rmk") + [LAMBDA (TEXTOBJ PANE) (* ; "Edited 19-Apr-2025 22:17 by rmk") + (* ; "Edited 23-Oct-2024 09:50 by rmk") (* ; "Edited 21-Oct-2024 00:33 by rmk") (* ; "Edited 27-Jan-2024 11:39 by rmk") (* ; "Edited 1-Oct-2023 23:30 by rmk") @@ -1609,52 +1621,47 @@ (* ;; "If in the split region, determine and execute the splitting operations for PANE.") + (* ;; "This will not be called if splitting is always invoked from the menu.") + (CL:WHEN (EQ (GETTOBJ TEXTOBJ MOUSEREGION) 'PANE) (* ; "In the split/ops region") - [LET ([WINDOWOPREGION (create REGION - LEFT _ (DIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + [LET ((PANEWINDOW (PANEWINDOW PANE)) + (WINDOWOPREGION (create REGION + LEFT _ (DIFFERENCE (PANERIGHT PANE) \TEDIT.OP.WIDTH) BOTTOM _ \TEDIT.OP.BOTTOM WIDTH _ \TEDIT.OP.WIDTH - HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP WINDOWTOSPLIT - 'REGION] + HEIGHT _ (PANEHEIGHT PANE))) Y OPERATION) [while [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) - (SETQ Y (LASTMOUSEY WINDOWTOSPLIT] do + (INSIDE? WINDOWOPREGION (LASTMOUSEX PANEWINDOW) + (SETQ Y (LASTMOUSEY PANEWINDOW] do (* ;;  "Wait until he lets up on a button, and signal which button was last pushed.") - (BLOCK) - (COND - ((MOUSESTATE MIDDLE) - (CURSOR - \TEDIT.MAKESPLITCURSOR - ) - (SETQ OPERATION - 'SPLIT)) - ((MOUSESTATE LEFT) - (CURSOR - \TEDIT.MOVESPLITCURSOR - ) - (SETQ OPERATION - 'MOVE)) - ((MOUSESTATE RIGHT) - (CURSOR - \TEDIT.UNSPLITCURSOR - ) - (SETQ OPERATION - 'UNSPLIT] + (BLOCK) + (COND + ((MOUSESTATE MIDDLE) + (CURSOR \TEDIT.MAKESPLITCURSOR + ) + (SETQ OPERATION 'SPLIT)) + ((MOUSESTATE LEFT) + (CURSOR \TEDIT.MOVESPLITCURSOR + ) + (SETQ OPERATION 'MOVE)) + ((MOUSESTATE RIGHT) + (CURSOR \TEDIT.UNSPLITCURSOR) + (SETQ OPERATION 'UNSPLIT] (COND - ((INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) - (SETQ Y (LASTMOUSEY WINDOWTOSPLIT))) + ((INSIDE? WINDOWOPREGION (LASTMOUSEX PANEWINDOW) + (SETQ Y (LASTMOUSEY PANEWINDOW))) (CURSOR \TEDIT.SPLITCURSOR) (SELECTQ OPERATION (SPLIT (* ; "Splitting the window") - (\TEDIT.SPLITW WINDOWTOSPLIT Y)) + (\TEDIT.SPLITW PANE Y)) (UNSPLIT (* ; "Rejoining two panes") - (\TEDIT.UNSPLITW WINDOWTOSPLIT)) + (\TEDIT.UNSPLITW PANE)) (MOVE (* ;  "Moving the divider between two panes.") (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T T @@ -1664,19 +1671,16 @@ T)]) (\TEDIT.SPLITW - [LAMBDA (OLDPANE Y) (* ; "Edited 1-Dec-2024 11:27 by rmk") + [LAMBDA (OLDPANE Y) (* ; "Edited 4-May-2025 14:04 by rmk") + (* ; "Edited 21-Apr-2025 20:20 by rmk") + (* ; "Edited 20-Apr-2025 15:20 by rmk") + (* ; "Edited 13-Apr-2025 15:21 by rmk") + (* ; "Edited 5-Apr-2025 13:04 by rmk") + (* ; "Edited 1-Dec-2024 11:27 by rmk") (* ; "Edited 20-Nov-2024 12:37 by rmk") - (* ; "Edited 17-Nov-2024 18:59 by rmk") (* ; "Edited 5-Jul-2024 11:37 by rmk") - (* ; "Edited 30-Jun-2024 21:59 by rmk") - (* ; "Edited 28-Jun-2024 21:08 by rmk") - (* ; "Edited 21-Jun-2024 22:47 by rmk") - (* ; "Edited 19-Jun-2024 08:57 by rmk") - (* ; "Edited 17-Jun-2024 09:01 by rmk") - (* ; "Edited 13-Jun-2024 17:34 by rmk") (* ; "Edited 18-May-2024 16:24 by rmk") (* ; "Edited 24-Apr-2024 09:42 by rmk") - (* ; "Edited 5-May-2024 23:13 by rmk") (* ; "Edited 20-Mar-2024 11:01 by rmk") (* ; "Edited 8-Feb-2024 23:38 by rmk") (* ; "Edited 2-Jan-2024 19:21 by rmk") @@ -1690,89 +1694,99 @@ (* ;; "Original code was goofy: after carefully setting things up, attached menus and prompts would move into the main-window space. Setting and reseting the ATTACHEDWINDOWS property seems to fix that.") - (LET* ((WREG (WINDOWPROP OLDPANE 'REGION)) - (TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of OLDPANE)) - (TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) - (SEL (TEXTSEL TEXTOBJ)) - (NEXTPANE (GETPANEPROP (PANEPROPS OLDPANE) - NEXTPANE)) - ATTACHEDWINDOWS NEWPANE PROPS NEXTCHAR1) - (CL:UNLESS Y (* ; + (SELECTQ Y + (T (SETQ Y (PANECARETY OLDPANE))) + (NIL (* ;  "Y-position of the split, either supplied or mouse.") - (SETQ Y (LASTMOUSEY OLDPANE))) - (CL:WHEN NEXTPANE (* ; + (SETQ Y (LASTMOUSEY OLDPANE))) + NIL) + (CL:WHEN (AND (FIXP Y) + (IGREATERP Y 0)) + (PROG* ((TSTREAM (PANETEXTSTREAM OLDPANE)) + (TEXTOBJ (FTEXTOBJ TSTREAM)) + (PREG (WINDOWPROP OLDPANE 'REGION)) + (SEL (TEXTSEL TEXTOBJ)) + (NEXTPANE (NEXTPANE OLDPANE)) + ATTACHEDWINDOWS NEWPANE PROPS NEXTCHAR1) + (CL:WHEN (ZEROP (TEXTLEN TEXTOBJ)) + (RETURN)) + (CL:WHEN NEXTPANE (* ;  "If there's already a pane below this one, detach it for the moment.") - (DETACHWINDOW NEXTPANE)) - (SETQ ATTACHEDWINDOWS (WINDOWPROP OLDPANE 'ATTACHEDWINDOWS NIL)) + (DETACHWINDOW NEXTPANE)) + (SETQ ATTACHEDWINDOWS (WINDOWPROP OLDPANE 'ATTACHEDWINDOWS NIL)) - (* ;; "Reshape the original window to form the upper pane. This fixes/displays the current selection in all existing panes") + (* ;; "Reshape the original window to form the upper pane. This fixes/displays the current selection in all existing panes. ") - (SHAPEW OLDPANE (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM of WREG) - Y) - HEIGHT _ (IDIFFERENCE (fetch HEIGHT of WREG) - Y))) + (SHAPEW OLDPANE (create REGION using PREG BOTTOM _ (IPLUS (fetch BOTTOM of PREG) + Y) + HEIGHT _ (IDIFFERENCE (fetch HEIGHT of PREG) + Y))) - (* ;; + (* ;;  "OLDPANE has now been shrunk, redisplayed with new lines, and highlighted. The selection is on.") - (* ;; "Attach the new window, without disturbing the pre-existing attached windows") + (* ;; "Attach the new window, without disturbing the pre-existing attached windows") - (SETQ NEWPANE (CREATEW (create REGION using WREG HEIGHT _ Y))) - (ATTACHWINDOW NEWPANE OLDPANE 'BOTTOM 'JUSTIFY 'MAIN) + (SETQ NEWPANE (CREATEW (create REGION using PREG HEIGHT _ Y))) + (ATTACHWINDOW NEWPANE OLDPANE 'BOTTOM 'JUSTIFY 'MAIN) (* ; "and attach a lower pane.") - [WINDOWPROP OLDPANE 'ATTACHEDWINDOWS (APPEND ATTACHEDWINDOWS (WINDOWPROP OLDPANE - 'ATTACHEDWINDOWS] + [WINDOWPROP OLDPANE 'ATTACHEDWINDOWS (APPEND ATTACHEDWINDOWS (WINDOWPROP OLDPANE + 'ATTACHEDWINDOWS] - (* ;; "[end of attached-window hackery to prevent disturbance while short]") + (* ;; "[end of attached-window hackery to prevent disturbance while short]") - (* ;; "") + (* ;; "") - (WINDOWPROP NEWPANE 'TEDITCREATED T) - (DSPFONT (GETCLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS) - CLFONT) - NEWPANE) (* ; + (WINDOWPROP NEWPANE 'TEDITCREATED T) + (DSPFONT (GETCLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS) + CLFONT) + NEWPANE) (* ;  "Set the font on the display stream to be the current one from CARETLOOKS") - (* ;; - "Not sure if same PROPS as for OLDPANE (which this would inherit from primary window)") + (* ;; "Not sure if same PROPS as for OLDPANE (which this would inherit from primary window)") - [SETQ PROPS (APPEND '(NOTITLE T PROMPTWINDOW DON'T TITLEMENUFN NILL) - (COPY (FGETTOBJ TEXTOBJ EDITPROPS] - (\TEDIT.MINIMAL.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE) + [SETQ PROPS (APPEND '(NOTITLE T PROMPTWINDOW DON'T TITLEMENUFN NILL) + (COPY (FGETTOBJ TEXTOBJ EDITPROPS] + (\TEDIT.LINKPANES OLDPANE (\TEDIT.MINIMAL.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE)) - (* ;; "Insert L1 and LN cells for NEWPANEafter OLDPANE's cells in each selection. The selections were created when the original textsteam was opened.") + (* ;; "Insert L1 and LN cells for NEWPANEafter OLDPANE's cells in each selection. The selections were created when the original textsteam was opened.") - (* ;; "Create the first line of NEWPANE starting at the character just after the last line of the now-shrunken OLDPANE. ") + (* ;; "Create the first line of NEWPANE starting at the character just after the last line of the now-shrunken OLDPANE. ") - [SETQ NEXTCHAR1 (for L (BOTTOM _ (PANEBOTTOM OLDPANE)) inlines (PANEPREFIX OLDPANE) - unless (AND (FGETLD L NEXTLINE) - (IGEQ (FGETLD (FGETLD L NEXTLINE) - YBOT) - BOTTOM)) - do - (* ;; + [SETQ NEXTCHAR1 (for L (BOTTOM _ (PANEBOTTOM OLDPANE)) inlines (PANEPREFIX OLDPANE) + unless (AND (FGETLD L NEXTLINE) + (IGEQ (FGETLD (FGETLD L NEXTLINE) + YBOT) + BOTTOM)) + do + (* ;;  "If we run off the end of the text, start with at least the last line (which may just be EOL's).") - (RETURN (if (AND (IGEQ (FGETLD L LCHAR1) - (TEXTLEN TEXTOBJ)) - (FGETLD L PREVLINE)) - then (FGETLD (FGETLD L PREVLINE) - LCHAR1) - else (FGETLD L LCHARLIM] - (\TEDIT.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE NEXTCHAR1) + (RETURN (if (AND (IGEQ (FGETLD L LCHAR1) + (TEXTLEN TEXTOBJ)) + (FGETLD L PREVLINE)) + then (FGETLD (FGETLD L PREVLINE) + LCHAR1) + else (FGETLD L LCHARLIM] + (\TEDIT.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE NEXTCHAR1) (* ; " OLDPANE covers everything before") - (WINDOWPROP NEWPANE 'PROCESS (WINDOWPROP OLDPANE 'PROCESS)) - (CL:WHEN (GETSEL SEL ONFLG) - (SETSEL SEL ONFLG NIL) (* ; + (WINDOWPROP NEWPANE 'PROCESS (WINDOWPROP OLDPANE 'PROCESS)) + (CL:WHEN (GETSEL SEL ONFLG) + (SETSEL SEL ONFLG NIL) (* ;  "Turn it off, so we can turn it on for NEWPANE") - (\TEDIT.SHOWSEL SEL T TEXTOBJ NEWPANE)) (* ; + (\TEDIT.SHOWSEL SEL T TSTREAM NEWPANE T)) (* ;  "Tell NEWPANE about the old pane below it") - (CL:WHEN NEXTPANE (* ; + (CL:WHEN NEXTPANE (* ;  "There was already a pane below this one. Attach it to the new lower pane.") - (ATTACHWINDOW NEXTPANE NEWPANE 'BOTTOM 'JUSTIFY 'MAIN))]) + (ATTACHWINDOW NEXTPANE NEWPANE 'BOTTOM 'JUSTIFY 'MAIN)) + (RETURN NEWPANE)))]) (\TEDIT.UNSPLITW - [LAMBDA (PANE) (* ; "Edited 1-Jul-2024 08:50 by rmk") + [LAMBDA (PANE) (* ; "Edited 4-May-2025 14:07 by rmk") + (* ; "Edited 20-Apr-2025 15:34 by rmk") + (* ; "Edited 19-Apr-2025 11:54 by rmk") + (* ; "Edited 13-Apr-2025 13:31 by rmk") + (* ; "Edited 1-Jul-2024 08:50 by rmk") (* ; "Edited 29-Jun-2024 09:00 by rmk") (* ; "Edited 18-May-2024 16:21 by rmk") (* ; "Edited 12-May-2024 20:58 by rmk") @@ -1786,49 +1800,52 @@ (* ; "Edited 2-Sep-2023 16:18 by rmk") (* ; "Edited 18-Apr-2023 23:41 by rmk") (* ; "Edited 6-Nov-2022 00:06 by rmk") - (PROG* ((TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)) - (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) - (SEL (FGETTOBJ TEXTOBJ SEL)) - PREVPANE NEXTPANE ATTACHEDWINDOWS) - (CL:WHEN (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) - (RETURN)) - (SETQ PREVPANE (GETPANEPROP (PANEPROPS PANE) - PREVPANE)) - (SETQ NEXTPANE (GETPANEPROP (PANEPROPS PANE) - NEXTPANE)) - (FSETTOBJ TEXTOBJ SELPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) - (for P inpanes TEXTOBJ as SL1 in (GETSEL SEL L1) as SLN in (GETSEL SEL LN) - when (EQ PANE P) do (change (GETSEL SEL L1) - (DREMOVE SL1 DATUM)) - (change (GETSEL SEL LN) - (DREMOVE SLN DATUM)) - (RETURN)) - (WINDOWPROP PANE 'CURSOROUTFN NIL) - (WINDOWPROP PANE 'CURSORMOVEDFN NIL) - (\TEDIT.UNLINKPANE PANE) (* ; "Disconnect") + (PROG ((TEXTOBJ (TEXTOBJ PANE T)) + SEL PREVPANE NEXTPANE ATTACHEDWINDOWS PANEWINDOW PREVPANEWINDOW NEXTPANEWINDOW) + (CL:UNLESS TEXTOBJ (RETURN)) + (CL:WHEN (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (TEDIT.PROMPTPRINT TEXTOBJ "Cannot remove the primary window-pane") + (RETURN)) + (SETQ SEL (TEXTSEL TEXTOBJ)) + (SETQ PREVPANE (PREVPANE PANE)) + (SETQ PREVPANEWINDOW PREVPANE) + (SETQ NEXTPANEWINDOW (PANEWINDOW (NEXTPANE PANE))) + (FSETTOBJ TEXTOBJ SELPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (* ; "Go back to the top window") + (for P inpanes TEXTOBJ as SL1 in (GETSEL SEL L1) as SLN in (GETSEL SEL LN) + when (EQ PANE P) do (change (GETSEL SEL L1) + (DREMOVE SL1 DATUM)) + (change (GETSEL SEL LN) + (DREMOVE SLN DATUM)) + (RETURN)) + (SETQ PANEWINDOW (PANEWINDOW PANE)) + (WINDOWPROP PANEWINDOW 'CURSOROUTFN NIL) + (WINDOWPROP PANEWINDOW 'CURSORMOVEDFN NIL) + (DETACHWINDOW PANEWINDOW) + (\TEDIT.UNLINKPANE PANE) (* ; "Disconnect") (* ;; "") - (* ;; "Done with the deleted pane, assign its region to the pane above and redisplay. ") + (* ;; "Done with the deleted PANE, assign its region to the pane above and redisplay. ") (* ;;  "Now rearrange the pane window-attachment linkages. This gives PANE's region to its prior pane.") (* ;; "Original code moved the promptwindow and attached menus down into the region of the main window, shrinking the overall footprint. This code only unsplits the target pane, leaving everything else unchanged.") - (DETACHWINDOW PANE) - (SETQ ATTACHEDWINDOWS (WINDOWPROP PREVPANE 'ATTACHEDWINDOWS NIL)) - [SHAPEW PREVPANE (UNIONREGIONS (WINDOWPROP PANE 'REGION) - (WINDOWPROP PREVPANE 'REGION] - (WINDOWPROP PREVPANE 'ATTACHEDWINDOWS ATTACHEDWINDOWS) - (CL:WHEN NEXTPANE + (SETQ ATTACHEDWINDOWS (WINDOWPROP PREVPANEWINDOW 'ATTACHEDWINDOWS NIL)) + [SHAPEW PREVPANEWINDOW (UNIONREGIONS (WINDOWPROP PANEWINDOW 'REGION) + (WINDOWPROP PREVPANEWINDOW 'REGION] + (WINDOWPROP PREVPANEWINDOW 'ATTACHEDWINDOWS ATTACHEDWINDOWS) + (CL:WHEN NEXTPANEWINDOW - (* ;; + (* ;;  "PANE had a yet lower pane attached to it. Promote it to PANE's position in the attachment chain") - (DETACHWINDOW NEXTPANE) - (ATTACHWINDOW NEXTPANE PREVPANE 'BOTTOM 'JUSTIFY 'MAIN)) - (CLOSEW PANE]) + (DETACHWINDOW NEXTPANEWINDOW) + (ATTACHWINDOW NEXTPANEWINDOW PREVPANEWINDOW 'BOTTOM 'JUSTIFY 'MAIN)) + (WINDOWDELPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + (CLOSEW PANE]) (\TEDIT.LINKPANES [LAMBDA (PANE1 PANE2) (* ; "Edited 1-Jul-2024 08:39 by rmk") @@ -1870,16 +1887,15 @@ (MOVD? 'NILL 'REGISTER-TYPED-REGION) -(RPAQ? \TEDIT.OP.WIDTH 12) +(RPAQ? \TEDIT.OP.WIDTH -1) -(RPAQ? \TEDIT.OP.BOTTOM 12) +(RPAQ? \TEDIT.OP.BOTTOM 14) -(RPAQ? \TEDIT.LINEREGION.WIDTH 12) -(DECLARE%: DONTEVAL@LOAD DOCOPY +(RPAQ? \TEDIT.LINEREGION.WIDTH 16) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM \TEDIT.LINEREGION.WIDTH) -) +(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM \TEDIT.LINEREGION.WIDTH \TEDIT.SPLITCURSOR + \TEDIT.LINECURSOR \TEDIT.MOVESPLITCURSOR \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR) ) (RPAQ BXCARET (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@CH@@CH@@FL@@FL@@LF@@ ) (QUOTE NIL) 3 4)) @@ -2070,31 +2086,25 @@ (CLEARW PW))))]) (TEDIT.PROMPTFLASH - [LAMBDA (TEXTSTREAM) (* ; "Edited 15-Mar-2024 18:32 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 25-Apr-2025 17:58 by rmk") + (* ; "Edited 15-Mar-2024 18:32 by rmk") (* ; "Edited 30-May-91 23:34 by jds") - (* ; - "Flash the TEdit prompt window, or the global promptwindow, if TEdit has none.") - (PROG (WINDOW PWINDOW (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - MAINTEXTOBJ) - (COND - [(AND TEXTOBJ (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) - (* ; - "There is a known textobj, and it's a menu. Go use the main editor's promptwindow.") - (SETQ MAINTEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of (\TEDIT.MAINW TEXTOBJ))) - (* ; - "Find the TEXTOBJ for the main edit window, and use ITS prompting window.") - (SETQ WINDOW (AND MAINTEXTOBJ (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ] - ((AND TEXTOBJ (SETQ WINDOW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (* ; - "There IS an editor window to get to; use its prompt window") - ) - ((SETQ WINDOW (GETPROMPTWINDOW (\TEDIT.MAINW TEXTSTREAM) - NIL NIL T)) (* ; - "Failing that, try any prompt window attached to the edit window.") - )) (* ; - "Try to find an editor's prompt window for our message") - (FLASHWINDOW (OR WINDOW PROMPTWINDOW) - 2]) + + (* ;; "Flash the TEdit prompt window, or the global promptwindow, if TEdit has none.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) + MAINTEXTOBJ WINDOW) + (SETQ WINDOW (if (AND TEXTOBJ (FGETTOBJ TEXTOBJ MENUFLG)) + then (* ; + "Use the main editor's promptwindow.") + (CL:WHEN (SETQ MAINTEXTOBJ (\TEDIT.MAINSTREAM TSTREAM)) + (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ)) + elseif (AND TEXTOBJ (FGETTOBJ TEXTOBJ PROMPTWINDOW)) + else (GETPROMPTWINDOW (\TEDIT.MAINW TSTREAM) + NIL NIL T))) + (FLASHWINDOW (OR WINDOW PROMPTWINDOW) + 2]) (\TEDIT.PROMPT.PAGEFULLFN [LAMBDA (PROMPT-DISPLAY-STREAM) (* ; "Edited 21-Jun-2024 23:21 by rmk") @@ -2221,7 +2231,8 @@ TITLE)))]) (\TEDIT.LIKELY.FILENAME - [LAMBDA (TSTREAM UNFORMATTED?) (* ; "Edited 14-Mar-2025 11:46 by rmk") + [LAMBDA (TSTREAM UNFORMATTED?) (* ; "Edited 7-Apr-2025 23:13 by rmk") + (* ; "Edited 14-Mar-2025 11:46 by rmk") (* ; "Edited 18-Jan-2024 09:03 by rmk") (* ; "Edited 29-Dec-2023 00:33 by rmk") (* ; "Edited 18-Dec-2023 14:06 by rmk") @@ -2234,9 +2245,10 @@ (* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed.") (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) - (DEFAULTEXT (CL:IF UNFORMATTED? - 'TXT - 'TEDIT)) + [DEFAULTEXT (OR (GETTEXTPROP TSTREAM 'DEFAULTPUTEXTENSION) + (CL:IF UNFORMATTED? + 'TXT + 'TEDIT)] (TXTFILE (GETTOBJ TEXTOBJ TXTFILE)) EXT) (CL:WHEN (type? STREAM TXTFILE) @@ -2294,7 +2306,9 @@ (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (PANE) (* ; "Edited 14-Mar-2025 16:22 by rmk") + [LAMBDA (PANE) (* ; "Edited 28-Apr-2025 15:38 by rmk") + (* ; "Edited 20-Apr-2025 15:10 by rmk") + (* ; "Edited 14-Mar-2025 16:22 by rmk") (* ; "Edited 18-Feb-2025 23:56 by rmk") (* ; "Edited 29-Nov-2024 13:10 by rmk") (* ; "Edited 1-Jul-2024 17:42 by rmk") @@ -2312,54 +2326,71 @@ (* ;; "If the session is or can be finished, deactivate this Tedit window and process, and all attached Tedit menus. This disconnects the window and process from the textstream, which persists. This is not used to unsplit panes. The actual window-closing is done by setting the flag EDITFINISHEDFLG to T and giving control to the edit process. The flag causes the command loop to exit.") - (PROG* [(TSTREAM (TEXTSTREAM PANE T)) - (TEXTOBJ (AND TSTREAM (GETTSTR TSTREAM TEXTOBJ] + (PROG* ((TSTREAM (TEXTSTREAM PANE T)) + (TEXTOBJ (AND TSTREAM (FTEXTOBJ TSTREAM))) + (PANEWINDOW (PANEWINDOW PANE)) + PROC) (CL:UNLESS TEXTOBJ (* ;  "Return NIL if not an editing window (rather than error?)") (RETURN)) - (TEXTOBJ! TEXTOBJ) (* ;; "Return DON'T to signal (to CLOSEW) that the window shouldn't be closed. if previously quit, the window is closed already, and would be reopened to reclose it.") - (CL:WHEN (\TEDIT.FINISHEDIT? TSTREAM T) - (RETURN 'DON'T)) - (CL:WHEN (AND (GETTOBJ TEXTOBJ PROMPTWINDOW) - (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW))) - (CLEARW (GETTOBJ TEXTOBJ PROMPTWINDOW))) + (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) + (CL:WHEN (EQ 'DON'T (\TEDIT.FINISHEDIT? TSTREAM T)) + (RETURN 'DON'T))) + (CL:UNLESS (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (* ; "Must be a lower split window") + (\TEDIT.UNSPLITW PANE) + (RETURN)) + + (* ;; "We're really closing: get rid of the splits, recover the region that they all occupy so we can recover the original/reshaped region of the primary pane=PANE.") + + (WINDOWPROP (PANEWINDOW PANE) + 'SAVED-TYPED-REGION + (\TEDIT.CLOSESPLITS TSTREAM)) + (\TEDIT.CLOSESPLITS TSTREAM) + + (* ;; "It's just the primary pane now. Shut things down.") + + (CL:WHEN (AND (FGETTOBJ TEXTOBJ PROMPTWINDOW) + (OPENWP (FGETTOBJ TEXTOBJ PROMPTWINDOW))) + (CLEARW (FGETTOBJ TEXTOBJ PROMPTWINDOW))) (\TEDIT.SETCARET (TEXTSEL TEXTOBJ) PANE TEXTOBJ 'OFF) (* ;  "Before the window is closed, make sure that the caret is down, or the window will reappear.") (CL:WHEN (AND (\TEDIT.WINDOW.TITLE TEXTOBJ) - (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW)) - (OPENWP PANE) - (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE))) + (OPENWP (FGETTOBJ TEXTOBJ PROMPTWINDOW)) + (OPENWP PANE)) (* ;;  "Reset the window's title to a known 'inactive' value, in case somebody else also has the window.") (\TEDIT.WINDOW.TITLE TEXTOBJ NIL "Edit Window [Inactive]")) - (for PANE backpanes TEXTOBJ do (\TEDIT.UNSPLITW PANE)) - (SETTOBJ TEXTOBJ PRIMARYPANE NIL) - (CL:WHEN (type? STREAM (GETTOBJ TEXTOBJ TXTFILE)) (* ; + (CL:WHEN (type? STREAM (FGETTOBJ TEXTOBJ TXTFILE))(* ;  "Close the file that this window was open on.") - (CL:UNLESS (fetch (TEXTWINDOW CLOSINGFILE) of PANE) - (replace (TEXTWINDOW CLOSINGFILE) of PANE with T) - (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE)))) - (WINDOWPROP PANE 'PROCESS.EXITFN NIL) - (WINDOWPROP PANE 'PROCESS.IDLEFN NIL) - (WINDOWPROP PANE 'BUTTONEVENTFN (FUNCTION TOTOPW))(* ; "And the button functions") - (WINDOWPROP PANE 'RIGHTBUTTONFN (FUNCTION DOWINDOWCOM)) - (WINDOWDELPROP PANE 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)) - (* ; "To avoid a loop") - (WINDOWPROP PANE 'SCROLLFN NIL) - (WINDOWPROP PANE 'AFTERMOVEFN NIL) - (WINDOWDELPROP PANE 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) - (\TEDIT.INTERRUPT.SETUP (WINDOWPROP PANE 'PROCESS) + (CL:UNLESS (fetch (TEXTWINDOW CLOSINGFILE) of PANEWINDOW) + (replace (TEXTWINDOW CLOSINGFILE) of PANEWINDOW with T) + (CLOSEF? (FGETTOBJ TEXTOBJ TXTFILE)))) + + (* ;; "Clean up the window properties") + + (WINDOWPROP PANEWINDOW 'PROCESS.EXITFN NIL) + (WINDOWPROP PANEWINDOW 'PROCESS.IDLEFN NIL) + (WINDOWPROP PANEWINDOW 'BUTTONEVENTFN (FUNCTION TOTOPW)) + (* ; "And the button functions") + (WINDOWPROP PANEWINDOW 'RIGHTBUTTONFN (FUNCTION DOWINDOWCOM)) + (WINDOWDELPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + (* ; "Remove to avoid a loop on reuse?") + (WINDOWPROP PANEWINDOW 'SCROLLFN NIL) + (WINDOWPROP PANEWINDOW 'AFTERMOVEFN NIL) + (WINDOWDELPROP PANEWINDOW 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) + (\TEDIT.INTERRUPT.SETUP (WINDOWPROP PANEWINDOW 'PROCESS) T) (* ; "Restore any disarmed interrupts.") (for MENUW MTEXTOBJ in (ATTACHEDWINDOWS PANE) when (AND (SETQ MTEXTOBJ (TEXTOBJ MENUW T)) (FGETTOBJ MTEXTOBJ MENUFLG)) do (* ; "Detach all the TEDITMENU windows.") - (SETTOBJ MTEXTOBJ EDITFINISHEDFLG T) (* ; + (FSETTOBJ MTEXTOBJ EDITFINISHEDFLG T) (* ;  "Mark it finished so it closes itself") (WINDOWPROP MENUW 'TEDITMENU NIL) (* ;  "And mark it no longer a menu window") @@ -2368,13 +2399,14 @@ (DISMISS 300)) (* ; "This closes up the other menus") (GIVE.TTY.PROCESS PANE) (* ; "Now kill this one") (DISMISS 300) - (WINDOWPROP PANE 'CURSOROUTFN NIL) - (WINDOWPROP PANE 'CURSORMOVEDFN NIL) - (\TEDIT.UNLINKPANE PANE) (* ; "Disconnect") + (WINDOWPROP PANEWINDOW 'CURSOROUTFN NIL) + (WINDOWPROP PANEWINDOW 'CURSORMOVEDFN NIL) (* ; "Disconnect") (replace (TEXTWINDOW WTEXTSTREAM) of PANE with NIL]) (\TEDIT.RESHAPEFN - [LAMBDA (PANE BITS OLDREGION) (* ; "Edited 30-Nov-2024 13:30 by rmk") + [LAMBDA (PANE BITS OLDREGION) (* ; "Edited 20-Apr-2025 12:55 by rmk") + (* ; "Edited 18-Apr-2025 15:03 by rmk") + (* ; "Edited 30-Nov-2024 13:30 by rmk") (* ; "Edited 4-Nov-2024 17:44 by rmk") (* ; "Edited 6-Jul-2024 17:00 by rmk") (* ; "Edited 28-Jun-2024 15:14 by rmk") @@ -2382,8 +2414,7 @@ (* ;;  "This tries to display the current top line at the same position relative to the top of PANE.")  (* ; "Edited 25-Jun-2024 15:53 by rmk") - (LET* ((TEXTOBJ (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of PANE) - TEXTOBJ)) + (LET* ((TEXTOBJ (PANETEXTOBJ PANE)) (PREG (DSPCLIPPINGREGION NIL PANE)) (PANEPREFIX (PANEPREFIX PANE)) (PANEPROPS (PANEPROPS PANE))) @@ -2398,9 +2429,6 @@ (SETQ PANEBOTTOM (fetch (REGION BOTTOM) of PREG)) (SETQ PANETOP (fetch (REGION TOP) of PREG)) (SETQ PANEREGION PREG)) - (WITH TEXTOBJ TEXTOBJ (SETQ WRIGHT (fetch (REGION WIDTH) of PREG)) - (SETQ WLEFT (fetch (REGION LEFT) of PREG)) - (SETQ WBOTTOM (fetch (REGION BOTTOM) of PREG))) [SETYBOT PANEPREFIX (IPLUS (FGETLD PANEPREFIX YBOT) (IDIFFERENCE (PANEHEIGHT PANE) (fetch (REGION HEIGHT) of OLDREGION] @@ -2415,12 +2443,41 @@ (* ;; "Ignores REGION, repaints all the panes") (\TEDIT.FILL.PANES WINDOW]) + +(\TEDIT.CLOSESPLITS + [LAMBDA (TSTREAM) (* ; "Edited 28-Apr-2025 15:32 by rmk") + + (* ;; "Detach and close all split panes, if any. This differs from unsplitting in that it doesn't do any intermediatge redisplays.") + + (* ;; "Returns the total region occupied by the primary pane (still open) and all of its the split windows. We include the primary pane's region but don't otherwise touch the primary pane.") + + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (PRIMARYPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))) + (PROG1 [for PANE PANEWINDOW SPLITREGIONS inpanes (NEXTPANE PRIMARYPANE) + eachtime (SETQ PANEWINDOW (PANEWINDOW PANE)) + collect + + (* ;; "Avoid closing loop through TEDIT.DEACTIVATE.WINDOW") + + (WINDOWDELPROP PANEWINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + (WINDOWREGION PANEWINDOW) finally (RETURN (APPLY (FUNCTION UNIONREGIONS) + (CONS (WINDOWREGION + PRIMARYPANE) + SPLITREGIONS] + (for PANE inpanes (NEXTPANE PRIMARYPANE) do (CLOSEW (PANEWINDOW PANE)) + (replace (TEXTWINDOW WTEXTSTREAM) + of (PANEWINDOW PANE) with NIL)) + (* ; "Disconnect all the splits") + (SETPANEPROP (PANEPROPS PRIMARYPANE) + NEXTPANE NIL))]) ) (DEFINEQ (\TEDIT.SCROLLFN [LAMBDA (PANE DX DY) + (* ;; "Edited 18-Apr-2025 15:04 by rmk") + (* ;; "Edited 29-Apr-2024 15:04 by rmk") (* ;; "Edited 27-Apr-2024 11:31 by rmk") @@ -2439,8 +2496,8 @@  "Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for panes that are partially off-screen") (TOTOPW PANE) - (PROG* [(TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)) - (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (PROG* ((TSTREAM (PANETEXTSTREAM PANE)) + (TEXTOBJ (FTEXTOBJ TSTREAM))) (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) then (* ;; "Don't scroll a zero-length file") @@ -2564,7 +2621,8 @@ (\TEDIT.SCROLLCH.TOP TSTREAM PANE (FGETLD TOPLINE LCHARLAST]) (\TEDIT.SCROLLUP - [LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk") + [LAMBDA (TSTREAM PANE DY) (* ; "Edited 20-Apr-2025 23:36 by rmk") + (* ; "Edited 1-Feb-2025 10:20 by rmk") (* ; "Edited 1-Dec-2024 11:32 by rmk") (* ; "Edited 29-Nov-2024 09:14 by rmk") (* ; "Edited 22-Nov-2024 17:33 by rmk") @@ -2635,7 +2693,7 @@ (\TEDIT.SETPANE.TOPLINE PANE NEWTOPLINE NEWPANEYBOT) (\TEDIT.SHIFTLINES (PANEPREFIX PANE) - PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE) + PANE TSTREAM (\TEDIT.BITMAPLINES PANE NEWTOPLINE) T) (\TEDIT.SETCARET (TEXTSEL TEXTOBJ) PANE TEXTOBJ 'ON]) @@ -2670,7 +2728,8 @@ (RETURN (IPLUS NEWBOT (FGETLD NEWTOPLINE LHEIGHT]) (\TEDIT.SCROLLDOWN - [LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Feb-2025 10:20 by rmk") + [LAMBDA (TSTREAM PANE DY) (* ; "Edited 20-Apr-2025 23:37 by rmk") + (* ; "Edited 1-Feb-2025 10:20 by rmk") (* ; "Edited 1-Dec-2024 20:46 by rmk") (* ; "Edited 29-Nov-2024 09:14 by rmk") (* ; "Edited 22-Nov-2024 17:33 by rmk") @@ -2769,7 +2828,7 @@ (* ;; "All needed lines have been constructed and linked, although there may still be some unneeded lines at the bottom. ") (\TEDIT.SHIFTLINES (PANEPREFIX PANE) - PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE) + PANE TSTREAM (\TEDIT.BITMAPLINES PANE OLDTOPLINE) T) (\TEDIT.SETCARET (TEXTSEL TEXTOBJ) PANE TEXTOBJ 'ON]) @@ -2932,19 +2991,20 @@ ]))]) (\TEDIT.SETPANE.TOPLINE - [LAMBDA (PANE TOPLINE PREFIXYBOT) (* ; "Edited 7-Nov-2024 08:50 by rmk") + [LAMBDA (PANE TOPLINE PREFIXYBOT) (* ; "Edited 18-Apr-2025 23:38 by rmk") + (* ; "Edited 7-Nov-2024 08:50 by rmk") (* ; "Edited 4-Nov-2024 23:05 by rmk") - - (* ;; "Install TOPLINE as the PANETOPLINE of PANE, setting PANE's YBOT to PREFIXYBOT if given or the YTOP of TOPLINE. In the PREFIXYBOT case, the pane will be inconsistent until either the line or the pane is adjusted. But before that, the difference between the PANE YBOT and TOPLINE YTOP may be useful.") - - (LET ((PREFIX (PANEPREFIX PANE))) - (SETLD PREFIX YBOT (OR PREFIXYBOT (FGETLD TOPLINE YTOP))) - (LINKLD PREFIX TOPLINE) - (\TEDIT.PREFIX.LCHARLIM PANE (SUB1 (FGETLD TOPLINE LCHAR1))) - TOPLINE]) + (CL:WHEN TOPLINE + (LET ((PREFIX (PANEPREFIX PANE))) + (SETLD PREFIX YBOT (OR PREFIXYBOT (FGETLD TOPLINE YTOP))) + (LINKLD PREFIX TOPLINE) + (FSETLD PREFIX LCHARLIM (FGETLD TOPLINE LCHAR1)) + TOPLINE))]) (\TEDIT.SHIFTLINES - [LAMBDA (PREVLINE PANE TEXTOBJ BITMAPLINES SCROLLING) (* ; "Edited 1-Feb-2025 10:22 by rmk") + [LAMBDA (PREVLINE PANE TSTREAM BITMAPLINES SCROLLING) (* ; "Edited 21-Apr-2025 12:02 by rmk") + (* ; "Edited 5-Apr-2025 11:30 by rmk") + (* ; "Edited 1-Feb-2025 10:22 by rmk") (* ; "Edited 7-Jan-2025 11:54 by rmk") (* ; "Edited 17-Dec-2024 23:40 by rmk") (* ; "Edited 3-Dec-2024 16:08 by rmk") @@ -2959,123 +3019,125 @@ (* ;; "Take down the caret, but importantly, don't take down the selection--that would wipe out the bitmap-highlighting that we want to translate.") - (LET ((SEL (TEXTSEL TEXTOBJ)) - LASTVISIBLE) - (\TEDIT.SETCARET SEL PANE TEXTOBJ 'OFF) - (if BITMAPLINES - then [LET* ((NEXTLINE (FGETLD PREVLINE NEXTLINE)) - (VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT)) - (PBOTTOM (PANEBOTTOM PANE)) - (BMTOPL (CAR BITMAPLINES)) - (BMTOPY (FGETLD BMTOPL YTOP)) - (BMBOTL (CDR BITMAPLINES)) - (BMBOTY (FGETLD BMBOTL YBOT)) - DELTA) + (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) + (SEL (TEXTSEL TEXTOBJ)) + LASTVISIBLE) + (\TEDIT.SETCARET SEL PANE TEXTOBJ 'OFF) + (if BITMAPLINES + then [LET* ((NEXTLINE (FGETLD PREVLINE NEXTLINE)) + (VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT)) + (PBOTTOM (PANEBOTTOM PANE)) + (BMTOPL (CAR BITMAPLINES)) + (BMTOPY (FGETLD BMTOPL YTOP)) + (BMBOTL (CDR BITMAPLINES)) + (BMBOTY (FGETLD BMBOTL YBOT)) + DELTA) (* ;;; " REPOSITION all lines in the chain properly with respect to PREVLINE. ") - [for L (Y _ (FGETLD PREVLINE YBOT)) inlines NEXTLINE - do (SETYTOP L Y) - (SETQ Y (IDIFFERENCE Y (FGETLD L LHEIGHT] + [for L (Y _ (FGETLD PREVLINE YBOT)) inlines NEXTLINE + do (SETYTOP L Y) + (SETQ Y (IDIFFERENCE Y (FGETLD L LHEIGHT] (* ;;; "TRANSLATE the bitmap to be consistent with its new line positions. This is done before any display operations, to be sure that the bitmap isn't corrupted.") - (SETQ DELTA (IDIFFERENCE (FGETLD BMTOPL YTOP) - BMTOPY)) - (BITBLT PANE VLEFT BMBOTY PANE VLEFT (IPLUS BMBOTY DELTA) - (PANEWIDTH PANE) - (IDIFFERENCE BMTOPY BMBOTY) - 'INPUT - 'REPLACE) - (SETQ BMTOPY (FGETLD BMTOPL YTOP)) + (SETQ DELTA (IDIFFERENCE (FGETLD BMTOPL YTOP) + BMTOPY)) + (BITBLT PANE VLEFT BMBOTY PANE VLEFT (IPLUS BMBOTY DELTA) + (PANEWIDTH PANE) + (IDIFFERENCE BMTOPY BMBOTY) + 'INPUT + 'REPLACE) + (SETQ BMTOPY (FGETLD BMTOPL YTOP)) (* ;;; "Display any lines ABOVE the top of the translated bitmap, presumably for scroll down and insertion. Lines exist and have been formatted and positioned, but not yet displayed.") - (for L inlines NEXTLINE while (IGEQ (FGETLD L YBOT) - BMTOPY) - do (\TEDIT.DISPLAYLINE TEXTOBJ L PANE)) + (for L inlines NEXTLINE while (IGEQ (FGETLD L YBOT) + BMTOPY) + do (\TEDIT.DISPLAYLINE TSTREAM L PANE)) (* ;;; "Deal with lines BELOW the bitmap. First. clear to the bottom--important to clear before displaying") - (for L backlines BMBOTL while (AND (ILESSP (FGETLD BMBOTL YBOT) - PBOTTOM) - (NOT (\TEDIT.SHOW.AT.BOTTOMP BMBOTL PANE)) - ) do (SETQ BMBOTL (FGETLD BMBOTL PREVLINE) - )) - (\TEDIT.CLEARPANE.BELOW.LINE BMBOTL PANE TEXTOBJ) - [SETQ LASTVISIBLE (if (EQ BMBOTL (PANESUFFIX PANE)) - then (PANEBOTTOMLINE PANE) - elseif (IGEQ (FGETLD BMBOTL YBOT) - PBOTTOM) - then - (* ;; + (for L backlines BMBOTL while (AND (ILESSP (FGETLD BMBOTL YBOT) + PBOTTOM) + (NOT (\TEDIT.SHOW.AT.BOTTOMP BMBOTL PANE) + )) do (SETQ BMBOTL (FGETLD BMBOTL + PREVLINE)) + ) + (\TEDIT.CLEARPANE.BELOW.LINE BMBOTL PANE TEXTOBJ) + [SETQ LASTVISIBLE (if (EQ BMBOTL (PANESUFFIX PANE)) + then (PANEBOTTOMLINE PANE) + elseif (IGEQ (FGETLD BMBOTL YBOT) + PBOTTOM) + then + (* ;;  "Bitmap didn't fill the pane. Maybe more lines needed below (scroll up or deletion).") - (\TEDIT.LINES.BELOW BMBOTL PANE TEXTOBJ) - else - (* ;; + (\TEDIT.LINES.BELOW BMBOTL PANE TSTREAM) + else + (* ;;  "Bit map went below the bottom, back up to the previous visible line. (scroll down or insertion)") - (find L backlines BMBOTL - suchthat (IGREATERP (FGETLD L YBOT) - PBOTTOM] - (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE) + (find L backlines BMBOTL + suchthat (IGREATERP (FGETLD L YBOT) + PBOTTOM] + (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTVISIBLE) - (* ;; "Lines are now properly linked, positioned, and displayed.") + (* ;; "Lines are now properly linked, positioned, and displayed.") (* ;;; "") (* ;;; "The part of the current SELECTION within the bitmap retains its correct highlighting, but highlighting has to be applied to lines above or below.") - (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE) - (CL:WHEN (AND (FGETSEL SEL ONFLG) - (NEQ 0 (FGETSEL SEL DCH))) + (\TEDIT.FIXSEL SEL TSTREAM PANE) + (CL:WHEN (AND (FGETSEL SEL ONFLG) + (NEQ 0 (FGETSEL SEL DCH))) - (* ;; "Restore the highlighting for selected lines that are above or below the bitmap. The lines within the bitmap retained their proper highlighting. Above is first.") + (* ;; "Restore the highlighting for selected lines that are above or below the bitmap. The lines within the bitmap retained their proper highlighting. Above is first.") - (for L (L1 _ (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) - (SEL1 _ (FGETSEL SEL CH#)) - (SELN _ (FGETSEL SEL CHLAST)) backlines (FGETLD BMTOPL PREVLINE) - first (CL:UNLESS (AND L1 (NEQ L1 BMTOPL) - (IGREATERP (FGETLD L1 YTOP) - BMTOPY)) + (for L (L1 _ (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) + (SEL1 _ (FGETSEL SEL CH#)) + (SELN _ (FGETSEL SEL CHLAST)) backlines (FGETLD BMTOPL PREVLINE) + first (CL:UNLESS (AND L1 (NEQ L1 BMTOPL) + (IGREATERP (FGETLD L1 YTOP) + BMTOPY)) - (* ;; "Selection's L1 is below the bitmap's new top.") + (* ;; "Selection's L1 is below the bitmap's new top.") - (RETURN)) when (FLINESELECTEDP L SEL1 SELN) - do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 L PANE SEL) - (RETURN) repeatuntil (EQ L L1)) - (for L (LN _ (\TEDIT.SEL.LN SEL PANE TEXTOBJ)) - (SEL1 _ (FGETSEL SEL CH#)) - (SELN _ (FGETSEL SEL CHLAST)) inlines (FGETLD BMBOTL NEXTLINE) - first (CL:UNLESS (AND LN (ILESSP (FGETLD LN YBOT) - (IPLUS BMBOTY DELTA))) + (RETURN)) when (FLINESELECTEDP L SEL1 SELN) + do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 L PANE SEL) + (RETURN) repeatuntil (EQ L L1)) + (for L (LN _ (\TEDIT.SEL.LN SEL PANE TEXTOBJ)) + (SEL1 _ (FGETSEL SEL CH#)) + (SELN _ (FGETSEL SEL CHLAST)) inlines (FGETLD BMBOTL NEXTLINE) + first (CL:UNLESS (AND LN (ILESSP (FGETLD LN YBOT) + (IPLUS BMBOTY DELTA))) - (* ;; "Selection's LN is above the bitmap's new bottom") + (* ;; "Selection's LN is above the bitmap's new bottom") - (RETURN)) when (FLINESELECTEDP L SEL1 SELN) - do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L LN PANE SEL) - (RETURN) repeatuntil (EQ L LN)))] - else - (* ;; "No useful bitmap bits, just create/display lines below PREVLINE") + (RETURN)) when (FLINESELECTEDP L SEL1 SELN) + do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L LN PANE SEL) + (RETURN) repeatuntil (EQ L LN)))] + else + (* ;; "No useful bitmap bits, just create/display lines below PREVLINE") - (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ) - (SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TEXTOBJ)) - (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE) - (\TEDIT.FIXSEL NIL TEXTOBJ NIL PANE)) - (CL:WHEN SCROLLING + (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ) + (SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TSTREAM)) + (\TEDIT.SUFFIXLINE.CREATE PANE TSTREAM LASTVISIBLE) + (\TEDIT.FIXSEL NIL TSTREAM PANE)) + (CL:WHEN SCROLLING - (* ;; "If scrolling up or down, we brute force wipe out whatever is above PREVLINE. If not scrolling, those are the lines from the top to lastvalid that are preserved.") + (* ;; "If scrolling up or down, we brute force wipe out whatever is above PREVLINE. If not scrolling, those are the lines from the top to lastvalid that are preserved.") - (BLTSHADE WHITESHADE PANE (PANELEFT PANE) - (FGETLD PREVLINE YBOT) - (PANEWIDTH PANE) - (PANEHEIGHT PANE) - 'REPLACE)) + (BLTSHADE WHITESHADE PANE (PANELEFT PANE) + (FGETLD PREVLINE YBOT) + (PANEWIDTH PANE) + (PANEHEIGHT PANE) + 'REPLACE)) - (* ;; "Caller is responsible for turning the caret back on") + (* ;; "Caller is responsible for turning the caret back on") - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) ) (DEFINEQ @@ -3249,7 +3311,8 @@ (DEFINEQ (\TEDIT.PROCIDLEFN - [LAMBDA (WINDOW) (* ; "Edited 15-Mar-2024 18:34 by rmk") + [LAMBDA (WINDOW) (* ; "Edited 25-Apr-2025 14:05 by rmk") + (* ; "Edited 15-Mar-2024 18:34 by rmk") (* ; "Edited 25-Sep-2023 10:30 by rmk") (* ; "Edited 19-Sep-2023 23:25 by rmk") (* ; "Edited 30-May-91 23:35 by jds") @@ -3268,7 +3331,7 @@ (PROCESSP (WINDOWPROP WINDOW 'PROCESS] (TTY.PROCESS (WINDOWPROP WINDOW 'PROCESS)) (* ;  "No SHIFT key down; let's regain control.") - (CL:WHEN (GETTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW) + (CL:WHEN (GETTOBJ (FTEXTOBJ (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW)) MENUFLG) (* ; "This is a MENU -- always select.") (\TEDIT.MENU.BUTTONEVENTFN WINDOW))) (T (* ; "Otherwise, let him select.") @@ -3282,16 +3345,16 @@ (\TEDIT.INTERRUPT.SETUP NEWPROCESS]) (\TEDIT.PROCEXITFN - [LAMBDA (THISP NEWP) (* ; "Edited 27-Mar-2024 15:23 by rmk") + [LAMBDA (THISP NEWP) (* ; "Edited 18-Apr-2025 15:15 by rmk") + (* ; "Edited 27-Mar-2024 15:23 by rmk") (* jds " 5-Apr-84 10:40") (* ;; "Re-arm any interrupts that TEdit turned off, so the poor user has them available in other parts of the system.") - (* Re-arm any interrupts that TEdit turned off, so the poor user has them - available in other parts of the system.) + (* ;; "Re-arm any interrupts that TEdit turned off, so the poor user has them available in other parts of the system.") - (AND (fetch (TEXTWINDOW WTEXTSTREAM) of (PROCESSPROP THISP 'WINDOW)) - (\TEDIT.INTERRUPT.SETUP THISP T]) + (CL:WHEN (PANETEXTSTREAM (PROCESSPROP THISP 'WINDOW)) + (\TEDIT.INTERRUPT.SETUP THISP T]) ) (RPAQ? \CARETRATE 333) @@ -3407,7 +3470,8 @@ TSTREAM))]) (\TEDIT.SETCARET - [LAMBDA (SEL PANE TEXTOBJ DISPOSITION) (* ; "Edited 1-Dec-2024 11:51 by rmk") + [LAMBDA (SEL PANE TEXTOBJ DISPOSITION) (* ; "Edited 10-Apr-2025 21:14 by rmk") + (* ; "Edited 1-Dec-2024 11:51 by rmk") (* ; "Edited 22-Nov-2024 11:39 by rmk") (* ; "Edited 20-Nov-2024 12:37 by rmk") (* ; "Edited 17-Nov-2024 19:01 by rmk") @@ -3458,7 +3522,7 @@ (RETURN)) (if LINE then (SETQ Y (FGETLD LINE YBASE)) - (if (AND (ILESSP Y (fetch (REGION PTOP) of (PANEREGION PANE))) + (if (AND (ILEQ Y (PANETOP PANE)) (IGEQ (FGETLD LINE YBOT) (PANEBOTTOM PANE))) then (* ; @@ -3491,214 +3555,13 @@ -(* ; "Menu interfacing") - -(DEFINEQ - -(TEDIT.ADD.MENUITEM - [LAMBDA (MENU ITEM) (* jds " 9-AUG-83 09:55") - (* Adds ITEM to the MENU, and updates - all the stuff.) - (PROG (OLDITM) - (COND - ((MEMBER ITEM (fetch ITEMS of MENU)) (* Do nothing--it's already in the - menu) - ) - ([AND (LISTP ITEM) - (SETQ OLDITM (SASSOC (CAR ITEM) - (fetch ITEMS of MENU] (* The menu item exists. - Make sure the thing behind it is - right.) - (RPLACD OLDITM (CDR ITEM))) - (T (* It isn't in the menu, so go ahead - and add it.) - (replace ITEMS of MENU with (NCONC1 (fetch ITEMS of MENU) - ITEM)) - (COND - ((EQ (fetch MENUCOLUMNS of MENU) - 1) (* If there is only one column, force - a re-figuring of the number of rows) - (replace MENUROWS of MENU with NIL)) - ((EQ (fetch MENUROWS of MENU) - 1) (* 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 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 25-Jun-2024 11:59 by rmk") - (* ; "Edited 18-May-2024 16:50 by rmk") - (* ; "Edited 12-May-2024 21:38 by rmk") - (* ; "Edited 20-Mar-2024 11:02 by rmk") - (* ; "Edited 24-Apr-2024 09:47 by rmk") - (* ; "Edited 15-Mar-2024 18:35 by rmk") - (* ; "Edited 9-Mar-2024 11:35 by rmk") - (* ; "Edited 29-Feb-2024 17:02 by rmk") - (* ; "Edited 27-Feb-2024 07:55 by rmk") - (* ; "Edited 22-Sep-2023 20:14 by rmk") - (* ; "Edited 19-Sep-2023 11:55 by rmk") - (* ; "Edited 16-Sep-2023 22:16 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 (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of 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)) - (Looks (* ; - "He wants to set the font for the current selection") - (\TEDIT.LOOKS TEXTOBJ)) - (Hardcopy (* ; "Print this document") - (TEDIT.HARDCOPY TEXTOBJ)) - (Expanded% Menu (* ; - "Open the expanded operations menu.") - (\TEDIT.EXPANDEDMENU.START TEXTOBJ)) - (Character% Looks (* ; - "Open the menu for setting character looks") - (\TEDIT.CHARMENU.START TEXTOBJ)) - (Paragraph% Formatting (* ; - "Open the paragraph formatting menu") - (\TEDIT.PARAMENU.START TEXTOBJ)) - (Page% Layout (* ; "Open the page-layout menu") - (\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE) - TSTREAM "Page Layout Menu" 150 'PAGE)) - (Buttons (TEDIT.BUTTONS.BUILD)) - (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) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY +(* ; "Background menu") -(RPAQ TEDIT.DEFAULT.MENU - [\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text)) - (Get 'Get NIL (SUBITEMS |Get Formatted Document| Unformatted% Get)) - Include Find Looks Substitute (Buttons 'Buttons "Display action buttons") - Quit - (Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu - Character% Looks - Paragraph% Formatting - Page% Layout]) -) (DECLARE%: DONTEVAL@LOAD DOCOPY [OR (SASSOC 'TEdit BackgroundMenuCommands) (NCONC1 BackgroundMenuCommands '(TEdit '(TEDIT) - "Opens a TEdit window for use."] + "Opens an empty TEdit window"] (SETQ BackgroundMenu NIL) ) @@ -3723,38 +3586,36 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (18637 19533 (TEDIT.DEFER.UPDATES 18647 . 19531)) (19534 45844 (\TEDIT.WINDOW.CREATE -19544 . 26156) (\TEDIT.WINDOW.GETREGION 26158 . 29527) (\TEDIT.WINDOW.SETUP 29529 . 33642) ( -\TEDIT.MINIMAL.WINDOW.SETUP 33644 . 41846) (\TEDIT.CLEARPANE 41848 . 42565) (\TEDIT.FILL.PANES 42567 - . 45842)) (45845 68752 (\TEDIT.CURSORMOVEDFN 45855 . 50728) (\TEDIT.CURSOROUTFN 50730 . 51175) ( -\TEDIT.ACTIVE.WINDOWP 51177 . 52228) (\TEDIT.EXPANDFN 52230 . 52793) (\TEDIT.MAINW 52795 . 54075) ( -\TEDIT.MAINSTREAM 54077 . 54344) (\TEDIT.PRIMARYPANE 54346 . 55116) (\TEDIT.PANELIST 55118 . 55614) ( -\TEDIT.NEWREGIONFN 55616 . 58132) (\TEDIT.SET.WINDOW.EXTENT 58134 . 63388) (\TEDIT.SHRINK.ICONCREATE -63390 . 66123) (\TEDIT.SHRINKFN 66125 . 66534) (\TEDIT.PANEREGION 66536 . 68750)) (68784 100358 ( -\TEDIT.BUTTONEVENTFN 68794 . 81356) (\TEDIT.BUTTONEVENTFN.DOOPERATION 81358 . 88081) ( -\TEDIT.BUTTONEVENTFN.GETOPERATION 88083 . 89925) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89927 . 93164) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 93166 . 95508) (\TEDIT.BUTTONEVENTFN.INTITLE 95510 . 97345) ( -\TEDIT.COPYINSERTFN 97347 . 98479) (\TEDIT.FOREIGN.COPY 98481 . 100356)) (100359 117468 ( -\TEDIT.PANE.SPLIT 100369 . 104848) (\TEDIT.SPLITW 104850 . 112309) (\TEDIT.UNSPLITW 112311 . 116125) ( -\TEDIT.LINKPANES 116127 . 116890) (\TEDIT.UNLINKPANE 116892 . 117466)) (118825 119716 (TEDITWINDOWP -118835 . 119714)) (119753 122856 (TEDIT.GETINPUT 119763 . 122206) (\TEDIT.MAKEFILENAME 122208 . 122854 -)) (122905 131206 (TEDIT.PROMPTWINDOW 122915 . 123229) (TEDIT.PROMPTPRINT 123231 . 125858) ( -TEDIT.PROMPTCLEAR 125860 . 127579) (TEDIT.PROMPTFLASH 127581 . 129513) (\TEDIT.PROMPT.PAGEFULLFN -129515 . 131204)) (131444 141085 (\TEDIT.FILENAME 131454 . 132226) (\TEDIT.DEFAULT.TITLE 132228 . -134607) (\TEDIT.WINDOW.TITLE 134609 . 136778) (\TEDIT.LIKELY.FILENAME 136780 . 138567) ( -\TEDIT.UPDATE.TITLE 138569 . 141083)) (141128 149656 (TEDIT.DEACTIVATE.WINDOW 141138 . 147256) ( -\TEDIT.RESHAPEFN 147258 . 149428) (\TEDIT.REPAINTFN 149430 . 149654)) (149657 192036 (\TEDIT.SCROLLFN -149667 . 151912) (\TEDIT.SCROLLCH.TOP 151914 . 154025) (\TEDIT.SCROLLCH.BOTTOM 154027 . 158357) ( -\TEDIT.SCROLLUP 158359 . 163976) (\TEDIT.TOPLINE.YTOP 163978 . 165647) (\TEDIT.SCROLLDOWN 165649 . -172579) (\TEDIT.SCROLL.CARET 172581 . 175419) (\TEDIT.VISIBLECARETP 175421 . 177715) ( -\TEDIT.VISIBLECHARP 177717 . 178808) (\TEDIT.BITMAPLINES 178810 . 182730) (\TEDIT.SETPANE.TOPLINE -182732 . 183523) (\TEDIT.SHIFTLINES 183525 . 192034)) (192037 202906 (\TEDIT.ONSCREEN? 192047 . 196598 -) (\TEDIT.ONSCREEN.REGION 196600 . 200251) (\TEDIT.AFTERMOVEFN 200253 . 201150) (OFFSCREENP 201152 . -202904)) (202948 205565 (\TEDIT.PROCIDLEFN 202958 . 204495) (\TEDIT.PROCENTRYFN 204497 . 204942) ( -\TEDIT.PROCEXITFN 204944 . 205563)) (205644 218798 (\TEDIT.DOWNCARET 205654 . 206447) ( -\TEDIT.FLASHCARET 206449 . 208560) (\TEDIT.UPCARET 208562 . 209666) (TEDIT.NORMALIZECARET 209668 . -212886) (\TEDIT.SETCARET 212888 . 218168) (\TEDIT.CARET 218170 . 218796)) (218832 231159 ( -TEDIT.ADD.MENUITEM 218842 . 221133) (TEDIT.DEFAULT.MENUFN 221135 . 228371) (TEDIT.REMOVE.MENUITEM -228373 . 229370) (\TEDIT.CREATEMENU 229372 . 229937) (\TEDIT.MENU.WHENHELDFN 229939 . 230844) ( -\TEDIT.MENU.WHENSELECTEDFN 230846 . 231157))))) + (FILEMAP (NIL (17091 17987 (TEDIT.DEFER.UPDATES 17101 . 17985)) (17988 43409 (\TEDIT.WINDOW.CREATE +17998 . 25018) (\TEDIT.WINDOW.GETREGION 25020 . 28510) (\TEDIT.WINDOW.SETUP 28512 . 32734) ( +\TEDIT.MINIMAL.WINDOW.SETUP 32736 . 40147) (\TEDIT.CLEARPANE 40149 . 40866) (\TEDIT.FILL.PANES 40868 + . 43407)) (43410 67383 (\TEDIT.CURSORMOVEDFN 43420 . 49030) (\TEDIT.CURSOROUTFN 49032 . 49720) ( +\TEDIT.ACTIVE.WINDOWP 49722 . 50792) (\TEDIT.EXPANDFN 50794 . 51357) (\TEDIT.MAINW 51359 . 52639) ( +\TEDIT.MAINSTREAM 52641 . 52975) (\TEDIT.PRIMARYPANE 52977 . 53747) (\TEDIT.PANELIST 53749 . 54245) ( +\TEDIT.NEWREGIONFN 54247 . 56763) (\TEDIT.SET.WINDOW.EXTENT 56765 . 62019) (\TEDIT.SHRINK.ICONCREATE +62021 . 64754) (\TEDIT.SHRINKFN 64756 . 65165) (\TEDIT.PANEREGION 65167 . 67381)) (67415 100137 ( +\TEDIT.BUTTONEVENTFN 67425 . 80297) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80299 . 87450) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 87452 . 89294) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89296 . 92861) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 92863 . 95287) (\TEDIT.BUTTONEVENTFN.INTITLE 95289 . 97124) ( +\TEDIT.COPYINSERTFN 97126 . 98258) (\TEDIT.FOREIGN.COPY 98260 . 100135)) (100138 117469 ( +\TEDIT.PANE.SPLIT 100148 . 104096) (\TEDIT.SPLITW 104098 . 111597) (\TEDIT.UNSPLITW 111599 . 116126) ( +\TEDIT.LINKPANES 116128 . 116891) (\TEDIT.UNLINKPANE 116893 . 117467)) (118903 119794 (TEDITWINDOWP +118913 . 119792)) (119831 122934 (TEDIT.GETINPUT 119841 . 122284) (\TEDIT.MAKEFILENAME 122286 . 122932 +)) (122983 130610 (TEDIT.PROMPTWINDOW 122993 . 123307) (TEDIT.PROMPTPRINT 123309 . 125936) ( +TEDIT.PROMPTCLEAR 125938 . 127657) (TEDIT.PROMPTFLASH 127659 . 128917) (\TEDIT.PROMPT.PAGEFULLFN +128919 . 130608)) (130848 140680 (\TEDIT.FILENAME 130858 . 131630) (\TEDIT.DEFAULT.TITLE 131632 . +134011) (\TEDIT.WINDOW.TITLE 134013 . 136182) (\TEDIT.LIKELY.FILENAME 136184 . 138162) ( +\TEDIT.UPDATE.TITLE 138164 . 140678)) (140723 151940 (TEDIT.DEACTIVATE.WINDOW 140733 . 147791) ( +\TEDIT.RESHAPEFN 147793 . 149878) (\TEDIT.REPAINTFN 149880 . 150104) (\TEDIT.CLOSESPLITS 150106 . +151938)) (151941 194740 (\TEDIT.SCROLLFN 151951 . 154182) (\TEDIT.SCROLLCH.TOP 154184 . 156295) ( +\TEDIT.SCROLLCH.BOTTOM 156297 . 160627) (\TEDIT.SCROLLUP 160629 . 166355) (\TEDIT.TOPLINE.YTOP 166357 + . 168026) (\TEDIT.SCROLLDOWN 168028 . 175067) (\TEDIT.SCROLL.CARET 175069 . 177907) ( +\TEDIT.VISIBLECARETP 177909 . 180203) (\TEDIT.VISIBLECHARP 180205 . 181296) (\TEDIT.BITMAPLINES 181298 + . 185218) (\TEDIT.SETPANE.TOPLINE 185220 . 185832) (\TEDIT.SHIFTLINES 185834 . 194738)) (194741 +205610 (\TEDIT.ONSCREEN? 194751 . 199302) (\TEDIT.ONSCREEN.REGION 199304 . 202955) (\TEDIT.AFTERMOVEFN + 202957 . 203854) (OFFSCREENP 203856 . 205608)) (205652 208466 (\TEDIT.PROCIDLEFN 205662 . 207322) ( +\TEDIT.PROCENTRYFN 207324 . 207769) (\TEDIT.PROCEXITFN 207771 . 208464)) (208545 221770 ( +\TEDIT.DOWNCARET 208555 . 209348) (\TEDIT.FLASHCARET 209350 . 211461) (\TEDIT.UPCARET 211463 . 212567) + (TEDIT.NORMALIZECARET 212569 . 215787) (\TEDIT.SETCARET 215789 . 221140) (\TEDIT.CARET 221142 . +221768))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 8a5172390..3dc7ede32 100644 Binary files a/library/tedit/TEDIT-WINDOW.LCOM and b/library/tedit/TEDIT-WINDOW.LCOM differ diff --git a/library/tedit/TEDIT.LCOM b/library/tedit/TEDIT.LCOM index 3b8856a03..cefa364d5 100644 Binary files a/library/tedit/TEDIT.LCOM and b/library/tedit/TEDIT.LCOM differ diff --git a/library/tedit/TOPLINE.TEDIT b/library/tedit/TOPLINE.TEDIT new file mode 100644 index 000000000..ff8c34089 Binary files /dev/null and b/library/tedit/TOPLINE.TEDIT differ diff --git a/library/tedit/TSTREAMS,TEDIT b/library/tedit/TSTREAMS,TEDIT new file mode 100644 index 000000000..88bd399b2 Binary files /dev/null and b/library/tedit/TSTREAMS,TEDIT differ diff --git a/library/tedit/tedit-exports.all b/library/tedit/tedit-exports.all index c8cb362f3..dcf7a26ae 100644 --- a/library/tedit/tedit-exports.all +++ b/library/tedit/tedit-exports.all @@ -1,11 +1,11 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "28-Mar-2025 17:12:59"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;209 53312 +(FILECREATED "21-Apr-2025 23:06:12"  +{DSK}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}TEDIT>tedit-exports.all;208) + :PREVIOUS-DATE "20-Apr-2025 00:13:59" {WMEDLEY}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))) diff --git a/lispusers/FOO.TEDIT b/lispusers/FOO.TEDIT new file mode 100644 index 000000000..18b8b9082 Binary files /dev/null and b/lispusers/FOO.TEDIT differ