(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED " 4-Feb-2026 16:02:02" {WMEDLEY}TEDIT>TEDIT.;852 146779 :EDIT-BY rmk :CHANGES-TO (FNS TEDIT.MAP.OBJECTS TEDIT.PARAGRAPH.BOUNDARIES) (VARS TEDITCOMS) :PREVIOUS-DATE "31-Jan-2026 11:49:19" {WMEDLEY}TEDIT>TEDIT.;849) (PRETTYCOMPRINT TEDITCOMS) (RPAQQ TEDITCOMS [(FILES (SYSLOAD) 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-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES) (FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT) (DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE (* ;; "This gets EXPORTS.ALL loaded when TEDIT-EXPORTS.ALL is loaded") (EXPORT (FILES (FROM LOADUPS) EXPORTS.ALL))) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) UNICODE))) [DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "Assertions go to comments if not being checked, so we see value-warnings") (EXPORT (COMS (MACROS TEDIT-ASSERT) (MACROS FTEXTOBJ) (GLOBALVARS CHECK-TEDIT-ASSERTIONS) (INITVARS (CHECK-TEDIT-ASSERTIONS T] (INITVARS (TEDIT.TENTATIVE NIL) (TEDIT.DEFAULT.PROPS NIL)) (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) (* ;; "Unslashed functions. Public?") (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 TEDIT.PARAGRAPH.BOUNDARIES) (FNS TEXTOBJ COERCETEXTOBJ) (MACROS TEVAL) (FNS TDRIBBLE) (COMS (* ; "Object-oriented editing") (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) (FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE TEDIT.NTHCHAR) (* ;; "Slashed functions. Private?") (FNS \TEDIT1 \TEDIT.INSERT \TEDIT.MOVE \TEDIT.COPY \TEDIT.REPLACE.SELPIECES \TEDIT.INSERT.SELPIECES \TEDIT.RESTARTFN \TEDIT.CHARDELETE \TEDIT.COPYPIECE \TEDIT.APPLY.OBJFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS \TEDIT.WORDDELETE \TEDIT.WORDDELETE.FORWARD \TEDIT.FINISHEDIT?) (COMS (FNS \TEDIT.THELP) (INITVARS (\TEDIT.THELPFLG NIL))) (FNS \TEDIT.PARAPIECES \TEDIT.PARACHNOS \TEDIT.PARA.FIRST \TEDIT.PARA.LAST) (FNS \TEDIT.WORD.FIRST \TEDIT.WORD.LAST) (FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) [COMS (* ; "TEDIT Support information") (FNS TEDITSYSTEMDATE) (VARS (TEDITSYSTEMDATE (TEDITSYSTEMDATE] (COMS (* ;  "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") (FNS TEDIT.IMAGESOURCEP) (ALISTS (PRINTFILETYPES TEDIT)) (P (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE]) (FILESLOAD (SYSLOAD) 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-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND TEDIT-ABBREV TEDIT-LOOKS TEDIT-STYLES) (DEFINEQ (MAKE-TEDIT-EXPORTS.ALL [LAMBDA NIL (* ; "Edited 29-Aug-2023 21:59 by rmk") (* ; "Edited 11-Sep-2022 23:43 by rmk") (LET (VAL) [CNDIR (PROG1 (DIRECTORYNAME T) (CNDIR (MEDLEYDIR "library>tedit")) (SETQ VAL (GATHEREXPORTS TEDITFILES (MEDLEYDIR "library/tedit" "tedit-exports.all" T))))] VAL]) (UPDATE-TEDIT [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") (* ;;  "Loads compiled TEDITFILES that were compiled on sources different from the currently loaded files.") (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 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") (* ; "Edited 14-Sep-2022 08:37 by rmk") (BKSYSBUF " ") (RESETLST (RESETSAVE LOADDBFLG 'YES) (UPDATE-TEDIT) (FOR F IN TEDITFILES DO (LOADFROM F) (LOADCOMP F))) (%. ANALYZE ON IN TEDITFILES]) ) (DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE (* "FOLLOWING DEFINITIONS EXPORTED") (FILESLOAD (FROM LOADUPS) EXPORTS.ALL) (* "END EXPORTED DEFINITIONS") ) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD TEDIT-EXPORTS.ALL) ) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) UNICODE) ) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND [CHECK-TEDIT-ASSERTIONS `(CL:UNLESS ,(CAR ARGS) [\TEDIT.THELP "TEDIT-ASSERT FAILURE" ,(KWOTE (CAR ARGS])] (T ` (* (TEDIT-ASSERT (\,@ ARGS)))]) ) (DECLARE%: EVAL@COMPILE (PUTPROPS FTEXTOBJ MACRO [(X) (TEXTOBJ! (CL:IF (type? TEXTOBJ X) X (GETTSTR X TEXTOBJ))]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS CHECK-TEDIT-ASSERTIONS) ) (RPAQ? CHECK-TEDIT-ASSERTIONS T) (* "END EXPORTED DEFINITIONS") ) (RPAQ? TEDIT.TENTATIVE NIL) (RPAQ? TEDIT.DEFAULT.PROPS NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) ) (* ;; "Unslashed functions. Public?") (DEFINEQ (TEDIT [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ;; "Edited 25-Jul-2025 20:48 by rmk") (* ;; "Edited 17-Jul-2025 00:24 by rmk") (* ;; "Edited 25-Jun-2024 11:59 by rmk") (* ;; "Edited 9-Mar-2024 22:47 by rmk") (* ;; "Edited 20-Oct-2023 11:02 by rmk") (* ;; "Edited 17-Oct-2023 08:53 by rmk") (* ;; "Edited 22-Jun-2022 20:01 by rmk: Call to OPENSTREAM passes FORMAT from PROPS") (* ;; "Edited 31-Jan-2022 17:19 by rmk: String TEXT is a file name") (* ;; "Edited 24-Dec-2021 19:21 by rmk") (* ;; "Edited 11-Jun-99 14:14 by rmk:") (* ;; "Edited 3-Jun-88 14:27 by jds") (* ;; "User entry to the text editor. Takes an optional window to be used for editing") (SETQ PROPS (APPEND PROPS TEDIT.DEFAULT.PROPS)) (* ;; "DONTSPAWN => Don't try to create a new process for this edit.") (LET (TSTREAM PROC) (* ;  "Make sure the file exists before trying to open the window.") (SETQ TSTREAM (OPENTEXTSTREAM TEXT (OR WINDOW 'Tedit) NIL NIL PROPS)) (SETQ WINDOW (\TEDIT.PRIMARYPANE TSTREAM)) (replace (TEXTOBJ UNDERTEDIT) of (FTEXTOBJ TSTREAM) with T) (if DONTSPAWN then (* ;  "Either no processes running, or specifically not to spawn one.") (\TEDIT1 TSTREAM WINDOW T) else (* ; "Spawn a process to do the edit.") [SETQ PROC (ADD.PROCESS (LIST (FUNCTION \TEDIT1) (KWOTE TSTREAM) WINDOW NIL) 'NAME 'TEdit 'RESTARTABLE 'HARDRESET 'RESTARTFORM (LIST (FUNCTION \TEDIT.RESTARTFN) (KWOTE TSTREAM) WINDOW (KWOTE PROPS] (PROCESSPROP PROC 'WINDOW WINDOW) (CL:UNLESS (LISTGET PROPS 'LEAVETTY) (* ;  "Unless he asked us to leave the tty where it is, TEdit should get it.") (TTY.PROCESS PROC)) PROC]) (TEXTSTREAM [LAMBDA (TSTREAM? NOERROR) (* ; "Edited 25-Apr-2025 18:07 by rmk") (* ; "Edited 29-Apr-2024 12:50 by rmk") (* ; "Edited 20-Mar-2024 08:51 by rmk") (* ; "Edited 24-Mar-2023 18:01 by rmk") (* jds "11-Jul-85 12:06") (* ;; "Convert from any designator of a textstream to that textstream.") (LET (TS WINDOW X) (SETQ TS (if (type? TEXTSTREAM TSTREAM?) then TSTREAM? elseif (type? TEXTOBJ TSTREAM?) then (FGETTOBJ TSTREAM? STREAMHINT) elseif (SETQ WINDOW (if (WINDOWP TSTREAM?) elseif (PROCESSP TSTREAM?) then (PROCESS.WINDOW TSTREAM?) elseif (DISPLAYSTREAMP TSTREAM?) then (WFROMDS TSTREAM?))) then (CL:WHEN (type? TEXTSTREAM (SETQ X (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW))) X) elseif (AND (type? SELECTION TSTREAM?) (FGETSEL TSTREAM? SET)) then (CL:WHEN (type? TEXTOBJ (GETTSTR (SETQ X (FGETSEL TSTREAM? SELTEXTSTREAM)) TEXTOBJ)) X))) (OR TS (CL:UNLESS NOERROR (ERROR TSTREAM? "is not a Tedit document"]) (TEXTSTREAMP [LAMBDA (TSTREAM) (* ; "Edited 20-Mar-2024 07:55 by rmk") (* jds " 3-Apr-84 14:34") (* ;; "Returns the TSTREAM if it is a text stream, else NIL. Use TEXTSTREAM for coercion.") (CL:WHEN (type? TEXTSTREAM TSTREAM) TSTREAM]) (COERCETEXTSTREAM [LAMBDA (TSTREAM TYPE OUTPUTSTREAM) (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 13-Jan-2024 20:01 by rmk") (* ; "Edited 26-Dec-2023 12:29 by rmk") (* ; "Edited 18-Dec-2023 23:13 by rmk") (* ; "Edited 21-Nov-2023 00:08 by rmk") (* ; "Edited 15-Sep-2023 00:08 by rmk") (* ; "Edited 15-Aug-2023 20:20 by rmk") (* ; "Edited 8-May-2023 13:25 by rmk") (* ; "Edited 4-May-2023 12:13 by rmk") (* ; "Edited 11-Jun-99 15:10 by rmk:") (* ; "Edited 18-Apr-93 23:42 by jds") (* ;; "Coerce the contents of the TEXOTBJ to be of the given type. This is for making a string from a textobj, e.g.") (* ;; "RMK: moved the string case up from the piece level to the stream-BIN level") (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (SETQ TSTREAM (TEXTSTREAM TEXTOBJ)) (SELECTQ TYPE ((STRINGP STRING) (\TEDIT.TEXTSETFILEPTR TSTREAM 0) (* ;  "This gets underneath the OPENP test of the generic SETFILEPTR") (* ;; "Allocstring presumably errors if greater than max stringsize.") [for CH# CH (NOBJECTS _ 0) (STR _ (ALLOCSTRING (TEXTLEN TEXTOBJ))) from 1 to (TEXTLEN TEXTOBJ) do (SETQ CH (BIN TSTREAM)) (if (IMAGEOBJP CH) then (add NOBJECTS 1) (* ; "Skip image objects") (add CH# -1) else (RPLCHARCODE STR CH# CH)) finally (RETURN (OR (SUBSTRING STR 1 (IDIFFERENCE CH# (ADD1 NOBJECTS))) (CONCAT ""]) (STREAM (* ;; "It seems that all this does is to ensure that the TXTFILE is open and TSTREAM is set to the beginning") (CL:WHEN (STREAMP (FGETTOBJ TEXTOBJ TXTFILE)) (CL:UNLESS (\GETSTREAM (FGETTOBJ TEXTOBJ TXTFILE))) (OPENSTREAM (FGETTOBJ TEXTOBJ TXTFILE) 'INPUT)) (SETFILEPTR TSTREAM 0) TSTREAM) (FILE (* ; "Throw away looks if no formatting") [SETQ OUTPUTSTREAM (OR (AND OUTPUTSTREAM (OPENP OUTPUTSTREAM 'OUTPUT)) (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW] (\TEDIT.PUT.PCTB TEXTOBJ OUTPUTSTREAM (NOT (\TEDIT.FORMATTEDSTREAMP TEXTOBJ))) OUTPUTSTREAM) (SPLIT (* ;; "Return 2 NODIRCORE files, one with the plain text character, one with formatting info, such that concatenating them will produce a proper Tedit-format file. If TSTREAM is actually a file stream and not a text stream, we could do the split by COPYBYTES. But if a text stream, there could be other kinds of pieces.") (LET [(CHARSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) (FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((LINELENGTH T] (\TEDIT.PUT.PCTB TEXTOBJ CHARSTREAM FORMATSTREAM NIL T) (SETFILEPTR CHARSTREAM 0) (SETFILEPTR FORMATSTREAM 0) (CONS CHARSTREAM FORMATSTREAM))) (SEXPR (TEDIT.SEL.AS.SEXPR TSTREAM)) NIL]) (TEDIT.CONCAT [LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 21-Apr-2025 22:28 by rmk") (* ; "Edited 8-Feb-2025 20:58 by rmk") (* ; "Edited 17-Mar-2024 00:21 by rmk") (* ; "Edited 18-Jan-2024 00:03 by rmk") (* ;; "Produces a textstream that contains the concatenation of all of the TSTREAMS, separated by SEPARATOR. Any stream that is not already a text stream is first converted to a plaintext stream. SEPARATOR if provided as a string or character is inserted between the files.") (CL:WHEN SEPARATOR (CL:UNLESS (CHARCODEP SEPARATOR) (SETQ SEPARATOR (OR (CHARCODE.DECODE SEPARATOR T) (MKSTRING SEPARATOR))))) [SETQ TSTREAMS (for TS inside TSTREAMS collect (OR (TEXTSTREAM TS T) (OPENTEXTSTREAM TS] (LET* ((CSTREAM (OPENTEXTSTREAM)) (CTEXTOBJ (TEXTOBJ CSTREAM)) (TSTEXTOBJECTS (for TS in TSTREAMS collect (FTEXTOBJ TS))) FIRSTTOBJ INITIALFILEPIECES) (CL:WHEN TSTREAMS (SETQ FIRSTTOBJ (CAR TSTEXTOBJECTS)) (* ;; "Take overall parameters from the first stream. ") (FSETTOBJ CTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FIRSTTOBJ DEFAULTCHARLOOKS)) (FSETTOBJ CTEXTOBJ DEFAULTPARALOOKS (FGETTOBJ FIRSTTOBJ DEFAULTPARALOOKS)) (FSETTOBJ CTEXTOBJ TXTRTBL (FGETTOBJ FIRSTTOBJ TXTRTBL)) (FSETTOBJ CTEXTOBJ TXTWTBL (FGETTOBJ FIRSTTOBJ TXTWTBL)) (FSETTOBJ CTEXTOBJ TXTSTYLESHEET (FGETTOBJ FIRSTTOBJ TXTSTYLESHEET)) (for TS PREVPC (LASTTOBJ _ (CAR (LAST TSTEXTOBJECTS))) (FIRSTPC _ (create PIECE)) in TSTREAMS as TSOBJ in TSTEXTOBJECTS first (* ;; "LASTTOBJ to suppress final separator") (SETQ PREVPC FIRSTPC) (* ; "Dummy") do (CL:WHEN (FGETTOBJ TSOBJ FORMATTEDP) (FSETTOBJ CTEXTOBJ FORMATTEDP T)) (for PC NEWPIECE inpieces (\TEDIT.FIRSTPIECE TSOBJ) do (SETQ NEWPIECE (\TEDIT.COPYPIECE PC TS CTEXTOBJ NIL 'COPY)) (FSETPC PREVPC NEXTPIECE NEWPIECE) (FSETPC NEWPIECE PREVPIECE PREVPC) (SETQ PREVPC NEWPIECE)) (* ;; "Information for pageframe adjustments") (push INITIALFILEPIECES (\TEDIT.FIRSTPIECE TSOBJ)) (CL:WHEN SEPARATOR (CL:UNLESS (EQ TSOBJ LASTTOBJ) (SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE PREVPC SEPARATOR)))) finally (\TEDIT.INSERTPIECES (NEXTPIECE FIRSTPC) NIL CTEXTOBJ) (\TEDIT.CONCAT.PAGEFRAMES CTEXTOBJ TSTEXTOBJECTS (DREVERSE INITIALFILEPIECES)) (\TEDIT.UNIQUIFY.ALL CTEXTOBJ))) CSTREAM]) (TEDITSTRING [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) (* ;;; "Edited 20-Feb-2025 08:50 by rmk") (* ;;; "Edited 31-Mar-2024 10:13 by rmk: If TEXT is NIL, don't coerce it to %"NIL%"") (* ;;; "Edited 31-Mar-2024 10:12 by rmk") (* ;;; "Edited 9-May-2023 21:55 by rmk") (* ;;; "Edited 23-May-2022 15:52 by rmk") (* ;;; "Edited 19-May-2022 22:46 by rmk: An interface function to replace calls to TEDIT when the text argument may be the string to be edited rather than the name of a file. This enables the transition that gets TEDIT aligned with the convention that strings, as well as litatoms, are file names.") (CL:WHEN TEXT (SETQ TEXT (MKSTRING TEXT))) (TEDIT (LET ((TSTR (OPENTEXTSTREAM NIL NIL PROPS))) (TEDIT.INSERT TSTR TEXT 1 NIL T) (TEDIT.SETSEL TSTR 1 0 'LEFT) TSTR) WINDOW DONTSPAWN PROPS]) (TEDIT-SEE [LAMBDA (FILE WINDOW FORMAT TITLE) (* ;; "Edited 27-Oct-2025 21:25 by rmk") (* ;;  "Edited 13-Sep-2023 09:04 by rmk: Old code replaced to take advantage of new standard interfaces.") (* ;; "Edited 14-Jul-2023 00:02 by rmk") (* ;; "Edited 13-Sep-2022 09:21 by rmk: Changed the default format here to the current Medley default. This shouldn't be special.") (* ;; "Edited 27-Feb-2021 20:07 by rmk:") (* ;; "Edited 1-Feb-88 19:00 by bvm:") (TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT TITLE ,TITLE FORMAT ,FORMAT]) (TEDIT.COPY [LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk") (* ; "Edited 7-Jul-2024 16:09 by rmk") (* ; "Edited 2-Jul-2024 10:40 by rmk") (* ; "Edited 18-May-2024 16:21 by rmk") (* ; "Edited 12-May-2024 20:54 by rmk") (* ; "Edited 22-Apr-2024 23:55 by rmk") (* ; "Edited 29-Apr-2024 12:54 by rmk") (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 20-Feb-2024 17:03 by rmk") (* ; "Edited 1-Feb-2024 20:37 by rmk") (* ; "Edited 20-May-2023 18:47 by rmk") (* ; "Edited 15-May-2023 22:11 by rmk") (* ; "Edited 4-Jun-92 11:11 by jds") (* ;; "Copy the FROM-selected pieces into the destination object and position as indicated by the TO selection. FROM and TO are external selections, with SELTEXTSTREAMS.") (* ;;  "This results in a single history event, either :Insert or :Replace depending on bluependingdelete.") (LET ((FROMSTREAM (TEXTSTREAM FROM)) (TOSTREAM (TEXTSTREAM TO))) (CL:UNLESS (type? SELECTION FROM) (SETQ FROM (TEXTSEL (GETTSTR FROMSTREAM TEXTOBJ)))) (CL:UNLESS (type? SELECTION TO) (SETQ TO (TEXTSEL (GETTSTR TOSTREAM TEXTOBJ)))) (CL:UNLESS (EQ TO FROM) (\TEDIT.COPY FROM TO FROMSTREAM TOSTREAM]) (TEDIT.DELETE [LAMBDA (TSTREAM SEL LEN LEAVECARETLOOKS) (* ; "Edited 6-Apr-2025 12:31 by rmk") (* ; "Edited 22-Jun-2024 00:06 by rmk") (* ; "Edited 22-May-2024 09:44 by rmk") (* ; "Edited 23-May-2023 12:57 by rmk") (* ; "Edited 22-May-2023 10:54 by rmk") (* ; "Edited 10-Nov-2022 22:48 by rmk") (* ; "Edited 12-Jun-90 17:49 by mitani") (* ;; "Delete the specified characters from TSTREAM.") (* ;; "If LEAVECARETLOOKS is non-NIL, the selection will NOT be set up to do the right thing with type-in. This can save time in inner loops.") (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (if (FIXP SEL) then (TEDIT.SETSEL TSTREAM SEL LEN NIL NIL LEAVECARETLOOKS) (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) elseif (NULL SEL) then (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) (SELECTION! SEL) (\TEDIT.DELETE TSTREAM SEL]) (TEDIT.INSERT [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 13-Nov-2025 20:58 by rmk") (* ; "Edited 4-Apr-2025 11:22 by rmk") (* ; "Edited 2-Aug-2024 22:17 by rmk") (* ; "Edited 31-Jul-2024 12:13 by rmk") (* ; "Edited 23-Jul-2024 16:35 by rmk") (* ; "Edited 7-Jul-2024 12:33 by rmk") (* ; "Edited 22-Jun-2024 00:02 by rmk") (* ; "Edited 20-Jun-2024 09:08 by rmk") (* ; "Edited 22-May-2024 14:00 by rmk") (* ; "Edited 22-Dec-2023 22:05 by rmk") (* ; "Edited 12-Nov-2023 12:30 by rmk") (* ; "Edited 15-Oct-2023 14:57 by rmk") (* ; "Edited 31-May-2023 23:25 by rmk") (* ; "Edited 27-May-2023 10:47 by rmk") (* ; "Edited 9-Nov-2022 10:36 by rmk") (* ; "Edited 29-May-91 18:21 by jds") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (if (IMAGEOBJP TEXT) then (TEDIT.INSERT.OBJECT TEXT TSTREAM CH#ORSEL LOOKS) else (CL:WHEN (ATOM TEXT) (SETQ TEXT (MKSTRING TEXT))) (CL:WHEN (AND (STRINGP TEXT) (NEQ 0 (NCHARS TEXT))) (* ;; "Nothing to do for an empty string") (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) (if (FIXP CH#ORSEL) then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT) (* ; "He gave us a ch# to insert before") (SETQ CH#ORSEL (TEXTSEL TEXTOBJ)) elseif (NOT CH#ORSEL) then (SETQ CH#ORSEL (TEXTSEL TEXTOBJ))) (SELECTION! CH#ORSEL) (if (FGETSEL CH#ORSEL SET) then (CL:WHEN LOOKS (TEDIT.CARETLOOKS TSTREAM LOOKS)) (\TEDIT.INSERT TEXT CH#ORSEL TSTREAM DONTSCROLL) else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T)))) ]) (TEDIT.TERPRI [LAMBDA (TSTREAM CH#ORSEL DONTSCROLL) (* ; "Edited 12-Aug-2024 20:04 by rmk") (* ;; "Inserts an EOL at CH#ORSEL, and then marks that as the end of a paragraph. Unlike BOUT, doesn't replace the character currently at that position, inserts in front. \TEDIT.INSERT will also clear out any bluependingdelete, and manage the display update.") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) (if (FIXP CH#ORSEL) then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT) (* ; "He gave us a ch# to insert before") (SETQ CH#ORSEL (TEXTSEL TEXTOBJ)) elseif (NOT CH#ORSEL) then (SETQ CH#ORSEL (TEXTSEL TEXTOBJ))) (SELECTION! CH#ORSEL) (if (FGETSEL CH#ORSEL SET) then (\TEDIT.INSERT [CONSTANT (CONCATCODES (CONS (CHARCODE EOL] CH#ORSEL TSTREAM DONTSCROLL) else (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T]) (TEDIT.KILL [LAMBDA (TSTREAM) (* ; "Edited 7-May-2025 00:08 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 12-May-2024 11:55 by rmk") (* ; "Edited 20-Sep-2023 17:55 by rmk") (* ; "Edited 12-Jun-90 17:49 by mitani") (* ;; "Force the edit session supported by TSTREAM to terminate") (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) TEDW TEDPROC) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T) (CL:WHEN (AND (SETQ TEDW (\TEDIT.PRIMARYPANE TEXTOBJ)) [PROCESSP (SETQ TEDPROC (WINDOWPROP TEDW 'PROCESS] (NEQ TEDPROC (THIS.PROCESS))) (DEL.PROCESS TEDPROC]) (TEDIT.QUIT [LAMBDA (TSTREAM VALUE) (* ; "Edited 12-Feb-2025 16:26 by rmk") (* ; "Edited 9-Feb-2025 21:22 by rmk") (* ; "Edited 7-Feb-2025 23:45 by rmk") (* ; "Edited 29-Jun-2024 09:12 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 20-Sep-2023 17:55 by rmk") (* ; "Edited 10-Apr-2023 10:19 by rmk") (* ; "Edited 12-Jun-90 17:49 by mitani") (* ;; "Force the edit session supported by TSTREAM to terminate, and to return VALUE") (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) (PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))) (* ;; "Make sure the process has the TTY, then tell the command loop to finish.") (CL:WHEN (AND PRIMPANE (WINDOWPROP PRIMPANE 'PROCESS)) (TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS))) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG (OR VALUE T]) (TEDIT.MOVE [LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk") (* ; "Edited 2-Jul-2024 14:11 by rmk") (* ;; "Public entry for moving FROM-selected text in its document to the TO-selected position in its document. FROM and TO may eventually be user-level selections that need to be converted here to internal SELECTION data structures.") (LET ((FROMSTREAM (TEXTSTREAM FROM)) (TOSTREAM (TEXTSTREAM TO))) (CL:UNLESS (type? SELECTION FROM) (SETQ FROM (TEXTSEL (GETTSTR FROMSTREAM TEXTOBJ)))) (CL:UNLESS (type? SELECTION TO) (SETQ TO (TEXTSEL (GETTSTR TOSTREAM TEXTOBJ)))) (CL:UNLESS (EQ TO FROM) (\TEDIT.MOVE FROM TO FROMSTREAM TOSTREAM]) (TEDIT.STRINGWIDTH [LAMBDA (STR FONT TERMSA) (* jds "19-AUG-83 14:40") (COND (TERMSA (* We have a terminal table to take account of.  Do so.) (for CH instring STR sum (TEDIT.CHARWIDTH CH FONT TERMSA))) (T (* Just use the native character  widths) (for CH instring STR sum (SELCHARQ CH (TAB 36) (CHARWIDTH CH FONT]) (TEDIT.CHARWIDTH [LAMBDA (CH FONT TERMSA) (* ; "Edited 21-Oct-2024 00:33 by rmk") (* jds "22-OCT-83 19:32") (* Returns the width of CH in FONT printed according to any special printing  instructions in CHARTABLE TERMSA) (COND (TERMSA (* There IS a TERMTABLE to account for) (SELECTC (fetch CCECHO of (\SYNCODE TERMSA CH)) (INDICATE.CCE (IPLUS (COND ((IGREATERP CH 127)(* META character) (SETQ CH (LOGAND CH 127)) (CHARWIDTH (CHARCODE %#) FONT)) (T 0)) (COND ((ILESSP CH 32) (* CONTROL character) (SETQ CH (LOGOR CH 64)) (CHARWIDTH (CHARCODE ^) FONT)) (T 0)) (CHARWIDTH CH FONT))) (SIMULATE.CCE (SELCHARQ CH ((EOL CR LF) (IMAX 6 (CHARWIDTH CH FONT))) (ESCAPE (CHARWIDTH (CHARCODE $) FONT)) (BELL 0) (TAB 36) (CHARWIDTH CH FONT))) (REAL.CCE (CHARWIDTH CH FONT)) (IGNORE.CCE 0) (\TEDIT.THELP))) (T (* The usual case is to treat every  character as a graphic.) (SELCHARQ CH (CR (IMAX 6 (CHARWIDTH CH FONT))) (TAB 36) (CHARWIDTH CH FONT]) (TEDIT.PARAGRAPH.BOUNDARIES [LAMBDA (TSTREAM SELORCH# PROTECTEDNOTOK) (* ; "Edited 2-Feb-2026 23:05 by rmk") (* ;; "Returns a pair (FIRSTCH# LASTCH#) where FIRSTCH# is the character number of the first character of the paragraph that contains the beginning of the selection, and LASTCH# is the last character number of the last character of the paragraph that contains the end of the selection.") (* ;;  "If PROTECTIONNOTOK, the scans stop at any protected piece (e.g. doesn't cross menu boiler plate).") (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (CL:UNLESS SELORCH# (SETQ SELORCH# (TEXTSEL TEXTOBJ))) (LIST (CAR (\TEDIT.PARA.FIRST TEXTOBJ (CL:IF (type? SELECTION SELORCH#) (GETSEL SELORCH# CH#) SELORCH#) PROTECTEDNOTOK)) (CAR (\TEDIT.PARA.LAST TEXTOBJ (CL:IF (type? SELECTION SELORCH#) (GETSEL SELORCH# CHLAST) SELORCH#) PROTECTEDNOTOK]) ) (DEFINEQ (TEXTOBJ [LAMBDA (TEXTOBJ? NOERROR) (* ; "Edited 20-Mar-2024 07:36 by rmk") (* ; "Edited 12-Jun-90 17:50 by mitani") (if (type? TEXTOBJ TEXTOBJ?) then TEXTOBJ? else (LET ((TSTRM (TEXTSTREAM TEXTOBJ? NOERROR))) (CL:WHEN TSTRM (fetch (TEXTSTREAM TEXTOBJ) of TSTRM))]) (COERCETEXTOBJ [LAMBDA (TSTREAM TYPE OUTPUTSTREAM) (* ; "Edited 20-Mar-2024 08:02 by rmk") (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 13-Jan-2024 20:01 by rmk") (* ; "Edited 26-Dec-2023 12:29 by rmk") (* ; "Edited 18-Dec-2023 23:13 by rmk") (* ; "Edited 21-Nov-2023 00:08 by rmk") (* ; "Edited 15-Sep-2023 00:08 by rmk") (* ; "Edited 15-Aug-2023 20:20 by rmk") (* ; "Edited 8-May-2023 13:25 by rmk") (* ; "Edited 4-May-2023 12:13 by rmk") (* ; "Edited 11-Jun-99 15:10 by rmk:") (* ; "Edited 18-Apr-93 23:42 by jds") (* ;; "Documented entry, to be deprecated in favor of COERCEDTEXTSTREAM.") (COERCETEXTSTREAM TSTREAM TYPE OUTPUTSTREAM]) ) (DECLARE%: EVAL@COMPILE (PUTPROPS TEVAL MACRO [(FORM WINDOW TIT DONTDEFER) (* ; "Capture FORM's T output in Tedit") (LET* [(TSTREAM (TEXTSTREAM (TEDIT NIL (OR WINDOW 'TeditEval) NIL `(LEAVETTY T HISTORY OFF PARABREAKCHARS NIL APPEND QUIET TITLE ,(OR TIT "Tedit EVAL") ,(PACK* "F" "ORM") 'FORM FONT DEFAULTFONT] (RESETLST (RESETSAVE (TTYDISPLAYSTREAM TSTREAM)) [RESETSAVE (DSPFONT DEFAULTFONT T) '(PROGN (DSPFONT OLDVALUE T] (BKSYSBUF " ") (* ; "Suppress pagehold") (CL:UNLESS DONTDEFER (TEDIT.DEFER.UPDATES TSTREAM)) (CL:UNLESS TIT (PRINTDEF 'FORM NIL T NIL NIL T) (TERPRI T)) (PROG1 FORM (TERPRI T)))]) ) (DEFINEQ (TDRIBBLE [LAMBDA NIL (* ; "Edited 31-Mar-2025 12:03 by rmk") (* ; "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 FONT DEFAULTFONT] [WHENCLOSE TSTREAM 'BEFORE (FUNCTION (LAMBDA (TSTREAM) [TEDIT TSTREAM 'Dribble NIL `(TITLE ,(CONCAT "Tedit Dribble " (DATE)) LEAVETTY T APPEND QUIET PARABREAKCHARS NIL HISTORY OFF OPENWIDTH ,(fetch (REGION WIDTH) of (WINDOWPROP (WFROMDS T) 'REGION)) OPENHEIGHT ,(fetch (REGION HEIGHT) of (WINDOWPROP (WFROMDS T) 'REGION] (TEDIT.SETSEL TSTREAM 1 0] (DRIBBLE TSTREAM]) ) (* ; "Object-oriented editing") (DEFINEQ (TEDIT.INSERT.OBJECT [LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 6-Sep-2025 08:54 by rmk") (* ; "Edited 28-Jul-2025 23:48 by rmk") (* ; "Edited 7-May-2025 00:10 by rmk") (* ; "Edited 21-Apr-2025 22:17 by rmk") (* ; "Edited 6-Apr-2025 14:10 by rmk") (* ; "Edited 25-Feb-2025 11:18 by rmk") (* ; "Edited 26-Dec-2024 10:13 by rmk") (* ; "Edited 19-May-2023 00:18 by rmk") (* ; "Edited 21-Apr-93 00:52 by jds") (* ;; "Inserts the Image-object OBJECT into text STREAM in front of character CH#.") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) SEL OBJPC OBJSELPIECES SUBSTREAM) (* ;; "We construct and copy a trivial SELPIECES so that we can share the basic insertion code.") (CL:UNLESS CH# (SETQ CH# (TEXTSEL TEXTOBJ))) (CL:WHEN (type? SELECTION CH#) (SETQ CH# (TEDIT.GETPOINT TSTREAM CH#))) (CL:WHEN (\TEDIT.READONLY TSTREAM NIL CH#) (RETURN)) (SETQ OBJPC (create PIECE PTYPE _ OBJECT.PTYPE PCONTENTS _ OBJECT PLEN _ 1 PCHARLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS))) (* ; "The new piece we're inserting") (CL:WHEN (SETQ SUBSTREAM (IMAGEOBJPROP OBJECT 'SUBSTREAM)) (* ;  "If this is computed text in bulk, fix the length.") (\TEDIT.THELP "SUBSTREAM NOT IMPLEMENTED") (FSETPC OBJPC PTYPE SUBSTREAM.PTYPE) (FSETPC OBJPC PLEN (TEXTLEN (FTEXTOBJ SUBSTREAM)))) (SETQ OBJSELPIECES (\TEDIT.SELPIECES.COPY (create SELPIECES SPLEN _ 1 SPFIRST _ OBJPC SPLAST _ OBJPC SPFIRSTCHAR _ CH# SPLASTCHAR _ CH#) 'INSERT TSTREAM)) (CL:UNLESS OBJSELPIECES (* ; "Copy may not be allowed") (RETURN)) (* ;; "") (* ;;  " OBJSELPIECES contains (a copy of) the object piece, and the object approved of insertion.") (SETQ SEL (TEXTSEL TEXTOBJ)) (\TEDIT.SEL.OFF TSTREAM) (CL:WHEN (type? SELECTION CH#) (SETQ CH# (GETSEL CH# CH#))) (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) (\TEDIT.DELETE TSTREAM SEL)) (CL:WHEN CH# (\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ))) 0 'LEFT) (\TEDIT.FIXSEL SEL TSTREAM)) (\TEDIT.INSERT.SELPIECES OBJSELPIECES TSTREAM SEL) (CL:WHEN LOOKS (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS SEL)) (\TEDIT.SCROLL.CARET TSTREAM) (\TEDIT.SEL.ON TSTREAM]) (TEDIT.EDIT.OBJECT [LAMBDA (TSTREAM OBJ) (* ; "Edited 7-May-2025 00:09 by rmk") (* ; "Edited 6-Apr-2025 23:14 by rmk") (* ; "Edited 3-Oct-2024 22:08 by rmk") (* ; "Edited 10-May-2024 22:42 by rmk") (* ; "Edited 15-Mar-2024 14:23 by rmk") (* ; "Edited 2-Dec-2023 09:57 by rmk") (* ; "Edited 19-May-2023 21:35 by rmk") (* ; "Edited 27-Apr-2023 00:14 by rmk") (* ; "Edited 21-Oct-2022 18:37 by rmk") (* ; "Edited 29-May-91 18:23 by jds") (* ;; "If OBJ, makes it be the selection and SELOBJ. Then edits SELOBJ") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) CH# EDITFN) (if (IMAGEOBJP OBJ) then (SETQ CH# (TEDIT.FIND.OBJECT TSTREAM OBJ)) (if CH# then (\TEDIT.SEL.OFF TSTREAM) (\TEDIT.UPDATE.SEL TSTREAM CH# 1) (\TEDIT.FIXSEL NIL TSTREAM) (SETSEL (TEXTSEL TEXTOBJ) SELOBJ OBJ) (TEDIT.NORMALIZECARET TSTREAM) else (TEDIT.PROMPTPRINT TSTREAM "Can't find the specified object" T T) (RETURN)) elseif OBJ then (TEDIT.PROMPTPRINT TSTREAM (CONCAT OBJ " is not an image object") T T) (RETURN) elseif (SETQ OBJ (GETSEL (TEXTSEL TEXTOBJ) SELOBJ)) else (TEDIT.PROMPTPRINT TSTREAM "Please select an editable object" T T) (RETURN)) (if (SETQ EDITFN (IMAGEOBJPROP OBJ 'EDITFN)) then (* ;  "OK There's an object selected. Edit it.") (CL:UNLESS (AND EDITFN (APPLY* EDITFN OBJ)) (* ;  "If the editfn makes a change, update the screen.") (TEDIT.OBJECT.CHANGED TSTREAM OBJ)) else (TEDIT.PROMPTPRINT TSTREAM (CONCAT OBJ " does not have an edit function" T]) (TEDIT.OBJECT.CHANGED [LAMBDA (TSTREAM OBJECT PIECE/CH#/SEL) (* ; "Edited 7-May-2025 00:10 by rmk") (* ; "Edited 21-Apr-2025 20:16 by rmk") (* ; "Edited 20-Apr-2025 13:24 by rmk") (* ; "Edited 26-Nov-2024 03:52 by rmk") (* ; "Edited 20-Oct-2024 12:08 by rmk") (* ; "Edited 19-Oct-2024 10:03 by rmk") (* ; "Edited 3-Oct-2024 22:58 by rmk") (* ; "Edited 16-Aug-2024 10:11 by rmk") (* ; "Edited 18-May-2024 17:13 by rmk") (* ; "Edited 10-May-2024 22:42 by rmk") (* ; "Edited 7-May-2024 08:18 by rmk") (* ; "Edited 17-Mar-2024 00:25 by rmk") (* ; "Edited 21-Oct-2023 08:59 by rmk") (* ; "Edited 18-Apr-2023 23:57 by rmk") (* ; "Edited 10-Apr-2023 00:02 by rmk") (* ; "Edited 9-Sep-2022 09:32 by rmk") (* ; "Edited 6-Aug-2022 09:37 by rmk") (* ; "Edited 12-Jun-90 17:51 by mitani") (* ;; "Notifies TEdit that an object has changed, and the display may need to be updated. Caller may provide the CH# or PIECE containing the object, otherwise we scan. ") (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) CH#) (SETQ CH# (if (FIXP PIECE/CH#/SEL) elseif (type? PIECE PIECE/CH#/SEL) then (CL:WHEN (EQ OBJECT (POBJ PIECE/CH#/SEL)) (\TEDIT.PCTOCH PIECE/CH#/SEL TEXTOBJ)) elseif (AND (type? SELECTION PIECE/CH#/SEL) (EQ OBJECT (FGETSEL PIECE/CH#/SEL SELOBJ))) then (FGETSEL PIECE/CH#/SEL CH#) else (TEDIT.FIND.OBJECT TSTREAM OBJECT 1))) (if CH# then (* ; "Change affected lines") (\TEDIT.UPDATE.LINES TSTREAM 'CHANGED CH# 1) (\TEDIT.SEL.ON TSTREAM) (* ; "And mark the document dirty.") (FSETTOBJ TEXTOBJ \DIRTY T) else (TEDIT.PROMPTPRINT TSTREAM "Changed object not found in document" T]) (TEDIT.MAP.OBJECTS [LAMBDA (TSTREAM FN FNARG COLLECT?) (* ; "Edited 4-Feb-2026 16:01 by rmk") (* ; "Edited 25-Feb-2025 15:06 by rmk") (* ; "Edited 23-Apr-2024 09:15 by rmk") (* ; "Edited 16-Mar-2024 10:03 by rmk") (* ; "Edited 4-Mar-2024 16:12 by rmk") (* ; "Edited 6-Nov-2022 12:15 by rmk") (* ;; "Apply FN to each of the imageobjects in TSTREAM. If COLLECT? value is the list of (CH# OBJ FNVAL) pairs that satisfy the predicate") (* ;; "FN is a function of 3 args ( CH#-of-OBJ OBJ FNARG). FN defaults to TRUE") (CL:UNLESS FN (SETQ FN (FUNCTION TRUE))) (for CH# OBJ FNVAL from 1 by (PLEN PC) as PC inpieces (\TEDIT.FIRSTPIECE (TEXTOBJ TSTREAM)) when (AND (EQ OBJECT.PTYPE (PTYPE PC)) (type? IMAGEOBJ (SETQ OBJ (PCONTENTS PC))) (SETQ FNVAL (APPLY* FN CH# OBJ FNARG))) do (SELECTQ COLLECT? (NIL) (OBJECT (PUSH $$VAL OBJ)) (CH# (PUSH $$VAL CH#)) (VALUE (PUSH $$VAL FNVAL)) (FIRST (RETURN (LIST CH# OBJ FNVAL))) (PUSH $$VAL (LIST CH# OBJ FNVAL))) (CL:WHEN (EQ FNVAL 'STOP) (GO $$OUT)) finally (RETURN (DREVERSE $$VAL]) (\TEDIT.FIRST.OBJPIECE [LAMBDA (TEXTOBJ) (* ; "Edited 24-Jul-2024 08:47 by rmk") (find PC in (\TEDIT.FIRSTPIECE TEXTOBJ) suchthat (EQ OBJECT.PTYPE (PTYPE PC]) (\TEDIT.NEXT.OBJPIECE [LAMBDA (TEXTOBJ PC) (* ; "Edited 24-Jul-2024 08:47 by rmk") (find old PC inpieces (NEXTPIECE PC) suchthat (EQ OBJECT.PTYPE (PTYPE PC]) ) (FILESLOAD IMAGEOBJ) (DEFINEQ (\TEDIT.CONCAT.PAGEFRAMES [LAMBDA (CTEXTOBJ TSTEXTOBJECTS INITIALFILEPIECES) (* ; "Edited 19-Feb-2025 13:30 by rmk") (* ; "Edited 8-Feb-2025 22:27 by rmk") (* ; "Edited 17-Mar-2024 13:20 by rmk") (* ; "Edited 16-Mar-2024 10:03 by rmk") (* ; "Edited 18-Jan-2024 22:16 by rmk") (* ;; "The individual files may have their own heading paragraphs specified in their pieces and in their pageframes. Since the heading types are global for the file, we have to make sure the any conflicting heading-type names are made distinct within the combined toplevel pageframe, and that any new names are propagated into the PARALOOKS of the pieces within each file.") (* ;;  "Scan all the first/left/right heading frames, grouping all of the heading types by their regions.") (LET (FIRSTREGIONS LEFTREGIONS RIGHTREGIONS FIRSTNEW LEFTNEW RIGHTNEW CPAGEFRAME) (* ;; "Index first, even, odd types by region. Keep the lists separate for the final step of building the concat pageframes.") (* ;; "If the same region is appears in both left and right headings, presumably the type-names will be different--and we maintain that difference as we canonicalize. ") (for TSOBJ FRAMES in TSTEXTOBJECTS do (SETQ FRAMES (GETTOBJ TSOBJ TXTPAGEFRAMES)) (SETQ FIRSTREGIONS (\TEDIT.GET.PAGE.HEADINGS (CAR FRAMES) FIRSTREGIONS)) (SETQ LEFTREGIONS (\TEDIT.GET.PAGE.HEADINGS (CADR FRAMES) LEFTREGIONS)) (SETQ RIGHTREGIONS (\TEDIT.GET.PAGE.HEADINGS (CADDR FRAMES) RIGHTREGIONS))) (* ;; "Invert these to map all encountered types with a given region into a canonical type with that region. ") [for R in FIRSTREGIONS as I from 1 do (for TYPE in (CDR R) do (push FIRSTNEW (LIST TYPE (PACK* 'HeadingF I) (CAR R] [for R in LEFTREGIONS as I from 1 do (for TYPE in (CDR R) do (push LEFTNEW (LIST TYPE (PACK* 'HeadingL I) (CAR R] [for R in RIGHTREGIONS as I from 1 do (for TYPE in (CDR R) do (push RIGHTNEW (LIST TYPE (PACK* 'HeadingR I) (CAR R] (* ;; "Replace the type in each heading piece to its canonical type. Presumably the input typenames were sorted by first/left/right, so a given name only appears in one of the list. So we can append.") [for PC PPARALOOKS (ALLNEW _ (APPEND FIRSTNEW LEFTNEW RIGHTNEW)) inpieces (\TEDIT.FIRSTPIECE CTEXTOBJ) eachtime (SETQ PPARALOOKS (PPARALOOKS PC)) when (EQ 'PAGEHEADING (GETPLOOKS PPARALOOKS FMTPARATYPE)) do (FSETPC PC PPARALOOKS (create PARALOOKS using PPARALOOKS FMTPARASUBTYPE _ (CADR (ASSOC (FGETPLOOKS PPARALOOKS FMTPARASUBTYPE) ALLNEW] (* ;; "Finally, build the pageframes for the new types and their regions. We take the page frame of the first TSOBJ as the base pattern") [SETQ CPAGEFRAME (\TEDIT.PARSE.PAGEFRAMES (\TEDIT.UNPARSE.PAGEFRAMES (FGETTOBJ (CAR TSTEXTOBJECTS ) TXTPAGEFRAMES] (\TEDIT.CONCAT.INSTALL.HEADINGS (CAR CPAGEFRAME) FIRSTNEW) (\TEDIT.CONCAT.INSTALL.HEADINGS (CADR CPAGEFRAME) LEFTNEW) (\TEDIT.CONCAT.INSTALL.HEADINGS (CADDR CPAGEFRAME) RIGHTNEW) (FSETTOBJ CTEXTOBJ TXTPAGEFRAMES CPAGEFRAME]) (\TEDIT.GET.PAGE.HEADINGS [LAMBDA (PAGEREGION HEADLIST) (* ; "Edited 18-Jan-2024 21:36 by rmk") (* ;; "Produces an ALIST that maps each different heading region to a list of heading types that have that region. All of those heading types can be reduced to a single type.") (CL:WHEN (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION)) [for PH in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) when [AND (EQ 'HEADING (fetch (PAGEREGION REGIONFILLMETHOD) of PH)) (EQ 'HEADINGTYPE (CAR (fetch (PAGEREGION REGIONLOCALINFO) of PH] do (pushnew [CDR (OR (SASSOC (fetch (PAGEREGION REGIONSPEC) of PH) HEADLIST) (CAR (PUSH HEADLIST (CONS (fetch (PAGEREGION REGIONSPEC) of PH] (CADR (fetch (PAGEREGION REGIONLOCALINFO) of PH] HEADLIST)]) (\TEDIT.CONCAT.INSTALL.HEADINGS [LAMBDA (PAGEREGION NEWTYPES) (* ; "Edited 18-Jan-2024 22:02 by rmk") (* ;;  "Smash headings representing NEWTYPES into PAGEREGION, removing any headings previously there.") (CL:WHEN (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION)) (* ;; "Replace all the old headings with the new ones, keeping all other subboxes") (* ;; "NEWTYPES is the list that maps old types to new types. We first reduce it to just a new-type region list.") [change (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) (NCONC (for SPF in DATUM unless (EQ 'HEADING (fetch (PAGEREGION REGIONFILLMETHOD) of SPF)) collect SPF) (for R in (for NT in NEWTYPES unless (ASSOC (CADR NT) $$VAL) collect (CDR NT)) collect (create PAGEREGION REGIONFILLMETHOD _ 'HEADING REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR R)) REGIONSPEC _ (CADR R])]) ) (DEFINEQ (\TEDIT.MOVE.MSG [LAMBDA (FROMOBJ TOOBJ COPYFLG) (* ; "Edited 7-Jul-2024 16:36 by rmk") (* ; "Edited 22-May-2024 14:06 by rmk") (* ; "Edited 3-May-2024 00:04 by rmk") (* ; "Edited 29-Apr-2024 12:52 by rmk") (* ; "Edited 1-Feb-2024 23:33 by rmk") (* ; "Edited 22-May-2023 09:35 by rmk") (* ; "Edited 20-May-2023 18:53 by rmk") (* ; "Edited 15-May-2023 22:11 by rmk") (* ; "Edited 4-Jun-92 11:11 by jds") (* ;; "Check whether it is possible to insert the FROM-selected pieces into the TO-selection. Value is NON-NIL if the operation can't be performed.") (LET ((TYPE (CL:IF COPYFLG "copy" "move"))) (if (AND FROMOBJ TOOBJ) then (if (EQ FROMOBJ TOOBJ) then (\TEDIT.READONLY TOOBJ NIL (FGETSEL (FGETTOBJ TOOBJ SEL) CH#)) elseif (\TEDIT.READONLY TOOBJ "Destination") else (AND (NOT COPYFLG) (\TEDIT.READONLY FROMOBJ "Source"))) else (if FROMOBJ then (TEDIT.PROMPTPRINT TOOBJ (CONCAT "Please select a destination for the " TYPE ) T T) else (TEDIT.PROMPTPRINT FROMOBJ (CONCAT "Please select a source for the " TYPE) T T)) T]) (\TEDIT.READONLY [LAMBDA (TSTREAM TYPE CHNO) (* ; "Edited 20-Apr-2025 23:12 by rmk") (* ; "Edited 4-Jul-2024 13:40 by rmk") (* ; "Edited 25-May-2024 10:01 by rmk") (* ; "Edited 22-May-2024 13:00 by rmk") (* ; "Edited 1-Feb-2024 17:33 by rmk") (* ; "Edited 13-Nov-2023 11:26 by rmk") (LET ((TEXTOBJ (FTEXTOBJ TSTREAM))) (if (FGETTOBJ TEXTOBJ TXTREADONLY) then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") " is read only--aborted") T T)) 'READONLY elseif [AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY) (OR (NULL CHNO) (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN] then (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") " is append only--aborted") T T)) 'APPENDONLY]) ) (DEFINEQ (TEDIT.NCHARS [LAMBDA (TSTREAM) (* ; "Edited 1-Feb-2024 09:11 by rmk") (* ; "Edited 7-Nov-2023 09:42 by rmk") (CL:IF (type? SELECTION TSTREAM) (FGETSEL TSTREAM DCH) (FGETTOBJ (TEXTOBJ TSTREAM) TEXTLEN))]) (TEDIT.RPLCHARCODE [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "Edited 24-Apr-2025 17:26 by rmk") (* ; "Edited 28-Mar-2025 09:58 by rmk") (* ; "Edited 9-Feb-2025 12:21 by rmk") (* ; "Edited 7-Feb-2025 08:02 by rmk") (* ; "Edited 23-Sep-2024 00:36 by rmk") (* ; "Edited 27-Aug-2024 14:49 by rmk") (* ; "Edited 31-Jul-2024 12:08 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 22-May-2024 14:10 by rmk") (* ; "Edited 10-May-2024 13:23 by rmk") (* ; "Edited 8-May-2024 23:09 by rmk") (* ; "Edited 5-May-2024 20:33 by rmk") (* ; "Edited 25-Apr-2024 00:13 by rmk") (* ; "Edited 17-Mar-2024 00:24 by rmk") (* ; "Edited 29-Dec-2023 11:50 by rmk") (* ; "Edited 7-Dec-2023 16:01 by rmk") (* ; "Edited 1-Dec-2023 21:52 by rmk") (* ; "Edited 9-Nov-2023 15:53 by rmk") (* ; "Edited 4-Nov-2023 15:23 by rmk") (* ;; "This is a user entry. Replaces the Nth charcode (or object) in TSTREAM with NEWCHARCODE (or object) with NEWCHARLOOKS. ") (* ;; "If DONTDISPLAY, this doesn't update the display. ") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (LET ((TEXTLEN (TEDIT.NCHARS TSTREAM))) (CL:WHEN (ILESSP N 0) (add N (ADD1 TEXTLEN))) (CL:UNLESS (AND (IGEQ N 1) (ILEQ N TEXTLEN)) (\ILLEGAL.ARG N)) (CL:UNLESS (OR (CHARCODEP NEWCHARCODE) (IMAGEOBJP NEWCHARCODE)) (\ILLEGAL.ARG NEWCHARCODE)) (CL:WHEN [AND NEWCHARLOOKS (NOT (OR (FONTP NEWCHARLOOKS) (type? CHARLOOKS NEWCHARLOOKS] (\ILLEGAL.ARG NEWCHARLOOKS)) (\TEDIT.RPLCHARCODE TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY]) (TEDIT.NTHCHARCODE [LAMBDA (TSTREAM N) (* ; "Edited 8-Sep-2025 22:09 by rmk") (* ; "Edited 28-Mar-2025 14:10 by rmk") (* ; "Edited 7-Jul-2024 11:09 by rmk") (* ; "Edited 29-Apr-2024 13:06 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 1-Feb-2024 09:50 by rmk") (* ; "Edited 8-Nov-2023 08:41 by rmk") (* ; "Edited 4-Nov-2023 15:23 by rmk") (* ;; "Returns the Nth character-code of TSTREAM, possibly an object. First character is N=1, NIL if out of bounds. If TSTREAM is a selection, treats it as a substring, N is relative to that.") (* ;; "This is a user-entry. If TSTREAM is a selection with a SELTEXTSTREAM, it is an external selection not held by the stream. No calls with internal selections should come through here.") [if (type? SELECTION TSTREAM) then (CL:UNLESS (EQ N 0) [add N (CL:IF (ILESSP N 0) (FGETSEL TSTREAM CHLIM) (SUB1 (FGETSEL TSTREAM CH#)))] (CL:WHEN (OR (ILESSP N (FGETSEL TSTREAM CH#)) (IGEQ N (FGETSEL TSTREAM CHLIM))) (* ;; "Out of the selection: force NIL") (SETQ N 0))) (SETQ TSTREAM (TEXTSTREAM TSTREAM)) else (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (CL:WHEN (ILESSP N 0) (SETQ N (IPLUS (TEDIT.NCHARS TSTREAM) N 1)))] (\TEDIT.NTHCHARCODE TSTREAM N]) (TEDIT.NTHCHAR [LAMBDA (TSTREAM N) (* ; "Edited 28-Mar-2025 09:48 by rmk") (* ; "Edited 22-Oct-2024 21:28 by rmk") (* ; "Either a code or an object") (LET ((CODE (TEDIT.NTHCHARCODE TSTREAM N))) (CL:IF (FIXP CODE) (CHARACTER CODE) CODE)]) ) (* ;; "Slashed functions. Private?") (DEFINEQ (\TEDIT1 [LAMBDA (TSTREAM WINDOW UNSPAWNED) (* ; "Edited 24-Apr-2024 10:38 by rmk") (* ; "Edited 17-Mar-2024 12:51 by rmk") (* ; "Edited 22-Sep-2023 20:23 by rmk") (* ; "Edited 13-Sep-2023 22:37 by rmk") (* ; "Edited 12-Jun-90 17:51 by mitani") (* ;; "Does the actual editing work, once TEDIT has OPENTEXTSTREAMed the thing to be edited.") (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) (\TEDIT.COMMAND.LOOP TSTREAM) (* ; "Run the editing engine") (CLOSEW WINDOW) (* ; "Close the edit window") (\TEDIT.TEXTCLOSEF TSTREAM) (* ; "Close the underlying files") (replace (STREAM ACCESSBITS) of TSTREAM with BothBits) (* ;  "But leave the stream itself accessible") (CL:WHEN (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) (* ;  "Apply any post-window-close (and post-QUIT) function") (APPLY* (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) WINDOW TSTREAM)) (CL:WHEN UNSPAWNED (* ;  "We're not a distinct process: Send back the edited text in some suitable form") (COND ((NEQ T (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)) (PROG1 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG NIL))) ((STRINGP (FGETTOBJ TEXTOBJ TXTFILE)) (COERCETEXTOBJ TEXTOBJ 'STRINGP)) (T TSTREAM)))]) (\TEDIT.INSERT [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "Edited 13-Nov-2025 20:57 by rmk") (* ; "Edited 7-May-2025 00:11 by rmk") (* ; "Edited 21-Apr-2025 20:16 by rmk") (* ; "Edited 20-Apr-2025 13:26 by rmk") (* ; "Edited 6-Apr-2025 14:12 by rmk") (* ; "Edited 5-Jan-2025 23:01 by rmk") (* ; "Edited 28-Nov-2024 09:53 by rmk") (* ; "Edited 25-Nov-2024 22:05 by rmk") (* ; "Edited 18-Nov-2024 15:53 by rmk") (* ; "Edited 15-Nov-2024 18:05 by rmk") (* ; "Edited 10-Nov-2024 23:38 by rmk") (* ; "Edited 30-Oct-2024 14:49 by rmk") (* ; "Edited 18-Oct-2024 22:07 by rmk") (* ; "Edited 27-Aug-2024 14:31 by rmk") (* ; "Edited 30-Jul-2024 23:55 by rmk") (* ; "Edited 21-Jun-2024 23:09 by rmk") (* ; "Edited 6-May-2024 13:47 by rmk") (* ; "Edited 21-Apr-2024 20:24 by rmk") (* ; "Edited 9-Mar-2024 11:36 by rmk") (* ; "Edited 14-Jan-2024 12:14 by rmk") (* ; "Edited 20-Dec-2023 15:27 by rmk") (* ; "Edited 18-Sep-2023 12:48 by rmk") (* ; "Edited 24-May-2023 14:23 by rmk") (* ; "Edited 29-May-91 18:22 by jds") (* ;; "The selection runs from CH# to CHLIM-1. The insertion is before the selection if POINT=LEFT or after the selection (POINT=RIGHT). This translates to before CH# or before CHLIM respectively. ") (* ;; "Inserts INSERT at the location picked out by the selection, and then implements all the consequences for line and screen updates. Assumes that the caller got the selection and the text set up properly.") (* ;; "") (* ;; "Text can be a string or a single charcode (only on the call from \TEDIT.COMMAND.LOOP). ") (CL:WHEN [AND (GETSEL SEL SET) (OR (CHARCODEP INSERT) (NEQ 0 (NCHARS INSERT] [PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (PARACHARS (FGETTOBJ TEXTOBJ PARABREAKCHARS)) NCHARSADDED CARETCHNO) (* ;; "FORM is not included in the EOL characters. It breaks a line, but the first line after it doesn't necessarily have first-line margins. CR/LF maybe should have been converted by plaintext reader or \TEXTBOUT.") (CL:WHEN (\TEDIT.READONLY TEXTOBJ NIL CARETCHNO) (RETURN NIL)) (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) (* ; "Blue pending delete?") (\TEDIT.DELETE TSTREAM SEL)) (SETQ CARETCHNO (TEDIT.GETPOINT TEXTOBJ SEL)) (if (CHARCODEP INSERT) then (* ;; "Meta,EOL causes a line break but not a paragraph break, in terms of formatting. Original code converted to a formatted file on the first appearance of Meta,EOL, not clear why and so removed.") (\TEDIT.INSERTCH INSERT CARETCHNO TEXTOBJ (FMEMB INSERT PARACHARS)) (SETQ NCHARSADDED 1) elseif (AND PARACHARS (thereis CH instring INSERT suchthat (FMEMB CH PARACHARS))) then (* ;; "It's maybe worth a scan here to see if we can insert the string. This avoids the heavier per-character complexity of \INSERTCH.") (for CH instring INSERT as NCH# from CARETCHNO do (\TEDIT.INSERTCH CH NCH# TEXTOBJ (MEMB CH PARACHARS))) (SETQ NCHARSADDED (NCHARS INSERT)) else (\TEDIT.INSERTCH INSERT CARETCHNO TEXTOBJ) (SETQ NCHARSADDED (NCHARS INSERT))) (FSETTOBJ TEXTOBJ \DIRTY T) (* ;; "") (* ;; "The piece table is now correct: NCHARSADDED new characters have been been added in front of CARETCHNO. ") (\TEDIT.SEL.OFF TSTREAM) (* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.") (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED)) 0 'RIGHT 'NORMAL) (CL:UNLESS DONTSCROLL (* ;; "All the panes must be updated. SELPANE mayalso need to be scrolled to make the caret visible for the next input.") (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION CARETCHNO NCHARSADDED) (CL:WHEN (EQ SEL (TEXTSEL TEXTOBJ)) (\TEDIT.SEL.ON TSTREAM)) (CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])]) (\TEDIT.MOVE [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk") (* ; "Edited 10-Jan-2026 01:38 by rmk") (* ; "Edited 7-May-2025 00:12 by rmk") (* ; "Edited 22-Apr-2025 09:21 by rmk") (* ; "Edited 16-Apr-2025 09:01 by rmk") (* ; "Edited 6-Apr-2025 14:14 by rmk") (* ; "Edited 5-Apr-2025 13:18 by rmk") (* ; "Edited 6-Feb-2025 16:17 by rmk") (* ; "Edited 8-Dec-2024 21:37 by rmk") (* ; "Edited 26-Nov-2024 22:34 by rmk") (* ; "Edited 22-Nov-2024 15:42 by rmk") (* ; "Edited 22-Sep-2024 18:43 by rmk") (* ; "Edited 13-Sep-2024 22:31 by rmk") (* ; "Edited 27-Aug-2024 14:27 by rmk") (* ; "Edited 7-Jul-2024 16:38 by rmk") (* ; "Edited 3-Jul-2024 10:11 by rmk") (* ; "Edited 18-May-2024 16:24 by rmk") (* ; "Edited 29-Apr-2024 12:53 by rmk") (* ; "Edited 22-Apr-2024 23:55 by rmk") (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 12-Oct-2023 22:23 by rmk") (* ; "Edited 24-Sep-2023 21:43 by rmk") (* ; "Edited 21-Jun-2023 15:58 by rmk") (* ; "Edited 29-May-91 18:21 by jds") (SELECTION! FROMSEL) (SELECTION! TOSEL) (* ;; "Extracts the FROM-selected text from its document and inserts it at the TO-selected position in its document. TOSEL is the SEL of , FROM should be a scratch selection.") (* ;; " from FROM and inserts them Insert the pieces at FROM into the location described by TO, possibly first deleting a TO-pending-delete and also removing the FROM pieces. ") (* ;; "This results in a single history event if FROM and TO are in the same TEXTOBJ--undo will restore it.") (* ;; "If they are in separate texts, then the modifcations to TO go into TO's history (pending delete and insert), the deletion of FROM is an event in its object. In that case it will require undos in both objects to get them both back to the original state.") (CL:UNLESS (EQ 0 (GETSEL FROMSEL DCH)) [PROG* ((FROMOBJ (FTEXTOBJ FROMTSTREAM)) (TOOBJ (FTEXTOBJ TOTSTREAM)) (TOCH# (FGETSEL TOSEL CH#)) (TODCH (FGETSEL TOSEL DCH)) (TOPOINT (FGETSEL TOSEL POINT)) TODELEVENT FROMPIECES BPD) (CL:WHEN (\TEDIT.MOVE.MSG FROMOBJ TOOBJ NIL) (RETURN NIL)) (* ;; "TOSEL is the SEL of TOOBJ. Its hilighting is taken down, the insertion happens at that position (maybe after a bluepending deletion. At the end the inserted material is hilighted with caret on the right.") (* ;; "FROMSEL is a selection maybe in a different document. Either way, its temporary hilighting is taken down and the selection is deleted.") (* ;; "If FROM is in a different document, the Venue sysout leaves that documents SEL as it was before (i.e. not at the position of the deletion). Maybe it should be moved (and scrolled) to a point selection at the deletion site?") (* ;; "") (* ;; "We'd like to check all the image objects for allowance before we make any changes, but we don't know whether the imageobject WHENxxx functions have side effects even if they decline. So we check only once, when we do the BPD operation or grab the from pieces. Since we are testing for MOVE, presumably the insert and delete are both OK.") (* ;; " ") (* ;; " Get rid of the BPD") (CL:WHEN (AND (FGETTOBJ TOOBJ BLUEPENDINGDELETE) (IGREATERP TODCH 0)) (FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL) (CL:UNLESS (\TEDIT.DELETE TOTSTREAM TOSEL) (RETURN NIL)) (SETQ BPD T) (CL:WHEN (EQ TOOBJ FROMOBJ) (* ; "Same text, pre-adjust the source") (\TEDIT.SEL.DELETEDCHARS FROMSEL TOCH# TODCH))) (* ;; "") (* ;; "BPD is gone, TOSEL and FROMSEL have been adjusted") (* ;; "Grab (a copy of) the source pieces, if image objects allow copying. FROMPIECES is essentially a clipboard for extract/insert--the FROMOBJ has not yet been changed.") (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROMSEL NIL FROMOBJ) 'MOVE TOTSTREAM FROMTSTREAM)) (CL:UNLESS FROMPIECES (* ;; "If bailing, should we undo the BPDEVENT (if history is ON)?") (RETURN)) (\TEDIT.SEL.OFF FROMTSTREAM) (\TEDIT.SEL.OFF TOTSTREAM) (* ;; "No need to recheck allowance") (if (EQ TOOBJ FROMOBJ) then (* ;;  "Can't call \TEDIT.DELETE because we don't want to implicitly update the TOSEL for the insert.") (\TEDIT.DELETE.SELPIECES FROMTSTREAM FROMSEL NIL T) (\TEDIT.SEL.DELETEDCHARS TOSEL FROMSEL) (\TEDIT.UPDATE.LINES FROMTSTREAM 'DELETION (FGETSEL FROMSEL CH#) (FGETSEL FROMSEL DCH)) (* ;; "Pop to accumulate into a single event (BPD, DELETE, INSERT).") else (\TEDIT.DELETE FROMTSTREAM FROMSEL NIL NIL T)) (* ;; "Deletion accomplished possibly in separate FROMOBJ with its own history.") (* ;; "") (CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF) (\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T) (CL:WHEN BPD (* ; "If no BPD, TO history is good") (\TEDIT.HISTORYADD.COMPOSITE TOOBJ TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ) (\TEDIT.POPEVENT TOOBJ)))) (RETURN)) (\TEDIT.INSERT.SELPIECES FROMPIECES TOTSTREAM TOSEL) (\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL) (\TEDIT.SEL.ON TOTSTREAM) (* ;; "") (* ;; "TO history in order has INS, DEL if TO=FROM, and possibly BPD. (DEL) (BPD), put them all in a composite event. ") (\TEDIT.HISTORYADD.COMPOSITE TOOBJ (LIST (\TEDIT.POPEVENT TOOBJ) (CL:IF (EQ TOOBJ FROMOBJ) (\TEDIT.POPEVENT TOOBJ)) (CL:IF BPD (\TEDIT.POPEVENT TOOBJ])]) (\TEDIT.COPY [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "Edited 31-Jan-2026 11:48 by rmk") (* ; "Edited 7-May-2025 00:12 by rmk") (* ; "Edited 22-Apr-2025 09:12 by rmk") (* ; "Edited 6-Apr-2025 14:16 by rmk") (* ; "Edited 5-Apr-2025 13:19 by rmk") (* ; "Edited 18-Mar-2025 23:13 by rmk") (* ; "Edited 23-Nov-2024 22:45 by rmk") (* ; "Edited 22-Nov-2024 15:44 by rmk") (* ; "Edited 13-Sep-2024 22:28 by rmk") (* ; "Edited 27-Aug-2024 13:37 by rmk") (* ; "Edited 24-Aug-2024 00:17 by rmk") (* ; "Edited 7-Jul-2024 22:04 by rmk") (* ; "Edited 2-Jul-2024 10:40 by rmk") (* ; "Edited 18-May-2024 16:21 by rmk") (* ; "Edited 12-May-2024 20:54 by rmk") (* ; "Edited 22-Apr-2024 23:55 by rmk") (* ; "Edited 29-Apr-2024 12:54 by rmk") (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 20-Feb-2024 17:03 by rmk") (* ; "Edited 1-Feb-2024 20:37 by rmk") (* ; "Edited 20-May-2023 18:47 by rmk") (* ; "Edited 15-May-2023 22:11 by rmk") (* ; "Edited 4-Jun-92 11:11 by jds") (* ;; "Copy the FROM-selected pieces into the destination object and position as indicated by the TO selection. These may be internal or external, but either way the strams are passed separately.") (* ;;  "This results in a single history event, either :Insert or :Replace depending on bluependingdelete.") (CL:UNLESS (ZEROP (GETSEL FROMSEL DCH)) (PROG* ((FROMOBJ (GETTSTR FROMTSTREAM TEXTOBJ)) (TOOBJ (GETTSTR TOTSTREAM TEXTOBJ)) FROMPIECES) (CL:WHEN (\TEDIT.MOVE.MSG FROMOBJ TOOBJ T) (RETURN)) (* ;; "Grab (a copy of) the source pieces, if image object allows") (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROMSEL NIL FROMOBJ) 'COPY TOTSTREAM FROMTSTREAM)) (CL:UNLESS FROMPIECES (RETURN)) (* ;; "No object objected") (\TEDIT.SEL.OFF FROMTSTREAM) (* ; "Turn off any current highlighting") (\TEDIT.SEL.OFF TOTSTREAM) (* ;; "") (CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF) (\TEDIT.FOREIGN.COPY FROMSEL FROMTSTREAM T) (RETURN)) (* ;; "") (* ;;  "Install FROM pieces at TO, either replacing or inserting depending on its BLUEPENDINGDELETE") (if (FGETTOBJ TOOBJ BLUEPENDINGDELETE) then (FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL) (\TEDIT.REPLACE.SELPIECES FROMPIECES TOTSTREAM TOSEL) else (\TEDIT.INSERT.SELPIECES FROMPIECES TOTSTREAM TOSEL)) (* ;; "") (\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL) (* ;; "") (\TEDIT.SEL.OFF TOTSTREAM) (* ;  "Take down anything that might thave appeared") (\TEDIT.SEL.ON TOTSTREAM) (\TEDIT.SCROLL.CARET TOTSTREAM)))]) (\TEDIT.REPLACE.SELPIECES [LAMBDA (INSERTSELPIECES TSTREAM SEL) (* ; "Edited 6-Sep-2025 09:54 by rmk") (* ; "Edited 7-May-2025 00:13 by rmk") (* ; "Edited 21-Apr-2025 22:29 by rmk") (* ; "Edited 19-Mar-2025 15:46 by rmk") (* ; "Edited 8-Dec-2024 13:46 by rmk") (* ; "Edited 26-Nov-2024 17:37 by rmk") (* ; "Edited 29-Sep-2024 00:24 by rmk") (* ; "Edited 21-Sep-2024 22:12 by rmk") (* ; "Edited 13-Sep-2024 22:28 by rmk") (* ; "Edited 7-Jul-2024 11:52 by rmk") (* ; "Edited 5-Jul-2024 23:21 by rmk") (* ; "Edited 18-May-2024 16:47 by rmk") (* ; "Edited 12-May-2024 21:13 by rmk") (* ; "Edited 17-Feb-2024 16:34 by rmk") (* ; "Edited 15-Mar-2024 13:32 by rmk") (* ; "Edited 27-May-2023 11:22 by rmk") (* ; "Edited 24-May-2023 22:38 by rmk") (* ;; "Replaces the selection SEL of TEXTOBJ with INSERTSELPIECES. Produces a :Replace history event. TEXTOBJ will remember the insertion for undoing, our history event only has to keep track of the pieces it replaced, and where they were.") (* ;; "If SEL includes an object that declines deletion, the document is left unchanged.") (* ;;  "On return, the pieces, lines, selection, and display are complete, correct, and consistent ") (CL:UNLESS (\TEDIT.READONLY TSTREAM) [PROG ((TEXTOBJ (FTEXTOBJ TSTREAM)) (POINT (GETSEL SEL POINT)) (CH# (FGETSEL SEL CH#)) (DCH (FGETSEL SEL DCH)) DELEVENT ILEN) (\TEDIT.SEL.OFF TSTREAM SEL) (* ;; "We first delete, then insert, updating the display after the second operation.") (CL:WHEN (\TEDIT.DELETE.SELPIECES TSTREAM CH# DCH) (* ;; "Reduce to a point to the right of the last remaining character so that FIXSEL sees starting character in its proper line.") (\TEDIT.UPDATE.SEL SEL (SUB1 CH#) 0 'RIGHT 'NORMAL) (\TEDIT.FIXSEL SEL TSTREAM) (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) (SETQ DELEVENT (\TEDIT.LASTEVENT TEXTOBJ T))) (* ; "Catch the deletion event") (* ;; "") (CL:WHEN (AND INSERTSELPIECES (IGEQ (SETQ ILEN (GETSPC INSERTSELPIECES SPLEN)) 0) (\TEDIT.INSERT.SELPIECES INSERTSELPIECES TSTREAM 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") (CL:WHEN DELEVENT (\TEDIT.POPEVENT TEXTOBJ) (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 TSTREAM 'INSERTION CH# (IDIFFERENCE ILEN DCH)) elseif (ILESSP ILEN DCH) then (\TEDIT.UPDATE.LINES TSTREAM 'DELETION CH# (IDIFFERENCE DCH ILEN)) else (\TEDIT.UPDATE.LINES TSTREAM 'LOOKS CH# DCH)))])]) (\TEDIT.INSERT.SELPIECES [LAMBDA (SELPIECES TSTREAM TARGETSEL DONTUPDATE) (* ; "Edited 20-Apr-2025 23:19 by rmk") (* ; "Edited 26-Nov-2024 11:04 by rmk") (* ; "Edited 31-Oct-2024 18:01 by rmk") (* ; "Edited 22-Sep-2024 18:37 by rmk") (* ; "Edited 15-Aug-2024 10:49 by rmk") (* ; "Edited 5-Jul-2024 23:22 by rmk") (* ; "Edited 17-Mar-2024 11:43 by rmk") (* ; "Edited 15-Feb-2024 23:58 by rmk") (* ; "Edited 13-Feb-2024 09:01 by rmk") (* ; "Edited 11-Feb-2024 11:42 by rmk") (* ; "Edited 29-Aug-2023 10:35 by rmk") (* ; "Edited 12-Aug-2023 11:57 by rmk") (* ; "Edited 17-Jun-2023 17:08 by rmk") (* ; "Edited 2-Jun-2023 12:02 by rmk") (* ; "Edited 31-May-2023 09:56 by rmk") (* ; "Edited 21-May-2023 23:57 by rmk") (* ;;  "Insert SELPIECES into TEXTOBJ at TARGETSEL's caret. TARGETSEL can be a character position.") (* ;; "\TEDIT.INSERTCH.HISTORY uses the first piece to decide whether it is in a consecutive run of insertions.") (CL:WHEN SELPIECES (LET ((TEXTOBJ (FTEXTOBJ TSTREAM)) (INSCH# (TEDIT.GETPOINT TSTREAM TARGETSEL)) (SPLEN (GETSPC SELPIECES SPLEN)) (SPFIRST (GETSPC SELPIECES SPFIRST)) NEXTPC) (SETQ NEXTPC (\TEDIT.ALIGNEDPIECE INSCH# TEXTOBJ)) (\TEDIT.INSERTPIECES SPFIRST NEXTPC TEXTOBJ) (\TEDIT.DIFFUSE.PARALOOKS (PREVPIECE SPFIRST) NEXTPC) (CL:UNLESS DONTUPDATE (* ; "Under replace?") (* ;; "Adjust SEL to select the inserted material, with point on the right.") (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) INSCH# SPLEN 'RIGHT) (\TEDIT.UPDATE.LINES TSTREAM 'INSERTION INSCH# SPLEN)) (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Insert INSCH# SPLEN NIL SPFIRST))))]) (\TEDIT.RESTARTFN [LAMBDA (TSTREAM WINDOW PROPS) (* ; "Edited 29-Jun-2024 00:02 by rmk") (* ; "Edited 24-Apr-2024 10:38 by rmk") (* ; "Edited 17-Mar-2024 16:58 by rmk") (* ; "Edited 22-Sep-2023 20:31 by rmk") (* ; "Edited 21-Aug-2022 08:13 by rmk") (* ; "Edited 12-Jun-90 17:51 by mitani") (* ;; "RMK: not sure why it needs to fool around with the window and create a new stream. Why not just restart the process and command loop?") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM WINDOW NIL NIL PROPS)) (LET* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) (ODIRTY (GETTOBJ TEXTOBJ \DIRTY))) (* ;  "Unattach the window, so we don't do a redisplay.") (SETTOBJ TEXTOBJ PRIMARYPANE) (* ; "Reopen, reattach") (SETQ TSTREAM (OPENTEXTSTREAM TSTREAM WINDOW NIL NIL PROPS)) (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) (* ; "New stream maybe new textobj.") (SETTOBJ TEXTOBJ \DIRTY ODIRTY) (* ; "Preserve dirty") (\TEDIT.COMMAND.LOOP TSTREAM) (* ; "Run the editing engine") (CLOSEW WINDOW) (* ; "Close the edit window. WHY ??") (\TEDIT.TEXTCLOSEF TSTREAM) (* ; "Close the underlying files") (replace (STREAM ACCESSBITS) of TSTREAM with BothBits) (* ;  "But leave the stream itself accessible") (* ;  "Apply any post-window-close (and post-QUIT) function") (CL:WHEN (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) (APPLY* (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) WINDOW TSTREAM))]) (\TEDIT.CHARDELETE [LAMBDA (TSTREAM FORWARD) (* ; "Edited 6-Apr-2025 12:28 by rmk") (* ; "Edited 28-Nov-2024 10:14 by rmk") (* ; "Edited 27-Nov-2024 09:18 by rmk") (* ; "Edited 29-Sep-2024 21:04 by rmk") (* ; "Edited 22-Sep-2024 18:56 by rmk") (* ; "Edited 8-Jul-2024 00:12 by rmk") (* ; "Edited 23-Jun-2024 19:41 by rmk") (* ; "Edited 1-Apr-2024 22:44 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 23-Dec-2023 17:32 by rmk") (* ; "Edited 22-May-2023 23:24 by rmk") (* ; "Edited 19-Apr-93 10:50 by jds") (* ;; "This identifies the character before or after the current caret position, and deletes it.") (CL:UNLESS (\TEDIT.READONLY TSTREAM) (PROG* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (SEL (TEXTSEL TEXTOBJ)) (DCH (GETSEL SEL DCH)) CH#) (if (AND (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) (IGREATERP (GETSEL SEL DCH) 1)) then (* ;; "If there is a BPD selection, just delete that. If only length 1, it's probably the first backspace after a selection in XYTOSEL. Back it up as if was the second backspace (with DCH=0) below.") (SETQ CH# (FGETSEL SEL CH#)) elseif (SETQ CH# (CL:IF FORWARD (\TEDIT.NEXTCHANGEABLE.CHNO (TEDIT.GETPOINT TSTREAM SEL) TEXTOBJ) (\TEDIT.LASTCHANGEABLE.CHNO (SUB1 (TEDIT.GETPOINT TSTREAM SEL)) TEXTOBJ))) then (* ;;  "Target the first visible character before or after, unless it is protected") (SETQ DCH 1) else (RETURN)) (\TEDIT.DELETE TSTREAM CH# DCH (CL:IF FORWARD 'RIGHT 'LEFT)) (\TEDIT.SCROLL.CARET TSTREAM)))]) (\TEDIT.COPYPIECE [LAMBDA (PC FROMTSTREAM TOTSTREAM UNPROTECT OPERATION PROMPTTEXTOBJ) (* ; "Edited 28-Jul-2025 23:49 by rmk") (* ; "Edited 22-Apr-2025 00:12 by rmk") (* ; "Edited 3-Aug-2024 12:40 by rmk") (* ; "Edited 15-Oct-2023 20:14 by rmk") (* ; "Edited 30-Jul-2023 22:44 by rmk") (* ; "Edited 21-Jun-2023 00:15 by rmk") (* ; "Edited 19-May-2023 21:39 by rmk") (* ; "Edited 7-May-2023 11:46 by rmk") (* ; "Edited 12-Jun-90 17:50 by mitani") (* ;; "PROMPTTEXTOBJ's prompt gets the message that a copy is not allowed, the FROMOBJ and TOOBJ provide the streams for the object's copy function. The copy is disconnected from PC's original connections.") (* ;; "If UNPROTECT, the copies of protected pieces are unprotected") (* ;; "OPERATION keys which imageobject function to apply, if any") (PROG ((TOOBJ (FTEXTOBJ TOTSTREAM)) (CROSSCOPY (NEQ FROMTSTREAM TOTSTREAM)) NEWPC SRCPFILE) (SETQ NEWPC (create PIECE using PC PNEW _ T PREVPIECE _ NIL NEXTPIECE _ NIL PTREENODE _ NIL)) (SELECTC (PTYPE PC) (FILE.PTYPES (CL:WHEN CROSSCOPY (* ;; "If this is a cross-document copy, and the text comes from a file, we must REALLY make a copy of the text, lest the source file be deleted. We want to preserve the external format, so that we can just copy the bytes.") (SETQ SRCPFILE (PCONTENTS PC)) (CL:UNLESS (\GETSTREAM SRCPFILE 'INPUT T) (* ;  "The source file was CLOSED -- reopen it, for our use") [SETQ SRCPFILE (OPENSTREAM SRCPFILE 'INPUT 'OLD '((TYPE TEXT]) [FSETPC PC PCONTENTS (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW `((:EXTERNAL-FORMAT ,(STREAMPROP SRCPFILE :EXTERNAL-FORMAT ] [COPYBYTES SRCPFILE (PCONTENTS PC) (PFPOS PC) (IPLUS (PFPOS PC) (ITIMES (PLEN PC) (PBYTESPERCHAR PC] (FSETPC PC PFPOS 0))) (STRING.PTYPES (* ;  "In case this is in the current insertion string") (change (PCONTENTS NEWPC) (CONCAT DATUM))) (OBJECT.PTYPE (* ;  "No copy if object doesn't allow it. Caller must be prepared for NIL?") (FSETPC NEWPC PCONTENTS (OR (\TEDIT.APPLY.OBJFN (PCONTENTS NEWPC) OPERATION FROMTSTREAM TOTSTREAM PROMPTTEXTOBJ) (RETURN NIL)))) NIL) (* ;; "If moving from one text to another, we have to register the looks.") (if (AND UNPROTECT (FGETCLOOKS (PCHARLOOKS NEWPC) CLPROTECTED)) then (FSETPC NEWPC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS using (PCHARLOOKS PC) CLPROTECTED _ NIL CLSELAFTER _ NIL) TOOBJ)) elseif CROSSCOPY then (FSETPC NEWPC PCHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (PCHARLOOKS PC) TOOBJ)) (FSETPC NEWPC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (PPARALOOKS PC) TOOBJ))) (RETURN NEWPC]) (\TEDIT.APPLY.OBJFN [LAMBDA (OBJ OPERATION FROMTSTREAM TOTSTREAM PROMPTTEXTOBJ)(* ; "Edited 21-Apr-2025 21:07 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 15-Mar-2024 15:38 by rmk") (* ; "Edited 15-Jul-2023 10:43 by rmk") (* ; "Edited 9-Jul-2023 16:24 by rmk") (* ; "Edited 6-Jun-2023 13:35 by rmk") (* ; "Edited 30-May-2023 08:15 by rmk") (* ; "Edited 19-May-2023 21:37 by rmk") (* ; "Edited 7-May-2023 11:46 by rmk") (* ;; "As part of an OPERATION on an image object piece, we execute the appropriate object functions. If any of them returns DONT, we print a message in the prompt window of PROMPTTEXTOBJ or FROMTOBJ, and return NIL. Otherwise, we return an object, either OBJ or a copy.") (CL:UNLESS TOTSTREAM (SETQ TOTSTREAM FROMTSTREAM)) (PROG ((OBJFN (IMAGEOBJPROP OBJ (SELECTQ OPERATION (COPY 'COPYFN) (MOVE 'WHENMOVEDFN) (INSERT 'WHENINSERTEDFN) (DELETE (* ;  "This may want to apply to the first pane?") 'WHENDELETEDFN) NIL))) NEWOBJ) (SETQ NEWOBJ (if OBJFN then (APPLY* OBJFN OBJ FROMTSTREAM (CL:UNLESS (EQ OPERATION 'DELETE) TOTSTREAM)) elseif (EQ OPERATION 'COPY) then (COPYALL OBJ) else OBJ)) (CL:WHEN (MEMB NEWOBJ '(DON'T DONT)) (TEDIT.PROMPTPRINT (OR PROMPTTEXTOBJ FROMTSTREAM) (CONCAT (L-CASE OPERATION T) " of this object not allowed.") T) (RETURN)) (* ;; "The WHENCOPIEDFN wants the display stream, not just the text stream. ") (CL:WHEN [AND (EQ OPERATION 'COPY) (SETQ OBJFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (\TEDIT.PRIMARYPANE TOTSTREAM) 'DSP) FROMTSTREAM TOTSTREAM) '(DON'T DONT] (RETURN NIL)) (RETURN (OR (IMAGEOBJP NEWOBJ) OBJ]) (\TEDIT.DELETE [LAMBDA (TSTREAM TARGETSEL/CHAR LEN POINT DONTCHECK) (* ; "Edited 22-Apr-2025 09:58 by rmk") (* ; "Edited 20-Apr-2025 13:27 by rmk") (* ; "Edited 6-Apr-2025 12:03 by rmk") (* ; "Edited 19-Mar-2025 11:22 by rmk") (* ; "Edited 6-Feb-2025 00:14 by rmk") (* ; "Edited 8-Dec-2024 21:39 by rmk") (* ; "Edited 13-Sep-2024 22:30 by rmk") (* ; "Edited 7-Jul-2024 12:07 by rmk") (* ; "Edited 23-Jun-2024 19:27 by rmk") (* ; "Edited 18-May-2024 16:20 by rmk") (* ; "Edited 24-Apr-2024 10:42 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 21-Feb-2024 20:40 by rmk") (* ; "Edited 12-Nov-2023 12:14 by rmk") (* ; "Edited 6-Jun-2023 12:48 by rmk") (* ; "Edited 29-May-91 18:22 by jds") (* ;; "Delete the DCH characters selected by TARGETSEL in TEXTOBJ. Unlike insert, the initial position of the caret doesn't matter.") (* ;;  "On return, the pieces, lines, and selection are complete and correct, and the display are correct.") (* ;; "") (* ;; "If this is called as part of a move, SEL should end up at the location of the insert, adjusted if the TARGETSEL comes earlier. If this is just a delete, SEL should end up as a point selection at TARGETSEL's CH#.") (LET* ((TEXTOBJ (FTEXTOBJ TSTREAM)) (SEL (TEXTSEL TEXTOBJ)) CLOOKS FIRSTCHAR) (CL:UNLESS TARGETSEL/CHAR (SETQ TARGETSEL/CHAR SEL)) [if (type? SELECTION TARGETSEL/CHAR) then (SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL/CHAR)) (SETQ FIRSTCHAR (FGETSEL TARGETSEL/CHAR CH#)) (CL:UNLESS LEN (SETQ LEN (FGETSEL TARGETSEL/CHAR DCH))) (SETQ POINT (FGETSEL TARGETSEL/CHAR POINT)) else (SETQ FIRSTCHAR TARGETSEL/CHAR) (CL:UNLESS POINT (SETQ POINT 'LEFT))] [SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ (CL:IF (EQ POINT 'LEFT) FIRSTCHAR (IPLUS -1 FIRSTCHAR LEN))] (CL:WHEN (\TEDIT.DELETE.SELPIECES TSTREAM FIRSTCHAR LEN DONTCHECK) (* ;  "Delete the selected characters (if objects allow)") (* ;;  "Pieces are gone, make lines, SEL, and caret looks consistent with current text.") (\TEDIT.UPDATE.LINES TSTREAM 'DELETION FIRSTCHAR LEN) (FSETTOBJ TEXTOBJ CARETLOOKS CLOOKS) (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") (\TEDIT.SEL.DELETEDCHARS SEL FIRSTCHAR LEN) (* ;; "In any event, TARGETSEL's characters are all gone, reduce it to a point selection in case it is still in use. And then SEL moves to the position of the deletion.") (* ;; "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 TSTREAM (SUB1 FIRSTCHAR) 0 'RIGHT) T)]) (\TEDIT.DIFFUSE.PARALOOKS [LAMBDA (PRIORPC SUCCEEDINGPC) (* ; "Edited 16-Feb-2024 00:07 by rmk") (* ; "Edited 1-Jul-2023 19:24 by rmk") (* ; "Edited 11-Apr-2023 00:08 by rmk") (* ; "Edited 22-Oct-2022 22:22 by rmk") (* ; "Edited 5-Sep-2022 14:32 by rmk") (* ; "Edited 23-Aug-2022 08:40 by rmk") (* ; "Edited 12-Jun-90 17:48 by mitani") (* ;; "Given a discontinuity in paragraph looks, caused by an insertion or by a deletion: Diffuse the existing paragraph looks across the discontinuity, so that all the pieces in a single paragraph have consistent paragraph looks. Give preference to diffusion toward the END of the document. This means that if you delete an EOL between paragraphs, the second para is absorbed into the first.") (* ;; "PRIORPC and SUCCEEDINGPC are the pieces that bound the area of potential discontinuity: the change will occur at one boundary or the other.") (CL:WHEN (AND PRIORPC (NOT (PPARALAST PRIORPC))) (* ;  "The discontinuity is inside a paragraph. Must copy para looks forward into the text.") (for PC (PPLOOKS _ (PPARALOOKS PRIORPC)) inpieces (NEXTPIECE PRIORPC) until (PPARALAST PC) do (* ;  "Copy para looks info in from the left, up to the first para break.") (FSETPC PC PPARALOOKS PPLOOKS))) (CL:WHEN SUCCEEDINGPC (* ;  "Copy para looks back from the right, up to the first para break") (for PC (PPLOOKS _ (PPARALOOKS SUCCEEDINGPC)) backpieces (PREVPIECE SUCCEEDINGPC) until (OR (EQ PC PRIORPC) (PPARALAST PC)) do (FSETPC PC PPARALOOKS PPLOOKS)))]) (\TEDIT.WORDDELETE [LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 12:31 by rmk") (* ; "Edited 27-Nov-2024 23:21 by rmk") (* ; "Edited 31-Oct-2024 17:47 by rmk") (* ; "Edited 7-Jul-2024 11:35 by rmk") (* ; "Edited 29-Apr-2024 11:01 by rmk") (* ; "Edited 20-Mar-2024 11:08 by rmk") (* ; "Edited 25-Dec-2023 00:03 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") (LET (LASTNO FIRSTNO) (SETQ LASTNO (SUB1 (TEDIT.GETPOINT TSTREAM))) (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") (CL:UNLESS (ILEQ LASTNO 0) (* ;  "Nothing to delete at start of file.") (SETQ FIRSTNO (\TEDIT.WORD.FIRST TSTREAM LASTNO)) (\TEDIT.DELETE TSTREAM FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) (\TEDIT.WORDDELETE.FORWARD [LAMBDA (TSTREAM) (* ; "Edited 6-Apr-2025 12:30 by rmk") (* ; "Edited 27-Nov-2024 20:31 by rmk") (* ; "Edited 31-Oct-2024 17:47 by rmk") (* ; "Edited 7-Jul-2024 11:35 by rmk") (* ; "Edited 29-Apr-2024 10:59 by rmk") (* ; "Edited 20-Mar-2024 10:54 by rmk") (* ; "Edited 25-Dec-2023 00:20 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") (* ;; "This deletes all characters from the character just after the caret to the end of the following word, skipping over separators to reach the target word.") (LET (FIRSTNO LASTNO) (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") (SETQ FIRSTNO (TEDIT.GETPOINT TSTREAM)) (CL:UNLESS (IGREATERP FIRSTNO (TEXTLEN (FTEXTOBJ TSTREAM))) (* ; "Nothing to delete at end of file.") (SETQ LASTNO (\TEDIT.WORD.LAST TSTREAM FIRSTNO)) (\TEDIT.DELETE TSTREAM FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) (\TEDIT.FINISHEDIT? [LAMBDA (TSTREAM NOFORCE) (* ; "Edited 27-Apr-2025 23:53 by rmk") (* ; "Edited 19-Apr-2025 10:47 by rmk") (* ; "Edited 14-Jul-2024 12:25 by rmk") (* ; "Edited 1-Jul-2024 16:11 by rmk") (* ; "Edited 30-Jun-2024 12:36 by rmk") (* ; "Edited 25-Jun-2024 11:59 by rmk") (* ; "Edited 2-May-2024 21:25 by rmk") (* ; "Edited 20-Mar-2024 10:53 by rmk") (* ; "Edited 15-Mar-2024 15:38 by rmk") (* ; "Edited 22-Sep-2023 20:21 by rmk") (* ; "Edited 20-Sep-2023 23:24 by rmk") (* ; "Edited 12-Jun-90 17:50 by mitani") (* ;; "Called to determine whether the edit in TSTREAM can be terminated. If there are no active operations and non of the QUITFNS (if any) returns DON'T, then the stream EDITFINISHEDFLG is set to T and T is returned. Setting the flag to T allows the edit process to terminate.") (* ;; "Otherwise, the return value is DON'T, so that this can be used by itself to guard closing as a window CLOSEFN.") (* ;; "Menus can always be closed.") (PROG* ((TEXTOBJ (TEXTOBJ TSTREAM)) (QUITFNS (GETTEXTPROP TEXTOBJ 'QUITFN)) (PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) QUITFLG) (CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE) (* ;; "We're busy doing something, don't close with a message") (CL:UNLESS (STRING.EQUAL "Get" (FGETTOBJ TEXTOBJ EDITOPACTIVE)) (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Not closed: " (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE )) "Edit" (FGETTOBJ TEXTOBJ EDITOPACTIVE)) " operation in progress") T)) (RETURN 'DON'T)) [for QUITFN (PRIMPANE _ (FGETTOBJ TEXTOBJ PRIMARYPANE)) inside QUITFNS until (OR (EQ QUITFLG 'DON'T) (EQ QUITFLG T)) do (SETQ QUITFLG (COND ((EQ QUITFN T)) (QUITFN (APPLY* QUITFN PRIMPANE TSTREAM TEXTOBJ (FGETTOBJ TEXTOBJ EDITPROPS] (CL:WHEN (EQ QUITFLG 'DON'T) (* ;; "The user supplied a QUITFN that returned DON'T. Editing continues.") (RETURN 'DON'T)) (* ;; "If this document has changed, check with the user to make sure he really wants to do it. The question is suppressed for menus and if the QUITFNs gave us T.") (CL:WHEN (AND (FGETTOBJ TEXTOBJ \DIRTY) (NOT (FGETTOBJ TEXTOBJ MENUFLG))) (CL:UNLESS (AND (FGETTOBJ TEXTOBJ MENUFLG) (EQ QUITFNS T) (EQ QUITFLG T)) (CL:UNLESS (MOUSECONFIRM "Not saved yet; LEFT to Quit anyway." T (FGETTOBJ TEXTOBJ PROMPTWINDOW )) (RETURN 'DON'T)))) (* ;; "OK, we can quit.") (CL:WHEN [AND PRIMPANE (NOT NOFORCE) (NEQ PRIMPANE (PROCESSPROP (TTY.PROCESS) 'WINDOW] (TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS))) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T) (RETURN T]) ) (DEFINEQ (\TEDIT.THELP [LAMBDA (MESS1 MESS2) (* ; "Edited 21-Oct-2024 01:00 by rmk") (* ; "Edited 3-Oct-2024 22:06 by rmk") (* ;; "This is used to signal an internal problem with Tedit or its datastructures. Tedit developers should set\TEDIT.THELPFLG is set to T to force breaks to happen when something goes wrong. It defaults to NIL so that ordinary users see the error message but don't get a break somewhere in the Tedit basement.") (CL:IF \TEDIT.THELPFLG (HELP MESS1 MESS2) (ERROR MESS1 MESS2 T))]) ) (RPAQ? \TEDIT.THELPFLG NIL) (DEFINEQ (\TEDIT.PARAPIECES [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 29-Nov-2024 18:28 by rmk") (* ; "Edited 7-Jul-2024 20:59 by rmk") (* ; "Edited 29-Apr-2024 13:14 by rmk") (* ; "Edited 3-Mar-2024 13:01 by rmk") (* ; "Edited 11-Dec-2023 23:03 by rmk") (* ;; "Produces SELPIECES that starts at the first piece of the paragraph containing FIRSTCHAR and runs to the last piece of the paragraph containing LASTCHAR. Since paragraphs are split anyway, this does not require further splitting.") (LET (FIRSTCHAR FIRST LAST START-OF-PIECE) (DECLARE (SPECVARS START-OF-PIECE)) (if (type? SELECTION SEL/FIRSTCHAR) then (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#)) (SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CHLAST))) elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR) then (SETQ FIRSTCHAR (GETTH SEL/FIRSTCHAR THCH#)) [SETQ LASTCHAR (SUB1 (IPLUS FIRSTCHAR (GETTH SEL/FIRSTCHAR THLEN] else (SETQ FIRSTCHAR SEL/FIRSTCHAR) (CL:UNLESS LASTCHAR (SETQ LASTCHAR FIRSTCHAR))) (SETQ FIRST (\TEDIT.PARA.FIRST TEXTOBJ FIRSTCHAR)) (SETQ LAST (\TEDIT.PARA.LAST TEXTOBJ LASTCHAR)) (create SELPIECES SPFIRST _ (CDR FIRST) SPLAST _ (CDR LAST) SPLEN _ (ADD1 (IDIFFERENCE (CAR LAST) (CAR FIRST))) 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 1-Aug-2025 14:49 by rmk") (* ; "Edited 26-Apr-2025 11:33 by rmk") (* ; "Edited 30-Jan-2025 12:02 by rmk") (* ; "Edited 11-Jan-2025 00:08 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 19-Jan-2024 10:10 by rmk") (* ; "Edited 26-Dec-2023 09:14 by rmk") (* ; "Edited 24-Dec-2023 22:14 by rmk") (* ; "Edited 11-Dec-2023 21:52 by rmk") (* ;; "Returns (FIRSTCHARNO . FIRSTPIECE) of the paragraph containing CHNO. FIRSTCHARNO is the firstcharacter of FIRSTPIECE, because paragraphs start on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the end of the paragraph.") (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) then (CONS 0) else (LET (CHPIECE START-OF-PIECE START) (DECLARE (SPECVARS START-OF-PIECE)) (if (type? SELPIECES CHNO) then (SETQ CHPIECE (GETSPC CHNO SPFIRST)) (SETQ START (GETSPC CHNO SPFIRSTCHAR)) elseif (type? PIECE CHNO) then (SETQ START (\TEDIT.PCTOCH CHNO TEXTOBJ)) (SETQ CHPIECE CHNO) else [SETQ CHNO (CL:IF (type? SELECTION CHNO) (FGETSEL CHNO CH#) (IMAX 0 (IMIN CHNO (TEXTLEN TEXTOBJ))))] (SETQ CHPIECE (\TEDIT.CHTOPC CHNO TEXTOBJ T)) (SETQ START START-OF-PIECE)) (* ;;  "Start one before CHPIECE, its PARALAST doesn't matter. Assume CHPIECE is visible") (for PC (PLENTOT _ 0) backpieces (AND CHPIECE (PREVPIECE CHPIECE)) when (VISIBLEPIECEP PC) until (PPARALAST PC) until (AND PROTECTEDNOTOK (GETCLOOKS (PCHARLOOKS PC) CLPROTECTED)) do (add PLENTOT (PLEN PC)) finally (* ;; "If the iteration reached the beginning, there is no PREVPIECE. Otherwise, PC is the previous PARALAST, and we have to take its next") (RETURN (CONS (IDIFFERENCE START PLENTOT) (CL:IF (PREVPIECE PC) (NEXTPIECE PC) (\TEDIT.FIRSTPIECE TEXTOBJ))]) (\TEDIT.PARA.LAST [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 1-Aug-2025 14:49 by rmk") (* ; "Edited 7-Feb-2025 08:32 by rmk") (* ; "Edited 31-Jan-2025 09:33 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 19-Jan-2024 10:37 by rmk") (* ; "Edited 26-Dec-2023 09:14 by rmk") (* ; "Edited 24-Dec-2023 22:16 by rmk") (* ; "Edited 11-Dec-2023 23:02 by rmk") (* ;; "Returns (LASTCHARNO . LASTPIECE) of the paragraph containing CHNO. If CHNO is SELPIECES or SELECTION, CHNO is taken as its last character. LASTCHARNO is the number of the last character of the paragraph (presumably on EOL). It is also the character of LASTPIECE, because pargraphs end on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the beginning of the paragraph.") (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) then (* ; "Empty document") (CONS 0) else (LET (CHPIECE START-OF-PIECE END FORMATTED) (DECLARE (SPECVARS START-OF-PIECE)) (if (type? SELPIECES CHNO) then (SETQ CHPIECE (GETSPC CHNO SPLAST)) [SETQ END (SUB1 (IDIFFERENCE (GETSPC CHNO SPLASTCHAR) (PLEN CHPIECE] elseif (type? PIECE CHNO) then (SETQ CHPIECE CHNO) (SETQ END (\TEDIT.PCTOCH CHNO TEXTOBJ)) else (SETQ CHPIECE (\TEDIT.CHTOPC (IMIN (CL:IF (type? SELECTION CHNO) (FGETSEL CHNO CHLAST) CHNO) (TEXTLEN TEXTOBJ)) TEXTOBJ T)) (SETQ END START-OF-PIECE)) (* ; "Find the paragraph's last char") (* ;; "END is now the first character of the piece containing CHNO") (for PC (PLENTOT _ 0) inpieces CHPIECE when (VISIBLEPIECEP PC) do (add PLENTOT (PLEN PC)) repeatuntil (PPARALAST PC) repeatuntil (AND PROTECTEDNOTOK (FGETCLOOKS (PCHARLOOKS PC) CLPROTECTED)) finally (RETURN (CONS (IMIN (IPLUS END PLENTOT -1) (FGETTOBJ TEXTOBJ TEXTLEN)) PC]) ) (DEFINEQ (\TEDIT.WORD.FIRST [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "Edited 28-Mar-2025 10:10 by rmk") (* ; "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") (* ; "Edited 25-Dec-2023 18:53 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 first character of the word containing CHNO or of the word preceding 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,\BACKBIN skips them.") (* ;; "Image objects are treated as text characters.") (* ;; "Punctuation is tricky: It stops whitespace and text, and its immediate predecessor doesn't matter.") (if (ILEQ CHNO 1) then 1 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))) (* ;; "Skip over any preceding whitespace characters. .") [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] (* ;; "") (* ;;  "We've reached the first unprotected non-white character, and CHNO is its number. ") (* ;;  "If a punct, we treat it as a break: Return its position. Otherwise, scan for the first non-text") (* ;; "If CHNO is text, then look for the first previous non-text. If non-text, look for the first previous text.") (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 28-Mar-2025 10:09 by rmk") (* ; "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 25-Dec-2023 18:38 by rmk") (* ; "Edited 23-May-2023 16:37 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 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.") (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)) (* ;; "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]) ) (FILESLOAD TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-OLDFILE TEDIT-WINDOW TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) (* ; "TEDIT Support information") (DEFINEQ (TEDITSYSTEMDATE [LAMBDA NIL (* ; "Edited 28-May-2025 16:04 by rmk") (for F in TEDITFILES largest [IDATE (CAAR (GETP F 'FILEDATES] finally (RETURN (CAAR (GETP $$VAL 'FILEDATES]) ) (RPAQ TEDITSYSTEMDATE (TEDITSYSTEMDATE)) (* ; "IMAGETYPE Interface, so the system can decide if a file is a TEdit file.") (DEFINEQ (TEDIT.IMAGESOURCEP [LAMBDA (X) (* ; "Edited 23-Dec-2025 11:26 by rmk") (OR (TEXTSTREAM X T) (TEDIT.FORMATTEDFILEP X]) ) (ADDTOVAR PRINTFILETYPES (TEDIT (TEST TEDIT.IMAGESOURCEP) (EXTENSION (TEDIT TED)))) (DEFAULT.IMAGETYPE.CONVERSIONS '(TEDIT TEDIT.TO.IMAGEFILE)) (DECLARE%: DONTCOPY (FILEMAP (NIL (4936 7330 (MAKE-TEDIT-EXPORTS.ALL 4946 . 5492) (UPDATE-TEDIT 5494 . 6423) (EDIT-TEDIT 6425 . 7328)) (8760 37759 (TEDIT 8770 . 11384) (TEXTSTREAM 11386 . 13275) (TEXTSTREAMP 13277 . 13661) (COERCETEXTSTREAM 13663 . 17874) (TEDIT.CONCAT 17876 . 21178) (TEDITSTRING 21180 . 22094) (TEDIT-SEE 22096 . 22780) (TEDIT.COPY 22782 . 24927) (TEDIT.DELETE 24929 . 26290) (TEDIT.INSERT 26292 . 29261) ( TEDIT.TERPRI 29263 . 30377) (TEDIT.KILL 30379 . 31361) (TEDIT.QUIT 31363 . 32729) (TEDIT.MOVE 32731 . 33619) (TEDIT.STRINGWIDTH 33621 . 34292) (TEDIT.CHARWIDTH 34294 . 36536) (TEDIT.PARAGRAPH.BOUNDARIES 36538 . 37757)) (37760 39701 (TEXTOBJ 37770 . 38235) (COERCETEXTOBJ 38237 . 39699)) (41101 42751 ( TDRIBBLE 41111 . 42749)) (42792 54772 (TEDIT.INSERT.OBJECT 42802 . 46509) (TEDIT.EDIT.OBJECT 46511 . 49451) (TEDIT.OBJECT.CHANGED 49453 . 52643) (TEDIT.MAP.OBJECTS 52645 . 54300) (\TEDIT.FIRST.OBJPIECE 54302 . 54535) (\TEDIT.NEXT.OBJPIECE 54537 . 54770)) (54795 62238 (\TEDIT.CONCAT.PAGEFRAMES 54805 . 59872) (\TEDIT.GET.PAGE.HEADINGS 59874 . 60903) (\TEDIT.CONCAT.INSTALL.HEADINGS 60905 . 62236)) (62239 65846 (\TEDIT.MOVE.MSG 62249 . 64330) (\TEDIT.READONLY 64332 . 65844)) (65847 71738 (TEDIT.NCHARS 65857 . 66230) (TEDIT.RPLCHARCODE 66232 . 69222) (TEDIT.NTHCHARCODE 69224 . 71267) (TEDIT.NTHCHAR 71269 . 71736)) (71784 128828 (\TEDIT1 71794 . 73871) (\TEDIT.INSERT 73873 . 79986) (\TEDIT.MOVE 79988 . 88086) (\TEDIT.COPY 88088 . 92694) (\TEDIT.REPLACE.SELPIECES 92696 . 97232) ( \TEDIT.INSERT.SELPIECES 97234 . 100231) (\TEDIT.RESTARTFN 100233 . 102738) (\TEDIT.CHARDELETE 102740 . 105669) (\TEDIT.COPYPIECE 105671 . 110833) (\TEDIT.APPLY.OBJFN 110835 . 113921) (\TEDIT.DELETE 113923 . 118291) (\TEDIT.DIFFUSE.PARALOOKS 118293 . 120564) (\TEDIT.WORDDELETE 120566 . 122181) ( \TEDIT.WORDDELETE.FORWARD 122183 . 123972) (\TEDIT.FINISHEDIT? 123974 . 128826)) (128829 129488 ( \TEDIT.THELP 128839 . 129486)) (129522 138653 (\TEDIT.PARAPIECES 129532 . 131506) (\TEDIT.PARACHNOS 131508 . 132400) (\TEDIT.PARA.FIRST 132402 . 135503) (\TEDIT.PARA.LAST 135505 . 138651)) (138654 145749 (\TEDIT.WORD.FIRST 138664 . 142668) (\TEDIT.WORD.LAST 142670 . 145747)) (145950 146227 ( TEDITSYSTEMDATE 145960 . 146225)) (146363 146570 (TEDIT.IMAGESOURCEP 146373 . 146568))))) STOP