diff --git a/internal/TEDIT-DEBUG b/internal/TEDIT-DEBUG index 6a953ed07..f04969b41 100644 --- a/internal/TEDIT-DEBUG +++ b/internal/TEDIT-DEBUG @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Feb-2025 12:21:45" {WMEDLEY}TEDIT-DEBUG.;135 130829 +(FILECREATED "23-Mar-2025 11:07:01" {WMEDLEY}TEDIT-DEBUG.;138 129322 :EDIT-BY rmk - :CHANGES-TO (FNS SPPRINT) + :CHANGES-TO (FNS TESTACTION) + (VARS TEDIT-DEBUGCOMS) - :PREVIOUS-DATE " 8-Feb-2025 22:41:55" {WMEDLEY}TEDIT-DEBUG.;134) + :PREVIOUS-DATE " 6-Mar-2025 11:29:26" {WMEDLEY}TEDIT-DEBUG.;136) (PRETTYCOMPRINT TEDIT-DEBUGCOMS) @@ -27,10 +28,12 @@  "Get/set (default) object, stream, window, selection") (FNS GTO GTS GTW GSEL) (INITVARS (LASTTEXTSTREAM NIL))) + (FNS TESTACTION) (COMS (* ; "Inspect") (FNS IPC ILINES ISEL ITS IPANES ITL IHIST IPCTB IMB ICL IPL ICARET INSPECTPIECES)) (COMS (* ; "Show") - (FNS SP SL SSP STL SPF SLF SHOWLINE SLL STBYTES SSEL)) + (FNS SP SL SSP SPF SLF SHOWLINE SLL STBYTES SSEL) + (FNS STL CLEARTHISLINE)) (COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES)) (COMS (FNS FILEBYTES TFILEBYTES)) (FNS TRELMOVE TSCROLL TSCROLL*) @@ -52,7 +55,7 @@ (FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC)) (INITVARS (LASTTS NIL)) (VARS (OK.TO.MODIFY.FNS T)) - (FNS DFOV OLDWI DFOV.OLDEST COMP DFR) + (FNS OLDWI COMP DFR) (FNS DFGV GDIRECTORIES) (COMS (FNS TTEST LTEST THC) (INITVARS (LASTTTESTFILE)) @@ -70,7 +73,7 @@ (FILES (NOERROR) VERSIONDEFS) (* ; "Until this is release") - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV DFOV) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV) (NLAML DFVENUE DFR) (LAMA]) @@ -150,6 +153,24 @@ ) (RPAQ? LASTTEXTSTREAM NIL) +(DEFINEQ + +(TESTACTION + [LAMBDA (CHAR TSTREAM) (* ; "Edited 23-Mar-2025 11:06 by rmk") + + (* ;; "If CHAR is bound to an action in TSTREAM's read table, execute it.") + + (SETQ TSTREAM (GTS TSTREAM)) + (\TEDIT.COMMAND.FUNCTION? TSTREAM (if (CHARCODEP CHAR) + then CHAR + elseif (CHARCODEP CHAR T) + elseif (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM)) + then (SETQ CHAR (CAR (TEDIT.GET.CHARBINDING CHAR TSTREAM))) + (CL:IF (CHARCODEP CHAR) + CHAR + (CHARCODE.DECODE CHAR)) + else (ERROR CHAR "is not a keybinding"]) +) @@ -550,140 +571,6 @@ (SPPRINT PC OFILE TEXTOBJ))) SELPIECES]) -(STL - [LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 22-Aug-2024 23:51 by rmk") - (* ; "Edited 4-Aug-2024 12:08 by rmk") - (* ; "Edited 31-Jul-2024 19:55 by rmk") - (* ; "Edited 29-Jul-2024 09:20 by rmk") - (* ; "Edited 1-Feb-2024 17:00 by rmk") - (* ; "Edited 25-Nov-2023 10:50 by rmk") - (* ; "Edited 23-Nov-2023 11:41 by rmk") - (* ; "Edited 23-Mar-2023 23:00 by rmk") - - (* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.") - - (* ;; "If OFILE isn't given, this goes to a textstream") - - (DECLARE (USEDFREE PREVSP CHARSLOT)) - (CL:UNLESS (type? THISLINE THISLINE) - (CL:WHEN (EQ THISLINE T) - (SETQ THISLINE NIL) - (SETQ LASTCS CHARSLOT)) - (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) - (\DTEST THISLINE 'THISLINE) - (DEBUGOUTPUT OFILE (CL:IF OFILE - NIL - 'STL) - (for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR - OF THISLINE)) - (FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE)) - (LINE _ (fetch (THISLINE DESC) of THISLINE)) - (NSPACES _ 0) - (NCHARS _ 0) - (SPACETOTAL _ 0) - (PSP _ (AND (BOUNDP 'PREVSP) - (NEQ PREVSP (GETATOMVAL 'PREVSP)) - PREVSP)) incharslots THISLINE as NSLOTS from 0 - first (if (NULL LINE) - then (printout OFILE THISLINE ":" T 5 - "No line parameters, start at CHNO = 1 LX1 = 0" T) - (SETQ CHNO 1) - (SETQ TX 0) - elseif (type? LINEDESCRIPTOR LINE) - then (SETQ CHNO (GETLD LINE LCHAR1)) - (SETQ TX (GETLD LINE LX1)) - (printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO - " LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM) - T)) - (CL:WHEN LCHAR1 - (SETQ CHNO (OR LCHAR1 1))) - (SETQ LENGTH TX) - (printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT)) - (SETQ CHARW (CHARW CSLOT)) - (CL:UNLESS (CHARSLOTP CSLOT THISLINE) - (HELP "THISLINE RUNS OFF THE EDGE" - THISLINE)) - repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE] - do (printout OFILE .I4 NSLOTS) - [if (IMAGEOBJP CHAR) - then (add NCHARS 1) - (printout OFILE " " .I5 CHNO ": ") - (add TX CHARW) - (printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ") - (SPPRINT.OBJ CHAR OFILE) - (add LENGTH CHARW) - (ADD CHNO 1) - elseif (SMALLP CHAR) - then (add NCHARS 1) - (printout OFILE " " .I5 CHNO ": ") - (printout OFILE .I3 CHAR " " - (SELCHARQ CHAR - ((EOL CR LF) - (add TX CHARW) - (add LENGTH CHARW) - "EOL") - (FORM "FORM") - (SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT) - (SETQ EXPANDSPACES T)) - (if EXPANDSPACES - then (add LENGTH (SCALEUP SPACEFACTOR CHARW)) - (add TX (SCALEUP SPACEFACTOR CHARW)) - else (add LENGTH CHARW) - (add TX CHARW)) - (ADD NSPACES 1) - " ") - (TAB (add LENGTH CHARW) - (add TX CHARW) - "TAB") - (Meta,TAB (add LENGTH CHARW) - (add TX CHARW) - "MTAB") - (PROGN (add LENGTH CHARW) - (add TX CHARW) - (CHARACTER CHAR))) - .FR 28 CHARW " " .I4 TX 35 CSLOT) - (ADD CHNO 1) - elseif [AND [OR (CHARSLOTP CHAR THISLINE) - (AND (NULL CHAR) - (NOT (TYPE? CHARLOOKS CHARW] - (OR (EQ CSLOT PSP) - (find CS incharslots (NEXTCHARSLOT CSLOT) - while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR] - then (* ; "Presumably a PREVSP") - (ADD NSPACES 1) - (printout OFILE " " .I5 CHNO ":") - (ADD LENGTH CHARW) - (ADD TX CHARW) - (PRINTOUT OFILE " " (OR CHAR "[ENDSP]") - .FR 28 CHARW " " .I4 TX 35 CSLOT) - (ADD CHNO 1) - elseif (SMALLP CHARW) - then (if (EQ CSLOT FIRSTSPACESLOT) - then (PRINTOUT OFILE "First space") - else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW) - (add CHNO CHARW)) - elseif (type? CHARLOOKS CHARW) - then (printout OFILE 7 CHARW 35 CSLOT) - else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T - ) - (TERPRI OFILE) - (GO $$OUT) - (AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? ")) - (TERPRI OFILE) - (GO $$OUT))] - (TERPRI OFILE) - finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2 - "next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE) - T) - (printout OFILE "line length = " LENGTH -3 "right margin = " - (AND LINE (GETLD LINE RIGHTMARGIN)) - -3 "X limit = " (AND LINE (GETLD (fetch (THISLINE DESC) of THISLINE) - LXLIM)) - T) - (printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = " - (CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR)) - T]) - (SPF [LAMBDA (ARG TITLE OFILE) (* ; "Edited 30-Aug-2024 21:25 by rmk") (* ; "Edited 15-Aug-2024 22:39 by rmk") @@ -987,6 +874,149 @@ ) (DEFINEQ +(STL + [LAMBDA (THISLINE LASTCS LCHAR1 OFILE) (* ; "Edited 22-Aug-2024 23:51 by rmk") + (* ; "Edited 4-Aug-2024 12:08 by rmk") + (* ; "Edited 31-Jul-2024 19:55 by rmk") + (* ; "Edited 29-Jul-2024 09:20 by rmk") + (* ; "Edited 1-Feb-2024 17:00 by rmk") + (* ; "Edited 25-Nov-2023 10:50 by rmk") + (* ; "Edited 23-Nov-2023 11:41 by rmk") + (* ; "Edited 23-Mar-2023 23:00 by rmk") + + (* ;; "Debugging tool while \FORMATLINE is creating THISLINE, or when it's done. During creation the NEXTAVAILABLECHARSLOT is at the very end, so bad slots are visible. When complete, they shouldn't appear.") + + (* ;; "If OFILE isn't given, this goes to a textstream") + + (DECLARE (USEDFREE PREVSP CHARSLOT)) + (CL:UNLESS (type? THISLINE THISLINE) + (CL:WHEN (EQ THISLINE T) + (SETQ THISLINE NIL) + (SETQ LASTCS CHARSLOT)) + (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) + (\DTEST THISLINE 'THISLINE) + (DEBUGOUTPUT OFILE (CL:IF OFILE + NIL + 'STL) + (for CSLOT EXPANDSPACES CHNO TX LENGTH CHAR CHARW (SPACEFACTOR _ (FETCH TLSPACEFACTOR + OF THISLINE)) + (FIRSTSPACESLOT _ (fetch TLFIRSTSPACE of THISLINE)) + (LINE _ (fetch (THISLINE DESC) of THISLINE)) + (NSPACES _ 0) + (NCHARS _ 0) + (SPACETOTAL _ 0) + (PSP _ (AND (BOUNDP 'PREVSP) + (NEQ PREVSP (GETATOMVAL 'PREVSP)) + PREVSP)) incharslots THISLINE as NSLOTS from 0 + first (if (NULL LINE) + then (printout OFILE THISLINE ":" T 5 + "No line parameters, start at CHNO = 1 LX1 = 0" T) + (SETQ CHNO 1) + (SETQ TX 0) + elseif (type? LINEDESCRIPTOR LINE) + then (SETQ CHNO (GETLD LINE LCHAR1)) + (SETQ TX (GETLD LINE LX1)) + (printout OFILE THISLINE " for " LINE ":" T 5 "Start at CHNO = " CHNO + " LX1 = " TX ", LXLIM = " (GETLD LINE LXLIM) + T)) + (CL:WHEN LCHAR1 + (SETQ CHNO (OR LCHAR1 1))) + (SETQ LENGTH TX) + (printout OFILE 29 "XLIM" T) eachtime (SETQ CHAR (CHAR CSLOT)) + (SETQ CHARW (CHARW CSLOT)) + (CL:UNLESS (CHARSLOTP CSLOT THISLINE) + (HELP "THISLINE RUNS OFF THE EDGE" + THISLINE)) + repeatuntil [OR (EQ CSLOT (OR LASTCS (LASTCHARSLOT THISLINE] + do (printout OFILE .I4 NSLOTS) + [if (IMAGEOBJP CHAR) + then (add NCHARS 1) + (printout OFILE " " .I5 CHNO ": ") + (add TX CHARW) + (printout OFILE "Imobj" .FR 28 CHARW " " .I4 TX 35 CSLOT " " CHAR " ") + (SPPRINT.OBJ CHAR OFILE) + (add LENGTH CHARW) + (ADD CHNO 1) + elseif (SMALLP CHAR) + then (add NCHARS 1) + (printout OFILE " " .I5 CHNO ": ") + (printout OFILE .I3 CHAR " " + (SELCHARQ CHAR + ((EOL CR LF) + (add TX CHARW) + (add LENGTH CHARW) + "EOL") + (FORM "FORM") + (SPACE (CL:WHEN (EQ CSLOT FIRSTSPACESLOT) + (SETQ EXPANDSPACES T)) + (if EXPANDSPACES + then (add LENGTH (SCALEUP SPACEFACTOR CHARW)) + (add TX (SCALEUP SPACEFACTOR CHARW)) + else (add LENGTH CHARW) + (add TX CHARW)) + (ADD NSPACES 1) + " ") + (TAB (add LENGTH CHARW) + (add TX CHARW) + "TAB") + (Meta,TAB (add LENGTH CHARW) + (add TX CHARW) + "MTAB") + (PROGN (add LENGTH CHARW) + (add TX CHARW) + (CHARACTER CHAR))) + .FR 28 CHARW " " .I4 TX 35 CSLOT) + (ADD CHNO 1) + elseif [AND [OR (CHARSLOTP CHAR THISLINE) + (AND (NULL CHAR) + (NOT (TYPE? CHARLOOKS CHARW] + (OR (EQ CSLOT PSP) + (find CS incharslots (NEXTCHARSLOT CSLOT) + while (CHARSLOTP CS THISLINE) suchthat (EQ CSLOT CHAR] + then (* ; "Presumably a PREVSP") + (ADD NSPACES 1) + (printout OFILE " " .I5 CHNO ":") + (ADD LENGTH CHARW) + (ADD TX CHARW) + (PRINTOUT OFILE " " (OR CHAR "[ENDSP]") + .FR 28 CHARW " " .I4 TX 35 CSLOT) + (ADD CHNO 1) + elseif (SMALLP CHARW) + then (if (EQ CSLOT FIRSTSPACESLOT) + then (PRINTOUT OFILE "First space") + else (PRINTOUT OFILE .FR 11 "Invis" .FR 38 CHARW) + (add CHNO CHARW)) + elseif (type? CHARLOOKS CHARW) + then (printout OFILE 7 CHARW 35 CSLOT) + else (printout OFILE " BAD CHARSLOT " 28 CSLOT " CHAR = " CHAR " CHARW = " CHARW T + ) + (TERPRI OFILE) + (GO $$OUT) + (AND NIL (CL:UNLESS (EQ 'Y (ASKUSER NIL NIL "Bad charslot, continue? ")) + (TERPRI OFILE) + (GO $$OUT))] + (TERPRI OFILE) + finally (printout OFILE NSLOTS " slots" -2 NCHARS " characters" -2 NSPACES " spaces" -2 + "next avail = " (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE) + T) + (printout OFILE "line length = " LENGTH -3 "right margin = " + (AND LINE (GETLD LINE RIGHTMARGIN)) + -3 "X limit = " (AND LINE (GETLD (fetch (THISLINE DESC) of THISLINE) + LXLIM)) + T) + (printout OFILE "first expanded space = " FIRSTSPACESLOT -3 "space factor = " + (CL:WHEN SPACEFACTOR (printout OFILE .F2.3 SPACEFACTOR)) + T]) + +(CLEARTHISLINE + [LAMBDA (TSTREAM) (* ; "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]) +) +(DEFINEQ + (NTHPIECE [LAMBDA (PIECES N) (* ; "Edited 16-Mar-2024 10:07 by rmk") (* ; "Edited 16-Sep-2023 12:17 by rmk") @@ -2017,58 +2047,12 @@ (RPAQQ OK.TO.MODIFY.FNS T) (DEFINEQ -(DFOV - [NLAMBDA ARGS (* ; "Edited 2-Dec-2024 08:14 by rmk") - (* ; "Edited 4-Oct-2024 22:17 by rmk") - (* ; "Edited 12-Jan-2024 00:30 by rmk") - (* ; "Edited 15-Dec-2023 12:36 by rmk") - (* ; "Edited 13-Aug-2023 14:09 by rmk") - - (* ;; "Brings in a function from an earlier version, for comparison. If FILE is a version number, it uses WHEREIS") - - (SETQ ARGS (NLAMBDA.ARGS ARGS)) - (PROG ((FN (POP ARGS)) - (FNFILE (POP ARGS)) - (VERSION (POP ARGS)) - (DIRLIST (POP ARGS)) - ALTFNS) - (CL:WHEN (FIXP FNFILE) - (SETQ VERSION FNFILE) - (SETQ FNFILE NIL)) - [if (AND FNFILE (MEMB FNFILE (WHEREIS FN 'FNS T))) - elseif (SETQ FNFILE (CAR (WHEREIS FN 'FNS T))) - else (CL:WHEN (EQ (CHARCODE \) - (CHCON1 FN)) - (push ALTFNS (SUBATOM FN 2))) - (if (STRPOS "TEDIT." FN NIL NIL T) - then (push ALTFNS (PACK* "\" FN)) - elseif (NOT (STRPOS "\TEDIT." FN 1 NIL T)) - then (push ALTFNS (PACK* "\TEDIT." FN))) - (for AF F in ALTFNS when (SETQ F (CAR (WHEREIS AF 'FNS T))) - collect (LIST AF F) finally (if (CDR $$VAL) - then (PRINTOUT T "Possible names/files for " FN - ", be more specific" T) - elseif $$VAL - then (SETQ FN (CAAR $$VAL)) - (SETQ FNFILE (CADAR $$VAL)) - elseif FNFILE - then (PRINTOUT T FN " not found on " FNFILE T) - else (PRINTOUT T FN " not found" T] - (APPLY (FUNCTION EDV) - (LIST FN 'FNS FNFILE VERSION DIRLIST NIL NIL NIL '(:DONTWAIT]) - (OLDWI [LAMBDA (FN) (* ; "Edited 16-May-2023 12:02 by rmk") (for F COMS in TEDITFILES when (AND (SETQ F (DFOV.OLDEST F)) (INFILECOMS? FN NIL (GETDEF (FILECOMS F) 'VARS F))) collect F]) -(DFOV.OLDEST - [LAMBDA (FILE DIRLIST) (* ; "Edited 15-Dec-2023 12:22 by rmk") - (* ; "Edited 13-Aug-2023 07:30 by rmk") - (* ; "Edited 16-May-2023 11:07 by rmk") - (CAR (LAST (FILDIR (PACKFILENAME 'VERSION '* 'BODY (FINDFILE FILE T DIRLIST]) - (COMP [LAMBDA (FN) (* ; "Edited 5-Feb-2023 20:14 by rmk") (COMPAREDEFS FN 'FNS (LIST 'SAVE (CAR (REMOVE 'SAVE (WHEREIS FN 'FNS T]) @@ -2434,37 +2418,37 @@ (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS -(ADDTOVAR NLAMA VSEE DFGV DFOV) +(ADDTOVAR NLAMA VSEE DFGV) (ADDTOVAR NLAML DFVENUE DFR) (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4850 7409 (GTO 4860 . 5110) (GTS 5112 . 6883) (GTW 6885 . 7041) (GSEL 7043 . 7407)) ( -7466 20597 (IPC 7476 . 8980) (ILINES 8982 . 11523) (ISEL 11525 . 12136) (ITS 12138 . 13862) (IPANES -13864 . 14099) (ITL 14101 . 14520) (IHIST 14522 . 17184) (IPCTB 17186 . 17494) (IMB 17496 . 18111) ( -ICL 18113 . 18678) (IPL 18680 . 19084) (ICARET 19086 . 19463) (INSPECTPIECES 19465 . 20595)) (20619 -56081 (SP 20629 . 25146) (SL 25148 . 28292) (SSP 28294 . 29725) (STL 29727 . 38239) (SPF 38241 . 40540 -) (SLF 40542 . 49675) (SHOWLINE 49677 . 53239) (SLL 53241 . 53988) (STBYTES 53990 . 55716) (SSEL 55718 - . 56079)) (56082 61455 (NTHPIECE 56092 . 57224) (NPIECES 57226 . 58091) (NTHPIECECHAR 58093 . 59401) -(SELPIECE 59403 . 59845) (PIECENUM 59847 . 60566) (PCBYTES 60568 . 61453)) (61456 63930 (FILEBYTES -61466 . 62890) (TFILEBYTES 62892 . 63928)) (63931 65253 (TRELMOVE 63941 . 64184) (TSCROLL 64186 . -64352) (TSCROLL* 64354 . 65251)) (65254 68303 (TRY 65264 . 66533) (TEDITCLOSEW 66535 . 66878) ( -PARALASTWITHOUTEOL 66880 . 67765) (FIXPARALAST 67767 . 68301)) (68304 82803 (SPPRINT 68314 . 74899) ( -SPPRINT.CHAR 74901 . 75885) (SPPRINT.OBJ 75887 . 78945) (SHOWPIECEBYTES 78947 . 80503) (CHECKPLENGTHS -80505 . 80962) (SBT 80964 . 81953) (COPYPCHAIN 81955 . 82801)) (82804 84865 (POSLINE 82814 . 84863)) ( -84866 85749 (PRESPLIT 84876 . 85747)) (85750 87463 (ALLTL 85760 . 87013) (NTHCHARSLOT 87015 . 87461)) -(87489 97702 (PLCHAIN 87499 . 88027) (PRINTLINE 88029 . 91019) (SL.GETLINES 91021 . 94314) (CHECKLINES - 94316 . 95296) (COLLECTLINES 95298 . 95550) (NTHLINE 95552 . 96557) (HEIGHT 96559 . 96847) (LINEBOTS -96849 . 97700)) (97703 100151 (IPC.DECODEARGS 97713 . 100149)) (100152 100745 (SPF1 100162 . 100743)) -(100774 103152 (SLF.FATPLEN 100784 . 101643) (FILEPIECE 101645 . 103150)) (103185 103953 (SELTEDIT -103195 . 103951)) (104023 109635 (PPARA 104033 . 104455) (PRUN 104457 . 105933) (ADDLINEPOSITIONS -105935 . 107362) (SBR 107364 . 108018) (SBC 108020 . 109633)) (109692 114367 (DFOV 109702 . 112172) ( -OLDWI 112174 . 112549) (DFOV.OLDEST 112551 . 112976) (COMP 112978 . 113173) (DFR 113175 . 114365)) ( -114368 115401 (DFGV 114378 . 114904) (GDIRECTORIES 114906 . 115399)) (115402 121967 (TTEST 115412 . -119944) (LTEST 119946 . 121311) (THC 121313 . 121965)) (122281 122973 (SHOWSAFE 122291 . 122971)) ( -123026 123473 (MYH 123036 . 123471)) (123718 124813 (DFVENUE 123728 . 124607) (VSEE 124609 . 124811)) -(124814 125268 (PTT 124824 . 125266)) (126515 128831 (TEDIT-DEBUG 126525 . 128829)) (128832 130568 ( -TRENAME 128842 . 130566))))) + (FILEMAP (NIL (4931 7490 (GTO 4941 . 5191) (GTS 5193 . 6964) (GTW 6966 . 7122) (GSEL 7124 . 7488)) ( +7523 8458 (TESTACTION 7533 . 8456)) (8483 21614 (IPC 8493 . 9997) (ILINES 9999 . 12540) (ISEL 12542 . +13153) (ITS 13155 . 14879) (IPANES 14881 . 15116) (ITL 15118 . 15537) (IHIST 15539 . 18201) (IPCTB +18203 . 18511) (IMB 18513 . 19128) (ICL 19130 . 19695) (IPL 19697 . 20101) (ICARET 20103 . 20480) ( +INSPECTPIECES 20482 . 21612)) (21636 48584 (SP 21646 . 26163) (SL 26165 . 29309) (SSP 29311 . 30742) ( +SPF 30744 . 33043) (SLF 33045 . 42178) (SHOWLINE 42180 . 45742) (SLL 45744 . 46491) (STBYTES 46493 . +48219) (SSEL 48221 . 48582)) (48585 57478 (STL 48595 . 57107) (CLEARTHISLINE 57109 . 57476)) (57479 +62852 (NTHPIECE 57489 . 58621) (NPIECES 58623 . 59488) (NTHPIECECHAR 59490 . 60798) (SELPIECE 60800 . +61242) (PIECENUM 61244 . 61963) (PCBYTES 61965 . 62850)) (62853 65327 (FILEBYTES 62863 . 64287) ( +TFILEBYTES 64289 . 65325)) (65328 66650 (TRELMOVE 65338 . 65581) (TSCROLL 65583 . 65749) (TSCROLL* +65751 . 66648)) (66651 69700 (TRY 66661 . 67930) (TEDITCLOSEW 67932 . 68275) (PARALASTWITHOUTEOL 68277 + . 69162) (FIXPARALAST 69164 . 69698)) (69701 84200 (SPPRINT 69711 . 76296) (SPPRINT.CHAR 76298 . +77282) (SPPRINT.OBJ 77284 . 80342) (SHOWPIECEBYTES 80344 . 81900) (CHECKPLENGTHS 81902 . 82359) (SBT +82361 . 83350) (COPYPCHAIN 83352 . 84198)) (84201 86262 (POSLINE 84211 . 86260)) (86263 87146 ( +PRESPLIT 86273 . 87144)) (87147 88860 (ALLTL 87157 . 88410) (NTHCHARSLOT 88412 . 88858)) (88886 99099 +(PLCHAIN 88896 . 89424) (PRINTLINE 89426 . 92416) (SL.GETLINES 92418 . 95711) (CHECKLINES 95713 . +96693) (COLLECTLINES 96695 . 96947) (NTHLINE 96949 . 97954) (HEIGHT 97956 . 98244) (LINEBOTS 98246 . +99097)) (99100 101548 (IPC.DECODEARGS 99110 . 101546)) (101549 102142 (SPF1 101559 . 102140)) (102171 +104549 (SLF.FATPLEN 102181 . 103040) (FILEPIECE 103042 . 104547)) (104582 105350 (SELTEDIT 104592 . +105348)) (105420 111032 (PPARA 105430 . 105852) (PRUN 105854 . 107330) (ADDLINEPOSITIONS 107332 . +108759) (SBR 108761 . 109415) (SBC 109417 . 111030)) (111089 112865 (OLDWI 111099 . 111474) (COMP +111476 . 111671) (DFR 111673 . 112863)) (112866 113899 (DFGV 112876 . 113402) (GDIRECTORIES 113404 . +113897)) (113900 120465 (TTEST 113910 . 118442) (LTEST 118444 . 119809) (THC 119811 . 120463)) (120779 + 121471 (SHOWSAFE 120789 . 121469)) (121524 121971 (MYH 121534 . 121969)) (122216 123311 (DFVENUE +122226 . 123105) (VSEE 123107 . 123309)) (123312 123766 (PTT 123322 . 123764)) (125013 127329 ( +TEDIT-DEBUG 125023 . 127327)) (127330 129066 (TRENAME 127340 . 129064))))) STOP diff --git a/internal/TEDIT-DEBUG.LCOM b/internal/TEDIT-DEBUG.LCOM index 1c29b2669..265572f11 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 880b90756..3695a22eb 100644 --- a/library/tedit/TEDIT +++ b/library/tedit/TEDIT @@ -1,21 +1,27 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Feb-2025 15:07:03" {WMEDLEY}TEDIT>TEDIT.;765 155339 +(FILECREATED "20-Mar-2025 21:17:50" {WMEDLEY}tedit>TEDIT.;787 151076 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.MAP.OBJECTS TEDIT.INSERT.OBJECT) + :CHANGES-TO (FNS \TEDIT.WORD.FIRST \TEDIT.WORD.LAST \TEDIT.REPLACE.SELPIECES \TEDIT.DELETE + \TEDIT.COPY \TEDIT.MOVE) - :PREVIOUS-DATE "20-Feb-2025 08:50:50" {WMEDLEY}TEDIT>TEDIT.;763) + :PREVIOUS-DATE "16-Mar-2025 21:48:26" {WMEDLEY}TEDIT>TEDIT.;783) (PRETTYCOMPRINT TEDITCOMS) (RPAQQ TEDITCOMS [(FILES (SYSLOAD) - POSTSCRIPTSTREAM PDFSTREAM) + POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL) (COMS (* ; "Loadup stuff") + + (* ;; "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) (FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT) (DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE @@ -34,24 +40,21 @@ (GLOBALVARS CHECK-TEDIT-ASSERTIONS) (INITVARS (CHECK-TEDIT-ASSERTIONS T))) (MACROS OBJECT.ALLOWS))) - (FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS - TEDIT-STYLES) - [VARS (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP] (INITVARS (TEDIT.TENTATIVE NIL) (TEDIT.DEFAULT.PROPS NIL)) (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) (* ;; "Unslashed functions. Public?") - (FNS TEDIT TEXTSTREAM TEXTSTREAMP TEDITMENUP COERCETEXTSTREAM TEDIT.CONCAT TEDITSTRING - TEDIT-SEE TEDIT.COPY TEDIT.DELETE TEDIT.INSERT TEDIT.TERPRI TEDIT.KILL TEDIT.QUIT - TEDIT.MOVE TEDIT.STRINGWIDTH TEDIT.CHARWIDTH) + (FNS TEDIT TEXTSTREAM TEXTSTREAMP COERCETEXTSTREAM TEDIT.CONCAT TEDITSTRING TEDIT-SEE + TEDIT.COPY TEDIT.DELETE TEDIT.INSERT TEDIT.TERPRI TEDIT.KILL TEDIT.QUIT TEDIT.MOVE + TEDIT.STRINGWIDTH TEDIT.CHARWIDTH) (FNS TEXTOBJ COERCETEXTOBJ) (MACROS TEVAL) (FNS TDRIBBLE) (COMS (* ; "Object-oriented editing") - (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD - TEDIT.OBJECT.CHANGED TEDIT.MAP.OBJECTS \TEDIT.FIRST.OBJPIECE \TEDIT.NEXT.OBJPIECE) + (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.OBJECT.CHANGED TEDIT.MAP.OBJECTS + \TEDIT.FIRST.OBJPIECE \TEDIT.NEXT.OBJPIECE) (FILES IMAGEOBJ)) (FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS) (FNS \TEDIT.MOVE.MSG \TEDIT.READONLY) @@ -65,11 +68,8 @@ \TEDIT.WORDDELETE.FORWARD \TEDIT.FINISHEDIT?) (COMS (FNS \TEDIT.THELP) (INITVARS (\TEDIT.THELPFLG NIL))) - (FNS \TEDIT.PARAPIECES \TEDIT.PARA.FIRST \TEDIT.PARA.LAST) + (FNS \TEDIT.PARAPIECES \TEDIT.PARACHNOS \TEDIT.PARA.FIRST \TEDIT.PARA.LAST) (FNS \TEDIT.WORD.FIRST \TEDIT.WORD.LAST) - - (* ;; "Would be nice to just do (DOFILESLOAD (CDR TEDITFILES)). But the order for exports.all and the order for loading have to be aligned.") - (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) (COMS (* ; "TEDIT Support information") @@ -81,17 +81,27 @@ (EXTENSION (TEDIT]) (FILESLOAD (SYSLOAD) - POSTSCRIPTSTREAM PDFSTREAM) + POSTSCRIPTSTREAM PDFSTREAM WHEELSCROLL) (* ; "Loadup stuff") + + +(* ;; +"Would be nice to just do (DOFILESLOAD (CDR TEDITFILES)). But the order for exports.all and the order for loading have to be aligned." +) + + (RPAQQ TEDITFILES (TEDIT TEDIT-PCTREE TEDIT-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND TEDIT-FILE TEDIT-OLDFILE TEDIT-LOOKS TEDIT-STYLES TEDIT-WINDOW TEDIT-BUTTONS 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 + ) (DEFINEQ (MAKE-TEDIT-EXPORTS.ALL @@ -105,22 +115,23 @@ VAL]) (UPDATE-TEDIT - [LAMBDA (FILES LDFLG) (* ; "Edited 16-Feb-2025 11:25 by rmk") - (* ; "Edited 26-Oct-2022 21:10 by rmk") - (CL:UNLESS LDFLG (SETQ LDFLG T)) - (for F in LOADEDFILELST eachtime (SETQ F (TRUEFILENAME F)) - when [AND (STRPOS ">library>tedit>TEDIT-" F 1 NIL NIL NIL UPPERCASEARRAY) - (STRING.EQUAL 'LCOM (FILENAMEFIELD F 'EXTENSION] collect (FILENAMEFIELD F - 'NAME) - finally + [LAMBDA (FILES LDFLG) (* ; "Edited 9-Mar-2025 19:17 by rmk") + (* ; "Edited 7-Mar-2025 23:40 by rmk") + (* ; "Edited 26-Oct-2022 21:10 by rmk") + (* ; "Edited 16-Feb-2025 11:25 by rmk") - (* ;; "Loading TEDIT will probably do the DOFILESLOAD for all the other files, this may be overkill. But we want to make sure the load's happen even if it looks like the files are already there (e.g. not LOAD?).") + (* ;; + "Loads compiled TEDITFILES that were compiled on sources different from the currently loaded files.") - (RETURN (for LF in (CONS 'TEDIT (REMOVE 'TEDIT $$VAL)) - collect (PSEUDOFILENAME (LOAD LF LDFLG]) + (CL:UNLESS LDFLG + (SETQ LDFLG 'SYSLOAD)) + (for F CF in TEDITFILES when (SETQ CF (FINDFILE-WITH-EXTENSIONS F NIL *COMPILED-EXTENSIONS*)) + unless (thereis LF TCF in LOADEDFILELST first (SETQ TCF (TRUEFILENAME CF)) + suchthat (STRING.EQUAL TCF (TRUEFILENAME LF))) do (LOAD CF LDFLG]) (EDIT-TEDIT - [LAMBDA NIL (* ; "Edited 3-Jul-2023 13:44 by rmk") + [LAMBDA NIL (* ; "Edited 7-Mar-2025 22:53 by rmk") + (* ; "Edited 3-Jul-2023 13:44 by rmk") (* ; "Edited 17-Jun-2023 10:00 by rmk") (* ; "Edited 25-Apr-2023 17:39 by rmk") (* ; "Edited 26-Oct-2022 21:12 by rmk") @@ -128,6 +139,7 @@ (BKSYSBUF " ") (RESETLST (RESETSAVE LOADDBFLG 'YES) + (UPDATE-TEDIT) (FOR F IN TEDITFILES DO (LOADFROM F) (LOADCOMP F))) (%. ANALYZE ON IN TEDITFILES]) @@ -177,11 +189,6 @@ ) -(FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES - ) - -(RPAQ TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP)) - (RPAQ? TEDIT.TENTATIVE NIL) (RPAQ? TEDIT.DEFAULT.PROPS NIL) @@ -291,19 +298,6 @@ (CL:WHEN (type? TEXTSTREAM TSTREAM) TSTREAM]) -(TEDITMENUP - [LAMBDA (WINDOW TITLE) (* ; "Edited 15-Mar-2024 15:39 by rmk") - (* ; "Edited 7-Dec-2023 21:06 by rmk") - (* ; "Edited 20-Sep-2023 22:36 by rmk") - (* ; "Edited 10-Apr-2023 10:14 by rmk") - (CL:WHEN (AND (WINDOWP WINDOW) - (WINDOWPROP WINDOW 'TEDITMENU) - (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW) - (CL:IF TITLE - (STRING.EQUAL TITLE (WINDOWPROP WINDOW 'TITLE)) - T)) - (WINDOWPROP WINDOW 'TITLE))]) - (COERCETEXTSTREAM [LAMBDA (TSTREAM TYPE OUTPUTSTREAM) (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 13-Jan-2024 20:01 by rmk") @@ -728,14 +722,22 @@ (DEFINEQ (TDRIBBLE - [LAMBDA NIL (* ; "Edited 27-Nov-2024 23:20 by rmk") + [LAMBDA NIL (* ; "Edited 16-Mar-2025 21:47 by rmk") + (* ; "Edited 27-Nov-2024 23:20 by rmk") (* ; "Edited 17-Nov-2024 14:10 by rmk") (* ; "Edited 15-Nov-2024 21:13 by rmk") (* ; "Edited 22-Oct-2024 21:23 by rmk") (LET [(TSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL `(HISTORY OFF TITLE "Tedit dribble" FONT DEFAULTFONT] [WHENCLOSE TSTREAM 'BEFORE (FUNCTION (LAMBDA (TSTREAM) - (TEDIT TSTREAM 'TeditDribble NIL + (TEDIT TSTREAM [GETBOXREGION + (fetch (REGION WIDTH) + of (WINDOWPROP (WFROMDS T) + 'REGION)) + (fetch (REGION HEIGHT) + of (WINDOWPROP (WFROMDS T) + 'REGION] + NIL '(LEAVETTY T APPEND QUIET PARABREAKCHARS NIL HISTORY OFF)) (TEDIT.SETSEL TSTREAM 1 0] @@ -861,57 +863,6 @@ (TEDIT.OBJECT.CHANGED TSTREAM OBJ))) (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select an editable object" T T]) -(TEDIT.FIND.OBJECT - [LAMBDA (TSTREAM OBJ START END) (* ; "Edited 20-Oct-2024 12:07 by rmk") - (* ; "Edited 10-May-2024 21:58 by rmk") - (* ; "Edited 16-Mar-2024 10:03 by rmk") - (* ; "Edited 6-Nov-2022 11:12 by rmk") - (* ; "Edited 3-May-93 12:52 by jds") - - (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END. We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.") - - (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (CL:WHEN (IMAGEOBJP OBJ) - [LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))) - (CL:UNLESS END - (SETQ END (FGETTOBJ TEXTOBJ TEXTLEN))) - (CL:UNLESS START - (SETQ START (TEDIT.GETPOINT TSTREAM))) - (CL:WHEN (AND (ILEQ START END) - (SETQ START (\TEDIT.CHTOPC START TEXTOBJ))) - (SETQ END (\TEDIT.CHTOPC END TEXTOBJ)) - (for PC inpieces START when (EQ OBJ (PCONTENTS PC)) - do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC END)))])]) - -(TEDIT.FIND.OBJECT.BACKWARD - [LAMBDA (TSTREAM OBJ START END AGAIN) (* ; "Edited 10-May-2024 22:06 by rmk") - (* ; "Edited 16-Mar-2024 10:03 by rmk") - (* ; "Edited 6-Nov-2022 11:12 by rmk") - (* ; "Edited 3-May-93 12:52 by jds") - - (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END and is the occurrence closest to END. START defaults to 1, END defaults to current caret position (or one before, if AGAIN).") - - (* ;; "If we were sure that a given object can appear only once in a document, we could just run the TEDIT.FIND.OBJECT with different defaults for START and END, but...") - - (* ;; "We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.") - - (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (CL:WHEN (IMAGEOBJP OBJ) - [LET [(TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] - (SETQ START (IMAX 1 (OR START 1))) - (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM))) - (FGETTOBJ TEXTOBJ TEXTLEN))) - (CL:WHEN AGAIN - - (* ;; "Assume that we aren't interested in another match at the current position.") - - (ADD END -1)) - (CL:WHEN (ILEQ START END) - (SETQ START (\TEDIT.CHTOPC START TEXTOBJ)) - (SETQ END (\TEDIT.CHTOPC END TEXTOBJ)) - (for PC backpieces END when (EQ OBJ (PCONTENTS PC)) - do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC START)))])]) - (TEDIT.OBJECT.CHANGED [LAMBDA (TSTREAM OBJECT PIECE/CH#/SEL) (* ; "Edited 26-Nov-2024 03:52 by rmk") (* ; "Edited 20-Oct-2024 12:08 by rmk") @@ -1626,7 +1577,8 @@ (CL:IF BPD (\TEDIT.POPEVENT TOOBJ])]) (\TEDIT.COPY - [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 23-Nov-2024 22:45 by rmk") + [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "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") (* ; "Edited 27-Aug-2024 13:37 by rmk") @@ -1693,10 +1645,12 @@ (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) (* ;  "Take down anything that might thave appeared") (\TEDIT.FIXSEL TOSEL TOOBJ) + (\TEDIT.SHOWSEL TOSEL T TOOBJ) (\TEDIT.SCROLL.CARET TOTSTREAM)))]) (\TEDIT.REPLACE.SELPIECES - [LAMBDA (INSERTSELPIECES TEXTOBJ SEL) (* ; "Edited 8-Dec-2024 13:46 by rmk") + [LAMBDA (INSERTSELPIECES TEXTOBJ SEL) (* ; "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") (* ; "Edited 21-Sep-2024 22:12 by rmk") @@ -1718,11 +1672,10 @@  "On return, the pieces, lines, selection, and display are complete, correct, and consistent ") (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) - (PROG ((POINT (GETSEL SEL POINT)) + [PROG ((POINT (GETSEL SEL POINT)) (CH# (FGETSEL SEL CH#)) (DCH (FGETSEL SEL DCH)) - (ILEN (GETSPC INSERTSELPIECES SPLEN)) - DELEVENT) + DELEVENT ILEN) (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;; "We first delete, then insert, updating the display after the second operation.") @@ -1742,7 +1695,8 @@ (* ;; "") - (CL:WHEN (AND (IGEQ ILEN 0) + (CL:WHEN (AND INSERTSELPIECES (IGEQ (SETQ ILEN (GETSPC INSERTSELPIECES SPLEN)) + 0) (\TEDIT.INSERT.SELPIECES INSERTSELPIECES TEXTOBJ SEL T)) (* ;; "If both delete and insert happened, foush the insert event and upgrade the DELEVENT to a single :Replace. The insert has not updated the lines or the selection") @@ -1752,12 +1706,12 @@ (SETTH DELEVENT THACTION :Replace) (SETTH DELEVENT THLEN ILEN) (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)) - elseif (ILESSP ILEN DCH) - then (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION CH# (IDIFFERENCE DCH ILEN)) - else (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS CH# DCH))))]) + (\TEDIT.UPDATE.SEL SEL CH# ILEN POINT) + (if (IGREATERP ILEN DCH) + then (\TEDIT.UPDATE.LINES TEXTOBJ '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)))])]) (\TEDIT.INSERT.SELPIECES [LAMBDA (SELPIECES TEXTOBJ TARGETSEL DONTUPDATE) (* ; "Edited 26-Nov-2024 11:04 by rmk") @@ -1992,7 +1946,8 @@ OBJ]) (\TEDIT.DELETE - [LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "Edited 6-Feb-2025 00:14 by rmk") + [LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "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") @@ -2056,12 +2011,12 @@ (* ;; "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) - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) T)]) (\TEDIT.DIFFUSE.PARALOOKS @@ -2248,6 +2203,20 @@ SPFIRSTCHAR _ (CAR FIRST) SPLASTCHAR _ (CAR LAST]) +(\TEDIT.PARACHNOS + [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 7-Mar-2025 23:39 by rmk") + (* ; "Edited 30-May-91 21:06 by jds") + + (* ;; "Returns a list containing the last character number (EOL?) for each paragraph that includes characters from SEL/FIRSTCHAR to LASTCHAR.") + + (CL:WHEN (type? SELECTION SEL/FIRSTCHAR) + (SETQ LASTCHAR (FGETSEL SEL/FIRSTCHAR CHLAST)) + (SETQ SEL/FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#))) + (LET [PARAS (FIRSTPARA (\TEDIT.PARA.LAST TEXTOBJ SEL/FIRSTCHAR)) + (LASTPARAPC (CDR (\TEDIT.PARA.LAST TEXTOBJ LASTCHAR] + (for PC inpieces (CDR FIRSTPARA) as CHNO from (CAR FIRSTPARA) by (PLEN PC) + when (PPARALAST PC) collect CHNO repeatuntil (EQ PC LASTPARAPC]) + (\TEDIT.PARA.FIRST [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 30-Jan-2025 12:02 by rmk") (* ; "Edited 11-Jan-2025 00:08 by rmk") @@ -2334,7 +2303,9 @@ (DEFINEQ (\TEDIT.WORD.FIRST - [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "Edited 20-Dec-2024 07:51 by rmk") + [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "Edited 20-Mar-2025 20:21 by rmk") + (* ; "Edited 13-Mar-2025 21:15 by rmk") + (* ; "Edited 20-Dec-2024 07:51 by rmk") (* ; "Edited 29-Apr-2024 10:56 by rmk") (* ; "Edited 20-Mar-2024 10:54 by rmk") (* ; "Edited 17-Mar-2024 12:05 by rmk") @@ -2353,145 +2324,89 @@ (if (ILEQ CHNO 1) then 1 - else (PROG ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) - READSA CH) - (SETQ READSA (fetch READSA of (OR WORDBOUNDTABLE (FGETTOBJ TEXTOBJ TXTWTBL) - TEDIT.WORDBOUND.READTABLE))) + else (LET* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + (READSA (fetch READSA of (OR WORDBOUNDTABLE (FGETTOBJ TEXTOBJ TXTWTBL) + TEDIT.WORDBOUND.READTABLE))) + CH) (SETQ CHNO (IMIN CHNO (FGETTOBJ TEXTOBJ TEXTLEN))) - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; "Fileptrs are one back") - (SETQ CH (BIN TSTREAM)) (* ; "The char at CHNO") - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; "Started on a punct, return") - (RETURN CHNO)) + (* ;; "Skip over any preceding whitespace characters. .") - (* ;; "Skip over any preceding whitespace characters. We don't know when the stream's piece might have changed, so test at each iteration.") + [SETQ CHNO (find CN from CHNO by -1 eachtime (SETQ CH (TEDIT.NTHCHARCODE TSTREAM CN) + ) + suchthat (OR (NOT (CHARCODEP CH)) + (NEQ (\TEDIT.TTC WHITESPACE) + (\SYNCODE READSA CH)) + (GETCLOOKS (PCHARLOOKS (GETTSTR TSTREAM PIECE)) + CLPROTECTED] - (for old CHNO from CHNO to 1 by -1 while (AND (CHARCODEP CH) - (EQ WHITESPACE.TTC (\SYNCODE READSA CH - ))) - until (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM))) - do (SETQ CH (\BACKBIN TSTREAM))) + (* ;; "") - (* ;; "") - - (* ;; "CH is either TEXT, PUNCT, or image object.") - - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; "Punct before whitespace, look no further, punct is our guy.") - - (RETURN (ADD1 CHNO))) - - (* ;; "") - - (* ;; "We've reached the first unprotected non-separator character, and CHNO is the number of the character BEFORE that one. Continue backwards through the text characters until reaching the first preceding non-text.") - - (for old CHNO from CHNO to 1 by -1 - until [OR (CL:IF (CHARCODEP CH) - (NEQ TEXT.TTC (\SYNCODE READSA CH)) - T) - (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM] - do (SETQ CH (\BACKBIN TSTREAM))) - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; - "We ended on a punct before some text, CHNO is one before the punct, get back to text") + (* ;; + "We've reached the first unprotected non-white character, and CHNO is its number. ") - (RETURN (IPLUS CHNO 2))) + (* ;; + "If a punct, we treat it as a break: Return its position. Otherwise, scan for the first non-text") - (* ;; "We've now reached the first non-text character before the word, and CHNO is the character number of the character BEFORE it, or 0 if you hit the front of the document. We add 1 for that, plus 1 to convert fileptr to charno.") + (* ;; "If CHNO is text, then look for the first previous non-text. If non-text, look for the first previous text.") - (RETURN (IPLUS CHNO (CL:IF (EQ CHNO 0) - 1 - 2)]) + (if (EQ (\TEDIT.TTC TEXT) + (\SYNCODE READSA CH)) + then [ADD1 (find CN from CHNO by -1 eachtime (SETQ CH (TEDIT.NTHCHARCODE TSTREAM + CN)) + suchthat (OR (NOT (CHARCODEP CH)) + (NEQ (\TEDIT.TTC TEXT) + (\SYNCODE READSA CH)) + (GETCLOOKS (PCHARLOOKS (GETTSTR TSTREAM PIECE)) + CLPROTECTED] + else CHNO]) (\TEDIT.WORD.LAST - [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "Edited 29-Apr-2024 10:57 by rmk") + [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "Edited 20-Mar-2025 20:21 by rmk") + (* ; "Edited 13-Mar-2025 21:06 by rmk") + (* ; "Edited 29-Apr-2024 10:57 by rmk") (* ; "Edited 20-Mar-2024 10:54 by rmk") - (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 25-Dec-2023 18:38 by rmk") (* ; "Edited 23-May-2023 16:37 by rmk") - (* ; "Edited 22-May-2023 10:52 by rmk") (* ; "Edited 29-May-91 18:22 by jds") - (* ;; "Returns the number of the last character of the word containing CHNO or of the word following CHNO if CHNO does not map to a text character. Unlike the paragraph case, we don't get much help from the pieces, because words are not piece-aligned. Caller can do the piece manipulation given the result. ") - - (* ;; "We don't need to worry about invisibles here,\BIN skips them.") - - (* ;; "Image objects are treated as text characters.") + (* ;; "Returns the number of the last character of the word containing CHNO or of the word following CHNO if CHNO is whitespace. Unlike the paragraph case, we don't get much help from the pieces, because words are not piece-aligned. . ") (* ;;  "Punctuation is tricky: It stops whitespace and text, and its immediate successor doesn't matter.") - (PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (SETQ CHNO (IMAX CHNO 1)) + (PROG* ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) (READSA (fetch READSA of (OR WORDBOUNDTABLE (FGETTOBJ TEXTOBJ TXTWTBL) TEDIT.WORDBOUND.READTABLE))) (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)) CH) (CL:WHEN (IGEQ CHNO TEXTLEN) (RETURN TEXTLEN)) - (SETQ CHNO (IMAX CHNO 1)) - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; "Fileptrs are one back") - (SETQ CH (BIN TSTREAM)) (* ; "The char at CHNO") - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; "Started on a punct, return") - - (RETURN CHNO)) - (* ;; "Skip over any following separator characters. Objects are consider to be text characters--don't skip over them. We don't know when the stream's piece might have changed, so test at each iteration.") - - (for old CHNO from CHNO to (SUB1 TEXTLEN) while (AND (CHARCODEP CH) - (EQ WHITESPACE.TTC (\SYNCODE READSA - CH))) - until (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM))) - do (SETQ CH (BIN TSTREAM))) - - (* ;; "CH is either TEXT, PUNCT, or image object.") - - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; "Punct after whitespace, look no further, punct is our guy.") - - (RETURN CHNO)) - - (* ;; "We reached the last unprotected non-separator character, and CHNO is the number of the character AFTER that one. Continue forwards through the text characters until reaching the first following separator.") - - (for old CHNO from CHNO to (SUB1 TEXTLEN) - until [OR (CL:IF (CHARCODEP CH) - (NEQ TEXT.TTC (\SYNCODE READSA CH)) - T) - (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM] - do (SETQ CH (BIN TSTREAM))) - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) - - (* ;; - "We ended on a punct after some text, CHNO is one after the punct, get back to text") - - (RETURN (SUB1 CHNO))) - - (* ;; "We've now reached the first separator character after the word, and CHNO is the character number of the character after it, or TEXTLEN if we ran off the end..") - - (RETURN (CL:IF (IGEQ CHNO TEXTLEN) - TEXTLEN - (SUB1 CHNO))]) + (* ;; "Skip over any following whitespace characters, arriving at first text/punct/object.") + + [SETQ CHNO (find CN from CHNO by 1 eachtime (SETQ CH (TEDIT.NTHCHARCODE TSTREAM CN)) + suchthat (OR (NOT (CHARCODEP CH)) + (NEQ (\TEDIT.TTC WHITESPACE) + (\SYNCODE READSA CH)) + (GETCLOOKS (PCHARLOOKS (GETTSTR TSTREAM PIECE)) + CLPROTECTED] + + (* ;; "Continue through the word characters. If CH is not text, we treat it as a break (stop and return its position). ") + + (RETURN (if (EQ (\TEDIT.TTC TEXT) + (\SYNCODE READSA CH)) + then [SUB1 (find CN from CHNO eachtime (SETQ CH (TEDIT.NTHCHARCODE TSTREAM CN) + ) + suchthat (OR (NOT (CHARCODEP CH)) + (NEQ (\TEDIT.TTC TEXT) + (\SYNCODE READSA CH)) + (GETCLOOKS (PCHARLOOKS (GETTSTR TSTREAM PIECE)) + CLPROTECTED] + else CHNO]) ) - - -(* ;; -"Would be nice to just do (DOFILESLOAD (CDR TEDITFILES)). But the order for exports.all and the order for loading have to be aligned." -) - - (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) @@ -2500,7 +2415,7 @@ (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE "25-Feb-2025 15:07:03") +(RPAQQ TEDITSYSTEMDATE "20-Mar-2025 21:17:50") @@ -2510,27 +2425,26 @@ (ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) (EXTENSION (TEDIT)))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4651 6994 (MAKE-TEDIT-EXPORTS.ALL 4661 . 5207) (UPDATE-TEDIT 5209 . 6223) (EDIT-TEDIT -6225 . 6992)) (8688 36922 (TEDIT 8698 . 11276) (TEXTSTREAM 11278 . 13198) (TEXTSTREAMP 13200 . 13584) -(TEDITMENUP 13586 . 14352) (COERCETEXTSTREAM 14354 . 18565) (TEDIT.CONCAT 18567 . 21873) (TEDITSTRING -21875 . 22789) (TEDIT-SEE 22791 . 23350) (TEDIT.COPY 23352 . 25497) (TEDIT.DELETE 25499 . 26751) ( -TEDIT.INSERT 26753 . 29711) (TEDIT.TERPRI 29713 . 30827) (TEDIT.KILL 30829 . 31745) (TEDIT.QUIT 31747 - . 33113) (TEDIT.MOVE 33115 . 34003) (TEDIT.STRINGWIDTH 34005 . 34676) (TEDIT.CHARWIDTH 34678 . 36920) -) (36923 38864 (TEXTOBJ 36933 . 37398) (COERCETEXTOBJ 37400 . 38862)) (40264 41320 (TDRIBBLE 40274 . -41318)) (41361 56908 (TEDIT.INSERT.OBJECT 41371 . 46212) (TEDIT.EDIT.OBJECT 46214 . 48555) ( -TEDIT.FIND.OBJECT 48557 . 50065) (TEDIT.FIND.OBJECT.BACKWARD 50067 . 51994) (TEDIT.OBJECT.CHANGED -51996 . 54863) (TEDIT.MAP.OBJECTS 54865 . 56436) (\TEDIT.FIRST.OBJPIECE 56438 . 56671) ( -\TEDIT.NEXT.OBJPIECE 56673 . 56906)) (56931 64374 (\TEDIT.CONCAT.PAGEFRAMES 56941 . 62008) ( -\TEDIT.GET.PAGE.HEADINGS 62010 . 63039) (\TEDIT.CONCAT.INSTALL.HEADINGS 63041 . 64372)) (64375 67804 ( -\TEDIT.MOVE.MSG 64385 . 66466) (\TEDIT.READONLY 66468 . 67802)) (67805 82641 (TEDIT.NCHARS 67815 . -68188) (TEDIT.RPLCHARCODE 68190 . 76205) (TEDIT.NTHCHARCODE 76207 . 78564) (TEDIT.NTHCHAR 78566 . -78824) (\TEDIT.PIECE.NTHCHARCODE 78826 . 82639)) (82687 137139 (\TEDIT1 82697 . 84774) (\TEDIT.INSERT -84776 . 90753) (\TEDIT.MOVE 90755 . 98105) (\TEDIT.COPY 98107 . 102085) (\TEDIT.REPLACE.SELPIECES -102087 . 106067) (\TEDIT.INSERT.SELPIECES 106069 . 108954) (\TEDIT.RESTARTFN 108956 . 111461) ( -\TEDIT.CHARDELETE 111463 . 114290) (\TEDIT.COPYPIECE 114292 . 119140) (\TEDIT.APPLY.OBJFN 119142 . -122339) (\TEDIT.DELETE 122341 . 127269) (\TEDIT.DIFFUSE.PARALOOKS 127271 . 129542) (\TEDIT.WORDDELETE -129544 . 131100) (\TEDIT.WORDDELETE.FORWARD 131102 . 132774) (\TEDIT.FINISHEDIT? 132776 . 137137)) ( -137140 137799 (\TEDIT.THELP 137150 . 137797)) (137833 145723 (\TEDIT.PARAPIECES 137843 . 139817) ( -\TEDIT.PARA.FIRST 139819 . 142686) (\TEDIT.PARA.LAST 142688 . 145721)) (145724 154689 ( -\TEDIT.WORD.FIRST 145734 . 150390) (\TEDIT.WORD.LAST 150392 . 154687))))) + (FILEMAP (NIL (4933 7327 (MAKE-TEDIT-EXPORTS.ALL 4943 . 5489) (UPDATE-TEDIT 5491 . 6420) (EDIT-TEDIT +6422 . 7325)) (8835 36301 (TEDIT 8845 . 11423) (TEXTSTREAM 11425 . 13345) (TEXTSTREAMP 13347 . 13731) +(COERCETEXTSTREAM 13733 . 17944) (TEDIT.CONCAT 17946 . 21252) (TEDITSTRING 21254 . 22168) (TEDIT-SEE +22170 . 22729) (TEDIT.COPY 22731 . 24876) (TEDIT.DELETE 24878 . 26130) (TEDIT.INSERT 26132 . 29090) ( +TEDIT.TERPRI 29092 . 30206) (TEDIT.KILL 30208 . 31124) (TEDIT.QUIT 31126 . 32492) (TEDIT.MOVE 32494 . +33382) (TEDIT.STRINGWIDTH 33384 . 34055) (TEDIT.CHARWIDTH 34057 . 36299)) (36302 38243 (TEXTOBJ 36312 + . 36777) (COERCETEXTOBJ 36779 . 38241)) (39643 41413 (TDRIBBLE 39653 . 41411)) (41454 53562 ( +TEDIT.INSERT.OBJECT 41464 . 46305) (TEDIT.EDIT.OBJECT 46307 . 48648) (TEDIT.OBJECT.CHANGED 48650 . +51517) (TEDIT.MAP.OBJECTS 51519 . 53090) (\TEDIT.FIRST.OBJPIECE 53092 . 53325) (\TEDIT.NEXT.OBJPIECE +53327 . 53560)) (53585 61028 (\TEDIT.CONCAT.PAGEFRAMES 53595 . 58662) (\TEDIT.GET.PAGE.HEADINGS 58664 + . 59693) (\TEDIT.CONCAT.INSTALL.HEADINGS 59695 . 61026)) (61029 64458 (\TEDIT.MOVE.MSG 61039 . 63120) + (\TEDIT.READONLY 63122 . 64456)) (64459 79295 (TEDIT.NCHARS 64469 . 64842) (TEDIT.RPLCHARCODE 64844 + . 72859) (TEDIT.NTHCHARCODE 72861 . 75218) (TEDIT.NTHCHAR 75220 . 75478) (\TEDIT.PIECE.NTHCHARCODE +75480 . 79293)) (79341 134242 (\TEDIT1 79351 . 81428) (\TEDIT.INSERT 81430 . 87407) (\TEDIT.MOVE 87409 + . 94759) (\TEDIT.COPY 94761 . 98894) (\TEDIT.REPLACE.SELPIECES 98896 . 103061) ( +\TEDIT.INSERT.SELPIECES 103063 . 105948) (\TEDIT.RESTARTFN 105950 . 108455) (\TEDIT.CHARDELETE 108457 + . 111284) (\TEDIT.COPYPIECE 111286 . 116134) (\TEDIT.APPLY.OBJFN 116136 . 119333) (\TEDIT.DELETE +119335 . 124372) (\TEDIT.DIFFUSE.PARALOOKS 124374 . 126645) (\TEDIT.WORDDELETE 126647 . 128203) ( +\TEDIT.WORDDELETE.FORWARD 128205 . 129877) (\TEDIT.FINISHEDIT? 129879 . 134240)) (134243 134902 ( +\TEDIT.THELP 134253 . 134900)) (134936 143720 (\TEDIT.PARAPIECES 134946 . 136920) (\TEDIT.PARACHNOS +136922 . 137814) (\TEDIT.PARA.FIRST 137816 . 140683) (\TEDIT.PARA.LAST 140685 . 143718)) (143721 +150579 (\TEDIT.WORD.FIRST 143731 . 147616) (\TEDIT.WORD.LAST 147618 . 150577))))) STOP diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV index b7c652c4e..29aaca270 100644 --- a/library/tedit/TEDIT-ABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,98 +1,208 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}tedit>TEDIT-ABBREV.;9 10946 +(FILECREATED "23-Mar-2025 17:09:00" {WMEDLEY}tedit>TEDIT-ABBREV.;20 15864 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND) + :CHANGES-TO (FNS \TEDIT.ABBREV.PARSE) - :PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}tedit>TEDIT-ABBREV.;8) + :PREVIOUS-DATE "20-Mar-2025 22:21:20" {WMEDLEY}tedit>TEDIT-ABBREV.;19) (PRETTYCOMPRINT TEDIT-ABBREVCOMS) -(RPAQQ TEDIT-ABBREVCOMS [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) - (GLOBALVARS TEDIT.ABBREVS) - (INITVARS (TEDIT.ABBREVS '(("b" . "357,146") - ("n" . "357,44") - ("m" . "357,45") - ("T" . "357,57") - ("d" . "357,60") - ("D" . "357,61") - ("s" . "0,247") - ("'" . "0,271") - ("`" . "0,251") - ("%"" . "0,252") - ("~" . "0,272") - ("1/4" . "0,274") - ("1/2" . "0,275") - ("3/4" . "0,276") - ("1/3" . "357,375") - ("2/3" . "357,376") - ("c" . "0,323") - ("c/o" . "357,100") - ("%%" . "357,100") - ("->" . "0,256") - ("ra" . "0,256") - ("|" . "0,257") - ("da" . "0,257") - ("^" . "0,255") - ("ua" . "0,255") - ("<-" . "0,254") - ("la" . "0,254") - ("_" . "0,254") - ("L" . "0,243") - ("o" . "0,260") - ("Y" . "0,245") - ("+" . "0,261") - ("x" . "0,264") - ("/" . "0,270") - ("=" . "357,121") - ("p" . "0,266") - ("r" . "0,322") - ("t" . "0,324") - ("tm" . "0,324") - ("box" . "42,42") - ("cbox" . "42,61") - ("-" . "357,43") - ("=" . "357,42") - (" " . "357,41") - ("DATE" . \TEDIT.EXPAND.DATE) - (">>DATE<<" . \TEDIT.EXPAND.DATE]) +(RPAQQ TEDIT-ABBREVCOMS + [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.ABBREV.PARSE \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) + (GLOBALVARS TEDIT.ABBREVS) + (INITVARS (TEDIT.ABBREVS '(("b" . "357,146") + ("n" . "357,44") + ("m" . "357,45") + ("T" . "357,57") + ("d" . "357,60") + ("D" . "357,61") + ("s" . "0,247") + ("'" . "0,271") + ("`" . "0,251") + ("%"" . "0,252") + ("~" . "0,272") + ("1/4" . "0,274") + ("1/2" . "0,275") + ("3/4" . "0,276") + ("1/3" . "357,375") + ("2/3" . "357,376") + ("c" . "0,323") + ("c/o" . "357,100") + ("%%" . "357,100") + ("->" . "0,256") + ("ra" . "0,256") + ("|" . "0,257") + ("da" . "0,257") + ("^" . "0,255") + ("ua" . "0,255") + ("<-" . "0,254") + ("la" . "0,254") + ("_" . "0,254") + ("L" . "0,243") + ("o" . "0,260") + ("Y" . "0,245") + ("+" . "0,261") + ("x" . "0,264") + ("/" . "0,270") + ("=" . "357,121") + ("p" . "0,266") + ("r" . "0,322") + ("t" . "0,324") + ("tm" . "0,324") + ("box" . "42,42") + ("cbox" . "42,61") + ("-" . "357,43") + ("=" . "357,42") + (" " . "357,41") + ("DATE" . \TEDIT.EXPAND.DATE) + (">>DATE<<" . \TEDIT.EXPAND.DATE]) (DEFINEQ (\TEDIT.ABBREV.EXPAND - [LAMBDA (TSTREAM) (* ; "Edited 31-Oct-2024 17:50 by rmk") - (* ; "Edited 17-Mar-2024 12:06 by rmk") - (* ; "Edited 17-May-2023 13:31 by rmk") - (* ; "Edited 8-Sep-2022 23:53 by rmk") - (* ; "Edited 1-Aug-2022 12:04 by rmk") + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 20-Mar-2025 21:52 by rmk") (* ; "Edited 30-May-91 19:27 by jds") (* ; "Expand an abbvreviation") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) - SEL CH# CH OLDLOOKS EXPANSION) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL))) - [COND - ((ZEROP (GETSEL SEL DCH)) (* ; - "Point Selection, so use the character to the left") - (CL:WHEN (ZEROP CH#) (* ; - "If we're off the front of the document, don't bother trying.") - (RETURN)) - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CH#) - CH#) - [SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM] - (TEDIT.SETSEL TSTREAM CH# 1 'RIGHT)) - (T (* ; - "We have a selection that isn't just a caret. Use it.") - (SETQ CH (TEDIT.SEL.AS.STRING TSTREAM] - (SETQ EXPANSION (\TEDIT.TRY.ABBREV CH TSTREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.") - (CL:WHEN EXPANSION (* ; - "It exists, so insert it where the abbrev used to be") - (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ)) - (TEDIT.DELETE TEXTOBJ SEL) (* ; - "First, delete the thing being expanded.") - (TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))]) + (LET ((CANDIDATES (\TEDIT.ABBREV.PARSE TSTREAM SEL)) + CAND EXPANSION) + + (* ;; "Candidates are ordered longest first, so D doesn't override EMDASH.") + + (* ;; "Try literal match first, then fiddle the case.") + + (* ;; "If we don't find it in abbrevs, try for a character code.") + + [SETQ CAND (OR (find C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV + (CAR C) + TSTREAM))) + (for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV + (U-CASE (CAR C)) + TSTREAM))) + (for C in CANDIDATES suchthat (SETQ EXPANSION (\TEDIT.TRY.ABBREV + (L-CASE (CAR C)) + TSTREAM] + (if EXPANSION + then (\TEDIT.UPDATE.SEL SEL (CADR CAND) + (CADDR CAND) + 'RIGHT + 'NORMAL) (* ; "Set the target") + (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.FROM.STRING EXPANSION TEXTOBJ NIL + (PCHARLOOKS (\TEDIT.CHTOPC (CADR CAND) + TEXTOBJ))) + TEXTOBJ SEL) + else (TEDIT.PROMPTPRINT TSTREAM "No abbreviation to expand" T]) + +(\TEDIT.ABBREV.PARSE + [LAMBDA (TSTREAM SEL) (* ; "Edited 23-Mar-2025 17:08 by rmk") + (* ; "Edited 20-Mar-2025 22:21 by rmk") + + (* ;; "This produces candidate abbreviation-strings by parsing the characters around the point. Each candidate is returned as a list (KEY STARTCH# LEN).") + + (* ;; + "It first backs up over any spaces to find the anchor position. The candidates then include") + + (* ;; " The immediately preceding singleton character, if a point selection") + + (* ;; " The remaining (after backing up) characters of the selection.") + + (* ;; " The word that contains the caret (backwards and forwards)") + + (* ;; " If the character before a candidate C is a comma, then the word before W before the comma (without or without \) is extracted, and W,C is is added to the list (a possible charname).") + + (* ;; "If the character before a candidate C is \, the \ is included in the replacement span, and \C is also added to the list (Tex style)") + + (* ;; "If one of the candidates is a character name, the abbreviation exapnds to the corresponding character.") + + (* ;; "Otherwise, the candidates are looked up in TEDIT.ABBREVS to find their expansions.") + + (PROG ((PT# (SUB1 (TEDIT.GETPOINT TSTREAM SEL))) + FIRST# LAST# LEN CANDIDATES KEY NSPACES) + + (* ;; "The abbreviation is taken from the CH# of the current selection. It is either the character just before a point selection, the entire selection, or the word containing the selection.") + + (* ;; " The character at CH#, if it is a point selection") + + (* ;; " Otherwise either the current selection up to and including CH# or the full word that includes the selection. What works is determined by what it finds in the abbreviations list.") + + (* ;; "Back up over spaces") + + (SETQ NSPACES (for I from PT# by -1 while (EQ (CHARCODE SPACE) + (TEDIT.NTHCHARCODE TSTREAM I)) sum 1)) + (add PT# (IMINUS NSPACES)) + (CL:WHEN (ZEROP PT#) (* ; "Beginning of document") + (RETURN)) + + (* ;; "Each candidate is a triple containing the key and the starting character and length of the replacement target..") + + (push CANDIDATES (LIST (MKSTRING (TEDIT.NTHCHAR TSTREAM PT#)) + PT# 1)) + (SETQ LEN (IMAX 0 (IDIFFERENCE (FGETSEL SEL DCH) + NSPACES))) (* ; "Last singleton predecessor") + (CL:WHEN (IGEQ LEN 2) (* ; "At least one more character") + (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM (FGETSEL SEL CH#) + LEN) + (FGETSEL SEL CH#) + LEN))) + (SETQ FIRST# (\TEDIT.WORD.FIRST TSTREAM PT#)) + (SETQ LEN (ADD1 (IDIFFERENCE PT# FIRST#))) + (CL:UNLESS (EQ LEN 1) (* ; "Already there") + (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN) + FIRST# LEN))) + (SETQ LAST# (\TEDIT.WORD.LAST TSTREAM FIRST#)) + (SETQ LEN (ADD1 (IDIFFERENCE LAST# FIRST#))) + (CL:UNLESS (EQ LEN 1) (* ; "Already there") + (push CANDIDATES (LIST (TEDIT.SEL.AS.STRING TSTREAM FIRST# LEN) + 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") + + (if [AND (MEMB (TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C))) + (CHARCODE (%, / -))) + (EQ (\TEDIT.TTC TEXT) + (TEDIT.WORDGET (TEDIT.NTHCHARCODE TSTREAM (IDIFFERENCE (CADR C) + 2] + then (SETQ END (\TEDIT.WORD.FIRST TSTREAM (IDIFFERENCE (CADR C) + 2))) + (* ; "Comma before, maybe a charname") + (SETQ KEY (CONCAT (TEDIT.SEL.AS.STRING TSTREAM END (IDIFFERENCE (CADR C) + END)) + (CAR C))) + (push CANDIDATES (LIST KEY END (NCHARS KEY))) + elseif [AND (MEMB (TEDIT.NTHCHARCODE TSTREAM (IPLUS (CADR C) + (CADDR C))) + (CHARCODE (%, / -))) + (EQ (\TEDIT.TTC TEXT) + (TEDIT.WORDGET (TEDIT.NTHCHARCODE TSTREAM (IPLUS 1 (CADR C) + (CADDR C] + then [SETQ END (\TEDIT.WORD.LAST TSTREAM (ADD1 (IPLUS (CADR C) + (CADDR C] + (* ; "Comma after") + [SETQ KEY (CONCAT (CAR C) + (TEDIT.SEL.AS.STRING TSTREAM (IPLUS (CADR C) + (CADDR C)) + (ADD1 (IDIFFERENCE END (IPLUS (CADR C) + (CADDR C] + (push CANDIDATES (LIST KEY (CADR C) + (NCHARS KEY] (* ; + "If preceded by \, include it optionally in the key, always include it in the replacement") + (for C in CANDIDATES when [EQ (CHARCODE \) + (TEDIT.NTHCHARCODE TSTREAM (SUB1 (CADR C] + do (* ; "Match and replace \KEY") + [push CANDIDATES (LIST (CONCAT "\" (CAR C)) + (SUB1 (CADR C)) + (ADD1 (CADDR C] + (change (CADR C) + (SUB1 DATUM)) (* ; "Match KEY but also replace the \") + (change (CADDR C) + (ADD1 DATUM))) + [SORT CANDIDATES (FUNCTION (LAMBDA (C1 C2) + (IGEQ (CADDR C1) + (CADDR C2] (* ; "Look for longest first") + (RETURN CANDIDATES]) (\TEDIT.EXPAND.DATE [LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds") @@ -109,100 +219,92 @@ " " DAY ", " YEAR]) (\TEDIT.TRY.ABBREV - [LAMBDA (ABBREV STREAM) (* ; "Edited 6-Aug-2020 14:41 by rmk:") + [LAMBDA (KEY TSTREAM) (* ; "Edited 20-Mar-2025 21:52 by rmk") + (* ; "Edited 6-Aug-2020 14:41 by rmk:") (* jds "11-Jul-85 12:46") - (* ;; - "Try expanding ABBREV as an abbreviation. Return the expansion; NIL = no such abbreviation.") - - (* ;; "RMK: Established that a character-code looking string (%"357,201%" or %"02FE%") or a number is a character code that converts to a character.") - - (PROG (SEL CH# (CH NIL) - EXPANSION) - (SETQ EXPANSION (OR (SASSOC ABBREV TEDIT.ABBREVS) - (SASSOC (U-CASE ABBREV) - TEDIT.ABBREVS))) - - (* Find the abbreviation's expansion --first try it as-is, then try the - upper-case version to be safe.) - - (RETURN (COND - (EXPANSION (* There's an expansion. - Turn it into an insertable string.) - (COND - [(STRINGP (CDR EXPANSION)) - - (* ;; "Could be a character code") - - (COND - ((SETQ CH (CHARCODE.DECODE (CDR EXPANSION) - T)) - (CHARACTER CH)) - (T (CDR EXPANSION] - ((SMALLP (CDR EXPANSION)) - - (* ;; "Treat a number as a character code.") - - (CHARACTER (CDR EXPANSION))) - ((AND (LITATOM (CDR EXPANSION)) - (GETD (CDR EXPANSION))) (* It's a function to be called.) - (APPLY* (CDR EXPANSION) - STREAM CH)) - (T (* Anything else is a form to EVAL.) - (EVAL (CDR EXPANSION]) + (* ;; "Decode the expansion. A string may be a character name, otherwise itself. A litatom is a function to be applied, anything else is evaled. ") + + (LET ((ABBREV (SASSOC KEY TEDIT.ABBREVS))) + (if (NULL ABBREV) + then (CL:WHEN (CHARCODE.DECODE KEY T) + (CHARACTER (CHARCODE.DECODE KEY T))) + elseif (STRINGP (CDR ABBREV)) + then + (* ;; "Could be a character code") + + (LET ((CH (CHARCODE.DECODE (CDR ABBREV) + T))) + (CL:IF CH + (CHARACTER CH) + (CDR ABBREV))) + elseif (SMALLP (CDR ABBREV)) + then + (* ;; "Treat a number as a character code.") + + (CHARACTER (CDR ABBREV)) + elseif (AND (LITATOM (CDR ABBREV)) + (GETD (CDR ABBREV))) + then (* ; "It's a function to be called.") + (APPLY* (CDR ABBREV) + TSTREAM + (CAR ABBREV)) + else (* ; "Anything else is a form to EVAL.") + (EVAL (CDR ABBREV]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.ABBREVS) ) -(RPAQ? TEDIT.ABBREVS '(("b" . "357,146") - ("n" . "357,44") - ("m" . "357,45") - ("T" . "357,57") - ("d" . "357,60") - ("D" . "357,61") - ("s" . "0,247") - ("'" . "0,271") - ("`" . "0,251") - ("%"" . "0,252") - ("~" . "0,272") - ("1/4" . "0,274") - ("1/2" . "0,275") - ("3/4" . "0,276") - ("1/3" . "357,375") - ("2/3" . "357,376") - ("c" . "0,323") - ("c/o" . "357,100") - ("%%" . "357,100") - ("->" . "0,256") - ("ra" . "0,256") - ("|" . "0,257") - ("da" . "0,257") - ("^" . "0,255") - ("ua" . "0,255") - ("<-" . "0,254") - ("la" . "0,254") - ("_" . "0,254") - ("L" . "0,243") - ("o" . "0,260") - ("Y" . "0,245") - ("+" . "0,261") - ("x" . "0,264") - ("/" . "0,270") - ("=" . "357,121") - ("p" . "0,266") - ("r" . "0,322") - ("t" . "0,324") - ("tm" . "0,324") - ("box" . "42,42") - ("cbox" . "42,61") - ("-" . "357,43") - ("=" . "357,42") - (" " . "357,41") - ("DATE" . \TEDIT.EXPAND.DATE) - (">>DATE<<" . \TEDIT.EXPAND.DATE))) +(RPAQ? TEDIT.ABBREVS + '(("b" . "357,146") + ("n" . "357,44") + ("m" . "357,45") + ("T" . "357,57") + ("d" . "357,60") + ("D" . "357,61") + ("s" . "0,247") + ("'" . "0,271") + ("`" . "0,251") + ("%"" . "0,252") + ("~" . "0,272") + ("1/4" . "0,274") + ("1/2" . "0,275") + ("3/4" . "0,276") + ("1/3" . "357,375") + ("2/3" . "357,376") + ("c" . "0,323") + ("c/o" . "357,100") + ("%%" . "357,100") + ("->" . "0,256") + ("ra" . "0,256") + ("|" . "0,257") + ("da" . "0,257") + ("^" . "0,255") + ("ua" . "0,255") + ("<-" . "0,254") + ("la" . "0,254") + ("_" . "0,254") + ("L" . "0,243") + ("o" . "0,260") + ("Y" . "0,245") + ("+" . "0,261") + ("x" . "0,264") + ("/" . "0,270") + ("=" . "357,121") + ("p" . "0,266") + ("r" . "0,322") + ("t" . "0,324") + ("tm" . "0,324") + ("box" . "42,42") + ("cbox" . "42,61") + ("-" . "357,43") + ("=" . "357,42") + (" " . "357,41") + ("DATE" . \TEDIT.EXPAND.DATE) + (">>DATE<<" . \TEDIT.EXPAND.DATE))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) ( -\TEDIT.TRY.ABBREV 6831 . 8977))))) + (FILEMAP (NIL (2933 14520 (\TEDIT.ABBREV.EXPAND 2943 . 5054) (\TEDIT.ABBREV.PARSE 5056 . 12222) ( +\TEDIT.EXPAND.DATE 12224 . 12857) (\TEDIT.TRY.ABBREV 12859 . 14518))))) STOP diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM index 48001bb52..787808832 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 91ffd5e90..69d60bf84 100644 --- a/library/tedit/TEDIT-BUTTONS +++ b/library/tedit/TEDIT-BUTTONS @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Feb-2025 15:02:06" {WMEDLEY}tedit>TEDIT-BUTTONS.;218 125051 +(FILECREATED "24-Mar-2025 09:26:13" {WMEDLEY}tedit>TEDIT-BUTTONS.;223 124611 :EDIT-BY rmk - :CHANGES-TO (FNS MB.FIELD.CREATE MB.SPEC.REMAINDER MB.NWAY.SIZEFN MB.NWAY.CREATE) - (VARS TEDIT-BUTTONSCOMS) + :CHANGES-TO (FNS MB.FIELD.INSURETYPE MB.BUTTONEVENTINFN) - :PREVIOUS-DATE "16-Feb-2025 11:10:40" {WMEDLEY}tedit>TEDIT-BUTTONS.;214) + :PREVIOUS-DATE "14-Mar-2025 15:29:51" {WMEDLEY}TEDIT>TEDIT-BUTTONS.;219) (PRETTYCOMPRINT TEDIT-BUTTONSCOMS) @@ -20,7 +19,7 @@ (COMS (* ;  "Generic functions for the various types of buttons.") (RECORDS MBARG) - (FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDITMENU.STREAM TEDIT.BACKTOMAIN)) + (FNS MB.ADD MB.DELETE MB.GET MB.GET.MBARG TEDIT.BACKTOMAIN)) [COMS (* ; "Simple Menu Button support") (FNS MB.BUTTONEVENTINFN MB.DISPLAYFN MB.SETIMAGE MB.SIZEFN MB.WHENOPERATEDONFN MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MB.CREATE MB.CHANGENAME MB.INIT @@ -289,17 +288,6 @@ ARGENDPC _ ENDPC ARGIDPC _ IDPC]) -(TEDITMENU.STREAM - [LAMBDA (TSTREAM) (* ; "Edited 29-Sep-2024 15:29 by rmk") - (* ; "Edited 28-Aug-2024 15:48 by rmk") - (* ; "Edited 10-Apr-2023 09:53 by rmk") - (* jds "13-Aug-84 14:10") - - (* ;; "returns the textstream of the teditmenu attached to this stream if any") - - (for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when (TEDITMENUP W "TEdit Menu") - do (RETURN (TEXTSTREAM W]) - (TEDIT.BACKTOMAIN [LAMBDA (MENUSTREAM) (* ; "Edited 20-Oct-2024 10:02 by rmk") (* ; "Edited 25-Aug-2024 09:17 by rmk") @@ -320,6 +308,7 @@ (MB.BUTTONEVENTINFN [LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON) + (* ; "Edited 22-Mar-2025 14:00 by rmk") (* ; "Edited 12-Jan-2025 13:03 by rmk") (* ; "Edited 28-Dec-2024 20:21 by rmk") (* ; "Edited 22-Aug-2024 16:26 by rmk") @@ -330,7 +319,6 @@ (* ;; "Called when a mouse-button is down inside the object, RELX and RELY are in the objects coordinate system. Decline unless it is a normal left-button selection within the object.") - (TEDIT.PROMPTCLEAR MENUSTREAM) (if [OR (EQ BUTTON 'RIGHT) (SHIFTDOWNP 'CTRL) (SHIFTDOWNP 'SHIFT) @@ -1897,7 +1885,8 @@ XKERN _ 0]) (MB.FIELD.INSURETYPE - [LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 4-Dec-2024 20:09 by rmk") + [LAMBDA (FIELDTYPE STR TSTREAM) (* ; "Edited 24-Mar-2025 09:26 by rmk") + (* ; "Edited 4-Dec-2024 20:09 by rmk") (* ; "Edited 8-Nov-2024 08:37 by rmk") (* ; "Edited 29-Sep-2024 21:52 by rmk") (* ; "Edited 31-Aug-2024 12:46 by rmk") @@ -1918,6 +1907,8 @@ ((TEXT STRING) (* ;  "String should be a string, not NIL atom") (SETQ VAL (OR STR '**EMPTY**))) + (TRIMMEDSTRING (CL:UNLESS (STREQUAL "" TRIMMED) + (SETQ VAL TRIMMED))) ((NUMBER PICAS POSITIVENUMBER SIGNEDNUMBER CARDINAL) (SETQ TRIMMED (MKATOM TRIMMED)) (if (OR (EQ 0 (NCHARS TRIMMED)) @@ -1970,26 +1961,25 @@ (MB.FIELD.INIT) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3338 19860 (MB.ADD 3348 . 9777) (MB.DELETE 9779 . 10153) (MB.GET 10155 . 16925) ( -MB.GET.MBARG 16927 . 18596) (TEDITMENU.STREAM 18598 . 19265) (TEDIT.BACKTOMAIN 19267 . 19858)) (19904 -39766 (MB.BUTTONEVENTINFN 19914 . 21408) (MB.DISPLAYFN 21410 . 23469) (MB.SETIMAGE 23471 . 24639) ( -MB.SIZEFN 24641 . 26189) (MB.WHENOPERATEDONFN 26191 . 28140) (MB.COPYFN 28142 . 28600) (MB.GETFN 28602 - . 29563) (MB.PUTFN 29565 . 30665) (MB.SHOWSELFN 30667 . 32176) (MB.CREATE 32178 . 36201) ( -MB.CHANGENAME 36203 . 36685) (MB.INIT 36687 . 38148) (MB.TRACK.UNTIL 38150 . 38845) (MB.DON'T 38847 . -39143) (MB.SPEC.REMAINDER 39145 . 39764)) (39928 49918 (MB.3STATE.CREATE 39938 . 40802) ( -MB.3STATE.DISPLAYFN 40804 . 41790) (MB.3STATE.SHOWSELFN 41792 . 44103) (MB.3STATE.INIT 44105 . 45516) -(MB.3STATE.SETSTATEFN 45518 . 46176) (MB.3STATE.BUTTONEVENTINFN 46178 . 49916)) (50073 80741 ( -MB.NWAY.CREATE 50083 . 56125) (MB.NWAY.DISPLAYFN 56127 . 56990) (MB.NWAY.WHENOPERATEDONFN 56992 . -59182) (MB.NWAY.SIZEFN 59184 . 63120) (MB.NWAY.SELECT 63122 . 66692) (MB.NWAY.BUTTONEVENTINFN 66694 . -69906) (MB.NWAY.NEWMENUBUTTON 69908 . 70620) (MB.NWAY.COPYFN 70622 . 71589) (MB.NWAY.INIT 71591 . -73082) (MB.NWAY.ARRANGEBUTTONS 73084 . 75055) (MB.NWAY.ADDITEM 75057 . 78919) (MB.NWAY.FINDSUBOBJ -78921 . 79435) (MB.NWAY.SETSTATEFN 79437 . 80739)) (80820 92707 (MB.TOGGLE.CREATE 80830 . 81825) ( -MB.TOGGLE.DISPLAYFN 81827 . 83310) (MB.TOGGLE.INIT 83312 . 85111) (MB.SET.TOGGLE 85113 . 86314) ( -MB.TOGGLE.SETSTATEFN 86316 . 87156) (MB.TOGGLE.BUTTONEVENTINFN 87158 . 91362) ( -MB.TOGGLE.WHENOPERATEDONFN 91364 . 92705)) (92788 124972 (MB.FIELD.CREATE 92798 . 98249) ( -MB.FIELD.DISPLAYFN 98251 . 99042) (MB.FIELD.IMAGEBOXFN 99044 . 100526) (MB.FIELD.PREFIXCREATE 100528 - . 104464) (MB.FIELD.SUFFIXCREATE 104466 . 106126) (MB.FIELD.INIT 106128 . 107895) ( -MB.FIELD.WHENOPERATEDONFN 107897 . 109168) (MB.FIELD.GETSTATEFN 109170 . 113104) (MB.FIELD.SETSTATEFN -113106 . 117801) (MB.FIELD.BUTTONEVENTINFN 117803 . 120108) (MB.FIELD.SIZEFN 120110 . 120350) ( -MB.FIELD.INSURETYPE 120352 . 124970))))) + (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))))) STOP diff --git a/library/tedit/TEDIT-BUTTONS.LCOM b/library/tedit/TEDIT-BUTTONS.LCOM index edd1a6e0f..5bc86b10f 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 32b529212..1027f5340 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 "24-Jun-2024 00:05:09" {WMEDLEY}tedit>TEDIT-CHAT.;16 12363 +(FILECREATED "11-Mar-2025 15:41:08" {WMEDLEY}tedit>TEDIT-CHAT.;17 12449 :EDIT-BY rmk :CHANGES-TO (FNS TEDITCHAT.CHARFN) - :PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}tedit>TEDIT-CHAT.;15) + :PREVIOUS-DATE "24-Jun-2024 00:05:09" {WMEDLEY}tedit>TEDIT-CHAT.;16) (PRETTYCOMPRINT TEDIT-CHATCOMS) @@ -70,7 +70,8 @@ (replace (CHAT.STATE HELD) of STATE with NIL]) (TEDITCHAT.CHARFN - [LAMBDA (CH CHAT.STATE) (* ; "Edited 24-Jun-2024 00:04 by rmk") + [LAMBDA (CH CHAT.STATE) (* ; "Edited 11-Mar-2025 15:40 by rmk") + (* ; "Edited 24-Jun-2024 00:04 by rmk") (* ; "Edited 2-May-2024 18:09 by rmk") (* ; "Edited 22-Dec-2023 23:57 by rmk") (* ; "Edited 18-Mar-2023 20:08 by rmk") @@ -79,7 +80,7 @@ (TEXTOBJ (TEXTOBJ TSTREAM))) (\CARET.DOWN (FGETTOBJ TEXTOBJ DS)) (SELCHARQ CH - (BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL))) + (BS (\TEDIT.CHARDELETE TSTREAM)) (LF NIL) (BOUT TSTREAM CH]) ) @@ -213,6 +214,6 @@ CHATDECLS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN - 3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473))))) + (FILEMAP (NIL (886 4630 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN + 3663 . 4628)) (4677 11561 (TEDIT.DISPLAYTEXT 4687 . 11559))))) STOP diff --git a/library/tedit/TEDIT-CHAT.LCOM b/library/tedit/TEDIT-CHAT.LCOM index 795bc5b74..8d82ab38d 100644 Binary files a/library/tedit/TEDIT-CHAT.LCOM and b/library/tedit/TEDIT-CHAT.LCOM differ diff --git a/library/tedit/TEDIT-COMMAND b/library/tedit/TEDIT-COMMAND index d039fe7a1..b3495f2f1 100644 --- a/library/tedit/TEDIT-COMMAND +++ b/library/tedit/TEDIT-COMMAND @@ -1,165 +1,31 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Feb-2025 12:25:49" {WMEDLEY}tedit>TEDIT-COMMAND.;135 49397 +(FILECREATED "23-Mar-2025 15:27:20" {WMEDLEY}tedit>TEDIT-COMMAND.;163 19331 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.COMMAND.LOOP) + :CHANGES-TO (FNS \TEDIT.COMMAND.FUNCTION? \TEDIT.COMMAND.LOOP) + (VARS TEDIT-COMMANDCOMS) - :PREVIOUS-DATE "28-Nov-2024 10:03:03" {WMEDLEY}tedit>TEDIT-COMMAND.;133) + :PREVIOUS-DATE "16-Mar-2025 14:20:07" {WMEDLEY}tedit>TEDIT-COMMAND.;160) (PRETTYCOMPRINT TEDIT-COMMANDCOMS) (RPAQQ TEDIT-COMMANDCOMS - [[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (CONSTANTS (MSPACE 153) - (NSPACE 152) - (THINSPACE 159) - (FIGSPACE 154)) - (EXPORT (CONSTANTS (NONE.TTC 0) - (CHARDELETE.TTC 1) - (WORDDELETE.TTC 2) - (DELETE.TTC 3) - (FUNCTIONCALL.TTC 4) - (REDO.TTC 5) - (UNDO.TTC 6) - (CMD.TTC 7) - (NEXT.TTC 8) - (EXPAND.TTC 9) - (CHARDELETE.FORWARD.TTC 10) - (WORDDELETE.FORWARD.TTC 11) - (PUNCT.TTC 20) - (TEXT.TTC 21) - (WHITESPACE.TTC 22)) - (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK) - (RECORDS TEDITTERMCODE) - - (* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character (RMK: THESE DON'T SEEM TO BE USED)") - - (CONSTANTS (NOTBEFORE.LB 1) - (* ; - "Must not break before this character (e.g. Japanese right-paren)") - (NOTAFTER.LB 2) - (* ; - "Must not break after this character (e.g. Japanese open-quote)") - (BEFORE.LB 4) - (* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)") - (AFTER.LB 8) - (* ; - "OK to break after this char, if it's OK to break before the next one (true of most white space)") - (DISAPPEAR-IF-NOT-SPLIT.LB 16) - (* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)") - (NEWCHAR-IF-SPLIT.LB 32) - (* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.") - ] - (FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.LOOP - \TEDIT.COMMAND.RESET.SETUP) + ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK))) + (FNS \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.FUNCTION?) + (FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.RESET.SETUP) [INITVARS (TEDIT.INTERRUPTS '((2 BREAK) (5 ERROR) (7 HELP) (20 CONTROL-T] (VARS (|| NIL)) - (GLOBALVARS || TEDIT.INTERRUPTS) - (COMS (* ; "Read-table Utilities") - (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX - TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET - TEDIT.ATOMBOUND.READTABLE) - [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) - (TEDIT.WORDBOUND.READTABLE ( - \TEDIT.WORDBOUND.READTABLE - ] - (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)) - [COMS (* ; "Wheelscroll") - (FILES (SYSLOAD FROM LISPUSERS) - WHEELSCROLL) - (FNS \TEDIT.WHEELSCROLL) - (GLOBALVARS WHEELSCROLLCHARCODES) - (VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL] - (COMS (* ; "Clipboard") - (FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL - ) - [DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY (CONSTANTS (CLIPBOARDCODES - (CHARCODE (meta,C meta,X meta,c - meta,X] - (P (\TEDIT.CLIPBOARD]) + (* ; "Why?") + (GLOBALVARS || TEDIT.INTERRUPTS))) (DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - -(DECLARE%: EVAL@COMPILE - -(RPAQQ MSPACE 153) - -(RPAQQ NSPACE 152) - -(RPAQQ THINSPACE 159) - -(RPAQQ FIGSPACE 154) - - -(CONSTANTS (MSPACE 153) - (NSPACE 152) - (THINSPACE 159) - (FIGSPACE 154)) -) - (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQQ NONE.TTC 0) - -(RPAQQ CHARDELETE.TTC 1) - -(RPAQQ WORDDELETE.TTC 2) - -(RPAQQ DELETE.TTC 3) - -(RPAQQ FUNCTIONCALL.TTC 4) - -(RPAQQ REDO.TTC 5) - -(RPAQQ UNDO.TTC 6) - -(RPAQQ CMD.TTC 7) - -(RPAQQ NEXT.TTC 8) - -(RPAQQ EXPAND.TTC 9) - -(RPAQQ CHARDELETE.FORWARD.TTC 10) - -(RPAQQ WORDDELETE.FORWARD.TTC 11) - -(RPAQQ PUNCT.TTC 20) - -(RPAQQ TEXT.TTC 21) - -(RPAQQ WHITESPACE.TTC 22) - - -(CONSTANTS (NONE.TTC 0) - (CHARDELETE.TTC 1) - (WORDDELETE.TTC 2) - (DELETE.TTC 3) - (FUNCTIONCALL.TTC 4) - (REDO.TTC 5) - (UNDO.TTC 6) - (CMD.TTC 7) - (NEXT.TTC 8) - (EXPAND.TTC 9) - (CHARDELETE.FORWARD.TTC 10) - (WORDDELETE.FORWARD.TTC 11) - (PUNCT.TTC 20) - (TEXT.TTC 21) - (WHITESPACE.TTC 22)) -) -(DECLARE%: EVAL@COMPILE - (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.") @@ -183,79 +49,16 @@ (T (KWOTE I] (T (CONS COMMENTFLG ARGS]) ) -(DECLARE%: EVAL@COMPILE - -(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) - (TTDECODE (LOGAND DATUM 31)))) -) -(DECLARE%: EVAL@COMPILE - -(RPAQQ NOTBEFORE.LB 1) - -(RPAQQ NOTAFTER.LB 2) - -(RPAQQ BEFORE.LB 4) - -(RPAQQ AFTER.LB 8) - -(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16) - -(RPAQQ NEWCHAR-IF-SPLIT.LB 32) - - -(CONSTANTS (NOTBEFORE.LB 1) - (NOTAFTER.LB 2) - (BEFORE.LB 4) - (AFTER.LB 8) - (DISAPPEAR-IF-NOT-SPLIT.LB 16) - (NEWCHAR-IF-SPLIT.LB 32)) -) (* "END EXPORTED DEFINITIONS") ) (DEFINEQ -(\TEDIT.INTERRUPT.SETUP - [LAMBDA (PROC FORCEOFF) (* ; "Edited 27-Mar-2024 15:27 by rmk") - (* ; "Edited 22-Sep-2023 20:45 by rmk") - (* jds "12-Sep-84 15:36") - - (* ;; "Disarm any inconvenient interrupts, and save re-arming info on the window.") - - [LET ((TEXTOBJ (TEXTOBJ PROC T))) - (CL:WHEN TEXTOBJ - (UNINTERRUPTABLY - [COND - ((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) - (* ; - "There are disarmed interrupts; re-arm them.") - (RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) - (PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL)) - ([AND (NOT FORCEOFF) - (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS] - (* ; - "There aren't any interrupts disarmed; go do it.") - (PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS - (OR (AND TEXTOBJ (GETTEXTPROP TEXTOBJ - 'INTERRUPTS)) - TEDIT.INTERRUPTS) - T]))] - PROC]) - -(\TEDIT.MARKACTIVE - [LAMBDA (TEXTOBJ OPERATION) (* ; "Edited 29-Jun-2024 10:32 by rmk") - (* ; "Edited 12-Jun-90 18:04 by mitani") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with OPERATION) - TEXTOBJ]) - -(\TEDIT.MARKINACTIVE - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) - TEXTOBJ]) - (\TEDIT.COMMAND.LOOP - [LAMBDA (TSTREAM) (* ; "Edited 17-Feb-2025 12:05 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 09:56 by rmk") + (* ; "Edited 16-Mar-2025 14:19 by rmk") + (* ; "Edited 17-Feb-2025 12:05 by rmk") (* ; "Edited 28-Nov-2024 10:01 by rmk") (* ; "Edited 21-Nov-2024 11:51 by rmk") (* ; "Edited 13-Sep-2024 22:34 by rmk") @@ -279,6 +82,7 @@ (* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch") + (DECLARE (SPECVARS TEXTSTREAM)) (LET [(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ] (for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS))) @@ -290,97 +94,110 @@ (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ) T)) (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - do - (ERSETQ - (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - do - (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") - (while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ) + do (ERSETQ (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) + do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") + (while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ) (* ;  "Flash caret while other operation completes") - (BLOCK)) - (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - (\TEDIT.FLASHCARET TEXTOBJ) (* ; + (BLOCK)) + (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) + (\TEDIT.FLASHCARET TEXTOBJ) (* ;  "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)") - (FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ; + (FSETTOBJ TEXTOBJ EDITOPACTIVE T) + (* ;  "Before starting to work, note that we're doing something.") - (* ;; "") + (* ;; "") - (* ;; "Handle user type-in") + (* ;; + "Handle user type-in. CHARCODE is special so functions can see it.") - [bind CH TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN)) - (ERSETQ (APPLY* FN TSTREAM))) while (\SYSBUFP) - do (SETQ CH (\GETKEY)) - (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN)) + [bind CHARCODE TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ + LOOPFN)) + (ERSETQ (APPLY* FN TSTREAM))) + while (\SYSBUFP) do (SETQ CHARCODE (\GETKEY)) + (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN)) (* ; - "Give the OEM user control for each character typed.") - (SETQ TCH (APPLY* FN TSTREAM CH)) - - (* ;; - "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.") - - (CL:UNLESS (EQ TCH T) - (SETQ CH TCH))) - (SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL)) - CH)) - (CHARDELETE.TTC - (\TEDIT.CHARDELETE TSTREAM)) - (CHARDELETE.FORWARD.TTC - (\TEDIT.CHARDELETE TSTREAM T)) - (WORDDELETE.TTC - (\TEDIT.WORDDELETE TSTREAM)) - (WORDDELETE.FORWARD.TTC - (\TEDIT.WORDDELETE.FORWARD TSTREAM)) - (DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ))) - (UNDO.TTC (* ; - "Take off the BPD, the undoing and put it back on.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (TEDIT.UNDO TSTREAM)) - (REDO.TTC (* ; - "He hit the REDO key, so go REDO something") - (TEDIT.REDO TSTREAM) - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)) - (FUNCTIONCALL.TTC (* ; - "This is a special character -- it calls a function") - (CL:WHEN [SETQ FN (CAR (fetch MACROFN - of (GETHASH CH (fetch READMACRODEFS - of (FGETTOBJ TEXTOBJ - TXTRTBL] + "The user can control each character typed.") + (SETQ TCH (APPLY* FN TSTREAM CHARCODE)) + + (* ;; + "Ignore input if TCH=NIL, continue if T, otherwise substitute.") + + (CL:UNLESS (EQ TCH T) + (SETQ CHARCODE TCH))) + (CL:WHEN CHARCODE + (OR (\TEDIT.COMMAND.FUNCTION? TSTREAM + CHARCODE) + (\TEDIT.INSERT CHARCODE (TEXTSEL + TEXTOBJ) + TSTREAM NIL T)))]) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))]) + +(\TEDIT.COMMAND.FUNCTION? + [LAMBDA (TSTREAM CHARCODE) (* ; "Edited 23-Mar-2025 15:27 by rmk") + (DECLARE (SPECVARS TSTREAM CHARCODE)) + + (* ;; "If CHARCODE is a function in TSTREAM's read table, execute the function.") + + (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + FN) + (DECLARE (SPECVARS TEXTOBJ)) + (CL:WHEN [AND (EQ (\TEDIT.TTC FUNCTIONCALL) + (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL)) + CHARCODE)) + (SETQ FN (CAR (fetch MACROFN of (GETHASH CHARCODE (fetch READMACRODEFS + of (FGETTOBJ TEXTOBJ + TXTRTBL] + (if (AND (LISTP FN) + (NOT (FNTYP FN))) + then + (* ;; "A form but not a LAMBDA. TSTREAM, TEXTOBJ, and CHARCODE are specvars") + + (EVAL FN) + else (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))) + T)]) +) +(DEFINEQ + +(\TEDIT.INTERRUPT.SETUP + [LAMBDA (PROC FORCEOFF) (* ; "Edited 27-Mar-2024 15:27 by rmk") + (* ; "Edited 22-Sep-2023 20:45 by rmk") + (* jds "12-Sep-84 15:36") + + (* ;; "Disarm any inconvenient interrupts, and save re-arming info on the window.") + + [LET ((TEXTOBJ (TEXTOBJ PROC T))) + (CL:WHEN TEXTOBJ + (UNINTERRUPTABLY + [COND + ((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) (* ; - "There IS a command function to be called.") - (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ)) - (* ; "do it") + "There are disarmed interrupts; re-arm them.") + (RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) + (PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL)) + ([AND (NOT FORCEOFF) + (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS] (* ; - "After a user function (that is not wheelscroll) no more blue-pending-delete") + "There aren't any interrupts disarmed; go do it.") + (PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS + (OR (AND TEXTOBJ (GETTEXTPROP TEXTOBJ + 'INTERRUPTS)) + TEDIT.INTERRUPTS) + T]))] + PROC]) - (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them") +(\TEDIT.MARKACTIVE + [LAMBDA (TEXTOBJ OPERATION) (* ; "Edited 29-Jun-2024 10:32 by rmk") + (* ; "Edited 12-Jun-90 18:04 by mitani") + (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with OPERATION) + TEXTOBJ]) - (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES) - (MEMB CH CLIPBOARDCODES)) - (* ; - "The FNs handled the selection. should preserve the highlighting") - (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (\TEDIT.SHOWSEL NIL T TEXTOBJ)))) - (NEXT.TTC (* ; - "Move to the next blank to fill in, delimited by >>...<<") - (TEDIT.NEXT TSTREAM)) - (EXPAND.TTC (* ; "EXPAND AN ABBREVIATION") - (\TEDIT.ABBREV.EXPAND TSTREAM)) - (SELECTC (AND CH (fetch TERMCLASS of (\SYNCODE (OR (FGETTOBJ TEXTOBJ - TXTTERMSA) - \PRIMTERMSA) - CH))) - (CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM)) - (WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM)) - (LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ)) - (CL:WHEN CH (* ; - "Any other key: insert the character.") - (\TEDIT.INSERT CH (TEXTSEL TEXTOBJ) - TSTREAM NIL T))]) - (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))) - (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))]) +(\TEDIT.MARKINACTIVE + [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") + (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) + TEXTOBJ]) (\TEDIT.COMMAND.RESET.SETUP [LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk") @@ -479,445 +296,17 @@ (20 CONTROL-T))) (RPAQQ || NIL) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS || TEDIT.INTERRUPTS) -) - -(* ; "Read-table Utilities") - -(DEFINEQ - -(\TEDIT.READTABLE - [LAMBDA NIL (* ; "Edited 24-Dec-2023 09:54 by rmk") - (* ; "Edited 20-Apr-2018 07:59 by rmk:") - (* jds "12-Sep-86 13:48") - - (* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.") - - (LET [(RTBL (create READTABLEP - READMACRODEFS _ (HASHARRAY 50] - - (* ;; "CHARDELETE.FORWARD replaces WORDDELETE on ^W") - - (for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL - in (CONSTANT (LIST CHARDELETE.TTC CHARDELETE.TTC CHARDELETE.FORWARD.TTC DELETE.TTC - UNDO.TTC NEXT.TTC CMD.TTC REDO.TTC)) - do (* ; - "Set up the default syntax classes for command characters") - (\SETSYNCODE (fetch READSA of RTBL) - CH CL)) - (for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND) - do (* ; - "Set up the default function-calling characters (^X to expand abbrevs for now)") - (TEDIT.SETFUNCTION CH FN RTBL)) - (TEDIT.SETFUNCTION (CHARCODE ^O) - (FUNCTION GET.OBJ.FROM.USER) - RTBL) (* ; "And for image object capture") - RTBL]) - -(\TEDIT.WORDBOUND.READTABLE - [LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds") - - (* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different") - - (PROG [(RTBL (create READTABLEP - READMACRODEFS _ (HARRAY 50] - (for CH from 0 to 255 do (\SETSYNCODE (fetch READSA of RTBL) - CH PUNCT.TTC)) - - (* ;; "By default, every character except those noted below is a punctuation character") - - (for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (* ; "Upper case alpha") - (for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (* ; "Lower case alpha") - (for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (* ; "And digits are text characters") - - (* ;; "European chars and accents are text characters:") - - (for CH from (CHARCODE "361,41") to (CHARCODE "361,376") - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (for CH from (CHARCODE "0,301") to (CHARCODE "0,317") - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (for CH from (CHARCODE "0,341") to (CHARCODE "0,376") - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (for CH in (CHARCODE (CR SPACE TAB ^L)) do (\SETSYNCODE (fetch READSA of RTBL) - CH WHITESPACE.TTC)) - (* ; "And these are white space") - (for CH in (LIST MSPACE NSPACE THINSPACE FIGSPACE) - do (\SETSYNCODE (fetch READSA of RTBL) - CH TEXT.TTC)) - (RETURN RTBL]) - -(TEDIT.GETSYNTAX - [LAMBDA (CH TABLE) (* ; "Edited 24-Dec-2023 09:47 by rmk") - (* ; "Edited 31-Mar-87 10:01 by jds") - (* ; - "Find TEdit's interpretation of a given character") - (SELECTC (\SYNCODE [fetch READSA of (COND - ((type? TEXTOBJ TABLE) - (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of TABLE) - TEDIT.READTABLE)) - ((type? STREAM TABLE) - (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM - TEXTOBJ) - of TABLE)) - TEDIT.READTABLE)) - (T (OR TABLE TEDIT.READTABLE] - (COND - ((LITATOM CH) (* ; - "Symbols are converted to numeric charcodes") - (APPLY* 'CHARCODE CH)) - ((STRINGP CH) (* ; "As are string char-names") - (APPLY* 'CHARCODE CH)) - (T CH))) - (WORDDELETE.TTC - 'WORDDELETE) - (WORDDELETE.FORWARD.TTC - 'WORDDELETE.FORWARD) - (CHARDELETE.TTC - 'CHARDELETE) - (CHARDELETE.FORWARD.TTC - 'CHARDELETE.FORWARD) - (DELETE.TTC 'DELETE) - (UNDO.TTC 'UNDO) - (REDO.TTC 'REDO) - (FUNCTIONCALL.TTC - 'FN) - (CMD.TTC 'CMD) - (NEXT.TTC 'NEXT) - (EXPAND.TTC 'EXPAND) - NIL]) - -(TEDIT.SETSYNTAX - [LAMBDA (CHAR CLASS TABLE) (* ; "Edited 24-Dec-2023 09:17 by rmk") - (* ; "Edited 31-Mar-87 10:00 by jds") - (* ; - "SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE") - (PROG1 (TEDIT.GETSYNTAX (SETQ CHAR (COND - ((LITATOM CHAR) - (APPLY* 'CHARCODE CHAR)) - ((STRINGP CHAR) - (APPLY* 'CHARCODE CHAR)) - (T CHAR))) - TABLE) - (\SETSYNCODE [fetch READSA of (COND - ((type? TEXTOBJ TABLE) - (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of TABLE) - TEDIT.READTABLE)) - ((type? STREAM TABLE) - (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (OR (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) - of TABLE)) - TEDIT.READTABLE)) - (T (OR TABLE TEDIT.READTABLE] - CHAR - (SELECTQ CLASS - (CHARDELETE CHARDELETE.TTC) - (CHARDELETE.FORWARD - CHARDELETE.FORWARD.TTC) - (WORDDELETE WORDDELETE.TTC) - (WORDDELETE.FORWARD - WORDDELETE.FORWARD.TTC) - ((DELETE LINEDELETE) - DELETE.TTC) - (UNDO UNDO.TTC) - (REDO REDO.TTC) - (CMD CMD.TTC) - (FN FUNCTIONCALL.TTC) - (NEXT NEXT.TTC) - (EXPAND EXPAND.TTC) - NONE.TTC)))]) - -(TEDIT.GETFUNCTION - [LAMBDA (CHARCODE TABLE) (* jds "19-Sep-85 17:06") - (* Gets the FN that is called when CH - is hit inside TEDIT.) - [SETQ TABLE (COND - ((type? TEXTOBJ TABLE) - - (* If given a TEXTOBJ in place of a read table, coerce it to the read table for - that edit session) - - (fetch (TEXTOBJ TXTRTBL) of TABLE)) - ((type? STREAM TABLE) - - (* If given a TEXTOBJ in place of a read table, coerce it to the read table for - that edit session) - - (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of TABLE))) - (T (OR TABLE TEDIT.READTABLE] - (SETQ CHARCODE (COND - ((LITATOM CHARCODE) - (APPLY* 'CHARCODE CHARCODE)) - (T CHARCODE))) - (AND TABLE (type? READTABLEP TABLE) - (IEQP FUNCTIONCALL.TTC (\SYNCODE (fetch READSA of TABLE) - CHARCODE)) - (fetch READMACRODEFS of TABLE) - (CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of TABLE]) - -(TEDIT.SETFUNCTION - [LAMBDA (CHARCODE FN RTBL) (* ; "Edited 31-Mar-87 10:58 by jds") - (* ; - "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.") - (* ; - "If FN is NIL, make the character be normal again.") - [SETQ RTBL (COND - ((type? TEXTOBJ RTBL) (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (fetch (TEXTOBJ TXTRTBL) of RTBL)) - ((type? STREAM RTBL) (* ; - "If given a TEXTOBJ in place of a read table, coerce it to the read table for that edit session") - (fetch (TEXTOBJ TXTRTBL) of (fetch (TEXTSTREAM TEXTOBJ) of RTBL))) - (T (OR RTBL TEDIT.READTABLE] - (\SETSYNCODE (fetch READSA of RTBL) - (SETQ CHARCODE (COND - ((LITATOM CHARCODE) - (APPLY* 'CHARCODE CHARCODE)) - ((STRINGP CHARCODE) - (APPLY* 'CHARCODE CHARCODE)) - (T CHARCODE))) - (COND - (FN (* ; - "He gave us a function to call. Set up the syntax so it IS called.") - FUNCTIONCALL.TTC) - (T (* ; - "He gave us a function of NIL, meaning 'turn it off' . Cause this character to become normal.") - NONE.TTC))) (* ; - "Mark the character as invoking a function") - (OR (fetch READMACRODEFS of RTBL) - (replace READMACRODEFS of RTBL with (HARRAY 50))) (* ; - "Make sure there's a hash table to store the function in.") - (PUTHASH CHARCODE (CREATE READMACRODEF - MACROTYPE _ 'TEDIT - MACROFN _ (LIST FN)) - (fetch READMACRODEFS of RTBL]) - -(TEDIT.WORDGET - [LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24") - (\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) - (COND - ((SMALLP CH)) - (T (CHCON1 CH]) - -(TEDIT.WORDSET - [LAMBDA (CHARCODE CLASS TABLE) (* jds " 1-JUN-83 12:23") - (* SETS TEDIT-STYLE SYNTAX BITS IN A - TERMTABLE) - (\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) - (COND - ((SMALLP CHARCODE)) - (T (CHCON1 CHARCODE))) - (COND - ((FIXP CLASS)) - (T (SELECTQ CLASS - (PUNCTUATION PUNCT.TTC) - (WHITESPACE WHITESPACE.TTC) - (TEXT TEXT.TTC) - TEXT.TTC]) - -(TEDIT.ATOMBOUND.READTABLE - [LAMBDA (READTABLE) (* ; "Edited 25-Dec-2023 13:10 by rmk") - (* ; "Edited 5-Dec-2023 23:47 by rmk") - - (* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable. This is specified as the BOUNDTABLE for Lisp source code edits. Not perfect, but not bad.") - - (* ;; "Could cache this for common readtables (interlisp, commonlisp)") - - (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 - 'PUNCTUATION TABLE)) - (TEDIT.WORDSET (CHARCODE %:) - 'TEXT TABLE) - TABLE]) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE)) - -(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE)) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) -) - - - -(* ; "Wheelscroll") +(* ; "Why?") -(FILESLOAD (SYSLOAD FROM LISPUSERS) - WHEELSCROLL) -(DEFINEQ - -(\TEDIT.WHEELSCROLL - [LAMBDA NIL (* ; "Edited 2-Oct-2023 23:23 by rmk") - - (* ;; "TEDIT disables interrupts, so it has to deal with wheelscroll behaviors when the caret is in the Tedit window. Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).") - - (* ;; "This localizes the behavior inside Tedit, where we also suppress Tedit from thinking that somehow these characters change the selection highlighting.") - - (for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I) - `[LAMBDA NIL - (AND WHEELSCROLLENABLED ,(CADR I] - TEDIT.READTABLE) - (CAR I]) -) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS WHEELSCROLLCHARCODES) -) - -(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL)) - - - -(* ; "Clipboard") - -(DEFINEQ - -(\TEDIT.CLIPBOARD - [LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk") - (* ; "Edited 2-Oct-2023 23:23 by rmk") - - (* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.") - - (* ;; "Clipboard paste") - - (TEDIT.SETFUNCTION (CHARCODE "Meta,v") - (FUNCTION PASTEFROMCLIPBOARD) - TEDIT.READTABLE) - (TEDIT.SETFUNCTION (CHARCODE "Meta,V") - (FUNCTION PASTEFROMCLIPBOARD) - TEDIT.READTABLE) - - (* ;; "Clipboard copy") - - (TEDIT.SETFUNCTION (CHARCODE "Meta,c") - (FUNCTION \TEDIT.COPYTOCLIPBOARD) - TEDIT.READTABLE) - (TEDIT.SETFUNCTION (CHARCODE "Meta,C") - (FUNCTION \TEDIT.COPYTOCLIPBOARD) - TEDIT.READTABLE) - - (* ;; "Clipboard extract") - - (TEDIT.SETFUNCTION (CHARCODE "Meta,X") - (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD) - TEDIT.READTABLE) - (TEDIT.SETFUNCTION (CHARCODE "Meta,x") - (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD) - TEDIT.READTABLE) - - (* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).") - - (for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I) - `[LAMBDA NIL - (AND WHEELSCROLLENABLED ,(CADR I] - TEDIT.READTABLE) - (CAR I]) - -(\TEDIT.COPYTOCLIPBOARD - [LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk") - (* ; "Edited 2-Apr-2024 17:01 by rmk") - (* ; "Edited 18-Apr-2018 00:02 by rmk:") - - (* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .") - - (CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD)) - (SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS)) - T)) - (CL:WHEN TSTREAM - (PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL)) - (CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))]) - -(\TEDIT.EXTRACTTOCLIPBOARD - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk") - (\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T]) - -(\TEDIT.WRITE.SEL - [LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk") - - (* ;; "Writes the selected characters in TSTREAM to STREAM. ") - - (* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects. Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.") - - (* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream. Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).") - - (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) - (SEL (FGETTOBJ TEXTOBJ SEL))) - (CL:WHEN (IGREATERP (GETSEL SEL DCH) - 0) - - (* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.") - - (for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE)) - (NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM)) - while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I)) - do (if (CHARCODEP CODE) - then (PRINTCCODE CODE STREAM) - elseif (IMAGEOBJP CODE) - then (add NOBJECTS 1) - (if OBJECTBYTE - then (PRINTCCODE OBJECTBYTE STREAM) - else (PRIN3 "{" STREAM) - (PRIN4 (IMAGEOBJPROP CODE 'GETFN) - STREAM) - (CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN) - (FUNCTION NILL)) - PRE CODE)) - (PRIN3 " : " STREAM) - (PRIN4 PRE STREAM)) - (PRIN3 "}" STREAM)) - else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE)) - finally (CL:WHEN (IGREATERP NOBJECTS 0) - (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS - " image object" - (CL:IF (EQ NOBJECTS 1) - "" - "s")) - T))))]) -) -(DECLARE%: EVAL@LOAD EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQ CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X))) - - -[CONSTANTS (CLIPBOARDCODES (CHARCODE (meta,C meta,X meta,c meta,X] -) +(GLOBALVARS || TEDIT.INTERRUPTS) ) - -(\TEDIT.CLIPBOARD) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8312 26689 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) ( -\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 20097) (\TEDIT.COMMAND.RESET.SETUP -20099 . 26687)) (26973 42170 (\TEDIT.READTABLE 26983 . 28640) (\TEDIT.WORDBOUND.READTABLE 28642 . -31235) (TEDIT.GETSYNTAX 31237 . 33676) (TEDIT.SETSYNTAX 33678 . 36156) (TEDIT.GETFUNCTION 36158 . -37518) (TEDIT.SETFUNCTION 37520 . 39959) (TEDIT.WORDGET 39961 . 40222) (TEDIT.WORDSET 40224 . 40921) ( -TEDIT.ATOMBOUND.READTABLE 40923 . 42168)) (42498 43407 (\TEDIT.WHEELSCROLL 42508 . 43405)) (43560 -49140 (\TEDIT.CLIPBOARD 43570 . 45325) (\TEDIT.COPYTOCLIPBOARD 45327 . 46107) ( -\TEDIT.EXTRACTTOCLIPBOARD 46109 . 46304) (\TEDIT.WRITE.SEL 46306 . 49138))))) + (FILEMAP (NIL (2688 10242 (\TEDIT.COMMAND.LOOP 2698 . 9039) (\TEDIT.COMMAND.FUNCTION? 9041 . 10240)) ( +10243 19041 (\TEDIT.INTERRUPT.SETUP 10253 . 11900) (\TEDIT.MARKACTIVE 11902 . 12231) ( +\TEDIT.MARKINACTIVE 12233 . 12449) (\TEDIT.COMMAND.RESET.SETUP 12451 . 19039))))) STOP diff --git a/library/tedit/TEDIT-COMMAND.LCOM b/library/tedit/TEDIT-COMMAND.LCOM index 435beb7f4..e1f35fabb 100644 Binary files a/library/tedit/TEDIT-COMMAND.LCOM and b/library/tedit/TEDIT-COMMAND.LCOM differ diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE index cebe32bb1..be3483912 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 "22-Feb-2025 16:00:43" {WMEDLEY}TEDIT>TEDIT-FILE.;604 161000 +(FILECREATED "14-Mar-2025 15:29:22" {WMEDLEY}tedit>TEDIT-FILE.;605 161312 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.PUT) + :CHANGES-TO (FNS TEDIT.PUT TEDIT.GET) - :PREVIOUS-DATE "19-Feb-2025 12:11:42" {WMEDLEY}TEDIT>TEDIT-FILE.;603) + :PREVIOUS-DATE "22-Feb-2025 16:00:43" {MEDLEY}tedit>TEDIT-FILE.;27) (PRETTYCOMPRINT TEDIT-FILECOMS) @@ -117,7 +117,8 @@ (DEFINEQ (TEDIT.GET - [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 26-Aug-2024 16:15 by rmk") + [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "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") (* ; "Edited 18-May-2024 16:31 by rmk") @@ -151,7 +152,7 @@ [SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: " (OR (GETTEXTPROP TEXTOBJ 'LASTGETFILENAME) - (\TEXTSTREAM.FILENAME TEXTOBJ] + (\TEDIT.LIKELY.FILENAME TEXTOBJ] (CL:UNLESS FILE (TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T) (RETURN)) @@ -390,7 +391,8 @@ (TEDIT.INCLUDE TSTREAM INFILE START END SAFE T]) (TEDIT.PUT - [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "Edited 22-Feb-2025 15:56 by rmk") + [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT QUIET) (* ; "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") (* ; "Edited 29-Jun-2024 10:31 by rmk") @@ -452,10 +454,11 @@ (SETQ FORCENEW 'DETEMPLATE))) [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: " (CL:UNLESS FORCENEW - (\TEXTSTREAM.FILENAME + ( + \TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED? ]) - (T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?))) + (T (SETQ FILE (\TEDIT.LIKELY.FILENAME TEXTOBJ UNFORMATTED?))) NIL) (CL:UNLESS FILE (* ; "No file to put to.") (TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T) @@ -2519,28 +2522,28 @@ (RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4999 34243 (TEDIT.GET 5009 . 11018) (TEDIT.FORMATTEDFILEP 11020 . 12336) ( -TEDIT.FILEDATE 12338 . 13509) (TEDIT.INCLUDE 13511 . 21540) (TEDIT.RAW.INCLUDE 21542 . 22350) ( -TEDIT.PUT 22352 . 30408) (TEDIT.PUT.STREAM 30410 . 34241)) (34244 54014 (\TEDIT.GET.FOREIGN.FILE 34254 - . 37679) (\TEDIT.GET.UNFORMATTED.FILE 37681 . 41673) (\TEDIT.GET.FORMATTED.FILE 41675 . 44593) ( -\TEDIT.FORMATTEDSTREAMP 44595 . 47613) (\ARBIN 47615 . 48335) (\ATMIN 48337 . 48874) (\DWIN 48876 . -49255) (\STRINGIN 49257 . 49965) (\TEDIT.GET.TRAILER 49967 . 52483) (\TEDIT.CACHEFILE 52485 . 54012)) -(54180 67934 (\TEDIT.GET.PIECES3 54190 . 64696) (\TEDIT.GET.IDATE3 64698 . 66093) ( -\TEDIT.MAKE.STRINGPIECE 66095 . 67932)) (67935 80310 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 67945 . 74061) -(\TEDIT.INTERPRET.XCCS.SHIFTS 74063 . 80308)) (80332 86354 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80342 . -86352)) (86377 95002 (\TEDIT.GET.CHARLOOKS.LIST 86387 . 87118) (\TEDIT.GET.SINGLE.CHARLOOKS 87120 . -91814) (\TEDIT.GET.CHARLOOKS 91816 . 93146) (\TEDIT.GET.PARALOOKS.INDEX 93148 . 93692) ( -\TEDIT.GET.CHARLOOKS.INDEX 93694 . 95000)) (95003 102660 (\TEDIT.GET.PARALOOKS.LIST 95013 . 95635) ( -\TEDIT.GET.SINGLE.PARALOOKS 95637 . 102658)) (102661 106251 (\TEDIT.GET.OBJECT 102671 . 106249)) ( -106313 138190 (\TEDIT.PUT.PCTB 106323 . 115973) (\TEDIT.PUT.PCTB.PIECEDATA 115975 . 119173) ( -\TEDIT.PUT.TRAILER 119175 . 119942) (\TEDIT.PUT.PCTB.MERGEABLE 119944 . 123378) ( -\TEDIT.PUT.UTF8.SPLITPIECES 123380 . 128082) (\TEDIT.PUT.PCTB.NEXTNEW 128084 . 132351) ( -\TEDIT.INSERT.NEWPIECES 132353 . 135788) (\TEDIT.PUTRESET 135790 . 136032) (\ARBOUT 136034 . 136758) ( -\ATMOUT 136760 . 137365) (\DWOUT 137367 . 137646) (\STRINGOUT 137648 . 138188)) (138191 150266 ( -\TEDIT.PUT.CHARLOOKS.LIST 138201 . 139873) (\TEDIT.PUT.SINGLE.CHARLOOKS 139875 . 145610) ( -\TEDIT.PUT.CHARLOOKS 145612 . 146837) (\TEDIT.PUT.CHARLOOKS1 146839 . 147890) (\TEDIT.PUT.OBJECT -147892 . 150264)) (150267 157906 (\TEDIT.PUT.PARALOOKS.LIST 150277 . 151179) ( -\TEDIT.PUT.SINGLE.PARALOOKS 151181 . 156765) (\TEDIT.PUT.PARALOOKS 156767 . 157904)) (158001 160770 ( -TEDITFROMLISPSOURCE 158011 . 160019) (SHELLSCRIPTP 160021 . 160250) (TEDITFROMSHELLSCRIPT 160252 . -160768))))) + (FILEMAP (NIL (5007 34555 (TEDIT.GET 5017 . 11137) (TEDIT.FORMATTEDFILEP 11139 . 12455) ( +TEDIT.FILEDATE 12457 . 13628) (TEDIT.INCLUDE 13630 . 21659) (TEDIT.RAW.INCLUDE 21661 . 22469) ( +TEDIT.PUT 22471 . 30720) (TEDIT.PUT.STREAM 30722 . 34553)) (34556 54326 (\TEDIT.GET.FOREIGN.FILE 34566 + . 37991) (\TEDIT.GET.UNFORMATTED.FILE 37993 . 41985) (\TEDIT.GET.FORMATTED.FILE 41987 . 44905) ( +\TEDIT.FORMATTEDSTREAMP 44907 . 47925) (\ARBIN 47927 . 48647) (\ATMIN 48649 . 49186) (\DWIN 49188 . +49567) (\STRINGIN 49569 . 50277) (\TEDIT.GET.TRAILER 50279 . 52795) (\TEDIT.CACHEFILE 52797 . 54324)) +(54492 68246 (\TEDIT.GET.PIECES3 54502 . 65008) (\TEDIT.GET.IDATE3 65010 . 66405) ( +\TEDIT.MAKE.STRINGPIECE 66407 . 68244)) (68247 80622 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 68257 . 74373) +(\TEDIT.INTERPRET.XCCS.SHIFTS 74375 . 80620)) (80644 86666 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 80654 . +86664)) (86689 95314 (\TEDIT.GET.CHARLOOKS.LIST 86699 . 87430) (\TEDIT.GET.SINGLE.CHARLOOKS 87432 . +92126) (\TEDIT.GET.CHARLOOKS 92128 . 93458) (\TEDIT.GET.PARALOOKS.INDEX 93460 . 94004) ( +\TEDIT.GET.CHARLOOKS.INDEX 94006 . 95312)) (95315 102972 (\TEDIT.GET.PARALOOKS.LIST 95325 . 95947) ( +\TEDIT.GET.SINGLE.PARALOOKS 95949 . 102970)) (102973 106563 (\TEDIT.GET.OBJECT 102983 . 106561)) ( +106625 138502 (\TEDIT.PUT.PCTB 106635 . 116285) (\TEDIT.PUT.PCTB.PIECEDATA 116287 . 119485) ( +\TEDIT.PUT.TRAILER 119487 . 120254) (\TEDIT.PUT.PCTB.MERGEABLE 120256 . 123690) ( +\TEDIT.PUT.UTF8.SPLITPIECES 123692 . 128394) (\TEDIT.PUT.PCTB.NEXTNEW 128396 . 132663) ( +\TEDIT.INSERT.NEWPIECES 132665 . 136100) (\TEDIT.PUTRESET 136102 . 136344) (\ARBOUT 136346 . 137070) ( +\ATMOUT 137072 . 137677) (\DWOUT 137679 . 137958) (\STRINGOUT 137960 . 138500)) (138503 150578 ( +\TEDIT.PUT.CHARLOOKS.LIST 138513 . 140185) (\TEDIT.PUT.SINGLE.CHARLOOKS 140187 . 145922) ( +\TEDIT.PUT.CHARLOOKS 145924 . 147149) (\TEDIT.PUT.CHARLOOKS1 147151 . 148202) (\TEDIT.PUT.OBJECT +148204 . 150576)) (150579 158218 (\TEDIT.PUT.PARALOOKS.LIST 150589 . 151491) ( +\TEDIT.PUT.SINGLE.PARALOOKS 151493 . 157077) (\TEDIT.PUT.PARALOOKS 157079 . 158216)) (158313 161082 ( +TEDITFROMLISPSOURCE 158323 . 160331) (SHELLSCRIPTP 160333 . 160562) (TEDITFROMSHELLSCRIPT 160564 . +161080))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index 2cb945a66..e8c08adba 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 12414eb60..400bc8988 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 " 6-Mar-2025 20:18:04" {WMEDLEY}TEDIT>TEDIT-FIND.;138 38227 +(FILECREATED "19-Mar-2025 11:25:45" {WMEDLEY}tedit>TEDIT-FIND.;153 43667 :EDIT-BY rmk :CHANGES-TO (FNS TEDIT.SUBSTITUTE) - :PREVIOUS-DATE "17-Feb-2025 12:25:36" {WMEDLEY}TEDIT>TEDIT-FIND.;136) + :PREVIOUS-DATE "15-Mar-2025 00:35:11" {WMEDLEY}tedit>TEDIT-FIND.;151) (PRETTYCOMPRINT TEDIT-FINDCOMS) @@ -14,12 +14,15 @@ (RPAQQ TEDIT-FINDCOMS ( (* ;; "User entries") - (FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT) + (FNS TEDIT.FIND TEDIT.FIND.SETSEL TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE + TEDIT.NEXT) + (FNS TEDIT.FIND.OBJECT TEDIT.FIND.OBJECT.BACKWARD) (* ;; "Implementation") - (FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD - \TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING))) + (FNS \TEDIT.FIND \TEDIT.FIND.BACKWARD \TEDIT.WCFIND \TEDIT.BASICFIND + \TEDIT.WCFIND.BACKWARD \TEDIT.BASICFIND.BACKWARD + \TEDIT.PARSE.SEARCHSTRING))) @@ -28,81 +31,50 @@ (DEFINEQ (TEDIT.FIND - [LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 10-May-2024 21:55 by rmk") - (* ; "Edited 24-Apr-2024 23:47 by rmk") - (* ; "Edited 19-Jun-2023 22:27 by rmk") - (* ; "Edited 6-May-2018 17:34 by rmk:") - (* ; "Edited 30-May-91 20:56 by jds") + [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 14-Mar-2025 23:39 by rmk") + (* ; "Edited 11-Mar-2025 12:33 by rmk") - (* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.") + (* ;; "This is the documented user interface that does the silly thing with the return value--caller must know whether WILCARD? was true or not.") - (* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,") + (LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? AGAIN START END))) + (CL:WHEN RESULT + (CL:IF WILDCARDS? + RESULT + (CAR RESULT)))]) - (* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?") +(TEDIT.FIND.SETSEL + [LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 11-Mar-2025 15:29 by rmk") - (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (CL:WHEN TARGET - - (* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING") + (* ;; "Sets the selection to the result of a successful FIND.") - [if (IMAGEOBJP TARGET) - then (TEDIT.FIND.OBJECT TSTREAM TARGET START END) - elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET] - then (CL:UNLESS END - (SETQ END (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) - TEXTLEN))) - (CL:UNLESS START - (SETQ START (TEDIT.GETPOINT TSTREAM))) - (CL:WHEN (ILEQ START END) - (CL:IF WILDCARDS? - (\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET) - START END) - (CAR (\TEDIT.BASICFIND TSTREAM TARGET START END))))])]) + (LET ((RESULT (\TEDIT.FIND TSTREAM TARGET WILDCARDS? NIL START END))) + (CL:WHEN RESULT + (TEDIT.SETSEL TSTREAM (CAR RESULT) + (CADR RESULT) + 'RIGHT) + (TEDIT.NORMALIZECARET TSTREAM))]) (TEDIT.FIND.BACKWARD - [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 19-May-2024 12:07 by rmk") - (* ; "Edited 10-May-2024 22:00 by rmk") - (* ; "Edited 24-Apr-2024 23:43 by rmk") - (* ; "Edited 12-Jul-2023 08:24 by rmk") - (* ; "Edited 20-Jun-2023 12:12 by rmk") - (* ; "Edited 18-Jun-2023 23:43 by rmk") + [LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 11-Mar-2025 15:06 by rmk") (* ; "Edited 30-May-91 19:17 by jds") - (* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.") - - (* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.") + (* ;; "This is a new function that preserves the silly interface of TEDIT.FIND--caller must know whether WILCARD? was true or not.") - (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (CL:WHEN TARGET - [if (IMAGEOBJP TARGET) - then (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN) - elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET] - then (SETQ START (IMAX 1 (OR START 1))) - (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM))) - (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) - TEXTLEN))) - (CL:WHEN AGAIN - - (* ;; - "Assume that we aren't interested in another match at the current position.") - - (ADD END -1)) - (CL:WHEN (ILEQ START END) - (CL:IF WILDCARDS? - (\TEDIT.WCFIND.BACKWARD TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET T) - START END) - (CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])]) + (LET ((RESULT (\TEDIT.FIND.BACKWARD TARGET WILDCARDS? AGAIN START END))) + (CL:WHEN RESULT + (CL:IF WILDCARDS? + RESULT + (CAR RESULT)))]) (TEDIT.SUBSTITUTE - [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 6-Mar-2025 20:17 by rmk") + [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM? NEWCHARLOOKS)(* ; "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 7-Jul-2024 11:46 by rmk") - (* ; "Edited 29-Jun-2024 10:49 by rmk") (* ; "Edited 18-May-2024 23:03 by rmk") - (* ; "Edited 9-Mar-2024 11:36 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") @@ -119,8 +91,8 @@ (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) (NREPLACEMENTS 0) (YESLIST '("Y" "y" "yes" "YES" "T" "Yes")) - SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN - ACTIONSTRING) + SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# CONFIRMFLG SEL REPLACE-LEN ACTIONSTRING + CHARLOOKS) (* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string. If the search pattern is empty, bail out.") @@ -165,7 +137,6 @@ "ing...") T) (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) (* ; "Turn off any blue pending delete") @@ -183,16 +154,15 @@ then (* ;; "In this case the selection moves along, ending up at the last hit.") - (bind (LASTSEL _ (\TEDIT.COPYSEL SEL)) - while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# - T)) + (bind HIT (LASTSEL _ (\TEDIT.COPYSEL SEL)) + while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL STARTCHAR# + ENDCHAR#)) do (* ;  "Show each substitution site and ask for permission") - (\TEDIT.UPDATE.SEL SEL (CAR RANGE) - NIL + (\TEDIT.UPDATE.SEL SEL (CAR HIT) + (CADR HIT) 'RIGHT - 'PENDINGDEL - (ADD1 (CADR RANGE))) + 'PENDINGDEL) (\TEDIT.FIXSEL SEL TEXTOBJ) (\TEDIT.SHOWSEL SEL T TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ SEL) @@ -201,6 +171,9 @@ 1)) (Q (GO $$OUT)) (Y (* ; "Do this one") + (CL:UNLESS NEWCHARLOOKS + (SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT) + TEXTOBJ)))) (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT 'COPY TEXTOBJ) TEXTOBJ SEL) @@ -209,32 +182,31 @@ (add NREPLACEMENTS 1) (SETQ STARTCHAR# (GETSEL SEL CHLIM)) (* ; "Next start, compensate for end") - [add ENDCHAR# (IDIFFERENCE REPLACE-LEN - (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE]) + (add ENDCHAR# (IDIFFERENCE REPLACE-LEN (CADR HIT)))) (PROGN (* ;;  "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.") (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (SETQ STARTCHAR# (ADD1 (CAR RANGE] + (SETQ STARTCHAR# (ADD1 (CAR HIT] finally (\TEDIT.COPYSEL LASTSEL SEL)) else (* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events") - (bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0) - EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# - ENDCHAR# T)) + (bind FIRSTHIT HIT HITLAST HITDIFF CHARLOOKS (TOTALDIFF _ 0) + EVENTS while (SETQ HIT (\TEDIT.FIND TEXTOBJ SEARCHSTRING T NIL + STARTCHAR# ENDCHAR#)) do (CL:UNLESS FIRSTHIT (* ; "For final line updating.") - (SETQ FIRSTHIT (CAR RANGE))) - [SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE] - (\TEDIT.UPDATE.SEL SEL (CAR RANGE) - HITLEN + (SETQ FIRSTHIT (CAR HIT))) + (CL:UNLESS NEWCHARLOOKS + (SETQ CHARLOOKS (PCHARLOOKS (\TEDIT.CHTOPC (CAR HIT) + TEXTOBJ)))) + (\TEDIT.UPDATE.SEL SEL (CAR HIT) + (CADR HIT) 'RIGHT) (\TEDIT.FIXSEL SEL TEXTOBJ) (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT - 'COPY TEXTOBJ) + 'COPY TEXTOBJ NIL CHARLOOKS) TEXTOBJ SEL) (push EVENTS (\TEDIT.POPEVENT TEXTOBJ)) (* ; @@ -242,26 +214,17 @@ (add NREPLACEMENTS 1) (SETQ STARTCHAR# (GETSEL SEL CHLIM)) (SETQ HITLAST STARTCHAR#) - (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN)) + (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN (CADR HIT))) (add ENDCHAR# HITDIFF) (add TOTALDIFF HITDIFF) finally (CL:UNLESS (EQ NREPLACEMENTS 0) - (* ;; "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. Might be better if UPDATELINES took a lastchangechar.") - - (if (IGREATERP TOTALDIFF 0) - then (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT - (IDIFFERENCE (IPLUS (FGETSEL SEL CHLIM) - TOTALDIFF) - FIRSTHIT)) - elseif (ILESSP TOTALDIFF 0) - then (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION FIRSTHIT - (IDIFFERENCE (IDIFFERENCE (FGETSEL SEL CHLIM) - TOTALDIFF) - FIRSTHIT)) - else (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED FIRSTHIT - (IDIFFERENCE (FGETSEL SEL CHLIM) - FIRSTHIT))) + (* ;; "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 + (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?") @@ -288,7 +251,10 @@ (RETURN NREPLACEMENTS))))]) (TEDIT.NEXT - [LAMBDA (TSTREAM) (* ; "Edited 15-Feb-2025 18:08 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 23:14 by rmk") + (* ; "Edited 11-Mar-2025 15:35 by rmk") + (* ; "Edited 9-Mar-2025 11:31 by rmk") + (* ; "Edited 15-Feb-2025 18:08 by rmk") (* ; "Edited 21-Oct-2024 00:40 by rmk") (* ; "Edited 7-Jul-2024 11:47 by rmk") (* ; "Edited 18-May-2024 16:23 by rmk") @@ -298,59 +264,109 @@ (* ; "Edited 14-Dec-2023 21:20 by rmk") (* ; "Edited 20-Jun-2023 00:05 by rmk") (* ; "Edited 3-May-2023 23:47 by rmk") - (* ; "Edited 18-Apr-2023 23:46 by rmk") + (* ; "Edited 18-Apr-2023 23:46 by rmk ") (* ; "Edited 30-May-91 20:57 by jds") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - TARGET SEL OPTION FIELDSEL) - (SETQ SEL (TEXTSEL TEXTOBJ)) - (SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))(* ; - "find the first >>delimited<< field") - (SETQ FIELDSEL (TEDIT.FIND TEXTOBJ "{*}" NIL NIL T))(* ; - "find the first menu-type insertion field, usually delimited with {}") - [SETQ OPTION (COND - [(AND TARGET FIELDSEL) (* ; "take the first one") - (COND - ((IGREATERP (CAR TARGET) - (GETSEL FIELDSEL CH#)) (* ; "use the {} selection") - 'FIELD) - (T 'TARGET] - (TARGET 'TARGET) - (FIELDSEL 'FIELD) - (T 'NEITHER] - (SELECTQ OPTION - (TARGET (* ; "Found another fill-in") - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) - (* ; - "Original comment: %"never pending a deletion%", but it is!") - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; - "Set up SELECTION to be the found text") - (\TEDIT.UPDATE.SEL SEL (CAR TARGET) - (IDIFFERENCE (ADD1 (CADR TARGET)) - (CAR TARGET)) - 'RIGHT - 'PENDINGDEL) - (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally") - (\TEDIT.SHOWSEL SEL T TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window") - ) - (FIELD (* ; - "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD") - (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T) - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; - "Set SELECTION to be the found text") - (\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#) - (GETSEL FIELDSEL DCH) - 'LEFT - 'PENDINGDEL) (* ; "And get it into the window") - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ)) - (NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T) - (SETQ SEL NIL)) - (\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT")) - (CL:WHEN SEL (* ; - "There really IS a selection made here, so set up the charlooks for it properly.") - (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))]) + + (* ;; "Finds/selects the next >>*<< or {*} or menu field after the current selection") + + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (SEL (TEXTSEL TEXTOBJ)) + CH CHNO DCH) + + (* ;; "One pass, search in parallel") + + (if [for old CHNO HIT from (FGETSEL SEL CHLIM) while (SETQ CH (TEDIT.NTHCHARCODE TEXTOBJ + CHNO)) + do (SELCHARQ CH + (> (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ ">>*<<" T NIL CHNO)) + (SETQ CHNO (CAR HIT)) + (SETQ DCH (CADR HIT)) + (RETURN T))) + ({ (CL:WHEN (SETQ HIT (\TEDIT.FIND TEXTOBJ "{*}" T NIL CHNO)) + (SETQ CHNO (CAR HIT)) (* ; "Shouldn't include the { and }") + (SETQ DCH (IDIFFERENCE (CADR HIT) + 2)) + (CL:UNLESS (EQ 0 DCH) (* ; + "Right of {, if empty. to put it inside") + (add CHNO 1)) + (RETURN T))) + (CL:WHEN (AND (IMAGEOBJP CH) + (IMAGEOBJPROP CH 'FIELDPREFIX)) + (* ; "Menu fields") + (add CHNO 1) + (RETURN (for ENDCHNO FCH from CHNO while (SETQ FCH (TEDIT.NTHCHARCODE + TEXTOBJ ENDCHNO)) + when (AND (IMAGEOBJP FCH) + (IMAGEOBJPROP FCH 'FIELDSUFFIX)) + do (SETQ DCH (IDIFFERENCE ENDCHNO CHNO)) + (CL:WHEN (EQ 0 DCH) + (* ; "RIGHT of prefix, if empty") + (add CHNO -1)) + (RETURN T))))] + 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) + (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]) +) +(DEFINEQ + +(TEDIT.FIND.OBJECT + [LAMBDA (TSTREAM OBJ START END) (* ; "Edited 20-Oct-2024 12:07 by rmk") + (* ; "Edited 10-May-2024 21:58 by rmk") + (* ; "Edited 16-Mar-2024 10:03 by rmk") + (* ; "Edited 6-Nov-2022 11:12 by rmk") + (* ; "Edited 3-May-93 12:52 by jds") + + (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END. We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:WHEN (IMAGEOBJP OBJ) + [LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))) + (CL:UNLESS END + (SETQ END (FGETTOBJ TEXTOBJ TEXTLEN))) + (CL:UNLESS START + (SETQ START (TEDIT.GETPOINT TSTREAM))) + (CL:WHEN (AND (ILEQ START END) + (SETQ START (\TEDIT.CHTOPC START TEXTOBJ))) + (SETQ END (\TEDIT.CHTOPC END TEXTOBJ)) + (for PC inpieces START when (EQ OBJ (PCONTENTS PC)) + do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC END)))])]) + +(TEDIT.FIND.OBJECT.BACKWARD + [LAMBDA (TSTREAM OBJ START END AGAIN) (* ; "Edited 10-May-2024 22:06 by rmk") + (* ; "Edited 16-Mar-2024 10:03 by rmk") + (* ; "Edited 6-Nov-2022 11:12 by rmk") + (* ; "Edited 3-May-93 12:52 by jds") + + (* ;; "Return the character number of OBJ in TSTREAM, if it occurs between START and END and is the occurrence closest to END. START defaults to 1, END defaults to current caret position (or one before, if AGAIN).") + + (* ;; "If we were sure that a given object can appear only once in a document, we could just run the TEDIT.FIND.OBJECT with different defaults for START and END, but...") + + (* ;; "We know that an object occupies its own singleton piece, so we don't need to worry about starting or ending in the middle of a piece. We also don't need to test PTYPE, just look at PCONTENTS.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:WHEN (IMAGEOBJP OBJ) + [LET [(TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (SETQ START (IMAX 1 (OR START 1))) + (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM))) + (FGETTOBJ TEXTOBJ TEXTLEN))) + (CL:WHEN AGAIN + + (* ;; "Assume that we aren't interested in another match at the current position.") + + (ADD END -1)) + (CL:WHEN (ILEQ START END) + (SETQ START (\TEDIT.CHTOPC START TEXTOBJ)) + (SETQ END (\TEDIT.CHTOPC END TEXTOBJ)) + (for PC backpieces END when (EQ OBJ (PCONTENTS PC)) + do (RETURN (\TEDIT.PCTOCH PC TEXTOBJ)) repeatuntil (EQ PC START)))])]) ) @@ -359,6 +375,95 @@ (DEFINEQ +(\TEDIT.FIND + [LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 14-Mar-2025 18:42 by rmk") + (* ; "Edited 11-Mar-2025 15:04 by rmk") + (* ; "Edited 10-May-2024 21:55 by rmk") + (* ; "Edited 24-Apr-2024 23:47 by rmk") + (* ; "Edited 19-Jun-2023 22:27 by rmk") + (* ; "Edited 6-May-2018 17:34 by rmk:") + (* ; "Edited 30-May-91 20:56 by jds") + + (* ;; "This returns the hit's (CH# DCL) or NIL.") + + (* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.") + + (* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,") + + (* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:WHEN TARGET + + (* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING") + + (CL:UNLESS END + (SETQ END (TEXTLEN (GETTSTR TSTREAM TEXTOBJ)))) + (CL:UNLESS START + (SETQ START (TEDIT.GETPOINT TSTREAM))) + (CL:WHEN AGAIN (* ; + "We aren't interested in the same hit") + (add START 1)) + (CL:WHEN (ILEQ START END) + [LET (RESULT) + (if (IMAGEOBJP TARGET) + then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT TSTREAM TARGET START END)) + (LIST RESULT 1)) + elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET] + then (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS? + (\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING + TARGET NIL) + START END) + (\TEDIT.BASICFIND TSTREAM TARGET START END))) + + (* ;; "Switch from CHLAST to DCH") + + [LIST (CAR RESULT) + (ADD1 (IDIFFERENCE (CADR RESULT) + (CAR RESULT])]))]) + +(\TEDIT.FIND.BACKWARD + [LAMBDA (TSTREAM TARGET WILDCARDS? AGAIN START END) (* ; "Edited 11-Mar-2025 15:07 by rmk") + + (* ;; "This returns the hit's (CH# DCL) or NIL.") + + (* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.") + + (* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:WHEN TARGET + [LET (RESULT) + (if (IMAGEOBJP TARGET) + then (CL:WHEN (SETQ RESULT (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END + AGAIN)) + (LIST RESULT 1)) + elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET] + then (SETQ START (IMAX 1 (OR START 1))) + (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM))) + (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + TEXTLEN))) + (CL:WHEN AGAIN + + (* ;; + "Assume that we aren't interested in another match at the current position.") + + (ADD END -1)) + (CL:WHEN (ILEQ START END) + (CL:WHEN (SETQ RESULT (CL:IF WILDCARDS? + (\TEDIT.WCFIND.BACKWARD TSTREAM ( + \TEDIT.PARSE.SEARCHSTRING + TARGET T) + START END) + (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START + END))) + + (* ;; "Switch from CHLAST to DCH") + + [LIST (CAR RESULT) + (ADD1 (IDIFFERENCE (CADR RESULT) + (CAR RESULT]))])]) + (\TEDIT.WCFIND [LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk") (* ; "Edited 23-Jun-2024 12:00 by rmk") @@ -582,8 +687,10 @@ (DREVERSE $$VAL))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (784 23475 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE -5119 . 18822) (TEDIT.NEXT 18824 . 23473)) (23508 38204 (\TEDIT.WCFIND 23518 . 27037) (\TEDIT.BASICFIND - 27039 . 29398) (\TEDIT.WCFIND.BACKWARD 29400 . 32864) (\TEDIT.BASICFIND.BACKWARD 32866 . 35123) ( -\TEDIT.PARSE.SEARCHSTRING 35125 . 38202))))) + (FILEMAP (NIL (967 20027 (TEDIT.FIND 977 . 1561) (TEDIT.FIND.SETSEL 1563 . 2028) (TEDIT.FIND.BACKWARD +2030 . 2609) (TEDIT.SUBSTITUTE 2611 . 15430) (TEDIT.NEXT 15432 . 20025)) (20028 23457 ( +TEDIT.FIND.OBJECT 20038 . 21538) (TEDIT.FIND.OBJECT.BACKWARD 21540 . 23455)) (23490 43644 (\TEDIT.FIND + 23500 . 26436) (\TEDIT.FIND.BACKWARD 26438 . 28956) (\TEDIT.WCFIND 28958 . 32477) (\TEDIT.BASICFIND +32479 . 34838) (\TEDIT.WCFIND.BACKWARD 34840 . 38304) (\TEDIT.BASICFIND.BACKWARD 38306 . 40563) ( +\TEDIT.PARSE.SEARCHSTRING 40565 . 43642))))) STOP diff --git a/library/tedit/TEDIT-FIND.LCOM b/library/tedit/TEDIT-FIND.LCOM index 9bf6dd806..3242cd767 100644 Binary files a/library/tedit/TEDIT-FIND.LCOM and b/library/tedit/TEDIT-FIND.LCOM differ diff --git a/library/tedit/TEDIT-FNKEYS b/library/tedit/TEDIT-FNKEYS index 86eb5d068..68a43c598 100644 --- a/library/tedit/TEDIT-FNKEYS +++ b/library/tedit/TEDIT-FNKEYS @@ -1,171 +1,421 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Feb-2025 09:12:22" {WMEDLEY}tedit>TEDIT-FNKEYS.;121 48129 +(FILECREATED "25-Mar-2025 17:14:10" {WMEDLEY}tedit>TEDIT-FNKEYS.;247 99606 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.ONECHAR.FORWARD \TEDIT.ONECHAR.BACKWARD) + :CHANGES-TO (FNS CHARNAME) - :PREVIOUS-DATE "16-Feb-2025 20:44:51" {WMEDLEY}tedit>TEDIT-FNKEYS.;120) + :PREVIOUS-DATE "23-Mar-2025 14:58:14" {WMEDLEY}TEDIT>TEDIT-FNKEYS.;234) (PRETTYCOMPRINT TEDIT-FNKEYSCOMS) (RPAQQ TEDIT-FNKEYSCOMS - [(COMS - (* ;; "Functions that actually implement the commands for the function keys:") - - (FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV - \TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL - \TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING - \TEDIT.KEY.FIND.BACKWARD \TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN - \TEDIT.ITALIC.SEL.OFF \TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL - \TEDIT.SHOWCARETLOOKS \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL - \TEDIT.UCASE.SEL \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON - \TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL - \TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED)) - (FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD \TEDIT.ONELINE.UP \TEDIT.ONELINE.DOWN - \TEDIT.ONELINE.MOVE) + ((FNS CHARNAME) + (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)) (COMS - (* ;; "Auxiliary functions used in the above main functions:") + (* ;; "Functions that implement the key actions:") + + (FNS \TEDIT.KEY.CHARLOOKS \TEDIT.KEY.QUAD \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL + \TEDIT.KEY.SIZE \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL \TEDIT.KEY.TRANSFORM + \TEDIT.KEY.OPENLINE \TEDIT.KEY.FAMILYN) + (FNS CAP-CASECODE) + (* ; "For intiial caps") + (FNS \TEDIT.SHOWCARETLOOKS \TEDIT.DESCRIBEFONT)) + (* ; "Moving around") + (FNS \TEDIT.ONECHAR.BACKWARD \TEDIT.ONECHAR.FORWARD \TEDIT.ONELINE.UP \TEDIT.ONELINE.DOWN + \TEDIT.ONELINE.MOVE \TEDIT.ONEWORD.BACKWARD \TEDIT.ONEWORD.FORWARD \TEDIT.LINE.BEGIN + \TEDIT.LINE.END \TEDIT.DOCUMENT.BEGIN \TEDIT.DOCUMENT.END) + (FNS \TEDIT.LINEDELETE.FORWARD \TEDIT.LINEDELETE.BACKWARD) + (FNS \TEDIT.KEY.NEST) + (INITVARS (TEDIT.NESTWIDTH 36)) + (* ; "Find") + (FNS \TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING) + (* ; "Miscellaneous") + (FNS \TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED \TEDIT.SELECT.ALL) + (* ; "Clipboard") + (FNS \TEDIT.CLIPBOARD \TEDIT.COPYTOCLIPBOARD \TEDIT.EXTRACTTOCLIPBOARD \TEDIT.WRITE.SEL) + (VARS (TEDIT.FNKEY.VERBOSE T)) + (COMS (* ; "Read-table Utilities") + (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) + (ALISTS (CHARACTERNAMES EMQUAD ENQUAD THINSPACE FIGURESPACE)) + (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) + (* ; "Installation") + [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) + (TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE] + + (* ;; "On-screen formatting buttons (TEDIT.BUTTONS.BUILD) creates the default button menu") + + (VARS TEDIT.BUTTONS.SPEC) + (FNS TEDIT.BUTTONS.BUILD TEDIT.BUTTONBITMAP.FILL) + (INITVARS (TEDIT.BUTTONS.WINDOW NIL)) + (VARS TEDIT.BUTTONBITMAP))) +(DEFINEQ + +(CHARNAME + [LAMBDA (CODE OCTALCHARS) (* ; "Edited 25-Mar-2025 17:13 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") + (* ; "Edited 20-Sep-2021 15:03 by rmk:") + + (* ;; "If CODE correspond to a named character, that character is returned.") + + (* ;; "Otherwise, if OCTALCHARS the result is of the form %"cset,octal-char%" where cset is a known name (Meta) or the octal string for an unknown character set. Ascii codes show up with %"0,xx%"") + + (* ;; "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.") + + (DECLARE (USEDFREE CHARACTERSETNAMES CHARACTERNAMES)) + + (* ;; "") + + (if (LISTP CODE) + then (CONS (CHARNAME (CAR CODE) + OCTALCHARS) + (AND (CDR CODE) + (CHARNAME (CDR CODE) + OCTALCHARS))) + elseif (CL:CHARACTERP CODE) + then (CHARNAME (CL:CHAR-CODE CODE) + OCTALCHARS) + elseif (NOT (CHARCODEP CODE)) + then (\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] + else (LET ((CHARSET (LRSH CODE 8)) + (CHAR (LOGAND CODE 255)) + (ASCIICODE (LOGAND CODE 127)) + CSETNAME CHARNAME ASCIINAME) + (SETQ CSETNAME (if [CAR (find CN in CHARACTERSETNAMES + suchthat (STRING.EQUAL CHARSET (CADR CN] + else (OCTALSTRING CHARSET))) + [SETQ CHARNAME (if OCTALCHARS + then (OCTALSTRING CHAR) + else (CAR (for CC in CHARACTERNAMES when (EQ CHAR (CADR CC)) + smallest (NCHARS (CAR CC] + (CL:WHEN (STREQUAL CHARNAME "Tenexeol") (* ; + "Put (%"^_%" Tenexeol) in CHARACTERNAMES ?") + (SETQ CHARNAME "^_")) + + (* ;; "Didn't find the special character name, let's find a corresponding Asciiname to prefix with ^ and/or #") + + (CL:UNLESS CHARNAME + [SETQ ASCIINAME (if [CAR (for CC in CHARACTERNAMES + when (EQ ASCIICODE (CADR CC)) + smallest (NCHARS (CAR CC] + elseif (ILESSP ASCIICODE (CHARCODE SPACE)) + then [CONCAT "^" (CHARACTER (IPLUS ASCIICODE (CHARCODE @] + else + (* ;; "Not named and not a control") + + (CONCAT (CHARACTER ASCIICODE] + (SETQ CHARNAME (CL:IF (IGEQ CHAR 128) + (CONCAT "#" ASCIINAME) + ASCIINAME))) + (CL:IF (AND (ZEROP CHARSET) + (NOT OCTALCHARS)) + CHARNAME + (CONCAT CSETNAME "," CHARNAME))]) +) - (FNS \TEDIT.BOLD.CARET.OFF \TEDIT.BOLD.CARET.ON \TEDIT.ITALIC.CARET.OFF - \TEDIT.ITALIC.CARET.ON \TEDIT.LARGER.CARET \TEDIT.SMALLER.CARET - \TEDIT.SUBSCRIPT.CARET \TEDIT.SUPERSCRIPT.CARET \TEDIT.UNDERLINE.CARET.OFF - \TEDIT.UNDERLINE.CARET.ON \TEDIT.STRIKEOUT.CARET.OFF \TEDIT.STRIKEOUT.CARET.ON)) - (COMS (* ; - "little selection utilities etc., for building hacks") - (FNS \TK.DESCRIBEFONT)) - [VARS (TEDIT.FNKEY.VERBOSE T) - (\TEDIT.KEYS '(("Function,^D" UNDO) - ("Function,$" UNDO) - ("Function,^C" FN \TEDIT.KEY.FIND) - ("Function,#" FN \TEDIT.KEY.FIND) - ("Function,Bs" REDO) - ("Function,(" REDO) - ("Function,^R" NEXT) - ("Function,62" NEXT) - ("Esc" EXPAND) - ("Function,^T" EXPAND) - ("Function,A" FN \TEDIT.CENTER.SEL) - ("Function,a" FN \TEDIT.CENTER.SEL.REV) - ("Function,B" FN \TEDIT.BOLD.SEL.ON) - ("Function,b" FN \TEDIT.BOLD.SEL.OFF) - ("Function,C" FN \TEDIT.ITALIC.SEL.ON) - ("Function,c" FN \TEDIT.ITALIC.SEL.OFF) - ("Function,D" FN \TEDIT.UCASE.SEL) - ("Function,d" FN \TEDIT.LCASE.SEL) - ("Function,E" FN \TEDIT.STRIKEOUT.SEL.ON) - ("Function,e" FN \TEDIT.STRIKEOUT.SEL.OFF) - ("Function,F" FN \TEDIT.UNDERLINE.SEL.ON) - ("Function,f" FN \TEDIT.UNDERLINE.SEL.OFF) - ("Function,G" FN \TEDIT.SUBSCRIPTSEL) - ("Function,g" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,H" FN \TEDIT.SMALLERSEL) - ("Function,h" FN \TEDIT.LARGERSEL) - ("Function,K" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,k" FN \TEDIT.SUBSCRIPTSEL) - ("Function,L" FN \TEDIT.SUBSCRIPTSEL) - ("Function,l" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,M" FN \TEDIT.DEFAULTSSEL) - ("Function,m" FN \TEDIT.SETDEFAULT.FROM.SEL) - ("Function,^A" FN \TEDIT.SHOWCARETLOOKS) - ("Meta,a" FN \TEDIT.SELECT.ALL) - ("Meta,A" FN \TEDIT.SELECT.ALL) - ("Meta,d" FN \TEDIT.MANPAGE) - ("Meta,D" FN \TEDIT.MANPAGE) - ("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD) - ("Meta,f" FN \TEDIT.KEY.FIND) - ("Meta,g" FN \TEDIT.FINDAGAIN) - ("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD) - ("Meta,N" NEXT) - ("Meta,n" NEXT) - ("Meta,o" FN \TEDIT.CALL.ED) - ("Meta,O" FN \TEDIT.CALL.ED) - ("Meta,p" FN \TEDIT.PRINT.MENU) - ("Meta,P" FN \TEDIT.PRINT.MENU) - ("Meta,r" REDO) - ("Meta,R" REDO) - ("Meta,s" FN \TEDIT.KEY.SUBSTITUTE) - ("Meta,S" FN \TEDIT.KEY.SUBSTITUTE) - ("Meta,U" FN \TEDIT.UNDO.UNDO) - ("Meta,u" UNDO) - ("Meta,z" UNDO) - ("Meta,Z" \TEDIT.UNDO.UNDO) - ("Meta,<" FN \TEDIT.ONECHAR.BACKWARD) - ("Meta,," FN \TEDIT.ONECHAR.BACKWARD) - ("Meta,>" FN \TEDIT.ONECHAR.FORWARD) - ("Meta,." FN \TEDIT.ONECHAR.FORWARD) - ("Meta,^" FN \TEDIT.ONELINE.UP) - ("Meta,LF" FN \TEDIT.ONELINE.DOWN] - (P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) - (SELECTQ (CADR ENTRY) - (FN (TEDIT.SETFUNCTION (CAR ENTRY) - (CADDR ENTRY))) - (TEDIT.SETSYNTAX (CAR ENTRY) - (CADR ENTRY]) - - - -(* ;; "Functions that actually implement the commands for the function keys:") + + +(* ; "Public functions (binding data below)") (DEFINEQ -(\TEDIT.BOLD.SEL.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 6-Nov-87 11:00 by jds") +(TEDIT.INSTALL.CHARBINDINGS + [LAMBDA (CHARBINDINGS RDTBL CHARACTIONS) (* ; "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") + (* ; "Edited 11-Mar-2025 22:03 by rmk") + + (* ;; "Installs CHARBINDINGS in the Tedit RDTBL. A binding is an action-name followed by a list of character-name strings or Tedit built-in action items (like NEXT, UNDO). The implementation of the action is taken from entries in CHARACTIONS or the TEDIT.CHARACTIONS list.") + + (* ;; "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 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) + (* ; "Set the method") + (CL:WHEN NIL + (ASSOC (CAR ACTION) + \TEDIT.TTCCODES) + (* ; + "A tag like NEXT, UNDO. Setup the termtable FWIW ") + (TEDIT.SETSYNTAX CHAR (CAR ACTION) + RDTBL))] + RDTBL]) + +(TEDIT.CLEAR.CHARBINDINGS + [LAMBDA (RDTBL BINDINGS) (* ; "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:WHEN (fetch READMACRODEFS of RDTBL) + [if (EQ BINDINGS T) + then [MAPHASH (fetch READMACRODEFS of RDTBL) + (FUNCTION (LAMBDA (VAL CHARCODE) + (CL:WHEN (EQ (\TEDIT.TTC FUNCTIONCALL) + (\SYNCODE (fetch READSA of RDTBL) + CHARCODE)) + (TEDIT.SETFUNCTION CHARCODE NIL RDTBL) + (CL:WHEN (ASSOC CHARCODE \TEDIT.TTCCODES) + (* ; + "A tag like NEXT, UNDO. Setup the termtable FWIW ") + (TEDIT.SETSYNTAX CHARCODE CHARCODE RDTBL)))] + BINDINGS + else (for CB in BINDINGS when (LISTP CB) unless (EQ '* (CAR CB)) + do (for CHARCODE in (CDR CB) do (CL:UNLESS (CHARCODEP CHARCODE) + (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))) + (TEDIT.SETFUNCTION CHARCODE NIL RDTBL) + (CL:WHEN (ASSOC (CAR CB) + \TEDIT.TTCCODES) + (* ; + "A tag like NEXT, UNDO. Setup the termtable FWIW ") + (TEDIT.SETSYNTAX CHARCODE (CAR CB) + RDTBL))])]) + +(TEDIT.GET.CHARACTION + [LAMBDA (CHARCODE BINDINGS) (* ; "Edited 19-Mar-2025 14:51 by rmk") + (* ; "Edited 18-Mar-2025 11:07 by rmk") + (* ; "Edited 17-Mar-2025 09:43 by rmk") + + (* ;; "Returns the keyaction that CHARCODE binds to in BINDINGS. If BINDINGS is a readtable, looks at all currently installed bindings in that readtable. If NIL, uses TEDIT.READTABLE.") + + (CL:UNLESS (CHARCODEP CHARCODE) + (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))) + (if (LISTP BINDINGS) + then [for CB in BINDINGS when (LISTP CB) unless (EQ '* (CAR CB)) + when [thereis C in (CDR CB) suchthat (EQ CHARCODE (CL:IF (CHARCODEP C) + C + (CHARCODE.DECODE C))] + collect (CAR CB) finally + + (* ;; "Maybe cause an error if a character is assigned twice?") + + (RETURN (CL:IF (CDR $$VAL) + $$VAL + (CAR $$VAL))] + else (LET [(RDTBL (if (NULL BINDINGS) + then TEDIT.READTABLE + elseif (TEXTSTREAM BINDINGS T) + then (OR (GETTOBJ (TEXTOBJ BINDINGS) + TXTRTBL) + TEDIT.READTABLE) + elseif (type? READTABLEP BINDINGS) + else (\ILLEGAL.ARG BINDINGS] + [MAPHASH (fetch READMACRODEFS of RDTBL) + (FUNCTION (LAMBDA (VAL CCODE) + (CL:WHEN (AND (EQ CCODE CHARCODE) + (EQ (\TEDIT.TTC FUNCTIONCALL) + (\SYNCODE (fetch READSA of RDTBL) + CHARCODE))) + (for CA in TEDIT.CHARACTIONS when (EQUAL (CADR CA) + (CADR VAL)) + do (RETFROM (FUNCTION TEDIT.GET.CHARACTION) + (CAR CA))))] + NIL]) + +(TEDIT.GET.CHARBINDING + [LAMBDA (ACTION BINDINGS RETURNCODES) (* ; "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.") + + (if (LISTP BINDINGS) + then (for CB in BINDINGS when (EQ ACTION (CAR CB)) join + (* ;; + "Allow for duplicate bindings for the same action?") + + (APPEND (CDR CB))) + else (LET ((RDTBL (if (NULL BINDINGS) + then TEDIT.READTABLE + elseif (TEXTSTREAM BINDINGS T) + then (OR (GETTOBJ (TEXTOBJ BINDINGS) + TXTRTBL) + TEDIT.READTABLE) + elseif (type? READTABLEP BINDINGS) + else (\ILLEGAL.ARG BINDINGS))) + [IMPL (CADR (find CA in TEDIT.CHARACTIONS suchthat (EQMEMB ACTION (CAR CA] + CHARS) + (CL:WHEN IMPL + [MAPHASH (fetch READMACRODEFS of RDTBL) + (FUNCTION (LAMBDA (VAL CCODE) + (CL:WHEN (EQUAL IMPL (CADR VAL)) + (* ; "charcode, not charname") + (push CHARS (CL:IF RETURNCODES + CCODE + (CHARNAME 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) + [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) + 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]) + +(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))) + (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 ANAME in TEDIT.CHARACTIONS when (LISTP CA) + unless (EQ '* (CAR CA)) when (EQUAL (CADR CA) + (CADR VAL)) + 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 + (CHARNAME S))] + ACTIONS]) +) - (* ;; "Turn boldness off for the selected characters, and for future type-in.") - (\TEDIT.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM) - SEL]) -(\TEDIT.BOLD.SEL.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-Nov-87 11:00 by jds") +(* ;; "Functions that implement the key actions:") - (* ;; "Turn boldness on for selected characters and for future type-in.") +(DEFINEQ - (\TEDIT.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD) - SEL]) +(\TEDIT.KEY.CHARLOOKS + [LAMBDA (TSTREAM PROP NEWVALUE) (* ; "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:") -(\TEDIT.CENTER.SEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL REVERSE) (* ; "Edited 11-Dec-2023 11:02 by rmk") + (* ;; " (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]) + +(\TEDIT.KEY.QUAD + [LAMBDA (TSTREAM REVERSE) (* ; "Edited 16-Mar-2025 00:03 by rmk") + (* ; "Edited 14-Mar-2025 16:37 by rmk") + (* ; "Edited 11-Dec-2023 11:02 by rmk") (* ; "Edited 28-Jul-2023 16:14 by rmk") (* ; "Edited 11-Apr-2023 13:22 by rmk") (* ; "Edited 10-Apr-2023 10:08 by rmk") (* ; "Edited 30-May-91 21:05 by jds") - (* ;; "Changes the QUAD of the selected paragraphs in TEXTSTREAM, when the CENTER key is typed. Rotates through the sequences (LEFT/RIGHT/CENTER) from the QUAD of the first paragraph to find the NEWQUAD that it will apply to all the paragraphs in SEL. If REVERSE, cycles the quads in the opposite direction.") + (* ;; "Changes the QUAD of the selected paragraphs in TSTREAM, when the CENTER key is typed. Rotates through the sequences (LEFT JUSTIFIED CENTERED RIGHT) from the QUAD of the first paragraph to find the NEWQUAD that it will apply to all the paragraphs in SEL. If REVERSE, cycles the quads in the opposite direction.") - (CL:UNLESS (TEDITMENUP TEXTOBJ) - (LET [(NEWQUAD (LIST 'QUAD (OR [CADR (MEMB (LISTGET (TEDIT.GET.PARALOOKS TEXTSTREAM SEL) + (CL:UNLESS (GETTOBJ (GETTSTR TSTREAM TEXTOBJ) + MENUFLG) + (LET [(NEWQUAD (LIST 'QUAD (OR [CADR (MEMB (LISTGET (TEDIT.GET.PARALOOKS TSTREAM) 'QUAD) (CL:IF REVERSE - '(LEFT CENTERED JUSTIFIED LEFT) + '(RIGHT CENTERED JUSTIFIED LEFT) '(LEFT JUSTIFIED CENTERED RIGHT))] 'LEFT] - (TEDIT.PARALOOKS TEXTSTREAM NEWQUAD SEL) - (CL:WHEN TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM NEWQUAD T))))]) - -(\TEDIT.CENTER.SEL.REV - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 11-Dec-2023 11:02 by rmk") - (* ; "Edited 30-May-91 21:05 by jds") - (\TEDIT.CENTER.SEL TEXTSTREAM TEXTOBJ SEL T]) - -(\TEDIT.DEFAULTS.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 26-Feb-2024 08:45 by rmk") - (* ; "Edited 11-Nov-2023 16:00 by rmk") - (* jds "21-Sep-85 11:24") - (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + (TEDIT.PARALOOKS TSTREAM NEWQUAD) + (TEDIT.PROMPTPRINT TSTREAM (SELECTQ (CADR NEWQUAD) + (LEFT "Aligned left") + (RIGHT "Aligned right") + (CENTERED "Centered") + (JUSTIFIED "Justified") + "") + T)))]) (\TEDIT.DEFAULTSSEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 11-Nov-2023 15:55 by rmk") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2025 16:18 by rmk") + (* ; "Edited 11-Nov-2023 15:55 by rmk") (* ; "Edited 20-Oct-87 11:12 by jds") (* ; "acts on the selection") (TEDIT.LOOKS TEXTSTREAM (create CHARLOOKS using (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) - SEL]) + SEL) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.SETDEFAULT.FROM.SEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Nov-2023 16:40 by rmk") @@ -176,211 +426,24 @@ (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (TEDIT.GET.LOOKS TEXTSTREAM SEL) NIL TEXTOBJ]) -(\TEDIT.KEY.FIND - [LAMBDA (TSTREAM TEXTOBJ SEL AGAIN BACKWARD SEARCHSTRING) (* ; "Edited 26-Nov-2024 23:47 by rmk") - (* ; "Edited 23-Nov-2024 16:25 by rmk") - (* ; "Edited 7-Jul-2024 11:47 by rmk") - (* ; "Edited 29-Jun-2024 16:20 by rmk") - (* ; "Edited 22-Jun-2024 10:00 by rmk") - (* ; "Edited 18-May-2024 16:29 by rmk") - (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 24-Apr-2024 23:39 by rmk") - (* ; "Edited 9-Mar-2024 11:36 by rmk") - (* ; "Edited 14-Dec-2023 21:14 by rmk") - (* ; "Edited 12-Jul-2023 08:26 by rmk") - (* ; "Edited 20-Jun-2023 13:06 by rmk") - (* ; "Edited 6-May-2018 17:14 by rmk:") - (* ; "Edited 30-May-91 21:05 by jds") - - (* ;; "Case sensitive search, with * and # wildcards. Just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).") - - (* ;; "AGAIN suppresses confirmation of a previous target.") - - (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (CL:UNLESS TEXTOBJ - (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) - (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find") - '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - CH) - (CL:UNLESS SEARCHSTRING - (SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING TEXTOBJ AGAIN BACKWARD))) - (CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING) - 1)) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (\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) - NIL NIL T) - else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" SEARCHSTRING - "%"") - T) - (TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING) - NIL NIL T))) - (if CH - then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found") - T) (* ; "We found the target text.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) - (* ; - "Set up SELECTION to be the found text") - (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (\TEDIT.UPDATE.SEL SEL (CAR CH) - (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH))) - (CL:IF BACKWARD - 'LEFT - 'RIGHT) - (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) - 'PENDINGDEL - 'NORMAL)) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T TEXTOBJ) - [SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH) - (CAR CH) - 'WORD - 'CHAR] - (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))))]) - -(\TEDIT.KEY.FIND.SEARCHSTRING - [LAMBDA (TEXTOBJ AGAIN BACKWARD) (* ; "Edited 22-Jun-2024 10:17 by rmk") - - (* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.") - - (LET (SEARCHSTRING) - (CL:WHEN AGAIN - (SETQ SEARCHSTRING (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING))) - (CL:UNLESS SEARCHSTRING - (SETQ SEARCHSTRING (\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING)) - (SETQ SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD - "Backward search string: " - "Search string: ") - SEARCHSTRING)) - (CL:WHEN SEARCHSTRING (* ; - "Save for next search, even if not found") - (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING SEARCHSTRING))) - SEARCHSTRING]) - -(\TEDIT.GET.TARGET.STRING - [LAMBDA (TEXTOBJ PROP) (* ; "Edited 14-Jul-2024 00:09 by rmk") - (* ; "Edited 23-Jun-2024 23:06 by rmk") - (* ; "Edited 22-Jun-2024 12:03 by rmk") - (* ; "Edited 29-Feb-2024 17:08 by rmk") - - (* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN. It tries to determine the best tentative target string for a search. PROP is presumably TEDIT.LAST.FIND.STRING.") - - (* ;; "Current heuristic: If a previous string, use it if it contains wild cards, otherwise the current non-point selection. Note that meta-G goes directly to the last search.") - - (* ;; "TEDIT.SUBSTITUTE doesn't call this because the current selection is the search domain") - - (LET [(PREV (STRINGP (GETTEXTPROP TEXTOBJ PROP] - (if [AND PREV (find I from 1 to (NCHARS PREV) - suchthat (AND (MEMB (NTHCHARCODE PREV I) - (CHARCODE (%# ESCAPE *))) - (NEQ (CHARCODE %') - (NTHCHARCODE PREV (SUB1 I] - then PREV - elseif (IGEQ (FGETSEL (FGETTOBJ TEXTOBJ SEL) - DCH) - 1) - then - (* ;; "TEDIT.SEL.AS.STRING breaks on image objects, should be fixed there.") - - (CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTOBJ))) - else PREV]) - -(\TEDIT.KEY.FIND.BACKWARD - [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 20-Jun-2023 13:57 by rmk") - (* ; "Edited 18-Jun-2023 17:59 by rmk") - (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL AGAIN T]) - -(\TEDIT.FINDAGAIN.BACKWARD - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Jun-2023 13:57 by rmk") - (* ; "Edited 18-Jun-2023 18:03 by rmk") - (* ; "Edited 6-May-2018 17:12 by rmk:") - (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL T T]) - -(\TEDIT.FINDAGAIN - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Jun-2023 13:57 by rmk") - (* ; "Edited 6-May-2018 17:12 by rmk:") - (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL T]) - -(\TEDIT.ITALIC.SEL.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 20-Oct-87 10:43 by jds") - (\TEDIT.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR) - SEL]) - -(\TEDIT.ITALIC.SEL.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 10:43 by jds") - (TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC) - SEL]) - -(\TEDIT.LARGERSEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") - (COND - ((SHIFTDOWNP 'META) - (\TEDIT.LARGER.CARET TEXTSTREAM TEXTOBJ SEL)) - (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT 2) - SEL]) - -(\TEDIT.LCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:05 by rmk") - (* ; "Edited 15-Mar-2024 13:57 by rmk") - (* ; "Edited 3-Mar-2024 12:28 by rmk") - (* ; "Edited 28-May-2023 00:34 by rmk") - (* ; "Edited 24-May-2023 22:46 by rmk") - - (* ;; "uppercasifies the selection. This changes the :Replace THACTION to :LowerCase for REDO. That could be stored in another field, in which case undo wouldn't need to know. Or maybe the transformation function should be stored.") - - (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY ( - \TEDIT.SELPIECES - SEL NIL TEXTOBJ - )) - (FUNCTION L-CASECODE) - NIL TEXTOBJ) - TEXTOBJ SEL) - (SETTH (\TEDIT.LASTEVENT TEXTOBJ) - THACTION :LowerCase]) - -(\TEDIT.SHOWCARETLOOKS - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:07 by rmk") - (* ; "Edited 30-May-91 21:09 by jds") - (LET ((LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))) - (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch (CHARLOOKS CLFONT) - of LOOKS)) - (COND - ((AND (fetch (CHARLOOKS CLOFFSET) of LOOKS) - (NEQ (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) - (CONCAT " offset " (fetch (CHARLOOKS CLOFFSET) - of LOOKS))) - (T "")) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - " overlined") - (T "")) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - " underlined") - (T ""))) - T]) - -(\TEDIT.SMALLERSEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") - (COND - ((SHIFTDOWNP 'META) - (\TEDIT.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL)) - (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT -2) - SEL]) +(\TEDIT.KEY.SIZE + [LAMBDA (TSTREAM INCREMENT) (* ; "Edited 21-Mar-2025 23:12 by rmk") + (* ; "Edited 19-Mar-2025 13:07 by rmk") + (* ; "Edited 16-Mar-2025 13:19 by rmk") + (* jds "21-Sep-85 08:58") + + (* ;; "Changes the font size, 2 points smaller if SMALLER, otherwise larger.") + + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (if (\TEDIT.CHANGE.CHARLOOKS TSTREAM (LIST 'SIZEINCREMENT INCREMENT)) + then (\TEDIT.SHOWCARETLOOKS TSTREAM) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT (CL:IF (OR (AND (FIXP INCREMENT) + (ILESSP INCREMENT 0)) + (EQ INCREMENT '-)) + "Smaller" + "Larger") + " font is not available") + T T)))]) (\TEDIT.SUBSCRIPTSEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds") @@ -392,90 +455,134 @@ (TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT 2) SEL]) -(\TEDIT.UCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:04 by rmk") +(\TEDIT.KEY.TRANSFORM + [LAMBDA (TSTREAM CHARFN) (* ; "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") (* ; "Edited 3-Mar-2024 12:56 by rmk") - (* ; "Edited 28-May-2023 00:33 by rmk") - (* ; "Edited 24-May-2023 22:45 by rmk") - - (* ;; "uppercasifies the selection. This changes the :Replace THACTION to :UpperCase for REDO. That could be stored in another field, in which case undo wouldn't need to know.") - - (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY ( - \TEDIT.SELPIECES - SEL NIL TEXTOBJ - )) - (FUNCTION U-CASECODE) - NIL TEXTOBJ) - TEXTOBJ SEL) - (SETTH (\TEDIT.LASTEVENT TEXTOBJ) - THACTION :UpperCase]) - -(\TEDIT.UNDERLINE.SEL.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:26 by jds") - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF) - SEL]) + (* ; "Edited 28-May-2023 00:33 by rmk") + + (* ;; "Applies CHARFN to transform each character in the selection.") + + (* ;; "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)) + (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) + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THACTION :Transform) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THOLDINFO CHARFN)))]) + +(\TEDIT.KEY.OPENLINE + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 9-Mar-2025 14:39 by rmk") + (* gbn "30-Jan-85 18:36") + + (* ;; "This is like typing a return, except that it positions the caret one character back") + + [TEDIT.INSERT TSTREAM (CONSTANT (CONSTANT (CHARACTER (CHARCODE EOL] + (\TEDIT.ONECHAR.BACKWARD TSTREAM TEXTOBJ SEL]) + +(\TEDIT.KEY.FAMILYN + [LAMBDA (TSTREAM CHARCODE) (* ; "Edited 19-Mar-2025 13:08 by rmk") + (* ; "Edited 16-Mar-2025 13:13 by rmk") + + (* ;; "CHARCODE is Meta,nn for nn from One..., changes the family to the nn-th entry on TEDIT.FONTFAMILIES.") + + (CL:WHEN (CHARCODEP CHARCODE) + [LET [(NEWFAMILY (CAR (NTH TEDIT.FONTFAMILIES (IDIFFERENCE CHARCODE (CHARCODE "Meta,Zero"] + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (if (NOT NEWFAMILY) + then (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Font family " (IDIFFERENCE CHARCODE + (CHARCODE + "Meta,Zero" + )) + " is not specified") + T T) + elseif (\TEDIT.CHANGE.CHARLOOKS TSTREAM (LIST 'FAMILY NEWFAMILY)) + then (\TEDIT.SHOWCARETLOOKS TSTREAM) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Cannot switch to font family " NEWFAMILY) + T T)))])]) +) +(DEFINEQ -(\TEDIT.UNDERLINE.SEL.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON) - SEL]) +(CAP-CASECODE + [LAMBDA (CHAR INDEX) (* ; "Edited 16-Mar-2025 13:23 by rmk") -(\TEDIT.STRIKEOUT.SEL.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON) - SEL]) + (* ;; "Uppercases CHAR if INDEX is 1, otherwise lowercases.") -(\TEDIT.STRIKEOUT.SEL.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:27 by jds") - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF) - SEL]) + (CL:IF (EQ INDEX 1) + (U-CASECODE CHAR) + (L-CASECODE CHAR))]) +) -(\TEDIT.SELECT.ALL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 29-Jun-2024 15:05 by rmk") - (* ; "Edited 6-May-2018 12:41 by rmk:") - (TEDIT.SETSEL TEXTSTREAM 1 (GETTOBJ TEXTOBJ TEXTLEN) - 'LEFT]) -(\TEDIT.KEY.SUBSTITUTE - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 8-May-2023 09:35 by rmk") - (* ;; "Stub for function-key") +(* ; "For intiial caps") - (TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T]) +(DEFINEQ -(\TEDIT.MANPAGE - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 21:48 by rmk") - (* ; "Edited 29-Dec-2024 08:40 by rmk") - (* ; "Edited 25-Jun-2024 11:59 by rmk") - (* ; "Edited 26-May-2024 21:53 by rmk") - (* ; "Edited 25-May-2024 14:50 by rmk") +(\TEDIT.SHOWCARETLOOKS + [LAMBDA (TSTREAM) (* ; "Edited 15-Mar-2025 20:40 by rmk") + (* ; "Edited 13-Mar-2025 23:52 by rmk") + (* ; "Edited 5-Mar-2025 14:55 by rmk") + (* ; "Edited 14-Dec-2023 21:07 by rmk") + (* ; "Edited 30-May-91 21:09 by jds") + (LET ((LOOKS (FGETTOBJ (TEXTOBJ TSTREAM) + CARETLOOKS))) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT (\TEDIT.DESCRIBEFONT (GETCLOOKS LOOKS CLFONT)) + (CL:IF (AND (GETCLOOKS LOOKS CLOFFSET) + (NEQ (GETCLOOKS LOOKS CLOFFSET) + 0)) + (CONCAT " offset " (GETCLOOKS LOOKS CLOFFSET)) + "") + (CL:IF (GETCLOOKS LOOKS CLSTRIKE) + " strikeout" + "") + (CL:IF (GETCLOOKS LOOKS CLOLINE) + " overlined" + "") + (CL:IF (GETCLOOKS LOOKS CLULINE) + " underlined" + "")) + T]) - (* ;; "If meta-D is typed in an existing DINFO window, the new stuff comes up but then the window closes. That could be debugged, but probably not worth it. The DINFO window has its own links to things that it thought were worth indexing.") +(\TEDIT.DESCRIBEFONT + [LAMBDA (FONT) (* ; "Edited 15-Mar-2025 16:19 by rmk") + (* ; "Edited 5-Mar-2025 14:53 by rmk") + (* gbn "15-Dec-84 17:54") - (CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) - 'DINFOGRAPH) - (TEDIT.PROMPTCLEAR TSTREAM) - [LET ((KEY (TEDIT.SEL.AS.STRING TSTREAM SEL))) - (if (OR (NULL KEY) - (EQ 0 (NCHARS KEY))) - then (TEDIT.PROMPTPRINT TSTREAM "Please select a man-page key" T T) - else (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL])]) +(* ;;; "returns a string which describes a font (in short. If it's not italic then no mention is made of slope, etc.)") -(\TEDIT.CALL.ED - [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 23:38 by rmk") - (* ; "Edited 29-Dec-2024 08:46 by rmk") - (* ; "Edited 25-May-2024 15:03 by rmk") - (TEDIT.PROMPTCLEAR TSTREAM) - (LET [(SYMBOL (MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL] - (if (OR (NULL SYMBOL) - (EQ 0 (NCHARS SYMBOL))) - then (TEDIT.PROMPTPRINT TSTREAM "Please select a symbol to edit" T T) - elseif (TYPESOF SYMBOL) - then (ED SYMBOL `(:DONTWAIT :DISPLAY)) - else (TEDIT.PROMPTPRINT TSTREAM (CONCAT SYMBOL " has no definitions to edit") - T T]) + (CONCAT (L-CASE (FONTPROP FONT 'FAMILY) + T) + " " + (FONTPROP FONT 'SIZE) + (CL:IF (EQ (FONTPROP FONT 'WEIGHT) + 'MEDIUM) + "" + [CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT] + "") + (CL:IF (EQ (FONTPROP FONT 'SLOPE) + 'REGULAR) + "" + [CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE])]) ) + + + +(* ; "Moving around") + (DEFINEQ (\TEDIT.ONECHAR.BACKWARD @@ -623,252 +730,1170 @@ (\TEDIT.FIXSEL SEL TEXTOBJ) (\TEDIT.SHOWSEL SEL T TEXTOBJ) (\TEDIT.SCROLL.CARET TSTREAM))]) + +(\TEDIT.ONEWORD.BACKWARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:47 by rmk") + (* ; "Edited 5-Mar-2025 17:37 by rmk") + (* gbn "20-Mar-85 00:49") + +(* ;;; "moves the caret one word back Refers to the syntax classes of the characters according to the TEDIT.WORDBOUND.READTABLE") + + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (LET ((HERE (SUB1 (TEDIT.GETPOINT TSTREAM))) + LAST FIRST) + (SETQ FIRST (\TEDIT.WORD.FIRST TSTREAM HERE)) (* ; + "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)) + '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") + (* ; "Edited 5-Mar-2025 17:33 by rmk") + (* gbn "20-Mar-85 00:48") + +(* ;;; "moves the caret one word forward. Refers to the syntax classes of the characters according to the TEDIT.WORDBOUND.READTABLE") + + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (LET ((HERE (TEDIT.GETPOINT TSTREAM)) + LAST FIRST) + (SETQ LAST (\TEDIT.WORD.LAST TSTREAM HERE)) (* ; + "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)) + '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") + (* ; "Edited 15-Mar-2025 22:55 by rmk") + (* ; "Edited 9-Mar-2025 19:50 by rmk") + (* ; "Edited 5-Mar-2025 00:05 by rmk") + (* gbn "11-Mar-85 15:04") + + (* ;; "Positions the cursor at the beginning of line. If L1 is NIL it is not visibnle in SELPANE. Should we normalize to top?") + + (LET ((L1 (\TEDIT.SEL.L1 SEL (GETTOBJ TEXTOBJ SELPANE) + TEXTOBJ))) + (CL:WHEN L1 + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL (FGETLD L1 LCHAR1) + 0 + 'LEFT) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + +(\TEDIT.LINE.END + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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") + (* gbn " 7-Jun-85 15:47") + + (* ;; "Positions the cursor at the end of its current line. If LN is NIL it is not visible in SELPANE. Not sure about normalizing, maybe to bottom?") + + (LET ((LN (\TEDIT.SEL.LN SEL NIL TEXTOBJ))) + (CL:WHEN LN + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + + (* ;; "Put the caret in front of the terminating EOL so it stays on LN.") + + (\TEDIT.UPDATE.SEL SEL (FGETLD LN LCHARLAST) + 0 + (CL:IF (FGETLD LN FORCED-END) + 'LEFT + 'RIGHT)) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + +(\TEDIT.DOCUMENT.BEGIN + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2025 23:08 by rmk") + (* gbn "13-Dec-84 11:24") + + (* ;; "Positions at the beginning of a document") + + (TEDIT.SETSEL TSTREAM 1 0 'LEFT) + (TEDIT.NORMALIZECARET TEXTOBJ]) + +(\TEDIT.DOCUMENT.END + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Mar-2025 13:19 by rmk") + (* ; "Edited 15-Mar-2025 23:09 by rmk") + (* gbn " 7-Jun-85 16:32") + + (* ;; "Positions at the end of a document") + + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (TEDIT.SETSEL TSTREAM (ADD1 (TEXTLEN TEXTOBJ)) + 0 + 'LEFT) + (TEDIT.NORMALIZECARET TSTREAM]) ) +(DEFINEQ +(\TEDIT.LINEDELETE.FORWARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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") + (* ;; "Deletes from the caret to the end of this line (including an ending EOL?)") -(* ;; "Auxiliary functions used in the above main functions:") + (LET ((LINE (\TEDIT.SEL.LN SEL NIL TEXTOBJ)) + HERE) + (CL:WHEN LINE + (SETQ HERE (TEDIT.GETPOINT TSTREAM)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHARLIM) + HERE)) + (TEDIT.DELETE TEXTOBJ SEL))]) + +(\TEDIT.LINEDELETE.BACKWARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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") + + (* ;; + "Deletes from the beginning of the caret's line to the caret. Line must be visible in the selpane.") + (LET ((LINE (\TEDIT.SEL.L1 SEL NIL TEXTOBJ)) + HERE) + (CL:WHEN LINE + (SETQ HERE (TEDIT.GETPOINT TSTREAM)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL HERE (IDIFFERENCE (FGETLD LINE LCHAR1) + HERE)) + (TEDIT.DELETE TEXTOBJ SEL))]) +) (DEFINEQ -(\TEDIT.BOLD.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:08 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT MEDIUM) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.BOLD.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:09 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT BOLD) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.ITALIC.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:09 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE REGULAR) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.ITALIC.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE ITALIC) - (GETTOBJ TEXTOBJ CARETLOOKS TEXTOBJ) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.LARGER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT 2) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.SMALLER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT -2) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.SUBSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:16 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT -2) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.SUPERSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:16 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT 2) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.UNDERLINE.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:17 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE OFF) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.UNDERLINE.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:17 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE ON) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.STRIKEOUT.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:18 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT OFF) - (GETTOBJ TEXTOBJ CARETLOOKS) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) - -(\TEDIT.STRIKEOUT.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 10-Aug-2024 16:31 by rmk") - (* ; "Edited 12-Jun-90 18:32 by mitani") - (LET ((LOOKS (\TEDIT.CHANGE.CHARLOOKS.NEW '(STRIKEOUT ON) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (CL:WHEN LOOKS - (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) +(\TEDIT.KEY.NEST + [LAMBDA (TSTREAM OUTFLAG) (* ; "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.") + + (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ))) + (for CHNO LOOKS (DELTA _ (OR (GETTEXTPROP TSTREAM 'NESTWIDTH) + TEDIT.NESTWIDTH)) + (TARGETSEL _ (\TEDIT.COPYSEL SEL)) in (\TEDIT.PARACHNOS SEL NIL TEXTOBJ) + first (CL:WHEN OUTFLAG + (SETQ DELTA (IMINUS DELTA))) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (FSETSEL SEL SET NIL) do (SETQ LOOKS (TEDIT.GET.PARALOOKS TSTREAM CHNO)) + (LISTPUT LOOKS 'LEFTMARGIN (IPLUS (LISTGET LOOKS + 'LEFTMARGIN) + DELTA)) + (LISTPUT LOOKS '1STLEFTMARGIN (IPLUS (LISTGET + LOOKS + '1STLEFTMARGIN) + DELTA)) + (LISTPUT LOOKS 'RIGHTMARGIN + (IMAX 0 (IDIFFERENCE (LISTGET LOOKS 'RIGHTMARGIN) + DELTA))) + (\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.PROMPTCLEAR TSTREAM]) ) +(RPAQ? TEDIT.NESTWIDTH 36) -(* ; "little selection utilities etc., for building hacks") + +(* ; "Find") (DEFINEQ -(\TK.DESCRIBEFONT - [LAMBDA (FONT) (* gbn "15-Dec-84 17:54") +(\TEDIT.KEY.FIND + [LAMBDA (TSTREAM AGAIN BACKWARD SEARCHSTRING) (* ; "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") + (* ; "Edited 23-Nov-2024 16:25 by rmk") + (* ; "Edited 7-Jul-2024 11:47 by rmk") + (* ; "Edited 29-Jun-2024 16:20 by rmk") + (* ; "Edited 22-Jun-2024 10:00 by rmk") + (* ; "Edited 18-May-2024 16:29 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") + (* ; "Edited 24-Apr-2024 23:39 by rmk") + (* ; "Edited 9-Mar-2024 11:36 by rmk") + (* ; "Edited 14-Dec-2023 21:14 by rmk") + (* ; "Edited 12-Jul-2023 08:26 by rmk") + (* ; "Edited 20-Jun-2023 13:06 by rmk") + (* ; "Edited 6-May-2018 17:14 by rmk:") + (* ; "Edited 30-May-91 21:05 by jds") - (* * returns a string which describes a font - (in short. If it's not italic then no mention is made of slope, etc.)) + (* ;; "Case sensitive search, with * and # wildcards. Just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).") - (CONCAT (L-CASE (FONTPROP FONT 'FAMILY)) - " " - (FONTPROP FONT 'SIZE) - (COND - [(NEQ (FONTPROP FONT 'WEIGHT) - 'MEDIUM) - (CONCAT " " (L-CASE (FONTPROP FONT 'WEIGHT] - (T "")) - (COND - [(NEQ (FONTPROP FONT 'SLOPE) - 'REGULAR) - (CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE] - (T ""]) + (* ;; "AGAIN suppresses confirmation of a previous target.") + + (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) + (* ; + "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))))]) + +(\TEDIT.KEY.FIND.SEARCHSTRING + [LAMBDA (TEXTOBJ AGAIN BACKWARD) (* ; "Edited 22-Jun-2024 10:17 by rmk") + + (* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.") + + (LET (SEARCHSTRING) + (CL:WHEN AGAIN + (SETQ SEARCHSTRING (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING))) + (CL:UNLESS SEARCHSTRING + (SETQ SEARCHSTRING (\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING)) + (SETQ SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD + "Backward search string: " + "Search string: ") + SEARCHSTRING)) + (CL:WHEN SEARCHSTRING (* ; + "Save for next search, even if not found") + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING SEARCHSTRING))) + SEARCHSTRING]) + +(\TEDIT.GET.TARGET.STRING + [LAMBDA (TEXTOBJ PROP) (* ; "Edited 14-Jul-2024 00:09 by rmk") + (* ; "Edited 23-Jun-2024 23:06 by rmk") + (* ; "Edited 22-Jun-2024 12:03 by rmk") + (* ; "Edited 29-Feb-2024 17:08 by rmk") + + (* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN. It tries to determine the best tentative target string for a search. PROP is presumably TEDIT.LAST.FIND.STRING.") + + (* ;; "Current heuristic: If a previous string, use it if it contains wild cards, otherwise the current non-point selection. Note that meta-G goes directly to the last search.") + + (* ;; "TEDIT.SUBSTITUTE doesn't call this because the current selection is the search domain") + + (LET [(PREV (STRINGP (GETTEXTPROP TEXTOBJ PROP] + (if [AND PREV (find I from 1 to (NCHARS PREV) + suchthat (AND (MEMB (NTHCHARCODE PREV I) + (CHARCODE (%# ESCAPE *))) + (NEQ (CHARCODE %') + (NTHCHARCODE PREV (SUB1 I] + then PREV + elseif (IGEQ (FGETSEL (FGETTOBJ TEXTOBJ SEL) + DCH) + 1) + then + (* ;; "TEDIT.SEL.AS.STRING breaks on image objects, should be fixed there.") + + (CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTOBJ))) + else PREV]) +) + + + +(* ; "Miscellaneous") + +(DEFINEQ + +(\TEDIT.KEY.SUBSTITUTE + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 8-May-2023 09:35 by rmk") + + (* ;; "Stub for function-key") + + (TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T]) + +(\TEDIT.MANPAGE + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 21:48 by rmk") + (* ; "Edited 29-Dec-2024 08:40 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 26-May-2024 21:53 by rmk") + (* ; "Edited 25-May-2024 14:50 by rmk") + + (* ;; "If meta-D is typed in an existing DINFO window, the new stuff comes up but then the window closes. That could be debugged, but probably not worth it. The DINFO window has its own links to things that it thought were worth indexing.") + + (CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) + 'DINFOGRAPH) + (TEDIT.PROMPTCLEAR TSTREAM) + [LET ((KEY (TEDIT.SEL.AS.STRING TSTREAM SEL))) + (if (OR (NULL KEY) + (EQ 0 (NCHARS KEY))) + then (TEDIT.PROMPTPRINT TSTREAM "Please select a man-page key" T T) + else (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL])]) + +(\TEDIT.CALL.ED + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 18-Jan-2025 23:38 by rmk") + (* ; "Edited 29-Dec-2024 08:46 by rmk") + (* ; "Edited 25-May-2024 15:03 by rmk") + (TEDIT.PROMPTCLEAR TSTREAM) + (LET [(SYMBOL (MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL] + (if (OR (NULL SYMBOL) + (EQ 0 (NCHARS SYMBOL))) + then (TEDIT.PROMPTPRINT TSTREAM "Please select a symbol to edit" T T) + elseif (TYPESOF SYMBOL) + then (ED SYMBOL `(:DONTWAIT :DISPLAY)) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT SYMBOL " has no definitions to edit") + T T]) + +(\TEDIT.SELECT.ALL + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 29-Jun-2024 15:05 by rmk") + (* ; "Edited 6-May-2018 12:41 by rmk:") + (TEDIT.SETSEL TEXTSTREAM 1 (GETTOBJ TEXTOBJ TEXTLEN) + 'LEFT]) +) + + + +(* ; "Clipboard") + +(DEFINEQ + +(\TEDIT.CLIPBOARD + [LAMBDA NIL (* ; "Edited 21-Apr-2024 09:57 by rmk") + (* ; "Edited 2-Oct-2023 23:23 by rmk") + + (* ;; "TEDIT disables interrupts, so it has to deal with special interrupt behaviors when the caret is in the Tedit window. This localizes the behavior of WHEELSCROLL and CLIPBOARD inside Tedit.") + + (* ;; "Clipboard paste") + + (TEDIT.SETFUNCTION (CHARCODE "Meta,v") + (FUNCTION PASTEFROMCLIPBOARD) + TEDIT.READTABLE) + (TEDIT.SETFUNCTION (CHARCODE "Meta,V") + (FUNCTION PASTEFROMCLIPBOARD) + TEDIT.READTABLE) + + (* ;; "Clipboard copy") + + (TEDIT.SETFUNCTION (CHARCODE "Meta,c") + (FUNCTION \TEDIT.COPYTOCLIPBOARD) + TEDIT.READTABLE) + (TEDIT.SETFUNCTION (CHARCODE "Meta,C") + (FUNCTION \TEDIT.COPYTOCLIPBOARD) + TEDIT.READTABLE) + + (* ;; "Clipboard extract") + + (TEDIT.SETFUNCTION (CHARCODE "Meta,X") + (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD) + TEDIT.READTABLE) + (TEDIT.SETFUNCTION (CHARCODE "Meta,x") + (FUNCTION \TEDIT.EXTRACTTOCLIPBOARD) + TEDIT.READTABLE) + + (* ;; "Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).") + + (for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I) + `[LAMBDA NIL + (AND WHEELSCROLLENABLED ,(CADR I] + TEDIT.READTABLE) + (CAR I]) + +(\TEDIT.COPYTOCLIPBOARD + [LAMBDA (TSTREAM TEXTOBJ SEL EXTRACT) (* ; "Edited 21-Apr-2024 11:51 by rmk") + (* ; "Edited 2-Apr-2024 17:01 by rmk") + (* ; "Edited 18-Apr-2018 00:02 by rmk:") + + (* ;; "If CLIPBOARD is loaded, this copies the characters in the current selection to the clipboard (SEL argument is ignored). .") + + (CL:WHEN (FGETD (FUNCTION PUTCLIPBOARD)) + (SETQ TSTREAM (TEXTSTREAM (OR TSTREAM (TTY.PROCESS)) + T)) + (CL:WHEN TSTREAM + (PUTCLIPBOARD TSTREAM (FUNCTION \TEDIT.WRITE.SEL)) + (CL:WHEN EXTRACT (TEDIT.DELETE TSTREAM))))]) + +(\TEDIT.EXTRACTTOCLIPBOARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Apr-2024 09:20 by rmk") + (\TEDIT.COPYTOCLIPBOARD TSTREAM TEXTOBJ SEL T]) + +(\TEDIT.WRITE.SEL + [LAMBDA (TSTREAM STREAM) (* ; "Edited 21-Apr-2024 11:55 by rmk") + + (* ;; "Writes the selected characters in TSTREAM to STREAM. ") + + (* ;; "If there are no image objects, this is equivalent to (PRIN3 (TEDIT.SEL.AS.STRING ...)), but that would trip over image objects. Image objects could be skipped, or as here, represented as the OBJECTBYTE or described in some way.") + + (* ;; "For Medley-to-Medley copy/paste we could also create a local tmp stream that shadows the system clipboard, and apply the PUTFN to that stream. Then copy/paste could be used to move image objects around with a single Medley or perhaps across Medley's (if the GETFN is available).") + + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (SEL (FGETTOBJ TEXTOBJ SEL))) + (CL:WHEN (IGREATERP (GETSEL SEL DCH) + 0) + + (* ;; "This could be run by setting the fileptr and doing BIN's. This way we don't manipulate TSTREAM's file position FWIW.") + + (for I CODE PRE (OBJECTBYTE _ (GETTEXTPROP TEXTOBJ 'OBJECTBYTE)) + (NOBJECTS _ 0) from (GETSEL SEL CH#) to (SUB1 (GETSEL SEL CHLIM)) + while (SETQ CODE (TEDIT.NTHCHARCODE TSTREAM I)) + do (if (CHARCODEP CODE) + then (PRINTCCODE CODE STREAM) + elseif (IMAGEOBJP CODE) + then (add NOBJECTS 1) + (if OBJECTBYTE + then (PRINTCCODE OBJECTBYTE STREAM) + else (PRIN3 "{" STREAM) + (PRIN4 (IMAGEOBJPROP CODE 'GETFN) + STREAM) + (CL:WHEN (SETQ PRE (APPLY* (OR (IMAGEOBJPROP CODE 'PREPRINTFN) + (FUNCTION NILL)) + PRE CODE)) + (PRIN3 " : " STREAM) + (PRIN4 PRE STREAM)) + (PRIN3 "}" STREAM)) + else (ERROR "UNRECOGNIZED TEDIT CHARACTER" CODE)) + finally (CL:WHEN (IGREATERP NOBJECTS 0) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Note: Selection contains " NOBJECTS + " image object" + (CL:IF (EQ NOBJECTS 1) + "" + "s")) + T))))]) ) (RPAQQ TEDIT.FNKEY.VERBOSE T) -(RPAQQ \TEDIT.KEYS - (("Function,^D" UNDO) - ("Function,$" UNDO) - ("Function,^C" FN \TEDIT.KEY.FIND) - ("Function,#" FN \TEDIT.KEY.FIND) - ("Function,Bs" REDO) - ("Function,(" REDO) - ("Function,^R" NEXT) - ("Function,62" NEXT) - ("Esc" EXPAND) - ("Function,^T" EXPAND) - ("Function,A" FN \TEDIT.CENTER.SEL) - ("Function,a" FN \TEDIT.CENTER.SEL.REV) - ("Function,B" FN \TEDIT.BOLD.SEL.ON) - ("Function,b" FN \TEDIT.BOLD.SEL.OFF) - ("Function,C" FN \TEDIT.ITALIC.SEL.ON) - ("Function,c" FN \TEDIT.ITALIC.SEL.OFF) - ("Function,D" FN \TEDIT.UCASE.SEL) - ("Function,d" FN \TEDIT.LCASE.SEL) - ("Function,E" FN \TEDIT.STRIKEOUT.SEL.ON) - ("Function,e" FN \TEDIT.STRIKEOUT.SEL.OFF) - ("Function,F" FN \TEDIT.UNDERLINE.SEL.ON) - ("Function,f" FN \TEDIT.UNDERLINE.SEL.OFF) - ("Function,G" FN \TEDIT.SUBSCRIPTSEL) - ("Function,g" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,H" FN \TEDIT.SMALLERSEL) - ("Function,h" FN \TEDIT.LARGERSEL) - ("Function,K" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,k" FN \TEDIT.SUBSCRIPTSEL) - ("Function,L" FN \TEDIT.SUBSCRIPTSEL) - ("Function,l" FN \TEDIT.SUPERSCRIPTSEL) - ("Function,M" FN \TEDIT.DEFAULTSSEL) - ("Function,m" FN \TEDIT.SETDEFAULT.FROM.SEL) - ("Function,^A" FN \TEDIT.SHOWCARETLOOKS) - ("Meta,a" FN \TEDIT.SELECT.ALL) - ("Meta,A" FN \TEDIT.SELECT.ALL) - ("Meta,d" FN \TEDIT.MANPAGE) - ("Meta,D" FN \TEDIT.MANPAGE) - ("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD) - ("Meta,f" FN \TEDIT.KEY.FIND) - ("Meta,g" FN \TEDIT.FINDAGAIN) - ("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD) - ("Meta,N" NEXT) - ("Meta,n" NEXT) - ("Meta,o" FN \TEDIT.CALL.ED) - ("Meta,O" FN \TEDIT.CALL.ED) - ("Meta,p" FN \TEDIT.PRINT.MENU) - ("Meta,P" FN \TEDIT.PRINT.MENU) - ("Meta,r" REDO) - ("Meta,R" REDO) - ("Meta,s" FN \TEDIT.KEY.SUBSTITUTE) - ("Meta,S" FN \TEDIT.KEY.SUBSTITUTE) - ("Meta,U" FN \TEDIT.UNDO.UNDO) - ("Meta,u" UNDO) - ("Meta,z" UNDO) - ("Meta,Z" \TEDIT.UNDO.UNDO) - ("Meta,<" FN \TEDIT.ONECHAR.BACKWARD) - ("Meta,," FN \TEDIT.ONECHAR.BACKWARD) - ("Meta,>" FN \TEDIT.ONECHAR.FORWARD) - ("Meta,." FN \TEDIT.ONECHAR.FORWARD) - ("Meta,^" FN \TEDIT.ONELINE.UP) - ("Meta,LF" FN \TEDIT.ONELINE.DOWN))) - -[MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) - (SELECTQ (CADR ENTRY) - (FN (TEDIT.SETFUNCTION (CAR ENTRY) - (CADDR ENTRY))) - (TEDIT.SETSYNTAX (CAR ENTRY) - (CADR ENTRY] + + +(* ; "Read-table Utilities") + +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) +) + +(ADDTOVAR CHARACTERNAMES (EMQUAD "357,55") + (ENQUAD "357,54") + (THINSPACE "357,57") + (FIGURESPACE "357,56")) +(DEFINEQ + +(\TEDIT.READTABLE + [LAMBDA NIL (* ; "Edited 18-Mar-2025 11:08 by rmk") + (* ; "Edited 15-Mar-2025 13:51 by rmk") + (* ; "Edited 11-Mar-2025 22:49 by rmk") + (* ; "Edited 24-Dec-2023 09:54 by rmk") + (* ; "Edited 20-Apr-2018 07:59 by rmk:") + (* jds "12-Sep-86 13:48") + + (* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.") + + (LET [(RTBL (create READTABLEP + READMACRODEFS _ (HASHARRAY 50] + (TEDIT.INSTALL.CHARBINDINGS NIL RTBL) + RTBL]) + +(\TEDIT.WORDBOUND.READTABLE + [LAMBDA NIL (* ; "Edited 15-Mar-2025 12:00 by rmk") + (* ; "Edited 13-Mar-2025 22:24 by rmk") + (* ; "Edited 22-May-92 15:10 by jds") + + (* ;; "Create a readtable which will let TEdit find word boundaries. A word boundary is any point where the SYNCODE of the adjacent characters is different") + + (LET* ((RTBL (create READTABLEP + READMACRODEFS _ (HARRAY 50))) + (READSA (fetch READSA of RTBL)) + (TEXTTTC (\TEDIT.TTC TEXT))) + + (* ;; "By default, every character except those noted below is a punctuation character") + + (for CH from 0 to 255 do (\SETSYNCODE READSA CH (\TEDIT.TTC PUNCT))) + (for CH from (CHARCODE A) to (CHARCODE Z) do (\SETSYNCODE READSA CH TEXTTTC)) + (* ; "Upper case alpha") + (for CH from (CHARCODE a) to (CHARCODE z) do (\SETSYNCODE READSA CH TEXTTTC)) + (* ; "Lower case alpha") + (for CH from (CHARCODE 0) to (CHARCODE 9) do (\SETSYNCODE READSA CH TEXTTTC)) + (* ; "And digits are text characters") + + (* ;; "European chars and accents are text characters:") + + (for CH from (CHARCODE "361,41") to (CHARCODE "361,376") do (\SETSYNCODE READSA CH TEXTTTC) + ) + (for CH from (CHARCODE "0,301") to (CHARCODE "0,317") do (\SETSYNCODE READSA CH TEXTTTC)) + (for CH from (CHARCODE "0,341") to (CHARCODE "0,376") do (\SETSYNCODE READSA CH TEXTTTC)) + (for CH in (CHARCODE (CR LF EOL SPACE TAB FORM)) do (\SETSYNCODE READSA CH (\TEDIT.TTC + WHITESPACE))) + (* ; + "And these are nonbreaking white space") + (for CH in '(EMQUAD ENQUAD THINSPACE FIGURESPACE) do (\SETSYNCODE READSA (CHARCODE.DECODE + CH) + TEXTTTC)) + RTBL]) + +(TEDIT.GETSYNTAX + [LAMBDA (CH TABLE) (* ; "Edited 12-Mar-2025 12:55 by rmk") + (* ; "Edited 24-Dec-2023 09:47 by rmk") + (* ; "Edited 31-Mar-87 10:01 by jds") + + (* ;; "Find TEdit's interpretation of a given character") + + (SELECTC (\SYNCODE (fetch READSA of (if (NULL TABLE) + then TEDIT.READTABLE + elseif (TEXTSTREAM TABLE T) + then (OR (GETTOBJ (TEXTOBJ TABLE) + TXTRTBL) + TEDIT.READTABLE) + else TABLE)) + (CL:IF (OR (LITATOM CH) + (STRINGP CH)) + (CHARCODE.DECODE CH) + CH)) + (WORDDELETE.TTC + 'WORDDELETE) + (WORDDELETE.FORWARD.TTC + 'WORDDELETE.FORWARD) + (CHARDELETE.TTC + 'CHARDELETE) + (CHARDELETE.FORWARD.TTC + 'CHARDELETE.FORWARD) + (DELETE.TTC 'DELETE) + (UNDO.TTC 'UNDO) + (REDO.TTC 'REDO) + (FUNCTIONCALL.TTC + 'FN) + (CMD.TTC 'CMD) + (NEXT.TTC 'NEXT) + (EXPAND.TTC 'EXPAND) + NIL]) + +(TEDIT.SETSYNTAX + [LAMBDA (CHAR CLASS RDTBL) (* ; "Edited 13-Mar-2025 21:52 by rmk") + (* ; "Edited 24-Dec-2023 09:17 by rmk") + (* ; "Edited 31-Mar-87 10:00 by jds") + (* ; + "SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE") + (SETQ CHAR (CL:IF (OR (LITATOM CHAR) + (STRINGP CHAR)) + (CHARCODE.DECODE CHAR) + CHAR)) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (TEXTOBJ RDTBL) + TXTRTBL) + TEDIT.READTABLE) + else RDTBL)) + (PROG1 (TEDIT.GETSYNTAX CHAR RDTBL) + (\SETSYNCODE (fetch READSA of RDTBL) + CHAR + (OR (CADR (ASSOC CLASS \TEDIT.TTCCODES)) + (\TEDIT.TTC NONE))))]) + +(TEDIT.GETFUNCTION + [LAMBDA (CHARCODE RDTBL) (* ; "Edited 13-Mar-2025 22:56 by rmk") + (* ; "Edited 7-Mar-2025 12:02 by rmk") + (* jds "19-Sep-85 17:06") + + (* ;; "Gets the FN that is called when CH is hit inside TEDIT.") + + (CL:UNLESS (CHARCODEP CHARCODE) + (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))) + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (TEXTOBJ RDTBL) + TXTRTBL) + TEDIT.READTABLE) + else RDTBL)) + (CL:WHEN (AND RDTBL (type? READTABLEP RDTBL) + (EQ (\TEDIT.TTC FUNCTIONCALL) + (\SYNCODE (fetch READSA of RDTBL) + CHARCODE)) + (fetch READMACRODEFS of RDTBL)) + [CAR (FETCH MACROFN OF (GETHASH CHARCODE (fetch READMACRODEFS of RDTBL])]) + +(TEDIT.SETFUNCTION + [LAMBDA (CHARCODE FN RDTBL) (* ; "Edited 13-Mar-2025 22:51 by rmk") + (* ; "Edited 7-Mar-2025 12:03 by rmk") + (* ; "Edited 31-Mar-87 10:58 by jds") + (* ; + "Set TEDITs (read) table so that FN is called whenever CHARCODE is typed.") + (* ; + "If FN is NIL, make the character be normal again.") + (CL:UNLESS (CHARCODEP CHARCODE) + (SETQ CHARCODE (CHARCODE.DECODE CHARCODE))) (* ; + "Mark the character whether or not it invokes a function") + (SETQ RDTBL (if (NULL RDTBL) + then TEDIT.READTABLE + elseif (TEXTSTREAM RDTBL T) + then (OR (GETTOBJ (TEXTOBJ RDTBL) + TXTRTBL) + TEDIT.READTABLE) + else RDTBL)) (* ; + "Mark the character as invoking a function") + (\SETSYNCODE (fetch READSA of RDTBL) + CHARCODE + (CL:IF FN + (\TEDIT.TTC FUNCTIONCALL) + (\TEDIT.TTC NONE))) + (CL:UNLESS (fetch READMACRODEFS of RDTBL) + (replace READMACRODEFS of RDTBL with (HARRAY 50))) (* ; + "Make sure there's a hash table to store the function in.") + (PUTHASH CHARCODE (CREATE READMACRODEF + MACROTYPE _ 'TEDIT + MACROFN _ (LIST FN)) + (fetch READMACRODEFS of RDTBL]) + +(TEDIT.WORDGET + [LAMBDA (CH TABLE) (* jds "27-MAY-83 13:24") + (\SYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) + (COND + ((SMALLP CH)) + (T (CHCON1 CH]) + +(TEDIT.WORDSET + [LAMBDA (CHARCODE CLASS TABLE) (* ; "Edited 13-Mar-2025 21:43 by rmk") + (* jds " 1-JUN-83 12:23") + + (* ;; "Sets Tedit syntax bits in a termtable. ") + + (\SETSYNCODE (fetch READSA of (OR TABLE TEDIT.WORDBOUND.READTABLE)) + (OR (SMALLP CHARCODE) + (CHARCODE.DECODE CHARCODE)) + (OR (FIXP CLASS) + (SELECTQ CLASS + (PUNCT (\TEDIT.TTC PUNCT)) + (WHITESPACE (\TEDIT.TTC WHITESPACE)) + (\TEDIT.TTC TEXT]) + +(TEDIT.ATOMBOUND.READTABLE + [LAMBDA (READTABLE) (* ; "Edited 14-Mar-2025 18:13 by rmk") + (* ; "Edited 25-Dec-2023 13:10 by rmk") + (* ; "Edited 5-Dec-2023 23:47 by rmk") + + (* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable. This is specified as the BOUNDTABLE for Lisp source code edits. Not perfect, but not bad.") + + (* ;; "Could cache this for common readtables (interlisp, commonlisp)") + + (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)) + (TEDIT.WORDSET (CHARCODE %:) + 'TEXT TABLE) + TABLE]) +) + + + +(* ; "Keybindings") + +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.TTC MACRO [(CLASS) + (CONSTANT (CADR (ASSOC 'CLASS \TEDIT.TTCCODES]) +) + +(* "END EXPORTED DEFINITIONS") + +) + +(RPAQQ TEDIT.CHARACTIONS + ( + (* ;; "This defines the implementation of the named actions. They are activated by keybinding specifications given to TEDIT.INSTALL.KEYBINDINGS.") + + + (* ;; "") + + + (* ;; "History") + + (UNDO (TEDIT.UNDO TSTREAM)) + (UNDO.UNDO \TEDIT.UNDO.UNDO) + (* ; "CHECK") + (REDO TEDIT.REDO) + + (* ;; "") + + + (* ;; "Find") + + ((FIND.FORWARD FIND) + (\TEDIT.KEY.FIND TSTREAM)) + (FIND.BACKWARD (\TEDIT.KEY.FIND TSTREAM NIL T)) + (FIND.FORWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T)) + (FIND.BACKWARD-AGAIN (\TEDIT.KEY.FIND TSTREAM T T)) + (SUBSTITUTE \TEDIT.KEY.SUBSTITUTE) + (NEXT TEDIT.NEXT) + + (* ;; "") + + + (* ;; "Character looks") + + (BOLD.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'ON)) + (BOLD.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'OFF)) + (BOLD.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'BOLD 'TOGGLE)) + (ITALIC.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'ON)) + (ITALIC.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'OFF)) + (ITALIC.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'ITALIC 'TOGGLE)) + (UCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION U-CASECODE))) + (LCASE (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION L-CASECODE))) + (INITIALCAP (\TEDIT.KEY.TRANSFORM TSTREAM (FUNCTION CAP-CASECODE))) + (STRIKEOUT.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'ON)) + (STRIKEOUT.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'OFF)) + (STRIKEOUT.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'STRIKEOUT 'TOGGLE)) + (UNDERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'ON)) + (UNDERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'OFF)) + (UNDERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNDERLINE 'TOGGLE)) + (OVERLINE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'ON)) + (OVERLINE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'OFF)) + (OVERLINE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'OVERLINE 'TOGGLE)) + (UNBREAKABLE.ON (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'ON)) + (UNBREAKABLE.OFF (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'OFF)) + (UNBREAKABLE.TOGGLE (\TEDIT.KEY.CHARLOOKS TSTREAM 'UNBREAKABLE 'TOGGLE)) + (SUBSCRIPT \TEDIT.SUBSCRIPTSEL) + (SUPERSCRIPT \TEDIT.SUPERSCRIPTSEL) + (SMALLER (\TEDIT.KEY.SIZE TSTREAM '-)) + (LARGER (\TEDIT.KEY.SIZE TSTREAM '+)) + (FAMILYN (\TEDIT.KEY.FAMILYN TSTREAM CHARCODE)) + (DEFAULTS \TEDIT.DEFAULTSSEL) + (SHOW.CHARLOOKS \TEDIT.SHOWCARETLOOKS) + + (* ;; "") + + + (* ;; "Paragraph looks") + + (NEST (\TEDIT.KEY.NEST TSTREAM)) + (UNNEST (\TEDIT.KEY.NEST TSTREAM T)) + ((QUAD CENTER) + (\TEDIT.KEY.QUAD TSTREAM)) + (QUAD.REVERSE (\TEDIT.KEY.QUAD TSTREAM T)) + + (* ;; "") + + + (* ;; "Cursor/selection") + + (ONECHAR.BACKWARD \TEDIT.ONECHAR.BACKWARD) + (ONECHAR.FORWARD \TEDIT.ONECHAR.FORWARD) + (LINE.UP \TEDIT.ONELINE.UP) + (LINE.DOWN \TEDIT.ONELINE.DOWN) + (ONEWORD.FORWARD \TEDIT.ONEWORD.FORWARD) + (ONEWORD.BACKWARD \TEDIT.ONEWORD.BACKWARD) + (LINE.BEGIN \TEDIT.LINE.BEGIN) + (LINE.END \TEDIT.LINE.END) + (DOCUMENT.BEGIN \TEDIT.DOCUMENT.BEGIN) + (DOCUMENT.END \TEDIT.DOCUMENT.END) + (ALL \TEDIT.SELECT.ALL) + + (* ;; "") + + + (* ;; "Deletion ") + + ((CHARDELETE CHARDELETE.BACKWORD) + (\TEDIT.CHARDELETE TSTREAM)) + (CHARDELETE.FORWARD (\TEDIT.CHARDELETE TSTREAM T)) + (WORDDELELETE \TEDIT.WORDDELETE) + (WORDDELETE.FORWARD \TEDIT.WORDDELETE.FORWARD) + (LINEDELETE.FORWARD \TEDIT.LINEDELETE.FORWARD) + (LINEDELETE.BACKWARD \TEDIT.LINEDELETE.BACKWARD) + + (* ;; "") + + + (* ;; "Miscellaneous") + + (MANPAGE \TEDIT.MANPAGE) + (OPEN.SEDIT \TEDIT.CALL.ED) + (PRINT.MENU \TEDIT.PRINT.MENU) + (EXPAND \TEDIT.ABBREV.EXPAND) + (GET.OBJECT GET.OBJ.FROM.USER) + (OPENLINE \TEDIT.KEY.OPENLINE) + + (* ;; "") + + + (* ;; "Clipboard") + + (CLIPBOARD-PASTE PASTEFROMCLIPBOARD) + (CLIPBOARD-COPY \TEDIT.COPYTOCLIPBOARD) + (CLIPBOARD-EXTRACT \TEDIT.EXTRACTTOCLIPBOARD) + + (* ;; "") + + + (* ;; "Wheelscroll") + + (WHEELSCROLL-UP (WHEELSCROLL 'VERTICAL T)) + (WHEELSCROLL-DOWN (WHEELSCROLL 'VERTICAL)) + (WHEELSCROLL-LEFT (WHEELSCROLL 'HORIZONTAL)) + (WHEELSCROLL-RIGHT (WHEELSCROLL 'HORIZONTAL T)))) + +(RPAQQ TEDIT.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).") + + + (* ;; "") + + + (* ;; "History") + + (UNDO "Meta,u" "Meta,z" "Function,4" "Function,44") + (UNDO.UNDO "Meta,U" "Meta,Z") + (REDO "Meta,r" "Meta,R" "Function,10" "Function,50") + + (* ;; "") + + + (* ;; "Find") + + (FIND.FORWARD "Meta,f" "Function,3" "Function,43") + (FIND.BACKWARD "Meta,F") + (FIND.FORWARD-AGAIN "Meta,g") + (FIND.BACKWARD-AGAIN "Meta,G") + (SUBSTITUTE "Meta,s" "Meta,S") + (NEXT "Meta,N" "Meta,n" "Function,22") + + (* ;; "") + + + (* ;; "Character looks") + + (BOLD.ON "Function,102") + (BOLD.OFF "Function,142") + (BOLD.TOGGLE) + (ITALIC.ON "Function,103") + (ITALIC.OFF "Function,143") + (ITALIC.TOGGLE) + (UCASE "Function,104") + (LCASE "Function,144") + (STRIKEOUT.ON "Function,105") + (STRIKEOUT.OFF "Function,145") + (STRIKEOUT.TOGGLE) + (UNDERLINE.ON "Function,106") + (UNDERLINE.OFF "Function,146") + (UNDERLINE.TOGGLE) + (OVERLINE.ON) + (OVERLINE.OFF) + (OVERLINE.TOGGLE) + (SUBSCRIPT "Function,114") + (SUPERSCRIPT "Function,113") + (SMALLER "Function,110") + (LARGER "Function,150") + (FAMILYN "Meta,One" "Meta,Two" "Meta,Three" "Meta,Four" "Meta,Five" "Meta,Six") + (DEFAULTS "Function,115" "Function,155") + (SHOW.CHARLOOKS "Function,1") + + (* ;; "") + + + (* ;; "Paragraph looks") + + (QUAD "Function,101") + (NEST "Meta,[") + (UNNEST "Meta,]") + + (* ;; "") + + + (* ;; "Cursor/selection") + + (ONECHAR.BACKWARD "Meta,<" "Meta,,") + (* ; "From arrows") + (ONECHAR.FORWARD "Meta,>" "Meta,.") + (LINE.UP "Meta,^") + (LINE.DOWN "Meta,LF") + (ONEWORD.FORWARD) + (ONEWORD.BACKWARD) + (LINE.BEGIN) + (LINE.END) + (ALL "Meta,a" "Meta,A") + + (* ;; "") + + + (* ;; "Deletion") + + (CHARDELETE "BS" "^A") + (* ; "CHARDELETE/WORDDELETE are TTC") + (CHARDELETE.FORWARD "^W" "^U") + (* ; "keyactions for DEL key ??") + (WORDDELELETE) + (WORDDELETE.FORWARD) + (* ; "^W is used for chardelete forward") + (LINEDELETE.FORWARD) + (LINEDELETE.BACKWARD) + + (* ;; "") + + + (* ;; "Miscellaneous") + + (MANPAGE "Meta,D" "Meta,d") + (OPEN.SEDIT "Meta,O" "Meta,o") + (PRINT.MENU "Meta,P" "Meta,p") + (EXPAND "^X") + (GET.OBJECT "^O") + + (* ;; "") + + + (* ;; "Wheelscroll ") + + (WHEELSCROLL-UP "WHEELSCROLL-UP") + (WHEELSCROLL-DOWN "WHEELSCROLL-DOWN") + (WHEELSCROLL-LEFT "WHEELSCROLL-LEFT") + (WHEELSCROLL-RIGHT "WHEELSCROLL-RIGHT") + + (* ;; "") + + + (* ;; "Clipboard") + + (CLIPBOARD-PASTE "Meta,V" "Meta,v") + (CLIPBOARD-COPY "Meta,C" "Meta,c") + (CLIPBOARD-EXTRACT "Meta,X" "Meta,x"))) + +(RPAQQ TEDIT.DORADO.CHARBINDINGS + ( + (* ;; "Taken from lispusers>TKDORADO, these make the indicatedd Tedit commands available from the Dorado keyboard.") + + (DEFAULTS "Meta,^V") + (BOLD.ON "Meta,^B") + (BOLD.OFF "Meta,^N") + (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.OFF "Meta,^K") + (SMALLER "Meta,^[") + (LARGER "Meta,^^]") + (SUBSCRIPT "Meta,^^") + (SUPERSCRIPT "Meta,^_") + (QUAD "Meta,^C"))) + + + +(* ; "Installation") + +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(RPAQ TEDIT.READTABLE (\TEDIT.READTABLE)) + +(RPAQ TEDIT.WORDBOUND.READTABLE (\TEDIT.WORDBOUND.READTABLE)) +) + + + +(* ;; "On-screen formatting buttons (TEDIT.BUTTONS.BUILD) creates the default button menu") + + +(RPAQQ TEDIT.BUTTONS.SPEC + ((Bold BOLD.ON BOLD.OFF) + (Italic ITALIC.ON ITALIC.OFF) + (Case UCASE LCASE) + ((Strike- out) + STRIKEOUT.ON STRIKEOUT.OFF) + ((Under- line) + UNDERLINE.ON UNDERLINE.OFF) + ((Super/ Sub) + SUPERSCRIPT SUBSCRIPT) + ((Larger Smaller) + LARGER SMALLER) + (Justify QUAD) + (Defaults DEFAULTS) + (Show SHOW.CHARLOOKS) + (Redo REDO))) +(DEFINEQ + +(TEDIT.BUTTONS.BUILD + [LAMBDA (BUTTONSPEC TITLE NROWS KEYBINDINGS) (* ; "Edited 23-Mar-2025 10:31 by rmk") + (* ; "Edited 18-Mar-2025 15:47 by rmk") + (* ; "Edited 15-Mar-2025 15:24 by rmk") + (* ; "Edited 5-Nov-85 15:35 by lmm") + + (* ;; "Each button is of the form (label action1 [action2]), e.g. (BOLD BOLD.ON BOLD.OFF) or (JUSTIFY QUAD)") + + (CL:UNLESS (AND (WINDOWP TEDIT.BUTTONS.WINDOW) + (OPENWP TEDIT.BUTTONS.WINDOW)) + (CL:UNLESS BUTTONSPEC (SETQ BUTTONSPEC TEDIT.BUTTONS.SPEC)) + (CL:UNLESS TITLE + (SETQ TITLE '(Tedit Buttons))) (* ; "List for the Shrink button label") + (CL:UNLESS KEYBINDINGS (SETQ KEYBINDINGS TEDIT.CHARBINDINGS)) + + (* ;; "The constructed menu will bksysbuf a character bound to action1 if the shift is not down, otherwise a character bound to action2. action2 is action1 if it is not specified. Buttons with no actions are skipped.") + + [LET (ITEMS) + (SETQ ITEMS (for BUTTON CHARS in BUTTONSPEC + eachtime (CL:WHEN (AND (CDR BUTTON) + (NULL (CDDR BUTTON))) + [SETQ BUTTON (APPEND BUTTON (CONS (CADR BUTTON]) + when [SETQ CHARS (for ANAME CHAR in (CDR BUTTON) + when (SETQ CHAR (CADR (ASSOC ANAME KEYBINDINGS))) + collect (CL:IF (CHARCODEP CHAR) + CHAR + (CHARCODE.DECODE CHAR))] + collect (LIST (TEDIT.BUTTONBITMAP.FILL (CAR BUTTON)) + CHARS))) + (SETQ TEDIT.BUTTONS.WINDOW (ADDMENU [create MENU + ITEMS _ ITEMS + TITLE _ (CL:IF (LISTP TITLE) + (SUBSTRING TITLE 2 -2) + TITLE) + MENUROWS _ (OR NROWS 1) + WHENSELECTEDFN _ + (FUNCTION (LAMBDA (X) + (CL:WHEN + (EQ '\TEDIT.PROCENTRYFN + (FETCH (PROCESS + PROCTTYENTRYFN + ) + OF (TTY.PROCESS))) + [\TEDIT.COMMAND.FUNCTION? + (TEXTSTREAM (TTY.PROCESS)) + (CL:IF (SHIFTDOWNP + 'SHIFT) + (CADR (CADR X)) + (CAR (CADR X)))])] + NIL + (create POSITION + XCOORD _ + (PLUS (DIFFERENCE (QUOTIENT SCREENWIDTH 2) + (QUOTIENT (TIMES (BITMAPWIDTH + + TEDIT.BUTTONBITMAP + ) + (LENGTH ITEMS)) + 2)) + (TIMES 2 WBorder)) + YCOORD _ 0])]) + +(TEDIT.BUTTONBITMAP.FILL + [LAMBDA (X) (* ; "Edited 16-Mar-2025 21:12 by rmk") + (* ; "Edited 15-Mar-2025 14:55 by rmk") + (* lmm " 5-Nov-85 14:04") + (LET ((BITMAP (BITMAPCOPY TEDIT.BUTTONBITMAP)) + DS QUARTER REGION) + (SETQ DS (DSPCREATE BITMAP)) + (DSPFONT MENUFONT DS) + (if (LISTP X) + then (* ; + "this is supposed to have two labels, one on top of the other") + (SETQ QUARTER (IQUOTIENT (BITMAPHEIGHT BITMAP) + 4)) + (CENTERPRINTINREGION (CADR X) + (SETQ REGION (create REGION + LEFT _ 0 + BOTTOM _ QUARTER + WIDTH _ (BITMAPWIDTH BITMAP) + HEIGHT _ QUARTER)) + DS) + (replace BOTTOM of REGION with (ITIMES 2 QUARTER)) + (CENTERPRINTINREGION (CAR X) + REGION DS) + else (CENTERPRINTINREGION X (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (BITMAPWIDTH BITMAP) + HEIGHT _ (BITMAPHEIGHT BITMAP)) + DS)) + BITMAP]) +) + +(RPAQ? TEDIT.BUTTONS.WINDOW NIL) + +(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 (6442 28702 (\TEDIT.BOLD.SEL.OFF 6452 . 6790) (\TEDIT.BOLD.SEL.ON 6792 . 7120) ( -\TEDIT.CENTER.SEL 7122 . 8638) (\TEDIT.CENTER.SEL.REV 8640 . 8936) (\TEDIT.DEFAULTS.CARET 8938 . 9431) - (\TEDIT.DEFAULTSSEL 9433 . 9880) (\TEDIT.SETDEFAULT.FROM.SEL 9882 . 10559) (\TEDIT.KEY.FIND 10561 . -15628) (\TEDIT.KEY.FIND.SEARCHSTRING 15630 . 16770) (\TEDIT.GET.TARGET.STRING 16772 . 18486) ( -\TEDIT.KEY.FIND.BACKWARD 18488 . 18793) (\TEDIT.FINDAGAIN.BACKWARD 18795 . 19206) (\TEDIT.FINDAGAIN -19208 . 19499) (\TEDIT.ITALIC.SEL.OFF 19501 . 19753) (\TEDIT.ITALIC.SEL.ON 19755 . 19948) ( -\TEDIT.LARGERSEL 19950 . 20238) (\TEDIT.LCASE.SEL 20240 . 21635) (\TEDIT.SHOWCARETLOOKS 21637 . 23237) - (\TEDIT.SMALLERSEL 23239 . 23530) (\TEDIT.SUBSCRIPTSEL 23532 . 23735) (\TEDIT.SUPERSCRIPTSEL 23737 . -23941) (\TEDIT.UCASE.SEL 23943 . 25282) (\TEDIT.UNDERLINE.SEL.OFF 25284 . 25482) ( -\TEDIT.UNDERLINE.SEL.ON 25484 . 25680) (\TEDIT.STRIKEOUT.SEL.ON 25682 . 25878) ( -\TEDIT.STRIKEOUT.SEL.OFF 25880 . 26078) (\TEDIT.SELECT.ALL 26080 . 26396) (\TEDIT.KEY.SUBSTITUTE 26398 - . 26619) (\TEDIT.MANPAGE 26621 . 27868) (\TEDIT.CALL.ED 27870 . 28700)) (28703 37902 ( -\TEDIT.ONECHAR.BACKWARD 28713 . 29842) (\TEDIT.ONECHAR.FORWARD 29844 . 31062) (\TEDIT.ONELINE.UP 31064 - . 34025) (\TEDIT.ONELINE.DOWN 34027 . 35684) (\TEDIT.ONELINE.MOVE 35686 . 37900)) (37974 44485 ( -\TEDIT.BOLD.CARET.OFF 37984 . 38519) (\TEDIT.BOLD.CARET.ON 38521 . 39053) (\TEDIT.ITALIC.CARET.OFF -39055 . 39592) (\TEDIT.ITALIC.CARET.ON 39594 . 40137) (\TEDIT.LARGER.CARET 40139 . 40674) ( -\TEDIT.SMALLER.CARET 40676 . 41213) (\TEDIT.SUBSCRIPT.CARET 41215 . 41756) (\TEDIT.SUPERSCRIPT.CARET -41758 . 42300) (\TEDIT.UNDERLINE.CARET.OFF 42302 . 42842) (\TEDIT.UNDERLINE.CARET.ON 42844 . 43382) ( -\TEDIT.STRIKEOUT.CARET.OFF 43384 . 43924) (\TEDIT.STRIKEOUT.CARET.ON 43926 . 44483)) (44554 45256 ( -\TK.DESCRIBEFONT 44564 . 45254))))) + (FILEMAP (NIL (3674 7637 (CHARNAME 3684 . 7635)) (7693 21570 (TEDIT.INSTALL.CHARBINDINGS 7703 . 10886) + (TEDIT.CLEAR.CHARBINDINGS 10888 . 13479) (TEDIT.GET.CHARACTION 13481 . 16128) (TEDIT.GET.CHARBINDING +16130 . 18054) (TEDIT.GET.ALL.CHARBINDINGS 18056 . 19710) (TEDIT.GET.ALL.CHARACTIONS 19712 . 21568)) ( +21630 31248 (\TEDIT.KEY.CHARLOOKS 21640 . 22582) (\TEDIT.KEY.QUAD 22584 . 24677) (\TEDIT.DEFAULTSSEL +24679 . 25290) (\TEDIT.SETDEFAULT.FROM.SEL 25292 . 25969) (\TEDIT.KEY.SIZE 25971 . 27167) ( +\TEDIT.SUBSCRIPTSEL 27169 . 27372) (\TEDIT.SUPERSCRIPTSEL 27374 . 27578) (\TEDIT.KEY.TRANSFORM 27580 + . 29390) (\TEDIT.KEY.OPENLINE 29392 . 29846) (\TEDIT.KEY.FAMILYN 29848 . 31246)) (31249 31538 ( +CAP-CASECODE 31259 . 31536)) (31572 34198 (\TEDIT.SHOWCARETLOOKS 31582 . 33291) (\TEDIT.DESCRIBEFONT +33293 . 34196)) (34229 48965 (\TEDIT.ONECHAR.BACKWARD 34239 . 35368) (\TEDIT.ONECHAR.FORWARD 35370 . +36588) (\TEDIT.ONELINE.UP 36590 . 39551) (\TEDIT.ONELINE.DOWN 39553 . 41210) (\TEDIT.ONELINE.MOVE +41212 . 43426) (\TEDIT.ONEWORD.BACKWARD 43428 . 44580) (\TEDIT.ONEWORD.FORWARD 44582 . 45733) ( +\TEDIT.LINE.BEGIN 45735 . 46786) (\TEDIT.LINE.END 46788 . 47997) (\TEDIT.DOCUMENT.BEGIN 47999 . 48358) + (\TEDIT.DOCUMENT.END 48360 . 48963)) (48966 50810 (\TEDIT.LINEDELETE.FORWARD 48976 . 49876) ( +\TEDIT.LINEDELETE.BACKWARD 49878 . 50808)) (50811 53069 (\TEDIT.KEY.NEST 50821 . 53067)) (53123 61078 +(\TEDIT.KEY.FIND 53133 . 58218) (\TEDIT.KEY.FIND.SEARCHSTRING 58220 . 59360) (\TEDIT.GET.TARGET.STRING + 59362 . 61076)) (61109 63741 (\TEDIT.KEY.SUBSTITUTE 61119 . 61340) (\TEDIT.MANPAGE 61342 . 62589) ( +\TEDIT.CALL.ED 62591 . 63421) (\TEDIT.SELECT.ALL 63423 . 63739)) (63768 69348 (\TEDIT.CLIPBOARD 63778 + . 65533) (\TEDIT.COPYTOCLIPBOARD 65535 . 66315) (\TEDIT.EXTRACTTOCLIPBOARD 66317 . 66512) ( +\TEDIT.WRITE.SEL 66514 . 69346)) (69700 81415 (\TEDIT.READTABLE 69710 . 70646) ( +\TEDIT.WORDBOUND.READTABLE 70648 . 73277) (TEDIT.GETSYNTAX 73279 . 74798) (TEDIT.SETSYNTAX 74800 . +76005) (TEDIT.GETFUNCTION 76007 . 77179) (TEDIT.SETFUNCTION 77181 . 79167) (TEDIT.WORDGET 79169 . +79430) (TEDIT.WORDSET 79432 . 80063) (TEDIT.ATOMBOUND.READTABLE 80065 . 81413)) (92003 98542 ( +TEDIT.BUTTONS.BUILD 92013 . 96810) (TEDIT.BUTTONBITMAP.FILL 96812 . 98540))))) STOP diff --git a/library/tedit/TEDIT-FNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM index 2b39e65e7..acf5a0260 100644 Binary files a/library/tedit/TEDIT-FNKEYS.LCOM and b/library/tedit/TEDIT-FNKEYS.LCOM differ diff --git a/library/tedit/TEDIT-HISTORY b/library/tedit/TEDIT-HISTORY index 2bbc317e1..642df4d07 100644 --- a/library/tedit/TEDIT-HISTORY +++ b/library/tedit/TEDIT-HISTORY @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Feb-2025 15:42:44" {WMEDLEY}TEDIT>TEDIT-HISTORY.;221 53072 +(FILECREATED "16-Mar-2025 18:50:43" {WMEDLEY}tedit>TEDIT-HISTORY.;225 53719 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.HISTORYADD.COMPOSITE) + :CHANGES-TO (FNS \TEDIT.UNDO1 TEDIT.REDO) - :PREVIOUS-DATE " 2-Feb-2025 11:32:56" {WMEDLEY}TEDIT>TEDIT-HISTORY.;220) + :PREVIOUS-DATE "15-Mar-2025 22:42:11" {WMEDLEY}tedit>TEDIT-HISTORY.;224) (PRETTYCOMPRINT TEDIT-HISTORYCOMS) @@ -326,7 +326,8 @@ (DEFINEQ (TEDIT.UNDO - [LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 8-Dec-2024 19:41 by rmk") + [LAMBDA (TSTREAM NOUNDOUNDO) (* ; "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") (* ; "Edited 3-Jul-2024 21:21 by rmk") @@ -372,6 +373,7 @@ (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.") + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) (TEDIT.PROMPTCLEAR TSTREAM) (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (\TEDIT.UNDO1 TSTREAM EVENT) @@ -394,7 +396,8 @@ (\TEDIT.SHOWSEL SEL T TEXTOBJ]) (\TEDIT.UNDO1 - [LAMBDA (TSTREAM EVENT) (* ; "Edited 25-Nov-2024 13:56 by rmk") + [LAMBDA (TSTREAM EVENT) (* ; "Edited 16-Mar-2025 18:46 by rmk") + (* ; "Edited 25-Nov-2024 13:56 by rmk") (* ; "Edited 29-Sep-2024 13:51 by rmk") (* ; "Edited 22-Sep-2024 21:41 by rmk") (* ; "Edited 19-Aug-2024 00:11 by rmk") @@ -423,9 +426,9 @@ (\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT)) (:PageFormat (* ; "Pageframe change") (\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT)) - ((LIST :Replace :LowerCase :UpperCase) + ((LIST :Replace :Transform) - (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") + (* ;; "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 TEXTOBJ EVENT)) @@ -454,7 +457,8 @@ T]) (TEDIT.REDO - [LAMBDA (TSTREAM) (* ; "Edited 2-Feb-2025 11:28 by rmk") + [LAMBDA (TSTREAM) (* ; "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") (* ; "Edited 26-Sep-2024 16:49 by rmk") @@ -497,10 +501,12 @@ (:Replace (* ;  "It was a replacement (a del/insert combo)") (\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION))) + (:Transform (\TEDIT.KEY.TRANSFORM TSTREAM (GETTH EVENT THOLDINFO))) (:LowerCase (* ; "He lower-cased something") - (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) + (\TEDIT.LCASE.SEL TSTREAM TEXTOBJ SEL)) (:UpperCase (* ; "He upper-cased something") - (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL)) + (\TEDIT.UCASE.SEL TSTREAM TEXTOBJ SEL)) + (:InitialCap (\TEDIT.KEY.INITIALCAP TSTREAM TEXTOBJ SEL)) (:CharLooks (* ; "It was a character looks change") (\TEDIT.CHANGE.CHARLOOKS TSTREAM (CAR (GETTH EVENT THOLDINFO)) SEL)) @@ -635,14 +641,15 @@ (\TEDIT.SHOWSEL SEL T TSTREAM]) (\TEDIT.UNDO.REPLACE - [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 13-Sep-2024 23:50 by rmk") + [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "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") (* ; "Edited 30-May-2023 23:10 by rmk") (* ; "Edited 27-May-2023 16:49 by rmk") (* ; "Edited 24-May-2023 22:43 by rmk") - (* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.") + (* ;; "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) @@ -839,14 +846,14 @@ (\TEDIT.THELP 'Redo-composite]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4913 5934 (\TEDIT.HISTORYEVENT.DEFPRINT 4923 . 5932)) (7024 17609 (\TEDIT.HISTORYADD -7034 . 11895) (\TEDIT.HISTORYADD.COMPOSITE 11897 . 12803) (\TEDIT.CUMULATE.EVENTS 12805 . 14399) ( -\TEDIT.COMPOSITE.EVENT 14401 . 15137) (\TEDIT.HISTORY.PROP 15139 . 16502) (\TEDIT.HISTORY.EVENT 16504 - . 17433) (\TEDIT.POPEVENT 17435 . 17607)) (17662 35601 (TEDIT.UNDO 17672 . 22066) (\TEDIT.UNDO1 22068 - . 26280) (TEDIT.REDO 26282 . 32755) (\TEDIT.UNDO.UNDO 32757 . 35599)) (35602 50688 ( -\TEDIT.UNDO.INSERT 35612 . 36525) (\TEDIT.UNDO.DELETE 36527 . 37321) (\TEDIT.UNDO.MOVE 37323 . 38912) -(\TEDIT.UNDO.REPLACE 38914 . 40010) (\TEDIT.UNDO.CHARLOOKS 40012 . 44586) (\TEDIT.UNDO.PARALOOKS 44588 - . 48820) (\TEDIT.UNDO.PAGELOOKS 48822 . 49231) (\TEDIT.UNDO.COMPOSITE 49233 . 50460) ( -\TEDIT.UNDO.REPLACECODE 50462 . 50686)) (50689 53049 (\TEDIT.REDO.INSERT 50699 . 51432) ( -\TEDIT.REDO.REPLACE 51434 . 52765) (\TEDIT.REDO.COMPOSITE 52767 . 53047))))) + (FILEMAP (NIL (4909 5930 (\TEDIT.HISTORYEVENT.DEFPRINT 4919 . 5928)) (7020 17605 (\TEDIT.HISTORYADD +7030 . 11891) (\TEDIT.HISTORYADD.COMPOSITE 11893 . 12799) (\TEDIT.CUMULATE.EVENTS 12801 . 14395) ( +\TEDIT.COMPOSITE.EVENT 14397 . 15133) (\TEDIT.HISTORY.PROP 15135 . 16498) (\TEDIT.HISTORY.EVENT 16500 + . 17429) (\TEDIT.POPEVENT 17431 . 17603)) (17658 36127 (TEDIT.UNDO 17668 . 22227) (\TEDIT.UNDO1 22229 + . 26541) (TEDIT.REDO 26543 . 33281) (\TEDIT.UNDO.UNDO 33283 . 36125)) (36128 51335 ( +\TEDIT.UNDO.INSERT 36138 . 37051) (\TEDIT.UNDO.DELETE 37053 . 37847) (\TEDIT.UNDO.MOVE 37849 . 39438) +(\TEDIT.UNDO.REPLACE 39440 . 40657) (\TEDIT.UNDO.CHARLOOKS 40659 . 45233) (\TEDIT.UNDO.PARALOOKS 45235 + . 49467) (\TEDIT.UNDO.PAGELOOKS 49469 . 49878) (\TEDIT.UNDO.COMPOSITE 49880 . 51107) ( +\TEDIT.UNDO.REPLACECODE 51109 . 51333)) (51336 53696 (\TEDIT.REDO.INSERT 51346 . 52079) ( +\TEDIT.REDO.REPLACE 52081 . 53412) (\TEDIT.REDO.COMPOSITE 53414 . 53694))))) STOP diff --git a/library/tedit/TEDIT-HISTORY.LCOM b/library/tedit/TEDIT-HISTORY.LCOM index f6374c410..51abfabaf 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 fa1ea94d8..db1ed347d 100644 --- a/library/tedit/TEDIT-LOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,12 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Feb-2025 09:49:05" {WMEDLEY}TEDIT>TEDIT-LOOKS.;392 151574 +(FILECREATED "23-Mar-2025 15:10:37" {WMEDLEY}tedit>TEDIT-LOOKS.;399 155940 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.CARETLOOKS) + :CHANGES-TO (FNS \TEDIT.CHARLOOKS.CHANGE.FONT \TEDIT.FONT.NEXTSIZE \TEDIT.FONTCLASS.TO.FONT + \TEDIT.CHANGE.CHARLOOKS) + (VARS TEDIT-LOOKSCOMS) - :PREVIOUS-DATE "19-Feb-2025 12:00:37" {WMEDLEY}TEDIT>TEDIT-LOOKS.;390) + :PREVIOUS-DATE "19-Mar-2025 13:20:52" {WMEDLEY}tedit>TEDIT-LOOKS.;395) (PRETTYCOMPRINT TEDIT-LOOKSCOMS) @@ -62,7 +64,8 @@ (FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS) [INITVARS (TEDIT.FONTCLASSES '(DISPLAY PDF POSTSCRIPT INTERPRESS PRESS] (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT - \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS)) + \TEDIT.FONT.NEXTSIZE \TEDIT.LOOKS \TEDIT.FONTCOPY \TEDIT.COERCE.FONTCLASS + \TEDIT.FONTCLASS.TO.FONT)) (COMS (* ; "Paragraph looks functions") (FNS \TEDIT.EQFMTSPEC TEDIT.GET.PARALOOKS \TEDIT.PARSE.PARALOOKS.LIST TEDIT.PARALOOKS \TEDIT.CHANGE.PARALOOKS \TEDIT.CHANGE.PARALOOKS.NEW TEDIT.COPY.PARALOOKS @@ -537,7 +540,8 @@ (DEFINEQ (\TEDIT.CHARLOOKS.FROM.FONT - [LAMBDA (FONT) (* ; "Edited 2-Jan-2025 10:21 by rmk") + [LAMBDA (FONT NOERROR) (* ; "Edited 19-Mar-2025 12:47 by rmk") + (* ; "Edited 2-Jan-2025 10:21 by rmk") (* ; "Edited 31-Dec-2024 23:33 by rmk") (* ; "Edited 28-Dec-2024 12:28 by rmk") (* ; "Edited 21-Dec-2024 00:12 by rmk") @@ -555,7 +559,7 @@ (SETQ FONT (if (AND (LITATOM FONT) (type? FONTCLASS (GETATOMVAL FONT))) then (GETATOMVAL FONT) - else (FONTCREATE FONT)))) + else (FONTCREATE FONT NIL NIL NIL NIL NOERROR)))) (CL:WHEN (type? FONTCLASS FONT) (SETQ FONT (\TEDIT.COERCE.FONTCLASS FONT))) (create CHARLOOKS @@ -653,21 +657,27 @@ " is an unknown feature of character looks. Detected in SAMECLOOKS"]) (TEDIT.CARETLOOKS - [LAMBDA (STREAM LOOKS) (* ; "Edited 21-Feb-2025 09:48 by rmk") + [LAMBDA (TSTREAM LOOKS) (* ; "Edited 19-Mar-2025 11:51 by rmk") + (* ; "Edited 21-Feb-2025 09:48 by rmk") (* ; "Edited 15-Oct-2023 17:12 by rmk") (* ; "Edited 28-May-2023 14:15 by rmk") (* ; "Edited 6-Apr-2023 21:42 by rmk") (* ; "Edited 8-Sep-2022 11:25 by rmk") (* ; "Edited 30-May-91 21:40 by jds") - (* ;; "Set the 'Caret looks' for a TEdit document, i.e., the looks that will be applied to newly-typed characters from here on. Returns the previous caret looks") + (* ;; "Set the caret looks for a TEdit document, i.e., the looks that will be applied to newly-typed characters from here on. Returns the previous caret looks") - (LET ((TEXTOBJ (TEXTOBJ STREAM))) (* ; - "Parse up the looks he gave us, to make sure they're a valid CHARLOOKS") - (PROG1 (FGETTOBJ TEXTOBJ CARETLOOKS) - (change (FGETTOBJ TEXTOBJ CARETLOOKS) - (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS DATUM - TEXTOBJ))))]) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + + (* ;; "Check to make sure the document allows the change.") + + (CL:WHEN (AND LOOKS (SETQ LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS (FGETTOBJ TEXTOBJ + CARETLOOKS) + TEXTOBJ)) + (SETQ LOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS))) + (PROG1 (FGETTOBJ TEXTOBJ CARETLOOKS) + (change (FGETTOBJ TEXTOBJ CARETLOOKS) + LOOKS)))]) (TEDIT.COPY.LOOKS [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 25-Nov-2024 14:38 by rmk") @@ -1395,7 +1405,9 @@ (DEFINEQ (\TEDIT.CHANGE.CHARLOOKS - [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 31-Jan-2025 10:31 by rmk") + [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "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") @@ -1417,7 +1429,7 @@ (* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection (unless it's the TARGETSEL).") (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - SELPIECES NEWLOOKSLIST FONT) (* ; + SELPIECES NEWLOOKSLIST FONT DIRTY) (* ;  "Construct the set of new looks to apply:") (CL:UNLESS TARGETSEL (SETQ TARGETSEL (TEXTSEL TEXTOBJ))) @@ -1431,7 +1443,7 @@ (if (type? CHARLOOKS NEWLOOKS) then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWLOOKS TEXTOBJ)) elseif (FONTP NEWLOOKS) - then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT 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)) @@ -1471,7 +1483,7 @@ (RETURN NIL] (CL:UNLESS NEWLOOKSLIST (* ; "At least one bad font?") (RETURN NIL)) - (for PC UNDOLIST NEWCHARLOOKS DIRTY (FIRSTCHAR _ (GETSPC SELPIECES SPFIRSTCHAR)) + [for PC UNDOLIST NEWCHARLOOKS (FIRSTCHAR _ (GETSPC SELPIECES SPFIRSTCHAR)) (ORIGFILEPTR _ (\TEDIT.TEXTGETFILEPTR TSTREAM)) OLDCHARLOOKS inselpieces SELPIECES as NEWCHARLOOKS in NEWLOOKSLIST do (SETQ OLDCHARLOOKS (PLOOKS PC)) @@ -1516,14 +1528,15 @@ (* ;; "Set caret looks to the looks of the last selected character--the looks of that piece may have been only partially modified") - (FSETTOBJ TEXTOBJ CARETLOOKS (PLOOKS (\TEDIT.CHTOPC - (IMAX 1 (SUB1 (TEDIT.GETPOINT - TEXTOBJ))) - TEXTOBJ))) + (TEDIT.CARETLOOKS TEXTOBJ (PCHARLOOKS (\TEDIT.CHTOPC + (IMAX 1 (SUB1 (TEDIT.GETPOINT + TEXTOBJ))) + TEXTOBJ))) (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS SELPIECES) (\TEDIT.SHOWSEL NIL T TEXTOBJ) - (\TEDIT.TEXTSETFILEPTR TSTREAM ORIGFILEPTR)))]) + (\TEDIT.TEXTSETFILEPTR TSTREAM ORIGFILEPTR)))] + (RETURN DIRTY]) (\TEDIT.CHANGE.CHARLOOKS.NEW [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 2-Jan-2025 15:49 by rmk") @@ -1580,7 +1593,9 @@ NIL) finally (RETURN NEWCHARLOOKS]) (\TEDIT.CHARLOOKS.CHANGE.FONT - [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 29-Jan-2025 23:52 by rmk") + [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 23-Mar-2025 15:10 by rmk") + (* ; "Edited 21-Mar-2025 13:54 by rmk") + (* ; "Edited 29-Jan-2025 23:52 by rmk") (* ; "Edited 10-Jan-2025 11:01 by rmk") (* ; "Edited 7-Jan-2025 12:34 by rmk") (* ; "Edited 2-Jan-2025 10:23 by rmk") @@ -1599,7 +1614,7 @@ (* ;; " 1. OLDCHARLOOKCS CLFONT is a FONTDESCRIPTOR, same for all devices") - (* ;; " If DEVICE is ALL or OFF, CLFONT is replaced by the new FONTDESCRIPTOR that stands for all devices.") + (* ;; " If DEVICE is ALL, OFF, or NIL, CLFONT is replaced by the new FONTDESCRIPTOR that stands for all devices.") (* ;; " If DEVICE is a particular device, then CLFONT is coerced to a fontclass that differentiates just for the new device.") @@ -1622,7 +1637,7 @@ (WEIGHT (LISTGET NEWLOOKS 'WEIGHT)) (SLOPE (LISTGET NEWLOOKS 'SLOPE)) (EXPANSION (LISTGET NEWLOOKS 'EXPANSION)) - (SIZE (LISTGET NEWLOOKS 'SIZE)) + [SIZE (MKATOM (LISTGET NEWLOOKS 'SIZE] (SIZEINCREMENT (LISTGET NEWLOOKS 'SIZEINCREMENT)) (OLDFONT (FGETCLOOKS OLDCHARLOOKS CLFONT)) FONTSPEC TEMP) @@ -1664,15 +1679,24 @@ (push FONTSPEC 'EXPANSION EXPANSION)) elseif FACE then (push FONTSPEC 'FACE FACE)) - (if SIZE + (if (FIXP SIZE) + then (CL:WHEN SIZEINCREMENT + (TEDIT.PROMPTPRINT TEXTOBJ + "Cannot specify both SIZE and SIZEINCREMENT font attributes--aborted" T + ) + (RETURN NIL)) + elseif (MEMB SIZE '(+ -)) + then (SETQ SIZEINCREMENT SIZE) + (SETQ SIZE NIL)) + [if SIZE then (push FONTSPEC 'SIZE SIZE) elseif SIZEINCREMENT then (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font. ") - (push FONTSPEC 'SIZE (IPLUS (FONTPROP (GETCLOOKS OLDCHARLOOKS CLFONT) - 'SIZE) - SIZEINCREMENT))) + (push FONTSPEC 'SIZE (OR (\TEDIT.FONT.NEXTSIZE (GETCLOOKS OLDCHARLOOKS CLFONT) + SIZEINCREMENT) + (RETURN NIL] (CL:WHEN (AND NEWFONT FONTSPEC) (* ;  "Caller should have checked this, but...") (TEDIT.PROMPTPRINT TEXTOBJ @@ -1681,7 +1705,7 @@ (* ;; "") - (RETURN (if (EQ 'ALL DEVICE) + (RETURN (if (MEMB DEVICE '(ALL OFF NIL)) then (if NEWFONT elseif (type? FONTDESCRIPTOR OLDFONT) then (\TEDIT.FONTCOPY OLDFONT FONTSPEC TEXTOBJ) @@ -1709,6 +1733,30 @@ (SETFONTCLASSCOMPONENT TEMP DEVICE NEWFONT) TEMP)]) +(\TEDIT.FONT.NEXTSIZE + [LAMBDA (FONT INCREMENT) (* ; "Edited 23-Mar-2025 11:36 by rmk") + (* ; "Edited 21-Mar-2025 23:18 by rmk") + + (* ;; "Returns the size of a FONT that is INCREMENT larger or smaller than FONT. If INCREMENT is a positive integer, then that is added to FONT's size, if negative subtracted. If +, the next larger available font, - the next smaller. NIL if an appropriate font doesn't exist.") + + (if (FIXP INCREMENT) + then (IPLUS (FONTPROP FONT 'SIZE) + INCREMENT) + else (LET [(FONTS (SORT (FONTSAVAILABLE FONT '* (FONTPROP FONT 'FACE) + (FONTPROP FONT 'ROTATION) + (FONTPROP FONT 'DEVICE) + T) + (FUNCTION (LAMBDA (F1 F2) + (ILESSP (FONTPROP F1 'SIZE) + (FONTPROP F2 'SIZE] + (CL:WHEN (EQ INCREMENT '-) (* ; "Smaller: descending size order") + (SETQ FONTS (DREVERSE FONTS))) + (for FTAIL (FSIZE _ (FONTPROP FONT 'SIZE)) on FONTS + when (EQ FSIZE (FONTPROP (CAR FTAIL) + 'SIZE)) do (RETURN (AND (CADR FTAIL) + (FONTPROP (CADR FTAIL) + 'SIZE]) + (\TEDIT.LOOKS [LAMBDA (TEXTOBJ) (* ; "Edited 28-Jun-2024 21:52 by rmk") (* ; "Edited 13-Jun-2024 22:10 by rmk") @@ -1802,6 +1850,23 @@ (FONTCLASSCOMPONENT FONT D))] NEWCLASS]) + +(\TEDIT.FONTCLASS.TO.FONT + [LAMBDA (FONTCLASS) (* ; "Edited 22-Mar-2025 21:29 by rmk") + + (* ;; + "If all of the hardcopy fonts in FONTCLASS have the same properties, reduce to the display font.") + + (for D DISPLAYFONT F in TEDIT.FONTDEVICES first (SETQ DISPLAYFONT (FONTCREATE FONTCLASS NIL NIL + NIL 'DISPLAY)) + unless (EQ D 'DISPLAY) do (SETQ F (FONTCREATE FONTCLASS NIL NIL NIL D)) + (CL:UNLESS [AND (EQ (FONTPROP DISPLAYFONT 'FAMILY) + (FONTPROP F 'FAMILY)) + (EQUAL (FONTPROP DISPLAYFONT 'FACE) + (FONTPROP F 'FACE)) + (EQ (FONTPROP DISPLAYFONT 'SIZE) + (FONTPROP F 'SIZE] + (RETURN FONTCLASS)) finally (RETURN DISPLAYFONT]) ) @@ -2060,7 +2125,8 @@ then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))]) (\TEDIT.CHANGE.PARALOOKS - [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 8-Feb-2025 22:30 by rmk") + [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "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") @@ -2414,25 +2480,26 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22500 24442 (\TEDIT.CHARLOOKS.DEFPRINT 22510 . 23646) (\TEDIT.PARALOOKS.DEFPRINT 23648 - . 24440)) (24546 25642 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24556 . 25264) (\TEDIT.CREATE.FACE.MENU 25266 - . 25438) (\TEDIT.CREATE.SIZE.MENU 25440 . 25640)) (26543 26732 (\TEDIT.CHARLOOK.FEATUREP 26553 . -26730)) (27034 49932 (\TEDIT.CHARLOOKS.FROM.FONT 27044 . 29124) (\TEDIT.EQCLOOKS 29126 . 31748) ( -\TEDIT.SAMECLOOKS 31750 . 34420) (TEDIT.CARETLOOKS 34422 . 35727) (TEDIT.COPY.LOOKS 35729 . 39012) ( -\TEDIT.UNPARSE.CHARLOOKS.LIST 39014 . 41981) (\TEDIT.MODIFYLOOKS 41983 . 43977) (TEDIT.NEW.FONT 43979 - . 44426) (\TEDIT.CARETLOOKS.VERIFY 44428 . 45265) (\TEDIT.CARETPIECE 45267 . 45572) ( -\TEDIT.GET.INSERT.CHARLOOKS 45574 . 48310) (\TEDIT.GET.TERMSA.WIDTHS 48312 . 48728) ( -\TEDIT.PARSE.CHARLOOKS.LIST 48730 . 49930)) (49933 66451 (\TEDIT.TRANSLATE.ASCIICHARS 49943 . 60429) ( -\TEDIT.CONVERT.TO.FORMATTED 60431 . 66449)) (67463 74574 (\TEDIT.UNIQUIFY.CHARLOOKS 67473 . 69133) ( -\TEDIT.UNIQUIFY.PARALOOKS 69135 . 70402) (\TEDIT.UNIQUIFY.ALL 70404 . 72379) ( -\TEDIT.FLUSH.UNUSED.LOOKS 72381 . 74572)) (74607 85703 (TEDIT.LOOKS 74617 . 77006) (TEDIT.GET.LOOKS -77008 . 79037) (TEDIT.SUBLOOKS 79039 . 83067) (TEDIT.FINDLOOKS 83069 . 85701)) (85778 112026 ( -\TEDIT.CHANGE.CHARLOOKS 85788 . 94784) (\TEDIT.CHANGE.CHARLOOKS.NEW 94786 . 98411) ( -\TEDIT.CHARLOOKS.CHANGE.FONT 98413 . 106037) (\TEDIT.LOOKS 106039 . 109368) (\TEDIT.FONTCOPY 109370 . -110871) (\TEDIT.COERCE.FONTCLASS 110873 . 112024)) (112069 143234 (\TEDIT.EQFMTSPEC 112079 . 115294) ( -TEDIT.GET.PARALOOKS 115296 . 119343) (\TEDIT.PARSE.PARALOOKS.LIST 119345 . 126687) (TEDIT.PARALOOKS -126689 . 127729) (\TEDIT.CHANGE.PARALOOKS 127731 . 134907) (\TEDIT.CHANGE.PARALOOKS.NEW 134909 . -138892) (TEDIT.COPY.PARALOOKS 138894 . 141568) (\TEDIT.PARABOUNDS 141570 . 143232)) (143294 150692 ( -TEDIT.SUBPARALOOKS 143304 . 147088) (SAMEPARALOOKS 147090 . 150690)) (150693 151380 ( -\TEDIT.MARK.REVISION 150703 . 151378))))) + (FILEMAP (NIL (22713 24655 (\TEDIT.CHARLOOKS.DEFPRINT 22723 . 23859) (\TEDIT.PARALOOKS.DEFPRINT 23861 + . 24653)) (24759 25855 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24769 . 25477) (\TEDIT.CREATE.FACE.MENU 25479 + . 25651) (\TEDIT.CREATE.SIZE.MENU 25653 . 25853)) (26756 26945 (\TEDIT.CHARLOOK.FEATUREP 26766 . +26943)) (27247 50519 (\TEDIT.CHARLOOKS.FROM.FONT 27257 . 29470) (\TEDIT.EQCLOOKS 29472 . 32094) ( +\TEDIT.SAMECLOOKS 32096 . 34766) (TEDIT.CARETLOOKS 34768 . 36314) (TEDIT.COPY.LOOKS 36316 . 39599) ( +\TEDIT.UNPARSE.CHARLOOKS.LIST 39601 . 42568) (\TEDIT.MODIFYLOOKS 42570 . 44564) (TEDIT.NEW.FONT 44566 + . 45013) (\TEDIT.CARETLOOKS.VERIFY 45015 . 45852) (\TEDIT.CARETPIECE 45854 . 46159) ( +\TEDIT.GET.INSERT.CHARLOOKS 46161 . 48897) (\TEDIT.GET.TERMSA.WIDTHS 48899 . 49315) ( +\TEDIT.PARSE.CHARLOOKS.LIST 49317 . 50517)) (50520 67038 (\TEDIT.TRANSLATE.ASCIICHARS 50530 . 61016) ( +\TEDIT.CONVERT.TO.FORMATTED 61018 . 67036)) (68050 75161 (\TEDIT.UNIQUIFY.CHARLOOKS 68060 . 69720) ( +\TEDIT.UNIQUIFY.PARALOOKS 69722 . 70989) (\TEDIT.UNIQUIFY.ALL 70991 . 72966) ( +\TEDIT.FLUSH.UNUSED.LOOKS 72968 . 75159)) (75194 86290 (TEDIT.LOOKS 75204 . 77593) (TEDIT.GET.LOOKS +77595 . 79624) (TEDIT.SUBLOOKS 79626 . 83654) (TEDIT.FINDLOOKS 83656 . 86288)) (86365 116283 ( +\TEDIT.CHANGE.CHARLOOKS 86375 . 95611) (\TEDIT.CHANGE.CHARLOOKS.NEW 95613 . 99238) ( +\TEDIT.CHARLOOKS.CHANGE.FONT 99240 . 107547) (\TEDIT.FONT.NEXTSIZE 107549 . 109170) (\TEDIT.LOOKS +109172 . 112501) (\TEDIT.FONTCOPY 112503 . 114004) (\TEDIT.COERCE.FONTCLASS 114006 . 115157) ( +\TEDIT.FONTCLASS.TO.FONT 115159 . 116281)) (116326 147600 (\TEDIT.EQFMTSPEC 116336 . 119551) ( +TEDIT.GET.PARALOOKS 119553 . 123600) (\TEDIT.PARSE.PARALOOKS.LIST 123602 . 130944) (TEDIT.PARALOOKS +130946 . 131986) (\TEDIT.CHANGE.PARALOOKS 131988 . 139273) (\TEDIT.CHANGE.PARALOOKS.NEW 139275 . +143258) (TEDIT.COPY.PARALOOKS 143260 . 145934) (\TEDIT.PARABOUNDS 145936 . 147598)) (147660 155058 ( +TEDIT.SUBPARALOOKS 147670 . 151454) (SAMEPARALOOKS 151456 . 155056)) (155059 155746 ( +\TEDIT.MARK.REVISION 155069 . 155744))))) STOP diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM index 6e5303e43..3c91a859d 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 d91fb6148..69c71b061 100644 --- a/library/tedit/TEDIT-MENU +++ b/library/tedit/TEDIT-MENU @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 5-Mar-2025 20:52:33" {WMEDLEY}TEDIT>TEDIT-MENU.;455 160734 +(FILECREATED "23-Mar-2025 14:56:57" {WMEDLEY}tedit>TEDIT-MENU.;464 162009 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.EXPANDEDMENU.ACTIONFN) + :CHANGES-TO (FNS \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.FILLIN) - :PREVIOUS-DATE "19-Feb-2025 13:27:11" {WMEDLEY}TEDIT>TEDIT-MENU.;454) + :PREVIOUS-DATE "19-Mar-2025 10:01:40" {WMEDLEY}tedit>TEDIT-MENU.;461) (PRETTYCOMPRINT TEDIT-MENUCOMS) @@ -36,7 +36,7 @@ \TEDIT.DOTTED.LEFTTAB \TEDIT.DOTTED.CENTERTAB \TEDIT.DOTTED.RIGHTTAB \TEDIT.DOTTED.DECIMALTAB TEDIT.EXTENDEDRIGHTMARK) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT] - (COMS (FNS \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN) + (COMS (FNS TEDIT.MENUSTREAM TEDITMENUP \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN) (BITMAPS TEXTMENUICON TEXTMENUICONMASK)) (* ; "Generic support for Tedit menus") (FNS \TEDIT.MENU.CREATE \TEDIT.MENU.PARSE \TEDIT.MENU.NEUTRALIZE @@ -49,7 +49,7 @@ (* ; "EXPANDEDMENU") (FNS \TEDIT.EXPANDEDMENU.CREATE \TEDIT.EXPANDEDMENU.START \TEDIT.EXPANDEDMENU.FN - \TEDIT.EXPANDEDMENU.ACTIONFN TEDIT.MENUSTREAM) + \TEDIT.EXPANDEDMENU.ACTIONFN) (* ;; "") @@ -66,7 +66,8 @@ (* ;; "") (* ; "CHARMENU") - [INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT] + [INITVARS (TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT)) + (TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha] (FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.START \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE \TEDIT.CHARMENU.FILLIN \TEDIT.SHOW.CHARLOOKS \TEDIT.APPLY.CHARLOOKS \TEDIT.OFFSETTYPE.STATEFN \TEDIT.OTHER.STATECHANGEFN \TEDIT.OTHER.SELECTFN) @@ -938,8 +939,40 @@ ) (DEFINEQ +(TEDIT.MENUSTREAM + [LAMBDA (TSTREAM TITLE) (* ; "Edited 14-Mar-2025 16:14 by rmk") + (* ; "Edited 29-Sep-2024 15:29 by rmk") + (* ; "Edited 28-Aug-2024 15:48 by rmk") + (* ; "Edited 10-Apr-2023 09:53 by rmk") + (* jds "13-Aug-84 14:10") + + (* ;; "returns the textstream of the teditmenu attached to this stream if any, or TSTREAM if it is that teditmenu") + + (CL:UNLESS TITLE (SETQ TITLE "TEdit Menu")) + (for W MTSTREAM in (CONS (\TEDIT.PRIMARYPANE TSTREAM) + (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM))) + when (AND (STRING.EQUAL TITLE (WINDOWPROP W 'TITLE)) + (SETQ MTSTREAM (TEXTSTREAM W T))) do (RETURN MTSTREAM]) + +(TEDITMENUP + [LAMBDA (TSTREAM TITLE) (* ; "Edited 14-Mar-2025 16:31 by rmk") + (* ; "Edited 15-Mar-2024 15:39 by rmk") + (* ; "Edited 7-Dec-2023 21:06 by rmk") + (* ; "Edited 20-Sep-2023 22:36 by rmk") + (* ; "Edited 10-Apr-2023 10:14 by rmk") + (CL:WHEN (AND (SETQ TSTREAM (TEXTSTREAM TSTREAM T)) + (GETTOBJ (GETTSTR TSTREAM TEXTOBJ) + MENUFLG) + (\TEDIT.PRIMARYPANE TSTREAM) + (CL:IF TITLE + (STRING.EQUAL TITLE (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) + 'TITLE)) + T)) + TSTREAM]) + (\TEDIT.MENU.START - [LAMBDA (MENUSTREAM MAINWINDOW TITLE HEIGHT TYPE) (* ; "Edited 28-Jun-2024 23:08 by rmk") + [LAMBDA (MENUSTREAM TSTREAM TITLE HEIGHT TYPE) (* ; "Edited 14-Mar-2025 16:13 by rmk") + (* ; "Edited 28-Jun-2024 23:08 by rmk") (* ; "Edited 19-Apr-2024 10:53 by rmk") (* ; "Edited 10-Apr-2024 23:04 by rmk") (* ; "Edited 27-Feb-2024 08:12 by rmk") @@ -960,28 +993,18 @@ (* ;; "Pretext: menu windows can't have menu windows.") - (* ;; "Typically this is called from a menu under the main window running in the mouse process. When we're done, we want to return to the main window's editing process, not to the process we are called in.") - - (CL:UNLESS [AND MAINWINDOW (OR (TEDITMENUP MAINWINDOW) - (for WW in (ATTACHEDWINDOWS MAINWINDOW) - thereis (STREQUAL (OR TITLE "TEdit Menu") - (WINDOWPROP WW 'TEDITMENU] - (LET ((WREG (CL:IF MAINWINDOW - (WINDOWPROP MAINWINDOW 'REGION) - (GETREGION))) - (MENUTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM)) - MENUW) - (SETQ MENUW (CREATEW (SETQ WREG (COND - (MAINWINDOW (create REGION - LEFT _ (fetch (REGION LEFT) - of WREG) - BOTTOM _ (fetch (REGION TOP) - of WREG) - WIDTH _ (fetch (REGION WIDTH) - of WREG) - HEIGHT _ (OR HEIGHT 133))) - (T WREG))) - (OR TITLE "TEdit Menu"))) + (CL:UNLESS TITLE (SETQ TITLE "TEdit Menu")) + (CL:UNLESS (TEDIT.MENUSTREAM TSTREAM TITLE) + (LET ((MAINWINDOW (\TEDIT.PRIMARYPANE TSTREAM)) + (MENUTEXTOBJ (GETTSTR MENUSTREAM TEXTOBJ)) + WREG MENUW) + (SETQ WREG (WINDOWPROP MAINWINDOW 'REGION)) + (SETQ MENUW (CREATEW (create REGION + LEFT _ (fetch (REGION LEFT) of WREG) + BOTTOM _ (fetch (REGION TOP) of WREG) + WIDTH _ (fetch (REGION WIDTH) of WREG) + HEIGHT _ (OR HEIGHT 133)) + TITLE)) (WINDOWADDPROP MENUW 'CLOSEFN (FUNCTION FREEATTACHEDWINDOW)) (WINDOWPROP MENUW 'TEDITMENU (OR TITLE "TEdit Menu")) (* ; "Mark this as a TEDIT MENU window") @@ -993,31 +1016,26 @@ (* ;; "The mainwindow's PROMPTWINDOW is also the menus prompt window") - (CL:WHEN MAINWINDOW - (WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW))) - [TEDIT MENUSTREAM MENUW NIL `(TITLEMENUFN DON'T PROMPTWINDOW ,(GETTOBJ (TEXTOBJ - MAINWINDOW - ) - PROMPTWINDOW] + (WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW)) + [TEDIT MENUSTREAM MENUW NIL `(TITLEMENUFN DON'T NOTSPLITTABLE T PROMPTWINDOW + ,(GETTOBJ (TEXTOBJ TSTREAM) + PROMPTWINDOW] (PROCESSPROP (WINDOWPROP MENUW 'PROCESS) 'NAME (PACK* "TEdit-" (CL:IF TYPE (L-CASE TYPE T) "Menu"))) - (CL:WHEN MAINWINDOW (* ; - "Give the tty back to the main window") - (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS))) (* ;; "No caret now, let the buttonevent fn bring it up") (\TEDIT.UPCARET (GETPANEPROP (PANEPROPS (FGETTOBJ MENUTEXTOBJ PRIMARYPANE)) PCARET) -10 -10) - (TEXTPROP MENUTEXTOBJ 'NOTSPLITTABLE T) (WINDOWPROP MENUW 'BUTTONEVENTFN (FUNCTION \TEDIT.MENU.BUTTONEVENTFN)) - (SETSEL (GETTOBJ MENUTEXTOBJ SEL) + (SETSEL (TEXTSEL MENUTEXTOBJ) SET NIL) (* ;  "Have to click to get the selection going") + (TEDIT.BACKTOMAIN MENUSTREAM) MENUW))]) (\TEDIT.MENU.BUTTONEVENTFN @@ -1163,7 +1181,8 @@ (DEFINEQ (\TEDIT.EXPANDEDMENU.CREATE - [LAMBDA NIL (* ; "Edited 7-Jan-2025 16:05 by rmk") + [LAMBDA NIL (* ; "Edited 8-Mar-2025 12:27 by rmk") + (* ; "Edited 7-Jan-2025 16:05 by rmk") (* ; "Edited 8-Nov-2024 08:35 by rmk") (* ; "Edited 22-Oct-2024 10:48 by rmk") (* ; "Edited 20-Oct-2024 22:51 by rmk") @@ -1234,7 +1253,7 @@ (FIELDTYPE STRING)) 3 (TOGGLE (LABEL "Confirm")) - TAB + 3 (TOGGLE (IDENTIFIER USENEWLOOKS) (LABEL "Use New Looks")) EOL @@ -1255,7 +1274,8 @@ (FIELDTYPE STRING]) (\TEDIT.EXPANDEDMENU.START - [LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 16:43 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk") + (* ; "Edited 7-Jan-2025 16:43 by rmk") (* ; "Edited 20-Aug-2024 15:46 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Feb-2024 08:11 by rmk") @@ -1265,9 +1285,7 @@ (* ; "'27-Sep-84 01:04' gbn") (LET (EXPANDEDMENU (TEXTOBJ (TEXTOBJ TSTREAM))) (\TEDIT.MENU.START (SETQ EXPANDEDMENU (\TEDIT.EXPANDEDMENU.CREATE)) - (\TEDIT.PRIMARYPANE TEXTOBJ) - "TEdit Menu" - (HEIGHTIFWINDOW 60 T) + TSTREAM "TEdit Menu" (HEIGHTIFWINDOW 60 T) 'EXPANDED) (CL:WHEN (OR (GETTEXTPROP TEXTOBJ 'CLEARGET) (GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialize the button") @@ -1325,7 +1343,10 @@ (RETURN 'DON'T]) (\TEDIT.EXPANDEDMENU.ACTIONFN - [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 5-Mar-2025 20:51 by rmk") + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 18-Mar-2025 23:54 by rmk") + (* ; "Edited 16-Mar-2025 21:43 by rmk") + (* ; "Edited 14-Mar-2025 15:43 by rmk") + (* ; "Edited 5-Mar-2025 20:51 by rmk") (* ; "Edited 7-Jan-2025 22:36 by rmk") (* ; "Edited 26-Nov-2024 23:30 by rmk") (* ; "Edited 22-Oct-2024 10:54 by rmk") @@ -1375,7 +1396,7 @@ (FIND (SETQ STATE (MB.GET 'FINDPATTERN MENUTEXTOBJ 'STATE MENUSEL)) (if (IGEQ (NCHARS STATE) 1) - then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL NIL NIL STATE) + then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL STATE) else (TEDIT.PROMPTPRINT MAINSTREAM "Search pattern not specified" T) )) (SUBSTITUTE [LET* [(STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS @@ -1393,14 +1414,13 @@ REPLACEMENT))) [TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT "") - (EQ 'ON (LISTGET STATES 'CONFIRM])]) + (EQ 'ON (LISTGET STATES 'CONFIRM)) + (EQ 'ON (LISTGET STATES 'USENEWLOOKS])]) (QUIT (* ; "Is it OK to quit the main edit?") (\TEDIT.FINISHEDIT? MAINSTREAM)) (PAGELAYOUT (* ; "Page layout menu") (\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE) - (\TEDIT.PRIMARYPANE MAINSTREAM) - "Page Layout Menu" - (HEIGHTIFWINDOW 135 5) + MAINSTREAM "Page Layout Menu" (HEIGHTIFWINDOW 135 5) 'PAGE)) (PARALOOKS (* ; "Page layout menu") (\TEDIT.PARAMENU.START MAINSTREAM)) @@ -1438,16 +1458,6 @@ (\TEDIT.SHOWSEL MENUSEL NIL MENUTEXTOBJ) (* ;  "And forget that anything is selected.") (SETSEL MENUSEL SET NIL]) - -(TEDIT.MENUSTREAM - [LAMBDA (TSTREAM) (* ; "Edited 28-Aug-2024 15:48 by rmk") - (* ; "Edited 10-Apr-2023 09:53 by rmk") - (* jds "13-Aug-84 14:10") - - (* ;; "returns the textstream of the teditmenu attached to this stream if any") - - (for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TSTREAM)) when (TEDITMENUP W "TEdit Menu") - do (RETURN (TSTREAM W]) ) @@ -1570,16 +1580,15 @@ EOL]) (\TEDIT.PARAMENU.START - [LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 15:36 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:42 by rmk") + (* ; "Edited 7-Jan-2025 15:36 by rmk") (* ; "Edited 27-Jul-2024 00:06 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Feb-2024 07:53 by rmk") (* ; "Edited 19-Sep-2023 08:51 by rmk") (* ; "Edited 20-Aug-87 16:51 by jds") (\TEDIT.MENU.START (\TEDIT.PARAMENU.CREATE) - (\TEDIT.PRIMARYPANE TSTREAM) - "Paragraph-Looks Menu" - (HEIGHTIFWINDOW 141 T) + TSTREAM "Paragraph-Looks Menu" (HEIGHTIFWINDOW 141 T) 'PARALOOKS]) (\TEDIT.APPLY.PARALOOKS @@ -1718,6 +1727,8 @@ (RPAQ? TEDIT.FONTDEVICES '(DISPLAY PDF POSTSCRIPT)) + +(RPAQ? TEDIT.FONTFAMILIES '(Classic Modern Terminal Helvetica TimesRoman Gacha)) (DEFINEQ (\TEDIT.CHARMENU.CREATE @@ -1760,7 +1771,8 @@ ,@(\TEDIT.CHARMENU.SPEC TSTREAM]) (\TEDIT.CHARMENU.START - [LAMBDA (TSTREAM) (* ; "Edited 7-Jan-2025 22:37 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 15:41 by rmk") + (* ; "Edited 7-Jan-2025 22:37 by rmk") (* ; "Edited 17-Dec-2024 00:04 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 27-Feb-2024 07:56 by rmk") @@ -1771,13 +1783,13 @@ (* ;; "Open a character-looks menu.") (\TEDIT.MENU.START (\TEDIT.CHARMENU.CREATE TSTREAM) - (\TEDIT.PRIMARYPANE TSTREAM) - "Character Looks Menu" - (HEIGHTIFWINDOW 100 T) + TSTREAM "Character Looks Menu" (HEIGHTIFWINDOW 100 T) 'CHARLOOKS]) (\TEDIT.CHARMENU.SPEC - [LAMBDA (TSTREAM) (* ; "Edited 26-Jan-2025 22:05 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 23-Mar-2025 14:48 by rmk") + (* ; "Edited 15-Mar-2025 23:38 by rmk") + (* ; "Edited 26-Jan-2025 22:05 by rmk") (* ; "Edited 10-Jan-2025 10:49 by rmk") (* ; "Edited 3-Jan-2025 11:21 by rmk") (* ; "Edited 1-Jan-2025 09:38 by rmk") @@ -1801,7 +1813,7 @@ (FUNCTION \TEDIT.OFFSETTYPE.STATEFN) (FUNCTION \TEDIT.OTHER.STATECHANGEFN) (FUNCTION \TEDIT.OTHER.SELECTFN)) - (LET [[FONTFAMILIES (APPEND '(Classic Helvetica Modern Terminal TimesRoman] + (LET [(FONTFAMILIES (APPEND TEDIT.FONTFAMILIES)) (FONTDEVICES (CONS 'All (for D in TEDIT.FONTDEVICES collect (CL:IF (EQ 'PDF D) 'PDF (L-CASE D T))] @@ -1835,8 +1847,9 @@ 3 (3STATE (LABEL Italic)) 3 - (FIELD (PRELABEL "Size:") - (FIELDTYPE NUMBER)) + (FIELD (IDENTIFIER SIZE) + (PRELABEL "Size:") + (FIELDTYPE TRIMMEDSTRING)) EOL (NWAY (IDENTIFIER OFFSETTYPE) (BUTTONS (Normal Superscript Subscript)) @@ -1897,7 +1910,8 @@ NEWLOOKS]) (\TEDIT.CHARMENU.FILLIN - [LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 1-Jan-2025 15:24 by rmk") + [LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "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") (* ; "Edited 21-Oct-2024 00:33 by rmk") @@ -1918,9 +1932,9 @@ first (SETQ FONT (FGETCLOOKS CHARLOOKS CLFONT)) (SETQ DEVICE (MB.GET 'DEVICE MENUSTREAM 'STATE)) (CL:WHEN (type? FONTCLASS FONT) - (CL:WHEN (MEMB DEVICE '(OFF ALL)) + (CL:WHEN (MEMB DEVICE '(OFF ALL NIL)) (TEDIT.PROMPTPRINT MENUSTREAM - "Please specify a particular display/hardcopy format" T) + "Please select a particular display/print device" T) (RETURN)) (SETQ FONT (FONTCREATE FONT NIL NIL NIL DEVICE))) when [AND (SETQ OBJ (POBJ PC)) @@ -2620,28 +2634,29 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5022 51393 (DRAWMARGINSCALE 5032 . 8491) (MARGINBAR 8493 . 15618) (MARGINBAR.CREATE -15620 . 19039) (MB.MARGINBAR.BUTTONEVENTINFN 19041 . 26680) (MB.MARGINBAR.SELFN.TABS 26682 . 31922) ( -MB.MARGINBAR.SELFN.TABS.KIND 31924 . 32859) (MARGINBAR.GETSTATEFN 32861 . 36739) (MARGINBAR.SETSTATEFN - 36741 . 36951) (MARGINBAR.NEUTRALIZE 36953 . 37366) (MARGINBAR.LOOKS 37368 . 40474) ( -MB.MARGINBAR.SIZEFN 40476 . 41079) (MB.MARGINBAR.DISPLAYFN 41081 . 44142) (MDESCALE 44144 . 44684) ( -MSCALE 44686 . 45016) (MB.MARGINBAR.SHOWTAB 45018 . 47341) (MB.MARGINBAR.TABTRACK 47343 . 48728) ( -MARGINBAR.INIT 48730 . 50123) (\TEDIT.PARALOOKS.TO.MARBAR 50125 . 51391)) (52218 58435 ( -\TEDIT.MENU.START 52228 . 57859) (\TEDIT.MENU.BUTTONEVENTFN 57861 . 58433)) (58754 66676 ( -\TEDIT.MENU.CREATE 58764 . 60575) (\TEDIT.MENU.PARSE 60577 . 64266) (\TEDIT.MENU.NEUTRALIZE 64268 . -66339) (\TEDITMENU.RECORD.UNFORMATTED 66341 . 66674)) (66742 86825 (\TEDIT.EXPANDEDMENU.CREATE 66752 - . 72047) (\TEDIT.EXPANDEDMENU.START 72049 . 73423) (\TEDIT.EXPANDEDMENU.FN 73425 . 76680) ( -\TEDIT.EXPANDEDMENU.ACTIONFN 76682 . 86266) (TEDIT.MENUSTREAM 86268 . 86823)) (86887 102378 ( -\TEDIT.PARAMENU.CREATE 86897 . 92918) (\TEDIT.PARAMENU.START 92920 . 93786) (\TEDIT.APPLY.PARALOOKS -93788 . 94840) (\TEDIT.SHOW.PARALOOKS 94842 . 97625) (\TEDIT.PARAMENU.FILLIN 97627 . 102376)) (102497 -128273 (\TEDIT.CHARMENU.CREATE 102507 . 105111) (\TEDIT.CHARMENU.START 105113 . 106144) ( -\TEDIT.CHARMENU.SPEC 106146 . 110595) (\TEDIT.CHARMENU.PARSE 110597 . 113765) (\TEDIT.CHARMENU.FILLIN -113767 . 118112) (\TEDIT.SHOW.CHARLOOKS 118114 . 121371) (\TEDIT.APPLY.CHARLOOKS 121373 . 122534) ( -\TEDIT.OFFSETTYPE.STATEFN 122536 . 124499) (\TEDIT.OTHER.STATECHANGEFN 124501 . 126146) ( -\TEDIT.OTHER.SELECTFN 126148 . 128271)) (128335 154774 (\TEDIT.PAGEMENU.CREATE 128345 . 135539) ( -\TEDIT.SHOW.PAGELOOKS 135541 . 137336) (\TEDIT.PAGEMENU.FILLIN 137338 . 138888) ( -\TEDIT.PAGEREGION.UNPARSE 138890 . 148080) (\TEDIT.APPLY.PAGELOOKS 148082 . 150009) ( -\TEDIT.CHANGE.PAGELOOKS 150011 . 153930) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 153932 . 154772)) (154775 -160578 (\TEDIT.PAGEMENU.CREATE.HEADINGS 154785 . 157597) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 157599 - . 159024) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 159026 . 160576))))) + (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))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index 9ef2611bc..b5d582188 100644 Binary files a/library/tedit/TEDIT-MENU.LCOM and b/library/tedit/TEDIT-MENU.LCOM differ diff --git a/library/tedit/TEDIT-RELEASENOTES.PDF b/library/tedit/TEDIT-RELEASENOTES.PDF new file mode 100644 index 000000000..54c0e08cc Binary files /dev/null and b/library/tedit/TEDIT-RELEASENOTES.PDF differ diff --git a/library/tedit/TEDIT-RELEASENOTES.TEDIT b/library/tedit/TEDIT-RELEASENOTES.TEDIT index 0281e2d6d..442d59266 100644 Binary files a/library/tedit/TEDIT-RELEASENOTES.TEDIT and b/library/tedit/TEDIT-RELEASENOTES.TEDIT differ diff --git a/library/tedit/TEDIT-SELECTION b/library/tedit/TEDIT-SELECTION index e328cb620..c7f1e5592 100644 --- a/library/tedit/TEDIT-SELECTION +++ b/library/tedit/TEDIT-SELECTION @@ -1,12 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 6-Mar-2025 11:59:08" {WMEDLEY}TEDIT>TEDIT-SELECTION.;661 153051 +(FILECREATED "19-Mar-2025 16:27:02" {WMEDLEY}tedit>TEDIT-SELECTION.;674 154655 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.CHTOLINEX) + :CHANGES-TO (FNS \TEDIT.SELPIECES.COPY \TEDIT.SELPIECES \TEDIT.RESET.EXTEND.PENDING.DELETE) + (I.S.OPRS inselpieces) - :PREVIOUS-DATE "28-Feb-2025 17:45:33" {WMEDLEY}TEDIT>TEDIT-SELECTION.;660) + :PREVIOUS-DATE "16-Mar-2025 10:06:15" {WMEDLEY}tedit>TEDIT-SELECTION.;665) (PRETTYCOMPRINT TEDIT-SELECTIONCOMS) @@ -442,13 +443,13 @@ (add START-OF-PIECE (PLEN PC]) (\TEDIT.WORD.BOUND - [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 16-Jul-2024 19:52 by rmk") + [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 13-Mar-2025 21:41 by rmk") + (* ; "Edited 16-Jul-2024 19:52 by rmk") (* ; "Edited 27-Sep-2022 23:54 by rmk") - (* ; "Edited 25-Sep-2022 23:48 by rmk") - (* ; "Edited 30-May-91 23:02 by jds") + (* ; "Edited 25-Sep-2022 23:48 by rmk") (if (AND (FIXP PREVCH) (FIXP CH)) - then (LET [(READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) + then (LET [(READSA (fetch READSA of (OR (GETTOBJ TEXTOBJ TXTWTBL) TEDIT.WORDBOUND.READTABLE] (NEQ (\SYNCODE READSA PREVCH) (\SYNCODE READSA CH))) @@ -1203,7 +1204,8 @@ (DEFINEQ (\TEDIT.RESET.EXTEND.PENDING.DELETE - [LAMBDA (TEXTOBJ) (* ; "Edited 26-Nov-2024 23:44 by rmk") + [LAMBDA (TSTREAM) (* ; "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") (* ; "Edited 24-Dec-2023 00:18 by rmk") @@ -1213,9 +1215,14 @@ (* ;; "Reset the 'Extend Pending Delete' status") - (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) - 'NORMAL) - (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL]) + (LET [(TEXTOBJ (CL:IF (type? TEXTOBJ TSTREAM) + TSTREAM + (GETTSTR TSTREAM TEXTOBJ))] + (\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ) + NIL TEXTOBJ) + (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) + 'NORMAL) + (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL]) (\TEDIT.SET.SEL.LOOKS [LAMBDA (SEL OPERATION) (* ; "Edited 28-Feb-2025 17:45 by rmk") @@ -1451,21 +1458,27 @@ (\TEDIT.THELP "ILLEGAL POINT" (GETSEL SEL POINT))))]) (\TEDIT.SEL.L1 - [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 24-Apr-2024 08:34 by rmk") + [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 9-Mar-2025 20:00 by rmk") + (* ; "Edited 24-Apr-2024 08:34 by rmk") (* ; "Edited 8-Apr-2024 23:42 by rmk") (* ; "Edited 16-Nov-2023 23:43 by rmk") (* ;; "Returns L1 for PANE in SEL") + (CL:UNLESS PANE + (SETQ PANE (FGETTOBJ TEXTOBJ SELPANE))) (for L in (GETSEL SEL L1) as P inpanes (PROGN TEXTOBJ) when (EQ P PANE) do (RETURN L]) (\TEDIT.SEL.LN - [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 24-Apr-2024 08:34 by rmk") + [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 9-Mar-2025 20:00 by rmk") + (* ; "Edited 24-Apr-2024 08:34 by rmk") (* ; "Edited 8-Apr-2024 23:41 by rmk") (* ; "Edited 16-Nov-2023 23:43 by rmk") (* ;; "Returns LN for PANE in SEL") + (CL:UNLESS PANE + (SETQ PANE (FGETTOBJ TEXTOBJ SELPANE))) (for L in (GETSEL SEL LN) as P inpanes (PROGN TEXTOBJ) when (EQ P PANE) do (RETURN L]) (\TEDIT.SEL.DELETEDCHARS @@ -1828,7 +1841,8 @@ (DEFINEQ (\TEDIT.SELPIECES - [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 26-Nov-2024 17:49 by rmk") + [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 19-Mar-2025 16:10 by rmk") + (* ; "Edited 26-Nov-2024 17:49 by rmk") (* ; "Edited 22-Nov-2024 14:24 by rmk") (* ; "Edited 7-Jul-2024 09:10 by rmk") (* ; "Edited 29-Apr-2024 13:13 by rmk") @@ -1860,15 +1874,17 @@ (* ;; "") - (* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ. ") + (* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ.") + + (* ;; " Returns NIL on an empty selection rather than the empty SELPIECES (SPLEN 0, NIL for pieces). Somehow SELPIECES.COPY gets screwed up. To be debugged. Meanwhile, callers hopefully test for NIL.") (LET (FIRSTCHAR LEFTPC RIGHTPC) (if (type? SELECTION SEL/FIRSTCHAR) then (if (FGETSEL SEL/FIRSTCHAR SET) then (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#)) - [SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) - FIRSTCHAR - (SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))] + [SETQ LASTCHAR (SUB1 (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) + FIRSTCHAR + (FGETSEL SEL/FIRSTCHAR CHLIM))] else (SETQ FIRSTCHAR 0) (SETQ LASTCHAR -1)) elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR) @@ -1891,7 +1907,9 @@ SPLASTCHAR _ LASTCHAR))]) (\TEDIT.SELPIECES.COPY - [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "Edited 26-Nov-2024 23:31 by rmk") + [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ CHARLOOKS) + (* ; "Edited 19-Mar-2025 16:26 by rmk") + (* ; "Edited 26-Nov-2024 23:31 by rmk") (* ; "Edited 22-Nov-2024 15:38 by rmk") (* ; "Edited 11-Dec-2023 08:16 by rmk") (* ; "Edited 2-Jun-2023 11:21 by rmk") @@ -1905,13 +1923,14 @@ (CL:WHEN SELPIECES (CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ)) - (for PC NPC PREVPC NEWFIRSTPIECE inselpieces SELPIECES + (for PC NPC PREVPC NEWFIRSTPIECE inselpieces (PROGN SELPIECES) do (SETQ NPC (\TEDIT.COPYPIECE PC FROMTEXTOBJ TOTEXTOBJ NIL OPERATION)) (CL:UNLESS NPC (* ; "Was an object-copy disallowed?") (RETURN)) (* ;; "Linke the new pieces together") + (CL:WHEN CHARLOOKS (FSETPC NPC PCHARLOOKS CHARLOOKS)) (if PREVPC then (SETPC PREVPC NEXTPIECE NPC) else (SETQ NEWFIRSTPIECE NPC)) @@ -1948,29 +1967,32 @@ SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2]) (\TEDIT.SELPIECES.CHARTRANSFORM - [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 7-Nov-2024 21:50 by rmk") + [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "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") (* ; "Edited 3-Mar-2024 12:28 by rmk") (* ; "Edited 24-May-2023 13:04 by rmk") - (* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO. The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries. Strings can't hold image objects.") + (* ;; "This transforms the characters in SELPIECES according to CHARFN, skipping image objects unless OBJECTSTOO. The purpose is to allow for character transformations (e.g. case switching) without depending on strings (TEDIT.SELAS.STRING) and character insertion (\INSERTCH) as intermediaries. Image objects would be lost if we had to go through strings.") (* ;;  "This smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.") - [for PC PCONTENTS inselpieces SELPIECES + [for PC PCONTENTS (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)) - do (RPLCHARCODE STR I (APPLY* CHARFN CH TEXTOBJ)))) + do (RPLCHARCODE STR I (APPLY* CHARFN CH (add INDEX 1) + TEXTOBJ)))) (FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC] (* ;; "This assumes that no file piece has a PLEN greater than \MaxArrayLen characters. We rely on the piece-table reader and writer to guarantee this. If not, ALLOCSTRING will cause an error.") [for I from 1 to (PLEN PC) do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE - TEXTOBJ PC I] + TEXTOBJ PC I) + (add INDEX 1] (if (fetch (STRINGP FATSTRINGP) of STR) then (FSETPC PC PTYPE FATSTRING.PTYPE) (FSETPC PC PBYTESPERCHAR 2) @@ -1981,10 +2003,9 @@ (FSETPC PC PCONTENTS STR) (FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC) (PLEN PC]) - (OBJECT.PTYPE (CL:WHEN OBJECTSTOO - (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS TEXTOBJ)))) - (SUBSTREAM.PTYPE - (\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED")) + (OBJECT.PTYPE (add INDEX 1) + (CL:WHEN OBJECTSTOO + (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS INDEX)))) (\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC] SELPIECES]) @@ -2464,25 +2485,25 @@ (ADDTOVAR LAMA TEDIT.SELPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (15578 17399 (\TEDIT.SELECTION.DEFPRINT 15588 . 17397)) (17436 18941 ( -\TEDIT.SET.GLOBAL.SELECTIONS 17446 . 18939)) (18942 24811 (\TEDIT.SELECTED.PIECES 18952 . 20472) ( -\TEDIT.FIND.PROTECTED.END 20474 . 22143) (\TEDIT.FIND.PROTECTED.START 22145 . 24003) ( -\TEDIT.WORD.BOUND 24005 . 24809)) (24945 59144 (\TEDIT.EXTEND.SEL 24955 . 32043) (\TEDIT.SCAN.LINE -32045 . 43823) (\TEDIT.SCAN.LINE.WORD 43825 . 49186) (\TEDIT.XYTOSEL 49188 . 56297) (\TEDIT.REGIONTYPE - 56299 . 57318) (\TEDIT.XYTOSEL.INLINEP 57320 . 57775) (\TEDIT.XYTOSEL.LINE 57777 . 59142)) (59145 -72769 (\TEDIT.FIXSEL 59155 . 68768) (\TEDIT.CHTOLINEX 68770 . 72767)) (72770 76417 ( -\TEDIT.RESET.EXTEND.PENDING.DELETE 72780 . 73753) (\TEDIT.SET.SEL.LOOKS 73755 . 76415)) (76418 94464 ( -\TEDIT.SHOWSEL 76428 . 80888) (\TEDIT.SHOWSEL.HILIGHT 80890 . 85511) (\TEDIT.UPDATE.SEL 85513 . 89012) - (\TEDIT.CARETLINE 89014 . 89728) (\TEDIT.SEL.L1 89730 . 90236) (\TEDIT.SEL.LN 90238 . 90744) ( -\TEDIT.SEL.DELETEDCHARS 90746 . 94462)) (94465 99171 (\TEDIT.COPYSEL 94475 . 96941) ( -\TEDIT.SEL.CHANGED? 96943 . 99169)) (99202 111931 (\TEDIT.SELECT.OBJECT 99212 . 103718) ( -\TEDIT.SHOWSEL.OBJECT 103720 . 105882) (\TEDIT.CLIP.OBJECT 105884 . 107888) (\TEDIT.OPERATE.OBJECT -107890 . 111929)) (111959 130306 (\TEDIT.SELPIECES 111969 . 115917) (\TEDIT.SELPIECES.COPY 115919 . -117957) (\TEDIT.SELPIECES.CONCAT 117959 . 119838) (\TEDIT.SELPIECES.CHARTRANSFORM 119840 . 122798) ( -\TEDIT.SELPIECES.FROM.STRING 122800 . 127941) (\TEDIT.SELPIECES.TO.STRING 127943 . 130304)) (130359 -152882 (TEDIT.XYTOCH 130369 . 132753) (TEDIT.SELPROP 132755 . 136785) (TEDIT.GETPOINT 136787 . 138707) - (TEDIT.GETSEL 138709 . 139443) (TEDIT.GETSEL.PARA 139445 . 140394) (TEDIT.SCANSEL 140396 . 141344) ( -TEDIT.SET.SEL.LOOKS 141346 . 142725) (TEDIT.SETSEL 142727 . 147491) (TEDIT.SHOWSEL 147493 . 148773) ( -TEDIT.SEL.AS.STRING 148775 . 151260) (TEDIT.SEL.AS.SEXPR 151262 . 152548) (TEDIT.SELECTALL 152550 . -152880))))) + (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))))) STOP diff --git a/library/tedit/TEDIT-SELECTION.LCOM b/library/tedit/TEDIT-SELECTION.LCOM index a079ba27c..2fb5bba02 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 5a302a2eb..fa06ee76e 100644 --- a/library/tedit/TEDIT-STREAM +++ b/library/tedit/TEDIT-STREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Feb-2025 13:39:40" {WMEDLEY}tedit>TEDIT-STREAM.;862 175251 +(FILECREATED "22-Mar-2025 21:37:13" {WMEDLEY}TEDIT>TEDIT-STREAM.;863 175354 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN) + :CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS) - :PREVIOUS-DATE "17-Feb-2025 12:25:59" {WMEDLEY}tedit>TEDIT-STREAM.;861) + :PREVIOUS-DATE "19-Feb-2025 13:39:40" {WMEDLEY}TEDIT>TEDIT-STREAM.;862) (PRETTYCOMPRINT TEDIT-STREAMCOMS) @@ -1622,7 +1622,8 @@ WINDOW]) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS - [LAMBDA (TEXTOBJ) (* ; "Edited 8-Feb-2025 22:04 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 22-Mar-2025 21:37 by rmk") + (* ; "Edited 8-Feb-2025 22:04 by rmk") (* ; "Edited 29-Dec-2024 20:37 by rmk") (* ; "Edited 20-Dec-2024 11:56 by rmk") (* ; "Edited 16-Dec-2024 13:14 by rmk") @@ -1644,7 +1645,7 @@ (SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT) (FONTCREATE DEFAULTFONT))) - (SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS)) + (SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'CHARLOOKS)) (SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ)) (AND (type? CHARLOOKS FONT) FONT) @@ -2878,31 +2879,31 @@ (ADDTOVAR LAMA TEXTPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (37136 67737 (\TEDIT.TEXTBIN 37146 . 47896) (\TEDIT.TEXTPEEKBIN 47898 . 53448) ( -\TEDIT.TEXTBACKFILEPTR 53450 . 59123) (\TEDIT.TEXTBOUT 59125 . 63527) (\TEDIT.INSTALL.FILEBUFFER 63529 - . 67735)) (68635 72683 (\TEDIT.TEXTOUTCHARFN 68645 . 70201) (\TEDIT.TEXTINCCODEFN 70203 . 70942) ( -\TEDIT.TEXTBACKCCODEFN 70944 . 71536) (\TEDIT.TEXTFORMATBYTESTREAM 71538 . 72241) ( -\TEDIT.TEXTFORMATBYTESTRING 72243 . 72681)) (72730 84251 (OPENTEXTSTREAM 72740 . 79692) ( -COPYTEXTSTREAM 79694 . 83474) (TEDIT.STREAMCHANGEDP 83476 . 83778) (TXTFILE 83780 . 84249)) (84252 -113999 (\TEDIT.REOPENTEXTSTREAM 84262 . 85614) (\TEDIT.OPENTEXTSTREAM.PIECES 85616 . 90046) ( -\TEDIT.OPENTEXTSTREAM.PROPS 90048 . 91150) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91152 . 96238) ( -\TEDIT.OPENTEXTSTREAM.WINDOW 96240 . 98921) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98923 . 101780) ( -\TEDIT.OPENTEXTFILE 101782 . 103495) (\TEDIT.CREATE.TEXTSTREAM 103497 . 104542) (\TEDIT.REOPEN.STREAM -104544 . 106880) (\TEDIT.TEXTINIT 106882 . 113997)) (114037 115225 (\TEDIT.TTYBOUT 114047 . 115223)) ( -115343 134135 (\TEDIT.TEXTCLOSEF 115353 . 116677) (\TEDIT.TEXTDSPFONT 116679 . 117649) ( -\TEDIT.TEXTEOFP 117651 . 119406) (\TEDIT.TEXTGETEOFPTR 119408 . 119731) (\TEDIT.TEXTSETEOFPTR 119733 - . 120823) (\TEDIT.TEXTGETFILEPTR 120825 . 123660) (\TEDIT.TEXTSETFILEINFO 123662 . 124170) ( -\TEDIT.TEXTOPENF 124172 . 125103) (\TEDIT.TEXTSETEOF 125105 . 125721) (\TEDIT.TEXTSETFILEPTR 125723 . -127764) (\TEDIT.TEXTDSPXPOSITION 127766 . 128783) (\TEDIT.TEXTDSPYPOSITION 128785 . 129526) ( -\TEDIT.TEXTLEFTMARGIN 129528 . 130119) (\TEDIT.TEXTRIGHTMARGIN 130121 . 133284) ( -\TEDIT.TEXTDSPCHARWIDTH 133286 . 133590) (\TEDIT.TEXTDSPSTRINGWIDTH 133592 . 133898) ( -\TEDIT.TEXTDSPLINEFEED 133900 . 134133)) (135182 155919 (\TEDIT.DELETE.SELPIECES 135192 . 138705) ( -\TEDIT.INSERTCH 138707 . 146501) (\TEDIT.INSERTCH.HISTORY 146503 . 149967) (\TEDIT.INSERTEOL 149969 . -151794) (\TEDIT.INSERTCH.INSERTION 151796 . 154633) (\TEDIT.INSERTCH.EXTEND 154635 . 155917)) (155920 -157424 (\TEDIT.NEXTCHANGEABLE.CHNO 155930 . 156645) (\TEDIT.LASTCHANGEABLE.CHNO 156647 . 157422)) ( -157425 159129 (\SETUPGETCH 157435 . 159127)) (159187 163645 (\TEDIT.INSTALL.PIECE 159197 . 163643)) ( -163683 172432 (TEXTPROP 163693 . 164040) (GETTEXTPROP 164042 . 164286) (PUTTEXTPROP 164288 . 164545) ( -GETTEXTPROPS 164547 . 164991) (PUTTEXTPROPS 164993 . 165897) (\TEDIT.TEXTPROP 165899 . 172430)) ( -172433 174503 (\TEDIT.TEXTOBJ.PROPNAMES 172443 . 173395) (\TEDIT.TEXTOBJ.PROPFETCHFN 173397 . 173913) -(\TEDIT.TEXTOBJ.PROPSTOREFN 173915 . 174501))))) + (FILEMAP (NIL (37126 67727 (\TEDIT.TEXTBIN 37136 . 47886) (\TEDIT.TEXTPEEKBIN 47888 . 53438) ( +\TEDIT.TEXTBACKFILEPTR 53440 . 59113) (\TEDIT.TEXTBOUT 59115 . 63517) (\TEDIT.INSTALL.FILEBUFFER 63519 + . 67725)) (68625 72673 (\TEDIT.TEXTOUTCHARFN 68635 . 70191) (\TEDIT.TEXTINCCODEFN 70193 . 70932) ( +\TEDIT.TEXTBACKCCODEFN 70934 . 71526) (\TEDIT.TEXTFORMATBYTESTREAM 71528 . 72231) ( +\TEDIT.TEXTFORMATBYTESTRING 72233 . 72671)) (72720 84241 (OPENTEXTSTREAM 72730 . 79682) ( +COPYTEXTSTREAM 79684 . 83464) (TEDIT.STREAMCHANGEDP 83466 . 83768) (TXTFILE 83770 . 84239)) (84242 +114102 (\TEDIT.REOPENTEXTSTREAM 84252 . 85604) (\TEDIT.OPENTEXTSTREAM.PIECES 85606 . 90036) ( +\TEDIT.OPENTEXTSTREAM.PROPS 90038 . 91140) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 91142 . 96228) ( +\TEDIT.OPENTEXTSTREAM.WINDOW 96230 . 98911) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 98913 . 101883) ( +\TEDIT.OPENTEXTFILE 101885 . 103598) (\TEDIT.CREATE.TEXTSTREAM 103600 . 104645) (\TEDIT.REOPEN.STREAM +104647 . 106983) (\TEDIT.TEXTINIT 106985 . 114100)) (114140 115328 (\TEDIT.TTYBOUT 114150 . 115326)) ( +115446 134238 (\TEDIT.TEXTCLOSEF 115456 . 116780) (\TEDIT.TEXTDSPFONT 116782 . 117752) ( +\TEDIT.TEXTEOFP 117754 . 119509) (\TEDIT.TEXTGETEOFPTR 119511 . 119834) (\TEDIT.TEXTSETEOFPTR 119836 + . 120926) (\TEDIT.TEXTGETFILEPTR 120928 . 123763) (\TEDIT.TEXTSETFILEINFO 123765 . 124273) ( +\TEDIT.TEXTOPENF 124275 . 125206) (\TEDIT.TEXTSETEOF 125208 . 125824) (\TEDIT.TEXTSETFILEPTR 125826 . +127867) (\TEDIT.TEXTDSPXPOSITION 127869 . 128886) (\TEDIT.TEXTDSPYPOSITION 128888 . 129629) ( +\TEDIT.TEXTLEFTMARGIN 129631 . 130222) (\TEDIT.TEXTRIGHTMARGIN 130224 . 133387) ( +\TEDIT.TEXTDSPCHARWIDTH 133389 . 133693) (\TEDIT.TEXTDSPSTRINGWIDTH 133695 . 134001) ( +\TEDIT.TEXTDSPLINEFEED 134003 . 134236)) (135285 156022 (\TEDIT.DELETE.SELPIECES 135295 . 138808) ( +\TEDIT.INSERTCH 138810 . 146604) (\TEDIT.INSERTCH.HISTORY 146606 . 150070) (\TEDIT.INSERTEOL 150072 . +151897) (\TEDIT.INSERTCH.INSERTION 151899 . 154736) (\TEDIT.INSERTCH.EXTEND 154738 . 156020)) (156023 +157527 (\TEDIT.NEXTCHANGEABLE.CHNO 156033 . 156748) (\TEDIT.LASTCHANGEABLE.CHNO 156750 . 157525)) ( +157528 159232 (\SETUPGETCH 157538 . 159230)) (159290 163748 (\TEDIT.INSTALL.PIECE 159300 . 163746)) ( +163786 172535 (TEXTPROP 163796 . 164143) (GETTEXTPROP 164145 . 164389) (PUTTEXTPROP 164391 . 164648) ( +GETTEXTPROPS 164650 . 165094) (PUTTEXTPROPS 165096 . 166000) (\TEDIT.TEXTPROP 166002 . 172533)) ( +172536 174606 (\TEDIT.TEXTOBJ.PROPNAMES 172546 . 173498) (\TEDIT.TEXTOBJ.PROPFETCHFN 173500 . 174016) +(\TEDIT.TEXTOBJ.PROPSTOREFN 174018 . 174604))))) STOP diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM index ca8ded422..02afc7431 100644 Binary files a/library/tedit/TEDIT-STREAM.LCOM and b/library/tedit/TEDIT-STREAM.LCOM differ diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 8837a1d3b..85141f62b 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Feb-2025 23:34:57" {WMEDLEY}tedit>TEDIT-WINDOW.;759 232910 +(FILECREATED "24-Mar-2025 11:30:23" {WMEDLEY}tedit>TEDIT-WINDOW.;786 236503 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.WINDOW.CREATE) + :CHANGES-TO (FNS \TEDIT.WINDOW.GETREGION \TEDIT.UPDATE.TITLE) - :PREVIOUS-DATE "13-Feb-2025 20:49:31" {WMEDLEY}TEDIT>TEDIT-WINDOW.;754) + :PREVIOUS-DATE "18-Mar-2025 21:56:50" {WMEDLEY}tedit>TEDIT-WINDOW.;782) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) @@ -25,8 +25,8 @@ (INITRECORDS TEDITCARET PANEPROPS) (FILES ATTACHEDWINDOW) (FNS TEDIT.DEFER.UPDATES) - (FNS \TEDIT.WINDOW.CREATE \TEDIT.WINDOW.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE - \TEDIT.FILL.PANES) + (FNS \TEDIT.WINDOW.CREATE \TEDIT.WINDOW.GETREGION \TEDIT.WINDOW.SETUP + \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.CLEARPANE \TEDIT.FILL.PANES) (FNS \TEDIT.CURSORMOVEDFN \TEDIT.CURSOROUTFN \TEDIT.ACTIVE.WINDOWP \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.MAINSTREAM \TEDIT.PRIMARYPANE \TEDIT.PANELIST \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN \TEDIT.PANEREGION) @@ -58,7 +58,7 @@ (TEDIT.PROMPTWINDOW.HEIGHT NIL)) (GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT)) (COMS (* ; "Title creation and update") - (FNS \TEXTSTREAM.TITLE \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEXTSTREAM.FILENAME + (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) @@ -85,7 +85,9 @@ Unformatted% Get )) - Include Find Looks Substitute + Include Find Looks Substitute + (Buttons 'Buttons + "Display action buttons") Quit (Expanded% Menu 'Expanded% Menu NIL @@ -355,7 +357,7 @@ (DEFINEQ (\TEDIT.WINDOW.CREATE - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 16-Feb-2025 23:34 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "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,7 +382,7 @@ (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) (PHEIGHT 0) - TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ WIDTH) + TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) (CL:WHEN (WINDOWP WINDOW) (CL:WHEN (SETQ WTEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)) @@ -414,27 +416,12 @@ (SETQ REGION (if (REGIONP WINDOW) then (PROG1 (COPY WINDOW) (SETQ WINDOW NIL)) - else (GRAB-TYPED-REGION REGIONTYPE))) - (CL:UNLESS REGION - (CLRPROMPT) (* ; "System promptwindow") - (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit") - " window region") - (CL:WHEN FILE - (printout PROMPTWINDOW " for " T " " (FULLNAME FILE))) - (TERPRI PROMPTWINDOW) - [SETQ WIDTH (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) - largest (GETPARA PARALOOKS RIGHTMAR) - finally (RETURN (IPLUS \TEDIT.LINEREGION.WIDTH (OR $$EXTREME 32) - 12 - (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) - 0 - \TEDIT.OP.WIDTH)] - (GETMOUSESTATE) - [SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32) - (CREATEREGION LASTMOUSEX LASTMOUSEY WIDTH (PLUS PHEIGHT 200] + elseif (GRAB-TYPED-REGION REGIONTYPE) + else (SETQ REGION (\TEDIT.WINDOW.GETREGION TSTREAM REGIONTYPE PHEIGHT)) (* ;  "We don't want the default to keep shrinking") - (SETQ PREPROMPT (create REGION using REGION))) + (SETQ PREPROMPT (create REGION using REGION)) + REGION)) (add (fetch (REGION HEIGHT) of REGION) (IMINUS PHEIGHT)) (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS)) @@ -442,6 +429,11 @@ (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.") (REGISTER-TYPED-REGION REGION REGIONTYPE WINDOW)) + + (* ;; "") + + (* ;; "We now have the main window") + (WINDOWPROP WINDOW 'TEDITCREATED (OR PREPROMPT T)) (CL:UNLESS [OR PWINDOW (EQ PROMPTPROP 'DON'T) (SETQ PWINDOW (WINDOWP (CAR (WINDOWPROP WINDOW 'PROMPTWINDOW] @@ -464,6 +456,47 @@ (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) +(\TEDIT.WINDOW.GETREGION + [LAMBDA (TSTREAM REGIONTYPE PHEIGHT) (* ; "Edited 24-Mar-2025 11:29 by rmk") + (* ; "Edited 18-Mar-2025 21:52 by rmk") + (* ; "Edited 19-Feb-2025 16:48 by rmk") + (* ; "Edited 18-Feb-2025 10:09 by rmk") + (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + WIDTH HEIGHT) + (CLRPROMPT) (* ; "System promptwindow") + (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit") + " window region") + (CL:WHEN (TXTFILE TSTREAM) + (printout PROMPTWINDOW " for " 2 (GETTEXTPROP TSTREAM 'FILENAME))) + (TERPRI PROMPTWINDOW) + (if (IGREATERP (TEXTLEN TEXTOBJ) + 0) + then [SETQ WIDTH (OR (GETTEXTPROP TEXTOBJ 'OPENWIDTH) + (for PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) + largest (GETPLOOKS PARALOOKS RIGHTMAR) + finally (RETURN (CL:IF (AND $$EXTREME (IGREATERP $$EXTREME 0)) + $$EXTREME + (TIMES 6 PTSPERINCH))] + [SETQ HEIGHT (if (GETTEXTPROP TEXTOBJ 'OPENHEIGHT) + elseif (ZEROP (TEXTLEN TEXTOBJ)) + then 50 + else (for I L (TEXTLEN _ (TEXTLEN TEXTOBJ)) + (CHNO _ 1) from 1 to 20 while (ILEQ CHNO TEXTLEN) + sum (SETQ L (\TEDIT.FORMATLINE TSTREAM CHNO)) + (SETQ CHNO (FGETLD L LCHARLIM)) + (FGETLD L LHEIGHT] + (* ; "36 for right margin selection") + (add WIDTH \TEDIT.LINEREGION.WIDTH 36 (ADD1 (TIMES 2 WBorder) + 1) + (CL:IF (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) + 0 + \TEDIT.OP.WIDTH)) + (add HEIGHT PHEIGHT (ADD1 (TIMES 2 WBorder)) + (FONTPROP WindowTitleDisplayStream 'HEIGHT)) + (GETBOXREGION WIDTH HEIGHT) + else (GETREGION (IMAX 200 (ADD1 (TIMES 2 WBorder))) + (IMAX 100 (ADD1 (TIMES 2 WBorder]) + (\TEDIT.WINDOW.SETUP [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 25-Nov-2024 20:10 by rmk") (* ; "Edited 21-Nov-2024 21:12 by rmk") @@ -971,48 +1004,51 @@ LEFT _ 0)))))]) (\TEDIT.SHRINK.ICONCREATE - [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 15-Mar-2024 18:28 by rmk") + [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 14-Mar-2025 12:35 by rmk") + (* ; "Edited 15-Mar-2024 18:28 by rmk") (* ; "Edited 20-Dec-2023 23:44 by rmk") (* ; "Edited 10-Apr-2023 09:44 by rmk") (* ; "Edited 25-Apr-88 23:53 by jds") (* ;; "Create the icon that represents this window.") - [PROG [(ICON (WINDOWPROP W 'ICON)) - (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE)) - (SHRINKFN (WINDOWPROP W 'SHRINKFN] - (COND - ((NOT (fetch (TEXTWINDOW WTEXTOBJ) of W)) (* ; - "This isn't really a TEdit window any more. Don't do anything") - NIL) - ((TEDITMENUP W) (* ; + [LET ((ICON (WINDOWPROP W 'ICON)) + (ICONTITLE (WINDOWPROP W 'TEDIT.ICON.TITLE)) + (SHRINKFN (WINDOWPROP W 'SHRINKFN)) + (TSTREAM (TEXTSTREAM W T))) + (CL:WHEN TSTREAM + [if (GETTOBJ (GETTSTR TSTREAM TEXTOBJ) + MENUFLG) + then (* ;  "This is a text menu, and shrinks without trace.") - NIL) - ((OR (IGREATERP (FLENGTH SHRINKFN) - 3) - (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN)) - (IGREATERP (FLENGTH SHRINKFN) - 2))) (* ; + NIL + elseif (OR (IGREATERP (FLENGTH SHRINKFN) + 3) + (AND (NOT (FMEMB 'SHRINKATTACHEDWINDOWS SHRINKFN)) + (IGREATERP (FLENGTH SHRINKFN) + 2))) + then (* ;  "There are other functions that expect to handle this. Don't bother.") - NIL) - ((OR [AND ICONTITLE (EQUAL ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W] - (AND (NOT ICONTITLE) - ICON)) - - (* ;; + NIL + else (OR (AND ICONTITLE (STRING.EQUAL ICONTITLE (\TEDIT.FILENAME TSTREAM))) + (AND (NOT ICONTITLE) + ICON)) + then + (* ;;  "we built this and the title is the same, or he has already put an icon on this. Do nothing") - NIL) - (ICON - (* ;; "There's an existing icon window; change the title in it") - - [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM - W] - (ICONTITLE ICONTITLE NIL NIL ICON)) - (T (* ; "install a new icon") - [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W] - (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT - ICON-POSITION T NIL 'FILE] + NIL + else (SETQ ICONTITLE (\TEDIT.FILENAME TSTREAM)) + (WINDOWPROP W 'TEDIT.ICON.TITLE ICONTITLE) + (if ICON + then + (* ;; "There's an existing icon window; change the title in it") + + (ICONTITLE ICONTITLE NIL NIL ICON) + else (* ; "install a new icon") + (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE + TEDIT.ICON.FONT ICON-POSITION T NIL + 'FILE])] (WINDOWPROP W 'ICON]) (\TEDIT.SHRINKFN @@ -2091,18 +2127,19 @@ (DEFINEQ -(\TEXTSTREAM.TITLE - [LAMBDA (STREAM) (* ; "Edited 18-Oct-2023 00:02 by rmk") +(\TEDIT.FILENAME + [LAMBDA (TSTREAM) (* ; "Edited 14-Mar-2025 11:44 by rmk") + (* ; "Edited 18-Oct-2023 00:02 by rmk") (* ; "Edited 24-Aug-2021 23:25 by rmk:") (* ;; "returns a string with which you can talk to the user about this stream. e.g. for Get and Put prompts") - (LET ((TEXTOBJ (TEXTOBJ STREAM)) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) TXTFILE) (SETQ TXTFILE (FGETTOBJ TEXTOBJ TXTFILE)) (OR (CL:TYPECASE TXTFILE (STRINGP TXTFILE) - (STREAM (fetch (STREAM FULLNAME) of TXTFILE)) + (STREAM (FULLNAME TXTFILE)) (LITATOM TXTFILE) (T TXTFILE)) ""]) @@ -2176,8 +2213,9 @@ (WINDOWPROP W 'TITLE TITLE)) TITLE)))]) -(\TEXTSTREAM.FILENAME - [LAMBDA (TEXTSTREAM UNFORMATTED?) (* ; "Edited 18-Jan-2024 09:03 by rmk") +(\TEDIT.LIKELY.FILENAME + [LAMBDA (TSTREAM UNFORMATTED?) (* ; "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") (* ; "Edited 30-May-91 23:34 by jds") @@ -2188,14 +2226,14 @@ (* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed.") - (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) (DEFAULTEXT (CL:IF UNFORMATTED? 'TXT 'TEDIT)) (TXTFILE (GETTOBJ TEXTOBJ TXTFILE)) EXT) (CL:WHEN (type? STREAM TXTFILE) - (SETQ TXTFILE (fetch FULLFILENAME of TXTFILE)) + (SETQ TXTFILE (fetch (STREAM FULLFILENAME) of TXTFILE)) [SETQ EXT (U-CASE (FILENAMEFIELD TXTFILE 'EXTENSION] (if (OR (NULL EXT) (EQ EXT 'BRAVO)) @@ -2206,7 +2244,10 @@ (PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))]) (\TEDIT.UPDATE.TITLE - [LAMBDA (TEXTOBJ FILENAME) (* ; "Edited 13-Dec-2024 08:59 by rmk") + [LAMBDA (TEXTOBJ FILENAME) (* ; "Edited 21-Mar-2025 23:41 by rmk") + (* ; "Edited 15-Mar-2025 00:32 by rmk") + (* ; "Edited 8-Mar-2025 12:00 by rmk") + (* ; "Edited 13-Dec-2024 08:59 by rmk") (* ; "Edited 22-Oct-2024 11:44 by rmk") (* ; "Edited 28-Aug-2024 15:50 by rmk") (* ; "Edited 11-Aug-2024 13:11 by rmk") @@ -2216,20 +2257,27 @@ (* ;; "find and set the title to reflect a new filename, and update the file fields of any attached menu too.") - (LET ((TITLE (\TEXTSTREAM.TITLE TEXTOBJ)) - MENUSTREAM PC STATEFN) + (LET ((TITLE (\TEDIT.FILENAME TEXTOBJ)) + MENUSTREAM SETSTATEFN FIELD FIELDS) (\TEDIT.WINDOW.TITLE TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE (OR FILENAME TITLE))) - (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) + (SETQ MENUSTREAM (TEDIT.MENUSTREAM TEXTOBJ)) (CL:WHEN (AND MENUSTREAM (LITATOM TITLE)) (* ; - "if we have a filename then put it in the GET and PUT fields of the menu") + "if we have a filename then put it in the GETFILE and PUTFILE fields of the menu") (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) - (for BUTTON SETSTATEFN in (MB.GET '(GET PUT) - MENUSTREAM - '(OBJECT STARTPC)) when (SETQ SETSTATEFN - (IMAGEOBJPROP (CAR BUTTON) - 'SETSTATEFN)) - do (APPLY* SETSTATEFN (CADR BUTTON) - FILENAME MENUSTREAM)))]) + [SETQ FIELDS (MB.GET '(GETFILE PUTFILE) + MENUSTREAM + '(OBJECT STARTPC] + (CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'GETFILE)) + (SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD) + 'SETSTATEFN] + (APPLY* SETSTATEFN (CADR FIELD) + FILENAME MENUSTREAM)) + (CL:WHEN [AND (SETQ FIELD (LISTGET FIELDS 'PUTFILE)) + (SETQ SETSTATEFN (IMAGEOBJPROP (CAR FIELD) + 'SETSTATEFN] + (APPLY* SETSTATEFN (CADR FIELD) + FILENAME MENUSTREAM)) + (\TEDIT.FILL.PANES MENUSTREAM))]) ) @@ -2239,7 +2287,9 @@ (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (PANE) (* ; "Edited 29-Nov-2024 13:10 by rmk") + [LAMBDA (PANE) (* ; "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") (* ; "Edited 18-May-2024 16:20 by rmk") (* ; "Edited 12-May-2024 17:19 by rmk") @@ -2256,7 +2306,7 @@ (* ;; "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 (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (TEXTOBJ (AND TSTREAM (GETTSTR TSTREAM TEXTOBJ] (CL:UNLESS TEXTOBJ (* ;  "Return NIL if not an editing window (rather than error?)") (RETURN)) @@ -2271,7 +2321,7 @@ (CLEARW (GETTOBJ 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.") + "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) @@ -2295,13 +2345,14 @@ (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) T) (* ; "Restore any disarmed interrupts.") - (for MENUW in (ATTACHEDWINDOWS PANE) when (TEDITMENUP MENUW) + (for MENUW MTEXTOBJ in (ATTACHEDWINDOWS PANE) when (AND (SETQ MTEXTOBJ (TEXTOBJ MENUW T)) + (FGETTOBJ MTEXTOBJ MENUFLG)) do (* ; "Detach all the TEDITMENU windows.") - (SETTOBJ (TEXTOBJ MENUW) - EDITFINISHEDFLG T) (* ; + (SETTOBJ MTEXTOBJ EDITFINISHEDFLG T) (* ;  "Mark it finished so it closes itself") (WINDOWPROP MENUW 'TEDITMENU NIL) (* ;  "And mark it no longer a menu window") @@ -3472,7 +3523,9 @@ (UPDATE/MENU/IMAGE MENU]) (TEDIT.DEFAULT.MENUFN - [LAMBDA (PANE) (* ; "Edited 12-Feb-2025 16:26 by rmk") + [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") @@ -3535,7 +3588,7 @@ (TEDIT.SUBSTITUTE TEXTOBJ))) (Find (* ;  "Case sensitive search, with * and # wildcards") - (\TEDIT.KEY.FIND TSTREAM TEXTOBJ)) + (\TEDIT.KEY.FIND TSTREAM)) (Looks (* ;  "He wants to set the font for the current selection") (\TEDIT.LOOKS TEXTOBJ)) @@ -3552,13 +3605,13 @@ (\TEDIT.PARAMENU.START TEXTOBJ)) (Page% Layout (* ; "Open the page-layout menu") (\TEDIT.MENU.START (\TEDIT.PAGEMENU.CREATE) - (\TEDIT.PRIMARYPANE TEXTOBJ) - "Page Layout Menu" 150 'PAGE)) + 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 (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])]) + (APPLY* ITEM (TEXTSTREAM PANE)))])]) (TEDIT.REMOVE.MENUITEM [LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06") @@ -3627,11 +3680,12 @@ (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 Quit (Expanded% Menu 'Expanded% Menu NIL - (SUBITEMS Expanded% Menu - Character% Looks - Paragraph% Formatting - Page% Layout]) + 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 @@ -3662,37 +3716,38 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (18423 19319 (TEDIT.DEFER.UPDATES 18433 . 19317)) (19320 43173 (\TEDIT.WINDOW.CREATE -19330 . 26856) (\TEDIT.WINDOW.SETUP 26858 . 30971) (\TEDIT.MINIMAL.WINDOW.SETUP 30973 . 39175) ( -\TEDIT.CLEARPANE 39177 . 39894) (\TEDIT.FILL.PANES 39896 . 43171)) (43174 65888 (\TEDIT.CURSORMOVEDFN -43184 . 48057) (\TEDIT.CURSOROUTFN 48059 . 48504) (\TEDIT.ACTIVE.WINDOWP 48506 . 49557) ( -\TEDIT.EXPANDFN 49559 . 50122) (\TEDIT.MAINW 50124 . 51404) (\TEDIT.MAINSTREAM 51406 . 51673) ( -\TEDIT.PRIMARYPANE 51675 . 52445) (\TEDIT.PANELIST 52447 . 52943) (\TEDIT.NEWREGIONFN 52945 . 55461) ( -\TEDIT.SET.WINDOW.EXTENT 55463 . 60717) (\TEDIT.SHRINK.ICONCREATE 60719 . 63259) (\TEDIT.SHRINKFN -63261 . 63670) (\TEDIT.PANEREGION 63672 . 65886)) (65920 97384 (\TEDIT.BUTTONEVENTFN 65930 . 78492) ( -\TEDIT.BUTTONEVENTFN.DOOPERATION 78494 . 85217) (\TEDIT.BUTTONEVENTFN.GETOPERATION 85219 . 87061) ( -\TEDIT.BUTTONEVENTFN.CURSEL.INIT 87063 . 90300) (\TEDIT.BUTTONEVENTFN.INACTIVE 90302 . 92644) ( -\TEDIT.BUTTONEVENTFN.INTITLE 92646 . 94481) (\TEDIT.COPYINSERTFN 94483 . 95615) (\TEDIT.FOREIGN.COPY -95617 . 97382)) (97385 114494 (\TEDIT.PANE.SPLIT 97395 . 101874) (\TEDIT.SPLITW 101876 . 109335) ( -\TEDIT.UNSPLITW 109337 . 113151) (\TEDIT.LINKPANES 113153 . 113916) (\TEDIT.UNLINKPANE 113918 . 114492 -)) (115851 116742 (TEDITWINDOWP 115861 . 116740)) (116779 119882 (TEDIT.GETINPUT 116789 . 119232) ( -\TEDIT.MAKEFILENAME 119234 . 119880)) (119931 128232 (TEDIT.PROMPTWINDOW 119941 . 120255) ( -TEDIT.PROMPTPRINT 120257 . 122884) (TEDIT.PROMPTCLEAR 122886 . 124605) (TEDIT.PROMPTFLASH 124607 . -126539) (\TEDIT.PROMPT.PAGEFULLFN 126541 . 128230)) (128470 137296 (\TEXTSTREAM.TITLE 128480 . 129170) - (\TEDIT.DEFAULT.TITLE 129172 . 131551) (\TEDIT.WINDOW.TITLE 131553 . 133722) (\TEXTSTREAM.FILENAME -133724 . 135394) (\TEDIT.UPDATE.TITLE 135396 . 137294)) (137339 145542 (TEDIT.DEACTIVATE.WINDOW 137349 - . 143142) (\TEDIT.RESHAPEFN 143144 . 145314) (\TEDIT.REPAINTFN 145316 . 145540)) (145543 187922 ( -\TEDIT.SCROLLFN 145553 . 147798) (\TEDIT.SCROLLCH.TOP 147800 . 149911) (\TEDIT.SCROLLCH.BOTTOM 149913 - . 154243) (\TEDIT.SCROLLUP 154245 . 159862) (\TEDIT.TOPLINE.YTOP 159864 . 161533) (\TEDIT.SCROLLDOWN -161535 . 168465) (\TEDIT.SCROLL.CARET 168467 . 171305) (\TEDIT.VISIBLECARETP 171307 . 173601) ( -\TEDIT.VISIBLECHARP 173603 . 174694) (\TEDIT.BITMAPLINES 174696 . 178616) (\TEDIT.SETPANE.TOPLINE -178618 . 179409) (\TEDIT.SHIFTLINES 179411 . 187920)) (187923 198792 (\TEDIT.ONSCREEN? 187933 . 192484 -) (\TEDIT.ONSCREEN.REGION 192486 . 196137) (\TEDIT.AFTERMOVEFN 196139 . 197036) (OFFSCREENP 197038 . -198790)) (198834 201451 (\TEDIT.PROCIDLEFN 198844 . 200381) (\TEDIT.PROCENTRYFN 200383 . 200828) ( -\TEDIT.PROCEXITFN 200830 . 201449)) (201530 214684 (\TEDIT.DOWNCARET 201540 . 202333) ( -\TEDIT.FLASHCARET 202335 . 204446) (\TEDIT.UPCARET 204448 . 205552) (TEDIT.NORMALIZECARET 205554 . -208772) (\TEDIT.SETCARET 208774 . 214054) (\TEDIT.CARET 214056 . 214682)) (214718 226880 ( -TEDIT.ADD.MENUITEM 214728 . 217019) (TEDIT.DEFAULT.MENUFN 217021 . 224092) (TEDIT.REMOVE.MENUITEM -224094 . 225091) (\TEDIT.CREATEMENU 225093 . 225658) (\TEDIT.MENU.WHENHELDFN 225660 . 226565) ( -\TEDIT.MENU.WHENSELECTEDFN 226567 . 226878))))) + (FILEMAP (NIL (18657 19553 (TEDIT.DEFER.UPDATES 18667 . 19551)) (19554 45257 (\TEDIT.WINDOW.CREATE +19564 . 26176) (\TEDIT.WINDOW.GETREGION 26178 . 28940) (\TEDIT.WINDOW.SETUP 28942 . 33055) ( +\TEDIT.MINIMAL.WINDOW.SETUP 33057 . 41259) (\TEDIT.CLEARPANE 41261 . 41978) (\TEDIT.FILL.PANES 41980 + . 45255)) (45258 68165 (\TEDIT.CURSORMOVEDFN 45268 . 50141) (\TEDIT.CURSOROUTFN 50143 . 50588) ( +\TEDIT.ACTIVE.WINDOWP 50590 . 51641) (\TEDIT.EXPANDFN 51643 . 52206) (\TEDIT.MAINW 52208 . 53488) ( +\TEDIT.MAINSTREAM 53490 . 53757) (\TEDIT.PRIMARYPANE 53759 . 54529) (\TEDIT.PANELIST 54531 . 55027) ( +\TEDIT.NEWREGIONFN 55029 . 57545) (\TEDIT.SET.WINDOW.EXTENT 57547 . 62801) (\TEDIT.SHRINK.ICONCREATE +62803 . 65536) (\TEDIT.SHRINKFN 65538 . 65947) (\TEDIT.PANEREGION 65949 . 68163)) (68197 99661 ( +\TEDIT.BUTTONEVENTFN 68207 . 80769) (\TEDIT.BUTTONEVENTFN.DOOPERATION 80771 . 87494) ( +\TEDIT.BUTTONEVENTFN.GETOPERATION 87496 . 89338) (\TEDIT.BUTTONEVENTFN.CURSEL.INIT 89340 . 92577) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 92579 . 94921) (\TEDIT.BUTTONEVENTFN.INTITLE 94923 . 96758) ( +\TEDIT.COPYINSERTFN 96760 . 97892) (\TEDIT.FOREIGN.COPY 97894 . 99659)) (99662 116771 ( +\TEDIT.PANE.SPLIT 99672 . 104151) (\TEDIT.SPLITW 104153 . 111612) (\TEDIT.UNSPLITW 111614 . 115428) ( +\TEDIT.LINKPANES 115430 . 116193) (\TEDIT.UNLINKPANE 116195 . 116769)) (118128 119019 (TEDITWINDOWP +118138 . 119017)) (119056 122159 (TEDIT.GETINPUT 119066 . 121509) (\TEDIT.MAKEFILENAME 121511 . 122157 +)) (122208 130509 (TEDIT.PROMPTWINDOW 122218 . 122532) (TEDIT.PROMPTPRINT 122534 . 125161) ( +TEDIT.PROMPTCLEAR 125163 . 126882) (TEDIT.PROMPTFLASH 126884 . 128816) (\TEDIT.PROMPT.PAGEFULLFN +128818 . 130507)) (130747 140388 (\TEDIT.FILENAME 130757 . 131529) (\TEDIT.DEFAULT.TITLE 131531 . +133910) (\TEDIT.WINDOW.TITLE 133912 . 136081) (\TEDIT.LIKELY.FILENAME 136083 . 137870) ( +\TEDIT.UPDATE.TITLE 137872 . 140386)) (140431 148959 (TEDIT.DEACTIVATE.WINDOW 140441 . 146559) ( +\TEDIT.RESHAPEFN 146561 . 148731) (\TEDIT.REPAINTFN 148733 . 148957)) (148960 191339 (\TEDIT.SCROLLFN +148970 . 151215) (\TEDIT.SCROLLCH.TOP 151217 . 153328) (\TEDIT.SCROLLCH.BOTTOM 153330 . 157660) ( +\TEDIT.SCROLLUP 157662 . 163279) (\TEDIT.TOPLINE.YTOP 163281 . 164950) (\TEDIT.SCROLLDOWN 164952 . +171882) (\TEDIT.SCROLL.CARET 171884 . 174722) (\TEDIT.VISIBLECARETP 174724 . 177018) ( +\TEDIT.VISIBLECHARP 177020 . 178111) (\TEDIT.BITMAPLINES 178113 . 182033) (\TEDIT.SETPANE.TOPLINE +182035 . 182826) (\TEDIT.SHIFTLINES 182828 . 191337)) (191340 202209 (\TEDIT.ONSCREEN? 191350 . 195901 +) (\TEDIT.ONSCREEN.REGION 195903 . 199554) (\TEDIT.AFTERMOVEFN 199556 . 200453) (OFFSCREENP 200455 . +202207)) (202251 204868 (\TEDIT.PROCIDLEFN 202261 . 203798) (\TEDIT.PROCENTRYFN 203800 . 204245) ( +\TEDIT.PROCEXITFN 204247 . 204866)) (204947 218101 (\TEDIT.DOWNCARET 204957 . 205750) ( +\TEDIT.FLASHCARET 205752 . 207863) (\TEDIT.UPCARET 207865 . 208969) (TEDIT.NORMALIZECARET 208971 . +212189) (\TEDIT.SETCARET 212191 . 217471) (\TEDIT.CARET 217473 . 218099)) (218135 230462 ( +TEDIT.ADD.MENUITEM 218145 . 220436) (TEDIT.DEFAULT.MENUFN 220438 . 227674) (TEDIT.REMOVE.MENUITEM +227676 . 228673) (\TEDIT.CREATEMENU 228675 . 229240) (\TEDIT.MENU.WHENHELDFN 229242 . 230147) ( +\TEDIT.MENU.WHENSELECTEDFN 230149 . 230460))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index d8ee8b71f..e9ef7b8fd 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 f169b97a5..061fa849e 100644 Binary files a/library/tedit/TEDIT.LCOM and b/library/tedit/TEDIT.LCOM differ diff --git a/library/tedit/tedit-exports.all b/library/tedit/tedit-exports.all index d18c4db04..17a6fd3e9 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 "19-Feb-2025 12:22:24"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;207 53931 +(FILECREATED "16-Mar-2025 00:20:08"  +{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;208 53292 :EDIT-BY rmk - :PREVIOUS-DATE "17-Feb-2025 12:26:08" {WMEDLEY}TEDIT>tedit-exports.all;206) + :PREVIOUS-DATE "19-Feb-2025 12:22:24" {WMEDLEY}TEDIT>tedit-exports.all;207) (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION @@ -18,7 +18,7 @@ PRINT)))))))) (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 "16-Feb-2025 11:25:32")) +(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "16-Mar-2025 00:16:31")) (RPAQQ \BTREEWORDSPERSLOT 4) (RPAQQ \BTREEMAXCOUNT 8) (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8)) @@ -118,7 +118,7 @@ $$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 "18-Feb-2025 22:06:22")) +(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 22:39:40")) (RECORD TAB (TABX . TABKIND)) (RECORD TABSPEC (DEFAULTTAB . TABS)) (DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ; @@ -261,7 +261,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX 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 "18-Feb-2025 12:50:32")) +(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 6-Mar-2025 11:42:48")) (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)." @@ -445,25 +445,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 "17-Feb-2025 12:25:59")) -(RPAQQ NONE.TTC 0) -(RPAQQ CHARDELETE.TTC 1) -(RPAQQ WORDDELETE.TTC 2) -(RPAQQ DELETE.TTC 3) -(RPAQQ FUNCTIONCALL.TTC 4) -(RPAQQ REDO.TTC 5) -(RPAQQ UNDO.TTC 6) -(RPAQQ CMD.TTC 7) -(RPAQQ NEXT.TTC 8) -(RPAQQ EXPAND.TTC 9) -(RPAQQ CHARDELETE.FORWARD.TTC 10) -(RPAQQ WORDDELETE.FORWARD.TTC 11) -(RPAQQ PUNCT.TTC 20) -(RPAQQ TEXT.TTC 21) -(RPAQQ WHITESPACE.TTC 22) -(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) ( -REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) ( -WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22)) +(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:39:40")) (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)) @@ -472,21 +454,12 @@ WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22)) I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP) "TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I)))))) )) (T (CONS COMMENTFLG ARGS))))) -(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) (TTDECODE (LOGAND DATUM 31)))) -(RPAQQ NOTBEFORE.LB 1) -(RPAQQ NOTAFTER.LB 2) -(RPAQQ BEFORE.LB 4) -(RPAQQ AFTER.LB 8) -(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16) -(RPAQQ NEWCHAR-IF-SPLIT.LB 32) -(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16) -(NEWCHAR-IF-SPLIT.LB 32)) -(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:49")) +(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 23:21:12")) (PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ ( \BIN STREAM)) BITSPERWORD))) (PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM ( LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255)))) -(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:11:42")) +(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "14-Mar-2025 15:29:22")) (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 (* ; @@ -575,8 +548,8 @@ 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 "19-Feb-2025 12:00:37")) -(PUTPROP (QUOTE TEDIT-STYLES) (QUOTE IMPORTDATE) (IDATE "12-Feb-2025 12:18:37")) +(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "21-Feb-2025 09:49:05")) +(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 means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is @@ -632,8 +605,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 "18-Feb-2025 23:57:08")) -(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "16-Feb-2025 15:02:06")) +(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 00:33:15")) +(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "14-Mar-2025 15:29:51")) (RPAQQ PTSPERPICA 12) (RPAQQ PTSPERINCH 72) (RPAQQ PICASPERINCH 6) @@ -644,10 +617,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 " 8-Feb-2025 23:19:34")) -(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 12:25:36")) -(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "17-Feb-2025 09:12:22")) -(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE " 8-Feb-2025 23:42:18")) +(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 23:41:25")) +(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 00:35:11")) +(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 "16-Mar-2025 00:03:34")) +(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 13:34:37")) (DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* ; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?") THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ; @@ -661,7 +639,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 " 6-Feb-2025 15:42:44")) +(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "15-Mar-2025 22:42:11")) (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." @@ -692,8 +670,8 @@ 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 " 8-Feb-2025 23:42:12")) -(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21")) +(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "23-Feb-2025 10:06:16")) +(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "11-Mar-2025 23:30:40")) (PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "19-Feb-2025 12:18:40")) (DECLARE%: DONTCOPY (FILEMAP (NIL)))