From abdb1286360bc5625cae47aa4b5640c5b75e854f Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 23 Dec 2024 11:07:54 -0800 Subject: [PATCH] Rmk36 tedit fifth round (#1857) * TMAX updates for compatibility with Tedit changes * DOC-OBJECTS changes for compatibility with Tedit changes * MODERNIZE update for Tedit split windows * Core Tedit files * IMAGEOBJ: Remove dependency on Tedit internals * WINDOW: Remove dependency on Tedit internal declaration Still strange that WFROMDS should have to branch on Tedit * WINDOWOBJ gets window of TTY process before the window of the stream of the TTY process So insert into Tedit works * TEDIT-CHAT: try to use TEXTSTREAM vs TEXTOBJ * Fix tab-initialization problem in SLIDES.TEDIT as reported by @nbriggs * TEDIT-CHAT: use TSTREAM rather than TEXTOBJ * Updates after lots more testing, particularly scrolling Some other files dragged along to avoid dependence on Tedit internals * Remove unwanted SAVE.SYSOUT * Addresses more end-of-file and empty-file display issues Try it again * TEDIT-DEBUG tracking other changes * Odds and ends * Adjust EOF selection and caret-scrolling on copy * More cleanup, plus fixing a few more ancient (Venue) glitches As usual, the problems have to do with the funky behavior of EOL's in the middle and end of the document. More abstraction and refactoring to get better control of this (I hope). * TEDIT-WINDOW: Scroll down of big objects Trying to fix what happens at the transition when scrolling down brings a big-object's top down in the window. Approach is to bring down the line above, which may make for a little jump. I hope that solves it. Scrolling up still needs some adjustment. * Eliminate junk at top of window after up/down scrolling of big objects BLTSHADE is OK there for scrolling, but not for redisplay after editing. In the edit case, the top of the pane above the last valid line is preserved. Scrolling still has the problem that the window can go blank at the first scroll that brings a tall object into the pane--still working on that. * Scrolling with tall lines should be more continuous * Another tweak for scrolling plus interface extension to TEDIT.MOVE and TEDIT.COPY, a little more on field menus * More robust strategy for field menu buttons Surround the field with prefix and suffix pieces with image objects that print the pre and post labels and shift the selection forward or backward into the field. Doesn't depend on inherited quirky logic in the selection line-scanner. * Field selection ignores right and middle clicks * A little more menu/selection tweaking You can't extend through fields and buttons * Added CUSTOMBUTTONEVENTFN to menu field buttons Also, menu buttons in general can't be deleted * A few more glitches, plus a little selection refactoring for buttons * Reduce flicker in pargraph menu margin bar * screen update glitch * DOC-OBJECTS, TEDIT-SCREEN: Fixes the HCFILES DOC-OBJECTS failure * TEDIT-BUTTONS: Field values should always be shown in the specified FIELDFONT * Abstracting the structure of the history lists cleanup, but mostly as a precursor to maybe doing a ring buffer of a specified length * TEDIT-FILE, a little font-reading cleanup * Include the files from rmk-39 that deal with the text/binary renamefile problem * TEDIT-PAGE addresses #1905 * Fix BUTTONSTART to STARTPC in Put/Get menu buttons * Use width of M as width of EOL--easy to select Also put in function call for potential kerning--needs eventual FONT support * Rename a few internal functions from TEDIT.-- to \TEDIT.-- * Doesn't make sense for a charlooks to not have a font * TEDIT-BUTTONS - Fix comment * Take out Tedit internals from \CARET.FLASH? Should have included this in fifth round long ago * TEDIT-FILE: use DEFAULTFONT for .sh files Easier to follow the layout * TEDIT-LOOKS: fix loadup order * tedit-exports.all Remove line-has-protection field Useless * Make sure that charlooks change as expected * External format for .sh files is UTF-8 * Better display of history information for debugging * Button changes: show document font families, better fields * TEDIT-WINDOW, remove extra truncated line with down-scroll * TEDIT-SELECTION: suppress line/paragraph selection for built-in menus Line/para selection would be reasonable for multi-line fields, but most menu lines have protected text that would behave inconsistently. So just suppress * Better support for potential kerning * Fix empty field value * Simplify ASCII translation code * Make sure headings have a default tab * Word boundary at character 1 * Remember that you specified a font class instead of a font For the charlooks menu, but also so that it is saved on a put * More items on the Family NWAY-button line * glitch * TEDIT-LOOKS: Better algorithm for Ascii translation * Charmenu remembers previous "Other" fonts, even if not installed * Fix initial piece index * Fix fontclass changes (again) --- internal/TEDIT-DEBUG | 2455 ++++++++++ internal/TEDIT-DEBUG.LCOM | Bin 0 -> 60892 bytes library/IMAGEOBJ | 311 +- library/IMAGEOBJ.LCOM | Bin 14984 -> 14631 bytes library/PDFSTREAM | 15 +- library/PDFSTREAM.LCOM | Bin 5449 -> 5528 bytes library/POSTSCRIPTSTREAM | 86 +- library/POSTSCRIPTSTREAM.LCOM | Bin 91371 -> 91379 bytes library/tedit/TEDIT | 2103 +++++---- library/tedit/TEDIT-ABBREV | 205 +- library/tedit/TEDIT-ABBREV.LCOM | Bin 3682 -> 3565 bytes library/tedit/TEDIT-BUTTONS | 1941 ++++++++ library/tedit/TEDIT-BUTTONS.LCOM | Bin 0 -> 34396 bytes library/tedit/TEDIT-CHAT | 29 +- library/tedit/TEDIT-CHAT.LCOM | Bin 5488 -> 5409 bytes library/tedit/TEDIT-COMMAND | 313 +- library/tedit/TEDIT-COMMAND.LCOM | Bin 17225 -> 15738 bytes library/tedit/TEDIT-FILE | 1120 ++--- library/tedit/TEDIT-FILE.LCOM | Bin 38701 -> 39139 bytes library/tedit/TEDIT-FIND | 720 +-- library/tedit/TEDIT-FIND.LCOM | Bin 7552 -> 7825 bytes library/tedit/TEDIT-FNKEYS | 323 +- library/tedit/TEDIT-FNKEYS.LCOM | Bin 14557 -> 17264 bytes library/tedit/TEDIT-HCPY | 151 +- library/tedit/TEDIT-HCPY.LCOM | Bin 13145 -> 12412 bytes library/tedit/TEDIT-HISTORY | 781 +++- library/tedit/TEDIT-HISTORY.LCOM | Bin 9086 -> 13329 bytes library/tedit/TEDIT-LOOKS | 2275 +++++----- library/tedit/TEDIT-LOOKS.LCOM | Bin 42804 -> 42189 bytes library/tedit/TEDIT-MENU | 5751 +++++++++--------------- library/tedit/TEDIT-MENU.LCOM | Bin 93028 -> 47015 bytes library/tedit/TEDIT-OLDFILE | 464 +- library/tedit/TEDIT-OLDFILE.LCOM | Bin 19028 -> 18055 bytes library/tedit/TEDIT-PAGE | 919 ++-- library/tedit/TEDIT-PAGE.LCOM | Bin 24624 -> 25662 bytes library/tedit/TEDIT-PCTREE | 85 +- library/tedit/TEDIT-PCTREE.LCOM | Bin 13490 -> 13640 bytes library/tedit/TEDIT-RELEASENOTES.TEDIT | Bin 0 -> 21011 bytes library/tedit/TEDIT-RENAMES | 172 + library/tedit/TEDIT-SCREEN | 2012 ++++----- library/tedit/TEDIT-SCREEN.LCOM | Bin 33456 -> 31362 bytes library/tedit/TEDIT-SELECTION | 2420 +++++----- library/tedit/TEDIT-SELECTION.LCOM | Bin 26531 -> 29809 bytes library/tedit/TEDIT-STREAM | 1145 +++-- library/tedit/TEDIT-STREAM.LCOM | Bin 30011 -> 34755 bytes library/tedit/TEDIT-STRESS | 30 +- library/tedit/TEDIT-STRESS.LCOM | Bin 10949 -> 10895 bytes library/tedit/TEDIT-TFBRAVO | 223 +- library/tedit/TEDIT-TFBRAVO.LCOM | Bin 27299 -> 27068 bytes library/tedit/TEDIT-WINDOW | 3563 ++++++++------- library/tedit/TEDIT-WINDOW.LCOM | Bin 58418 -> 65130 bytes library/tedit/TEDIT.LCOM | Bin 32028 -> 34949 bytes library/tedit/tedit-exports.all | 397 +- lispusers/DOC-OBJECTS | 395 +- lispusers/DOC-OBJECTS.LCOM | Bin 22603 -> 22186 bytes lispusers/EQUATIONS | 119 +- lispusers/EQUATIONS.LCOM | Bin 28162 -> 28135 bytes lispusers/GITFNS.PDF | Bin 0 -> 30511 bytes lispusers/GREP | 22 +- lispusers/GREP.LCOM | Bin 3240 -> 4115 bytes lispusers/MODERNIZE | 28 +- lispusers/MODERNIZE.LCOM | Bin 10582 -> 10541 bytes lispusers/REGIONMANAGER | 30 +- lispusers/REGIONMANAGER.LCOM | Bin 9650 -> 9661 bytes lispusers/TEDIT-PF-SEE | 60 +- lispusers/TEDIT-PF-SEE.LCOM | Bin 3930 -> 4937 bytes lispusers/TEDIT-PF-SEE.TEDIT | Bin 4103 -> 4562 bytes lispusers/tmax/TMAX | 37 +- lispusers/tmax/TMAX-DATE | 67 +- lispusers/tmax/TMAX-DATE.LCOM | Bin 6305 -> 6232 bytes lispusers/tmax/TMAX-ENDNOTE | 16 +- lispusers/tmax/TMAX-ENDNOTE.LCOM | Bin 10385 -> 10388 bytes lispusers/tmax/TMAX-INDEX | 39 +- lispusers/tmax/TMAX-INDEX.LCOM | Bin 17784 -> 17773 bytes lispusers/tmax/TMAX-NUMBER | 116 +- lispusers/tmax/TMAX-NUMBER.LCOM | Bin 15655 -> 15391 bytes lispusers/tmax/TMAX-XREF | 66 +- lispusers/tmax/TMAX-XREF.LCOM | Bin 10958 -> 10864 bytes lispusers/tmax/TMAX.LCOM | Bin 15247 -> 14767 bytes lispusers/tmax/TMAX.pdf | Bin 0 -> 51894 bytes sources/ADISPLAY | 89 +- sources/ADISPLAY.LCOM | Bin 71872 -> 71737 bytes sources/UFS | 50 +- sources/UFS.LCOM | Bin 36725 -> 36619 bytes sources/WINDOW | 187 +- sources/WINDOW.LCOM | Bin 67824 -> 67636 bytes sources/WINDOWOBJ | 32 +- sources/WINDOWOBJ.LCOM | Bin 12874 -> 12946 bytes 88 files changed, 18046 insertions(+), 13316 deletions(-) create mode 100644 internal/TEDIT-DEBUG create mode 100644 internal/TEDIT-DEBUG.LCOM create mode 100644 library/tedit/TEDIT-BUTTONS create mode 100644 library/tedit/TEDIT-BUTTONS.LCOM create mode 100644 library/tedit/TEDIT-RELEASENOTES.TEDIT create mode 100644 library/tedit/TEDIT-RENAMES create mode 100644 lispusers/GITFNS.PDF create mode 100644 lispusers/tmax/TMAX.pdf diff --git a/internal/TEDIT-DEBUG b/internal/TEDIT-DEBUG new file mode 100644 index 00000000..bd61d0ea --- /dev/null +++ b/internal/TEDIT-DEBUG @@ -0,0 +1,2455 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "16-Dec-2024 20:38:14" {WMEDLEY}TEDIT-DEBUG.;123 130350 + + :EDIT-BY rmk + + :CHANGES-TO (FNS SP) + + :PREVIOUS-DATE "14-Dec-2024 14:32:20" {WMEDLEY}TEDIT-DEBUG.;122) + + +(PRETTYCOMPRINT TEDIT-DEBUGCOMS) + +(RPAQQ TEDIT-DEBUGCOMS + [ + (* ;; "This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/.") + + + (* ;; "This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented.") + + + (* ;; + "This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.") + + (VARS (\TEDIT.THELPFLG T)) + (COMS (* ; + "Get/set (default) object, stream, window, selection") + (FNS GTO GTS GTW GSEL) + (INITVARS (LASTTEXTSTREAM NIL))) + (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)) + (COMS (FNS NTHPIECE NPIECES NTHPIECECHAR SELPIECE PIECENUM PCBYTES)) + (COMS (FNS FILEBYTES TFILEBYTES)) + (FNS TRELMOVE TSCROLL TSCROLL*) + (FNS TRY TEDITCLOSEW PARALASTWITHOUTEOL FIXPARALAST) + (FNS SPPRINT SPPRINT.CHAR SPPRINT.OBJ SHOWPIECEBYTES CHECKPLENGTHS SBT COPYPCHAIN) + (FNS POSLINE) + (FNS PRESPLIT) + (FNS ALLTL NTHCHARSLOT) + (* ; "THISLINE") + (FNS PLCHAIN PRINTLINE SL.GETLINES CHECKLINES COLLECTLINES NTHLINE HEIGHT LINEBOTS) + (FNS IPC.DECODEARGS) + (FNS SPF1) + (* ; "Page frames") + (FNS SLF.FATPLEN FILEPIECE) + (* ; "Show looks file") + (FNS SELTEDIT) + (* ; "New editor on an old selection") + (COMS (* ; "Bravo") + (FNS PPARA PRUN ADDLINEPOSITIONS SBR SBC)) + (INITVARS (LASTTS NIL)) + (VARS (OK.TO.MODIFY.FNS T)) + (FNS DFOV OLDWI DFOV.OLDEST COMP DFR) + (FNS DFGV GDIRECTORIES) + (COMS (FNS TTEST LTEST THC) + (INITVARS (LASTTTESTFILE)) + (VARS * TTESTREGIONS)) + (COMS (FNS SHOWSAFE) + (INITVARS SAFESHOW SAFEHELP)) + (FNS MYH) + (VARS VTDIR VTF TF) + (FNS DFVENUE VSEE) + (FNS PTT) + (* ; "Plain text") + (MACROS DEBUGOUTPUT) + (FNS TEDIT-DEBUG) + (FNS TRENAME) + (FILES (NOERROR) + VERSIONDEFS) + (* ; "Until this is release") + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA VSEE DFGV DFOV) + (NLAML DFVENUE DFR) + (LAMA]) + + + +(* ;; +"This is an internal/ file containing a hodge-podge of functions for use in Tedit debugging. To start working on TEDIT, (LOAD 'TEDIT-DEBUG.LCOM) and then run (TEDIT--DEBUG). That will load TEDIT-EXPORTS.ALL and EXPORTS.ALL, load the fuller database if available, and analyze the functions on TEDITFILES. And leave you connected to {MEDLEYDIR}/library/tedit/." +) + + + + +(* ;; +"This has functions for accessing,showing, inspecting and manipulating a variety of internal Tedit data structures (textobj, piece, line, selection, thisline), and other random bits of code. It has grown as different issues have been addressed, at some point it should be cleaned up and documented." +) + + + + +(* ;; +"This is stored in internal/ so that it remains compatible with the commits/branches/PRs/releases.") + + +(RPAQQ \TEDIT.THELPFLG T) + + + +(* ; "Get/set (default) object, stream, window, selection") + +(DEFINEQ + +(GTO + [LAMBDA (ARG NOERROR) (* ; "Edited 9-Aug-2024 13:14 by rmk") + (LET ((TSTREAM (GTS ARG NOERROR))) + (CL:WHEN TSTREAM + (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))]) + +(GTS + [LAMBDA (ARG NOERROR) (* ; "Edited 23-Nov-2024 11:38 by rmk") + (* ; "Edited 4-Oct-2024 22:13 by rmk") + (* ; "Edited 21-Sep-2024 21:51 by rmk") + (* ; "Edited 11-Aug-2024 21:53 by rmk") + (CL:UNLESS (AND (TEXTSTREAM LASTTEXTSTREAM T) + (OPENWP (\TEDIT.PRIMARYPANE LASTTEXTSTREAM))) + (SETQ LASTTEXTSTREAM NIL)) + (LET* ((TWINDOWS (for W in (OPENWINDOWS) when (WINDOWPROP W 'TEDITCREATED) collect W)) + (TSTREAM (TEXTSTREAM (OR ARG (CL:IF (CDR TWINDOWS) + (WHICHW) + (CAR TWINDOWS))) + T))) + (if TSTREAM + then (if (EQ TSTREAM LASTTEXTSTREAM) + elseif (NULL LASTTEXTSTREAM) + then (SETQ LASTTEXTSTREAM TSTREAM) + elseif (AND (NOT (OR (type? TEXTOBJ ARG) + (STREAMP ARG))) + (EQ 'Y (ASKUSER NIL 'Y " Switch default textstream? "))) + then (SETQ LASTTEXTSTREAM TSTREAM)) + TSTREAM + elseif (AND (NULL ARG) + LASTTEXTSTREAM) + elseif NOERROR + then NIL + else (TEXTSTREAM ARG]) + +(GTW + [LAMBDA (ARG) (* ; "Edited 5-Nov-2024 13:50 by rmk") + (\TEDIT.PRIMARYPANE (GTO ARG]) + +(GSEL + [LAMBDA (WHICH ARG) (* ; "Edited 25-Nov-2024 14:19 by rmk") + (* ; "Edited 11-Feb-2024 09:07 by rmk") + (* ; "Edited 23-May-2023 00:03 by rmk") + (TEXTSEL (GTO ARG]) +) + +(RPAQ? LASTTEXTSTREAM NIL) + + + +(* ; "Inspect") + +(DEFINEQ + +(IPC + [LAMBDA (PC TOBJ) (* ; "Edited 3-Dec-2024 16:51 by rmk") + (* ; "Edited 4-Oct-2024 11:03 by rmk") + (* ; "Edited 29-Sep-2024 15:03 by rmk") + (* ; "Edited 22-Aug-2024 23:14 by rmk") + (* ; "Edited 25-Jul-2024 17:47 by rmk") + + (* ;; "Inspects the piece specified by decoding PC and TOBJ") + (* ; "Edited 6-Nov-2023 08:03 by rmk") + (LET (PCWINDOW OBJWINDOW TAG (DECODED (IPC.DECODEARGS PC TOBJ))) + (SETQ PC (POP DECODED)) + (if PC + then (SETQ TAG (POP DECODED)) + (SETQ PCWINDOW (INSPECT PC NIL NIL TAG)) + (CL:WHEN (POBJ PC) + (SETQ OBJWINDOW (INSPECT (POBJ PC) + NIL + (RELCREATEPOSITION (LIST PCWINDOW 'RIGHT -2) + (LIST PCWINDOW 'BOTTOM)) + TAG)) + (CLOSEWITH OBJWINDOW PCWINDOW) + (MOVEWITH OBJWINDOW PCWINDOW)) + else (PRINTOUT T "No such piece")) + PC]) + +(ILINES + [LAMBDA (LINES TAG WHERE) (* ; "Edited 28-Jun-2024 15:22 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Apr-2024 13:48 by rmk") + (* ; "Edited 27-Nov-2023 12:52 by rmk") + (* ; "Edited 21-Oct-2023 10:22 by rmk") + (* ; "Edited 9-May-2023 15:45 by rmk") + (* ; "Edited 28-Mar-2023 22:02 by rmk") + (* ; "Edited 25-Mar-2023 15:26 by rmk") + (* ; "Edited 22-Feb-2023 11:08 by rmk") + (* ; "Edited 21-Feb-2023 00:11 by rmk") + (* ; "Edited 9-Oct-2022 08:36 by rmk") + (DECLARE (USEDFREE TEXTOBJ)) (* ; "Edited 17-Sep-2022 11:50 by rmk") + (if (type? SELECTION LINES) + then [LET (WINDOW) + (CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch L1 of LINES))) + (SETQ WINDOW (ILINES (fetch L1 of LINES) + 'L2))) + (CL:WHEN (type? LINEDESCRIPTOR (CAR (fetch LN of LINES))) + (if WINDOW + then (ATTACHWINDOW (ILINES (fetch LN of LINES) + 'LN) + WINDOW + 'RIGHT + 'TOP) + else (ILINES (fetch LN of LINES) + 'LN)))] + else [SETQ LINES (if (type? LINEDESCRIPTOR LINES) + then LINES + elseif (type? LINEDESCRIPTOR (CAR (LISTP LINES))) + then (CAR LINES) + else (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO LINES] + (INSPECT/TOP/LEVEL/LIST (COLLECTLINES LINES) + WHERE TAG]) + +(ISEL + [LAMBDA (ARG TAG) (* ; "Edited 3-Oct-2024 14:51 by rmk") + (* ; "Edited 6-Sep-2024 10:36 by rmk") + (* ; "Edited 4-Jun-2023 13:02 by rmk") + (* ; "Edited 27-Apr-2023 10:29 by rmk") + (LET [(SEL (CL:IF (type? SELECTION ARG) + ARG + (TEXTSEL (GTO ARG)))] + (INSPECT SEL NIL NIL TAG) + SEL]) + +(ITS + [LAMBDA (TS NPIECES) (* ; "Edited 25-Nov-2024 18:27 by rmk") + (* ; "Edited 26-Nov-2023 20:46 by rmk") + (* ; "Edited 31-Oct-2023 19:44 by rmk") + (* ; "Edited 21-Oct-2023 17:04 by rmk") + (* ; "Edited 9-Oct-2022 13:01 by rmk") + (* ; "Edited 14-Sep-2022 08:33 by rmk") + + (* ;; "Inspect the key components of a Text stream TS") + + (SETQ TS (GTS TS)) + (LET (TSW WS) + (SETQ TSW (INSPECT TS 'TEXTSTREAM (RELCREATEPOSITION 'TTY 5))) + (* ; "The text stream fields") + (push WS (INSPECT TS 'STREAM (RELCREATEPOSITION (LIST TSW 'RIGHT 2) + 5))) (* ; "All stream fields") + (push WS (INSPECT (TEXTOBJ TS) + 'TEXTOBJ + (RELCREATEPOSITION (LIST (CAR WS) + 'RIGHT 2) + 5))) + (push WS (INSPECT (GETTOBJ (TEXTOBJ TS) + PCTB) + 'LIST + (RELCREATEPOSITION (LIST (CAR WS) + 'RIGHT 2) + 5))) + (CLOSEWITH WS TSW) + (MOVEWITH WS TSW)) + (SP TS (OR NPIECES 10)) + TS]) + +(IPANES + [LAMBDA (ARG TAG WHERE) (* ; "Edited 28-Jun-2024 21:21 by rmk") + (INSPECT/ALIST (for P inpanes (GTO ARG) collect (CONS P (PANEPROPS P))) + WHERE TAG]) + +(ITL + [LAMBDA (THISLINE) (* ; "Edited 29-Jul-2024 09:42 by rmk") + + (* ;; "Inspect THISLINE") + + (CL:UNLESS (type? THISLINE THISLINE) + (CL:WHEN (EQ THISLINE T) + (SETQ THISLINE NIL) + (SETQ LASTCS CHARSLOT)) + (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) + (INSPECT THISLINE) + THISLINE]) + +(IHIST + [LAMBDA (LAST ARG) (* ; "Edited 8-Dec-2024 20:33 by rmk") + (* ; "Edited 21-Jun-2023 14:24 by rmk") + (* ; "Edited 1-Jun-2023 22:31 by rmk") + (* ; "Edited 31-May-2023 11:35 by rmk") + (* ; "Edited 4-May-2023 20:25 by rmk") + (LET* ((TEXTOBJ (GTO ARG)) + (EVENTS (GETTOBJ TEXTOBJ TXTHISTORY)) + (UNDONEEVENTS (GETTOBJ (GTO ARG) + TXTHISTORYUNDONE)) + HISTW HISTUNDOW HISTUNDOWHERE) + (CL:WHEN EVENTS + [SETQ HISTW (if LAST + then (INSPECT (CAR EVENTS) + 'LIST NIL 'HIST) + else (INSPECT EVENTS 'LIST NIL 'HIST]) + (CL:WHEN UNDONEEVENTS + (CL:WHEN HISTW + [SETQ HISTUNDOWHERE (RELCREATEPOSITION (LIST HISTW 'RIGHT) + (LIST HISTW 'BOTTOM] + + (* ;; "Make it wide so the undo events show up") + + [SETQ HISTUNDOWHERE (CREATEW (CREATEREGION (fetch (POSITION XCOORD) of + HISTUNDOWHERE + ) + (fetch (POSITION YCOORD) of HISTUNDOWHERE) + 600 + (TIMES (FONTPROP (DSPFONT DEFAULTFONT) + 'HEIGHT) + (IPLUS 1 (LENGTH UNDONEEVENTS]) + [SETQ HISTUNDOW (if LAST + then (INSPECT (CAR UNDONEEVENTS) + (AND (LIST (CAR UNDONEEVENTS)) + 'LIST) + HISTUNDOWHERE + 'HISTUNDO) + else (INSPECT UNDONEEVENTS 'LIST HISTUNDOWHERE 'HISTUNDO] + (CL:WHEN HISTW + (CLOSEWITH HISTUNDOW HISTW) + (MOVEWITH HISTUNDOW HISTW))) + (LIST (LENGTH EVENTS) + (LENGTH UNDONEEVENTS]) + +(IPCTB + [LAMBDA (ARG) (* ; "Edited 31-Oct-2023 19:45 by rmk") + (* ; "Edited 4-May-2023 20:28 by rmk") + (INSPECT (FETCH (TEXTOBJ PCTB) of (GTO ARG)) + 'LIST]) + +(IMB + [LAMBDA (KEY ARG) (* ; "Edited 22-Aug-2024 16:34 by rmk") + (* ; "Edited 21-Aug-2024 10:00 by rmk") + (* ; "Edited 8-Aug-2024 09:08 by rmk") + (* ; "Edited 4-Aug-2024 09:05 by rmk") + + (* ;; "Inspect the menu button for KEY") + + (LET [(OBJ (MB.FIND KEY (GTO ARG) + 'OBJECT] + (CL:IF OBJ (INSPECT OBJ NIL NIL KEY]) + +(ICL + [LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk") + (* ; "Edited 4-Oct-2024 13:33 by rmk") + + (* ;; "Inspect the character looks of PC") + (* ; "Edited 11-Apr-2023 11:42 by rmk") + (LET ((DECODED (IPC.DECODEARGS PC ARG))) + (SETQ PC (POP DECODED)) + (INSPECT (PCHARLOOKS PC) + NIL NIL (CONCAT PC " " (POP DECODED]) + +(IPL + [LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 17:01 by rmk") + (* ; "Edited 11-Apr-2023 11:42 by rmk") + (LET ((DECODED (IPC.DECODEARGS PC ARG))) + (SETQ PC (POP DECODED)) + (INSPECT (PPARALOOKS PC) + NIL NIL (CONCAT PC " " (POP DECODED]) + +(ICARET + [LAMBDA (ARG) (* ; "Edited 27-Nov-2024 13:48 by rmk") + (* ; "Edited 4-Oct-2024 13:33 by rmk") + (* ; "Edited 11-Apr-2023 11:42 by rmk") + (INSPECT (PANECARET (GTW ARG]) + +(INSPECTPIECES + [LAMBDA (PIECE N TAG WHERE) (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 30-Dec-2023 14:47 by rmk") + (* ; "Edited 1-Dec-2023 21:34 by rmk") + (* ; "Edited 27-Nov-2023 12:51 by rmk") + (CL:UNLESS (type? PIECE PIECE) + [SETQ PIECE (if (FIXP PIECE) + then (NTHPIECE (GTO) + PIECE) + elseif (type? SELECTION PIECE) + then (SELPIECE PIECE) + else (\TEDIT.FIRSTPIECE (GTO PIECE]) + (CL:UNLESS (FIXP N) + (SETQ WHERE TAG) + (SETQ TAG N) + (SETQ N 20)) + (LET (W PIECES) + (SETQ PIECES (for PC inpieces PIECE as I from 1 to N collect PC)) + (SETQ W (INSPECT/TOP/LEVEL/LIST PIECES)) + (WINDOWPROP W 'TITLE PIECE) + PIECE]) +) + + + +(* ; "Show") + +(DEFINEQ + +(SP + [LAMBDA (PC NP OFILE TOBJ FONT NOCR) (* ; "Edited 16-Dec-2024 15:50 by rmk") + (* ; "Edited 30-Nov-2024 19:34 by rmk") + (* ; "Edited 26-Nov-2024 20:53 by rmk") + (* ; "Edited 23-Nov-2024 15:35 by rmk") + (* ; "Edited 9-Sep-2024 14:53 by rmk") + (* ; "Edited 1-Sep-2024 00:05 by rmk") + (* ; "Edited 11-Aug-2024 21:06 by rmk") + (* ; "Edited 15-Jun-2024 11:52 by rmk") + (* ; "Edited 21-May-2024 11:29 by rmk") + (* ; "Edited 13-May-2024 12:16 by rmk") + (* ; "Edited 5-May-2024 12:56 by rmk") + (* ; "Edited 29-Apr-2024 12:46 by rmk") + (* ; "Edited 17-Mar-2024 12:58 by rmk") + (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 11-Jan-2024 22:19 by rmk") + (* ; "Edited 3-Jan-2024 00:41 by rmk") + (* ; "Edited 27-Dec-2023 13:02 by rmk") + (* ; "Edited 25-Nov-2023 10:49 by rmk") + (* ; "Edited 23-Nov-2023 11:47 by rmk") + (* ; "Edited 21-Oct-2023 10:56 by rmk") + + (* ;; "PC is the starting piece, NP is the number of pieces including it.") + + (* ;; "OFILE=T or TEDIT means Tedit stream. NIL means primary output (usually T)") + + (PROG ((TEXTOBJ (CL:IF (type? TEXTOBJ PC) + PC + (GTO TOBJ))) + WTYPE) + (CL:WHEN (AND NP (LITATOM NP) + (NULL OFILE)) + (SETQ WTYPE (CL:IF (EQ NP T) + 'SP + NP)) + (SETQ NP NIL)) + (CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ)) + (PRINTOUT T "Document is empty" T) + (RETURN)) + [if (type? PIECE PC) + elseif (NULL PC) + then [SETQ PC (\TEDIT.FIRSTPIECE (OR TEXTOBJ (GTO] + elseif [AND (FIXP PC) + (OR TEXTOBJ (AND TOBJ (SETQ TEXTOBJ (GTO] + then (SETQ PC (NTHPIECE TEXTOBJ PC)) + elseif [OR (type? SELECTION PC) + (MEMB PC '(SEL T] + then (CL:UNLESS TEXTOBJ + (SETQ TEXTOBJ (TEXTOBJ PC))) + (SETQ PC (SELPIECE TEXTOBJ)) + elseif (OR (EQ PC TEXTOBJ) + (SETQ TEXTOBJ (GTO PC T))) + then (SETQ PC (\TEDIT.FIRSTPIECE TEXTOBJ)) + elseif (type? LINEDESCRIPTOR (CAR (MKLIST PC))) + then + (* ;; "Assume it's from the current TEXTOBJ") + + (SETQ PC (\TEDIT.CHTOPC (GETLD (CAR (MKLIST PC)) + LCHAR1) + (GTO TEXTOBJ] + (CL:UNLESS (SMALLP NP) + (SETQ NP (CL:IF NP + 20 + MAX.SMALLP))) + (DEBUGOUTPUT OFILE WTYPE (DSPFONT (OR FONT '(TERMINAL 8)) + OFILE) + (for P PFILES inpieces PC as I from 1 to NP as PCNO + from (OR (PIECENUM PC TEXTOBJ) + 1) do + (* ;; "Put the fileptrs back where they were.") + + (CL:WHEN (AND (MEMB (PTYPE PC) + FILE.PTYPES) + (NOT (MEMB (PCONTENTS PC) + PFILES))) + (CL:UNLESS (GETSTREAM (PCONTENTS PC) + 'INPUT T) + (\TEDIT.REOPEN.STREAM TEXTOBJ)) + [RESETSAVE (GETFILEPTR (PCONTENTS PC)) + `(PROGN (SETFILEPTR ,(PCONTENTS PC) + OLDVALUE]) + (PRINTOUT OFILE .I3 PCNO "/") + (SPPRINT P OFILE TEXTOBJ NOCR)) + (TERPRI OFILE)) + (RETURN PC]) + +(SL + [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ OFILE) (* ; "Edited 7-Dec-2024 16:34 by rmk") + (* ; "Edited 3-Dec-2024 10:29 by rmk") + (* ; "Edited 25-Nov-2024 21:42 by rmk") + (* ; "Edited 18-Nov-2024 21:28 by rmk") + (* ; "Edited 9-Nov-2024 23:22 by rmk") + (* ; "Edited 28-Oct-2024 22:25 by rmk") + (* ; "Edited 27-Oct-2024 18:38 by rmk") + (* ; "Edited 25-Oct-2024 22:25 by rmk") + (* ; "Edited 21-Oct-2024 23:08 by rmk") + + (* ;; "Shows a selection of the lines backing the display in PANE") + + (LET (LINES WTYPE PNO) + (CL:UNLESS OFILE + (CL:WHEN (EQ LASTLINE T) + (SETQ WTYPE 'SL) + (SETQ LASTLINE NIL))) + (CL:WHEN [AND (type? LINEDESCRIPTOR (CAR (LISTP FIRSTLINE))) + (NULL LASTLINE) + (OR (NULL (CDR FIRSTLINE)) + (type? LINEDESCRIPTOR (CDR FIRSTLINE] + (SETQ LASTLINE (CDR FIRSTLINE)) (* ; "BITMAPLINES ?") + (SETQ FIRSTLINE (CAR FIRSTLINE))) + (SETQ LINES (SL.GETLINES FIRSTLINE LASTLINE PANE TOBJ)) + (SETQ FIRSTLINE (pop LINES)) + (SETQ LASTLINE (pop LINES)) + (SETQ TOBJ (pop LINES)) + (SETQ PANE (pop LINES)) + (SETQ PNO (pop LINES)) + (DEBUGOUTPUT OFILE WTYPE (PRINTOUT OFILE .FONT '(TERMINAL 8) + "Pane " PNO " = " PANE T) + (PRINTOUT OFILE .FONT '(TERMINAL 8) + 15 "HT" -3 "BOT" 27 .FONT '(TERMINAL 8 BOLD) + "C1" 36 "CN" .FONT '(TERMINAL 8) + 40 "LN/*=PARALAST" T) + (for L inlines FIRSTLINE do (SHOWLINE L OFILE TOBJ) repeatuntil (EQ L LASTLINE) + finally (CL:WHEN (EQ LASTLINE (PANEBOTTOMLINE PANE)) + (SHOWLINE (PANESUFFIX PANE) + OFILE TOBJ))) + (TERPRI OFILE)) + FIRSTLINE]) + +(SSP + [LAMBDA (SELPIECES NP OFILE TEXTOBJ) (* ; "Edited 26-Nov-2024 20:54 by rmk") + (* ; "Edited 3-Mar-2024 12:58 by rmk") + (* ; "Edited 12-Feb-2024 12:33 by rmk") + (* ; "Edited 22-Nov-2023 20:23 by rmk") + (* ; "Edited 21-Oct-2023 10:52 by rmk") + (* ; "Edited 9-May-2023 13:50 by rmk") + (* ; "Edited 7-May-2023 20:47 by rmk") + + (* ;; "Prints up to NP pieces from SELPIECES.") + + (SETQ TEXTOBJ (GTO TEXTOBJ)) + (DEBUGOUTPUT OFILE (CL:UNLESS OFILE 'SSP) + (for PC inselpieces SELPIECES as I from 1 to (OR NP 50) + do (PRINTOUT OFILE .I3 I "/") + (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") + (* ; "Edited 13-Aug-2024 10:45 by rmk") + (* ; "Edited 11-Jul-2024 10:34 by rmk") + (* ; "Edited 19-Jan-2024 22:32 by rmk") + (* ; "Edited 6-Nov-2023 21:24 by rmk") + + (* ;; + "PAGEFRAMES can be one or more PAGEREGIONs. ARG can be a TEXTOBJ or one of the PAGEREGIONS.") + + (LET (TEXTOBJ PAGEREGIONS) + (if (AND ARG (for PF inside ARG always (type? PAGEREGION PF))) + then (SETQ PAGEREGIONS ARG) + else (SETQ TEXTOBJ (GTO ARG)) + (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) + (SETQ TEXTOBJ (TEXTOBJ (\TEDIT.MAINW TEXTOBJ)))) + (SETQ PAGEREGIONS (GETTOBJ TEXTOBJ TXTPAGEFRAMES))) + (SETQ TITLE (CONCAT "Page regions for " (OR TITLE TEXTOBJ PAGEREGIONS))) + (DEBUGOUTPUT OFILE 'SPF (PRINTOUT OFILE .FONT '(TERMINAL 8 BOLD) + TITLE .FONT '(TERMINAL 8) + T) + (for TYPE PF (FIRSTPF _ (TEDIT.GET.PAGEFORMAT PAGEREGIONS 'FIRST/DEFAULT)) + in '(FIRST/DEFAULT LEFT RIGHT) + collect (SETQ PF (TEDIT.GET.PAGEFORMAT PAGEREGIONS TYPE)) + (PRINTOUT OFILE T .FONT '(TERMINAL 8 BOLD) + (L-CASE TYPE T) + " region " PF .FONT '(TERMINAL 8)) + (if (AND (EQ PF FIRSTPF) + (NEQ TYPE 'FIRST/DEFAULT)) + then (PRINTOUT OFILE " defaults to first" T) + else (TERPRI OFILE) + (PRINTDEF (SPF1 PF) + NIL NIL NIL NIL OFILE)) + (TERPRI OFILE) + PF]) + +(SLF + [LAMBDA (FORMATSTREAM OUTFILE TITLE SHOWPAGEFRAMES) (* ; "Edited 14-Dec-2024 12:38 by rmk") + (* ; "Edited 24-Nov-2024 22:28 by rmk") + (* ; "Edited 23-Nov-2024 13:21 by rmk") + (* ; "Edited 14-Jan-2024 13:14 by rmk") + (* ; "Edited 19-Dec-2023 10:20 by rmk") + (* ; "Edited 28-Aug-2023 21:58 by rmk") + (* ; "Edited 26-Aug-2023 20:07 by rmk") + (RESETLST + [if (GTS FORMATSTREAM T) + then (SETQ FORMATSTREAM (TXTFILE (GTS FORMATSTREAM))) + else (RESETSAVE (SETQ FORMATSTREAM (\TEDIT.OPENTEXTFILE FORMATSTREAM)) + '(PROGN (CLOSEF? OLDVALUE] + [RESETSAVE (GETFILEPTR FORMATSTREAM) + '(PROGN (SETFILEPTR FORMATSTREAM OLDVALUE] + [SELECTQ OUTFILE + (NIL) + ((T TEDIT) + [SETQ OUTFILE (OPENTEXTSTREAM NIL NIL NIL NIL '(APPEND QUIET FONT DEFAULTFONT]) + (RESETSAVE (SETQ OUTFILE (OPENSTREAM OUTFILE 'OUTPUT 'NEW)) + `(PROGN (CLOSEF? OUTFILE OLDVALUE) + (AND (EQ RESETSTATE 'ERROR) + (DELFILE OLDVALUE] + (PROG* ((TRAILER (\TEDIT.GET.TRAILER FORMATSTREAM)) + (PCCOUNT (CADDDR TRAILER))) + (CL:UNLESS TRAILER + (PRINTOUT T FORMATSTREAM " is not a Tedit looks file" T) + (RETURN)) + (for PCNO BYTELEN LTYPE LOOKSMAP PLOOKSMAP LASTCHARLOOKNO (PFPOS _ 0) + (CHNO _ 0) + (TEXTPCNO _ 0) + (START _ (CAR TRAILER)) + (TYPETAB _ 13) + (FPOSTAB _ 28) + (BYTESTAB _ 38) from 1 to PCCOUNT + first (PRINTOUT OUTFILE "Starting FILEPTR = " START " " "PCCOUNT = " PCCOUNT T) + (SETFILEPTR FORMATSTREAM START) + do (SETQ BYTELEN (\DWIN FORMATSTREAM)) + (SETQ LTYPE (\WIN FORMATSTREAM)) + (if (EQ \PieceDescriptorPARA LTYPE) + then (TERPRI OUTFILE) + else (PRINTOUT OUTFILE PCNO "|" (IDIFFERENCE (GETFILEPTR FORMATSTREAM) + 6))) + (SELECTC LTYPE + (\PieceDescriptorPARA + (LET ((PLOOKNO (\WIN FORMATSTREAM)) + PLOOK) + (SETQ PLOOK (ELT PARAMAP PLOOKNO)) + (PRINTOUT OUTFILE .TAB TYPETAB "Paragraph looks " PLOOKNO ": " + (SUBSTRING PLOOK (ADD1 (STRPOS ":" PLOOK 6)) + -2) + T))) + (\PieceDescriptorLOOKS + (LET ((FLAGS (BIN FORMATSTREAM)) + LOOKNO FAT CLOOK) + (SETQ FAT (EQ 2 (LOGAND FLAGS 2))) + (SETQ LOOKNO (\WIN FORMATSTREAM)) + (SETQ CLOOK (ELT LOOKSMAP LOOKNO)) + (SETQ LASTCHARLOOKNO LOOKNO) + (ADD TEXTPCNO 1) + (PRINTOUT OUTFILE .TAB TYPETAB "Char piece #" TEXTPCNO " " .I3 + PFPOS "-" (CL:IF FAT + (SLF.FATPLEN FORMATSTREAM PFPOS BYTELEN) + BYTELEN) + (CL:IF FAT + " fat" + "") + .TAB BYTESTAB .I4 BYTELEN " bytes") + (CL:IF (EQ 1 (LOGAND FLAGS 1)) + " New" + "") + (PRINTOUT OUTFILE " " "Looks " LOOKNO ": ") + (PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T)) + OUTFILE) + (TERPRI OUTFILE) + (ADD PFPOS BYTELEN))) + (\PieceDescriptorOBJECT + (ADD TEXTPCNO 1) + (PRINTOUT OUTFILE .TAB TYPETAB "Objt piece #" TEXTPCNO " " PFPOS "-1" + -1 .I4 BYTELEN " bytes") + (PRINTOUT OUTFILE " " (\ATMIN FORMATSTREAM) + " ") + (LET (CLOOK INDEX) + (SELECTQ (BIN FORMATSTREAM) + (0 (SETQ CLOOK (ELT LOOKSMAP LASTCHARLOOKNO)) + (PRINTOUT OUTFILE "Previous looks " LASTCHARLOOKNO " ")) + (1 (SETQ CLOOK (\TEDIT.GET.SINGLE.CHARLOOKS FORMATSTREAM)) + (PRINTOUT OUTFILE "Inline looks ")) + (SHOULDNT)) + (PRIN3 (CAR (\TEDIT.CHARLOOKS.DEFPRINT CLOOK NIL NIL T)) + OUTFILE) + (TERPRI OUTFILE)) + (ADD PFPOS BYTELEN)) + (\PieceDescriptorPAGEFRAME + (LET ((PFS (READ FORMATSTREAM))) + (PRINTOUT OUTFILE .TAB TYPETAB "Pageframes") + (if SHOWPAGEFRAMES + then (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 4) + .PPV PFS) + else (PRINTOUT OUTFILE "..." T)) + (TERPRI OUTFILE))) + (\PieceDescriptorCHARLOOKSLIST + (PRINTOUT OUTFILE .TAB TYPETAB "Charlooks list") + (add PCNO -1) (* ; "Lists don't count in this format") + (LET ((CHARLOOKLIST (\TEDIT.GET.CHARLOOKS.LIST FORMATSTREAM))) + (SETQ LOOKSMAP (ARRAY (LENGTH CHARLOOKLIST))) + (for I from 1 as CSLOOKS IN CHARLOOKLIST + do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2) + .I2 I ": " (CL:IF (type? FONTCLASS + (fetch (CHARLOOKS CLFONT) + of CSLOOKS)) + (fetch (FONTCLASS FONTCLASSNAME) + of (fetch (CHARLOOKS CLFONT) + of CSLOOKS)) + CSLOOKS) + T) + (SETA LOOKSMAP I CSLOOKS)))) + (\PieceDescriptorPARALOOKSLIST + (PRINTOUT OUTFILE .TAB TYPETAB "Paralooks list") + (add PCNO -1) (* ; "Lists don't count in this format") + (LET ((PARALOOKS (\TEDIT.GET.PARALOOKS.LIST FORMATSTREAM))) + (SETQ PARAMAP (ARRAY (LENGTH PARALOOKS))) + (for I from 1 as PLOOKS in PARALOOKS + do (PRINTOUT OUTFILE .TAB (IPLUS TYPETAB 2) + .I2 I ": " PLOOKS T) + (SETA PARAMAP I PLOOKS)) + (TERPRI OUTFILE))) + "Unknown type")) + (if (TEXTSTREAMP OUTFILE) + then + (* ;; + "Don't return the text stream, let it be collected when the window closes") + + [TEDIT OUTFILE 'Looks% File NIL + `(LEAVE TTY TITLE ,(OR TITLE (CONCAT "SLF for " (FULLNAME FORMATSTREAM + ] + else (RETURN OUTFILE))))]) + +(SHOWLINE + [LAMBDA (LINE FILE TEXTOBJ) (* ; "Edited 20-Nov-2024 00:31 by rmk") + (* ; "Edited 17-Nov-2024 15:56 by rmk") + (* ; "Edited 9-Nov-2024 10:37 by rmk") + (* ; "Edited 1-Sep-2024 16:49 by rmk") + (* ; "Edited 10-May-2024 00:27 by rmk") + (* ; "Edited 2-Dec-2023 23:07 by rmk") + (* ; "Edited 29-Sep-2023 12:37 by rmk") + (* ; "Edited 26-Sep-2023 17:22 by rmk") + (* ; "Edited 15-Jul-2023 21:19 by rmk") + (* ; "Edited 2-Jul-2023 23:55 by rmk") + (LET ((LOC (LOC LINE))) + (PRINTOUT FILE .FONT '(TERMINAL 8) + "L" + (CAR LOC) + "/" + (CDR LOC) + ": " 13 .I4 (GETLD LINE LHEIGHT) + " " %# (CL:IF (GETLD LINE YBOT) + (PRINTOUT NIL .I5 (GETLD LINE YBOT)) + (PRINTOUT T "---")) + " " .FONT '(TERMINAL 8 BOLD) + .I5 + (GETLD LINE LCHAR1) + " -> " .I5 (GETLD LINE LCHARLAST) + .FONT + '(TERMINAL 8) + " " .I3 (GETLD LINE LNCH) + (CL:IF (GETLD LINE LSTLN) + "*" + " ") + .FONT + '(TERMINAL 6) + " ") + (if (GETLD LINE LDUMMY) + then (PRINTOUT FILE -8 (CL:IF (GETLD LINE LDUMMY) + "l" + "") + "dummy" T) + else (for CNO C LASTC (TSTREAM _ (TEXTSTREAM TEXTOBJ)) from (GETLD LINE LCHAR1) + to (GETLD LINE LCHARLAST) first (SETFILEPTR TSTREAM (SUB1 (GETLD LINE LCHAR1))) + (PRINTOUT FILE " %"") until (EOFP TSTREAM) + do (SETQ C (BIN TSTREAM)) (* ; + "This may read LF if that's what's on the file") + (if (SMALLP C) + then (SETQ LASTC C) + (SELCHARQ C + (TAB (PRIN3 "[TAB]" FILE)) + ((EOL CR) + (PRIN3 "[EOL]" FILE)) + (LF (PRIN3 "[LF]" FILE)) + (FORM (PRIN3 "[FORM]" FILE)) + (meta,EOL (PRIN3 "[MLB]" FILE)) + (PRINTCCODE C FILE)) + elseif (IMAGEOBJP C) + then (printout FILE " " C " ")) finally (PRIN3 "%"" FILE) + (TERPRI FILE) + (CL:WHEN (GETLD LINE FORCED-END) + (TERPRI FILE]) + +(SLL + [LAMBDA (LINELIST FILE TEXTOBJ) (* ; "Edited 2-Jul-2023 23:48 by rmk") + + (* ;; "Show a list of lines.") + + (SETQ TEXTOBJ (GTO TEXTOBJ)) + (RESETLST + [RESETSAVE (DSPFONT '(TERMINAL 8) + FILE) + '(PROGN (DSPFONT OLDVALUE FILE] + (for L inside LINELIST do (if (LISTP L) + then (PRINTOUT FILE T "SUBLIST:" T) + (SLL L FILE TEXTOBJ) + elseif L + then (SHOWLINE L FILE TEXTOBJ) + else (PRINTOUT FILE "(NIL LINE)" T))))]) + +(STBYTES + [LAMBDA (FILE OUTFILE) (* ; "Edited 12-Dec-2024 16:44 by rmk") + + (* ;; "Shows the bytes that ought to make up the trailer for FILE as a Tedit formatted file.") + + (SETQ FILE (FINDFILE-WITH-EXTENSIONS FILE NIL *TEDIT-EXTENSIONS*)) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (LET (VERSION) + (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) + 8)) + (PRINTOUT OUTFILE "Piece start: " (BIN STREAM) + " " + (BIN STREAM) + " " + (BIN STREAM) + " " + (BIN STREAM) + " = ") + (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) + 8)) + (PRINTOUT OUTFILE (\DWIN STREAM) + T) + (PRINTOUT OUTFILE "Piece count: " (BIN STREAM) + " " + (BIN STREAM) + " = ") + (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) + 4)) + (PRINTOUT OUTFILE (\WIN STREAM) + T) + (PRINTOUT OUTFILE "Version: " (BIN STREAM) + " " + (BIN STREAM) + " = ") + (SETFILEPTR STREAM (IDIFFERENCE (GETEOFPTR STREAM) + 2)) + (SETQ VERSION (\SMALLPIN STREAM)) + (PRINTOUT OUTFILE VERSION " (" (IDIFFERENCE VERSION 31415) + ")" T]) +) +(DEFINEQ + +(NTHPIECE + [LAMBDA (PIECES N) (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 16-Sep-2023 12:17 by rmk") + (* ; "Edited 22-Jun-2023 12:46 by rmk") + (* ; "Edited 22-May-2023 21:21 by rmk") + (* ; "Edited 9-Apr-2023 11:36 by rmk") + + (* ;; "N=0 means the previous piece of PIECES (if any). This might be the dummy empty piece before the firstpiece of a text object.") + + (CL:UNLESS (type? PIECE PIECES) + (SETQ PIECES (\TEDIT.FIRSTPIECE (GTO PIECES)))) + (if (NULL N) + then (SETQ N 1) + elseif (ILESSP N 0) + then (SETQ N (IPLUS (NPIECES PIECES) + N 1))) + (if (EQ N 0) + then (PREVPIECE PIECES) + else (for PC inpieces PIECES as I from 1 when (EQ I N) do (RETURN PC]) + +(NPIECES + [LAMBDA (TSTREAM) (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 2-Sep-2023 11:02 by rmk") + (* ; "Edited 6-Apr-2023 23:39 by rmk") + (* ; "Edited 24-Mar-2023 10:20 by rmk") + (* ; "Edited 21-Aug-2022 14:47 by rmk") + (* ; "Edited 8-Aug-2022 08:52 by rmk") + (for PC inpieces [if (type? PIECE TSTREAM) + then TSTREAM + else (NEXTPIECE (\TEDIT.FIRSTPIECE (GTO TSTREAM] count T]) + +(NTHPIECECHAR + [LAMBDA (PC N) (* ; "Edited 26-Sep-2023 17:48 by rmk") + (* ; "Edited 8-May-2023 21:25 by rmk") + (* ; "Edited 24-Oct-2022 21:10 by rmk") + + (* ;; "Gets the Nth CHAR of PC, 0 origin. The last character is either -1 or (SUB1 PLEN)") + + (LET ((PLEN (PLEN PC)) + (PCONTENTS (PCONTENTS PC))) + (CL:WHEN (ILESSP N 0) + (add N PLEN)) + (CL:WHEN (AND (IGEQ N 0) + (ILESSP N PLEN)) + (SELECTC (PTYPE PC) + (STRING.PTYPES (NTHCHARCODE PCONTENTS N)) + (THINFILE.PTYPE + (SETFILEPTR PCONTENTS (IPLUS N (fetch (PIECE PFPOS) of PC))) + (BIN PCONTENTS)) + (FATFILE2.PTYPE + (SETFILEPTR PCONTENTS (IPLUS (UNFOLD N 2) + (fetch (PIECE PFPOS) of PC))) + (LOGOR (UNFOLD (BIN PCONTENTS) + 256) + (BIN PCONTENTS))) + (OBJECT.PTYPE PCONTENTS) + (SHOULDNT)))]) + +(SELPIECE + [LAMBDA (ARG) (* ; "Edited 17-Mar-2024 12:58 by rmk") + (* ; "Edited 10-Aug-2023 16:57 by rmk") + + (* ;; "Returns the piece containing the first character of the current selection") + + (SETQ ARG (GTO ARG)) + (\TEDIT.CHTOPC (GETSEL (TEXTSEL ARG) + CH#) + ARG]) + +(PIECENUM + [LAMBDA (PIECE ARG) (* ; "Edited 23-Nov-2024 13:10 by rmk") + (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 16-Sep-2023 09:08 by rmk") + + (* ;; "Returns N if PIECE is the NTH piece of PIECES") + + (CL:UNLESS (type? PIECE PIECE) + (ERROR "NOT A PIECE" PIECE)) + (LET [(PIECES (if (type? PIECE ARG) + then ARG + else (\TEDIT.FIRSTPIECE (GTO ARG] + (find I from 1 as PC inpieces PIECES suchthat (EQ PC PIECE]) + +(PCBYTES + [LAMBDA (PC) (* ; "Edited 31-Jan-2024 22:32 by rmk") + (* ; "Edited 23-Jan-2024 12:04 by rmk") + (* ; "Edited 5-Jan-2024 11:14 by rmk") + + (* ;; "Returns a list of the PFILE bytes for file-piece PC") + + (CL:WHEN (MEMB (PTYPE PC) + FILE.PTYPES) + [LET ((PFILE (PCONTENTS PC))) + (SETFILEPTR PFILE (PFPOS PC)) + (for I BYTE from 1 to (PBYTELEN PC) collect (SETQ BYTE (BIN PFILE)) + (LIST I (CHARACTER BYTE) + BYTE + (SUB1 (GETFILEPTR PFILE])]) +) +(DEFINEQ + +(FILEBYTES + [LAMBDA (FILE START NBYTES) (* ; "Edited 15-May-2024 10:44 by rmk") + (* ; "Edited 23-Jan-2024 12:03 by rmk") + (* ; "Edited 20-Jan-2024 14:13 by rmk") + + (* ;; "CHARS means return CHARACTER of bytes, since we don't know whether START respects FILES external format alignments.") + + (CL:WHEN (GTO FILE T) + (SETQ FILE (SELPIECE FILE))) + (CL:WHEN (type? PIECE FILE) + (CL:WHEN (MEMB (PTYPE FILE) + FILE.PTYPES) + (CL:UNLESS START + (SETQ START (PFPOS FILE))) + (SETQ FILE (PCONTENTS FILE)))) + (CL:UNLESS START (SETQ START 0)) + (CL:UNLESS NBYTES (SETQ NBYTES 40)) + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (SETFILEPTR STREAM START) + (SETQ NBYTES (IMIN NBYTES (IDIFFERENCE (GETEOFPTR STREAM) + START))) + (FOR I B FROM START AS J FROM 1 TO NBYTES COLLECT (SETQ B (BIN STREAM)) + + (* ;; "Do CHARACTER of the byte, since we don't know whether START respected FILE's external-format character alignment.") + + (LIST I B (CHARACTER B]) + +(TFILEBYTES + [LAMBDA (FILE START NBYTES) (* ; "Edited 14-Dec-2024 00:04 by rmk") + (* ; "Edited 23-Nov-2024 15:41 by rmk") + (* ; "Edited 23-Sep-2024 11:40 by rmk") + (LET ((BYTES (FILEBYTES FILE START NBYTES))) + (TEVAL (for B in BYTES first (DSPFONT DEFAULTFONT T) + do (printout T .I6 (CAR B) + " " .I3 (CADR B) + " " .FONT '(MODERN 8) + (SELCHARQ (CADR B) + (EOL 'EOL) + (LF 'LF) + (CR 'CR) + (SPACE "SP") + (CADDR B)) + .FONT DEFAULTFONT T) + T) + 'FILEBYTES + (CONCAT "Bytes from " FILE]) +) +(DEFINEQ + +(TRELMOVE + [LAMBDA (DY ARG) (* ; "Edited 5-Nov-2024 15:29 by rmk") + (RELMOVEW (GTW ARG) + (create POSITION + XCOORD _ 0 + YCOORD _ DY]) + +(TSCROLL + [LAMBDA (DY ARG) (* ; "Edited 5-Nov-2024 15:30 by rmk") + (SCROLLW (GTW ARG) + 0 DY]) + +(TSCROLL* + [LAMBDA (DIST ARG) (* ; "Edited 27-Nov-2024 17:17 by rmk") + + (* ;; "Repeatedly scrolls up or down by DIST") + + (bind (W _ (GTW ARG)) do (SELECTQ [ASKUSER NIL NIL NIL '((U NIL CONFIRMFLG NIL RETURN + 'UP) + (D NIL CONFIRMFLG NIL RETURN + 'DOWN) + (F NIL CONFIRMFLG NIL RETURN + 'FINISHED] + (UP (SCROLLW W 0 DIST)) + (DOWN (SCROLLW W 0 (IMINUS DIST))) + (FINISHED (RETURN)) + (RETURN]) +) +(DEFINEQ + +(TRY + [LAMBDA (FILE VAR KEEPOPEN) (* ; "Edited 17-Mar-2024 12:57 by rmk") + (* ; "Edited 5-Sep-2022 18:48 by rmk") + (* ; "Edited 1-Sep-2022 22:43 by rmk") + (* ; "Edited 10-Aug-2022 13:12 by rmk") + (* ; "Edited 1-Aug-2022 21:30 by rmk") + (CL:UNLESS VAR + (SETQ VAR 'TSTR)) + (LET [(TSTREAM (AND (BOUNDP VAR) + (TEXTSTREAMP (EVAL VAR] + (CL:WHEN (AND TSTREAM (OPENWP (WFROMDS TSTREAM))) + (CL:UNLESS KEEPOPEN + (CLOSEW (WFROMDS TSTREAM)))) + (SETQ TSTREAM (OPENTEXTSTREAM (SELECTQ FILE + (NIL '{LI}FEW.TXT) + (T '{LI}LOTS.TXT) + FILE))) + (TEDIT TSTREAM (CREATEREGION 817 900 397 80) + NIL + '(LEAVETTY T)) + (SET VAR TSTREAM) + (PROG1 (ITS TSTREAM KEEPOPEN) + (\TEDIT.CHECK-BTREE TSTREAM]) + +(TEDITCLOSEW + [LAMBDA NIL (* ; "Edited 1-Sep-2022 22:52 by rmk") + (LET ((W (WHICHW))) + (CL:WHEN (MEMB 'TEDIT.DEACTIVATE.WINDOW (WINDOWPROP W 'CLOSEFN)) + [WINDOWPROP W 'CLOSEFN (REMOVE 'TEDIT.DEACTIVATE.WINDOW (WINDOWPROP W 'CLOSEFN] + (CLOSEW W))]) + +(PARALASTWITHOUTEOL + [LAMBDA (TSTREAM HELP) (* ; "Edited 17-Mar-2024 12:55 by rmk") + (* ; "Edited 16-Mar-2024 10:06 by rmk") + (* ; "Edited 21-Oct-2023 10:54 by rmk") + (* ; "Edited 24-Oct-2022 21:07 by rmk") + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (PPARALAST PC) + unless (MEMB (NTHPIECECHAR PC -1) + (CHARCODE (EOL CR LF))) do (SPPRINT PC NIL TEXTOBJ) + (CL:WHEN HELP + (HELP PC (\TEDIT.PCTOCH PC TEXTOBJ)))]) + +(FIXPARALAST + [LAMBDA (TSTREAM HELP) (* ; "Edited 16-Mar-2024 10:06 by rmk") + (* ; "Edited 24-Oct-2022 21:59 by rmk") + (for (PC _ (\TEDIT.FIRSTPIECE (TEXTOBJ TSTREAM))) by (NEXTPIECE PC) while PC + when (PPARALAST PC) unless (MEMB (NTHPIECECHAR PC -1) + (CHARCODE (EOL CR LF))) + do (replace (PIECE PPARALAST) of PC with NIL]) +) +(DEFINEQ + +(SPPRINT + [LAMBDA (P OSTREAM TEXTOBJ NOCR) (* ; "Edited 5-Aug-2024 00:30 by rmk") + (* ; "Edited 5-May-2024 12:55 by rmk") + (* ; "Edited 23-Apr-2024 08:54 by rmk") + (* ; "Edited 17-Mar-2024 12:58 by rmk") + (* ; "Edited 22-Jan-2024 20:52 by rmk") + (* ; "Edited 13-Jan-2024 23:54 by rmk") + (* ; "Edited 28-Dec-2023 21:21 by rmk") + (* ; "Edited 26-Dec-2023 09:00 by rmk") + (* ; "Edited 23-Dec-2023 16:55 by rmk") + (* ; "Edited 7-Dec-2023 15:55 by rmk") + (* ; "Edited 9-Nov-2023 17:04 by rmk") + (* ; "Edited 24-Oct-2022 17:13 by rmk") + (* ; "Edited 8-Aug-2022 15:36 by rmk") + (* ; + "TMAX image objects want TEXTOBJ context, although they shouldn't") + (DECLARE (SPECVARS TEXTOBJ)) + (CL:WHEN (FIXP P) + (SETQ P (\TEDIT.CHTOPC P TEXTOBJ))) + + (* ;; "Prints a summary of PC on OSTREAM. If PC is acharno and TEXTOBJ is provided, maps the CHNO to its pc.") + + (COND + ((PCONTENTS P) + (LET ((POS (POSITION OSTREAM)) + (PLEN (PLEN P)) + (PCONTENTS (PCONTENTS P)) + (PTYPE (PTYPE P)) + (CHNO (CL:IF (FGETPC P PTREENODE) + (\TEDIT.PCTOCH P TEXTOBJ) + 1)) + (FONT (DSPFONT NIL OSTREAM)) + (PARALOOKS (PPARALOOKS P))) + (CL:WHEN (AND (STREAMP PCONTENTS) + (NOT (\GETSTREAM PCONTENTS 'INPUT T))) + (SETQ PCONTENTS (\TEDIT.REOPEN.STREAM TEXTOBJ PCONTENTS))) + (PRINTOUT OSTREAM .TAB0 POS .I3 CHNO " P" (SUBSTRING P (IPLUS 2 (STRPOS "}" P))) + .TAB0 + (IPLUS 22 POS) + " ") + (CL:WHEN (MEMB PTYPE FILE.PTYPES) + (SETFILEPTR PCONTENTS (PFPOS P))) + (PRINTOUT OSTREAM (SELECTC PTYPE + (THINFILE.PTYPE + 'Thinfile) + (FATFILE1.PTYPE + "Fatfile1") + (FATFILE2.PTYPE + 'Fatfile2) + (THINSTRING.PTYPE + 'Thinstring) + (FATSTRING.PTYPE + 'Fatstring) + (UTF8.PTYPE 'UFT-8) + (SUBSTREAM.PTYPE + 'Substream) + (OBJECT.PTYPE 'Object) + (LOOKS.PTYPE 'Looks) + NIL) + .TAB0 + (IPLUS POS 35) + .I4 PLEN (CL:IF (PPARALAST P) + "*" + "") + (CL:IF (type? FMTSPEC PARALOOKS) + (if (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOKS) + then (CL:IF (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS) + "ba" + "b") + elseif (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOKS) + then "a" + else "") + "") + .TAB0 + (IPLUS POS 43)) + (CL:WHEN (EQ OSTREAM T) + (DSPFONT '(MODERN 8) + OSTREAM)) + [if (EQ PLEN 0) + then (PRINTOUT OSTREAM "[Empty piece]" T) + elseif (EQ OBJECT.PTYPE (PTYPE P)) + then (PRINTOUT OSTREAM PCONTENTS -3) + (SPPRINT.OBJ PCONTENTS OSTREAM (IPLUS POS 43)) + else (CL:WHEN (AND (type? CHARLOOKS (PLOOKS P)) + (fetch (CHARLOOKS CLINVISIBLE) of (PLOOKS P))) + (PRIN1 "i " OSTREAM)) + (PRIN1 "%"" OSTREAM) + (for I C from 1 to PLEN + do (SETQ C (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ P I)) + (PRIN1 (SELCHARQ C + ((EOL CR) + "[EOL]") + (LF "[LF]") + (FORM "[FORM]") + (TAB "[TAB]") + (Meta,TAB "[MTAB]") + (Meta,EOL "[MLB]") + (CHARACTER C)) + OSTREAM) + (CL:WHEN (IEQP I PLEN) + (PRIN1 '%" OSTREAM)) + (CL:WHEN [AND (NOT NOCR) + (MEMB C (CHARCODE (EOL CR LF FORM] + (TERPRI OSTREAM) + (CL:UNLESS (IEQP I PLEN) + (DSPFONT (PROG1 (DSPFONT FONT OSTREAM) + + (* ;; "Add1 for %"") + + (TAB (ADD1 42) + 0 OSTREAM)) + OSTREAM)))] + (TERPRI OSTREAM) + (DSPFONT FONT OSTREAM))) + (T (PRINTOUT OSTREAM "Piece has no CONTENTS" P T))) + P]) + +(SPPRINT.CHAR + [LAMBDA (C OSTREAM LAST FONT) (* ; "Edited 4-Nov-2023 22:51 by rmk") + (* ; "Edited 8-Aug-2023 18:15 by rmk") + (* ; "Edited 6-Aug-2023 22:20 by rmk") + (HELP 'NOTUSED) + (PRIN1 (SELCHARQ C + ((EOL CR) + "[EOL]") + (LF "[LF]") + (FORM "[FORM]") + (TAB "[TAB]") + (Meta,TAB "[MTAB]") + (CHARACTER C)) + OSTREAM) + (CL:WHEN LAST + (PRIN1 '%" OSTREAM)) + (CL:WHEN (MEMB C (CHARCODE (EOL CR LF FORM))) + (TERPRI OSTREAM) + (CL:UNLESS LAST + (DSPFONT (PROG1 (DSPFONT FONT OSTREAM) + + (* ;; "Add1 for %"") + + (TAB (ADD1 42) + 0 OSTREAM)) + OSTREAM)))]) + +(SPPRINT.OBJ + [LAMBDA (OBJ STREAM POS) (* ; "Edited 6-Oct-2024 20:54 by rmk") + (* ; "Edited 29-Sep-2024 14:45 by rmk") + (* ; "Edited 29-Aug-2024 10:44 by rmk") + (* ; "Edited 25-Aug-2024 14:31 by rmk") + (* ; "Edited 21-Aug-2024 09:36 by rmk") + (* ; "Edited 5-Aug-2024 00:31 by rmk") + (* ; "Edited 1-Aug-2024 00:09 by rmk") + (* ; "Edited 28-Jul-2024 09:47 by rmk") + (* ; "Edited 26-Jul-2024 13:19 by rmk") + (* ; "Edited 23-Apr-2024 15:02 by rmk") + (* ; "Edited 29-Jul-2023 23:36 by rmk") + (* ; "Edited 16-Jul-2023 15:20 by rmk") + (* ; "Edited 8-Jul-2023 23:09 by rmk") + (* ; "Edited 25-Jun-2023 18:27 by rmk") + (* ; "Edited 28-Sep-2022 11:13 by rmk") + (* ; "Edited 7-Sep-2022 15:21 by rmk") + (CL:UNLESS [NLSETQ (SELECTQ (IMAGEOBJPROP OBJ 'DISPLAYFN) + (MB.NWAY.DISPLAYFN + (PRINTOUT STREAM (IMAGEOBJPROP OBJ 'IDENTIFIER) + ":" T .TAB (IPLUS POS 2)) + (for SOBJ in (IMAGEOBJPROP OBJ 'SUBOBJECTS) + do (PRINTOUT STREAM (IMAGEOBJPROP SOBJ 'IDENTIFIER) + " "))) + (if (OR (IMAGEOBJPROP OBJ 'IDENTIFIER) + (IMAGEOBJPROP OBJ 'LABEL)) + then (PRIN1 (OR (IMAGEOBJPROP OBJ 'IDENTIFIER) + (IMAGEOBJPROP OBJ 'LABEL)) + STREAM) + elseif (IMAGEOBJPROP OBJ 'PREPRINTFN) + then (LET ((PPRINT (APPLY* (IMAGEOBJPROP OBJ 'PREPRINTFN) + OBJ STREAM))) + (CL:WHEN PPRINT (PRIN1 PPRINT STREAM] + (PRIN1 "**IMAGEOBJECT DISPLAY ERROR**" STREAM]) + +(SHOWPIECEBYTES + [LAMBDA (PC ARG) (* ; "Edited 25-Nov-2024 15:52 by rmk") + (* ; "Edited 21-Oct-2023 10:45 by rmk") + + (* ;; "Shows the bytes that define the contents of a file piece.") + (* ; "Edited 11-Oct-2022 13:58 by rmk") + (SETQ ARG (TEXTOBJ ARG)) + (CL:WHEN (FIXP PC) + (SETQ PC (NTHPIECE ARG PC))) + (CL:UNLESS (TYPE? PIECE PC) + (ERROR "NOT A PIECE" PC)) + (CL:UNLESS (MEMB (PTYPE PC) + FILE.PTYPES) + (ERROR "NOT A FILE PIECE TYPE")) + (LET ((FILE (PCONTENTS PC)) + (FAT (EQ FATFILE2.PTYPE (PTYPE PC))) + NBYTES) + (SPPRINT PC T ARG) + (SETQ NBYTES (CL:IF FAT + (UNFOLD (PLEN PC) + 2) + (PLEN PC))) + (SETFILEPTR FILE (PFPOS PC)) + (for I from 1 to NBYTES do (PRINTOUT T (BIN FILE) + " ")) + (TERPRI T) + (SETFILEPTR FILE (PFPOS PC)) + [for I from 1 to (CL:IF FAT + (FOLDLO NBYTES 2) + NBYTES) do (PRINTOUT T (CHARACTER (CL:IF FAT + (\WIN FILE) + (BIN FILE))] + (TERPRI T]) + +(CHECKPLENGTHS + [LAMBDA (MSG TOBJ) (* ; "Edited 16-Mar-2024 10:07 by rmk") + (* ; "Edited 13-Apr-2023 23:11 by rmk") + (find P inpieces (\TEDIT.FIRSTPIECE (GTO TOBJ)) when (ILESSP (PLEN P) + 0) + do (HELP (CONCAT "negative" MSG) + P]) + +(SBT + [LAMBDA (DONTCLOSE ARG) (* ; "Edited 13-Jun-2024 22:00 by rmk") + (* ; "Edited 31-Oct-2023 19:44 by rmk") + (* ; "Edited 29-May-2023 17:23 by rmk") + (* ; "Edited 26-May-2023 11:05 by rmk") + + (* ;; "Inspect the BTREE") + + (LET ([W (WINDOWP (GETATOMVAL 'BTW] + (POS (CREATEPOSITION 50 10))) + (if DONTCLOSE + then (CL:WHEN W + (SETQ POS (CREATEPOSITION [IPLUS 2 (FETCH (REGION RIGHT) + OF (WINDOWPROP W 'REGION] + 10))) + else (CLOSEW W)) + (SETATOMVAL 'BTW (INSPECT (fetch PCTB of (GTO ARG)) + 'LIST POS]) + +(COPYPCHAIN + [LAMBDA (PIECES I J) (* ; "Edited 23-Sep-2023 11:38 by rmk") + + (* ;; "Produces a chain of copies of the pieces in PIECES from I to J. The pieces are chained in both directions so a copy can be copied or shortened.") + + (for PC NEWPC [LASTPC _ (NTHPIECE PIECES (IMIN (NPIECES PIECES) + (OR J (NPIECES PIECES] + inpieces (NTHPIECE PIECES (IMAX 1 (OR I 1))) + do (SETQ NEWPC (create PIECE using PC PREVPIECE _ NEWPC)) repeatuntil (EQ PC LASTPC) + finally (RETURN (for NPC NEXTPC backpieces NEWPC do (SETPC NPC NEXTPIECE NEXTPC) + (SETQ NEXTPC NPC) + finally (RETURN NPC]) +) +(DEFINEQ + +(POSLINE + [LAMBDA (FILEPOS INSTREAM OUTSTREAM) (* ; "Edited 7-Aug-2023 22:22 by rmk") + (* ; "Edited 6-Aug-2023 09:16 by rmk") + + (* ;; "Copies the characters in the line containing the byte after FILEPOS (e.g. byte presumably after the one just read) in INSTREAM to OUTSTREAM") + + (RESETLST + (CL:UNLESS (\GETSTREAM INSTREAM 'INPUT T) + [RESETSAVE (SETQ INSTREAM (OPENSTREAM INSTREAM 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + [RESETSAVE (GETFILEPTR INSTREAM) + `(PROGN (SETFILEPTR ,INSTREAM OLDVALUE] (* ; "Back up to just read") + (LET (START END AFTERCR) + (SETFILEPTR INSTREAM FILEPOS) (* ; + "If we just read an EOL, go to the next line") + (SETQ AFTERCR (CL:IF (EQ (CHARCODE EOL) + (\BACKCCODE.EOLC INSTREAM 'ANY)) + (ADD1 FILEPOS) + FILEPOS)) + (SETFILEPTR INSTREAM AFTERCR) + (SETQ START (DO (SELCHARQ (\BACKCCODE.EOLC INSTREAM 'ANY) + (EOL (\INCCODE.EOLC INSTREAM) + (RETURN (GETFILEPTR INSTREAM))) + (NIL (RETURN 0)) + NIL))) + (SETFILEPTR INSTREAM AFTERCR) + (SETQ END (DO (SELCHARQ (AND (\PEEKCCODE INSTREAM T) + (\INCCODE.EOLC INSTREAM 'ANY)) + (EOL (RETURN (GETFILEPTR INSTREAM))) + (NIL (RETURN 0)) + NIL))) + (PRINTOUT OUTSTREAM .I6 FILEPOS ": ") + (COPYCHARS INSTREAM OUTSTREAM START FILEPOS) + (PRIN1 (CHARACTER 128) + OUTSTREAM) + (COPYCHARS INSTREAM OUTSTREAM FILEPOS END)))]) +) +(DEFINEQ + +(PRESPLIT + [LAMBDA (N SPREAD) (* ; "Edited 26-May-2023 11:07 by rmk") + (TTEST) + (CL:UNLESS N (SETQ N 7)) + (CL:UNLESS SPREAD (SETQ SPREAD 4)) + (LET ((TEXTOBJ (GTO))) + [for I (POS _ (CL:IF (IGREATERP SPREAD 0) + 0 + 90)) from 1 to 3 do (TEDIT.INSERT TEXTOBJ (CONCAT I) + (add POS 4) + '(FACE BOLD] + [for I (POS _ 90) from (IDIFFERENCE N 3) to N do (TEDIT.INSERT TEXTOBJ (CONCAT I) + (add POS -4) + '(FACE BOLD] + (SP TEXTOBJ) + (SBT TEXTOBJ]) +) +(DEFINEQ + +(ALLTL + [LAMBDA (THISLINE N) (* ; "Edited 13-Mar-2023 15:12 by rmk") + (* ; "Edited 10-Mar-2023 11:03 by rmk") + + (* ;; "This shows the whole THISLINE, no matter what the final slot eventually might be") + + (DECLARE (USEDFREE TEXTOBJ)) + (CL:UNLESS THISLINE + (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of (GTO THISLINE)))) + (CL:UNLESS (FIXP N) + (SETQ N MAX.SMALLP)) + (for (CHARSLOT _ (FIRSTCHARSLOT THISLINE)) + (LASTSLOT _ (LASTCHARSLOT THISLINE)) + CHAR CHARW by (NEXTCHARSLOT CHARSLOT) as I from 0 to (SUB1 N) repeatuntil (EQ CHARSLOT + LASTSLOT) + do (SETQ CHAR (CHAR CHARSLOT)) + (SETQ CHARW (CHARW CHARSLOT)) + (PRINTOUT T .I3 I " " CHARSLOT) + (if (SMALLP CHAR) + then (PRINTOUT T .FR 20 CHAR " " (CHARACTER CHAR) + " " CHARW T) + elseif CHAR + then (PRINTOUT T " " CHAR " " CHARW T) + else (PRINTOUT T .FR 20 CHAR " " " " " " CHARW T]) + +(NTHCHARSLOT + [LAMBDA (THISLINE SLOTN) (* ; "Edited 13-Mar-2023 15:12 by rmk") + (* ; "Edited 8-Mar-2023 13:22 by rmk") + (CL:UNLESS (TYPE? THISLINE THISLINE) + (SETQ THISLINE (FETCH THISLINE of (GTO THISLINE)))) + (find CHARSLOT incharslots THISLINE as I from 1 suchthat (EQ I SLOTN]) +) + + + +(* ; "THISLINE") + +(DEFINEQ + +(PLCHAIN + [LAMBDA (LN TSTREAM) (* ; "Edited 25-Apr-2024 00:04 by rmk") + (* ; "Edited 14-Sep-2022 16:07 by rmk") + (* ; "Edited 29-May-91 18:20 by jds") + (PRINTLINE LN TSTREAM) + (COND + ((fetch (LINEDESCRIPTOR NEXTLINE) of LN) + (PLCHAIN (fetch (LINEDESCRIPTOR NEXTLINE) of LN) + TSTREAM]) + +(PRINTLINE + [LAMBDA (LN TSTREAM) (* ; "Edited 13-Dec-2024 17:07 by rmk") + (* ; "Edited 17-Nov-2024 15:56 by rmk") + (* ; "Edited 26-Oct-2024 11:20 by rmk") + (* ; "Edited 24-Oct-2024 20:25 by rmk") + (* ; "Edited 10-May-2024 00:26 by rmk") + (* ; "Edited 25-Apr-2024 00:09 by rmk") + (* ; "Edited 17-Mar-2024 17:18 by rmk") + (* ; "Edited 2-Dec-2023 23:11 by rmk") + (* ; "Edited 26-Mar-2023 11:46 by rmk") + (* ; "Edited 29-Sep-2022 08:43 by rmk") + (* ; "Edited 8-Sep-2022 23:41 by rmk") + (* ; "Edited 29-May-91 18:20 by jds") + (* ; + "Print out a line descriptor in a reasonable form.") + (printout T "-----" T LN " Bot: " (GETLD LN YBOT) + " Base: " + (GETLD LN YBASE) + " Height: " + (GETLD LN LHEIGHT) + " Ascent: " + (GETLD LN LASCENT) + " Descent: " + (GETLD LN LDESCENT) + T "Char1: " (GETLD LN LCHAR1) + " Lim: " + (GETLD LN LCHARLAST)) + (COND + ((GETLD LN FORCED-END) + (PRIN1 " Forced-end" T))) + (PRIN1 ". +") + (printout T "RMar: " (GETLD LN RIGHTMARGIN) + " XLim: " + (GETLD LN LXLIM) + T "Prev: " (GETLD LN PREVLINE) + T "Next: " (GETLD LN NEXTLINE) + T) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (COND + ((AND (IGEQ (fetch (LINEDESCRIPTOR LCHAR1) of LN) + 1) + (ILEQ (GETLD LN LCHAR1) + (GETTOBJ TEXTOBJ TEXTLEN))) (* ; "The line is real -- print it.") + (PRIN1 "|" T) + [bind CH first (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETLD LN LCHAR1))) for CHNO + from (GETLD LN LCHAR1) to (IMIN (GETTOBJ TEXTOBJ TEXTLEN) + (GETLD LN LCHARLAST)) + do (SETQ CH (BIN TSTREAM)) + (COND + ((SMALLP CH) + (PRIN1 (CHARACTER CH) + T)) + (T (PRINT CH T] + (PRINTOUT T "|" T]) + +(SL.GETLINES + [LAMBDA (FIRSTLINE LASTLINE PANE TOBJ) (* ; "Edited 30-Nov-2024 17:00 by rmk") + (* ; "Edited 28-Oct-2024 22:24 by rmk") + (* ; "Edited 21-Oct-2024 23:10 by rmk") + (* ; "Edited 9-Sep-2024 14:25 by rmk") + (* ; "Edited 7-Sep-2024 21:44 by rmk") + (* ; "Edited 1-Sep-2024 23:21 by rmk") + + (* ;; "A selection goes to its L1, NIL goes to the first line of PANE, T goes to the first line of TEXTOBJ's SEL.") + + (* ;; "If FIRSTLINE is already a line.") + + (* ;; "LASTLINE also coerces a selection to its LN, but it can be a number of lines.") + + (LET [TEXTOBJ SEL PANEPREFIX (PNO PANE) + (NLINES (OR (FIXP LASTLINE) + (CL:IF (type? LINEDESCRIPTOR FIRSTLINE) + 1 + 100)] + [SETQ TEXTOBJ (if (type? TEXTOBJ FIRSTLINE) + then (PROG1 FIRSTLINE (SETQ FIRSTLINE NIL)) + elseif (GTO TOBJ T) + elseif (GTO FIRSTLINE T) + then (PROG1 (GTO FIRSTLINE) + (SETQ FIRSTLINE NIL] + (SETQ PANE (if (WINDOWP PANE) + elseif (AND (FIXP PANE) + (find P inpanes TEXTOBJ as I from 1 suchthat (EQ I PANE))) + else (SETQ PNO 1) + (\TEDIT.PRIMARYPANE TEXTOBJ))) + (CL:UNLESS (type? LINEDESCRIPTOR FIRSTLINE) + (CL:WHEN (EQ FIRSTLINE 'SEL) + (SETQ FIRSTLINE (TEXTSEL TEXTOBJ))) + [SETQ FIRSTLINE (if (AND (type? SELECTION FIRSTLINE) + (FGETSEL FIRSTLINE SET)) + then (SETQ SEL FIRSTLINE) (* ; "For lastline") + (\TEDIT.SEL.L1 SEL PANE TEXTOBJ) + elseif (NULL FIRSTLINE) + then (PANEPREFIX PANE) + elseif (AND (EQ FIRSTLINE T) + (FGETSEL (TEXTSEL TEXTOBJ) + SET)) + then (SETQ SEL (TEXTSEL TEXTOBJ)) + (SETQ FIRSTLINE (\TEDIT.SEL.L1 SEL PANE TEXTOBJ]) + (CL:WHEN FIRSTLINE + (CL:UNLESS (type? LINEDESCRIPTOR LASTLINE) + [SETQ LASTLINE (if SEL + then (\TEDIT.SEL.LN SEL PANE TEXTOBJ) + else (find L inlines FIRSTLINE as I from 1 + suchthat (OR (NULL (FGETLD L NEXTLINE)) + (EQ I NLINES])) + (LIST FIRSTLINE LASTLINE TEXTOBJ PANE (OR PNO 1]) + +(CHECKLINES + [LAMBDA (LINE1 LINEN MSG) (* ; "Edited 20-Nov-2024 23:44 by rmk") + (* ; "Edited 17-Nov-2024 15:56 by rmk") + (* ; "Edited 9-Nov-2024 10:30 by rmk") + (* ; "Edited 11-Mar-2023 17:38 by rmk") + (CL:WHEN LINE1 + (CL:WHEN (EQ 0 (GETLD LINE1 LCHAR1)) (* ; "Dummy") + (SETQ LINE1 (GETLD LINE1 NEXTLINE))) + (for L NEXT inlines LINE1 while (SETQ NEXT (GETLD L NEXTLINE)) + do (CL:UNLESS (IEQP (GETLD L LCHARLIM L) + (GETLD NEXT LCHAR1)) + (CL:WHEN MSG (PRINTOUT T "Line sequence error: " MSG T)) + (HELP L NEXT)) + (CL:WHEN (AND LINEN (EQ L LINEN)) + (RETURN))))]) + +(COLLECTLINES + [LAMBDA (LINE) (* ; "Edited 25-Mar-2023 15:27 by rmk") + (for L inlines (CL:IF (LISTP LINE) + (CAR LINE) + LINE) collect L]) + +(NTHLINE + [LAMBDA (LINE N) (* ; "Edited 28-Jun-2024 15:24 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Apr-2024 13:45 by rmk") + (* ; "Edited 17-Mar-2024 17:19 by rmk") + (* ; "Edited 21-Oct-2023 10:23 by rmk") + (* ; "Edited 1-Apr-2023 21:15 by rmk") + (LET (TOBJ) + (if (TYPE? LINEDESCRIPTOR LINE) + else (SETQ TOBJ (GTO LINE)) + (SETQ LINE (GETLD (PANEPREFIX (\TEDIT.PRIMARYPANE TOBJ)) + NEXTLINE))) + (for I from 1 as L in (COLLECTLINES LINE) when (EQ I N) do (RETURN L]) + +(HEIGHT + [LAMBDA (LINE) (* ; "Edited 17-Mar-2024 13:03 by rmk") + (* ; "Edited 1-Apr-2023 12:47 by rmk") + (for L inlines LINE SUM (GETLD L LHEIGHT]) + +(LINEBOTS + [LAMBDA (LINE) (* ; "Edited 28-Jun-2024 15:24 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Apr-2024 13:48 by rmk") + (* ; "Edited 21-Oct-2023 10:23 by rmk") + (* ; "Edited 19-Apr-2023 20:50 by rmk") + (* ; "Edited 1-Apr-2023 21:24 by rmk") + (CL:UNLESS (type? LINEDESCRIPTOR LINE) + [SETQ LINE (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO]) + (for L inlines (CAR (MKLIST LINE)) collect (GETLD L YBOT]) +) +(DEFINEQ + +(IPC.DECODEARGS + [LAMBDA (PC TOBJ) (* ; "Edited 3-Dec-2024 09:37 by rmk") + (* ; "Edited 26-Oct-2024 12:35 by rmk") + (* ; "Edited 4-Oct-2024 13:32 by rmk") + + (* ;; "Finds the piece specified by decoding PC and TOBJ") + + (LET ((TEXTOBJ (GTO TOBJ T)) + (ID (AND PC (LITATOM PC) + PC)) + N) + (SETQ PC (if (type? PIECE PC) + then (CL:WHEN TEXTOBJ + [SETQ N (find I from 1 suchthat (EQ PC (NTHPIECE TEXTOBJ I]) + PC + elseif (FIXP PC) + then (SETQ N PC) + (SETQ PC (NTHPIECE TEXTOBJ PC)) + elseif (MEMB PC '(SEL T)) + then (SETQ PC (SELPIECE TEXTOBJ)) + elseif (TEXTOBJ PC T) + then (SETQ PC (NTHPIECE (TEXTOBJ PC) + TOBJ)) + elseif [AND ID TEXTOBJ (SETQ N + (find I OBJ from 1 as TPC inpieces (\TEDIT.FIRSTPIECE + TEXTOBJ) + suchthat (AND (SETQ OBJ (POBJ TPC)) + (OR (EQ ID (IMAGEOBJPROP OBJ + 'IDENTIFIER)) + (EQ ID (IMAGEOBJPROP OBJ + 'LABEL] + then (SETQ PC (NTHPIECE TEXTOBJ N)) + elseif (AND TEXTOBJ (NULL PC)) + then (SELPIECE TEXTOBJ) + else (ERROR "NOT A PIECE" PC))) + [SETQ ID (AND (POBJ PC) + (OR (IMAGEOBJPROP (POBJ PC) + 'IDENTIFIER) + (IMAGEOBJPROP (POBJ PC) + 'LABEL] + (LIST PC (CL:IF ID + (CONCAT N "-" ID) + N)]) +) +(DEFINEQ + +(SPF1 + [LAMBDA (PAGEREGION) (* ; "Edited 30-Aug-2024 15:24 by rmk") + (* ; "Edited 6-Nov-2023 22:39 by rmk") + `(,(fetch REGIONFILLMETHOD OF PAGEREGION) + (LOCALINFO ,(fetch REGIONLOCALINFO of PAGEREGION)) + (TYPE ,(fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) + ,(fetch REGIONSPEC of PAGEREGION) + ,@(for PAGEREGION inside (fetch REGIONSUBBOXES of PAGEREGION) collect (SPF1 PAGEREGION]) +) + + + +(* ; "Page frames") + +(DEFINEQ + +(SLF.FATPLEN + [LAMBDA (LOOKSFILE PFPOS BYTELEN) (* ; "Edited 28-Aug-2023 22:03 by rmk") + + (* ;; "Calculates the eventual PLEN given that there is an XCCS fat charlooks piece of BYTELEN bytes starting at PFPOS") + + (LET ((ORIGPTR (GETFILEPTR LOOKSFILE))) + (SETFILEPTR LOOKSFILE PFPOS) + (PROG1 (if (EQ NSCHARSETSHIFT (BIN LOOKSFILE)) + then (SELECTC (BIN LOOKSFILE) + (0 (ADD BYTELEN -2)) + (NSCHARSETSHIFT + (BIN LOOKSFILE) + (FOLDLO (IDIFFERENCE BYTELEN 3) + 2)) + (ADD BYTELEN -2)) + else (FOLDLO BYTELEN 2)) + (SETFILEPTR LOOKSFILE ORIGPTR]) + +(FILEPIECE + [LAMBDA (FILEPOS FILE) (* ; "Edited 24-Nov-2024 23:17 by rmk") + + (* ;; "Interprets the bytes in the looks file that represent a character piece at the FILEPOS value shown by SLF") + + (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) + (SETFILEPTR STREAM FILEPOS) + (LET* [(BYTELEN (\DWIN STREAM)) + (BYTELENBYTES (LIST (LRSH BYTELEN 24) + (LOGAND 255 (LRSH BYTELEN 16)) + (LOGAND 255 (LRSH BYTELEN 8)) + (LOGAND 255 BYTELEN))) + (TYPE (\WIN STREAM)) + (PTYPEBYTES (LIST (LRSH PTYPE 8) + (LOGAND PTYPE BYTELEN))) + (FLAG (BIN STREAM)) + (CLOOKSINDEX (\WIN STREAM)) + (CLOOKSBYTES (LIST (LRSH CLOOKSINDEX 8) + (LOGAND 255 CLOOKSINDEX] + (SELECTC TYPE + (\PieceDescriptorLOOKS + `((FILEPOS ,FILEPOS) + (BYTELEN ,BYTELEN) + (BYTELENBYTES ,BYTELENBYTES) + (TYPE ,TYPE) + (FLAG ,FLAG) + (CLOOKSINDEX ,CLOOKSINDEX) + (CLOOKSBYTES ,CLOOKSBYTES))) + (\PieceDescriptorOBJECT) + (HELP "Piece type?"]) +) + + + +(* ; "Show looks file") + +(DEFINEQ + +(SELTEDIT + [LAMBDA (SRC START LEN) (* ; "Edited 2-Dec-2024 09:01 by rmk") + (* ; "Edited 15-May-2024 15:40 by rmk") + + (* ;; "This brings up a Tedit that contains the contents of a selection in the SRC Tedit, to help in focusing on a specific problem.") + + (SETQ SRC (GTS SRC)) + (LET [(TARG (TEXTSTREAM (TEDIT NIL 'SELTEDIT NIL `(LEAVETTY T] + (CL:UNLESS START + (SETQ START (TEDIT.SELPROP SRC 'CH#)) + (CL:UNLESS LEN + (SETQ LEN (TEDIT.SELPROP SRC 'LENGTH)))) + (TEDIT.SETSEL SRC START LEN) + (TEDIT.COPY SRC TARG) + (TEXTPROP TARG 'DIRTY NIL) + TARG]) +) + + + +(* ; "New editor on an old selection") + + + + +(* ; "Bravo") + +(DEFINEQ + +(PPARA + [LAMBDA (PARA BSTR) (* ; "Edited 8-Aug-2023 17:00 by rmk") + (CL:UNLESS BSTR (SETQ BSTR BSTREAM)) + (RESETLST + [RESETSAVE (GETFILEPTR BSTR) + `(PROGN (SETFILEPTR ,BSTR OLDVALUE] + (PRINTOUT T "FILEPOS = " (GETFILEPTR BSTR) + T) + (for R in (fetch (PARA RUNS) of PARA) do (PRUN R BSTR)))]) + +(PRUN + [LAMBDA (RUN BSTR) (* ; "Edited 22-Aug-2023 10:59 by rmk") + (* ; "Edited 8-Aug-2023 16:47 by rmk") + + (* ;; "Shows the characters in RUN, with font information") + + (CL:UNLESS BSTR (SETQ BSTR BSTREAM)) + (RESETLST + [RESETSAVE (GETFILEPTR BSTR) + `(PROGN (SETFILEPTR ,BSTR OLDVALUE] + (PRINTOUT T .I5 (fetch (RUN RUNSTART) of RUN) + "/" + (fetch (RUN RUNLENGTH) of RUN) + ": " 11) + (SETFILEPTR BSTR (fetch (RUN RUNSTART) of RUN)) + (for I from 1 to (fetch (RUN RUNLENGTH) of RUN) do (SBC (BIN BSTR) + BSTR T)) + (LET (FONT (CL (fetch (RUN RUNLOOKS) of RUN))) + (SETQ FONT (fetch (CHARLOOKS CLFONT) of CL)) + (TAB 13 NIL T) + (if FONT + then (for X in (FONTUNPARSE FONT) + do (if (MEMB X '(MEDIUM BOLD ITALIC REGULAR)) + then (PRIN1 (NTHCHAR X 1) + T) + elseif (NUMBERP X) + then (PRINTOUT T " " X " ") + else (PRIN1 X T))) + (TERPRI T) + else (PRINTOUT T (fetch (CHARLOOKS CLNAME) of CL) + " " + (fetch (CHARLOOKS CLSIZE) of CL) + " " + (CL:IF (fetch (CHARLOOKS CLBOLD) of CL) + "B" + "M") + (CL:IF (fetch (CHARLOOKS CLITAL) of CL) + "I" + "R") + T))) + RUN)]) + +(ADDLINEPOSITIONS + [LAMBDA (FILE) (* ; "Edited 22-Aug-2023 11:06 by rmk") + (* ; "Edited 13-Aug-2023 19:07 by rmk") + (* ; "Edited 11-Aug-2023 08:30 by rmk") + (* ; "Edited 8-Aug-2023 22:17 by rmk") + + (* ;; "Makes a copy of FILE except that each each CR is followed by the fileptr of the next byte, and and ^z and \ are also marked with the file position of the nexxt character. This helps in decoding Bravo files.") + + (CL:WITH-OPEN-FILE (INSTREAM FILE :DIRECTION :INPUT) + (STREAMPROP INSTREAM 'ENDOFSTREAMOP (FUNCTION NILL)) + (CL:WITH-OPEN-FILE (OUTSTREAM (PACKFILENAME 'EXTENSION 'POS 'VERSION NIL 'BODY + (FULLNAME INSTREAM)) + :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + (LINELENGTH MAX.SMALLP OUTSTREAM) + (bind B first (PRINTOUT OUTSTREAM .I6 0 ": ") while (SETQ B (BIN INSTREAM)) + do + (* ;; "Line endings are marked, then executed. Tabs are replaced") + + (SBC B INSTREAM OUTSTREAM T)) + (FULLNAME OUTSTREAM]) + +(SBR + [LAMBDA (RUN) (* ; "Edited 22-Aug-2023 11:07 by rmk") + + (* ;; "Show Bravo run") + + (LET ((ORIGPTR (GETFILEPTR BSTREAM))) + (SETFILEPTR BSTREAM (fetch (RUN RUNSTART) of RUN)) + (printout T (fetch (RUN RUNSTART) of RUN) + "/" + (fetch (RUN RUNLENGTH) of RUN) + ": ") + (for I from 1 to (fetch (RUN RUNLENGTH) of RUN) do (SBC (BIN BSTREAM) + BSTREAM T)) + (SETFILEPTR BSTREAM ORIGPTR) + RUN]) + +(SBC + [LAMBDA (BYTE INSTREAM OUTSTREAM SPACELINES) (* ; "Edited 22-Aug-2023 12:12 by rmk") + + (* ;; "Show Bravo char-byte") + + (SELCHARQ BYTE + (CR (PRINTOUT OUTSTREAM "[CR]") + (if SPACELINES + then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) + ": ") + else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) + "]"))) + (LF (PRINTOUT OUTSTREAM "[LF]") + (if SPACELINES + then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) + ": ") + else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) + "]"))) + (FORM (PRINTOUT OUTSTREAM "[FORM]") + (if SPACELINES + then (PRINTOUT OUTSTREAM T T .I6 (GETFILEPTR INSTREAM) + ": ") + else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) + "]"))) + (TAB (PRINTOUT OUTSTREAM "[TAB]")) + (^Z (BOUT OUTSTREAM (CHARCODE ^Z)) (* ; "Comes out black") + (if SPACELINES + then (PRINTOUT OUTSTREAM T .I6 (GETFILEPTR INSTREAM) + ": " -5) + else (PRINTOUT OUTSTREAM "[" (GETFILEPTR INSTREAM) + "]"))) + (\ (PRINTOUT OUTSTREAM (CHARACTER (CHARCODE \)) + "[" + (GETFILEPTR INSTREAM) + "]")) + (BOUT OUTSTREAM BYTE]) +) + +(RPAQ? LASTTS NIL) + +(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]) + +(DFR + [NLAMBDA (FN FILE) (* ; "Edited 12-Mar-2023 13:18 by rmk") + (* ; "Edited 10-Sep-2022 16:15 by rmk") + (* ; "Edited 6-Sep-2022 23:35 by rmk") + (* ; "Edited 4-Sep-2022 20:57 by rmk") + (* ; "Edited 9-Aug-2022 22:37 by rmk") + (* ; "Edited 8-Aug-2022 16:17 by rmk") + (* ; "Edited 7-Aug-2022 00:08 by rmk") + + (* ;; "Gets the definition from the release") + + (CL:UNLESS FILE + (SETQ FILE (CAR (WHEREIS FN 'FNS T)))) + (CL:UNLESS FILE (ERROR FN " not found")) + (SETQ FILE (FINDFILE FILE T)) + (CL:UNLESS FILE (ERROR FN " not found")) + (LET [FILEPKGFLG (FNR (PACK* FN '-R] + (COPYDEF FN FNR 'FNS (PACKFILENAME 'HOST '{RMEDLEY} 'VERSION NIL 'BODY FILE)) + (EDITDEF.FNS FNR NIL '(:DONTWAIT]) +) +(DEFINEQ + +(DFGV + [NLAMBDA ARGS (* ; "Edited 15-Dec-2023 12:26 by rmk") + (* ; "Edited 13-Aug-2023 14:09 by rmk") + + (* ;; "Brings in a function from an earlier version on {MEDLEY}, for comparison. FILE can be a version number, it uses WHEREIS") + + (APPLY (FUNCTION DFOV) + (LIST (POP ARGS) + (POP ARGS) + (POP ARGS) + (GDIRECTORIES]) + +(GDIRECTORIES + [LAMBDA NIL (* ; "Edited 15-Dec-2023 12:19 by rmk") + (for D in DIRECTORIES when (EQ 'WMEDLEY (FILENAMEFIELD D 'HOST)) collect (PACKFILENAME + 'HOST + '{MEDLEY} + 'BODY D]) +) +(DEFINEQ + +(TTEST + [LAMBDA (FILE REGION OPENONLY AFTERFORMS DONTQUIT READONLY)(* ; "Edited 27-Sep-2024 11:18 by rmk") + (* ; "Edited 5-May-2024 21:55 by rmk") + (* ; "Edited 29-Nov-2023 10:50 by rmk") + (* ; "Edited 23-Nov-2023 14:28 by rmk") + (* ; "Edited 22-Oct-2023 00:07 by rmk") + (* ; "Edited 9-Sep-2023 17:21 by rmk") + (* ; "Edited 8-Sep-2023 00:16 by rmk") + (* ; "Edited 19-Aug-2023 10:57 by rmk") + (* ; "Edited 17-Jul-2023 18:01 by rmk") + (* ; "Edited 15-Jul-2023 21:05 by rmk") + + (* ;; "FILE NIL gets the last file.") + + (* ;; "Region NIL defaults to last region, T always gets a new one. If we are reusing the region, we also close the previous file and kill its process.") + + (* ;; "OPENONLY creates the text stream, doesn't create the window or process") + + [if (NULL REGION) + then [SETQ REGION (REGIONP (EVALV 'LASTTEXTSTREAMREGION] + elseif (AND (LITATOM REGION) + (REGIONP (EVALV REGION))) + then (SETQ REGION (COPY (EVALV REGION] + (IF FILE + THEN [LET ((SUBDIR (LISTGET (UNPACKFILENAME.STRING FILE) + 'SUBDIRECTORY)) + (TESTDIR '{TTESTS})) + (CL:WHEN SUBDIR + (SETQ TESTDIR (CONCAT TESTDIR "/" SUBDIR)) + (SETQ FILE (ROOTFILENAME FILE))) + (CL:UNLESS (STRINGP FILE) + (SETQ FILE (OR (FINDFILE-WITH-EXTENSIONS FILE (CONS (PSEUDOFILENAME + (DIRECTORYNAME T)) + (CONS TESTDIR DIRECTORIES)) + '(TEDIT TXT NIL)) + (ERROR "FILE NOT FOUND" FILE))))] + (SETQ LASTTESTFILE FILE) + elseif (AND (BOUNDP 'LASTTESTFILE) + LASTTESTFILE) + then (SETQ FILE (OR (STRINGP LASTTESTFILE) + (PACKFILENAME 'VERSION NIL 'BODY LASTTESTFILE))) + else (ERROR "NO FILE SPECIFIED")) + (CL:WHEN (STRINGP FILE) + (SETQ FILE (OPENSTRINGSTREAM FILE))) + (LET (TEXTSTREAM TEXTOBJ) + (DECLARE (SPECVARS TEXTSTREAM TEXTOBJ)) + (CL:WHEN (AND (BOUNDP 'LASTTESTSTREAM) + (TEXTSTREAMP LASTTESTSTREAM)) + (CL:UNLESS DONTQUIT + (SETTOBJ (TEXTOBJ LASTTESTSTREAM) + \DIRTY NIL) + (TEDIT.QUIT LASTTESTSTREAM))) + [SETQ TEXTSTREAM (if OPENONLY + then [OPENTEXTSTREAM FILE NIL NIL NIL (CL:WHEN READONLY + '(READONLY T))] + else (if (REGIONP REGION) + then (SETQ REGION (COPY REGION)) + elseif REGION + else (SETQ REGION 'TTEST)) + (TEXTSTREAM (TEDIT FILE (COPY REGION) + NIL + `(LEAVETTY T ,@(CL:WHEN READONLY + `(READONLY T))] + (SETQ LASTTESTSTREAM TEXTSTREAM) + (SETQ LASTTEXTSTREAMREGION (REGIONP REGION)) + (SETQ TEXTOBJ (TEXTOBJ TEXTSTREAM)) + (CL:WHEN AFTERFORMS + (if (NLISTP AFTERFORMS) + then (APPLY* AFTERFORMS) + elseif (NLISTP (CAR (LISTP AFTERFORMS))) + then (EVAL AFTERFORMS) + elseif (LISTP (CAR AFTERFORMS)) + then (EVAL (CONS (FUNCTION PROGN) + AFTERFORMS)))) + (SETQ LASTTEXTSTREAM TEXTSTREAM) (* ; "for GTS") + TEXTSTREAM]) + +(LTEST + [LAMBDA (FILE SCROLL) (* ; "Edited 28-Jun-2024 15:25 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Apr-2024 13:50 by rmk") + (* ; "Edited 17-Mar-2024 13:04 by rmk") + (* ; "Edited 21-Oct-2023 10:24 by rmk") + (* ; "Edited 17-May-2023 09:48 by rmk") + (* ; "Edited 13-May-2023 21:34 by rmk") + + (* ;; "Line reformatting with inserts and deletes") + + (LET (LPC) + (CL:WHEN (NUMBERP FILE) + (SETQ SCROLL FILE) + (SETQ FILE NIL)) + (TTEST FILE) + (CL:WHEN SCROLL + (SCROLLW (WFROMDS (TEXTSTREAM (GTO))) + 0 SCROLL)) + (SETQ LPC (\TEDIT.CHTOPC (GETLD (GETLD (PANEPREFIX (\TEDIT.PRIMARYPANE (GTO))) + NEXTLINE) + LCHAR1) + (GTO))) + (SP LPC) + (SPLINES]) + +(THC + [LAMBDA (TSTREAM PRINTER TYPE) (* ; "Edited 10-Jul-2023 23:00 by rmk") + (CL:UNLESS TYPE (SETQ TYPE DEFAULTPRINTERTYPE)) + (LET ((TFILE (TXTFILE (GTO TSTREAM))) + HCFILE) + (CL:UNLESS PRINTER + (SETQ HCFILE (OUTFILEP (PACKFILENAME 'EXTENSION TYPE 'VERSION NIL 'NAME + (PACK* (FILENAMEFIELD TFILE 'NAME) + 'W) + 'BODY TFILE)))) + (HARDCOPY.SOMEHOW (WFROMDS (TEXTSTREAM (GTO TSTREAM))) + HCFILE TYPE) + HCFILE]) +) + +(RPAQ? LASTTTESTFILE ) + +(RPAQQ TTESTREGIONS (RBRAVO RHUGE RMID RSMALL RBIG RHIGH)) + +(RPAQQ RBRAVO (1321 246 561 554)) + +(RPAQQ RHUGE (865 26 811 957)) + +(RPAQQ RMID (753 774 531 169)) + +(RPAQQ RSMALL (858 796 462 81)) + +(RPAQQ RBIG (900 400 600 358)) + +(RPAQQ RHIGH (877 880 462 103)) +(DEFINEQ + +(SHOWSAFE + [LAMBDA (PIECE TAG HELP FILE TEXTOBJ) (* ; "Edited 21-Oct-2023 10:50 by rmk") + (* ; "Edited 4-Sep-2023 23:31 by rmk") + (CL:UNLESS FILE (SETQ FILE TTY)) + (CL:WHEN (OR (EQ SAFESHOW T) + (EQMEMB TAG SAFESHOW)) + (CL:WHEN TAG (PRINTOUT FILE TAG " ")) + (PRINTOUT FILE (PFPOS PIECE) + " Left = " BYTESLEFT " Inbuffer = " BYTESLEFTINBUFFER " Prefix = " PREFIXBYTES T) + (SPPRINT PIECE FILE (GTO TEXTOBJ))) + (CL:WHEN (OR HELP (EQ SAFEHELP T) + (EQMEMB TAG SAFEHELP)) + (HELP PIECE TAG]) +) + +(RPAQ? SAFESHOW NIL) + +(RPAQ? SAFEHELP NIL) +(DEFINEQ + +(MYH + [LAMBDA (MESS1 MESS2 SKIP N) (* ; "Edited 30-Nov-2024 14:18 by rmk") + (* ; "Edited 31-Jul-2024 21:41 by rmk") + + (* ;; "Call HELP after waiting for the mouse to get to a safe place and the buttons to come up.") + + (CL:UNLESS SKIP + (DISMISS (OR N 1000) + NIL T) + (HELP MESS1 MESS2))]) +) + +(RPAQQ VTDIR {DSK}kaplan>local>medley3.5>pregit-medley>venuelispcore>library>.) + +(RPAQQ VTF {DSK}kaplan>local>medley3.5>pregit-medley>venuelispcore>library>TFBRAVO.) + +(RPAQQ TF {WMEDLEY}TEDIT>TEDIT-TFBRAVO.) +(DEFINEQ + +(DFVENUE + [NLAMBDA (FN FILE) (* ; "Edited 2-Aug-2023 12:30 by rmk") + (* ; "Edited 31-Jul-2023 20:42 by rmk") + + (* ;; "Edit from pregit Venue files, default to TFBRAVO.") + + (CL:UNLESS FILE + (SETQ FILE 'TFBRAVO)) + (SETQ FILE (PACKFILENAME 'NAME FILE 'BODY VTDIR)) + (LET (VNAME DEF) + (CL:UNLESS FILE (SETQ FILE)) + (SETQ DEF (GETDEF FN NIL FILE 'NOERROR)) + (if DEF + then (SETQ VNAME (PACK* FN "-" "Venue")) + (PRINTOUT T "Editing " FN " from " FILE T) + (PUTDEF VNAME 'FNS DEF) + (ADDTOFILE VNAME 'FNS NIL) + (EDITDEF VNAME 'FNS NIL NIL '(:DONTWAIT)) + else (PRINTOUT T FN " not found on " FILE) + NIL]) + +(VSEE + [NLAMBDA FILE (* ; "Edited 2-Aug-2023 12:08 by rmk") + (PFI.MAYBE.SEE.PRETTY (PACKFILENAME 'DIRECTORY VTDIR 'BODY FILE) + T]) +) +(DEFINEQ + +(PTT + [LAMBDA (FILE NOTREADONLY) (* ; "Edited 30-Nov-2023 10:40 by rmk") + (* ; "Edited 12-Aug-2023 23:27 by rmk") + (* ; "Edited 11-Aug-2023 08:40 by rmk") + + (* ;; "Plaintext readonly") + + (TEDIT FILE NIL NIL `(UNFORMATTED T READONLY ,(NOT NOTREADONLY]) +) + + + +(* ; "Plain text") + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS DEBUGOUTPUT MACRO + [ARGS + `(LET [(OFILE ,(CAR ARGS)) + (WTYPE ,(CADR ARGS] + (RESETLST + [if WTYPE + then [SETQ OFILE (OPENTEXTSTREAM NIL (REGIONP OFILE) + NIL NIL '(FONT DEFAULTFONT] + [RESETSAVE NIL + `(PROGN (CL:UNLESS RESETSTATE + [TEDIT OFILE WTYPE NIL + `(READONLY QUIET LEAVETTY T TITLE + ,WTYPE])] + elseif OFILE + then (RESETSAVE (SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW)) + '(PROGN (CLOSEF? OLDVALUE] + [RESETSAVE (DSPFONT NIL OFILE) + '(PROGN (DSPFONT OLDVALUE OFILE] + ,@(CDDR ARGS))]) +) +(DEFINEQ + +(TEDIT-DEBUG + [LAMBDA (DONTOVERLOAD) (* ; "Edited 9-Aug-2024 13:20 by rmk") + (* ; "Edited 16-Jul-2024 12:37 by rmk") + (* ; "Edited 6-Jul-2024 21:16 by rmk") + (* ; "Edited 10-Jun-2024 14:21 by rmk") + (* ; "Edited 19-May-2024 21:32 by rmk") + (* ; "Edited 6-May-2024 22:13 by rmk") + (* ; "Edited 22-Apr-2024 23:42 by rmk") + (* ; "Edited 4-Apr-2024 12:13 by rmk") + (* ; "Edited 17-Mar-2024 19:46 by rmk") + (* ; "Edited 15-Mar-2024 15:28 by rmk") + (* ; "Edited 3-Dec-2023 21:00 by rmk") + (* ; "Edited 29-Nov-2023 10:49 by rmk") + (* ; "Edited 24-Nov-2023 12:53 by rmk") + (CL:WHEN (DIRECTORYNAMEP (MEDLEYDIR "../oldtedit/")) + (PSEUDOHOST 'OT (MEDLEYDIR "../oldtedit/"))) + (FILESLOAD (NOERROR FROM LOADUPS) + FULLER.DATABASE) + (CL:IF DONTOVERLOAD + (LOAD 'TEDIT-EXPORTS.ALL) + (EDIT-TEDIT)) + (FILESLOAD (NOERROR FROM {WMEDLEY}/library/tedit/) + TEDIT-STRESS TEDIT-RENAMES) + (CL:UNLESS DONTOVERLOAD + (%. ANALYZE ON (TEDIT-STRESS TEDIT-DEBUG))) + [SETQ TFILES `(TEDIT-DEBUG TEDIT-STRESS ,@TEDITFILES] + (CNDIR (PSEUDOFILENAME (MEDLEYDIR "library/tedit"))) + [GIT-PUT-PROJECT-FIELD 'MEDLEY 'EXCLUSIONS `("tedit-tests/" ,@(GIT-GET-PROJECT 'MEDLEY + 'EXCLUSIONS] + (FILESLOAD (NOERROR) + {OT}OTWHEREIS) + (PRINTOUT T T "Connected to " (PSEUDOFILENAME (MEDLEYDIR "library/tedit")) + T]) +) +(DEFINEQ + +(TRENAME + [LAMBDA (FNS FILES) (* ; "Edited 16-Mar-2024 09:22 by rmk") + (CL:UNLESS FILES (SETQ FILES TEDITFILES)) + (LET [(MAP (FOR F TRANS INSIDE FNS + WHEN (SETQ TRANS (if (EQ (CHARCODE \) + (NTHCHARCODE F 1)) + then (CL:UNLESS (STRPOS "TEDIT." F 2 NIL T) + (PACK* "\TEDIT." (SUBSTRING F 2))) + elseif (STRPOS "TEDIT" F NIL NIL T) + then (PACK* "\" F) + else (PACK* "\TEDIT." F))) COLLECT (CONS F TRANS] + (for M in MAP do (COPYDEF (CAR M) + (CDR M))) + (for M WH FS in MAP DO [SETQ WH (CAR (WHEREIS (CAR M) + 'FNS] + (SETQ FS (%. WHO ON IN FILES CALLS (CAR M))) + (CL:WHEN WH (pushnew FS WH)) + (DSUBLIS MAP (GETD (CDR M))) + (MARKASCHANGED (CDR M) + 'FNS) + (%. ERASE IN (CAR M)) + (CL:WHEN WH + (DSUBST (CDR M) + (CAR M) + (FILECOMS WH)) + (MARKASCHANGED (FILECOMS WH) + 'VARS)) + (%. ANALYZE ON IN FS)) + MAP]) +) + +(FILESLOAD (NOERROR) + VERSIONDEFS) + + + +(* ; "Until this is release") + +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA VSEE DFGV DFOV) + +(ADDTOVAR NLAML DFVENUE DFR) + +(ADDTOVAR LAMA ) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (4840 7227 (GTO 4850 . 5100) (GTS 5102 . 6701) (GTW 6703 . 6859) (GSEL 6861 . 7225)) ( +7284 20415 (IPC 7294 . 8798) (ILINES 8800 . 11341) (ISEL 11343 . 11954) (ITS 11956 . 13680) (IPANES +13682 . 13917) (ITL 13919 . 14338) (IHIST 14340 . 17002) (IPCTB 17004 . 17312) (IMB 17314 . 17929) ( +ICL 17931 . 18496) (IPL 18498 . 18902) (ICARET 18904 . 19281) (INSPECTPIECES 19283 . 20413)) (20437 +55479 (SP 20447 . 25793) (SL 25795 . 28371) (SSP 28373 . 29486) (STL 29488 . 38000) (SPF 38002 . 40301 +) (SLF 40303 . 49436) (SHOWLINE 49438 . 53000) (SLL 53002 . 53749) (STBYTES 53751 . 55477)) (55480 +60853 (NTHPIECE 55490 . 56622) (NPIECES 56624 . 57489) (NTHPIECECHAR 57491 . 58799) (SELPIECE 58801 . +59243) (PIECENUM 59245 . 59964) (PCBYTES 59966 . 60851)) (60854 63328 (FILEBYTES 60864 . 62288) ( +TFILEBYTES 62290 . 63326)) (63329 64651 (TRELMOVE 63339 . 63582) (TSCROLL 63584 . 63750) (TSCROLL* +63752 . 64649)) (64652 67701 (TRY 64662 . 65931) (TEDITCLOSEW 65933 . 66276) (PARALASTWITHOUTEOL 66278 + . 67163) (FIXPARALAST 67165 . 67699)) (67702 81927 (SPPRINT 67712 . 74128) (SPPRINT.CHAR 74130 . +75114) (SPPRINT.OBJ 75116 . 78069) (SHOWPIECEBYTES 78071 . 79627) (CHECKPLENGTHS 79629 . 80086) (SBT +80088 . 81077) (COPYPCHAIN 81079 . 81925)) (81928 83989 (POSLINE 81938 . 83987)) (83990 84873 ( +PRESPLIT 84000 . 84871)) (84874 86587 (ALLTL 84884 . 86137) (NTHCHARSLOT 86139 . 86585)) (86613 96826 +(PLCHAIN 86623 . 87151) (PRINTLINE 87153 . 90143) (SL.GETLINES 90145 . 93438) (CHECKLINES 93440 . +94420) (COLLECTLINES 94422 . 94674) (NTHLINE 94676 . 95681) (HEIGHT 95683 . 95971) (LINEBOTS 95973 . +96824)) (96827 99275 (IPC.DECODEARGS 96837 . 99273)) (99276 99869 (SPF1 99286 . 99867)) (99898 102276 +(SLF.FATPLEN 99908 . 100767) (FILEPIECE 100769 . 102274)) (102309 103077 (SELTEDIT 102319 . 103075)) ( +103147 109305 (PPARA 103157 . 103579) (PRUN 103581 . 105603) (ADDLINEPOSITIONS 105605 . 107032) (SBR +107034 . 107688) (SBC 107690 . 109303)) (109362 114037 (DFOV 109372 . 111842) (OLDWI 111844 . 112219) +(DFOV.OLDEST 112221 . 112646) (COMP 112648 . 112843) (DFR 112845 . 114035)) (114038 115071 (DFGV +114048 . 114574) (GDIRECTORIES 114576 . 115069)) (115072 121637 (TTEST 115082 . 119614) (LTEST 119616 + . 120981) (THC 120983 . 121635)) (121951 122643 (SHOWSAFE 121961 . 122641)) (122696 123143 (MYH +122706 . 123141)) (123388 124483 (DFVENUE 123398 . 124277) (VSEE 124279 . 124481)) (124484 124938 (PTT + 124494 . 124936)) (126036 128352 (TEDIT-DEBUG 126046 . 128350)) (128353 130089 (TRENAME 128363 . +130087))))) +STOP diff --git a/internal/TEDIT-DEBUG.LCOM b/internal/TEDIT-DEBUG.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..3297fbe8ee35090c74ac9f18984f63e29880060e GIT binary patch literal 60892 zcmd_T3vgW5c_xT%fFK1+6aX?51yRx!B+(!vg6M9%$S6`j&|o*vKsUP^Y(k>LfM`e! zq6sJR|DSX3?FL9mv1ezhRuA;O=bn4+dHnDHKmQq+NKU3_lgB30ndGtb z>}1xtFBeNp$4(`k{`71yna`vPxqj!qd@?psjKwo8#qn4n>4b)kbaf4|g#@Y1t{$G;%T&IXQHq-?^~9w| zAmW^2t%cZ?r z*G3zqy9)ioA=fPdt6>$9vn+pU!_NulwO;|&L37ItEV z>A6BO?}Ubj&BW!L6DRz&#zM}iq?s>P&E>P0!7-^k+ zpu}J=a-w>|l^O zWw;ADxrBQ&$C69ntIv1%5Fpf^3Z#NBUuY}We@3oei&o0hw{!Jh ziGHW8z1q1|UyR;p6G*Ag0$~uAt#Z^7R+5}*h$Y8a>+yyRCnCTCo{UZ zxoja_OlN1Eh*x3M!K4l9L}2O#v4@77c(z!~&N$t$wAa zyDh2B4U@|crlwho=KibW{!hPVnxPBokTVRHdxd- z3IPLMv=@{QjqHffp%Ksr&~UD{ncvV5=t{8|19=cC>!5M-2vkO|i2GyXGRYIkLL#5e z6+!DmAT}fu{9pkTr0H&0*Ti2vyuAgGoy;sC?1TdZ#&8H(CqQ*Tv`&N#+<*+C&KM}3 zTV>=#YhN%f?{Nf=!%igZD}s2ysq%Mc)c1JAyH+aT(i1W|-UxmhU{eP7urN4*tLLM? zqAP633;A8891|!>VJ#!>Qi60V;llb_x&sd9_Fcd3F~X1|Y>&*=Fuq(mnE+Z4=)pss zw*M|jG9$oqp{>UWL_H|2?h;BM5cRT_D-2hIBp&|9>AqLA4S72qke^#r(}61Ix<&2z zl+vQK{_cy$Han_aQYN$rKm}2X;Oh~hk#RpE8a`pMK)Bv^LKF&x-H8khc@uqNC#p3D znr@kvN5BA1+uQZ6831?tbMg-%b>OK=;6egq#81dI_A}!nmi&#oWy7PU3`k;RDBxqU z2(GG3)h86CiD51k90mj0nE)zG=68|&2{2HuDJ#_*X{2s+)Q(ePIe4z@5uiRuG=C!! zO~xzKmEE)XX1doSMq}Nu&qXnoWXy z&jPP0K)9E#=pp3AiY*)zMmGxCVlpFEiibe&SK_~n}Jp3tsz z{qE=s>A-VFG?0ZALiE~H{ln9ncSh@(slZgA(szBTmXN2Q1=IFIQ1e59nc!;h>={pD z`sZCMQ*!s_pGjMC{jJ*Ol)N|NedP7&e~_70oVUMesjRQ#Q^MN79FnuAD0Ym4Fq_M< zF&`BeJ>jPUz))8l0d-edqy!;!*j(q6r^q`(SV!AjDB?^Ma-2Lcn4z68c-(C?91*r? zVKy}4ttQA0`IeydxWndrOax5Iia8O3(<8d{&MQt={w~|mWM)wHv=G++lg%n3xI*ECMI7BLlg1jGvAFamBNvcCyZ7<2Hi!- zS6V2QdC0}2_z`g>Z%|1QhM@VQ98FUy!ODJRPg`4up~FMba>V(v>e5jeR;^Dc^ovS@ zKchb~KG5n|#QA3YLT4j(p`%gVe<9d_FcVwpiSLeXcGMi1it~FL(^KESwlBN)+cTRF z&sO?A^m=yhjXj(9XL{#Vem<-0Eh?}R?VdgSt=hkGUtM|Q$=dHjvL@r1GfJ{b%N|;_ z%Gxlo7{z!poi7w+oX)V|o)dxelFVokc>ioMrPrZxiyI&UrU<%LF3yokUn|x=$xqS$I#&-u6~y%#rYiH z0F@DviYu&rjwNAOe-im4PT-MUd)fk}-gDg{y79a0a@yydu@=nKL)qGIDt>hD-VKvcSsMOWo4vhSw!jkXQTq&;i`&n3_5` zH774?Z?&_H>A6yO>7dZ9#x#JlYoE?Wx9Ql*8?Q{Qyz%PQcg};Hk5dGIl?Fl`j4Op4 zHFNNc5x|4!=wZkxQZ_p`gbSPbB+WX5MwkqZOFer>={gB+5JIbZ z0WvP&#zsR!BQBrBdzNK_i;az4on+EBDrwDWoMHm2O@rUu82oy$qD1G|9HO>hJ6X9-m?xYvtj6m1KG^PnOJ5H zL?#5B92f$OhY5q@&WR&5f(>9EXVSB=j5B`385?m1^t%IgK=yrw{Ub-Z989gPB$kiK z#~oYg$Pt>#yr(DUW`Sn~3>kwf6lq4q_h9len55VN=HmK}v=d>&XI)l?zred6i-X=zuT*r6umCKoahS z3AR)D!Sm6dPY4P@dW~(~o4OIaxK$4chN*R`v8))@U5-Sz>feoD`->O^`OhgvzES~4 zsQr)H6fpax=w@$fb2r$HvFKiH`$WX~jnrl&@sbpt-8`a|e=n+JNGZUfMr!jmWjtr) zbG5YLO|jJ0H=^2;voEFe*|BK3{j25YD}Ba(1l7Xa3o_q0p!K9_vanr&--*3Y-T%qe zciusFXzXdW!GzI%OHnB7vxYbzk4h?J4glMp{48{20ON3gP>_xKC)O6P zTv}S)aF#DSOP8M6coqU+A@d$tDf)2>h6xc@V0{uKXB&1+lKIkFK1no#?q*a~be3W_ z6*_*b>Q&o!Xry}2PF0&4d+1$j4D3`x zy9KLmsr%E4e}^_>#ez(Sj8F?Z^yj{<`l0R5P8*KBPa9LFeAbqx%Ehhv*BZ5NLfnR+ zR!C(_vYHW?A1$zhoqFXkWH(FV5#pouz=&`era{y2cyMgP*J1gBn-g3g)-Lhc35^fa zKw=m_zQ_ttaZL%hzrQN=Jyrk?8SG<^;Z%h{7=ppZ6asTtjSd;#+acJXOs7Ins7+n) zJaYx>q`k7u!=UDC0GMexD-3piQ2~qrf`d;~pmohk3K6{5g7Fdb%u`b$6q#M6B?2j+ zwK_Jj;TqNh ze>Dg1Tam-gtrbYD)Z#!7wsp1(EnNNtK4grbZq zNsNFT$}dWeMd2~}j(w)!Mf>=$E1>vf7QzaispU{mn}Ul=jfFP5A3fr7kuqg_q5lO^)cj|qyYj;JC~SN`FUajf2C6%;~%Ps{LNpDkntL5Mg;F;hcSZso}E z1h!xczR*$vD_S9=YUz8{OTiCmM1Z~G7ChCjgl=1Vs-%`_HtV6Pa*9tzBm)|M|LLwy z=$(7PLElyHR1UhM-g%~P@pi*OUA2>CrC#_f!lnJxFw-zaoD%lZNZ)9ai`UXO)P?u@ zROcI{es#*~NuKYCE*x9xYERx0&_d%ULc_ZPZ5^sRUFeLLe_M#e zbCsT8V6NwZj$4ro#)-737Fa?{Fd$kKEK*x*GPrB&8?ZK_n$m#cdljewXOI^1CDH+r zJo3DP-@3qG_}=&fVh!di-W+J4CzKA`TYZZSfUdDEUX8e|Lf5c`5o_~D1sEpJvLd1x zQpy^Joa9-MeE_M5M(`}76LcWuAcxQLid_PhVZB9tX1!vz2ulK)&Md#e8W1GhCb-yO zB>0Z$v$U;^0-1O>8B5SfPWB?uvdszyR&BKk$X(Xe1P(;Ubt`s6>kkUmDm^NoB!5(~c$Aj6 zXy0Pg)Gj@0RSPLCJ*JX&&|Y-di?)kpHN?uNum4yn?m_8RW$SuJDPDT)V$Xluo87BE z$}cpsd$qC7^Suq*%%1ZPHKsPFOOKfkYd7qT8Cavb3uE*tC#}y{&L3!8Jb&<7?T2I~JQ>?6D7R>!s8t0#X9M zm_2yDuTj1C)&tG<-e^02sDYp0`TH;$8E$>v&Ss~3QGKV{@n`>{C%8Y``zP7MfAaRV zyYyn~`q6CfpJosL>3@71i*z3g2ma(gzP%~+2L5F0`Um)U;7{?i_nSILkLes`d$SL1 zy>N9`OiHuec0sa-1OhPUf0$W$oa*gcFPZE8tn6%IZePZl zr?)=4e188YviouWt9+}yKHM{OSN6Wz;c}oSa4?m<@88K<^qxQ3$Ud@pTlQ$B@BH8= zvquk~f20v?-~99JVDB%wwPfH}g!cN#`);M?ee9QQ|Lu6DSKfF{`d=$nZ`-Qh-TGXg zjb{(725$a%+gk?A?1KK#fMS+Bn6*gsgo``wg@;6kEE35Dk?4>QiBM>eNUn%Pc&tbS zSJt5yt_D7wy-#ozmn+%cSs+pyR-piU?>t-S1^9j4U1Yl;vZ|zrJAuDNvz<^rd&szaY)e0)rLApb?;3ewXJ>uh|}K<2p^XvVFGAYP-E^sxW0kyF2aUn^nBtYd@*F(~Vny zIsGo}rLNy89Z4CuvenHzSGt?JSv};f)BEEH?yA}aw7*w>a9Yq5B1^U#Orrbh-+mkh z{Rm8D*5Vg|$& z7JL0>w5k2d5G-e=#t?iU_7biN+r|()gtpiXTMiFVKsI9;f>G4gfS1s{G(tEmp(k9M zYv_dg6&UT@`9q+soxjit1Okb*^aK0iTWNIgVJnjjKM70-DgcaaOghv-#4~!8fDS1Hdcadn9bVk^ z!wBru7l%!chS7k1XxKW{V=dL8~V`^&(e>NFfgqt<{D+_A-vF{J%{O&Xst1Xd39@qP9S8#yBo)JQNPV( zv(v!rk*0?um?W?22nd_+4$$b`4a4s4y8}4*?$D<16A_??_b>vO^W9;J-MbMijCVs) zYDYN&;^*EBL(^{^G2BC~MVRx}A|Osn5yL;+h8dpk-GJ_UHxfZ2h68T+Fg65Q|GX-6 zCE5Ol$XVi{ZWMHJU^0_M z+#Z7S5!FGLOaJ9(78aMBrxq4B*4FjyFbpI8Pc5%s-f*zpZeg{I&2(A|{*x|vVL%J| z&pOrROUoPj2Dh~IuP;Ac*>El`tUryNdGxe|xpAexx(ruKb!qkKjf$2IVM+T}u@T8x z`0&DV)fB?()URK;j5miuBVD*(tSqdfV@vBO3!MO*ph|UZgLmVAw*K_$hnM9Bz}7!0 zJ(iB*`563MVksSlhiD8wIK(5;L4+PXnWQc1L%a=#_!(S{0wnuS@&YVM-W$PtqhN*d zI0BOBwiaexz7%F_Ga!b%2D0_*C4GNCgRzVP zby#zhVKpqnyo`cj_q(8$pTl;=?BpbXFX<#FP9^&hLW@tH&7?7cVG#2EN1P1rxMc8j z(eH+WkgQ+?{II{Uv9OM1-2m9Z^hX$ou!ES_2w!)e0*GOC!D+eKNFd`Gtnj5JF7YGI z<(Aihs?z$9Kpj>e4H1TO63}$hz#>Km+B!Q~z5Ncn|C}B=V&e`Tx}xi%`%ziFt)&}A zQ?X9MCaV577%gcYbwPl3Z`Kfs!MF*(5xlf3*k&V3eG&e1^tXv!LzQER@R!R3;&whI zW=9yx&)mXLju;$ZYpc~8A!OE04vK-O4ikZ6Hwu6Vw!Q+13H2CP<_-zck&UkL*npbS zbCd5eHU)yqq*$hn`_tH*QFwFX@|bH|hM2Y8m<&FEop{QuX*mY|T6Y`J-2|Zp3cGi~ zhPt@;DHuVL%j!JT?j zJ7hmKE8tftm$B>DSSH;^uTO8@k*V}O`6~7dUwvmTbNIE||Ap8R$^Asv2ld;>cYmj9zy?fM|hVye-hy&W)1g`r)3Q_NmR=mV4{> zL~AF@?Z5e2<>vygO$A?_7VF-%zpB*!R}(Axo$)I&zUV)#aDzp#5OzO zt4RwLx)4-dDmO8h^1X5_+5}Wd z!`g8#0(`w>IS95A)eX1MB8Vg(q%V&kd0ei3JxiJf8tv;&y8NSwSX#(iqEN_`DqWre~_EXP;jUiRIAmRdd> za^mwvY)YPGEo^wl4PwLNxC3#*PIQtb5NA*zkaL>HjkxOyGUbv#|m5#*}H{GOdl~P=Wjvi!6Q2(`rZ@zvFtdOf1iK@$qsGc zbMn@wni|UPZ=ML&-(g;w-f6nY9=0E7Eff*K+Nx)6He=1hxHo&!8^&U)kv)lFIN3+rH+%Ql>4AIp$*ceOxxo48jw5<(=MhC) zI}951SXOshHnNYQ!;dwxj|R^_TKk;+QvIX}{Lzd@o@!W{+T5ors0=~C55&B$PtdH= zU5ZmS8imxL+pLgX1S*E^`o%Sz4@kWwdm~{)R#`?_960d^BDW!P#&8AxWmS|Bm=#qs zLNudyY1J>;3MZCfx_X8gHE(pAVc2tG`Fsr78HQokx7*8y(Vp2GqZ*SDZU#kmfl1P{ ztke3;RwL-Cc1$eEru_)a2Bu>XND=0ey9Rivj-xOPbJ7HTccwF8hVPoK^I=F?zRu8y zA~K8V3~Z)uyD%k6OCi`i>=0pz^sb>ZnLcoDko1ANX-M`7*z`Zhx`CzPpzx2aKSaML z%V@;s-ZxyKHT#tzv$-LHVt5-&f4#oqEAllwh6n<=V=glxoA+Jq7Pe_Otqmu=ke)r2 zNe;SA;7w!z(cXK0zY`d#DTC1_nJGFa%&y9ibHarRy8h0^iqPF)8@0Y2`u_CQala#P z9F|SvfgDGZriSZs8F!l>cbgxFuxjeTEX`S>Gtf-UnDM4YuyOHL6Enum5#qQRbGLCw4!qX3gL6r20ZgTT7{S&4T^KGtxNk06vQhW%ClFy^Yy&)|wHJHu)Lvw+{ zR+DXM9NbwI`GFryqem4`qW(vSk|NB9M(DgOGJhM4OS1Kpmr!Tc)>bY*>`WqEBK>}_ zF2X9DKu{@MY!QH&54-4J_CLkq_?`lS=qw6BLsM^&Lth?u$x^EfjnYK{5Hn_YY?7f# z9ab0Ea%hW&Qy>hd$1r^fIhf_E>=&%`mp4!a$qr3rn#SD9VLB%gaMSoIW4DcDpOajS zh;5hsHcu}-MMFQmHB1!=*Nr-c+|@NN4P>XAGZzZP5~ zFw-F~!DEJL8HIVR|5(2>0-TU)aI1|N_s<9nVlp+} zmxsBx8cvL1tg7^YK53cjr`H#rso3$tz67$+|M%!B!EmhlDLysC8lac>Ka2ngb+|0A zJ`LlXZb@eyhKclZ6Xxm~oH0&usSH1zPUTa8F;oC~-R2-MDy!W>fIZR(*>(n!r~L*b zvu|2bO=64oz(g`52;jcO4budsSPq`)2}ibD>&|6kI3)C9j=a4KJ_69BDSJ&e?^8gA zyrzBPVivL1E~G5;Tf20}P0OYxZcwsYvALbPS-*xM1XM^6mR=I8$f{YhqT5_zy9lA!PMbYOc?a9dIJj!Ic1XL&QHLiX(yuSnl858CRgKG<8W=TDTV zYSFgO_**})t#$v?gF8RJ<1M{mD#*txj%+tQ>exxQDoT|!p25kDbp z0hBl%YjdZ&*l;TZ`0z>?dDx94q00bN+^uh<2o*ftm+2~SUuG^+-z(hjX!sobt>y~c zz^(6!BQUGGg^0WnS;4*mTBEPJ!81NSYg?84U#6=7Nk+J}ghhmb+^t2B2wICUNi9Y6 zfV39Tn%Eq|LVnUx1cKXKLUtE1yn^C}=Mxx3*aIXeG83l$=s${I=qQ$UBSu1>fsK1F zA)f_8*R&GD0;GXskI@OvjI8o9%OPI-UUGdFq}b%3;B3c^fmuM1ci+MC@*zfUxQqj3 zL|6k^1b2Ml?F>Eyf(h})IyOM`?9OO635D!JfsGQjO#FptYfO$bW!j`P+boYXX@UeO z)id^N(mkQ-Bp{qv5Qtyi?d7!#XxbLddj_4cf`5AgftwM&eNmwX-#HBX{k0R-J(`i& zSLjDFeJEI`m--c(>GPnzcH@BB{CXbj%-E8Zx738h zr^<+Z|B4bB{SLBMApHMpGiCh!vj0J?g8cx$;cK;4LZ#bVDkW9}cQn@u&1l250r|Q~ zxT9qa^UVL9h8P9j$@#w2(7`v%5c{s*X6Bsa22zTVcboRcD}G0?L&;(@w{R<7M_j3% z{!cH~j;JD30e0?*Bs>L55h6elr7O5H(SEox(mk$>@C|hm!gn$|Nh`lq#zLTVKGx2J z$@F&^nB=ZmE3Lb_9x+=xidKwv2Z5=TWuhg^GC}Mt9wDyPq)3g~!Y`=5kRxaZ{ZGzh;s{I% zV*>i0q`bi!M8x$!nVIAzNEO1DvKd}edVdlG9M=e6LK|$AnOytJS1w(87BmA?A4McF zRY}G1UbhZn#y}7>BID?`ZF7u3mE2V-%`{0@%)nvYTDpmHHc4{~1f-7yJB)}S5T3Ud zr$XOi=N#Pz<^QG|4!~F707QQ8m(%6;`amNuxT9#IZ`h)AzNnVE+CTrIcdh%Inrqg+ z4nr2S01I!%;6&4d3q5qX6_85a(?DIT0_d@Q)6LUl(q3b>v6utQIz%WqLOlR7`CObs zhM3=y6Umc#Z9J!yab-rCY>0g@1pWPsvecf{Be{)&i%G0iWIYU#wOtA6g?AHOp~$y_ zHG<+T9s--ub45YBj};uWs84 z=AAcxlr0CFS}w2t{deB}9C9kXwer^49VRNZ`m_J!tsTmBki9bPmBmgbTq5g2_74j= z5d>qnY|IL=5!XB>$wmY z4o2qaeT~whc>yEUD_1FS4Xf^M1b6C;=@{yW6$D&q9%c{U;7)iSvvf@Yj6u$5jN)M) z5CkX}iva?bQejsN;yi<}O~mVn4G99WNw6a32THD}kz+1-XL0Sy>W0*!2};@-AJxcP z&{;MIrY^05r|Bya3yN2oC`LqyBeM`2K>}uRi|1{7p~SZ3L=4qbN%UYaLgA!Dfr9*u zI45KAY+f^^8cJm8t!YP`{HAe|(Ix|c^1ZNgRE%oJKy8tr57en}6b$b1AkqUzD|ul{ zNGC5Hkv~$hj3CGs5jiFIY2{;z8&Dx^e>o>EngAUAgcD{!8X#e2WGYzl<6}HTz}F*= z7Kf9_aJgOG_c|muJTbWdF(nh}Jn~s$7($@kB$|c~0p_SrAO$V{ZOS&v%pX4`$FzYrHFi|GP0`95XKVis^a5s0O*O(O5@W@cC@_;g1J-9AMKM5AyCl@0HD41P>aPyW zwBa8Yxr&iVF_=d%n7~E$O9q5P1n%*T=`*%hZ@$cKexG^e87HK%dH((YqohCdJxDho zPxH5FexbhSJ=n{^wFY1+7G$c$0pOeM1UmOInduvyIDrC?glYX;EcFIrZ*g_)LMrz5 z^`GK#6=isNe~XUS&o|PlYjo4)d;oVwi|BY$B(Jp7EkORG2S_~t- zA73;Xn1Mzz>o@xJr&Ch}a^_u2d_wc^S-AtSjfNGVp>$iBNWLhYprg^1u>`g?K*}r@ zL!!Mr&AM(*+o^UY`4_PGM ztVZFjyd@6fZ)G;`n5p!gdrk7_{MpRm*BN08PV4iVK!_$d#AIh1(832SSR$r8w5$iV zm?6wRGmAnVCVaggd2!5P@K?l{GUL9v)F@6b9-hSLM2!iPDC}9CM7mqSSi(cF{j@Fb zf$D;svb}0yDD5|?YD>Lu0Tol_^xMxj(!GoOOT8;SiQUub?_WDs>UNMTc?#JzRQQ2o z9T}5*Bx5p@&r;d1y~*sz-_Kb2=zx)r;M}luAG7Gq8=O6!Sb+Y!5`%jRPt$Y_DNLEqIyP5y*1cB@z+q^bv)0Qn>#({la2`kfd2?o{gZwAFL z$9@|?$gKr8+Q>}4dJ)(0->MEEH?(lP?3lW`$ka_AoE5)b100e8ed3PMxS z+DTEDa`7S1mLRF8k(1v$)BwQm*$JtyTj19zf$p?7h#d$r)kO=)6-jj|M6jTX2{OR! zmr^9Pw5}>QX9Q`k^~ux9GQyNhh`uJ9ZBX|&?KH5N;P!nL^PoGRalPrlvPwwOf(av( z>vZs@k4!bxph52?O<`L*!rUJA2Dv-#*m_Z){3_CTXh7S~r4hYo-nQK`9g-acKMmFc zx!y?gv~>ePUDG{0gGN?|j^lg4_zv^Hs32uh{D?L_ zm`00<*o3b{_GcKsrPoRLE`iddt*5;g1~^vh;>>2~;KU@@T+x%f$K05EBwS}B+y*bR zz=yF3`SKBGP`=vId8i$57$a9D{npM?>uZL+BkdPEKtW5td3z_i#XsLHED63+VNhu;F@<(Wd zTrmXA{3DTQDp3V)nP`o|DSTEf<|crg$4C*s;CNH0WS$(sZe^Bu8>fS~p^!xQ(IftJ@p;n{k6v1&8z#M@ZH*VXi>x&#jh_VzJW~Y0Bow z8*DmqU{KTNBu}XY;r~D3%aQG&0|@tkJzF-_g3I<#!gq#yjd4g~=e*ir{U`?9!QoLn z-byjYFWyh^6qau28|GY}i%~tuj}V3PWb`#`zlLaz(>=^ths8o7kHgKT`I%GQp;Ix-8JlPX2&5#G+B!-D0T}a`GMFhX$xFy7GjX85nM@Tpw z7?^Wt00$3(3OqBJIVHC^XJroDzyK|3gFH^Wdqp0@z#E{@#=@k+xqfDPxA`k|UoKH%X8JUc?qV$!Xo4oH`cOfynBTtj01Dj{ykDNW|H zGZV-$3i1Q{Q3-zHakmi5>XE}72@(+s#!GmznTY}`4twLrGU<;qW#b?s-moiN?kAHa zxkUr`sz3(RrvaCqfrE8PhfPo1r78ioV_1f^J@}uhr%a(v$c=|&lCD3jX0q*11g^C% zAzHR2;rL94QLas=%fQx~PYMB`Ne#z0&E;{*CXWt-bIpkOP|2GfV6NoERtyFRV&y6* zu<0|9ss_#LAmcKmNuGRlvs!2Z+PO(|O*0*Aij*|`hA1**zxPJ6oe)+%>r_DuK*|r{ zE|ZJe<6>Nx|IS`I*N>+!z2k9Gxw>{wx{^`?5c_hvtZ*k!kUw`%`P%Pe<{*X1=YZevWXOrt+n}Zf%>8f(H3V;*&!n%aBMeaxLe~ea*z~P<>Bs4kX8OSB+5O~f@=D2 zI~TM~07XOEq2}>FE@xJGI7maqKdf}8bnH%Q+t`0c_Xl45VedoP4AoX>9V{bU-(jE%G#b9(-*g1RKmMBjjcT|=|^j4 zumj4JPfyd_Y4y3Egw@kL2;;#A+y@U~_l9|JHy(6arSF%jySJ`u!f(@+RQ18;E~d>8 zqXJ~x163NcYP}erRr{nCg&fxF-SarfIub^ay)vouV& zx(D7=*7a;$4IJlc^6cXNDf6h>ZZ4)`sp^lvsknbN0K4(++Sfz4lHPu&bLirhS~JZn zP2a?}mD{r2*}V**`5)rZY_~LZz86~a*R#EuG_-0n+{gF?88Xdc9Y>grdGZjR zFr}n@w4V_(IvbzPstL^WBHNwDzPB&Q+MA-pwV%lL%Etsu>c`9kWV_3(d+mN3QBys- z;?1Je#SR-u4EN6XKJ$_ZzS&nhA9o{X#@($el1dPhwOv|(>&0=DbGh$uS~7}9R4 zm>oJ|D8VP#07hZvrui5yOv^b~OsybWttu8&Sz@YyDa%ug@oPj(6j~no3s;wz+&-9Bp>1SWXxjfA!B9$rU);7uAG2``z6S>9YW4TdWnL9 zel6-JpeH;6I*11z{d7F~`D0NbpD!w9{gkw%)G^*fD)szMA$`{mE5(anJCx9>+sUK4 z_AqM}M0kp6tenT^%Y-{8pd@w&9xr*i=&~q%k_-1Zr>Z4NV;9m z3YKQKx3Q0jq${2o`A1EJ(*^nPxuVX1AfnY0OsbqLyS8(BjyjD?E;f| z_?}_-I23rc6q_G3_I!RHD6Pi*Nd|U+q=ACsUv6GH$*>y556S&$G?$2T6r2Ed1;m0J zgI8k$i7t-Cp(taYAe=`q2`B<7z%#Q43q#IPtZ5>doRAbpQcQI%5Y&z8W&v4AEF%n(~QVIM*qpW(^1>FVT6uHps zZ~YyaJefASTt%x0Zh?kHmsJHy|2nkCfBi}PdBP13m|DT9Ntx;IU%NNu`2BL`8u|Ip z)xNh+y=U%A=@+K{@;Ud-`_nI`obRTbH$Rbb)-ziZwlae+O_av&gv!EvCNCn95i zW0SxMvSHsak}9YT>^+t~G>NAW(+n8U=&y?fDN$_&aDwIYI7$R~W{n1bPGhbi6+nlq zZ9pUlpc#cDjnAOtK%Yw<8ekxp-w;-lF%IJSr8l4@m_y8ev;p9Z_JYqkBCBo=00q_; z7%wwM!wB#|nZ3+n?IF?dUcQ*R(fM|LzbvkTf?9xR4=G>!pE0ozAjS9tLI&LDncgtZ zY&YrH1C>c>?NHh4)upEwHkLoUM1m4GM{5&OiRomjJha+p&4!$*v3O3~#dh@C6N;qU z)o`^-_!* z1F=sMeJxvYH9Q+~aJ+~-QT&ST}XZTUty@DJeK84dI*w8v=}LP++!UkBEnfSzaw*m6B_wP!!2Z z(u4q)e8FYhHwfdsY+f3KT9AM~2ZYTflheAPiJ8>>rU+>3{?{RPwY&~>=Uf~fV1JXK z)xI{6#<8^qL|R`3#6bAI0eOx776Tt>%Ck!Vbb0VxY!-q7J1 zLKD{5U2NgvdERIMoC$idhGBcr6^Os~AKDGIS{r~kvV9Y^K^{wg{w}*uJOm)kckzVC zscp)~C4&xx`9bpp z1lT+Qj*;WRV#j=WHu5qAd(i+6O-q`Mt1!~|ZjW@uG8r#5F>o1pT*3ruehOTGG|GI^ z3?d1HDF+C)^H?^5gzn<8sd*V)2Cfl|{$u4!!a;5zeQ+ZdaW;3$3EnGjnb71;`>SW? zT3@b}AYaD`kl&JNo>s!DO0^Ls(^jP9&d*Szx<7N#3qq5(Yz3iQ=0+aW zrt0@L)o6Nn?B-4RU-Dm@Jh&zcULy@2ii0R|cF!xi`|~*Iq^psJ-Mu2shY%Z*Xe^D{8O@cu9W;bSJ$lO+8B+sL;cvt>@3@DAm@O`1d9^7nX)Ln2>S->w z*8-Lz?Fe~-`COu$#H@zxBv6%kPcwl0!agp)5V_?S^pd|cJ>p+j30)hUv3m=Exr&m7 zMYTT(6uN*%DAcVBe5Vxz+ny8<6wgR296lFC@bj)zSss4AVX}>OzG^^m&$p&-w7oWU zBl!B%%+|F7>DbnFEO1QSzf!hxF*)^xtjk8I}JJPO|Y(d{>XwD;zZ zy3HfgD}P7LClB2G<%9ajRP0mFoxi%!l^xpb^j9+1rj-2I-(%1Hwf>lM4%GHbK7#u5 zrZW=w{ui2iPK$JiVwD+z7HX|=&@PoQjTj-Y=!}3vnKHz0dqiv)WW=bf#2&xU|=!AXkpkr@1Dd{T zTV&2S^VIeEg{kUD(>%)DT*2OFu7rxeba9GCdn|+~(ZG zT5gwI|}}QW5&Rm=a6w!mwk*RdqJAe2MaYm`SGcGYji-gURn7 z>_RD6F)B^2tuHQ>k1eg1$#P+kavbv-RVK+z6%wTZD}-kgOP3dy%sx%PI7(t}0W>b$ zr(EVnNVNefmeX=~n&7Xy~+!3dAd57*g zd4A;+)pAeRoN9snetik0Nt-`r7}NFJRXDAHe?FmmIWC>c^V&&nvl&e+T(Eh zjLo)wU-Ucs8QgUs`eb}cELyb;KeO`2Pt{(GZr-CgnSI~T!_aFVT;96=pgGmHPn+0h zZ*5D@VOY;a>!)-V+qK81H$Q-FnYTqZ@2Cyhk9|;j&I9&(Zyfq{#Ae{k$==QGX;5~9;ozkr%r4tjs)y0vMH=j_i(!B@-=F|k9}{DDGi-Q@cm#0k)$AQ{t}Q%-Q{F# zY3e+3sk^)dc^B|%-U7j!iRI^I?MVQkbNgOp#G}Od!R2ps9@!?ygPP42O;l+{NElT9B@L2yUg0*IEqgb|{-QzGYy-I?XC(HTewo+>EEtRP_;o$;%0t2oX2 zIP$vf7iEK2899G{PC?_q#jP(IS%Cs5bN+93*UCn!I0TG2D;4$cjYIR-)8-kna-~fh zjPDtUH!EWCCefymN(=lqV)d`3%CW6F!UCZwL$(#u_Rh&a41dL_!LXZWf@Z~*5-e?N zN$dR4O59QhEWV`#I$LuI=|3~SWOz*0<)xpwvb2f~^GoaNYb5D34QB`ne92uBuq>>A zwuEW_ao8sUJy95X+v`rCcJI{TSAI?A?#WlvoBw{Q(l`I|w9e(B&3~KfZj&(f?Ldx{ z2iv*^+dwhJQcJ!0X`j)A-aAjTXGQd9p7s*>Bb3Ho8&nElBcba}lLCWCGuG33XF_`X)WM=W^y}tva-)4q31uST zMuMLHn^wpWtVt!)r&6wI35)Juo`-=Ix~sf)j|}vclmYGA-+0+v9oqaic446UwsdCO z!q9KjTt|ArqBtV6{cGg|lLdl_S(AtNKv`_N#flJH1){!+L!9~owTA&zwSx*(x>{`j zuD@vpuD`?>=nQLK4v2g^Er(T$VeD)k3paGMl)#wUQUVUpTA~sFOq`^s{+m{EE|Znc zB?c#w+@B5~syk&MkH*(R$o6bna=-*!?m`AF1r;q^F#zI70s_V|rY0Cu+7vCnSdK*D zeP$$xPCGqX2UdCl?a`EaQntP@4U0kVtI?}%zYoRewc20PZTrPnQ|ha`+NNi`3%-0_ zO@LS1K5s;muPCl)U=PxlrRz_p>T4@K5A4#KpJt0Q@bi7M_lbHYrS5>*ysX}bG-~wv zoijJu#Jq8R7p~6L|0tdDFm&tpn(pdXr#Jt}a_xHR^U<&A7c`31x|qwR%|h9>nT99% z`hqu@_A2$jQBHln^{0i z3(hBIRt!o@4C!DfKZ%7NEh8kEI|Aqw!Mr5lzHe7thBLt$@SN&9TlI&cJTT((jrgS> zym6tUb{EQCiaL!r+y}p)WuJ)uWz@Lzfe?@teZ~)XR(*GVmzlejP5d%k@b~C6Wp)~N zT?17l*QDG-$d2_Z|| z4+N5C>Oa4>0w2IH33(HS+>3wYqO!Q(WQ1V$QJbzH1Y}pS)~1hYP6YvPA{?r|RpKse zz1LNu13*@Z8A%o3VcRlrs>{Lz(WU_IcWhhHIS0h6$zFqpH=ccF>2ZjtO+dta2jgAX zz=y@OesTnWXeze%o1)2W*@`r#C1Jy+c_J3;3Bj=)b=pR_TPh~gFMmXHes4LLVE%Ix zMbI~F@-ss)bNi#{f?1+h7t;dK-z0;;R5sN@kdK>eX-!5lZvsFenk4^xn*BvYmgT50GI&neMYK_@s!oc?8u2RZ*0pf7v@KYOhuf59$Olq~*$EQJL)cW)j=~)GR=r2UHRO;S-;BV3DxrIb;xGY@ttm73 zAVqb2wGa&aYB|8&Ynm~S5xZ|!FzJ}+91h{- zK22kO#gwQ;7bxtDCXi47T6Gb;=oMp*nga&#ZuXSKeqzH~zd;R2z6QYcA_L%C;`l5K zzJJfZnLSRgG{oGCoKL0L)U8aqbxh$y?LnaBR|^2iV$ZFUrDHHHTkHWl78#)vdCQNH zLyBvujY5nJ^Z6bjWY|%&qlEKQ#Z6GtRo~&w;0A}RV7(X`Zs13QMVsS(0vC5Rfz25Y zY&6~*U{l)Lx42iz=a_y(BfsU|fXn+pbb zyrNOpUPFp@)A00W#+2^lNHdQ*%$NNi)JNax=!Qw=X?ajv5|UFZo^j5Y*5Ue`zxvK| z1aU-)OD*ZzOBz{Ldmz$X*T5(9g^d48&zU=7#kXsZ?DTb5L;XAP%-iZlngbrulVcq; zKpe#&9zbHQAd~A=*xk9{OBM<2Gd^Z9u8Wu+mY|CS)JpIg#4ygy0?-TCm<^#?oAL#; zGbT;FIZzzT6}J#0*c?Y+_(d{OS(Lh|Bi++V+{BTvRj>tdxwj%avpLfTrdyC0Am!aL z53}zM&VSz>8uIRLN-`iR_vg8h2GW0;7Jl609B^(?qEB8@6!RCpih&tyM#mD8|8;WJJ;*N}g z5>Ev{l@MfO(ze20C%AS|Q)j9}-aN}YXEzV*Q&wgqQ_ba?Kdqk zG#bF`9unq-`>BUhAX;r{%Jgj%61RKNqXeswfWs(s%$v?sM8Sf>rhmjDCCVV*XO^=a zKcwHd)oPgUiB#(K5Pmv}CSuOAs^N*NFf}t<(8jM5n?8H3X zl=e*!K?VSVphGs*EUuK)VH?jt%SSkHc2c`29o!iP`3Kgl_S-Ye_t9JXY zO%;*Ue8t_^nOZ;REBFyNFS}j;(+=P^lS{#j8DH$fkYGg9R8NWev3H-T>aO=OW9PQ& z;p#boRej4heK(utxLVO6y$-_|i+nrCtpmYGVQkn{_=X`!dVq!PXBrg`cyz_vVc;mm zyO`u!Tzg)!Podf0^kAY@4|Fspij`SiUHgNYWqM1-ki?D(*XC#~4!{Dt42tnpDA{3-{2;XK;b(lf7c!A0A z`GTA=N4mr_Ow9{j@Ekxaw?~kK82*D-M0Uq3JeO3ZH1ybhgYn~LgEojLs{@?)0Sfp+ z_pk$j!98G&3@>^zk^c~=;KXG1jO7Jjz>{DGkT3WHNg#urv;|xueMUMj+o-6STOLl< zIEl1l++Rm_sL=@Y=Yc+6`aoN|mqj`d4PF3~Z2Hsa+24_dzwL!rEA#b(X|;hVI}kGX z!qvcTe_>!A0h9khU0>C6TVG67gHkWk_qt$siecq&a1Z2#TmtY z=l6blCitP+)ok}+1Payu!xv`*ftP0k!N7cNBwat))TC)X{VO|_s!F|2gbJOA^whLX zK4;C>eM&}Yz~Z60$at86poMT01IZCcl!^cm*&r=U(~WcF5uo~%x^*d)%qP=GbY@N< zVraXI+Rz&{Drj37^>;3Gr?pzgaxSf{Bk<#yrN!l^mKUie<3Voi^5x|V zNZYZ>BQuXPg9j3ZB2g;TWlDnm#s!J$5JY@;u#okiLn*fdsaX~n2Ccl5wkXC;STjT^ z*r`Q@1lG`iCAEo4+&38SgtT?0=kzWlhibEPOh;GVm6mGsoran%tQU~+I z%1TJDV`za-20j9;)7_-fHTh$=E_;@7;mH9)Ds0Wn)`3rg~}As=|u` zal$!@i8J&^I*5_wY|jW9n7sk?#V?PSRW|ogmH?1P=1sf8He&fCCI$-0xXo1u6f)4s z4q(Cnc7Uxy42diS7R>~?lC=6ka?_`ngi#41joyCu2)l=a1Oma>rg0D$N^&8%d8aRP zNW%m%TnLu`k-ymIMBp(AN))^qm#d2Wjj3`fbDydRy|W_@fpar^A;vqXg94Jmw?M$4 z!@Ox7;L=nC2U}D3J)p?047~iN5Jo0%vcM5_wY=klfK?yM!%US)&VSs2p*@8hE!O*K4&zkWW23=_fZhD<79H$kkTekzemm zMi!?DasR*|E`>3_@{YJc;wu$-B(2CWi3_GhCK=M&$Lz#nX=GxtEF~=iq0=ICv}s&O z2+7T7-Z*$iM3m6qxwu|Zywu2X!n4nflm-fLlU{Zf+$Ig2BmqX+U2ZhP$xqzbD=E)$ ztI6C=MP`CL#kfjKJ3#yp9|T&!?;Dki^w1V@*r=oQ!s~!(g(+aPrgd;Z@@VYpXzPq^ zD&G{6BY$f5GajgZNL2tS`m*nu5wx4_pS;@k6;=;G~H-?>{S=0*MabnNT$H3>47cC=s1w(os?9*sX+UhLA>7Wb;GHlNt+ zOf7bIw{PBdF>xm(qJQ5WX#Yk+8fw)3O(M`<|4V5<(Pzs36s!xHj-)>w1}Bh<2!s|3 zjoeM5AOLWMWZ?k@ZV9v?Z;%X_Qvp6xs!4hQ{_MU69&O^0U{bdft@Rim@Fg&&LUIoF zD1(3~LS`m|O!Hz}3qxlF>>^DI#AD!YKAV+f*ZL4~Ja*$Jge3YdJhR-Oz9xY}{&EOj zB4kOEJlu+AAKxf(aJi0hP>?PJ1IOoc@B-mhWO2IhojN^Nzl;jKYo%lzQG7JPD z39ibs+3D_3!bCO6&N4_bd_O0gk13V-IBqcELZpOLBYQXamXJe+YFPb*8j+i=x zTOyRjR0)lw$YifQ{Hb zAQ%&?-z`i{ZsdLJGhj2`k*bP4gIMwE*ye zly5-JoB#wgl0+V&Qu}rR03l38Xd3Qr0U)Prg2qCc%-jGVn;+SLtywg3W$c#*^2qvQ zbs*BSGZ0u4`E(AsBwp|Gy!Csra&GH)8oBoRv$5Qv`bMmN zAeK<(E?m@HBZck`rG*{JiaV6enKHv5qlpPwV&T?}__ckfm$$wdJH7Rd)9u&y#!er) zewztd`2_WzVy`cNA;XR-ltbDTzTrLrFAJ0|8r*PsSUZK{>*(AGxI5{#vvwG#KyvO zI){r8j0J@P-4rw%6bjtwat}o9j`+2^5}UhL+yC0cRoHo;DFi};P6W=3O&4a;1*o&) z1)#ccCOJFj?x=t|3%!Skenw!lMPUO>Kpm!JjL-hlU;wI{D+~#S#^i5aMYJHc*u=hC zp`cXJ2U0#?u3u6$PQXN#@~m81e~I7BWUh@0XmS-OVMxoXdTpY`o2qzEGLkj28a(gxBtqYm)dB^YjOSx#NP6J2hWW)) z4b{>U0{ijXhiI;~hra;A`;+D64W@F1xfF`!nWfb$OPW25`zOy7kpAEJh?M#P9snr@ z9`0@n7$sAWy^P9g>+CBK;?TFjnb>?hiEzB+AZQCo5wWjjuH!$iUFtN&(=(o}xcEs41ILACz!{}`|Mgl?ANS+9`N|n+a5^!uH z8J|1l4V$VRPVYdV3zD*M_@1o_x1hu%&NN%Sg#$nX0@fa%tKTI6>XrJ)rPPXkQ7Xvw zr}khhZEAqkhyJ{HQcwQm`uY|%n}PQsx$>&W2fbVQs@i=U3Naz7v^B${RvUdy-9NAKG}^oIv&dG)>pASZSoQ<)V)ko16v=XQs& zBGRhb5=eh(w~;UU0F?MgUxE9S&;_Y3c{Y)mlT%rNrM5S)6c0B&0WHxN9oU+sGsh_H z6$+G9^j^UbGoZK0vpF0cTNp$h9EJ^KCGk=SF(3tFSOPB7gbVpQv9`L3 zJkCpHXJZYxP0lzlV5rCu=VRI8$FoIiv62m~{qpuP91XQ`8R1ZJkb85(IQjxdGx}*jNkFQnBG8ha41hJ_AD6UOg!w&>ESUoAu!+?ihEDQbu zfbkcbWMVn|Vpmo^20Cnw)@sqDqa09-au5MJ<^WcP5(Hwm2M}iZTcv~KgtTLCejwf3 z6X=}1+V%_WUroJU`BX}`k7!IHygBuU1^F`7V6&431%kV^2P!qq<)3lgJes}!Q~ILR z`cVC)%uJuR9p#s3Px}-@A$Mo@2C{p#Eygzf@3TFj4`gAJ=$P$>S0^B(LfU{=$47zA zA82IvZ$34f?F|Y|kSf@Vt(G6X^T-D3)<1}c+1@~QztmT;&D?k&@qGaa@`LBQufFq< za`wQX7aFw}vj_U{)!MIt;s6(bz*L2yH%-S1a4h4jy9t;eR3sK(LKv_;A!*yir^q$X za)1ushBDRiHn=xmfI|_9RPs7CMw zPj<^YGr%gkqXtT;EU}L@NwXYm4$2gKb?AKY95fV2&%tj4i;=oyz}@{75TWY1YLKCg z9GVUR465iSM4VD|IG>B1KHXXl3_a@n#7{U~{YdzJ*};Dct2k0`V`+VLp?chr4DgF< zs~Zc;s}waBoXT4H>7`@O@UOG>l=IY;)x`}Qpe9$%5v%qcHjxbpPVcx%vc ziffJ>%k6w*ZGD9e!IdRw_Xr~M$(%pvqd|ii^!Nxm0t#4JT6Na1tXhJl4E_jPtSoFe zA6c$eo$A^`*$m51X!*MD{t>N*2GQqg6%u`UVPoOK0(<~_bW{=2c7clr| ze|CwV_l?l@S=J6+h~W#>rG*bKInSvl^ zWpU%mI$VJR8%PeacH!b9nl&G@g5BefVEcHLt*@;JfdGy!U%}TZoSX|wSi^;K8K1wrR7R^C z&gHdBOU^TE=&J)j!62_x%k*e2VmepB_^v!7%TQihymAT6EtR*=8X)!Z1{|Pe0-PQ6 zakPv9;0tJWed!XQ_A)wq=^0EEouVIE-l)i;qU;jJava=ub+H0RX)b^H_&O#5@Njvs zA1l-)Xg^@Eu}GDS&M|CU1isP_$~AQQPc3a6zr3{J43w9iTDVf(IO1S(F_oCojrFC4 zOON22n7WVnrkJghlu)zn!cG=kl$=x8uYz)%msZpdtF6x(_ryHc^69jKgl!JnlAW~L zxzgNT!(+eFv=bGaE}Smtq{3YQ@INRNP6k7u80>mQu}KtKzEl7d z+Rwm#R>(L7{-9Cp;l%BvBZ;W_aonL)51jW};c(qut~O_@EnvtIx9g}mME){WXHE~L zZfc}U=%!dWd}lJU3cmpPKo9G)$LyKkqwe#0r4y3HvIM4}M@ab&*20c7_hc#amNiD$ zT;JMVUkdb=9Nf+Mmzi*pj3|fK((s{5N4vm+I9cWvlv@%^np@45X!sB_&!Jpk&E|Tu zOJNhc3Bfm$KL~kSfuPHmkfSN<0a}*ICiMWXx%c0Ey?J-LDdbjN+l$-+DF0LI3@>0u zx;XRxy{x2;vWWHtLJx@V+6u@V!Vzrm-3?kgx-O(G`iMiufnWttTCgDqgC1exYd*Y- zuP=Of%{HaGkYoo`Ydk3;%K=>R1YxAB1-k%~FnZ&GVqA85u$UdhVYKPVdGRg_u5)-2 zXr!?azIX$yD;)R}lQ6Hys){qW%kOG+yDZQtrgAly!(fYNE#2XBPM+JNqiQr(!@dtE z(OQ>djgJ0yXgL%!qBS8}%z%js^<F~-dS^A*8PKQp(wv0N4ILn*}2Vtx_1 z7O)*8`S3~c)Y3T<6_H^gE7x2FG%pXuv11DIx~c#Oz35_?PRtRzh%A+O$DIKdXRwSq z2fCcB$6e zKZC3i`2r4*$T<0U`V@+hOT_E5sm#2u*zX6s=LmwVMn;BxHKZNvqa30BH4cU91ol3- zgO(2rj3Int4Cbj32;-sA6TZj#X>6DuN0PWv$>}y8@;zst5EVUykmn(UN({kYHtu`O z-Z}&05U9st%wtA4gmBpBkBb>xfSE{YC&>b~Z=O%9P0RV%L}B{lk3s@nzx>$B!ZX!{ z)yJx9iwo7qE-jU-OV36IM;?1-ed+1tjbmEy*oSE_t1e%DW)WhRelP>cK>YMvwwUA|*COP3HF*x4 zgJ@0VL!wGZ2uk7vGUXHQ13c-HU8@<02Lq6WwVp`c$kk9hjpK%iUjr?ETr3NHgbazu zX_X^f75U$uI4nCNyNqv%H^eEv#Vx>$Mv_Ks_tmM&BQNG=p&b=q?qj_o^64A--*iQL z*z_)jU`&I0g0kzDg(f6tD|6iP9=pJQoTcjJB@99hK)uEO z5;kl{?~Z3%&g|w%aE~nKh@?AI5zLyJM(lY?;6id*kk*rNU}RA&H4hLsYt3S8q$kl8 MO1U%P6|cho3kdj?r2qf` literal 0 HcmV?d00001 diff --git a/library/IMAGEOBJ b/library/IMAGEOBJ index 46a2e120..d261e49c 100644 --- a/library/IMAGEOBJ +++ b/library/IMAGEOBJ @@ -1,137 +1,69 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Dec-95 13:21:56" {DSK}LIBRARY/IMAGEOBJ.;1 35602 +(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}IMAGEOBJ.;3 34260 + :EDIT-BY rmk + :CHANGES-TO (FNS GET.OBJ.FROM.USER) - changes to%: (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN) - - - - previous date%: " 6-Dec-95 15:18:32" {DSK}LIBRARY/IMAGEOBJ.;1) - - - - - -(* ; " - -Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation. All rights reserved. - -") - + :PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}IMAGEOBJ.;1) (PRETTYCOMPRINT IMAGEOBJCOMS) - - (RPAQQ IMAGEOBJCOMS - ((COMS - - (* ;; "Bit-map image objects") - - + (* ;; "Bit-map image objects") (FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP - ) - - - (* ;; "fns for the bitmap tedit object.") - - + (* ;; "fns for the bitmap tedit object.") (FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN - BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU) - (INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700)) - (*SMALLSCREENFACTOR* 0.5)) - (FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4) - - (* ; - - "GETFNs for backward compatibility with older objects.") - + (* ; + "GETFNs for backward compatibility with older objects.") (RECORDS BITMAPOBJ) - [INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1] - - - (* ;; "make ^O be a character that inserts an object read from the user.") - - + (* ;; "make ^O be a character that inserts an object read from the user.") (GLOBALVARS (BITMAP.OBJ.MENU)) - (ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW)) - - "prompts for an area of the screen to insert." - ) - ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5)) - - "prompts for an area of the screen to insert, scaled down by 50%%." - ) - ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T)) - - "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50." - ) - ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*)) - "Inserts *INSERT-BITMAP* in a document")) - (IMAGEOBJGETFNS (BMOBJ.GETFN)) - (IMAGEOBJGETFNS (BMOBJ.GETFN2)) - (IMAGEOBJGETFNS (BMOBJ.GETFN3)) - (IMAGEOBJGETFNS (BMOBJ.GETFN4)) - (IMAGEOBJGETFNS (BMOBJ.GETFN5)) - (IMAGEOBJGETFNS (SCALED.BITMAP.GETFN))) - (VARS (BackgroundCopyMenu)) - (FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT))) - (FILES EDITBITMAP)))) - - - - (* ;; "Bit-map image objects") - - (DEFINEQ - - (BITMAPTEDITOBJ [LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT) (* ; "Edited 13-Aug-93 17:17 by rmk:") (* ; "Edited 6-Jan-89 16:34 by jds") @@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu BMOBJDESCENT _ (OR DESCENT 0)) BITMAPIMAGEFNS]) - - (COERCETOBITMAP [LAMBDA (BMSPEC) (* ; "Edited 11-Jun-90 16:28 by mitani") (* tries to interpret X as a spec @@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (fetch (REGION HEIGHT) of CR)) BM]) - - (WINDOWTITLEFONT (LAMBDA (FONT) (* rrb " 1-Feb-84 15:26") (* reset type of function that changes  the title font) (DSPFONT FONT WindowTitleDisplayStream))) - - (\PRINTBINARYBITMAP (LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16") @@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu BMH BYTESPERWORD)) (RETURN BITMAP)))) - - (\READBINARYBITMAP (LAMBDA (STREAM) (* rrb "23-Jul-84 15:17") @@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP) BMH BYTESPERWORD)) (RETURN BITMAP)))) - ) - - - - (* ;; "fns for the bitmap tedit object.") - - (DEFINEQ - - (BMOBJ.BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION) (* ; "Edited 14-Aug-93 19:44 by rmk:") @@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu  "And clear any cached shrunk bitmaps so the display looks reasonable.") (RETURN 'CHANGED]) - - (BMOBJ.COPYFN [LAMBDA (IMAGEOBJ) (* ; "Edited 13-Aug-93 17:13 by rmk:") (* ; "Edited 6-Jan-89 16:19 by jds") @@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (FETCH (BITMAPOBJ BMOBJROTATION) OF BMOBJ) (FETCH (BITMAPOBJ BMOBJDESCENT) OF BMOBJ]) - - (BMOBJ.DISPLAYFN [LAMBDA (IMAGEOBJ IMAGE.STREAM) (* ; "Edited 7-Dec-95 13:20 by ") @@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu 'REPLACE NIL NIL FACTOR]) - - (BMOBJ.IMAGEBOXFN [LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 7-Dec-95 13:20 by ") @@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu XKERN _ 0]) - - (BMOBJ.PUTFN [LAMBDA (BMOBJ STREAM) (* ; "Edited 13-Aug-93 15:41 by rmk:") (* ; "Edited 11-Jan-89 17:00 by jds") @@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu STREAM FILERDTBL) (SPACES 1 STREAM]) - - (BMOBJ.INIT [LAMBDA NIL (* ; "Edited 13-Aug-93 14:27 by rmk:") (* ; "Edited 11-Jan-89 17:01 by jds") @@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (FUNCTION NILL) (FUNCTION NILL]) - - (BMOBJ.GETFN5 [LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 13-Aug-93 15:40 by rmk:") (* jds "30-Oct-85 11:29") @@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (READ INPUT.STREAM FILERDTBL) (READ INPUT.STREAM FILERDTBL]) - - (BMOBJ.CREATE.MENU [LAMBDA NIL (* ; "Edited 30-Jul-87 19:19 by jds") @@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu MENUOFFSET _ (create POSITION XCOORD _ -1 YCOORD _ 0]) - ) - - (RPAQ? *SMALLSCREEN* (ILESSP SCREENWIDTH 700)) - - (RPAQ? *SMALLSCREENFACTOR* 0.5) - (DEFINEQ - - (SCALED.BITMAP.GETFN (LAMBDA (INPUT.STREAM TEXTSTREAM) (* jds "30-Oct-85 11:29") @@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (RETURN (BITMAPTEDITOBJ BITMAP (FQUOTIENT 1.0 FACTOR) 0))))) - - (BMOBJ.GETFN (LAMBDA (STREAM) (* rrb "17-Jul-84 11:46") @@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (RETURN (BITMAPTEDITOBJ BITMAP (CAR FIELDS) (CADR FIELDS))))))) - - (BMOBJ.GETFN2 (LAMBDA (STREAM) (* rrb "17-Jul-84 11:29") @@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM) SCALE ROT))))) - - (BMOBJ.GETFN3 [LAMBDA (STREAM) (* ; "Edited 11-Jan-89 17:03 by jds") @@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM) SCALE 0 DESC]) - - (BMOBJ.GETFN4 [LAMBDA (STREAM) (* ; "Edited 6-Jan-89 16:33 by jds") @@ -731,162 +616,90 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM) SCALE ROT DESCENT]) - ) - - - - (* ; "GETFNs for backward compatibility with older objects.") - - (DECLARE%: EVAL@COMPILE - - (RECORD BITMAPOBJ ( + (* ;; "Describes a bitmap imageobj") - (* ;; "Describes a bitmap imageobj") - - - - BITMAP (* ; "The bitmap itself") - - BMOBJSCALEFACTOR (* ; - - "The factor to scale it by when displaying") - - BMOBJROTATION (* ; - - "A rotation to apply when displaying") - - BMOBJDESCENT (* ; - - "How far below the base line to display it. NIL => 0.") - - )) - + BITMAP (* ; "The bitmap itself") + BMOBJSCALEFACTOR (* ; + "The factor to scale it by when displaying") + BMOBJROTATION (* ; + "A rotation to apply when displaying") + BMOBJDESCENT (* ; + "How far below the base line to display it. NIL => 0.") + )) ) - - (RPAQ? DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1))) - - - - (* ;; "make ^O be a character that inserts an object read from the user.") - - (DECLARE%: DOEVAL@COMPILE DONTCOPY - - (GLOBALVARS (BITMAP.OBJ.MENU)) - ) - - (ADDTOVAR BackgroundCopyMenuCommands - (SNAP (FUNCTION (BITMAPOBJ.SNAPW)) - "prompts for an area of the screen to insert.") - ("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5)) - "prompts for an area of the screen to insert, scaled down by 50%%.") - ("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T)) - "prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.") - ("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*)) - "Inserts *INSERT-BITMAP* in a document")) - - (ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN)) - - (ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN2)) - - (ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN3)) - - (ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN4)) - - (ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN5)) - - (ADDTOVAR IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)) - - (RPAQQ BackgroundCopyMenu NIL) - (DEFINEQ - - (GET.OBJ.FROM.USER - [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 26-Apr-91 10:54 by jds") + [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Jul-2024 21:04 by rmk") + (* ; "Edited 26-Apr-91 10:54 by jds") - (* ;; "reads an expression from the user and puts the result into the textstream.") + (* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.") - (ERSETQ (PROG ((VAL (PROMPTFOREVALED "Form to eval:")) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - BM) - (CL:TYPECASE VAL - (STRINGP (* ; - "Atoms and strings get inserted as text.") - (AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL))) - (LITATOM (* ; - "Atoms and strings get inserted as text.") - (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T) - SEL))) - (IMAGEOBJ (* ; "IMAGEOBJs get inserted as is") - (TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch POINT of SEL) - (LEFT (fetch (SELECTION CH#) - of SEL)) - (RIGHT (fetch (SELECTION CHLIM) - of SEL)) - NIL))) - (T (COND - ((SETQ BM (COERCETOBITMAP VAL)) + (ERSETQ (LET ((VAL (PROMPTFOREVALED "Form to eval:")) + BM) + (CL:WHEN VAL + (CL:TYPECASE VAL + (STRINGP (* ; + "Atoms and strings get inserted as text.") + (TEDIT.INSERT TEXTSTREAM VAL)) + (LITATOM (* ; + "Atoms and strings get inserted as text.") + (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T))) + (IMAGEOBJ (* ; "IMAGEOBJs get inserted as is") + (TEDIT.INSERT.OBJECT VAL TEXTSTREAM)) + (T [COND + ((SETQ BM (COERCETOBITMAP VAL)) (* ; - "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject") - (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0) - TEXTSTREAM - (SELECTQ (fetch POINT of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (fetch (SELECTION CHLIM) of SEL)) - NIL))) - (T (* ; - "Not a bitmap, nor one of the special cases above; complain") - (AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T) - SEL)) (* ; - "(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)") - ))))]) - - + "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject") + (TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0) + TEXTSTREAM)) + (T (* ; + "Not a bitmap, nor one of the special cases above; see what happens") + (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))]) (BITMAPOBJ.SNAPW [LAMBDA (SCALE SAVE) (* ; "Edited 14-Aug-93 19:54 by rmk:") @@ -911,8 +724,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu 0] (RETURN]) - - (PROMPTFOREVALED (LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT) (* jds "26-Sep-85 16:46") @@ -950,42 +761,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu '>))))) (CLOSEW WIN) (RETURN NEWVALUE)))) - ) - (DECLARE%: DONTEVAL@LOAD DOCOPY - - (BMOBJ.INIT) - ) - - (FILESLOAD EDITBITMAP) - -(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993 - - 1995)) - (DECLARE%: DONTCOPY - - (FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT - -5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 ( - -BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) ( - -BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5 - -21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) ( - -BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4 - -26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) ( - -PROMPTFOREVALED 33154 . 35378))))) - + (FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT +5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 ( +BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) ( +BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5 +20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) ( +BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4 +25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) ( +PROMPTFOREVALED 31934 . 34158))))) STOP - diff --git a/library/IMAGEOBJ.LCOM b/library/IMAGEOBJ.LCOM index c2b958edcd969a92f336ffa19badc89dcb906375..9781535634d64ee261d77e142d79c9681f782403 100644 GIT binary patch delta 1412 zcmb7DO>EnA6mLSZ4;NTEZKLbN`s%K&t=6tT;(T~$)JguyoY{^WJ1y15N0)>V+QwB_ z5Yq%X4Y+VXW(a{0nwW$Hmx&4x0tq2Fa+tWV14j-MLT~^C9Qb&4TCJlXfe*j;;rHJE z{onijpYOianPdv2s9S_9>IUI-t5|`fww6Dol?c$f<&vtQJ2w5|(BWQAa|nn6OHoV^ zoUaniB?X`%&6T^WoFqs|kVI8Ts$z-;hOT>S>#fyh1H3i{U0gIt!5~Xd-?!R2+ga{h zIH8+(NF`V1kIO7jx0MkDRghIFNyFJrbF)sb0nMk@J5NlgP$DiLBo?a`ldn0X3N1XM zSThXR-VD$4G&GjaV+;RSK1;Lz=_>u!d;iiq$Vn+BfJzFw%jK4!v$g_i{-kD=h{L%R zV2YLl)Q*-}Q0*#N&?_~EE8rl*ITo6AE~|iucNbL!r?_ouQ#-~cvQ$oYP0hwN=q?Tf z)Ix^xZ$w^>P#a$Ko@j*fpNl<$#?9DA5foQZl+@j=|+@OOy64u6HN>xaLOqw&e;+lX!Uh<^!QMGeM2k5Y`!kB|Csx{i(( z{Q=_G__uM2u_5Uvjva`}kTZSZnATIkB@eici_9^h2q|!MRkaLE9F}F>)LQROgjDENUhuo zT_Nm$tT$4>Gc1ubTy8uArV%@f>4xEWBgx1#UbR#=w&A102Tp_r@;s#U3)ngNOkTWob$X6thK_;ORJ)W-o?u z8#ksd2jpn8Uj$1(KK&tLu;Ika@94gpgMde~vkxM^Fxy1@arQJ~MQ{_LuVsv#fb5A1~r35nMU34{a^LNJME1n1h>Qh^W>dHC+V-}$}g zp5wgVe0_!EN@m$|%}m*{&5Y%it1#%BMkzEVY!g_^4Nc#+0*`&OZ`*2`;iy^>6+*KF zEU1}sbU33GKos?yqDwgzICidae5t+=%|l}mRbDCuQ!npbYBr8VbIaq$qxpsCbdDFt z7wU(bv(3}vmSaqs)rkuKh?oY3%?X)OG?&rxAQp7=Dkv;0Q;!P|&96coJ$i;;gdj8> z$MnH5rVycUI}e`cS(u+)#^`LD6*XNFbWvmfae+b-O$JfYbD}O|v?O82EZOGtxNS}N zhCiK+vxFo~kYq*3!Q9c=#Us%PSZ<8yz?Izq7&4rNnKUdlqm%W<%857;6tbY)2_x&G z8rO;W_c*O;FcVhj7#>#I3XuZ6q%!1()P)qY_G0G)ohgRA)%7eMe((A$h0Dj?-KkE7 zBYTHc^4q41$ei80vI({Ry!R3wF7(h$o3t-P?PV6STfpw75SU} zziveS#?VKIXSki@9K3_Ov0c{@Z|!=mhv7UBp=1U{vTyeea-PL>$e!Ilk5GXOMO)X0 zhr?;l%+w6~fC(PtVZy;hg21$iG;FLY5SoX=AjB?mpbUlhNH16h6#`4wT{|$t#}fx> z==i34LuW^QUtedc(Sg6aC>*?}n=W4t^syT&Ge_vYhr)%*mAP8w@*(F7dRi+d>lL|D zn@S9}&acMWw=Q05G2L$@#MPb_(X)lxUfx-WBR%!$Q02W^r5?MVibdD%KRQ1!*BhJl zK7TCc+W!B`J=604c?Xvh6w*7gy)3Knx3?B070ZGT&s%O_`XTmb4xA}0n&nR7v}sVR zntsv5#)z8)DG^<5>y%WoIx@J*aH6KsikrpIs=6R*0{GVCesrYf*7F4kY_p8CBCn@q z0d%+OJBAISkY6X!Bm%Jbik*p-6IFhKx>(XoS*$wQfQ3Bf4$&(@N9SA+Y>ILmaDOSDdq*FPz7A>wsFbapFX5$nT8_lIgb9TAj pSY)xGRs4(4RQz&lszL$(gfvy9pds{Q!{Z2u6eNZs&Cj)L<}Wx(#$x~g diff --git a/library/PDFSTREAM b/library/PDFSTREAM index c1bfbcce..1d644db9 100644 --- a/library/PDFSTREAM +++ b/library/PDFSTREAM @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}PDFSTREAM.;56 14033 +(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}PDFSTREAM.;59 14133 :EDIT-BY rmk :CHANGES-TO (VARS PDFSTREAMCOMS) - :PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}PDFSTREAM.;55) + :PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}PDFSTREAM.;56) (PRETTYCOMPRINT PDFSTREAMCOMS) @@ -30,6 +30,7 @@ (FONTCREATE POSTSCRIPT.FONTCREATE) (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC] + (ALISTS (DEFAULTFILETYPELIST PDF)) (VARS (DEFAULTPRINTERTYPE 'PDF)) (FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT) (P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT] @@ -73,6 +74,8 @@ (FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE) (CREATECHARSET \CREATECHARSET.PSC))) +(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY)) + (RPAQQ DEFAULTPRINTERTYPE PDF) (DEFINEQ @@ -280,8 +283,8 @@ thereis (ShellWhich (CAR TEMPLATE]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) ( -PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) ( -PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 . -14008))))) + (FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) ( +PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) ( +PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 . +14108))))) STOP diff --git a/library/PDFSTREAM.LCOM b/library/PDFSTREAM.LCOM index 01411eee513d11581ba64b5a8eb7dbb8f9048e7e..889ef259c5c31f73924e4b7258efc261ebb1cd99 100644 GIT binary patch delta 318 zcmX@9HA8zsgs_3GOKP&Nk%5tkf}x3(v6+>r<-}}*dP_|OE+qv^grt#?m5GIwiJ6i@ zQc-Gher`c#PHKumYDGa&v8t6qUVceNW?s5NW}bqQTd0qZ09I)=EqC@2|XbJk>iMg>+&peqe0hcG%#mS!~Fe45dnPs`EAGdLtz zL4(W1)y*-~Cj?|tNMwL3NLV4j#Z6OFK_kpD2&iJRq=2g+7f4JGXpLtGP$EDFYKlT~Mq*xiYO$)7LSBAJMrK~RLS~+Vl3S>c570D($$ENvN(w27B|sh6Of@!C z(&W-`^Yn3b4svx2adlCcJekpqMZwU-U~&+nlZb+)u77d~#E}LDKo?pWnNHSaRA4mS we3H?fk3GyWC|E&*YqFJqtDr)Fi<=(M2+t5r1&sip=;jFm8<{ufi)bPOSTSCRIPTSTREAM.;12 258100 +(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}POSTSCRIPTSTREAM.;15 258118 :EDIT-BY rmk - :CHANGES-TO (FNS POSTSCRIPTFILEP) + :CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS) - :PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}POSTSCRIPTSTREAM.;11) + :PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}POSTSCRIPTSTREAM.;12) (PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS) @@ -18,11 +18,11 @@ (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM)) (INITRECORDS \POSTSCRIPTDATA) (FNS POSTSCRIPT.INIT) - (ADDVARS (DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) + (ADDVARS (DEFAULTFILETYPELIST (PS . BINARY) + (PSC . BINARY) (PSF . BINARY) (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) + (POSTSCRIPT . BINARY)) (*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) (AVANTGARDE-DEMI . AD) (BECKMAN . BM) @@ -483,11 +483,11 @@ (\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*]) ) -(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT) - (PSC . TEXT) +(ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY) + (PSC . BINARY) (PSF . BINARY) (PSCFONT . BINARY) - (POSTSCRIPT . TEXT)) + (POSTSCRIPT . BINARY)) (ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB) (AVANTGARDE-DEMI . AD) @@ -4383,38 +4383,38 @@ (ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 . -32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) ( -PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) ( -PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) ( -POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) ( -\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622 -74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 ( -POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) ( -POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE -81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) ( -POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND -94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) ( -POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024) -(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719) -(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) ( -\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 . -126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 . -133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 . -142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 . -147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) ( -\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863) - (\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 . -160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938 - . 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 . -167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC -168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) ( -\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 . -180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 ( -\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) ( -\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC -199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) ( -205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 . -206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 . -254985))))) + (FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 . +32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) ( +PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) ( +PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) ( +POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) ( +\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640 +74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 ( +POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) ( +POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE +81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) ( +POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND +94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) ( +POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042) +(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737) +(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) ( +\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 . +126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 . +133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 . +142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 . +147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) ( +\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881) + (\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 . +160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956 + . 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 . +167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC +169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) ( +\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 . +180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 ( +\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) ( +\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC +199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) ( +205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 . +206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 . +255003))))) STOP diff --git a/library/POSTSCRIPTSTREAM.LCOM b/library/POSTSCRIPTSTREAM.LCOM index 10cea2ccc53d72125eced35ab6d40cdb94a26581..b3c4a7e9db47575a4ec80189076341265f1a6bfa 100644 GIT binary patch delta 357 zcmaETlJ)aR)(PPvh6cJWsmZ!V21X_dhNf1AW>&^#6SK|hO*Iv`loTuxl14^WCKgsE zW=aZ0smb}d1(`XiDGI3-1x3ZGRtkCfB^jA{=?a;73QBIFK0XS_I`#DQloV1DOMvRJ z8EI;$q{*e>=IP_=9OUX4;_9NHWN09Suo&j5$+nE@9Ht6JrWS^V7L#)rWmv)-gMud? zcq*o%U=rfTp3h)mO33d+h P3$tq6SK|hjWiXwl#C1zl14^W2F6wf zCQ1rLsmb}d1(`XiDGJFMiFxU%#i~{c0sg@u!OlUR0U>UlKCS@@nRyCIZlOLt3dm;Y z>FFscq$HLAbz(K#Qc06b1Ek+sF38m}#MMPX37h+r6eb^FREt(HGPN)?Fi@~^b@2?* zb&6Cd%FR~bvU2ut^mBI&)(!Dj&~Wn$Mt7N}f>l6}YnZ2hXt1se&7z%6Re~MomV;&CeL$JrN9XjR?_H&TEDIT>TEDIT.;538 125643 +(FILECREATED "20-Dec-2024 07:51:49" {WMEDLEY}TEDIT>TEDIT.;731 154713 :EDIT-BY rmk - :PREVIOUS-DATE "31-Mar-2024 10:14:22" {WMEDLEY}TEDIT>TEDIT.;537) + :CHANGES-TO (FNS \TEDIT.WORD.FIRST) + + :PREVIOUS-DATE " 8-Dec-2024 21:39:48" {WMEDLEY}TEDIT>TEDIT.;730) (PRETTYCOMPRINT TEDITCOMS) @@ -31,40 +33,43 @@ (INITVARS (CHECK-TEDIT-ASSERTIONS T))) (MACROS OBJECT.ALLOWS))) (FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) - [VARS (TEDIT.TERMSA.FONTS NIL) - (TEDIT.TENTATIVE NIL) - (TEDIT.DEFAULT.PROPS NIL) - (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP] + [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.KILL TEDIT.QUIT TEDIT.MOVE - TEDIT.STRINGWIDTH TEDIT.CHARWIDTH) + 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) + (FILES IMAGEOBJ)) (FNS \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS \TEDIT.CONCAT.INSTALL.HEADINGS \TEDIT.DO.BLUEPENDINGDELETE) (FNS \TEDIT.MOVE.MSG \TEDIT.READONLY) - (FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE \TEDIT.PIECE.NTHCHARCODE) + (FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE TEDIT.NTHCHAR \TEDIT.PIECE.NTHCHARCODE) (* ;; "Slashed functions. Private?") - (FNS \TEDIT1 \TEDIT.INSERT \TEDIT.REPLACE.SELPIECES \TEDIT.INSERT.SELPIECES - \TEDIT.OBJECT.SHOWSEL \TEDIT.RESTARTFN \TEDIT.CHARDELETE \TEDIT.CHARDELETE.FORWARD - \TEDIT.COPYPIECE \TEDIT.APPLY.OBJFN \TEDIT.DELETE \TEDIT.DIFFUSE.PARALOOKS \TEDIT.QUIT - \TEDIT.WORDDELETE \TEDIT.WORDDELETE.FORWARD) + (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.PARA.FIRST \TEDIT.PARA.LAST) (FNS \TEDIT.WORD.FIRST \TEDIT.WORD.LAST) - (COMS (* ; "Object-oriented editing") - (FNS TEDIT.INSERT.OBJECT TEDIT.EDIT.OBJECT TEDIT.FIND.OBJECT TEDIT.OBJECT.CHANGED - TEDIT.MAP.OBJECTS) - (FILES IMAGEOBJ)) (* ;; "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-MENU TEDIT-FNKEYS) + TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) (COMS (* ; "TEDIT Support information") (E (SETQ TEDITSYSTEMDATE (DATE))) (VARS TEDITSYSTEMDATE)) @@ -79,8 +84,9 @@ (RPAQQ TEDITFILES (TEDIT TEDIT-PCTREE TEDIT-SELECTION TEDIT-SCREEN TEDIT-STREAM TEDIT-COMMAND - TEDIT-FILE TEDIT-OLDFILE TEDIT-LOOKS TEDIT-WINDOW TEDIT-MENU TEDIT-FIND - TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-PAGE TEDIT-ABBREV TEDIT-TFBRAVO)) + TEDIT-FILE TEDIT-OLDFILE TEDIT-LOOKS TEDIT-WINDOW TEDIT-BUTTONS TEDIT-MENU + TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-PAGE TEDIT-ABBREV + TEDIT-TFBRAVO)) (DEFINEQ (MAKE-TEDIT-EXPORTS.ALL @@ -140,7 +146,8 @@ (PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND [CHECK-TEDIT-ASSERTIONS `(CL:UNLESS ,(CAR ARGS) - [HELP "TEDIT-ASSERT FAILURE" ,(KWOTE (CAR ARGS])] + [\TEDIT.THELP "TEDIT-ASSERT FAILURE" + ,(KWOTE (CAR ARGS])] (T ` (* (TEDIT-ASSERT (\,@ ARGS)))]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -163,13 +170,11 @@ (FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) -(RPAQQ TEDIT.TERMSA.FONTS NIL) - -(RPAQQ TEDIT.TENTATIVE NIL) - -(RPAQQ TEDIT.DEFAULT.PROPS NIL) - (RPAQ TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP)) + +(RPAQ? TEDIT.TENTATIVE NIL) + +(RPAQ? TEDIT.DEFAULT.PROPS NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) @@ -184,6 +189,8 @@ (TEDIT [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) + (* ;; "Edited 25-Jun-2024 11:59 by rmk") + (* ;; "Edited 9-Mar-2024 22:47 by rmk") (* ;; "Edited 20-Oct-2023 11:02 by rmk") @@ -212,7 +219,7 @@  "Mark the document as actively in edit, so caret flashes when the window first opens.") (SETQ TSTREAM (OPENTEXTSTREAM TEXT (OR WINDOW 'Tedit) NIL NIL PROPS)) - (SETQ WINDOW (\TEDIT.PRIMARYW TSTREAM)) + (SETQ WINDOW (\TEDIT.PRIMARYPANE TSTREAM)) (COND (DONTSPAWN (* ;  "Either no processes running, or specifically not to spawn one.") @@ -237,14 +244,15 @@ PROC]) (TEXTSTREAM - [LAMBDA (TSTREAM? NOERROR) (* ; "Edited 20-Mar-2024 08:51 by rmk") + [LAMBDA (TSTREAM? NOERROR) (* ; "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?) + (SETQ TS (if (type? TEXTSTREAM TSTREAM?) then TSTREAM? elseif (type? TEXTOBJ TSTREAM?) then (FGETTOBJ TSTREAM? STREAMHINT) @@ -257,9 +265,11 @@ then X elseif (type? TEXTOBJ (SETQ X (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW))) then (FGETTOBJ X STREAMHINT)) - elseif (type? SELECTION TSTREAM?) - then (CL:WHEN (type? TEXTOBJ (SETQ X (FGETSEL TSTREAM? SELTEXTOBJ))) - (FGETTOBJ X STREAMHINT] + elseif (AND (type? SELECTION TSTREAM?) + (FGETSEL TSTREAM? SET)) + then (CL:WHEN [type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) + of (SETQ X (FGETSEL TSTREAM? SELTEXTSTREAM] + X))) (OR TS (CL:UNLESS NOERROR (ERROR TSTREAM? "is not a Tedit document"]) (TEXTSTREAMP @@ -435,106 +445,118 @@ (TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT]) (TEDIT.COPY - [LAMBDA (FROM TO) (* ; "Edited 15-Mar-2024 13:54 by rmk") + [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.") + (* ;; "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.") + (* ;; + "This results in a single history event, either :Insert or :Replace depending on bluependingdelete.") - (CL:UNLESS (\TEDIT.MOVE.MSG FROM TO T) - (PROG ((TOBJ (GETSEL TO SELTEXTOBJ)) - (FOBJ (GETSEL FROM SELTEXTOBJ)) - FROMPIECES) - (\TEDIT.SHOWSEL FROM NIL) (* ; "Turn off any current highlighting") - (\TEDIT.SHOWSEL TO NIL) - - (* ;; "Install FROM pieces at TO, first clearing out the blue pending delete.") - - (* ;; "") - - (* ;; "Grab (a copy of) the source pieces, if image object allows") - - (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROM) - 'COPY TOBJ FOBJ)) - (CL:UNLESS FROMPIECES (RETURN)) - - (* ;; "") - - (* ;; "Either replace or insert in the target, depending on its BLUEPENDINGDELETE") - - (if (FGETTOBJ TOBJ BLUEPENDINGDELETE) - then (FSETTOBJ TOBJ BLUEPENDINGDELETE NIL) - (\TEDIT.REPLACE.SELPIECES FROMPIECES TOBJ TO) - else (\TEDIT.INSERT.SELPIECES FROMPIECES TOBJ TO)) - - (* ;; "") - - (\TEDIT.SET.SEL.LOOKS TO 'NORMAL) - - (* ;; "") - - (\TEDIT.SHOWSEL TO NIL) (* ; - "Take down anything that might thave appeared") - (\TEDIT.FIXSEL TO TOBJ) - (\TEDIT.SHOWSEL TO T)))]) + (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 (STREAM SEL LEN LEAVECARETLOOKS) (* ; "Edited 23-May-2023 12:57 by rmk") + [LAMBDA (TSTREAM SEL LEN LEAVECARETLOOKS) (* ; "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 STREAM.") + (* ;; "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 STREAM))) - (CL:WHEN (FIXP SEL) - (TEDIT.SETSEL STREAM SEL LEN NIL NIL LEAVECARETLOOKS) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (\TEDIT.DELETE TEXTOBJ (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ]) + (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 TEXTOBJ SEL]) (TEDIT.INSERT - [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 22-Dec-2023 22:05 by rmk") + [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "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))) - (* ;; "Insert TEXT (litatom or string) at the appropriate spot in the text.. No-op if given something else--should it error? ") + (* ;; "Nothing to do for an empty string") - (CL:UNLESS (\TEDIT.READONLY TSTREAM) - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM))) - (CL:WHEN (LITATOM TEXT) - (SETQ TEXT (MKSTRING TEXT))) - - (* ;; "Can't insert an empty string sensibly.") - - (CL:WHEN (OR (NOT (STRINGP TEXT)) - (ZEROP (NCHARS TEXT))) - (RETURN)) - (if (FIXP CH#ORSEL) - then (TEDIT.SETSEL TEXTOBJ CH#ORSEL 1 'LEFT) + (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))) - (CL:UNLESS (AND CH#ORSEL (GETSEL CH#ORSEL SET)) - (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T) - (RETURN)) - (CL:WHEN LOOKS (* ; "Set up any specified looks.") - (TEDIT.CARETLOOKS TSTREAM LOOKS)) - (\TEDIT.INSERT TEXT CH#ORSEL TEXTOBJ DONTSCROLL)))]) + (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 TEXT CH#ORSEL TSTREAM DONTSCROLL) + (CL:WHEN LOOKS (* ; + "TEXTSEL now selects the insertion, apply the looks.") + (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS)) + 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 20-Sep-2023 17:55 by rmk") + [LAMBDA (TSTREAM) (* ; "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") @@ -542,122 +564,53 @@ (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) TEDW TEDPROC) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T) - (CL:WHEN (AND (SETQ TEDW (CAR (FGETTOBJ TEXTOBJ \WINDOW))) + (CL:WHEN (AND (SETQ TEDW (\TEDIT.PRIMARYPANE TEXTOBJ)) [PROCESSP (SETQ TEDPROC (WINDOWPROP TEDW 'PROCESS] (NEQ TEDPROC (THIS.PROCESS))) (DEL.PROCESS TEDPROC) (TEDIT.DEACTIVATE.WINDOW TEDW))]) (TEDIT.QUIT - [LAMBDA (STREAM VALUE) (* ; "Edited 20-Sep-2023 17:55 by rmk") + [LAMBDA (TSTREAM VALUE) (* ; "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 STREAM to terminate, and to return VALUE") + (* ;; "Force the edit session supported by TSTREAM to terminate, and to return VALUE") - (LET (MAINW (TEXTOBJ (TEXTOBJ STREAM))) + (LET (PRIMPANE (TEXTOBJ (TEXTOBJ TSTREAM))) (FSETTOBJ TEXTOBJ EDITFINISHEDFLG (OR VALUE T)) (* ;  "tell the command loop to stop next time through") - (CL:WHEN [AND (FGETTOBJ TEXTOBJ \WINDOW) - (NEQ (SETQ MAINW (\TEDIT.PRIMARYW TEXTOBJ)) - (PROCESSPROP (TTY.PROCESS) - 'WINDOW] + (CL:WHEN [AND (SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (NEQ PRIMPANE (PROCESSPROP (TTY.PROCESS) + 'WINDOW] - (* ;; "there is a main window of the stream, and it is not the window of the tty process, so give it the tty") + (* ;; "there is a primary pane of the stream, and it is not the window of the tty process, so give it the tty") - (TTY.PROCESS (WINDOWPROP MAINW 'PROCESS)) + (TTY.PROCESS (WINDOWPROP PRIMPANE 'PROCESS)) (AND (NEQ (TTY.PROCESS) (THIS.PROCESS)) - (until [OR (NOT (WINDOWPROP MAINW 'PROCESS)) - (PROCESS.FINISHEDP (WINDOWPROP MAINW 'PROCESS] do + (until [OR (NOT (WINDOWPROP PRIMPANE 'PROCESS)) + (PROCESS.FINISHEDP (WINDOWPROP PRIMPANE 'PROCESS] do (* ;  "Wait until the Edit process has had a chance to go away before continuing here.") - (DISMISS))))]) + (DISMISS))))]) (TEDIT.MOVE - [LAMBDA (FROM TO) (* ; "Edited 15-Mar-2024 13:54 by rmk") - (* ; "Edited 5-Mar-2024 00:22 by rmk") - (* ; "Edited 1-Mar-2024 20:13 by rmk") - (* ; "Edited 20-Feb-2024 20:07 by rmk") - (* ; "Edited 15-Feb-2024 21:27 by rmk") - (* ; "Edited 1-Feb-2024 23:30 by rmk") - (* ; "Edited 28-Jan-2024 22:27 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") + [LAMBDA (FROM TO) (* ; "Edited 2-Dec-2024 09:02 by rmk") + (* ; "Edited 2-Jul-2024 14:11 by rmk") - (* ;; "Insert the pieces at FROM into the location described by TO, possibly first deleting a TO-pending-delete and also removing the FROM pieces. ") + (* ;; "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.") - (* ;; "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 (\TEDIT.MOVE.MSG FROM TO NIL) - (PROG ((TOBJ (GETSEL TO SELTEXTOBJ)) - (FOBJ (GETSEL FROM SELTEXTOBJ)) - FROMPIECES) - (\TEDIT.SHOWSEL FROM NIL) (* ; "Turn off any current highlighting") - (\TEDIT.SHOWSEL TO NIL) - - (* ;; "Install FROM pieces at TO, first clearing out the blue pending delete. The move-event may be a composite of both. If we are doing a move in the same textobject, the TO selection (= SEL for a CTRL-SHIFIT SELOPERATION) must be updated to reflect a preceding FROM-deletion.") - - (* ;; "") - - (* ;; "Grab (a copy of) the source pieces, if image objects allow copying") - - (SETQ FROMPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES FROM) - 'COPY TOBJ FOBJ)) - (CL:UNLESS FROMPIECES (RETURN)) - - (* ;; "") - - (* ;; "Delete the FROM unless an object doesn't allow deletion.") - - (if (EQ TOBJ FOBJ) - then - (* ;; "In this case, TOBJ is SEL and FOBJ is something else.") - - (CL:UNLESS (\TEDIT.DELETE.SELPIECES FOBJ FROM) - (RETURN)) - (\TEDIT.UPDATE.LINES FOBJ 'DELETION FROM NIL NIL) - (\TEDIT.SEL.DELETEDCHARS TO FROM) (* ; - "Adjust TO to after-deletion chnos.") - elseif (\TEDIT.DELETE FOBJ FROM) - else (RETURN)) - - (* ;; "") - - (* ;; "The deletion has been accomplished and lines have been adjusted accordingly.") - - (* ;; "Either replace or insert in the target, depending on its BLUEPENDINGDELETE") - - (if (FGETTOBJ TOBJ BLUEPENDINGDELETE) - then (FSETTOBJ TOBJ BLUEPENDINGDELETE NIL) - (\TEDIT.REPLACE.SELPIECES FROMPIECES TOBJ TO) - else (\TEDIT.INSERT.SELPIECES FROMPIECES TOBJ TO)) - (\TEDIT.SET.SEL.LOOKS TO 'NORMAL) - (\TEDIT.FIXSEL TO TOBJ) - (\TEDIT.SHOWSEL TO T) - - (* ;; "Create a :Move event that combines the insert with the prior delete/replace.If FOBJ=TOBJ, the delete and insert happened in the same document. If the events happened in different documents, the delete event is already in FOBJ and we leave it there so that event can be undone by a separate undo action in FOBJ. But we still include in the TOBJ move event: if we undo the move, we certainly want to undo the insert. And if the delete event is still the next undoing candidate in FOBJ, it makes sense to do the FOBJ undo, otherwise not. \TEDIT.UNDO.MOVE figures this out.") - - (LET [(INSEVENT (\TEDIT.POPEVENT TOBJ)) - (DELEVENT (CL:IF (EQ TOBJ FOBJ) - (\TEDIT.POPEVENT TOBJ) - (\TEDIT.LASTEVENT FOBJ))] - - (* ;; - "We have to pop the INSEVENT so we can see the DELEVENT, then we push it back.") - - (* ;; "We coerce the insert event into a move. We save the entire DELEVENT so that \TEDIT.UNDO.MOVE can test to see whether a foreign FOBJ is in the proper state.") - - (* ;; "If DELEVENT may be a :Replace, with THDELETEDPIECES.") - - (SETTH INSEVENT THACTION :Move) - (SETTH INSEVENT THOLDINFO (CONS DELEVENT (CL:IF (NEQ FOBJ TOBJ) - FOBJ))) - (\TEDIT.HISTORYADD TOBJ INSEVENT))))]) + (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") @@ -675,10 +628,11 @@ (CHARWIDTH CH FONT]) (TEDIT.CHARWIDTH - [LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32") - - (* Returns the width of CH in FONT printed according to any special printing - instructions in CHARTABLE TERMSA) + [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) @@ -706,8 +660,9 @@ (CHARWIDTH CH FONT))) (REAL.CCE (CHARWIDTH CH FONT)) (IGNORE.CCE 0) - (SHOULDNT))) - (T (* The usual case is to treat every character as a graphic.) + (\TEDIT.THELP))) + (T (* The usual case is to treat every + character as a graphic.) (SELCHARQ CH (CR (IMAX 6 (CHARWIDTH CH FONT))) (TAB 36) @@ -742,6 +697,278 @@ (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 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 + '(LEAVETTY T APPEND QUIET PARABREAKCHARS NIL + HISTORY OFF)) + (TEDIT.SETSEL TSTREAM 1 0] + (DRIBBLE TSTREAM]) +) + + + +(* ; "Object-oriented editing") + +(DEFINEQ + +(TEDIT.INSERT.OBJECT + [LAMBDA (OBJECT TSTREAM CH# LOOKS) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 2-Aug-2024 08:46 by rmk") + (* ; "Edited 30-Jul-2024 22:19 by rmk") + (* ; "Edited 23-Jul-2024 22:20 by rmk") + (* ; "Edited 7-Jul-2024 12:32 by rmk") + (* ; "Edited 22-May-2024 13:56 by rmk") + (* ; "Edited 18-May-2024 16:20 by rmk") + (* ; "Edited 12-May-2024 20:53 by rmk") + (* ; "Edited 3-Mar-2024 13:01 by rmk") + (* ; "Edited 16-Mar-2024 00:08 by rmk") + (* ; "Edited 9-Feb-2024 10:52 by rmk") + (* ; "Edited 28-Jan-2024 23:29 by rmk") + (* ; "Edited 11-Dec-2023 08:21 by rmk") + (* ; "Edited 12-Nov-2023 12:16 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 + PLOOKS _ (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 (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM)))) + (SETQ OBJSELPIECES + (\TEDIT.SELPIECES.COPY (create SELPIECES + SPLEN _ 1 + SPFIRST _ OBJPC + SPLAST _ OBJPC + SPFIRSTCHAR _ CH# + SPLASTCHAR _ CH#) + 'INSERT TEXTOBJ)) + (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.SHOWSEL SEL NIL TEXTOBJ) + (CL:WHEN (type? SELECTION CH#) + (SETQ CH# (GETSEL CH# CH#))) + (\TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) (* ; + "Do the pending delete, if there is one.") + (CL:WHEN CH# + (\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ))) + 0 + 'LEFT) + (\TEDIT.FIXSEL SEL TEXTOBJ)) + (\TEDIT.INSERT.SELPIECES OBJSELPIECES TEXTOBJ SEL) + (CL:WHEN LOOKS (\TEDIT.CHANGE.CHARLOOKS TSTREAM LOOKS SEL)) + (TEDIT.NORMALIZECARET TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ]) + +(TEDIT.EDIT.OBJECT + [LAMBDA (TSTREAM OBJ) (* ; "Edited 3-Oct-2024 22:08 by rmk") + (* ; "Edited 10-May-2024 22:42 by rmk") + (* ; "Edited 7-May-2024 08:18 by rmk") + (* ; "Edited 29-Apr-2024 12:41 by rmk") + (* ; "Edited 15-Mar-2024 14:23 by rmk") + (* ; "Edited 2-Dec-2023 09:57 by rmk") + (* ; "Edited 19-May-2023 21:35 by rmk") + (* ; "Edited 27-Apr-2023 00:14 by rmk") + (* ; "Edited 21-Oct-2022 18:37 by rmk") + (* ; "Edited 29-May-91 18:23 by jds") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET ((TEXTOBJ (TEXTOBJ! (FGETTSTR TSTREAM TEXTOBJ))) + SEL CH# EDITFN) + [COND + [(AND OBJ (IMAGEOBJP OBJ)) + (SETQ CH# (TEDIT.FIND.OBJECT TEXTOBJ OBJ)) + (COND + (CH# (SETQ SEL (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL))) + (\TEDIT.UPDATE.SEL SEL CH# 1) + (SETSEL SEL SELOBJ OBJ) + (\TEDIT.FIXSEL SEL TEXTOBJ)) + (T (TEDIT.PROMPTPRINT TEXTOBJ "Can't find specified object." T] + (T (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (SETQ OBJ (GETSEL SEL SELOBJ] + (COND + (CH# (* ; + "OK There's an object selected. Edit it.") + (SETQ EDITFN (IMAGEOBJPROP OBJ 'EDITFN)) + (CL:UNLESS (AND EDITFN (APPLY* EDITFN OBJ)) (* ; + "If the editfn makes a change, update the screen.") + (TEDIT.OBJECT.CHANGED TSTREAM OBJ))) + (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select an editable object" T T]) + +(TEDIT.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") + (* ; "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 TEXTOBJ 'CHANGED CH# 1) + (\TEDIT.SHOWSEL NIL T TEXTOBJ) (* ; "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 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 (CL:WHEN COLLECT? + (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 @@ -849,7 +1076,8 @@ REGIONSPEC _ (CADR R])]) (\TEDIT.DO.BLUEPENDINGDELETE - [LAMBDA (SEL TEXTOBJ) (* ; "Edited 9-Mar-2024 11:33 by rmk") + [LAMBDA (SEL TEXTOBJ) (* ; "Edited 27-Nov-2024 12:05 by rmk") + (* ; "Edited 9-Mar-2024 11:33 by rmk") (* ; "Edited 24-Dec-2023 00:01 by rmk") (* ; "Edited 8-Jul-2023 22:48 by rmk") (* ; "Edited 4-May-2023 00:05 by rmk") @@ -861,13 +1089,16 @@ (* ;; "Return T if the deletion was made. For people who need to know") (CL:WHEN (GETTOBJ TEXTOBJ BLUEPENDINGDELETE) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) (* ; "Make it a normal selection again.") - (\TEDIT.DELETE TEXTOBJ SEL T))]) + (\TEDIT.DELETE TEXTOBJ SEL T]) ) (DEFINEQ (\TEDIT.MOVE.MSG - [LAMBDA (FROM TO COPYFLG) (* ; "Edited 1-Feb-2024 23:33 by rmk") + [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") @@ -875,35 +1106,45 @@ (* ;; "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 ((FOBJ (AND FROM (GETSEL FROM SET) - (GETSEL FROM SELTEXTOBJ))) - (TOBJ (AND TO (GETSEL TO SET) - (GETSEL TO SELTEXTOBJ))) - (TYPE (CL:IF COPYFLG + (LET ((TYPE (CL:IF COPYFLG "copy" "move"))) - (if (AND FOBJ TOBJ) - then (if (EQ FOBJ TOBJ) - then (\TEDIT.READONLY TOBJ) - elseif (\TEDIT.READONLY TOBJ "Destination") + (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 FOBJ "Source"))) - else (if FOBJ - then (TEDIT.PROMPTPRINT TOBJ (CONCAT "Please select a destination for the " TYPE) + (\TEDIT.READONLY FROMOBJ "Source"))) + else (if FROMOBJ + then (TEDIT.PROMPTPRINT TOOBJ (CONCAT "Please select a destination for the " TYPE + ) T T) - else (TEDIT.PROMPTPRINT FOBJ (CONCAT "Please select a source for the " TYPE) + else (TEDIT.PROMPTPRINT FROMOBJ (CONCAT "Please select a source for the " TYPE) T T)) T]) (\TEDIT.READONLY - [LAMBDA (TEXTOBJ TYPE) (* ; "Edited 1-Feb-2024 17:33 by rmk") + [LAMBDA (TEXTOBJ TYPE CHNO) (* ; "Edited 4-Jul-2024 13:40 by rmk") + (* ; "Edited 25-May-2024 10:01 by rmk") + (* ; "Edited 22-May-2024 13:00 by rmk") + (* ; "Edited 1-Feb-2024 17:33 by rmk") (* ; "Edited 13-Nov-2023 11:26 by rmk") (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (OR TYPE "Text") - " is read only--aborted") - T T) - T)]) + (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 @@ -916,7 +1157,16 @@ TEXTLEN))]) (TEDIT.RPLCHARCODE - [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 17-Mar-2024 00:24 by rmk") + [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS DONTDISPLAY) (* ; "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") @@ -925,67 +1175,130 @@ (* ;; "Replaces the Nth charcode (or object) in TSTREAM with NEWCHARCODE (or object) with NEWCHARLOOKS. This is accomplished by isolating the target character into a length 1 piece, then converting that into a string (or object) piece containing NEWCHAR.") + (* ;; "If DONTDISPLAY, this doesn't update the display. ") + (* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - PC START-OF-PIECE) - (DECLARE (SPECVARS START-OF-PIECE)) - (CL:WHEN (ILESSP N 0) - (add N (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN)))) - (CL:UNLESS (AND (IGEQ N 1) - (ILEQ N (FGETTOBJ TEXTOBJ 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)) - (CL:WHEN (FGETTOBJ TEXTOBJ STREAMHINT) - (replace (STREAM BINABLE) of (FGETTOBJ TEXTOBJ STREAMHINT) with NIL)) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (PROG ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + PC OFFSET START-OF-PIECE PARALAST OLDCHAR) + (DECLARE (SPECVARS START-OF-PIECE)) + (CL:WHEN (ILESSP N 0) + (add N (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN)))) + (CL:WHEN (\TEDIT.READONLY TEXTOBJ) + (RETURN NIL)) + (CL:UNLESS (AND (IGEQ N 1) + (ILEQ N (FGETTOBJ TEXTOBJ 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)) + (replace (STREAM BINABLE) of TSTREAM with NIL) + (SETQ PC (\TEDIT.CHTOPC N TEXTOBJ T)) + (SETQ OFFSET (ADD1 (IDIFFERENCE N START-OF-PIECE)))(* ; "Change is at OFFSET 1") + (if [AND (SMALLP NEWCHARCODE) + (MEMB (PTYPE PC) + STRING.PTYPES) + (OR (NULL NEWCHARLOOKS) + (EQ NEWCHARLOOKS (PLOOKS PC))) + (NEQ PC (FGETTOBJ TEXTOBJ LASTPIECE)) + (NOT (SETQ PARALAST (MEMB NEWCHARCODE (CHARCODE (EOL CR LF FORM] + then + (* ;; + "Fast case: Smash a new character code into an existing string piece with same looks. ") - (* ;; "Chop off the suffix. Unless N was last in PC, the piece containing is new.") + (SETQ OLDCHAR (NTHCHARCODE (PCONTENTS PC) + OFFSET)) + (RPLCHARCODE (PCONTENTS PC) + OFFSET NEWCHARCODE) + (CL:WHEN (AND (EQ THINSTRING.PTYPE (PTYPE PC)) + (IGREATERP NEWCHARCODE 255)) + (FSETPC PC PTYPE FATSTRING.PTYPE) + (FSETPC PC PBINABLE NIL) + (FSETPC PC PBYTESPERCHAR 2) + (FSETPC PC PBYTELEN (UNFOLD (PLEN PC) + 2))) + elseif [AND (IMAGEOBJP NEWCHARCODE) + (EQ OBJECT.PTYPE (PTYPE PC)) + (OR (NULL NEWCHARLOOKS) + (EQ NEWCHARLOOKS (PLOOKS PC] + then (SETQ OLDCHAR (POBJ PC)) (* ; "We know PLEN is 1") + (FSETPC PC PCONTENTS NEWCHARCODE) + else + (* ;; + "The PC that contained character N becomes the suffix of characters after N, ") - (\TEDIT.ALIGNEDPIECE (ADD1 N) - TEXTOBJ) - (SETQ PC (\TEDIT.ALIGNEDPIECE N TEXTOBJ)) (* ; - "Chop off the prefix. PC is now the singleton target") - (if (IMAGEOBJP NEWCHARCODE) - then (FSETPC PC PBINABLE NIL) - (FSETPC PC PCONTENTS NEWCHARCODE) - (FSETPC PC PTYPE OBJECT.PTYPE) - (FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects") - (FSETPC PC PBYTELEN NIL) - else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE))) - (if (IGREATERP NEWCHARCODE 255) - then (FSETPC PC PTYPE FATSTRING.PTYPE) - (FSETPC PC PBINABLE NIL) - (FSETPC PC PBYTESPERCHAR 2) - (FSETPC PC PBYTELEN 2) - else (FSETPC PC PTYPE THINSTRING.PTYPE) - (FSETPC PC PBINABLE T) - (FSETPC PC PBYTESPERCHAR 1) - (FSETPC PC PBYTELEN 1))) - (FSETPC PC PFPOS NIL) - (CL:WHEN NEWCHARLOOKS - (FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS) - (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT NEWCHARLOOKS) - TEXTOBJ) - NEWCHARLOOKS))) - NEWCHARCODE]) + (CL:UNLESS (IEQP OFFSET (PLEN PC)) (* ; "No suffix for the last character") + + (* ;; + "Chop off the suffix (essentially (\TEDIT.ALIGNEDPIECE CHNO ..) but we already have the piece") + + (\TEDIT.SPLITPIECE PC OFFSET TEXTOBJ) + (SETQ PC (PREVPIECE PC))) (* ; + "Original PC holds the suffix, new PC ends with change position.") + (CL:UNLESS (EQ OFFSET 1) + (SETQ PC (\TEDIT.SPLITPIECE PC (SUB1 OFFSET) + TEXTOBJ))) (* ; + "Chop off the prefix. PC is now the singleton target ") + + (* ;; "N is now isolated into a one-character new piece which we smash. ") + + (SETQ OLDCHAR (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC 1)) + (if (IMAGEOBJP NEWCHARCODE) + then (FSETPC PC PBINABLE NIL) + (FSETPC PC PCONTENTS NEWCHARCODE) + (FSETPC PC PTYPE OBJECT.PTYPE) + (FSETPC PC PBYTESPERCHAR NIL) (* ; "Doesn't make sense for objects") + (FSETPC PC PBYTELEN NIL) + else (FSETPC PC PCONTENTS (MKSTRING (CHARACTER NEWCHARCODE))) + (* ; + "Use the extend-string in INSERTCH for repeated calls?") + (if (IGREATERP NEWCHARCODE 255) + then (FSETPC PC PTYPE FATSTRING.PTYPE) + (FSETPC PC PBINABLE NIL) + (FSETPC PC PBYTESPERCHAR 2) + (FSETPC PC PBYTELEN 2) + else (FSETPC PC PTYPE THINSTRING.PTYPE) + (FSETPC PC PBINABLE T) + (FSETPC PC PBYTESPERCHAR 1) + (FSETPC PC PBYTELEN 1))) + (FSETPC PC PFPOS NIL) + (CL:WHEN NEWCHARLOOKS + (FSETPC PC PLOOKS (CL:IF (FONTP NEWCHARLOOKS) + (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT + NEWCHARLOOKS) + TEXTOBJ) + NEWCHARLOOKS))) + (CL:WHEN PARALAST (FSETPC PC PPARALAST T))) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ReplaceCode N NIL NIL NIL OLDCHAR + )) + (CL:UNLESS (OR DONTDISPLAY (NOT (\TEDIT.PRIMARYPANE TEXTOBJ))) + (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION N 1)) + (RETURN TSTREAM]) (TEDIT.NTHCHARCODE - [LAMBDA (TSTREAM N) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TSTREAM N) (* ; "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 of TSTREAM. 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.") + (LET (TEXTOBJ START-OF-PIECE) (DECLARE (SPECVARS START-OF-PIECE)) [if (type? SELECTION TSTREAM) - then (SETQ TEXTOBJ (TEXTOBJ (FGETSEL TSTREAM SELTEXTOBJ))) + then + (* ;; + "This case should only be a user-entry convenience--internally the stream is always passed.") + + (SETQ TEXTOBJ (TEXTOBJ (FGETSEL TSTREAM SELTEXTSTREAM))) (CL:UNLESS (EQ N 0) [add N (CL:IF (ILESSP N 0) (FGETSEL TSTREAM CHLIM) @@ -1006,8 +1319,17 @@ (IDIFFERENCE (ADD1 N) START-OF-PIECE)))]) +(TEDIT.NTHCHAR + [LAMBDA (TSTREAM N) (* ; "Edited 22-Oct-2024 21:28 by rmk") + (LET ((CODE (TEDIT.NTHCHARCODE TSTREAM N))) + (CL:IF (FIXP CODE) + (CHARACTER CODE) + CODE)]) + (\TEDIT.PIECE.NTHCHARCODE - [LAMBDA (TEXTOBJ PC OFFSET) (* ; "Edited 22-Mar-2024 00:02 by rmk") + [LAMBDA (TEXTOBJ PC OFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 29-Apr-2024 08:46 by rmk") + (* ; "Edited 22-Mar-2024 00:02 by rmk") (* ; "Edited 1-Feb-2024 09:55 by rmk") (* ; "Edited 6-Jan-2024 16:36 by rmk") (* ; "Edited 29-Dec-2023 11:55 by rmk") @@ -1016,40 +1338,49 @@ (* ; "Edited 8-Nov-2023 08:43 by rmk") (* ; "Edited 5-Nov-2023 08:17 by rmk") - (* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. ") + (* ;; "Returns the OFFSETth charcode of PC, NIL if OFFSET is out of bounds. For file pieces, ensures that the backing stream is restored to its original position, so that it remains comaptible with the values (buffer, offset) in the textstream.") (CL:WHEN (AND (IGEQ OFFSET 1) (ILEQ OFFSET (PLEN PC))) - [LET ((PCONTENTS (PCONTENTS PC))) + [LET ((PCONTENTS (PCONTENTS PC)) + FILEPOS) (SELECTC (PTYPE PC) (STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET)) (THINFILE.PTYPE + (SETQ FILEPOS (\GETFILEPTR PCONTENTS)) (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) (SUB1 OFFSET))) - (BIN PCONTENTS)) + (PROG1 (BIN PCONTENTS) + (\SETFILEPTR PCONTENTS FILEPOS))) (FATFILE1.PTYPE + (SETQ FILEPOS (\GETFILEPTR PCONTENTS)) (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) (SUB1 OFFSET))) - (create WORD - HIBYTE _ (PCHARSET PC) - LOBYTE _ (BIN PCONTENTS))) + (PROG1 (create WORD + HIBYTE _ (PCHARSET PC) + LOBYTE _ (BIN PCONTENTS)) + (\SETFILEPTR PCONTENTS FILEPOS))) (FATFILE2.PTYPE + (SETQ FILEPOS (\GETFILEPTR PCONTENTS)) (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) (UNFOLD (SUB1 OFFSET) 2))) - (\WIN PCONTENTS)) - (UTF8.PTYPE [\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) + (PROG1 (\WIN PCONTENTS) + (\SETFILEPTR PCONTENTS FILEPOS))) + (UTF8.PTYPE (SETQ FILEPOS (\GETFILEPTR PCONTENTS)) + [\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) (ITIMES (SUB1 OFFSET) (PBYTESPERCHAR PC] - (UTF8.INCCODEFN PCONTENTS)) + (PROG1 (UTF8.INCCODEFN PCONTENTS) + (\SETFILEPTR PCONTENTS FILEPOS))) (OBJECT.PTYPE PCONTENTS) (SUBSTREAM.PTYPE (* ; "A substream stored as an object") - (HELP 'SUBSTREAM?) + (\TEDIT.THELP 'SUBSTREAM?) (BIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM))) (PROGN (* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.") - (HELP '\TEDIT.PIECE.NTHCHARCODE])]) + (\TEDIT.THELP '\TEDIT.PIECE.NTHCHARCODE])]) ) @@ -1059,7 +1390,8 @@ (DEFINEQ (\TEDIT1 - [LAMBDA (TSTREAM WINDOW UNSPAWNED) (* ; "Edited 17-Mar-2024 12:51 by rmk") + [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") @@ -1067,7 +1399,7 @@ (* ;; "Does the actual editing work, once TEDIT has OPENTEXTSTREAMed the thing to be edited.") (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) - (\TEDIT.COMMAND.LOOP TEXTOBJ) (* ; "Run the editing engine") + (\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) @@ -1088,22 +1420,22 @@ (T TSTREAM)))]) (\TEDIT.INSERT - [LAMBDA (INSERT SEL TEXTOBJ DONTSCROLL) (* ; "Edited 17-Mar-2024 11:41 by rmk") - (* ; "Edited 15-Mar-2024 13:32 by rmk") + [LAMBDA (INSERT SEL TSTREAM DONTSCROLL TYPEIN) (* ; "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 18-Feb-2024 15:30 by rmk") - (* ; "Edited 9-Feb-2024 10:52 by rmk") - (* ; "Edited 28-Jan-2024 23:29 by rmk") (* ; "Edited 14-Jan-2024 12:14 by rmk") - (* ; "Edited 22-Dec-2023 22:03 by rmk") (* ; "Edited 20-Dec-2023 15:27 by rmk") - (* ; "Edited 12-Nov-2023 12:28 by rmk") - (* ; "Edited 19-Oct-2023 11:05 by rmk") - (* ; "Edited 15-Oct-2023 16:01 by rmk") (* ; "Edited 18-Sep-2023 12:48 by rmk") - (* ; "Edited 6-Jun-2023 15:23 by rmk") - (* ; "Edited 2-Jun-2023 00:12 by rmk") - (* ; "Edited 27-May-2023 10:45 by rmk") (* ; "Edited 24-May-2023 14:23 by rmk") (* ; "Edited 29-May-91 18:22 by jds") @@ -1115,97 +1447,310 @@ (* ;; "Text can be a string or a single charcode (only on the call from \TEDIT.COMMAND.LOOP). ") - (* ;; - "TEDIT.INSERT passes DONTSCROLL and asserts NOTINCREMENTAL, other calls do incremental scrolling.") + (CL:WHEN [AND (GETSEL SEL SET) + (OR (CHARCODEP INSERT) + (NEQ 0 (NCHARS INSERT] + [PROG* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (PARACHARS (FGETTOBJ TEXTOBJ PARABREAKCHARS)) + NCHARSADDED CARETCHNO) - (* ;; "SELECTION-SET test may be unnecessary here, TEDIT.INSERT already checks, not sure about the 2 other calls.") + (* ;; "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:UNLESS (\TEDIT.READONLY TEXTOBJ) - [if (NOT (AND SEL (GETSEL SEL SET))) - then (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T) - else - (* ;; "Check for blue-pending-delete, and do it if it's there.") - - (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) - (* ; "Make it a normal selection again.") + (CL:WHEN (\TEDIT.READONLY TEXTOBJ NIL CARETCHNO) + (RETURN NIL)) + (CL:WHEN (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) (* ; "Blue pending delete?") (\TEDIT.DELETE TEXTOBJ SEL)) - (PROG ((CHNO (TEDIT.GETPOINT TEXTOBJ SEL)) - (PANES (FGETTOBJ TEXTOBJ \WINDOW)) - NCHARSADDED) - (CL:WHEN PANES - (CL:UNLESS DONTSCROLL (TEDIT.NORMALIZECARET TEXTOBJ SEL)) - (\TEDIT.SHOWSEL SEL NIL)) (* ; "Turn off any old highlights") - (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.") + (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.") - (* ;; "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.") + (\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.") - [\TEDIT.INSERTCH INSERT CHNO TEXTOBJ (FMEMB INSERT - (CHARCODE (EOL CR LF] - (SETQ NCHARSADDED 1) - else - (* ;; - "It's maybe worth a scan here to avoid the heavier per-character complexity of \INSERTCH.") + (for CH instring INSERT as NCH# from CARETCHNO + do (\TEDIT.INSERTCH CH NCH# TEXTOBJ PARACHARS)) + (SETQ NCHARSADDED (NCHARS INSERT)) + else (\TEDIT.INSERTCH INSERT CARETCHNO TEXTOBJ) + (SETQ NCHARSADDED (NCHARS INSERT))) + (FSETTOBJ TEXTOBJ \DIRTY T) - (if [thereis CH instring INSERT - suchthat (FMEMB CH (CHARCODE (EOL CR LF] - then [for CH instring INSERT as NCH# from CHNO - do (\TEDIT.INSERTCH CH NCH# TEXTOBJ - (FMEMB CH (CHARCODE (EOL CR LF] - else (\TEDIT.INSERTCH INSERT CHNO 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. ") - (* ;; "The model (piece table) is now correct: NCHARSADDED new characters have been been added in front of CHNO. ") + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CHNO NCHARSADDED (AND NIL DONTSCROLL)) + (* ;; "Set the caret so that the next insertion should also come in front of that (now displaced) character, and then update the screen.") - (* ;; " The insertion happened before the original CHNO, which is now shifted back by NCHARSADDED. The next insertion should also come in front of that (now displaced) character.") + (* ;; "If typein, the new selection is a point selection, if from a function e.g. TEDIT.INSERT, the insertion is selected/underlined. TEDIT.INSERT can then apply the looks, if specified.") - (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CHNO NCHARSADDED)) - 0 - 'RIGHT) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (CL:UNLESS DONTSCROLL (TEDIT.NORMALIZECARET TEXTOBJ SEL)) - (\TEDIT.SHOWSEL SEL T) - (for PANE in PANES do (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE])]) + (if TYPEIN + then (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CARETCHNO NCHARSADDED)) + 0 + 'RIGHT + 'NORMAL) + else (\TEDIT.UPDATE.SEL SEL CARETCHNO NCHARSADDED '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 TEXTOBJ 'INSERTION CARETCHNO NCHARSADDED) + (CL:WHEN (EQ SEL (TEXTSEL TEXTOBJ)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ)) + (CL:WHEN TYPEIN (\TEDIT.SCROLL.CARET TSTREAM)))])]) + +(\TEDIT.MOVE + [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "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 (GETTSTR FROMTSTREAM TEXTOBJ)) + (TOOBJ (GETTSTR TOTSTREAM TEXTOBJ)) + (TOCH# (FGETSEL TOSEL CH#)) + (TODCH (FGETSEL TOSEL DCH)) + (TOPOINT (FGETSEL TOSEL POINT)) + TODELEVENT FROMPIECES) + (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?") + + (* ;; "Install FROM pieces at TO, first clearing out the blue pending delete. The move-event may be a composite of both. If we are doing a move in the same textobject, the TO selection (= SEL for a CTRL-SHIFT SELOPERATION) must be updated to reflect a preceding FROM-deletion.") + + (* ;; "") + + (* ;; "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) + 'COPY TOOBJ FROMOBJ)) + (CL:UNLESS FROMPIECES (RETURN)) + (\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ) (* ; "Turn off any current highlighting") + (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) + + (* ;; "") + + (* ;; "Delete the FROM unless an object doesn't allow deletion.") + + (if (EQ TOOBJ FROMOBJ) + then + (* ;; "In this case, TOSEL is SEL and FROMSEL is somewhere else in TOOBJ.") + + (CL:UNLESS (\TEDIT.DELETE.SELPIECES FROMOBJ FROMSEL) + (RETURN)) + (SETQ TODELEVENT (\TEDIT.POPEVENT TOOBJ)) + (* ; + "Pop so the insert below doesn't bump the history count") + (\TEDIT.UPDATE.LINES FROMOBJ 'DELETION FROMSEL) + (\TEDIT.SEL.DELETEDCHARS TOSEL FROMSEL) + + (* ;; "TOSEL has been adjusted to after-deletion chnos, but lines have not yet been updated/displayed and TOSEL has not been fixed.") + + elseif (\TEDIT.DELETE FROMOBJ FROMSEL) + then + (* ;; "The FROM deletion has been accomplished, and FROM's history is good. If the destination is foreign, that's not our problem.") + + (CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF) + (\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM) + FROMSEL T) + (RETURN)) + else (RETURN)) + + (* ;; "") + + (if (FGETTOBJ TOOBJ BLUEPENDINGDELETE) + then (FSETTOBJ TOOBJ BLUEPENDINGDELETE NIL) + (\TEDIT.REPLACE.SELPIECES FROMPIECES TOOBJ TOSEL) + else (\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL)) + + (* ;; + "TO's history has either a single replace or insert, depending on its BLUEPENDINGDELETE") + + (\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL) + (\TEDIT.FIXSEL TOSEL TOOBJ) + (\TEDIT.SHOWSEL TOSEL T TOOBJ) + + (* ;; "") + + (* ;; "TO's last history event is either a single replace or insert, depending on its BLUEPENDINGDELETE. If there is also a preceding TODELEVENT, we combine both events into a single Move. There is no history connection between the deletion and insertion events if they happen in separate documents, they have to be undone separately. Otherwise, we would have to make sure that both documents at both reverted to just after this move before we could undo either of them. ") + + (CL:WHEN TODELEVENT (* ; "We popped it above") + (\TEDIT.HISTORYADD TOOBJ (\TEDIT.HISTORY.EVENT TOOBJ :Move TOCH# TODCH TOPOINT NIL + (LIST (\TEDIT.POPEVENT TOOBJ) + TODELEVENT))))])]) + +(\TEDIT.COPY + [LAMBDA (FROMSEL TOSEL FROMTSTREAM TOTSTREAM) (* ; "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 TOOBJ FROMOBJ)) + (CL:UNLESS FROMPIECES (RETURN)) + + (* ;; "No object objected") + + (\TEDIT.SHOWSEL FROMSEL NIL FROMOBJ) (* ; "Turn off any current highlighting") + (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) + + (* ;; "") + + (CL:WHEN (GETTEXTPROP TOOBJ 'COPYBYBKSYSBUF) + (\TEDIT.FOREIGN.COPY (WFROMDS TOTSTREAM) + FROMSEL 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 TOOBJ TOSEL) + else (\TEDIT.INSERT.SELPIECES FROMPIECES TOOBJ TOSEL)) + + (* ;; "") + + (\TEDIT.SET.SEL.LOOKS TOSEL 'NORMAL) + + (* ;; "") + + (\TEDIT.SHOWSEL TOSEL NIL TOOBJ) (* ; + "Take down anything that might thave appeared") + (\TEDIT.FIXSEL TOSEL TOOBJ) + (\TEDIT.SCROLL.CARET TOTSTREAM)))]) (\TEDIT.REPLACE.SELPIECES - [LAMBDA (SELPIECES TEXTOBJ SEL DONTDISPLAY) (* ; "Edited 15-Mar-2024 13:32 by rmk") + [LAMBDA (INSERTSELPIECES TEXTOBJ SEL) (* ; "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 SELPIECES, either a string or SELPIECES. Produces a :Replace history event. TEXTOBJ will remember the inserted SELPIECES for undoing, our history event only has to keep track of the pieces it replaced. (and where they were).") + (* ;; "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.") - (LET ((POINT (GETSEL SEL POINT)) - DELEVENT) (* ; "Keep the SEL point in case ") - (\TEDIT.SHOWSEL SEL NIL) - (CL:WHEN (\TEDIT.DELETE TEXTOBJ SEL T) - (SETQ DELEVENT (\TEDIT.LASTEVENT TEXTOBJ)) - (\TEDIT.INSERT.SELPIECES SELPIECES TEXTOBJ SEL DONTDISPLAY) + (* ;; "If SEL includes an object that declines deletion, the document is left unchanged.") - (* ;; "SELPIECES is now in the TEXTOBJ; we don't want the insert event") + (* ;; + "On return, the pieces, lines, selection, and display are complete, correct, and consistent ") - (\TEDIT.POPEVENT TEXTOBJ) - (SETTH DELEVENT THACTION :Replace) - (SETTH DELEVENT THLEN (fetch (SELPIECES SPLEN) of SELPIECES)) - (SETTH DELEVENT THPOINT POINT) - (\TEDIT.UPDATE.SEL SEL NIL (fetch (SELPIECES SPLEN) of SELPIECES) - POINT) (* ; "Maintain the original point.") - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) + (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) + (PROG ((POINT (GETSEL SEL POINT)) + (CH# (FGETSEL SEL CH#)) + (DCH (FGETSEL SEL DCH)) + (ILEN (GETSPC INSERTSELPIECES SPLEN)) + DELEVENT) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) - (* ;; "Make sure SEL is off to guarantee turning on") + (* ;; "We first delete, then insert, updating the display after the second operation.") - (\TEDIT.SHOWSEL SEL NIL)) - (\TEDIT.SHOWSEL SEL T]) + (CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ 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 TEXTOBJ) + (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) + (SETQ DELEVENT (\TEDIT.LASTEVENT TEXTOBJ T))) + (* ; "Catch the deletion event") + + (* ;; "") + + (CL:WHEN (AND (IGEQ ILEN 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") + + (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 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 DONTDISPLAY) (* ; "Edited 17-Mar-2024 11:43 by rmk") + [LAMBDA (SELPIECES TEXTOBJ TARGETSEL DONTUPDATE) (* ; "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") @@ -1221,8 +1766,8 @@ (* ;; "\TEDIT.INSERTCH.HISTORY uses the first piece to decide whether it is in a consecutive run of insertions.") - (CL:WHEN (AND SELPIECES (fetch (SELPIECES SPFIRST) of SELPIECES)) - (LET ((INSCH# (TEDIT.GETPOINT NIL TARGETSEL)) + (CL:WHEN SELPIECES + (LET ((INSCH# (TEDIT.GETPOINT TEXTOBJ TARGETSEL)) (SPLEN (fetch (SELPIECES SPLEN) of SELPIECES)) (SPFIRST (fetch (SELPIECES SPFIRST) of SELPIECES)) NEXTPC) @@ -1230,102 +1775,37 @@ (\TEDIT.INSERTPIECES SPFIRST NEXTPC TEXTOBJ) (\TEDIT.DIFFUSE.PARALOOKS (PREVPIECE SPFIRST) NEXTPC) - (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION INSCH# SPLEN DONTDISPLAY) + (CL:UNLESS DONTUPDATE (* ; "Under replace?") - (* ;; "Adjust SEL to select the inserted material, with point on the right.") + (* ;; "Adjust SEL to select the inserted material, with point on the right.") - (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) - INSCH# SPLEN 'RIGHT NIL T) - (\TEDIT.HISTORYADD TEXTOBJ - (create TEDITHISTORYEVENT - THACTION _ :Insert - THLEN _ SPLEN - THCH# _ INSCH# - THFIRSTPIECE _ SPFIRST))))]) - -(\TEDIT.OBJECT.SHOWSEL - [LAMBDA (TEXTOBJ SEL L1 ON PANE) (* ; "Edited 24-Jan-2024 09:27 by rmk") - (* ; "Edited 25-Nov-2023 15:48 by rmk") - (* ; "Edited 14-Oct-2023 12:12 by rmk") - (* ; "Edited 6-Jun-2023 15:28 by rmk") - (* ; "Edited 1-May-2023 14:36 by rmk") - (* ; "Edited 9-Apr-2023 15:37 by rmk") - (* ; "Edited 12-Jun-90 17:50 by mitani") - - (* ;; "We are hilighting (or dehilighting) a selection containing only a single image object if it appears in PANE ") - - (PROG ((X0 (FGETSEL SEL X0)) - (Y (FGETLD L1 YBOT)) - (OBJ (FGETSEL SEL SELOBJ)) - (XOFFSET (DSPXOFFSET NIL PANE)) - (YOFFSET (DSPYOFFSET NIL PANE)) - (IMAGEFN (IMAGEOBJPROP (FGETSEL SEL SELOBJ) - 'WHENOPERATEDONFN)) - IMAGEBOX) - (CL:UNLESS (AND IMAGEFN (INSIDE? (CREATEREGION 0 0 (WINDOWPROP PANE 'WIDTH) - (WINDOWPROP PANE 'HEIGHT)) - X0 Y)) - (RETURN)) - - (* ;; "The selection is in the pane and has an image function") - - (SETQ IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (APPLY* (IMAGEOBJPROP OBJ 'IMAGEBOXFN) - OBJ PANE))) - (CL:WHEN L1 (* ; "If no line, why are we here??") - - (* ;; "We need to use the YBASE of the line rather than the YBOT, taking into account the object's descent.") - - (SETQ Y (- (GETLD L1 YBASE) - (fetch (IMAGEBOX YDESC) of IMAGEBOX)))) - (RESETLST - [RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS X0 XOFFSET) - (fetch XKERN of IMAGEBOX)) - PANE) - (LIST (FUNCTION DSPXOFFSET) - XOFFSET - (WINDOWPROP PANE 'DSP] - (RESETSAVE (DSPYOFFSET (IPLUS Y YOFFSET) - PANE) - (LIST (FUNCTION DSPYOFFSET) - YOFFSET PANE)) - (RESETSAVE (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (IMIN (GETSEL SEL DX) - (IDIFFERENCE (FGETTOBJ TEXTOBJ - WRIGHT) - X0)) - HEIGHT _ (fetch YSIZE of IMAGEBOX)) - PANE) - (LIST (FUNCTION DSPCLIPPINGREGION) - (DSPCLIPPINGREGION NIL PANE) - PANE)) - [AND IMAGEFN (ERSETQ (APPLY* IMAGEFN OBJ PANE (COND - (ON 'HIGHLIGHTED) - (T 'UNHIGHLIGHTED)) - SEL - (FGETTOBJ TEXTOBJ STREAMHINT])]) + (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) + INSCH# SPLEN 'RIGHT) + (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION INSCH# SPLEN)) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Insert INSCH# SPLEN NIL + SPFIRST))))]) (\TEDIT.RESTARTFN - [LAMBDA (TSTREAM WINDOW PROPS) (* ; "Edited 17-Mar-2024 16:58 by rmk") + [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 full around with the window and create a new stream. Why not just restart the process and command loop?") + (* ;; "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 \WINDOW) (* ; "Reopen, reattach") + (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 TEXTOBJ) (* ; "Run the editing engine") + (\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) @@ -1338,70 +1818,51 @@ WINDOW TSTREAM))]) (\TEDIT.CHARDELETE - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TSTREAM FORWARD) (* ; "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 24-May-2023 22:50 by rmk") (* ; "Edited 22-May-2023 23:24 by rmk") (* ; "Edited 19-Apr-93 10:50 by jds") - (* ;; "This creates a selection that specifies a deletion of the single character just before SEL's caret, and then uses that to delete the character. It assumes that SEL can be smashed.") + (* ;; "This identifies the character before or after the current caret position, and deletes it.") - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (PROG [FIRSTPIECE (CH# (SUB1 (TEDIT.GETPOINT TEXTOBJ SEL] - (CL:WHEN (ILEQ CH# 0) (* ; - "Can't backspace past start of document") - (RETURN)) + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (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.") - (* ;; "Back up to the first visible character--that's the target, unless it is protected") + (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") - (for PC START-OF-PIECE backpieces (SETQ FIRSTPIECE (\TEDIT.CHTOPC CH# TEXTOBJ T)) - declare (SPECVARS START-OF-PIECE) until (fetch (CHARLOOKS CLPROTECTED) - of (PLOOKS PC)) - do (if (VISIBLEPIECEP PC) - then - (* ;; "Found the last character of the most recent visible piece") - - (\TEDIT.UPDATE.SEL SEL (CL:IF (EQ PC FIRSTPIECE) - CH# - (SUB1 START-OF-PIECE)) - 1 - 'RIGHT) - (\TEDIT.DELETE TEXTOBJ SEL) - (RETURN) - elseif (NEQ PC FIRSTPIECE) - then (add START-OF-PIECE (IMINUS (PLEN PC]) - -(\TEDIT.CHARDELETE.FORWARD - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 24-Dec-2023 00:36 by rmk") - - (* ;; "This creates a selection specifying a deletion of the single character just after SEL's caret, and then uses that to delete the character. It assumes that SEL can be smashed.") - - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (PROG (FIRSTPIECE (CH# (TEDIT.GETPOINT TEXTOBJ SEL))) - (CL:WHEN (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))(* ; "Can't delete past the end") - (RETURN)) - - (* ;; "Forward to the first visible character--that's the target, unless it is protected") - - (for PC START-OF-PIECE inpieces (SETQ FIRSTPIECE (\TEDIT.CHTOPC CH# TEXTOBJ T)) - declare (SPECVARS START-OF-PIECE) until (fetch (CHARLOOKS CLPROTECTED) - of (PLOOKS PC)) - do (if (VISIBLEPIECEP PC) - then - (* ;; "Delete the next visible character") - - (\TEDIT.UPDATE.SEL SEL (CL:IF (EQ PC FIRSTPIECE) - CH# - (SUB1 START-OF-PIECE)) - 1 - 'RIGHT) - (\TEDIT.DELETE TEXTOBJ SEL) - (RETURN SEL) - else (add START-OF-PIECE (PLEN PC]) + (SETQ DCH 1) + else (RETURN)) + (\TEDIT.DELETE TEXTOBJ CH# DCH (CL:IF FORWARD + 'RIGHT + 'LEFT)) + (\TEDIT.SCROLL.CARET TSTREAM)))]) (\TEDIT.COPYPIECE [LAMBDA (PC FROMOBJ TOOBJ UNPROTECT OPERATION PROMPTTEXTOBJ) + (* ; "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") @@ -1458,7 +1919,7 @@ then (FSETPC NEWPC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS using (PLOOKS PC) CLPROTECTED _ NIL - CLSELHERE _ NIL) + CLSELAFTER _ NIL) TOOBJ)) elseif CROSSCOPY then (FSETPC NEWPC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (PLOOKS PC) @@ -1468,7 +1929,8 @@ (RETURN NEWPC]) (\TEDIT.APPLY.OBJFN - [LAMBDA (OBJ OPERATION FROMTOBJ TOTOBJ PROMPTTEXTOBJ) (* ; "Edited 15-Mar-2024 15:38 by rmk") + [LAMBDA (OBJ OPERATION FROMTOBJ TOTOBJ PROMPTTEXTOBJ) (* ; "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") @@ -1505,7 +1967,7 @@ (CL:WHEN [AND (EQ OPERATION 'COPY) (SETQ OBJFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (\TEDIT.PRIMARYW TOTOBJ) + (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (\TEDIT.PRIMARYPANE TOTOBJ) 'DSP) (fetch (TEXTOBJ STREAMHINT) of FROMTOBJ) (fetch (TEXTOBJ STREAMHINT) of TOTOBJ)) @@ -1515,7 +1977,18 @@ OBJ]) (\TEDIT.DELETE - [LAMBDA (TEXTOBJ TARGETSEL DONTDISPLAY) (* ; "Edited 15-Mar-2024 13:36 by rmk") + [LAMBDA (TEXTOBJ TARGETSEL/CHAR LEN POINT) (* ; "Edited 8-Dec-2024 21:39 by rmk") + (* ; "Edited 28-Nov-2024 10:13 by rmk") + (* ; "Edited 27-Nov-2024 09:18 by rmk") + (* ; "Edited 13-Sep-2024 22:30 by rmk") + (* ; "Edited 8-Sep-2024 00:07 by rmk") + (* ; "Edited 7-Jul-2024 12:07 by rmk") + (* ; "Edited 23-Jun-2024 19:27 by rmk") + (* ; "Edited 18-May-2024 16:20 by rmk") + (* ; "Edited 12-May-2024 20:51 by rmk") + (* ; "Edited 23-Apr-2024 07:35 by rmk") + (* ; "Edited 24-Apr-2024 10:42 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 21-Feb-2024 20:40 by rmk") (* ; "Edited 20-Feb-2024 20:09 by rmk") (* ; "Edited 19-Feb-2024 11:48 by rmk") @@ -1525,45 +1998,55 @@ (* ; "Edited 6-Jun-2023 12:48 by rmk") (* ; "Edited 29-May-91 18:22 by jds") - (* ;; "Delete the DCH characters selected by TARGETSEL. Unlike insert, the initial position of the caret doesn't matter.") + (* ;; "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 is correct unless DONTDISPLAY.") + (* ;; + "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#.") - (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) - (\DTEST TARGETSEL 'SELECTION) - (CL:WHEN (AND (FGETSEL TARGETSEL SET) - (IGEQ (FGETSEL TARGETSEL DCH) - 1)) - (LET ((SEL (FGETTOBJ TEXTOBJ SEL)) - (TCH# (FGETSEL TARGETSEL CH#))) - (\TEDIT.SHOWSEL SEL NIL) - (CL:UNLESS DONTDISPLAY (* ; - "Make sure target is on-screen in the SELPANE") - (AND NIL (TEDIT.NORMALIZECARET TEXTOBJ TARGETSEL))) - (CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ TARGETSEL) + (CL:UNLESS TARGETSEL/CHAR + (SETQ TARGETSEL/CHAR (TEXTSEL TEXTOBJ))) + (LET ((SEL (TEXTSEL TEXTOBJ)) + CLOOKS FIRSTCHAR) + [if (type? SELECTION TARGETSEL/CHAR) + then (SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL/CHAR)) + (SETQ FIRSTCHAR (FGETSEL TARGETSEL/CHAR CH#)) + (CL:UNLESS LEN + (SETQ LEN (FGETSEL TARGETSEL/CHAR DCH))) + (SETQ POINT (FGETSEL TARGETSEL/CHAR POINT)) + else (SETQ FIRSTCHAR TARGETSEL/CHAR) + (CL:UNLESS POINT + (SETQ POINT 'LEFT))] + [SETQ CLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ (CL:IF (EQ POINT 'LEFT) + (SUB1 FIRSTCHAR) + (IPLUS FIRSTCHAR LEN))] + (CL:WHEN (\TEDIT.DELETE.SELPIECES TEXTOBJ FIRSTCHAR LEN) (* ;  "Delete the selected characters (if objects allow)") - (* ;; - "Pieces are gone, make lines, SEL, and TARGTSEL consistent with current text.") + (* ;; "Pieces are gone, make lines, SEL, and caret looks consistent with current text.") - (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION TARGETSEL NIL DONTDISPLAY) - (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL)) + (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION FIRSTCHAR LEN) + (FSETTOBJ TEXTOBJ CARETLOOKS CLOOKS) - (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") + (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") - (\TEDIT.SEL.DELETEDCHARS SEL TARGETSEL) + (\TEDIT.SEL.DELETEDCHARS SEL FIRSTCHAR LEN) - (* ;; "In any event, TARGETSEL's characters are all gone, reduce it to a point selection in case it is still in use. And then SEL moves to the position of the deletion.") + (* ;; "In any event, TARGETSEL's characters are all gone, reduce it to a point selection in case it is still in use. And then SEL moves to the position of the deletion.") - (\TEDIT.UPDATE.SEL SEL TCH# 0 'LEFT) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (CL:UNLESS DONTDISPLAY (\TEDIT.SHOWSEL SEL T)) - T))))]) + (* ;; "This is to the right of the last remaining character so that FIXSEL sees starting character in its proper line.") + + (\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 [LAMBDA (PRIORPC SUCCEEDINGPC) (* ; "Edited 16-Feb-2024 00:07 by rmk") @@ -1590,76 +2073,33 @@ until (OR (EQ PC PRIORPC) (PPARALAST PC)) do (FSETPC PC PPARALOOKS PPLOOKS)))]) -(\TEDIT.QUIT - [LAMBDA (W NOFORCE) (* ; "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 by the default TEDIT.DEFAULT.MENUFN to perform the QUIT command.") - - (PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of W))) - (QUITFNS (GETTEXTPROP TEXTOBJ 'QUITFN)) - QUITFLG RESP) - [for QUITFN inside QUITFNS until (OR (EQ QUITFLG 'DON'T) - (EQ QUITFLG T)) - do (SETQ QUITFLG (COND - ((EQ QUITFN T)) - (QUITFN (APPLY* QUITFN W (FGETTOBJ TEXTOBJ STREAMHINT) - TEXTOBJ - (FGETTOBJ TEXTOBJ EDITPROPS] - (COND - ((EQ QUITFLG 'DON'T) - - (* ;; "The user supplied a QUITFN, and it returned 'DON'T' , so just ignore all this Fooferaw and keep editing.") - - (RETURN)) - [(AND (FGETTOBJ TEXTOBJ \DIRTY) - (NOT (FGETTOBJ TEXTOBJ MENUFLG)) - (NEQ QUITFNS T) - (NEQ QUITFLG T)) (* ; - "If this document has changed, check with the user to make sure he really wants to do it.") - (FSETTOBJ TEXTOBJ EDITFINISHEDFLG (MOUSECONFIRM "Not saved yet; LEFT to Quit anyway." - T (FGETTOBJ TEXTOBJ PROMPTWINDOW] - (T (* ; - "Go ahead and quit the next time we see the main command loop.") - (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T))) - (CL:WHEN [AND (FGETTOBJ TEXTOBJ \WINDOW) - (NOT NOFORCE) - (NEQ (\TEDIT.PRIMARYW TEXTOBJ) - (PROCESSPROP (TTY.PROCESS) - 'WINDOW] - (TTY.PROCESS (WINDOWPROP (\TEDIT.PRIMARYW TEXTOBJ) - 'PROCESS))) - (RETURN (FGETTOBJ TEXTOBJ EDITFINISHEDFLG]) - (\TEDIT.WORDDELETE - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 20-Mar-2024 11:08 by rmk") + [LAMBDA (TSTREAM) (* ; "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 ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + LASTNO FIRSTNO) + (SETQ LASTNO (SUB1 (TEDIT.GETPOINT TSTREAM))) - (* ;; "This deletes all characters from the character just before the caret to the beginning of the preceding word, skipping over separators to reach the target word.") + (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (PROG ((LASTNO (SUB1 (TEDIT.GETPOINT SEL))) - FIRSTNO) - - (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") - - (CL:WHEN (ILEQ LASTNO 0) (* ; + (CL:UNLESS (ILEQ LASTNO 0) (* ;  "Nothing to delete at start of file.") - (RETURN)) - (SETQ FIRSTNO (\TEDIT.WORD.FIRST TEXTOBJ LASTNO)) - (\TEDIT.UPDATE.SEL SEL FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))) - (\TEDIT.DELETE TEXTOBJ SEL]) + (SETQ FIRSTNO (\TEDIT.WORD.FIRST TSTREAM LASTNO)) + (\TEDIT.DELETE TEXTOBJ FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) (\TEDIT.WORDDELETE.FORWARD - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 20-Mar-2024 10:54 by rmk") + [LAMBDA (TSTREAM) (* ; "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") @@ -1667,25 +2107,105 @@ (* ;; "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.") - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (PROG ((FIRSTNO (TEDIT.GETPOINT SEL)) - LASTNO) + (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + FIRSTNO LASTNO) - (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") + (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") - (CL:WHEN (IGREATERP FIRSTNO (FGETTOBJ TEXTOBJ TEXTLEN)) - (* ; "Nothing to delete at end of file.") - (RETURN)) - (SETQ LASTNO (\TEDIT.WORD.LAST TEXTOBJ FIRSTNO)) - (\TEDIT.UPDATE.SEL SEL FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))) - (\TEDIT.DELETE TEXTOBJ SEL]) + (SETQ FIRSTNO (TEDIT.GETPOINT TSTREAM)) + (CL:UNLESS (IGREATERP FIRSTNO (TEXTLEN TEXTOBJ)) (* ; "Nothing to delete at end of file.") + (SETQ LASTNO (\TEDIT.WORD.LAST TSTREAM FIRSTNO)) + (\TEDIT.DELETE TEXTOBJ FIRSTNO (ADD1 (IDIFFERENCE LASTNO FIRSTNO))))]) + +(\TEDIT.FINISHEDIT? + [LAMBDA (TSTREAM NOFORCE) (* ; "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 NIL is returned. Setting the flag to T will allow the edit process to terminate.") + + (* ;; "Otherwise, the return value is DON'T, so that this can be used by itself to guard closing as a CLOSEWFN.") + + (* ;; "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") + + (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 NIL]) ) (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 3-Mar-2024 13:01 by rmk") + [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.") @@ -1693,11 +2213,10 @@ (LET (FIRSTCHAR FIRST LAST START-OF-PIECE) (DECLARE (SPECVARS START-OF-PIECE)) (if (type? SELECTION SEL/FIRSTCHAR) - then (SETQ TEXTOBJ (FGETSEL SEL/FIRSTCHAR SELTEXTOBJ)) - (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#)) - [SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) + then (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#)) + (SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) FIRSTCHAR - (SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))] + (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] @@ -1793,7 +2312,9 @@ (DEFINEQ (\TEDIT.WORD.FIRST - [LAMBDA (TEXTOBJ CHNO WORDBOUNDTABLE) (* ; "Edited 20-Mar-2024 10:54 by rmk") + [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "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") @@ -1808,68 +2329,68 @@ (* ;; "Punctuation is tricky: It stops whitespace and text, and its immediate predecessor doesn't matter.") - (TEXTOBJ! TEXTOBJ) - (PROG ((TSTREAM (FGETTOBJ TEXTOBJ STREAMHINT)) - (READSA (fetch READSA of (OR WORDBOUNDTABLE (FGETTOBJ TEXTOBJ TXTWTBL) - TEDIT.WORDBOUND.READTABLE))) - CH) - (CL:WHEN (ILEQ CHNO 1) (* ; "Beginning of document") - (RETURN 1)) - (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))) + (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))) + (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") + (* ;; "Started on a punct, return") - (RETURN CHNO)) + (RETURN CHNO)) - (* ;; "Skip over any preceding whitespace characters. We don't know when the stream's piece might have changed, so test at each iteration.") + (* ;; "Skip over any preceding whitespace characters. We don't know when the stream's piece might have changed, so test at each iteration.") - (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))) + (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.") + (* ;; "CH is either TEXT, PUNCT, or image object.") - (CL:WHEN (AND (CHARCODEP CH) - (EQ PUNCT.TTC (\SYNCODE READSA CH))) + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) - (* ;; "Punct before whitespace, look no further, punct is our guy.") + (* ;; "Punct before whitespace, look no further, punct is our guy.") - (RETURN (ADD1 CHNO))) + (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.") + (* ;; "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))) + (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 ended on a punct before some text, CHNO is one before the punct, get back to text") - (RETURN (IPLUS CHNO 2))) + (RETURN (IPLUS CHNO 2))) - (* ;; "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.") + (* ;; "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.") - (RETURN (IPLUS CHNO (CL:IF (EQ CHNO 0) - 1 - 2)]) + (RETURN (IPLUS CHNO (CL:IF (EQ CHNO 0) + 1 + 2)]) (\TEDIT.WORD.LAST - [LAMBDA (TEXTOBJ CHNO WORDBOUNDTABLE) (* ; "Edited 20-Mar-2024 10:54 by rmk") + [LAMBDA (TSTREAM CHNO WORDBOUNDTABLE) (* ; "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") @@ -1885,236 +2406,79 @@ (* ;;  "Punctuation is tricky: It stops whitespace and text, and its immediate successor doesn't matter.") - (TEXTOBJ! TEXTOBJ) - (PROG ((TSTREAM (FGETTOBJ TEXTOBJ STREAMHINT)) - (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))) + (PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (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") + (* ;; "Started on a punct, return") - (RETURN CHNO)) + (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))) + (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))) + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) - (* ;; "Punct after whitespace, look no further, punct is our guy.") + (* ;; "Punct after whitespace, look no further, punct is our guy.") - (RETURN CHNO)) + (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))) + (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") + (* ;; + "We ended on a punct after some text, CHNO is one after the punct, get back to text") - (RETURN (SUB1 CHNO))) + (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))]) + (RETURN (CL:IF (IGEQ CHNO TEXTLEN) + TEXTLEN + (SUB1 CHNO))]) ) -(* ; "Object-oriented editing") - -(DEFINEQ - -(TEDIT.INSERT.OBJECT - [LAMBDA (OBJECT TSTREAM CH#) (* ; "Edited 16-Mar-2024 00:08 by rmk") - (* ; "Edited 3-Mar-2024 13:01 by rmk") - (* ; "Edited 9-Feb-2024 10:52 by rmk") - (* ; "Edited 28-Jan-2024 23:29 by rmk") - (* ; "Edited 11-Dec-2023 08:21 by rmk") - (* ; "Edited 12-Nov-2023 12:16 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.") - - (CL:UNLESS (\TEDIT.READONLY 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.") - - (SETQ OBJPC (create PIECE - PTYPE _ OBJECT.PTYPE - PCONTENTS _ OBJECT - PLEN _ 1 - PLOOKS _ (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.") - (FSETPC OBJPC PTYPE SUBSTREAM.PTYPE) - (FSETPC OBJPC PLEN (TEXTLEN (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM)))) - (SETQ OBJSELPIECES - (\TEDIT.SELPIECES.COPY (create SELPIECES - SPLEN _ 1 - SPFIRST _ OBJPC - SPLAST _ OBJPC - SPFIRSTCHAR _ CH# - SPLASTCHAR _ CH#) - 'INSERT TEXTOBJ)) - (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.SHOWSEL SEL NIL) - (CL:WHEN (type? SELECTION CH#) - (SETQ CH# (GETSEL CH# CH#))) - (\TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) (* ; - "Do the pending delete, if there is one.") - (CL:WHEN CH# - (\TEDIT.UPDATE.SEL SEL (IMIN CH# (ADD1 (TEXTLEN TEXTOBJ))) - 0 - 'LEFT)) - (\TEDIT.INSERT.SELPIECES OBJSELPIECES TEXTOBJ SEL) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)))]) - -(TEDIT.EDIT.OBJECT - [LAMBDA (STREAM OBJ) (* ; "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") - (LET ((TEXTOBJ (TEXTOBJ STREAM)) - SEL CH# SELOBJ EDITFN) - [COND - [(AND OBJ (IMAGEOBJP OBJ)) - (SETQ CH# (TEDIT.FIND.OBJECT TEXTOBJ OBJ)) - (COND - (CH# (SETQ SEL (FGETTOBJ TEXTOBJ SCRATCHSEL)) - (\TEDIT.UPDATE.SEL SEL CH# 1) - (SETSEL SEL SELOBJ OBJ) - (SETSEL SEL SELTEXTOBJ TEXTOBJ) - (\TEDIT.FIXSEL SEL TEXTOBJ)) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Can't find specified object." T] - (T (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (SETQ OBJ (GETSEL SEL SELOBJ] - (COND - [OBJ (* ; - "OK There's an object selected. Edit it.") - (SETQ EDITFN (IMAGEOBJPROP OBJ 'EDITFN)) - (COND - ((AND EDITFN (APPLY* EDITFN OBJ)) (* ; - "If the editfn makes a change, update the screen.") - (for LINE inside (GETSEL SEL L1) do (FSETLD LINE LDIRTY T)) - (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE T) - (\TEDIT.UPDATE.SCREEN TEXTOBJ] - (T (* ; "No object selected.") - (TEDIT.PROMPTPRINT TEXTOBJ "Please select an editable object first." T]) - -(TEDIT.FIND.OBJECT - [LAMBDA (TEXTOBJ OBJ) (* ; "Edited 16-Mar-2024 10:03 by rmk") - (* ; "Edited 6-Nov-2022 11:12 by rmk") - (* ; "Edited 3-May-93 12:52 by jds") - (for CH# from 1 by (PLEN PC) as PC inpieces (\TEDIT.FIRSTPIECE (TEXTOBJ TEXTOBJ)) - when (EQ OBJ (PCONTENTS PC)) do (RETURN CH#]) - -(TEDIT.OBJECT.CHANGED - [LAMBDA (TSTREAM OBJECT) (* ; "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") - (* ; - "Notify TEdit that an object has changed, and the display may need to be updated.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - OBJPIECE CHANGEDCH#) - [SETQ OBJPIECE (find PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) - suchthat (EQ OBJECT (PCONTENTS PC](* ; - "Find the piece containing this object") - (CL:UNLESS OBJPIECE (HELP "Changed OBJECT not found!?")) - (SETQ CHANGEDCH# (\TEDIT.PCTOCH OBJPIECE TEXTOBJ)) (* ; "Get the CH# of the changed object") - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CHANGEDCH# CHANGEDCH#) - (* ; "Mark affected lines") - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "And mark the document dirty.") - (\TEDIT.SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) - (\TEDIT.SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - T]) - -(TEDIT.MAP.OBJECTS - [LAMBDA (TEXTOBJ FN FNARG COLLECT?) (* ; "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 TEXTOBJ. 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)") - - (for CH# OBJ FNVAL from 1 by (PLEN PC) as PC inpieces (\TEDIT.FIRSTPIECE (TEXTOBJ TEXTOBJ)) - when (AND (EQ OBJECT.PTYPE (PTYPE PC)) - (type? IMAGEOBJ (SETQ OBJ (PCONTENTS PC))) - (SETQ FNVAL (APPLY* FN CH# OBJ FNARG))) - do (CL:WHEN COLLECT? - (PUSH $$VAL (LIST CH# OBJ FNVAL))) - (CL:WHEN (EQ FNVAL 'STOP) - (GO $$OUT)) finally (RETURN (DREVERSE $$VAL]) -) - -(FILESLOAD IMAGEOBJ) - - - (* ;; "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-MENU TEDIT-FNKEYS) + TEDIT-TFBRAVO TEDIT-HCPY TEDIT-PAGE TEDIT-BUTTONS TEDIT-MENU TEDIT-FNKEYS) (* ; "TEDIT Support information") -(RPAQQ TEDITSYSTEMDATE " 1-Apr-2024 09:46:05") +(RPAQQ TEDITSYSTEMDATE "20-Dec-2024 07:51:50") @@ -2124,25 +2488,28 @@ (ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) (EXTENSION (TEDIT)))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4237 6179 (MAKE-TEDIT-EXPORTS.ALL 4247 . 4793) (UPDATE-TEDIT 4795 . 5408) (EDIT-TEDIT -5410 . 6177)) (7825 37823 (TEDIT 7835 . 10360) (TEXTSTREAM 10362 . 12033) (TEXTSTREAMP 12035 . 12419) -(TEDITMENUP 12421 . 13187) (COERCETEXTSTREAM 13189 . 17400) (TEDIT.CONCAT 17402 . 20581) (TEDITSTRING -20583 . 21436) (TEDIT-SEE 21438 . 21997) (TEDIT.COPY 21999 . 24295) (TEDIT.DELETE 24297 . 25270) ( -TEDIT.INSERT 25272 . 27342) (TEDIT.KILL 27344 . 28046) (TEDIT.QUIT 28048 . 29616) (TEDIT.MOVE 29618 . -35122) (TEDIT.STRINGWIDTH 35124 . 35795) (TEDIT.CHARWIDTH 35797 . 37821)) (37824 39765 (TEXTOBJ 37834 - . 38299) (COERCETEXTOBJ 38301 . 39763)) (39766 48320 (\TEDIT.CONCAT.PAGEFRAMES 39776 . 44910) ( -\TEDIT.GET.PAGE.HEADINGS 44912 . 45941) (\TEDIT.CONCAT.INSTALL.HEADINGS 45943 . 47274) ( -\TEDIT.DO.BLUEPENDINGDELETE 47276 . 48318)) (48321 50476 (\TEDIT.MOVE.MSG 48331 . 49984) ( -\TEDIT.READONLY 49986 . 50474)) (50477 58947 (TEDIT.NCHARS 50487 . 50860) (TEDIT.RPLCHARCODE 50862 . -54330) (TEDIT.NTHCHARCODE 54332 . 56109) (\TEDIT.PIECE.NTHCHARCODE 56111 . 58945)) (58993 99952 ( -\TEDIT1 59003 . 60971) (\TEDIT.INSERT 60973 . 67187) (\TEDIT.REPLACE.SELPIECES 67189 . 68988) ( -\TEDIT.INSERT.SELPIECES 68990 . 71412) (\TEDIT.OBJECT.SHOWSEL 71414 . 75174) (\TEDIT.RESTARTFN 75176 - . 77463) (\TEDIT.CHARDELETE 77465 . 79578) (\TEDIT.CHARDELETE.FORWARD 79580 . 81207) ( -\TEDIT.COPYPIECE 81209 . 85947) (\TEDIT.APPLY.OBJFN 85949 . 89034) (\TEDIT.DELETE 89036 . 92293) ( -\TEDIT.DIFFUSE.PARALOOKS 92295 . 94566) (\TEDIT.QUIT 94568 . 97205) (\TEDIT.WORDDELETE 97207 . 98582) -(\TEDIT.WORDDELETE.FORWARD 98584 . 99950)) (99953 107185 (\TEDIT.PARAPIECES 99963 . 101684) ( -\TEDIT.PARA.FIRST 101686 . 104452) (\TEDIT.PARA.LAST 104454 . 107183)) (107186 115696 ( -\TEDIT.WORD.FIRST 107196 . 111551) (\TEDIT.WORD.LAST 111553 . 115694)) (115737 124985 ( -TEDIT.INSERT.OBJECT 115747 . 119177) (TEDIT.EDIT.OBJECT 119179 . 121334) (TEDIT.FIND.OBJECT 121336 . -121858) (TEDIT.OBJECT.CHANGED 121860 . 123926) (TEDIT.MAP.OBJECTS 123928 . 124983))))) + (FILEMAP (NIL (4507 6449 (MAKE-TEDIT-EXPORTS.ALL 4517 . 5063) (UPDATE-TEDIT 5065 . 5678) (EDIT-TEDIT +5680 . 6447)) (8122 36577 (TEDIT 8132 . 10710) (TEXTSTREAM 10712 . 12632) (TEXTSTREAMP 12634 . 13018) +(TEDITMENUP 13020 . 13786) (COERCETEXTSTREAM 13788 . 17999) (TEDIT.CONCAT 18001 . 21180) (TEDITSTRING +21182 . 22035) (TEDIT-SEE 22037 . 22596) (TEDIT.COPY 22598 . 24743) (TEDIT.DELETE 24745 . 25997) ( +TEDIT.INSERT 25999 . 28957) (TEDIT.TERPRI 28959 . 30073) (TEDIT.KILL 30075 . 30991) (TEDIT.QUIT 30993 + . 32768) (TEDIT.MOVE 32770 . 33658) (TEDIT.STRINGWIDTH 33660 . 34331) (TEDIT.CHARWIDTH 34333 . 36575) +) (36578 38519 (TEXTOBJ 36588 . 37053) (COERCETEXTOBJ 37055 . 38517)) (39919 40975 (TDRIBBLE 39929 . +40973)) (41016 55977 (TEDIT.INSERT.OBJECT 41026 . 45617) (TEDIT.EDIT.OBJECT 45619 . 47960) ( +TEDIT.FIND.OBJECT 47962 . 49470) (TEDIT.FIND.OBJECT.BACKWARD 49472 . 51399) (TEDIT.OBJECT.CHANGED +51401 . 54268) (TEDIT.MAP.OBJECTS 54270 . 55505) (\TEDIT.FIRST.OBJPIECE 55507 . 55740) ( +\TEDIT.NEXT.OBJPIECE 55742 . 55975)) (56000 64557 (\TEDIT.CONCAT.PAGEFRAMES 56010 . 61144) ( +\TEDIT.GET.PAGE.HEADINGS 61146 . 62175) (\TEDIT.CONCAT.INSTALL.HEADINGS 62177 . 63508) ( +\TEDIT.DO.BLUEPENDINGDELETE 63510 . 64555)) (64558 67987 (\TEDIT.MOVE.MSG 64568 . 66649) ( +\TEDIT.READONLY 66651 . 67985)) (67988 82609 (TEDIT.NCHARS 67998 . 68371) (TEDIT.RPLCHARCODE 68373 . +76173) (TEDIT.NTHCHARCODE 76175 . 78532) (TEDIT.NTHCHAR 78534 . 78792) (\TEDIT.PIECE.NTHCHARCODE 78794 + . 82607)) (82655 136918 (\TEDIT1 82665 . 84742) (\TEDIT.INSERT 84744 . 90602) (\TEDIT.MOVE 90604 . +98003) (\TEDIT.COPY 98005 . 101983) (\TEDIT.REPLACE.SELPIECES 101985 . 105965) ( +\TEDIT.INSERT.SELPIECES 105967 . 108852) (\TEDIT.RESTARTFN 108854 . 111359) (\TEDIT.CHARDELETE 111361 + . 114188) (\TEDIT.COPYPIECE 114190 . 119038) (\TEDIT.APPLY.OBJFN 119040 . 122237) (\TEDIT.DELETE +122239 . 127048) (\TEDIT.DIFFUSE.PARALOOKS 127050 . 129321) (\TEDIT.WORDDELETE 129323 . 130879) ( +\TEDIT.WORDDELETE.FORWARD 130881 . 132553) (\TEDIT.FINISHEDIT? 132555 . 136916)) (136919 137578 ( +\TEDIT.THELP 136929 . 137576)) (137612 145097 (\TEDIT.PARAPIECES 137622 . 139596) (\TEDIT.PARA.FIRST +139598 . 142364) (\TEDIT.PARA.LAST 142366 . 145095)) (145098 154063 (\TEDIT.WORD.FIRST 145108 . 149764 +) (\TEDIT.WORD.LAST 149766 . 154061))))) STOP diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV index 28459e35..b7c652c4 100644 --- a/library/tedit/TEDIT-ABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,71 +1,69 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Mar-2024 18:15:40"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8 9500 +(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}tedit>TEDIT-ABBREV.;9 10946 :EDIT-BY rmk :CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND) - :PREVIOUS-DATE "17-Mar-2024 12:06:12" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7) + :PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}tedit>TEDIT-ABBREV.;8) (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.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 17-Mar-2024 12:06 by rmk") + [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") @@ -74,7 +72,7 @@ (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) SEL CH# CH OLDLOOKS EXPANSION) (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL))) + (SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL))) [COND ((ZEROP (GETSEL SEL DCH)) (* ;  "Point Selection, so use the character to the left") @@ -158,54 +156,53 @@ (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 (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) ( -\TEDIT.TRY.ABBREV 6008 . 8154))))) + (FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) ( +\TEDIT.TRY.ABBREV 6831 . 8977))))) STOP diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM index b68567601dab53ce111b279d011ea18b019f1d32..96be80d0b45a382c89a2305017da7d222be5e941 100644 GIT binary patch delta 272 zcmaDP^HzF7xPh^uu77fgu91O}iGrcIm8r3nv6+&BhEj5VZb4>FYKlUBo`RA>b-1sq zi;rt$tCK)43O$9C`G@S+pRtDxu3Pq`Kov9TCIho0sB{`LFYKlUBo`RABSG7y9 zcdbomacWVqU3OwYPGX*&PkwS@j$LkQN=|B}v7V`2d45rLW?s53M8t0L9Y#4F1ui8N z3(TzyjjW6el@yYSQsFkFRumK!t6ELI$0k;v3AD{E)W=5wS(~1oo{~aJVhPYSSj{t4 z(&W-`^Yn3b4svx2adlBZwG`|t69Zy=A&AWzvaAZ0rUnL+OBsW0jI0dIfPNsxENn)} YFq>;~O}@`2I$3}zi!oz!HB%8c09BQCV*mgE diff --git a/library/tedit/TEDIT-BUTTONS b/library/tedit/TEDIT-BUTTONS new file mode 100644 index 00000000..81699340 --- /dev/null +++ b/library/tedit/TEDIT-BUTTONS @@ -0,0 +1,1941 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "20-Dec-2024 22:19:48" {WMEDLEY}tedit>TEDIT-BUTTONS.;198 119318 + + :EDIT-BY rmk + + :CHANGES-TO (FNS MB.NWAY.CREATE) + + :PREVIOUS-DATE "18-Dec-2024 14:02:17" {WMEDLEY}tedit>TEDIT-BUTTONS.;197) + + +(PRETTYCOMPRINT TEDIT-BUTTONSCOMS) + +(RPAQQ TEDIT-BUTTONSCOMS + [ + (* ;; + "Implementation of the various kinds of menu buttons: Action, toggle, 3state, N-way, field") + + (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)) + [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 + MB.TRACK.UNTIL MB.DON'T) + (GLOBALVARS MB.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.INIT] + [COMS (* ; "3STATE") + + (* ;; "ON-OFF-NEUTRAL menu buttons, for, e.g., character properties like BOLD") + + (FNS MB.3STATE.CREATE MB.3STATE.DISPLAYFN MB.3STATE.SHOWSELFN MB.3STATE.INIT + MB.3STATE.SETSTATEFN MB.3STATE.BUTTONEVENTINFN) + (GLOBALVARS MB.3STATE.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.3STATE.INIT] + [COMS (* ; "NWAY") + + (* ;; "Mutually exclusive togggles with a single enclosing object") + + (FNS MB.NWAY.CREATE MB.NWAY.DISPLAYFN MB.NWAY.WHENOPERATEDONFN MB.NWAY.SIZEFN + MB.NWAY.SELECT MB.NWAY.BUTTONEVENTINFN MB.NWAY.NEWMENUBUTTON MB.NWAY.COPYFN + MB.NWAY.INIT MB.NWAY.ARRANGEBUTTONS MB.NWAY.ADDITEM MB.NWAY.FINDSUBOBJ + MB.NWAY.SETSTATEFN) + (GLOBALVARS MB.NWAY.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.NWAY.INIT] + [COMS (* ; "TOGGLE") + (FNS MB.TOGGLE.CREATE MB.TOGGLE.DISPLAYFN MB.TOGGLE.INIT MB.SET.TOGGLE + MB.TOGGLE.SETSTATEFN MB.TOGGLE.BUTTONEVENTINFN MB.TOGGLE.WHENOPERATEDONFN) + (GLOBALVARS MB.TOGGLE.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.TOGGLE.INIT] + (COMS (* ; "FIELDS") + (FNS MB.FIELD.CREATE MB.FIELD.DISPLAYFN MB.FIELD.IMAGEBOXFN MB.FIELD.PREFIXCREATE + MB.FIELD.SUFFIXCREATE MB.FIELD.INIT MB.FIELD.WHENOPERATEDONFN MB.FIELD.GETSTATEFN + MB.FIELD.SETSTATEFN MB.FIELD.BUTTONEVENTINFN MB.FIELD.SIZEFN MB.FIELD.INSURETYPE) + (GLOBALVARS MB.FIELD.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MB.FIELD.INIT]) + + + +(* ;; "Implementation of the various kinds of menu buttons: Action, toggle, 3state, N-way, field") + + + + +(* ; "Generic functions for the various types of buttons.") + +(DECLARE%: EVAL@COMPILE + +(RECORD MBARG (ARGSTATE ARGOBJ ARGSTARTPC ARGENDPC ARGIDPC)) +) +(DEFINEQ + +(MB.ADD + [LAMBDA (MENUDESC MENUTSTREAM WHERE) (* ; "Edited 22-Oct-2024 09:16 by rmk") + (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 18-Oct-2024 13:49 by rmk") + (* ; "Edited 6-Oct-2024 15:25 by rmk") + (* ; "Edited 24-Aug-2024 21:08 by rmk") + (DECLARE (SPECVARS MENUTSTREAM)) + (SETQ MENUTSTREAM (TEXTSTREAM MENUTSTREAM)) (* ; "Edited 22-Aug-2024 11:10 by rmk") + + (* ;; "MENUDESC is a Tedit menu specification, a list of items describing one or more elements to be inserted in TSTREAM after WHERE. ") + + (* ;; "This is a user entry for adding items to a Tedit menu.") + + (* ;; "If button-type is a list, it is interpreted as form to be evaluated, with MENUTSTREAM and the current CH# available as free variables. The result of the evaluation should be the increment in CH#.") + + (* ;; "An item can be of the form (button-type . attribute-values), a number indicating how many spaces, EOL or TAB atoms, or a string to be inserted as text in the default menu font.") + + (* ;; "CH# can be used freely") + + (* ;; "Returns the textstream character number of the character just after the last inserted character/object.") + + (for DESC TYPE SPEC OBJ [EOL _ (CONCATCODES (CHARCODE (EOL] + [TAB _ (CONCATCODES (CHARCODE (TAB] + (CH# _ (if (NULL WHERE) + then (ADD1 (TEXTLEN (FGETTSTR MENUTSTREAM TEXTOBJ))) + elseif (FIXP WHERE) + else (\ILLEGAL.ARG WHERE))) in MENUDESC declare (SPECVARS CH#) + do (SETQ DESC (MKLIST DESC)) (* ; "MKLIST for EOL/TAB, FIXP") + (SETQ TYPE (CAR DESC)) + (SETQ SPEC (CDR DESC)) + (SELECTQ TYPE + ( (* ; ;; NIL) + (* ; + "Ignore comments within menu descriptions") + ) + (EOL (TEDIT.INSERT MENUTSTREAM EOL CH# '(PROTECTED ON)) + (add CH# 1)) + (TAB (TEDIT.INSERT MENUTSTREAM TAB CH# '(PROTECTED ON)) + (add CH# 1)) + (ACTION (* ; "Hitting calls a function") + (TEDIT.INSERT.OBJECT (MB.CREATE SPEC) + MENUTSTREAM CH# '(PROTECTED OFF)) + (add CH# 1)) + (3STATE (* ; + "3-state button; hitting it changes state among ON, OFF, and NEUTRAL.") + (TEDIT.INSERT.OBJECT (MB.3STATE.CREATE SPEC) + MENUTSTREAM CH# '(PROTECTED OFF)) + (add CH# 1)) + (TOGGLE (* ; + "TOGGLE button; hitting it switches between ON and OFF.") + (TEDIT.INSERT.OBJECT (MB.TOGGLE.CREATE SPEC) + MENUTSTREAM CH# '(PROTECTED OFF)) + (add CH# 1)) + (NWAY (* ; + "N-way buttons; choosing one turns the others off.") + (SETQ OBJ (MB.NWAY.CREATE SPEC)) + (TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH# '(PROTECTED OFF)) + (add CH# 1)) + (TEXT (* ; "Arbitrary protected text.") + [TEDIT.INSERT MENUTSTREAM (CADR (ASSOC 'STRING SPEC)) + CH# + (CL:IF (CADR (ASSOC 'FONT SPEC)) + `(FONT ,(CADR (ASSOC 'FONT SPEC)) + PROTECTED ON) + '(PROTECTED ON))] + [add CH# (NCHARS (CADR (ASSOC 'STRING SPEC]) + (FIELD (SETQ CH# (MB.FIELD.CREATE SPEC MENUTSTREAM CH#))) + (MENU (* ; + "Real menu, except the selection sticks") + (\TEDIT.THELP "NOT IMPLEMENTED") + (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR SPEC)) + MENUTSTREAM CH# '(PROTECTED OFF)) + (add CH# 1)) + (if (STRINGP TYPE) + then (TEDIT.INSERT MENUTSTREAM TYPE CH# '(PROTECTED ON)) + (add CH# (NCHARS TYPE)) + elseif (FIXP TYPE) + then (* ; "TYPE spaces") + (TEDIT.INSERT MENUTSTREAM (ALLOCSTRING TYPE (CHARCODE SPACE)) + CH# + '(PROTECTED ON)) + (add CH# TYPE) + elseif (LISTP TYPE) + then + (* ;; "Form to be evaluated") + + (add CH# (EVAL TYPE)) + else (\ILLEGAL.ARG DESC))) finally (RETURN CH#]) + +(MB.DELETE + [LAMBDA (IDENTIFIERS MENUSTREAM) (* ; "Edited 8-Nov-2024 08:58 by rmk") + (for ID CHNOS inside IDENTIFIERS when [SETQ CHNOS (MB.GET ID MENUSTREAM '(STARTCHNO ENDCHNO] + do (TEDIT.DELETE MENUSTREAM (CAR CHNOS) + (IDIFFERENCE (ADD1 (CADR CHNOS)) + (CAR CHNOS]) + +(MB.GET + [LAMBDA (IDENTIFIERS MENUSTREAM RETURNS START BEFORE) (* ; "Edited 13-Dec-2024 09:24 by rmk") + (* ; "Edited 2-Dec-2024 09:41 by rmk") + (* ; "Edited 7-Nov-2024 22:20 by rmk") + (* ; "Edited 22-Oct-2024 22:02 by rmk") + (* ; "Edited 20-Oct-2024 21:55 by rmk") + (* ; "Edited 18-Oct-2024 23:12 by rmk") + (* ; "Edited 29-Sep-2024 22:53 by rmk") + (* ; "Edited 2-Sep-2024 23:36 by rmk") + (* ; "Edited 28-Aug-2024 20:06 by rmk") + (* ; "Edited 24-Aug-2024 21:23 by rmk") + (* ; "Edited 16-Aug-2024 13:14 by rmk") + (* ; "Edited 12-Aug-2024 10:25 by rmk") + (* ; "Edited 9-Aug-2024 22:52 by rmk") + (* ; "Edited 29-Jul-2024 11:00 by rmk") + (* ; "Edited 27-Jul-2024 20:48 by rmk") + + (* ;; ";; Computes the arguments from other image objects as requested by the object at SEL/PC in TEXTOBJ. START can be a piece, a selection, a character number, or NIL. If NIL, the whole menu is scanned from the beginning or the end.") + + (* ;; "If IDENTIFIERS is a list, this returns a plist keyed by each identifier . ") + + (* ;; "If IDENTIFIERS is a litatom, the triple for that identifier is returned. ") + + (* ;; "RETURNS specifies what information should be returned for each identifier, defaulting to the identified object. If ALL, the value is an instance of the MBARG record. Otherwise RETURNS can be one of OBJECT, STATE, STARTPC, STARTCHNO, ENDPC, ENDCHNO, or a list of those. If a list, the components for each identifier are returned in a list parallel to RETURNS.") + + (CL:WHEN IDENTIFIERS + (CL:UNLESS (OR (type? PIECE START) + (type? SELECTION START) + (FIXP START) + (NULL START)) + (\ILLEGAL.ARG START)) + (SETQ MENUSTREAM (TEXTSTREAM MENUSTREAM)) + (LET ((MENUTEXTOBJ (TEXTOBJ MENUSTREAM)) + RESULT) + (if (type? SELECTION START) + then (SETQ START (\TEDIT.CHTOPC (GETSEL START CH#) + MENUTEXTOBJ)) + elseif (FIXP START) + then (SETQ START (\TEDIT.CHTOPC START MENUTEXTOBJ))) + [SETQ RESULT (if BEFORE + then (for PC ID IDOBJ (REMAINING _ (COPY (MKLIST IDENTIFIERS))) + backpieces (CL:IF START + (PREVPIECE START) + (\TEDIT.LASTPIECE MENUTEXTOBJ)) while REMAINING + when [SETQ ID (AND (SETQ IDOBJ (POBJ PC)) + (CAR (MEMB (IMAGEOBJPROP IDOBJ 'IDENTIFIER) + REMAINING] + join (SETQ REMAINING (DREMOVE ID REMAINING)) + (MB.GET.MBARG PC MENUSTREAM)) + else (for PC ID IDOBJ (REMAINING _ (COPY (MKLIST IDENTIFIERS))) + inpieces (CL:IF START + (NEXTPIECE START) + (\TEDIT.FIRSTPIECE MENUTEXTOBJ)) while REMAINING + when [SETQ ID (AND (SETQ IDOBJ (POBJ PC)) + (CAR (MEMB (IMAGEOBJPROP IDOBJ 'IDENTIFIER) + REMAINING] + join (SETQ REMAINING (DREMOVE ID REMAINING)) + (MB.GET.MBARG PC MENUSTREAM] + (CL:UNLESS (EQ RETURNS 'ALL) + (CL:UNLESS RETURNS + (SETQ RETURNS 'OBJECT)) + (SETQ RETURNS (MKLIST RETURNS)) + [for ATAIL A on RESULT by (CDDR ATAIL) + do (SETQ A (CADR ATAIL)) + (RPLACA (CDR ATAIL) + (for R in RETURNS + collect (SELECTQ R + ((OBJECT NIL) + (fetch (MBARG ARGOBJ) of A)) + (STATE (fetch (MBARG ARGSTATE) of A)) + (STARTPC (fetch (MBARG ARGSTARTPC) of A)) + (ENDPC (fetch (MBARG ARGENDPC) of A)) + (STARTCHNO (\TEDIT.PCTOCH (fetch (MBARG ARGSTARTPC) + of A) + MENUTEXTOBJ)) + (ENDCHNO (IPLUS -1 (PLEN (fetch (MBARG ARGENDPC) + of A)) + (\TEDIT.PCTOCH (fetch (MBARG ARGENDPC) + of A) + MENUTEXTOBJ))) + (IDPC (fetch (MBARG ARGIDPC) of A)) + (ERROR R " is not a button return")) + finally (CL:UNLESS (CDR RETURNS) + (RETURN (CAR $$VAL)))]) + (CL:IF (LITATOM IDENTIFIERS) + (CADR RESULT) + RESULT)))]) + +(MB.GET.MBARG + [LAMBDA (IDPC MENUSTREAM) (* ; "Edited 17-Dec-2024 11:54 by rmk") + (* ; "Edited 4-Dec-2024 16:48 by rmk") + + (* ;; "Returns the full set of properties for the argument identified at IDPC, including (for fields) the starting piece, ending piece, and ID piece itself.") + + (LET ((IDOBJ (POBJ IDPC)) + ENDPC STATEFN STATE) + (if [AND (EQ 'FieldPrefixButton (IMAGEOBJPROP IDOBJ 'IMAGECLASSNAME)) + (NOT (IMAGEOBJPROP IDOBJ 'FIELDSUFFIX] + then + (* ;; "Scan forward from prefix to suffix, but don't scan backwards from suffix. Asking for the field ID gets the prefix and everything, asking for the suffix just gets the suffix") + + (SETQ ENDPC (OR [for P inpieces (NEXTPIECE IDPC) + suchthat (AND (EQ OBJECT.PTYPE (PTYPE P)) + (IMAGEOBJPROP (POBJ P) + 'FIELDSUFFIX] + (\TEDIT.THELP "Missing field suffix:"))) + else (SETQ ENDPC IDPC)) + (CL:WHEN (SETQ STATEFN (IMAGEOBJPROP IDOBJ 'STATEFN)) + (APPLY* STATEFN IDPC IDOBJ MENUSTREAM)) + (LIST (IMAGEOBJPROP IDOBJ 'IDENTIFIER) + (create MBARG + ARGSTATE _ (IMAGEOBJPROP IDOBJ 'STATE) + ARGOBJ _ IDOBJ + ARGSTARTPC _ IDPC + 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") + + (* ;; "If MENUSTREAM's window is attached to a main window that is also the window of a running Tedit process, gives the TTY to that main window. Otherwise, gives the TTY to the exec.") + + (LET ((MAINW (\TEDIT.MAINW MENUSTREAM))) + (TTY.PROCESS (CL:IF MAINW + (WINDOWPROP MAINW 'PROCESS)) + T]) +) + + + +(* ; "Simple Menu Button support") + +(DEFINEQ + +(MB.BUTTONEVENTINFN + [LAMBDA (OBJ MENUSTREAM SEL RELX RELY SELWINDOW HOSTSTREAM BUTTON) + (* ; "Edited 22-Aug-2024 16:26 by rmk") + (* ; "Edited 20-Aug-2024 10:04 by rmk") + (* ; "Edited 20-Jul-2024 15:26 by rmk") + (* ; "Edited 9-Apr-2023 18:22 by rmk") + (* ; "Edited 30-May-91 22:15 by jds") + + (* ;; "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.") + + (if [OR (EQ BUTTON 'RIGHT) + (SHIFTDOWNP 'CTRL) + (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] + (OR (ILESSP RELX 0) + (ILESSP RELY 0) + (IGREATERP RELX (fetch XSIZE of OBJBOX)) + (IGREATERP RELY (fetch YSIZE of OBJBOX] + then 'DON'T + else T]) + +(MB.DISPLAYFN + [LAMBDA (OBJ IMAGESTREAM) (* ; "Edited 26-Aug-2024 09:35 by rmk") + (* ; "Edited 19-Jul-2024 23:32 by rmk") + (* ; "Edited 20-Nov-2023 17:31 by rmk") + (* ; "Edited 11-Jan-89 16:58 by jds") + + (* ;; "Display the innards of a menu button. Assumes that the stream is set to the bottom-left corner of the object in stream coordinates (so X,Y instead of 0,0).") + + (if (EQ 'DISPLAY (IMAGESTREAMTYPE IMAGESTREAM)) + then + (* ;; "Going to the display. Use the cached bitmap version of the button") + + [LET ((BITMAP (MB.SETIMAGE OBJ)) + (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) + (X (DSPXPOSITION NIL IMAGESTREAM)) + (Y (DSPYPOSITION NIL IMAGESTREAM))) + (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX))) + (BITBLT BITMAP 0 0 IMAGESTREAM X Y) (* ; "Display the button's image") + (CL:WHEN (EQ (IMAGEOBJPROP OBJ 'STATE) + 'ON) (* ; "Invert if ON") + (BLTSHADE BLACKSHADE IMAGESTREAM X Y (fetch XSIZE of OBJBOX) + (fetch YSIZE of OBJBOX) + 'INVERT))] + else + (* ;; "Going to some output image stream. Just print the text (without ON inversion?)") + + (DSPFONT (PROG1 (DSPFONT (FONTCOPY (IMAGEOBJPROP OBJ 'FONT) + 'DEVICE IMAGESTREAM) + IMAGESTREAM) (* ; + "Change to the font for this menu button.") + (PRIN1 (IMAGEOBJPROP OBJ 'LABEL) + IMAGESTREAM))]) + +(MB.SETIMAGE + [LAMBDA (OBJ) (* ; "Edited 26-Aug-2024 09:37 by rmk") + (* ; "Edited 21-Jul-2024 16:20 by rmk") + (* ; "Edited 19-Jul-2024 23:27 by rmk") + (* jds "23-Aug-84 13:22") + + (* ;; "Create a bitmap image of the object's text. Assumes that box exists if bitmap exists.") + + (OR (IMAGEOBJPROP OBJ 'BITCACHE) + (LET ((FONT (IMAGEOBJPROP OBJ 'FONT)) + (BOX (MB.SIZEFN OBJ)) + BITMAP DS) + (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX) + (fetch YSIZE of BOX))) + (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) + (SETQ DS (DSPCREATE BITMAP)) + (DSPXOFFSET 0 DS) + (DSPYOFFSET 0 DS) + (DSPFONT FONT DS) + (MOVETO 0 (FONTPROP FONT 'DESCENT) + DS) + (PRIN1 (IMAGEOBJPROP OBJ 'LABEL) + DS) + BITMAP]) + +(MB.SIZEFN + [LAMBDA (OBJ STREAM) (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 3-Aug-2024 13:10 by rmk") + (* ; "Edited 19-Jul-2024 23:26 by rmk") + (* ; "Edited 11-Oct-2022 22:51 by rmk") + (* ; "Edited 4-Oct-2022 11:59 by rmk") + (* jds "30-Aug-84 11:24") + + (* ;; + "Create the box for a menu button containing LABEL in font FONT on STREAM (NIL means display).") + + (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) + (LET ((FONT (IMAGEOBJPROP OBJ 'FONT)) + BOX) + (CL:UNLESS (AND STREAM (NOT (DISPLAYSTREAMP STREAM))) + (SETQ FONT (FONTCOPY FONT 'DEVICE (IMAGESTREAMTYPE STREAM)))) + (SETQ BOX (create IMAGEBOX + XSIZE _ (CL:IF (IMAGEOBJPROP OBJ 'LABEL) + (STRINGWIDTH (IMAGEOBJPROP OBJ 'LABEL) + FONT) + 0) + YSIZE _ (FONTPROP FONT 'HEIGHT) + YDESC _ (FONTPROP FONT 'DESCENT) + XKERN _ 0)) + (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) + BOX]) + +(MB.WHENOPERATEDONFN + [LAMBDA (OBJ MENUWINDOW OPERATION MENUSEL MENUSTREAM) (* ; "Edited 20-Oct-2024 09:51 by rmk") + (* ; "Edited 18-Oct-2024 14:22 by rmk") + (* ; "Edited 6-Oct-2024 23:29 by rmk") + (* ; "Edited 29-Sep-2024 15:44 by rmk") + (* ; "Edited 26-Jul-2024 15:24 by rmk") + (* ; "Edited 20-Jul-2024 20:57 by rmk") + (* ; "Edited 17-Jul-2024 21:27 by rmk") + (* ; "Edited 27-Mar-2024 13:49 by rmk") + (* jds " 7-Feb-84 14:20") + + (* ;; "HIGHLIGHTED is in OBJ's coordinate system, SELECTED is in PANE's coordinate system.") + + (* ;; "Here we deal only with the button hilighting itself.") + + (SELECTQ OPERATION + (HIGHLIGHTED (MB.SHOWSELFN OBJ T MENUWINDOW) + (MB.TRACK.UNTIL OBJ MENUWINDOW) + (MB.SHOWSELFN OBJ NIL MENUWINDOW)) + (SELECTED + (* ;; "Old code tested for a return of DON'T from the BUTTONFN. That was probably a mistaken carry-over from the description of the BUTTONEVENTINFN, where DON'T meant don't allow the selection. But if we are here, we passed that gate.") + + (* ;; + "We don't update the display here: That happens on the separate HIGHLIGHTED call from SHOWSEL") + + (LET [(SELECTFN (IMAGEOBJPROP OBJ 'SELECTFN] + (CL:WHEN SELECTFN (APPLY* SELECTFN OBJ MENUSEL MENUWINDOW MENUSTREAM)))) + NIL]) + +(MB.COPYFN + [LAMBDA (OBJ) (* jds "23-May-84 11:32") + (* Copy a menu button object.) + (create IMAGEOBJ + OBJECTDATUM _ (COPY (fetch (IMAGEOBJ OBJECTDATUM) of OBJ)) + IMAGEOBJPLIST _ (COPY (fetch (IMAGEOBJ IMAGEOBJPLIST) of OBJ)) + IMAGEOBJFNS _ (fetch (IMAGEOBJ IMAGEOBJFNS) of OBJ]) + +(MB.GETFN + [LAMBDA (OBJ FILE) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 19-Dec-2023 10:24 by rmk") + (* ; "Edited 20-Aug-87 16:17 by jds") + (* READ a menu button from a file.) + (\TEDIT.THELP "HELP FROM JDS--NOT USED?") + (PROG [(TEXT (IMAGEOBJPROP OBJ 'LABEL)) + (MBFN (IMAGEOBJPROP OBJ 'MBFN)) + (FONT (IMAGEOBJPROP OBJ 'FONT] + (\STRINGOUT FILE TEXT) + (\ATMOUT FILE MBFN) + (\ATMOUT FILE (FONTPROP FONT 'FAMILY)) + (\WOUT FILE (FONTPROP FONT 'SIZE)) + (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) + +(MB.PUTFN + [LAMBDA (OBJ FILE) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 19-Dec-2023 10:23 by rmk") + (* ; "Edited 20-Aug-87 16:17 by jds") + + (* ;; "Write a menu button from a file; suitable for re-reading using the image objects GETFN.") + + (PROG [(TEXT (IMAGEOBJPROP OBJ 'LABEL)) + (MBFN (IMAGEOBJPROP OBJ 'MBFN)) + (FONT (IMAGEOBJPROP OBJ 'FONT] + (\TEDIT.THELP "HELP FROM JDS -- NOT USED?") + (\STRINGOUT FILE TEXT) (* ; "The button's image") + (\ATMOUT FILE MBFN) (* ; "The FN called when hit") + (\ATMOUT FILE (FONTPROP FONT 'FAMILY)) + (\WOUT FILE (FONTPROP FONT 'SIZE)) + (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) + +(MB.SHOWSELFN + [LAMBDA (OBJ ON PANE) (* ; "Edited 18-Oct-2024 13:17 by rmk") + (* ; "Edited 5-Oct-2024 23:47 by rmk") + (* ; "Edited 20-Jul-2024 20:58 by rmk") + (* ; "Edited 17-Jul-2024 00:49 by rmk") + (* ; "Edited 27-Mar-2024 13:47 by rmk") + (* ; "Edited 20-Nov-2023 20:16 by rmk") + (* ; "Edited 11-Jan-89 16:35 by jds") + + (* ;; "Redisplay the bitmap (presumably the button's vanilla label), then invert it if ON.") + + (* ;; + "We are in the object's coordinate system for buttonevent, highlighting and unhighlighting. ") + + (LET* [(BITMAP (MB.SETIMAGE OBJ)) + (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] + (BITBLT BITMAP 0 0 PANE 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) + (fetch (IMAGEBOX YSIZE) of OBJBOX) + 'INPUT + 'REPLACE) + (CL:WHEN (AND ON (NEQ ON 'OFF)) + (BLTSHADE BLACKSHADE PANE 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) + (fetch (IMAGEBOX YSIZE) of OBJBOX) + 'INVERT))]) + +(MB.CREATE + [LAMBDA (SPEC IMAGEFNS) (* ; "Edited 18-Oct-2024 10:27 by rmk") + (* ; "Edited 6-Oct-2024 16:59 by rmk") + (* ; "Edited 5-Oct-2024 11:51 by rmk") + (* ; "Edited 29-Sep-2024 14:51 by rmk") + (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 20-Aug-2024 16:16 by rmk") + (* ; "Edited 13-Aug-2024 22:16 by rmk") + (* ; "Edited 9-Aug-2024 16:00 by rmk") + (* ; "Edited 31-Jul-2024 22:00 by rmk") + (* ; "Edited 25-Jul-2024 23:42 by rmk") + (* ; "Edited 24-Jul-2024 08:30 by rmk") + (* ; "Edited 21-Jul-2024 22:58 by rmk") + (* ; "Edited 19-Jul-2024 11:00 by rmk") + (* ; "Edited 11-Jan-89 16:10 by jds") + + (* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields. ") + + (for S PROP VAL (OBJ _ (IMAGEOBJCREATE NIL (OR IMAGEFNS (CADR (ASSOC 'IMAGEFNS SPEC)) + MB.IMAGEFNS))) in SPEC + eachtime (SETQ PROP (MKATOM (CAR S))) + (SETQ VAL (CADR S)) unless (EQ PROP 'IMAGEFNS) + do (SELECTQ PROP + (FONT [SETQ VAL (FONTCREATE (FONTCREATE VAL NIL NIL NIL 'DISPLAY]) + ((LABEL IDENTIFIER) + (SETQ VAL (MKATOM VAL))) + NIL) + (IMAGEOBJPROP OBJ PROP VAL) + finally (CL:UNLESS (IMAGEOBJPROP OBJ 'FONT) + (IMAGEOBJPROP OBJ 'FONT (FONTCREATE '(HELVETICA 8 BOLD) + NIL NIL NIL 'DISPLAY))) + (CL:UNLESS (IMAGEOBJPROP OBJ 'IDENTIFIER) + (if (SETQ VAL (IMAGEOBJPROP OBJ 'LABEL)) + then [IMAGEOBJPROP OBJ 'IDENTIFIER + (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab #\Newline #\:) + VAL] + else (ERROR (ERROR "Missing both IDENTIFIER and LABEL" SPEC)))) + (CL:WHEN (IMAGEOBJPROP OBJ 'INITSTATE) + (IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP OBJ 'INITSTATE))) + (MB.SETIMAGE OBJ) + (RETURN OBJ]) + +(MB.CHANGENAME + [LAMBDA (TEXTOBJ OBJ NEWNAME) (* ; "Edited 26-Aug-2024 09:31 by rmk") + (* jds "23-Aug-84 13:26") + + (* Change the text that appears in a button, and redisplay the button if it's + visible) + + (PROG (BOX BITMAP DS) + (IMAGEOBJPROP OBJ 'LABEL NEWNAME) + (MB.SETIMAGE OBJ) + (TEDIT.OBJECT.CHANGED TEXTOBJ OBJ]) + +(MB.INIT + [LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk") + (* ; "Edited 28-Aug-2024 23:34 by rmk") + (* ; "Edited 24-Aug-2024 11:00 by rmk") + (* ; "Edited 20-Aug-2024 15:23 by rmk") + (* ; "Edited 18-Feb-2024 14:15 by rmk") + (* jds "12-Feb-85 14:32") + (SETQ MB.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAYFN) + (FUNCTION MB.SIZEFN) + (FUNCTION MB.PUTFN) + (FUNCTION MB.GETFN) + (FUNCTION MB.COPYFN) + (FUNCTION MB.BUTTONEVENTINFN) + 'NILL + 'NILL + 'NILL + (FUNCTION MB.DON'T) + 'NILL + (FUNCTION MB.WHENOPERATEDONFN) + (FUNCTION NILL) + 'TEditMenuButton]) + +(MB.TRACK.UNTIL + [LAMBDA (OBJ PANE) (* ; "Edited 23-Oct-2024 10:10 by rmk") + (* ; "Edited 18-Oct-2024 11:57 by rmk") + + (* ;; "Track the mouse untill either it leaves the object or the buttons come up. Returns DON'T if it leaves, NIL if buttons are up.") + + (do (BLOCK) + (GETMOUSESTATE) + (CL:WHEN (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ PANE NIL (LASTMOUSEX PANE) + (LASTMOUSEY PANE) + PANE)) + (RETURN 'DON'T)) + (CL:WHEN (ALLBUTTONSUP) + (RETURN NIL]) + +(MB.DON'T + [LAMBDA (OBJ) (* ; "Edited 16-Dec-2024 13:31 by rmk") + (* ; "Edited 7-Dec-2024 08:58 by rmk") + (CL:UNLESS (IMAGEOBJPROP OBJ 'DELETABLE) + 'DON'T]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MB.IMAGEFNS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MB.INIT) +) + + + +(* ; "3STATE") + + + + +(* ;; "ON-OFF-NEUTRAL menu buttons, for, e.g., character properties like BOLD") + +(DEFINEQ + +(MB.3STATE.CREATE + [LAMBDA (SPEC) (* ; "Edited 6-Oct-2024 17:08 by rmk") + (* ; "Edited 5-Oct-2024 17:00 by rmk") + (* ; "Edited 2-Aug-2024 23:51 by rmk") + (* ; "Edited 21-Jul-2024 00:52 by rmk") + (* ; "Edited 19-Jul-2024 10:48 by rmk") + (* jds "24-Sep-86 00:49") + (CL:UNLESS (ASSOC 'INITSTATE SPEC) + (push SPEC (LIST 'INITSTATE 'NEUTRAL))) + (push SPEC (LIST 'SETSTATEFN (FUNCTION MB.3STATE.SETSTATEFN))) + (MB.CREATE SPEC MB.3STATE.IMAGEFNS]) + +(MB.3STATE.DISPLAYFN + [LAMBDA (OBJ IMAGESTREAM) (* ; "Edited 5-Oct-2024 16:49 by rmk") + (* ; "Edited 25-Aug-2024 23:11 by rmk") + (* ; "Edited 24-Aug-2024 00:25 by rmk") + (* ; "Edited 26-Jul-2024 16:29 by rmk") + (* ; "Edited 20-Jul-2024 23:57 by rmk") + (* ; "Edited 20-Nov-2023 14:27 by rmk") + (* jds "30-Aug-84 13:53") + + (* ;; "IMAGEFNS function called from DISPLAYLINE") + + (MB.3STATE.SHOWSELFN OBJ IMAGESTREAM (IMAGEOBJPROP OBJ 'STATE) + (DSPXPOSITION NIL IMAGESTREAM) + (DSPYPOSITION NIL IMAGESTREAM]) + +(MB.3STATE.SHOWSELFN + [LAMBDA (OBJ IMAGESTREAM SHOWSTATE X Y) (* ; "Edited 5-Oct-2024 16:33 by rmk") + (* ; "Edited 25-Aug-2024 15:01 by rmk") + (* ; "Edited 24-Aug-2024 00:44 by rmk") + (* ; "Edited 20-Jul-2024 23:52 by rmk") + (* ; "Edited 18-Jul-2024 22:41 by rmk") + (* ; "Edited 17-Jul-2024 22:09 by rmk") + (* ; "Edited 20-Nov-2023 14:31 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "Shows the label of OBJ highlighted according to SHOWSTATE. X and Y are not provided if PANE is already in the object's coordinate system (bottom-left at (0,0).") + + (LET* ((BITMAP (MB.SETIMAGE OBJ)) + (OBJBOX (MB.SIZEFN OBJ IMAGESTREAM)) + (XSIZE (fetch XSIZE of OBJBOX)) + (YSIZE (fetch YSIZE of OBJBOX))) + (CL:UNLESS X (* ; "What about kerning?") + (SETQ X 0)) + (SETQ Y (CL:IF Y + (IDIFFERENCE Y (fetch YDESC of OBJBOX)) + 0)) + + (* ;; "Put down the neutral label, then modify") + + (BITBLT BITMAP 0 0 IMAGESTREAM X Y XSIZE YSIZE 'INPUT 'REPLACE) + (SELECTQ SHOWSTATE + (ON (* ; + "Display as white text on black background") + (BLTSHADE BLACKSHADE IMAGESTREAM X Y XSIZE YSIZE 'INVERT)) + (OFF (* ; + " Mark with a diagonal line thru it.") + (DRAWLINE X Y (SUB1 (IPLUS X XSIZE)) + (SUB1 (IPLUS Y YSIZE)) + 1 + 'PAINT IMAGESTREAM)) + NIL]) + +(MB.3STATE.INIT + [LAMBDA NIL (* ; "Edited 7-Dec-2024 12:38 by rmk") + (* ; "Edited 18-Oct-2024 11:40 by rmk") + (* ; "Edited 25-Aug-2024 23:11 by rmk") + (* ; "Edited 20-Aug-2024 15:36 by rmk") + (* jds " 9-Feb-86 15:17") + + (* ;; "Initialize the IMAGEFNS for 3-state menu button IMAGEOBJs") + + (SETQ MB.3STATE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.3STATE.DISPLAYFN) + (FUNCTION MB.SIZEFN) + (FUNCTION MB.PUTFN) + (FUNCTION MB.GETFN) + (FUNCTION MB.COPYFN) + (FUNCTION MB.3STATE.BUTTONEVENTINFN) + 'NILL + 'NILL + 'NILL + (FUNCTION MB.DON'T) + 'NILL NIL 'NILL '3StateMenuButton]) + +(MB.3STATE.SETSTATEFN + [LAMBDA (PC NEWVALUE TSTREAM) (* ; "Edited 5-Oct-2024 17:04 by rmk") + (* ; "Edited 25-Aug-2024 12:22 by rmk") + (* ; "Edited 5-Aug-2024 10:06 by rmk") + (* ; "Edited 3-Aug-2024 00:12 by rmk") + (IMAGEOBJPROP (PCONTENTS PC) + 'STATE + (SELECTQ NEWVALUE + ((NIL OFF) + 'OFF) + (NEUTRAL 'NEUTRAL) + 'ON)) + PC]) + +(MB.3STATE.BUTTONEVENTINFN + [LAMBDA (OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON) + (* ; "Edited 7-Dec-2024 13:11 by rmk") + (* ; "Edited 5-Dec-2024 21:53 by rmk") + (* ; "Edited 18-Oct-2024 12:00 by rmk") + (* ; "Edited 5-Oct-2024 22:42 by rmk") + (* ; "Edited 25-Aug-2024 12:50 by rmk") + (* ; "Edited 6-Aug-2024 10:55 by rmk") + (* ; "Edited 25-Jul-2024 20:13 by rmk") + (* ; "Edited 19-Jul-2024 10:43 by rmk") + (* ; "Edited 18-Jul-2024 10:11 by rmk") + (* ; "Edited 29-Apr-2024 13:30 by rmk") + (* ; "Edited 25-Feb-2024 23:40 by rmk") + (* ; "Edited 21-Oct-2022 18:45 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "BUTTONEVENTINFN for 3STATE buttons. This run's in the coordinate system of the object. ") + + (* ;; "This brings up the display for the next state, tracks the mouse until either it leaves the object or the buttons come up. If the mouse leaves, the original highlighting is restored. Otherwise the state of the obj is advanced to its next state. Either way, we report that the %"selection%" didn't succeed.") + + (if (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ MENUDS SEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)) + then 'DON'T + else (LET [(NEXTSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) + (ON 'OFF) + (OFF 'NEUTRAL) + (NEUTRAL 'ON) + (\TEDIT.THELP "ILLEGAL 3STATE" (IMAGEOBJPROP OBJ 'STATE] + (RESETLST + + (* ;; + "In case of an error or interrupt, make the display consistent with the state") + + [RESETSAVE NIL `(PROGN (CL:WHEN RESETSTATE + (MB.3STATE.SHOWSELFN ,OBJ ,MENUDS (IMAGEOBJPROP + ,OBJ + 'STATE)))] + (MB.3STATE.SHOWSELFN OBJ MENUDS NEXTSTATE) + [if (EQ 'DON'T (MB.TRACK.UNTIL OBJ MENUDS)) + then (* ; "Mouse moved out of object") + (MB.3STATE.SHOWSELFN OBJ MENUDS (IMAGEOBJPROP OBJ 'STATE)) + else (* ; "Buttons came up: do it") + (IMAGEOBJPROP OBJ 'STATE NEXTSTATE) + (CL:WHEN (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) + (APPLY* STATECHANGEFN OBJ NEXTSTATE (fetch (TEXTWINDOW WTEXTSTREAM) + of MENUDS)))]) + (TEDIT.BACKTOMAIN MENUTSTREAM) + NIL]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MB.3STATE.IMAGEFNS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MB.3STATE.INIT) +) + + + +(* ; "NWAY") + + + + +(* ;; "Mutually exclusive togggles with a single enclosing object") + +(DEFINEQ + +(MB.NWAY.CREATE + [LAMBDA (SPEC) (* ; "Edited 20-Dec-2024 22:17 by rmk") + (* ; "Edited 22-Oct-2024 00:26 by rmk") + (* ; "Edited 29-Sep-2024 12:43 by rmk") + (* ; "Edited 31-Aug-2024 14:57 by rmk") + (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 20-Aug-2024 16:06 by rmk") + (* ; "Edited 13-Aug-2024 22:44 by rmk") + (* ; "Edited 9-Aug-2024 12:14 by rmk") + (* ; "Edited 2-Aug-2024 23:12 by rmk") + (* ; "Edited 23-Jul-2024 11:43 by rmk") + (* ; "Edited 22-Jul-2024 08:38 by rmk") + (* gbn "24-Sep-84 15:31") + (LET ((IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC))) + (BUTTONS (CADR (ASSOC 'BUTTONS SPEC))) + [FONT (FONTCREATE (OR (CADR (ASSOC 'FONT SPEC)) + '(HELVETICA 8 BOLD] + (STATECHANGEFN (CADR (ASSOC 'STATECHANGEFN SPEC))) + (STATEFN (CADR (ASSOC 'STATEFN SPEC))) + (INITSTATE (OR (CADR (ASSOC 'INITSTATE SPEC)) + 'OFF)) + (MAXITEMS/LINE (OR (CADR (ASSOC 'MAXITEMS/LINE SPEC)) + 5)) + (DONTAPPLY (CADR (ASSOC 'DONTAPPLY SPEC))) + (OBJ (IMAGEOBJCREATE NIL MB.NWAY.IMAGEFNS)) + SPACING HEIGHT SUBOBJECTS) + (SETQ SPACING (STRINGWIDTH " " FONT)) + [SETQ HEIGHT (IPLUS 2 (FONTPROP FONT 'HEIGHT] + (CL:UNLESS (LISTP BUTTONS) + (ERROR "BAD BUTTONS" BUTTONS)) + [SETQ SUBOBJECTS (for BUTTON in BUTTONS collect (MB.TOGGLE.CREATE + `((LABEL ,BUTTON) + (FONT ,FONT] + (* ; "Initially all OFF") + (CL:UNLESS (EQ 'OFF INITSTATE) + (for SOBJ in SUBOBJECTS when [OR (STRING.EQUAL INITSTATE (IMAGEOBJPROP SOBJ 'LABEL)) + (STRING.EQUAL INITSTATE (IMAGEOBJPROP SOBJ 'IDENTIFIER] + do (IMAGEOBJPROP SOBJ 'STATE 'ON) + (IMAGEOBJPROP OBJ 'SELECTED SOBJ) + (RETURN) finally (ERROR "INITSTATE must be a button" INITSTATE))) + (IMAGEOBJPROP OBJ 'STATE INITSTATE) + (IMAGEOBJPROP OBJ 'MAXITEMS/LINE MAXITEMS/LINE) + [IMAGEOBJPROP OBJ 'MINWIDTH (fetch XSIZE + of (IMAGEOBJPROP [for SOBJ in SUBOBJECTS + largest (fetch XSIZE + of (IMAGEOBJPROP SOBJ + 'BOUNDBOX] + 'BOUNDBOX] + (IMAGEOBJPROP OBJ 'MINHEIGHT HEIGHT) (* ; + "MIN: all on same line. MAX: all on separate lines") + (IMAGEOBJPROP OBJ 'MAXHEIGHT (ITIMES HEIGHT (LENGTH BUTTONS))) + + (* ;; "At most, we're as wide as the N widest buttons put together. COPY because we want to preserve the original order") + + [IMAGEOBJPROP OBJ 'MAXWIDTH (for SOBJ + in [SORT (COPY SUBOBJECTS) + (FUNCTION (LAMBDA (A B) + (IGEQ (fetch XSIZE + of (IMAGEOBJPROP A 'BOUNDBOX)) + (fetch XSIZE + of (IMAGEOBJPROP B 'BOUNDBOX] + as I from 1 to MAXITEMS/LINE + sum (fetch XSIZE of (IMAGEOBJPROP SOBJ 'BOUNDBOX)) + finally (RETURN (IPLUS $$VAL (ITIMES SPACING (SUB1 + MAXITEMS/LINE + ] + (IMAGEOBJPROP OBJ 'SUBOBJECTS SUBOBJECTS) + (IMAGEOBJPROP OBJ 'ITEMSPACE SPACING) + (IMAGEOBJPROP OBJ 'BUTTONHEIGHT HEIGHT) + (IMAGEOBJPROP OBJ 'FONT FONT) + (IMAGEOBJPROP OBJ 'IDENTIFIER IDENTIFIER) + (IMAGEOBJPROP OBJ 'STATECHANGEFN STATECHANGEFN) + (IMAGEOBJPROP OBJ 'STATEFN STATEFN) + (IMAGEOBJPROP OBJ 'DONTAPPLY DONTAPPLY) + (IMAGEOBJPROP OBJ 'SETSTATEFN (FUNCTION MB.NWAY.SETSTATEFN)) + (CL:IF (CADR (ASSOC 'IGNORE SPEC)) + (IMAGEOBJPROP OBJ 'IGNORE T)) + OBJ]) + +(MB.NWAY.DISPLAYFN + [LAMBDA (OBJ STREAM) (* ; "Edited 22-Jul-2024 10:31 by rmk") + (* ; "Edited 18-Jul-2024 17:02 by rmk") + (* jds "28-Aug-84 15:07") + + (* ;; "Each of the subobjects has its own positions relative to X and Y and its own displayfn. Each object also knows whether it is on or off.") + + (for SOBJ (X _ (DSPXPOSITION NIL STREAM)) + (Y _ (DSPYPOSITION NIL STREAM)) in (IMAGEOBJPROP OBJ 'SUBOBJECTS) + do (DSPXPOSITION (IPLUS X (IMAGEOBJPROP SOBJ 'X)) + STREAM) + (DSPYPOSITION (IPLUS Y (IMAGEOBJPROP SOBJ 'Y)) + STREAM) + (APPLY* (IMAGEOBJPROP SOBJ 'DISPLAYFN) + SOBJ STREAM]) + +(MB.NWAY.WHENOPERATEDONFN + [LAMBDA (OBJ PANE OPERATION SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 24-Aug-2024 23:38 by rmk") + (* ; "Edited 13-Aug-2024 23:43 by rmk") + (* ; "Edited 2-Aug-2024 00:36 by rmk") + (* ; "Edited 21-Jul-2024 13:17 by rmk") + (* ; "Edited 17-Jul-2024 21:51 by rmk") + (* ; "Edited 9-Apr-2023 15:57 by rmk") + (* ; "Edited 13-Sep-2022 12:09 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "Perhaps the selected subobject should be stored here, as the state?") + + (* ;; "Mouse tracking and highlighting happens in the BUTTONEVENTINFN (MB.NWAYBUTTON.SELFN). The code here applies the STATECHANGEFN on the main object") + + (NOTUSED) + (SELECTQ OPERATION + (SELECTED [AND NIL (\TEDIT.THELP) + (LET [(SELECTED (IMAGEOBJPROP OBJ 'SELECTED] + (if (IMAGEOBJPROP OBJ 'STATECHANGEFN) + then (\TEDIT.THELP) + (APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN) + OBJ SELECTED SEL PANE) + elseif (AND NIL SELECTED (IMAGEOBJPROP SELECTED 'STATECHANGEFN)) + then + (* ;; + "This is nuked out: the selected object may be should have done its own thing?") + + (APPLY* (IMAGEOBJPROP SELECTED 'STATECHANGEFN) + OBJ SELECTED SEL PANE]) + ((HIGHLIGHTED UNHIGHLIGHTED DESELECTED)) + NIL]) + +(MB.NWAY.SIZEFN + [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 20-Aug-2024 15:12 by rmk") + (* ; "Edited 22-Jul-2024 11:31 by rmk") + (* jds " 6-Sep-84 14:19") + (* ; "Tell the size of an n-way menu") + (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) + (LET ((OLDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) + (SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS)) + (MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE)) + (MAXWIDTH (IMAGEOBJPROP OBJ 'MAXWIDTH)) + (MINHEIGHT (IMAGEOBJPROP OBJ 'MINHEIGHT)) + (BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT)) + (SPACING (IMAGEOBJPROP OBJ 'ITEMSPACE)) + (SLACK (IDIFFERENCE RIGHTMARGIN CURX)) + BOX XSIZE YSIZE LINES) + [if (AND (IGEQ SLACK MAXWIDTH) + (EQ MAXITEMS/LINE (LENGTH SUBOBJECTS))) + then (* ; + "All the subjobjects fit on one line.") + (SETQ XSIZE MAXWIDTH) + (SETQ YSIZE MINHEIGHT) + (for SO (X _ 0) in SUBOBJECTS do (IMAGEOBJPROP SO 'X X) + (add X (fetch XSIZE of (IMAGEOBJPROP + SO + 'BOUNDBOX)) + SPACING) + (IMAGEOBJPROP SO 'Y 0)) + elseif (ILEQ SLACK (IMAGEOBJPROP OBJ 'MINWIDTH)) + then (* ; "Stack them vertically.") + (for SO (Y _ (ITIMES BUTTONHEIGHT (LENGTH SUBOBJECTS))) in SUBOBJECTS + do (add Y (IMINUS BUTTONHEIGHT)) + (IMAGEOBJPROP SO 'Y Y) + (IMAGEOBJPROP SO 'X 0)) + else (* ; "Divide them into lines") + (SETQ LINES (MB.NWAY.ARRANGEBUTTONS SLACK SUBOBJECTS SPACING MAXITEMS/LINE)) + (SETQ XSIZE (for LINE LASTSO in LINES + largest (SETQ LASTSO (CAR (LAST LINE))) + [IPLUS (IMAGEOBJPROP LASTSO 'X) + (fetch XSIZE of (IMAGEOBJPROP LASTSO 'BOUNDBOX] + finally (RETURN $$EXTREME))) + (SETQ YSIZE (ITIMES BUTTONHEIGHT (LENGTH LINES))) + (for LINE (Y _ YSIZE) in LINES do (add Y (IMINUS BUTTONHEIGHT)) + (for SO in LINE + do (IMAGEOBJPROP SO 'Y Y] + (if (AND OLDBOX (IEQP XSIZE (fetch XSIZE of OLDBOX)) + (IEQP YSIZE (fetch YSIZE of OLDBOX))) + then + (* ;; "Nothing changed.") + + OLDBOX + else (SETQ BOX (create IMAGEBOX + XSIZE _ XSIZE + YSIZE _ YSIZE + YDESC _ (fetch YDESC of (IMAGEOBJPROP (CAR SUBOBJECTS) + 'BOUNDBOX)) + XKERN _ 0)) + (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) + BOX]) + +(MB.NWAY.SELECT + [LAMBDA (OBJ SELECTED MENUWINDOW SEL) (* ; "Edited 29-Sep-2024 12:44 by rmk") + (* ; "Edited 24-Aug-2024 15:28 by rmk") + (* ; "Edited 20-Aug-2024 15:13 by rmk") + (* ; "Edited 2-Aug-2024 00:28 by rmk") + (* ; "Edited 22-Jul-2024 23:55 by rmk") + (* ; "Edited 29-Apr-2024 13:31 by rmk") + (* ; "Edited 25-Feb-2024 23:43 by rmk") + (* ; "Edited 21-Oct-2022 18:46 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "SELECTED, if any, is the new subobject that should replace the old selection. If T, just turn off the old (neutralize).") + + (LET [(OLDSELECTED (IMAGEOBJPROP OBJ 'SELECTED] + (CL:WHEN (AND SELECTED (NEQ SELECTED T) + (LITATOM SELECTED)) + (SETQ SELECTED (MB.NWAY.FINDSUBOBJ SELECTED OBJ))) + (CL:UNLESS (EQ OLDSELECTED SELECTED) (* ; "Reclicking is a no-op. ") + (CL:WHEN (AND OLDSELECTED SELECTED) (* ; + "Turn the old one off if it's changing") + (IMAGEOBJPROP OLDSELECTED 'STATE 'OFF) + (CL:WHEN MENUWINDOW + (BITBLT (IMAGEOBJPROP OLDSELECTED 'BITCACHE) + 0 0 MENUWINDOW (IMAGEOBJPROP OLDSELECTED 'X) + (IMAGEOBJPROP OLDSELECTED 'Y) + NIL NIL 'INPUT 'REPLACE)) + (IMAGEOBJPROP OBJ 'STATE NIL) + (IMAGEOBJPROP OBJ 'SELECTED NIL)) + (CL:WHEN (AND SELECTED (NEQ T SELECTED)) (* ; "Turn on the new one.") + (IMAGEOBJPROP SELECTED 'STATE 'ON) + (CL:WHEN MENUWINDOW + (BITBLT (IMAGEOBJPROP SELECTED 'BITCACHE) + 0 0 MENUWINDOW (IMAGEOBJPROP SELECTED 'X) + (IMAGEOBJPROP SELECTED 'Y) + NIL NIL 'INVERT 'REPLACE)) + (IMAGEOBJPROP OBJ 'SELECTED SELECTED) + (IMAGEOBJPROP OBJ 'STATE (IMAGEOBJPROP SELECTED 'IDENTIFIER)) + (CL:WHEN (IMAGEOBJPROP OBJ 'STATECHANGEFN) + (APPLY* (IMAGEOBJPROP OBJ 'STATECHANGEFN) + OBJ SELECTED SEL MENUWINDOW))))]) + +(MB.NWAY.BUTTONEVENTINFN + [LAMBDA (OBJ MENUDS SEL RELX RELY SELWINDOW MENUTSTREAM BUTTON) + (* ; "Edited 5-Dec-2024 21:09 by rmk") + (* ; "Edited 25-Aug-2024 11:31 by rmk") + (* ; "Edited 22-Aug-2024 16:29 by rmk") + (* ; "Edited 20-Aug-2024 16:41 by rmk") + (* ; "Edited 22-Jul-2024 11:32 by rmk") + (* ; "Edited 29-Apr-2024 13:31 by rmk") + (* ; "Edited 25-Feb-2024 23:43 by rmk") + (* ; "Edited 21-Oct-2022 18:46 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "The BUTTONEVENTINFN for NWAY buttons. The mouse clicked in OBJ's box") + + (* ;; " Could be making a new selection, or maybe just throwing away an old one (all off).") + + (* ;; "The window is mapped to the object's coordinate system (the baseline-left is 0,0. We have to figure out which of the subobjects the mouse is in, given that their coordinates are relative to the main object's coordinates. Then make the selection.") + + (PROG1 (if (OR (MEMB BUTTON '(MIDDLE RIGHT)) + (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ MENUDS SEL RELX RELY SELWINDOW MENUTSTREAM + BUTTON))) + then 'DON'T + else (MB.NWAY.SELECT OBJ (find SOBJ in (IMAGEOBJPROP OBJ 'SUBOBJECTS) + suchthat (INSIDE? [create REGION + LEFT _ (IMAGEOBJPROP SOBJ + 'X) + BOTTOM _ (IMAGEOBJPROP SOBJ + 'Y) + WIDTH _ (fetch XSIZE + of (IMAGEOBJPROP + SOBJ + 'BOUNDBOX)) + HEIGHT _ (fetch YSIZE + of (IMAGEOBJPROP + SOBJ + 'BOUNDBOX] + RELX RELY)) + MENUDS SEL) + T) + (TEDIT.BACKTOMAIN MENUTSTREAM]) + +(MB.NWAY.NEWMENUBUTTON + [LAMBDA (TEXTOBJ CH# OLDBUTTON NEWBUTTON) (* ; "Edited 22-Jul-2024 10:08 by rmk") + (* jds " 8-Feb-84 19:41") + + (* ;; "Not called?") + + (* ;; "Given a hook on an existing button, and an insertion point, insert a new button") + + (PROG ((ARBITRATOR (IMAGEOBJPROP OLDBUTTON 'ARBITRATOR)) + BUTTON) + (IMAGEOBJPROP BUTTON 'ARBITRATOR ARBITRATOR) + (TEDIT.INSERT.OBJECT BUTTON TEXTOBJ CH#) + (TEDIT.INSERT TEXTOBJ " " (ADD1 CH#)) + (TEDIT.LOOKS TEXTOBJ '(PROTECTED ON) + (ADD1 CH#) + 2) + (RETURN BUTTON]) + +(MB.NWAY.COPYFN + [LAMBDA (OBJ) (* ; "Edited 11-Aug-2024 17:11 by rmk") + (* ; "Edited 21-Jul-2024 10:34 by rmk") + (* jds "23-May-84 11:32") + (* ; "Copy an NWAY menu button.") + (LET [(NEWOBJ (MB.COPYFN OBJ)) + (SELECTED (IMAGEOBJPROP OBJ 'SELECTED] + + (* ;; "MB.COPYFN copies the property list.") + + (for SOTAIL SUBOBJ SCOPY on (IMAGEOBJPROP NEWOBJ 'SUBOBJECTS) + do (SETQ SUBOBJ (CAR SOTAIL)) + (SETQ SCOPY (APPLY* (IMAGEOBJPROP SUBOBJ 'COPYFN) + SUBOBJ)) + (CL:WHEN (EQ SUBOBJ SELECTED) + (IMAGEOBJPROP NEWOBJ 'SELECTED SCOPY)) + (RPLACA SOTAIL SCOPY)) + NEWOBJ]) + +(MB.NWAY.INIT + [LAMBDA (BUTTONS FONT INITSTATE) (* ; "Edited 7-Dec-2024 09:05 by rmk") + (* ; "Edited 24-Aug-2024 23:11 by rmk") + (* ; "Edited 20-Aug-2024 16:41 by rmk") + (* ; "Edited 11-Aug-2024 17:13 by rmk") + (* jds " 9-Feb-86 15:17") + + (* ;; "Selection happens in the BUTTEVENTINFN, no WHENOPERATEDONFN") + + (SETQ MB.NWAY.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NWAY.DISPLAYFN) + (FUNCTION MB.NWAY.SIZEFN) + (FUNCTION MB.PUTFN) + (FUNCTION MB.GETFN) + (FUNCTION MB.NWAY.COPYFN) + (FUNCTION MB.NWAY.BUTTONEVENTINFN) + 'NILL + 'NILL + 'NILL + (FUNCTION MB.DON'T) + 'NILL + 'NILL + 'NILL + 'NWayButton]) + +(MB.NWAY.ARRANGEBUTTONS + [LAMBDA (WIDTH SUBOBJECTS SPACING MAXITEMS/LINE) (* ; "Edited 21-Jul-2024 20:18 by rmk") + (* jds "24-Oct-84 17:42") + +(* ;;; "Pack the subobjects, separated by SPACING, into lines WIDTH wide. Each line is a list of subobjects, and the X of each one is set to reflect its new position in the larger object. ") + + (for SO XSIZE LINES LINEOBJECTS (NLINEOBJECTS _ 0) + (X _ 0) in SUBOBJECTS do [SETQ XSIZE (fetch XSIZE of (IMAGEOBJPROP SO 'BOUNDBOX] + (CL:WHEN (OR (ILESSP WIDTH (IPLUS X XSIZE)) + (AND MAXITEMS/LINE (IGEQ NLINEOBJECTS MAXITEMS/LINE))) + (* ; "Time for a new line") + (push LINES (DREVERSE LINEOBJECTS)) + (* ; + "Add a new line, reset for next line") + (SETQ X 0) + (SETQ LINEOBJECTS NIL) + (SETQ NLINEOBJECTS 0)) + (push LINEOBJECTS SO) + (IMAGEOBJPROP SO 'X X) + (add X XSIZE SPACING) (* ; "Position of the next object") + (add NLINEOBJECTS 1) finally (CL:WHEN LINEOBJECTS + (* ; "Add a final partial line") + (push LINES (DREVERSE LINEOBJECTS) + )) + (RETURN (DREVERSE LINES]) + +(MB.NWAY.ADDITEM + [LAMBDA (OBJ NEWBUTTON) (* ; "Edited 20-Oct-2024 00:13 by rmk") + (* ; "Edited 29-Sep-2024 12:47 by rmk") + (* ; "Edited 26-Aug-2024 09:36 by rmk") + (* ; "Edited 20-Aug-2024 15:46 by rmk") + (* ; "Edited 16-Aug-2024 00:04 by rmk") + (* ; "Edited 13-Aug-2024 19:33 by rmk") + (* ; "Edited 27-Jul-2024 23:28 by rmk") + (* ; "Edited 22-Jul-2024 13:34 by rmk") + (* jds "11-Jul-85 12:44") + + (* ;; "Given an existing n-way choice menu button, add another choice to the list. The items are arranged in alphabetical order by their labels. MAXITEMS/LINE is goofy: it should flow with reshaping of the window.") + + (CL:WHEN NEWBUTTON + (LET* [(SUBOBJECTS (IMAGEOBJPROP OBJ 'SUBOBJECTS)) + [NEWSOBJ (MB.TOGGLE.CREATE `((IDENTIFIER ,(U-CASE NEWBUTTON)) + (LABEL ,NEWBUTTON) + (FONT ,(IMAGEOBJPROP OBJ 'FONT] + (MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE] + [SETQ SUBOBJECTS (SORT (CONS NEWSOBJ SUBOBJECTS) + (FUNCTION (LAMBDA (S1 S2) + (ALPHORDER (IMAGEOBJPROP S1 'LABEL) + (IMAGEOBJPROP S2 'LABEL] + (IMAGEOBJPROP OBJ 'SUBOBJECTS SUBOBJECTS) + [IMAGEOBJPROP OBJ 'MINWIDTH (IMAX (IMAGEOBJPROP OBJ 'MINWIDTH) + (fetch XSIZE of (IMAGEOBJPROP NEWSOBJ 'BOUNDBOX] + (CL:WHEN (ILESSP (LENGTH SUBOBJECTS) + MAXITEMS/LINE) + [IMAGEOBJPROP OBJ 'MAXWIDTH + (for SOBJ in [SORT (COPY SUBOBJECTS) + (FUNCTION (LAMBDA (A B) + (IGEQ (fetch XSIZE of (IMAGEOBJPROP + A + 'BOUNDBOX)) + (fetch XSIZE of (IMAGEOBJPROP + B + 'BOUNDBOX] + as I from 1 to MAXITEMS/LINE sum (fetch XSIZE of (IMAGEOBJPROP + SOBJ + 'BOUNDBOX)) + finally (RETURN (IPLUS $$VAL (ITIMES (IMAGEOBJPROP OBJ 'ITEMSPACE) + (SUB1 MAXITEMS/LINE]) + (IMAGEOBJPROP OBJ 'MAXHEIGHT (ITIMES (IMAGEOBJPROP OBJ 'BUTTONHEIGHT) + (LENGTH SUBOBJECTS))) + (IMAGEOBJPROP OBJ 'BOUNDBOX NIL) (* ; + "OBJ's original bound box is no longer valid.") + NEWSOBJ))]) + +(MB.NWAY.FINDSUBOBJ + [LAMBDA (TEXT OBJ) (* ; "Edited 26-Aug-2024 09:31 by rmk") + (* ; "Edited 22-Jul-2024 13:29 by rmk") + (find SOBJ in (IMAGEOBJPROP OBJ 'SUBOBJECTS) suchthat (STRING.EQUAL TEXT (IMAGEOBJPROP + SOBJ + 'LABEL]) + +(MB.NWAY.SETSTATEFN + [LAMBDA (PC NEWVALUE MENUSTREAM) (* ; "Edited 20-Oct-2024 00:02 by rmk") + (* ; "Edited 29-Sep-2024 12:45 by rmk") + (* ; "Edited 31-Aug-2024 14:46 by rmk") + (* ; "Edited 9-Aug-2024 13:36 by rmk") + (* ; "Edited 5-Aug-2024 09:42 by rmk") + (* ; "Edited 3-Aug-2024 12:15 by rmk") + + (* ;; "If NEWVALUE is OFF, the selection is turned off. Otherwise, the button for NEWVALUE (perhaps added if it wasn't there already) is turned on and all the others are turned off.. ") + + (CL:WHEN (type? SELECTION PC) + (SETQ PC (\TEDIT.CHTOPC (FGETSEL PC CH#) + (TEXTOBJ MENUSTREAM)))) + (LET ((OBJ (PCONTENTS PC))) + (CL:UNLESS (OR (EQ NEWVALUE 'OFF) + (MB.NWAY.FINDSUBOBJ NEWVALUE OBJ)) + (MB.NWAY.ADDITEM OBJ NEWVALUE)) + (MB.NWAY.SELECT OBJ NEWVALUE) + (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC)) + PC]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MB.NWAY.IMAGEFNS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MB.NWAY.INIT) +) + + + +(* ; "TOGGLE") + +(DEFINEQ + +(MB.TOGGLE.CREATE + [LAMBDA (SPEC) (* ; "Edited 19-Oct-2024 09:13 by rmk") + (* ; "Edited 6-Oct-2024 22:22 by rmk") + (* ; "Edited 28-Aug-2024 18:39 by rmk") + (* ; "Edited 25-Jul-2024 16:00 by rmk") + (* ; "Edited 22-Jul-2024 00:04 by rmk") + (* gbn "24-Sep-84 14:45") + + (* ;; "Creates a TOGGLE menu button, that turns off and on alternately") + + (CL:UNLESS (ASSOC 'INITSTATE SPEC) + (push SPEC (LIST 'INITSTATE 'OFF))) + (CL:UNLESS (CADR (ASSOC 'SETSTATEFN SPEC)) + (push SPEC (LIST 'SETSTATEFN (FUNCTION MB.TOGGLE.SETSTATEFN)))) + (MB.CREATE SPEC MB.TOGGLE.IMAGEFNS]) + +(MB.TOGGLE.DISPLAYFN + [LAMBDA (OBJ STREAM MODE) (* ; "Edited 25-Aug-2024 23:13 by rmk") + (* ; "Edited 24-Aug-2024 16:02 by rmk") + (* ; "Edited 21-Jul-2024 00:41 by rmk") + (* ; "Edited 19-Jul-2024 10:57 by rmk") + (* ; "Edited 20-Nov-2023 14:35 by rmk") + (* gbn "27-Sep-84 01:23") + (* ; "'27-Sep-84 01:11' gbn") + + (* ;; "Display the innards of a menu toggle") + + (LET ((BITMAP (MB.SETIMAGE OBJ)) + (OBJBOX (MB.SIZEFN OBJ)) + (X (DSPXPOSITION NIL STREAM)) + (Y (DSPYPOSITION NIL STREAM)) + XSIZE YSIZE) + (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX))) + (SETQ XSIZE (fetch XSIZE of OBJBOX)) + (SETQ YSIZE (fetch YSIZE of OBJBOX)) + (BITBLT BITMAP 0 0 STREAM X Y XSIZE YSIZE 'INPUT 'REPLACE) + (CL:WHEN (EQ 'ON (IMAGEOBJPROP OBJ 'STATE)) (* ; + "Display white text on black background") + (BLTSHADE BLACKSHADE STREAM X Y XSIZE YSIZE 'INVERT))]) + +(MB.TOGGLE.INIT + [LAMBDA NIL (* ; "Edited 7-Dec-2024 12:33 by rmk") + (* ; "Edited 19-Oct-2024 23:21 by rmk") + (* ; "Edited 18-Oct-2024 13:27 by rmk") + (* ; "Edited 6-Oct-2024 23:43 by rmk") + (* ; "Edited 25-Aug-2024 23:13 by rmk") + (* ; "Edited 24-Aug-2024 10:56 by rmk") + (* ; "Edited 20-Aug-2024 15:47 by rmk") + (* jds " 9-Feb-86 15:18") + (SETQ MB.TOGGLE.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.TOGGLE.DISPLAYFN) + (FUNCTION MB.SIZEFN) + (FUNCTION MB.PUTFN) + (FUNCTION MB.GETFN) + (FUNCTION MB.COPYFN) + (FUNCTION MB.TOGGLE.BUTTONEVENTINFN) + 'NILL + 'NILL + 'NILL + (FUNCTION MB.DON'T) + 'NILL + (FUNCTION MB.TOGGLE.WHENOPERATEDONFN) + 'NILL + 'ToggleButton]) + +(MB.SET.TOGGLE + [LAMBDA (IDENTIFIER VALUE MENUSTREAM) (* ; "Edited 22-Oct-2024 09:17 by rmk") + (* ; "Edited 26-Aug-2024 09:35 by rmk") + (* ; "Edited 20-Aug-2024 15:26 by rmk") + (* ; "Edited 11-Aug-2024 13:13 by rmk") + (* ; "Edited 21-Jul-2024 01:03 by rmk") + (* ; "Edited 6-Jul-2024 16:57 by rmk") + (* ; "Edited 6-Aug-2022 18:18 by rmk") + (* ; "Edited 12-Jun-90 19:02 by mitani") + +(* ;;; "Finds the button with IDENTIFIER in TEXTSTREAM and sets its state to VALUE") + + (LET [(OBJ (OR (MB.GET IDENTIFIER MENUSTREAM) + (ERROR IDENTIFIER " was not found as a button."] + (IMAGEOBJPROP OBJ 'STATE VALUE) + (\TEDIT.FILL.PANES MENUSTREAM) + VALUE]) + +(MB.TOGGLE.SETSTATEFN + [LAMBDA (PC NEWVALUE MENUSTREAM) (* ; "Edited 20-Oct-2024 18:14 by rmk") + (* ; "Edited 18-Oct-2024 23:17 by rmk") + (* ; "Edited 6-Oct-2024 22:54 by rmk") + (* ; "Edited 8-Aug-2024 14:34 by rmk") + (* ; "Edited 3-Aug-2024 00:10 by rmk") + (CL:WHEN (type? SELECTION PC) + (SETQ PC (\TEDIT.CHTOPC (FGETSEL PC CH#) + (GETTSTR MENUSTREAM TEXTOBJ)))) + (IMAGEOBJPROP (POBJ PC) + 'STATE NEWVALUE) + (TEDIT.OBJECT.CHANGED MENUSTREAM (POBJ PC) + PC) + PC]) + +(MB.TOGGLE.BUTTONEVENTINFN + [LAMBDA (OBJ MENUDS MENUSEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON) + (* ; "Edited 7-Dec-2024 13:11 by rmk") + (* ; "Edited 19-Oct-2024 19:52 by rmk") + (* ; "Edited 5-Oct-2024 22:42 by rmk") + (* ; "Edited 25-Aug-2024 12:50 by rmk") + (* ; "Edited 6-Aug-2024 10:55 by rmk") + (* ; "Edited 25-Jul-2024 20:13 by rmk") + (* ; "Edited 19-Jul-2024 10:43 by rmk") + (* ; "Edited 18-Jul-2024 10:11 by rmk") + (* ; "Edited 29-Apr-2024 13:30 by rmk") + (* ; "Edited 25-Feb-2024 23:40 by rmk") + (* ; "Edited 21-Oct-2022 18:45 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "BUTTONEVENTINFN for toggle buttons. This run's in the coordinate system of the object. ") + + (* ;; "This brings up the display for the next state, tracks the mouse until either it leaves the object or the buttons come up. If the mouse leaves, the original highlighting is restored. Otherwise the state of the obj is advanced to its next state. Either way, we report that the %"selection%" didn't succeed.") + + (if (EQ 'DON'T (MB.BUTTONEVENTINFN OBJ MENUDS MENUSEL RELX RELY MENUWINDOW MENUTSTREAM BUTTON)) + then 'DON'T + else (LET ([NEXTSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) + ((ON T) + 'OFF) + ((OFF NIL) + 'ON) + (\TEDIT.THELP "ILLEGAL TOGGLE" (IMAGEOBJPROP OBJ 'STATE] + STATECHANGEFN) + (RESETLST + + (* ;; + "In case of an error or interrupt, make the display consistent with the state") + + [RESETSAVE NIL `(PROGN (CL:WHEN RESETSTATE + (MB.SHOWSELFN ,OBJ (IMAGEOBJPROP ,OBJ 'STATE) + ,MENUDS))] + (MB.SHOWSELFN OBJ NEXTSTATE MENUDS) + (if (EQ 'DON'T (MB.TRACK.UNTIL OBJ MENUDS)) + then (* ; "Mouse moved out of object") + (MB.SHOWSELFN OBJ (IMAGEOBJPROP OBJ 'STATE) + MENUDS) + NIL + else (* ; "Buttons came up: do it") + (SETQ STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) + (if (OR (NULL STATECHANGEFN) + (NEQ 'DON'T (APPLY* STATECHANGEFN OBJ NEXTSTATE + (fetch (TEXTWINDOW WTEXTSTREAM) of MENUDS) + MENUSEL))) + then (IMAGEOBJPROP OBJ 'STATE NEXTSTATE) + (* ; + "SELECTFN value: WHENOPERATEDONFN will run it in window's coordinate system") + (IMAGEOBJPROP OBJ 'SELECTFN) + else (* ; "NIL value: object is ignored") + (MB.SHOWSELFN OBJ (IMAGEOBJPROP OBJ 'STATE) + MENUDS) + NIL)))]) + +(MB.TOGGLE.WHENOPERATEDONFN + [LAMBDA (OBJ MENUDS OPERATION MENUSEL MENUSTREAM) (* ; "Edited 20-Oct-2024 22:11 by rmk") + (* ; "Edited 6-Oct-2024 21:34 by rmk") + (* ; "Edited 24-Aug-2024 10:48 by rmk") + (* ; "Edited 20-Aug-2024 15:46 by rmk") + (* ; "Edited 9-Feb-2024 10:52 by rmk") + (* ; "Edited 28-Jan-2024 23:32 by rmk") + (* ; "Edited 30-May-91 22:16 by jds") + + (* ;; "Run's the SELECTFN of a toggle in the window's coordinate system, after it has been selected (mouse buttons came up). The buttoneventfn manages the STATECHANGEFN and highlighting in the objectg's coordinate system") + + (SELECTQ OPERATION + (SELECTED (CL:WHEN (IMAGEOBJPROP OBJ 'SELECTFN) + (APPLY* (IMAGEOBJPROP OBJ 'SELECTFN) + OBJ MENUDS MENUSEL MENUSTREAM)) + (TEDIT.BACKTOMAIN MENUSTREAM)) + ((DESELECTED HIGHLIGHTED UNHIGHLIGHTED)) + NIL]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MB.TOGGLE.IMAGEFNS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MB.TOGGLE.INIT) +) + + + +(* ; "FIELDS") + +(DEFINEQ + +(MB.FIELD.CREATE + [LAMBDA (SPEC MENUTSTREAM CH#) (* ; "Edited 16-Dec-2024 13:33 by rmk") + (* ; "Edited 9-Dec-2024 21:53 by rmk") + (* ; "Edited 4-Dec-2024 15:57 by rmk") + (* ; "Edited 20-Oct-2024 23:43 by rmk") + (* ; "Edited 29-Sep-2024 12:52 by rmk") + (* ; "Edited 29-Aug-2024 09:41 by rmk") + (* ; "Edited 22-Aug-2024 23:22 by rmk") + (* ; "Edited 21-Aug-2024 09:55 by rmk") + (* ; "Edited 15-Aug-2024 23:13 by rmk") + (* ; "Edited 14-Aug-2024 00:25 by rmk") + (* ; "Edited 7-Aug-2024 23:48 by rmk") + (* ; "Edited 2-Aug-2024 12:21 by rmk") + (* ; "Edited 30-Jul-2024 13:31 by rmk") + (* ; "Edited 27-Jul-2024 21:16 by rmk") + (* ; "Edited 26-Jul-2024 13:37 by rmk") + (* ; "Edited 24-Jul-2024 18:20 by rmk") + + (* ;; "Installs a FIELDPREFIX image objects with preceding text followed by %" {%" and a post-field string piece with %"} %" followed by the postlabel.") + + (LET ((INITSTATE (CADR (ASSOC 'INITSTATE SPEC))) + (PRELABEL (CADR (ASSOC 'PRELABEL SPEC))) + (POSTLABEL (CADR (ASSOC 'POSTLABEL SPEC))) + (IDENTIFIER (CADR (ASSOC 'IDENTIFIER SPEC))) + [LABELFONT (FONTCREATE (OR (CADR (ASSOC 'LABELFONT SPEC)) + '(HELVETICA 8] + [FIELDFONT (FONTCREATE (OR (CADR (ASSOC 'FIELDFONT SPEC)) + '(HELVETICA 8] + PRE POST FIELDLOOKS PREFIXOBJ SUFFIXOBJ REMAINDER) + + (* ;; "Collect any other properties to put on the prefix") + + (SETQ REMAINDER (for S in SPEC unless (MEMB (CAR S) + '(INITSTATE PRELABEL POSTLABEL IDENTIFIER + LABELFONT FIELDFONT)) collect S)) + + (* ;; "SPEC could specify a prelabel font different from a field font") + + (CL:UNLESS IDENTIFIER + (if PRELABEL + then [push SPEC (LIST IDENTIFIER (U-CASE (MKATOM (CL:STRING-TRIM '(#\Space #\Tab + #\Newline + #\:) + PRELABEL] + else (ERROR "NO IDENTIFIER FOR FIELD"))) + [SETQ PRE `((,FIELDFONT " {"] + (CL:WHEN PRELABEL + (push PRE (LIST LABELFONT PRELABEL))) + (CL:WHEN POSTLABEL + [SETQ POST `((,LABELFONT ,POSTLABEL]) + (push POST (LIST FIELDFONT "} ")) + + (* ;; "") + + (SETQ FIELDLOOKS (\TEDIT.CHARLOOKS.FROM.FONT FIELDFONT)) + (SETQ PREFIXOBJ (MB.FIELD.PREFIXCREATE SPEC PRE FIELDLOOKS)) + (for S in REMAINDER do (IMAGEOBJPROP PREFIXOBJ (CAR S) + (CADR S))) + (SETQ SUFFIXOBJ (MB.FIELD.SUFFIXCREATE SPEC POST FIELDLOOKS)) + + (* ;; "Let the suffixobj have the same extras as the prefix ? E.g. DELETABLE ?") + + (for S in REMAINDER do (IMAGEOBJPROP SUFFIXOBJ (CAR S) + (CADR S))) + (IMAGEOBJPROP PREFIXOBJ 'SUFFIXOBJ SUFFIXOBJ) + + (* ;; "") + + (TEDIT.INSERT.OBJECT PREFIXOBJ MENUTSTREAM CH# FIELDFONT) + (add CH# 1) + (CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Initial entry") + [TEDIT.INSERT MENUTSTREAM (MKSTRING INITSTATE) + CH# + `(FONT ,FIELDFONT] + (add CH# (NCHARS INITSTATE))) + (TEDIT.INSERT.OBJECT SUFFIXOBJ MENUTSTREAM CH# FIELDFONT) + (add CH# 1]) + +(MB.FIELD.DISPLAYFN + [LAMBDA (OBJ IMAGESTREAM) (* ; "Edited 4-Dec-2024 16:11 by rmk") + (* ; "Edited 4-Dec-2021 08:24 by rmk") + (* ; "Edited 1-Dec-2021 14:18 by rmk:") + (for X in (IMAGEOBJPROP OBJ 'OBJECTDATUM) do (DSPFONT (OR (FONTP (CAR X)) + (FONTCREATE (CAR X) + NIL NIL NIL IMAGESTREAM)) + IMAGESTREAM) + (for I in (CDR X) do (PRIN3 I IMAGESTREAM]) + +(MB.FIELD.IMAGEBOXFN + [LAMBDA (OBJ IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 4-Dec-2024 08:36 by rmk") + (* ; "Edited 9-Dec-2021 23:02 by rmk") + (* ; "Edited 7-Dec-2021 10:50 by rmk") + (* ; "Edited 5-Dec-2021 23:52 by rmk") + (* ; "Edited 4-Dec-2021 08:24 by rmk") + (* ; "Edited 1-Dec-2021 13:27 by rmk:") + + (* ;; "Calculates the image box for a sequence of (font string/atom) items.") + + (SETQ IMAGESTREAM (GETSTREAM IMAGESTREAM 'OUTPUT)) + (for X FONT (XSIZE _ 0) + (ASCENT _ 0) + (DESCENT _ 0) in (IMAGEOBJPROP OBJ 'OBJECTDATUM) + do (SETQ FONT (FONTCREATE (CAR X) + NIL NIL NIL IMAGESTREAM)) + [SETQ DESCENT (IMAX DESCENT (FONTPROP FONT 'DESCENT] + [SETQ ASCENT (IMAX ASCENT (FONTPROP FONT 'ASCENT] + (add XSIZE (for I in (CDR X) sum (STRINGWIDTH I FONT))) + finally (RETURN (create IMAGEBOX + XSIZE _ XSIZE + YSIZE _ (IPLUS ASCENT DESCENT) + YDESC _ DESCENT + XKERN _ 0]) + +(MB.FIELD.PREFIXCREATE + [LAMBDA (SPEC PRE FIELDLOOKS) (* ; "Edited 9-Dec-2024 21:53 by rmk") + (* ; "Edited 7-Dec-2024 09:01 by rmk") + (* ; "Edited 4-Dec-2024 17:48 by rmk") + (* ; "Edited 8-Nov-2024 08:36 by rmk") + (* ; "Edited 22-Oct-2024 12:54 by rmk") + (* ; "Edited 20-Oct-2024 17:25 by rmk") + (* ; "Edited 6-Oct-2024 17:43 by rmk") + (* ; "Edited 29-Sep-2024 21:45 by rmk") + (* ; "Edited 29-Aug-2024 09:40 by rmk") + (* ; "Edited 21-Aug-2024 09:48 by rmk") + + (* ;; "Create a FIELDPREFIX image object, and fill in its image and function-hook fields. This displays its own text, but returns the characters of the following unprotected text field when selected") + + (CL:UNLESS (CADR (ASSOC 'SETSTATEFN SPEC)) + (push SPEC (LIST 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN)))) + (LET ((INITSTATE (CADR (ASSOC 'INITSTATE SPEC))) + (EMPTYVALUE (ASSOC 'EMPTYVALUE SPEC)) + FIELDTYPE OBJ) + (CL:WHEN EMPTYVALUE (* ; + "Put it in a list, so we can distinguish NIL") + (SETQ SPEC (CONS (LIST 'EMPTYVALUE (CDR EMPTYVALUE)) + (REMOVE EMPTYVALUE SPEC)))) + (CL:UNLESS (SETQ FIELDTYPE (CADR (ASSOC 'FIELDTYPE SPEC))) + [push SPEC (LIST 'FIELDTYPE (SETQ FIELDTYPE 'STRING]) + (SETQ OBJ (IMAGEOBJCREATE PRE MB.FIELD.IMAGEFNS)) + (IMAGEOBJPROP OBJ 'STATEFN (FUNCTION MB.FIELD.GETSTATEFN)) + (CL:UNLESS (CADR (ASSOC 'SETSTATEFN SPEC)) + (IMAGEOBJPROP OBJ SPEC 'SETSTATEFN (FUNCTION MB.FIELD.SETSTATEFN))) + (IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS) + (for S in SPEC unless (MEMB (CAR S) + '(PRELABEL POSTLABEL LABELFONT FIELDFONT)) + do (IMAGEOBJPROP OBJ (CAR S) + (CADR S))) + (CL:WHEN (AND EMPTYVALUE (EQ INITSTATE (CADR EMPTYVALUE))) + (SETQ INITSTATE '**EMPTY**)) + (CL:WHEN (AND INITSTATE (NEQ INITSTATE '**EMPTY**)) (* ; "Can SELECTION be initialized?") + (CL:UNLESS (SELECTQ FIELDTYPE + (NUMBER (NUMBERP INITSTATE)) + (SYMBOL (LITATOM INITSTATE)) + (POSITIVENUMBER + (AND (NUMBERP INITSTATE) + (IGEQ INITSTATE 1))) + (CARDINAL (AND (NUMBERP INITSTATE) + (IGEQ INITSTATE 0))) + ((TEXT STRING) + (STRINGP INITSTATE)) + (IMAGEOBJ (IMAGEOBJP INITSTATE)) + NIL) + (\ILLEGAL.ARG INITSTATE)) + (IMAGEOBJPROP OBJ 'INITSTATE INITSTATE)) + (IMAGEOBJPROP OBJ 'FIELDPREFIX T) + OBJ]) + +(MB.FIELD.SUFFIXCREATE + [LAMBDA (SPEC POST FIELDLOOKS) (* ; "Edited 9-Dec-2024 21:53 by rmk") + (* ; "Edited 7-Dec-2024 09:02 by rmk") + (* ; "Edited 4-Dec-2024 11:58 by rmk") + (* ; "Edited 8-Nov-2024 08:36 by rmk") + (* ; "Edited 22-Oct-2024 12:54 by rmk") + (* ; "Edited 20-Oct-2024 17:25 by rmk") + (* ; "Edited 6-Oct-2024 17:43 by rmk") + (* ; "Edited 29-Sep-2024 21:45 by rmk") + (* ; "Edited 29-Aug-2024 09:40 by rmk") + (* ; "Edited 21-Aug-2024 09:48 by rmk") + + (* ;; "Creates the FIELDSUFFIX image object. This displays the POST strings, but otherwise just moves the caret to its right when selected. All the action is in the FIELDPREFIX on the other side of the field.") + + (LET (OBJ) + (SETQ OBJ (IMAGEOBJCREATE POST MB.FIELD.IMAGEFNS)) + (IMAGEOBJPROP OBJ 'FIELDSUFFIX T) + (IMAGEOBJPROP OBJ 'FIELDLOOKS FIELDLOOKS) + (IMAGEOBJPROP OBJ 'IDENTIFIER (PACK* (CADR (ASSOC 'IDENTIFIER SPEC)) + ".SUFFIX")) + OBJ]) + +(MB.FIELD.INIT + [LAMBDA NIL (* ; "Edited 7-Dec-2024 09:05 by rmk") + (* ; "Edited 4-Dec-2024 16:09 by rmk") + (* ; "Edited 22-Aug-2024 10:07 by rmk") + (* ; "Edited 20-Aug-2024 16:03 by rmk") + (* ; "Edited 23-Jul-2024 14:49 by rmk") + (* ; "Edited 18-Feb-2024 14:15 by rmk") + (* jds "12-Feb-85 14:32") + + (* ;; "The displayfn is NILL--field prefixes don't display") + + (SETQ MB.FIELD.IMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.FIELD.DISPLAYFN) + (FUNCTION MB.FIELD.IMAGEBOXFN) + (FUNCTION MB.PUTFN) + (FUNCTION MB.GETFN) + (FUNCTION MB.COPYFN) + (FUNCTION MB.FIELD.BUTTONEVENTINFN) + 'NILL + 'NILL + 'NILL + (FUNCTION MB.DON'T) + 'NILL + (FUNCTION MB.FIELD.WHENOPERATEDONFN) + (FUNCTION NILL) + 'FieldPrefixButton]) + +(MB.FIELD.WHENOPERATEDONFN + [LAMBDA (OBJ PANE OPERATION SEL TSTREAM) (* ; "Edited 5-Dec-2024 15:12 by rmk") + (* ; "Edited 8-Nov-2024 08:37 by rmk") + (* ; "Edited 26-Jul-2024 00:17 by rmk") + (* ; "Edited 24-Jul-2024 00:02 by rmk") + (* ; "Edited 20-Jul-2024 20:57 by rmk") + (* ; "Edited 17-Jul-2024 21:27 by rmk") + (* ; "Edited 27-Mar-2024 13:49 by rmk") + + (* ;; "If the buttoneventfn didn't take care of this.") + + (SELECTQ OPERATION + (SELECTED (if (IMAGEOBJPROP OBJ 'FIELDPREFIX) + then (FSETSEL SEL POINT 'RIGHT) + else (FSETSEL SEL POINT 'LEFT)) + (FSETSEL SEL SELOBJ NIL) + (FSETSEL SEL DCH 0)) + (\TEDIT.FIXSEL SEL (GETTSTR TSTREAM TEXTOBJ)) + ((DESELECTED HIGHLIGHTED UNHIGHLIGHTED) + NIL) + NIL]) + +(MB.FIELD.GETSTATEFN + [LAMBDA (PREFIXPC PREFIXOBJ TSTREAM) (* ; "Edited 18-Dec-2024 14:01 by rmk") + (* ; "Edited 4-Dec-2024 16:41 by rmk") + (* ; "Edited 8-Nov-2024 08:37 by rmk") + (* ; "Edited 22-Oct-2024 10:43 by rmk") + (* ; "Edited 29-Sep-2024 12:46 by rmk") + (* ; "Edited 29-Aug-2024 11:05 by rmk") + (* ; "Edited 27-Mar-2024 13:49 by rmk") + + (* ;; "Piece PREFIXPC contains a FIELDPREFIX image object. This extracts the field-value from the following unprotected pieces, and stores in as the STATE of OBJ. Crucially, it returns the last piece of the field, the corresponding SUFFIXPC. Higher iterations can continue with that value.") + + (* ;; "This also records the starting CHNO and length of the field--intuitively, the field is part of the object. Can't save it at insertion time, because it might change.") + + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (FIELDSTART (ADD1 (\TEDIT.PCTOCH PREFIXPC TEXTOBJ))) + (ENDPC PREFIXPC) + FIELDLENGTH FSEL FIELDTYPE VAL) (* ; "FSEL selects the field") + (SETQ FIELDLENGTH (for PC inpieces (NEXTPIECE PREFIXPC) + sum (CL:WHEN (AND (EQ OBJECT.PTYPE (PTYPE PC)) + (IMAGEOBJPROP (POBJ PC) + 'FIELDSUFFIX)) + (SETQ ENDPC PC) + (RETURN $$VAL)) + (PLEN PC))) + (SETQ FSEL (create SELECTION + SET _ T)) + (\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'RIGHT) + (SETQ FIELDTYPE (IMAGEOBJPROP PREFIXOBJ 'FIELDTYPE)) + (SETQ VAL (SELECTQ FIELDTYPE + (IMAGEOBJ (if (EQ FIELDLENGTH 1) + then (IMAGEOBJP (FGETSEL FSEL SELOBJ)) + elseif (EQ FIELDLENGTH 0) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT + (L-CASE (IMAGEOBJPROP + PREFIXOBJ + 'IDENTIFIER) + T) + + " field does not contain an image object" + ) + T T) + NIL)) + (SELECTION FSEL) + (MB.FIELD.INSURETYPE FIELDTYPE (TEDIT.SEL.AS.STRING TSTREAM FSEL) + TSTREAM))) + (CL:WHEN (EQ VAL '**EMPTY**) + (if (IMAGEOBJPROP PREFIXOBJ 'EMPTYVALUE) + then (SETQ VAL (IMAGEOBJPROP PREFIXOBJ 'EMPTYVALUE)) + else (SELECTQ FIELDTYPE + ((STRING TEXT) + (SETQ VAL (CONCAT))) + (SYMBOL (SETQ VAL NIL)) + NIL))) + (IMAGEOBJPROP PREFIXOBJ 'STATE VAL) + (IMAGEOBJPROP PREFIXOBJ 'FIELDSTART FIELDSTART) + (IMAGEOBJPROP PREFIXOBJ 'FIELDLENGTH FIELDLENGTH) + ENDPC]) + +(MB.FIELD.SETSTATEFN + [LAMBDA (PREFIXPC NEWVALUE TSTREAM) (* ; "Edited 9-Dec-2024 22:14 by rmk") + (* ; "Edited 4-Dec-2024 20:31 by rmk") + (* ; "Edited 20-Oct-2024 17:20 by rmk") + (* ; "Edited 29-Sep-2024 12:46 by rmk") + (* ; "Edited 31-Aug-2024 11:33 by rmk") + (* ; "Edited 26-Aug-2024 09:23 by rmk") + (* ; "Edited 22-Aug-2024 10:04 by rmk") + (* ; "Edited 8-Aug-2024 22:07 by rmk") + (* ; "Edited 6-Aug-2024 12:09 by rmk") + (* ; "Edited 5-Aug-2024 09:57 by rmk") + + (* ;; "Piece PREFIXPC contains a FIELDPREFIX image object. The following (unprotected) field begins at the next character position and ends just before the following SUFFIXPC. This replaces the current contents of that field with NEWVAL. Returns the last piece of the new value, PREFIXPC if NEWVALUE is NIL=empty value.") + + (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (PREFIXOBJ (PCONTENTS PREFIXPC)) + (FIELDSTART (ADD1 (\TEDIT.PCTOCH PREFIXPC TEXTOBJ))) + (FIELDTYPE (IMAGEOBJPROP PREFIXOBJ 'FIELDTYPE)) + (EMPTYVALUE (IMAGEOBJPROP PREFIXOBJ 'EMPTYVALUE)) + FIELDLENGTH FSEL) + (CL:WHEN (AND EMPTYVALUE (EQ NEWVALUE (CAR EMPTYVALUE))) + (SETQ NEWVALUE '**EMPTY**)) + (SELECTQ FIELDTYPE + (IMAGEOBJ (CL:WHEN (AND NEWVALUE (NOT (IMAGEOBJP NEWVALUE))) + (* ; "must be an image object") + (TEDIT.PROMPTPRINT (CONCAT "Invalid value for " + (L-CASE (IMAGEOBJPROP PREFIXOBJ 'IDENTIFIER) + T) + " field") + T T) + (RETURN NIL))) + (SELECTION (\ILLEGAL.ARG NEWVALUE)) + (SETQ NEWVALUE (MB.FIELD.INSURETYPE FIELDTYPE NEWVALUE TSTREAM))) + + (* ;; "NEWVALUE is valid for this type of field") + + (SETQ FIELDLENGTH (for PC inpieces (NEXTPIECE PREFIXPC) + until (AND (EQ OBJECT.PTYPE (PTYPE PC)) + (IMAGEOBJPROP (POBJ PC) + 'FIELDSUFFIX)) sum (PLEN PC))) + (SETQ FSEL (create SELECTION + SET _ T)) (* ; + "FSEL selects the field to the right of PREFIXPC") + (\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT) + (CL:UNLESS (EQ 0 FIELDLENGTH) (* ; "Clear the old value") + (\TEDIT.DELETE TEXTOBJ FSEL) + (SETQ FIELDLENGTH 0)) + (SETQ FIELDLENGTH (if (EQ NEWVALUE '**EMPTY**) + then 0 + elseif (EQ 'IMAGEOBJ FIELDTYPE) + then (TEDIT.INSERT.OBJECT NEWVALUE TSTREAM FSEL) + 1 + else (SETQ NEWVALUE (MKSTRING NEWVALUE)) + (\TEDIT.INSERT NEWVALUE FSEL TSTREAM T T) + (NCHARS NEWVALUE))) + (\TEDIT.UPDATE.SEL FSEL FIELDSTART FIELDLENGTH 'LEFT) + (\TEDIT.CHANGE.CHARLOOKS TSTREAM (IMAGEOBJPROP PREFIXOBJ 'FIELDLOOKS) + FSEL) + (IMAGEOBJPROP PREFIXOBJ 'FIELDLENGTH FIELDLENGTH) + (IMAGEOBJPROP PREFIXOBJ 'STATE NEWVALUE) + + (* ;; "Maybe the insert jiggled the pieces, scan again for the end piece") + + (RETURN (find PC inpieces (NEXTPIECE PREFIXPC) suchthat (AND (EQ OBJECT.PTYPE (PTYPE + PC)) + (IMAGEOBJPROP (POBJ PC) + 'FIELDSUFFIX]) + +(MB.FIELD.BUTTONEVENTINFN + [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM BUTTON) + (* ; "Edited 17-Dec-2024 10:26 by rmk") + (* ; "Edited 9-Dec-2024 21:55 by rmk") + (* ; "Edited 7-Dec-2024 12:16 by rmk") + (* ; "Edited 5-Dec-2024 21:10 by rmk") + (* ; "Edited 20-Jul-2024 15:26 by rmk") + (* ; "Edited 9-Apr-2023 18:22 by rmk") + (* ; "Edited 30-May-91 22:15 by jds") + + (* ;; "Called when a mouse-button is down inside the object, RELX and RELY are in the objects coordinate system. Decline the selection if the mouse isn't in the object. Otherwise, make sure that the selection is a point selection to the right. if this is a prefix, or left if a suffix.") + + (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) + (CUSTOMFN (IMAGEOBJPROP OBJ 'CUSTOMBUTTONEVENTFN)) + (ISPREFIX (IMAGEOBJPROP OBJ 'FIELDPREFIX] + (if (AND (EQ BUTTON 'LEFT) + (IGEQ RELX 0) + (IGEQ RELY 0) + (ILEQ RELX (fetch XSIZE of OBJBOX)) + (ILEQ RELY (fetch YSIZE of OBJBOX))) + then (if (AND CUSTOMFN (EQ 'DON'T + (APPLY* CUSTOMFN OBJ STREAM SEL RELX RELY SELWINDOW + TEXTSTREAM BUTTON ISPREFIX))) + then 'DON'T + else (FSETSEL SEL POINT (CL:IF ISPREFIX + 'RIGHT + 'LEFT)) + (FSETSEL SEL SELOBJ NIL) + (FSETSEL SEL DCH 0) + (FSETTOBJ (GETTSTR TEXTSTREAM TEXTOBJ) + CARETLOOKS + (IMAGEOBJPROP OBJ 'FIELDLOOKS)) + T) + else 'DON'T]) + +(MB.FIELD.SIZEFN + [LAMBDA (OBJ STREAM) (* ; "Edited 31-Jul-2024 21:22 by rmk") + (create IMAGEBOX + XSIZE _ 0 + YSIZE _ 0 + YDESC _ 0 + XKERN _ 0]) + +(MB.FIELD.INSURETYPE + [LAMBDA (FIELDTYPE STR TSTREAM) (* ; "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") + (* ; "Edited 29-Aug-2024 10:28 by rmk") + (* ; "Edited 20-Aug-2024 23:23 by rmk") + (* ; "Edited 9-Aug-2024 11:47 by rmk") + + (* ;; "Coerce string field selections to atoms or numbers, promptprinting and returning nIL if type is wrong. Returns **EMPTY** for atom and number cases, if the trimmed field is in fact empty.") + + (if (STRING.EQUAL STR '**EMPTY**) + then '**EMPTY** + else (LET ((TRIMMED (CL:IF (STRINGP STR) + (CL:STRING-TRIM '(#\Space #\Newline) + STR) + STR)) + VAL) + (SELECTQ FIELDTYPE + ((TEXT STRING) (* ; + "String should be a string, not NIL atom") + (SETQ VAL (OR STR '**EMPTY**))) + ((NUMBER PICAS POSITIVENUMBER SIGNEDNUMBER CARDINAL) + (SETQ TRIMMED (MKATOM TRIMMED)) + (if (OR (EQ 0 (NCHARS TRIMMED)) + (NULL STR)) + then (SETQ VAL '**EMPTY**) + elseif (NUMBERP TRIMMED) + then (SETQ VAL TRIMMED) + (SELECTQ FIELDTYPE + (POSITIVENUMBER + (CL:UNLESS (GREATERP VAL 0) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT STR + " is not a positive number" + ) + T T) + (SETQ VAL NIL))) + (SIGNEDNUMBER (SETQ VAL + (LIST [CAR (MEMB (NTHCHAR TRIMMED 1) + '(+ -] + VAL))) + (NATURALNUMBER (CL:UNLESS (IGEQ VAL 0) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT STR + " is not a natural number" + ) + T T))) + (PICAS + (* ;; "Convert picas to points") + + (SETQ VAL (FIXR (TIMES PTSPERPICA VAL)))) + NIL) + (CL:WHEN (AND (IGEQ (NCHARS VAL) + 3) + (EQ (CHARCODE 0) + (NTHCHARCODE VAL -1)) + (EQ (CHARCODE %.) + (NTHCHARCODE VAL -2))) + (* ; "xxx.0 -> xxx") + (SETQ VAL (FIX VAL))) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT STR " is not a number") + T T)) + (CL:UNLESS VAL (ERROR!))) + (SYMBOL (SETQ VAL (CL:IF (OR (EQ 0 (NCHARS TRIMMED)) + (NULL STR)) + '**EMPTY** + (MKATOM TRIMMED)))) + (\TEDIT.THELP "UNRECOGNIZED FIELD TYPE" FIELDTYPE)) + VAL]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MB.FIELD.IMAGEFNS) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MB.FIELD.INIT) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (3448 19023 (MB.ADD 3458 . 9047) (MB.DELETE 9049 . 9423) (MB.GET 9425 . 16088) ( +MB.GET.MBARG 16090 . 17759) (TEDITMENU.STREAM 17761 . 18428) (TEDIT.BACKTOMAIN 18430 . 19021)) (19067 +36833 (MB.BUTTONEVENTINFN 19077 . 20286) (MB.DISPLAYFN 20288 . 22347) (MB.SETIMAGE 22349 . 23517) ( +MB.SIZEFN 23519 . 25067) (MB.WHENOPERATEDONFN 25069 . 27018) (MB.COPYFN 27020 . 27478) (MB.GETFN 27480 + . 28441) (MB.PUTFN 28443 . 29543) (MB.SHOWSELFN 29545 . 31054) (MB.CREATE 31056 . 34041) ( +MB.CHANGENAME 34043 . 34525) (MB.INIT 34527 . 35836) (MB.TRACK.UNTIL 35838 . 36533) (MB.DON'T 36535 . +36831)) (37058 46874 (MB.3STATE.CREATE 37068 . 37932) (MB.3STATE.DISPLAYFN 37934 . 38920) ( +MB.3STATE.SHOWSELFN 38922 . 41233) (MB.3STATE.INIT 41235 . 42487) (MB.3STATE.SETSTATEFN 42489 . 43147) + (MB.3STATE.BUTTONEVENTINFN 43149 . 46872)) (47099 76218 (MB.NWAY.CREATE 47109 . 52619) ( +MB.NWAY.DISPLAYFN 52621 . 53484) (MB.NWAY.WHENOPERATEDONFN 53486 . 55676) (MB.NWAY.SIZEFN 55678 . +59614) (MB.NWAY.SELECT 59616 . 62426) (MB.NWAY.BUTTONEVENTINFN 62428 . 65640) (MB.NWAY.NEWMENUBUTTON +65642 . 66354) (MB.NWAY.COPYFN 66356 . 67323) (MB.NWAY.INIT 67325 . 68659) (MB.NWAY.ARRANGEBUTTONS +68661 . 70632) (MB.NWAY.ADDITEM 70634 . 74396) (MB.NWAY.FINDSUBOBJ 74398 . 74912) (MB.NWAY.SETSTATEFN +74914 . 76216)) (76365 88093 (MB.TOGGLE.CREATE 76375 . 77370) (MB.TOGGLE.DISPLAYFN 77372 . 78855) ( +MB.TOGGLE.INIT 78857 . 80497) (MB.SET.TOGGLE 80499 . 81700) (MB.TOGGLE.SETSTATEFN 81702 . 82542) ( +MB.TOGGLE.BUTTONEVENTINFN 82544 . 86748) (MB.TOGGLE.WHENOPERATEDONFN 86750 . 88091)) (88244 119170 ( +MB.FIELD.CREATE 88254 . 92989) (MB.FIELD.DISPLAYFN 92991 . 93782) (MB.FIELD.IMAGEBOXFN 93784 . 95266) +(MB.FIELD.PREFIXCREATE 95268 . 98820) (MB.FIELD.SUFFIXCREATE 98822 . 100482) (MB.FIELD.INIT 100484 . +102093) (MB.FIELD.WHENOPERATEDONFN 102095 . 103366) (MB.FIELD.GETSTATEFN 103368 . 107302) ( +MB.FIELD.SETSTATEFN 107304 . 111999) (MB.FIELD.BUTTONEVENTINFN 112001 . 114306) (MB.FIELD.SIZEFN +114308 . 114548) (MB.FIELD.INSURETYPE 114550 . 119168))))) +STOP diff --git a/library/tedit/TEDIT-BUTTONS.LCOM b/library/tedit/TEDIT-BUTTONS.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..da0fe0ff0e1cd79eb31c6e15b047fd31ff9d2196 GIT binary patch literal 34396 zcmdsgdvILWdEf4Wq$tXQupmUy5KUb{vI5W~jJvx42+B=x_W|w&cK3q23lWegK_nLv z074|ohh;Z$Mo#Rw?lfs5+mavZB$m@UZd_-%AZDV6wQ1Z;&3H0xXE+|p(`njCGSi3u z0ORSO7W@0Y@0@$jy$f1QnyF_>jTZNwd+vFD=l4C&xr6z_lv^nrnsQ5pLvCftv-ZzA zxf$nZ!5VNY^+L7e)@BE+{ndh#uRGaNBsuHU3YI-Gv}@NOm5@WWdLeHOq(%m9xW@ z z?ZWst`Mh-`e|Xp6tTk?V*=cLm8nbG%g&ZzMt@^@j0T&r7U#L+^+R7Cl!QYex8o*!M zDtIN!#r^SOp<2L|ZIug^xq7V*3Mk`#gzxF~AuEyE8H;r}cgOJWRATZR{pFkBD!Xx? zvxCyF?Y)*bbK@U3($?>BmSp~}V%NsDnVxu~>l=;VUhY2;|86PqPWgGty!rB#_z#22 z9|V_wTyDI6CH_W3vbFZM9e0Ln`vASyo;h>lgEoDrT{}v$oj(QU$pVUsU!a;xqnLtB)@ml*%3L@BfV1VLv1H1-*~G zrfYqzU2$gap>aX#Z*a!V)?hFDcDkc$)Y*w4Jh2At z^boU$e4$hTvr!x(1^BOcH3oh+@1wnp7lXZj1qY7iqldZpUrsLCz_?a8i@pn0?-TY6nL99EWW7UK-I7xQ+XrVr| ztKyb0H!1WT)LgAoo2)`5Pk*J=$fcWXXRIpPJ7GEaJ#0C3$1UM%%yRR>?M88hgp4&y z3@&9=3uVWx5OffGs}^c=r8+K!j}hV0YcBF<3sWAmyfg>~%|If(U7xFhd22>^yP-)u zb6+gBee!D8uU&~>%6*Rzaea^c{dO*G{eJG1oIs%FmJPm5CgYN+)t3`CxueK%dTK}e zGk9;q%C~-XQgKLm!`YGBI9=rH=F@)W=DYm*+taO?(x1h;)^==Oy{~jF#tpf;9aqmZ zTDzGAaPiap8-KdBccv`YZAm6JOjXrGCTPw{f@En?T~{B;|`V&9cpIj{e*#l7w3-*|g^_foGCS8jE?J;XK-TZL-Xs{+TyG`pJ3 z)xBI1d=Z!}3rwY??UZ$*LO`7Y00EPEwGEfE#Bhl%<*_upCkg;t0_<`Y7dGGxDgu@S zKoYAbozaC(xz$>I)-B|aKLymJsuZTpDPaKoN5Ki)JZcyn8PV`!Wx&S+ z&>^7#z=J%Q3~?-=09~hTx&~}!0HsQfNP}nUOE5f$C{}8mP)Oq?06yjS)k+HEp)=BHsG6JOA{GwI_F zu99|FkyjH_ysWF%Ge*+-v1HG-$(Kskb~e7#yHN?QJEe_3 zUTJ=J@(rW(C%-&dbk@42@9S|jo8tUH#cYI9Rl?mSkCL10*ILOGx(GZR+D z)XLIYWA?(*b1R?73Q>UfaszT$VYP}=hN=(JRh=YS!g?JjuUx#ia`t)aIeOi?c=5;7$rTIv<8CGI9j`&9RU=JI{o1Tovij7yek=KS-n2bRuuz%F+3&ViPT%iV$7uLVWy;=W-$zb)Mm#ev(8@;Rfn;ZA$it(Epcjb$T z_|4ugah{$P^f?{S8?y%+*jaR^>X?bjEXW4PmiH>ZPzMrPS#PeA&w8NJjFqcbOXyV9 zJz9jcHzHb#j}5S%g+gm%d?M&!r@=UNHmp?2FYFfMtrw|`Ke&3fRIe4C ze8C!z6f-tvWoIyU$N+9eB`(Z*HJ6npa6;VA2lr8kW1Y2DsB?9oWnV3DpQ5@eGIf0a zZn32prONYZ;u`j-p3afTBtdi`DGOG>!_*s@e!x9Vh&MHb9$U}^X*%?sO?S$~IT~ga z7DipxgLz7v5 z)a=qzw92e}L2|lW1_{n&90-jJbbhoGO5t%gUoTqY5spqg*kt)wto|z0++X_1231JO zijF0b1m|!8;9O>bG!vj0ViL2lx8ltf zs${)Dk3GwhImTA{BWC=TV^U)z5F)WS~QFCd68awN5NvYXSL1r!S>{eAmXHg z#AUhdQLwttm`UQUSMQn3Ir+71#rwK3Sr}|{tVoiF>{=^=-4{wk<)d_8uY#Em&w+;m zf!Gx0=RnsnNq+az;8H9-!{7tX3MNz{MpVe_AtG?qd?>(^qa?gMOK|_tBm=-Tv27<4 z@nXa6i?w@Ia)Pl#B`5skZ7OA38-0TGFAy$z3~GiMA+4Uh7kyS)!h8bu%i{~`Wq#p6iksk*add_|eok|4KwlO7JUnU>f=E$;h zTt-P}nx~VmI}+Z0s`Qtf*q$k^-TG^}G+y}4Mm!nc?v(k#?nKwd&1G7rq_sKqvNu-; zTah)PI33hPESI_k^RHYS7Lw=3fK&b2xXtT^lfiFwGOUCrWW`eh+{$8ea>lrjsF`2>C|Nk?szBV8>{HVMdM& zb6Q6t^J*PBWJPAyM<=a%*d(`T?kPMSs}uUXQxU%#1Fl}J^FX66CB?*J=1j)pkYTf{ zjX+2hNmZ6)qctF)yZ%AQvY~8BmZfzED)!|_5(Bi{7!^1fd9{oNf+m?$q&!%rAils< z0;L3UJyr%3Iky6OCIvtK zK{h!oI~%>+ze%{qHtu4$=8h**+n{Qma|4K4e^_pq?w1?FtnNiAu^7tfb>dBy9v$d@cO52PUs~&L;Bmku#P7o8-5`F4$M8ZiOjzC@trmzqO zra%~Cd`ywEj?IuMfLu5eymjRn2TC@KgQ5$lxwhfaVHt`e2|yGOTvbLe=ujax_~G24 z97iCKe5rP4dsSlq3@;9AlDQXQE{P+ zll_l;HtGs4A|suIe#7zy?MLZGB=d`kW04_AA&44UB54~YMdMYlH+d6klaV~;OPFwo zN-0=hTpD;4W|kXH<*Bj6B{7^7a`}dwQ|B%%n}wb{+mOlz&(FU}c>b6_iyTF?+nWdSQ#V=W%qJi%L~ zaGbM}EGg?-L=@2#9)g3ZD>;%7%X*f{So8rUN)lQDiN(;3cVHnMmImYz1rnlh;EtY7 z!W9h1VV@JT34-R2(HQg$&z-#em|0v|xD$~8)RK^4JgJzB?V#HMVbTvOxX_Q3X1BIEHzxkk-CHRX~aTr z`H?JKFe3yL%%EEsVLzi3iI9R(Wx>L_;lb72myuQ-*ZsX8O*c&r|B`#w!;)+mPEicx z1}OwpkQ0_-u5{^PFTP)ku)5d;Rl`M3?pc>`5Wa)1JK29K*5(^CrSUA@h%vLk_`&*2 z1i-k93JG}qxB(wFU~>vm!6taHph1x9Be(-fR0?w-1?XIWEgu)L()4wtOFkWGGpB++ zQIwgX%gTQQElx~2hGY{q*$JmccOcXmEe*6nv8ebaEl@hyRD%03t3Wd;E&!k&X>f;} z2D>Cn_#~FhtE;VLw+t+pq&zE|EH#a}2CWnx=#EZ*4mPXpfmA2ja`ItVsosRe@vYo9 zR^bQEZ+vX^)J`%~=JL}bCGce5%M5i?O%|GE6Hm^RI%jc$VoOw4t zgP${;=%|dOd;zzs&hZk$1}y}P_!1#dDv$_81Qa7sR2;OyL1$r4hs*~%6Ul=lW{7|Y z#~%b*n6tEeIEocQ@?m8B!=QYW2$|dYvwuubUJkNG09o;S6OhrYfSUZ(0OdSgyM!1* z6PUrf2$_|N9x4j9FVcEK^n zqvU+WQR3;V0wYbqmrX(E&u}K@!jo8ffQ|@9g(Qes1z2iW0AA=zFdiZS;2!uS+Q46Ngg^$F zVu6FaNhG~ZVQun@2m*omM88F*Ks**H0u0ZJ{qxv%1-Jnz@zv}x`NPsUdkp0VNW9$W z@2~Zr-Z6Wu%HuVAjF%_p-)!AKdu*03IgvB;NP@~8JUqSgYTs;CD&pL0U3IpLkzWA3 zOpI@=DIxAOG$B}a5kn>d)&lYlpbf@fb0WzAjcg{1mryiCeEy3dJ{vO}gnO~YKQw$S zl*@Qy@yi9giNgA#>Vk+P(OO7je1;no0C!QUm!HC@^}y=+-1ksKTLbL_QH09a&6+m4A$OKPMe%Q(59b zl`zTcDnWc-*cOlNoOH4|1aKeizLy0lp&}(Q87wlgc1I)kAC~uC;Xlm>M28G0jj0QA zR~;OOQ(0Z)AFj3i=#KdADZXcs2Kti7-G(2Pm)6PR<2G%gT67$NA>4IivCr-L1AZtr@^*6aKDRmEh%fFJ{_5=q zui!$biD~rrbE6RL<@F;pZ7%}B_Whc-_c26?8 zfJJLnzw$ydCCiwD}?;NoL#@6p8KqgUShcziL{_J;B7unZyv!wHC23MWKs$-vDS&Jhii$iN&B&JmS| zGGHyC9BGQP@~VhFhr@1J4;TBFu`;~?;8_pbYAxI3M+4B^I`-KvG zJE~1_m(h5CiY^o5DoJ-T5#ppKKB-GmMpZDzz@7={ABP=M+uA`L6f2>kaK;GzeJ>~i z#~`+kA$&x5<0zbI2DFZXHHsB-l*asMh2o+|DQZn!qA)a^d5ocej1of$j0K}3%s3T8 zp!ig-41k}3v6-)Zz|WAeEWq{*Y!+-U%=x8OAgmbhuIFrNIl!Zbjc=i2Wf;!FG#B@>UAQ+b};%QB)@D6%-H4nhtEm z%D}6fLlA$&>TS63NxIREn-i!gko16e1pOCTFD#g|(6AM5TmwqPa+ zUsu(V2ihmnMT%p*Y_^bW5h?N<`*Z>v3|oNUvsBT8Z@FRyVVJ$4qO6o@B$Q@kdwa%N zOOz-K6mf=c!sQiN$)uy0AyV3U>q8np59~=%FrpwR^L+qs*!~noGt2=3O@onwzO_JZ z>3K*=0Y!(Txei;fQur~tTSjU`jI$qs__B@VdTlaVe~^cIbA7jpy8nIk_i7i(`>-l| zb@EN46%>*NrI`Yf5k-M0<++LxNC97u8CSuAqsklV0a?$m{FOF_5mSO8)*#3JiRHHD zLDWNu>LJUflrkp71G$kike!WXRLZBsQ*Ei6@GW)ZsGxjUtME$B;0g@Dmt3{5>x;E8 z(fD9M`l62-B$0*}CF(Y23I#)lC~?Fihh~zTTt=ilVok~Ik(;ZMS+JAn6R{6sUJRX% z#k)--;s5?Jmwh)`yl2MizPWy4T4cJ-R&@qjCQ6HaZFe=<+wJY`+SsxCO6*VdW(lvK zg&WAFp6s3wndW-sI_+AJq*aw=Z(?z8^WS>iMoVw5A9c%0d`$Kxz5QJq+jlpgBe~17 zR?F{RU$ojvu<|TbjEG~p(EW+U{mmbE-EL)?_jWF78TKD|2YS);vJympgf4h{yuM`b zUJ^o|++BpX_BXuVMlt^G>SpUx*j0fzR=PZ2gxvQSORph8%`=6z8-~>OMUmP_U~7Ip zPBPgrH+{J6jWi#i2$pU&65cTPfdX0nCkt*@ZoTOBdVQ`aAv|`7HgEJ9_#eZmPHQRMLHhH|8%KHM}wj9eVB;$y9eOp}7`N3$QNT6M5RS@Vb# z_)Mt46!>O1ftIBzCu(XUX(p7}jzTDH)eGkU`&Pw8rBHHzno<)ud+5GHIE=`bQIi2o z5~24aavNZZc7^!7KLa5+xB=E9t_S_|lhR=I^Kb``(J$mIayuE)0&OC|_85S=|Aq~* za^502%a>lj=R>j$N(;~jmU16_V2}u74;XO3B(NVRs3wqK!pO^TtdWMR9Vp1zDD*n9z-b{ot{U6;vJjj@VIx3Q?b7T0woropE{F`cx1j7ii??Rv1`! z^#SANjY%h$UEAiuWJ`^D@5hepQ+w|(9SPq!m4G()Lt?OLgof#*h_f2O=0A{ON~HUaU%;#@}Pl5rU~t`l(>%li9sd0u^AayObQ&3{9({O`eY z2`v$uZ!pup1dS_7s8Oql4WtgyT9l6h`#bF1r2hFDFU>TLEC`n(`|+a_gf&1LA2Ep( zgC1}LQ&ERWX2Ak?nWqqZ1J}_jF+2nAeZw=taLR5ThpVXVG=a4ju0DcqX@Q1%)Tzz6 z*gRDQy&)1D!TtpLctJfR36+Fb$x31>9ScIBuQpeL2yz7cq9EvrmFW>9oja+}lBvWw zb3;&4->oHh_9+$(WG};8^1K;@TIU!E05*gKO7-2eh6fB=u?nQj1D3u+V3q! zALfhDE_&LO4--DL*j#O30)qn45ZfS#h=i`_0D&Bo zQ1LZ!cW?V+`txnQc7;d*KENlNDn5H0WpAz z`39}-u*68SqxD`^LxZWM8Db+B=H~?v?KWq%k<9G?YVWCR+$~4A^e`Ql`=4(9P5h~V zQsZw=PM2={^yd0dZew7k(*KSaT*QXoo-SR_UVqa)a~(%S%r{%^&Gr8xhv}62zq|V8 z@;j?&F+NTMzfmG0Y6H%xJQzBYh&a~7=O79N<2DEigXE{ZRW=V)Hu5_TllMmfgb6C5Aq-u!x7wuecm z;ml8OwjP(i3=lo-O6e!-8(z2a zB5~W}*B86n<-~U@XRg1~{1S)_QfEj;A=x&Z5XJlyz)kDsBoCR|Gg+v^3BdDE0*Sfo z7_qT=o%tR~xvD%nx(ktv!{OH<0f!Shr7my~^1MVN&&6gRKJ-YVJBX2)JxbRB;bE-< zt15-Pe7;;ono)2AkA)DVvhSrRLe@9^r{JFmlyMuyXpmQ{g76{((Vs1U$_E3j$1k5m zP2WL4+m(VF7)Ol70f^h8XxoC46-H^ul;ZYKvE2|+1Vq4$4Lv60^#}orp++iJLZi;A zK{(tRn3sk?rvk0DK&R~MZ%i73H$VHLyV146TlD{ex9Eo)gpk<6b04NYo+BR&gJB6Z z-0&NzhBJZyp)vaY#(dmv71B11xZ|$L?*YSOt=*H?c4QeXxZ$T_FCo?qK`w&mn}4V_ zJAJdL+y?q@wm2ygE1({1NJLQKz9Vdv3F#%zFLM2u;MQD** z@3@DlR9hhk$IX~qJ-?U?9&ZG={y*Iaq3b7JMf3%#tDk%R`L(4jH$$l09e%L)m+IA< zTg&x#BGRidXBMFf^C?wRFy=xn4NbeZg|HwbH$Zhz=0V1>EHBB8d*wV$zM;(#A}=vU z3BEa4wP5rLR#0WWbVEod>U6>Mn2C52lKSTCNu$Oi{KckVK_ z1>r`YAT%r*vg)<5%oP~j0Y0Aq&S-qTpYU1sQ}6W=ddri8%nomTworiBFsf~d*ik_O zR?rX(qx;5!BsdrIo3S;F9FGb^Zja9q$}%*KpIaQWMf`+WXQ2ez`d6_Xw~1-yah_#E zO@IF}61G|5Cc#_BG*^!?-GyVC_soi&o@Y@qEUTbqPCC7_(fUv*l6h`z8$y`{EZ4tx zoA_r?H6M{>%CDWCBZyv+Sm>xfNY35dFfDQxKd^-lnxN?6AO<>OyAe}@U+WzOKigXdKi>xBlspxRsV3d7BNU$0 zJ3kVcjSAtuh?z@A)4z|gIpj&&DjZsoCi7^z4uwRM!9zu1gLXf&{cjx-{f)-Trry$U zK!rtrz41-8$zgAs$=%@K0<+2ZT=L;nf#f*f}rc=TPzyq5| zajh?dLq_;aHhoU7T9Whztus27l+Ga|%MxzMutEpCk={m;);K5Jzk^~(ClZV4oWfeL z!Hwdvarzr#^vG7t&smEkb2Y1v>JAck;0vS0PVb6-NftyDpl_hSY5ANrF!2VEE5qFL zfOg7W{I4aoRW}rN&Fg6El#RQ10rD*R+04Y`bN5Up?fWP!<)GJ(DCn8>r`(o0j9Ox= zgB1!^MH?ZThvN-7Bb%w`JBYc)fuFq;a=o~Z&)TFom8Q40sSaN7mu;LI*=`XmjI*fP@2;`rFOm4$7If$<*3=F{yjWb4YEV5A?Hn2&($OuEx zV6bHUf`jUe_k!m6tscVh(XfX7>=OWB2Q#BSaU=l55aUPy*?}dq=PO5A6~aIOokn1! zCld}&dxv5^O$I3g@tYGAVihaKd8Kc37vnfT!;y`^+IsU(DNEdyTUu{7m+ANW6kh?T zrX%*!>i9dEM>Ap?0RcR_jJYN$V&+HH>8|)T!yFwQ&Tc~K9Opz>A#h#;IRI0@m%?rd zcgZOOuPshj!!eJz#(CxX65+4BjhLJ?d?aExOt6XH9x=EjV~oAty`7$f)HnX>Fwx%-_)1!nNdThl6GC!nr@Ai>w$UiX`BDS^1aT^`O_ z{(#rpD?XfW#VObhac#2ke_fLB1e{Qepx5HwDO8vwxwI* z>`^zeyJrR~KONm}LO5KuyaAWTvY;wF9rZGdS`=$M&vK#^%9<^)0b;6dt}3Vb38j(MYFzH?4B?^dw0 zhmQ3I1Hg%&IBIsToF%s#pRfyRh3tdI;J z;0mAE+m-Bz8EbxCR-2HxtU_7Ra@`={U@4Umf>EJ}g%I@`5=%rFJS3P1p+cb1WGObo zD4Aj`AX^z?1h$$P-N4xLo%9>$1NkGZ=aL2!G&e9TSwyeocOYy2ob1o4dc*wOc~&+= zLO%Ba(vIJ!4n6q&P0&(RM2#l_1cly-1=?t;h#vf=r25hp#@L|2j#e@q(rKT;zICjx zE!FhM=8djchW$W+o_$uYC}to-TgYv-2x_UBgnKCr5klrQI%xwl7w|84f0bn4;& zu<$+;_@+%=95T6~i$e?-d4kNizEyml`Uf~F6{c`5^v2yLI$~; z&Ee#`-@)qc5*Glz#4;&oa-O-7JhpT4?bT#**W~BDzH2*JHtV~#bK_Sby*R|9iY(!rVUA)xA8R$oC@Wbk=t?vdjNJT4H0yfn-UDN`P-G>^18DXE=NFeu}29jtx2QxuNl|P zM?Gbj{?}f&%KVC)V)Z$0)#ewL5xOC7D1BaTWLvUa%MR=kfHxBju-HN*iFg7@0+G)u zfwxCQ4%(&|!sj&3N%7$bIynxWXBtfT>OBZ?*s0MO{j^Iz1$jr*e!x2VdRIf#2Lu+Oli%e<%&+Ey8XC*@gn`(J;i= z(c#7^IPMMhMqitfl`0=wNEsV+5EJ5m&BKUvwbnI>QfG2oCi1tMpIw z#XQ(h_vJ$ijdM%li93Dn?4^_V#No-a*2)VfpI@@homyQweaU2;fvDnZqG%Z56O4!o zrxYS7pz;xE%p4aVuoR9#EhZgFgA^-1z6tX7kcHT=z_S@3Rw9W7+NGU-_#g-(GTsPq zE56N$Ho>95=H0_PE3Y|~_~xs;2C;QQf7`A#-ga6g2_IX}GZ+}}84$su&`N{tRT1ucCaxo6VP3o3=V1;x#9$aH)N!xlej{D&h5HR~lk6X-gVj_9De+ zjiJ+JNRm2PL7g@#5#H@&&pnf$_V(a|Ev?4|;Pqq1aV0M%7EfgG}}bJQDeUZB7idbJ2T)C0?8R@q9%4{0DN*U z0saVoVfafMd<87dgyJ-&N+dM!DY*c!c7i3;vGC_@=<9g8gOKW=-tZ@?Z1mH|S%4uZ zBe26ld-Puc0}L1fqj4X~eFN^OCdkfFd~t~z&H%9NWM-AmS>ub9XTU<54b<%1~0VNx@712&6ls-T5(^v#f7hpK*_oF zr2E2qayv}7Gw$k*g)6rTenV83vGMbo^ZJ$d{+(DWd$?s{>!mGFB;6{0p-!sDhGFHS zO2cNO`4fP(QZEvVqYtmb?F80k-orMfvZg@FkkDY_gQUELpbuEpf<8SY%T4DnN95Oh7R@*MA5FATW$g2d}dL6NP(vgJ$$kX;e-$sgkuc5c$ zNQ}G;W+8RMOslGZupSi0T#!`{Y*t}yWHfk+e(=8Wfw@Yxki*f1*c6l(VBt@34?yxK zUgCeW@9ar@t?%TTb@uWLra26@m{61X1i?oK=o`Dc2HY3U zuPwc>1U==_3cfXX?m6qy@)FqKg_U!cFIs0-&NePmB63_--y^(u#Il^zl>4A{i9*BMpXIkNGMhDPyY$KP zP@GWPDgMUYMZ_&ygEZ<@L>BQ!FL6&cWk_K3k#zh~(i^T|=-EXn_^UpU$>Txs4*Dy1 zvOI!VlA)l5)WF&bjfF)A##$_;loFWXV&Sn-IFB`Ck5p_-Z+9U&kw5Nhw#szM;awL zpOZ#JQIJBh$KfR)YG6FG+-(*I>Nz|=#+)~PPOP-@4Wlcd;Q)PG&;a?XH73hszn6i zp#O3o>b@i~!ia0be@&$C=*uDBT2P0k7bz~VgFah+hjULpSL2&4c(6TEDIT>TEDIT-CHAT.;14 12223 +(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}tedit>TEDIT-CHAT.;16 12363 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-CHATCOMS) - (FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN) + :CHANGES-TO (FNS TEDITCHAT.CHARFN) - :PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}tedit>TEDIT-CHAT.;9) + :PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}tedit>TEDIT-CHAT.;15) (PRETTYCOMPRINT TEDIT-CHATCOMS) @@ -71,16 +70,18 @@ (replace (CHAT.STATE HELD) of STATE with NIL]) (TEDITCHAT.CHARFN - [LAMBDA (CH CHAT.STATE) (* ; "Edited 22-Dec-2023 23:57 by rmk") + [LAMBDA (CH CHAT.STATE) (* ; "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") (* ; "Edited 12-Jun-90 18:00 by mitani") - (LET [(TEXTOBJ (TEXTOBJ (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE] - (\CARET.DOWN (FGETTOBJ TEXTOBJ DS)) - (SELCHARQ CH - (BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL))) - (LF NIL) - (BOUT (FGETTOBJ TEXTOBJ STREAMHINT) - CH]) + (LET* ((TSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE)) + (TEXTOBJ (TEXTOBJ TSTREAM))) + (\CARET.DOWN (FGETTOBJ TEXTOBJ DS)) + (SELCHARQ CH + (BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL))) + (LF NIL) + (BOUT TSTREAM CH]) ) @@ -212,6 +213,6 @@ CHATDECLS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN - 3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333))))) + (FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN + 3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473))))) STOP diff --git a/library/tedit/TEDIT-CHAT.LCOM b/library/tedit/TEDIT-CHAT.LCOM index ac40324226dcff04bb3775473b4d31a0120828db..795bc5b740ffc8ddc7967f340212f059b640c134 100644 GIT binary patch delta 446 zcmeyMwNPt9gs_ROS81NEk%5tkf`NgRfvJ^&<-}~2$tFxf^@e7e3S3G?#t0Qg##RQ# zR>sCk3Q0w&$@#ejnK`K`3aJ$ZMa8OC3L&m8o*~X2jv;zLBFN28Au~@w$t~2!M*-Ok zJv}`og_Oh+phm2QTPSIAX}Ed%xXL;QxjF*PR8TU);>gJgOls_gW(tNz#%7cI8D(wV z{DLuDps8RL5ab%>=^q-b>jE@OK}o?#*Eg{e;$K4xpl7X&%#;+kCMz+iFd3R|c4vCZ zTyF?8CnCh($x9(X!9XD-I0WbpUj<-JJv0>k&{fZ!yL zAR~hZCx|J?$mn@e0?c$s$>I1gYrlu*NhvOnlt2#Ghlv>i9u5#5gNCWOf|Gw}h=Pf+ pLJZKq@}7_YbaC}@1zKcet`Otw7~~qF=i(pkr(kHdc@NtbJ^(;FYHa`j delta 558 zcmZuv$x6dO7)}(57LgV&;sQTGp%oI6X`*x#X_`z)ByCDE-Jq9l*lJr#^&%pD1*JD{ zK7-yp_d&dP>LWN!1VuWBnfYh=wwc$X`O#B#Dx+Vni= zMZ?mmbgHOHhzbb(o>w%iDp*qlXpTFro585p@3f)SZ456vw}*IIkMB*`T`yOF07x=z zzv$>SN~#okLxz?sIS%}Vlq5-jcH@rWEThtdWHgbp9b$MyXPE5J68!=^RPw}hNbONL z>-U=D#`r$8^3M<`2%+f}zdtGKo*#+~+!}7)PeLMB_*wKRB1m=Q}Lbog@ zT=YoUc1yl!GMym6v8a#6Va!Ous*L56KQgBlzsslJzWC48iOd+P)XiRi4GILXK3#y= zAhR+F9OgN0MUQZ-%{JB-L!9TV*>*6^wEJuGmk+Bw+lel=V*Tj+xf`=)QYNgqgr-5( lEm26Np&mZWLbpjA!dT+$Bh(GuBUCcoN`Xc6Hi*1$egoZ(jf(&P diff --git a/library/tedit/TEDIT-COMMAND b/library/tedit/TEDIT-COMMAND index c25b455a..64c25f42 100644 --- a/library/tedit/TEDIT-COMMAND +++ b/library/tedit/TEDIT-COMMAND @@ -1,15 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Apr-2024 11:55:17"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;87 53604 +(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}tedit>TEDIT-COMMAND.;133 49278 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL) - (MACROS \TEDIT.MOUSESTATE) + :CHANGES-TO (FNS \TEDIT.COMMAND.LOOP) - :PREVIOUS-DATE "21-Apr-2024 10:17:38" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;80) + :PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}tedit>TEDIT-COMMAND.;128) (PRETTYCOMPRINT TEDIT-COMMANDCOMS) @@ -247,8 +244,9 @@ PROC]) (\TEDIT.MARKACTIVE - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) + [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 @@ -257,193 +255,135 @@ TEXTOBJ]) (\TEDIT.COMMAND.LOOP - [LAMBDA (STREAM RTBL) (* ; "Edited 21-Apr-2024 09:08 by rmk") - (* ; "Edited 2-Apr-2024 15:35 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 28-Nov-2024 10:01 by rmk") + (* ; "Edited 21-Nov-2024 11:51 by rmk") + (* ; "Edited 13-Sep-2024 22:34 by rmk") + (* ; "Edited 26-Aug-2024 23:26 by rmk") + (* ; "Edited 18-Aug-2024 23:05 by rmk") + (* ; "Edited 2-Aug-2024 08:46 by rmk") + (* ; "Edited 13-Jul-2024 23:13 by rmk") + (* ; "Edited 12-Jul-2024 00:39 by rmk") + (* ; "Edited 9-Jul-2024 18:02 by rmk") + (* ; "Edited 7-Jul-2024 16:24 by rmk") + (* ; "Edited 3-Jul-2024 12:31 by rmk") + (* ; "Edited 29-Jun-2024 00:08 by rmk") + (* ; "Edited 18-May-2024 16:21 by rmk") + (* ; "Edited 29-Apr-2024 10:58 by rmk") + (* ; "Edited 7-May-2024 10:42 by rmk") (* ; "Edited 20-Mar-2024 10:59 by rmk") - (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 9-Mar-2024 11:35 by rmk") (* ; "Edited 24-Feb-2024 15:33 by rmk") - (* ; "Edited 21-Feb-2024 14:49 by rmk") - (* ; "Edited 18-Feb-2024 23:35 by rmk") (* ; "Edited 24-Dec-2023 09:50 by rmk") (* ; "Edited 22-Sep-2023 20:40 by rmk") - (* ; "Edited 16-Sep-2023 22:48 by rmk") (* ; "Edited 30-May-91 19:33 by jds") (* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch") - (PROG ((TEXTOBJ (CL:IF (type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM) - STREAM)) - SEL PANES) - (TEXTOBJ! TEXTOBJ) - (SETQ SEL (TEXTSEL TEXTOBJ)) - (SETQ PANES (FGETTOBJ TEXTOBJ \WINDOW)) - (SETQ RTBL (OR RTBL (FGETTOBJ TEXTOBJ TXTRTBL) - TEDIT.READTABLE)) (* ; - "Used to derive command characters from type-in") - (for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS))) - (* ; "Add the pane to this process") - (until (TTY.PROCESSP) do (* ; + (LET + [(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ] + (for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS))) + (* ; "Add the process to our panes") + (until (TTY.PROCESSP) do (* ;  "Wait until we really have the TTY before proceeding.") - (DISMISS 250)) - (RESETLST - (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ PANES) - T)) - (LET - (CH FN TCH (READSA (fetch READSA of %#CURRENTRDTBL#)) - (TERMSA (OR (FGETTOBJ TEXTOBJ TXTTERMSA) - \PRIMTERMSA)) - (TEDITSA (fetch READSA of RTBL)) - (TEDITFNHASH (fetch READMACRODEFS of RTBL)) - (LOOPFN (GETTEXTPROP TEXTOBJ 'LOOPFN)) - (CHARFN (GETTEXTPROP TEXTOBJ 'CHARFN)) - SELOPERATION SOURCESEL SELPANE) - (DECLARE (SPECVARS SELOPERATION SOURCESEL SELPANE)) + (DISMISS 250)) + (RESETLST + (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) (* ; - "Set by \TEDIT.BUTTONEVENTFN in MOUSE process") - (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - do - (ERSETQ - (until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") - (until (OR SELOPERATION (NOT (FGETTOBJ TEXTOBJ EDITOPACTIVE))) - do (\TEDIT.FLASHCARET TEXTOBJ) - (BLOCK)) - (CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - (CL:WHEN (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE) - (* ; - "We got here somehow with the window not in sync with the text. Run an update.") - (\TEDIT.SHOWSEL SEL NIL) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)) - (\TEDIT.FLASHCARET TEXTOBJ) (* ; + "Flash caret while other operation completes") + (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.") - (CL:WHEN LOOPFN - (ERSETQ (APPLY* LOOPFN (FGETTOBJ TEXTOBJ STREAMHINT)))) - (* ;; "") + (* ;; "") - (* ;; - "Process any pending selections from \TEDIT.BUTTONEVENTFN, here instead of in MOUSE process") + (* ;; "Handle user type-in") - (SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL)) - (NORMAL (CL:WHEN (FGETSEL SOURCESEL SET) - (SETQ SEL (\TEDIT.COPYSEL SOURCESEL SEL)) - (* ; "SOURCESEL is new SEL selection") - (FSETTOBJ TEXTOBJ CARETLOOKS ( - \TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (\TEDIT.SHOWSEL SEL T))) - (MOVE (* ; "Move source to SEL") - (TEDIT.MOVE SOURCESEL SEL)) - (COPY (* ; "Copy source to SEL.") - (TEDIT.COPY SOURCESEL SEL)) - (COPYLOOKS (* ; "Copy source-looks to SEL") - (if (EQ 'PARA (GETSEL SOURCESEL SELKIND)) - then (TEDIT.COPY.PARALOOKS TEXTOBJ SOURCESEL SEL) - else (TEDIT.COPY.LOOKS TEXTOBJ SOURCESEL SEL))) - (DELETE (* ; "Delete CTRL selection") - (\TEDIT.DELETE TEXTOBJ SOURCESEL NIL SELPANE)) - NIL) - - (* ;; "") - - (* ;; "Handle user type-in") - - [while (\SYSBUFP) - do (SETQ CH (\GETKEY)) - (CL:WHEN CHARFN (* ; + [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)) + (* ;  "Give the OEM user control for each character typed.") - (SETQ TCH (APPLY* CHARFN (FGETTOBJ TEXTOBJ STREAMHINT) - CH)) + (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.") - (OR (EQ TCH T) - (SETQ CH TCH))) - (SELECTC (AND CH (\SYNCODE TEDITSA CH)) - (CHARDELETE.TTC (* ; - "Backspace handler: Remove the character just before SEL:CH#.") - (\TEDIT.CHARDELETE TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (CHARDELETE.FORWARD.TTC - (\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (WORDDELETE.TTC - (\TEDIT.WORDDELETE TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (WORDDELETE.FORWARD.TTC - (\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (DELETE.TTC (* ; - "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (UNDO.TTC (* ; - "He hit the CANCEL key, so go UNDO something") - (TEDIT.UNDO TEXTOBJ) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (REDO.TTC (* ; + (OR (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 TEXTOBJ) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)) - (FUNCTIONCALL.TTC (* ; + (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 TEDITFNHASH] + (CL:WHEN [SETQ FN (CAR (fetch MACROFN + of (GETHASH CH (fetch READMACRODEFS + of (FGETTOBJ TEXTOBJ + TXTRTBL] (* ;  "There IS a command function to be called.") - (APPLY* FN (FGETTOBJ TEXTOBJ STREAMHINT) - TEXTOBJ SEL) + (APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ)) (* ; "do it") (* ;  "After a user function (that is not wheelscroll) no more blue-pending-delete") - (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them") + (* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them") - (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES) - (MEMB CH CLIPBOARDCODES)) + (CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES) + (MEMB CH CLIPBOARDCODES)) (* ;  "The FNs handled the selection. should preserve the highlighting") - (\TEDIT.SHOWSEL SEL NIL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)))) - (NEXT.TTC (* ; - "Move to the next blank to fill in. For now, blanks are delimited by >>...<<") - (TEDIT.NEXT TEXTOBJ)) - (EXPAND.TTC (* ; "EXPAND AN ABBREVIATION") - (\TEDIT.ABBREV.EXPAND (FGETTOBJ TEXTOBJ STREAMHINT - ))) - (SELECTC (AND TERMSA CH (fetch TERMCLASS - of (\SYNCODE TERMSA CH))) - (CHARDELETE.TC (* ; - "Backspace handler: Remove the character just before SEL:CH#.") - (\TEDIT.CHARDELETE TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL - TEXTOBJ)) - (WORDDELETE.TC (* ; "Back-WORD handler") - (\TEDIT.WORDDELETE TEXTOBJ) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL - TEXTOBJ)) - (LINEDELETE.TC (* ; - "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE TEXTOBJ SEL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL - TEXTOBJ)) - (CL:WHEN CH (* ; + (\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 SEL TEXTOBJ))]) - (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))) - (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))]) + (\TEDIT.INSERT CH (TEXTSEL TEXTOBJ) + TSTREAM NIL T))]) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))]) (\TEDIT.COMMAND.RESET.SETUP - [LAMBDA (TEXT&WIND STARTING) (* ; "Edited 17-Mar-2024 18:54 by rmk") + [LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk") + (* ; "Edited 17-Mar-2024 18:54 by rmk") (* ; "Edited 22-Feb-2024 23:14 by rmk") (* ; "Edited 5-Oct-2023 22:41 by rmk") (* ; "Edited 22-Sep-2023 20:41 by rmk") @@ -453,21 +393,20 @@ (* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing") - (PROG ((TEXTOBJ (CAR TEXT&WIND)) - (PANES (CADR TEXT&WIND)) - (OTTYWINDOW (CADDR TEXT&WIND)) - (OTTYENTRYFN (CADDDR TEXT&WIND)) - (OTTYEXITFN (CAR (CDDDDR TEXT&WIND))) - (OWINDOW (CADR (CDDDDR TEXT&WIND))) - TTYWINDOW) + (PROG ((TEXTOBJ (pop ARGS)) + (OTTYWINDOW (pop ARGS)) + (OTTYENTRYFN (pop ARGS)) + (OTTYEXITFN (pop ARGS)) + (OWINDOW (pop ARGS)) + TTYWINDOW PRIMPANE) + (SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) [COND (STARTING (* ;  "We're going INTO the command loop. Set up all the stuff") (FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;  "Mark us busy until we're set up, so that nobody tries any funny stuff.") (SETQ OWINDOW (PROCESSPROP (THIS.PROCESS) - 'WINDOW - (CAR PANES))) (* ; + 'WINDOW PRIMPANE)) (* ;  "Attach the process to this window.") (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ;  "Disarm all interrupt chars, re-arm them when we leave the edit") @@ -493,7 +432,7 @@ (* ;  "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS") (WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) - (WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR PANES))) + (WINDOWPROP TTYWINDOW 'MAINWINDOW PRIMPANE)) (FSETTOBJ TEXTOBJ TXTEDITING T) (* ;  "Tell TEdit that this document is actively being edited.") (* ; @@ -502,21 +441,19 @@ (T (* ;  "Coming OUT OF the command loop -- reset everything") (PROCESSPROP (THIS.PROCESS) - 'WINDOW - (CAR PANES)) (* ; + 'WINDOW PRIMPANE) (* ;  "Detach the window from the edit process, to prevent circularity there") - (WINDOWPROP (CAR PANES) - 'PROCESS NIL) + (WINDOWPROP PRIMPANE 'PROCESS NIL) (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS) T) (* ;  "Re-arm the interrupts we turned off coming in.") - (CL:WHEN [AND (TXTFILE TEXTOBJ) - (NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR PANES] + (CL:WHEN (AND (TXTFILE TEXTOBJ) + (NOT (fetch (TEXTWINDOW CLOSINGFILE) of PRIMPANE))) (* ;  "Remember to close the file we were editing (Only if the window function isn't closing it.)") (CLOSEF? (TXTFILE TEXTOBJ)) (* ;  "Let anyone else who wants to close the file.") - (replace (TEXTWINDOW CLOSINGFILE) of (CAR PANES) with NIL)) + (replace (TEXTWINDOW CLOSINGFILE) of PRIMPANE with NIL)) (PROCESSPROP (THIS.PROCESS) 'TTYEXITFN OTTYEXITFN) (PROCESSPROP (THIS.PROCESS) @@ -532,7 +469,7 @@ (TTYDISPLAYSTREAM OTTYWINDOW) (PROCESSPROP (THIS.PROCESS) 'TEDITTTYWINDOW NIL))] - (RETURN (LIST TEXTOBJ PANES OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW]) + (RETURN (LIST TEXTOBJ OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW]) ) (RPAQ? TEDIT.INTERRUPTS '((2 BREAK) @@ -974,12 +911,12 @@ (\TEDIT.CLIPBOARD) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) ( -\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP -24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 . -35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 . -41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) ( -TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767 -53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) ( -\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345))))) + (FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) ( +\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP +19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 . +31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 . +37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) ( +TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441 +49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) ( +\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019))))) STOP diff --git a/library/tedit/TEDIT-COMMAND.LCOM b/library/tedit/TEDIT-COMMAND.LCOM index 7006b95a4bf8657cf04ad816d69c59068d6fd485..976127b30546b1a6e6e39c6a944b74cd456727de 100644 GIT binary patch delta 3949 zcmZu!U2G#)6&^crHc9u#PO|y&W_RyeY&TAo;5$G53GFr$dmK+Pp7G9%cM_C_ZPy5U z*RW7km7qdiA;beni0!B^p|sUL7Zhh%A=)CNRste~;1MBKMM(U-Af=B~G~wKP$M)Ds z$yeEFiNNfi}Pho zLw?=G#l;w^y!Z+jKgkF$#NwlKc~w)grXt%)4#oHro$NYQuf6p0i!XokI+(1z^59qD z5%3U+89tSE{}PBl*L5h4mP)2_Q#H!gLJn+$Y1{>Y@scC}h!`5}+6KTO%%|g{?oVf? z9{nl!=fKk#870M(ZPn0`iW10HHf&>MEsnU;9LEKhhv3P{?ym=bqgys$D55+PP+o^G z5n1ZelCD{bePiLKtd$j5bv`%{2V8FaMDM zOQD$iztHfF3^g;)?Bq3hbsm*a8qJqXBdaL6g{*8T7Llcn?FYgn@uh?$WM>QTEuw6} zeSRp@z#S;yDaOd|c#rwxc0ffqwj&5dv{f?IqOF)kOOB&pZ8SvD#Ri;-{lreS61_dm z;MHeF2+S79ufOF?G}vgE$aeojlwWTKk%OIfJer3;WHEjA@t`yNJ`3o&7sa==_8Z-s#B*Kyuzu%s|L?+U_(D=QTif6%cy?bSA5{Ga>48^YF~LGf{;MX@2$&HNVxle17G$%nj8kY;u?w5r9Pz42~LpWw9xSs z&q6S^AR6n+CiDz&#oDx1%J~uuFmgW*U38a2Lye@+wgUuZ6|%CaK!}oPMKiMN5R4OM zd9drqstta7CZQ8Z=}enpkpvV)e6{5j4NfrO9|@r66ck0XvZkSF?(dgJ8c0Y1%Q1RJ zf`k#UagHu7AwC5R=S|^M(q|VZdq%y>(rG^x`Uw|7JUyZYw*jH({{5W(1xB5HT#b)0 zX9*ffe{XRA8@|vGI$pNh$GoXP|9~JBf#dVQ<9)mjEoEt7fD2HTwW?7@Qq^d*8nvOf zSo?_w)o>)t-6Ew^2Ko%DwBp9bEmA?df8*xFPHnjV3{3^G;NBR!G%FZp zCFFiQKK)#{{wX7(-QRI@7;-bGT1C~epfySq6vbKA9aYbP3=+C{6JXg;1`;WQ=>|&j zq-uzQ;Xt^c=O$38>=QtuV8~(;BEL0AvMt-*T%;j}9ijTR%(AYl`f5j(f+OmeB~z#* z>k8S*LejE-BmxEWt3wgCci@wq@I$lrPQsl(|3-;4b7B;Z2x`gRWN2U{BBS#zAOoh9 z4X9mmwcy!Mx6MsDh8t67rF(kv(za}_T9CRBQzb8#H5+D4Wfd+|aTNIIRDcUE2bO~` z!AT!~v?5oB3j2fG^1~+gq(CkO^yKL2>h!2TaKAr!x$%BiOy}s-dxdTm(6@s}-|&eZ zhn=&uFIH>hD#yJ*6X2I!OGTDTMY^`?A9VL<(b)#qFX5PXt-{?uE}>QdO0CKLqHEfl z)%~XFtaryKP+#`um;%k?M;DlorD^X<_uZ+Hv32HQcat^uw^Q+e>V7gc+W0Z+0O|K9|NNUJsk{MJ5|W){V)LTVo9ajqfUY&eQu5Cu zftOArd&4Hzd?etMyEDDk03IOsSIeRXcoD|_T0uOY>6bvR_Uhn_)GtZ*+Qmtl#=YpU zltC){z2U$WmNvT%R1Ck3{LnGk)#qsj_Y6}B_uZM92Kd_5fjSofKD{h-DglZ7Nks`v zk~8#c&@6!&y2=9SS5RYKQ3=qbjuo^Z!F_?%;RPr>L4*$9U-W{Ia=#Rv4Djx&(NrRd zyc*_{aAoS(Xg{U06D;{N~u delta 4973 zcmbVQO>7%k9k-pdY0}iOQzuQ`w0+IC*`#dDe0pqe37OdAdK$;$&POI$mC_Pd>$Kjs zbkU*(q1j!nxa@&#M@Y~Gv=qdikm97h&?5730G9*onFHd0IB-eD1y)PS|GhV3J5B(J zsBzwV|M&hMzyGKE$=90S48Fg-%+AQS@62!vCm@#1h+>A7CeYNx>aEvquhp(q(5;(j z0u6jUXDoc}%I5wQFzk332wTx9;3nyZP!2J(+dO z!Q=6iG>rx(xDFXiIwPhsjC8kg(*4IvVfTZVBMw@-3AgfAv4}daCK8DWRJr;UP+|`j zEI%*27Q_1bT)VAe+>OQ=;@&{5968R(}xNiifJzWpG31RHgG|H59Wl7a6 zV!P+b1(Ovbh+M-ipsL7&0j!y#G|67mGdQ7 z3dm41nNrbE%!@Nia?w(zQQ%0ZClpwli-v-FGjYQh3RmN+2VM=pPb5%Mivv>}(%1Q-eEuvd1M{s!7Qlyq9%i9LpnqB-W|jz>nGdG7$trHCsq6OASO46{SWG)euu19 z!wq|EuXJwl+q(&+E^fH!HQ!o|G$<+QB^u=PR|IJqd|QZ9frC zeeB7uKOe2s_U&=Ly1Ji^}3Wf}&3s zqQtd?h$4^G85RXx_Mm_ybS0-Dkt6(uMbL*HTP1wVVCByoPPcUT^cGU?-TpHnL2`!% z#(M-}O ziQ19nOG+hu*?Dyt^O0Jdtuk)f2?OQ^rG(m{=RXBs%onxn0unk!ea@G~0cTr={-Nm} zkT8cx(4w#zraWJSxCSNLJ29O`?z2qHL3}dZan6g$jvbfcknaVNM;K+q38bqkS<)#v zUPKsY4}9o)1a%fdjN%P}S<>`H89-yxot=_4bT@IRFAA+NLob2WD9MWMFAkPMtl$m} zjyQYues+)MU&cM#@2IeWmfmXiWdx!-8+;jN0o=yRFd9G?FC%O<`~hQVqc6i012&cO zJf=d=Z+BaS79i23Zk0-E>3o7DDdx!oPdtIc8d4k2_npjA zxQUu8t?Rg=cC(Q9-De^md+9d_@Up4Q&<-Z&Xvu;q>yx>5Heq9kx7;g3-*!MOwG=!n zBCWL+kOm}W8PC)};^`JLY=!JOvTxmHy==re?2A+(wIP~x6M#TCMlfNLfQP?Pg(|Hv=>@IFJq=;(g=K|S!N0v@=DGl^T(Ao1zX-Cssd z2A{Zpj>KY*3xqGc+Iv?>ccJ0^;pAowf zgNF#q7Bxf3e;)DBL(OFqe|bkdn{uBHUvMBSI<(*frt3WiZ+4~{$AA($lP?Ww>^$jG zl*RL5w{dt#SQQ$kv>NrkC9uj@`9hiT= z6&nrm?oVP8%()(W4(h|MyByD>MOh_POtTTkvF@RfBZukWL8p5V!vPoEYRH7fLXU+Z zhd8^11#TEDIT>TEDIT-FILE.;23 155256 +(FILECREATED "16-Dec-2024 11:25:16" {WMEDLEY}tedit>TEDIT-FILE.;591 159329 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.GET.PIECES3) + :CHANGES-TO (FNS TEDITFROMSHELLSCRIPT) - :PREVIOUS-DATE " 7-Apr-2024 17:22:52" {MEDLEY}TEDIT>TEDIT-FILE.;20) + :PREVIOUS-DATE "15-Dec-2024 11:47:29" {WMEDLEY}tedit>TEDIT-FILE.;590) (PRETTYCOMPRINT TEDIT-FILECOMS) @@ -19,7 +19,8 @@ (\PieceDescriptorCHARLOOKSLIST 4) (\PieceDescriptorPARALOOKSLIST 5) (\PieceDescriptorSAFEOBJECT 6) - (\PieceDescriptorMETAINFO 7)) + (\PieceDescriptorMETAINFO 7) + (\PieceDescriptorPROPERTIES 8)) (EXPORT (MACROS \SMALLPIN \SMALLPOUT))) (COMS (* ;; "Public entries ") @@ -41,20 +42,21 @@ (* ; "UTF-8") (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.GET.CHARLOOKS \TEDIT.GET.PARALOOKS.INDEX \TEDIT.GET.CHARLOOKS.INDEX) - (FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.GET.PARALOOKS) + (FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS) (FNS \TEDIT.GET.OBJECT)) (COMS (* ;; "Putting (pageframe functions on TEDIT-PAGE)") - (FNS \TEDIT.PUT.PCTB \TEDIT.PUT.TRAILER \TEDIT.PUT.PCTB.MERGEABLE - \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW \TEDIT.INSERT.NEWPIECES - \TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT) + (FNS \TEDIT.PUT.PCTB \TEDIT.PUT.PCTB.PIECEDATA \TEDIT.PUT.TRAILER + \TEDIT.PUT.PCTB.MERGEABLE \TEDIT.PUT.UTF8.SPLITPIECES \TEDIT.PUT.PCTB.NEXTNEW + \TEDIT.INSERT.NEWPIECES \TEDIT.PUTRESET \ARBOUT \ATMOUT \DWOUT \STRINGOUT) (FNS \TEDIT.PUT.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS \TEDIT.PUT.CHARLOOKS1 \TEDIT.PUT.OBJECT) (FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS)) (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) - (FNS TEDITFROMLISPSOURCE) - (ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE))) + (FNS TEDITFROMLISPSOURCE SHELLSCRIPTP TEDITFROMSHELLSCRIPT) + (ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE) + (SHELLSCRIPTP TEDITFROMSHELLSCRIPT))) (INITVARS (* ;  "For consistent reading and writing of info on TEdit files.") (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE]) @@ -77,6 +79,8 @@ (RPAQQ \PieceDescriptorMETAINFO 7) +(RPAQQ \PieceDescriptorPROPERTIES 8) + (CONSTANTS (\PieceDescriptorLOOKS 0) (\PieceDescriptorOBJECT 1) @@ -85,7 +89,8 @@ (\PieceDescriptorCHARLOOKSLIST 4) (\PieceDescriptorPARALOOKSLIST 5) (\PieceDescriptorSAFEOBJECT 6) - (\PieceDescriptorMETAINFO 7)) + (\PieceDescriptorMETAINFO 7) + (\PieceDescriptorPROPERTIES 8)) ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -112,7 +117,13 @@ (DEFINEQ (TEDIT.GET - [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 17-Mar-2024 18:17 by rmk") + [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "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") + (* ; "Edited 12-May-2024 21:33 by rmk") + (* ; "Edited 17-Mar-2024 18:17 by rmk") + (* ; "Edited 29-Apr-2024 10:15 by rmk") (* ; "Edited 15-Mar-2024 13:34 by rmk") (* ; "Edited 21-Jan-2024 23:13 by rmk") (* ; "Edited 22-Sep-2023 20:16 by rmk") @@ -124,73 +135,79 @@ (* ;; "A new file overwrites the textstream,textobj, and window of the one being edited. We have to make a new TEXTOBJ because we don't want the new file to inherit random properties (like READONLY etc. (Not sure about BEING-EDITED, that may only have been used for window-creation)") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - FSTREAM GETFN MAINWINDOW BEINGEDITED PROC NTSTREAM NTEXTOBJ TEDITCREATED BEING-EDITED) - (CL:WHEN [AND (GETTOBJ TEXTOBJ \DIRTY) - (PROGN (TEDIT.PROMPTCLEAR TEXTOBJ) - (NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T - (GETTOBJ TEXTOBJ PROMPTWINDOW] + (RESETLST + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + FSTREAM GETFN MAINWINDOW BEINGEDITED PROC NTSTREAM NTEXTOBJ TEDITCREATED BEING-EDITED) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Get") + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (CL:WHEN [AND (GETTOBJ TEXTOBJ \DIRTY) + (PROGN (TEDIT.PROMPTCLEAR TEXTOBJ) + (NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T + (GETTOBJ TEXTOBJ PROMPTWINDOW] - (* ;; "Only do the GET if he knows he'll zorch himself.") + (* ;; "Only do the GET if he knows he'll zorch himself.") - (RETURN)) - (CL:UNLESS FILE - [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "GET from: " - (OR (GETTEXTPROP TEXTOBJ 'LASTGETFILENAME) - (\TEXTSTREAM.FILENAME TEXTOBJ]) - (CL:WHEN [AND (SETQ GETFN (GETTEXTPROP TEXTOBJ 'GETFN)) - (EQ 'DON'T (APPLY* GETFN (GETTOBJ TEXTOBJ STREAMHINT) - (FULLNAME FSTREAM) - 'BEFORE] (* ; + (RETURN)) + [SETQ FILE (\TEDIT.MAKEFILENAME (OR FILE (TEDIT.GETINPUT TEXTOBJ "GET from: " + (OR (GETTEXTPROP TEXTOBJ + 'LASTGETFILENAME) + (\TEXTSTREAM.FILENAME TEXTOBJ] + (CL:UNLESS FILE + (TEDIT.PROMPTPRINT TEXTOBJ "No input file--aborted" T T) + (RETURN)) + (CL:WHEN [AND (SETQ GETFN (GETTEXTPROP TEXTOBJ 'GETFN)) + (EQ 'DON'T (APPLY* GETFN TSTREAM (FULLNAME FILE) + 'BEFORE] (* ;  "He doesn't want this document put. Bail out.") - (RETURN)) + (RETURN)) - (* ;; "") + (* ;; "") - (SETQ FSTREAM (\TEDIT.OPENTEXTFILE FILE)) - (CL:UNLESS (\GETSTREAM FSTREAM 'INPUT T) (* ; + (SETQ FSTREAM (\TEDIT.OPENTEXTFILE FILE)) + (CL:UNLESS (AND (STREAMP FSTREAM) + (\GETSTREAM FSTREAM 'INPUT T)) (* ;  "Didn't find it but save the name as a hint for the next try") - (PUTTEXTPROP TEXTOBJ 'LASTGETFILENAME FILE) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT FILE " not found--aborted") - T) - (RETURN NIL)) - (RESETLST - (RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ 'DON'T (GETTOBJ TEXTOBJ PROMPTWINDOW)) - (GETTOBJ TEXTOBJ PROMPTWINDOW)) - PROMPTWINDOW))) + (PUTTEXTPROP TEXTOBJ 'LASTGETFILENAME FILE) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT FILE " not found--aborted") + T) + (RETURN NIL)) + (RESETLST + (RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ 'DON'T (GETTOBJ TEXTOBJ PROMPTWINDOW)) + (GETTOBJ TEXTOBJ PROMPTWINDOW)) + PROMPTWINDOW))) - (* ;; "New file is good, clean out the old stuff") + (* ;; "New file is good, clean out the old stuff") - (\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ) - NIL) - (\TEDIT.TEXTCLOSEF TEXTOBJ) (* ; + (\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ) + NIL TEXTOBJ) + (\TEDIT.TEXTCLOSEF TEXTOBJ) (* ;  "Close the old files, still in TXTFILE") - (* ;; "") + (* ;; "") - (* ;; "Open a textstream NTSTREAM on the new file, then reconnect its textobj to the old TSTREAM and window") + (* ;; "Open a textstream NTSTREAM on the new file, then reconnect its textobj to the old TSTREAM and window") - (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ)) - (SETQ BEING-EDITED (GETTEXTPROP TEXTOBJ 'BEING-EDITED)) - (CL:WHEN MAINWINDOW - (SETQ TEDITCREATED (WINDOWPROP MAINWINDOW 'TEDITCREATED))) - (CL:WHEN UNFORMATTED? - (push PROPS 'CLEARGET T)) - (SETQ NTSTREAM (OPENTEXTSTREAM FSTREAM MAINWINDOW NIL NIL PROPS)) - (SETQ NTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of NTSTREAM)) - (replace (TEXTSTREAM TEXTOBJ) of TSTREAM with NTEXTOBJ) - (SETTOBJ NTEXTOBJ STREAMHINT TSTREAM) - (\TEDIT.TEXTSETFILEPTR TSTREAM 0) - (CL:WHEN MAINWINDOW - (\TEDIT.UPDATE.TITLE NTEXTOBJ) - (WINDOWPROP MAINWINDOW 'TEDITCREATED TEDITCREATED) + (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ)) + (SETQ BEING-EDITED (GETTEXTPROP TEXTOBJ 'BEING-EDITED)) + (CL:WHEN MAINWINDOW + (SETQ TEDITCREATED (WINDOWPROP MAINWINDOW 'TEDITCREATED))) + (CL:WHEN UNFORMATTED? + (push PROPS 'CLEARGET T)) + (SETQ NTSTREAM (OPENTEXTSTREAM FSTREAM MAINWINDOW NIL NIL PROPS)) + (SETQ NTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of NTSTREAM)) + (replace (TEXTSTREAM TEXTOBJ) of TSTREAM with NTEXTOBJ) + (SETTOBJ NTEXTOBJ STREAMHINT TSTREAM) + (\TEDIT.TEXTSETFILEPTR TSTREAM 0) + (CL:WHEN MAINWINDOW + (\TEDIT.UPDATE.TITLE NTEXTOBJ) + (WINDOWPROP MAINWINDOW 'TEDITCREATED TEDITCREATED) (* ; "To keep the default region") - (WINDOWPROP MAINWINDOW 'TEXTSTREAM TSTREAM)) - (CL:WHEN BEING-EDITED (TEDIT TSTREAM))) (* ; "find and set the title") - (CL:WHEN GETFN - (APPLY* GETFN TSTREAM (FULLNAME (GETTOBJ TEXTOBJ TXTFILE)) - 'AFTER)) - (RETURN TSTREAM]) + (WINDOWPROP MAINWINDOW 'TEXTSTREAM TSTREAM)) + (CL:WHEN BEING-EDITED (TEDIT TSTREAM))) (* ; "find and set the title") + (CL:WHEN GETFN + (APPLY* GETFN TSTREAM (FULLNAME (GETTOBJ TEXTOBJ TXTFILE)) + 'AFTER)) + (RETURN TSTREAM)))]) (TEDIT.FORMATTEDFILEP [LAMBDA (FILE) (* ; "Edited 26-Mar-2024 22:10 by rmk") @@ -232,7 +249,15 @@ (GDATE IDATE)))]) (TEDIT.INCLUDE - [LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 17-Mar-2024 12:06 by rmk") + [LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 25-Nov-2024 20:17 by rmk") + (* ; "Edited 22-Sep-2024 18:43 by rmk") + (* ; "Edited 11-Aug-2024 12:30 by rmk") + (* ; "Edited 7-Jul-2024 22:03 by rmk") + (* ; "Edited 2-Jul-2024 10:48 by rmk") + (* ; "Edited 29-Jun-2024 10:29 by rmk") + (* ; "Edited 22-May-2024 14:03 by rmk") + (* ; "Edited 29-Apr-2024 10:17 by rmk") + (* ; "Edited 17-Mar-2024 12:06 by rmk") (* ; "Edited 16-Feb-2024 23:54 by rmk") (* ; "Edited 13-Jan-2024 09:39 by rmk") (* ; "Edited 12-Nov-2023 12:29 by rmk") @@ -258,25 +283,31 @@ (* ;; "If SAFE, the caller is taking responsibility for closing FILE when its contents are no longer needed (e.g. DOC-OBJECTS inclusions). Otherwise, the contents are copied to a NODIRCORE that is owned by this TSTREAM, and then FILE is closed here if it wasn't previously open. (This may not be accurate, unless FILE was actually an open stream and not a name?)") - (CL:UNLESS (\TEDIT.READONLY TSTREAM) - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (RESETLST + (PROG ((TOOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) TSEL FSEL WASOPEN FTSTREAM NDCSTREAM (FROMFILE FILE)) - (SETQ TSEL (TEXTSEL TEXTOBJ)) + [RESETSAVE (\TEDIT.MARKACTIVE TOOBJ "Include") + `(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (SETQ TSEL (TEXTSEL TOOBJ)) (CL:UNLESS (GETSEL TSEL SET) - (TEDIT.PROMPTPRINT TEXTOBJ "Please select a destination for the included text" T) + (TEDIT.PROMPTPRINT TOOBJ "Please select a destination for the included text" T) (RETURN NIL)) + (CL:WHEN (\TEDIT.READONLY TOOBJ NIL (FGETSEL TSEL CH#)) + (RETURN NIL)) (* ;; "We know where the new text is supposed to go. Where is it coming from?") (CL:UNLESS FROMFILE - (SETQ FROMFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ - "Name of the file to include: "))) + (SETQ FROMFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TOOBJ "Include from: "))) (CL:UNLESS FROMFILE - (TEDIT.PROMPTPRINT TEXTOBJ "No file to include--aborted]" T) + (TEDIT.PROMPTPRINT TOOBJ "No file to include--aborted]" T) (RETURN))) (CL:UNLESS (OR (STREAMP FROMFILE) - (INFILEP FROMFILE)) (* ; "File not found") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT FROMFILE " not found--include aborted") + (OR (FINDFILE FROMFILE) + (FINDFILE-WITH-EXTENSIONS FROMFILE NIL *TEDIT-EXTENSIONS*))) + (* ; "File not found") + (TEDIT.PROMPTPRINT TOOBJ (CONCAT FROMFILE " not found--include aborted") T T) (RETURN)) @@ -288,7 +319,7 @@ (CL:UNLESS END (SETQ END (GETFILEINFO FILE 'LENGTH))) (CL:UNLESS (IGEQ END START) - (TEDIT.PROMPTPRINT TEXTOBJ "Negative number of characters to include--aborted" T T) + (TEDIT.PROMPTPRINT TOOBJ "Negative number of characters to include--aborted" T T) (RETURN)) (* ;; "") @@ -328,30 +359,24 @@ (CL:UNLESS (\GETSTREAM FROMFILE 'INPUT T) (SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT)) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Closefile - THOLDINFO _ FROMFILE))) - [SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL NIL NIL - `(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TSEL) + (\TEDIT.HISTORYADD TOOBJ (\TEDIT.HISTORY.EVENT TOOBJ :Closefile NIL NIL NIL NIL + FROMFILE))) + [SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL START END + `(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TSEL) PARALOOKS - ,(GETTOBJ TEXTOBJ FMTSPEC) + ,(GETTOBJ TOOBJ FMTSPEC) PLAINTEXT ,PLAINTEXT] (* ;; "") - (* ;; "FTSTREAM is now a text stream for the source.") + (* ;; "FTSTREAM is now a text stream for the source. The COPYSEL is so that this doesn't smash the current FTSTREAM SEL, if the stream previously existed.") - (SETQ FSEL (TEXTSEL (TEXTOBJ FTSTREAM))) (* ; "Select START to END") - (\TEDIT.UPDATE.SEL FSEL (ADD1 START) - (IDIFFERENCE END START) - 'LEFT T) (* ; "ADD1 takes filepos to charno") - (TEDIT.MOVE FSEL TSEL T) - - (* ;; "The exit conditions are not documented, but we set the fileptr to the end of the insertion and return the length of the insertion.") - - (\TEDIT.TEXTSETFILEPTR (FGETTOBJ TEXTOBJ STREAMHINT) - (SUB1 (FGETSEL TSEL CHLIM))) + [SETQ FSEL (\TEDIT.COPYSEL (TEXTSEL (TEXTOBJ FTSTREAM] + (* ; "Select START to END") + (\TEDIT.UPDATE.SEL FSEL 1 (TEXTLEN (TEXTOBJ FTSTREAM)) + 'LEFT) + (\TEDIT.COPY FSEL TSEL FTSTREAM TSTREAM) (RETURN (FGETSEL FSEL DCH))))]) (TEDIT.RAW.INCLUDE @@ -364,7 +389,11 @@ (TEDIT.INCLUDE TSTREAM INFILE START END SAFE T]) (TEDIT.PUT - [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 31-Mar-2024 23:54 by rmk") + [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 11-Aug-2024 12:30 by rmk") + (* ; "Edited 29-Jun-2024 10:31 by rmk") + (* ; "Edited 26-Jun-2024 15:46 by rmk") + (* ; "Edited 29-Apr-2024 10:12 by rmk") + (* ; "Edited 31-Mar-2024 23:54 by rmk") (* ; "Edited 7-Feb-2024 13:31 by rmk") (* ; "Edited 4-Feb-2024 00:10 by rmk") (* ; "Edited 22-Dec-2023 10:41 by rmk") @@ -378,10 +407,11 @@ (* ;; "Returns the destination stream open for input.") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (CL:UNLESS (\TEDIT.READONLY TSTREAM) (RESETLST - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - CHARSTREAM NEWPIECES PUTFN OLDEXTFORMAT NEWEXTFORMAT) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + CHARSTREAM NEWPIECES PUTFN OLDEXTFORMAT NEWEXTFORMAT PUTSTRING) (CL:WHEN (AND (SETQ PUTFN (GETTEXTPROP TEXTOBJ 'PUTFN)) (EQ (APPLY* PUTFN TSTREAM (FULLNAME FILE) 'BEFORE) @@ -391,9 +421,11 @@ (TEDIT.PROMPTPRINT TEXTOBJ "This document cannot be saved" T T) (RETURN NIL)) - (CL:UNLESS (OR (IGREATERP (TEXTLEN TEXTOBJ) + (CL:UNLESS [OR (IGREATERP (TEXTLEN TEXTOBJ) 0) - (TEDIT.GETINPUT TEXTOBJ "Document is empty. Save anyway? " "Yes")) + (EQ (CHARCODE Y) + (CHCON1 (TEDIT.GETINPUT TEXTOBJ + "Document is empty. Save anyway? " "Yes"] (RETURN NIL)) (if (AND (STREAMP FILE) (\GETSTREAM FILE 'OUTPUT T)) @@ -415,7 +447,7 @@ "No") 1] (SETQ FORCENEW 'DETEMPLATE))) - [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "PUT to: " + [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Put to: " (CL:UNLESS FORCENEW (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED? @@ -435,6 +467,8 @@ 'FORMAT] (SETQ NEWEXTFORMAT (OR FORMAT (GETTEXTPROP TEXTOBJ 'OUTPUT-FORMAT) OLDEXTFORMAT :DEFAULT)) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Put") + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] [RESETSAVE [SETQ CHARSTREAM (OPENSTREAM FILE 'OUTPUT 'NEW `([TYPE ,(CL:IF UNFORMATTED? 'TEXT @@ -444,9 +478,9 @@ '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] [RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS) 'DON'T] - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting to file " (FULLNAME CHARSTREAM) - "...") - T) + (SETQ PUTSTRING (CONCAT "Put to " (FULLNAME CHARSTREAM) + "...")) + (TEDIT.PROMPTPRINT TEXTOBJ PUTSTRING T) (* ;; "") @@ -454,7 +488,7 @@ (* ;; "We don't know how to decide that the user doesn't want to continue editing and therefore doesn't need the pieces to be updated to the new file. The stream itself may be used in the future, even if right now there is no process or window") - (SETQ CHARSTREAM (TEDIT.PUT.STREAM TEXTOBJ CHARSTREAM UNFORMATTED? NIL T)) + (SETQ CHARSTREAM (TEDIT.PUT.STREAM TSTREAM CHARSTREAM UNFORMATTED? NIL T)) (* ;; "The file is written, nothing can be lost. CHARSTREAM isn't closed yet") @@ -473,7 +507,7 @@ (* ;; "") - (TEDIT.PROMPTPRINT TEXTOBJ "done") + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT PUTSTRING "done")) (* ;; "") @@ -483,6 +517,10 @@ (TEDIT.PUT.STREAM [LAMBDA (TSTREAM DESTSTREAM UNFORMATTED? EXTERNALFORMAT CONTINUE) + (* ; "Edited 20-Nov-2024 16:26 by rmk") + (* ; "Edited 22-Sep-2024 18:40 by rmk") + (* ; "Edited 14-May-2024 17:49 by rmk") + (* ; "Edited 29-Apr-2024 10:09 by rmk") (* ; "Edited 19-Mar-2024 21:38 by rmk") (* ; "Edited 17-Mar-2024 17:29 by rmk") (* ; "Edited 7-Feb-2024 12:41 by rmk") @@ -497,7 +535,7 @@ (* ; "") (RESETLST (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - NEWPIECES ENDPTR OPENEDHERE) + NEWPIECES OPENEDHERE) (CL:UNLESS (\GETSTREAM DESTSTREAM 'OUTPUT T) [RESETSAVE [SETQ DESTSTREAM (OPENSTREAM DESTSTREAM 'OUTPUT NIL '(LINELENGTH T] '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] @@ -506,27 +544,23 @@ (STREAMPROP DESTSTREAM 'FORMAT EXTERNALFORMAT)) (SETQ NEWPIECES (\TEDIT.PUT.PCTB TEXTOBJ DESTSTREAM UNFORMATTED? CONTINUE)) (if CONTINUE - then (SETQ ENDPTR (GETFILEPTR DESTSTREAM)) - (CLOSEF? DESTSTREAM) + then (CLOSEF? DESTSTREAM) (CL:UNLESS UNFORMATTED? (* ;  "Make the directory date the same as the internal Tedit date") (SETFILEINFO (FULLNAME DESTSTREAM) 'ICREATIONDATE (TEDIT.FILEDATE DESTSTREAM T))) (SETQ DESTSTREAM (OPENSTREAM DESTSTREAM 'INPUT)) - (\TEDIT.INSERT.NEWPIECES DESTSTREAM TEXTOBJ NEWPIECES) - (SETFILEPTR DESTSTREAM ENDPTR) - (\PEEKBIN DESTSTREAM T) (* ; "Get the buffers set up") + (\TEDIT.INSERT.NEWPIECES DESTSTREAM TSTREAM NEWPIECES) + (SETFILEPTR DESTSTREAM 0) + (\PEEKBIN DESTSTREAM T) (* ; + "Opening doesn't set up the buffers, you have to read.") (CL:WHEN (FGETTOBJ TEXTOBJ TXTFILE) (CLOSEF? (FGETTOBJ TEXTOBJ TXTFILE))) (FSETTOBJ TEXTOBJ TXTFILE DESTSTREAM) (FSETTOBJ TEXTOBJ \XDIRTY NIL) - (\TEDIT.UPDATE.TITLE TEXTOBJ DESTSTREAM) - - (* ;; "Wipe out previous history: Put is not undoable.") - - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Put)) + (\TEDIT.UPDATE.TITLE TEXTOBJ DESTSTREAM) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Put)) DESTSTREAM elseif OPENEDHERE then (OR (CLOSEF? DESTSTREAM) @@ -639,7 +673,10 @@ (\TEDIT.INSERTPIECES PIECES NIL TEXTOBJ)))]) (\TEDIT.GET.FORMATTED.FILE - [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 17-Mar-2024 00:21 by rmk") + [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 28-Oct-2024 17:48 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Apr-2024 10:25 by rmk") + (* ; "Edited 17-Mar-2024 00:21 by rmk") (* ; "Edited 5-Feb-2024 09:25 by rmk") (* ; "Edited 21-Jan-2024 10:25 by rmk") (* ; "Edited 18-Jan-2024 10:25 by rmk") @@ -647,12 +684,11 @@ (* ; "Edited 11-Jun-99 14:37 by rmk:") (* ; "Edited 19-Apr-93 13:46 by jds") - (* ;; "TEXT is an open stream that knows its external format, TEXTOBJ is the TEXTOBJ to be filled in. If specified, START and END define the byte positions in TEXT to be included") + (* ;; "TEXT is an open stream that knows its external format, TSTREAM is the textstream to be filled in. If specified, START and END define the byte positions in TEXT to be included") - (* ;; - "If TSTREAM is a formatted file, it is included in TEXTOBJ and TEXTOBJ is returned, otherwise NIL") + (* ;; "Returns NIL if TSTREAM is not a formatted file, otherwise the ") - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) (TRAILER (\TEDIT.GET.TRAILER TEXT END)) PCCOUNT IDATE PC) (CL:WHEN TRAILER @@ -660,20 +696,17 @@ (SETQ PCCOUNT (CADDDR TRAILER)) (SELECTQ (CADDR TRAILER) (3 (* ; "Version 3") - (CL:WHEN (\TEDIT.GET.IDATE3 TEXT END) (* ; - "IDATE means 3.1, LINELEADING above-hack.") - (FSETTOBJ TEXTOBJ TXTLINELEADINGABOVE T)) - (\TEDIT.INSERTPIECES (\TEDIT.GET.PIECES3 TEXT TEXTOBJ PCCOUNT START END) + (\TEDIT.INSERTPIECES (\TEDIT.GET.PIECES3 TEXT TSTREAM PCCOUNT START END) NIL TEXTOBJ)) (2 (* ; "Version 2; obsoleted 5/22/85") - (\TEDIT.GET.PCTB2 TEXT TEXTOBJ PCCOUNT START END)) + (\TEDIT.GET.PCTB2 TEXT TSTREAM PCCOUNT START END)) (1 (* ;  "Version 1; obsoleted at INTERMEZZO release 2/85") - (\TEDIT.GET.PCTB1 TEXT TEXTOBJ PCCOUNT START END)) + (\TEDIT.GET.PCTB1 TEXT TSTREAM PCCOUNT START END)) (0 (* ; "VERSION 0") - (\TEDIT.GET.PCTB0 TEXT TEXTOBJ (CADR PCCOUNT) + (\TEDIT.GET.PCTB0 TEXT TSTREAM (CADR PCCOUNT) PCCOUNT START END)) - (SHOULDNT "File format version incompatible with this version of TEdit.")) + (\TEDIT.THELP "File format version incompatible with this version of TEdit.")) (CL:WHEN (SETQ PC (PREVPIECE (\TEDIT.LASTPIECE TEXTOBJ))) (FSETPC PC PPARALAST T)) (\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL) @@ -855,7 +888,9 @@ (DEFINEQ (\TEDIT.GET.PIECES3 - [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END) (* ; "Edited 11-Jul-2024 14:20 by rmk") + [LAMBDA (TEXT TSTREAM PCCOUNT CURFILEBYTE# END) (* ; "Edited 30-Aug-2024 15:44 by rmk") + (* ; "Edited 11-Jul-2024 13:20 by rmk") + (* ; "Edited 29-Apr-2024 10:37 by rmk") (* ; "Edited 7-Apr-2024 17:20 by rmk") (* ; "Edited 20-Mar-2024 10:59 by rmk") (* ; "Edited 15-Mar-2024 14:37 by rmk") @@ -867,19 +902,20 @@ (* ; "Edited 24-Sep-2023 22:00 by rmk") (* ; "Edited 2-Sep-2023 11:12 by rmk") (* ; "Edited 29-Aug-2023 00:18 by rmk") - - (* ;; "This runs through the Looks table portion of the TEXT file, gathering the looks and installing pointers to positions in the character section of the file. It doesn't actually examine the characters in the file. It returns a piece chain that covers the text but that hasn't been installed in the btree. The pieces need further adjustment for character encoding and to prevent mutlibyte characters from crossing buffer boundaries before they are installed in the btree.") - - (TEXTOBJ! TEXTOBJ) (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) 8)) (SETFILEPTR TEXT (\DWIN TEXT)) (* ; "Pieceinfo byte #") - (for PCNO PC BYTELEN PREVPC FIRSTPC PARALOOKSMAP CHARLOOKSMAP (ORIGBYTE# _ CURFILEBYTE#) - (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) - (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) from 1 to PCCOUNT first (SETQ FIRSTPC - (CREATE PIECE)) + (for PCNO PC BYTELEN PREVPC FIRSTPC PARALOOKSMAP CHARLOOKSMAP DEFAULTCHARLOOKS OLDPARALOOKS + (TEXTOBJ _ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (ORIGBYTE# _ CURFILEBYTE#) from 1 to PCCOUNT first (SETQ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ + + DEFAULTCHARLOOKS + )) + (SETQ OLDPARALOOKS (FGETTOBJ TEXTOBJ + FMTSPEC)) + (SETQ FIRSTPC (CREATE PIECE)) (* ; "Throw away at the end") - (SETQ PREVPC FIRSTPC) + (SETQ PREVPC FIRSTPC) do (SETQ PC NIL) (* ;  "This loop may not really read a piece, so we have to distinguish that case.") (SETQ BYTELEN (\DWIN TEXT)) @@ -924,8 +960,7 @@ PPARALOOKS _ OLDPARALOOKS PTYPE _ OBJECT.PTYPE PREVPIECE _ PREVPC)) - (\TEDIT.GET.OBJECT (GETTOBJ TEXTOBJ STREAMHINT) - PC TEXT CURFILEBYTE#) + (\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILEBYTE#) (add CURFILEBYTE# BYTELEN) (FSETPC PC PLOOKS (if (ZEROP (BIN TEXT)) then @@ -938,11 +973,6 @@  "There are new character looks for this object. Read them in.") (\TEDIT.GET.SINGLE.CHARLOOKS TEXT TEXTOBJ)))) - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT - *TEDIT-FILE-READTABLE* - )))) (\PieceDescriptorCHARLOOKSLIST (* ;  "Read the list of CHARLOOKSs used in this document.") (add PCNO -1) (* ; @@ -962,6 +992,11 @@  "Build an array of the looks, so the reader can index them.") (for J from 1 as PARALOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) do (SETA PARALOOKSMAP J PARALOOKS))) + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT + *TEDIT-FILE-READTABLE* + )))) (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) (\WIN TEXT] @@ -1149,13 +1184,17 @@ (SETQ EOLC CR.EOLC]) (\TEDIT.INTERPRET.XCCS.SHIFTS - [LAMBDA (PIECES PFILE) (* ; "Edited 21-Jan-2024 00:02 by rmk") + [LAMBDA (PIECES PFILE) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 14-May-2024 18:39 by rmk") + (* ; "Edited 21-Jan-2024 00:02 by rmk") (* ; "Edited 19-Jan-2024 10:34 by rmk") (* ; "Edited 12-Jan-2024 23:53 by rmk") (* ; "Edited 6-Jan-2024 15:02 by rmk") (* ; "Edited 19-Dec-2023 13:13 by rmk") - (* ;; "PIECES is a chain of pieces read from a formatted XCCS file but not yet inserted into the BTREE. Each file piece has PFILE, PFPOS, and PBYTELEN. This function interprets any XCCS shift characters that prefix the actual characters, coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. ") + (* ;; "This is called after a GET or PUT, when the file pieces are known all to reside in PFILE.PIECES is a chain of pieces read from a formatted XCCS file but not yet inserted into the BTREE. Each file piece has PFILE, PFPOS, and PBYTELEN. This function interprets any XCCS shift characters that prefix the actual characters, coercing the piece properties and bumping the PFPOS/PLEN to hide the shifts. ") + + (* ;; "We run this before the pieces are inistalled in a stream, since this may change the character lengths.") (for PC BYTE EOLC inpieces PIECES when (EQ PFILE (PCONTENTS PC)) do (\SETFILEPTR PFILE (PFPOS PC)) @@ -1174,7 +1213,7 @@ 2)) (\NORUNCODE (* ; "Going for 3 byte characters") (CL:UNLESS (EQ 0 (BIN PFILE)) - (SHOULDNT "XCCS CHARACTER NOT IN PLANE 0")) + (\TEDIT.THELP "XCCS CHARACTER NOT IN PLANE 0")) (FSETPC PC PTYPE FATFILE2.PTYPE) (FSETPC PC PBYTESPERCHAR 2) (add (PFPOS PC) @@ -1358,7 +1397,11 @@ (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE TEXTOBJ]) (\TEDIT.GET.SINGLE.CHARLOOKS - [LAMBDA (FILE TEXTOBJ) (* ; "Edited 7-Apr-2024 17:21 by rmk") + [LAMBDA (FILE TEXTOBJ) (* ; "Edited 11-Dec-2024 22:59 by rmk") + (* ; "Edited 9-Dec-2024 20:11 by rmk") + (* ; "Edited 13-Aug-2024 08:49 by rmk") + (* ; "Edited 31-Jul-2024 00:04 by rmk") + (* ; "Edited 7-Apr-2024 17:21 by rmk") (* ; "Edited 16-Jan-2024 22:46 by rmk") (* ; "Edited 21-Dec-2023 23:54 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") @@ -1374,16 +1417,17 @@ (PROG* ((LOOKS (create CHARLOOKS)) (FILEPOS (GETFILEPTR FILE)) (LOOKSLEN (\WIN FILE)) - FONT NAME SIZE SUPER PROPS STYLESTR) + FONT NAME FACE SIZE SUPER PROPS STYLESTR) (SETQ NAME (\ARBIN FILE)) (* ; "The font name") (SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points") (SETQ SUPER (\SMALLPIN FILE)) (* ;  "Superscripting distance, could be negative") - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) + (FSETCLOOKS LOOKS CLSTYLE (OR (\ARBIN FILE) + 0)) + (FSETCLOOKS LOOKS CLUSERINFO (\ARBIN FILE)) (SETQ PROPS (\WIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS] + (with CHARLOOKS LOOKS [SETQ CLSELBEFORE (NOT (ZEROP (LOGAND 8192 PROPS] + [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS] [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] @@ -1394,33 +1438,33 @@ [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) - [SETQ FONT (if (LISTP NAME) + (SETQ FACE (PACK* (CL:IF (FGETCLOOKS LOOKS CLBOLD) + 'B + 'M) + (CL:IF (FGETCLOOKS LOOKS CLITAL) + 'I + 'R) + 'R)) + (SETQ FONT (if (LISTP NAME) then (* ;  "This was a font class. Restore it.") (FONTCLASS (pop NAME) NAME) - elseif (AND NAME (NOT (ZEROP SIZE))) - then (FONTCREATE NAME SIZE (COND - ((AND (fetch (CHARLOOKS CLBOLD) of LOOKS) - (fetch (CHARLOOKS CLITAL) of LOOKS)) - 'BOLDITALIC) - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 'BOLD) - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 'ITALIC] - (replace (CHARLOOKS CLNAME) of LOOKS - with (if (type? FONTCLASS FONT) - then - (* ;; "Put the display family in the CLNAME spot. Better than NIL.") + else (FONTCREATE NAME SIZE FACE))) + (FSETCLOOKS LOOKS CLNAME (if (type? FONTCLASS FONT) + then + (* ;; + "Put the display family in the CLNAME spot. Better than NIL.") - (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T] - (FONTPROP NAME 'FAMILY)) - else NAME)) - (replace (CHARLOOKS CLFONT) of LOOKS with FONT) + (CL:WHEN [SETQ NAME (FONTCOPY FONT + '(DEVICE DISPLAY NOERROR T] + (FONTPROP NAME 'FAMILY)) + else NAME)) + (FSETCLOOKS LOOKS CLFONT FONT) (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) (RETURN LOOKS]) @@ -1490,7 +1534,13 @@ (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ]) (\TEDIT.GET.SINGLE.PARALOOKS - [LAMBDA (FILE TEXTOBJ) (* ; "Edited 16-Jan-2024 22:52 by rmk") + [LAMBDA (FILE TEXTOBJ) (* ; "Edited 22-Nov-2024 23:55 by rmk") + (* ; "Edited 23-Oct-2024 16:03 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 5-Aug-2024 09:47 by rmk") + (* ; "Edited 29-Jul-2024 23:26 by rmk") + (* ; "Edited 28-Jul-2024 21:38 by rmk") + (* ; "Edited 16-Jan-2024 22:52 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 3-Mar-2023 23:16 by rmk") (* ; "Edited 11-Oct-2022 15:23 by rmk") @@ -1499,104 +1549,85 @@  "Edited 2-Jul-93 21:31 by sybalskY:MV:ENVOS") (* ;  "Read a paragraph format spec from the FILE, and return it for later use.") - (PROG ((LOOKS (create FMTSPEC)) - (FILEPOS (GETFILEPTR FILE)) - (LOOKSLEN (\WIN FILE)) - TABFLG DEFTAB TABCOUNT TABS TABSPEC TABTYPE QUAD) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (LET ((FMT (create FMTSPEC)) + (FILEPOS (GETFILEPTR FILE)) + (LOOKSLEN (\WIN FILE)) + TABFLG DEFTAB TABS) + (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the first line of the paragraph") - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the rest of the paragraph") - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; "Right margin for the paragraph") - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* ; "Leading before the paragraph") - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* ; "Lead after the paragraph") - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (SETQ TABSPEC (CONS DEFAULTTAB NIL)) (* ; "inter-line leading") - (replace (FMTSPEC TABSPEC) of LOOKS with TABSPEC) (* ; "Will be tab specs") - (SETQ TABFLG (BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (SETQ QUAD (BIN FILE)) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read") - (SETQ DEFTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ - (SELECTQ (SETQ TABTYPE - (BIN FILE)) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (4 'DOTTEDLEFT) - (5 'DOTTEDRIGHT) - (6 'DOTTEDCENTERED) - (7 'DOTTEDDECIMAL) - (SHOULDNT] - (CL:UNLESS (ZEROP DEFTAB) - (RPLACA TABSPEC DEFTAB)) - (RPLACD TABSPEC TABS)) - (CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ; + (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph") + (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph") + (FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph") + (FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading") + (SETQ TABFLG (BIN FILE)) + (FSETPARA FMT QUAD (SELECTC (BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (\TEDIT.THELP "UNRECOGNIZED QUAD BYTE"))) + (CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read") + (SETQ DEFTAB (\SMALLPIN FILE)) + (CL:WHEN (ILEQ DEFTAB 1) (* ; + "0/1 don't make sense, seemed to code default") + (SETQ DEFTAB DEFAULTTAB)) + (FSETPARA FMT FMTDEFAULTTAB DEFTAB) + [SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (4 'DOTTEDLEFT) + (5 'DOTTEDRIGHT) + (6 'DOTTEDCENTERED) + (7 'DOTTEDDECIMAL) + (\TEDIT.THELP] + (FSETPARA FMT FMTTABS TABS)) + (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB) + (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB)) + (CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;  "There are other paragraph parameters to be read.") - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;  "Special X location on page for this paragraph") - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTHEADINGKEEP) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTKEEP) of LOOKS with (\ARBIN FILE)) - (CL:WHEN (ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTBASETOBASE) of LOOKS with (\ARBIN FILE))) - (CL:WHEN (ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTREVISED) of LOOKS with (\ARBIN FILE))) - (CL:WHEN (ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCOLUMN) of LOOKS with (\ARBIN FILE))) - (CL:WHEN (ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)))) - (CL:WHEN (ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) (* ; + (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE)) + (FSETPARA FMT FMTUSERINFO (\ARBIN FILE)) + (FSETPARA FMT FMTPARATYPE (\ATMIN FILE)) + (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE)) + (FSETPARA FMT FMTSTYLE (\ARBIN FILE)) + (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)) + (FSETPARA FMT FMTHEADINGKEEP (\ARBIN FILE)) + (FSETPARA FMT FMTKEEP (\ARBIN FILE)) + (CL:WHEN (ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (FSETPARA FMT FMTBASETOBASE (\ARBIN FILE))) + (CL:WHEN (ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (FSETPARA FMT FMTREVISED (\ARBIN FILE))) + (CL:WHEN (ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (FSETPARA FMT FMTCOLUMN (\ARBIN FILE))) + (CL:WHEN (ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) + (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE)))) + (CL:WHEN (ILESSP (GETFILEPTR FILE) + (IPLUS FILEPOS LOOKSLEN)) (* ;  "There is more PARALOOKS info in this piece -- we probably lost data.") - (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T) - (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))) - (RETURN LOOKS]) - -(\TEDIT.GET.PARALOOKS - [LAMBDA (FILE PARAHASH) (* ; "Edited 19-Dec-2023 10:13 by rmk") - (* ; "Edited 18-Dec-88 17:47 by jds") - - (* ;; "Read a paragraph format spec from the FILE, and return it for later use.") - - (* ;; "Paragraph format # of 0 indicates an end-of-file dummy, used to preserve the paralooks of EOF para break.") - - (LET ((LOOKS# (\WIN FILE))) - (COND - ((ZEROP LOOKS#) - NIL) - (T (ELT PARAHASH LOOKS#]) + (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Newer file version; you lost PARALOOKS info" T) + (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN))) + FMT]) ) (DEFINEQ (\TEDIT.GET.OBJECT - [LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN) (* ; "Edited 5-Dec-2023 12:28 by rmk") + [LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN) (* ; "Edited 31-Jul-2024 12:09 by rmk") + (* ; "Edited 5-Dec-2023 12:28 by rmk") (* ; "Edited 26-Nov-2023 10:22 by rmk") (* ; "Edited 21-Nov-2023 17:53 by rmk") (* ; "Edited 25-Aug-2023 23:07 by rmk") @@ -1635,7 +1666,8 @@ ((PREVPIECE PIECE) (PLOOKS (PREVPIECE PIECE))) (T (OR (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) - (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) + (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT + DEFAULTFONT) TEXTOBJ] (FSETPC PIECE PTYPE (CL:IF (IMAGEOBJPROP OBJ 'SUBSTREAM) SUBSTREAM.PTYPE @@ -1651,6 +1683,8 @@ (\TEDIT.PUT.PCTB [LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE) + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 15-May-2024 17:03 by rmk") (* ; "Edited 16-Mar-2024 12:40 by rmk") (* ; "Edited 11-Mar-2024 00:33 by rmk") (* ; "Edited 25-Jan-2024 00:00 by rmk") @@ -1675,17 +1709,16 @@ (* ;; "") - (* ;; "PLEN is the number of characters in the piece, but they occupy different numbers of bytes depending on thin, fat, utf-8... ") - (* ;; "") (* ;; "If CONTINUE, return NEWPIECES for continued editing. NEWPIECES is the head of a chain of new pieces that characterize the merged pieces on the file, to reestablish the correspondence between memory pieces and file pieces for continued editing. It is initialized to a throwaway dummy, and NEXTNEW slides down to link in subsequent new pieces. If not CONTINUE, there will be no future editing in CHARSTREAM, no need to build new pieces.") (CL:WHEN (AND KEEPSEPARATE (NOT (STREAMP FORMATSTREAM))) - (SHOULDNT "FORMATSTREAM not provided with KEEPSEPARATE")) + (\TEDIT.THELP "FORMATSTREAM not provided with KEEPSEPARATE")) (CL:WHEN (EQ :UTF-8 (STREAMPROP CHARSTREAM 'FORMAT)) (\TEDIT.PUT.UTF8.SPLITPIECES TEXTOBJ)) - (for PC PREVPC PFILE NEXTNEW RUNLEN PLEN (CURBYTE# _ 0) + (for PC PFILE NEXTNEW RUNLEN UNFORMATTED? (NSHIFTBYTES _ 0) + (CURBYTE# _ 0) (OLDBYTE# _ 0) [UNFORMATTED? _ (PROG1 (EQ FORMATSTREAM T) (CL:UNLESS (STREAMP FORMATSTREAM) @@ -1699,12 +1732,8 @@ (*READTABLE* _ *TEDIT-FILE-READTABLE*) (*PRINT-BASE* _ 10) (EXTFORMAT _ (GETSTREAMPROP CHARSTREAM 'FORMAT)) - (EOLC _ (fetch (STREAM EOLCONVENTION) of CHARSTREAM)) - (NSHIFTBYTES _ 0) inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) - first - (* ;; "NSHIFTBYTES is for the continuation, so the new pieces can skip any charset shifting. We can't hide them from the getfunction of version 3, since version 3 assumes that pieces are in contiguous bytes, we can't bump thePFPOS even though we could deal with it here.") - - (SETQ NEXTNEW NEWPIECES) + (EOLC _ (fetch (STREAM EOLCONVENTION) of CHARSTREAM)) inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) + first (SETQ NEXTNEW NEWPIECES) (* ;; "All the layout and looks information goes into the LOOKSTREAM, CHARSTREAM is essentally plaintext. Unless UNFORMATTED?, APPENDEDSTREAM is appended to the end of CHARSTREAM.") @@ -1726,123 +1755,118 @@ (* ;; " We're ready to put the pieces on the output file. ") (SETQ CURBYTE# (\GETFILEPTR CHARSTREAM)) - (SETQ OLDBYTE# CURBYTE#) - (SETQ NSHIFTBYTES (CL:WHEN (\TEDIT.FIRSTPIECE TEXTOBJ) - (* ; - "Set up for first piece, possibly hiding shifts.") - (CHARSET CHARSTREAM (CL:IF (THINPIECEP (\TEDIT.FIRSTPIECE TEXTOBJ) - ) - 0 - T)) - (IDIFFERENCE (\GETFILEPTR CHARSTREAM) - CURBYTE#))) + (SETQ OLDBYTE# CURBYTE#) (* ;; "ZEROP should never happen, but...") - unless (ZEROP (SETQ PLEN (PLEN PC))) + + (* ;; "PLEN is the number of characters in the piece, but they occupy different numbers of bytes depending on thin, fat, utf-8,XCCS... ") + + unless (ZEROP (PLEN PC)) do - (* ;; "If there are undescribed characters and PC can't be merged with PREVPC, then finish off PREVPC by writing its character looks. And if PREVPC was the last of a pargraph, put out its PARALOOKS. ") + (* ;; "PC starts a run of one or more pieces that can be collapsed together into a single file piece. The paragraph looks are produced before the first piece of a new paragraph (first piece or previous piece was PPARALAST), then the piece(s)-characters, followed by the charlooks. I.e., FORMATSTREAM describes the paragraph-start piece with its paragraph looks forllowed by its char looks.") - (CL:UNLESS (OR (IEQP CURBYTE# OLDBYTE#) - (\TEDIT.PUT.PCTB.MERGEABLE PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ)) - (SETQ RUNLEN (IDIFFERENCE CURBYTE# OLDBYTE#)) - (\TEDIT.PUT.CHARLOOKS FORMATSTREAM RUNLEN PREVPC EDITSTENTATIVE LOOKSHASH) - - (* ;; "We've put out all the preceding characters in a sequence of RUNLEN bytes that combined the mergeable pieces. ") - - (add PCCOUNT 1) - (CL:WHEN NEWPIECES - - (* ;; "For continued editing, make a new piece that describes those characters as they reside on CHARSTREAM.") - - (SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW NEXTNEW PREVPC OLDBYTE# RUNLEN EXTFORMAT - TEXTOBJ EOLC NSHIFTBYTES))) - - (* ;; "") - - (SETQ NSHIFTBYTES (if (EQ (THINPIECEP PREVPC) - (THINPIECEP PC)) - then 0 - else - (* ;; - "Put out any shifting bytes. Inversion 3 all the file bytes belong to a piece, no skipping.") - - (CHARSET CHARSTREAM (CL:IF (THINPIECEP PC) - 0 - T)) - (IDIFFERENCE (GETFILEPTR CHARSTREAM) - CURBYTE#))) - (SETQ OLDBYTE# CURBYTE#)) - (CL:WHEN (OR (NULL PREVPC) - (PPARALAST PREVPC)) (* ; - "Last piece of a paragraph terminates with its paralooks") + (CL:WHEN (OR (NULL (PREVPIECE PC)) + (PPARALAST (PREVPIECE PC))) (\TEDIT.PUT.PARALOOKS FORMATSTREAM PC PARAHASH) (add PCCOUNT 1)) - (CL:WHEN (MEMB (PTYPE PC) - FILE.PTYPES) (* ; - "Set up to read characters from PFILE") - (SETQ PFILE (PCONTENTS PC)) - (CL:UNLESS (\GETSTREAM PFILE 'INPUT T) (* ; "Make sure the input file is open.") - (SETQ PFILE (\TEDIT.REOPEN.STREAM TEXTOBJ PFILE))) - (* ; "Presumably only happens once") - (SETFILEPTR PFILE (PFPOS PC))) - (SELECTC (PTYPE PC) - (THINFILE.PTYPE (* ; - "\OUTCHAR deals with external format") - (for I from 1 to PLEN do (\OUTCHAR CHARSTREAM (BIN PFILE)))) - (STRING.PTYPES (* ; - "Could split with infatstring/inthinstring") - (for CH instring (PCONTENTS PC) do (\OUTCHAR CHARSTREAM CH))) - (FATFILE2.PTYPE (* ; - "COPYCHARS automatically deals with external formats. ") - (for I from 1 to PLEN do (\OUTCHAR CHARSTREAM (\WIN PFILE)))) - (FATFILE1.PTYPE - (* ;; - "We read but don't write FATFILE1 pieces, they merge with FATFILE2.") + (CL:WHEN (EQ EXTFORMAT :XCCS) - [for I (CSET _ (LLSH (PCHARSET PC) - 8)) from 1 to PLEN do (\OUTCHAR CHARSTREAM - (LOGOR CSET (BIN PFILE]) - (UTF8.PTYPE (for I from 1 to PLEN do (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE)))) - (OBJECT.PTYPE (* ; - "It's an object, use its PUTFN. Byte positions don't matter for continued editing.") - (\TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM CURBYTE#) - (CL:WHEN NEWPIECES (* ; - "Link in the object piece, for continued editing") - (SETQ NEXTNEW (FSETPC NEXTNEW NEXTPIECE - (create PIECE using PC PREVPIECE _ NEXTNEW)))) - (add PCCOUNT 1) + (* ;; "For XCCS, CHARSET will put out the char-shifting prefix bytes as needed. In format-version 3 all the file bytes belong to a piece, no skipping in the file. TEDIT.GET calls \TEDIT.INTERPRET.XCCS.SHIFTS to shave those bytes. NSHIFTBYTES is used here if the edit will continue.") - (* ;; "0 indicates that nothing special needs to be done to recover the looks of this piece, its index will be written on the next iteration. In earlier versions the value 1 indicated that the looks were not indexed and therefore had to be written explicitly here. This byte won't be needed in the next version of the format.") + (CHARSET CHARSTREAM (CL:IF (MEMB (PTYPE PC) + FAT.PTYPES) + T + 0)) + (SETQ NSHIFTBYTES (IDIFFERENCE (\GETFILEPTR CHARSTREAM) + OLDBYTE#))) + (do (\TEDIT.PUT.PCTB.PIECEDATA PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#) + (CL:UNLESS (\TEDIT.PUT.PCTB.MERGEABLE PC (NEXTPIECE PC) + EDITSTENTATIVE EXTFORMAT TEXTOBJ) + (RETURN)) + (SETQ PC (NEXTPIECE PC))) - (BOUT FORMATSTREAM 0) + (* ;; "PC is the last piece written for a mergeable sequence. Finish off the corresponding file piece by writing PC's character looks into FORMATSTREAM. ") - (* ;; "RMK: Upping OLDBYTE# suppresses the natural charlooks that ought to happen on the next iteration if we just go around the loop. But things get screwed up if we take this out, even though OLDBYTE#. Possibly the extra 0 byte makes it think that the object is bigger than it is? I really don't understand why it fails if this is left out.") - - (SETQ OLDBYTE# (\GETFILEPTR CHARSTREAM))) - (SHOULDNT "OTHER PTYPES")) (SETQ CURBYTE# (\GETFILEPTR CHARSTREAM)) - (SETQ PREVPC PC) finally (CL:UNLESS (IEQP OLDBYTE# CURBYTE#) + (SETQ RUNLEN (IDIFFERENCE CURBYTE# OLDBYTE#)) + (CL:UNLESS (EQ OBJECT.PTYPE (PTYPE PC)) (* ; + "Objects get their charlooks from the preceding piece.") + (\TEDIT.PUT.CHARLOOKS FORMATSTREAM RUNLEN PC EDITSTENTATIVE LOOKSHASH)) + (add PCCOUNT 1) + + (* ;; "The output for the sequence of mergeable pieces is complete.") + + (CL:WHEN NEWPIECES + + (* ;; "Only for continued editing: make a new piece that describes those characters as they now reside on CHARSTREAM. ") + + (SETQ NEXTNEW (\TEDIT.PUT.PCTB.NEXTNEW NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ + EOLC NSHIFTBYTES))) + (SETQ OLDBYTE# CURBYTE#) finally + + (* ;; "Finalize and append FORMATSTREAM unless unformatted or KEEPSEPARATE (for splitting). If KEEPSEPARATE, the caller must have provided the formatstream") + + (CL:UNLESS UNFORMATTED? + (\TEDIT.PUT.TRAILER FORMATSTREAM (\GETFILEPTR CHARSTREAM + ) + PCCOUNT 3)) + (CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE) + (COPYBYTES FORMATSTREAM CHARSTREAM 0 (GETEOFPTR + FORMATSTREAM + ))) + (RETURN (CL:WHEN NEWPIECES + + (* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must make install the new pieces.") + + (NEXTPIECE NEWPIECES))]) + +(\TEDIT.PUT.PCTB.PIECEDATA + [LAMBDA (PC CHARSTREAM TEXTOBJ FORMATSTREAM OLDBYTE#) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 15-May-2024 17:04 by rmk") + + (* ;; "Write the data defining PC on CHARSTREAM.") + + (* ;; "TEXTOBJ needed only to reopen any backing files that might currently be closed.") + + (* ;; "FORMATSTREAM is needed for objects.") + + (* ;; "OLDBYTE# needed to deal with XCCS shift before objects.") + + (LET (PFILE) + (CL:WHEN (MEMB (PTYPE PC) + FILE.PTYPES) (* ; + "Set up to read characters from PFILE") + (SETQ PFILE (PCONTENTS PC)) + (CL:UNLESS (\GETSTREAM PFILE 'INPUT T) (* ; + "Make sure this input file is open.") + (SETQ PFILE (\TEDIT.REOPEN.STREAM TEXTOBJ PFILE))) (* ; - "The charlooks for the final piece sequence") - (SETQ RUNLEN (IDIFFERENCE CURBYTE# OLDBYTE#)) - (\TEDIT.PUT.CHARLOOKS FORMATSTREAM RUNLEN PREVPC - EDITSTENTATIVE LOOKSHASH) - (CL:WHEN NEWPIECES - (\TEDIT.PUT.PCTB.NEXTNEW NEXTNEW PREVPC OLDBYTE# RUNLEN - EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES)) - (add PCCOUNT 1)) + "Presumably only happens once for each PFILE") + (\SETFILEPTR PFILE (PFPOS PC))) + (SELECTC (PTYPE PC) + (THINFILE.PTYPE (* ; + "\OUTCHAR deals with external format") + (for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (BIN PFILE)))) + (STRING.PTYPES (* ; + "Could split with infatstring/inthinstring") + (for CH instring (PCONTENTS PC) do (\OUTCHAR CHARSTREAM CH))) + (FATFILE2.PTYPE + (for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (\WIN PFILE)))) + (FATFILE1.PTYPE + (* ;; + "We read but don't write FATFILE1 pieces, they merge with FATFILE2.") - (* ;; "Finalize and append FORMATSTREAM unless unformatted or keepseparate (for splitting). If KEEPSEPARATE, the caller must have provided the formatstream") + [for I (CSET _ (LLSH (PCHARSET PC) + 8)) from 1 to (PLEN PC) + do (\OUTCHAR CHARSTREAM (LOGOR CSET (BIN PFILE]) + (UTF8.PTYPE (for I from 1 to (PLEN PC) do (\OUTCHAR CHARSTREAM (UTF8.INCCODEFN PFILE)))) + (OBJECT.PTYPE (* ; "It's an object, use its PUTFN.") + (\TEDIT.PUT.OBJECT PC CHARSTREAM FORMATSTREAM OLDBYTE#) - (CL:UNLESS UNFORMATTED? - (\TEDIT.PUT.TRAILER FORMATSTREAM (\GETFILEPTR CHARSTREAM) - PCCOUNT 3)) - (CL:UNLESS (OR UNFORMATTED? KEEPSEPARATE) - (COPYBYTES FORMATSTREAM CHARSTREAM 0 (GETEOFPTR FORMATSTREAM))) - - (* ;; "Throw away the dummy head of the new piece chain (NEWPIECES is NIL if not continuing). The caller must make newpieces safe and then installed them.") + (* ;; "0 indicates that nothing special needs to be done here to recover the looks of this piece. \TEDIT.GET.PIECES3 says that the object-piece looks are taken from the previous piece (or default for first piece. In earlier versions the value 1 indicated that the looks were not indexed and therefore had to be written explicitly here. This byte won't be needed in the next version of the format.") - (RETURN (AND NEWPIECES (NEXTPIECE NEWPIECES]) + (BOUT FORMATSTREAM 0)) + (\TEDIT.THELP "OTHER PTYPES"]) (\TEDIT.PUT.TRAILER [LAMBDA (FORMATSTREAM PIECESTART PCCOUNT VERSION) (* ; "Edited 13-Jan-2024 10:13 by rmk") @@ -1857,49 +1881,50 @@ (\WOUT FORMATSTREAM (IPLUS 31415 VERSION]) (\TEDIT.PUT.PCTB.MERGEABLE - [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 23-Jan-2024 09:12 by rmk") + [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "Edited 14-May-2024 11:55 by rmk") + (* ; "Edited 12-May-2024 21:57 by rmk") + (* ; "Edited 23-Jan-2024 09:12 by rmk") (* ; "Edited 12-Jan-2024 09:46 by rmk") (* ; "Edited 5-Jan-2024 11:34 by rmk") (* ; "Edited 30-Dec-2023 00:44 by rmk") (* ; "Edited 22-Sep-2023 10:12 by rmk") (* ; "Edited 6-Sep-2023 00:03 by rmk") (* ; "Edited 24-Aug-2023 11:03 by rmk") + (CL:WHEN PC + [LET ((PREVTYPE (PTYPE PREVPC)) + (PCTYPE (PTYPE PC))) + (CL:UNLESS [OR (EQ OBJECT.PTYPE PREVTYPE) + (EQ OBJECT.PTYPE PCTYPE) + (NEQ (PLOOKS PREVPC) + (PLOOKS PC)) + (NEQ (PPARALOOKS PREVPC) + (PPARALOOKS PC)) + (PPARALAST PREVPC) + (AND EDITSTENTATIVE (NEQ (PNEW PREVPC) + (PNEW PC] - (* ;; "True if PREVPC and PC have enough properties in common so they can be concatenated together into a single new piece on a file. The PPARALOOKS test allows for the possibility that different pieces in a paragraph might have different formatting (e.g. tab stops)--but that will mess up assumptions that the paragraph menu and maybe other things depend on. Object pieces and pieces with different looks can never merge.") + (* ;; "PC cannot merge with PREVPC if PREVPC ends in EOL (even if not PPARALAST). (We assume here that EOL's of interest appear only in last-of-piece position.) For some input piece types we can make the decision without bothering to look at their last character. If the destination EXTFORMAT is :UTF-8, the splitter has presumably arranged it so that EOL's only appear in thin string and file pieces.") - (LET ((PREVTYPE (PTYPE PREVPC)) - (PCTYPE (PTYPE PC))) - (CL:UNLESS [OR (EQ OBJECT.PTYPE PREVTYPE) - (EQ OBJECT.PTYPE PCTYPE) - (NEQ (PLOOKS PREVPC) - (PLOOKS PC)) - (NEQ (PPARALOOKS PREVPC) - (PPARALOOKS PC)) - (PPARALAST PREVPC) - (AND EDITSTENTATIVE (NEQ (PNEW PREVPC) - (PNEW PC] + [AND (SELECTQ EXTFORMAT + (:XCCS + (* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ") - (* ;; "PC cannot merge with PREVPC if PREVPC ends in EOL (even if not PPARALAST). (We assume here that EOL's of interest appear only in last-of-piece position.) For some input piece types we can make the decision without bothering to look at their last character. If the destination EXTFORMAT is :UTF-8, the splitter has presumably arranged it so that EOL's only appear in thin string and file pieces.") + (EQ (THINPIECEP PREVPC) + (THINPIECEP PC))) + (:UTF-8 - [AND (SELECTQ EXTFORMAT - (:XCCS - (* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ") + (* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting, all pieces with the same PUTF8BYTESPERCHAR can be merged.") - (EQ (THINPIECEP PREVPC) - (THINPIECEP PC))) - (:UTF-8 - (* ;; "UTF8 pieces with the same bytesperchar are mergeable. We rely on \TEDIT.PUT.UTF8.SPLITPIECES to examine string pieces and split thin strings that include mixtures of Ascii and non-Ascii characters, and to split fat pieces that may contain Ascii character in 2-byte form. After splitting all pieces with the same PUTF8BYTESPERCHAR can be merged.") - - (EQ (FGETPC PREVPC PUTF8BYTESPERCHAR) - (FGETPC PC PUTF8BYTESPERCHAR))) - NIL) - (OR (EQ PREVTYPE UTF8.PTYPE) - (AND (EQ PREVTYPE FATFILE1.PTYPE) - (NEQ 0 (PCHARSET PREVPC))) - [AND (EQ EXTFORMAT :UTF-8) - (NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE] - (NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PREVPC (SUB1 (PLEN PREVPC))) - (CHARCODE (EOL LF])]) + (EQ (FGETPC PREVPC PUTF8BYTESPERCHAR) + (FGETPC PC PUTF8BYTESPERCHAR))) + NIL) + (OR (EQ PREVTYPE UTF8.PTYPE) + (AND (EQ PREVTYPE FATFILE1.PTYPE) + (NEQ 0 (PCHARSET PREVPC))) + [AND (EQ EXTFORMAT :UTF-8) + (NOT (MEMB PREVTYPE (CONSTANT (LIST THINFILE.PTYPE THINSTRING.PTYPE] + (NOT (MEMB (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PREVPC (SUB1 (PLEN PREVPC))) + (CHARCODE (EOL LF])])]) (\TEDIT.PUT.UTF8.SPLITPIECES [LAMBDA (TEXTOBJ) (* ; "Edited 17-Mar-2024 00:14 by rmk") @@ -1972,7 +1997,10 @@ NIL]) (\TEDIT.PUT.PCTB.NEXTNEW - [LAMBDA (NEXTNEW PREVPC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES) + [LAMBDA (NEXTNEW PC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES) + (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 14-May-2024 18:54 by rmk") + (* ; "Edited 13-May-2024 08:27 by rmk") (* ; "Edited 24-Jan-2024 23:29 by rmk") (* ; "Edited 23-Jan-2024 15:24 by rmk") (* ; "Edited 21-Jan-2024 10:34 by rmk") @@ -1980,41 +2008,43 @@ (* ; "Edited 5-Jan-2024 17:46 by rmk") (* ; "Edited 30-Dec-2023 21:56 by rmk") - (* ;; "This updates the piece chain for continued editing.") + (* ;; "This updates the piece chain that is created for continued editing.") (* ;; "Note that the PCONTENTS (= PFILE) field for these file pieces isn't filled in, that has to be done after CHARSTREAM is closed and reopened at the TEDIT.PUT level. For the same reason, PBINABLE isn't set here.") + (* ;; "NSHIFTBYTES strips any XCCS charset shifts at the beginning of the new piece.") + (SETQ RUNLEN (IDIFFERENCE RUNLEN NSHIFTBYTES)) - - (* ;; "PREVPC is never an object piece.") - - (FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE using PREVPC PFPOS _ (IPLUS NSHIFTBYTES - OLDBYTE#) - PBYTELEN _ RUNLEN PREVPIECE _ NEXTNEW - ))) + (FSETPC NEXTNEW NEXTPIECE (SETQ NEXTNEW (create PIECE + using PC PFPOS _ (IPLUS NSHIFTBYTES OLDBYTE#) + PBYTELEN _ RUNLEN PREVPIECE _ NEXTNEW PTREENODE + _ NIL))) (SELECTQ EXTFORMAT - (:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PREVPC PUTF8BYTESPERCHAR)) + (:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR)) THINFILE.PTYPE UTF8.PTYPE)) - (FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PREVPC PUTF8BYTESPERCHAR))) + (FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PC PUTF8BYTESPERCHAR))) (:XCCS (* ;  "String pieces can be merged with corresponding file pieces") - (FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PREVPC) + (FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PC) (THINSTRING.PTYPE THINFILE.PTYPE) ((LIST FATSTRING.PTYPE FATFILE1.PTYPE) (FSETPC NEXTNEW PBYTESPERCHAR 2) (FSETPC NEXTNEW PCHARSET \NORUNCODE) FATFILE2.PTYPE) - (PTYPE PREVPC)))) - (HELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT)) (* ; - "Accumulate PLEN across merged pieces") - (FSETPC NEXTNEW PLEN (IQUOTIENT RUNLEN (PBYTESPERCHAR NEXTNEW))) + (PTYPE PC)))) + (\TEDIT.THELP "EXTERNAL FORMAT NOT RECOGNIZED" EXTFORMAT)) + (* ; + "Accumulate PLEN across merged pieces. Objects are always 1.") + [FSETPC NEXTNEW PLEN (CL:IF (EQ OBJECT.PTYPE (PTYPE NEXTNEW)) + 1 + (IQUOTIENT RUNLEN (PBYTESPERCHAR NEXTNEW)))] (CL:UNLESS (EQ EOLC CR.EOLC) (* ;  "The file may have LF, but we want to restore EOL internally") (CL:WHEN [AND (EQ THINFILE.PTYPE (PTYPE NEXTNEW)) (EQ (CHARCODE EOL) - (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PREVPC (PLEN PREVPC] + (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC (PLEN PC] (if (EQ 1 (PLEN NEXTNEW)) then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE) (FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL))) @@ -2028,7 +2058,9 @@ NEXTNEW]) (\TEDIT.INSERT.NEWPIECES - [LAMBDA (STREAM TEXTOBJ NEWPIECES) (* ; "Edited 20-Mar-2024 10:59 by rmk") + [LAMBDA (DESTSTREAM OLDSTREAM NEWPIECES) (* ; "Edited 14-May-2024 18:38 by rmk") + (* ; "Edited 29-Apr-2024 10:13 by rmk") + (* ; "Edited 20-Mar-2024 10:59 by rmk") (* ; "Edited 17-Mar-2024 12:06 by rmk") (* ; "Edited 5-Feb-2024 09:24 by rmk") (* ; "Edited 3-Feb-2024 23:59 by rmk") @@ -2038,20 +2070,20 @@ (* ; "Edited 11-Nov-2023 16:31 by rmk") (* ; "Edited 8-Sep-2023 16:32 by rmk") - (* ;; "This makes the pieces and BTREE of TEXTOBJ consistent with the NEWPIECES chain and the new STREAM. The character numbers of old and new pieces correspond, so editing can continue without updating panes, lines, or selections (which are all based on character numbers, not particular pieces). This puts STREAM as the PFILE of each new file piece and then installs NEWPIECES in TEXTOBJ, replacing the BTREE and pieces already there.") + (* ;; "This makes the pieces and BTREE of OLDSTREAM's TEXTOBJ consistent with the NEWPIECES chain and the new DESTSTREAM. The character numbers of old and new pieces correspond, so editing can continue without updating panes, lines, or selections (which are all based on character numbers, not particular pieces). This puts DESTSTREAM as the PFILE of each new file piece and then installs NEWPIECES in DESTSTREAM, replacing the BTREE and pieces already there.") - (TEXTOBJ! TEXTOBJ) + (* ;; "The \SETFILEPTR translates OLDSTREAM's buffer parameters to the new file. ") - (* ;; "The \SETFILEPTR translates TSTREAM's buffer parameters to the new file. ") - - (LET ((TSTREAM (GETTOBJ TEXTOBJ STREAMHINT)) + (LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of OLDSTREAM))) FILEPTR) - (SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR TSTREAM)) (* ; "Restore the editing parameters") - (for PC (SBINABLE _ (fetch (STREAM BINABLE) of STREAM)) inpieces NEWPIECES + (SETQ FILEPTR (\TEDIT.TEXTGETFILEPTR OLDSTREAM)) (* ; "Restore the editing parameters") + (for PC (SBINABLE _ (fetch (STREAM BINABLE) of DESTSTREAM)) inpieces NEWPIECES when (MEMB (PTYPE PC) - FILE.PTYPES) do (FSETPC PC PCONTENTS STREAM) + FILE.PTYPES) do (FSETPC PC PCONTENTS DESTSTREAM) (CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC)) - (FSETPC PC PBINABLE SBINABLE))) + (* ; + "If the backing stream isn't binable, the thinfile pieces aren't either") + (FSETPC PC PBINABLE SBINABLE))) (* ; "Non-object pieces are on OFILE") (* ;; "Here, finally, we toss the out-of-date pieces to install the new ones. For complete safety, the rest should be uninterruptable (although the file has just been saved, so nothing would really be lost)") @@ -2062,7 +2094,7 @@ (* ;; "This guards agains the possiblity that a sequence of edits somehow got the positioning parameters cached in the stream out of step with the document. This ensures that they are consistent after all the pieces have been written out.") - (\TEDIT.TEXTSETFILEPTR TSTREAM (IMAX 0 (IMIN FILEPTR (FGETTOBJ TEXTOBJ TEXTLEN]) + (\TEDIT.TEXTSETFILEPTR OLDSTREAM (IMAX 0 (IMIN FILEPTR (FGETTOBJ TEXTOBJ TEXTLEN]) (\TEDIT.PUTRESET [LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38") @@ -2140,7 +2172,9 @@ (PUTHASH LOOKS I LOOKSHASH]) (\TEDIT.PUT.SINGLE.CHARLOOKS - [LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 16-Jan-2024 23:07 by rmk") + [LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 13-Aug-2024 08:47 by rmk") + (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 16-Jan-2024 23:07 by rmk") (* ; "Edited 21-Dec-2023 23:54 by rmk") (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 26-Aug-2023 11:29 by rmk") @@ -2174,7 +2208,10 @@ ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) (\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) (T (\WOUT FORMATSTREAM 0))) - (\WOUT FORMATSTREAM (LOGOR (CL:IF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS) + (\WOUT FORMATSTREAM (LOGOR (CL:IF (fetch (CHARLOOKS CLSELBEFORE) of LOOKS) + 8192 + 0) + (CL:IF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS) 4096 0) (CL:IF (fetch (CHARLOOKS CLLEADER) of LOOKS) @@ -2207,7 +2244,7 @@ (CL:IF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS) 4 0) - (CL:IF (fetch (CHARLOOKS CLSELHERE) of LOOKS) + (CL:IF (fetch (CHARLOOKS CLSELAFTER) of LOOKS) 2 0) (CL:IF (fetch (CHARLOOKS CLCANCOPY) of LOOKS) @@ -2223,7 +2260,8 @@ (SETFILEPTR FORMATSTREAM -1]) (\TEDIT.PUT.CHARLOOKS - [LAMBDA (FORMATSTREAM BYTELEN PREVPC EDITSTENTATIVE LOOKSHARRAY) + [LAMBDA (FORMATSTREAM BYTELEN PC EDITSTENTATIVE LOOKSHARRAY) + (* ; "Edited 14-May-2024 10:24 by rmk") (* ; "Edited 13-Jan-2024 16:35 by rmk") (* ; "Edited 30-Dec-2023 16:25 by rmk") (* ; "Edited 23-Aug-2023 22:27 by rmk") @@ -2231,13 +2269,13 @@ (* ; "Edited 8-Sep-2022 22:54 by rmk") (* ; "Edited 30-May-91 21:45 by jds") - (* ;; "Put a description of PREVPC's charlooks into FORMATSTREAM. The looks apply to bytes OLDBYTE# thru CURBYTE#-1") + (* ;; "Put a description of PC's charlooks into FORMATSTREAM. The looks apply to bytes OLDBYTE# thru CURBYTE#-1") - (\DTEST PREVPC 'PIECE) - (\TEDIT.PUT.CHARLOOKS1 FORMATSTREAM BYTELEN (GETHASH (PLOOKS PREVPC) + (\DTEST PC 'PIECE) + (\TEDIT.PUT.CHARLOOKS1 FORMATSTREAM BYTELEN (GETHASH (PLOOKS PC) LOOKSHARRAY) - (AND EDITSTENTATIVE PREVPC (PNEW PREVPC)) - (EQ FATFILE2.PTYPE (PTYPE PREVPC]) + (AND EDITSTENTATIVE PC (PNEW PC)) + (EQ FATFILE2.PTYPE (PTYPE PC]) (\TEDIT.PUT.CHARLOOKS1 [LAMBDA (FORMATSTREAM BYTELEN CHARLOOKSINDEX NEW FAT) (* ; "Edited 13-Jan-2024 16:36 by rmk") @@ -2259,7 +2297,8 @@ (\WOUT FORMATSTREAM CHARLOOKSINDEX]) (\TEDIT.PUT.OBJECT - [LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "Edited 24-Jan-2024 23:35 by rmk") + [LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "Edited 14-May-2024 12:09 by rmk") + (* ; "Edited 24-Jan-2024 23:35 by rmk") (* ; "Edited 13-Jan-2024 12:20 by rmk") (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 26-Aug-2023 15:13 by rmk") @@ -2267,7 +2306,7 @@ (* ; "Edited 6-Aug-2022 10:02 by rmk") (* ; "Edited 12-Jun-90 17:49 by mitani") - (* ;; "Given a piece which describes an object, put the object out there.") + (* ;; "Given a piece which describes an object, put the object out there. ") (LET ((OBJECT (PCONTENTS PIECE)) (ORIGFILEPTR (GETFILEPTR FORMATSTREAM)) @@ -2308,7 +2347,9 @@ (PUTHASH PL I PARAHASH]) (\TEDIT.PUT.SINGLE.PARALOOKS - [LAMBDA (FONTFILE LOOKS) (* ; "Edited 16-Jan-2024 23:00 by rmk") + [LAMBDA (FONTFILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 28-Jul-2024 21:29 by rmk") + (* ; "Edited 16-Jan-2024 23:00 by rmk") (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 16-Aug-2023 22:11 by rmk") (* ; "Edited 3-Mar-2023 23:25 by rmk") @@ -2318,75 +2359,69 @@ (* ;; "Put a description of LOOKS into FILE.") (LET ((FILEPOS (GETFILEPTR FONTFILE)) - DEFTAB TABSPECS LEN) + DEFTAB TABS LEN) (\SMALLPOUT FONTFILE 0) (* ;  "Reserve space to store the look length") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) - (* ; + (\SMALLPOUT FONTFILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;  "Left margin for the first line of the paragraph") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) - (* ; + (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEFTMAR)) (* ;  "Left margin for the rest of the paragraph") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) - (* ; "Right margin for the paragraph") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) - (* ; "Leading before the paragraph") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) - (* ; "Lead after the paragraph") - (\SMALLPOUT FONTFILE (fetch (FMTSPEC LINELEAD) of LOOKS)) - (* ; "inter-line leading") - (SETQ DEFTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (\SMALLPOUT FONTFILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph") + (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph") + (\SMALLPOUT FONTFILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph") + (\SMALLPOUT FONTFILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading") + (SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB)) + (SETQ TABS (FGETPARA LOOKS FMTTABS)) (* ;; "Indicate whether there are tab specs or a default tab setting to save") - (\BOUT FONTFILE (CL:IF (OR DEFTAB TABSPECS) + (\BOUT FONTFILE (CL:IF (OR DEFTAB TABS) 3 2)) - (\BOUT FONTFILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) + (\BOUT FONTFILE (SELECTQ (FGETPARA LOOKS QUAD) (LEFT 1) (RIGHT 2) ((CENTER CENTERED) 3) ((JUST JUSTIFIED) 4) - (SHOULDNT))) - (CL:WHEN (OR TABSPECS DEFTAB) (* ; "There are tab specs to save.") + (\TEDIT.THELP))) + (CL:WHEN (OR TABS DEFTAB) (* ; "There are tab specs to save.") (\SMALLPOUT FONTFILE (OR DEFTAB 0)) - (CL:WHEN (IGREATERP (LENGTH TABSPECS) + (CL:WHEN (IGREATERP (LENGTH TABS) 255) - (SHOULDNT "Paragraph has more than 255 TABs set--can't be saved.")) - (\BOUT FONTFILE (LENGTH TABSPECS)) - [for TAB in TABSPECS do (\SMALLPOUT FONTFILE (fetch TABX of TAB)) + (\TEDIT.THELP "Paragraph has more than 255 TABs set--can't be saved.")) + (\BOUT FONTFILE (LENGTH TABS)) + [for TAB in TABS do (\SMALLPOUT FONTFILE (fetch (TAB TABX) of TAB)) (* ; "Setting and tab type.") - (\BOUT FONTFILE (SELECTQ (fetch TABKIND of TAB) - (LEFT 0) - (RIGHT 1) - (CENTERED 2) - (DECIMAL 3) - (DOTTEDLEFT 4) - (DOTTEDRIGHT 5) - (DOTTEDCENTERED - 6) - (DOTTEDDECIMAL 7) - (SHOULDNT]) - (\SMALLPOUT FONTFILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) + (\BOUT FONTFILE (SELECTQ (fetch (TAB TABKIND) of TAB) + (LEFT 0) + (RIGHT 1) + (CENTERED 2) + (DECIMAL 3) + (DOTTEDLEFT 4) + (DOTTEDRIGHT 5) + (DOTTEDCENTERED + 6) + (DOTTEDDECIMAL 7) + (\TEDIT.THELP]) + (\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALX) 0)) - (\SMALLPOUT FONTFILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + (\SMALLPOUT FONTFILE (OR (FGETPARA LOOKS FMTSPECIALY) 0)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) - (\ATMOUT FONTFILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) - (\ATMOUT FONTFILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTHEADINGKEEP) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTKEEP) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTBASETOBASE) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTREVISED) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTCOLUMN) of LOOKS)) - (\ARBOUT FONTFILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTUSERINFO)) + (\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARATYPE)) + (\ATMOUT FONTFILE (FGETPARA LOOKS FMTPARASUBTYPE)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTSTYLE)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEBEFORE)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTNEWPAGEAFTER)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTHEADINGKEEP)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTKEEP)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTBASETOBASE)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTREVISED)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTCOLUMN)) + (\ARBOUT FONTFILE (FGETPARA LOOKS FMTCHARSTYLES)) (* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)") @@ -2397,7 +2432,8 @@ (SETFILEPTR FONTFILE -1]) (\TEDIT.PUT.PARALOOKS - [LAMBDA (LOOKSFILE PC PARAHASH) (* ; "Edited 19-Dec-2023 10:14 by rmk") + [LAMBDA (LOOKSFILE PC PARAHASH) (* ; "Edited 14-May-2024 13:32 by rmk") + (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 25-Aug-2023 11:41 by rmk") (* ; "Edited 3-Mar-2023 23:28 by rmk") (* ; "Edited 30-May-91 21:44 by jds") @@ -2409,9 +2445,8 @@  "Place holder for number of characters in the piece -- really taken from the charlooks.") (\WOUT LOOKSFILE \PieceDescriptorPARA) (* ;  "Identify this as a paragraph looks piece") - (\WOUT LOOKSFILE (OR (FIXP PC) - (GETHASH (PPARALOOKS PC) - PARAHASH]) + (\WOUT LOOKSFILE (GETHASH (PPARALOOKS PC) + PARAHASH]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -2420,7 +2455,8 @@ (DEFINEQ (TEDITFROMLISPSOURCE - [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 25-Dec-2023 12:28 by rmk") + [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 17-Nov-2024 10:03 by rmk") + (* ; "Edited 25-Dec-2023 12:28 by rmk") (* ; "Edited 5-Dec-2023 23:46 by rmk") (* ; "Edited 26-Oct-2023 11:22 by rmk") (* ; "Edited 22-Oct-2023 22:55 by rmk") @@ -2438,41 +2474,63 @@ (* ;; "An empty window for TSTREAM may already be up on the screen. Since this conversion can take awhile, we tell the user what's going on") + (TEXTPROP TSTREAM 'PARABREAKCHARS NIL) + (TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE) + of USERTEMP))) (TEDIT.PROMPTPRINT TSTREAM (CONCAT "Fetching " (FULLNAME SOURCEFILE) " ...") T) (COPY.TEXT.TO.IMAGE SOURCEFILE TSTREAM) - (TEDIT.PROMPTCLEAR TSTREAM) - (TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE (fetch (READER-ENVIRONMENT REREADTABLE) - of USERTEMP))) + (TEXTPROP TSTREAM 'PARABREAKCHARS NIL) + TSTREAM]) + +(SHELLSCRIPTP + [LAMBDA (FILE) (* ; "Edited 15-Dec-2024 11:12 by rmk") + + (* ;; "True if FILE has extension .sh") + + (EQ 'sh (L-CASE (FILENAMEFIELD FILE 'EXTENSION]) + +(TEDITFROMSHELLSCRIPT + [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "Edited 16-Dec-2024 11:25 by rmk") + + (* ;; "Use DEFAULTFONT for shell scripts") + + (STREAMPROP SOURCEFILE :EXTERNAL-FORMAT :UTF-8) + [if (TEXTSTREAMP TSTREAM) + then [TEDIT.LOOKS TSTREAM `(FONT ,(FONTCREATE DEFAULTFONT] + (COPYCHARS SOURCEFILE TSTREAM START END) + else (SETQ TSTREAM (OPENTEXTSTREAM SOURCEFILE NIL START END (APPEND 'FONT 'DEFAULTFONT PROPS] TSTREAM]) ) -(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)) +(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE) + (SHELLSCRIPTP TEDITFROMSHELLSCRIPT)) (RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4746 30357 (TEDIT.GET 4756 . 9598) (TEDIT.FORMATTEDFILEP 9600 . 10916) (TEDIT.FILEDATE -10918 . 12089) (TEDIT.INCLUDE 12091 . 19059) (TEDIT.RAW.INCLUDE 19061 . 19869) (TEDIT.PUT 19871 . -26814) (TEDIT.PUT.STREAM 26816 . 30355)) (30358 49522 (\TEDIT.GET.FOREIGN.FILE 30368 . 33553) ( -\TEDIT.GET.UNFORMATTED.FILE 33555 . 37429) (\TEDIT.GET.FORMATTED.FILE 37431 . 40219) ( -\TEDIT.FORMATTEDSTREAMP 40221 . 43121) (\ARBIN 43123 . 43843) (\ATMIN 43845 . 44382) (\DWIN 44384 . -44763) (\STRINGIN 44765 . 45473) (\TEDIT.GET.TRAILER 45475 . 47991) (\TEDIT.CACHEFILE 47993 . 49520)) -(49688 63095 (\TEDIT.GET.PIECES3 49698 . 59857) (\TEDIT.GET.IDATE3 59859 . 61254) ( -\TEDIT.MAKE.STRINGPIECE 61256 . 63093)) (63096 75039 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 63106 . 69222) -(\TEDIT.INTERPRET.XCCS.SHIFTS 69224 . 75037)) (75061 81083 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 75071 . -81081)) (81106 89610 (\TEDIT.GET.CHARLOOKS.LIST 81116 . 81847) (\TEDIT.GET.SINGLE.CHARLOOKS 81849 . -86422) (\TEDIT.GET.CHARLOOKS 86424 . 87754) (\TEDIT.GET.PARALOOKS.INDEX 87756 . 88300) ( -\TEDIT.GET.CHARLOOKS.INDEX 88302 . 89608)) (89611 97849 (\TEDIT.GET.PARALOOKS.LIST 89621 . 90243) ( -\TEDIT.GET.SINGLE.PARALOOKS 90245 . 97257) (\TEDIT.GET.PARALOOKS 97259 . 97847)) (97850 101249 ( -\TEDIT.GET.OBJECT 97860 . 101247)) (101311 133882 (\TEDIT.PUT.PCTB 101321 . 115324) ( -\TEDIT.PUT.TRAILER 115326 . 116093) (\TEDIT.PUT.PCTB.MERGEABLE 116095 . 119613) ( -\TEDIT.PUT.UTF8.SPLITPIECES 119615 . 124702) (\TEDIT.PUT.PCTB.NEXTNEW 124704 . 128479) ( -\TEDIT.INSERT.NEWPIECES 128481 . 131480) (\TEDIT.PUTRESET 131482 . 131724) (\ARBOUT 131726 . 132450) ( -\ATMOUT 132452 . 133057) (\DWOUT 133059 . 133338) (\STRINGOUT 133340 . 133880)) (133883 145276 ( -\TEDIT.PUT.CHARLOOKS.LIST 133893 . 135565) (\TEDIT.PUT.SINGLE.CHARLOOKS 135567 . 140811) ( -\TEDIT.PUT.CHARLOOKS 140813 . 141957) (\TEDIT.PUT.CHARLOOKS1 141959 . 143010) (\TEDIT.PUT.OBJECT -143012 . 145274)) (145277 153315 (\TEDIT.PUT.PARALOOKS.LIST 145287 . 146189) ( -\TEDIT.PUT.SINGLE.PARALOOKS 146191 . 152240) (\TEDIT.PUT.PARALOOKS 152242 . 153313)) (153410 155092 ( -TEDITFROMLISPSOURCE 153420 . 155090))))) + (FILEMAP (NIL (5010 33799 (TEDIT.GET 5020 . 11029) (TEDIT.FORMATTEDFILEP 11031 . 12347) ( +TEDIT.FILEDATE 12349 . 13520) (TEDIT.INCLUDE 13522 . 21433) (TEDIT.RAW.INCLUDE 21435 . 22243) ( +TEDIT.PUT 22245 . 29964) (TEDIT.PUT.STREAM 29966 . 33797)) (33800 52997 (\TEDIT.GET.FOREIGN.FILE 33810 + . 36995) (\TEDIT.GET.UNFORMATTED.FILE 36997 . 40871) (\TEDIT.GET.FORMATTED.FILE 40873 . 43694) ( +\TEDIT.FORMATTEDSTREAMP 43696 . 46596) (\ARBIN 46598 . 47318) (\ATMIN 47320 . 47857) (\DWIN 47859 . +48238) (\STRINGIN 48240 . 48948) (\TEDIT.GET.TRAILER 48950 . 51466) (\TEDIT.CACHEFILE 51468 . 52995)) +(53163 66713 (\TEDIT.GET.PIECES3 53173 . 63475) (\TEDIT.GET.IDATE3 63477 . 64872) ( +\TEDIT.MAKE.STRINGPIECE 64874 . 66711)) (66714 79089 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 66724 . 72840) +(\TEDIT.INTERPRET.XCCS.SHIFTS 72842 . 79087)) (79111 85133 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 79121 . +85131)) (85156 93847 (\TEDIT.GET.CHARLOOKS.LIST 85166 . 85897) (\TEDIT.GET.SINGLE.CHARLOOKS 85899 . +90659) (\TEDIT.GET.CHARLOOKS 90661 . 91991) (\TEDIT.GET.PARALOOKS.INDEX 91993 . 92537) ( +\TEDIT.GET.CHARLOOKS.INDEX 92539 . 93845)) (93848 101016 (\TEDIT.GET.PARALOOKS.LIST 93858 . 94480) ( +\TEDIT.GET.SINGLE.PARALOOKS 94482 . 101014)) (101017 104607 (\TEDIT.GET.OBJECT 101027 . 104605)) ( +104669 136931 (\TEDIT.PUT.PCTB 104679 . 114329) (\TEDIT.PUT.PCTB.PIECEDATA 114331 . 117529) ( +\TEDIT.PUT.TRAILER 117531 . 118298) (\TEDIT.PUT.PCTB.MERGEABLE 118300 . 121734) ( +\TEDIT.PUT.UTF8.SPLITPIECES 121736 . 126823) (\TEDIT.PUT.PCTB.NEXTNEW 126825 . 131092) ( +\TEDIT.INSERT.NEWPIECES 131094 . 134529) (\TEDIT.PUTRESET 134531 . 134773) (\ARBOUT 134775 . 135499) ( +\ATMOUT 135501 . 136106) (\DWOUT 136108 . 136387) (\STRINGOUT 136389 . 136929)) (136932 148915 ( +\TEDIT.PUT.CHARLOOKS.LIST 136942 . 138614) (\TEDIT.PUT.SINGLE.CHARLOOKS 138616 . 144259) ( +\TEDIT.PUT.CHARLOOKS 144261 . 145486) (\TEDIT.PUT.CHARLOOKS1 145488 . 146539) (\TEDIT.PUT.OBJECT +146541 . 148913)) (148916 156410 (\TEDIT.PUT.PARALOOKS.LIST 148926 . 149828) ( +\TEDIT.PUT.SINGLE.PARALOOKS 149830 . 155269) (\TEDIT.PUT.PARALOOKS 155271 . 156408)) (156505 159099 ( +TEDITFROMLISPSOURCE 156515 . 158348) (SHELLSCRIPTP 158350 . 158579) (TEDITFROMSHELLSCRIPT 158581 . +159097))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index c8ad84b48ef47cb70dd0f0e59fd3c160d8fdd268..d780e5fb6c7c6c885e967239eef4029d10cf7ea8 100644 GIT binary patch delta 14760 zcma)j32DHJ>NGaeZ5sNeb=v1PPNz=C)39y2QgNqgXPT(r zf6l$YCGF|dGX~GT-T(jo@Bh!yuRrJbt2M`!)8)`m?A-j2>Qe(uQO4BZm=f}`e((H+ z`yW_bIagvA&NDCjSTPfirQ$kQ zux76kv<#?@`9foXu$P^^c&<9)xeq^Z@zRkoCOVfBIX#n4#?$G1G?$txutm(5m`7EBba>Dua5E+J1dK2?poyl z8=K0-Po?zf{7?)NVm|A(73_IT9rd#2w@&zW^Z5pv#Vo@o;swp;^C|SBva#4mb3acU z_V6CZx9qR;A2{xGOzq)a&S&ERhNi_-Hl`P+^YPqNPM>0`&o9rEDWiTiHEq<3I%UMS zyCf9ix19U$3$s}{cOibdkdGJW6sHO~rl>xqPsOvMxPW8Lu#pj(l?ud|;h@FZjG7?4s=92>}VPoah`hcw0$0wNLA7N%YwU+cL zESipMIjo3{`1!561^zSp5q^LDi+u0F?s>(}XeTVelmIj5K_mW3$((H+92s3A&v9jry2eloATDn4Wz{0g@MD z<8g>woGE3$(BDLsVVd2YLq2mptb?ggLoYjj;WB&Qg%6xB4GrCQ_QFMAh!#S8b3VE}wmw7twO-S!S#ox1Mj1M;Wt{rM?J?gaE>LNne&f0iu{~bKl^9~Q@ z7huMMVnb36uqP$NAMD?^@$_vCPX6n+y@UT+OR7%C@$$d8?ZA;Rgha~~pp+vl4q;3% zK!+hhP*k7LYW~LIo|&mMP=~$@DX^an3UL@hKAz2|^sH3u0LyEMICT1_jZM($4yhO2 zMR$9y;qCOg%QN4_v#p0)k_!`?4N?R9_=By3ZG$PXzYT9{0lLV)+Im1OwtanRzO7Pp zJy&$sRDIr6DYg||H@~_I4T?P*5A&_oJIh}NSfYUdiO*TmmGu9Tb5ycostOIB-7#=> z=8+xXa8%|5#JrF!iM9)+QYqEiNB|(pD_Ah56LranW*h%z+dfCJo4?d{pe*LOyR@7U ziA{%SBo;O~ktue_)Mg7%BQUC(DihVGW>{dPnxCE`6F8iYr=ea|;bno4V(lTS17ruJ zE(HQA>)2&r0=`kcxVN_q^)cj-5LwU7Xt5ack5rY`C>@TUf_-9s=ok%TNQs}|3$kZs z{Xs$m(#=#hp))_!#;{F(MXe@bJ856hq?XHfFcmOD+3}e|JP!yM<+t|kduLd+&Z7dp zEYqqgkg7H<&=B~wuU(*8b#f&XBvgw6bq&;10s)A0HbzZ`im5`JYGD73riB(q>)`E_s7SNVBRQp=6ukJ;zc}gX0-?GZ46~1A^;jww1#~_H2sWWrRsAN&jsSw?2tk!W(Bc4e zJZa3$fdL?4fcJKU96>)n)xn&KqVf-SuzjFW-qiW| zl@FB8RgpBrU+f5u06YWLIsoX%e-l9Ym6rWHzDMQ%-tsQ~bJi}Pvtc)M_NKDY^mHu# zU%)5-myU0`!#HIawJDe`oE3y4l|8|q>3pDJM8f2N`@qaJgg%$iV3%We5mG8vIHk{& zi^l291&GR~1I+PQQv=|#%Ye)F`x-1<=I-@l#jc`@f7X5M6q6t)pj4ox0FsrN?dP4J zShHt~E|Gs`&GwjqK$5boUn;s@NE-a)`MpR9ka?}_A^ZL{d+ckX*vlN+df;~t>gqx-_4?us0&*!|69(Jdx-Hh|h!^TJd^Lcv*Ke+XU)q6MA<9}PTL;C+n6 z;t6d!4Ne>im5quaV-ZRaVk`g)1`h^SS^-F{+zF;INiv1UqP zEd7J$E`I3Z;^lMf^11sTSV1u2E;LfZn33A3VL$&1&w!H*{}>w{Zx&uS4M*l7{NJ<> z45rLGbMBItfpbI;9Cd`7`O<;4HXj&vy=f*&{7}z8e)KJ_2t=pqx0y1AGm=&WNMVR} zl>zMH3e9?7EG@CiK{!m_wTXb!B zWJ-*lUld4*_GO!`BD;%{`G!&i@ESt@NWY$x-g zr9quVT6T3!tp8k2dZS7HCD$41T~kiw-6oT~3k0Hy92Uw-5gFsqcT!emR6+2iYaj$3 zDB>h{3IA|*DjuJN3IbE`buF=&0RNBP17%2|g>X`U#%Lpmt%BHw#1-O_A}Xa|{_1)` zX3V*Oj>fXc3QR={;|$!^Kq|sCkW$M`n212FY?=#9BRD+yazM;6(k%r?W4OFHij)ZC zfP;x;089*(27H+~fEk2t6C;CGTU3%X5~KBNaQ}p{fkz0q>)%MT-)<`ZZy4Kp%^)V? zPb4ZnS-V=7BGzI1l#G5XxC<$V!(l&zUwdiAxxK!>6455cqtaY2B!#G~MoTM>?XOsC zR(+-AT_wFs+h0Xrhkb%SIiNa%qkMCqw+s$z93%PgQ>l0qzCA$HC@dhV3G+}R*f>LR z*gmkZYAdr)VKooSEK?Z*W5#HyEaH4}l01X)oh|VB!S?sSn=u+tr$SD{x6k2B;q@3_ z2`i{3O~XZpuK0r+zcu(mV;P^fM%}UCQ8oce2?9VCSQ2_DZ25ur(6Z zt-YWi<`@}`I*!z)k_BOQ7XmXly(nryV-Zyq$si-&3mA=J%t^J7om}b!6(2^fx+#9d zAJ}h*W{OFd1Pu01_CZegRX@9XhpdBbb@%GumsaYw*H2bb_uqQ;g$c9iDICrz(N_G-bx?k}y`x?4 zb>3*`T(hm(=e!lYLua~I;q*I&_H`cb{#81yIxJzCNG9CLlEKN1=|5fNWX>_`mdF06VdgmIBprxGdg z-wJk=(@$m7?xsrmrPT7PGi$$SUcj;GJ)2E8dOIV+jEEsbYWu0Q{8(w1_#$&Xn=SSB z^&Y)PWU)<|*laNlk_K|2#hO{+n)9Gcw)WuUuj_ZXbdPAg`Z-&F81yF&x)Xvni@*LL zKOeed82rY9xk32o7R(PKlme9|ET?chDBWtKI}wEMYUn$(FCQPC(oVz^IfQcaEErIL zms*Sk5j4d}8p1J%V&-xh!ZqNqhKn2s`FJ}&a410W1Zw3+utT=;Q#evO(*AIee?Q#C zf8|=ei%9rv;!K<@15qJvKhbl$zh>JAc@V#Y*G=I{z7{^{7^U6^%h=&;3_)cCRIGag zgO|ks8OxSMtR$`{uwMXF7!ycL4Pk*s3czQi5En2~Se=nlLu~AHGzxqKT*2ft!tX`s zGsJIxpc^sY0Q-2IQ#2)Zdidj5Z7m)}0q9-Tu!+*38pt-B$Q1HZ@hF2q+tm~X(}Y_; zg)r&9gg_QloOz2{E}PnTbL0=2TCApF<9D?A`nxGAK9dHy$`PnxD>&smB_SNsQwTuQ z#SW<6nK)9w=7a_-gA^D!1@MugC;(zDNa5>I{6(Us667B|F;I5A*=@5qgx1_4(5?NA zHVHxP_Pr7IMuffA{@{KCl=>>N1d1pVrSs)mH=jIz>(&pKe>gW-Ny>INoJ-IxBjav1 zI~}h`%c~zh&um*WOWXe^RnPmAt>rdXt;S{BI)j>tdgoIULW94y{K(QP4qvTBlWptn zrR^K7ll9K$n83BtwEh_YZgPKF+{pHM1y4#hi&T~w8)?ZLYw?rvLki;yxq3- zUKD0gC7q7WmNu5z>$V8mpX1M_+FKheYjE)2PIZ@S zC$PLV*F$6V&{*;&OP+IetbW)P<8uwduq0oub1iLuLjdCA;uj^hoh71JK(j#QlJm=U zfz1NwKBM=S^`o-ZTS@BP-zBTFeo*%cbQW#q`bxhn1`)YO^*$I)w1k<9=)F37O%x|V zw8Mz4T7V%8hmvGm#6H3ZHBv@|p+j({MFt92D8nZX8+kA?qDe$;qLYIx2*1jNFp7ax z)8rNz&_*H8Y8qHtP5a52^%hoL5r&j5Q7h%bP3|n#_h_#%GgSF%kmbK(|EL4HP zs?{k#_Et;QH^O6?K8J5~V=1%dNC3OFaiW5ty4pBlW`H;-(numsqKzlgCy-QkprVM3 zPU+Mf$C)YcD~bKb9KUF_f@CwXzb5)=s7S;!fHL2hprjXo=MMX0{pHMvZ9b#2Y|V?fr^60(r{ zv$rDi?DEZLR{Fl3OuL7H#mnt#%WYsSt~b&8S9yERT`nzEC%eb8q?6Vq#jHyT6E8H^ zH%N5O%p3&y+#>5D6k#=;+OB5n7~byxJR8*aUO!86wdj;(iq!F8;S-Fm;?eH4^; z^``FbcrlrA1G+YczmZ(&!-^+Y90GT-+J7bJ{Url>k^gIPm`((6>DbGjs?F)Drh2NW z-fF6&nsQfD06zIC-9RUqx=NPE0|YiIVEx3=rzT$e`OT-z(w1sz*;+hUEw+{(ecMvE zwRF8(+rd{cTMhSs3Rc`hj8ZZXAYW#Rzu4GV4g+;8yf92$$^Z-~owWv+Fh&ibq@^Z= z+hMZ?H!jv11p3UHK=s~?_-Duu;)!|6K&BAUIyq+ubDBxK$S{(43RF!Z-e;DAgU)J& z3`U@^w3!6d8x2I9*}%s@&9Rk!v`XG~;!IhvPKw(GgElj4qg1G*)4i zCZ_X+R3e3uDezOBM!__)wPIYV@%I$>JHvqxFBZcGi8C|rbT)@a3MaDQc`vdP(?B#1XT+z1@R^|VMS3=KsPr!1JJj}1=Ywy7{Qj)?sr+Kw{3snKEp z-L%L{M?b0Mlc>a1BJolq7h?2qBaeG}#C7Q51tIuUG^$Sv78{_Dv0&+h(YO_`USLhJ zcOVFsj+s#ae3j{(nenk~KAB1sD4*vGvuUT}p8fp)&ieUJW*<(q-`^qC`$qkm{fzYV zJeBlZZzZx>_{unbgc?>d%dfsD8yZ?$8P{Er&C}8+9oO6V>OG!&JGEu~Xj{k3w{*{D z!(5-h>A%za2)+6QhycC*9Cgi4)6dIopi<9`>mJ=DhoMRIE`j;m>tRjzylivUc+%Cy zNBFIKyUT7&(%;rG@x$NLJz8XZLPoACx~H_+l-0W;GXEva&@|^+{YxXz(Jc11nQgc4 zL;pc6a^i>No6{V?ZY+c8o~+(xj7CdIuXlrhc_vWP716tstpd)=IGYr0u<3?2xiK>S zmhrnV{_(bs%!*S6ASO3DW6zCiOXK1MWLdg&b+gHEtUYVL_+49n5ME~OayL+U0WB6(M)}v~Jx;{Pxa%YCdfe^$7$08ngaQy;(<3&5nZrVQ5PF1fi;zAs z2!N`%)X2m$eqBXbUl7<5K zme6T1%-?x#w7dhW%r|UPz$s#8(s>O6-x9I-DY)_Gr4jfSE@-JN05F#8!7~VOVJh?E z;LI|tPddIT5J1$bKv<(z89iir$OIc^X^@yQ-3%l2tdNI%l47{h+|+baffbQuyPaTM zH|=tQan^(-z@u>;xA~y}|K<1fwfRFn)~|w_;dv-7HMZWDFH^+X@{zhHO9CG+BDtLC%%XibuceEWfm~WYac>hd%e;dTnw=&hy%fI~siAWyhyi zV%u}BN;Y$IKh`?2qIHm-?g<{_hEr=Bn|hf zGO=97Dt|(e#$(hh^0K?}jdo|V!5D7^G~JzKKbC_^0=N1%rIkI~>$`^Cqb0?TEPMY6 z@MXO-qD5mu`J?h4##Ljr@a_EJa`om_ns#~?GLG8-=7$nmblHe0`N_{hHR&<)!&kz! z-^ehYNJMqWB*m7%Ak2C}6RH^>d1XdVlKmq`NQLj68KMBtPqjsOeY=hFQKnX*Lc zG}*tf(Q-!EHyA>*>&%dzNRW`y6^c1B-6UIBTR`Ey`K}RKHAXenEyM_Wpz`KL35AFJ zu+m=W3Wa%SNqO8A^8a_aXCwUn^Y*OmmV@p(#HGg1Nc1%P-|ny{amp|+TPgYX^~h$6 zw%H<{T-g3Nvgy(`T{81~5n*`50KduqVd3`ZSEKTg*!KFnDuysWOY(ZHviLcC;^&(n z4WC}#rimcuqKa1*S9_`Mc1_gr(~I})!6mAIQq@1gzq5GY-5@3A_TbQs;R_9oARbjq z;+3R8DB3kWqwELCP<*)PQNkNtORqF^lA_PjgT7pDdP>j;#WD&-Vb~>4f%AOW*A{zir!E_>=Q{Z*Bef55fFbI+kDi{=)zNLtAGD|L}tsnoHOV z4(jUi9pfE1xB+^zrCr zwYca}(a=aCtZSr*bjfQVxa|^=LA}l6P<8<(odw;8d$GBAE(?;H(D|WDrzeo7=ca^a zH7-PW2IRBAS?x*|7qOp#)pzc=>S$M-8h`21;dZH}12`gvx1WQjlXvDf*-AD_&?lvorkNQx(bgF@d%3TkIAF zh3w(;^R9<}G)*_KmUssq1lDqJc`P|#fF%ccuI0!kTXJFkLizwd_3)qr*Sw#2_#f?2 z9)5&vTrbbm@tcn+_GA3;@gF)W}?GP$hS@rZByDOB)mq|%N`KY zg>AE8pP7(X9B4RbmK-$`#$W>Sll<$S9*m9Prq^=TBR;s5;&8(ddLxDB5tb%l9Jl3j zghMKS@H1Uygs;d21fJr;6H;fU;apYI(8FpP-j$gS;ayENP0w76z9B@Cs%fYtd7CtT zNO-tLngW4nUltW$b#l!VK{Hb1LQ8R}?kGs|FUv^$46zqiy#d;Xs0#Q^c?^(OEXw?N zMP**DKwd08%W!kRoy_IGOsaw!%0?escf^A$uSWDZOlfx5dkb|E`EEQ%M0$w_ZhfLuSN-QaOZb z3_(DH$R&UIe|)%i1m@KlksQVNQ;Agdjh8-u$YX9C7E7K0VyqBg(0_jDqeuAfeSXeA zhrm~ZcH=hTGM$xAsO7UgO|Z$RbjKV*afJ7$arFy_6;Ww41T6wk(hZUfapM&5`goWM zh70;I0vIRajQ?@hzB2qH^NAj=xT-JoEKlMf$5JS@f}X)w%f^PQo;h75)n*Zn3S}iQ z<7n{3=~90j9VQ9T^59$IPBESvif2!ya%DZ6p*Po%M=`WC)D%0|(Tz?Sq|VFa11!Wh z66Y?@FD#yaKf}M&vix(eDfy3_$ix%9haJOhmCbIsq7}y`9c7%-2|RL1%V&bdzXhOM zFvMKaG0chGU0Oge0b7#)2mocqKUvuI54iXbKA$S%&1?150tMDF`>f4wYml>xIpy~f zYgqTn?>QxMc*7)s5f4XVaY1%h4@VYaanVcsjEj2lBR%c24h=hi^Gp6Aj=gMhLlKUf zLSYOKJ_y2$G_;MxKz<1En3*1K$`=`c$?Cla9@3#n)-mK@e6e#6hQlM26fT=b_|s1uw>R_Of8q|l z^+e>L@ekN?T9KGJJzh4X5HE}vAHOnzwx7RpfPdjiBX=Ha=ij-apycM2gAUfrU02UJ z`kOaCboKl8rUBNU$mUU4;*5Wi$A+5?q%@x@SsX`8jq&nD#02=ycn=0|Ior*TUGL_x z>j7tTBFopVckwIN8~ERSq=$d!S|fkudMp2f>-*92M`(3+-p%(sIo8sABCU^W=~E>9 z{N$6d!)%AR%6;yZrYD~~#DD*(zCPB!Q@Dj9?rOa8=TGjnqveia->zXZ|J$eH{|U$U Br``Yn delta 14704 zcmaKTYjj)JbtWDpMbi|;2S`ycEgeCRkdnyYUOY)T4lY1Y014niAV`X~6j%~z^QDIs zIZfj@khAP@(|9$OjwQPpJ5AcSopd!WNmw&=8wYE({Sm4&QK#c}?6usaUQ?xAZPU`@ z>HL_CtNHdh_g-Ac@@OrQ`<%1yd7p28d!NJqvF7^z>#i4$m6gHqCsqbkzZzspa6}D{ z_(ML{?>l|&%=yKY`8js(Ec3A^v&qp+a`veQRu)fPICR~X)P;GgzWFbnzwr5eBkZ`SVyJv1SscozlZoVHfGwh}v8hak z*{c~E8uGEZlNZsKyVf7_4Yc%A9}iyO?wtkxvHthNTG#(JhbjhHIc9}losluXvICgtxZUqmG5aHe|Ao! z7w;wI${tyTCQ{Xuc8+pIg;HUmea6ebwPmNv8{^e2+mFQB9sO!hVYH8PS~kg4%=~0} zWTcRsOctkdw4}(xWM`)_o+1`?SkC4U#;*DOeuY+-AMNrS#Iz>#TtX`{B@&?3wH8YW z4YT9WH)k@)&o*x_t7@%T#UH9$-eJXD&a5_(r1K(rCsqzyof=Q)&;*MLMRPHSEKT$P zI#v%tewM}dPojfk=|YwT{H!dGG#A=I;K?@(UZ4sPU6?;M(D<%s}4FoME z)gS!WWGUeY%V?8Dv~G1q2?dz!F72mLJ@+Zh(HZQgcydfHB$@fxxvAcr_Nmf^7ydvnGcn)M=zW^GXkAJn6s9Bl`r4h z>^3**_u3|!WRv`M_k-R6=KQlQ4o8#Rqm`rbx7JZ;;@{u4hrhS&!1yk?5i8qMY1_7% zYo#r=&>sJ-rBe;n#P>C^9mSSA)l`iqKKNEjXfK+Iqm?i5lkE?de?6UxC&b6UVoBA^ zZ_7riIkCB`RA;WP#@y_sw0*~`G9?;(GxZ2{W|uq?9!GU9?P;kRDOXkKRMQJ{lv8#% zQsW{=)MgyE5s^qPc*Vc1ja1zUd0ypd^gcWnUw$VMe^>TFYD|pF)0Ns78sBJHepggG zvC)dd6~xjT#zSC^+!gs^A;p40KUSS~b5@^DvS2_pHK+0f(?gTV3=865m|G(-9K912 z1K}`#zhkE>ILw`$o>SPs1e?Y=3t%hRj-47+#m>TEO6SIOriO7~B~Yq3pq2=1)AO^i zA%#h%qK}k{&lZzN1^oPl&hAgEbgHKAjL*9cM(z#>7=oNa)Gbd~$WP6ct%HJ-Y|KB*2##K67Dp$jhFB&! zR%Ahi)_DqLu)T@TuAM&>TSSNHGPtjj~*F2EQ@Q zQ$<2K6<<7=(?`>V1n}Z1KrYP{l_)TTCbR%AWDNmzh+*?26UDTi!>XAB5uh;~Vg3Eo z6OlVG01gr6Kk$TIil6^44|7HRe0w+B7Y4TEPM(=(=N@Gj7v`B5*~N2UJ*QWmn42GA zfR!N6bcgs~^!#p97&B7H@)x$Bzc0dQ4cQorvMFq{LRJF|kA4;z!`$EBeZ)_yi6o71 z49Le!tAGRyg3upeuBk0e4(Cjdw3J61ZIks3rzv=Zld-*SV@84~diE}J|%(VaJn&UqUam}$Y)6S3XINaP` zooTy%V#dQ?+z|(@adJcfBOY@dZ&}} zLkVuR?i#R>o@rlLlu$Bj8|m|N&JJgjM8YnY`}+Un-}Y_~)UbEPBRaeJ@8vhLCux9A z2L^9|`6FH1pd*Aut@FPLu-?aU4HxuLIa`Mjdq)KLB=n#|aMv!6vA~ zvUfF`A5bD}YA~TqCRqS`DOXGph~cx2Srv?cD>ez;= z4%f|=s)YH|eco9hf_)MdfSv4|B)e+VOk%@h0-$TmtOAHOG>PHf(H!_ICM^%cV9m8E z*n!n`i>cyhheQQgKo}@~2n2gHSxlPAP{`mfAtl1k-0v-if(8)@(sUN4a=CQw$PoGq z-)0iF$>P_wCB^j0^9idIWbt%PE6f7y>KY1QKLK*0v;mE_)iCCisc_jW&J2K*J5;y^ z0*n;&o-jed&N5I>2@iu+C&#p@41f+DmidE5CzL?c?2iIgYJ7x6lLQM)%cNH!Vxwa@ zg1->xnQ!jg*^zm`7n<}5hb@p{KafHL@13-%bn{@H;cRL-8G5#tW;7|7K_o6XLw?Agj_#gH# z9^9>LmsUABno5FG!vA8)+$fj^e|&eS6|0?`GUBzthZS^g$($PSaVWRe$s7G_id$Leyceg%$d z&p;$<6)B)0$MebL1kMCDDm*BQ<{`^6j6prXSkl6M2Hz09$AlQC6ov*Tb03`*K%YFMbPz!-?>Jg&6sKXRvcC7V z=5hthyHS&ryEm2)%h{neq{+TJUX)~g!Bb4TTrTHB`01Qmac{2gs~W0TQ_DBo9o1NB zJf4ttbs;78&}w3C#kKjWy=2utw|qy=&c>z9Z^cslF9yS|aFn+U?c579WXv=9WFiEF z2ozR2rB7u>K?Z?FJU`?)AZ(LiG{kzqK?XP&A7ko8ri!q^l~45?w+^!?Fak@Vh+RER z6BY4|S7-1A$5@MK)$D@!wLSOIUE0Lhb7*d+a;Q^^sKmX?kdfLDZZ+d`?a&z$i6k+9rwh_}dMmnBt zH4gktzo)%Ax8!M}9}V=wRV}rb+N$Z)hi`Q1?HkP}7Jl4P?P%YcU3328E$Qq2Fvi}G zv3KT{HrLZtqoNr3kO`_HN0sGJ&s;{-ebeDay*E8us&nOKPg`|PZ$phIVq&LO6S=of zHLW?HrOmePtLkmndt@U&klkLsIpSDzKDvCf%~4(bJM6#pC+^lHT3e=eMUyK{qD|4x zTgK5C%El6{@MIkh*<>{vW2K&@&B}dxPow*KTTB!E@wBcv{*OS)^?%XZuIg`BDzrSsHOGy)m4?mrqt*18+i$Ye&teZNuTUevg^s{33e-|9~^{?lPr&i=aImi07Ov$V>~Z_loMbbA2{ zrF%D;ukY-N3FH?86w>CktX!#VyTF)|ccZn@x!$LHMH1bY!bYnxe^gOBG}g?5_EInM zq;~JprmylMde|$pSAW&fAHj)Ag0+Mre)&6~@>fT8eHzElhRq?+4x6b6g@blz55X@3 z{R2f821R2*K)+TfXtR*W^AwyU809}bynVk2&ILh!P#-j5JPb{Ej;2=#4u0uyp9}tg z^YD(|0GJTD#4G@aK0fwPl47<2HOL=-v5UWTxMhbrT!&6T7&w$<6!_m9zTXv9P+3nI z@xkOVAO;|76v09`$Mz8coMbj^i*2Bo9N=A29|Jo9SVcgBC8CBw%MA&n(U3s=3@HE{ zB8)_QE5JsMB@&a{SeWdj@EQ^2Qu*uGwwFOaYe5qgAHf$F-x>Zl88{O&6+{B=C=RI~ z%Q4jnS;>#`&1ePU%Oh;+?DE-jzjSu+;xC_{XXh8^PtUVT{xhr1&8A_fw2qx_JgQ*X zXER`61;RQE7n3~+k)o|rd4v@qVr!%yBH{*~Eux)}$c)0cKtjNRq7M>Vl_0+{F;I55 z_c$Cb1FHz`I{xcci8CF}HVJ1PC%a`%$yb#*I5`H=oh{$~;Og1ix8GfU7bi>_RjGX4 zy@a!5&p{l`_`Ki9*ZUtk+wQnEyR`Xx=|=Z8>Dqp0`O?x&m)}x3+w8dY(9-7ht>caE zH=4)ADPP$1wAK_F9Jd}u6%(jpLKKTCn%Zj`E`Br9y|uxXX6>DsH1_^6k@kZZA+W4>urthmvk8&kUF)luCQCBcG77lo%UK^T(*YVZtwNUn^&A4{(L=G?D11r|#5S$yL$eJ@PFBl_M(_sjZTQD>!~`}Do?vl|TelTY%zfznO({Bg@h%L+v%8W<)$LEdb|@ey~3w6SRK6&T7Gll5g&n8tOi+`(Qgw zby(Gy-ly+;NAx%a)*V66&;}3@oI%?7!hMdApI1hT0+B2NZ=Q~oC1@K5{hz|auAmYmW;D($;7Zs7zDYuWKj3xV-Fknh}O*l6-3*TfijkikgX|G zc+QeB4ojxctX3d@0ry8A=zGe*{u&>O0LaI*Y&wJS!f&n(Dgtb%sfCA!S-PlY(g|D^ zz#TD38&ZB22kl~ExX`w21X(EC{05^p3m=_iVeok~iRpt^YD*ykYD)#|^f837)XIW& z0|_GZQ7a1!^Z)Xd`^vz-TAm6g+?GQ8#g+m*)=~;k-Il@@v88~XwG^VNwFGQzEfEB? z^P!{Nu0WuYJi6v816PY$d=DY4!j4YC96|!;)Z!v4LDU!WWIjnu7cnEq5D=-+;t739 zKy#S*EYipqm5pVNKn&XP8vBys+B$u!$^w>Vhk~^FKCz_ft|evI3QzN0i>Rc9dR*$1<$9+FM(Bj8 zT#8 z@w1Q50$6;hZMj431Oe^)5IVp4aUH05K=aMMoLDxyGO2rrv6}^>)GgV`VJd0Ze5q{p zztJq(MMX`u{%@)4zgG~|>mHpZ#z)jx(BZY)^ZMTXu*s_*=&ZBUUd=6S{(jAVeOK?y zfnUN^*-_1|z(#nNHm|HXHND$Q6W|q?jtoUkF4w2K%jP@_C&p&lJ>IHOB);m5_}v;k=H- zM*%QKNdz}9w%Q^#}5w$&!f|7!8xl zWy(QJ`>0O0Q=`d5I*Z#7y2+3^xS%SQ5l0O2Kzy3}gr`nJy#E z{6KA-A*cPT(n|A)->~?o_SmDQJBd&oK{{CUlN%@8)kC=<_HTDP_MWLINHkm>K zQz~qfW1kZ?N&;(#(~$z5>`5Ws(4wWpk&@(j{lf(ut$=L@h4}75Z{^L|FE}gVho5$q zF_W5~qKt4n;jlsslc)+2@gwX%mcY3r$&dD7Jc$C(Z#<}=Uy4wLgGf#lRRFJ%JgL0l zC&9&?${BJP_Y230bjKjvsr*f4BufdO%-JP?7b5icVo{Ue(-YvUi#cq*` zkG(0?-k8*+aKqt-Mg1-r@+;NV-no@~H(xR8xZ!zjdGi@qNWOS^>Cz(qc4>RLTU*u- zv~{N56;YIprV<>MD{Jl!a#^lFl1jfzNymHe5xiO56O$oaMocc*sAqc*Id6v-F%resEf~{i*L9Wb+1hy zW9c@OymqC{D@&`x+MTN40ir&sS{t&QT=`r}47r?oQ}25T?Y6qf_7C_Wm z^P|=eBJ|`a?G!vj+OFS?={rT8rJYZM=6E+6WD910))6k-yWHX0t`F&lKCE~&eJ3+C zh7dU$S}p%$*P8Qdv{=7GtOj>8&r^WQ(Q)*C-9LB31^@3gVWpq`k-HSG-jRpiM5}uE z%Svy$s=xOKMfqRij_w z<#$Tq)pxtr93P69>A|`Y?4S|6kN?tQS9LjzpF#akDR}y6(#GgLTi)+*@6sR8M?S1< z*YpSR#ornYJb-~eu=@A-;>z60$$K}~2kKhrMGIoYb@TLhU8_Xx){DAVi>Jg*R&`>X z>Fg1rrn*-s&*==2-_m{rO!WQOaI}VT{u`yO=I)mMos1_7^{^_4}*j*Jrgx^ z{g|jbBDWN67dMg_#G%3S=o@-1Vtk?^;w|!2&^)smdYUZegI*h$nRpOlJ~F_2GQ^a7 z=@1xKv^8sui#^;)ZQp}Jn6z4xK~c^-G{@0*fBCF;7jp^Nj%j= z9HZY4TaHtq3}8Rw8CoP zQuO`UM!UArE)#FZglQ24KZ>vKh}~$1rCHe2jNel0^@MyHxw$@3rB-YfoJ?5|j&RIw z^{5v%9m6teLS=OanNQCm|H|TtlXCON@#4X{$rN)uWIU~*!%X+-bVTCV81&+81Sfqk zirBX$!d((EehRv)G)o|7ihlqvNy3%SEZuD4yB^Q?Na9A+)F5|w$lB@RPd`4$|J&o| zc;>>FTxyuVkoE!!zz{PTJ%L3==w3WDF+q(sKwak)gvL_I3^*2I@dj#9NAV2UI6d%y z3<(>vP60${vq!M0cd<_8a zmSAt*{B5#l4z98Rxr_vgqzc}U$;u-ypd%|Ld5e2;RsqW+0)W&$}g_U?J zPy-P<&NXzxP_1)8w@>4m9@q4U}#WljzFy} zP#0qi)WtFbp%8!XD`8hO%01Z=&-x7MkR|0T>HM?12c&IobIuwo*XDXCmj2H8l@<5XD=xtxVzQ+2y=OJ2*}%Ws zXGq(g+gFxV^w^a*`sz}W4;mG1bk>!5>Qa&knwma)*$uA%347MYUZesJhp8{`L(SBI zI@SI56o2ixXqgPOZFz@jyNUH2rnrKX5InZ2MB(P!c0iP#w;-YcvySI+GGs1fdX8b{ z8?hIWk8rb>*+W4g?4r?R zS;m4wFbh_6CxoSw(VY+mD55(=P-?ND0CobU5C;LMSs^66E0+mGLd+ThW)1Xs+#HIE z)i>l>7)vVwV_BOl`g;-c1L9YfY>SW4!!2WtYSAPDc|7RlKl;@#Iv?QL*Y9tb3$Wke zpZof5-v4xGvv`mOg2?-x*~fqQ_0qO1yo@I8`aQx2Kjq^2=l6VCI3SwvViOY2Tp~-v z7Bsp7w7przqpQDu{=V(lFp{={Xj*@y6AbVdp7*%Gj`28R0SIF}Nv46Cf5j9Ll$4B> zVM1H_5mTkGOtLVT%uS~YdM=Au#w8)SCpj6dp<&|i`6RaFE}7c^CfZ?ZD+2U%uQ2>AB0}{GTp2^Z$OR3#p%9PV>l>`&})JPhXjLwe(ls zy7K2v7ZU-tEd#87EH}yc)fX9bufI6jWik*rL8e>9k1yQEwX1#P1@JFi?Stedit>TEDIT-FIND.;102 30083 +(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}tedit>TEDIT-FIND.;134 36434 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD) + :CHANGES-TO (FNS TEDIT.SUBSTITUTE) - :PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}tedit>TEDIT-FIND.;98) + :PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}TEDIT>TEDIT-FIND.;132) (PRETTYCOMPRINT TEDIT-FINDCOMS) @@ -28,7 +28,9 @@ (DEFINEQ (TEDIT.FIND - [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS?) (* ; "Edited 19-Jun-2023 22:27 by rmk") + [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") @@ -38,26 +40,30 @@ (* ;; "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 TEXTOBJ (TEXTOBJ TEXTOBJ)) - (CL:WHEN TARGETSTRING - (SETQ TARGETSTRING (MKSTRING TARGETSTRING)) - (CL:UNLESS END - (SETQ END (TEXTLEN TEXTOBJ))) - (CL:UNLESS START - (SETQ START (TEDIT.GETPOINT TEXTOBJ))) + (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:WHEN (ILEQ START END) - (CL:IF WILDCARDS? - (\TEDIT.WCFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (\TEDIT.PARSE.SEARCHSTRING TARGETSTRING) - START END) - (CAR (\TEDIT.BASICFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - TARGETSTRING START END)))))]) + [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))))])]) (TEDIT.FIND.BACKWARD - [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS? AGAIN) (* ; "Edited 12-Jul-2023 08:24 by rmk") + [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") (* ; "Edited 30-May-91 19:17 by jds") @@ -66,197 +72,220 @@ (* ;; "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 TEXTOBJ (TEXTOBJ TEXTOBJ)) - (CL:WHEN [AND TARGETSTRING (NEQ 0 (NCHARS (SETQ TARGETSTRING (MKSTRING TARGETSTRING] - (SETQ START (IMAX 1 (OR START 1))) - (SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TEXTOBJ))) - (TEXTLEN TEXTOBJ))) - (CL:WHEN AGAIN + (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.") + (* ;; + "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 (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (DREVERSE (\TEDIT.PARSE.SEARCHSTRING TARGETSTRING)) - START END) - (CAR (\TEDIT.BASICFIND.BACKWARD (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - TARGETSTRING START END)))))]) + (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))))])]) (TEDIT.SUBSTITUTE - [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 15-Mar-2024 14:09 by rmk") + [LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "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 3-Mar-2024 12:24 by rmk") - (* ; "Edited 29-Feb-2024 17:00 by rmk") - (* ; "Edited 27-Feb-2024 08:20 by rmk") + (* ; "Edited 12-May-2024 21:11 by rmk") + (* ; "Edited 15-Mar-2024 14:09 by rmk") (* ; "Edited 6-Jan-2024 11:09 by rmk") (* ; "Edited 12-Nov-2023 12:29 by rmk") (* ; "Edited 22-Sep-2023 20:36 by rmk") (* ; "Edited 31-May-2023 00:04 by rmk") - (* ; "Edited 24-May-2023 20:01 by rmk") (* ; "Edited 30-Mar-94 16:04 by jds") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.") - (CL:UNLESS (\TEDIT.READONLY TEXTSTREAM) - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (NREPLACEMENTS 0) - (YESLIST '("Y" "y" "yes" "YES" "T" "Yes")) - SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN - ACTIONSTRING) - (CL:UNLESS [SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:" - (\TEDIT.GET.TARGET.STRING TEXTOBJ - 'TEDIT.LAST.SUBSTITUTE.STRING] - (* ; - "If the search pattern is empty, bail out.") - (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]") - (RETURN)) - (CL:UNLESS REPLACEMENT - [SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" (GETTEXTPROP - TEXTOBJ - - ' + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (RESETLST + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + (NREPLACEMENTS 0) + (YESLIST '("Y" "y" "yes" "YES" "T" "Yes")) + SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN + ACTIONSTRING) + + (* ;; "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.") + + [CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:" + (GETTEXTPROP TEXTOBJ + ' + TEDIT.LAST.SUBSTITUTE.STRING + ] + (CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ + "Replace string:" + (GETTEXTPROP TEXTOBJ + + ' TEDIT.LAST.REPLACEMENT.STRING - ]) - (if (type? SELPIECES REPLACEMENT) - elseif (OR (STRINGP REPLACEMENT) - (LITATOM REPLACEMENT)) - then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)) - elseif (LISTP REPLACEMENT) - then (HELP "LISTP REPLACEMENT")) + ] + (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]") + (RETURN)) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (if (type? SELPIECES REPLACEMENT) + elseif (OR (STRINGP REPLACEMENT) + (LITATOM REPLACEMENT)) + then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))) - (* ;; "Could be NIL or empty string, meaning just delete all occurrences.") + (* ;; "Could be NIL or empty string, meaning just delete all occurrences.") - (SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT)) - (SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN) - "delet" - "substitut")) + (SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT)) + (SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN) + "delet" + "substitut")) - (* ;; - "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.") + (* ;; + "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.") - (SETQ CONFIRMFLG (CL:IF PATTERN - CONFIRM? - (MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each " - ACTIONSTRING "ion?") - "No") - YESLIST))) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T) - "ing...") - T) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) + (SETQ CONFIRMFLG (CL:IF PATTERN + CONFIRM? + (MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each " + ACTIONSTRING "ion?") + "No") + YESLIST))) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T) + "ing...") + T) + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) (* ; "Turn off any blue pending delete") - (* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.") + (* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.") - (SETQ STARTCHAR# (GETSEL SEL CH#)) - [SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH] - [if CONFIRMFLG - then - (* ;; "In this case the selection moves along, ending up at the last hit.") + (SETQ STARTCHAR# (GETSEL SEL CH#)) + [SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH)) + (GETTOBJ TEXTOBJ TEXTLEN) + (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))] + [if CONFIRMFLG + then + (* ;; "In this case the selection moves along, ending up at the last hit.") - [bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING - STARTCHAR# ENDCHAR# T)) - do (* ; + [bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ + SEARCHSTRING STARTCHAR# + ENDCHAR# T)) + do (* ;  "Show each substitution site and ask for permission") - (SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE) - (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE))) - 'RIGHT T)) - (\TEDIT.SHOWSEL PENDING.SEL T) - (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL) - (SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ - "OK to replace? ['q' quits]" "Yes") - 1)) - (Q (RETURN)) - (Y (* ; "Do this one") - (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT - 'COPY TEXTOBJ) - TEXTOBJ PENDING.SEL) - (add NREPLACEMENTS 1) - (SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM)) + (SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE) + (ADD1 (IDIFFERENCE (CADR RANGE) + (CAR RANGE))) + 'RIGHT T)) + (\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ) + (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL) + (SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ + "OK to replace? ['q' quits]" "Yes") + 1)) + (Q (RETURN)) + (Y (* ; "Do this one") + (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT + 'COPY TEXTOBJ) + TEXTOBJ PENDING.SEL) + (add NREPLACEMENTS 1) + (SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM)) (* ; "Next start, compensate for end") - [add ENDCHAR# (IDIFFERENCE REPLACE-LEN (ADD1 (IDIFFERENCE - (CADR RANGE) - (CAR RANGE]) - (PROGN - (* ;; + [add ENDCHAR# (IDIFFERENCE REPLACE-LEN + (ADD1 (IDIFFERENCE (CADR RANGE) + (CAR RANGE]) + (PROGN + (* ;;  "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.") - (TEDIT.SHOWSEL TEXTOBJ NIL PENDING.SEL) - (SETQ STARTCHAR# (ADD1 (CAR RANGE] - else - (* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events") + (\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ) + (SETQ STARTCHAR# (ADD1 (CAR RANGE] + else + (* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events") - (bind FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0) - (SAVESEL _ (\TEDIT.COPYSEL SEL)) - while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T)) - collect (CL:UNLESS FIRSTHIT (* ; "For final line updating.") - (SETQ FIRSTHIT (CAR RANGE))) - [SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE] - (\TEDIT.UPDATE.SEL SEL (CAR RANGE) - HITLEN - 'RIGHT) - (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT - 'COPY TEXTOBJ) - TEXTOBJ SEL) - (add NREPLACEMENTS 1) - (SETQ STARTCHAR# (GETSEL SEL CHLIM)) - (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN)) - (add ENDCHAR# HITDIFF) - (add TOTALDIFF HITDIFF) - (\TEDIT.POPEVENT TEXTOBJ) - finally (CL:WHEN $$VAL + (bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0) + (SAVESEL _ (\TEDIT.COPYSEL SEL)) + EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# + ENDCHAR# T)) + 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 + 'RIGHT) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT + 'COPY TEXTOBJ) + TEXTOBJ SEL) + (push EVENTS (\TEDIT.POPEVENT TEXTOBJ)) + (* ; + "Collect the events for a single composite") + (add NREPLACEMENTS 1) + (SETQ STARTCHAR# (GETSEL SEL CHLIM)) + (SETQ HITLAST STARTCHAR#) + (SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN)) + (add ENDCHAR# HITDIFF) + (add TOTALDIFF HITDIFF) + finally (CL:UNLESS (EQ NREPLACEMENTS 0) - (* ;; - "At least one replacement, update the lines that have changed.") + (* ;; + "At least one replacement, update the lines that have changed.") - (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT - (IDIFFERENCE (GETSEL SEL CHLIM) - FIRSTHIT)) + (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT + (IDIFFERENCE (GETSEL SEL CHLIM) + FIRSTHIT)) - (* ;; "We want the new selection to begin at the beginning of the original selection, somewhere before the first hit, and end at the position that the prior ending moved to. The text grew or shrank with each hit.") + (* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?") - (\TEDIT.SHOWSEL SEL NIL) - (\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#) - (IPLUS (GETSEL SAVESEL DCH) - TOTALDIFF) - 'RIGHT) - (\TEDIT.HISTORYADD TEXTOBJ (DREVERSE $$VAL)))] + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT + ) + 'RIGHT) + (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))] - (* ;; "Save the search & replacement strings to offer for next time:") + (* ;; "Save the search & replacement strings to offer for next time:") - (\TEDIT.SHOWSEL SEL T) - (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING) - (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING - REPLACEMENT NIL TEXTOBJ)) - (TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS - (0 (CONCAT " No " ACTIONSTRING "ions made")) - (1 (CONCAT " 1 " ACTIONSTRING "ion made")) - (CONCAT " " (MKSTRING NREPLACEMENTS) - " " ACTIONSTRING "ions made")) - T) - (RETURN NREPLACEMENTS)))]) + (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (TEDIT.NORMALIZECARET TSTREAM SEL) + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING) + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING + REPLACEMENT NIL TEXTOBJ)) + (TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS + (0 (CONCAT " No " ACTIONSTRING "ions made")) + (1 (CONCAT " 1 " ACTIONSTRING "ion made")) + (CONCAT " " (MKSTRING NREPLACEMENTS) + " " ACTIONSTRING "ions made")) + T) + (RETURN NREPLACEMENTS))))]) (TEDIT.NEXT - [LAMBDA (STREAM) (* ; "Edited 15-Mar-2024 13:34 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:40 by rmk") + (* ; "Edited 7-Jul-2024 11:47 by rmk") + (* ; "Edited 18-May-2024 16:23 by rmk") + (* ; "Edited 12-May-2024 21:10 by rmk") (* ; "Edited 16-Feb-2024 23:48 by rmk") + (* ; "Edited 15-Mar-2024 13:34 by rmk") (* ; "Edited 14-Dec-2023 21:20 by rmk") (* ; "Edited 20-Jun-2023 00:05 by rmk") (* ; "Edited 3-May-2023 23:47 by rmk") (* ; "Edited 18-Apr-2023 23:46 by rmk") (* ; "Edited 30-May-91 20:57 by jds") - (LET ((TEXTOBJ (TEXTOBJ STREAM)) + (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 (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (GETSEL SEL CH#))) - (* ; + (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") @@ -273,28 +302,30 @@ (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) (* ;  "Original comment: %"never pending a deletion%", but it is!") - (\TEDIT.SHOWSEL SEL NIL) (* ; + (\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) - (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "Always selected normally") + 'RIGHT + 'PENDINGDEL) + (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally") (TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window") - (\TEDIT.SHOWSEL SEL T)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ)) (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) (* ; + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;  "Set SELECTION to be the found text") (\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#) (GETSEL FIELDSEL DCH) - 'LEFT) - (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "And get it into the window") + 'LEFT + 'PENDINGDEL) (* ; "And get it into the window") + (\TEDIT.FIXSEL SEL TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)) (NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T) (SETQ SEL NIL)) - (SHOULDNT "No legal value found in selectq in TEDIT.NEXT")) + (\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)))]) @@ -307,192 +338,227 @@ (DEFINEQ (\TEDIT.WCFIND - [LAMBDA (TSTREAM TARGETLIST START END HITSTART ANCHORED) (* ; "Edited 19-Jun-2023 23:50 by rmk") + [LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk") + (* ; "Edited 23-Jun-2024 12:00 by rmk") + (* ; "Edited 19-May-2024 23:46 by rmk") + (* ; "Edited 3-May-2024 07:11 by rmk") + (* ; "Edited 29-Apr-2024 20:45 by rmk") + (* ; "Edited 17-Mar-2024 11:59 by rmk") + (* ; "Edited 20-Jun-2023 13:52 by rmk") - (* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITSTART is the first character of such a match") + (* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.") - (CL:UNLESS (IGREATERP START END) - [LET (RESULT) - (COND - ((NULL TARGETLIST) (* ; "Final match") - (LIST (OR HITSTART (SUB1 START)) - (SUB1 START))) - [(EQ '%# (CAR TARGETLIST)) (* ; - "Single-char wildcard, next segment is anchored ") - (OR (\TEDIT.WCFIND TSTREAM (CDR TARGETLIST) - (ADD1 START) - END - (OR HITSTART START) - T) - (CL:UNLESS ANCHORED (* ; - "Initial # didn't match, let it slide in this loop") - (for S from (ADD1 START) to END - when (SETQ RESULT (\TEDIT.WCFIND TSTREAM TARGETLIST S END S T)) - do (RETURN RESULT)))] - ((EQ '* (CAR TARGETLIST)) + (CL:WHEN TARGETLIST + [bind STACK CONFIG HITSTART ANCHORED RESULT TARGETTAIL TARGET (TOPSTART _ (SUB1 START)) + do (SETQ CONFIG (pop STACK)) + (if CONFIG + then (SETQ START (pop CONFIG)) + (SETQ TARGETTAIL (pop CONFIG)) + (SETQ HITSTART (pop CONFIG)) + (SETQ ANCHORED (pop CONFIG)) + elseif (IGEQ TOPSTART END) + then (RETURN NIL) (* ; "No more, failed") + else (add TOPSTART 1) (* ; "First time or outer advance") + (SETQ START TOPSTART) + (SETQ TARGETTAIL TARGETLIST) + (SETQ HITSTART NIL) + (SETQ ANCHORED NIL)) + (SETQ TARGET (CAR TARGETTAIL)) + (SELECTQ TARGET + (%# (CL:UNLESS (CDR TARGETTAIL) + (RETURN (LIST (OR HITSTART START) + START))) + (CL:WHEN (ILEQ START END) (* ; + "If we are unanchored, slipping continues") + (push STACK (LIST (ADD1 START) + (CDR TARGETTAIL) + (OR HITSTART START) + ANCHORED)))) + (* + (* ;; "Unanchored config for the tail that starts here.") - (* ;; "Variable width wildcard, not anchored so the match can slide along.") - - (\TEDIT.WCFIND TSTREAM (CDR TARGETLIST) - START END HITSTART)) - ((SETQ RESULT (\TEDIT.BASICFIND TSTREAM (CAR TARGETLIST) - START END ANCHORED)) (* ; - "Matched a string segment, keep going") - (\TEDIT.WCFIND TSTREAM (CDR TARGETLIST) - (ADD1 (CADR RESULT)) - END - (OR HITSTART (CAR RESULT])]) + (push STACK (LIST START (CDR TARGETTAIL) + HITSTART NIL))) + (if (SETQ RESULT (\TEDIT.BASICFIND TSTREAM TARGET START END ANCHORED)) + then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!") + (RETURN (LIST (OR HITSTART (CAR RESULT)) + (CADR RESULT)))) + (SETQ START (ADD1 (CADR RESULT))) (* ; "Next target") + (CL:WHEN (ILEQ START END) + [push STACK (LIST START (CDR TARGETTAIL) + (OR HITSTART (CAR RESULT]) + elseif (NOT ANCHORED) + then (RETURN NIL])]) (\TEDIT.BASICFIND - [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk") + [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 12:03 by rmk") + (* ; "Edited 22-Jun-2024 12:01 by rmk") + (* ; "Edited 19-May-2024 23:18 by rmk") + (* ; "Edited 17-Mar-2024 12:06 by rmk") (* ; "Edited 20-Jun-2023 00:11 by rmk") (* ; "Edited 30-May-91 20:56 by jds") - (* ;; "Search thru TEXTOBJ, starting where the caret is, for an exact match of TARGETSTRING. Optionally, start the search at character START. ") + (* ;; "Search thru TSTREAM for an exact match of TARGETSTRING. ") (* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM") (bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING)) - (CHAR1 _ (NTHCHARCODE TARGETSTRING 1)) - (ANCHOR _ (SUB1 START)) first [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED + (ANCHOR _ (SUB1 START)) first (CL:WHEN (ZEROP NCHARS) + (RETURN NIL)) + [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED ANCHOR - (IDIFFERENCE END NCHARS))] - eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR) + (IDIFFERENCE END NCHARS))] - (* ;; "Match failed, bump the start--single char wild-card # always matches") - while [SETQ ANCHOR (find A from (ADD1 ANCHOR) to LASTANCHOR suchthat (EQ CHAR1 (BIN TSTREAM] - when [OR (EQ NCHARS 1) - (for I from 2 to NCHARS always (EQ (NTHCHARCODE TARGETSTRING I) - (BIN TSTREAM] - do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS]) + (* ;; "LASTANCHOR protects us from running into the EOF") + eachtime (CL:WHEN (IGEQ ANCHOR LASTANCHOR) + (RETURN NIL)) + (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR) + (add ANCHOR 1) (* ; "Move the anchor up 1") + + (* ;; "Match failed, bump the start--single char wild-card # always matches") + + when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I) + (BIN TSTREAM)) + (RETURN NIL)) + (CL:WHEN (EQ I NCHARS) (* ; "Matched the last char") + (RETURN T))) do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS]) (\TEDIT.WCFIND.BACKWARD - [LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "Edited 17-Mar-2024 11:59 by rmk") + [LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk") + (* ; "Edited 23-Jun-2024 12:02 by rmk") + (* ; "Edited 19-May-2024 23:46 by rmk") + (* ; "Edited 3-May-2024 07:11 by rmk") + (* ; "Edited 29-Apr-2024 20:45 by rmk") + (* ; "Edited 17-Mar-2024 11:59 by rmk") (* ; "Edited 20-Jun-2023 13:52 by rmk") - (* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITEND is the last character of such a match") + (* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.") - (LET (RESULT) - (COND - ((NULL TARGETLIST) (* ; "Final match") - (LIST (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM)) - (OR HITEND END))) - [(EQ '%# (CAR TARGETLIST)) (* ; - "Single-char wildcard, next segment is anchored ") - (OR (\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST) - START - (SUB1 END) - (OR HITEND END) - T) - (CL:UNLESS ANCHORED (* ; - "Initial # didn't match, let it slide in this loop") - (for E from (SUB1 END) to START by -1 - when (SETQ RESULT (\TEDIT.WCFIND.BACKWARD TSTREAM TARGETLIST START E E T)) - do (RETURN RESULT)))] - ((EQ '* (CAR TARGETLIST)) + (CL:WHEN TARGETLIST + [bind STACK CONFIG HITEND ANCHORED RESULT TARGETTAIL TARGET (TOPEND _ (ADD1 END)) + do (SETQ CONFIG (pop STACK)) + (if CONFIG + then (SETQ END (pop CONFIG)) + (SETQ TARGETTAIL (pop CONFIG)) + (SETQ HITEND (pop CONFIG)) + (SETQ ANCHORED (pop CONFIG)) + elseif (ILEQ TOPEND START) + then (RETURN NIL) (* ; "No more, failed") + else (add TOPEND -1) (* ; "First time or outer advance") + (SETQ END TOPEND) + (SETQ TARGETTAIL TARGETLIST) + (SETQ HITEND NIL) + (SETQ ANCHORED NIL)) + (SETQ TARGET (CAR TARGETTAIL)) + (SELECTQ TARGET + (%# (CL:UNLESS (CDR TARGETTAIL) + (RETURN (LIST END (OR HITEND END)))) + (CL:WHEN (ILEQ START END) (* ; + "If we are unanchored, slipping continues") + (push STACK (LIST (SUB1 END) + (CDR TARGETTAIL) + (OR HITEND (SUB1 END)) + ANCHORED)))) + (* + (* ;; "Unanchored config for the tail that starts here.") - (* ;; "Variable width wildcard, not anchored so the match can slide along.") - - (\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST) - START END HITEND)) - ((SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM (CAR TARGETLIST) - START END ANCHORED)) (* ; - "Matched a string segment, keep going") - (\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST) - START - (SUB1 (CAR RESULT)) - (OR HITEND (CADR RESULT]) + (push STACK (LIST END (CDR TARGETTAIL) + HITEND NIL))) + (if (SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END ANCHORED)) + then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!") + [RETURN (LIST (CAR RESULT) + (OR HITEND (CADR RESULT]) + (SETQ END (SUB1 (CADR RESULT))) (* ; "Next target") + (CL:WHEN (ILEQ START END) + [push STACK (LIST END (CDR TARGETTAIL) + (OR HITEND (CADR RESULT]) + elseif (NOT ANCHORED) + then (RETURN NIL])]) (\TEDIT.BASICFIND.BACKWARD - [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk") - (* ; "Edited 12-Jul-2023 08:14 by rmk") - (* ; "Edited 23-Apr-2023 12:42 by rmk") + [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 11:32 by rmk") + (* ; "Edited 19-May-2024 23:07 by rmk") + (* ; "Edited 17-Mar-2024 12:06 by rmk") + (* ; "Edited 20-Jun-2023 00:11 by rmk") + (* ; "Edited 30-May-91 20:56 by jds") - (* ;; "Returns a (Startmatch Endmatch) pair of character positions in TSTREAM that denote the nearest occurrence of TARGETSTRING whose first character is at or ahead of START and whose last character is at or before END. ") + (* ;; "Seach backwards thru TSTREAM for an exact match of TARGETSTRING.") - (* ;; "A better interface would return a selection for the string-match, but we repeat the pair interface that is documented for forward search.") + (* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM") - (* ;; - "Note that caller must decrement END in subsequent calls to avoid looping on the same match.") + (bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING)) + (ANCHOR _ (ADD1 END)) first (CL:WHEN (ZEROP NCHARS) + (RETURN NIL)) + (CL:WHEN ANCHORED + (SETQ START (IDIFFERENCE ANCHOR NCHARS))) - (* ;; "") + (* ;; "LASTANCHOR protects agains the beginning of the stream") - (* ;; "The last target character first matches at END. Setting the initial ANCHOR one past END and going into the anchor backup loop won't work if END points to the last character in the stream--the \TEXTSETFILEPTR would be out of bounds. So the first anchor-match has to be special, by setting the fileptr at END and peeking.") - - [SETQ END (IMIN END (TEXTLEN (TEXTOBJ TSTREAM] - (bind ANCHOR LASTANCHOR (NCHARS1 _ (SUB1 (NCHARS TARGETSTRING))) - (CHARN _ (NTHCHARCODE TARGETSTRING -1)) - first - (* ;; "NCHARS1 because the last character is matched separately.") - - (CL:WHEN (ILESSP (IDIFFERENCE END START) - NCHARS1) (* ; "Too few characters") - (RETURN NIL)) - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 END)) - (CL:WHEN [AND (EQ CHARN (\TEDIT.TEXTPEEKBIN TSTREAM)) - (OR (EQ NCHARS1 0) - (for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I) - (\TEDIT.TEXTBACKFILEPTR - TSTREAM] - (RETURN (LIST (IDIFFERENCE END NCHARS1) - END))) - (CL:WHEN ANCHORED (* ; "Anchored at END, didn't match") - (RETURN NIL)) - (SETQ ANCHOR (SUB1 END)) - (SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR) - (* ; - "The filepos one before the last CHARN match") - (ADD ANCHOR -1) - (* ; "For next attempt") - while (find old ANCHOR from ANCHOR to LASTANCHOR by -1 suchthat (EQ CHARN ( - \TEDIT.TEXTBACKFILEPTR - TSTREAM))) - when [OR (EQ NCHARS1 0) - (for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I) - (\TEDIT.TEXTBACKFILEPTR TSTREAM] - do (ADD ANCHOR 1) - (RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1) - ANCHOR]) + [SETQ LASTANCHOR (SUB1 (CL:IF ANCHORED + ANCHOR + (IPLUS START NCHARS))] + eachtime (CL:WHEN (ILESSP ANCHOR LASTANCHOR) (* ; "Won't fit in the frame") + (RETURN NIL)) + (add ANCHOR -1) (* ; "Move the anchor back 1") + (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR) + when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I) + (\TEDIT.TEXTBACKFILEPTR TSTREAM)) + (RETURN NIL)) + (CL:WHEN (EQ I NCHARS) (* ; "Matched the last char") + (RETURN T))) do (RETURN (LIST (IDIFFERENCE (ADD1 ANCHOR) + NCHARS) + ANCHOR]) (\TEDIT.PARSE.SEARCHSTRING - [LAMBDA (TARGETSTRING) (* ; "Edited 19-Jun-2023 16:42 by rmk") + [LAMBDA (TARGETSTRING BACKWARD) (* ; "Edited 23-Jun-2024 08:02 by rmk") + (* ; "Edited 19-May-2024 22:43 by rmk") + (* ; "Edited 19-Jun-2023 16:42 by rmk") (* jds "31-Jan-84 13:26") - (* ;; - "Quote Is an escape if it comes before a wild card. ''# would match ' in front of literal .") + (* ;; "Parse TARGETSTRING into string-segments that are separated by the wild-card characters # and * (or escape). Each # is left as its own segment, multiple *'s collapse to one, and *'s on the edges are removed. ' quotes the following character.") - (for TTAIL C SEG on (CHCON TARGETSTRING) - do (SETQ C (CAR TTAIL)) - (SELCHARQ C - (%' (if (MEMB (CADR TTAIL) - (CHARCODE (%# *))) - then (POP TTAIL) - (PUSH SEG (CAR TTAIL)) - else (PUSH SEG C))) - (%# (CL:WHEN SEG - (push $$VAL (CONCATCODES (DREVERSE SEG)))) - (push $$VAL (CHARACTER C)) - (SETQ SEG NIL)) - (* (CL:UNLESS (EQ (CAR $$VAL) - '*) (* ; "Reduce adjacent *s to one.") - (CL:WHEN SEG - (push $$VAL (CONCATCODES (DREVERSE SEG)))) - (CL:UNLESS $$VAL (* ; "Ignore leading *") - (push $$VAL (CHARACTER C))) - (SETQ SEG NIL))) - (PUSH SEG C)) finally [if SEG - then (PUSH $$VAL (CONCATCODES (DREVERSE SEG))) - else (* ; "Ignore trailing *") - (SETQ $$VAL (find VTAIL on $$VAL - suchthat (NEQ (CAR $$VAL) - '*] - (RETURN (CL:IF $$VAL - (DREVERSE $$VAL) - TARGETSTRING)]) + (* ;; "If BACKWARD, the search string segments are reverse, and the characters within each segment are reversed, so that the search can go backwards.") + + (* ;; " ") + + (for CTAIL C SEGCODES on (CHCON TARGETSTRING) eachtime (SETQ C (CAR CTAIL)) + do (SELCHARQ C + ((* ESCAPE) (* ; + "Throw away the first and multiiple *'s") + (CL:WHEN SEGCODES + [push $$VAL (CONCATCODES (CL:IF BACKWARD + SEGCODES + (DREVERSE SEGCODES))] + (SETQ SEGCODES NIL)) + (CL:WHEN (AND $$VAL (NEQ '* (CAR $$VAL))) + (push $$VAL '*))) + (%# (* ; "# stands alone") + (CL:WHEN SEGCODES + [push $$VAL (CONCATCODES (CL:IF BACKWARD + SEGCODES + (DREVERSE SEGCODES))]) + (push $$VAL '%#) + (SETQ SEGCODES NIL)) + (%' (* ; "Quote the next character") + (CL:WHEN (CDR CTAIL) + (push SEGCODES (CADR CTAIL)) + (SETQ CTAIL (CDR CTAIL)))) + (push SEGCODES C)) finally (if SEGCODES + then [push $$VAL (CONCATCODES (CL:IF BACKWARD + SEGCODES + (DREVERSE SEGCODES))] + elseif (EQ '* (CAR $$VAL)) + then + (* ;; "Strip the first edge *") + + (pop $$VAL)) + (RETURN (CL:IF BACKWARD + $$VAL + (DREVERSE $$VAL))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (832 18922 (TEDIT.FIND 842 . 2482) (TEDIT.FIND.BACKWARD 2484 . 4297) (TEDIT.SUBSTITUTE -4299 . 14915) (TEDIT.NEXT 14917 . 18920)) (18955 30060 (\TEDIT.WCFIND 18965 . 20966) (\TEDIT.BASICFIND - 20968 . 22446) (\TEDIT.WCFIND.BACKWARD 22448 . 24507) (\TEDIT.BASICFIND.BACKWARD 24509 . 28037) ( -\TEDIT.PARSE.SEARCHSTRING 28039 . 30058))))) + (FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE +5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND + 25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) ( +\TEDIT.PARSE.SEARCHSTRING 33332 . 36409))))) STOP diff --git a/library/tedit/TEDIT-FIND.LCOM b/library/tedit/TEDIT-FIND.LCOM index 9c1647ac635906d36fb56157337c98b8e447ffd9..ed0153c4e4a956d4548c785ac50212ed1e13dbd1 100644 GIT binary patch literal 7825 zcmcgxO>7&-6(%X!ZP~<;l*BOW+CXy*z zjwA<3gQRVm^w1Oq;=)0j1PKzLDUhV7e&Pa79P`jqfEI007qEKkq1Qq_v^}cd%F z$##Pl=z+`G`FS(*=9~Av_cof>3#P3P6iiDWFztdv_La2Us5Y#Vh-tfe*)l7o2-#QG zwY;lktu57At)det-WLu>se~N5xq6;NNO~Y&KQkc5WtB*YK{Ycd$q^EboS8d!VP>{o zBXj4`>4j=h&s+NVi-%`trsgN-pFgr#ugxqTfe6#ZlI(o!aY<48NH{`LErGH$s6u8c zLZ;^HzQp=-7v>iZ4iYvvRvF7yT+ zbyZ%GRz#qMp9H5)1abn{T$`zt0q&VvJlapRQhCnAf zqUT&9C5c(YwZLnMB+%i6&_y_!pxR=32}j#?9LwS=RiRp;>;%zpkPUjh?B_oKSvat#v5fp`cMSZ@u0$ zd!}~kZ`96h+@R-#(|IKS?vOSUro!)ZJW%D<<7sVQQv6naP;E`}-Ht4!ZaXs7KeANo z$RNK3?HE6@wmH&wKD+d7&aP!Vw0Jx&@zb-lqE0I2;9&olUBv|&D3u)-$mk~}BFjWS zuG?;fmL+1CZr&^u=u4cwSh|g}lwoD9;?kEiDVXJoi&pxUA{FhpUePW30{A(uW_co{ z1j!kWnbT>LN=mq&05g!y`pQJhxu#=#&_x%Cl=YIO<@5n>+Bnf2tD>_tWC$OZCOOB( z0*VD|7;;mjOf3;gNq+C?rPz)MAcCX%Bm9OkE*o*Nrtzww|IxU@=Ua!VhqqlE76Z@Dq zu>R9sTmln4-P>DLd(WuV*l(zq)xFgitN)-Ht0_b4Z&qUl8+0c2y=sgbz|M)?wX^FV z)^>EfU1NPOGkLGD=fs|>{F7>O=>VV5*~4nt5?iGaCUT<7aQ5(P$(mT@4C`v}nR+LB zYSRX~1Y;?Z)TJ8>7x%Z~ILwwQ=+M z@<#fs)59j}F7MvFtCySuKS!^L1L!NZHW6()J#@2CHa&A~sNqN2+_I=1z9@rh`mx@L z$M^z0orj;Cc(jQnM%O0#n?tl}tUSS7NRc^UPl=y`_6H^0=1I$8uP?Q!&B4QY{ZRR-$Z-ncx&Gyf?}hB>7cdM+*$QLXzMZUe}USV*Y|8 zu~o0mGksJl-xo>3NeJ1Z5(_GglVn^KEd}!gU40^x5H)S9OMscQ{31yxzCbF5joZF{ zHI)*gwy#NrMsL3+m2R(aQm4nH!cmP4@s;WG2OrQ;ywq^~L=Syoe?pmwOrsw8kI zD-yBzhGb~0s28((8LqyKp78z1I2jMS5}n6Wh@|*B_0Km}z_k#_l|UOfh)X2n_bqDW zQR?51>m)6vYF}YW&>ml(m=k6HzF-GjL4F4%xv2xaqRcNN+)1T{7A%mISeq{vt4yUR z^F?qLV?A0t$?u>fNZA}VaKpgYu~iTxuoIHZNW`=&dYQi^HnmAIR0dQhKXObo*Os(;H+7DH4v~KNc`3CPQ38 zq2fE~1jx9XN}yMg291r(%$;8#=O$})1joq~qF?+clKfxg?V=fAi6HJm2cTlpKmaa6 z>^VG?OqxW->kG7`kccx%7U#%({le_znfg(3>d-TX$TJsb78g!O!XQ?dXXgCVEa;VS zAtUx2Cdi3yU+07Z>R}mQ$`x_zV zcA3LukFQdq*gUY4N45&E4lc{q%R>u-RKXL)P%dkHbwN2UZQd93u-8%$M8`}p5O=4Dp+k;VUCVQ;5uf;L)B zK2ziOg+OyeFr*PPXof)c%pm7TY!GKB%@L2eagNp;@z~PRIo4@?C1-4rC06GB-^2Rd zS>n=xQ7-9SzEw_#n$ss=V^oP9e{KHebG3qoe#~G~< zIpaHg*8mqFGH4XXe!D-A6T%^G@uqUZca0ulkYPo=i`zyRsBsYP-Qz`4dYikHQi9oS znMP`{18*7$rg{4`Qi}=+7p#hvv&4?FnYRegQBWt7#MVt{0sa?;(sSt?(H>u$CrM}uj@Nm zG)&h-?aM>Xu58ZYM&tBK+zx#-dZn`%EQW$~8vHeGB8ztG((*=?j-+i=BqT0x6f9H^ zv7{wPhNpi&X$cHVu+04gSMuO~W|6mc5q4RD=b_4`)Po-dQ@CIBvzIiV=%3ZylDJ-+ zv|0W2PNZ_Z!5``sANOCJ#4h_>IJ3 zhc?RIhsgSS(?1xk8S9suGd&+H{kd`Dv!%b8H3O*xso!>H4Awb7wMG@kV7>EBu>LUDSfd!+f&Uh;xyM|8H`fmA<&E!b zMz#WE7lRnvhU_(-^#zEJ(ZQmPgZn52cZP%8k5hbb`^Ujho}wt1?}T!{@BbO@i!Hd* zV_|S#eVF3?zWmCArm+SC(gOb9r@OMo&Bhu9{^~zW9N1NX{&wWETe2Dbf1v39tJ%0| zteG7Bh~e7cPCpI^ydyMezZdXvZ5`Y01uXo3x)-oPQvkvT=4>uQJwoQCk2zm5Q>oiUVKO5=zrG?z!Wety)t>wTgqqF_%zZk8}KD@pn zHLaE1+UwS<7E=p*n7vo0ubC^y%pf7oxpxcJWLVjE@9ooyYey9bbl!WoLvRc_^+C z3Dl|8h%7pf;=M-DGrtk3qxLqi2)~J@>d{8QpHcvR2|53R`w6~E^%I27{mj}UY(j)S zPBTj^BgR}j``U@B3c8d_+OcEY^ZV5#8to^KKTaZJ3-x(YKaaSH20-oK4H7&-6(%X$O_fBIXxA|W!yV9WObHReUH(dO6)l%5?@~)HO|D|gj!Q@;W73qZ zM3P$sLD3*6ilXf$t&;*lfc^jhil9I#%0$uDF%JO>_*4||!8-L)^zTv`KJ-+$-~8+k z<(~#9AT4KS-pqUR=FNNGdmGJb^F~RVnm0^s$|%iS6tBbXu!U*%pb;m#XA7wzn7*Y^ZdDk91&2T{x>$+>x`4&h4HcGv$i*s$nfwr}8)z zs+*MWRFX4Nd?udyd}2>$Cx*E|OqQ8^b~tK~BspuCc@;8LUm*rb5Djt~L?%^Rsn}>q z1dY?0U9~Gl=`=dx#MaK)R<1BX0;ND8uz&80cm`GiO1+!o&5-)>+?~+Mfqt$xEJpXK z_qUJdy9ej)#1ux9Q=g;LMrns=2S=NufoMj4L{B6gclx-7NGjoUl$APZphv|^O7?f*|v-wp)=2Yia! z5Q<_yS9Z5oa=oGUSTNAm@BdtXryX9|r#h-@??9Jhp`czj?!VVJ!Yc=~59(JR-lgh= zQlt6q5m%{C*Q_KTxc6R4*q;2^XVM z{alAoUCdQ&!(N1~vlA#2%-0P&Z_LjVyvX#$)Jn81k$Iz1wb6k$DMPBtt6Ehv=}Vf} zmaUj#mXso@ZW*dZhmxcW6Nf3oW*DtZ6xBAYk}waDNTi~bO-0qFI43DiG|Q}NjO{ex z^Rh&>N)VtpZ=S}w8B(E_AFVXMI&{y+@tUGH%6Ul=C1+J^J|%&bd{&DcktMAPXU+CQ zNy1C2Ze`zRlze-Vdx4L0^~BunhdG_i zTiMq+n5z$c)MqT1o%VAFDE*y%wZru*yPwqe4}DZ;1Mf4M@33d>i1H(~bAofUj<7x^ zmDegT2DMS$I?`fIHpE&jMyhi@@)AiUAICQpr!I^JbB0=yS$AzZiEb&G&I$@gu%x$xM+HbCQV3wS zM}R~&NfxJ63WpP!X;QLv>bBAL#WbS?1(QSy0fq@xvMNQzG|p>4P#Ol3-r_>z322Pcav{O zmJ+0>6?0mJ$nlKe4|v4)BO#`XITD3h^XD~cZW4f$j*~+~bhYm3Y#wIqSRMrk+z87g z`^fUJ6R>iv7##Ti{bECLywepb=~@@MVjP6J{OFM|5Qq5cYEQ{qC36WtKa+M=GnJ|x z^9538flSJ|os7bR9WH?!Cl%wgZj%hcKX$D#kU%nV$@i89SoOxz=>#!KRjoqd1W8Nu zoVk$cIJHqBa3<@UlS;`@Ju`oYVKMx~GUTN=qBeqloF z7ch>FJHs%j2!IL*aKHT%Gt(d>r8PVfxY&`U#s+Pn(^?>#Yh=BF6!TK!6>{O^n4G+tj@Z;;0Fr6v^t3X5!9 zU)k7fZC>BRJA7B9-dJtWb^@YNI9B!pEHKMJ@CuiMY;3NB?MwuYjYKXeD{JdWK`%mN z&{P}C>)_&&z#yWLC8*;q`cF3&0pP>arY*crIJrm(r{)0QBw(&)=5crcfeB)jnRQXL z$h({bZ4X3*(F)WTln^+B9PN#r+3%pC^Bkcx>jJ_o=>-vBSp1j~YQ!^xpq~ zMbFML{_}$IK5P8Y! zE>F9mih3Y^vtu+Sn3lCrB{E_WLe8R@M_{Kn?@_NNryO6mCs4>qH-V)-A14_Ti^6b( zL-R#nIqs2*xFP`?IC0GBa%I@VP4Z&QAUDa&qkY^YPX;%nW=JsyXknFD9F9=~MGJOG z;EMRhS%CIs*HIam*)?Xt=LwVruiy8!iQQFTAS^XXm|12ql~cjY=XQ z(%DinE8L&tbFwsnfLn zy|uauQq--ebDW)>Jar0HDsiTw&fz4%glB+22#Y4o@lcmQR&7;KsH3F`J0F-LZ96noFMzFTbHz1aCzGkpGL zT5s=eNA*?IkG^1ylpbs!QLGW>XhHn*=J%|T_TAb@=kKj>_t%BGj@*|Xd?1P-Ea0zd z;r*#3l5SsPHhS88&tn$}AId!B67yc+pr^*zR>KcqIz z%sI?sUi%&_SM^);*O)oBcWA$3(SOmlPvlgnITSJqP}H1~DNBsJSxSUkM%T+!!=yjOanS_A9$tZ6KeY-6F!ltc!RI|;#Jd6X zco3_^@lZQYQ#;Q*$<7}+5-de6ep=Z5fWAS*9to( zzizUZU(pk!Uj>{SCL{asUqvb7IW|@7sqYyeDd}qNN zzf}lzezSUfw@b|4$by*l+h*q6}wDqtGPmp#}b?RkNAV+b?EwfXMLoXSM(|}JB>ef6%7o@;C zE-7%TM+y6&i9SgVPCymHrB5WhHZ6@~VYmtj#idCkJxMZ&Hv-5Qh2KxgNJ^sk3T4|% zD(YCQip9VU`(}r(D#j~i<;)q5dE9OijZTu6UnUXyZICpsAyJ|!4*xXfLyTV2^G3YS z%gTxPaz*hJR^aOz_#D`{iiMXqk>fcl5BNyO>b<}|FzhjOV3$ki4T%|#8tw!%L%$&X E7k!UZT>t<8 diff --git a/library/tedit/TEDIT-FNKEYS b/library/tedit/TEDIT-FNKEYS index 266fcfad..302917a7 100644 --- a/library/tedit/TEDIT-FNKEYS +++ b/library/tedit/TEDIT-FNKEYS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "15-Mar-2024 14:07:55" {WMEDLEY}tedit>TEDIT-FNKEYS.;74 32961 +(FILECREATED "26-Nov-2024 23:53:32" {WMEDLEY}tedit>TEDIT-FNKEYS.;101 38718 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND) + :CHANGES-TO (FNS \TEDIT.KEY.FIND) - :PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}tedit>TEDIT-FNKEYS.;69) + :PREVIOUS-DATE "23-Nov-2024 16:29:11" {WMEDLEY}tedit>TEDIT-FNKEYS.;100) (PRETTYCOMPRINT TEDIT-FNKEYSCOMS) @@ -17,12 +17,14 @@ (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.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.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 \TEDIT.ONECHAR.BACKWARD + \TEDIT.ONECHAR.FORWARD)) (COMS (* ;; "Auxiliary functions used in the above main functions:") @@ -69,12 +71,16 @@ ("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) @@ -84,7 +90,11 @@ ("Meta,U" FN \TEDIT.UNDO.UNDO) ("Meta,u" UNDO) ("Meta,z" UNDO) - ("Meta,Z" \TEDIT.UNDO.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] (P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) @@ -164,92 +174,125 @@ NIL TEXTOBJ]) (\TEDIT.KEY.FIND - [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "Edited 15-Mar-2024 13:36 by rmk") + [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 29-Feb-2024 17:06 by rmk") - (* ; "Edited 27-Feb-2024 00:22 by rmk") - (* ; "Edited 16-Feb-2024 23:43 by rmk") (* ; "Edited 14-Dec-2023 21:14 by rmk") (* ; "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") - (* ;; "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).") + (* ;; "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, but also assumes that the user is not interested in trying again at the current character position--starts forward or backward from there.") + (* ;; "AGAIN suppresses confirmation of a previous target.") - (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - TARGET CH) (* ; - "Case sensitive search, with * and # wildcards") - - (* ;; "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.") - - (CL:WHEN AGAIN - (SETQ TARGET (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING))) - (CL:UNLESS TARGET - (SETQ AGAIN NIL) (* ; - "If no previous target, we aren't %"again%"") - [SETQ TARGET (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD - "Backward search string: " - "Search string: ") - (\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING]) - (CL:WHEN TARGET - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (\TEDIT.SHOWSEL SEL NIL) (* ; - "Save for next search, even if not found") - (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING TARGET) - (SETQ CH (if BACKWARD - then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" TARGET - "%"") - T) - (TEDIT.FIND.BACKWARD TEXTOBJ (MKSTRING TARGET) - NIL NIL T) - else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" TARGET "%"") - T) - (TEDIT.FIND TEXTOBJ (MKSTRING TARGET) - NIL NIL T))) - (COND - (CH (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" found") - T) (* ; "We found the target text.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) + (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.UPDATE.SEL SEL (CAR CH) - (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH))) - (CL:IF BACKWARD - 'LEFT - 'RIGHT)) - (TEDIT.SET.SEL.LOOKS SEL (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) - 'PENDINGDEL - 'NORMAL)) - [SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH) - (CAR CH) - 'WORD - 'CHAR] - (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ)) - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found") - T))) - (\TEDIT.SHOWSEL SEL T))]) + (\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 29-Feb-2024 17:08 by rmk") + [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, TEDIT.SUBSTITUTE. It tries to determine the best tentative target string for a search. PROP is either TEDIT.LAST.FIND.STRING or TEDIT.LAST.SUBSTITUTE.STRING.") + (* ;; "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: use selection if longer than 1 character, otherwise last search string. Note that meta-G goes directly to the last search.") + (* ;; "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.") - (if (GETTEXTPROP TEXTOBJ PROP) - then (if (IGREATERP (GETSEL (GETTOBJ TEXTOBJ SEL) - DCH) + (* ;; "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 TEXTOBJ) - else (GETTEXTPROP TEXTOBJ PROP)) - else (TEDIT.SEL.AS.STRING TEXTOBJ]) + 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") @@ -287,7 +330,8 @@ SEL]) (\TEDIT.LCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk") + [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") @@ -296,7 +340,8 @@ (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY ( \TEDIT.SELPIECES - SEL)) + SEL NIL TEXTOBJ + )) (FUNCTION L-CASECODE) NIL TEXTOBJ) TEXTOBJ SEL) @@ -345,7 +390,8 @@ SEL]) (\TEDIT.UCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk") + [LAMBDA (STREAM TEXTOBJ SEL) (* ; "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") @@ -354,7 +400,8 @@ (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY ( \TEDIT.SELPIECES - SEL)) + SEL NIL TEXTOBJ + )) (FUNCTION U-CASECODE) NIL TEXTOBJ) TEXTOBJ SEL) @@ -382,8 +429,9 @@ SEL]) (\TEDIT.SELECT.ALL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:") - (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ)) + [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 @@ -392,6 +440,50 @@ (* ;; "Stub for function-key") (TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T]) + +(\TEDIT.MANPAGE + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "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) + (GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL)))]) + +(\TEDIT.CALL.ED + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-May-2024 15:03 by rmk") + (ED [MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL] + '(:DONTWAIT]) + +(\TEDIT.ONECHAR.BACKWARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk") + (* ; "Edited 1-Sep-2024 10:39 by rmk") + (TEXTOBJ! TEXTOBJ) + (SELECTION! SEL) + (LET ((PT (TEDIT.GETPOINT TSTREAM SEL))) + (CL:UNLESS (ILEQ PT 1) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL (SUB1 PT) + 0) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) + +(\TEDIT.ONECHAR.FORWARD + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk") + (* ; "Edited 1-Sep-2024 10:39 by rmk") + + (* ;; "Moves caret to a point one character forward.") + + (TEXTOBJ! TEXTOBJ) + (LET ((PT (TEDIT.GETPOINT TSTREAM SEL))) + (CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL (ADD1 PT) + 0) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ))]) ) @@ -511,13 +603,14 @@ (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.STRIKEOUT.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT ON) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [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))]) ) @@ -585,12 +678,16 @@ ("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) @@ -600,7 +697,11 @@ ("Meta,U" FN \TEDIT.UNDO.UNDO) ("Meta,u" UNDO) ("Meta,z" UNDO) - ("Meta,Z" \TEDIT.UNDO.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))) [MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) (SELECTQ (CADR ENTRY) @@ -609,21 +710,23 @@ (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY] (DECLARE%: DONTCOPY - (FILEMAP (NIL (5609 23249 (\TEDIT.BOLD.SEL.OFF 5619 . 5957) (\TEDIT.BOLD.SEL.ON 5959 . 6287) ( -\TEDIT.CENTER.SEL 6289 . 7805) (\TEDIT.CENTER.SEL.REV 7807 . 8103) (\TEDIT.DEFAULTS.CARET 8105 . 8598) - (\TEDIT.DEFAULTSSEL 8600 . 9047) (\TEDIT.SETDEFAULT.FROM.SEL 9049 . 9726) (\TEDIT.KEY.FIND 9728 . -14757) (\TEDIT.GET.TARGET.STRING 14759 . 15623) (\TEDIT.KEY.FIND.BACKWARD 15625 . 15930) ( -\TEDIT.FINDAGAIN.BACKWARD 15932 . 16343) (\TEDIT.FINDAGAIN 16345 . 16636) (\TEDIT.ITALIC.SEL.OFF 16638 - . 16890) (\TEDIT.ITALIC.SEL.ON 16892 . 17085) (\TEDIT.LARGERSEL 17087 . 17375) (\TEDIT.LCASE.SEL -17377 . 18564) (\TEDIT.SHOWCARETLOOKS 18566 . 20166) (\TEDIT.SMALLERSEL 20168 . 20459) ( -\TEDIT.SUBSCRIPTSEL 20461 . 20664) (\TEDIT.SUPERSCRIPTSEL 20666 . 20870) (\TEDIT.UCASE.SEL 20872 . -22003) (\TEDIT.UNDERLINE.SEL.OFF 22005 . 22203) (\TEDIT.UNDERLINE.SEL.ON 22205 . 22401) ( -\TEDIT.STRIKEOUT.SEL.ON 22403 . 22599) (\TEDIT.STRIKEOUT.SEL.OFF 22601 . 22799) (\TEDIT.SELECT.ALL -22801 . 23024) (\TEDIT.KEY.SUBSTITUTE 23026 . 23247)) (23321 29730 (\TEDIT.BOLD.CARET.OFF 23331 . -23866) (\TEDIT.BOLD.CARET.ON 23868 . 24400) (\TEDIT.ITALIC.CARET.OFF 24402 . 24939) ( -\TEDIT.ITALIC.CARET.ON 24941 . 25484) (\TEDIT.LARGER.CARET 25486 . 26021) (\TEDIT.SMALLER.CARET 26023 - . 26560) (\TEDIT.SUBSCRIPT.CARET 26562 . 27103) (\TEDIT.SUPERSCRIPT.CARET 27105 . 27647) ( -\TEDIT.UNDERLINE.CARET.OFF 27649 . 28189) (\TEDIT.UNDERLINE.CARET.ON 28191 . 28729) ( -\TEDIT.STRIKEOUT.CARET.OFF 28731 . 29271) (\TEDIT.STRIKEOUT.CARET.ON 29273 . 29728)) (29799 30501 ( -\TK.DESCRIBEFONT 29809 . 30499))))) + (FILEMAP (NIL (6220 28574 (\TEDIT.BOLD.SEL.OFF 6230 . 6568) (\TEDIT.BOLD.SEL.ON 6570 . 6898) ( +\TEDIT.CENTER.SEL 6900 . 8416) (\TEDIT.CENTER.SEL.REV 8418 . 8714) (\TEDIT.DEFAULTS.CARET 8716 . 9209) + (\TEDIT.DEFAULTSSEL 9211 . 9658) (\TEDIT.SETDEFAULT.FROM.SEL 9660 . 10337) (\TEDIT.KEY.FIND 10339 . +15406) (\TEDIT.KEY.FIND.SEARCHSTRING 15408 . 16548) (\TEDIT.GET.TARGET.STRING 16550 . 18264) ( +\TEDIT.KEY.FIND.BACKWARD 18266 . 18571) (\TEDIT.FINDAGAIN.BACKWARD 18573 . 18984) (\TEDIT.FINDAGAIN +18986 . 19277) (\TEDIT.ITALIC.SEL.OFF 19279 . 19531) (\TEDIT.ITALIC.SEL.ON 19533 . 19726) ( +\TEDIT.LARGERSEL 19728 . 20016) (\TEDIT.LCASE.SEL 20018 . 21413) (\TEDIT.SHOWCARETLOOKS 21415 . 23015) + (\TEDIT.SMALLERSEL 23017 . 23308) (\TEDIT.SUBSCRIPTSEL 23310 . 23513) (\TEDIT.SUPERSCRIPTSEL 23515 . +23719) (\TEDIT.UCASE.SEL 23721 . 25060) (\TEDIT.UNDERLINE.SEL.OFF 25062 . 25260) ( +\TEDIT.UNDERLINE.SEL.ON 25262 . 25458) (\TEDIT.STRIKEOUT.SEL.ON 25460 . 25656) ( +\TEDIT.STRIKEOUT.SEL.OFF 25658 . 25856) (\TEDIT.SELECT.ALL 25858 . 26174) (\TEDIT.KEY.SUBSTITUTE 26176 + . 26397) (\TEDIT.MANPAGE 26399 . 27155) (\TEDIT.CALL.ED 27157 . 27369) (\TEDIT.ONECHAR.BACKWARD 27371 + . 27941) (\TEDIT.ONECHAR.FORWARD 27943 . 28572)) (28646 35157 (\TEDIT.BOLD.CARET.OFF 28656 . 29191) ( +\TEDIT.BOLD.CARET.ON 29193 . 29725) (\TEDIT.ITALIC.CARET.OFF 29727 . 30264) (\TEDIT.ITALIC.CARET.ON +30266 . 30809) (\TEDIT.LARGER.CARET 30811 . 31346) (\TEDIT.SMALLER.CARET 31348 . 31885) ( +\TEDIT.SUBSCRIPT.CARET 31887 . 32428) (\TEDIT.SUPERSCRIPT.CARET 32430 . 32972) ( +\TEDIT.UNDERLINE.CARET.OFF 32974 . 33514) (\TEDIT.UNDERLINE.CARET.ON 33516 . 34054) ( +\TEDIT.STRIKEOUT.CARET.OFF 34056 . 34596) (\TEDIT.STRIKEOUT.CARET.ON 34598 . 35155)) (35226 35928 ( +\TK.DESCRIBEFONT 35236 . 35926))))) STOP diff --git a/library/tedit/TEDIT-FNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM index deacbf47f0b5aee77418d17069a125b1c9a7f0ac..15218874f768ae29d1f120d64436756aa0dc47fd 100644 GIT binary patch literal 17264 zcmeHP&2L**b|)p*X*rqH%DBbUzyvqU3_=+eA%5tK2?9NmkK&8TN1E@^vId1QvP4IW zWXX`^nMpeX6ved50u3-g7hScTP0>XXJ3x0@d$#Rj@?SWZ^%VV`b3Y$RDbjdSG={yP z`0hRL-h0kH=XXBtrE_(^5rqC+BWU?^LD=YsH@aT!rnlycY!JqNuN6eytazj6d-d3> zwnmz(UgV3y{A?zZqY-K#i~YLD78mEjgCEZo=Zj@gEL9dtl~OS)a@nne2M>pPgKcrJ zFS6pV*V}%*v#y+=aMe5H}snn%aulgIZ-Hy+`1pEHDdvt2>R{W2@4JNI?uVZ>E~ElIALY9bi1yaPxe6~l*{Tu zI-$RQtMAnzsgl6H`8}A&S4&bfSjZ$SR{A_%tac(F67HqbsY~9UkYpbRAJCuGYKH#s z_qS`mWTF3pKe>G>{rM~0w{z{%- z#YNrd^*p(4HX!~Km3wv28ik9DqVQ7NIP$=?W^g#PXj{Dy4 zM{&>yfD%%G_|l_&pB1H|A~7A7mR_AC`aGn30j(ebkX8&|B^g2v%UUh%ZmNwp`Uiyc z`mH$1v(jE*vbWPb*=3sQ=_)qkNA#`9+w?krYW>7QN{f0WQM0qoQ^_4DE~`y(+lnHT zSX+c_3yb1sm!`>b`Hgs^>%a9gL3_z&3yLvbjM9F!azY8kS&SHiFD4DX`1`Ig@?$0P zd;`j94eVTNePaqj_gLo2Qg%F6`nu`I z?MdR)F2B;opewx0%+vDCZ zKmIiRz3B5-noqB7UEXOjN&mAOO&+YrpWG$^=OmVI?Q9Rf{YPX1pIkpL<;M2Ee46_B zH0mZV<|I-pIEjLEFqIC{U+n&-|4RnJU+`!1*OeThLVSqh!uwi z`SQv1&eiXpG`Ax*)vM(bIo&6JaoTe9C=9Tr@`7v7WN;?FBYW& z`C4)VA@sm&1wZs9=9K1(dN9(-AdLK8Y}Hm2m&PV50?d_?H-bAfeR08nUB64g1Y1^d zenry}@G#;0yl!G`%0q?xu%7SY1In1M`z;@#NMWTkft|wgl4hr{2xVnSy8~q)Ti1DON*)<8YBszG}&mddAPMR-2VV{ zhl1W)Da-EVWw-a<=GN{{HV?NoSw=w5vW+24Sr$2nZY>l!hr=M0JPO1+x4l;1pS7-6 z3roj5MZ`HkoG7N~lpv1r%tavrJjx>OGznY-pjJZ80oGu4m*OTysneq-gMKADDtuIF zI-R<_%7Ab$<^B7%^t#`@H+2%tyg9|D&z=17$Am&B-@lxOGk_k@l6l1vvPB7M)4t8V z09&U7qZyZ2FWrG$3#r1&*dPV)DdS|v|LQ@Ks>abbiD^VIMOQEdBN*d9!1fxs=9w!g z@1IwhN5-l9UnH=I0B$t52^z zef7)7!NE?yZ?RnlmFUz{j-lr>kHV6Fm9U67w&^oo@KZSr+KNQ zJqP@l!h}=Q3h*k8qKl|(%qZ0M3P6jaH11B2vIEL1ou0@$ z@2Slm$7ky?O>X}czzVZhfF)AjhUh7=uc?SlYU~ISjwVWE;ylOL+~>&GX-3Y>wq?;G~#+^J*1ih!mJ2^bU+C+>J%}+vhBy7i>@t#KaPf#txVQe zV;%3(qN^&eo+!2; zO4-Jte%$lIh%!4$P{%1c-3?o0GjD>;g(XpG9sFc)Slc`rh=qCg2}uh3TMErOy$w{X zAfS@X8VgIJ#m<3hg09F$iWDY-kvns)t^YZNF5c5JSE*#UmSSNx<-_IA-qhbdeD?Uy zST%J6Y~~$Obud7`NiqPxrVLgmtYy10gUH2lwwE4UPrM)>=1^K_U+LgWBVR|2daEMsn)k+aRNU zmBieQFShvaFov;>B^QbfRbeI7qRA!%YR?GP3@RjayWfS_o^Spna9wQv{tFLB{f7@7 zII>UYfTR9IIO>OWI;sj8M_n&H8ObSdH)wt#&u1ng1+uQsG|MRAYjeD29?=Qy>=bO? z^gDgzVico%ZL^zs&YInxCjFsh?@aH?9z3H2lLy#cAPS_DtLfEU<)meOK%WVivkt0j z_$@#~p)AiejAL}+g2F}utT>4KsDYdrLL?MVMxv;S>WOuw-;OpKinhJ5OJ}oZPhwR2 zP3F=@DC{=>L)FE(nQN7(O0D^!-$Rg#3Ap6lM|!Bsd!$q*MHQ%PAf=(wc4xhhIwWU= zCL_W@5^7`{T`#0?0htw2&_-vi=XIN|%xc)JJWhVj$%kM*qD*++pLTV zQOfGj2^;@pW>p?DnA`^Oe`1rJlRYE`a?hMLo99eAu99Y^N>O;AlI~e2=_;92PU3~& zGkGpQnl!%%8+vxK{~~SaS)~Q{1pb??xXFq{(Fx@enUlfZ3#8Tm&!8yD>72`|PV!!y zZ5>G}MUq{URlc|kJKJkg70Inl%D&l_YuGw10eq3b*kN{Jx~X{8Dc?7HXHQEnO>+HB z*jZ#RxKGOUV)hw%+(?`hAv(;;olTZDbz(LzxX>w5|9}iE?HnoF?8|9%zH$-n+2ikV zOzgDtdrtM%={oN#_IwCYw64zLoXmX1B}6U~p_sbF>*o{|w^fK2{*L<;iW)UrMU4A0 zroUXY-w~0UcI3W#Xek*Qjk79bhI}5gvaF9}sA4PIa1gEna$I_mw_B;kuG(-IPCgRJ zSi@@vtqls{3#F2*0#jjER(-Pq$By(+#DOW%Gv9B zw{FRN!s!sX9QBLbb@9$SxcuCBw7+#cJlH=H$2*(HVsq>G(dORXM`HNk;ojiEVE-8H z1A$xC4>tF=kN6S^HQZOPiQU0RN0sbs;{GzHRFrqaBMM!RwvC}qaqX?k@fN+E<*91@$#z4YIOEg2jvc0`iT!y)1rF zaEDm13tPkwX>_B1w3QVoYvRUFg63{KvDxFbY2C5dn|OEAWx&!98Yk$gE}aAIAaYo^ zH<=3cdzUAcs}@=U1QTRn7P8grcj-pP!-m>TFi@5l3rDJ!#2{*N@xDuA^zhcmKfC_00vF0^8r@{e{(?NdW*05iuOW(=u$dIn8rx)W+- z!XDEtl~GM%y2ob;C6Z;#i~APZSWpM9?3J50#GSJ`A9AN=fFtBQ{YuHajUP2y`=8K% zXaHI68K78$HZKhz?qCr~h_qIo0h&o7cal?R`YsK*p}h7*JkKNixG&N0SJp8x!4I<< zILBXp*Bx8OKRPZltGtn5WJe3+4?96AXQ{ z5ysvf8qp5uj85yMe~An#`O`ea6}s0N6WDMZ^##KUM;v@v8tZkS>bb)T8$dWwg)_l( zhZRZ;HeyIJkia}kbdj*avLK@hZQVBb7;%ah3M*_?KY? zhbWGeUxpQw7{hw3%DfCKC~SHeR;c*#Wmv(NbZl6W`FaBi9ZzJQE1=;2>EM3>Q63us delta 2018 zcmb_dOKcNY6!q8%A(J%VVkeHn=Vn@p6UcbJ9?#Ia9*@WIB#v$T5l|??V3&l1ICWAX zR8?saDqE^6x~f#ERTouT2{2t&QN^O7n{GjBH{Ep81$0rV5{teWe_{lz+L87A=Du_P z=e~LLG4$>RJ6ub0bqMcEzA2Ex6{aJ&2(;?5^kPZE7O%{XqJD@Lb=bquqj84kUT!NZQf0oYj#n+3Tij zD{VQ>7pqGz_1ordO+O#{Eb^`D7q?y4UxZGioiMf%bJU!hnxh^rKS)|*NA>Yt&!R7|m98e7BcDXHTA;KO`>pX82C?MecDq8Nq{3;^ zcdNt})4AhCGXtW;D*c%gq--kd%(?az07eWuJk-D>z2K>Jd2Ab~7z-V#f_1wV7ZWN?F+?p)n5&^TkrZ z%FY5G5s@1639`~fi_so5o6wE<<9dOp32Kj;z!Noptec7|L%v+H`Iax_@(>j}A$HP_ zbYdXfw6X*Xg#X@f@Pxnv5p^}?4r$2%35p6NH`6Ftxhx0~1+uxqf=-f+@Q^pNNs>X* z&Rr6qV9lmWAczsjn5hy(Rs3XR%ndT$7zubtn&frjtSEB89Asd%z5(yl-&?IRWcDOm z!~m~GowK%_SB17*?rfw8FvVJ>aek59BSgOejvnvWBnCJM9}MjulZe3<4AwUq1geo6 zN{r&Y5qYyUtQMJ4r%cxNj81{;FkzrOt~(sMMa z;x=D0tX^c>Esku1e7U?`R=%gIyo8Uyhp~a3csf4V{M}ph3}_?}Pht>be$_3gc*Q?K z33$^#InH&vYG(45X_!UU$mLIxD*xj5?~_5x)GyZ>MrFMQQuL`e!m?4{aJRX@%gxEr zFaL|H^4eODtDd*#xVjZgyVZc5Rs5pfDyVz;!S=;KYDtRH9X7%_QYOAlCB-SwtU7|n z_MK_=P1b1Y2;M%lcWh6*eJ{lIgmcL)Iz7P(^EM709%_1y{Nu*)@XNRm54eHGQ_*oe z6At0^@Ii{kZ^Ih?5uPSHFE@=0H;M%=h(An>;Z@F$admXp6oic2LJ>mKaP%n9O`88^ z2bIEl+)r8+z`vDUI1^=wfm6{b{53vKt>H2KKwqAG5AjLVz^b}`pvXWfO9QdDA0O%r xKG7jaw{NC$Hko7XWy*eld_(Z3#4NElVjMu$c%vCS`d8oo;L!VwL%f&x?qBJDTEDIT>TEDIT-HCPY.;153 33754 +(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}tedit>TEDIT-HCPY.;164 32996 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE) + :CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN) - :PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}TEDIT>TEDIT-HCPY.;152) + :PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}tedit>TEDIT-HCPY.;160) (PRETTYCOMPRINT TEDIT-HCPYCOMS) @@ -87,9 +87,11 @@ "Can't HARDCOPY: No print server specified." T]) (\TEDIT.PRINT.MENU - [LAMBDA (TSTREAM) (* ; "Edited 25-Jun-2023 13:16 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk") + (* ; "Edited 25-Jun-2023 13:16 by rmk") (* ; "Edited 6-Jun-2023 17:48 by rmk") - (LET [(W (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TSTREAM] + (LET ((W (GETTOBJ (TEXTOBJ TSTREAM) + PRIMARYPANE))) (SELECTQ [MENU (create MENU ITEMS _ '(("Print to a file" 'FILE "Puts image on a file; prompts for filename and format" @@ -101,7 +103,8 @@ NIL]) (TEDIT.HCPYFILE - [LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 4-Oct-2022 09:23 by rmk") + [LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk") + (* ; "Edited 4-Oct-2022 09:23 by rmk") (* ; "Edited 1-Oct-2022 22:12 by rmk") (* ; "Edited 12-Jun-90 18:36 by mitani") @@ -125,10 +128,14 @@ 'HCPY) 'BODY (fetch (STREAM FULLFILENAME) of TXTFILE] - (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE]) + (if FILENM + then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE) + else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))]) (\TEDIT.HARDCOPY.DISPLAYLINE - [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Apr-2024 09:09 by rmk") + [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 13-Dec-2024 23:49 by rmk") + (* ; "Edited 13-Jun-2024 17:13 by rmk") + (* ; "Edited 19-Apr-2024 09:09 by rmk") (* ; "Edited 20-Mar-2024 11:04 by rmk") (* ; "Edited 15-Mar-2024 19:23 by rmk") (* ; "Edited 24-Dec-2023 22:07 by rmk") @@ -151,16 +158,16 @@ (FGETTOBJ TEXTOBJ TEXTLEN)) [LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE))) (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) - (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) + (FGETLD LINE LCHAR1) LINE REGION PRSTREAM FORMATTINGSTATE)) (* ;; "Use the characters cached in THISLINE.") - (for CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE - + (for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE TLSPACEFACTOR - ) - of THISLINE)) + ) + of THISLINE)) (FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE)) (SCALE _ (DSPSCALE NIL PRSTREAM)) (TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM) @@ -225,11 +232,7 @@ ) of CLOOKS] (T (FGETLD LINE YBASE] - (DSPYPOSITION CURY PRSTREAM) - (CL:WHEN (SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) - of CLOOKS) - 'KERN)) - (SETQ KERN (HCSCALE SCALE KERN))) + (DSPYPOSITION CURY PRSTREAM) (* ;; "LOOKSTARTX: Starting X position for this CLOOKS.") @@ -253,6 +256,8 @@ (SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE PRSTREAM)) + elseif (EQ 'KERN CHAR) + then (RELMOVETO 0 CHARW PRSTREAM) else (\OUTCHAR PRSTREAM CHAR)) (add TX CHARW))) finally @@ -272,13 +277,14 @@ (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS [LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 26-Oct-2024 11:04 by rmk") (* ; "Edited 17-Mar-2024 17:22 by rmk") (* ; "Edited 19-Jan-2024 23:19 by rmk") (* ; "Edited 3-Oct-2022 13:05 by rmk") (* ;; "Return setup LINE to skip a sequence of heading pieces STATE") - (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) + (SELECTQ (GETPARA FMTSPEC FMTPARATYPE) (PAGEHEADING (* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.") @@ -287,11 +293,11 @@ T) (EVEN (* ; "Skip an odd page.") (CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#)) - (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO) + (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO) T)) (ODD (* ; "Skip an even page") (CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#)) - (TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO) + (\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO) T)) NIL]) @@ -337,7 +343,8 @@ (MOVETO CURX CURY PRSTREAM]) (\TEDIT.HCPYFMTSPEC - [LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk") + [LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 28-Jul-2024 22:25 by rmk") + (* ; "Edited 15-Mar-2024 19:34 by rmk") (* ; "Edited 7-Mar-2023 21:03 by rmk") (* ; "Edited 6-Mar-2023 15:14 by rmk") (* ; "Edited 20-Oct-2022 22:35 by rmk") @@ -346,44 +353,31 @@ (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ") - (LET ((SCALE (DSPSCALE NIL IMAGESTREAM)) - FMTSPEC) - [SETQ FMTSPEC (create FMTSPEC using SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _ - (HCSCALE SCALE (fetch (FMTSPEC 1STLEFTMAR) of SPEC)) - LEFTMAR _ (HCSCALE SCALE (fetch (FMTSPEC LEFTMAR) - of SPEC)) - RIGHTMAR _ (HCSCALE SCALE (fetch (FMTSPEC RIGHTMAR) - of SPEC)) - QUAD _ (fetch (FMTSPEC QUAD) of SPEC) - TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE) - FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX) - of SPEC) - (HCSCALE SCALE - (SCALEPAGEUNITS - (fetch (FMTSPEC FMTSPECIALX) - of SPEC) - 1.0 NIL))) - FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY) - of SPEC) - (HCSCALE SCALE - (SCALEPAGEUNITS - (fetch (FMTSPEC FMTSPECIALY) - of SPEC) - 1.0 NIL))) - LEADBEFORE _ (HCSCALE SCALE (fetch (FMTSPEC LEADBEFORE) - of SPEC)) - LEADAFTER _ (HCSCALE SCALE (fetch (FMTSPEC LEADAFTER) - of SPEC)) - LINELEAD _ (HCSCALE SCALE (fetch (FMTSPEC LINELEAD) - of SPEC)) - FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE) - of SPEC) - (HCSCALE SCALE (fetch (FMTSPEC - - FMTBASETOBASE - ) - of SPEC] - FMTSPEC]) + (LET* ((SCALE (DSPSCALE NIL IMAGESTREAM))) + (create FMTSPEC using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _ + (HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR)) + LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR)) + RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR)) + QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT) + FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB)) + FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS) + SCALE) + FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX) + (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA + DISPLAYFMT + FMTSPECIALX) + 1.0 NIL))) + FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY) + (HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA + DISPLAYFMT + FMTSPECIALY) + 1.0 NIL))) + LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE)) + LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER)) + LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD)) + FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE) + (HCSCALE SCALE (FGETPARA DISPLAYFMT + FMTBASETOBASE]) (\TEDIT.INTEGER.IMAGEBOX [LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52") @@ -451,7 +445,9 @@ (DEFINEQ (TEDIT.HARDCOPYFN - [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Mar-2024 10:49 by rmk") + [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk") + (* ; "Edited 29-Jun-2024 14:42 by rmk") + (* ; "Edited 20-Mar-2024 10:49 by rmk") (* ; "Edited 25-Sep-2023 16:29 by rmk") (* ; "Edited 4-Jul-2023 11:16 by rmk") (* ; "Edited 21-Sep-2021 15:33 by rmk:") @@ -459,22 +455,15 @@ (* ;;  "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.") - (LET ((TEXTOBJ (TEXTOBJ WINDOW)) - (TEXTSTREAM (TEXTSTREAM WINDOW)) - WASDIRTY) + (LET ((TEXTSTREAM (TEXTSTREAM WINDOW))) (* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!") - (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) - (SETQ WINDOW (\TEDIT.MAINW WINDOW)) - (SETQ TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW))) - (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) - '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] - (FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy) (* ; "Build the hardcopy") - (SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY)) - (PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM) - (FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))]) + (TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW) + MENUFLG) + (\TEDIT.MAINW WINDOW) + WINDOW) + IMAGESTREAM]) (\TEDIT.HARDCOPYFILEFN [LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk") @@ -566,11 +555,11 @@ (CLOSEF DOC]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE - 5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 . -18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) ( -\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 ( -\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) ( -\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY - 30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729))))) + (FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE + 5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 . +19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) ( +\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 ( +\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) ( +\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY + 30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971))))) STOP diff --git a/library/tedit/TEDIT-HCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM index 629023942d78d567f99bce87e0bcb39b19fe8857..d766b2f04d4f1801d9ffeb40e7c90028983b8bd3 100644 GIT binary patch delta 3241 zcma)8OKcn06&;eYV$rff(i4RuWa^rdSxKds`SW8}Aw>>L$|N5{jv@(gJCRM}ttiHeHfg6oHeol(A`2PtqV1~4irNK53-rF3p-I6; zAT7i<_nkTS^X8s+AK&`#8^7MTATDLMZ!QU(Ab}tzWj-m0_uraZy1QN9y}PWb*@Cu| z&r~*}S9nEQ0C$KVdVyDxTs$c%_dmVb95P3v(Gb+Pkirem!ApE-!9AZV6xB>sO{0sG zpnen~_}O|%%@)e4-ng@M=bh!}Mg^jfNH~<%+m0(+U`8Cxr>ofvsch!T3y`c- z)z=GTt+td!XAlyUC35qwl`+pJIXTI3A#k708P{<+eNNwPC&M^WV+{U{(tq8N*8Ip1 znjG{U7fR{xtLssXRH}utrdA;?Kf6au05J|qYIzN041Gf*E2~(W1P}f9VhWfrNrtSN zORp6*iq5OWY_1HV0-0j9QYEE|1_Cz&_eNZFTidLtv-g1KhB!fpb!N{59gg=}E2D2; zsUHSENUiR!?9}t;U!W;?QhW4gw?1w@G4s5n*wwTgm=OUl3au|j|1-mj2?&+;be|Iv~bsj%xyS|g^ z#=X2Nowp8!>2)roy3tl@?6UKhp4RQLnI;%-W!yADgG}@nzAmFr8^qUj>OuS=(0kB! z{)9}|8_+x4MN6so+oBEL)dNPR0euP*c-VF(NzipDds8e49$c z+@moP+6n04eG-a<^*O`odh~>ZeQoE+Q(W8eO=GP0A^QB0W32bE&D=N0bW3o*+I)#j zki{diNPnI@KJq#yNrWsu?#CWMd+_ME!)6*$J1E@#N{<};`@#jf_mytv*>?P}aUL^s zY>?@On=S}V(KKZrx%S)4?@918TAGJ#heX&zHckA*Gm-8(37a`@R@5ND2j{-GJ+*o; zQ&_b#j2eW)45OH#uur04oudiLZWab<-AEYtbGmgVcM&oZ}`ndBl4gQPcKjQJ^ErcFCxM*|q-hYz> zE$h1(GX3khtul>J!c9N}~@$Uu%1+H7#QA$^@MX6-e3Zx8iuJzG)a3-b* zaGk7a^oxaMj$5g(E8`pR8vXBz_uxI5wf*Pj+8Y}FiwO=T!uBb}W34}o zUu;U)YiQeeN-HMhK^`KC%gJ3-8M7zNP8B5%Xa-bBLFoGt@S-q1^YO%hinplDw#}t8 z8mVF{^RJww=TQ*Q-!Ld<#%#7crqa?UCYwADxsq0^s2PY!0$fw8SPjI{z)UH?>S3`8 zwMsFK0uQpp5ADeq-T*11o(!HOJfNW`Jkr6FNDlxHJyTclJ{iV|C{(Ck_;D1~bQYyt ztyn0lfM+yV57`y5bL&N~!*RXyQ_pW)tpGdS?59)G7QnSN$1u*F zwE5Y3k6-lmf?j|(XcweRTRqQ4jC`ug{P|C-uEU6zn;mY*6@z54Ay=>=bNgf^tY@u; z%ncgyllnE5p$yKyd|ILmO>VYyFjFkqJ^d{deav6$W!6b4Ms$xsyUOD_d<7#Ro`XxM zJDzW4`UlDRel>*hHH|v)u_H#R>(NA1dZ=vNK0Y?Ce{=~c4)Ea@|x15^q*Q|!3mVdmo~=D8-7(l|D{ zscbRD7FR0mrbS7h6jF>L3-*G_lqtZmz5t8%mXxp+Qc@IanyKJ0xK=J`HIT%Z^_tih za52V1tx0E|0ZK&Ovu`6)8lzfzrG~O(^9pe~6k;@jX#3_-)=dj9+x$GvT&4wQNh?kp zffrrbn!5!s<)3;ORdMPRxE41x=~g)4qa4nba;Gx&#M%1b;@NR)khCta)+P2OWxY_& zlJx~(E;~@GtV!7GV64U8WsVA}h%y{xo+SP1Z18Fzf zE)j<&A@#yxB{oi4X<-)z2`<@7IqV@7D}>+zoRa&3_}-ft+l4MP z2j|Uu-}`-k-ur&v_db2)$ydL>Ig+1KU*DbMSzbhJzQFMXfxrLiT_xkQ#&z}FZ3JHRo3yaPh;TP*Os8BbwbseuY=1PE#GCVt1 zz3w~6aRoM45abMsJs&oI$V3v6k?lw*6kZ$%!CxQwIZA{brRQavLuJ({6>)t_ud3Iy zjjW05hF&u@11ZvfuMwA#%%Q4QTSGZyYMUlrT7g*Pc@*rEWkkh936->Eb**9&>9STS zE!U7BqhiIV8@O6G5zmdIH+!OF+1#pYm)=Ai+l7gEjJ`LRhvyboZY^y$ z%V%F89t?-3Il*}?opi=t_^UJCFW(SYq@z0G1!S6=WWb{mHaGN=Stef`UF9TH1eZ5p zhRe|*8HuP-R4ZDet`@ZhnGjF~ijUPAl>d zr<*(Id^q6+)i23dw6onnsOu2M}NfAiB@E(EqA^Zk#+`7-UX$vg$GU^v_kh?oObTU zuG*uZW%d})l7F8(IgW=f;4Gef;@bn`A&ibs51Hal*0&0lKen>_e;XMgYad%fo@^`p zlby5RTKI=Jy%QsYw~3E*YVT2WuNC?iM!zFoK4^t^F>}DEIE9CY)T0Pyif3u`T#TG+ zXRg?(mHlyj#q-f(UCe`vEVwA{VRp*miHm>1V&YyPbG!#A)@Wcf;~hopYed@@tR(Cn zvQn+k@1qA|oc$b5dT~tGa59LapxS^Xmt|6Jtd%K7P zlJa@T?@a?q66X&fYoFSXo5&Lm0GV7MlVgRp6{3=(mfNDIX|t_K$O|1;1X(0ox>mt@ zn!7Zk1wlc?DZ*Wd5A^Vm=2SBW^wo|ECsXY-y_eOZi4DZ@iv2V^$K}aHw~!1B0yBgf zP!3F^#U#6ojjC!^^qL05rvMu+SItIUDm1i|o%rj~%! z1=b@#Kv6(F{}d?4%E&D14dNThOP#UOH7~J;FQ1Et5AO{BC_2({zK&RrM4k68p0`On zW>ECYnNTRQt_L%f2^ue!IqX)Bbc4BpZd}YX+!l` z3D+8i6pS8x3E*&Ie*zEV#Q#M6GhRx352Wlsi~&%F>2ZB8hk+xSc$67-7t1sTKqF0@ zWQGEPRNIs}pcGgs7mxX-jDaaBJoee9*uaXOEgi8mXi785KvSxtDb=kh zY6T+F#*3?$ik(zXyHlAcs?MU`n(=HSvJne%{1Lzc#GSk<_ z?631zYQ9*L>Ed57JX0=KzS@ahoK!Q2{0v_ zi3M>Ud{_-mbkHieP)l&Zhc5uUf(y?9-;tUJ_<3f~h4x2*W{Ps198fahcRFLsY|a}= zz)5sU3Yak``%AfCznJ$)Qv{Nu!Xl6erM)^dg=;n4Y#;#$m97aQ5HBHjf%h}MBg8}9 zAuMU@W*1FnDU_)$0pA3hc_Qr2LTrK|37tCT@f}4V~9XCf{F=PxLy!yaZhqPtS`wuvR01LeOlzR9y!h zCRBW|4W6Lcj?*g3!c7xdbWMYI2{}aCalyrJhf}X@ASnCfW#xO-{mg=tAUDL*nD$hP UkgBwuLvZ~%`(_TWj9q2^4Iv-w(EtDd diff --git a/library/tedit/TEDIT-HISTORY b/library/tedit/TEDIT-HISTORY index d5d7e0a4..7009a3db 100644 --- a/library/tedit/TEDIT-HISTORY +++ b/library/tedit/TEDIT-HISTORY @@ -1,21 +1,25 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}tedit>TEDIT-HISTORY.;154 33348 +(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}tedit>TEDIT-HISTORY.;219 53094 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.UNDO) + :CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO + TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE + \TEDIT.COMPOSITE.EVENT) + (VARS TEDIT-HISTORYCOMS) + (MACROS \TEDIT.HISTORYADD1) - :PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}tedit>TEDIT-HISTORY.;153) + :PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}tedit>TEDIT-HISTORY.;213) (PRETTYCOMPRINT TEDIT-HISTORYCOMS) (RPAQQ TEDIT-HISTORYCOMS ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT) - (MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH) - )) + (MACROS \TEDIT.LASTEVENT GETTH SETTH))) (FNS \TEDIT.HISTORYEVENT.DEFPRINT) + (MACROS \TEDIT.HISTORYADD1) (INITRECORDS TEDITHISTORYEVENT) (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST) (INITVARS (TEDIT.HISTORY.TYPELST NIL) @@ -23,13 +27,16 @@ (COMS (* ;; "History-list maintenance functions") - (FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS)) + (FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS + \TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT)) (COMS (* ;; "Specialized UNDO & REDO functions.") (FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO) - (FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE) - (FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE)))) + (FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE + \TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS + \TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE) + (FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE)))) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -47,16 +54,16 @@ NIL (* ;  "Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) - [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT - THCH#) of DATUM) - (IPLUS (fetch ( + [ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch ( TEDITHISTORYEVENT - THCH#) - of DATUM) - (fetch ( + THCH#) + of DATUM) + 0) + (OR (fetch ( TEDITHISTORYEVENT - THLEN) - of DATUM] + THLEN) + of DATUM) + 0] (INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT ))) THPOINT _ 'LEFT) @@ -80,9 +87,6 @@ (PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) -(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) - (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) - (PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT))) @@ -114,6 +118,15 @@ (CDR LOC) "}"]) ) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.HISTORYADD1 MACRO ((TEXTOBJ EVENT) + + (* ;; "This is the primitive, to be upgraded if we go to a ring.") + + (push (FGETTOBJ TEXTOBJ TXTHISTORY) + EVENT))) +) (/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER) @@ -144,7 +157,11 @@ (DEFINEQ (\TEDIT.HISTORYADD - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Mar-2024 12:15 by rmk") + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Dec-2024 17:32 by rmk") + (* ; "Edited 29-Aug-2024 12:30 by rmk") + (* ; "Edited 11-Aug-2024 21:57 by rmk") + (* ; "Edited 30-Apr-2024 22:51 by rmk") + (* ; "Edited 3-Mar-2024 12:15 by rmk") (* ; "Edited 19-Feb-2024 12:09 by rmk") (* ; "Edited 30-Dec-2023 22:19 by rmk") (* ; "Edited 11-Aug-2023 14:25 by rmk") @@ -158,55 +175,73 @@ (* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards. Old code seemed to treat those as separate events, and only the second/right one could be undone.") - (CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY)) - (if (type? TEDITHISTORYEVENT EVENT) - then (CL:WHEN (MEMB (GETTH EVENT THACTION) - (CONSTANT (LIST :Put :Get))) (* ; + (if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE) + then + (* ;; "Maybe the first event after setting the textprop--now's the time to flush") + + (FSETTOBJ TEXTOBJ TXTHISTORY NIL) + (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) + else (if (type? TEDITHISTORYEVENT EVENT) + then (CL:WHEN (MEMB (GETTH EVENT THACTION) + (CONSTANT (LIST :Put :Get))) + (* ;  "Can't back up over Put/Get, flush the history.") - (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) + (FSETTOBJ TEXTOBJ TXTHISTORY NIL)) - (* ;; "Somebody may have already done there own fixup.") + (* ;; "Somebody may have already done there own fixup.") - (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ))) - (CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT) - (EQ :Delete (GETTH EVENT THACTION)) - (EQ :Delete (GETTH OLDEVENT THACTION))) + (LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ))) + (CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT) + (EQ :Delete (GETTH EVENT THACTION)) + (EQ :Delete (GETTH OLDEVENT THACTION))) - (* ;; - "Repeated successive deletions, we can combine them if they are adjacent.") + (* ;; + "Repeated successive deletions, we can combine them if they are adjacent.") - (CL:WHEN (IEQP (GETTH EVENT THCHLIM) - (GETTH OLDEVENT THCH#)) + (CL:WHEN (IEQP (GETTH EVENT THCHLIM) + (GETTH OLDEVENT THCH#)) (* ;  "OLDEVENT is first, EVENT is still delete") - (SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ)) - (\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing") - (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ))) + (SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ)) + (\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing") + (SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ))) - (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation") + (* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation") - (CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT) - (EQ :Delete (GETTH OLDEVENT THACTION)) - (IEQP (GETTH OLDEVENT THCHLIM) - (IPLUS (GETTH EVENT THCH#) - (GETTH OLDEVENT THLEN] + (CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT) + (EQ :Delete (GETTH OLDEVENT THACTION)) + (IEQP (GETTH OLDEVENT THCHLIM) + (IPLUS (GETTH EVENT THCH#) + (GETTH OLDEVENT THLEN] - (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.") + (* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.") - (SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT)) - (\TEDIT.POPEVENT TEXTOBJ))) - (push (GETTOBJ TEXTOBJ TXTHISTORY) - EVENT)) - elseif (LISTP EVENT) - then - (* ;; "A monolithic sequence of undoable events") + (SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT)) + (\TEDIT.POPEVENT TEXTOBJ))) + (\TEDIT.HISTORYADD1 TEXTOBJ EVENT)) + elseif (LISTP EVENT) + then + (* ;; "A monolithic sequence of undoable events") - (push (GETTOBJ TEXTOBJ TXTHISTORY) - EVENT))) + (* ;; "SHOULDNT HAPPEN ?") + + (\TEDIT.HISTORYADD1 TEXTOBJ EVENT))) EVENT]) +(\TEDIT.HISTORYADD.COMPOSITE + [LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 19:31 by rmk") + (* ; "Edited 22-Sep-2024 18:47 by rmk") + (* ; "Edited 3-Jul-2024 08:02 by rmk") + (* ; "Edited 8-May-2024 12:34 by rmk") + (CL:WHEN EVENTS + (\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS) + (\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL + EVENTS) + (CAR EVENTS))))]) + (\TEDIT.CUMULATE.EVENTS - [LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 15-Mar-2024 13:54 by rmk") + [LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 8-Dec-2024 17:35 by rmk") + (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 3-Mar-2024 12:15 by rmk") (* ; "Edited 3-Jun-2023 17:09 by rmk") (* ; "Edited 27-May-2023 00:54 by rmk") @@ -222,8 +257,68 @@ (SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES) (GETTH EVENT2 THDELETEDPIECES) TEXTOBJ)) - (SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES))) + (SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES) + SPLEN)) EVENT1]) + +(\TEDIT.COMPOSITE.EVENT + [LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 15:47 by rmk") + (* ; "Edited 22-Sep-2024 18:47 by rmk") + (* ; "Edited 3-Jul-2024 08:02 by rmk") + (* ; "Edited 8-May-2024 12:34 by rmk") + (CL:WHEN EVENTS + (\TEDIT.HISTORYADD (CL:IF (CDR EVENTS) + (\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite) + NIL NIL NIL NIL NEWEVENTS) + (CAR EVENTS))))]) + +(\TEDIT.HISTORY.PROP + [LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE) (* ; "Edited 22-Sep-2024 08:42 by rmk") + + (* ;; "Called fromTEDIT.TEXT.PROP to manage the history list. History is ON by default, and the events always correspond to the current state of the document. If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch. CLEAR flushes old events but then turns on collection.") + + (PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE) + 'OFF + 'ON) + (CL:WHEN SETNEWVALUE + (SELECTQ NEWVALUE + ((ON T) + (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL)) + ((OFF NIL) + (* ;; + "HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out") + + (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T)) + (CLEAR (* ; + "Wipes out current history now, then resumes collection") + (FSETTOBJ TEXTOBJ TXTHISTORY NIL) + (FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL)) + (\ILLEGAL.ARG NEWVALUE))))]) + +(\TEDIT.HISTORY.EVENT + [LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES) + (* ; "Edited 26-Sep-2024 15:44 by rmk") + (* ; "Edited 23-Sep-2024 16:47 by rmk") + + (* ;; "Don't create if it's inactive") + + (CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE) + (CL:WHEN (AND (NULL LEN) + (type? SELPIECES CH#)) + (SETQ LEN (fetch (SELPIECES SPLEN) of CH#)) + (SETQ CH# (fetch (SELPIECES SPFIRSTCHAR) of CH#))) + (create TEDITHISTORYEVENT + THACTION _ ACTION + THCH# _ CH# + THLEN _ LEN + THPOINT _ (OR POINT 'LEFT) + THFIRSTPIECE _ FIRSTPIECE + THOLDINFO _ OLDINFO + THDELETEDPIECES _ DELETEDPIECES))]) + +(\TEDIT.POPEVENT + [LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2024 21:24 by rmk") + (pop (GETTOBJ TEXTOBJ TXTHISTORY]) ) @@ -233,7 +328,14 @@ (DEFINEQ (TEDIT.UNDO - [LAMBDA (TEXTOBJ) (* ; "Edited 20-Mar-2024 11:04 by rmk") + [LAMBDA (TSTREAM NOUNDOUNDO) (* ; "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") + (* ; "Edited 18-May-2024 16:23 by rmk") + (* ; "Edited 12-May-2024 21:08 by rmk") + (* ; "Edited 20-Mar-2024 11:04 by rmk") + (* ; "Edited 8-May-2024 11:16 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 7-Mar-2024 12:48 by rmk") (* ; "Edited 3-Mar-2024 20:02 by rmk") @@ -246,95 +348,123 @@ (* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.") - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY) - - (* ;; "Only undo things if the document is allowed to change.") - - (TEDIT.PROMPTPRINT TEXTOBJ "" T) - (PROG ((SEL (TEXTSEL TEXTOBJ)) - (EVENT (\TEDIT.POPEVENT TEXTOBJ)) - PREVEVENTS UNDOEVENT) - (CL:UNLESS EVENT - (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ)) + EVENT PREVEVENT UNDOEVENT) + (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) (RETURN)) + (SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ)) + (CL:UNLESS EVENT + (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T) + (RETURN)) + (CL:WHEN (MEMB (GETTH EVENT THACTION) + '(:Get :Put)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION)) + T) + (RETURN)) + (SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ)) + (SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ; + "So we can test for the undoundo event.") + (CL:UNLESS EVENT + (TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T) + (RETURN)) - (* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ") + (* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ") - (* ;; "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.") + (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.") - (SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY)) - (\TEDIT.SHOWSEL SEL NIL) - (\TEDIT.UNDO1 TEXTOBJ EVENT) + (TEDIT.PROMPTCLEAR TSTREAM) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UNDO1 TSTREAM EVENT) - (* ;; "Get the event that undid EVENT") + (* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ") - (SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ)) - (FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS) - (CL:WHEN [OR (NULL PREVEVENTS) - (AND (type? TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS))) - (MEMB (GETTH (CAR PREVEVENTS) - THACTION) - (CONSTANT (LIST :Get :Put] - (SETTOBJ TEXTOBJ \DIRTY NIL)) + (CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) + (SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))) + (CL:WHEN [OR (NULL PREVEVENT) + (MEMB (GETTH PREVEVENT THACTION) + (CONSTANT (LIST :Get :Put] + (FSETTOBJ TEXTOBJ \DIRTY NIL)) + (CL:UNLESS NOUNDOUNDO - (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing.") + (* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing by redoing the original event.") - (push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ) - (LIST (CAR PREVEVENTS) - UNDOEVENT EVENT)) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)))]) + (push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE) + (LIST PREVEVENT UNDOEVENT EVENT))) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ]) (\TEDIT.UNDO1 - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 14:55 by rmk") + [LAMBDA (TSTREAM EVENT) (* ; "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") + (* ; "Edited 12-Aug-2024 23:42 by rmk") + (* ; "Edited 7-May-2024 23:10 by rmk") + (* ; "Edited 4-Mar-2024 14:55 by rmk") (* ; "Edited 16-Jul-2023 11:14 by rmk") (* ; "Edited 30-May-2023 23:50 by rmk") (* ; "Edited 25-May-2023 00:33 by rmk") - (SELECTC (GETTH EVENT THACTION) - ((LIST :Insert :Copy) - (\TEDIT.UNDO.INSERTION TEXTOBJ EVENT)) - (:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT)) - (:Delete (* ; "Deletion or case-shift") - (\TEDIT.UNDO.DELETION TEXTOBJ EVENT)) - (:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT)) - (:Looks (* ; "Character-looks change") - (\TEDIT.UNDO.LOOKS TEXTOBJ EVENT)) - (:ParaLooks (* ; "PARA looks change") - (\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT)) - (:PageFormat (* ; "Pageframe change") - [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO) - (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ - TXTPAGEFRAMES))) - ] - (\TEDIT.HISTORYADD TEXTOBJ EVENT)) - ((LIST :Replace :LowerCase :UpperCase) - (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") + (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))) + (CL:WHEN (GETTH EVENT THCH#) + (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) + EVENT) + (\TEDIT.SHOWSEL NIL T TEXTOBJ) + (\TEDIT.SCROLL.CARET TSTREAM)) + (PROG1 (SELECTC (GETTH EVENT THACTION) + ((LIST :Insert :Copy) + (\TEDIT.UNDO.INSERT TEXTOBJ EVENT)) + (:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT)) + (:Delete (* ; "Deletion or case-shift") + (\TEDIT.UNDO.DELETE TEXTOBJ EVENT)) + (:CharLooks (* ; "Character-looks change") + (\TEDIT.UNDO.CHARLOOKS TEXTOBJ EVENT)) + (:ParaLooks (* ; "PARA looks change") + (\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT)) + (:PageFormat (* ; "Pageframe change") + (\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT)) + ((LIST :Replace :LowerCase :UpperCase) - (\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION))) - (:Closefile (* ; "Closes an included file") - (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO)) - (CLOSEF? (GETTH EVENT THOLDINFO)))) - ((LIST :Get :Put) (* ; + (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") + + (\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION))) + (:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT)) + (:Closefile (* ; "Closes an included file") + (CL:WHEN (STREAMP (GETTH EVENT THOLDINFO)) + (CLOSEF? (GETTH EVENT THOLDINFO)))) + (:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)) + ((LIST :Get :Put) (* ;  "He did a GET or PUT-- not undoable.") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION)) - T)) - (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION) - TEDIT.HISTORY.TYPELST] - (COND - (UNDOFN + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION + )) + T)) + (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION) + TEDIT.HISTORY.TYPELST] + (COND + (UNDOFN - (* ;; "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") + (* ;; + "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") - (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN) - (GETTH EVENT THCH#) - (GETTH EVENT THFIRSTPIECE))) - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT - THACTION)) - T]) + (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN) + (GETTH EVENT THCH#) + (GETTH EVENT THFIRSTPIECE))) + (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " + (GETTH EVENT THACTION)) + T]) (TEDIT.REDO - [LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 13:36 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 17:53 by rmk") + (* ; "Edited 27-Nov-2024 23:11 by rmk") + (* ; "Edited 26-Sep-2024 16:49 by rmk") + (* ; "Edited 29-Jul-2024 23:58 by rmk") + (* ; "Edited 3-Jul-2024 07:41 by rmk") + (* ; "Edited 18-May-2024 16:23 by rmk") + (* ; "Edited 12-May-2024 21:08 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") + (* ; "Edited 7-May-2024 23:13 by rmk") (* ; "Edited 4-Mar-2024 21:33 by rmk") (* ; "Edited 2-Mar-2024 09:41 by rmk") (* ; "Edited 21-Dec-2023 11:57 by rmk") @@ -343,71 +473,81 @@ (* ;; "REDO the last thing this guy did.") - (CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY) - (PROG ((SEL (GETTOBJ TEXTOBJ SEL)) - (EVENT (\TEDIT.LASTEVENT TEXTOBJ)) - CH) - (CL:UNLESS EVENT - (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T) - (RETURN)) - (CL:UNLESS (GETSEL SEL SET) - (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T) - (RETURN)) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (GETTOBJ TEXTOBJ SEL)) + (EVENT (\TEDIT.LASTEVENT TEXTOBJ)) + CH) + (CL:WHEN (\TEDIT.READONLY TEXTOBJ) + (RETURN NIL)) + (CL:UNLESS EVENT + (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T) + (RETURN)) + (CL:UNLESS (GETSEL SEL SET) + (TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T) + (RETURN)) - (* ;; "There really is something to redo and something to do it to.") + (* ;; "There really is something to redo and something to do it to.") - (\TEDIT.SHOWSEL SEL NIL) - (SELECTC (GETTH EVENT THACTION) - ((LIST :Insert :Copy :Move) (* ; "It was an insertion") - (\TEDIT.REDO.INSERTION TEXTOBJ EVENT SEL)) - (:Delete (* ; "It was a deletion") - (\TEDIT.DELETE TEXTOBJ SEL)) - (:Replace (* ; + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (SELECTC (GETTH EVENT THACTION) + ((LIST :Insert :Copy :Move) (* ; "It was an insertion") + (\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL)) + (:Delete (* ; "It was a deletion") + (\TEDIT.DELETE TEXTOBJ SEL)) + (:Replace (* ;  "It was a replacement (a del/insert combo)") - (\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION))) - (:LowerCase (* ; "He lower-cased something") - (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) - (:UpperCase (* ; "He upper-cased something") - (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL)) - (:Looks (* ; "It was a character looks change") - (TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE)) - SEL)) - (:ParaLooks (* ; "It was a Paragraph looks change") - (TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE)) - SEL)) - (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T)) - (:Find (* ; "EXACT-MATCH SEARCH COMMAND") + (\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION))) + (:LowerCase (* ; "He lower-cased something") + (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) + (:UpperCase (* ; "He upper-cased something") + (\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL)) + (:CharLooks (* ; "It was a character looks change") + (\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO)) + SEL)) + (:ParaLooks (* ; "It was a Paragraph looks change") + (\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO)) + SEL)) + (:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T)) + (:Find (* ; "EXACT-MATCH SEARCH COMMAND") (* (* ;; "RESTLST ?")  (AND NIL (RESETSAVE (CURSOR  WAITINGCURSOR))) (TEDIT.PROMPTPRINT  TEXTOBJ "Searching..." T)  (SETQ SEL (fetch (TEXTOBJ SEL) of - TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL) - (SETQ CH (TEDIT.FIND TEXTOBJ + TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL + TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ  (GETTH EVENT THAUXINFO)))  (COND (CH (TEDIT.PROMPTPRINT TEXTOBJ  "done.") (\TEDIT.UPDATE.SEL SEL CH  (NCHARS (GETTH EVENT THAUXINFO))  (QUOTE RIGHT)) (\TEDIT.FIXSEL SEL  TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)) + (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))  (T (TEDIT.PROMPTPRINT TEXTOBJ  "[Not found]")))) - ) - (:Move (* ; "He moved some text") - (\TEDIT.REDO.MOVE TEXTOBJ EVENT (GETTH EVENT THLEN) - (IMAX 1 (TEDIT.GETPOINT NIL SEL)) - (GETTH EVENT THFIRSTPIECE))) - ((LIST :Get :Put) (* ; "Why can't you redo a get or put ?") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION)) - T T)) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION) - " isn't implemented.") - T)) - (\TEDIT.SHOWSEL SEL T)))]) + ) + (:Move + (* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place. The insert part is probably OK--that maps to the :Insert clause above.") + + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION)) + T T)) + (:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL)) + ((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?") + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION)) + T T)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION) + " isn't implemented.") + T)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ]) (\TEDIT.UNDO.UNDO - [LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 21:27 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk") + (* ; "Edited 26-Sep-2024 22:57 by rmk") + (* ; "Edited 22-Sep-2024 11:08 by rmk") + (* ; "Edited 12-Aug-2024 23:45 by rmk") + (* ; "Edited 3-Jul-2024 09:50 by rmk") + (* ; "Edited 3-Mar-2024 21:27 by rmk") (* ; "Edited 13-Jun-2023 15:05 by rmk") (* ; "Edited 3-Jun-2023 23:04 by rmk") (* ; "Edited 1-Jun-2023 23:53 by rmk") @@ -419,33 +559,34 @@ (* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone. If we have moved back to the same point in history, we can do the undoing.") - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (TEDIT.PROMPTPRINT TEXTOBJ "" T) - (LET [(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE] - (if (NULL LASTUNDONE) - then (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T) - elseif (EQ (CAR LASTUNDONE) - (\TEDIT.LASTEVENT TEXTOBJ)) - then - (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE] + (TEDIT.PROMPTCLEAR TSTREAM) + (if (NULL LASTUNDONE) + then (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed") + elseif (EQ (CAR LASTUNDONE) + (\TEDIT.LASTEVENT TEXTOBJ)) + then + (* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.") - (push (FGETTOBJ TEXTOBJ TXTHISTORY) - (CADR LASTUNDONE)) - (TEDIT.UNDO TEXTOBJ) + (\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE)) + (TEDIT.UNDO TSTREAM) + (TEDIT.PROMPTPRINT TSTREAM "Undo undone" T) - (* ;; "This saved what we just undid, don't want to keep reundoing it.") + (* ;; "This undoing saved what we just undid, don't want to keep reundoing it.") - (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)) - (push (FGETTOBJ TEXTOBJ TXTHISTORY) - (CADDR LASTUNDONE)) - else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ; + (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)) + (\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE)) + else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;  "If something else has happened, there are no undos to undo.") - (TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T]) + (TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T]) ) (DEFINEQ -(\TEDIT.UNDO.INSERTION - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 22:54 by rmk") +(\TEDIT.UNDO.INSERT + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Jul-2024 00:07 by rmk") + (* ; "Edited 30-May-2023 22:54 by rmk") (* ; "Edited 26-May-2023 23:49 by rmk") (* ; "Edited 24-May-2023 23:53 by rmk") (* ; "Edited 2-May-2023 23:26 by rmk") @@ -453,11 +594,13 @@ (* ;; "UNDO a prior Insert, Copy, or Include. ") - (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - EVENT]) + (\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) + EVENT) + TEXTOBJ]) -(\TEDIT.UNDO.DELETION - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk") +(\TEDIT.UNDO.DELETE + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 29-Sep-2024 00:23 by rmk") + (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 30-May-2023 23:31 by rmk") (* ; "Edited 27-May-2023 23:39 by rmk") (* ; "Edited 21-Apr-93 12:01 by jds") @@ -470,35 +613,32 @@ (GETTH EVENT THCH#]) (\TEDIT.UNDO.MOVE - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk") + [LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 19:38 by rmk") + (* ; "Edited 25-Nov-2024 14:12 by rmk") + (* ; "Edited 29-Sep-2024 00:23 by rmk") + (* ; "Edited 7-Jul-2024 11:50 by rmk") + (* ; "Edited 3-Jul-2024 10:17 by rmk") + (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 4-Mar-2024 16:08 by rmk") - (* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense. The deleted string would reappear in some random place.") + (* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)") - (LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO))) - (FOBJ (CDR (GETTH EVENT THOLDINFO))) - (SEL (FGETTOBJ TEXTOBJ SEL))) - (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT)) - (* ; "Undo the insert in this document") - (CL:WHEN (GETTH EVENT THDELETEDPIECES) (* ; - ":Move must have started as :Replace") - (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES) - 'INSERT TEXTOBJ) - TEXTOBJ - (GETTH EVENT THCH#))) - (if FOBJ - then (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ)) - (* ; - "Delete is last event in other document") - (TEDIT.UNDO FOBJ)) - else (\TEDIT.UNDO1 TEXTOBJ DELEVENT)) - - (* ;; "Put the point back after the original target. Caller wil fix it.") - - (\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T]) + (LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ)) + (REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO)) + THACTION] + (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT) + (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if REPLACE + then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T) + 'PENDINGDEL + else 'NORMAL)) + (\TEDIT.FIXSEL SEL TSTREAM) + (\TEDIT.SHOWSEL SEL T TSTREAM]) (\TEDIT.UNDO.REPLACE - [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk") + [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "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") @@ -508,27 +648,176 @@ (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES) NIL TEXTOBJ) TEXTOBJ - (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) EVENT)) (SETTH (\TEDIT.LASTEVENT TEXTOBJ) THACTION ACTION]) + +(\TEDIT.UNDO.CHARLOOKS + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 21:59 by rmk") + (* ; "Edited 28-Sep-2024 22:37 by rmk") + (* ; "Edited 26-Sep-2024 16:06 by rmk") + (* ; "Edited 11-Aug-2024 22:11 by rmk") + (* ; "Edited 5-Jul-2024 22:54 by rmk") + (* ; "Edited 18-May-2024 16:21 by rmk") + (* ; "Edited 19-Feb-2024 11:32 by rmk") + (* ; "Edited 14-Dec-2023 21:01 by rmk") + (* ; "Edited 30-May-2023 22:56 by rmk") + (* ; "Edited 18-Apr-2023 23:56 by rmk") + (* ; "Edited 30-May-91 21:44 by jds") + + (* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed. We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece") + + (for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#) + TEXTOBJ)) + (CHNO _ (GETTH EVENT THCH#)) + (SEL _ (FGETTOBJ TEXTOBJ SEL)) + (CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO)) + do + (* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ") + + (* ;; "Perhaps we should also save the CHNO of the CARETPC") + + (SETQ NEXTCHNO (CAR U)) + (SETQ OLDLOOKS (CDR U)) + (CL:WHEN (AND OLDLOOKS (EQ PC CARETPC)) + (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS))) + [push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC] + + (* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM") + + (for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS) + (add CHNO (PLEN P)) + (CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run") + (SETQ PC P) + (RETURN))) finally + + (* ;; + "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.") + + (CL:WHEN NEWUNDOLIST + (change (GETTH EVENT THOLDINFO) + (CONS (CAR DATUM) + (DREVERSE NEWUNDOLIST))) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL + 'NORMAL) + (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS + (GETTH EVENT THCH#) + (GETTH EVENT THLEN)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (TEDIT.PROMPTPRINT TEXTOBJ + "Character looks restored" T)) + + (* ;; + "Save the event for REDO, even if these pieces didn't change") + + (\TEDIT.HISTORYADD TEXTOBJ EVENT]) + +(\TEDIT.UNDO.PARALOOKS + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 22:00 by rmk") + (* ; "Edited 28-Sep-2024 22:38 by rmk") + (* ; "Edited 27-Sep-2024 12:23 by rmk") + (* ; "Edited 11-Aug-2024 22:10 by rmk") + (* ; "Edited 5-Jul-2024 22:54 by rmk") + (* ; "Edited 18-May-2024 16:22 by rmk") + (* ; "Edited 19-Feb-2024 11:32 by rmk") + (* ; "Edited 11-Dec-2023 11:10 by rmk") + (* ; "Edited 21-Sep-2023 23:51 by rmk") + (* ; "Edited 30-May-2023 22:55 by rmk") + (* ; "Edited 18-Apr-2023 23:57 by rmk") + (* ; "Edited 30-May-91 21:44 by jds") + + (* ;; "Undo the setting of paragraph looks.") + + (for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#) + TEXTOBJ)) + (CHNO _ (GETTH EVENT THCH#)) + (SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO)) + do + (* ;; "Find the first piece of the next changed paragraph") + + (for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U)) + (SETQ PC P) + (RETURN)) + (add CHNO (PLEN P))) + (SETQ OLDLOOKS (CDR U)) + (push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC))) (* ; "Save for UNDO UNDO") + + (* ;; "Change all the pieces in this paragraph") + + (for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS) + (CL:WHEN (PPARALAST P) + (SETQ PC P) + (RETURN)) + (add CHNO (PLEN P))) finally + + (* ;; + "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.") + + (CL:WHEN NEWUNDOLIST + (change (GETTH EVENT THOLDINFO) + (CONS (CAR DATUM) + (DREVERSE NEWUNDOLIST))) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (\TEDIT.UPDATE.SEL SEL EVENT NIL NIL + 'NORMAL) + (\TEDIT.UPDATE.LINES TEXTOBJ + 'LOOKS + (GETTH EVENT THCH#) + (GETTH EVENT THLEN)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ) + (TEDIT.PROMPTPRINT TEXTOBJ + "Paragraph looks restored" T)) + + (* ;; + "Save the event for REDO, even if these pieces didn't change") + + (\TEDIT.HISTORYADD TEXTOBJ EVENT]) + +(\TEDIT.UNDO.PAGELOOKS + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 12-Aug-2024 10:28 by rmk") + [SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO)) + (SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))] + (TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T) + (\TEDIT.HISTORYADD TEXTOBJ EVENT]) + +(\TEDIT.UNDO.COMPOSITE + [LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 15:47 by rmk") + (* ; "Edited 25-Nov-2024 22:27 by rmk") + (* ; "Edited 15-Aug-2024 10:14 by rmk") + (* ; "Edited 7-May-2024 23:17 by rmk") + + (* ;; "A composite event is a group of other events that are to be undone at the same time. Only show the selection of the last undo event. We want to end up with a single event on history. We don't want to bump the count. (Presumably EVENT was alread popped)") + + (for E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in (GETTH EVENT THOLDINFO) + do (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ)) + (\TEDIT.UNDO1 TSTREAM E) + (CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed") + (push EVENTS (\TEDIT.POPEVENT TEXTOBJ))) + (\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS)) + (\TEDIT.SCROLL.CARET TSTREAM]) + +(\TEDIT.UNDO.REPLACECODE + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk") + (TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#) + (GETTH EVENT THOLDINFO]) ) (DEFINEQ -(\TEDIT.REDO.INSERTION - [LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Mar-2024 13:54 by rmk") +(\TEDIT.REDO.INSERT + [LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Aug-2024 10:47 by rmk") + (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 31-May-2023 10:26 by rmk") (* ; "Edited 18-May-2023 19:24 by rmk") (* ; "Edited 21-Apr-93 01:06 by jds") - - (* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret. We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.") - (\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ) 'INSERT TEXTOBJ) TEXTOBJ SEL]) (\TEDIT.REDO.REPLACE - [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk") + [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 7-Jul-2024 11:59 by rmk") + (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 2-Oct-2023 11:43 by rmk") (* ; "Edited 31-May-2023 10:25 by rmk") (* ; "Edited 27-May-2023 11:16 by rmk") @@ -540,31 +829,25 @@ (\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ) NIL TEXTOBJ) TEXTOBJ - (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + (\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL) EVENT)) (SETTH (\TEDIT.LASTEVENT TEXTOBJ) THACTION ACTION]) -(\TEDIT.REDO.MOVE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 16-Feb-2024 23:36 by rmk") - (* ; "Edited 7-Jun-2023 23:19 by rmk") - (* ; "Edited 27-May-2023 11:18 by rmk") - (* ; "Edited 23-May-2023 12:54 by rmk") - (* ; "Edited 30-May-91 21:28 by jds") - (LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2))) - (\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#) - LEN) - (SETSEL SCR2 SET T) - (\TEDIT.FIXSEL SCR2 TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SCR2 'MOVE) - (TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL]) +(\TEDIT.REDO.COMPOSITE + [LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 7-May-2024 23:12 by rmk") + (\TEDIT.THELP 'Redo-composite]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD -6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) ( -\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162 -(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 . -29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) ( -\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323))))) + (FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD +7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) ( +\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635 + . 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199 + . 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 ( +\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934) +(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610 + . 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) ( +\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) ( +\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069))))) STOP diff --git a/library/tedit/TEDIT-HISTORY.LCOM b/library/tedit/TEDIT-HISTORY.LCOM index e86bb9ad3f0e8693d562556a0cf9606dfa74137b..d5b081349444913423cb1a0709ad63820c01ee36 100644 GIT binary patch literal 13329 zcmc&*U2G%QbtWZQUbD7B?JDj%k(In#U^i}wqEEX(k%#sn3EG!F_DRouX#3rJ z&z(QcZtMa@jfFUK|K{Fv&-u=G&b`iVm{q%GE>>;FT(oOdmwlyfRJM#uCd=5hmf3LZ zWe|`@ zOJ&%KKc=pg3dK@kCBv={I^Lk2-#Ho_|9Xju{<)pnhRb^RPIbp|Sg?04m&>sB9zGU3 zY*EWB{POh_KhOMGF~77{U?s7z^<6f&^$tswDwa{ZWHuLDF3VPH&EUL$ORj-rU~FtK zDyi&j?>G>0&b(sQT1{2V7b{mRJ2p%#J~cKE8&8%W?q5(?gGnR zF&a&l3T+h{HBqx|R2r@~Gk*!%0xQ)U<`vuBX)bPH4N!sbp6bgb4RTF=X2r-aMAj&z zl7mv$8&F?X+E`6x>r7*gTVZv!#Dt35C}_5ztJ};*ndq~?5{DCs#KbI1mZuZ=?_r|P zf9Pd8_%aoInRq9~+dcO*|9h?c4FA~`4a6Ty{I!$vXF~iucaAse&ZiSuZK=pAZmnXp z*z&5F<+7#d!=P+!jb*-*VQV_ed>uwx z#ExK3P*}oGfn~ncvNEiovCLwI>8s*L6OE#B=Nd}FUSh7ZA?L>ht)7-JgKI5!eRF{& zUrR#LQnHV#>6>SNQ|``LBm7C9BwsfEkxS>JljM{U+z27%KamY(xs{wvCM;^5_y^T` zpLaj|=p^xDi~4&dA5xp?dy_ZmaSD$=qlVKzzj=20f?<_^g%5FkVkCESL^@z4uYK1# zy(YhSS`UwYT2_N#KzbBot52%3pYe}eune)D=r;`YsrfnU!ku}eJ$d>(eLh%aKy!5H z3)y$wtxGBE#WhtH#R)B@x%T+xMU8En+w0H~0GHZ1mS57nXMHvByi)Yb3$aR>Uq%bS zdPskDxQCchEgx691pM6S9CU^qxRf|+&{p|OquZp6SbxLh=}?ERdsA z0RiYA_l6zJ*_&ikS80B}etC1%eZYn{NvvY3lhS0!aAwHdX4Zub&&`BuB_K@AO_jL? zt*DtcO{Z>~6|)H;aV*B<3aiX3jY)#5fvi|ZcKJ0uh3sHONMxO#F3?HQ}W zi5Zoa?bh(9v6^{RzyW-5;^o8yHnV-2!Cqb*mFxGO_O|n~+D_rJ_;wbRJc8Tlp$rxJ z+qv?X?Nklx4Y#i5t@Bx3F`OL}I|%Pwp4h9ABw4dPy97bOY7p{?1$^^ z-r4s@<(ogPrblU6_R;#iXUgvc3Ozkafy9$Z;>KJ+{PILY>JT@lpmGB_G33Nqy?GN6+fj3QorogD zmPp13_VT5tIC~LFbv@CRTX1pKm?959|7rJ)*Y8`8N+33OCx7oGaYhwZ@{N0G$p?D^ zow{ivD1sFVR6YGQ*QO5*0($5vN%v~K?NmBh&Sc#T~H4=d9RD7G1`izI`NIs zm<9u;QPiijB9V$50BF13lJ>2^z@>i3QW+m;(AFr4(iHum{?u}5Me*|0WjVoRA|au6 zQX@%MQdzyo8%br=1^b}qC9Z5y8lZuCtJWIi<2}c=hNX@VQSe6)!I(3({;=CS+-Ji+yM5U1BPIa--|gRKH}(#HV<^hl9)g2aEz}p$%2-#= z(B&49DN0kT)N{gILF6F~G9}FX?iWI@ zez(Yce?;Fq{jx+3weSFPq(`doEqI2+^Ai(@oRaow#+#Z7wWg`zxr3+dFU$~Fsm{R> z6WIco@VG%0z|tw6%?kyFiihkYufyTVfL8}UCgbCp5+JBNwy8L7)2x1j=|!cx0Pnm9 z38F{CtUE@XutE}Yo-}7GmLEujiW!CrhJJtT+*4_}~;!JgCazjMrZs936W_XhN;VPJ|$ zkxD6T_uuU>#KlSUAPAr1>Wcx)&aVMzxoWY){*d)<9UXLT zbq;w3^X>isu*{?M7`R@L3A&s}2NDp&oCGJ*Jx+v-lNEvGAQ=B*igU6k-_a%&0tX05 z_r9bTf7DHHejKJclF>Yx1HJe#QlsdKA|!-pQ6&9fWNmH<3_VF2)aC~xOLCl(WKIF$ z7tt;RxhKi@LKDdjWJxq5rA})m-@k;O>D%2BaDHk;{~B z3N5eT`4xWD;?|s97NL>_1;-&oENF2oFwYT>XM^$_>p19g;17UqK0cqE*9gS&99gTq z!#30TxkUgG^_4iR(wBkhK2GYf!|QMx0rb>4dIn&b&p8as7{^Hkc&1FF)9wor z-R-cw8^fMB6!+e@}2=K-m^&h5Njqrn&jDb7^(4mp|N z;hs>Hqe180UjOzn1%MjY+Z|rXTO2~&z?Ut+oJ*h|<{o~iU4hCuje(j{K(o~FPJd#RH! zPAc(|GV6W~6iO<-sC)|; zQ#8ah22L+E3XD}jLEOnM7|{5bDxL`s8ON>TO#);T2~(aL0MY6U z*n!9w3_8cdJ}6ei3;K}@S=SreP9; z+UeU7i>UqI8pNlw>8I^KaA%;=5AgTgy}1j{#NTb&57YCt`M>9tcfKlhe`d7Vc9LA@ z|9Rxj+`sel%|I_Q6A7Dd&TNANx-*YvkZAbi7rgPm!$QEZNXvpoP>74fG#^ft5^Fxc zAZH|vAdunnffw-+eM)r)+4F25PTgU3r0&pMdQyiFVSS7ZVvu=~N`iw4(t8Bz<0>wW z2FAQ!oG(z^H}vtCAz`aXi6Nlik>CDc@2LCB^j_s&$!Eqp%2zqhlG~}kStz1>A@|q< zOwYA~P^%K-iL9Rv2<*06ewffB(G2!wI1bi=?6UHEu@_TRUSdovf^2hPAVh~O_B%ZM zLZEgG8XOA%-gP=jIEC}u;V_A#VehoEiAN;q@Ynap5f|vuwr}z?NhK_j(8XDO3U)nf z%M95C>HpHn2R4ON$xq9h!U>HWujuSYwvhGK{7<@V@@Mcuckbi#d`z*C$R$xCik@dA|k3(2s>a zbF2Y2rVvWSC44<9(iofY|BmR=r2pTDZu}}gJNF$EL&RwL)eX*h9=COz6i$jQ69&bj z9wqjc1-WDV0^=E@MSg+VzZ8|l1%*~?mw!#%VHH5GZbOSJwyA8RZd|@BAwF2cve^x@ z;($iu7PN`$Hf25vE@m_2Z(1DaSk}B&cN;C1ZQ$6fvC$m&6W$Hpl$tJ20ZDASgqc}b zHU2Ivpdr7t9QLcCop%A(8!OTZ6cqQjvMIY};~wtgCvwSg*9}KpH5OvX5nANbNmQs5 zM^hM-k12X&>F^`k2iIKCEZURtVw7_Uv+UQ{tFN+*)#K>>{^9|C*{!`E4qOiR4sQV7 zZy$>E-f@PnVq6M=3)^w{rlb+Q_(r1SnwXol^@D7puZzr0AZjzk9QWh4o3sN}6D#}~xcBgG@y(4Z2}Wx41SC>QB4>ZxYS+vg~E5o}7C zmSEA?{d0vl!A5?V8Tx|HrGt(AQ{G^yCs?%sVvh7N0qb({>H|Tzrg213WO|~^8ykiJ z)2{Ed_%=n&gDXB07vy29%Bu;Rf%JsZrI2DndJX@0`u1qhyVV=^-tD}?Z)PB`cKZlC ztBvjJz0Kb1uzjTNcshB2)SKA5qua+_EP@*c*~yx$xW8sLnXz}h4r)DXk2ACDwH>`r4R z8++w-T1r)^0*OZ+5E2Lkh`xZ3D!L|p03P-Mfs{T_@m8Kdf{iWfH#PQL%eE?> zwO*SduUl=K>DhE5kwOV&VDsz>(~Ru$R%f_uWQ`ot^^seh&6a)5ZEUxfE1*)Q>3Kz?W-*^H<_wJ`9(fC9 zI`O*D3+dIqX4kz8Tz|6#7tM;5LL${8NAVXe^$NItzhCMuI>&NO{QSi^hqz<^ zklaGj`$w_AI5advVfxbdDd z?ujjoJK^QVSEa=J7vvi~7e1A%2LxP|ITk;pvgq%`q8pP%EqVB*Md!kYOV-}}_-Wds zI%I)W8E|*x7v=4(?Hc%6hTlk=>G{>uhH`nfWpAy6U6>|X8^0~^@$BSXSKhN`KsUgE zB)?Hm==n9E1MG#Y*2qU$sF6b%GrZ9z4geg%3#M7D`1}6I2Vjh_c%b6`r`OO6D?k;e z)mQVA_Z5X6xjWs&v(CsfP{s@ub{9d-=7K%1MY%ZaO`Zw-a#p}f6cO%N9w>5$M)bB> zrBQ#$V}S+`A#z!kDmL$pSn-NKN(XK~ZB`s;T{ba;!1av@#_9mF1@NtTVaa6A=g1|_ zt#ij)JQp4np1iQQP~wIyjkj&rnyy{8+Zh3$2$2OAP!Y6dm1Ra=L6ipdsOb^2VcB$o zFC-!}1)LniI4wZ1$xMb}j~uWGN|FN*hU{7x8)JWi15*epeOyf5KDj^tt)tkVOFVM) zxQa+|OZ0Tk$72pnaS$&)f8IE=@qs#{n=CzWUURz~Wl9_3AvEiJjizql)YnU!i_Yfw z;^usu!|V9cW}L8;Z-CDnKU4bnQtbB02PGl!xODrIOEJQt&3J92yR;-Xmt0y*x+Ol% z?eRw!?@?b1F4AdSM=cn-AxTyD22%7@Q&O(Gpw8+cO990L(Dx{w0M`m)^ms`XRjZ!Zq< zm)tJ4CxYZJ==sCrk_bl0(+EG9V))J9iF0~j`uF(D!eVLVgm{t_dy9$VMQ=*Dv-Esy|BUnGx#Z~*V<|IF!AP|@X2LB~>SwHyF@+e6)oj23FkY@T+IIC-a1_8f zp1ne1yOx(Gk1mjD+0B|&Mi&X_6nZg1!(>yjmrT=YS+z!Ev&{-2Ps#}5N{~cw*%iBH zdv2r70B2PxTa9ZrGxZS7t+(wKGJ`prk^W;w21!$oih*V}3ZjiQ!srYgG2`tt?ONM| zOf@n+Sc!^y1{N?F-wcR!+~*7<%Cn8ghybM^E0*^MhyEK-05ZK0m38Q=u*CMkfj=yF z4uJ`-wOAXxC4a7fh?ak_-`RyR9<~TSqN9}&r6HXs{WK4NwAk$2@~ea4-Oh-uK?c$6 z3_G>K;Laf{@Wt_MRcFPm!J9qxO?UN8lCh*qWv z^#WQ5>kme(clTi5zw7t041HrTgmS_FxYl+C_tbPx7U@1b&LeKD;ds4H%F<2vR6HfM841038h;v%&NU7!7a=iGXG36=is~ zvKA0)6XGO=;d=@288DF~a99Pz2Gmh^9Uv%HnD)ljJG06Dj z8$x6bcr?~KMEp|#68d#H2zXk{-y87UuIsbT?x@Gxh$h4m1vZDkgRlu^3(cAdoD%&2 z@O~Na76E^^+v(r(wFHA()SCM~2AxAFi+4vLVAL7jf{R6H9>H=$|G?)hL$NMw2)aH> zu8HEqS!SrtfySEE_7ME*_Ea77D-P2<9lIIZo2_1w;i@GGRm;VB_oF9OU`|qL^1z9o zj2!{-?p#2GMu_OQ5%?!3O_L;5BQ7LxH0mt92Bl3>{OT@J#ztu$bmCShu!e9&hX60& zfJZohmRZOEyPqYh2|ecX(k^revB5jE)Pi@O`N+y)Lg)4;$YAD@8*Wy4QD~Kgt*OaqN%*; z4-fr44ReC2(jzm0E9wNu7>*5A+A384PeVMJD^YA*5_JZT9@q*EVu6IjN&eZyb}_;% z94siM;5}6TK--rx)Q9fj1>6HA@8@{!BRYO1nb?cU0@C&%j)>FY`l9CmiC%!ok_LT< z<_>HrGOvY{OvpGTi3*>CN30+v!r+2AQ5AZpyoZg)#5VV7Ub}4Sb687Reja*-h zt;3~2JC#&L%PK|Uy41^ez{6|B{vs?{y ze${G48xfmKfxXO_(rNz7g64Q|TC^MKz3SbC^11)*?r78hx4Vlz<)dHcj2cwHf|9M= z!lrMIRozzGG6w+)o#cwE%JO|tk z{-)C~5x?IOj|z~%2UcKl>n=2-#M+{yS2=;uXEhwWA zqT$==!(>B{dFb$DXOrV6^cB2<;J-UOMD^9}x=1VN8da4|+?k;0Rl?0EuM=Q3#erQ{ K^t}Z9N&E+Fij#f- diff --git a/library/tedit/TEDIT-LOOKS b/library/tedit/TEDIT-LOOKS index b5bcc34a..43b35c50 100644 --- a/library/tedit/TEDIT-LOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,50 +1,54 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Mar-2024 13:53:47" {WMEDLEY}TEDIT>TEDIT-LOOKS.;242 155521 +(FILECREATED "22-Dec-2024 15:27:12" {WMEDLEY}TEDIT>TEDIT-LOOKS.;359 160454 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.GET.PARALOOKS) + :CHANGES-TO (FNS \TEDIT.CHARLOOKS.CHANGE.FONT) - :PREVIOUS-DATE "20-Mar-2024 11:06:29" {WMEDLEY}TEDIT>TEDIT-LOOKS.;241) + :PREVIOUS-DATE "22-Dec-2024 11:42:48" {WMEDLEY}TEDIT>TEDIT-LOOKS.;357) (PRETTYCOMPRINT TEDIT-LOOKSCOMS) (RPAQQ TEDIT-LOOKSCOMS - ( + [ (* ;; "Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.). Uses compiled create functions in case DWIM is not available at loadup time.") - (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS CHARLOOKS FMTSPEC) - (MACROS \WORDSETA) - (MACROS ONOFF))) + (DECLARE%: EVAL@COMPILE DONTCOPY + (EXPORT (RECORDS CHARLOOKS FMTSPEC) + (MACROS \WORDSETA) + (MACROS ONOFF) + (MACROS FSETPARA FGETPARA GETPARA SETPARA GETCLOOKS SETCLOOKS FGETCLOOKS + FSETCLOOKS PARALOOKS! CHARLOOKS!))) (INITRECORDS CHARLOOKS FMTSPEC PENDINGTAB) (FNS \TEDIT.CHARLOOKS.DEFPRINT \TEDIT.FMTSPEC.DEFPRINT) - [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.TERMSA.FONTS NIL) - (TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC)) - (TEDIT.TERMSA.FONTS NIL) - (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC) - (Modern 'MODERN) - (Terminal 'TERMINAL) - (Titan 'TITAN) - (Gacha 'GACHA) - (Helvetica 'HELVETICA) - (Times% Roman 'TIMESROMAN] - (INITVARS (TEDIT.DEFAULT.FOLIO)) - (VARS (TEDIT.CHARLOOKS.FEATURES '(SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY - OVERLINE STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT)) - (TEDIT.FACE.MENU (\CREATE.TEDIT.FACE.MENU)) - (TEDIT.SIZE.MENU (\CREATE.TEDIT.SIZE.MENU))) - (GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS - TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT - TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) + (COMS + (* ;; + "Added by yabu.fx, for SUNLOADUP without DWIM. Not sure any of these are needed/used.") + + (FNS \TEDIT.CREATE.DEFAULT.FMTSPEC \TEDIT.CREATE.FACE.MENU \TEDIT.CREATE.SIZE.MENU)) + [INITVARS (TEDIT.DEFAULT.FOLIO) + (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC) + (Modern 'MODERN) + (Terminal 'TERMINAL) + (Titan 'TITAN) + (Gacha 'GACHA) + (Helvetica 'HELVETICA) + (Times% Roman 'TIMESROMAN] + (VARS TEDIT.CHARLOOKS.FEATURES (TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC)) + (TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU)) + (TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU))) + (FNS \TEDIT.CHARLOOK.FEATUREP) + (GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU + TEDIT.DEFAULT.FMTSPEC) (ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT) (TEDIT.ICON.FONT MENUFONT))) (COMS (* ; "Character looks functions") - (FNS CHARLOOKS.FROM.FONT \TEDIT.EQCLOOKS \TEDIT.SAMECLOOKS TEDIT.CARETLOOKS - TEDIT.COPY.LOOKS \TEDIT.UNPARSE.CHARLOOKS.LIST TEDIT.MODIFYLOOKS TEDIT.NEW.FONT + (FNS \TEDIT.CHARLOOKS.FROM.FONT \TEDIT.EQCLOOKS \TEDIT.SAMECLOOKS TEDIT.CARETLOOKS + TEDIT.COPY.LOOKS \TEDIT.UNPARSE.CHARLOOKS.LIST \TEDIT.MODIFYLOOKS TEDIT.NEW.FONT \TEDIT.CARETLOOKS.VERIFY \TEDIT.CARETPIECE \TEDIT.GET.INSERT.CHARLOOKS - \TEDIT.GET.TERMSA.WIDTHS \TEDIT.PARSE.CHARLOOKS.LIST) + \TEDIT.GET.TERMSA.WIDTHS \TEDIT.PARSE.CHARLOOKS.LIST \TEDIT.CHARLOOK.FEATURE) (COMS (FNS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.CONVERT.TO.FORMATTED) (MACROS \TEDIT.TRANSLATE.ASCII.CHARLOOKS)) (FNS \TEDIT.UNIQUIFY.CHARLOOKS \TEDIT.UNIQUIFY.PARALOOKS \TEDIT.UNIQUIFY.ALL @@ -53,21 +57,18 @@ (* ;; "Public entries") (FNS TEDIT.LOOKS TEDIT.GET.LOOKS TEDIT.SUBLOOKS TEDIT.FINDLOOKS) - (FNS \TEDIT.CHANGE.LOOKS \TEDIT.LOOKS \TEDIT.FONTCOPY)) + (FNS \TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.CHARLOOKS.NEW \TEDIT.CHARLOOKS.CHANGE.FONT + \TEDIT.LOOKS \TEDIT.FONTCOPY)) (COMS (* ; "Paragraph looks functions") (FNS \TEDIT.EQFMTSPEC TEDIT.GET.PARALOOKS \TEDIT.PARSE.PARALOOKS.LIST TEDIT.PARALOOKS - TEDIT.COPY.PARALOOKS \TEDIT.PARABOUNDS) + \TEDIT.CHANGE.PARALOOKS \TEDIT.CHANGE.PARALOOKS.NEW TEDIT.COPY.PARALOOKS + \TEDIT.PARABOUNDS) (* ;; "For making paragraph-looks substitutions.") (FNS TEDIT.SUBPARALOOKS SAMEPARALOOKS)) - (COMS (* ; "UNDO & History List stuff") - (FNS \TEDIT.UNDO.LOOKS \TEDIT.UNDO.PARALOOKS)) (COMS (* ; "Revision-mark support") (FNS \TEDIT.MARK.REVISION)) - (COMS (* ; - "Added by yabu.fx, for SUNLOADUP without DWIM") - (FNS \CREATE.TEDIT.DEFAULT.FMTSPEC \CREATE.TEDIT.FACE.MENU \CREATE.TEDIT.SIZE.MENU)) (COMS (* ; "Style-sheet support") (FNS \TEDIT.APPLY.STYLES \TEDIT.APPLY.PARASTYLES TEDIT.STYLESHEET TEDIT.POP.STYLESHEET TEDIT.PUSH.STYLESHEET TEDIT.ADD.STYLESHEET) @@ -89,7 +90,12 @@ (*TEDIT-CURRENTPARA-CACHE*) (*TEDIT-STYLESHEET-SAVE-LIST*)) (GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* - *TEDIT-STYLESHEET-SAVE-LIST*)))) + *TEDIT-STYLESHEET-SAVE-LIST*)) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA + \TEDIT.CHARLOOK.FEATURE + ]) @@ -103,6 +109,8 @@ (DATATYPE CHARLOOKS ( (* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") + (* ;; "NOTE: If fields change EQCLOOKS should change too.") + CLFONT (* ;  "The font descriptor for these characters") CLNAME @@ -129,9 +137,10 @@  "T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ;  "T if TEDIT is to ignore these chars; else NIL") - (CLSELHERE FLAG) + (CLSELAFTER FLAG) (* ; + "T if TEDIT can put selection after this char (for menu fields).") - (* ;; "T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED.") + (* ;; "Was CLSELHERE. ") (CLCANCOPY FLAG) @@ -153,6 +162,8 @@ (* ;; "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document") + (CLSELBEFORE FLAG) (* ; + "T if TEDIT can put selection before this char (for menu fields).") ) CLOFFSET _ 0 (INIT (DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)))) @@ -169,10 +180,9 @@ LEADAFTER (* ;  "Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") LINELEAD (* ; "Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented.") - FMTBASETOBASE (* ; - "The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING") - TABSPEC (* ; - "The list of tabs for this paragraph, including CAR for a default tab width") + FMTBASETOBASE (* ; "The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING") + NIL (* ; + "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ;  "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ; @@ -202,14 +212,16 @@ (FMTHARDCOPY FLAG) (* ;  "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (* ; "T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output.") - FMTHARDCOPYSCALE) (* ; "The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)") + FMTHARDCOPYSCALE (* ; "The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T") + FMTDEFAULTTAB (* ; "Default tab in points)") + FMTTABS) (* ; "List of tabs (in points)") (INIT (DEFPRINT 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) - LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL)) + LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0) ) (/DECLAREDATATYPE 'CHARLOOKS '(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG - POINTER POINTER POINTER POINTER FLAG) + POINTER POINTER POINTER POINTER FLAG FLAG) '((CHARLOOKS 0 POINTER) (CHARLOOKS 2 POINTER) (CHARLOOKS 4 POINTER) @@ -230,7 +242,8 @@ (CHARLOOKS 10 POINTER) (CHARLOOKS 12 POINTER) (CHARLOOKS 14 POINTER) - (CHARLOOKS 14 (FLAGBITS . 0))) + (CHARLOOKS 14 (FLAGBITS . 0)) + (CHARLOOKS 14 (FLAGBITS . 16))) '16) (DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)) @@ -238,7 +251,7 @@ (/DECLAREDATATYPE 'FMTSPEC '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER - FLAG FLAG POINTER POINTER) + FLAG FLAG POINTER POINTER POINTER POINTER) '((FMTSPEC 0 POINTER) (FMTSPEC 2 POINTER) (FMTSPEC 4 POINTER) @@ -264,8 +277,10 @@ (FMTSPEC 40 (FLAGBITS . 0)) (FMTSPEC 40 (FLAGBITS . 16)) (FMTSPEC 42 POINTER) - (FMTSPEC 44 POINTER)) - '46) + (FMTSPEC 44 POINTER) + (FMTSPEC 46 POINTER) + (FMTSPEC 48 POINTER)) + '50) (DEFPRINT 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT)) (DECLARE%: EVAL@COMPILE @@ -288,6 +303,38 @@ (VAL 'ON) (T 'OFF]) ) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) + (freplace (FMTSPEC FIELD) of F with NEWVALUE))) + +(PUTPROPS FGETPARA MACRO ((F FIELD) + (ffetch (FMTSPEC FIELD) of F))) + +(PUTPROPS GETPARA MACRO ((F FIELD) + (fetch (FMTSPEC FIELD) of F))) + +(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) + (replace (FMTSPEC FIELD) of F with NEWVALUE))) + +(PUTPROPS GETCLOOKS MACRO ((CL FIELD) + (fetch (CHARLOOKS FIELD) of CL))) + +(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) + (replace (CHARLOOKS FIELD) of CL with NEWVALUE))) + +(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) + (ffetch (CHARLOOKS FIELD) of CL))) + +(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) + (freplace (CHARLOOKS FIELD) of CL with NEWVALUE))) + +(PUTPROPS PARALOOKS! MACRO ((PL) + (\DTEST PL 'FMTSPEC))) + +(PUTPROPS CHARLOOKS! MACRO ((CL) + (\DTEST CL 'CHARLOOKS))) +) (* "END EXPORTED DEFINITIONS") @@ -295,7 +342,7 @@ (/DECLAREDATATYPE 'CHARLOOKS '(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG - POINTER POINTER POINTER POINTER FLAG) + POINTER POINTER POINTER POINTER FLAG FLAG) '((CHARLOOKS 0 POINTER) (CHARLOOKS 2 POINTER) (CHARLOOKS 4 POINTER) @@ -316,7 +363,8 @@ (CHARLOOKS 10 POINTER) (CHARLOOKS 12 POINTER) (CHARLOOKS 14 POINTER) - (CHARLOOKS 14 (FLAGBITS . 0))) + (CHARLOOKS 14 (FLAGBITS . 0)) + (CHARLOOKS 14 (FLAGBITS . 16))) '16) (DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)) @@ -324,7 +372,7 @@ (/DECLAREDATATYPE 'FMTSPEC '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER - FLAG FLAG POINTER POINTER) + FLAG FLAG POINTER POINTER POINTER POINTER) '((FMTSPEC 0 POINTER) (FMTSPEC 2 POINTER) (FMTSPEC 4 POINTER) @@ -350,8 +398,10 @@ (FMTSPEC 40 (FLAGBITS . 0)) (FMTSPEC 40 (FLAGBITS . 16)) (FMTSPEC 42 POINTER) - (FMTSPEC 44 POINTER)) - '46) + (FMTSPEC 44 POINTER) + (FMTSPEC 46 POINTER) + (FMTSPEC 48 POINTER)) + '50) (DEFPRINT 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT)) @@ -406,36 +456,75 @@ (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) "}"]) ) -(DECLARE%: DONTEVAL@LOAD DOCOPY -(RPAQQ TEDIT.TERMSA.FONTS NIL) -(RPAQ TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC)) -(RPAQQ TEDIT.TERMSA.FONTS NIL) +(* ;; "Added by yabu.fx, for SUNLOADUP without DWIM. Not sure any of these are needed/used.") -(RPAQQ TEDIT.KNOWN.FONTS - ((Classic 'CLASSIC) - (Modern 'MODERN) - (Terminal 'TERMINAL) - (Titan 'TITAN) - (Gacha 'GACHA) - (Helvetica 'HELVETICA) - (Times% Roman 'TIMESROMAN))) +(DEFINEQ + +(\TEDIT.CREATE.DEFAULT.FMTSPEC + [LAMBDA NIL (* ; "Edited 4-Aug-2024 17:13 by rmk") + (* ; "Edited 28-Jul-2024 12:57 by rmk") + (* ; "Edited 24-Aug-2023 23:31 by rmk") + (create FMTSPEC + QUAD _ 'LEFT + 1STLEFTMAR _ 0 + LEFTMAR _ 0 + RIGHTMAR _ 0 + LEADBEFORE _ 0 + LEADAFTER _ 0 + LINELEAD _ 0 + FMTDEFAULTTAB _ DEFAULTTAB]) + +(\TEDIT.CREATE.FACE.MENU + [LAMBDA NIL + (create MENU + ITEMS _ '(Bold Italic Bold% Italic Regular) + CENTERFLG _ T + TITLE _ "Face:"]) + +(\TEDIT.CREATE.SIZE.MENU + [LAMBDA NIL + (create MENU + ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36) + CENTERFLG _ T + MENUROWS _ 4 + TITLE _ "Type Size:"]) ) (RPAQ? TEDIT.DEFAULT.FOLIO ) -(RPAQQ TEDIT.CHARLOOKS.FEATURES (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE - STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT)) +(RPAQ? TEDIT.KNOWN.FONTS + '((Classic 'CLASSIC) + (Modern 'MODERN) + (Terminal 'TERMINAL) + (Titan 'TITAN) + (Gacha 'GACHA) + (Helvetica 'HELVETICA) + (Times% Roman 'TIMESROMAN))) -(RPAQ TEDIT.FACE.MENU (\CREATE.TEDIT.FACE.MENU)) +(RPAQQ TEDIT.CHARLOOKS.FEATURES (BOLD EXPANSION FACE FAMILY FONT INVERTED INVISIBLE ITALIC OFFSET + OFFSETINCREMENT OVERLINE PROTECTED SELECTPOINT SELAFTER + SELBEFORE SIZE SIZEINCREMENT SLOPE SMALLCAPS STRIKEOUT STYLE + SUBSCRIPT SUPERSCRIPT UNBREAKABLE UNDERLINE USERINFO WEIGHT + OFFSETTYPE)) -(RPAQ TEDIT.SIZE.MENU (\CREATE.TEDIT.SIZE.MENU)) +(RPAQ TEDIT.DEFAULT.FMTSPEC (\TEDIT.CREATE.DEFAULT.FMTSPEC)) + +(RPAQ TEDIT.FACE.MENU (\TEDIT.CREATE.FACE.MENU)) + +(RPAQ TEDIT.SIZE.MENU (\TEDIT.CREATE.SIZE.MENU)) +(DEFINEQ + +(\TEDIT.CHARLOOK.FEATUREP + [LAMBDA (P) (* ; "Edited 27-Jul-2024 17:33 by rmk") + (MEMB P TEDIT.CHARLOOKS.FEATURES]) +) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS TEDIT.CURRENT.FONT TEDIT.CURRENT.CHARLOOKS TEDIT.CURRENT.PARALOOKS TEDIT.KNOWN.FONTS - TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) +(GLOBALVARS TEDIT.CHARLOOKS.FEATURES TEDIT.KNOWN.FONTS TEDIT.FACE.MENU TEDIT.SIZE.MENU + TEDIT.DEFAULT.FMTSPEC) ) (ADDTOVAR FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT) @@ -447,29 +536,37 @@ (DEFINEQ -(CHARLOOKS.FROM.FONT - [LAMBDA (FONT) (* ; "Edited 15-Oct-2023 18:56 by rmk") +(\TEDIT.CHARLOOKS.FROM.FONT + [LAMBDA (FONT) (* ; "Edited 21-Dec-2024 00:12 by rmk") + (* ; "Edited 16-Dec-2024 13:14 by rmk") + (* ; "Edited 10-Aug-2024 16:15 by rmk") + (* ; "Edited 15-Oct-2023 18:56 by rmk") (* ; "Edited 25-Aug-2023 20:03 by rmk") (* ; "Edited 30-May-91 21:45 by jds") - (* ;; "Create a CHARLOOKS from a font, filling in such fields as can be inferred from the font descriptor.") + (* ;; "Create a CHARLOOKS from a font, filling in such fields as can be inferred from the font descriptor. If the name of a fontclass, the class goes into the FONT field, but all the other parameters are taken from its display font. Maybe this should take a device argument? Or maybe it doesn't matter. ") - (LET ((LOOKS (create CHARLOOKS - CLFONT _ FONT))) - (CL:UNLESS (FONTP FONT) - (\ILLEGAL.ARG FONT)) (* ; "It HAS to be a font, first off.") - (freplace (CHARLOOKS CLNAME) of LOOKS with (FONTPROP FONT 'FAMILY)) - (CL:WHEN [EQ 'BOLD (CAR (FONTPROP FONT 'FACE] - (freplace (CHARLOOKS CLBOLD) of LOOKS with T)) (* ; - "Set the boldness bit, if it's a bold font.") - (CL:WHEN [EQ 'ITALIC (CADR (FONTPROP FONT 'FACE] - (freplace (CHARLOOKS CLITAL) of LOOKS with T)) (* ; - "Set the italic bit, if it's italic") - (freplace (CHARLOOKS CLSIZE) of LOOKS with (FONTPROP FONT 'SIZE)) - LOOKS]) + (LET [(RESOLVED (if (type? FONTDESCRIPTOR FONT) + then FONT + elseif (type? FONTCLASS FONT) + then (FONTCREATE FONT) + elseif (AND (LITATOM FONT) + (type? FONTCLASS (GETATOMVAL FONT))) + then (SETQ FONT (GETATOMVAL FONT)) + (FONTCREATE FONT) + else (SETQ FONT (FONTCREATE FONT] + (create CHARLOOKS + CLFONT _ FONT + CLNAME _ (FONTPROP RESOLVED 'FAMILY) + CLBOLD _ [EQ 'BOLD (CAR (FONTPROP RESOLVED 'FACE] + CLITAL _ [EQ 'ITALIC (CADR (FONTPROP RESOLVED 'FACE] + CLSIZE _ (FONTPROP RESOLVED 'SIZE]) (\TEDIT.EQCLOOKS - [LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 1-Dec-2023 19:27 by rmk") + [LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 18-Oct-2024 22:29 by rmk") + (* ; "Edited 11-Aug-2024 20:41 by rmk") + (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 1-Dec-2023 19:27 by rmk") (* ; "Edited 9-Nov-2023 00:46 by rmk") (* ; "Edited 24-Jul-2023 17:18 by rmk") (* ; @@ -477,9 +574,9 @@ (* ;; "Given two sets of CHARLOOKS, are they effectively the same?") - (LET ((FONT1 (fetch (CHARLOOKS CLFONT) of CLOOK1)) - (FONT2 (fetch (CHARLOOKS CLFONT) of CLOOK2))) - (OR (EQ CLOOK1 CLOOK2) + (OR (EQ CLOOK1 CLOOK2) + (LET ((FONT1 (FGETCLOOKS CLOOK1 CLFONT)) + (FONT2 (FGETCLOOKS CLOOK2 CLFONT))) (AND [OR (EQ FONT1 FONT2) (AND (type? FONTCLASS FONT1) (type? FONTCLASS FONT2) @@ -487,35 +584,38 @@ (fetch (FONTCLASS DISPLAYFD) of FONT1)) (EQUAL (FONTCLASSUNPARSE FONT1) (FONTCLASSUNPARSE FONT2] - (EQ (ffetch (CHARLOOKS CLPROTECTED) of CLOOK1) - (ffetch (CHARLOOKS CLPROTECTED) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLINVISIBLE) of CLOOK1) - (ffetch (CHARLOOKS CLINVISIBLE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLSELHERE) of CLOOK1) - (ffetch (CHARLOOKS CLSELHERE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLCANCOPY) of CLOOK1) - (ffetch (CHARLOOKS CLCANCOPY) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLULINE) of CLOOK1) - (ffetch (CHARLOOKS CLULINE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLOLINE) of CLOOK1) - (ffetch (CHARLOOKS CLOLINE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLINVERTED) of CLOOK1) - (ffetch (CHARLOOKS CLINVERTED) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLSTRIKE) of CLOOK1) - (ffetch (CHARLOOKS CLSTRIKE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLOFFSET) of CLOOK1) - (ffetch (CHARLOOKS CLOFFSET) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLSMALLCAP) of CLOOK1) - (ffetch (CHARLOOKS CLSMALLCAP) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLSTYLE) of CLOOK1) - (ffetch (CHARLOOKS CLSTYLE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLUNBREAKABLE) of CLOOK1) - (ffetch (CHARLOOKS CLUNBREAKABLE) of CLOOK2)) - (EQ (ffetch (CHARLOOKS CLUSERINFO) of CLOOK1) - (ffetch (CHARLOOKS CLUSERINFO) of CLOOK2]) + (EQ (FGETCLOOKS CLOOK1 CLPROTECTED) + (FGETCLOOKS CLOOK2 CLPROTECTED)) + (EQ (FGETCLOOKS CLOOK1 CLINVISIBLE) + (FGETCLOOKS CLOOK2 CLINVISIBLE)) + (EQ (FGETCLOOKS CLOOK1 CLSELAFTER) + (FGETCLOOKS CLOOK2 CLSELAFTER)) + (EQ (FGETCLOOKS CLOOK1 CLSELBEFORE) + (FGETCLOOKS CLOOK2 CLSELBEFORE)) + (EQ (FGETCLOOKS CLOOK1 CLCANCOPY) + (FGETCLOOKS CLOOK2 CLCANCOPY)) + (EQ (FGETCLOOKS CLOOK1 CLULINE) + (FGETCLOOKS CLOOK2 CLULINE)) + (EQ (FGETCLOOKS CLOOK1 CLOLINE) + (FGETCLOOKS CLOOK2 CLOLINE)) + (EQ (FGETCLOOKS CLOOK1 CLINVERTED) + (FGETCLOOKS CLOOK2 CLINVERTED)) + (EQ (FGETCLOOKS CLOOK1 CLSTRIKE) + (FGETCLOOKS CLOOK2 CLSTRIKE)) + (EQ (FGETCLOOKS CLOOK1 CLOFFSET) + (FGETCLOOKS CLOOK2 CLOFFSET)) + (EQ (FGETCLOOKS CLOOK1 CLSMALLCAP) + (FGETCLOOKS CLOOK2 CLSMALLCAP)) + (EQ (FGETCLOOKS CLOOK1 CLSTYLE) + (FGETCLOOKS CLOOK2 CLSTYLE)) + (EQ (FGETCLOOKS CLOOK1 CLUNBREAKABLE) + (FGETCLOOKS CLOOK2 CLUNBREAKABLE)) + (EQ (FGETCLOOKS CLOOK1 CLUSERINFO) + (FGETCLOOKS CLOOK2 CLUSERINFO]) (\TEDIT.SAMECLOOKS - [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 24-Jul-2023 17:17 by rmk") + [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 31-Jul-2024 00:06 by rmk") + (* ; "Edited 24-Jul-2023 17:17 by rmk") (* ; "Edited 30-May-91 21:45 by jds") (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES") @@ -545,8 +645,8 @@ (fetch (CHARLOOKS CLOFFSET) of CLOOK2))) (INVISIBLE (EQ (fetch (CHARLOOKS CLINVISIBLE) of CLOOK1) (fetch (CHARLOOKS CLINVISIBLE) of CLOOK2))) - (SELECTPOINT (EQ (fetch (CHARLOOKS CLSELHERE) of CLOOK1) - (fetch (CHARLOOKS CLSELHERE) of CLOOK2))) + (SELECTPOINT (EQ (fetch (CHARLOOKS CLSELAFTER) of CLOOK1) + (fetch (CHARLOOKS CLSELAFTER) of CLOOK2))) (PROTECTED (EQ (fetch (CHARLOOKS CLPROTECTED) of CLOOK1) (fetch (CHARLOOKS CLPROTECTED) of CLOOK2))) (OVERLINE (EQ (fetch (CHARLOOKS CLOLINE) of CLOOK1) @@ -580,36 +680,57 @@ (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS DATUM TEXTOBJ]) (TEDIT.COPY.LOOKS - [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 25-Nov-2024 14:38 by rmk") + (* ; "Edited 2-Aug-2024 08:47 by rmk") + (* ; "Edited 13-Jul-2024 23:15 by rmk") + (* ; "Edited 12-Jul-2024 00:37 by rmk") + (* ; "Edited 29-Apr-2024 13:00 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 9-Feb-2024 11:42 by rmk") (* ; "Edited 18-Apr-2023 23:53 by rmk") (* ; "Edited 22-Oct-2022 15:27 by rmk") (* ; "Edited 22-Aug-2022 13:14 by rmk") (* ; "Edited 30-May-91 21:43 by jds") - (* ;; "Copy the CHARACTER LOOKS of one piece of text (actually, the first selected character) to another piece of text") + (* ;; "Copy the CHARACTER LOOKS of one piece of text (actually, the first selected character) to another piece of text.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - LOOKS LEN) (* ; + (* ;; "According to (slightly wrong) documentation:") + + (* ;; "STREAM is the stream of the destination, no matter what.") + + (* ;; "STREAM is the stream of the source if SOURCE is an integer (or if it has no textstream). Otherwise, it provides its own stream") + + (* ;; "Not clear why the destination can't be in a different stream") + + (SETQ STREAM (TEXTSTREAM STREAM)) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + SOURCESTREAM TOOBJ) (* ;  "get the character looks of the first character of SOURCE") - [SETQ LOOKS (PLOOKS (if (FIXP SOURCE) - then (\TEDIT.CHTOPC SOURCE TEXTOBJ) - elseif (type? SELECTION SOURCE) - then (\TEDIT.CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (SELECTION SELTEXTOBJ) of SOURCE)) - else (\ILLEGAL.ARG SOURCE] - (COND - ((type? SELECTION DEST) (* ; - "make sure that the destination selection is in this document") - (CL:UNLESS (EQ TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of DEST)) - (\LISPERROR "Destination selection is not in stream " STREAM))) - (T (* ; - "set the LEN arg for TEDIT.LOOKS to be 1 since we just have a char pos.") - (SETQ LEN 1))) - (TEDIT.LOOKS TEXTOBJ LOOKS DEST LEN]) + (if (type? SELECTION SOURCE) + then (SETQ SOURCESTREAM (OR (GETSEL SOURCE SELTEXTSTREAM) + STREAM)) + elseif (FIXP SOURCE) + then (SETQ SOURCESTREAM STREAM) + (SETQ SOURCE (\TEDIT.UPDATE.SEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)) + SOURCE 1)) + else (\ILLEGAL.ARG SOURCE)) + (if (type? SELECTION DEST) + then (* ; + "make sure that the destination selection is in this document;") + (CL:UNLESS (OR (EQ STREAM (FGETSEL DEST SELTEXTSTREAM)) + (NULL (FGETSEL DEST SELTEXTSTREAM))) + (\LISPERROR "Destination selection is not in stream " STREAM)) + elseif (FIXP DEST) + then (SETQ DEST (\TEDIT.UPDATE.SEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)) + DEST 1)) + else (\ILLEGAL.ARG DEST)) + (\TEDIT.CHANGE.CHARLOOKS STREAM (PCHARLOOKS (\TEDIT.CHTOPC (GETSEL SOURCE CH#) + SOURCESTREAM)) + DEST]) (\TEDIT.UNPARSE.CHARLOOKS.LIST - [LAMBDA (LOOKS) (* ; "Edited 24-Jul-2023 17:28 by rmk") + [LAMBDA (LOOKS) (* ; "Edited 31-Jul-2024 00:06 by rmk") + (* ; "Edited 24-Jul-2023 17:28 by rmk") (* ; "Edited 11-Feb-2023 14:51 by rmk") (* ; "Edited 30-May-91 21:45 by jds") @@ -635,7 +756,7 @@ (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) 'SIZE) (ONOFF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)) - (ONOFF (fetch (CHARLOOKS CLSELHERE) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLSELAFTER) of LOOKS)) (ONOFF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS))) as PROPNAME in '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE UNBREAKABLE FAMILY SIZE PROTECTED SELECTPOINT INVISIBLE) @@ -650,7 +771,7 @@ (IABS (OR OFFSET 0))) NEWLOOKS]) -(TEDIT.MODIFYLOOKS +(\TEDIT.MODIFYLOOKS [LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* ; "Edited 20-Nov-2023 14:18 by rmk") (* ; "Edited 27-May-2023 12:11 by rmk") (* ; "Edited 24-Sep-2022 11:12 by rmk") @@ -686,11 +807,12 @@ (MOVETO CURX LINEBASEY DS]) (TEDIT.NEW.FONT - [LAMBDA (TEXTOBJ) (* jds " 8-Feb-85 11:27") - (PROG [(NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font: "] - (AND NAME [SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE - NAME] - (RETURN (U-CASE NAME]) + [LAMBDA (TEXTOBJ) (* ; "Edited 29-Jun-2024 16:31 by rmk") + (* jds " 8-Feb-85 11:27") + (LET [(NAME (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "Name of font: "] + (CL:WHEN NAME + [SETQ TEDIT.KNOWN.FONTS (NCONC1 TEDIT.KNOWN.FONTS (LIST NAME (KWOTE (U-CASE NAME] + (U-CASE NAME))]) (\TEDIT.CARETLOOKS.VERIFY [LAMBDA (TEXTOBJ NEWLOOKS) (* ; "Edited 15-Oct-2023 20:13 by rmk") @@ -715,7 +837,10 @@ TEXTOBJ]) (\TEDIT.GET.INSERT.CHARLOOKS - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TEXTOBJ SEL/CHNO) (* ; "Edited 26-Nov-2024 04:58 by rmk") + (* ; "Edited 23-Oct-2024 00:04 by rmk") + (* ; "Edited 31-Jul-2024 12:10 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 16-Feb-2024 22:48 by rmk") (* ; "Edited 15-Dec-2023 08:40 by rmk") (* ; "Edited 3-Aug-2023 22:39 by rmk") @@ -723,19 +848,28 @@ (* ; "Edited 22-Aug-2022 13:21 by rmk") (* ; "Edited 30-May-91 21:45 by jds") + (* ;; "We want to get the looks of a selected character. If point is RIGHT, that's the last character of the selection. If LEFT, the first character of the selection.") + (* ;; "Return the looks at SEL, or defaults. Reset CLPROTECTED if need be.") - (LET ((PC (\TEDIT.CHTOPC (IMAX 1 (IMIN (FGETTOBJ TEXTOBJ TEXTLEN) - (TEDIT.GETPOINT TEXTOBJ SEL))) + (LET ((PC (\TEDIT.CHTOPC (IMAX 1 (IMIN (TEXTLEN TEXTOBJ) + (if (type? SELECTION SEL/CHNO) + then (SELECTQ (GETSEL SEL/CHNO POINT) + (LEFT (ADD1 (TEDIT.GETPOINT TEXTOBJ SEL/CHNO) + )) + (RIGHT (SUB1 (TEDIT.GETPOINT TEXTOBJ SEL/CHNO + ))) + (\TEDIT.THELP "BAD POINT")) + else SEL/CHNO))) TEXTOBJ)) LOOKS) (SETQ LOOKS (if PC - then (PLOOKS PC) + then (PCHARLOOKS PC) elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) - else (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of LOOKS) (* ; + else (\TEDIT.CHARLOOKS.FROM.FONT DEFAULTFONT))) + (CL:WHEN (GETCLOOKS LOOKS CLPROTECTED) (* ;  "Unprotect by copying to a new CHARLOOKS.") - (SETQ LOOKS (create CHARLOOKS using LOOKS CLPROTECTED _ NIL CLSELHERE _ NIL))) + (SETQ LOOKS (create CHARLOOKS using LOOKS CLPROTECTED _ NIL CLSELAFTER _ NIL))) (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS]) (\TEDIT.GET.TERMSA.WIDTHS @@ -749,110 +883,111 @@ (RETURN NWIDTHS]) (\TEDIT.PARSE.CHARLOOKS.LIST - [LAMBDA (NLOOKS DEFAULTCLOOKS TEXTOBJ) (* ; "Edited 13-Nov-2023 01:08 by rmk") + [LAMBDA (NEWLOOKS DEFAULTCLOOKS TEXTOBJ) (* ; "Edited 10-Aug-2024 23:52 by rmk") + (* ; "Edited 31-Jul-2024 12:10 by rmk") + (* ; "Edited 13-Nov-2023 01:08 by rmk") (* ; "Edited 11-Nov-2023 16:09 by rmk") (* ; "Edited 16-Oct-2023 09:02 by rmk") (* ; "Edited 24-Jul-2023 17:24 by rmk") (* ; "Edited 30-May-91 21:46 by jds") - (* ;; "NLOOKS is either a CHARLOOKS, a FONTDESCRIPTOR, or an ALIST-format looks spec. If NLOOKS is not already a CHARLOOKS, it is coerced into one.") + (* ;; "NEWLOOKS is either a CHARLOOKS, a FONTDESCRIPTOR, or a PLIST-format looks spec. If NEWLOOKS is not already a CHARLOOKS, it is coerced into one.") - (* ;; "ALIST is the complicated case. The various properties are extracted from the list, wutg values for unspecified properties taken from DEFAULTCLOOKS. If DEFAULTCLOOKS is not provided, default values are taken from the DEFAULTCHARLOOKS of TEXTOBJ.") + (if (type? CHARLOOKS NEWLOOKS) + then NEWLOOKS + elseif (FONTP NEWLOOKS) + then (\TEDIT.CHARLOOKS.FROM.FONT NEWLOOKS) + else (\TEDIT.CHANGE.CHARLOOKS.NEW NEWLOOKS DEFAULTCLOOKS TEXTOBJ]) - (if (type? CHARLOOKS NLOOKS) - then NLOOKS - elseif (FONTP NLOOKS) - then (CHARLOOKS.FROM.FONT NLOOKS) - else (LET (FAMILY FONT FACE SIZEINC SIZE PROT SELHERE ULINE OLINE STRIKE SUPER OFFSETINC WEIGHT - SLOPE EXPANSION SUB INVISIBLE UNBREAKABLE STYLE STYLESET UISET USERINFO - NEWFONTSPEC NEWFONT INVERSEVIDEO) (* ; - "Construct the set of new looks to apply:") - (* ; - "We got an AList -- prepare looks changes in that form") +(\TEDIT.CHARLOOK.FEATURE + [LAMBDA NARGS (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 31-Jul-2024 00:06 by rmk") + (* ; "Edited 27-Jul-2024 20:36 by rmk") - (* ;; "First get the new font") + (* ;; "Returns the current value for the given FNAME in CHARLOOKS. If 3 arguments, tries to set a new value. Some of the font-related values are tricky: setting e.g. the SIZE should not ony set the CLSIZE, but also change the font to be consistent.") - [SETQ FONT (FONTP (LISTGET NLOOKS 'FONT] - (CL:WHEN (SETQ FAMILY (LISTGET NLOOKS 'FAMILY)) - (PUSH NEWFONTSPEC 'FAMILY FAMILY)) - (CL:WHEN (SETQ SIZE (LISTGET NLOOKS 'SIZE)) - (PUSH NEWFONTSPEC 'SIZE SIZE)) - (SETQ SIZEINC (OR (LISTGET NLOOKS 'SIZEINCREMENT) - 0)) - (SETQ FACE (LISTGET NLOOKS 'FACE)) - (SETQ WEIGHT (LISTGET NLOOKS 'WEIGHT)) - (SETQ SLOPE (LISTGET NLOOKS 'SLOPE)) - (SETQ EXPANSION (LISTGET NLOOKS 'EXPANSION)) - (COND - ((OR WEIGHT SLOPE EXPANSION) (* ; - "Setting one of these inhibits the FACE parameter") - (CL:WHEN WEIGHT - (PUSH NEWFONTSPEC 'WEIGHT WEIGHT)) - (CL:WHEN SLOPE - (PUSH NEWFONTSPEC 'SLOPE SLOPE)) - (CL:WHEN EXPANSION - (PUSH NEWFONTSPEC 'EXPANSION EXPANSION))) - (FACE (PUSH NEWFONTSPEC 'FACE FACE))) - (CL:UNLESS DEFAULTCLOOKS - [SETQ DEFAULTCLOOKS (OR (AND TEXTOBJ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) - (CHARLOOKS.FROM.FONT (FONTCOPY NIL NEWFONTSPEC]) - [PUSH NEWFONTSPEC 'SIZE (IPLUS SIZEINC (FONTPROP (fetch (CHARLOOKS CLFONT) - of DEFAULTCLOOKS) - 'SIZE] - (SETQ NEWFONT (OR FONT (\TEDIT.FONTCOPY (fetch (CHARLOOKS CLFONT) of DEFAULTCLOOKS) - NEWFONTSPEC TEXTOBJ))) - - (* ;; "") - - (* ;; "Now for other CHARLOOKS properties") - - (SETQ PROT (LISTGET NLOOKS 'PROTECTED)) - (SETQ SELHERE (LISTGET NLOOKS 'SELECTPOINT)) - (SETQ ULINE (LISTGET NLOOKS 'UNDERLINE)) - (SETQ OLINE (LISTGET NLOOKS 'OVERLINE)) - (SETQ INVERSEVIDEO (LISTGET NLOOKS 'INVERTED)) - (SETQ STRIKE (LISTGET NLOOKS 'STRIKEOUT)) - (SETQ INVISIBLE (LISTGET NLOOKS 'INVISIBLE)) - (SETQ SUPER (LISTGET NLOOKS 'SUPERSCRIPT)) - (SETQ SUB (LISTGET NLOOKS 'SUBSCRIPT)) - (SETQ OFFSETINC (LISTGET NLOOKS 'OFFSETINCREMENT)) - (SETQ UNBREAKABLE (LISTGET NLOOKS 'UNBREAKABLE)) - (SETQ STYLE (LISTGET NLOOKS 'STYLE)) - (SETQ STYLESET (FMEMB 'STYLE NLOOKS)) - (SETQ USERINFO (LISTGET NLOOKS 'USERINFO)) - (SETQ UISET (FMEMB 'USERINFO NLOOKS)) - [SETQ NLOOKS (create CHARLOOKS using DEFAULTCLOOKS CLFONT _ NEWFONT CLSIZE _ SIZE - CLBOLD _ (EQ 'BOLD (FONTPROP NEWFONT - 'WEIGHT)) - CLITAL _ (EQ 'ITALIC (FONTPROP NEWFONT - 'SLOPE] - - (* ;; - "NLOOKS has the new font but all other properties come from the default. Override if specified.") - - [AND PROT (replace (CHARLOOKS CLPROTECTED) of NLOOKS with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NLOOKS with (EQ SELHERE 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NLOOKS with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NLOOKS with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NLOOKS with (EQ STRIKE 'ON] - [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NLOOKS with (EQ INVISIBLE - 'ON] - [AND UNBREAKABLE (replace (CHARLOOKS CLUNBREAKABLE) of NLOOKS - with (EQ UNBREAKABLE 'ON] - [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NLOOKS - with (EQ INVERSEVIDEO 'ON] - (AND SUPER (replace (CHARLOOKS CLOFFSET) of NLOOKS with SUPER)) - (AND SUB (replace (CHARLOOKS CLOFFSET) of NLOOKS with (IMINUS SUB))) - (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NLOOKS with USERINFO)) - (AND OFFSETINC (add (fetch (CHARLOOKS CLOFFSET) of NLOOKS) - OFFSETINC)) - NLOOKS]) + (LET ((CHARLOOKS (ARG NARGS 1)) + (FNAME (ARG NARGS 2)) + (HASVALUE (EQ NARGS 3)) + (NEWVALUE (AND) + (EQ NARGS 3) + (ARG NARGS 3))) + (CL:WHEN (EQ NEWVALUE 'OFF) + (SETQ NEWVALUE NIL)) + (SELECTQ FNAME + (BOLD (PROG1 (FGETCLOOKS CHARLOOKS CLBOLD) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLBOLD NEWVALUE)))) + (ITALIC (PROG1 (FGETCLOOKS CHARLOOKS CLITAL) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLITAL NEWVALUE)))) + ((FAMILY NAME) + (PROG1 (FGETCLOOKS CHARLOOKS CLNAME) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLNAME NEWVALUE)))) + (FONT (PROG1 (FGETCLOOKS CHARLOOKS CLFONT) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLFONT NEWVALUE)))) + (INVERTED (PROG1 (FGETCLOOKS CHARLOOKS CLINVERTED) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLINVERTED NEWVALUE)))) + (INVISIBLE (PROG1 (FGETCLOOKS CHARLOOKS CLINVISIBLE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLINVISIBLE NEWVALUE)))) + (OFFSET (PROG1 (FGETCLOOKS CHARLOOKS CLOFFSET) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLOFFSET NEWVALUE)))) + (OFFSETINCREMENT + (PROG1 0 (* ; "What else?") + (CL:WHEN HASVALUE + (change (FGETCLOOKS CHARLOOKS CLOFFSET) + (CL:IF (ILESSP DATUM 0) + (IDIFFERENCE DATUM NEWVALUE) + (IPLUS DATUM NEWVALUE)))))) + (OVERLINE (PROG1 (FGETCLOOKS CHARLOOKS CLOLINE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLOLINE NEWVALUE)))) + (PROTECTED (PROG1 (FGETCLOOKS CHARLOOKS CLPROTECTED) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLPROTECTED NEWVALUE)))) + (SELECTPOINT (PROG1 (FGETCLOOKS CHARLOOKS CLSELAFTER) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLSELAFTER NEWVALUE)))) + (SIZE (PROG1 (FGETCLOOKS CHARLOOKS CLSIZE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLSIZE NEWVALUE)))) + (SIZEINCREMENT '(PROG1 (FGETCLOOKS CHARLOOKS SIZEINCREMENT) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS SIZEINCREMENT NEWVALUE)))) + (SMALLCAPS (PROG1 (FGETCLOOKS CHARLOOKS CLSMALLCAP) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLSMALLCAP NEWVALUE)))) + (STRIKEOUT (PROG1 (FGETCLOOKS CHARLOOKS CLSTRIKE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLSTRIKE NEWVALUE)))) + (STYLE (PROG1 (FGETCLOOKS CHARLOOKS CLSTYLE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLSTYLE NEWVALUE)))) + (SUBSCRIPT (PROG1 (FGETCLOOKS CHARLOOKS CLOFFSET) + (CL:WHEN HASVALUE + (FSETCLOOKS CHARLOOKS CLOFFSET (IMINUS NEWVALUE))))) + (SUPERSCRIPT (PROG1 (FGETCLOOKS CHARLOOKS CLOFFSET) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLOFFSET NEWVALUE)))) + (UNBREAKABLE (PROG1 (FGETCLOOKS CHARLOOKS CLUNBREAKABLE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLUNBREAKABLE NEWVALUE)))) + (UNDERLINE (PROG1 (FGETCLOOKS CHARLOOKS CLULINE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLULINE NEWVALUE)))) + (USERINFO (PROG1 (FGETCLOOKS CHARLOOKS CLUSERINFO) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS CLUSERINFO NEWVALUE)))) + (PROGN (* ; "These are alternative/overlays") + '(SELECTQ FNAME + (EXPANSION (PROG1 (FGETCLOOKS CHARLOOKS EXPANSION) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS EXPANSION NEWVALUE)))) + (FACE (PROG1 (FONTPROP (FGETCLOOKS CHARLOOKS CLFONT) + FACE) + (CL:WHEN HASVALUE (* ; + "Would have to reset the fields and font") + (\TEDIT.THELP "CAN'T SET FACE")))) + (FAMILY (PROG1 (FONTPROP (FGETCLOOKS CHARLOOKS CLFONT) + FAMILY) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS FAMILY NEWVALUE)))) + (SLOPE (PROG1 (FGETCLOOKS CHARLOOKS SLOPE) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS SLOPE NEWVALUE)))) + (WEIGHT (PROG1 (FGETCLOOKS CHARLOOKS WEIGHT) + (CL:WHEN HASVALUE (FSETCLOOKS CHARLOOKS WEIGHT NEWVALUE)))]) ) (DEFINEQ (\TEDIT.TRANSLATE.ASCIICHARS - [LAMBDA (TEXTOBJ NOASCIIFONTS) (* ; "Edited 17-Mar-2024 00:25 by rmk") + [LAMBDA (TEXTOBJ NOASCIIFONTS) (* ; "Edited 22-Dec-2024 11:42 by rmk") + (* ; "Edited 20-Dec-2024 13:34 by rmk") + (* ; "Edited 23-Sep-2024 00:50 by rmk") + (* ; "Edited 17-Mar-2024 00:25 by rmk") (* ; "Edited 1-Dec-2023 22:28 by rmk") (* ; "Edited 27-Nov-2023 16:13 by rmk") (* ; "Edited 26-Nov-2023 11:19 by rmk") @@ -861,138 +996,128 @@ (* ;; "Converts characters in Alto/Ascii font pieces to their XCCS character and font (more or less) equivalents. The affected characters are put in their own string pieces with their new CHARLOOKS. Asciifont pieces are completely replaced if NOASCIIFONTS, otherwise untranslated characters remain in their Asciifonts.") - (* ;; "It is tricky to mix the pieces iteration with the TEDIT.RPLCHARCODE, the within-piece indexing has to be adjusted to continue the iteration,because the replacement may split the piece. ") - (* ;; "ASCIITONSTRANSLATIONS and the mapping arrays are from INTERPRESS.") - (* ;; "\ASCIITOSTAR is the default translation array, for Gacha, Timesromand. HIPPO, MATH ... have their own.") + (* ;; "\ASCII2MCCS is the default translation array, for Gacha, Timesroman. HIPPO, MATH ... have their own.") - (DECLARE (GLOBALVARS ASCIITONSTRANSLATIONS \ASCIITOSTAR)) + (DECLARE (GLOBALVARS ASCIITONSTRANSLATIONS \ASCII2MCCS)) (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (CL:WHEN (thereis CL in (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) - unless (EQ 'CLASSIC (fetch (CHARLOOKS CLNAME) of CL)) - suchthat + (thereis CL in (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) unless (EQ 'CLASSIC (GETCLOOKS CL CLNAME)) + suchthat - (* ;; "CLASSIC is in the list presumably to provide a coercion to MODERN for Interpress. We don't want to translate it.") + (* ;; "CLASSIC is in the list presumably to provide a coercion to MODERN for Interpress. We don't want to translate it.") - (ASSOC (fetch (CHARLOOKS CLNAME) of CL) - ASCIITONSTRANSLATIONS)) - (for PC CLOOKS TRANS MAPARRAY NEWFONTNAME STRING FAT CLOOKSLIST CLNAME TARRAYLAST - inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) eachtime (SETQ CLOOKS (PLOOKS PC)) - (SETQ CLNAME (fetch (CHARLOOKS CLNAME) - of CLOOKS)) - unless (OR (EQ OBJECT.PTYPE (PTYPE PC)) - (EQ CLNAME 'CLASSIC)) when (SETQ TRANS (ASSOC CLNAME ASCIITONSTRANSLATIONS)) - do - (* ;; "PC needs some work.") + (ASSOC (GETCLOOKS CL CLNAME) + ASCIITONSTRANSLATIONS)) + (for PC CLOOKS TRANS MAPARRAY NEWFONTNAME STRING FAT CLOOKSLIST CLNAME TARRAYLAST + inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CHNO from 1 by (PLEN PC) + eachtime (SETQ CLOOKS (PLOOKS PC)) + (SETQ CLNAME (GETCLOOKS CLOOKS CLNAME)) unless (OR (EQ OBJECT.PTYPE (PTYPE PC)) + (EQ CLNAME 'CLASSIC)) + when (SETQ TRANS (ASSOC CLNAME ASCIITONSTRANSLATIONS)) + do + (* ;; "PC needs some work.") - (SETQ MAPARRAY (CADR TRANS)) - (SETQ NEWFONTNAME (CADDR TRANS)) - (CL:WHEN MAPARRAY (* ; + (SETQ MAPARRAY (CADR TRANS)) + (SETQ NEWFONTNAME (CADDR TRANS)) + (CL:WHEN MAPARRAY (* ;  "Idiosyncratic fonts (MATH, CYRILLIC). ") - (SETQ MAPARRAY (GETATOMVAL MAPARRAY)) (* ; "Global value") - (CL:WHEN (AND NOASCIIFONTS (PREVPIECE PC)) + (SETQ MAPARRAY (GETATOMVAL MAPARRAY)) (* ; "Global value") + (CL:WHEN (AND NOASCIIFONTS (PREVPIECE PC)) - (* ;; " Look backward for NEWFONTNAME, since that piece has already been coerced. The idea is to get Cyrillic to continue the previous looks (serif, san-serif)") + (* ;; " Look backward for NEWFONTNAME, since that piece has already been coerced. The idea is to get Cyrillic to continue the previous looks (serif, san-serif)") - [SETQ NEWFONTNAME (fetch (CHARLOOKS CLNAME) of (PLOOKS (PREVPIECE PC])) - (if (OR MAPARRAY NOASCIIFONTS) - then - (* ;; "Translate all characters in idiosyncratic fonts, flush everything and change the looks even for Helvetica etc. if NO ALTOFONTS") + (SETQ NEWFONTNAME (GETCLOOKS (PLOOKS (PREVPIECE PC)) + CLNAME)))) + (if (OR MAPARRAY NOASCIIFONTS) + then + (* ;; "Translate all characters in idiosyncratic fonts, flush everything and change the looks even for Helvetica etc. if NO ALTOFONTS") - (CL:UNLESS MAPARRAY (SETQ MAPARRAY \ASCIITOSTAR)) - (SETQ TARRAYLAST (SUB1 (ARRAYSIZE MAPARRAY))) + (CL:UNLESS MAPARRAY (SETQ MAPARRAY \ASCII2MCCS)) + (SETQ TARRAYLAST (SUB1 (ARRAYSIZE MAPARRAY))) - (* ;; "Create a string with the translated codes, then convert the existing piece to a string piece holding that string.") + (* ;; "Create a string with the translated codes, then convert the existing piece to a string piece holding that string.") - (SETQ STRING (ALLOCSTRING (PLEN PC))) - (for OFFSET CODE NEWCODE from 1 to (PLEN PC) - do - (* ;; + (SETQ STRING (ALLOCSTRING (PLEN PC))) + (for OFFSET OLDCODE NEWCODE from 1 to (PLEN PC) + do + (* ;;  "Out-of-range alone and zero newcodes alone (some arrays are not filled in).") - (SETQ CODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC OFFSET)) - (RPLCHARCODE STRING OFFSET (if [OR (IGREATERP CODE TARRAYLAST) - (ZEROP (SETQ NEWCODE (ELT MAPARRAY - CODE] - then CODE - else NEWCODE))) - (SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING)) - (FSETPC PC PTYPE (CL:IF FAT - FATSTRING.PTYPE - THINSTRING.PTYPE)) - (FSETPC PC PCONTENTS STRING) - (FSETPC PC PFPOS NIL) - (FSETPC PC PBINABLE (NOT FAT)) - (FSETPC PC PBYTESPERCHAR (CL:IF FAT - 2 - 1)) - (FSETPC PC PBYTELEN (CL:IF FAT - (UNFOLD (PLEN PC) - 2) - (PLEN PC))) - (FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS NEWFONTNAME - )) - else - (* ;; "Must be a text font (GACHA, TIMESROMAN, HELVETICA) \ASCIITOSTAR is the translation array, mostly identities.") + (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC OFFSET)) + (RPLCHARCODE STRING OFFSET (if [OR (IGREATERP OLDCODE TARRAYLAST) + (ZEROP (SETQ NEWCODE (ELT MAPARRAY + OLDCODE] + then OLDCODE + else NEWCODE))) + (SETQ FAT (ffetch (STRINGP FATSTRINGP) of STRING)) + (FSETPC PC PTYPE (CL:IF FAT + FATSTRING.PTYPE + THINSTRING.PTYPE)) + (FSETPC PC PCONTENTS STRING) + (FSETPC PC PFPOS NIL) + (FSETPC PC PBINABLE (NOT FAT)) + (FSETPC PC PBYTESPERCHAR (CL:IF FAT + 2 + 1)) + (FSETPC PC PBYTELEN (CL:IF FAT + (UNFOLD (PLEN PC) + 2) + (PLEN PC))) + (FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS NEWFONTNAME)) + else + (* ;; "Must be a text font (GACHA, TIMESROMAN, HELVETICA) \ASCIITONS is the translation array, mostly identities. ") - (* ;; "The way TEDIT.RPLCHARCODE works, the PC piece is always the suffix after the last change. So offset 1 is always the next character to be examined after a change, and PLEN is always shrinking. START has to be adjusted after each hit to reflect the new starting CHNO of the shortened PC.") + (* ;; "Find the first change quickly, in piece coordinates. Then change whatever else needs it, slowly, in document coordinates. It would be more complicated to do the replacements in piece coordinates, because the pieces would get split on the fly. ") - (bind (OFFSET _ 0) - OLDCODE NEWCODE START eachtime (add OFFSET 1) - (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE - TEXTOBJ PC OFFSET)) - while OLDCODE when (ILEQ (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC - OFFSET)) - 255) unless (EQ OLDCODE (SETQ NEWCODE - (ELT \ASCIITOSTAR OLDCODE)) - ) - do (CL:UNLESS START - (SETQ START (\TEDIT.PCTOCH PC TEXTOBJ))) - (TEDIT.RPLCHARCODE TEXTOBJ (IPLUS START OFFSET -1) - NEWCODE - (FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS - NEWFONTNAME))) + (for OFFSET OLDCODE NEWLOOKS from 1 to (PLEN PC) + eachtime (SETQ OLDCODE (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ PC OFFSET)) + when (ILEQ OLDCODE 255) unless (EQ OLDCODE (ELT \ASCII2MCCS OLDCODE)) + do + (* ;; "First hit, scan/change the rest of PC") - (* ;; - "Move START up to the new START of PC, set OFFSET back to its beginning.") - - (add START OFFSET) - (SETQ OFFSET 0))) finally + (SETQ NEWLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS NEWFONTNAME)) + (for I NEWCODE from (IPLUS CHNO (SUB1 OFFSET)) + to (SUB1 (IPLUS CHNO (PLEN PC))) eachtime (SETQ OLDCODE (TEDIT.NTHCHARCODE + TEXTOBJ I)) + when (ILEQ OLDCODE 255) unless (EQ OLDCODE (SETQ NEWCODE (ELT \ASCII2MCCS + OLDCODE))) + do (TEDIT.RPLCHARCODE TEXTOBJ I NEWCODE NEWLOOKS)) + (RETURN))) finally (* ;; "Here we change the default and caret looks. Perhaps this should be done only if NOASCIIFONTS. But there is a risk that Ascii fonts and characters would slip in by future editing. ") - (CL:WHEN NOASCIIFONTS - (SETQ CLOOKS (FGETTOBJ TEXTOBJ - DEFAULTCHARLOOKS)) - (SETQ CLNAME (fetch (CHARLOOKS CLNAME) - of CLOOKS)) - (CL:WHEN (AND (NEQ CLNAME 'CLASSIC) - (SETQ TRANS (ASSOC CLNAME - ASCIITONSTRANSLATIONS - ))) - (FSETTOBJ TEXTOBJ DEFAULTCHARLOOKS - (\TEDIT.TRANSLATE.ASCII.CHARLOOKS - TEXTOBJ CLOOKS (CADDR TRANS)))) - (SETQ CLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)) - (SETQ CLNAME (fetch (CHARLOOKS CLNAME) - of CLOOKS)) - (CL:WHEN (AND (NEQ CLNAME 'CLASSIC) - (SETQ TRANS (ASSOC CLNAME - ASCIITONSTRANSLATIONS - ))) - (FSETTOBJ TEXTOBJ CARETLOOKS - (\TEDIT.TRANSLATE.ASCII.CHARLOOKS - TEXTOBJ CLOOKS (CADDR TRANS))))) - (CL:WHEN CLOOKSLIST + (CL:WHEN NOASCIIFONTS + (SETQ CLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (SETQ CLNAME (GETCLOOKS CLOOKS CLNAME)) + (CL:WHEN (AND (NEQ CLNAME 'CLASSIC) + (SETQ TRANS (ASSOC CLNAME + ASCIITONSTRANSLATIONS))) + (FSETTOBJ TEXTOBJ DEFAULTCHARLOOKS + (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ + CLOOKS (CADDR TRANS)))) + (SETQ CLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)) + (SETQ CLNAME (GETCLOOKS CLOOKS CLNAME)) + (CL:WHEN (AND (NEQ CLNAME 'CLASSIC) + (SETQ TRANS (ASSOC CLNAME + ASCIITONSTRANSLATIONS))) + (FSETTOBJ TEXTOBJ CARETLOOKS ( + \TEDIT.TRANSLATE.ASCII.CHARLOOKS + TEXTOBJ CLOOKS + (CADDR TRANS))))) + (CL:WHEN CLOOKSLIST - (* ;; - "Something happened, get rid of any lingering old looks") + (* ;; + "Something happened, get rid of any lingering old looks") - (\TEDIT.UNIQUIFY.ALL TEXTOBJ))))]) + (\TEDIT.UNIQUIFY.ALL TEXTOBJ))]) (\TEDIT.CONVERT.TO.FORMATTED - [LAMBDA (TEXTOBJ START END) (* ; "Edited 20-Mar-2024 11:00 by rmk") + [LAMBDA (TSTREAM START END) (* ; "Edited 7-Jul-2024 09:06 by rmk") + (* ; "Edited 10-May-2024 22:42 by rmk") + (* ; "Edited 6-May-2024 23:49 by rmk") + (* ; "Edited 29-Apr-2024 10:42 by rmk") + (* ; "Edited 20-Mar-2024 11:00 by rmk") (* ; "Edited 17-Mar-2024 12:06 by rmk") (* ; "Edited 15-Mar-2024 13:53 by rmk") (* ; "Edited 6-Jan-2024 15:10 by rmk") @@ -1009,49 +1134,61 @@ (* ;; "Using BIN for the main iteration is a little tricky when TEDIT.RPLCHARCODE is used to make the single-character change. RPLCHARCODE can split the pieces and parameters in the TSTREAM that are used to drive the high-speed (BINABLE) operation. It should perhaps figure out how to fix the stream internally, but for now the \TEXTSETFILEPTR gets things consistent again.") - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS (OR (FGETTOBJ TEXTOBJ FORMATTEDP) - (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))) - (CL:UNLESS START (SETQ START 1)) - (CL:UNLESS END - (SETQ END (FGETTOBJ TEXTOBJ TEXTLEN))) - (FSETTOBJ TEXTOBJ \DIRTY T) - (CL:WHEN (IGEQ END START) - (for CHNO (TSTREAM _ (FGETTOBJ TEXTOBJ STREAMHINT)) from START - first - (* ;; "CHNO is in characters, one more than stream positions") + (LET [(TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (CL:UNLESS (OR (FGETTOBJ TEXTOBJ FORMATTEDP) + (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))) + (CL:UNLESS START (SETQ START 1)) + (CL:UNLESS END + (SETQ END (FGETTOBJ TEXTOBJ TEXTLEN))) + (CL:WHEN (IGEQ END START) + [for CHNO CHANGED CRLF from START first + (* ;; + "CHNO is in characters, one more than stream positions") - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 START)) - do (SELCHARQ (BIN TSTREAM) - (LF - (* ;; "Linefeed not preceded by CR, replace by EOL and mark it paragraph-last. \TEXTSETFILEPTR to make sure that the next BIN does what we want") + (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 START)) + do (SELCHARQ (BIN TSTREAM) + (LF + (* ;; + "Linefeed not preceded by CR, replace by EOL and mark it paragraph-last. What about FORM?") - (TEDIT.RPLCHARCODE TEXTOBJ CHNO (CHARCODE EOL)) - (FSETPC (\TEDIT.CHTOPC CHNO TEXTOBJ) - PPARALAST T) - (\TEDIT.TEXTSETFILEPTR TSTREAM CHNO)) - (CR - (* ;; + (TEDIT.RPLCHARCODE TEXTOBJ CHNO (CHARCODE EOL)) + (SETQ CHANGED T) + (FSETPC (\TEDIT.CHTOPC CHNO TEXTOBJ) + PPARALAST T)) + (CR + (* ;;  "Post-CR characters go to a separate piece, the CR piece is then paragraph-final") - (FSETPC (PREVPIECE (\TEDIT.ALIGNEDPIECE (ADD1 CHNO) - TEXTOBJ)) - PPARALAST T) - (CL:WHEN (EQ (CHARCODE LF) - (\TEDIT.TEXTPEEKBIN TSTREAM T)) - (* ; "DO WE EVER WANT TO SEE LF'S ??") + (FSETPC (PREVPIECE (\TEDIT.ALIGNEDPIECE (ADD1 CHNO) + TEXTOBJ)) + PPARALAST T) + (CL:WHEN (EQ (CHARCODE LF) + (\TEDIT.TEXTPEEKBIN TSTREAM T)) - (* ;; + (* ;;  "Linefeed following CR. Chop it off from whatever follows, and then delete it.") - (add END -1) (* ; "One less char to do") - (\TEDIT.DELETEPIECES (\TEDIT.SELPIECES (ADD1 CHNO) - (ADD1 CHNO)) - TEXTOBJ))) - NIL) repeatuntil (IGEQ CHNO END))) (* ; + (SETQ CRLF T) + (add END -1) (* ; "One less char to do") + (\TEDIT.DELETEPIECES (\TEDIT.SELPIECES (ADD1 CHNO) + (ADD1 CHNO) + TEXTOBJ) + TEXTOBJ) + + (* ;; "We deleted the LF at CHNO, setting the fileptr there resynchronizes on the character just after it.") + + (\TEDIT.TEXTSETFILEPTR TSTREAM CHNO)) + (SETQ CHANGED T)) + NIL) (* ;  "Test END explicitly, because it may get reduced") - (FSETTOBJ TEXTOBJ FORMATTEDP T) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ START END))]) + repeatuntil (IGEQ CHNO END) finally (FSETTOBJ TEXTOBJ FORMATTEDP T) + (CL:WHEN CHANGED + (FSETTOBJ TEXTOBJ \DIRTY T) + (\TEDIT.UPDATE.LINES (CL:IF CRLF + 'DELETION + 'CHANGED) + START + (ADD1 (IDIFFERENCE END START))))]))]) ) (DECLARE%: EVAL@COMPILE @@ -1187,35 +1324,36 @@ (DEFINEQ (TEDIT.LOOKS - [LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 9-Feb-2024 11:40 by rmk") + [LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 11-Aug-2024 18:11 by rmk") + (* ; "Edited 2-Aug-2024 08:46 by rmk") + (* ; "Edited 27-Jul-2024 23:49 by rmk") + (* ; "Edited 25-Jul-2024 15:01 by rmk") + (* ; "Edited 13-Jul-2024 16:04 by rmk") + (* ; "Edited 22-May-2024 13:55 by rmk") + (* ; "Edited 9-Feb-2024 11:40 by rmk") (* ; "Edited 23-Dec-2023 14:12 by rmk") (* ; "Edited 28-May-2023 13:56 by rmk") (* ; "Edited 24-May-2023 23:12 by rmk") (* ; "Edited 30-May-91 21:41 by jds") - (* ;; "Programmatic interface for character looks in TEdit. Applies to the LEN characters starting at SELORCH#, or the characters selected by SELORCH# if it is a selection. Nothing to do if the selection isn't set. POINT is used only to set the caret looks.") + (* ;; "Programmatic interface for character looks in TEdit. Applies to the LEN characters starting at SELORCH#, or the characters selected by SELORCH# if it is a selection. Nothing to do if the selection isn't set. POINT is preserved and used only to set the caret looks.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - SEL) - (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - (* ;; "Ignores LEN if SELORCH# is a selection") + (* ;; "Ignores LEN if SELORCH# is a selection") - [SETQ SEL (COND - ((type? SELECTION SELORCH#) - SELORCH#) - (SELORCH# (TEDIT.SETSEL TSTREAM SELORCH# LEN 'LEFT)) - (T (FGETTOBJ TEXTOBJ SEL] - (CL:WHEN (GETSEL SEL SET) - (if (AND (IGREATERP (GETSEL SEL DCH) - 0) - (ILEQ (GETSEL SEL CH#) - (TEXTLEN TEXTOBJ))) - then (\TEDIT.CHANGE.LOOKS TSTREAM NEWLOOKS SEL) - else - (* ;; "Out of bounds or maybe a point selection, no text to change. Punt out after setting the caret looks. Old code did not set the history, should we?") + [\TEDIT.CHANGE.CHARLOOKS TSTREAM NEWLOOKS (if (type? SELECTION SELORCH#) + then SELORCH# + elseif SELORCH# + then (TEDIT.SETSEL TSTREAM SELORCH# LEN + 'LEFT) + else (TEXTSEL (fetch (TEXTSTREAM TEXTOBJ) + of TSTREAM] - (TEDIT.CARETLOOKS TSTREAM NEWLOOKS))))]) + (* ;; "Out of bounds or maybe a point selection, no text to change. Punt out after setting the caret looks. Old code did not set the history, should we?") + + (TEDIT.CARETLOOKS TSTREAM NEWLOOKS) + TSTREAM]) (TEDIT.GET.LOOKS [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 17-Mar-2024 00:27 by rmk") @@ -1245,7 +1383,13 @@ TEXTOBJ]) (TEDIT.SUBLOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 17-Mar-2024 17:17 by rmk") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 25-Nov-2024 21:57 by rmk") + (* ; "Edited 5-Jul-2024 22:54 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 18-May-2024 16:22 by rmk") + (* ; "Edited 10-May-2024 22:42 by rmk") + (* ; "Edited 17-Mar-2024 17:17 by rmk") + (* ; "Edited 6-May-2024 17:27 by rmk") (* ; "Edited 16-Mar-2024 10:03 by rmk") (* ; "Edited 13-Nov-2023 00:26 by rmk") (* ; "Edited 18-Apr-2023 23:53 by rmk") @@ -1256,37 +1400,37 @@ (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ; "Turn off the selection, first.") (CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) - [for PC CHANGEMADE SEL (OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST NIL TEXTOBJ - )) + (for PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0) + (OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST NIL TEXTOBJ)) (NEWLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKSLIST NIL TEXTOBJ)) (FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) - (CH# _ 1) inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CH# from 1 - by (PLEN PC) when (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC) - FEATURELIST) do (CL:UNLESS CHANGEMADE - (SETQ CHANGEMADE T) - (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (\TEDIT.SHOWSEL SEL NIL) - (FSETTOBJ TEXTOBJ \DIRTY T)) + inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CH# from 1 by (PLEN PC) + when (\TEDIT.SAMECLOOKS OLDLOOKS (PLOOKS PC) + FEATURELIST) do (CL:UNLESS CHANGEMADE + (SETQ CHANGEMADE T) + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (FSETTOBJ TEXTOBJ \DIRTY T)) - (* ;; + (* ;;  "Note that we may be creating new looks each time, depending on what is there and what is changed.") - (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS - ( - \TEDIT.PARSE.CHARLOOKS.LIST - NEWLOOKSLIST - (PLOOKS PC) - TEXTOBJ) - TEXTOBJ)) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# - (+ CH# (PLEN PC))) - finally (CL:WHEN (FGETTOBJ TEXTOBJ \WINDOW) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)) - (RETURN (CL:IF CHANGEMADE - 'Done - 'NoChangesMade)])]) + (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS + (\TEDIT.PARSE.CHARLOOKS.LIST + NEWLOOKSLIST + (PLOOKS PC) + TEXTOBJ) + TEXTOBJ)) + + (* ;; "This goes piece by piece, each one adding to the collection of dirty lines. We keep track of the first and last changes") + + (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO CH#)) + (add NCHARSCHANGED (PLEN PC)) + finally (CL:WHEN (AND CHANGEMADE (\TEDIT.PRIMARYPANE TEXTOBJ)) + (* ; "Update the screen image") + (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED) + (\TEDIT.SHOWSEL SEL T TEXTOBJ)) + (RETURN CHANGEMADE)))]) (TEDIT.FINDLOOKS [LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") @@ -1329,259 +1473,325 @@ ) (DEFINEQ -(\TEDIT.CHANGE.LOOKS - [LAMBDA (TSTREAM NEWLOOKS SEL) (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 11-Mar-2024 00:37 by rmk") - (* ; "Edited 9-Mar-2024 11:36 by rmk") - (* ; "Edited 24-Feb-2024 12:33 by rmk") - (* ; "Edited 22-Feb-2024 23:01 by rmk") +(\TEDIT.CHANGE.CHARLOOKS + [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 26-Nov-2024 23:50 by rmk") + (* ; "Edited 22-Oct-2024 23:37 by rmk") + (* ; "Edited 2-Oct-2024 14:22 by rmk") + (* ; "Edited 28-Sep-2024 17:58 by rmk") + (* ; "Edited 16-Aug-2024 22:41 by rmk") + (* ; "Edited 11-Aug-2024 21:12 by rmk") + (* ; "Edited 6-Aug-2024 09:33 by rmk") + (* ; "Edited 31-Jul-2024 12:05 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 15-Mar-2024 14:23 by rmk") (* ; "Edited 23-Dec-2023 15:24 by rmk") (* ; "Edited 31-Oct-2023 19:40 by rmk") (* ; "Edited 24-Jul-2023 17:20 by rmk") (* ; "Edited 28-May-2023 14:38 by rmk") - (* ; "Edited 11-May-2023 12:59 by rmk") (* ; "Edited 19-Apr-93 14:08 by jds") -(* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection.") - -(* ;;; -"THIS FUNCTION AND \TEDIT.PARSE.CHARLOOKS.LIST MUST TRACK ONE ANOTHER, FOR THE P-LIST FORMAT..") +(* ;;; "Internal programmatic interface to changing character looks. DOES NOT CHANGE the current selection (unless it's the TARGETSEL).") (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - FAMILY FONT FACE SIZE PROTECTED SELECTPOINT UNDERLINE OVERLINE STRIKEOUT INVERTED - UNBREAKABLE SUPERSCRIPT WEIGHT SLOPE SIZEINCREMENT OFFSETINCREMENT EXPANSION SUBSCRIPT - INVISIBLE FONTSPEC NEWFONT STYLE STYLESET UISET USERINFO START-OF-PIECE SELPIECES) - (* ; + SELPIECES NEWLOOKSLIST) (* ;  "Construct the set of new looks to apply:") + (CL:UNLESS TARGETSEL + (SETQ TARGETSEL (TEXTSEL TEXTOBJ))) + (CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET) + (NOT (\TEDIT.READONLY TSTREAM NIL (GETSEL TARGETSEL CH#))) + (ILEQ (GETSEL TARGETSEL CH#) + (TEXTLEN TEXTOBJ)) + (IGEQ (GETSEL TARGETSEL CH#) + 1)) + (RETURN NIL)) (if (type? CHARLOOKS NEWLOOKS) then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWLOOKS TEXTOBJ)) elseif (FONTP NEWLOOKS) - then (SETQ FONT NEWLOOKS) - (SETQ NEWLOOKS NIL) (* ; - "NEWLOOKS is NIL unless it's a CHARLOOKS") - else - (* ;; "We got a PList -- extract the various look properties") - (* (for L on NEWLOOKS by CDDR do - (SET (CAR L) (CADR L)))) - (SETQ FONT (LISTGET NEWLOOKS 'FONT)) - (SETQ FAMILY (LISTGET NEWLOOKS 'FAMILY)) - (SETQ FACE (LISTGET NEWLOOKS 'FACE)) - (SETQ SIZE (LISTGET NEWLOOKS 'SIZE)) - (SETQ PROTECTED (LISTGET NEWLOOKS 'PROTECTED)) - (SETQ SELECTPOINT (LISTGET NEWLOOKS 'SELECTPOINT)) - (SETQ UNDERLINE (LISTGET NEWLOOKS 'UNDERLINE)) - (SETQ OVERLINE (LISTGET NEWLOOKS 'OVERLINE)) - (SETQ UNBREAKABLE (LISTGET NEWLOOKS 'UNBREAKABLE)) - (SETQ INVERTED (LISTGET NEWLOOKS 'INVERTED)) - (SETQ STRIKEOUT (LISTGET NEWLOOKS 'STRIKEOUT)) - (SETQ INVISIBLE (LISTGET NEWLOOKS 'INVISIBLE)) - (SETQ SUPERSCRIPT (LISTGET NEWLOOKS 'SUPERSCRIPT)) - (SETQ SUBSCRIPT (LISTGET NEWLOOKS 'SUBSCRIPT)) - (SETQ WEIGHT (LISTGET NEWLOOKS 'WEIGHT)) - (SETQ SLOPE (LISTGET NEWLOOKS 'SLOPE)) - (SETQ EXPANSION (LISTGET NEWLOOKS 'EXPANSION)) - (SETQ SIZEINCREMENT (LISTGET NEWLOOKS 'SIZEINCREMENT)) - (SETQ OFFSETINCREMENT (LISTGET NEWLOOKS 'OFFSETINCREMENT)) - (SETQ STYLE (LISTGET NEWLOOKS 'STYLE)) - (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS)) - (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO)) - (SETQ UISET (FMEMB 'USERINFO NEWLOOKS)) (* ; - "We have extracted all the properties") - (CL:WHEN FAMILY - (push FONTSPEC 'FAMILY FAMILY)) - (CL:WHEN FONT - (CL:UNLESS (OR (type? FONTCLASS FONT) - (type? FONTDESCRIPTOR FONT)) - (TEDIT.PROMPTPRINT (CONCAT FONT " isn't a valid font descriptor.") - T) - (RETURN))) - (if (OR WEIGHT SLOPE EXPANSION) - then (* ; + then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT NEWLOOKS) + TEXTOBJ)) + elseif (for PTAIL on NEWLOOKS by (CDDR PTAIL) unless (OR (\TEDIT.CHARLOOK.FEATUREP + (CAR PTAIL)) + (NULL (CADR PTAIL))) + do + (* ;; + "OK if a known property or NIL value. Caller can delete temporary properties.") + + (TEDIT.PROMPTPRINT TSTREAM (CONCAT (CAR PTAIL) + + " is not a valid character property--aborted" + ) + T T) + (RETURN T)) + then (RETURN)) + (SETQ SELPIECES (\TEDIT.SELPIECES TARGETSEL NIL TEXTOBJ)) + + (* ;; "Verify that all of the new looks are OK before we change anything") + + [SETQ NEWLOOKSLIST (for PC OLDCHARLOOKS inselpieces SELPIECES + collect (SETQ OLDCHARLOOKS (PLOOKS PC)) + (OR (CL:IF (type? CHARLOOKS NEWLOOKS) + NEWLOOKS + (\TEDIT.CHANGE.CHARLOOKS.NEW NEWLOOKS OLDCHARLOOKS + TEXTOBJ)) + (RETURN NIL] + (CL:UNLESS NEWLOOKSLIST (* ; "At least one bad font?") + (RETURN NIL)) + (for PC UNDOLIST NEWCHARLOOKS DIRTY (FIRSTCHAR _ (GETSPC SELPIECES SPFIRSTCHAR)) + OLDCHARLOOKS inselpieces SELPIECES as NEWCHARLOOKS in NEWLOOKSLIST + do (SETQ OLDCHARLOOKS (PLOOKS PC)) + (add FIRSTCHAR (PLEN PC)) (* ; + "Beginning of next piece--where to stop undoing if new pieces inserted") + (if (\TEDIT.EQCLOOKS OLDCHARLOOKS NEWCHARLOOKS) + then (SETQ OLDCHARLOOKS NIL) (* ; "Undo skips if NIL") + else (FSETPC PC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWCHARLOOKS TEXTOBJ)) + (CL:UNLESS DIRTY (* ; + "Resetting DIRTY is expensive, only do it once ") + (FSETTOBJ TEXTOBJ \DIRTY T) + (SETQ DIRTY T))) + (push UNDOLIST (CONS FIRSTCHAR OLDCHARLOOKS)) + finally + + (* ;; + "Create an event even if no change, so that NEWLOOKS is still available for REDO. ") + + [\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :CharLooks SELPIECES NIL + NIL NIL (CONS NEWLOOKS (AND DIRTY (DREVERSE + UNDOLIST] + (CL:WHEN DIRTY (* ; "Something changed") + (CL:WHEN (\TEDIT.PRIMARYPANE TEXTOBJ) + (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) + (SELECTQ (LISTGET NEWLOOKS 'INVISIBLE) + (ON + (* ;; + "Previously visible characters have disappeared, drop the selection to a point") + + (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) + 0 + 'LEFT)) + (OFF + (* ;; + "Previously invisible characters have appeared, expand the selection") + + (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) + (GETSEL TARGETSEL CH#) + (GETSEL TARGETSEL DCH) + 'RIGHT)) + NIL) + + (* ;; "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 (SUB1 (TEDIT.GETPOINT + TEXTOBJ)) + TEXTOBJ))) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS SELPIECES) + (\TEDIT.SHOWSEL NIL T TEXTOBJ)))]) + +(\TEDIT.CHANGE.CHARLOOKS.NEW + [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 2-Dec-2024 23:52 by rmk") + (* ; "Edited 29-Aug-2024 11:12 by rmk") + (* ; "Edited 22-Aug-2024 10:50 by rmk") + (* ; "Edited 16-Aug-2024 18:23 by rmk") + (* ; "Edited 11-Aug-2024 00:12 by rmk") + + (* ;; "Make a new CHARLOOKS reflecting the properties in NEWLOOKS, with defaults taken from OLDCHARLOOKS, if given, or the DEFAULTCHARLOOKS of TEXTOBJ, if given,;") + + (* ;; "OLDCHARLOOKS is also used as the base for increments.") + + (CL:UNLESS OLDCHARLOOKS + (CL:WHEN TEXTOBJ + (SETQ OLDCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)))) + (for NLTAIL NEWFONT VAL NEWCHARLOOKS on NEWLOOKS by (CDDR NLTAIL) + first (SETQ NEWFONT (\TEDIT.CHARLOOKS.CHANGE.FONT NEWLOOKS OLDCHARLOOKS TEXTOBJ)) + (CL:UNLESS NEWFONT (* ; "Bad font specification") + (RETURN NIL)) + [SETQ NEWCHARLOOKS (create CHARLOOKS using (OR OLDCHARLOOKS (AND TEXTOBJ + (FGETTOBJ TEXTOBJ + DEFAULTCHARLOOKS + ] + (FSETCLOOKS NEWCHARLOOKS CLFONT NEWFONT) + (FSETCLOOKS NEWCHARLOOKS CLNAME (FONTPROP NEWFONT 'FAMILY)) + [FSETCLOOKS NEWCHARLOOKS CLBOLD (EQ 'BOLD (FONTPROP NEWFONT 'WEIGHT] + [FSETCLOOKS NEWCHARLOOKS CLITAL (EQ 'ITALIC (FONTPROP NEWFONT 'SLOPE] + (FSETCLOOKS NEWCHARLOOKS CLSIZE (FONTPROP NEWFONT 'SIZE)) + do (SETQ VAL (CADR NLTAIL)) + (CL:WHEN (MEMB VAL '(NEUTRAL OFF)) (* ; "Off and NEUTRAL both turn off") + (SETQ VAL NIL)) + + (* ;; "Skip the font attributes here, they have already been interpreted") + + (SELECTQ (CAR NLTAIL) + (OVERLINE (FSETCLOOKS NEWCHARLOOKS CLOLINE VAL)) + (SUPERSCRIPT (FSETCLOOKS NEWCHARLOOKS CLOFFSET VAL)) + (SUBSCRIPT (FSETCLOOKS NEWCHARLOOKS CLOFFSET (IMINUS VAL))) + (PROTECTED (FSETCLOOKS NEWCHARLOOKS CLPROTECTED VAL)) + (UNDERLINE (FSETCLOOKS NEWCHARLOOKS CLULINE VAL)) + (STYLE (FSETCLOOKS NEWCHARLOOKS CLSTYLE VAL)) + (UNBREAKABLE (FSETCLOOKS NEWCHARLOOKS CLUNBREAKABLE VAL)) + (STRIKEOUT (FSETCLOOKS NEWCHARLOOKS CLSTRIKE VAL)) + (INVERTED (FSETCLOOKS NEWCHARLOOKS CLINVERTED VAL)) + ((SELECTPOINT SELAFTER) + (FSETCLOOKS NEWCHARLOOKS CLSELAFTER VAL) (* ; "Mutually exclusive") + (FSETCLOOKS NEWCHARLOOKS CLSELBEFORE (NOT VAL))) + (SELBEFORE (FSETCLOOKS NEWCHARLOOKS CLSELBEFORE VAL) + (FSETCLOOKS NEWCHARLOOKS CLSELAFTER (NOT VAL))) + (OFFSETINCREMENT + (FSETCLOOKS NEWCHARLOOKS CLOFFSET (IPLUS VAL (OR (AND OLDCHARLOOKS + (FGETCLOOKS OLDCHARLOOKS + CLOFFSET)) + 0)))) + (INVISIBLE (FSETCLOOKS NEWCHARLOOKS CLINVISIBLE VAL)) + NIL) finally (RETURN NEWCHARLOOKS]) + +(\TEDIT.CHARLOOKS.CHANGE.FONT + [LAMBDA (NEWLOOKS OLDCHARLOOKS TEXTOBJ) (* ; "Edited 22-Dec-2024 15:27 by rmk") + (* ; "Edited 30-Oct-2024 14:09 by rmk") + (* ; "Edited 7-Sep-2024 13:08 by rmk") + (* ; "Edited 16-Aug-2024 18:25 by rmk") + (* ; "Edited 11-Aug-2024 00:11 by rmk") + (* ; "Edited 30-Jul-2024 22:36 by rmk") + (* ; "Edited 26-Jul-2024 14:55 by rmk") + + (* ;; "Converts all the independent font properties into a final list of font properties and uses them to create a new font, with defaults taken from the newly specified FONT property, or the font of OLDCHARLOOKS. ") + + (PROG ((BASEFONT (OR (LISTGET NEWLOOKS 'FONT) + (FGETCLOOKS OLDCHARLOOKS CLFONT))) + [NEWFAMILY (CL:UNLESS (EQ 'OFF (LISTGET NEWLOOKS 'FAMILY)) + (LISTGET NEWLOOKS 'FAMILY))] + (FACE (LISTGET NEWLOOKS 'FACE)) + (WEIGHT (LISTGET NEWLOOKS 'WEIGHT)) + (SLOPE (LISTGET NEWLOOKS 'SLOPE)) + (EXPANSION (LISTGET NEWLOOKS 'EXPANSION)) + (SIZE (LISTGET NEWLOOKS 'SIZE)) + (SIZEINCREMENT (LISTGET NEWLOOKS 'SIZEINCREMENT)) + FONTSPEC NEWFONT) + + (* ;; "Ignore the other looks if we are going for a fontclass") + + (if [AND NEWFAMILY (type? FONTCLASS (GETATOMVAL (U-CASE NEWFAMILY] + then (RETURN (GETATOMVAL (U-CASE NEWFAMILY))) + elseif (AND BASEFONT (type? FONTCLASS BASEFONT)) + then (SETQ BASEFONT (FONTCREATE BASEFONT))) + (CL:WHEN BASEFONT + (if (type? FONTDESCRIPTOR BASEFONT) + elseif (SETQ NEWFONT (FONTCREATE BASEFONT NIL NIL NIL NIL T)) + then + (* ;; "BASEFONT could be a font specification--no error.") + + (SETQ BASEFONT NEWFONT) + else (if TEXTOBJ + then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT BASEFONT + " isn't a valid font descriptor.") + T T) + (RETURN) + else (ERROR BASEFONT " isn't a valid font descriptor.")))) + (CL:UNLESS WEIGHT + (SETQ WEIGHT (SELECTQ (LISTGET NEWLOOKS 'BOLD) + (ON 'BOLD) + (OFF 'REGULAR) + NIL))) + (CL:UNLESS SLOPE + (SETQ SLOPE (SELECTQ (LISTGET NEWLOOKS 'ITALIC) + (ON 'ITALIC) + (OFF 'REGULAR) + NIL))) + (CL:IF NEWFAMILY + (push FONTSPEC 'FAMILY NEWFAMILY)) + (if (OR WEIGHT SLOPE EXPANSION) + then (* ;  "Setting one of these inhibits the FACE parameter") - (AND WEIGHT (push FONTSPEC 'WEIGHT WEIGHT)) - (AND SLOPE (push FONTSPEC 'SLOPE SLOPE)) - (AND EXPANSION (push FONTSPEC 'EXPANSION EXPANSION)) - elseif FACE - then (push FONTSPEC 'FACE FACE)) - (if SIZE - then (push FONTSPEC 'SIZE SIZE) - elseif SIZEINCREMENT - then (push FONTSPEC 'SIZE 'BOGUSSIZE)) - (SETQ NEWLOOKS NIL)) - (FSETTOBJ TEXTOBJ \DIRTY T) (* ; "Mark the document changed.") - (SETQ SELPIECES (\TEDIT.SELPIECES SEL)) - (for PC NEWPCLOOKS OLDLOOKSLIST OLDPCLOOKS (CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) - inselpieces SELPIECES - do (SETQ OLDPCLOOKS (PLOOKS PC)) - (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST OLDPCLOOKS)) - (* ; "Save old looks for the Undo.") - [COND - (NEWLOOKS (* ; - "We got a CHARLOOKS in. Just use it") - (FSETPC PC PLOOKS NEWLOOKS)) - (T (* ; - "Otherwise, we have to override selectively") - (SETQ NEWPCLOOKS (create CHARLOOKS using OLDPCLOOKS)) - (FSETPC PC PLOOKS NEWPCLOOKS) + (CL:IF WEIGHT + (push FONTSPEC 'WEIGHT WEIGHT)) + (CL:IF SLOPE + (push FONTSPEC 'SLOPE SLOPE)) + (CL:IF EXPANSION + (push FONTSPEC 'EXPANSION EXPANSION)) + elseif FACE + then (push FONTSPEC 'FACE FACE)) + (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.") - (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.") - - (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of OLDPCLOOKS) - (PROGN (CL:WHEN SIZEINCREMENT - (* ; - "There's a size change requested. Fix up the size of the font.") - (LISTPUT FONTSPEC 'SIZE (IPLUS (FONTPROP - (fetch (CHARLOOKS CLFONT) - of OLDPCLOOKS) - 'SIZE) - SIZEINCREMENT))) - FONTSPEC) - TEXTOBJ))) - (CL:UNLESS NEWFONT (RETURN)) - (replace (CHARLOOKS CLFONT) of NEWPCLOOKS with NEWFONT) - (* ; "Give this piece its new looks") - [replace (CHARLOOKS CLBOLD) of NEWPCLOOKS with (EQ 'BOLD (FONTPROP NEWFONT - 'WEIGHT] - [replace (CHARLOOKS CLITAL) of NEWPCLOOKS with (EQ 'ITALIC (FONTPROP - NEWFONT - 'SLOPE] - [AND PROTECTED (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS - with (EQ PROTECTED 'ON] - [AND SELECTPOINT (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS - with (EQ SELECTPOINT 'ON] - [AND UNDERLINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS - with (EQ UNDERLINE 'ON] - [AND OVERLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS - with (EQ OVERLINE 'ON] - [AND STRIKEOUT (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS - with (EQ STRIKEOUT 'ON] - [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS - with (EQ INVISIBLE 'ON] - (AND SUPERSCRIPT (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with SUPERSCRIPT)) - (AND SUBSCRIPT (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS - SUBSCRIPT - ))) - (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) - [AND UNBREAKABLE (replace (CHARLOOKS CLUNBREAKABLE) of NEWPCLOOKS - with (EQ UNBREAKABLE 'ON] - (AND OFFSETINCREMENT (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) - of NEWPCLOOKS) - 0) - OFFSETINCREMENT))) - [AND INVERTED (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS - with (EQ INVERTED 'ON] - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) - - (* ;; "Assure that each set of looks appears only once in the world.") - - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS - TEXTOBJ] - (CL:WHEN (EQ PC CARETPC) - (TEDIT.CARETLOOKS TEXTOBJ NEWPCLOOKS)) - finally (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Looks - THLEN _ (GETSEL SEL DCH) - THCH# _ (GETSEL SEL CH#) - THFIRSTPIECE _ (fetch (SELPIECES SPFIRST) - of SELPIECES) - THOLDINFO _ OLDLOOKSLIST)) - (CL:WHEN (FGETTOBJ TEXTOBJ \WINDOW) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ SEL) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - NIL) - (SELECTQ INVISIBLE - (ON - (* ;; "Previously visible characters have disappeared, to a point") - - (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) - (GETSEL SEL CH#) - 0 - 'LEFT NIL T)) - (OFF - (* ;; "Previously invisible characters have appeared, to select them") - - (\TEDIT.UPDATE.SEL (FGETTOBJ TEXTOBJ SEL) - (GETSEL SEL CH#) - (GETSEL SEL DCH) - 'RIGHT NIL T)) - NIL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE (FGETTOBJ TEXTOBJ SEL) - TEXTOBJ) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") - (\TEDIT.FIXSEL (FGETTOBJ TEXTOBJ SEL) - TEXTOBJ) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - T))]) + (push FONTSPEC 'SIZE (IPLUS (FGETCLOOKS OLDCHARLOOKS CLSIZE) + SIZEINCREMENT))) + (RETURN (\TEDIT.FONTCOPY BASEFONT FONTSPEC TEXTOBJ]) (\TEDIT.LOOKS - [LAMBDA (TEXTOBJ) (* ; "Edited 8-May-2023 21:21 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 28-Jun-2024 21:52 by rmk") + (* ; "Edited 13-Jun-2024 22:10 by rmk") + (* ; "Edited 8-May-2023 21:21 by rmk") (* ; "Edited 30-May-91 21:41 by jds") (* ;; "Handler for the middle-button menu's LOOKS button. Brings up 3 menus, for font, face, and size. Then calls TEDIT.LOOKS to make the requested changes.") - (LET* ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (REGION (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - 'REGION)) - (POS (create POSITION - XCOORD _ (fetch LEFT of REGION) - YCOORD _ (fetch TOP of REGION))) - FONT FACE SIZE NEWLOOKS) - (CL:WHEN (ILEQ (fetch (SELECTION CH#) of SEL) - (TEXTLEN TEXTOBJ)) (* ; "Otherwise, nothing to change") - (COND - ((fetch (SELECTION SET) of SEL) - (CURSORPOSITION (CREATEPOSITION 0 (fetch HEIGHT of REGION)) - (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (SETQ FONT (MENU (create MENU - TITLE _ "Font:" - ITEMS _ (NCONC1 (COPY TEDIT.KNOWN.FONTS) - (LIST 'Other (LIST (FUNCTION TEDIT.NEW.FONT) - TEXTOBJ))) - CENTERFLG _ T) - POS)) (* ; "Set the font for the new text.") - (SETQ FACE (SELECTQ (MENU TEDIT.FACE.MENU POS) - (Bold 'BOLD) - (Italic 'ITALIC) - (Bold% Italic 'BOLDITALIC) - (Regular 'STANDARD) - NIL)) (* ; "Set the face (bold, etc.)") - (SETQ SIZE (MENU TEDIT.SIZE.MENU POS)) (* ; "Set the type size") + (RESETLST + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + [LET* ((SEL (GETTOBJ TEXTOBJ SEL)) + (REGION (WINDOWPROP (FGETTOBJ TEXTOBJ PRIMARYPANE) + 'REGION)) + (POS (create POSITION + XCOORD _ (fetch (REGION LEFT) of REGION) + YCOORD _ (fetch (REGION TOP) of REGION))) + FONT FACE SIZE NEWLOOKS) + (CL:WHEN (ILEQ (GETSEL SEL CH#) + (TEXTLEN TEXTOBJ)) (* ; "Otherwise, nothing to change") + (COND + ((FGETSEL SEL SET) + (CURSORPOSITION (CREATEPOSITION 0 (fetch HEIGHT of REGION)) + (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (SETQ FONT (MENU (create MENU + TITLE _ "Font:" + ITEMS _ (NCONC1 (COPY TEDIT.KNOWN.FONTS) + (LIST 'Other + (LIST (FUNCTION TEDIT.NEW.FONT) + TEXTOBJ))) + CENTERFLG _ T) + POS)) (* ; "Set the font for the new text.") + (SETQ FACE (SELECTQ (MENU TEDIT.FACE.MENU POS) + (Bold 'BOLD) + (Italic 'ITALIC) + (Bold% Italic 'BOLDITALIC) + (Regular 'STANDARD) + NIL)) (* ; "Set the face (bold, etc.)") + (SETQ SIZE (MENU TEDIT.SIZE.MENU POS)) (* ; "Set the type size") (* ;  "Construct the set of new looks to apply:") - (SETQ NEWLOOKS (AND FONT (LIST 'FAMILY FONT))) - (CL:WHEN FACE - (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS)))) - (CL:WHEN SIZE - (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS)))) - (CL:WHEN NEWLOOKS (* ; "There's something to do.") - (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL))) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify" T))))]) + (SETQ NEWLOOKS (AND FONT (LIST 'FAMILY FONT))) + (CL:WHEN FACE + (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS)))) + (CL:WHEN SIZE + (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS)))) + (CL:WHEN NEWLOOKS (* ; "There's something to do.") + (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL))) + (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify" T))))])]) (\TEDIT.FONTCOPY - [LAMBDA (FONT NEWSPECS TEXTOBJ) (* ; "Edited 22-Feb-2024 15:35 by rmk") + [LAMBDA (FONT NEWSPECS TEXTOBJ) (* ; "Edited 11-Aug-2024 00:01 by rmk") + (* ; "Edited 22-Feb-2024 15:35 by rmk") (* ; "Edited 12-Nov-2023 23:24 by rmk") (* jds "26-Dec-84 16:06") (* ;; "Cloak FONTCOPY in protection for the user from an unavailable font.") - (COND - ((NULL NEWSPECS) (* ; "No changes specified. Punt it.") - FONT) - [(CAR (NLSETQ (FONTCOPY FONT NEWSPECS] - (T (TEDIT.PROMPTPRINT TEXTOBJ [CONCAT "Can't find font " (OR (LISTGET NEWSPECS 'FAMILY) - (FONTPROP FONT 'FAMILY)) - " " - (OR (LISTGET NEWSPECS 'SIZE) - (FONTPROP FONT 'SIZE)) - " " - (OR (LISTGET NEWSPECS 'FACE) - (FONTPROP FONT 'FACE] - T) - NIL]) + (if (NULL NEWSPECS) + then (* ; "No changes specified. Punt it.") + FONT + elseif (CAR (NLSETQ (FONTCOPY FONT NEWSPECS))) + else (LET [(MSG (CONCAT "Can't find font " (OR (LISTGET NEWSPECS 'FAMILY) + (FONTPROP FONT 'FAMILY)) + " " + (OR (LISTGET NEWSPECS 'SIZE) + (FONTPROP FONT 'SIZE)) + " " + (OR (LISTGET NEWSPECS 'FACE) + (FONTPROP FONT 'FACE] + (if TEXTOBJ + then (TEDIT.PROMPTPRINT TEXTOBJ MSG T T) + else (ERROR MSG))) + NIL]) ) @@ -1591,7 +1801,8 @@ (DEFINEQ (\TEDIT.EQFMTSPEC - [LAMBDA (PARALOOK1 PARALOOK2) (* ; + [LAMBDA (PARALOOK1 PARALOOK2) (* ; "Edited 28-Jul-2024 21:29 by rmk") + (* ;  "Edited 2-Jul-93 21:32 by sybalskY:MV:ENVOS") (* ;; "Given two sets of FMTSPECS, are they effectively the same?") @@ -1641,11 +1852,15 @@ (ffetch (FMTSPEC FMTUSERINFO) of PARALOOK2)) (EQUAL (ffetch (FMTSPEC FMTCHARSTYLES) of PARALOOK1) (ffetch (FMTSPEC FMTCHARSTYLES) of PARALOOK2)) - (EQUALALL (ffetch (FMTSPEC TABSPEC) of PARALOOK1) - (ffetch (FMTSPEC TABSPEC) of PARALOOK2]) + (EQ (ffetch (FMTSPEC FMTDEFAULTTAB) of PARALOOK1) + (ffetch (FMTSPEC FMTDEFAULTTAB) of PARALOOK2)) + (EQUAL (ffetch (FMTSPEC FMTTABS) of PARALOOK1) + (ffetch (FMTSPEC FMTTABS) of PARALOOK2]) (TEDIT.GET.PARALOOKS - [LAMBDA (TSTREAM SELORCH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TSTREAM SELORCH#) (* ; "Edited 4-Aug-2024 17:17 by rmk") + (* ; "Edited 28-Jul-2024 16:25 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 11-Dec-2023 10:12 by rmk") (* ; "Edited 22-Jun-2023 00:02 by rmk") (* ; "Edited 11-Feb-2023 14:55 by rmk") @@ -1670,36 +1885,40 @@ (FMTSPEC (CL:IF PC (PPARALOOKS PC) (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))] - (for PROP in (LIST (fetch (FMTSPEC QUAD) of FMTSPEC) - (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) - (fetch (FMTSPEC LEFTMAR) of FMTSPEC) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) - (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) - (fetch (FMTSPEC LEADAFTER) of FMTSPEC) - (fetch (FMTSPEC LINELEAD) of FMTSPEC) - (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - (fetch (FMTSPEC TABSPEC) of FMTSPEC) - (fetch (FMTSPEC FMTSTYLE) of FMTSPEC) - (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC) - (fetch (FMTSPEC FMTUSERINFO) of FMTSPEC) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) - (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) - (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC) - (ONOFF (fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC)) - (ONOFF (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC)) - (ONOFF (fetch (FMTSPEC FMTHEADINGKEEP) of FMTSPEC)) - (fetch (FMTSPEC FMTKEEP) of FMTSPEC) - (ONOFF (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC)) - (fetch (FMTSPEC FMTREVISED) of FMTSPEC) - (fetch (FMTSPEC FMTCOLUMN) of FMTSPEC)) as PROPNAME + (for PROP in (LIST (FGETPARA FMTSPEC QUAD) + (FGETPARA FMTSPEC 1STLEFTMAR) + (FGETPARA FMTSPEC LEFTMAR) + (FGETPARA FMTSPEC RIGHTMAR) + (FGETPARA FMTSPEC LEADBEFORE) + (FGETPARA FMTSPEC LEADAFTER) + (FGETPARA FMTSPEC LINELEAD) + (FGETPARA FMTSPEC FMTBASETOBASE) + (create TABSPEC + DEFAULTTAB _ (FGETPARA FMTSPEC FMTDEFAULTTAB) + TABS _ (COPY (FGETPARA FMTSPEC FMTTABS))) + (FGETPARA FMTSPEC FMTSTYLE) + (FGETPARA FMTSPEC FMTCHARSTYLES) + (FGETPARA FMTSPEC FMTUSERINFO) + (FGETPARA FMTSPEC FMTSPECIALX) + (FGETPARA FMTSPEC FMTSPECIALY) + (FGETPARA FMTSPEC FMTPARATYPE) + (FGETPARA FMTSPEC FMTPARASUBTYPE) + (ONOFF (FGETPARA FMTSPEC FMTNEWPAGEBEFORE)) + (ONOFF (FGETPARA FMTSPEC FMTNEWPAGEAFTER)) + (ONOFF (FGETPARA FMTSPEC FMTHEADINGKEEP)) + (FGETPARA FMTSPEC FMTKEEP) + (ONOFF (FGETPARA FMTSPEC FMTHARDCOPY)) + (FGETPARA FMTSPEC FMTREVISED) + (FGETPARA FMTSPEC FMTCOLUMN)) as PROPNAME in '(QUAD 1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING LINELEADING BASETOBASE TABS STYLE CHARSTYLES USERINFO SPECIALX SPECIALY TYPE SUBTYPE NEWPAGEBEFORE NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY REVISED COLUMN) join (LIST PROPNAME PROP]) (\TEDIT.PARSE.PARALOOKS.LIST - [LAMBDA (NEWLOOKS OLDLOOKS) (* ; "Edited 17-Oct-2023 12:08 by rmk") + [LAMBDA (NEWLOOKS OLDLOOKS TEXTOBJ) (* ; "Edited 28-Jul-2024 22:14 by rmk") + (* ; "Edited 29-Apr-2024 11:03 by rmk") + (* ; "Edited 17-Oct-2023 12:08 by rmk") (* ; "Edited 9-May-2023 13:20 by rmk") (* ; "Edited 5-Sep-2022 15:39 by rmk") (* ; @@ -1708,13 +1927,13 @@  "Apply a given format spec to the paragraphs which are included in this guy.") (if (type? FMTSPEC NEWLOOKS) then (* ; - "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") + "if we were given a FMTSPEC it replace the FMTSPEC of all pieces affected") NEWLOOKS - else (LET (1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD NLOOKSAVE TYPE SUBTYPE TYPESET - SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET + else (LET (NEWFMT 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPEC QUADD NLOOKSAVE TYPE SUBTYPE + TYPESET SUBTYPESET NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET REVISED REVISEDSET COLUMN COLUMNSET USERINFO USERINFOSET SPECIALX SPECXSET SPECIALY SPECYSET STYLE STYLESET CHARSTYLES - CHARSTYLESSET) (* ; "create an FMTSPEC from the Plist") + CHARSTYLESSET DEFTAB TABS) (* ; "create an FMTSPEC from the Plist") (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN)) (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN)) (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN)) @@ -1751,243 +1970,232 @@ (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS)) (SETQ CHARSTYLES (LISTGET NEWLOOKS 'CHARSTYLES)) (SETQ CHARSTYLESSET (FMEMB 'CHARSTYLES NEWLOOKS)) + (SETQ DEFTAB (LISTGET NEWLOOKS 'DEFAULTTAB)) + (SETQ TABS (LISTGET NEWLOOKS 'TABS)) + (SETQ TABSPEC (LISTGET NEWLOOKS 'TABSPEC)) + (CL:WHEN TABSPEC + (SETQ DEFTAB (fetch (TABSPEC DEFAULTTAB) of TABSPEC)) + (SETQ TABS (fetch (TABSPEC TABS) of TABSPEC))) [SELECTQ QUADD ((LEFT RIGHT CENTERED JUSTIFIED NIL) (* ;  "Do nothing -- we got a valid justification spec") ) ((JUST J) (SETQ QUADD 'JUSTIFIED)) - ((L) - (SETQQ QUADD LEFT)) + (L (SETQQ QUADD LEFT)) (R (SETQQ QUADD RIGHT)) ((C CENTER) (SETQQ QUADD CENTERED)) (PROGN (* ;  "We got an illegal QUAD value. Use LEFT.") - (TEDIT.PROMPTPRINT (AND (BOUNDP 'TEXTOBJ) - (EVALV 'TEXTOBJ)) - (CONCAT "Illegal paragraph quad " QUADD ", replaced with LEFT.") + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Illegal paragraph quad " QUADD + ", replaced with LEFT.") T) (SETQ QUADD 'LEFT] - (SETQ TABSPECC (LISTGET NEWLOOKS 'TABS)) (* ;; "change from the users list to the real tabspec CONS pair of default width and LIST of TAB record instances") - [COND - (TABSPECC (SETQ TABSPECC (CONS [OR (CAR TABSPECC) - (AND OLDLOOKS (CAR (fetch (FMTSPEC TABSPEC) - of OLDLOOKS] - (for SPEC in (CDR TABSPECC) - collect (create TAB - TABKIND _ (CDR SPEC) - TABX _ (CAR SPEC] - (SETQ NEWLOOKS (create FMTSPEC using (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC))) - (AND 1STLEFT (replace (FMTSPEC 1STLEFTMAR) of NEWLOOKS with 1STLEFT)) - (AND LEFT (replace (FMTSPEC LEFTMAR) of NEWLOOKS with LEFT)) - (AND RIGHT (replace (FMTSPEC RIGHTMAR) of NEWLOOKS with RIGHT)) - (AND LEADB (replace (FMTSPEC LEADBEFORE) of NEWLOOKS with LEADB)) - (AND LEADA (replace (FMTSPEC LEADAFTER) of NEWLOOKS with LEADA)) - (AND LLEAD (replace (FMTSPEC LINELEAD) of NEWLOOKS with LLEAD)) - (AND TABSPECC (replace (FMTSPEC TABSPEC) of NEWLOOKS with TABSPECC)) - (AND QUADD (replace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) - (AND TYPESET (replace (FMTSPEC FMTPARATYPE) of NEWLOOKS with TYPE)) - (AND SUBTYPESET (replace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS with SUBTYPE)) - (AND NEWBEFORESET (replace (FMTSPEC FMTNEWPAGEBEFORE) of NEWLOOKS with NEWBEFORE)) - (AND NEWAFTERSET (replace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS with NEWAFTER)) - [AND HEADINGKEEP (replace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS - with (EQ HEADINGKEEP 'ON] - (AND KEEPSET (replace (FMTSPEC FMTKEEP) of NEWLOOKS with KEEP)) - (AND BASESET (replace (FMTSPEC FMTBASETOBASE) of NEWLOOKS with BASETOBASE)) - (AND REVISEDSET (replace (FMTSPEC FMTREVISED) of NEWLOOKS with REVISED)) - (AND COLUMNSET (replace (FMTSPEC FMTCOLUMN) of NEWLOOKS with COLUMN)) - (AND SPECXSET (replace (FMTSPEC FMTSPECIALX) of NEWLOOKS with SPECIALX)) - (AND SPECYSET (replace (FMTSPEC FMTSPECIALY) of NEWLOOKS with SPECIALY)) - (AND STYLESET (replace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) - (AND CHARSTYLESSET (replace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS with CHARSTYLES)) - (AND USERINFOSET (replace (FMTSPEC FMTUSERINFO) of NEWLOOKS with USERINFO)) - NEWLOOKS]) + (SETQ NEWFMT (create FMTSPEC using (OR OLDLOOKS TEDIT.DEFAULT.FMTSPEC))) + (AND 1STLEFT (FSETPARA NEWFMT 1STLEFTMAR 1STLEFT)) + (AND LEFT (FSETPARA NEWFMT LEFTMAR LEFT)) + (AND RIGHT (FSETPARA NEWFMT RIGHTMAR RIGHT)) + (AND LEADB (FSETPARA NEWFMT LEADBEFORE LEADB)) + (AND LEADA (FSETPARA NEWFMT LEADAFTER LEADA)) + (AND LLEAD (FSETPARA NEWFMT LINELEAD LLEAD)) + (AND TABS (FSETPARA NEWFMT FMTTABS TABS)) + (AND DEFTAB (FSETPARA NEWFMT FMTDEFAULTTAB DEFTAB)) + (AND QUADD (FSETPARA NEWFMT QUAD QUADD)) + (AND TYPESET (FSETPARA NEWFMT FMTPARATYPE TYPE)) + (AND SUBTYPESET (FSETPARA NEWFMT FMTPARASUBTYPE SUBTYPE)) + (AND NEWBEFORESET (FSETPARA NEWFMT FMTNEWPAGEBEFORE NEWBEFORE)) + (AND NEWAFTERSET (FSETPARA NEWFMT FMTNEWPAGEAFTER NEWAFTER)) + [AND HEADINGKEEP (FSETPARA NEWFMT FMTHEADINGKEEP (EQ HEADINGKEEP 'ON] + (AND KEEPSET (FSETPARA NEWFMT FMTKEEP KEEP)) + (AND BASESET (FSETPARA NEWFMT FMTBASETOBASE BASETOBASE)) + (AND REVISEDSET (FSETPARA NEWFMT FMTREVISED REVISED)) + (AND COLUMNSET (FSETPARA NEWFMT FMTCOLUMN COLUMN)) + (AND SPECXSET (FSETPARA NEWFMT FMTSPECIALX SPECIALX)) + (AND SPECYSET (FSETPARA NEWFMT FMTSPECIALY SPECIALY)) + (AND STYLESET (FSETPARA NEWFMT FMTSTYLE STYLE)) + (AND CHARSTYLESSET (FSETPARA NEWFMT FMTCHARSTYLES CHARSTYLES)) + (AND USERINFOSET (FSETPARA NEWFMT FMTUSERINFO USERINFO)) + NEWFMT]) (TEDIT.PARALOOKS - [LAMBDA (TSTREAM NEWLOOKS SEL LEN) (* ; "Edited 16-Mar-2024 21:53 by rmk") - (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 9-Mar-2024 11:35 by rmk") - (* ; "Edited 24-Feb-2024 12:33 by rmk") - (* ; "Edited 9-Feb-2024 11:41 by rmk") - (* ; "Edited 19-Jan-2024 14:35 by rmk") - (* ; "Edited 29-Dec-2023 15:29 by rmk") - (* ; "Edited 21-Oct-2023 08:55 by rmk") - (* ; "Edited 28-Jul-2023 15:44 by rmk") - (* ; "Edited 6-Jun-2023 21:36 by rmk") - (* ; "Edited 23-May-2023 14:40 by rmk") - (* ; "Edited 21-Apr-93 18:44 by jds") + [LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 10-Aug-2024 00:23 by rmk") + (* ; "Edited 13-Jul-2024 23:16 by rmk") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + TARGETSEL) - (* ;; "Apply a given format spec to the paragraphs which are included in this guy. This assumes that paragraph boundaries are aligned with piece boundaries, so no splitting is needed. If we are given a FMTSPEC we replace the FMTSPEC of all pieces in all selected paragraphs. Otherwise, we just override particular values in the selected-paragraph looks.") + (* ;; "Ignores LEN if SELORCH# is a selection") - (CL:WHEN - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - PARAPIECES REPLACEALLFIELDS 1STLEFT LEFT RIGHT LEADB LEADA BLEAD BLEADSET LLEAD TABSPECC - QUADD OLDLOOKSLIST TYPE SUBTYPE TYPESET SUBTYPESET SPECIALX SPECIALY NEWBEFORESET - NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET HEADINGKEEP BASETOBASE BASESET HCPYMODE - HCPYSET USERINFO USERSET REVISED REVISEDSET COLUMN COLUMNSET STYLE STYLESET CHARSTYLES - CHARSTYLESSET) - (CL:UNLESS (type? SELECTION SEL) - (SETQ SEL (CL:IF (FIXP SEL) - (TEDIT.SETSEL TEXTOBJ SEL LEN 'RIGHT) - (FGETTOBJ TEXTOBJ SEL)))) - (CL:UNLESS (AND (FGETSEL SEL SET) - (NOT (\TEDIT.READONLY TEXTOBJ))) - (RETURN NIL)) - [COND - ((type? FMTSPEC NEWLOOKS) (* ; - "In case it wasn't already uniquified") - (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS NEWLOOKS TEXTOBJ))) - (T (* ; "create an FMTSPEC from the Plist") - (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN)) - (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN)) - (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN)) - (SETQ LEADB (LISTGET NEWLOOKS 'PARALEADING)) - (SETQ LEADA (LISTGET NEWLOOKS 'POSTPARALEADING)) - (SETQ LLEAD (LISTGET NEWLOOKS 'LINELEADING)) - (SETQ BLEAD (LISTGET NEWLOOKS 'BASETOBASE)) - (SETQ BLEADSET (FMEMB 'BASETOBASE NEWLOOKS)) - (SETQ QUADD (LISTGET NEWLOOKS 'QUAD)) - (SETQ TYPESET (FMEMB 'TYPE NEWLOOKS)) - (SETQ TYPE (LISTGET NEWLOOKS 'TYPE)) - (SETQ SUBTYPESET (FMEMB 'SUBTYPE NEWLOOKS)) - (SETQ SUBTYPE (LISTGET NEWLOOKS 'SUBTYPE)) - (SETQ SPECIALX (LISTGET NEWLOOKS 'SPECIALX)) - (SETQ SPECIALY (LISTGET NEWLOOKS 'SPECIALY)) - (SETQ NEWBEFORESET (FMEMB 'NEWPAGEBEFORE NEWLOOKS)) - (SETQ NEWBEFORE (LISTGET NEWLOOKS 'NEWPAGEBEFORE)) - (SETQ NEWAFTERSET (FMEMB 'NEWPAGEAFTER NEWLOOKS)) - (SETQ NEWAFTER (LISTGET NEWLOOKS 'NEWPAGEAFTER)) - (SETQ HEADINGKEEP (LISTGET NEWLOOKS 'HEADINGKEEP)) - (SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ; - "More general 'Keep-together' spec -- undefined as of 5/22/85") - (SETQ KEEPSET (FMEMB 'KEEP NEWLOOKS)) - (SETQ BASETOBASE (LISTGET NEWLOOKS 'BASETOBASE)) - (SETQ BASESET (FMEMB 'BASETOBASE NEWLOOKS)) - (SETQ HCPYMODE (LISTGET NEWLOOKS 'HARDCOPY)) - (SETQ HCPYSET (FMEMB 'HARDCOPY NEWLOOKS)) - (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO)) - (SETQ USERSET (FMEMB 'USERINFO NEWLOOKS)) - (SETQ REVISED (LISTGET NEWLOOKS 'REVISED)) - (SETQ REVISEDSET (FMEMB 'REVISED NEWLOOKS)) - (SETQ TABSPECC (LISTGET NEWLOOKS 'TABS)) - (SETQ STYLE (LISTGET NEWLOOKS 'STYLE)) - (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS)) - (SETQ CHARSTYLES (LISTGET NEWLOOKS 'CHARSTYLES)) - (SETQ CHARSTYLESSET (FMEMB 'CHARSTYLES NEWLOOKS)) - (SETQ COLUMN (LISTGET NEWLOOKS 'COLUMN)) - (SETQ COLUMNSET (FMEMB 'COLUMN NEWLOOKS)) - (SETQ STYLE (LISTGET NEWLOOKS 'STYLE)) - (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS] + [SETQ TARGETSEL (COND + ((type? SELECTION SELORCH#) + SELORCH#) + (SELORCH# (TEDIT.SETSEL TSTREAM SELORCH# LEN 'RIGHT)) + (T (TEXTSEL TEXTOBJ] + (CL:WHEN (GETSEL TARGETSEL SET) + (if (\TEDIT.READONLY TEXTOBJ NIL (GETSEL TARGETSEL CH#)) + elseif (AND (ILEQ (GETSEL TARGETSEL CH#) + (TEXTLEN TEXTOBJ))) + then (\TEDIT.CHANGE.PARALOOKS TSTREAM NEWLOOKS TARGETSEL)))]) - (* ;; "The new format specification has been decoded into the different variables. ") +(\TEDIT.CHANGE.PARALOOKS + [LAMBDA (TSTREAM NEWLOOKS TARGETSEL) (* ; "Edited 26-Nov-2024 23:51 by rmk") + (* ; "Edited 27-Sep-2024 16:06 by rmk") + (* ; "Edited 16-Aug-2024 14:21 by rmk") + (* ; "Edited 11-Aug-2024 21:59 by rmk") + (* ; "Edited 4-Aug-2024 23:19 by rmk") + (* ; "Edited 2-Aug-2024 00:39 by rmk") + (* ; "Edited 1-Aug-2024 00:12 by rmk") + (* ; "Edited 29-Jul-2024 11:20 by rmk") + (* ; "Edited 26-Jul-2024 16:17 by rmk") + (* ; "Edited 13-Jul-2024 22:55 by rmk") - (* ;; "Apply it to the piece that begins the paragraph containing the first selected character, the piece that ends the paragraph containing the last piece of the selection, and all pieces in between.") + (* ;; "Apply new looks to the piece that begins the paragraph containing the first selected character, the piece that ends the paragraph containing the last piece of the selection, and all pieces in between. All the pieces within a paragraph have the same looks.") - (SETQ PARAPIECES (\TEDIT.PARAPIECES SEL NIL TEXTOBJ)) + (* ;; "If we are given a FMTSPEC we replace the FMTSPEC of all pieces in all selected paragraphs. Otherwise, we just override particular values in the selected-paragraph looks.") - (* ;; "Presumably all the pieces within a paragraph have the same looks, and maybe a sequence of paragraphs will have the same looks. Testing LASTFMTSPEC will typically avoid repeated calculation of the same NEWFMTSPEC") + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + (PROPNAMES '(1STLEFTMARGIN LEFTMARGIN RIGHTMARGIN PARALEADING POSTPARALEADING LINELEADING + BASETOBASE QUAD TYPE SUBTYPE SPECIALX SPECIALY NEWPAGEBEFORE + NEWPAGEAFTER HEADINGKEEP KEEP HARDCOPY USERINFO REVISED STYLE + CHARSTYLES COLUMN TABS DEFAULTTAB MARGINBAR)) + PARAPIECES) + (CL:UNLESS TARGETSEL + (SETQ TARGETSEL (TEXTSEL TEXTOBJ))) + (CL:UNLESS (AND NEWLOOKS (FGETSEL TARGETSEL SET) + (NOT (\TEDIT.READONLY TEXTOBJ NIL (GETSEL TARGETSEL CH#))) + (ILEQ (GETSEL TARGETSEL CH#) + (TEXTLEN TEXTOBJ)) + (IGEQ (GETSEL TARGETSEL CH#) + 1)) + (RETURN NIL)) + (if (type? FMTSPEC NEWLOOKS) + then (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS NEWLOOKS TEXTOBJ)) + elseif (for PTAIL on NEWLOOKS by (CDDR PTAIL) unless (OR (MEMB (CAR PTAIL) + PROPNAMES) + (NULL (CADR PTAIL))) + do + (* ;; "Caller can set NIL to delete temporary properties") - (for PC LASTFMTSPEC NEWFMTSPEC inselpieces PARAPIECES - do (push OLDLOOKSLIST (PPARALOOKS PC)) (* ; - "Save the old looks of each piece for undoing.") - (if (type? FMTSPEC NEWLOOKS) - then (FSETPC PC PPARALOOKS NEWLOOKS) - else (CL:UNLESS (EQ (PPARALOOKS PC) - LASTFMTSPEC) + (TEDIT.PROMPTPRINT TSTREAM (CONCAT (CAR PTAIL) + + " is not a valid paragraph property--aborted" + ) + T T) + (RETURN T)) + then (RETURN)) + (SETQ PARAPIECES (\TEDIT.PARAPIECES TARGETSEL NIL TEXTOBJ)) - (* ;; "We need to instantiate new looks for this piece.") + (* ;; "Testing LASTFMTSPEC will typically avoid repeated calculation of the same NEWFMTSPEC, given the uniquifying.") - (SETQ LASTFMTSPEC (PPARALOOKS PC)) - (SETQ NEWFMTSPEC (create FMTSPEC using LASTFMTSPEC)) - (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with 1STLEFT)) - (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWFMTSPEC with LEFT)) - (AND RIGHT (freplace (FMTSPEC RIGHTMAR) of NEWFMTSPEC with RIGHT)) - (AND LEADB (freplace (FMTSPEC LEADBEFORE) of NEWFMTSPEC with LEADB)) - (AND LEADA (freplace (FMTSPEC LEADAFTER) of NEWFMTSPEC with LEADA)) - (AND BLEADSET (freplace (FMTSPEC FMTBASETOBASE) of NEWFMTSPEC - with BLEAD)) - (AND LLEAD (freplace (FMTSPEC LINELEAD) of NEWFMTSPEC with LLEAD)) - (CL:WHEN TABSPECC + (* ;; "For each changed paragraph we keep track of its first character number and its prior looks, for history. That's because the number of pieces in a paragraph may change by the doing and doing of future actions, but their character positions will be restored if undoing gets back to this event. No need to record prior looks for unchanged pieces.") - (* ;; "change from the users list to the real tabspec --- CONS pair of default width and LIST of TAB record instances") + (for PC NEWFMTSPEC OLDFMTSPEC UNDOLIST (FIRSTPARAPIECE _ T) + (FIRSTCHAR _ (fetch (SELPIECES SPFIRSTCHAR) of PARAPIECES)) inselpieces PARAPIECES + do (CL:WHEN FIRSTPARAPIECE - [SETQ TABSPECC (CONS [OR (COND - ((AND (CAR TABSPECC) - (ZEROP (CAR TABSPECC))) - 1) - (T (CAR TABSPECC))) - (CAR (fetch (FMTSPEC TABSPEC) - of (PPARALOOKS PC] - (for SPEC in (CDR TABSPECC) - collect (create TAB - TABKIND _ (CDR SPEC) - TABX _ (CAR SPEC] - (freplace (FMTSPEC TABSPEC) of NEWFMTSPEC with TABSPECC)) - (AND QUADD (freplace (FMTSPEC QUAD) of NEWFMTSPEC with QUADD)) - (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with TYPE)) - (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) of NEWFMTSPEC - with SUBTYPE)) - (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) of NEWFMTSPEC with SPECIALX - )) - (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) of NEWFMTSPEC with SPECIALY - )) - (AND NEWBEFORESET (freplace (FMTSPEC FMTNEWPAGEBEFORE) of NEWFMTSPEC - with NEWBEFORE)) - (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER) of NEWFMTSPEC - with NEWAFTER)) - [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) of NEWFMTSPEC - with (EQ HEADINGKEEP 'ON] - (AND KEEPSET (freplace (FMTSPEC FMTKEEP) of NEWFMTSPEC with KEEP)) - (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) of NEWFMTSPEC with - BASETOBASE - )) - (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) of NEWFMTSPEC with HCPYMODE) - ) - (AND USERSET (freplace (FMTSPEC FMTUSERINFO) of NEWFMTSPEC with USERINFO) - ) - (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) of NEWFMTSPEC with REVISED - )) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWFMTSPEC with STYLE)) - (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES) of NEWFMTSPEC - with CHARSTYLES)) - (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) of NEWFMTSPEC with COLUMN)) - (AND STYLESET (replace (FMTSPEC FMTSTYLE) of NEWFMTSPEC with STYLE))) + (* ;; "First piece of a new paragraph, get the NEWFMTSPEC for all its pieces") + + (SETQ OLDFMTSPEC (PPARALOOKS PC)) + (SETQ NEWFMTSPEC (CL:IF (type? FMTSPEC NEWLOOKS) + NEWLOOKS + (\TEDIT.CHANGE.PARALOOKS.NEW NEWLOOKS OLDFMTSPEC TEXTOBJ))) + (CL:UNLESS (\TEDIT.EQFMTSPEC OLDFMTSPEC NEWFMTSPEC) + (* ; "Something changed") (SETQ NEWFMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS NEWFMTSPEC TEXTOBJ)) - (FSETPC PC PPARALOOKS NEWFMTSPEC))) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :ParaLooks - THLEN _ (fetch (SELPIECES SPLEN) of PARAPIECES) - THCH# _ (fetch (SELPIECES SPFIRSTCHAR) of PARAPIECES) - THFIRSTPIECE _ (fetch (SELPIECES SPFIRST) of PARAPIECES) - THOLDINFO _ (DREVERSE OLDLOOKSLIST))) + (CL:UNLESS UNDOLIST (* ; + "Resetting DIRTY is expensive, only do it once ") + (FSETTOBJ TEXTOBJ \DIRTY T)) + (push UNDOLIST (CONS FIRSTCHAR OLDFMTSPEC)))) + (FSETPC PC PPARALOOKS NEWFMTSPEC) + (add FIRSTCHAR (PLEN PC)) + (SETQ FIRSTPARAPIECE (PPARALAST PC)) + finally - (* ;; "Pieces have been updated. Now update any visible lines.") + (* ;; + "Create an event even if UNDOLIST is NIL, so that NEWLOOKS is still available for REDO. ") - (CL:WHEN (FGETTOBJ TEXTOBJ \WINDOW) - (\TEDIT.SHOWSEL SEL NIL) (* ; - "Turn off the sel before updating the screen") - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ PARAPIECES) - (CL:UNLESS (AND (LISTP NEWLOOKS) - (EQ 'HARDCOPY (CAR NEWLOOKS)) - (NULL (CDDR NEWLOOKS))) + [\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :ParaLooks PARAPIECES NIL + NIL NIL (CONS NEWLOOKS (DREVERSE UNDOLIST] + (CL:WHEN UNDOLIST - (* ;; "The document is %"dirty%" for the titlebar and saving only if something other than hardcopy-display mode was changed") + (* ;; "Something changed, update any visible lines.") - (FSETTOBJ TEXTOBJ \DIRTY T)) (* ; "Save this action for undo/redo") - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; + (CL:WHEN (\TEDIT.PRIMARYPANE TEXTOBJ) + (CL:UNLESS (AND (LISTP NEWLOOKS) + (EQ 'HARDCOPY (CAR NEWLOOKS)) + (NULL (CDDR NEWLOOKS))) + + (* ;; "The document is %"dirty%" for the titlebar and saving only if something other than hardcopy-display mode was changed") + + (FSETTOBJ TEXTOBJ \DIRTY T)) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS PARAPIECES) + (* ;  "Update the screen image, showing the original selection") - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T))]) + (\TEDIT.SHOWSEL NIL T TEXTOBJ)))]) + +(\TEDIT.CHANGE.PARALOOKS.NEW + [LAMBDA (NEWLOOKS OLDFMTSPEC TEXTOBJ) (* ; "Edited 31-Aug-2024 15:00 by rmk") + (* ; "Edited 29-Aug-2024 11:13 by rmk") + (* ; "Edited 23-Aug-2024 23:41 by rmk") + (* ; "Edited 11-Aug-2024 21:22 by rmk") + + (* ;; "Make a new FMTSPEC reflecting the properties in NEWLOOKS, with defaults taken from OLDCHARFMTSPEC, if given, or the DEFAULTFMTSPEC of TEXTOBJ, if given,;") + + (* ;; "OLDCHARLOOKS is also used as the base for increments.") + + (CL:UNLESS OLDFMTSPEC + (CL:WHEN TEXTOBJ + (SETQ OLDFMTSPEC (GETTOBJ TEXTOBJ FMTSPEC)))) + (for NLTAIL VAL NEWFMTSPEC on NEWLOOKS by (CDDR NLTAIL) + first (SETQ NEWFMTSPEC (CL:IF OLDFMTSPEC + (create FMTSPEC using OLDFMTSPEC) + (create FMTSPEC))) + do (SETQ VAL (CADR NLTAIL)) + (CL:WHEN (MEMB VAL '(NEUTRAL OFF)) (* ; + "NEUTRAL and OFF both turn off the flag") + (SETQ VAL NIL)) + (SELECTQ (CAR NLTAIL) + (1STLEFTMARGIN (FSETPARA NEWFMTSPEC 1STLEFTMAR VAL)) + (LEFTMARGIN (FSETPARA NEWFMTSPEC LEFTMAR VAL)) + (RIGHTMARGIN (FSETPARA NEWFMTSPEC RIGHTMAR VAL)) + (PARALEADING (FSETPARA NEWFMTSPEC LEADBEFORE VAL)) + (POSTPARALEADING + (FSETPARA NEWFMTSPEC LEADAFTER VAL)) + (LINELEADING (FSETPARA NEWFMTSPEC LINELEAD VAL)) + (BASETOBASE (FSETPARA NEWFMTSPEC FMTBASETOBASE VAL)) + (QUAD (CL:WHEN VAL + (FSETPARA NEWFMTSPEC QUAD (U-CASE VAL)))) + (TYPE (FSETPARA NEWFMTSPEC FMTPARATYPE (CL:IF (EQ VAL 'ON) + 'PAGEHEADING))) + (SUBTYPE (FSETPARA NEWFMTSPEC FMTPARASUBTYPE VAL)) + (SPECIALX (FSETPARA NEWFMTSPEC FMTSPECIALX VAL)) + (SPECIALY (FSETPARA NEWFMTSPEC FMTSPECIALY VAL)) + (NEWPAGEBEFORE (FSETPARA NEWFMTSPEC FMTNEWPAGEBEFORE VAL)) + (NEWPAGEAFTER (FSETPARA NEWFMTSPEC FMTNEWPAGEAFTER VAL)) + (HEADINGKEEP (FSETPARA NEWFMTSPEC FMTHEADINGKEEP VAL)) + (KEEP (FSETPARA NEWFMTSPEC FMTKEEP VAL)) + (HARDCOPY (FSETPARA NEWFMTSPEC FMTHARDCOPY VAL)) + (USERINFO (FSETPARA NEWFMTSPEC FMTUSERINFO VAL)) + (REVISED (FSETPARA NEWFMTSPEC FMTREVISED VAL)) + (STYLE (FSETPARA NEWFMTSPEC FMTSTYLE VAL)) + (CHARSTYLES (FSETPARA NEWFMTSPEC FMTCHARSTYLES VAL)) + (COLUMN (FSETPARA NEWFMTSPEC FMTCOLUMN VAL)) + (TABS (FSETPARA NEWFMTSPEC FMTTABS VAL)) + (DEFAULTTAB (FSETPARA NEWFMTSPEC FMTDEFAULTTAB VAL)) + NIL) finally (RETURN NEWFMTSPEC]) (TEDIT.COPY.PARALOOKS - [LAMBDA (TSTREAM SOURCE DEST) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TSTREAM SOURCE DEST) (* ; "Edited 25-Nov-2024 14:43 by rmk") + (* ; "Edited 13-Jul-2024 23:22 by rmk") + (* ; "Edited 29-Apr-2024 12:58 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 9-Feb-2024 11:39 by rmk") (* ; "Edited 18-Apr-2023 23:53 by rmk") (* ; "Edited 22-Oct-2022 15:29 by rmk") @@ -1996,24 +2204,31 @@ CONS pair of default width and LIST of TAB record instances") (* ;; "Copy the PARAGRAPH LOOKS from one place to another") - (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) - LOOKS LEN) (* ; + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + SOURCESTREAM LOOKS DESTOBJ) (* ;  "get the paragraph looks of the first character of SOURCE") - [SETQ LOOKS (PPARALOOKS (if (FIXP SOURCE) - then (\TEDIT.CHTOPC SOURCE TEXTOBJ) - elseif (type? SELECTION SOURCE) - then (\TEDIT.CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (SELECTION SELTEXTOBJ) of SOURCE)) - else (\ILLEGAL.ARG SOURCE] - (COND - ((type? SELECTION DEST) (* ; - "make sure that the destination selection is in this document") - (CL:UNLESS (EQ TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of DEST)) - (\LISPERROR "Destination selection is not in stream " TSTREAM))) - (T (* ; - "set the LEN arg for TEDIT.PARALOOKS to be 1 since we just have a char pos.") - (SETQ LEN 1))) - (TEDIT.PARALOOKS TEXTOBJ LOOKS DEST LEN]) + (if (type? SELECTION SOURCE) + then (SETQ SOURCESTREAM (OR (GETSEL SOURCE SELTEXTSTREAM) + TSTREAM)) + elseif (FIXP SOURCE) + then (SETQ SOURCESTREAM TSTREAM) + (SETQ SOURCE (\TEDIT.UPDATE.SEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)) + SOURCE 1)) + else (\ILLEGAL.ARG SOURCE)) + (if (type? SELECTION DEST) + then (* ; + "make sure that the destination selection is in this document;") + (CL:UNLESS (OR (EQ TSTREAM (FGETSEL DEST SELTEXTSTREAM)) + (NULL (FGETSEL DEST SELTEXTSTREAM))) + (\LISPERROR "Destination selection is not in stream " TSTREAM)) + elseif (FIXP DEST) + then (SETQ DEST (\TEDIT.UPDATE.SEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)) + DEST 1)) + else (\ILLEGAL.ARG DEST)) + (\TEDIT.CHANGE.PARALOOKS TSTREAM (PPARALOOKS (\TEDIT.CHTOPC (GETSEL SOURCE CH#) + SOURCESTREAM)) + DEST]) (\TEDIT.PARABOUNDS [LAMBDA (TEXTOBJ CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") @@ -2047,7 +2262,14 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (TEDIT.SUBPARALOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 25-Nov-2024 22:00 by rmk") + (* ; "Edited 5-Jul-2024 22:54 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 18-May-2024 16:22 by rmk") + (* ; "Edited 10-May-2024 22:42 by rmk") + (* ; "Edited 29-Apr-2024 11:06 by rmk") + (* ; "Edited 6-May-2024 17:28 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 15-Mar-2024 14:23 by rmk") (* ; "Edited 18-Apr-2023 23:54 by rmk") (* ; "Edited 22-Aug-2022 13:13 by rmk") @@ -2055,40 +2277,40 @@ CONS pair of default width and LIST of TAB record instances") (* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.") - (LET* ((OLDLOOKS (\TEDIT.PARSE.PARALOOKS.LIST OLDLOOKSLIST)) - (NEWLOOKS (\TEDIT.PARSE.PARALOOKS.LIST NEWLOOKSLIST)) - (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (FIRSTPC (\TEDIT.CHTOPC 1 TEXTOBJ)) - (FEATURELIST (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) - CHANGEMADE) - (\TEDIT.SHOWSEL SEL NIL) (* ; "Turn off the selection, first.") - [OR (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (bind (CH# _ 1) for (PC _ FIRSTPC) while PC by (fetch (PIECE NEXTPIECE) of PC) - do (COND - ((SAMEPARALOOKS OLDLOOKS (fetch (PIECE PPARALOOKS) of PC) - FEATURELIST) - (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) - (freplace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (\TEDIT.PARSE.PARALOOKS.LIST - NEWLOOKSLIST - (fetch (PIECE PPARALOOKS) - of PC)) - (TEXTOBJ TEXTSTREAM))) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (+ CH# (fetch (PIECE PLEN) of PC))) - (SETQ CHANGEMADE T))) - (add CH# (fetch (PIECE PLEN) of PC] - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T))) - (COND - (CHANGEMADE 'Done) - (T 'NoChangesMade]) + (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))) + (for PC CHANGEMADE SEL FIRSTCHANGEDCHNO (NCHARSCHANGED _ 0) + (OLDLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST OLDLOOKSLIST)) + (NEWLOOKS _ (\TEDIT.PARSE.PARALOOKS.LIST NEWLOOKSLIST)) + (FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) + inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) as CH# from 1 by (PLEN PC) + when (SAMEPARALOOKS OLDLOOKS (PPARALOOKS PC PPARALOOKS) + FEATURELIST) do (CL:UNLESS CHANGEMADE(* ; + "First change, turn off the selection") + (SETQ CHANGEMADE T) + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (FSETTOBJ TEXTOBJ \DIRTY T)) + (FSETPC PC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS + (\TEDIT.PARSE.PARALOOKS.LIST + NEWLOOKSLIST + (PPARALOOKS PC) + TEXTOBJ) + TEXTOBJ)) + + (* ;; "This goes piece by piece, each one adding to the collection of dirty lines. We keep track of the first and last changes") + + (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO CH#)) + (add NCHARSCHANGED (PLEN PC)) + finally (CL:WHEN (AND CHANGEMADE (\TEDIT.PRIMARYPANE TEXTOBJ)) + (* ; "Update the screen image") + (\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS FIRSTCHANGEDCHNO NCHARSCHANGED) + (\TEDIT.SHOWSEL SEL T TEXTOBJ)) + (RETURN CHANGEMADE]) (SAMEPARALOOKS - [LAMBDA (PARALOOK1 PARALOOK2 FEATURES) (* ; "Edited 8-Dec-92 00:44 by jds") + [LAMBDA (PARALOOK1 PARALOOK2 FEATURES) (* ; "Edited 29-Jul-2024 23:34 by rmk") + (* ; "Edited 28-Jul-2024 16:27 by rmk") + (* ; "Edited 8-Dec-92 00:44 by jds") (* ;; "Predicate to determine if CLOOK1 and CLOOK2 are the same in all the characteristics listed in FEATURES") @@ -2110,8 +2332,10 @@ CONS pair of default width and LIST of TAB record instances") (fetch (FMTSPEC LEADBEFORE) of PARALOOK2))) (LINELEADING (IEQP (fetch (FMTSPEC LINELEAD) of PARALOOK1) (fetch (FMTSPEC LINELEAD) of PARALOOK2))) - (TABS (EQUAL (fetch (FMTSPEC TABSPEC) of PARALOOK1) - (fetch (FMTSPEC TABSPEC) of PARALOOK2))) + (DEFAULTTAB (EQ (FGETPARA PARALOOK1 FMTDEFAULTTAB) + (FGETPARA PARALOOK2 FMTDEFAULTTAB))) + (TABS (EQUAL (FGETPARA PARALOOK1 FMTTABS) + (FGETPARA PARALOOK2 FMTTABS))) (NEWPAGEBEFORE (EQ (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOK1) (fetch (FMTSPEC FMTNEWPAGEBEFORE) of PARALOOK2))) (NEWPAGEAFTER (EQ (fetch (FMTSPEC FMTNEWPAGEAFTER) of PARALOOK1) @@ -2129,74 +2353,6 @@ CONS pair of default width and LIST of TAB record instances") -(* ; "UNDO & History List stuff") - -(DEFINEQ - -(\TEDIT.UNDO.LOOKS - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 19-Feb-2024 11:32 by rmk") - (* ; "Edited 14-Dec-2023 21:01 by rmk") - (* ; "Edited 30-May-2023 22:56 by rmk") - (* ; "Edited 28-May-2023 00:31 by rmk") - (* ; "Edited 4-May-2023 14:35 by rmk") - (* ; "Edited 18-Apr-2023 23:56 by rmk") - (* ; "Edited 30-May-91 21:44 by jds") - - (* ;; "The loop is controlled by the looks, since the pieces are still chained through the text.") - - (for PC (CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) - (SEL _ (FGETTOBJ TEXTOBJ SEL)) inpieces (fetch THFIRSTPIECE of EVENT) as OLDLOOKS - in (GETTH EVENT THOLDINFO) collect (* ; "Remember this for the undo.") - (* ; "Give this piece its old looks") - (CL:WHEN (EQ PC CARETPC) - (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ OLDLOOKS))) - (PROG1 (PLOOKS PC) - (FSETPC PC PLOOKS OLDLOOKS)) - finally (SETTH EVENT THOLDINFO $$VAL) (* ; - "Remember the other looks in case we UNDO the UNDO.") - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (GETTH EVENT THCH#) - (SUB1 (GETTH EVENT THCHLIM))) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)) - (\TEDIT.HISTORYADD TEXTOBJ EVENT]) - -(\TEDIT.UNDO.PARALOOKS - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 19-Feb-2024 11:32 by rmk") - (* ; "Edited 11-Dec-2023 11:10 by rmk") - (* ; "Edited 21-Sep-2023 23:51 by rmk") - (* ; "Edited 30-May-2023 22:55 by rmk") - (* ; "Edited 4-May-2023 14:35 by rmk") - (* ; "Edited 18-Apr-2023 23:57 by rmk") - (* ; "Edited 30-May-91 21:44 by jds") - - (* ;; "Undo the setting of paragraph looks.") - - (for PC (SEL _ (GETTOBJ TEXTOBJ SEL)) inpieces (fetch THFIRSTPIECE of EVENT) as OLDLOOKS - in (fetch THOLDINFO of EVENT) do (FSETPC PC PPARALOOKS OLDLOOKS) - (* ; "Give this piece its old looks") - finally - - (* ;; "Remember the current looks in case we UNDO the UNDO.") - - (replace THOLDINFO of EVENT with $$VAL) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch THCH# of EVENT) - (IPLUS (fetch THCH# of EVENT) - (fetch THLEN of EVENT) - -1)) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T)) - (\TEDIT.HISTORYADD TEXTOBJ EVENT]) -) - - - (* ; "Revision-mark support") (DEFINEQ @@ -2215,42 +2371,6 @@ CONS pair of default width and LIST of TAB record instances") -(* ; "Added by yabu.fx, for SUNLOADUP without DWIM") - -(DEFINEQ - -(\CREATE.TEDIT.DEFAULT.FMTSPEC - [LAMBDA NIL (* ; "Edited 24-Aug-2023 23:31 by rmk") - (create FMTSPEC - QUAD _ 'LEFT - 1STLEFTMAR _ 0 - LEFTMAR _ 0 - RIGHTMAR _ 0 - LEADBEFORE _ 0 - LEADAFTER _ 0 - LINELEAD _ 0 - FMTSPECIALX _ 0 - FMTSPECIALY _ 0 - TABSPEC _ (CONS DEFAULTTAB NIL]) - -(\CREATE.TEDIT.FACE.MENU - [LAMBDA NIL - (create MENU - ITEMS _ '(Bold Italic Bold% Italic Regular) - CENTERFLG _ T - TITLE _ "Face:"]) - -(\CREATE.TEDIT.SIZE.MENU - [LAMBDA NIL - (create MENU - ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36) - CENTERFLG _ T - MENUROWS _ 4 - TITLE _ "Type Size:"]) -) - - - (* ; "Style-sheet support") (DEFINEQ @@ -2311,7 +2431,9 @@ CONS pair of default width and LIST of TAB record instances") STYLE]) (\TEDIT.APPLY.PARASTYLES - [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "Edited 4-Mar-2023 22:23 by rmk") + [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "Edited 4-Aug-2024 14:48 by rmk") + (* ; "Edited 29-Apr-2024 11:06 by rmk") + (* ; "Edited 4-Mar-2023 22:23 by rmk") (* ; "Edited 25-Sep-2022 13:26 by rmk") (* ;  "Edited 3-Jul-93 23:15 by sybalskY:MV:ENVOS") @@ -2336,11 +2458,9 @@ CONS pair of default width and LIST of TAB record instances") PARALOOKS PC TEXTOBJ)) (T (SETQ NOSTYLE T) PARALOOKS] - (SETQ STYLE (COND - ((LISTP STYLE) - (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL)) - PARALOOKS)) - (T STYLE))) + (CL:WHEN (LISTP STYLE) + (SETQ STYLE (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL)) + PARALOOKS TEXTOBJ))) (CL:UNLESS NOSTYLE (push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE))) STYLE]) @@ -2439,26 +2559,37 @@ CONS pair of default width and LIST of TAB record instances") (GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*) ) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA \TEDIT.CHARLOOK.FEATURE) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (20987 22748 (\TEDIT.CHARLOOKS.DEFPRINT 20997 . 22128) (\TEDIT.FMTSPEC.DEFPRINT 22130 . -22746)) (23858 50564 (CHARLOOKS.FROM.FONT 23868 . 25236) (\TEDIT.EQCLOOKS 25238 . 28296) ( -\TEDIT.SAMECLOOKS 28298 . 32457) (TEDIT.CARETLOOKS 32459 . 33501) (TEDIT.COPY.LOOKS 33503 . 35609) ( -\TEDIT.UNPARSE.CHARLOOKS.LIST 35611 . 38214) (TEDIT.MODIFYLOOKS 38216 . 40209) (TEDIT.NEW.FONT 40211 - . 40631) (\TEDIT.CARETLOOKS.VERIFY 40633 . 41470) (\TEDIT.CARETPIECE 41472 . 41777) ( -\TEDIT.GET.INSERT.CHARLOOKS 41779 . 43412) (\TEDIT.GET.TERMSA.WIDTHS 43414 . 43830) ( -\TEDIT.PARSE.CHARLOOKS.LIST 43832 . 50562)) (50565 65304 (\TEDIT.TRANSLATE.ASCIICHARS 50575 . 60783) ( -\TEDIT.CONVERT.TO.FORMATTED 60785 . 65302)) (66494 73729 (\TEDIT.UNIQUIFY.CHARLOOKS 66504 . 68164) ( -\TEDIT.UNIQUIFY.PARALOOKS 68166 . 69433) (\TEDIT.UNIQUIFY.ALL 69435 . 71292) ( -\TEDIT.FLUSH.UNUSED.LOOKS 71294 . 73727)) (73762 83747 (TEDIT.LOOKS 73772 . 75619) (TEDIT.GET.LOOKS -75621 . 77650) (TEDIT.SUBLOOKS 77652 . 81111) (TEDIT.FINDLOOKS 81113 . 83745)) (83748 101074 ( -\TEDIT.CHANGE.LOOKS 83758 . 96972) (\TEDIT.LOOKS 96974 . 99872) (\TEDIT.FONTCOPY 99874 . 101072)) ( -101117 133234 (\TEDIT.EQFMTSPEC 101127 . 104635) (TEDIT.GET.PARALOOKS 104637 . 108417) ( -\TEDIT.PARSE.PARALOOKS.LIST 108419 . 116337) (TEDIT.PARALOOKS 116339 . 129487) (TEDIT.COPY.PARALOOKS -129489 . 131568) (\TEDIT.PARABOUNDS 131570 . 133232)) (133294 139573 (TEDIT.SUBPARALOOKS 133304 . -136174) (SAMEPARALOOKS 136176 . 139571)) (139616 143771 (\TEDIT.UNDO.LOOKS 139626 . 141910) ( -\TEDIT.UNDO.PARALOOKS 141912 . 143769)) (143810 144388 (\TEDIT.MARK.REVISION 143820 . 144386)) (144450 - 145275 (\CREATE.TEDIT.DEFAULT.FMTSPEC 144460 . 144897) (\CREATE.TEDIT.FACE.MENU 144899 . 145071) ( -\CREATE.TEDIT.SIZE.MENU 145073 . 145273)) (145312 154217 (\TEDIT.APPLY.STYLES 145322 . 148887) ( -\TEDIT.APPLY.PARASTYLES 148889 . 151091) (TEDIT.STYLESHEET 151093 . 152160) (TEDIT.POP.STYLESHEET -152162 . 152830) (TEDIT.PUSH.STYLESHEET 152832 . 153572) (TEDIT.ADD.STYLESHEET 153574 . 154215))))) + (FILEMAP (NIL (22860 24621 (\TEDIT.CHARLOOKS.DEFPRINT 22870 . 24001) (\TEDIT.FMTSPEC.DEFPRINT 24003 . +24619)) (24725 25710 (\TEDIT.CREATE.DEFAULT.FMTSPEC 24735 . 25332) (\TEDIT.CREATE.FACE.MENU 25334 . +25506) (\TEDIT.CREATE.SIZE.MENU 25508 . 25708)) (26600 26789 (\TEDIT.CHARLOOK.FEATUREP 26610 . 26787)) + (27091 56841 (\TEDIT.CHARLOOKS.FROM.FONT 27101 . 28911) (\TEDIT.EQCLOOKS 28913 . 31882) ( +\TEDIT.SAMECLOOKS 31884 . 36154) (TEDIT.CARETLOOKS 36156 . 37198) (TEDIT.COPY.LOOKS 37200 . 40483) ( +\TEDIT.UNPARSE.CHARLOOKS.LIST 40485 . 43198) (\TEDIT.MODIFYLOOKS 43200 . 45194) (TEDIT.NEW.FONT 45196 + . 45643) (\TEDIT.CARETLOOKS.VERIFY 45645 . 46482) (\TEDIT.CARETPIECE 46484 . 46789) ( +\TEDIT.GET.INSERT.CHARLOOKS 46791 . 49527) (\TEDIT.GET.TERMSA.WIDTHS 49529 . 49945) ( +\TEDIT.PARSE.CHARLOOKS.LIST 49947 . 51147) (\TEDIT.CHARLOOK.FEATURE 51149 . 56839)) (56842 71973 ( +\TEDIT.TRANSLATE.ASCIICHARS 56852 . 65951) (\TEDIT.CONVERT.TO.FORMATTED 65953 . 71971)) (73163 80398 ( +\TEDIT.UNIQUIFY.CHARLOOKS 73173 . 74833) (\TEDIT.UNIQUIFY.PARALOOKS 74835 . 76102) ( +\TEDIT.UNIQUIFY.ALL 76104 . 77961) (\TEDIT.FLUSH.UNUSED.LOOKS 77963 . 80396)) (80431 91527 ( +TEDIT.LOOKS 80441 . 82830) (TEDIT.GET.LOOKS 82832 . 84861) (TEDIT.SUBLOOKS 84863 . 88891) ( +TEDIT.FINDLOOKS 88893 . 91525)) (91528 111971 (\TEDIT.CHANGE.CHARLOOKS 91538 . 99274) ( +\TEDIT.CHANGE.CHARLOOKS.NEW 99276 . 103010) (\TEDIT.CHARLOOKS.CHANGE.FONT 103012 . 107289) ( +\TEDIT.LOOKS 107291 . 110620) (\TEDIT.FONTCOPY 110622 . 111969)) (112014 141681 (\TEDIT.EQFMTSPEC +112024 . 115781) (TEDIT.GET.PARALOOKS 115783 . 119520) (\TEDIT.PARSE.PARALOOKS.LIST 119522 . 126596) ( +TEDIT.PARALOOKS 126598 . 127604) (\TEDIT.CHANGE.PARALOOKS 127606 . 134253) ( +\TEDIT.CHANGE.PARALOOKS.NEW 134255 . 137339) (TEDIT.COPY.PARALOOKS 137341 . 140015) (\TEDIT.PARABOUNDS + 140017 . 141679)) (141741 149288 (TEDIT.SUBPARALOOKS 141751 . 145535) (SAMEPARALOOKS 145537 . 149286) +) (149327 149905 (\TEDIT.MARK.REVISION 149337 . 149903)) (149942 158994 (\TEDIT.APPLY.STYLES 149952 . +153517) (\TEDIT.APPLY.PARASTYLES 153519 . 155868) (TEDIT.STYLESHEET 155870 . 156937) ( +TEDIT.POP.STYLESHEET 156939 . 157607) (TEDIT.PUSH.STYLESHEET 157609 . 158349) (TEDIT.ADD.STYLESHEET +158351 . 158992))))) STOP diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM index 2c0963298f5934095cdfccd12aba09aada2d2e1e..f4c32e53badab9e4c7e65fa997ef7f9e440ce446 100644 GIT binary patch literal 42189 zcmeHwdvILWdEf2=f+(1x7torbA%?nwDGFo=2>SpC!mhIyz=FGr#a?Iuh=fFo0=baz zB0&S7WZ6z@d)(Sh6Q`1CJANpR)7Z|#Nfsb66N$2R(sZU-Wm07tH4)q9(LXY2(`Ew2 zZZn-}t^U66JLlYU7YmANr!)Pdw1vIr{rb-LKIe3eWJYtvO!sK6km=49M?L4zggZRu zp2|3#x#Co&RLD(EbUKGh8FysL9V*mC54n>WC*FIswY7_C7)G|K%!t#ONOX_PUFc5q zCQ?qkZ!mFUFrMgix;ihcT)e!nJXdyBE;*gfCr*!NMhcmkpZw7B!ui$N)#pBp!nrB= z+gNvG(^SHc;dC?F>8Oilq9#_>s+ zu#!ie&=;FRq2}~mA^c0X(BIdZql??$UZKy=@?RYt3P!h5j<)uQB-bJf9HBzZIWEdk zU*gYC<=#UD9vgn4TzPtUDl-;lIvff`WMSIEp$0RiraHQ`9O0?uEP6HUK(kCOXX2?H=+)De zN;;F%Lja3h@sy+IuK$Fiy5V3$=+9(Qf6_#qNbx-NWBlD1KL(DU1ZD-3mcZQ6oMGxd zfztj=2r8n9aHk7XJ-TKBGE4^b?C#%ZsrP{fW?@X8O}YfA-Ly z)@phAaIB}ge0aX2EfUU_bFqEZXb5$+c41`;nb9dH<$SWaNwqXJGm-hgC((VgHmXOo zb$Z4##cAGF+?R~i7oIh55o)v&3V zY^E?WT4YcxlqO2v_=M^xC7ND334qn;?1ec3#JJNnw6a`wa_h6p3l|*veozNWb5CDc zo?Sg!Kdi~zWA(!t+jUsW%`~(BdxJaKU~nk_*{ueb1n5jXcX`g4T==*iVZU?28E{Tw z!_$D{2`3IxHQ<0?VLvAOtpTd-+%pQ|HeJe02tF)0UA@l4QS6?(0X^aLlLSPJgb1PZ zI^&t~AuNBNQ%{amHIo6@&?uv46e}d8N@3kzr<9rW3Xg)U5-uewhBmL?L2dpHwfRE2 zGALhPku6;L@pL(v-rhVYLC*A|e4h_7_Whg=wYkktQXTh~(*XS}Zv-C0OMvf)9TDcV z?U&2>=a)XU_D38|5)c4b=5YxuACwO-+A44+5YFN&*~6Ba%Qbkbw@Il%aA$ zKhOcman{o@eVYIJkSsWN- z$SaHh98ip?+dvP-`hq(-2_DA^$oEKQa=4V6nDR>YLT4Ts zW@@NuDw@a05==|!E6%i&^MKr9z4^ zQ>YL80k_V-+t=N6t;MaiY+oNhc9kZ-+t(jV*Y>!zJ=@n0qMWK-ez&jRm9DkAwbpHb z<$$cjFfHeFal$Qu)Ss|cRmEW~`vo#Nr_*Oc0nm^S5+KkfU_-#9JD%AA16XQQB=}`= zHxP(i0SGh=wY7z_O~~HP)8xjd0Oa_kfxd4Z^~43Opm@gQ^loD$x)vxfED$gx+pY zoj|Rsjsx2pp+BmtP64vyQqa5+s_d*z!Ln*s0D2?zIaS^Ls&{IusOqHA%B-pF{c5aL znF$5xm9(m*>vop=hd*mE(u^CvH6P7J&TRb8tD&xbkj6}@v2kU%fkJROJ+*yvv&cFq=0%Jz`}cydz)?6CRnv%ZrjO+2<+-$@i9 zG~PEb;IrLM-wBl9=o3J#n&^V0C^FEOI$=i>U*Ts0Uoc%9f>blcf^Z*AgrADJ@I$GS zapWB#@wu3BQa~hDT0evhQ!WJzLOk(U#+wFX7LXWH2}@*fQs7a%M^%-{lMq8pCCLH1 zD@hP6%-d9Em}K!Jmcq(Ol8#>vjP_&(a{JVTM}l55ZVx|+rSkJ8PNpFLJ(`=$krp5U zd}*bjMJv>w0;fNbDG31tYuW3Z&g4#Ir@&nWGA0uy0sN;`1L&zL5kGm-nJjn{Als0~ z{48;FK*d8ou;L+rsdxxXnKKh^aWdx>LG%N;FmNj^VNWK>Usf8{mAQtKcFzIp92rBd=Db7n6&S1v7GT6y-8^VHnz`jyo= zXXPp9!u;&&?1lBYRcCo+WofO)aYp9W=MYgQ#fDE=AO{-cX*Y zj3g1CA>ukX%VW%E@ct)C!x$&)Dh?u*Wyy|N#Fg^ztIGms@dT(kG6K8?SY6ZY_p;)`?s3XGnI$ja?;s6SWUmArlW(W$z9?} zIUo5f2dhI|bo0m3<)PaC?Q4To{A?y!+DY@wRURCoiaM%+YKBxb&8nKTrfNAZRNFhm z%@7NHBCh8Za74N-3!K0#8%++_V(_@YX=ihVLgtiP=y6M@!1SKfS*9mQdDH_OfY^kN z9mZU96vUXbqyQAmf1*EFPyc`}U{wQ5s+(7}$SN!N0vir|Bshn+CHB2uDrGlBjr|J_NWZ$E}v>7A7^qud~x_>l(D#1`+2u30SPZareDVP{chsv1NS z6J|%V8iQ0B>R(&p&O*~x(?1NqI@YxH;CTBP)o#m7dGW2yZl12(R@36ki}|;%9m`ja zh0pD)j(huxsE9Yq_Y09%#v(T=Hx_emZT@S{U-^T@{LO3!sr!;A0J%kCViHiGS&T*k z0B@L!xXsr^|(Y_=ETz_*WkQboiB)}ekCM8HYW{7bD zbc_?RuP71Bjg<&u#)%*)lo;R>63`qnC^2EHK1qSei6Ci|*lTwN{FqNv13Vd6G9lPOmh7bF00JFQ z?Mw54)&snf&6*KiJ>hgsPR)RCnVtk?A~OeAnM{fJBgJP(7yK^z+#4{A;?4~BWwU{5 zhI#&du1j!~a8-tD@^wn%-U#Sp9XTVQV(cC^EA z(k8;<QqMXq4A}6T$--4{&F+aqcLH!I1aSOFIMdXu_#K9pV`giYGhOpzcu1jyf zJ!Hz=brYRZ&9-vaM1^0?ju_II0Bsw`I>CmL0QWIen3~MGBVZn(q%T1eT5?Y#iBv%< zR~*ckmC$R7gWCD=eFG*xl&g~yGZWrqZi)z4KLyX|ATu(|Cj+>g1o3uQR9_VYeYJ=( zRut_*YloeHGRP%nJPuS+S2`Zp_Hih`B`bD!UCw|&fE_LQzzGn1SdC+jthTM)jFD*8 z3ly$SBgq7jpiT2>PN)dBF`Q;5hk?#8kk<#EB=E_WIcBDOJyu@W{$4V=^&UavK-v6% zE_E+w<($CNz)RC&bOFlM2pgQciiD7$SdDRa3}(zihWiB^F3d0Vg1O?v^c04I8IZWK zqIbH;qnUIdmOL^IG06e@zay2f22|q3*^A71KecjcebBM^hT$E|u3{Nr3*hZZTqtLP z@}2Bq0Y1T>w-d~6^HlH*5YK)6E;qd#$-Z~rOj)U4zFJM!Qd{p$*V56gCReyfOb}3` znt|zJ?vZJr6rYa){$*t-xP9VbFdpzxBVO?#;=BFcj~02QHP1$)n#g4!IP-9VYrGGu z6Bb_CbOE|^T{g??rdD`k_8I*hC3}ly20?sJt_U~(98|n>OwHfdt7(^~cj?W_{XE&*U)3=;{|Q4a z1Kp=wF{Zrrd^Oh&Q`l1Wt#4&NwbU-dZEI`FZ+#Gpu(fB3vp+5Z19LyuI-Vrp9ph%o zi?6r9ShM(gBwD?ZmbhqbZ{-ibyo0Xm8QTFvai~g)qUVM|0s_CzsksEpJ^+epQhDYf z`KpL17=0#4H)%G4lJAMBhRwOhUz{#dfj3ZZ$Kw_O7vrrlCh(X{NetZK=r1Xg$)^d@pCEX?R) zc`r>iKlV5t{vC6-K zQVa8oUJ+p(&7GNWpmUPxA(Y6S0TOoHQpugcxFEOi=LGaQ`U|YfxLYXD?lK0khN7<8 zO}>yzgH#}_w7~@68cATh4`6&vV%K>-9hF`8W%-GwT|@AE5gVNjh=M(+3?xXyghBHb z2w`+I(bRoQQ(+HAm(s>By=E!uDoifZBp4-~tUIX#P<|+R$<`3@`a<}G8$jgmw}c|0 zIoe&b%aPgaa?|!gTkMX4Y|H28U&(8o^L^DEdkD;LkNx6CB#|p<(^FLPZgwD@HKvr_ zuG2%+XkIe>imvMCtGQYPnZkdaE5NR$%DdUI$mZ&aA?TQ|m z(!ZwDd;Kb?y%tLRNmSip${ksxxP_d+X3O{GV{!bgFOC;(erCMzCglxuLo~-!DyfHu zX8hrc)rQjV(cN(Bst{c^vV^u(79b^m2AV15kI>C#znr*H*v;r!4t-BIQ$Jy%$EM2u zv2F%gq^Doc)%J{SUPdE({6=JsHXq9^7H;};gsd%Nn;DrlGZpU#B#6;wZ1bqD-k*qj z0SBxTAN#6GY^GT-jkk_%{s1+?Le8jOneF?5#Ed-92QJL#`TMZhZ6?1DjF&Ce^#L`L zGlK|yr0o^)A_Yd#mlsl`tRVa_>`qKVe~VnOKjsL*!}tz$E94-S8%RfMOAJYDTVIw) zAe#|A63{a0O*vUFBtp3h0SuZ6zl{W#M2TZ@&&VPW>|h1eLJ;|&Fv^WX0m<7JYF8!M zph0CV1?$B&Qt0YXCD4S^5A9!<^!yRE@4I{%staQ{6^AnukgP&-e%DR5qfXawVeoV| zQ}oeD7Y$6I(+f0&HY0g%za3Sl-O$liY@z{wr5ldM-eI@jT5x09 zjcV7bsS+#+1=5zflf$_j0kY4*fNRT~9`+z;f_24yp&urZS{5MHNMS_h(A$)dwiYy*g`C07u;Ow8E-j<*W1E0;3t=MoT1`Oxf$kC9 zt0Mi*xC=G~d<_!8u+z}+1q+GpFDyvIh#}n%cyCg%4~tu0(c|G$Wu$wsM8Kxs>oi_u z=R@V%qsmZS=?u>Z!HWn&zV?73fRQJOiQE6pdzRY%gW_`spunHcWgvDBjH!aBN5UF7B@SK%%{KVZoY4< z*821KueMiLhxDze3(9$4acd7(@C0XGx_RzEb*$FHfpby%Tx#o#d568uA6z??9`g<} zk9qD$)r%tXNZC8^*0l$!MehjnnCH3{w|~v+D&NucHLl?W@5raUE-q5_4lliN?r`O| z?(w3m8vU*pr)(acq-|>35F|UVP!`g%^ z@1he2(fq+(I&rSInnxGjT)LU}jzi7V)_z~wOUWdoCn+!SgKKf_$F&E7y*Ssu{XJy$ z`n_J36Ob7bpQ=`V`<{EoYJ1p)CWfUC{dWj+K71+goHy{a`H^(FK)}@2bjTZ|sXgTl z%5Vp{AKqYKc0YvK^#)|F4q;@6cw`^K^m+rFU(IiOB$g(L{`Q)Fz)MThX=z%P$_wb? zy&-D)!_qV)PtW0|hp6cf*EOB0dNH`ZFyzfgF|}`;J6_%R(S1CW8#Lu_yu9&0J|F5j z34TJ6H=|zwH{+ZH(yEX53Ht!FQ7VCJNLnBhP-=cQb`4c2AJh;#Ah8_L0V4qRmMB9{2eox#@8qm>tt(A9N{HIT`X* zHLN7*vD-*NHNSfs#0%CBD+LRKX(I{F>%j*ZDR+~LS$A=Id?-_bkpQx{HP8g6^6cni z8Den~aG9WfC4Af6&VD7JhsUaU!-^clVaeuZnDvaqpB8jfIna?rEYmcaD@`g*kg?E# z<2%_0T_Wp;2FQ0qtP2AH59k5tAsQ$Y2B6wt(lO-~(Gwx2(4bB_17r^;zbiQ84S?$T z3v+@z|CAFR`CV%*2wZ{_joLUt;yO|19c`R|aZtC>56y{RRX_T5mJ21uhlimRgo#15 z*#~8^pRo_!Y%s3AUKm`h@+sIJRQXiE0+NISMT7EjIJDU1$v@I>G!9<7@rdGpNj)M| z;TM5DMOFx#rg70a9}rWG?FJE00(dMZ^h|lsoR-GjDS(Kt2pBFEM!_Mldju2^(EIpo zgJBQADkPjtk$hN5R)V=gmlR{|+7!wiu@Y)~*Pj*H8kJ(yeW)b8i z^e4GHn!YN|iwM2${JEV@g-rmgQm)?}PS}Vm?({jv!iXK^bW$5DDZ=eBWqI_J7RaTQU8(^UNDG_ zwBSr@)oOK)d=mtj0pJqiqr*UyfHID|D_#PqQ@mCnC=19~8n*^0-6)jll+2V1kAH$n z;%=Flr4NoJaMV>>3OMNB9%&|S_Ij@iMmFA*ooU+IFG^+Ym+@#v?9p^I{IXj9O=oPY zIUmhM-mjeS@=6Cy`Kpz_%sn2dyb|j2Nvd`Q#=x=Vbtiyd^(UJpWYiE0RII%(&A7qK zyTZBupO1Tz#;v-3rt!$nbi~fw&d4dBHF5(gnMc$i2^u=-TxF0j%IQxS<;|xbYZD@) zZZ(rYoQWDf>|$g+FxUsn`D-wUh6TUOW8E0T%*W2OMMJ^}RR%cf4F6SrIeUfE0y8WT zDmtp7;Q|j{^0j*u)=F=_U%qr$Wdo2)cO@Sn%IX6`DzhR$Lb_Z-5E(5@PiA|ji%|BB1bxT` zjImA$ywJOuy~Gwg!*T?{>F>ZjD{!hQXsVsT3AOA`m&3f;i$p;pO*Go$Wuh}yi*n@B>&Q*A%AYFu%C@|#z#svr z)90)by|CfPVKi9VZP!UMYx@utw~-t;V7-n21zjAhyPqFEA_g3EhM+rT($o=z1%Y@A zOR^^gl#axifB<@>;p_*PJ%O%7vhk8@4ka`cGN%`z-f+ds?}eet14A#ShlZJyv#|LE zwb6x(sdX@ASH{LPHZ~wy`r;d59iP}^r~xYu9o&-apql8Wa+)+m5cFElS&BF-K6DAk z7(S4O1rg;eh$s^dsR{hPy$y&4V(c^l>d0&z?ws?F2c8d!W8@2Nr3iB?j5yiF?XA1B zcQjq!BgabGuR^e`#K~3i+6UMZ5_#`&x89?sr9<2s8OUobg7#{ASs2CS__E_Jj(GqK zg@P2rL6V*A-3auc#UmR40?vhiB0Xsk{mc}B&GA9anlEVjEx4gmOAZ6RtksBCkuew% zd%=b;tl~I%o*>NRh!k@KVWgN-Cq0zHjRi5D&2?ld2(<^*c^rt09#u zqGi-&RfOc$5FFkE1HM8%#9V8J`o9Jk>c3oc=Y_o;Qon7z&F;^Z!!M6*-I<^7IQ!}R zksA?Uw!bN~FSTXvmQ~+su6&f2^jr*@uvl%c7iGBLoc8u#JH7zjUAES7?trSXx+`bw z#fGS~&0mB3dL6&ywL@VwjK|){wFFu$jQSXU)QfV+>&&Ze|*Sis(m!<0K49*QQ(MMC4=v3w0Vdz z7qpvzd@j%lX_lj`eS(_=6zD2Gj3FN+m2}b`tZN$nCrEH59W_K%QZqy1ma|W4N5IF? z-vmLB*GO7tXbkBw0G|)(eA3#-x&hXzqNT(aQD};;vaXuxw3y~YhSip6X((M z+5_9{knaU{$j|EyvirtpOWZXi(qZKyL2LQiQ2W;7-ae?4y?v4ZK+FOrMFH$Zq3874 zZ~9cEDxgiNDVpaMyt6y3&bRp&ZP8Y5 z-^Sa|0qV(>N)Z$vlq{*zKScoBgvo1M!l65n(nZn)6ku&(GRE>}fKJ)qKRo3PXJK(P zdcO%3^_>(l&Baws)X4cwX3aEM-)(o=o=4|OgzEO1U(GqhA{+L`9yktND+1hP(+ys+Ia|{S<*QuloxK|dG}{rhVsqB z@+(_}^g4=S%#_<^?;6|6Y=nN=ZEI@?qh!Y7zNt$L6f<#U9nY`n>B!g^-jtW3P^H-3tfv zkG$gTD|_wRFIEffkCn^U?uizUe82M7wLPl3N>#ge9rPTT9ioe!*Y4kylrEg> zq8g%N#SuSmazLuYBdhdO|SN{gHF~H{L$P#kMye)BvObLH+Kvk)L>rF5Q%& z*7n9y1|f1bx#6Qaujo9{^M0S+YI@%9pGFDL^L}5;g~RpWhM|FgaB5;i95;kOq{;>uixiHwtM~@&O44U1v}OwS1*5mC zM||vEMh6LGI^c1EizVc`m^fbzaIk=Hin#l1m*XG$wEJH7?SDM8;Y+LO)XBuT~3-WAK*S2>qA(VlB=_=#T3on-TfX?Yj1Cgf{Cl zMS3?vFYbs8ZG=9rBEPP?))K9(skmQOznceiBD@L?Wul*ZCZLXKc913bjgk=ljw1K3kQ{MM!gHzuAqzFQrgxW-Ny%D^C&!5M3o z{oPUcH)B)lBZ`U*h33;Z+9hEv1ZSlV6eV!1%yu&*=RR>HOaL?Z?uf*mTmFDBEBeld zaom(*yC(AaEqzR!oV&%$3ssQ5^Mp_epQs)3GY3sTx zx3xdJ`BAy7WwT3ot1}gc*)RUX>axv05#uJuM6;V|DR6Bd3y!V4aJS-Bw~h>Ly*KOQ zlFGeSKry}Z(KFStYe!V?)Smltl?U^g~mUZmxR1ZD1Mpai(l~eZN~W1tu=f5-c-q1FY3Fw`+7gx zqwG}j&fEuFCFJOGoGurma^MEQ*pa)d@AMGI8DxE=2m+Ut01~Pa$Q{;{2Zl%jxiD-d z$>W!RGzp5#5SWC<);PD~N(H3zZlkTQpp|Y^tC)o}I=;?iY05 zO>hT-!{M=ki}Oc>sgwc1cB{rit&k5cu#Fy;Itr>UH^2_2c5FuC(nCHULC&;Jd2a2( z>cZvql~r8F7{|?U#BSU&mq9qf%PF1$9?V*UuaOGl5``b6Cx`(~^++b>1t6Y}umzBM zQ2QMwuRv|;>A;DTbgh}UX04?y+%y&*i{Sro5qtCE+i!NjBBP|67HG%GKkjf=3CH2P z7danu6sUuLnd`XU+=RwKuAFxR|4H-dIGmB=0(38zz8sE|V~y{G!#!PacNY)9k8ri} zt#H6s1P4@l>cWR^g(IG@>N&S>{JI?A8%O`nMT@eti)!n7`(EVUdHW>d(_ZxYd(v8% zj>I2!JC6IqG&HW&&9d%E(3fyUmi*rU=X$|4u}(SC(bOL4?4 zjbQV}9d$__wyo?#vvp56fy?v~Bpk?1WC@6o>b|`M>~wZ6L8_C?^S1OXtM$ z-0a$%x@*B%TfuS3^|_D1TYkm4xKdtt>N&Z_a+J9v`3S2G50Kp~!U%Cjmv`!w3BJGN*}^nB?<;R9CS8 z;r@|sKAHp{fO{iNk*H3<{a z&eH=ItZaLD>q$;^IqIRUyM?XbiG247!p5|Pn}@bq3ykvSqXosbRQ?;51Jp&JGoV@k zW3DJVT^OXUY=w6W%>y#R(jbJMzik1)KPRUbkzo(3OFm4z%jxP@{s3Rh`yY-|LjEWN zAK`%7Kz%_1Q2;{rK5NnJB}MHHP*o@XN0*r5e=yH<4$l%%dul-)B0($$KxbfNWIa}G z3YPqf1B~m8fFQB4+F?QN3)CUHGSCZ=3zNDs@RYK@MwM?*l>O?$z3H0c)*K0ZAYJQp zYn>9Mro01g?EnWt|07-NaBCeB_?z@=9qi@is$YqIGhI9E)(%VH_tLe4 zZtb81UQO2yxwS(Q*hs(Dg_HhtnV3w4n!6FqXf>#jersulPdrv@L{?0PXh6DZLeF~D}lr5+J3jT|A*J_OV?s7C9e}ktx504D!j7tm&*f93k*~GqYq5N7f4+7gUqkR@WsAS^wNBeVGS6^jUl)_F9nLej z1S5~-Ye&G0H2fF1QKoqu&N7WJjQRIiV6eeHD*=XqSP9?dMQMV`cpET30b8*f8!a>l zIJ4!DAHY`bxNb%ChjDP%lnUm7GLv5nf@oaJs6aNpG7f%&Ivz}eA5WGd()SUn0YrA; zwrX5rItiE1(J2_JPr-T9`eaR~ie^xQa+Hq9Q zbjdl~wy+9?>G7hE2+>=Z)XjDY+}cFvxT&Wg%rLoOBHSVR7QbrgG=@Y`;s~zBfiOfH zx+X@YlB$L-jX?qkI0lDXvA7uamkgC`d7vy5IwNVcIC>fgNtoGD$&e`Z6*Ndjmv~$% zkw_X16SYF)qlT{1NJ^2ZKw^Tm8Y(5u0kuR(>~-wv1cErpb1J!kjd+3)&3-2`{|K=~ zl0zyZoKG^R)nXx?HMJ5{88AJvvMLM+#d50vrbsP2$^r!uAdnwGky&~7Q3?&<{tYr~ zkd#IXhIzwxzk|EV==uO~HT2=)i}dU62(O~j)?=Kab4T?W-jR_{(*d>a;F`3*01I~* z7^`h8seo>jjeQNK?x;z}PpcR)p) z6MY6^I&_R2SVPP~9U~So#5g*pQ-5^nkHflVt;IQaOvfD8d3tnAua1f8kAzN2>6m^U zGoWJzbfspd!N>7&j4Zyr_~?lp!-+P0Bw{cge+VCgF<6Sz`1o+Fqw0;|V<-k| zb`~F_G59_WT+Mp@vHe-_FMYs+Mit&?y!F9Y7z194ZVO}H8dRkp`X10FvSUFoR9p*f z=MQ`mky^e~lBl_7pH57%Ni0PoH%ye75|DTb0=xvA6x<+(@t8rM+RrKQ`z72ng53`T z=1C_%Jvo&d%~2sVlIPR&6z3$-IX{t((3|R$bZ3*eZ$OdF%_rgTq)`j26NoO5iA{Bw zNJCP&{V6g)CO3<^km|gd%~S7}TGDxz7)vI|}cU z3$6ZymS2cD7*37)>6C~0#>`r@nfz_+Al%0p(UV3%KA@nq2?L$!2oT{oXihLfh=N75 z=}tG5MNtN?TT{*E7s^Zj&JND6PG_aD4|u7v5^BrL>2)RCrzj@ zqe^^e?IOY07>*&)`T+ualLFpY^QvIQWJdzF{0!J|rcR?=Q6@OQe_AaB0Y^DKowR+V z*aJ$fJ1D=LaW_&C%;3aKK+d9rjI^H-QhvMCgc!+*i!dQ#7}1szw>NCd$Xn`<;VmWC$--S~zjl|}-_Tv^58<~Hsr*ZE zT^d)OORtV=x20HhZ1b^VE!xms3epu0$M0hrdM#yK9ueDq?Y><-mdIe_wRgZXvWPS3 zuooBM1NBOg4>Zhg-zb*7*!JeL+JPz04ovMLTLzq$+OI#N9G7x#(~E9ci0V~064~6n zaqVx(ne)6BmV1%%W_oqw?Y%g|^ZJ5-uGFacuFCpEk@Zf(anI;rqz+fD};YsB1Lm+~>D14uMJV*93A1ks} zM!6R;ovYyUvMd8;2onC!#@iBEoUdm)vi#oFKOfR_^7%{qjzfdNHb{dV^ek#^Cbv z7?T3VhR@HxY+Qc6QXPY<(MDMN*>E_r5&oEwcaYw^5uUfhEgRu8c6iSQ9-|Tr$K_i$ z!UJ}A??$*wg*Ri>JnlQ`7|S!#j72xXck85k(HE&jc?84`ZiN2EuISK4=+Er%0UW-z z!yOyAOT_93T#tU!4tH*ZzNy0BKx0bA*$DlViu^Lo#^K7xRq*RNPgk_^l$~XN<+L3< zR?)-f3fe0t?bKN1m>oP)xlaYZM6LDyl=Sy1zI&9Pkp~SRxNv3nheW{$%DN4La0~FS zB|xNLt7ed;#~c(0lM9gr*eR%N1lm(TY8w8N@SilBA_;_LA*U0kYV0N9C6q? z>zVmD6l*r(q01y~q!b4pw(u3?svs_dKfw-J6E2QB;sWkSkS*)Hk%XX-8qwl<4UT|M z1iyp8nk02)D^T>ieM!J5*F(Qa$U;sNTkL(jNf@>lmEGn4g{K6RUkzE_cfKXy6MZ_k zY3Td^e@oyU-x8pi8=`Ygw)I9-no1a<8!$)=ksB}w^7yOU8|@Y@gCvmQtbCJ{A;+DJ z90IHDr`d$l_~_*q7t0;dwuw9N9#-W0<#F6%JDwIr*G&HLwrESPaxb&nMcdBPFs?{gOCXWTY(I1FeObTGki?k#ae8s_Y#OREGWvPygv-X5rAHoLw1W z;@Z~RM299{%5UA7o9}r1)43xr^P$NxIyAXggbn}DWIK*Fw$~srvD|?}lQB9p8RJ8f z```J{Wcv`64jh^!t>Z7@3^&|!kw&Z7&W9#rI}S}AD5yh|`}Lv8m^wrT4PulFL&n3Q zNf1W=u!0tR=w$)TquckC#Npbi;%&)=t{c+X^_A5=G|)S&x=M(gU&!(GwM~ z`vs1gPO|xR`-ji0(~<GD zLBX%w=CAv_)1d!nP#`sY0PbFO#{?|)qE>4E;YRp3gt^%~pe+CTR*%TdMZACZPj@^X zh9?E3aELRk)D>@5sm+}Fh$(K`_B{(W!eV#WHf@_H+PHAc6xI)y;r%{oyM;1@eo)tT zt4eL<)PJLke+`$Yv4MUg^xIP6tLYjW>g}i2Oa~oRi-Q)PS1r6xO-`pu>)ftf(bdDZ zU8NpSsRz)0Wm*-zS0#3+#12XvFoo||g|&MGk5BtZe8HCp7+t8R)_!!1v$t_TI0Atdk2sglI(6#;PKMxbQC z?#XP19SK0AREn84o?azW;G3O$XjYk`fc<*|>|c|x80VYQtajKRp$jc>Uzr`+kQ0<` zAH7pysXZ@cYfmUE=gaetpZ&-a;P7&rr_S}2-eP-cC8gErJZN5*v>ddN+v@j$yW7j&1-%RJ^eS{8v z;-mUA!7x1}7l))8pti)R@vzl>2|yWVu`J-B@iqdCSHK^%#9$Axl9O;?$6NGd?lU)q z(U-9^5btt~X+19+PdxlChqIYuaG6N#nnvC`svMk&OE6{9s_T-Z%-lWI(hEY7D_y}A zhx!YcK$s5&EI@*0%=EzdZrz3XWY;zcH_+8l>b)bpz2WQ31g5F`szDOg-f~l(0PeTa9@iTb0;`Kn`40wTg zHPA(8yBN4IwQ=a_cU=`Qr@N)mYt{J(B%wZX{5DDHLvT{6rvwG;R-UMg>+}ABT=i?~9b$fl;%3-Z9 zJf#DZcRPcFgV-&{=G%~Oqym0mz2`0 zRC1z^-j47}Q%+YYGwhY1M)S#`LW!tk+#N3A+}7FClp`~Rw}Et2t5<|4tskam5|~A! z2PpVM|LO#U)s^>%QD4?;71lcohR{9Ww3=Q$z|T+QiaA`nwo8W{b*BWR9&~IJ*BvV! z$5evbCPoEN^iu^MUTo~=u+P7-10MX>kAi53Le$M!-BbCPHmk6RIfeglvXaEjX)@#56;b*-3>DSMYs8urweqOUAn4(=53q5WCqUOpD zB%dn46})ikVX0-d7gVOebW4)~bA+xAFk~Xo9I(HD4xQQw0Fk&9$e}hhfs_Yjq^=w^ zCz48s**J+N!)zp+!>L292D8ytXl*bL_EjTl3e8n1Ds0`JrB>a%@utSi<|xq*>UG%V zszX(!{Z^>d37v|JOs}J9LqEK&Yv#MTL@lZE(jk)_&+l1j!57+80+8R%`|C^_N=(yG zVkX&|L4DtQ;PDjQ`v$j*qYj1Ubt`o>_&0FTqFOB(-xagnG{QA029+CJXOid+Vb!gj zm&T$YCeWP|SI&d@Iv}5`3v+84amw1Lm6ZTZwnRu6rVl%4?#l}f0X-*2J%0dt4(b!w z$wtqj5tdahf_Oa^X;cpk2?T_}-O$=et}x;b$tokC(CY!J^1lC%KS+N{RVINL6D<cA%e-6NoCP#%!SZ1D)}LFR>t36m!y{9TiwBfZ zYKC_R^Qzx`euZToJ>5Y`NU}}Ti3}1O7pZ?24164%8fx*3fPkz9%f&2hzFr;7eI?~oEVw0Vqit-sVyYS z6I{>E&t2koxGv7}Tkfb)rVZ^~dU{S}=UmUuQ6~`Tue$W*xbyVFGpL4ohmOsIPvv*M zF0U>;L;NjuT{;VpAf{C@o95Y6v zqo>8R%-bQT@Rj~Y2Ke26?GjQfSTjjY63*|XSk61rg_SEu~wRtV#5E!#~ zrgc^rG1Vx0{rt+6OXXR@W2km~Wo>==IYwBm*m)WKf3Oq$>9evF4lnbXvm(p? z)G7->)Gy>+xs0rs!i#9(DV#({<>!~5!*HfB3_ZP6WB1zn?1d%FHtm~Ns zE8S=V99OY*n?-<93QPnx7sHFs?%Ly{O|KxSG(JWe$K;?hKKmS|m}VOTK`W9`1cNHQV|jU?khVr(oxDv7croT6qPTf2${cbo)8 z`Yqs>f)@2*HM8Mgh;wi4dRVnR;!e5j5T!*BO=wY#l2Z7dC*1s0|4Rq`oko9j#@0rO zb#XfHZoeiwt%ebsbSI&rZB-?a?6VXwmwC`lWJ-Zpx)G&OY!@{$l*5Z}Jx(u^FH?Vt zSY%(rPeJ=nWf2`wQD@uQweNZd41F&z|Gpe4&t?N~59-0%R0wg+@o| zE*k8P(dnYxrKmU-1AV??;}-kOSNOccE>q*u(T^)=zhZ?LW38!pNVbMM_k~!vybrO(2+i{^YDi6>ZOx6>ZN{s}&E|4XZ1d2`kOoGX6})LDfX3 z{}YN~GzvXda0b(Ct(Z@*-?f^vUd!3~e@D$3)N-n|n92pzoB?}=ueQ+q6!gA)o0Wfq z9H{~IJvywWFxO-Hmu{+Sv7pa~X5ML)U;qA1^By+TfKxbAgLA@i(uM(pzU5*Ae5iw} ze3K9T@hg#Q?EDwHTVbJBH*+$-OTO}x^2E1&!=`;>r+-JM@#9x_;z^H*bJWmL4;)(C ztI4CN)D7$?9jF2=RhXtu?*H0d<16c-3Rr62U^^y(x(7~q$^+BP_b3VTtmGR$7XI$E ztgT%W(|j3|v32aKyu&-hFy=U29`+b`@}Uuz)VJ~+m@>ye*-0=$H{f6|DiLaY_QL84 z#M2A2&>O%iK<@jjg&;|4j^w&2h)*z)LF}A;W@Q0ycC-14v_K>^Lb$r*T)DLH(JQ#2 zj3Vctc3?vl$)L~9;x!^H@vB^Gb(H+|{OQ(~e3aoEh|V=mCbkg&f_P4epgM9F;m{OP={tqQ N`W%fV(N;3n|1Yb}wyppG literal 42804 zcmdUYdvILWdEa6IQ8Y}!3kabpn4zy>iUJV=!alG7Va3@6u;4DR*bCtykrFKkhF7;bI%19l;q~0(lYLO-E+_5JLmkq*V&HY+(@C6>l!H(b6thfi0_@6$PSHV zFXX)TLTNfTSu9LVw0ox}bJ^kP>|k+U@?dr<=f!)@Ha2!p4MQk4og4Pr6MbFdbL(A+ zo>8BrBS-i47xBl!W@p55W z{&p38e{8Dz6Nyyftk>9{=y7U{52O+Uz43PM%KE&ma{k9}tZ&>u;H|E0E-bD-NscB62ID%9Nb9L5>{BnIH(vbN;1phKe=d%bb59gkEm)?T}pK;AeW z39o$+RH>6UGCn;uksIpXKXqoJLerv!F)=fBkw{b~rnxRsW5jf*W6LX19$GG9X2Xp% z$k1{j9@_pMGhC^pH#IW|vM7`;cxLRrL5UGHHS|P<<&Lr!@NCh5n=CcqA|? z7_Zf__mijyBVk9sdt}ld?;i030#-_7nxu5}d;>kNdy)v@qvcF%q*7jLJyO9K z$Y6X!9+iCNDJsGw)*5vpb)3HUVt)DchFHbPh`KqEa0Lx{BDtRP9<^a&(x3496G6Ba zBVy817!ngs#=XmhVlj6iTkOtGUhuGYavnw~-jnjC3XkQy{_|d8I$JCZd3~sb)@VBE z4f@4luNPmScoJXDju(oTyp;D-4fS@grY}w8KK@gv%aT&=;UQkPX7yvyqbUhq^%RQp zD(5oT7_iDY7(eUP6{AE=yuhoGtUjBgb(!qmZvFGyb@6;*@78es4`@hlQ-W6r!mW9E zA!?rAqau;-=Xu*G@Lx&#ADP#VcuRW=ds%(%amjy!ci&6pW)};?QEucBwIbQce@|O zHBX*_h#%JRxox zrmwFjNcGY}R$RpEb#s#aPBAPVO9xn(HtbTvRCYXffF3aI_yP{~naSMLVdN0K338|( zY;La0*Y7qg#_BGWWzp>XNW~CIu(}Mn1Sxyl(H?!F^F5Z26yEPA>i+2ceWLEm@Bb4^ z`ibM(izC|CBYWF*C0pIcbWjWt%Q-0&je_@UC7x7bXj)1sVQ)v?sZpJfvsTBEz3s@q z+gF`ZxRg>d-;Qh@tWJqszbll!9r;9H z_cGnz`z7c2=iT9}3$c9k;`aAHAL&TP`@P)cq(AAUiOA)IPxr`5;GMVE-Fg$fvZgpE zk#siV1a?@v6UY10P6T)$$kBDh6%dlJIXJ{^*xli2Kh_-{%dPi3UZHKex4%DFhhDGQ z&3m!D?eYW?Q6Scv>T{D*p+Z0xGo?Xbu`vedz2Vi4u?Q+mVV{{P4HK*{<-Am%vlnw%n zBzzXU2Y4`*13xi6;S)Sf#@+5GF;zj?#Q79Z>m!A!0&ypaez$1}e9!o{u$-Ko4Z*JAQxw^c%_ROkxZGLX^=K8$1cFnuGFtJ zar(!i*>ckRl|1)q>wZR1J15MUqR-=;`!iV{nCh`hgHr6i{2-4|_4wZJ2zuvo&n-Vz z$rlDkj}bCkV311v18=H*0KU9TEWhlj*!e<;G=*I4c7EEQ7y|9@OK^t{^e>B;=$y!( zS2RVi*nfGicga#Y)E1)Y1ff!fUHi^DAHrMCpu6qHG zqyTFFv?`O^N1M<@32+BfljaD|mOnBwm7C`2D&-yxD3C({y}x=Cj6`#fFqnF99o1)} z9)|=Hzs^VGXZi2J^XRAWL8kaAvxn zGXV^oOdJH935K8E44ttF$O?EXPhi`3-XX{#>|GqfgCK)WA*zg^3o46;PJnp&ykvq| zq)eOy&YLN`L2m+8P-emvc96(|GjRe_W{=w#V42`R3gH>R89D62aOS)@Jwpx9@5|>y zUk~977uL|$(C2kbO<%&9KQo10okW*_0l7)+Pv$GqgrJE5@(GZQMJ_Ic(h=tI4-kuN zOoB)(;y7!Lv~hnJN6WsGfM|+0m!X--OT4upa1mR6$|D3u;?qlrLG(ldG=y+G2%j}I zot>Pfk`QU2Bo4s8z|nBm!XU2&eGJJSA8D?SN|5)ATb}ov3ULRw&IYfn)c?nKeTO#3TOF(KyfbLu z`@mahlzz66nmuseA`*f z4r;*xw@+@y=OIy>fj(Yj0*I?F!{~vD&SJ0I15Xn9qXMM98=XTW24KoSRXY1@EswKR8~Ve7TE)y)CV0S-e4kfLG+7t3*> zkrI|>+zSDPVC4E3tMXv*7!Y8+{ef&|C7Sv;_<;#V)KUXQVKy?;)nfEcqFSpvBME@dVTuXWB^&=hxz^_MRl~*#77ONiH`eVr70w8;U z2C&bRM6;D35w=}ij`$gpgz$hF(hLTy1H9-#c`U>hL51$5(TGC*Ha?Z@ezY(=ou4vN zS`x*QUZ$kUG@dkQI-v9h#%~-$5M8Ykn734Byx;t>=*l}wFMoTq@Ry&<$MU1)Y=#ep z=K8zF^dOPvN&^p9@y$OT|D(vgqswnRw)L+dY5`rMRdi;J6fRD9kc0?P(137bu)lfP z$;m9SjNtA$H~}ex2>}$0XNyH5TPuXF$$%;4Kmg81`V`b)!#N+_1{%SVJ=he63L5K|7~a5c?w;0 zMlODdx3s)}uB~nMoGL>exGbr~a4L}eT zC$t{FO%vKo!pWWcq{zvi9hGm6YF75viNW$OS2N{r`RAB)x!G5u6)r!fta5~7od2f0 zSlDebdHy*89JAfp$WQ6>3Df8%6Ns5Wj|sGxfM)`&CUD9Gj+;Qc37qEkWKPbWF)5uU zrGs}Z+55_VH>s_Ptqm2wJLm$3_GS~6vY+_e@@JMvJyjz=h5VG{M=Dn$<2xUg-Emyr z=NxQ`rJWB8U@ST5*e3m^ofDGbH#s>CUd4~uoS2)_Q}J7DPK%QhjZ}Qk=6Fud5xmoG zbK0GpC~|sij%o>{&1hTe7qw}vQ0e)nz9g|F|I}L)KVx!Fw;rwd9VXV<+F0?A@BEMy zmcP{_{_!_jk7RKArbrTt?UZ@P6gaaWLi>$52NJ-Ny5m!UAxME(o@h%G|5odyNI+n1 z-vGC zd1H{60;jH8&lIq!5YRCZ2$o4eU>QU&33eplHDe{DMBZwNV##CnIb)U2tndO^#{X3Y(HtKfz0_y+7{JC8)-6GOb|^IUNt1^;(_T& z2*!)Bcj?Yf4HXJhCV)N|bYhEfHVP0J^1%lp0^%$Vn}|7sDFa7d?orJ^S4;?mXM}w? zvQZ^43pB6Hs)Ktfs&Ei5@PWxfVLG@+U_L^}Hccl?97ueqa75qe^~SS6G^h@l5EoNt z5W-d<3_hAf7?@7)Au*yU`P@$$5@P%Je$eu{gSbV-e|Jr4umbNs;Jh zmRr#{Klb@@^~isD9<6MRRz}DCmgBpbG476Fe}j5?&`8cGczE^%&dd{Z=9ciDFd1!r zOWSNqU9|OBWjpfnQgi%---!lyR?z8A>GZj;ZAZT1L|5K<`_`ZM=lFXHOJ=+GZdLuB z-yD@nXL~9czsK)<^ZGk)`rYrNfo*7DTkQtUo~uv*5Q1#a!O`RHi&egwkC95kEykcfn6dUs61oeo9`B@T-0r z!{;YtBu=4ur>J>;8UyGjxV(;FOSCmZeD8bv^eKNpJ}nXle?UGx5c>2(^yz;2G}t@e z<4-?CpYGrH=@h^T%r2O+7Ghk>W7T6pTPmZkMe0|M?7gu4xBu4HK|#1`hlR%PZz|h= z`_CdB{W#4O0$4^J+znI~R)k^G?N;aYgLT*s9QtqoTVz2;^!{pt*V8y&_rIRT>1to^ z1u_t}Y;vMV@A0133sLjomG+Y5k-S9v5Q7;yfo-LvDAocKL(~3H9?Ie#FIObRuw|TC z!q8os&fBl1z`&W;Nc<4WOa?uvF-%Daj`uey2~N^Bi8T55-_KiZ7nwG7m1f2VbCAYC z{N?sMfo=ct$YVJ&!b=#!q^0i1Y>Kd^zlXH{tg!6^ zQVWQn4?2b#FsBcaquO6%NT^@ygRCv6Dh;)Xej^>ilxa|Rjc=qOpRfImG@Y;djWobQ z@C~wm)o=6y-Z>cn5;eY&!VFy2kI;GVB|&UjK@xdE1<6#rRs|$e4OI{aA0NC0i^M~^ z5Nb6Y(K11>~AcC$sPPUid<=^ zWL`VRW;%;|znu~L*-B>l^>dL*cJOVKehy}8-ObVHXmPPIDXiQh z$8bSTrsdb0aJCk>*w!aj?%CVvD=fb$dDTYAl}}Iw9~r#<&Kqa|ir_zfNs3km3va(z zSbpQu){FO|DFczpGFi@LvMSss4Rj*dF2}QzW6;2ta#P*Ig~@4fRIv2W6*dekJe}i( zF$J|Vlzp;c0VA8lV3T6`Xf8K4Sb)k3jEt6r-Q)#`%4K!M0h%?PibH5a!sdzTNeFlB z7CoeDZdidF+*C;!R=b9PIefHG8ulOUo-Ry7QAK;DY(=0Vcb~A*uo^p|m7X0Qw@PEDCTcQB@%QVc<)7kOe;6KsfStPZkg|UZ1~Izk6Jy9vKyWJkr+sNG4YI za%Pn0ZpRzjZ5WLeqW7uU)~Hjivi0YM$D>={0jF%wDPu^AUV$$$jp!vAsF-xHEM9`x zB{bDtNw(hr&tm>=))AQu{ebr`wPe%V;qGH%`!EDNRm=QU@dz8%<%fbzl@L zJdW*K*GY|ej)Q02pBwDev~wSx8?3V$71Jpqi`Hfa^@1WbbHpCqAV|`To9T)}FKxp> z6*df1W5bXv1mR$Q!5N!mkcDhGke^Ec8;=CAA7}tn&iWY~kLJCaBr;N*naX$1lpw$u z4qF}dTWcfKB^+k3mPkk(^gT>Ye+4kC2%&S{}W#8!tzk_cdeCG@D4s;rp zMnYsjc7DcbAweiioGx&dxafnlxxuK$-AxX-&&(r8!MqNv6_f|Swd7z5gbnbLwvI3@ z2vLhbLAMD23aHd*n$2g~r~r0o1UiuCPY&fj&d4LIvJ{MhLt+ssOZD6#IRkS@w;mO1 zvKI!oerWK^nZY4u^_aDMK3{FSq262k=lD5Y?KJSmDZn!1TaqQ!u(p!|fZgF8SZgtC@qA+s|q?jQ#; zx?*kw8hs~`k0kjP>EE0orqdN8NW-YkQ~P%1`M|;EN+ipgl^3#Gr9;5m=fMGQ#mT(y z*2hiRd$YSA)Sb2MvpoK?`yP=EwR()xu%8Ct=MY0TkenSyHq#^9DA%(j03xB0gLE($ zAJC_vC9ncPI`~&R2F`dv8tM!eFfR`)K@^r$V>ZXhXajLR(nupl6iHGwc|t%aeg-OS zW6_#aNjfnI_)H{d7!kLjXMT;Q$&}OtDQ)PyuIZk@z!G#`jb2&;w;%cI!d>+*iSG$w z|0}y72Bm}gZ0>2u{!+Q_<+0tnM;F>IKR0^jl_<8v|6OcZE;sicljXA8uyuo{Y_=65 zuh!}@zllNh&a{90){iVgbcRJUdtyPrcRoPtc}45+F#=lmTL^F?3e;uV7-dc&NxBokLT_XUme7uS3_yft4?A_V*l)KIIv>bkLNH5$c5y+hI5Z~N zhk~?C=GLC+b66Y(O|#h}6eI!p>h=#24t92@gu+^Ug-4GU0cqAO{|~kp zW)vh>>GDUqq;*K^4YYlTrL0W|G)Rt32%!Mh{-F$;b+L{L5z)}9feALnK(B|R42C3D z35aN)qd7yA&1%IMMAe2!6ir>AGD8xyTE>@EzMvEMsA`-}TCvfvYLQkMc3@l8@ zU5AZKj7tvNnOL76(pkwg$&4F&6LHE38J)1o5JMpPI(*Lv;lemm4tm;P%uy`R$Q-$M zd1r#1*E7#e3oN*_XHLp2_lpe&A(&ep{cf=<_@J{H{J<)hCv( z3B_#axDB=1P>T(nv7r+-blQg6Z0Mv7wcF4s8}e-EoS2(rPtJDRw1iFTsT9O$rQmnK ze5RuUqcy+nH~o{p0o#Wu$J#}5{gZ0`a#D+<)I&Tpe*4xr#*DXqe^j0?i@Q7H3OV~1 zVq@~LF@3xE1%9{qi~gzGqSuhRHE<0E; ziP70n6R!A!q%euRlxNM+N5$|F>KS!TIX2r5eN8`9c$#ozb^r+jWWJH+daIGyhmi6R zOgPH^2uwG$ifBbqRF$=%(SNQ76G5y6$%6Wk`?&YD?dUY6n{SAl=5};9=X6{vLx zkelr!X>RmBf0+B_cVZN5ICxK5Z0&hW;o1cvmGPYuTFC)>9+Pp-oq13geUbn@Wdok+stx>lq?CMfq@x{!r_Zy z(-eloKEo!>gmF0eK57N<)&~CyX(aRw-4pl&a|K)(K_YYPh&BI_x>hpj$Af!qXK1#_?{z#3NUDbh#7;umbV}dZ`D{(X#r8 zLXzo5Lz=jF51QrXx)yDC7n(j)c^*(WD0CiEONpU+&!e}L2%(Qt617nxCOb&%7wfhD zkmFH5SW1-a4-G>&Mgx+UgGp+xjsCY)wW=SG9B6uXJ_o)cTCcRbR;Ds?V5Q z^@T<_jS;P(=uBgxSq7C3O>r9fC-k8gwrQN(OAfpi=JtlllIlJnj$Xjnfg-u!;x3t9 z`XrO7Qh)9dn6Ak+ATY24#n?Ji7(*upagh*K3d`0>hoj4&e_;knYuI?Dj019#Z0IN@ z31>ICf&`LtqJP&Z1;fNEpH!+ai97E=b1REwj~rgS^8Cit^~D>TYwO*C%WOz?hwaxmz_PU)O)l{b$`Hto zj}(YA{3$%KbLB3O=M*sp=t5XDTDJxOX*3LNa6(Y<*iy&9vU;Ssu70d;EQB|gS1Vx!nZF`Hf2(_6{FKJO zAo;(*HSgWNo1afO^~^Sn-xmL=aeQw!RuTYT@?#W(3`F^XCP{eCkKO)Y#*YcQjES4p zB4bV#uqQz&HO?qV)Ff3VoWKMOT4%uYrZoWaX<}x3mYUJ@E3S;q2rv`1*ct za{j5CD|71zCwQaQ{XBtXIk>h`zTYcsg2bk_aH|uWp(A?%e{%u1ACR}K^u%>Z!$C@0 zF;%I%FH3|}RgBHkNKIf1?L;smRse58vaoS`*u={G+{V1R!+RTRaA@0{|M5+4bIrTH zR$jdJEZs5&SGN&zaSN8Y0bkjk9-MPV20^-a+0nAYw8^tXYI9U|O8?I)SvHJ;J8b1yvC)5uEITu?NB2 zDQY%k64Y#I$4D`IffD0hCnj+ymm6mPLoP_TDcoLcUV#o+r5e&Z(wkCCxSRW{8iAzj zPL0Aa{9HpcQlI^5CI(eKFZ}7YMc$`o+M4U@Mfsr2)$RIxOWp3{gPfh^p?YBV9&r=l z5q$p{!j8xe!5TOS5)W<=q{UPaOTMVoU5pu|OAgG(S!B}#NxYdOCM`@Jksq&gGLzu| z4E`7=kflBC1;Ggq9Axaf(q{fazwX?)Ge@g{Jo(%4KVV3DfPZKonxnJs+TyAnbXWrC zy^f*cfLvzL?Np~U1Ltjp=hl!zNQ~y)sL$o@GZUlh&qg9-P@{L9eNxY#m|B{|*lerr zflSrQRy~QdWvcDjYP&@4$y8gi)fS0FGSw5=>IsfS{xVZ-%U0VY^4~JAwc)U%d&cA` z$**Usr?b`568Zg1^<=hsQX;#V>Zxq?ltjLnd94HP*7UYKCHZriYG=0EDUr`+s%Ns* zGj#D8ZgHzdn6PeN$BCP*MkVrOrrMCLiaX%#DY@oMaz^A{Gl`s+i_9c)E>k_0tsaxe zM>Eyq+3NA{-9DbFwq~oX-@A?OH)X3$oQ>t5#Fm+(3mD1hg`6I84`cblK$D+9zWl_- z$WO2_`~-IAC$JTsv~OTLGD>t3HqG^MpRz^m$UBr}XK4k@upXug13DS>&K*w7ih;S@)kx0WhtVL?y6Y?h@EgFtPN0dcovnC5#cN?br1~fhHG$8IYfNr6(Wnf-x!?fp`ccELdVY-;Wq=WUg zVL%%jhA_j1=^6x69;(+M9K1_TM_L5S*+Lm8KrG&Y386_xpM!LaGBcpG(Ze>r1N+0U z7oUO+<;XO|JQrZr=>%E*q{+O-VHLveIX;9-WKXDZvMe=W@?yqqQ*_-ct~H)g-jNt6 zQ3?e-CY}9-Z1JL}flD5NIN}WXNlGf*mOPjPILfig3bE`6T(`Zve0MCDoACG#YKNE7 z#3isxxUUSh!b5&>X1o-fLTK$&F4(8!HY%es6VZt@4~++)0n_QU81axw3+KCV#K^#= zg>FC{$*@vbby|?mC{?0b zfb?rThZ={K5hhk67$Tiu(yZ}JlTu9_sI!j{Kir3lCP<)2oH5Z529fOUaPKV<8A7<@ z1%WI=xB>wo@*~GEu(A{_65$T9%u3lIB|Y=dh7E@^*w3A%(}ndt@Yp6F?Y$pv{>=RX z2_Lwq&rA9=F4x8d`?98giuY%@99wT>0h~y&&e889iL5W`!aG%4~#%AiRZHgAm> z4`vwn{Eid;niGa$AQvZ-pnu>umA|$fd0rC!DPj^boc=Y5-nw)krzkn!G?j_&ZL61) zSr~EqSPb5BQU>!anm*?gU! zkG9PgD}HJB1AcL#ZFb^$zj$W0M0T71)t_i-do{azH}f1&&hgV1Tkk88{7Yr7FAs%O z;UxjH1@f2E@F=7sV;UZVdZno0A~ZJR8Xkvaq@>{zT<`oQ<89s43em-J6KjD;#Xn(U zt*xgjew&G%Z1v#7ZDL+)J3P3p=eMg^YJ=kJv?3P|Y7i<_n!G?hlY#5xH4MTNf z!hIxIG3PGinl=m&0#wllErm^j4AX|e$=NXWRvRW~U#%_;X^{<+;>V-|TiGx?&1{(T zL8c7O5*sGg(4<46WWv3GYY>!Zls4Uu{}ir9H3AnE&2-!1IAm-XOeP=XDIg-2ny1hx z11?f%lntZPLlA`HvJEJMaB+)7a3>*TT=*N;9Xf?0V-iws_*%emqt_dqnVK$)6!20K zkYp6nZu~_WdnY-W5YOA{$q`(QV;~gcW+l~rQej3CV9q(i6ZnuE+6jC_LuAlu&g%q( zQ9%TA=|tp^2UdaO3@}_sN*+WoXnIPMm9q(A_ylBuA`Lnr`y?C2EI7wBDV*FWKrJ83 zBs7!&E>v~#4++Q>D#?*eGV*YO9Ow?1BEf+c(Q_Q6ZH{HqSm+52Z#X`n(I$Rk;$5f* zeIG=VAtVT`moIYSXr5WYHr25fg4hvTA#bI;C=e$T$%2i(k)}Z!wc9FblT80Pz1C5lppcf#Z zp(;HgB!MmHh(k=k9T+6CYSLUoQOF=E4`ENuv4nuEl$mtRvq+AB46a7NMGBhZ&=|6M zy!;SZyfKUfh(iQ-;<10e(2i#Hxs(G$lnxOJ5_%oH2P#p#hk3xb7`z95-^8?9Hb1g> z4?G+4LwL_wD?nc%oC{PL#)8;P0xXCnX|W(U6Q(gnlp#xFq$DgNgzUsmQ;ZS*9n^zSYe&CX|=4i0{gBrwp@p` z*6Orr=WJSF%ayWeJ+@rJrloCKzfBvkX%E@7PujGMO&hdn!!|9jT^qHzMVni)X%jYW z#HQtKn)|LXX1`Q!&L;gQ1Vu)6@7k{WGY-!_Suv^6*=r_T@t>q3zh8~{P(;Bhj(Lz5 z{U>22^%eg~Bwrzo+|N*O_KJebD=gldEmy`~^vh#FmPI^^K$YWojssDa@GOzBPSY3s zGH!B!^-l|hVuavYDb&g)K(GKlL9r8rBRvY8Bn;V3p;Lq(PgCeLp}8{@IzvdVgF>Bz zC(lu+o3LbR=kFmXOvT>L_2sSQa@`J)-SN8FNw}{(;7{IFzuSiBZWHw+fY@pO_|{nl z?K^+Ey!EF*+tYRaG|=`!#a{y2UI5x&dEQ?*GrJ^cdj&T|9IxPG$AN^m-x*wboe*n+ zTGB&kwVy(1>gPkhhR^^TCv~8E8Or!%E8ZQZ&>+FrB85f?kWNsjL|`;ep%H?!MO45o zl_F)4A!6A5C;c*w*pp@d8tmU9|FUxLeiJqzxEYat)(I`9?4s(4_ z18`$0Wuk-X(6Ig2--7kkliT0_G^vdOD<z_#giPy4V4K$i;{yGnV~~Vj5x`w-09tgeLeUbm*VtPzR$)tN zx+%g~bN2#z1Uv|tNd<^PPXNf>G|`$L1$9A@YP+v)R4k7pr!1ULq{k0gD3ObWm0$sz zsqG3>!mPE_PsV$IO*cGE2c8bUi1C#TR?69fctz!tF! zZWMfjyqyHAs3CNhc@(-~$^dJ+UCM@mo-I&Mq9;KFUAALSDw7}r)ZrlUB-kk@N(vRm zPYHZm0vI(Hn3LTZfB?a6!Bz=0BAkGRXoAA41X{B%1x*S#5e$V!F2aBw5rt3WDP+Sm z7$iuIV=yFumIx1m7C3!~-p_&N@P)p8vNiDwTukdPgs>=dLF7GElhtD)6@j@5p(@96mDrE*)WdEzeI zyb=9wc^voGj%P%=cWLzT=Gc+K)`$7{eu6!nzcjW~svddkjaN$5#@+vpdspAO+#I{R zu=T@&&YCJkI4m7`<2$$!iyWh0WcQ^%yLYTe_umJHnX0$2`309v;G~j1V0+_$L&8{* z!Mq!j5ZcT>P7H@>pIFO0Jfv|PrS^9OL? z%;3V}dT|(mEtxncz=BNfbZTzCt0>T|?YqljpVj=aqs=`Z%x<*-xdBGC0EREnpR*siKARo%rXh2gy8Kp zuV!;>UA1ztp6Ex4!Y-g>*vgKdbX%xtF&VJQT1-H+qag@KB}C4G8p5%sA((2Jw{h}n zkXLZH>t^x7K#3NXE>ZbC0W&}cty%s(JpXI{dfSKfx(}GE2tl@dZ@car0_2Tk9=0Nq z7kz69KVJ582Y&f0_mBYoNYwwtGU9x8spzIxmYS-WPp?`>`9 zn|i@6?0uwBC-B*=N9?O7%&Tph-$waqefg9qW{gP?*I?{|4*PwyzfIs+z*-UWC-Qp` zeFP{c1&2!maZ--$453&T9i~8frW^rT8wPr_crOW=w9UZPH#SUbQv}x+Ayy0kd=fH7 zTWG%=m==xAbd&?MJ?#UXXoM-5aMTfGI?gzo{8eoM=lh9$5HjIdc#s#2eFqy9uNz3@ z$e9=a9dbb!-mv>b%yCE05_fbWaY*I`5evrgr6iN23bHmMOJl({?1n*#6IkIzRWf=71*54l!krxDh<+{ zTL56O7)S*SCrL1kdoRH)c3EImxY_l*$R85m(lyd3rzh;@ny2p8G`MtceS#OrtMq%6 zTMv?fP^nzl`*I}%QInjssY(g1-Vi(;t9-Y(dmSd%mjSzu?k-3rV~}o`+p+8>a{FHW zf=Ow3bNMat@{?v%MtQZ0)I;z1tmyH7uetqX{LFW@M1%V({fOZ^vyf$wkG7n%u3R9v z-N>9?aZ)5oK_lP5`qmWi?BLsrI@FGIBYbuf0qPqEq!xilAaDUQznK;s>w()8NX9v^ zKzCxg3u_D2h`OF9fpv5^6%})r!l}@U9Zba*a4-?N3_V3_y;38MPfi^ICQeJVhJSgypL(}Wzb~(KdgIYbPQ;ZE@XX7iY(Nk zIDNZ;oFYPmR&WSSuk5Q71nXHs)6e0~-(LcWL0hC6KsrG!IU!QT&DogOq%9Z%`-^d+otQ>~=~QwWx-v zPE7FMg+#ayETSP77sXhx4;q4D8R$Wz5e&Er>hvGDl4ZK+TbF9-+6)DJQm>}m;r^b)|`LJ zT8EQ_MdpXBL#+xNIc$4!PJ7tEh8n=GJ`!s&GVIzuKiZr|(;PtZgZ?38g=gJExS@fk z2gZ){ne8J`4$}|7$Gr~rK2f)nkmrhexR5nqs9S+kjP2Igq1{?(pwa!oI(NQC=SazX zr_N!cZ=Zhl#=JMR_!FjwX&mtVu$qI~6CDPg0%HY$1E2@$Or`^K$Lz#J@lrQ~4@W{{ zRt-UeLaB>3XO=2h=_<<>Y>f1r5HA3J(QmP50}r6I%SQpclgm0bzNw&e$~nm>KF`T!jLcE0+A8d|-)@c89VJpt%Z z*twvd;XSvTO^7$=YU|~f3dQ4}`uyUn<6HL^#3C!Y`;kI9nc4e_IE4IaCYxWWFMO!! z`NdZ<`01$nogdQq73qQae_a~8)n58arXas|)W*NLRr$qmoPHFQgsr+|V_d;<(=c+k z#nzO565ukX1s>y=Hc&Rmoi+^MGVBXe@ZI!bBNMQrv~}X{RKDmIv`*Z8CvOovZ9MSs zwHeCiIw1&79GXXhVSNwYWs|VZp;Q6jqE z&5(O$x&AA>rwGmQ-^cU6of&iKZH(wE02D%Bw(Uw^V0tWlVOlMDk;^+%7si&Z{W^47 zumvBM2Xtum4u?5&EZ!j_H3i5WSuM~ERy7+D*kL1WflF6yYGw+6gf&C~E}ik_!&6Ue zOt46JpW&?u`%H@N49u24&!bOwJm0=|ftRlMeq>so$iz6F;lJ=hrMd6~$}asTb?5unyh79W5x;*O0EHmTt2?)-ubLxY7gHxz#_or4|w9sB0p zp>F|IhWiD_f;;zXUpwDlyE||#G%hn3!u=b3`v!Npi?>OnO<`OoC$bMeEJG2bdmSB} z-X}icHMURPym4b~9sYuA>mKgyTX%lH-0L7m`E%YPyA(fo1^&Y4yp5Yz9^ANjV}4z{ z=NDI>I_J%AUOkJSL@ztmeJmL9I(}wy<|`(Lx=<)(0Vt3M`m?Vz;tKgJzj9&j>cX5U ze*xesONI0ED^JgFE?%`c@LtDn<`#xHcN)~OalbdYc0H(Zx-g!bf}1zh%KtE0G^6f_ z+JV7O7W(uVH#3+>t7*`Vcepp#1-E20iUwUTp0jsbursjw|Js`|0Oa&G4TxxRlf;rb z7k0>H9dc0z+HU7LU;+2du+89sWhOS@tM-+(8C>&)BHYA^+;1f&g{b2EFXUj7?2zad zY|Q7+TJv(WC9vqg@mp*ZcNOyKS}8l+c>D1LFKxs_p~kR|Cwx;M}4q-w$Mv zW;Dszg130j>==jKfGibYnc1J@mJ}!uq(^2iI`Ct!rs6=zY1&6F#0P%kR_mcW9e4d% zR?QF;9E<`%G8!8hL}yntzYY`n-80k58ox7wN_3AlE#6l{z}nHIIbX7-V767Jhc+i5 zS5vvoA~$Vq*1^l@@gY84+b3>bq02aM_N_0@ZxA(517r?#0woe$vn_ELBS^kP?e)0f zE}-SX_2AkXdCfEpbWG>NSvn9Mf+gECvBH;gIz+I}7zNh>1kF4+C^ES=U057>!6v$- z8zgEoDM1WW%*Zw3#*TIG`rI<`MSv>0q_uz`zz~}^Hy77dH*k56JE|coj*wb7yk;BQ zN#yOF@$!osxB}=|uZX9&v3c{_HB+HB&e7YrDYg^)>z$l`dT|3S>jL&!23%rzwXe>Q zEOmbc*>V{O=*qL+vvXH&c3=DPbBxWVX5e(09iEwB--@-Hn+%0)y&+NA{ta=TBrVuu z!^gkfYQrsRpW1wOWxi`;VSXMX6z-2%7a<1>Vw z!T>#>mQKz-C~XlH9xfY(gVNeH&s$qx1Re#>0Cre^ko0%}j&x5LE{xfrZUTCSbGkiT zo?&{vZk$13&?fLJ;a+5~&u?IOo>`b*^>7CcNEe8eYm{+At#l=}6z5XU z%+sfk7|^%0<(&7_;?t;xT8D-$0NgIjJ&j`Pi%%0MrUq)&f^-$h>loCK9HDu{k1k&G zo|%7OecoGLLyuOyIsSzC!bYtRoWqDw@2E>gP|zU*^|7-|m)t&TD)dM;9)$$zepQv_xZDVugS+EWZ ziyIHDtaw-Exo0#7(kWsxusN(gRcmMh(sLO{bPrTO%O4bSV{LJDlh}<7YPJxayav{1 zjrw;L(DDBE8)*Oi?cVDAGcpw(PxFSiCewdyojE6J7s{^PKv4|gb$sC(E-OOiS5}@y zcc#$|GrUw|*T&}D)n$z2syBb_+Wgf`Gm_X1YAt|sW(kECi%^-o5MEu(8SO{6(mz`C zN=cLBV_Y<-+PzZA@A&X zP+2ql7C@E_cn#NMM9OG`GDeK}aU;V1C*92C)%s%!HrC4AmuAWy_N3x89+pWn?SsT$ z-(i$slcDhSaiM2!5-$Z9DRoF{2h~4V0LR(w_3!~=D@x&j4l?8E#ye#v6L-o@^@np4 zp{m2*Z6y2F8a+tg;T^mZZfp2+;aq8IV=y-1>^rwL4h4`quHl~SABBY1=(cNr)lh8K z=qMCVHIr*kEVNUNHH(L*4`WOX7b>DoG(t9^@{1ajKQdDqqU*^FShj-|2siGqh5|v% zyR0B>xaseKr|H>&jCXsH7umZNGWiF-!f)5AA{fGs4s))$vt`oUsWNG)M$-$-gGqEr z-K4oxVbVf0VH0b8rV#|89do_|*=CKzT3>=O*};;KU6-FRzQSqX2t0R)H4S^2sK}g#9FO@*5qKxM(BtSrXums2Jg$09l`Vlc6v2xbJl1; zLaCaoP%ENd?^}bK^PW~sDcXw<{d`JC&)@ zF&`4D{+-KIA*FSNsxoFjwtvuAm>M4L;CKjRskMcu??Z;#_2J_LGDx&uf-eE6MEQa7xvT4IK>k9xf&G&!WeA>j?NK;RTsy_>6xpT3D3St)TIJT$9nh@pCB4!1GWg{^bT#A<-I zo}+7A*XLF@z+OO-BCOod@FZG}|BLm7wl`=DnhRkib`kJGZW|%@A_1((#X77Ar||F$ zgrb3T5ZjX~oh%K4<)_BlFVVnwvzS?#EQ*Tq!+%?13WY xKTDR}!EozToW(md{`geQYyx2T7hY7#PnpC+I34@a;T+Yz8fvpuWaZZQe*t__Nv8k+ diff --git a/library/tedit/TEDIT-MENU b/library/tedit/TEDIT-MENU index 15aa1276..98276efa 100644 --- a/library/tedit/TEDIT-MENU +++ b/library/tedit/TEDIT-MENU @@ -1,1347 +1,150 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Apr-2024 10:53:42" {WMEDLEY}tedit>TEDIT-MENU.;171 269091 +(FILECREATED "22-Dec-2024 00:24:03" {WMEDLEY}TEDIT>TEDIT-MENU.;425 169589 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.MENU.START) + :CHANGES-TO (FNS \TEDIT.OTHER.STATECHANGEFN \TEDIT.OTHER.SELECTFN \TEDIT.CHARMENU.SPEC) - :PREVIOUS-DATE "10-Apr-2024 23:06:52" {WMEDLEY}tedit>TEDIT-MENU.;170) + :PREVIOUS-DATE "20-Dec-2024 22:07:54" {WMEDLEY}TEDIT>TEDIT-MENU.;424) (PRETTYCOMPRINT TEDIT-MENUCOMS) (RPAQQ TEDIT-MENUCOMS - [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS MB.3STATE MB.BUTTON MB.INSERT MB.MARGINBAR - MB.NWAY MB.TEXT MB.TOGGLE) - (RECORDS MBUTTON NWAYBUTTON MARGINBAR TAB))) - (DECLARE%: EVAL@COMPILE DOCOPY (MACROS TEDIT.DEFERRED-UPDATES)) - (INITRECORDS MBUTTON NWAYBUTTON MARGINBAR) - [COMS (* ; "Simple Menu Button support") - (FNS MB.BUTTONEVENTINFN MB.DISPLAY MB.SETIMAGE MB.SELFN MB.SIZEFN MB.WHENOPERATEDFN - MB.COPYFN MB.GETFN MB.PUTFN MB.SHOWSELFN MBUTTON.CREATE MBUTTON.CHANGENAME - MBUTTON.FIND.BUTTON MBUTTON.FIND.NEXT.BUTTON MBUTTON.FIND.NEXT.FIELD MBUTTON.INIT - MBUTTON.NEXT.FIELD.AS.NUMBER MBUTTON.NEXT.FIELD.AS.TEXT MBUTTON.NEXT.FIELD.AS.ATOM - MBUTTON.SET.FIELD MBUTTON.SET.NEXT.FIELD MBUTTON.SET.NEXT.BUTTON.STATE - TEDITMENU.STREAM) - (GLOBALVARS MBUTTONIMAGEFNS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MBUTTON.INIT)) - (ADDVARS (IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN] - [COMS - (* ;; - "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD") + [ + (* ;; "TEdit-specific menus and support") - (FNS MB.CREATE.THREESTATEBUTTON MB.THREESTATE.DISPLAY MB.THREESTATE.SHOWSELFN - MB.THREESTATE.WHENOPERATEDFN MB.THREESTATEBUTTON.FN THREESTATE.INIT) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (THREESTATE.INIT] - [COMS (* ; "One-of-N Menu button sets") - (FNS MB.CREATE.NWAYBUTTON MB.NB.DISPLAYFN MB.NB.WHENOPERATEDFN MB.NB.SIZEFN - MB.NWAYBUTTON.SELFN MB.NWAYMENU.NEWBUTTON NWAYBUTTON.INIT MB.NB.PACKITEMS - MB.NWAYBUTTON.ADDITEM) - (GLOBALVARS NWAYBUTTONIMAGEFNS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (NWAYBUTTON.INIT)) - (ADDVARS (IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN] - [COMS - (* ;; "Two-state, toggling menu buttons.") + [DECLARE%: DOEVAL@COMPILE DONTCOPY (RECORDS MARGINBAR) + (EXPORT (CONSTANTS (PTSPERPICA 12) + (PTSPERINCH 72) + (PICASPERINCH 6) + (MICASPERINCH 2540) + (PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + (MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH] + + (* ;; "") - (FNS \TEXTMENU.TOGGLE.CREATE \TEXTMENU.TOGGLE.DISPLAY \TEXTMENU.TOGGLE.SHOWSELFN - \TEXTMENU.TOGGLE.WHENOPERATEDFN \TEXTMENU.TOGGLEFN \TEXTMENU.TOGGLE.INIT - \TEXTMENU.SET.TOGGLE) - (GLOBALVARS \TOGGLEIMAGEFNS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTMENU.TOGGLE.INIT)) - (ADDVARS (IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN] - [COMS - (* ;; "Margin Setting and display") - - (FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.SELFN MB.MARGINBAR.SIZEFN + [COMS (* ; "MARGINBAR") + (FNS DRAWMARGINSCALE MARGINBAR MARGINBAR.CREATE MB.MARGINBAR.BUTTONEVENTINFN + MB.MARGINBAR.SELFN.TABS MB.MARGINBAR.SELFN.TABS.KIND MARGINBAR.GETSTATEFN + MARGINBAR.SETSTATEFN MARGINBAR.NEUTRALIZE MARGINBAR.LOOKS MB.MARGINBAR.SIZEFN MB.MARGINBAR.DISPLAYFN MDESCALE MSCALE MB.MARGINBAR.SHOWTAB MB.MARGINBAR.TABTRACK - \TEDIT.TABTYPE.SET MARGINBAR.INIT) + MARGINBAR.INIT \TEDIT.FMTSPECTOMARBAR) (BITMAPS \TEDIT.LEFTTAB \TEDIT.CENTERTAB \TEDIT.RIGHTTAB \TEDIT.DECIMALTAB \TEDIT.DOTTED.LEFTTAB \TEDIT.DOTTED.CENTERTAB \TEDIT.DOTTED.RIGHTTAB \TEDIT.DOTTED.DECIMALTAB TEDIT.EXTENDEDRIGHTMARK) (GLOBALVARS MARGINBARIMAGEFNS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT)) - (ADDVARS (IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN] - (COMS - (* ;; "Text menu creation and support") - - (FNS \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN \TEXTMENU.DOC.CREATE) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (MARGINBAR.INIT] + (COMS (FNS \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN) (BITMAPS TEXTMENUICON TEXTMENUICONMASK)) - [COMS (* ; "TEdit-specific support") - (FNS \TEDITMENU.CREATE \TEDIT.EXPANDED.MENU MB.DEFAULTBUTTON.FN - \TEDITMENU.RECORD.UNFORMATTED MB.DEFAULTBUTTON.ACTIONFN) - (FNS \TEDIT.CHARLOOKSMENU.CREATE \TEDIT.EXPANDEDCHARLOOKS.MENU \TEDIT.APPLY.BOLDNESS - \TEDIT.APPLY.CHARLOOKS \TEDIT.APPLY.OLINE \TEDIT.APPLY.UNBREAKABLE - \TEDIT.SHOW.CHARLOOKS \TEDIT.NEUTRALIZE.CHARLOOKS \TEDIT.FILL.IN.CHARLOOKS.MENU - \TEDIT.NEUTRALIZE.CHARLOOKS.MENU \TEDIT.PARSE.CHARLOOKS.MENU \TEDIT.APPLY.SLOPE - \TEDIT.APPLY.STRIKEOUT \TEDIT.APPLY.ULINE) - (FNS \TEDITPARAMENU.CREATE \TEDIT.EXPANDEDPARA.MENU \TEDIT.APPLY.PARALOOKS - \TEDIT.SHOW.PARALOOKS \TEDIT.NEUTRALIZE.PARALOOKS.MENU \TEDIT.RECORD.TABLEADERS) - (FNS \TEDIT.SHOW.PAGEFORMATTING \TEDITPAGEMENU.CREATE \TEDIT.APPLY.PAGEFORMATTING - TEDIT.UNPARSE.PAGEFORMAT) - (COMS (* ; "Initialization Code") - (GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU - TEDIT.MENUDIVIDER.SPEC TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC - TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC TEDIT.EXPANDED.PAGEMENU) - (FNS \TEDIT.MENU.INIT) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.MENU.INIT) - (\TEDITMENU.CREATE) - (\TEDIT.CHARLOOKSMENU.CREATE) - (\TEDITPARAMENU.CREATE) - (\TEDITPAGEMENU.CREATE] + (* ; "Generic support for Tedit menus") + (FNS \TEDIT.MENU.CREATE \TEDIT.MENU.PARSE \TEDIT.MENU.NEUTRALIZE + \TEDITMENU.RECORD.UNFORMATTED) + + (* ;; "") + + + (* ;; "") + + (* ; "DEFAULTMENU") + (FNS \TEDIT.DEFAULTMENU.CREATE \TEDIT.EXPANDED.MENU \TEDIT.DEFAULTMENU.FN + \TEDIT.DEFAULTMENU.ACTIONFN TEDIT.MENUSTREAM) + + (* ;; "") + + + (* ;; "") + + (* ; "PARAMENU") + (FNS \TEDIT.PARAMENU.CREATE \TEDIT.APPLY.PARALOOKS \TEDIT.SHOW.PARALOOKS + \TEDIT.EXPANDEDPARA.MENU \TEDIT.PARAMENU.FILLIN) + + (* ;; "") + + + (* ;; "") + + (* ; "CHARMENU") + (FNS \TEDIT.CHARMENU.CREATE \TEDIT.CHARMENU.SPEC \TEDIT.CHARMENU.PARSE \TEDIT.CHARMENU.FILLIN + \TEDIT.SHOW.CHARLOOKS \TEDIT.EXPANDEDCHAR.MENU \TEDIT.APPLY.CHARLOOKS + \TEDIT.OFFSETTYPE.STATEFN \TEDIT.OTHER.STATECHANGEFN \TEDIT.OTHER.SELECTFN) + + (* ;; "") + + + (* ;; "") + + (* ; "PAGEMENU") + (FNS \TEDIT.PAGEMENU.CREATE \TEDIT.SHOW.PAGELOOKS \TEDIT.PAGEMENU.FILLIN + \TEDIT.PAGEREGION.UNPARSE \TEDIT.APPLY.PAGELOOKS \TEDIT.CHANGE.PAGELOOKS + \TEDIT.PAGEMENU.CHARLOOKS.STATEFN) + (FNS \TEDIT.PAGEMENU.CREATE.HEADINGS \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN + \TEDIT.PAGEMENU.HEADINGS.STATEFN) + + (* ;; "") + + (GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.CHARLOOKS.MENU TEDIT.EXPANDED.PAGEMENU + TEDIT.EXPANDEDPARA.MENU) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEDIT.DEFAULTMENU.CREATE) + (\TEDIT.PARAMENU.CREATE) + (\TEDIT.PAGEMENU.CREATE))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) -(DECLARE%: EVAL@COMPILE DONTCOPY -(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(TYPERECORD MB.3STATE ( - (* ;; "Describes a 3-state menu button.") - MBLABEL (* ; - "Label for the button on the screen") - MBFONT (* ; - "Font the label text should appear in") - MBCHANGESTATEFN (* ; - "Function to call when the button's state changes") - MBINITSTATE (* ; "Button's initial state.") - ) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) -(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) - MBBUTTONEVENTFN _ 'MB.DEFAULTBUTTON.FN MBFONT _ (FONTCREATE 'HELVETICA 8 - 'BOLD)) +(* ;; "TEdit-specific menus and support") -(TYPERECORD MB.INSERT (MBINITENTRY)) - -(TYPERECORD MB.MARGINBAR (ignoredfield)) - -(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) - -(TYPERECORD MB.TEXT (MBSTRING MBFONT)) - -(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) -) +(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(RECORD MBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM) - (OR (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.DISPLAY) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.THREESTATE.DISPLAY) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - '\TEXTMENU.TOGGLE.DISPLAY]) - -(RECORD NWAYBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.NB.DISPLAYFN]) - (RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) [TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) 'MB.MARGINBAR.DISPLAYFN]) +) -(RECORD TAB (TABX . TABKIND)) +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQQ PTSPERPICA 12) + +(RPAQQ PTSPERINCH 72) + +(RPAQQ PICASPERINCH 6) + +(RPAQQ MICASPERINCH 2540) + +(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + +(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + +(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH)) + + +(CONSTANTS (PTSPERPICA 12) + (PTSPERINCH 72) + (PICASPERINCH 6) + (MICASPERINCH 2540) + (PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) + (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) + (MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))) ) (* "END EXPORTED DEFINITIONS") ) -(DECLARE%: EVAL@COMPILE DOCOPY -(DECLARE%: EVAL@COMPILE -(PUTPROPS TEDIT.DEFERRED-UPDATES MACRO [(TOBJ . BODY) - (* ;; "Used to be a cleaner DEFMACRO, maybe revert when DEFMACROS work better with file package and compiler. Can't do OPENLAMBDA because of . BODY") - (* ;; "For TEdit windows, run BODY without updating the edit window for TEXTOBJ. then updates at the end. This is useful if you're making a log of changes to a document at one time, where the changes are in essence atomic, and you don't need to see intermediate results. It's also a good bit faster than constant updating.") +(* ;; "") - (* ;; - "TEXTOBJ is the TEXTOBJ for the document being modified.") - (* ;; - "SCRATCHSEL is the TEXTOBJ scratch selection, bound here for BODY use.") - (LET* ((TEXTOBJ TOBJ) - (SCRATCHSEL (GETTOBJ TEXTOBJ SCRATCHSEL)) - (OLD-DON'TUPDATE (GETTOBJ TEXTOBJ TXTDON'TUPDATE))) - (CL:UNWIND-PROTECT - (PROGN (SETTOBJ TEXTOBJ TXTDON'TUPDATE T) . BODY) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 -1) - (SETTOBJ TEXTOBJ TXTDON'TUPDATE OLD-DON'TUPDATE) - (\TEDIT.UPDATE.SCREEN TEXTOBJ))]) -) -) - - -(* ; "Simple Menu Button support") - -(DEFINEQ - -(MB.BUTTONEVENTINFN - [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM) (* ; "Edited 9-Apr-2023 18:22 by rmk") - (* ; "Edited 30-May-91 22:15 by jds") - - (* ;; "There was a buttn event inside a menu button. Turn the button OFF when the mouse moves outside it.") - - (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] - (replace (SELECTION SELKIND) of SEL with 'VOLATILE) - (COND - ((IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED) (* ; - "This button is still active from an earlier hit. Don't let it be selected again.") - 'DON'T) - ((AND (IGEQ RELX 0) - (IGEQ RELY 0) - (ILEQ RELX (fetch XSIZE of OBJBOX)) - (ILEQ RELY (fetch YSIZE of OBJBOX))) (* ; - "We're really inside the thing. Return an indication that we're to be left alone.") - T) - (T (* ; - "He's moved outside the button. Don't permit the selection.") - 'DON'T]) - -(MB.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 20-Nov-2023 17:31 by rmk") - (* ; "Edited 11-Jan-89 16:58 by jds") - - (* ;; "Display the innards of a menu button") - - (SELECTQ (IMAGESTREAMTYPE STREAM) - (DISPLAY - (* ;; "Going to the display. Use the cached bitmap version of the button") - - [PROG (BITMAP (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - (X (DSPXPOSITION NIL STREAM)) - (Y (DSPYPOSITION NIL STREAM))) - [SETQ BITMAP (COND - ((IMAGEOBJPROP OBJ 'BITCACHE)) - (T (MB.SETIMAGE OBJ) - (IMAGEOBJPROP OBJ 'BITCACHE] - (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX))) - (BITBLT BITMAP 0 0 STREAM X Y) (* ; "Display the button's image") - (CL:WHEN (EQ (IMAGEOBJPROP OBJ 'STATE) - 'ON) (* ; "If the button is ON, mark it so.") - (BLTSHADE BLACKSHADE STREAM X Y (fetch XSIZE of OBJBOX) - (fetch YSIZE of OBJBOX) - 'INVERT))]) - (PROGN - (* ;; "Going to some output image stream. Use the actual text.") - - (DSPFONT (PROG1 (DSPFONT (FONTCOPY (IMAGEOBJPROP OBJ 'MBFONT) - 'DEVICE STREAM) - STREAM) (* ; - "Change to the font for this menu button.") - (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) - STREAM))]) - -(MB.SETIMAGE - [LAMBDA (OBJ) (* jds "23-Aug-84 13:22") - (PROG ((MBFONT (IMAGEOBJPROP OBJ 'MBFONT)) - (MBTEXT (IMAGEOBJPROP OBJ 'MBTEXT)) - BOX BITMAP DS) - (SETQ BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH MBTEXT MBFONT) - YSIZE _ (FONTPROP MBFONT 'HEIGHT) - YDESC _ (FONTPROP MBFONT 'DESCENT) - XKERN _ 0)) - (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX) - (fetch YSIZE of BOX))) - (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT MBFONT DS) - (MOVETO 0 (FONTPROP MBFONT 'DESCENT) - DS) - (PRIN1 MBTEXT DS) - (RETURN OBJ]) - -(MB.SELFN - [LAMBDA (OBJ SEL W FN) (* ; "Edited 15-Mar-2024 13:38 by rmk") - (* ; "Edited 16-Feb-2024 20:48 by rmk") - (* ; "Edited 24-Jan-2024 10:48 by rmk") - (* ; "Edited 6-Jun-2023 15:31 by rmk") - (* ; "Edited 18-Apr-2023 23:58 by rmk") - (* ; "Edited 21-Oct-2022 18:52 by rmk") - (* ; "Edited 30-May-91 22:15 by jds") - - (* ;; - "Calls a menu-button's associated function, then turns off the highlighting of the menu button.") - - (LET [(TSEL (\TEDIT.COPYSEL SEL)) - (BUTTONFN (OR FN (IMAGEOBJPROP OBJ 'MBFN] (* ; - "Save the selection that points to the menu button.") - (SETSEL SEL SELKIND 'CHAR) - (SETSEL SEL ONFLG NIL) (* ; "Call the button's function") - (CL:UNLESS (EQ (AND BUTTONFN (APPLY* BUTTONFN OBJ SEL W)) - 'DON'T) (* ; - "If the button fn left the selection alone,") - (\TEDIT.FIXSEL TSEL) (* ; - "Turn off the button hilite. Perhaps the function changed something that changed the selection?") - (\TEDIT.SHOWSEL TSEL NIL)) - (SETSEL SEL SET NIL]) - -(MB.SIZEFN - [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* ; "Edited 11-Oct-2022 22:51 by rmk") - (* ; "Edited 4-Oct-2022 11:59 by rmk") - (* jds "30-Aug-84 11:24") - (* ; "Tell the size of a menu button") - (LET ((FONT (IMAGEOBJPROP OBJ 'MBFONT)) - BOX) - (CL:UNLESS (DISPLAYSTREAMP STREAM) - (SETQ FONT (FONTCOPY FONT 'DEVICE (IMAGESTREAMTYPE STREAM)))) - (SETQ BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH (IMAGEOBJPROP OBJ 'MBTEXT) - FONT) - YSIZE _ (FONTPROP FONT 'HEIGHT) - YDESC _ (FONTPROP FONT 'DESCENT) - XKERN _ 0)) - (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) - BOX]) - -(MB.WHENOPERATEDFN - [LAMBDA (OBJ W OPERATION SEL) (* ; "Edited 27-Mar-2024 13:49 by rmk") - (* jds " 7-Feb-84 14:20") - (SELECTQ OPERATION - (HIGHLIGHTED (MB.SHOWSELFN OBJ SEL T W)) - (UNHIGHLIGHTED (MB.SHOWSELFN OBJ SEL NIL W)) - (SELECTED (MB.SELFN OBJ SEL W)) - (DESELECTED) - NIL]) - -(MB.COPYFN - [LAMBDA (OBJ) (* jds "23-May-84 11:32") - (* Copy a menu button object.) - (create IMAGEOBJ - OBJECTDATUM _ (COPY (fetch (IMAGEOBJ OBJECTDATUM) of OBJ)) - IMAGEOBJPLIST _ (COPY (fetch (IMAGEOBJ IMAGEOBJPLIST) of OBJ)) - IMAGEOBJFNS _ (fetch (IMAGEOBJ IMAGEOBJFNS) of OBJ]) - -(MB.GETFN - [LAMBDA (OBJ FILE) (* ; "Edited 19-Dec-2023 10:24 by rmk") - (* ; "Edited 20-Aug-87 16:17 by jds") - (* READ a menu button from a file.) - (HELP "HELP FROM JDS--NOT USED?") - (PROG [(TEXT (IMAGEOBJPROP OBJ 'MBTEXT)) - (MBFN (IMAGEOBJPROP OBJ 'MBFN)) - (FONT (IMAGEOBJPROP OBJ 'MBFONT] - (\STRINGOUT FILE TEXT) - (\ATMOUT FILE MBFN) - (\ATMOUT FILE (FONTPROP FONT 'FAMILY)) - (\WOUT FILE (FONTPROP FONT 'SIZE)) - (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) - -(MB.PUTFN - [LAMBDA (OBJ FILE) (* ; "Edited 19-Dec-2023 10:23 by rmk") - (* ; "Edited 20-Aug-87 16:17 by jds") - - (* ;; "Write a menu button from a file; suitable for re-reading using the image objects GETFN.") - - (PROG [(TEXT (IMAGEOBJPROP OBJ 'MBTEXT)) - (MBFN (IMAGEOBJPROP OBJ 'MBFN)) - (FONT (IMAGEOBJPROP OBJ 'MBFONT] - (HELP "HELP FROM JDS -- NOT USED?") - (\STRINGOUT FILE TEXT) (* ; "The button's image") - (\ATMOUT FILE MBFN) (* ; "The FN called when hit") - (\ATMOUT FILE (FONTPROP FONT 'FAMILY)) - (\WOUT FILE (FONTPROP FONT 'SIZE)) - (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) - -(MB.SHOWSELFN - [LAMBDA (OBJ SEL ON W) (* ; "Edited 27-Mar-2024 13:47 by rmk") - (* ; "Edited 20-Nov-2023 20:16 by rmk") - (* ; "Edited 11-Jan-89 16:35 by jds") - (LET [(OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX] - (OR (IMAGEOBJPROP OBJ 'BITCACHE) - (MB.DISPLAY OBJ)) (* ; "MAKE SURE THE DISPLAY FORM EXISTS") - (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) - 0 0 W 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) - (fetch (IMAGEBOX YSIZE) of OBJBOX) - 'INPUT - 'REPLACE) - (CL:WHEN (OR ON (EQ (IMAGEOBJPROP OBJ 'STATE) - 'ON)) - (BLTSHADE BLACKSHADE W 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) - (fetch (IMAGEBOX YSIZE) of OBJBOX) - 'INVERT))]) - -(MBUTTON.CREATE - [LAMBDA (MBTEXT MBFN MBFONT IMAGEFNS) (* ; "Edited 11-Jan-89 16:10 by jds") - - (* ;; "Create a MENU BUTTON image object, and fill in its image and function-hook fields") - - (LET* ([REAL-FONT (OR MBFONT (FONTCLASSCOMPONENT DEFAULTFONT 'DISPLAY] - (OBJ (IMAGEOBJCREATE NIL (OR IMAGEFNS MBUTTONIMAGEFNS))) - (BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH MBTEXT REAL-FONT) - YSIZE _ (FONTPROP REAL-FONT 'HEIGHT) - YDESC _ (FONTPROP REAL-FONT 'DESCENT) - XKERN _ 0)) - BITMAP DS) - (IMAGEOBJPROP OBJ 'MBFN MBFN) (* ; - "The function to be called when the button is pushed") - (IMAGEOBJPROP OBJ 'MBTEXT MBTEXT) (* ; "The text displayed in the button") - (IMAGEOBJPROP OBJ 'MBFONT REAL-FONT) (* ; "The font that text appears in") - (MB.SETIMAGE OBJ) (* ; - "Set up the image for the button, so we don't create it repeatedly.") - OBJ]) - -(MBUTTON.CHANGENAME - [LAMBDA (TEXTOBJ OBJ NEWNAME) (* jds "23-Aug-84 13:26") - - (* Change the text that appears in a button, and redisplay the button if it's - visible) - - (PROG (BOX BITMAP DS) - (IMAGEOBJPROP OBJ 'MBTEXT NEWNAME) - (MB.SETIMAGE OBJ) - (TEDIT.OBJECT.CHANGED TEXTOBJ OBJ]) - -(MBUTTON.FIND.BUTTON - [LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 16-Sep-2022 21:20 by rmk") - (* ; "Edited 22-Aug-2022 15:29 by rmk") - (* ; "Edited 22-Apr-93 15:40 by jds") - (* ; "'27-Sep-84 00:52' gbn") - - (* ;; "Returns the piece containing the imageobj with MBTEXT prop LABEL") - - (for (PC _ (\TEDIT.CHTOPC (OR CH# 1) - (TEXTOBJ TEXTSTREAM))) - OBJ - (LABELATOM _ (MKATOM LABEL)) by (NEXTPIECE PC) while PC - do (CL:WHEN [AND (EQ OBJECT.PTYPE (PTYPE PC)) - (SETQ OBJ (PCONTENTS PC)) - (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ 'MBTEXT] - (RETURN PC]) - -(MBUTTON.FIND.NEXT.BUTTON - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 21-Oct-2023 08:54 by rmk") - (* ; "Edited 5-Sep-2022 15:39 by rmk") - (* ; "Edited 22-Aug-2022 13:19 by rmk") - (* ; "Edited 6-Aug-2022 17:36 by rmk") - (* ; "Edited 22-Apr-93 16:39 by jds") - - (* ;; "Finds the next instance of an OBJECT which looks like a menu button, 3-state button, or menuobj. If none is found, return NIL") - - (for (PC _ (\TEDIT.CHTOPC CH# TEXTOBJ)) - OBJ by (NEXTPIECE PC) while PC when (AND (EQ OBJECT.PTYPE (PTYPE PC)) - (SETQ OBJ (PCONTENTS PC)) - (OR (type? MBUTTON OBJ) - (type? MARGINBAR OBJ) - (type? NWAYBUTTON OBJ))) - do (RETURN (CONS OBJ (\TEDIT.PCTOCH PC TEXTOBJ]) - -(MBUTTON.FIND.NEXT.FIELD - [LAMBDA (TEXTOBJ CH# DONTFIX) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 25-Feb-2024 23:17 by rmk") - (* ; "Edited 9-May-2023 12:43 by rmk") - (* ; "Edited 20-Mar-2023 17:33 by rmk") - (* ; "Edited 11-Feb-2023 11:23 by rmk") - (* ; "Edited 9-Sep-2022 17:04 by rmk") - (* ; "Edited 22-Aug-2022 13:06 by rmk") - (* ; "Edited 22-Apr-93 16:53 by jds") - - (* ;; "Scan forward from CH# to the next type-in field. If found, sets SCRATCHSEL to the text inside the field") - - (PROG ((SCRATCHSEL (GETTOBJ TEXTOBJ SCRATCHSEL)) - PC START-OF-PIECE LEN) - (DECLARE (SPECVARS START-OF-PIECE)) - (CL:WHEN (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN))(* ; - "Can't look past the end of the document") - (RETURN NIL)) - - (* ;; - "Find the start of the field. CLSELHERE is set for the prefix {, since the field may be empty") - - (for old PC inpieces (\TEDIT.CHTOPC CH# TEXTOBJ T) until (fetch (CHARLOOKS CLSELHERE) - of (PLOOKS PC)) - do (add START-OF-PIECE (PLEN PC))) - (CL:UNLESS PC (* ; - "Ran off the text without finding a fill-in field") - (RETURN NIL)) - (add START-OF-PIECE (PLEN PC)) (* ; "Skip the leading bracket") - - (* ;; "Find the length of the fill-in. The closing bracket is protected.") - - (SETQ LEN (for P inpieces (NEXTPIECE PC) until (fetch (CHARLOOKS CLPROTECTED) - of (PLOOKS P)) sum (PLEN P))) - (\TEDIT.UPDATE.SEL SCRATCHSEL START-OF-PIECE LEN 'LEFT DONTFIX) - (FSETSEL SCRATCHSEL SELKIND 'CHAR) - (FSETSEL SCRATCHSEL SET T) - (RETURN SCRATCHSEL]) - -(MBUTTON.INIT - [LAMBDA NIL (* ; "Edited 18-Feb-2024 14:15 by rmk") - (* jds "12-Feb-85 14:32") - (SETQ MBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.DISPLAY) - (FUNCTION MB.SIZEFN) - (FUNCTION MB.PUTFN) - (FUNCTION MB.GETFN) - (FUNCTION MB.COPYFN) - (FUNCTION MB.BUTTONEVENTINFN) - 'NILL - 'NILL - 'NILL - 'NILL - 'NILL - (FUNCTION MB.WHENOPERATEDFN) - (FUNCTION NILL) - 'TEditMenuButton]) - -(MBUTTON.NEXT.FIELD.AS.NUMBER - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 15-Dec-2023 13:59 by rmk") - (* ; "Edited 30-Jul-2023 08:54 by rmk") - (* ; "Edited 12-Jun-90 19:00 by mitani") - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) - (LET [(VAL (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ] - (CL:WHEN (IGREATERP (NCHARS VAL) - 0) - (SETQ VAL (MKATOM (CL:STRING-TRIM '(#\Space #\Newline) - VAL))) - (if (NUMBERP VAL) - else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT VAL " is not a number, ignored") - T T) - NIL))]) - -(MBUTTON.NEXT.FIELD.AS.TEXT - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 22-Apr-93 16:14 by jds") - - (* ;; "Find the next fill-in field in the menu after CH#, and return its contents as a string.") - - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) - (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ]) - -(MBUTTON.NEXT.FIELD.AS.ATOM - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 25-Feb-2024 17:46 by rmk") - (* ; "Edited 12-Jun-90 19:00 by mitani") - - (* ;; "Find the next fill-in field, and return its contents as an atom. If the field is empty, return NIL.") - - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) (* ; "Move to the next fill-in field.") - (LET [(STR (TEDIT.SEL.AS.STRING (GETTOBJ TEXTOBJ STREAMHINT) - (GETTOBJ TEXTOBJ SCRATCHSEL] - (CL:UNLESS (ZEROP (NCHARS STR)) (* ; - "The field isn't emtpy, convert to atom") - (MKATOM STR))]) - -(MBUTTON.SET.FIELD - [LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "Edited 17-Mar-2024 00:25 by rmk") - (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 21-Oct-2023 08:55 by rmk") - (* ; "Edited 13-Sep-2022 12:24 by rmk") - (* ; "Edited 6-Aug-2022 17:45 by rmk") - (* ; "Edited 22-Apr-93 10:56 by jds") - - (* ;; "Makes the contents of the field with name FIELD be VALUE.") - - (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - OBJ SAVED.SEL FIELD.SEL PC NEW-STRING) - (SETQ PC (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM)) - (CL:WHEN (SETQ PC (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM)) - (SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (\TEDIT.PCTOCH PC TEXTOBJ))) - (* ; - "select the field following this button.") - (CL:WHEN FIELD.SEL (* ; - "there are contents to set for this button") - (\TEDIT.FIXSEL FIELD.SEL TEXTOBJ) - (TEDIT.SETSEL TEXTSTREAM (fetch (SELECTION CH#) of FIELD.SEL) - (fetch (SELECTION DCH) of FIELD.SEL) - (fetch (SELECTION POINT) of FIELD.SEL) - T) - (SETQ NEW-STRING (MKSTRING VALUE)) - [COND - ((ZEROP (NCHARS NEW-STRING)) (* ; - "Nothing to replace, so just delete it.") - (TEDIT.DELETE TEXTSTREAM)) - (T (* ; "there IS new info, so insert it.") - (TEDIT.INSERT TEXTSTREAM (MKSTRING VALUE]))]) - -(MBUTTON.SET.NEXT.FIELD - [LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 22-May-2023 10:50 by rmk") - (* ; "Edited 20-Mar-2023 12:40 by rmk") - (* ; "Edited 18-Mar-2023 23:18 by rmk") - (* ; "Edited 11-Feb-2023 09:33 by rmk") - (* ; "Edited 30-May-91 22:15 by jds") - - (* ;; "SET the text content of the next fill-in field in this document to be NEWVALUE. Perhaps SHOULDNT if it can't find one?") - - (LET (FIELDSEL) - (CL:WHEN (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)) - (\TEDIT.FIXSEL FIELDSEL TEXTOBJ) (* ; - "Fix up the SELECTION that describes its contents, so we've got the right screen coordinates &c") - (CL:UNLESS (ZEROP (fetch (SELECTION DCH) of FIELDSEL)) - (\TEDIT.DELETE TEXTOBJ FIELDSEL)) (* ; "Delete existing text") - (CL:WHEN NEWVALUE - (\TEDIT.INSERT (MKSTRING NEWVALUE) - FIELDSEL TEXTOBJ)))]) - -(MBUTTON.SET.NEXT.BUTTON.STATE - [LAMBDA (TEXTOBJ STARTINGCH NEWSTATE) (* jds "31-Jul-85 22:09") - - (* * Find the next menu button in the document, and set its state to NEWSTATE. - Return 1 + the CH# of the button, for further searchers) - - (PROG* ((NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ STARTINGCH)) - (BUTTON (CAR NEXTB))) - (IMAGEOBJPROP BUTTON 'STATE NEWSTATE) - (RETURN (ADD1 (CDR NEXTB]) - -(TEDITMENU.STREAM - [LAMBDA (TEXTSTREAM) (* ; "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 TEXTSTREAM)) when (TEDITMENUP W "TEdit Menu") - do (RETURN (TEXTSTREAM W]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS MBUTTONIMAGEFNS) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(MBUTTON.INIT) - - -(ADDTOVAR IMAGEOBJTYPES (TEditMenuButton FILE TEDITMENU GETFN MB.GETFN)) -) - - - -(* ;; "Three-state (ON-OFF-NEUTRAL) menu buttons, for, e.g., character properties like BOLD") - -(DEFINEQ - -(MB.CREATE.THREESTATEBUTTON - [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* jds "24-Sep-86 00:49") - (PROG ((OBJ (IMAGEOBJCREATE NIL THREESTATEIMAGEFNS)) - (BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH TEXT FONT) - YSIZE _ (FONTPROP FONT 'HEIGHT) - YDESC _ (FONTPROP FONT 'DESCENT) - XKERN _ 0)) - DS BITMAP X Y) - (SETQ X (fetch XSIZE of BOX)) - (SETQ Y (fetch YSIZE of BOX)) - (IMAGEOBJPROP OBJ 'MBTEXT TEXT) - (IMAGEOBJPROP OBJ 'MBFONT FONT) - (IMAGEOBJPROP OBJ 'MBFN 'MB.THREESTATEBUTTON.FN) - (IMAGEOBJPROP OBJ 'STATECHANGEFN STATECHANGEFN) - (IMAGEOBJPROP OBJ 'STATE (OR INITSTATE 'NEUTRAL)) - (SETQ BITMAP (BITMAPCREATE X Y)) - (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (MOVETO 0 (FONTPROP FONT 'DESCENT) - DS) - (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) - DS) - (RETURN OBJ]) - -(MB.THREESTATE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 20-Nov-2023 14:27 by rmk") - (* jds "30-Aug-84 13:53") - - (* ;; "Display the innards of a menu button") - - (PROG (DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - (FONT (IMAGEOBJPROP OBJ 'MBFONT)) - (CURX (DSPXPOSITION NIL STREAM)) - (CURY (DSPYPOSITION NIL STREAM)) - BITMAP X Y) - (OR OBJBOX (SETQ OBJBOX (MB.SIZEFN OBJ STREAM))) (* ; "Make sure the size is set.") - (SETQ X (fetch XSIZE of OBJBOX)) - (SETQ Y (fetch YSIZE of OBJBOX)) - (COND - ((SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE)) (* ; - "The image bitmap exists already. Use it.") - ) - (T (* ; - "Need to create an image for this object.") - (SETQ BITMAP (BITMAPCREATE X Y)) - (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (MOVETO 0 (FONTPROP FONT 'DESCENT) - DS) - (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) - DS))) - (BITBLT BITMAP 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'INPUT 'PAINT) - (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* ; - "The button is ON. Display it as white text on black background") - (BLTSHADE BLACKSHADE STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'INVERT)) - (OFF (* ; - "The button is OFF. Mark it with a diagonal line thru it.") - (DRAWLINE CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - (SUB1 (IPLUS CURX X)) - (SUB1 (IPLUS (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - Y)) - 1 - 'PAINT STREAM)) - (NEUTRAL (* ; - "The button is neutral. Just display it regular.")) - NIL]) - -(MB.THREESTATE.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 20-Nov-2023 14:31 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (LET [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ DS] - (COND - (ON (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* ; "Switch from ON to NEUTRAL") - (BLTSHADE BLACKSHADE DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INVERT)) - (OFF (* ; "Switch from OFF to ON") - (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) - 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INPUT - 'REPLACE) - (BLTSHADE BLACKSHADE DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INVERT)) - (NEUTRAL (* ; "Switch from NEUTRAL to OFF") - (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX)) - (SUB1 (fetch YSIZE of IMAGEBOX)) - 1 - 'PAINT DS)) - NIL)) - ((GETSEL SEL SET) - (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* ; "Switch from NEUTRAL to ON") - (BLTSHADE BLACKSHADE DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INVERT)) - (OFF (* ; "Switch from ON to OFF") - (BLTSHADE BLACKSHADE DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INVERT) - (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX)) - (SUB1 (fetch YSIZE of IMAGEBOX)) - 1 - 'PAINT DS)) - (NEUTRAL (* ; "Switch from OFF to NEUTRAL") - (BITBLT (IMAGEOBJPROP OBJ 'BITCACHE) - 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INPUT - 'REPLACE)) - NIL]) - -(MB.THREESTATE.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 9-Feb-2024 10:52 by rmk") - (* ; "Edited 28-Jan-2024 23:33 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (* ; - "Handle operations on a three-state button") - (SELECTQ OPERATION - (HIGHLIGHTED (* ; "It is being hilighted") - (MB.THREESTATE.SHOWSELFN OBJ SEL T DS)) - (UNHIGHLIGHTED (* ; "And being de-hilighted") - (MB.THREESTATE.SHOWSELFN OBJ SEL NIL DS)) - (SELECTED (* ; "It's being selected") - (MB.THREESTATEBUTTON.FN OBJ SEL DS) (* ; "Run the state-changing function") - (SETSEL SEL SET NIL) (* ; - "And mar the selection turned off, so others can use it without trashing us") - (SETSEL SEL ONFLG NIL)) - (DESELECTED) - NIL]) - -(MB.THREESTATEBUTTON.FN - [LAMBDA (OBJ SEL W) (* ; "Edited 25-Feb-2024 23:40 by rmk") - (* ; "Edited 21-Oct-2022 18:45 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (* ; - "MBFN for TEdit default menu item buttons.") - (LET ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) - (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) - NEWSTATE) - (SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (OFF 'ON) - (ON 'NEUTRAL) - (NEUTRAL 'OFF) - 'ON)) - (CL:WHEN STATECHANGEFN (* ; - "apply any user supplied state change fn ") - (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ))) - (IMAGEOBJPROP OBJ 'STATE NEWSTATE) - (FSETSEL SEL ONFLG NIL) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) - -(THREESTATE.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:17") - (* Initialize the IMAGEFNS for 3-state - menu button IMAGEOBJs) - (SETQ THREESTATEIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.THREESTATE.DISPLAY) - (FUNCTION MB.SIZEFN) - (FUNCTION MB.PUTFN) - (FUNCTION MB.GETFN) - (FUNCTION MB.COPYFN) - (FUNCTION MB.BUTTONEVENTINFN) - 'NILL - 'NILL - 'NILL - 'NILL - 'NILL - (FUNCTION MB.THREESTATE.WHENOPERATEDFN) - 'NILL - '3StateMenuButton]) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(THREESTATE.INIT) -) - - - -(* ; "One-of-N Menu button sets") - -(DEFINEQ - -(MB.CREATE.NWAYBUTTON - [LAMBDA (BUTTONS FONT CHANGESTATEFN INITSTATE MAXITEMS/LINE) - (* gbn "24-Sep-84 15:31") - (PROG ((OBJECT (IMAGEOBJCREATE NIL NWAYBUTTONIMAGEFNS)) - HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS TWIDTHS) - (SETQ FONT (OR FONT (FONTCREATE 'HELVETICA 10))) - (SETQ HEIGHT (FONTPROP FONT 'HEIGHT)) - (SETQ DESCENT (FONTPROP FONT 'DESCENT)) - (SETQ WIDTHS (for BUTTON in BUTTONS collect (STRINGWIDTH (COND - ((NLISTP BUTTON) - BUTTON) - (T (CAR BUTTON))) - FONT))) - (SETQ IMAGES (for WIDTH in WIDTHS as BUTTON in BUTTONS collect (BITMAPCREATE WIDTH HEIGHT)) - ) - (SETQ SPACING (STRINGWIDTH " " FONT)) - [SETQ SIDEEFFECTFNS (for BUTTON in BUTTONS collect (AND (LISTP BUTTON) - (CADR BUTTON] - (SETQ DS (DSPCREATE)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (DSPRIGHTMARGIN 32000 DS) - (for IMAGE in IMAGES as BUTTON in BUTTONS do (DSPDESTINATION IMAGE DS) - (MOVETO 0 DESCENT DS) - (PRIN1 (COND - ((NLISTP BUTTON) - BUTTON) - (T (CAR BUTTON))) - DS)) - (IMAGEOBJPROP OBJECT 'MINWIDTH (for WIDTH in WIDTHS largest WIDTH)) - (* We always need at least one - button's width) - (IMAGEOBJPROP OBJECT 'MINHEIGHT (IPLUS HEIGHT 2)) (* And at least one button's height) - [IMAGEOBJPROP OBJECT 'MAXWIDTH (COND - [MAXITEMS/LINE (SETQ TWIDTHS (SORT (COPY WIDTHS))) - (IPLUS (CAR TWIDTHS) - (for WIDTH in (CDR TWIDTHS) as I - from 1 to (SUB1 MAXITEMS/LINE) - sum (IPLUS WIDTH SPACING] - (T (IPLUS (CAR WIDTHS) - (for WIDTH in (CDR WIDTHS) - sum (IPLUS WIDTH SPACING] - (* At most, we're as wide as the N - widest buttons put together) - (IMAGEOBJPROP OBJECT 'MAXHEIGHT (ITIMES (IPLUS HEIGHT 2) - (LENGTH BUTTONS))) - (IMAGEOBJPROP OBJECT 'ITEMSPACE SPACING) - (IMAGEOBJPROP OBJECT 'BUTTONS BUTTONS) - (IMAGEOBJPROP OBJECT 'BUTTONIMAGES IMAGES) - (IMAGEOBJPROP OBJECT 'BUTTONHEIGHT (IPLUS HEIGHT 2)) - (IMAGEOBJPROP OBJECT 'BUTTONWIDTHS WIDTHS) - (IMAGEOBJPROP OBJECT 'NBUTTONS (LENGTH BUTTONS)) - (IMAGEOBJPROP OBJECT 'STATE INITSTATE) - (IMAGEOBJPROP OBJECT 'SELECTEDBUTTON NIL) - (IMAGEOBJPROP OBJECT 'SIDEEFFECTFNS SIDEEFFECTFNS) - (IMAGEOBJPROP OBJECT 'DESCENT DESCENT) - (IMAGEOBJPROP OBJECT 'MBFONT FONT) - (IMAGEOBJPROP OBJECT 'MAXITEMS/LINE MAXITEMS/LINE) - (RETURN OBJECT]) - -(MB.NB.DISPLAYFN - [LAMBDA (OBJ STREAM MODE) (* jds "28-Aug-84 15:07") - (* Display the innards of a menu - button) - (PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - (X (DSPXPOSITION NIL STREAM)) - (Y (DSPYPOSITION NIL STREAM)) - (BUTTONX (IMAGEOBJPROP OBJ 'BUTTONX)) - (BUTTONY (IMAGEOBJPROP OBJ 'BUTTONY)) - (BUTTONLIST (IMAGEOBJPROP OBJ 'BUTTONS)) - (BUTTONIMAGES (IMAGEOBJPROP OBJ 'BUTTONIMAGES)) - STATE) - [COND - ((SETQ BITMAP (IMAGEOBJPROP OBJ 'IMAGECACHE)) (* The button image exists already) - ) - (T (* Have to make one.) - (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of OBJBOX) - (fetch YSIZE of OBJBOX))) - (IMAGEOBJPROP OBJ 'IMAGECACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT (IMAGEOBJPROP OBJ 'MBFONT) - DS) - (for X in BUTTONX as Y in BUTTONY as IMAGE in BUTTONIMAGES - do (* Display the images) - (BITBLT IMAGE 0 0 DS X Y NIL NIL 'INPUT 'REPLACE] - [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX] - (* Display the button's image) - (COND - ((SETQ STATE (IMAGEOBJPROP OBJ 'STATE)) (* There's a selected button.) - (for BXVAL in BUTTONX as BYVAL in BUTTONY as IMAGE in BUTTONIMAGES as BUTTON - in BUTTONLIST when (EQ STATE BUTTON) do (BITBLT IMAGE 0 0 STREAM (IPLUS X BXVAL) - (IPLUS Y BYVAL) - NIL NIL 'INVERT 'REPLACE]) - -(MB.NB.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 9-Apr-2023 15:57 by rmk") - (* ; "Edited 13-Sep-2022 12:09 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (SELECTQ OPERATION - (HIGHLIGHTED (* (MB.SHOWSELFN OBJ SEL T DS)) - NIL) - (UNHIGHLIGHTED (* (MB.SHOWSELFN OBJ SEL NIL DS)) - NIL) - (SELECTED - (* ;; "There may be a side-effect to occur upon selection.") - - (for BUTTON (STATE _ (IMAGEOBJPROP OBJ 'STATE)) in (IMAGEOBJPROP OBJ 'BUTTONS) - as SIDEFN in (IMAGEOBJPROP OBJ 'SIDEEFFECTFNS) - when (AND (EQ STATE BUTTON) - SIDEFN) do (MB.SELFN OBJ SEL DS SIDEFN)) - (replace (SELECTION SET) of SEL with NIL)) - (DESELECTED) - NIL]) - -(MB.NB.SIZEFN - [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds " 6-Sep-84 14:19") - (* Tell the size of an n-way menu) - (PROG ((OLDBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - BOX - (MAXITEMS/LINE (IMAGEOBJPROP OBJ 'MAXITEMS/LINE)) - (MAXWIDTH (IMAGEOBJPROP OBJ 'MAXWIDTH)) - (MINWIDTH (IMAGEOBJPROP OBJ 'MINWIDTH)) - (MAXHEIGHT (IMAGEOBJPROP OBJ 'MAXHEIGHT)) - (MINHEIGHT (IMAGEOBJPROP OBJ 'MINHEIGHT)) - (LINEHEIGHT (IMAGEOBJPROP OBJ 'LINEHEIGHT)) - (BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT)) - (BUTTONWIDTHS (IMAGEOBJPROP OBJ 'BUTTONWIDTHS)) - (SPACING (IMAGEOBJPROP OBJ 'ITEMSPACE)) - (SLACK (IDIFFERENCE RIGHTMARGIN CURX)) - BUTTONX BUTTONY BUTTONINFO WIDTH HEIGHT) - [COND - ((AND (IGEQ SLACK MAXWIDTH) - (NOT MAXITEMS/LINE)) (* There's space for all the items on - one line. Use it) - (SETQ WIDTH MAXWIDTH) - (SETQ HEIGHT MINHEIGHT) - [SETQ BUTTONX (bind (CURX _ 0) for ITEM in BUTTONWIDTHS - collect (PROG1 CURX - (add CURX SPACING) - (add CURX ITEM))] - (SETQ BUTTONY (for ITEM in BUTTONWIDTHS collect 0))) - [(ILEQ SLACK MINWIDTH) (* Have to stack it vertically.) - (SETQ WIDTH MINWIDTH) - (SETQ HEIGHT MAXHEIGHT) - (SETQ BUTTONX (for ITEM in BUTTONWIDTHS collect 0)) - (SETQ BUTTONY (bind (CURY _ (ITIMES BUTTONHEIGHT (LENGTH BUTTONWIDTHS))) for ITEM - in BUTTONWIDTHS collect (add CURY (IMINUS BUTTONHEIGHT] - (T (SETQ BUTTONINFO (MB.NB.PACKITEMS SLACK BUTTONWIDTHS SPACING MAXITEMS/LINE)) - [SETQ BUTTONX (for LINE in BUTTONINFO join (COPY (CDR LINE] - [SETQ BUTTONY (bind (CURY _ (ITIMES BUTTONHEIGHT (LENGTH BUTTONINFO))) for LINE - in BUTTONINFO join (PROGN (SETQ CURY (IDIFFERENCE CURY BUTTONHEIGHT) - ) - (for X in (CDR LINE) collect CURY] - [SETQ WIDTH (CAR (for LINE in BUTTONINFO largest (CAR LINE] - (SETQ HEIGHT (ITIMES BUTTONHEIGHT (LENGTH BUTTONINFO] - (COND - ((AND OLDBOX (IEQP WIDTH (fetch XSIZE of OLDBOX)) - (IEQP HEIGHT (fetch YSIZE of OLDBOX))) (* If nothing changed, don't bother - reformatting.) - (RETURN OLDBOX)) - (T (* Otherwise invalidate the image - cache) - (IMAGEOBJPROP OBJ 'IMAGECACHE NIL))) - (SETQ BOX (create IMAGEBOX - XSIZE _ WIDTH - YSIZE _ HEIGHT - YDESC _ (IMAGEOBJPROP OBJ 'DESCENT) - XKERN _ 0)) - (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) - (IMAGEOBJPROP OBJ 'BUTTONX BUTTONX) - (IMAGEOBJPROP OBJ 'BUTTONY BUTTONY) - (RETURN BOX]) - -(MB.NWAYBUTTON.SELFN - [LAMBDA (OBJ W SEL MOUSEX MOUSEY) (* ; "Edited 25-Feb-2024 23:43 by rmk") - (* ; "Edited 21-Oct-2022 18:46 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (* ; "Selecting an NWAY button.") - (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - (OLDSTATE (IMAGEOBJPROP OBJ 'STATE)) - (BUTTONLIST (IMAGEOBJPROP OBJ 'BUTTONS)) - (BUTTONX (IMAGEOBJPROP OBJ 'BUTTONX)) - (BUTTONIMAGES (IMAGEOBJPROP OBJ 'BUTTONIMAGES)) - (BUTTONY (IMAGEOBJPROP OBJ 'BUTTONY)) - (BUTTONWIDTHS (IMAGEOBJPROP OBJ 'BUTTONWIDTHS)) - (BUTTONLIST (IMAGEOBJPROP OBJ 'BUTTONLIST)) - (BUTTONHEIGHT (IMAGEOBJPROP OBJ 'BUTTONHEIGHT)) - CH STATE) - [for BUTTON in BUTTONLIST as X in BUTTONX as Y in BUTTONY as WIDTH in BUTTONWIDTHS - as IMAGE in BUTTONIMAGES - do (COND - ((INSIDE? (create REGION - LEFT _ X - BOTTOM _ Y - WIDTH _ WIDTH - HEIGHT _ BUTTONHEIGHT) - MOUSEX MOUSEY) (* ; - "The mouse is pointing here. Select this.") - (SETQ STATE BUTTON) - (BITBLT IMAGE 0 0 W X Y NIL NIL 'INVERT 'REPLACE)) - ((EQ OLDSTATE BUTTON) (* ; - "This was the old selection (and it's different, too). Unselect it") - (BITBLT IMAGE 0 0 W X Y NIL NIL 'INPUT 'REPLACE] - (IMAGEOBJPROP OBJ 'STATE STATE) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS)) - T]) - -(MB.NWAYMENU.NEWBUTTON - [LAMBDA (TEXTOBJ CH# OLDBUTTON NEWBUTTON) (* jds " 8-Feb-84 19:41") - - (* Given a hook on an existing button, and an insertion point, insert a new - button) - - (PROG ((ARBITRATOR (IMAGEOBJPROP OLDBUTTON 'ARBITRATOR)) - BUTTON) - (IMAGEOBJPROP BUTTON 'ARBITRATOR ARBITRATOR) - (TEDIT.INSERT.OBJECT BUTTON TEXTOBJ CH#) - (TEDIT.INSERT TEXTOBJ " " (ADD1 CH#)) - (TEDIT.LOOKS TEXTOBJ '(PROTECTED ON) - (ADD1 CH#) - 2) - (RETURN BUTTON]) - -(NWAYBUTTON.INIT - [LAMBDA (BUTTONS FONT INITSTATE) (* jds " 9-Feb-86 15:17") - (SETQ NWAYBUTTONIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.NB.DISPLAYFN) - (FUNCTION MB.NB.SIZEFN) - (FUNCTION MB.PUTFN) - (FUNCTION MB.GETFN) - (FUNCTION MB.COPYFN) - (FUNCTION MB.NWAYBUTTON.SELFN) - 'NILL - 'NILL - 'NILL - 'NILL - 'NILL - (FUNCTION MB.NB.WHENOPERATEDFN) - 'NILL - 'NWayButton]) - -(MB.NB.PACKITEMS - [LAMBDA (WIDTH ITEMWIDTHS SPACING MAXITEMS/LINE) (* jds "24-Oct-84 17:42") - - (* * Pack items into lines WIDTH wide. Item widths are in ITEMWIDTHS, and each - pair of items on a line is separated by SPACING. - Returns a list of lists, one per line packed, of the relative X starts of the - items) - - (PROG ((CURX 0) - (LINES NIL) - (CURLINE NIL) - (CURLINEITEMS 0) - ITEM) - (while ITEMWIDTHS do (SETQ ITEM (pop ITEMWIDTHS)) - (COND - ((OR [ILESSP WIDTH (IPLUS CURX ITEM (COND - (CURLINE SPACING) - (T 0] - (AND MAXITEMS/LINE (IGEQ CURLINEITEMS MAXITEMS/LINE))) - (* Time for a new line) - (SETQ LINES (NCONC1 LINES (CONS CURX CURLINE))) - (* Add to our list of lines so far) - (SETQ CURLINE NIL) (* Empty the line accumulator) - (SETQ CURLINEITEMS 0) (* reset the line item count) - (SETQ CURX 0))) - (AND CURLINE (add CURX SPACING)) - (SETQ CURLINE (NCONC1 CURLINE CURX)) - (add CURX ITEM) - (add CURLINEITEMS 1)) - [AND CURLINE (SETQ LINES (NCONC1 LINES (CONS CURX CURLINE] - (* Capture the last partial line, if - there is one.) - (RETURN LINES]) - -(MB.NWAYBUTTON.ADDITEM - [LAMBDA (OBJECT NEWBUTTON) (* jds "11-Jul-85 12:44") - (* Given an existing n-way choice menu - button, add another choice to the list) - (PROG ([BUTTONS (CONS NEWBUTTON (IMAGEOBJPROP OBJECT 'BUTTONS] - HEIGHT IMAGES IMAGE DS DESCENT SPACING SIDEEFFECTFNS WIDTHS FONT) - (SETQ FONT (IMAGEOBJPROP OBJECT 'MBFONT)) - (SETQ HEIGHT (FONTPROP FONT 'HEIGHT)) - (SETQ DESCENT (FONTPROP FONT 'DESCENT)) - (SETQ WIDTHS (for BUTTON in BUTTONS collect (STRINGWIDTH (COND - ((NLISTP BUTTON) - BUTTON) - (T (CAR BUTTON))) - FONT))) - (SETQ IMAGES (for WIDTH in WIDTHS as BUTTON in BUTTONS collect (BITMAPCREATE WIDTH HEIGHT)) - ) - (SETQ SPACING (STRINGWIDTH " " FONT)) - [SETQ SIDEEFFECTFNS (for BUTTON in BUTTONS collect (AND (LISTP BUTTON) - (CADR BUTTON] - (SETQ DS (DSPCREATE)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (DSPRIGHTMARGIN 32000 DS) - (for IMAGE in IMAGES as BUTTON in BUTTONS do (DSPDESTINATION IMAGE DS) - (MOVETO 0 DESCENT DS) - (PRIN1 (COND - ((NLISTP BUTTON) - BUTTON) - (T (CAR BUTTON))) - DS)) - (IMAGEOBJPROP OBJECT 'MINWIDTH (for WIDTH in WIDTHS largest WIDTH)) - (IMAGEOBJPROP OBJECT 'MINHEIGHT (IPLUS HEIGHT 2)) - [IMAGEOBJPROP OBJECT 'MAXWIDTH (IPLUS (CAR WIDTHS) - (for WIDTH in (CDR WIDTHS) - sum (IPLUS WIDTH SPACING] - (IMAGEOBJPROP OBJECT 'MAXHEIGHT (ITIMES (IPLUS HEIGHT 2) - (LENGTH BUTTONS))) - (IMAGEOBJPROP OBJECT 'ITEMSPACE SPACING) - (IMAGEOBJPROP OBJECT 'BUTTONS BUTTONS) - (IMAGEOBJPROP OBJECT 'BUTTONIMAGES IMAGES) - (IMAGEOBJPROP OBJECT 'BUTTONHEIGHT (IPLUS HEIGHT 2)) - (IMAGEOBJPROP OBJECT 'BUTTONWIDTHS WIDTHS) - (IMAGEOBJPROP OBJECT 'NBUTTONS (LENGTH BUTTONS)) - (IMAGEOBJPROP OBJECT 'SELECTEDBUTTON NIL) - (IMAGEOBJPROP OBJECT 'SIDEEFFECTFNS SIDEEFFECTFNS) - (IMAGEOBJPROP OBJECT 'DESCENT DESCENT) - (RETURN OBJECT]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS NWAYBUTTONIMAGEFNS) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(NWAYBUTTON.INIT) - - -(ADDTOVAR IMAGEOBJTYPES (NWayButton FILE TEDITMENU GETFN MB.GETFN)) -) - - - -(* ;; "Two-state, toggling menu buttons.") - -(DEFINEQ - -(\TEXTMENU.TOGGLE.CREATE - [LAMBDA (TEXT FONT STATECHANGEFN INITSTATE) (* gbn "24-Sep-84 14:45") - (* Creates a TOGGLE menu button, that - can turn off and on alternately.) - (PROG ((OBJ (IMAGEOBJCREATE NIL \TOGGLEIMAGEFNS)) - (BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH TEXT FONT) - YSIZE _ (FONTPROP FONT 'HEIGHT) - YDESC _ (FONTPROP FONT 'DESCENT) - XKERN _ 0)) - DS BITMAP X Y) - (SETQ X (fetch XSIZE of BOX)) - (SETQ Y (fetch YSIZE of BOX)) - (IMAGEOBJPROP OBJ 'MBTEXT TEXT) - (IMAGEOBJPROP OBJ 'MBFONT FONT) - (IMAGEOBJPROP OBJ 'MBFN '\TEXTMENU.TOGGLEFN) - (IMAGEOBJPROP OBJ 'STATECHANGEFN STATECHANGEFN) - - (* a function to be called on finalization of selection of this button to provide - for user side-effects) - - (IMAGEOBJPROP OBJ 'STATE (OR INITSTATE 'OFF)) - (SETQ BITMAP (BITMAPCREATE X Y)) - (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (MOVETO 0 (FONTPROP FONT 'DESCENT) - DS) - (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) - DS) - (RETURN OBJ]) - -(\TEXTMENU.TOGGLE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 20-Nov-2023 14:35 by rmk") - (* gbn "27-Sep-84 01:23") - (* ; "'27-Sep-84 01:11' gbn") - - (* ;; "Display the innards of a menu toggle") - - (PROG (DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) - (FONT (IMAGEOBJPROP OBJ 'MBFONT)) - (CURX (DSPXPOSITION NIL STREAM)) - (CURY (DSPYPOSITION NIL STREAM)) - BITMAP X Y) - (CL:UNLESS OBJBOX - (SETQ OBJBOX (MB.SIZEFN OBJ STREAM))) (* ; "Make sure the size is set.") - (SETQ X (fetch XSIZE of OBJBOX)) - (SETQ Y (fetch YSIZE of OBJBOX)) - (COND - ([type? BITMAP (SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE] - (* ; - "The image bitmap exists already. Use it.") - ) - (T (* ; - "Need to create an image for this object.") - (SETQ BITMAP (BITMAPCREATE X Y)) - (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) - (DSPXOFFSET 0 DS) - (DSPYOFFSET 0 DS) - (DSPFONT FONT DS) - (MOVETO 0 (FONTPROP FONT 'DESCENT) - DS) - (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) - DS))) - (BITBLT BITMAP 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'INPUT 'PAINT) - (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* ; - "The button is ON. Display it as white text on black background") - (BLTSHADE BLACKSHADE STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'INVERT)) - (OFF (* ; - "The button is OFF. Just display it regular.")) - (ERROR "Invalid state in toggle button " OBJ]) - -(\TEXTMENU.TOGGLE.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 20-Nov-2023 14:46 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (CL:WHEN (AND (OR ON (GETSEL SEL SET)) - (IMAGEOBJPROP OBJ 'STATE)) - (LET [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ DS] - (BLTSHADE BLACKSHADE DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'INVERT)))]) - -(\TEXTMENU.TOGGLE.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 9-Feb-2024 10:52 by rmk") - (* ; "Edited 28-Jan-2024 23:32 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (* ; - "Handle operations on a three-state button") - (SELECTQ OPERATION - (HIGHLIGHTED (* ; "It is being hilighted") - (\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL T DS)) - (UNHIGHLIGHTED (* ; "And being de-hilighted") - (\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL NIL DS)) - (SELECTED (* ; "It's being selected") - (\TEXTMENU.TOGGLEFN OBJ SEL DS) (* ; "Run the state-changing function") - (SETSEL SEL SET NIL) (* ; - "And mar the selection turned off, so others can use it without trashing us") - (SETSEL SEL ONFLG NIL)) - (DESELECTED) - NIL]) - -(\TEXTMENU.TOGGLEFN - [LAMBDA (OBJ SEL W) (* ; "Edited 21-Oct-2022 18:46 by rmk") - (* ; "Edited 30-May-91 22:16 by jds") - (* MBFN for TOGGLE buttons--cycle back - and forthe betwen states.) - (PROG ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) - (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) - OFILE CH NEWSTATE) - (SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (OFF 'ON) - (ON 'OFF) - 'ON)) - (COND - (STATECHANGEFN (* apply the user supplied state - change fn if he supplied one) - (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ) - SEL))) - (IMAGEOBJPROP OBJ 'STATE NEWSTATE) - (replace (SELECTION ONFLG) of SEL with NIL]) - -(\TEXTMENU.TOGGLE.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:18") - (SETQ \TOGGLEIMAGEFNS (IMAGEFNSCREATE (FUNCTION \TEXTMENU.TOGGLE.DISPLAY) - (FUNCTION MB.SIZEFN) - (FUNCTION MB.PUTFN) - (FUNCTION MB.GETFN) - (FUNCTION MB.COPYFN) - (FUNCTION MB.BUTTONEVENTINFN) - 'NILL - 'NILL - 'NILL - 'NILL - 'NILL - (FUNCTION \TEXTMENU.TOGGLE.WHENOPERATEDFN) - 'NILL - 'ToggleButton]) - -(\TEXTMENU.SET.TOGGLE - [LAMBDA (TEXT VALUE TEXTSTREAM) (* ; "Edited 22-Nov-2023 14:48 by rmk") - (* ; "Edited 22-Aug-2022 15:29 by rmk") - (* ; "Edited 6-Aug-2022 18:18 by rmk") - (* ; "Edited 12-Jun-90 19:02 by mitani") - -(* ;;; "finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state to VALUE") - - (LET ((PC (MBUTTON.FIND.BUTTON TEXT TEXTSTREAM)) - OBJ) - (CL:UNLESS PC (ERROR TEXT " was not found as a button.")) - (CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC)) - (SETQ OBJ (PCONTENTS PC)) - (IMAGEOBJPROP OBJ 'STATE VALUE) - (IMAGEOBJPROP OBJ 'BITCACHE 'JUNK) - (for PANE inpanes (TEXTOBJ TEXTSTREAM) do (\TEDIT.REPAINTFN PANE)) - VALUE)]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \TOGGLEIMAGEFNS) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\TEXTMENU.TOGGLE.INIT) - - -(ADDTOVAR IMAGEOBJTYPES (ToggleButton FILE TEDITMENU GETFN MB.GETFN)) -) - - - -(* ;; "Margin Setting and display") +(* ; "MARGINBAR") (DEFINEQ @@ -1413,7 +216,9 @@ (DSPOPERATION OLDOP W]) (MARGINBAR - [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "Edited 20-Nov-2023 20:34 by rmk") + [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 23-Jul-2024 00:41 by rmk") + (* ; "Edited 20-Nov-2023 20:34 by rmk") (* ; "Edited 2-Oct-2022 00:01 by rmk") (* ; "Edited 9-Sep-2022 22:38 by rmk") (* ; "Edited 12-Jun-90 18:59 by mitani") @@ -1426,6 +231,7 @@ (FLOATINGRIGHT NIL) (EXTENDEDRIGHT NIL) UNSETL1 UNSETLN) + (CL:UNLESS RIGHTLIM (\TEDIT.THELP)) (CL:UNLESS UPDATE (DRAWMARGINSCALE W UNIT)) (DSPFONT (FONTCREATE 'TERMINAL 10) W) @@ -1539,9 +345,16 @@ (MB.MARGINBAR.SHOWTAB W TAB UNIT 'PAINT]) (MARGINBAR.CREATE - [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Create an instance of the - margin-setting ruler for TEdit's use.) + [LAMBDA (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 4-Aug-2024 22:36 by rmk") + (* ; "Edited 29-Jul-2024 10:13 by rmk") + (* ; "Edited 28-Jul-2024 09:18 by rmk") + (* ; "Edited 25-Jul-2024 16:10 by rmk") + (* ; "Edited 22-Jul-2024 11:54 by rmk") + (* ; "Edited 12-Jun-90 18:59 by mitani") + + (* ;; "Create an instance of the margin-setting ruler for TEdit's use.") + (PROG ((BOX (create IMAGEBOX XSIZE _ 1008 YSIZE _ 62 @@ -1557,17 +370,14 @@ MARTABS _ MARTABS MARUNIT _ MARUNIT MARTABTYPE _ MARTABTYPE)) - MARGINBARIMAGEFNS)) - - (* Create an IMAGEOBJ, containing an instance of the record to hold margin and - tab info) - + MARGINBARIMAGEFNS)) (* ; + "Create an IMAGEOBJ, containing an instance of the record to hold margin and tab info") (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of BOX) - (fetch YSIZE of BOX))) (* A cache for the ruler's screen - image) + (fetch YSIZE of BOX))) (* ; + "A cache for the ruler's screen image") (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) - (SETQ DS (DSPCREATE BITMAP)) (* And a displaystream for modifying - that image) + (SETQ DS (DSPCREATE BITMAP)) (* ; + "And a displaystream for modifying that image") (IMAGEOBJPROP OBJ 'DSPCACHE DS) (DSPXOFFSET 0 DS) (DSPYOFFSET 0 DS) @@ -1585,231 +395,392 @@ NIL (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL DS))) - (* Fill in the cache with the original value This does the time-consuming part of - drawing the ticks on the ruler and such, which would make drawing it on the fly - unbearable.) - - (IMAGEOBJPROP OBJ 'NEEDSUPDATE T) - - (* And tell the display function that it needs to be updated when first - displayed. Which is the faster part.) + (* ;; "Fill in the cache with the original value This does the time-consuming part of drawing the ticks on the ruler and such, which would make drawing it on the fly unbearable.") + (IMAGEOBJPROP OBJ 'IDENTIFIER 'MARGINBAR) + (IMAGEOBJPROP OBJ 'STATEFN (FUNCTION MARGINBAR.GETSTATEFN)) + (IMAGEOBJPROP OBJ 'SETSTATEFN (FUNCTION MARGINBAR.SETSTATEFN)) (RETURN OBJ]) -(MB.MARGINBAR.SELFN - [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* ; "Edited 26-Feb-2024 11:44 by rmk") +(MB.MARGINBAR.BUTTONEVENTINFN + [LAMBDA (OBJ MENUDS SEL RELX RELY MENUTSTREAM) (* ; "Edited 7-Dec-2024 21:21 by rmk") + (* ; "Edited 25-Aug-2024 09:12 by rmk") + (* ; "Edited 1-Aug-2024 22:56 by rmk") + (* ; "Edited 23-Jul-2024 00:44 by rmk") + (* ; "Edited 18-Jul-2024 17:08 by rmk") + (* ; "Edited 26-Feb-2024 11:44 by rmk") (* ; "Edited 12-Jun-90 18:59 by mitani") - (* ; - "Let the user adjust margins and tabs using the mouse.") - [LET [(OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) - (IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ STREAM 'DISPLAY] - (LET ((L1 (fetch MARL1 of OBJDATUM)) - (LN (fetch MARLN of OBJDATUM)) - (R (fetch MARR of OBJDATUM)) - (TABS (fetch MARTABS of OBJDATUM)) - [SCALEDTABS (COND - ((LISTP (fetch MARTABS of OBJDATUM)) - (* ; - "Only scale the tabs if there are any, and they're not neutralized.") - (for TAB in (fetch MARTABS of OBJDATUM) - collect (MSCALE (fetch TABX of TAB) - (fetch MARUNIT of OBJDATUM] - (UNIT (fetch MARUNIT of OBJDATUM)) - (CLIP (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch XSIZE of IMAGEBOX) - HEIGHT _ (fetch YSIZE of IMAGEBOX))) - (RIGHTLIM (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL SELWINDOW)) - 4)) - TAB TABX OL1 OLN OR) - (SETQ OL1 L1) - (SETQ OLN LN) - (SETQ OR R) - [COND - [(INSIDE? (create REGION - LEFT _ (IDIFFERENCE (MSCALE (ABS L1) - UNIT) - 2) - BOTTOM _ 42 - WIDTH _ 16 - HEIGHT _ 16) - RELX RELY) (* ; "Move the 1st-line left margin.") - (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) - do (SETQ L1 (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ L1 (MINUS L1] - (COND - ((NOT (EQUAL OL1 L1)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OL1 L1] - [(INSIDE? (create REGION - LEFT _ (IDIFFERENCE (MSCALE (ABS LN) - UNIT) - 2) - BOTTOM _ 26 - WIDTH _ 16 - HEIGHT _ 16) - RELX RELY) (* ; "Move the skirt's left margin") - (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) - do (SETQ LN (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ LN (MINUS LN] - (COND - ((NOT (EQUAL OLN LN)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OLN LN] - [(OR (INSIDE? (create REGION - LEFT _ (IDIFFERENCE (IMIN (MSCALE (ABS R) - UNIT) - (fetch XSIZE of IMAGEBOX) - (fetch (REGION WIDTH) - of (DSPCLIPPINGREGION NIL - SELWINDOW))) - 16) - BOTTOM _ 26 - WIDTH _ 16 - HEIGHT _ 32) - RELX RELY) - (AND (ZEROP (IABS (FIXR R))) - (INSIDE? (create REGION - LEFT _ (IDIFFERENCE (IMIN (fetch XSIZE of IMAGEBOX) - (fetch (REGION WIDTH) - of (DSPCLIPPINGREGION NIL - SELWINDOW))) - 16) - BOTTOM _ 26 - WIDTH _ 16 - HEIGHT _ 32) - RELX RELY))) (* ; "Move the right margin") - (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) - do (SETQ R (MAX 0 (MDESCALE (LASTMOUSEX STREAM) - UNIT))) - [COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right mouse button UNsets the margin.") - (SETQ R (MINUS R] - (COND - ((NOT (EQUAL OR R)) - (MARGINBAR STREAM L1 LN R TABS UNIT T RIGHTLIM) - (SETQ OR R] - ((INSIDE? (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (fetch (REGION WIDTH) of CLIP) - HEIGHT _ 16) - RELX RELY) (* ; "We're in the tab ruler region") - (COND - ((MOUSESTATE LEFT) (* ; "MOVE a tab") - [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS - smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] - (AND TAB (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB))) - [(MOUSESTATE MIDDLE) (* ; "ADD/CHANGE a tab") - (COND - ((EQ (fetch MARTABS of OBJDATUM) - 'NEUTRAL) (* ; - "The tabs used to be NEUTRAL. Clear the tab region, and start afresh.") - (replace MARTABS of OBJDATUM with NIL) - (* ; "So we don't come this way again.") - (DSPFILL (create REGION - LEFT _ 2 - BOTTOM _ 1 - HEIGHT _ 8 - WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) - of (DSPCLIPPINGREGION NIL SELWINDOW - )) - 4)) - WHITESHADE - 'REPLACE SELWINDOW) (* ; - "Make the tab region look non-neutral, too, so that tabs look OK on it.") - )) - (COND - ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS - smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] - (SETQ TABX (MSCALE (CAR TAB) - UNIT)) - (IGEQ (LASTMOUSEX STREAM) - (IDIFFERENCE TABX 2)) - (ILEQ (LASTMOUSEX STREAM) - (IPLUS TABX 2))) - (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) - (replace TABKIND of TAB with (OR (fetch MARTABTYPE of OBJDATUM) - 'LEFT)) - (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) - (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)) - ([OR (NOT TAB) - (NOT (EQP (fetch TABX of TAB) - (MDESCALE (LASTMOUSEX STREAM) - UNIT] (* ; "Really create a new tab") - [SETQ TAB (create TAB - TABX _ (MDESCALE (LASTMOUSEX STREAM) + + (* ;; "Let the user adjust margins and tabs using the mouse. Do the adjustment based on the region of the margin bar that mouse starts out in: left marging, first line, right margin, tabs") + + (LET* ((OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) + (IMAGEBOX OBJ MENUTSTREAM))) + (L1 (fetch MARL1 of OBJDATUM)) + (OL1 L1) + (LN (fetch MARLN of OBJDATUM)) + (OLN LN) + (R (fetch MARR of OBJDATUM)) + (OR R) + (TABS (fetch MARTABS of OBJDATUM)) + (UNIT (fetch MARUNIT of OBJDATUM)) + (CLIP (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch XSIZE of IMAGEBOX) + HEIGHT _ (fetch YSIZE of IMAGEBOX))) + (RIGHTLIM (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL MENUDS)) + 4))) + (if (INSIDE? (create REGION + LEFT _ (IDIFFERENCE (MSCALE (ABS L1) UNIT) - TABKIND _ (OR (fetch MARTABTYPE of OBJDATUM) - 'LEFT] - (SETQ TABS (CONS TAB TABS)) - (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) - (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB] - ((MOUSESTATE RIGHT) (* ; "DELETE a tab.") - (COND - ((AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS - smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] - (SETQ TABX (MSCALE (CAR TAB) - UNIT)) - (IGEQ (LASTMOUSEX STREAM) - (IDIFFERENCE TABX 2)) - (ILEQ (LASTMOUSEX STREAM) - (IPLUS TABX 2))) - (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) - (SETQ TABS (LDIFFERENCE TABS (LIST TAB] - (replace MARL1 of OBJDATUM with L1) - (replace MARLN of OBJDATUM with LN) - (replace MARR of OBJDATUM with R) - (replace MARTABS of OBJDATUM with TABS) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP (WFROMDS SELWINDOW) - 'MAINWINDOW) - 'PROCESS] + 2) + BOTTOM _ 42 + WIDTH _ 16 + HEIGHT _ 16) + RELX RELY) + then (* ; "Move the 1st-line left margin.") + (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) + (INSIDE? CLIP (LASTMOUSEX MENUTSTREAM) + (LASTMOUSEY MENUTSTREAM))) + do (SETQ L1 (MAX 0 (MDESCALE (LASTMOUSEX MENUTSTREAM) + UNIT))) + (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ L1 (MINUS L1))) + (CL:UNLESS (EQP OL1 L1) + (MARGINBAR MENUTSTREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OL1 L1))) + elseif (INSIDE? (create REGION + LEFT _ (IDIFFERENCE (MSCALE (ABS LN) + UNIT) + 2) + BOTTOM _ 26 + WIDTH _ 16 + HEIGHT _ 16) + RELX RELY) + then (* ; "Move the skirt's left margin") + (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) + (INSIDE? CLIP (LASTMOUSEX MENUTSTREAM) + (LASTMOUSEY MENUTSTREAM))) + do (SETQ LN (MAX 0 (MDESCALE (LASTMOUSEX MENUTSTREAM) + UNIT))) + (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ LN (MINUS LN))) + (CL:UNLESS (EQP OLN LN) + (MARGINBAR MENUTSTREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OLN LN))) + elseif (OR (INSIDE? (create REGION + LEFT _ (IDIFFERENCE (IMIN (MSCALE (ABS R) + UNIT) + (fetch XSIZE of IMAGEBOX) + (fetch (REGION WIDTH) + of (DSPCLIPPINGREGION NIL MENUDS) + )) + 16) + BOTTOM _ 26 + WIDTH _ 16 + HEIGHT _ 32) + RELX RELY) + (AND (ZEROP (IABS (FIXR R))) + (INSIDE? (create REGION + LEFT _ (IDIFFERENCE (IMIN (fetch XSIZE of IMAGEBOX) + (fetch (REGION WIDTH) + of (DSPCLIPPINGREGION NIL + MENUDS))) + 16) + BOTTOM _ 26 + WIDTH _ 16 + HEIGHT _ 32) + RELX RELY))) + then (* ; "Move the right margin") + (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) + (INSIDE? CLIP (LASTMOUSEX MENUTSTREAM) + (LASTMOUSEY MENUTSTREAM))) + do (SETQ R (MAX 0 (MDESCALE (LASTMOUSEX MENUTSTREAM) + UNIT))) + (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; + "Right mouse button UNsets the margin.") + (SETQ R (MINUS R))) + (CL:UNLESS (EQP OR R) + (MARGINBAR MENUTSTREAM L1 LN R TABS UNIT T RIGHTLIM) + (SETQ OR R))) + elseif (INSIDE? (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (fetch (REGION WIDTH) of CLIP) + HEIGHT _ 16) + RELX RELY) + then (* ; "We're in the tab ruler region") + (replace MARTABS of OBJDATUM with (MB.MARGINBAR.SELFN.TABS OBJDATUM MENUDS + MENUTSTREAM))) + (replace MARL1 of OBJDATUM with L1) + (replace MARLN of OBJDATUM with LN) + (replace MARR of OBJDATUM with R) + (TEDIT.BACKTOMAIN MENUTSTREAM)) T]) +(MB.MARGINBAR.SELFN.TABS + [LAMBDA (OBJDATUM SELWINDOW STREAM) (* ; "Edited 24-Aug-2024 21:40 by rmk") + (* ; "Edited 2-Aug-2024 08:18 by rmk") + + (* ;; "Mouse is down in the tab region of the marginbar. Creates, moves, or deletes a tab, depending on the mouse button. Returns the modified TABS list. UNIT was only partially implemented, tabs are assumed to be in picas and are scaled to points (PTSPERPICA=12).") + + (LET* ((TABS (fetch MARTABS of OBJDATUM)) + (UNIT (fetch MARUNIT of OBJDATUM)) + [SCALEDTABS (CL:WHEN (LISTP (fetch MARTABS of OBJDATUM)) + (* ; + "Only scale the tabs if there are any, and they're not neutralized.") + (for TAB in (fetch MARTABS of OBJDATUM) + collect (MSCALE (fetch TABX of TAB) + (fetch MARUNIT of OBJDATUM))))] + TAB TABX) + [if (MOUSESTATE LEFT) + then (* ; "MOVE a tab") + [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS + smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] + (AND TAB (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)) + elseif (MOUSESTATE MIDDLE) + then (* ; "ADD/CHANGE a tab") + (CL:WHEN (EQ (fetch MARTABS of OBJDATUM) + 'NEUTRAL) (* ; + "The tabs used to be NEUTRAL. Clear the tab region, and start afresh.") + (replace MARTABS of OBJDATUM with NIL)(* ; "So we don't come this way again.") + + (* ;; + "Make the tab region look non-neutral, too, so that tabs look OK on it. ") + + (DSPFILL (create REGION + LEFT _ 2 + BOTTOM _ 1 + HEIGHT _ 8 + WIDTH _ (IDIFFERENCE (fetch (REGION WIDTH) + of (DSPCLIPPINGREGION NIL SELWINDOW)) + 4)) + WHITESHADE + 'REPLACE SELWINDOW)) + (if (AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS + smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] + (SETQ TABX (MSCALE (CAR TAB) + UNIT)) + (IGEQ (LASTMOUSEX STREAM) + (IDIFFERENCE TABX 2)) + (ILEQ (LASTMOUSEX STREAM) + (IPLUS TABX 2))) + then (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) + (replace (TAB TABKIND) of TAB with (MB.MARGINBAR.SELFN.TABS.KIND + SELWINDOW)) + (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) + (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB) + elseif [OR (NOT TAB) + (NOT (EQP (fetch TABX of TAB) + (MDESCALE (LASTMOUSEX STREAM) + UNIT] + then (* ; "Really create a new tab") + (SETQ TAB (create TAB + TABX _ (MDESCALE (LASTMOUSEX STREAM) + UNIT) + TABKIND _ (MB.MARGINBAR.SELFN.TABS.KIND SELWINDOW))) + (SETQ TABS (CONS TAB TABS)) + (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'PAINT) + (MB.MARGINBAR.TABTRACK STREAM OBJDATUM TAB)) + elseif (MOUSESTATE RIGHT) + then (* ; "DELETE a tab.") + (CL:WHEN (AND [SETQ TAB (for TABX in SCALEDTABS as TAB in TABS + smallest (ABS (IDIFFERENCE TABX (LASTMOUSEX STREAM] + (SETQ TABX (MSCALE (CAR TAB) + UNIT)) + (IGEQ (LASTMOUSEX STREAM) + (IDIFFERENCE TABX 2)) + (ILEQ (LASTMOUSEX STREAM) + (IPLUS TABX 2))) + (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) + (SETQ TABS (REMOVE TAB TABS)))] + TABS]) + +(MB.MARGINBAR.SELFN.TABS.KIND + [LAMBDA (SELWINDOW) (* ; "Edited 22-Oct-2024 13:03 by rmk") + (* ; "Edited 28-Aug-2024 19:15 by rmk") + (* ; "Edited 25-Aug-2024 23:47 by rmk") + (* ; "Edited 24-Aug-2024 21:49 by rmk") + + (* ;; "Look backward through SELWINDOW to find the TABTYPE and DOTTEDLEADER buttons, use them to produce the current TABKIND") + + (LET* [(STATES (MB.GET '(DOTTEDLEADER TABTYPE) + SELWINDOW + 'STATE NIL T)) + (TABTYPE (OR (LISTGET STATES 'TABTYPE) + 'LEFT] + (CL:IF (EQ 'ON (LISTGET STATES 'DOTTEDLEADER)) + (PACK* 'DOTTED TABTYPE) + TABTYPE)]) + +(MARGINBAR.GETSTATEFN + [LAMBDA (PC OBJ TEXTOBJ) (* ; "Edited 22-Oct-2024 12:26 by rmk") + (* ; "Edited 20-Oct-2024 11:39 by rmk") + (* ; "Edited 29-Aug-2024 09:32 by rmk") + (* ; "Edited 12-Aug-2024 10:43 by rmk") + (* ; "Edited 9-Aug-2024 22:24 by rmk") + (* ; "Edited 4-Aug-2024 22:40 by rmk") + (* ; "Edited 1-Aug-2024 00:12 by rmk") + (* ; "Edited 29-Jul-2024 11:01 by rmk") + + (* ;; "This gets the current state of the marginbar's image object in the menu, for applying.") + (* ; "Edited 25-Jul-2024 16:18 by rmk") + (LET* ((OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (MARUNIT (fetch (MARGINBAR MARUNIT) of OBJDATUM)) + (L1 (FIXR (TIMES (fetch (MARGINBAR MARL1) of OBJDATUM) + MARUNIT))) + (LN (FIXR (TIMES (fetch (MARGINBAR MARLN) of OBJDATUM) + MARUNIT))) + (R (FIXR (TIMES (fetch (MARGINBAR MARR) of OBJDATUM) + MARUNIT))) + (MARTABS (fetch (MARGINBAR MARTABS) of OBJDATUM)) + LOOKS) + (CL:WHEN (IGEQ L1 0) (* ; + "The 1stleftmargin is set, and non-neutral.") + (push LOOKS '1STLEFTMARGIN L1)) + (CL:WHEN (IGEQ LN 0) (* ; + "The LEFTMARGIN is set, and non-neutral.") + (push LOOKS 'LEFTMARGIN LN)) + (CL:WHEN (IGEQ R 0) (* ; + "The RIGHTMARGIN is set, and non-neutral.") + (push LOOKS 'RIGHTMARGIN R)) + (CL:UNLESS (MEMB MARTABS '(NIL NEUTRAL)) (* ; + "If the tab settings are neutral, don't change anything.") + + (* ;; + "Convert from incoming tab units (picas?) to points. The default tab is already in points.") + + [push LOOKS 'TABS (SORT (\TEDIT.SCALE.TABS MARTABS MARUNIT) + (FUNCTION (LAMBDA (A B) + (ILEQ (CAR A) + (CAR B]) + + (* ;; "Toggle the dotted-leader state of the margin bar tab-setter.") + + (change (fetch (MARGINBAR MARTABTYPE) of OBJDATUM) + (SELECTQ (MB.GET 'DOTTEDLEADER TEXTOBJ 'STATE PC T) + (ON (SELECTQ (OR DATUM 'LEFT) + (LEFT 'DOTTEDLEFT) + (CENTERED 'DOTTEDCENTERED) + (RIGHT 'DOTTEDRIGHT) + (DECIMAL 'DOTTEDDECIMAL) + NIL)) + (OFF (SELECTQ DATUM + (DOTTEDLEFT 'LEFT) + (DOTTEDCENTERED + 'CENTERED) + (DOTTEDRIGHT 'RIGHT) + (DOTTEDDECIMAL 'DECIMAL) + NIL)) + NIL)) + (IMAGEOBJPROP OBJ 'STATE (CONS LOOKS)) + PC]) + +(MARGINBAR.SETSTATEFN + [LAMBDA (PC NEWVALUE TSTREAM) (* ; "Edited 3-Aug-2024 23:55 by rmk") + (IMAGEOBJPROP (PCONTENTS PC) + 'OBJECTDATUM NEWVALUE) + PC]) + +(MARGINBAR.NEUTRALIZE + [LAMBDA (OBJ) (* ; "Edited 29-Jul-2024 12:14 by rmk") + + (* ;; "Neutralizes the settings of the marginbar") + + (create MARGINBAR smashing (IMAGEOBJPROP OBJ 'OBJECTDATUM) + MARL1 _ -0.5 MARLN _ -0.5 MARR _ -39.5 MARTABS _ 'NEUTRAL MARUNIT _ 12 + MARTABTYPE _ NIL]) + +(MARGINBAR.LOOKS + [LAMBDA (OBJ DOTTEDLEADER) (* ; "Edited 20-Oct-2024 15:27 by rmk") + (* ; "Edited 28-Jul-2024 21:17 by rmk") + (* ; "Edited 25-Jul-2024 16:18 by rmk") + (LET* ((OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (MARUNIT (fetch (MARGINBAR MARUNIT) of OBJDATUM)) + (L1 (FIXR (TIMES (fetch (MARGINBAR MARL1) of OBJDATUM) + MARUNIT))) + (LN (FIXR (TIMES (fetch (MARGINBAR MARLN) of OBJDATUM) + MARUNIT))) + (R (FIXR (TIMES (fetch (MARGINBAR MARR) of OBJDATUM) + MARUNIT))) + (MARTABS (fetch (MARGINBAR MARTABS) of OBJDATUM)) + LOOKS) + (CL:WHEN (IGEQ L1 0) (* ; + "The 1stleftmargin is set, and non-neutral.") + (push LOOKS '1STLEFTMARGIN L1)) + (CL:WHEN (IGEQ LN 0) (* ; + "The LEFTMARGIN is set, and non-neutral.") + (push LOOKS 'LEFTMARGIN LN)) + (CL:WHEN (IGEQ R 0) (* ; + "The RIGHTMARGIN is set, and non-neutral.") + (push LOOKS 'RIGHTMARGIN R)) + (CL:UNLESS (MEMB MARTABS '(NIL NEUTRAL)) (* ; + "If the tab settings are neutral, don't change anything.") + + (* ;; + "Convert from incoming tab units (picas?) to points. The default tab is already in points.") + + [push LOOKS 'TABUNIT MARUNIT 'TABS (SORT (\TEDIT.SCALE.TABS MARTABS MARUNIT) + (FUNCTION (LAMBDA (A B) + (ILEQ (CAR A) + (CAR B]) + + (* ;; "Toggle the dotted-leader state of the margin bar tab-setter.") + + (change (fetch (MARGINBAR MARTABTYPE) of OBJDATUM) + (SELECTQ DOTTEDLEADER + (ON (SELECTQ (OR DATUM 'LEFT) + (LEFT 'DOTTEDLEFT) + (CENTERED 'DOTTEDCENTERED) + (RIGHT 'DOTTEDRIGHT) + (DECIMAL 'DOTTEDDECIMAL) + NIL)) + (OFF (SELECTQ DATUM + (DOTTEDLEFT 'LEFT) + (DOTTEDCENTERED + 'CENTERED) + (DOTTEDRIGHT 'RIGHT) + (DOTTEDDECIMAL 'DECIMAL) + NIL)) + NIL)) + LOOKS]) + (MB.MARGINBAR.SIZEFN - [LAMBDA (OBJ) (* jds " 5-Sep-84 14:10") - (PROG ((BOX (create IMAGEBOX - XSIZE _ 1008 - YSIZE _ 62 - YDESC _ 0 - XKERN _ 4))) - (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) - (RETURN BOX]) + [LAMBDA (OBJ) (* ; "Edited 3-Dec-2024 20:03 by rmk") + (* jds " 5-Sep-84 14:10") + + (* ;; "YDESC is 2 so that selecting the bar and highlighting doesn't wipe out the bottom line. Although you shouldn't be able to select it") + + (LET ((BOX (create IMAGEBOX + XSIZE _ 1008 + YSIZE _ 62 + YDESC _ 2 + XKERN _ 4))) + (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) + BOX]) (MB.MARGINBAR.DISPLAYFN - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 9-Sep-2022 22:37 by rmk") + [LAMBDA (OBJ STREAM) (* ; "Edited 29-Jul-2024 12:01 by rmk") + (* ; "Edited 23-Jul-2024 00:42 by rmk") + (* ; "Edited 18-Jul-2024 17:04 by rmk") + (* ; "Edited 9-Sep-2022 22:37 by rmk") (* ; "Edited 12-Jun-90 18:59 by mitani") (* ;  "Display the innards of a menu button") (PROG ((IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ STREAM MODE))) + (IMAGEBOX OBJ STREAM))) (OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) - BITMAP - (DS (DSPCREATE)) - WASON) + (BITMAP (IMAGEOBJPROP OBJ 'BITCACHE)) + (DS (DSPCREATE))) (COND - [[SETQ WASON (SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE] + [BITMAP - (* ;; "The marginbar existed already as an image. Don't bother re-creating it, and remember that we're allowed to MODIFY the old image instead of creating a new one.") + (* ;; "The marginbar existed already as an image. Don't bother re-creating it, and remember that we're allowed to MODIFY the old image instead of creating a new one.") - (SETQ DS (IMAGEOBJPROP OBJ 'DSPCACHE] + (SETQ DS (IMAGEOBJPROP OBJ 'DSPCACHE] (T (* ;  "Have to create an image for the margin bar") (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of IMAGEBOX) @@ -1831,7 +802,7 @@ (fetch (MARGINBAR MARR) of OBJDATUM) (fetch (MARGINBAR MARTABS) of OBJDATUM) (fetch (MARGINBAR MARUNIT) of OBJDATUM) - (OR WASON (IMAGEOBJPROP OBJ 'NEEDSUPDATE NIL)) + NIL (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL STREAM))) (* ; "Update the image, if it needs it") (BITBLT BITMAP 0 0 STREAM (IDIFFERENCE (DSPXPOSITION NIL STREAM) @@ -1912,48 +883,16 @@ 'PAINT) (SETQ OLDX X]) -(\TEDIT.TABTYPE.SET - [LAMBDA (OBJ SEL W) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 21-Oct-2022 18:46 by rmk") - (* ; "Edited 3-Oct-2022 22:16 by rmk") - (* ; "Edited 9-Sep-2022 15:47 by rmk") - (* ; "Edited 6-Aug-2022 17:16 by rmk") - (* ; - "Edited 24-Apr-95 12:03 by sybalsky:mv:envos") - - (* ;; "Change the kind of TAB that will be set in the succeeding marginbar.") - - (LET ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) - (STATE (IMAGEOBJPROP OBJ 'STATE)) - DOTTEDBUTTON) (* ; - "Find out roughly what kind of TAB this is to be.") - (SETQ STATE (U-CASE (CL:IF (LISTP STATE) - (CAR STATE) - STATE))) (* ; - "Make sure it's upper case, and an atom.") - [SETQ DOTTEDBUTTON (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SEL] - (* ; - "Find out if this is to be a tab with a dotted leader.") - (CL:WHEN (EQ (IMAGEOBJPROP DOTTEDBUTTON 'STATE) - 'ON) (* ; "Yes. Make this a DOTTEDxxx tab.") - (SETQ STATE (PACK* 'DOTTED STATE))) - (for (PC _ (\TEDIT.CHTOPC (ADD1 (fetch (SELECTION CH#) of SEL)) - TEXTOBJ)) by (NEXTPIECE PC) while PC when (type? MARGINBAR (PCONTENTS - PC)) - do (replace MARTABTYPE of (IMAGEOBJPROP (PCONTENTS PC) - 'OBJECTDATUM) with STATE) - (RETURN]) - (MARGINBAR.INIT - [LAMBDA NIL (* jds " 9-Feb-86 15:18") + [LAMBDA NIL (* ; "Edited 25-Aug-2024 09:11 by rmk") + (* ; "Edited 17-Jul-2024 21:58 by rmk") + (* jds " 9-Feb-86 15:18") (SETQ MARGINBARIMAGEFNS (IMAGEFNSCREATE (FUNCTION MB.MARGINBAR.DISPLAYFN) (FUNCTION MB.MARGINBAR.SIZEFN) (FUNCTION MB.MARGINBAR.PUTFN) (FUNCTION MB.MARGINBAR.GETFN) (FUNCTION MB.COPYFN) - (FUNCTION MB.MARGINBAR.SELFN) - 'NILL + (FUNCTION MB.MARGINBAR.BUTTONEVENTINFN) 'NILL 'NILL 'NILL @@ -1962,6 +901,25 @@ 'NILL 'NILL 'MarginRuler]) + +(\TEDIT.FMTSPECTOMARBAR + [LAMBDA (FMTSPEC UNIT) (* ; "Edited 4-Aug-2024 22:50 by rmk") + + (* ;; "Creates a margin bar reflecting the properties of FMTSPEC, for PARAMENU display. Assumes that UNIT is the conversion factor (presumably PTSPERPICA) that takes FMTSPEC screen-point numbers into MARGINBAR numbers. No rounding.") + + (* ;; "Hardcopy scaling isn't relevant for menus.") + + (create MARGINBAR + MARL1 _ (FQUOTIENT (FGETPARA FMTSPEC 1STLEFTMAR) + UNIT) + MARLN _ (FQUOTIENT (FGETPARA FMTSPEC LEFTMAR) + UNIT) + MARR _ (FQUOTIENT (FGETPARA FMTSPEC RIGHTMAR) + UNIT) + MARUNIT _ UNIT + MARTABS _ (for TAB in (FGETPARA FMTSPEC FMTTABS) + collect (create TAB using TAB TABX _ (QUOTIENT (fetch (TAB TABX) of TAB) + UNIT]) ) (RPAQQ \TEDIT.LEFTTAB #*(10 8)B@@@B@@@G@@@JH@@B@@@B@@@CN@@@@@@) @@ -1989,19 +947,12 @@ (DECLARE%: DONTEVAL@LOAD DOCOPY (MARGINBAR.INIT) - - -(ADDTOVAR IMAGEOBJTYPES (MarginRuler FILE TEDITMENU GETFN MB.GETFN)) ) - - - -(* ;; "Text menu creation and support") - (DEFINEQ (\TEDIT.MENU.START - [LAMBDA (MENUSTREAM MAINWINDOW TITLE HEIGHT TYPE) (* ; "Edited 19-Apr-2024 10:53 by rmk") + [LAMBDA (MENUSTREAM MAINWINDOW TITLE HEIGHT TYPE) (* ; "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") (* ; "Edited 3-Nov-2023 22:23 by rmk") @@ -2071,7 +1022,8 @@ (* ;; "No caret now, let the buttonevent fn bring it up") - (\TEDIT.UPCARET (CAR (GETTOBJ MENUTEXTOBJ CARET)) + (\TEDIT.UPCARET (GETPANEPROP (PANEPROPS (FGETTOBJ MENUTEXTOBJ PRIMARYPANE)) + PCARET) -10 -10) (TEXTPROP MENUTEXTOBJ 'NOTSPLITTABLE T) (WINDOWPROP MENUW 'BUTTONEVENTFN (FUNCTION \TEDIT.MENU.BUTTONEVENTFN)) @@ -2081,142 +1033,14 @@ MENUW))]) (\TEDIT.MENU.BUTTONEVENTFN - [LAMBDA (MENUW) (* ; "Edited 25-Sep-2023 12:53 by rmk") + [LAMBDA (MENUW) (* ; "Edited 28-Jun-2024 23:09 by rmk") + (* ; "Edited 25-Sep-2023 12:53 by rmk") (* ;; "Entry for menus that allows for any special menu actions. In particular, turns on the caret blinking if it wasn't on before.") - (replace (TEDITCARET TCFORCEUP) of (CAR (MKLIST (GETTOBJ (TEXTOBJ MENUW) - CARET))) with NIL) + (replace (TEDITCARET TCFORCEUP) of (GETPANEPROP (PANEPROPS MENUW) + PCARET) with NIL) (\TEDIT.BUTTONEVENTFN MENUW]) - -(\TEXTMENU.DOC.CREATE - [LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 19-Sep-2023 14:36 by rmk") - (* ; "Edited 16-Sep-2023 13:03 by rmk") - (* ; "Edited 13-Aug-2022 23:11 by rmk") - (* ; "Edited 31-Jan-2022 22:48 by rmk") - (* ; "Edited 12-Jun-90 19:00 by mitani") - - (* ;; "Create the TEXTSTREAM for a menu, given a description. That stream is passed to \TEDIT.MENU.START to get the menu up on screen") - - (LET ([MENUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10] - CH#1) - (bind (CH# _ 1) - OBJ for DESC in MENUDESC - do (SELECTQ (CAR DESC) - (* - (* ;; "This is a comment within a menu description -- Ignore it.") -) - (MB.BUTTON (* ; - "A menu button -- hitting it calls a function") - (TEDIT.INSERT.OBJECT (MBUTTON.CREATE (MKATOM (fetch (MB.BUTTON MBLABEL) - of DESC)) - (fetch (MB.BUTTON MBBUTTONEVENTFN) - of DESC) - (fetch (MB.BUTTON MBFONT) of DESC)) - MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.3STATE (* ; - "3-state button; hitting it changes state among ON, OFF, and NEUTRAL.") - (TEDIT.INSERT.OBJECT (MB.CREATE.THREESTATEBUTTON - (MKATOM (fetch (MB.3STATE MBLABEL) of DESC)) - (fetch (MB.3STATE MBFONT) of DESC) - (fetch (MB.3STATE MBCHANGESTATEFN) of DESC) - (fetch (MB.3STATE MBINITSTATE) of DESC)) - MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.TOGGLE (* ; - "TOGGLE button; hitting it switches between ON and OFF.") - (TEDIT.INSERT.OBJECT (\TEXTMENU.TOGGLE.CREATE - (MKATOM (fetch (MB.TOGGLE MBTEXT) of DESC)) - (fetch (MB.TOGGLE MBFONT) of DESC) - (fetch (MB.TOGGLE MBCHANGESTATEFN) of DESC) - (fetch (MB.TOGGLE MBINITSTATE) of DESC)) - MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.NWAY (* ; - "N-way buttons; choosing one turns the others off.") - (SETQ OBJ (MB.CREATE.NWAYBUTTON (fetch (MB.NWAY MBBUTTONS) of DESC) - (fetch (MB.NWAY MBFONT) of DESC) - (fetch (MB.NWAY MBCHANGESTATEFN) of DESC) - (fetch (MB.NWAY MBINITSTATE) of DESC) - (fetch (MB.NWAY MBMAXITEMSPERLINE) of DESC))) - (TEDIT.INSERT.OBJECT OBJ MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MENU (* ; - "Real menu, except the selection sticks") - (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC)) - MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.MARGINBAR (* ; "Margin ruler for TEdit formatting") - (TEDIT.INSERT.OBJECT (MARGINBAR.CREATE -0.5 -0.5 -39.5 NIL 12) - MENUTSTREAM CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.TEXT (* ; - "Arbitrary text, which will be protected from the user.") - (TEDIT.INSERT MENUTSTREAM (fetch (MB.TEXT MBSTRING) of DESC) - CH#) - (CL:WHEN (fetch (MB.TEXT MBFONT) of DESC) - (TEDIT.LOOKS MENUTSTREAM (LIST 'MBFONT (fetch (MB.TEXT MBFONT) - of DESC)) - CH# - (NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED ON) - CH# - (NCHARS (fetch (MB.TEXT MBSTRING) of DESC))) - (add CH# (NCHARS (fetch (MB.TEXT MBSTRING) of DESC)))) - (MB.INSERT (* ; - "An insertion point, with optional text to put there") - (TEDIT.INSERT MENUTSTREAM " {}" CH#) - (TEDIT.LOOKS MENUTSTREAM '(PROTECTED ON) - CH# 4) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTSTREAM) - '(PROTECTED ON SELECTPOINT ON) - (IPLUS CH# 2) - 1) - (OR CH#1 (SETQ CH#1 (IPLUS CH# 3))) - [COND - ((fetch (MB.INSERT MBINITENTRY) of DESC) - (* ; - "There is an initial entry to be made. Make it") - [COND - ((IMAGEOBJP (fetch (MB.INSERT MBINITENTRY) of DESC)) - (* ; "It is an imageobj.") - (TEDIT.INSERT.OBJECT (fetch (MB.INSERT MBINITENTRY) - of DESC) - MENUTSTREAM - (IPLUS CH# 3))) - (T (* ; "It's regular text.") - (TEDIT.INSERT MENUTSTREAM (MKSTRING (fetch (MB.INSERT - MBINITENTRY - ) - of DESC)) - (IPLUS CH# 3] - [TEDIT.LOOKS MENUTSTREAM '(PROTECTED OFF SELECTPOINT OFF) - (IPLUS CH# 3) - (NCHARS (MKSTRING (fetch (MB.INSERT MBINITENTRY) - of DESC] - (add CH# (NCHARS (fetch (MB.INSERT MBINITENTRY) of DESC] - (add CH# 4)) - (\ILLEGAL.ARG DESC))) - (SETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of MENUTSTREAM) - MENUFLG T) (* ; "Remember that this is a menu") - (CL:WHEN CH#1 (* ; - "We actually inserted some text, so it makes sense to put up a selection at") - (PUTTEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of MENUTSTREAM) - 'SEL CH#1)) - MENUTSTREAM]) ) (RPAQQ TEXTMENUICON #*(16 24)@@@@@@@@@@@@H@@@L@@AK@@GHLAIHCFAJ@HAKFKIJJJAJBKIJBJAH@KIJDHAKDJIJLJIJDJIJDJIH@KIF@HFAHIH@FN@@@H@ @@ -2227,84 +1051,102 @@ -(* ; "TEdit-specific support") +(* ; "Generic support for Tedit menus") (DEFINEQ -(\TEDITMENU.CREATE - [LAMBDA NIL (* gbn "27-Sep-84 01:04") - (* Creates the TEdit Expanded Menu) - (SETQ TEDIT.EXPANDED.MENU (\TEXTMENU.DOC.CREATE TEDIT.EXPANDEDMENU.SPEC]) +(\TEDIT.MENU.CREATE + [LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 17-Dec-2024 08:53 by rmk") + (* ; "Edited 22-Aug-2024 11:09 by rmk") + (* ; "Edited 21-Aug-2024 09:54 by rmk") + (* ; "Edited 14-Aug-2024 09:40 by rmk") + (* ; "Edited 9-Aug-2024 16:01 by rmk") + (* ; "Edited 3-Aug-2024 12:35 by rmk") + (* ; "Edited 27-Jul-2024 12:10 by rmk") + (* ; "Edited 19-Sep-2023 14:36 by rmk") + (* ; "Edited 16-Sep-2023 13:03 by rmk") + (* ; "Edited 13-Aug-2022 23:11 by rmk") + (* ; "Edited 31-Jan-2022 22:48 by rmk") + (* ; "Edited 12-Jun-90 19:00 by mitani") -(\TEDIT.EXPANDED.MENU - [LAMBDA (STREAM) (* ; "Edited 27-Feb-2024 08:11 by rmk") - (* ; "Edited 22-Sep-2023 20:00 by rmk") - (* ; "Edited 19-Sep-2023 08:51 by rmk") - (* ; "Edited 20-Aug-87 16:51 by jds") - (* ; "'27-Sep-84 01:04' gbn") - (LET (CHARMENUTEXTSTREAM (TEXTOBJ (TEXTOBJ STREAM))) - (\TEDIT.MENU.START (SETQ CHARMENUTEXTSTREAM (COPYTEXTSTREAM TEDIT.EXPANDED.MENU T)) - (\TEDIT.PRIMARYW TEXTOBJ) - "TEdit Menu" - (HEIGHTIFWINDOW 60 T) - 'EXPANDED) - (COND - ((OR (GETTEXTPROP TEXTOBJ 'CLEARGET) - (GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialise the button") - (\TEXTMENU.SET.TOGGLE "Unformatted" 'ON CHARMENUTEXTSTREAM]) + (* ;; "Create the TEXTSTREAM for a menu, given a menu description. That stream is marked as a menu and passed to \TEDIT.MENU.START to get the menu up on screen") -(MB.DEFAULTBUTTON.FN - [LAMBDA (OBJ SEL W) (* ; "Edited 20-Mar-2024 11:03 by rmk") - (* ; "Edited 9-Mar-2024 11:43 by rmk") - (* ; "Edited 22-Feb-2024 23:26 by rmk") - (* ; "Edited 7-Feb-2024 23:07 by rmk") - (* ; "Edited 29-Jan-2024 17:22 by rmk") - (* ; "Edited 21-Oct-2022 18:46 by rmk") - (* ; "Edited 30-Mar-94 15:46 by jds") - (* ; - "MBFN for TEdit default menu item buttons.") - (PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of W))) - [MAINTEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of (WINDOWPROP W 'MAINWINDOW] - (MAINSEL (FGETTOBJ MAINTEXTOBJ SEL)) - PROC) - [COND - ((EQ (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE) - T) - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Edit operation in progress; please wait." T) - (RETURN)) - ((FGETTOBJ MAINTEXTOBJ EDITOPACTIVE) - (TEDIT.PROMPTPRINT MAINTEXTOBJ (CONCAT (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE) - " operation in progress; please wait.") - T) - (CL:UNLESS (EQ (FGETTOBJ MAINTEXTOBJ EDITOPACTIVE) - (IMAGEOBJPROP OBJ 'MBTEXT)) - (RETURN] - [COND - ((AND (SETQ PROC (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS)) - (PROCESSP PROC)) (* ; - "THE MAIN window has a live process behind it; go evaluate the button fn there.") - (PROCESS.EVAL PROC (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN) - OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL))) - ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) - (PROCESSP PROC)) (* ; - "This window has a live process behind it; go evaluate the button fn there.") - (PROCESS.EVAL PROC (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN) - OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL))) - (T (ADD.PROCESS (LIST (FUNCTION MB.DEFAULTBUTTON.ACTIONFN) - OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL] - (CL:WHEN (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - (GIVE.TTY.PROCESS W) - (DISMISS 20)) - (CL:WHEN (OR (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) - (EQ (WINDOWPROP W 'PROCESS) - (TTY.PROCESS))) (* ; - "If the TEDIT MENU still has the tty, give it back to the real TEdit.") - (GIVE.TTY.PROCESS (WINDOWPROP W 'MAINWINDOW))) + (LET [(MENUTSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10] + (MB.ADD MENUDESC MENUTSTREAM) + (SETSEL (TEXTSEL (GETTSTR MENUTSTREAM TEXTOBJ)) + SET NIL) + (SETTOBJ (GETTSTR MENUTSTREAM TEXTOBJ) + MENUFLG T) + MENUTSTREAM]) - (* ;; "Tell the menu button handler not to turn off this button--it's still active and will turn itself off.") +(\TEDIT.MENU.PARSE + [LAMBDA (MENUTEXTSTREAM STARTPIECE STOPIDENTIFIER) (* ; "Edited 22-Oct-2024 00:28 by rmk") + (* ; "Edited 6-Oct-2024 15:34 by rmk") + (* ; "Edited 29-Sep-2024 12:55 by rmk") + (* ; "Edited 7-Sep-2024 13:07 by rmk") + (* ; "Edited 31-Aug-2024 14:06 by rmk") + (* ; "Edited 29-Aug-2024 11:08 by rmk") + (* ; "Edited 21-Aug-2024 12:13 by rmk") + (* ; "Edited 16-Aug-2024 08:40 by rmk") + (* ; "Edited 10-Aug-2024 00:13 by rmk") - (RETURN 'DON'T]) + (* ;; "This is the generic parsing function for Tedit menus. It collects all of the specifications currently installed in the menu, and returns them in plist format. The IDENTIFIER and STATEFN of each menu imageobject determines its contribution to the result.") + + (* ;; "The STATEFN is given the PC containing its image object, and it returns the last PC that went into formulating the state property.") + + (* ;; "If the STATE after running the STATEFN is a list whose CAR looks like a property list, that is merged in to the top level. So this function can itself be used as a STATEFN for menu items that combine the information of other image objects.") + + (* ;; "Optional STARTPIEC and STOPIDENTIFIER permit confining the parse to a subregon of the menu. The parsing begins at STARTPIECE and ends after examining the first object with that identifier. The piece containing that identifier is stored as a property of the STARTPIECE object..") + + (for PC OBJ PROP STATE STATEFN inpieces (CL:IF STARTPIECE + (NEXTPIECE STARTPIECE) + (\TEDIT.FIRSTPIECE (fetch (TEXTSTREAM TEXTOBJ) + of MENUTEXTSTREAM))) + when [SETQ PROP (AND (SETQ OBJ (POBJ PC)) + (IMAGEOBJPROP OBJ 'IDENTIFIER] unless (IMAGEOBJPROP OBJ 'IGNORE) + join (CL:WHEN (SETQ STATEFN (IMAGEOBJPROP OBJ 'STATEFN)) + (SETQ PC (APPLY* STATEFN PC OBJ MENUTEXTSTREAM))) + (CL:UNLESS (IMAGEOBJPROP OBJ 'IGNORE) (* ; "Skip if DONTAPPLY or empty") + (SETQ STATE (IMAGEOBJPROP OBJ 'STATE)) (* ; + " LISTP CAR means a sub-property list") + (CL:UNLESS (EQ '**EMPTY** STATE) + (CL:IF (LISTP (CAR STATE)) + (APPEND (CAR STATE)) + (LIST PROP STATE)))) repeatuntil (CL:WHEN (AND STOPIDENTIFIER + (EQ STOPIDENTIFIER PROP) + (EQ OBJECT.PTYPE (PTYPE + STARTPIECE + ))) + (IMAGEOBJPROP (PCONTENTS STARTPIECE) + 'PARSEENDPIECE PC))]) + +(\TEDIT.MENU.NEUTRALIZE + [LAMBDA (OBJ MENUWINDOW MENUSEL MENUSTREAM) (* ; "Edited 20-Oct-2024 09:18 by rmk") + (* ; "Edited 19-Oct-2024 09:16 by rmk") + (* ; "Edited 6-Oct-2024 15:40 by rmk") + (* ; "Edited 31-Aug-2024 11:29 by rmk") + (* ; "Edited 25-Aug-2024 13:58 by rmk") + (* ; "Edited 22-Aug-2024 08:35 by rmk") + (* ; "Edited 16-Aug-2024 08:35 by rmk") + (* ; "Edited 29-Jul-2024 12:16 by rmk") + + (* ;; "Set all the fields of a PARAGRAPH LOOKS menu to neutral settings.") + + (RESETLST + (TEDIT.DEFER.UPDATES MENUSTREAM) (* ; "Turn of the NEUTRAL button") + (for PC OBJ inpieces (\TEDIT.FIRSTPIECE MENUSTREAM) when (SETQ OBJ (POBJ PC)) + do (SELECTQ (IMAGEOBJPROP OBJ 'IMAGECLASSNAME) + (3StateMenuButton + (IMAGEOBJPROP OBJ 'STATE 'NEUTRAL)) + (FieldPrefixButton + (SETQ PC (MB.FIELD.SETSTATEFN PC (OR (IMAGEOBJPROP OBJ 'INITSTATE) + '**EMPTY**) + MENUSTREAM))) + (ToggleButton (IMAGEOBJPROP OBJ 'STATE 'OFF)) + (NWayButton (MB.NWAY.SELECT OBJ T)) + (MarginRuler (MARGINBAR.NEUTRALIZE OBJ)) + NIL)) + (TEDIT.BACKTOMAIN MENUSTREAM))]) (\TEDITMENU.RECORD.UNFORMATTED [LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* ; "Edited 22-Sep-2023 20:06 by rmk") @@ -2312,2003 +1154,1499 @@ (PUTTEXTPROP (TEXTOBJ TEXTSTREAM) 'UNFORMATTEDPUT/GET (EQ NEWSTATE 'ON]) +) -(MB.DEFAULTBUTTON.ACTIONFN - [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXTOBJ MAINSEL) (* ; "Edited 15-Mar-2024 13:53 by rmk") - (* ; "Edited 9-Mar-2024 11:33 by rmk") + + +(* ;; "") + + + + +(* ;; "") + + + + +(* ; "DEFAULTMENU") + +(DEFINEQ + +(\TEDIT.DEFAULTMENU.CREATE + [LAMBDA NIL (* ; "Edited 8-Nov-2024 08:35 by rmk") + (* ; "Edited 22-Oct-2024 10:48 by rmk") + (* ; "Edited 20-Oct-2024 22:51 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 2-Sep-2024 23:48 by rmk") + (* ; "Edited 15-Aug-2024 12:19 by rmk") + (* ; "Edited 14-Aug-2024 09:34 by rmk") + (* ; "Edited 11-Aug-2024 11:43 by rmk") + (* ; "Edited 27-Jul-2024 21:09 by rmk") + (* ; "Edited 24-Jul-2024 18:34 by rmk") + (* gbn "27-Sep-84 01:04") + + (* ;; "Creates the TEdit Expanded Menu") + + (PROGN + (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") + + (FUNCTION \TEDIT.DEFAULTMENU.FN)) + (SETQ TEDIT.EXPANDED.MENU (\TEDIT.MENU.CREATE `((ACTION (LABEL "Quit") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + 5 + (ACTION (IDENTIFIER PAGELAYOUT) + (LABEL "Page layout") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + 5 + (ACTION (IDENTIFIER CHARLOOKS) + (LABEL "Char looks") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + 5 + (ACTION (IDENTIFIER PARALOOKS) + (LABEL "Para looks") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + 5 + (ACTION (LABEL "All") + (SELECTFN \TEDIT.DEFAULTMENU.FN) + (ACTION (LABEL "Unformatted") + (SELECTFN \TEDIT.DEFAULTMENU.FN))) + EOL + (ACTION (LABEL "Get") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + (FIELD (IDENTIFIER GETFILE) + (FIELDTYPE SYMBOL) + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + TAB + (ACTION (LABEL "Put") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + (FIELD (IDENTIFIER PUTFILE) + (FIELDTYPE SYMBOL) + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + TAB + (ACTION (LABEL "Include") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + (FIELD (IDENTIFIER INCLUDEFILE) + (FIELDTYPE SYMBOL) + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + EOL + (ACTION (LABEL "Find") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + (FIELD (IDENTIFIER FINDPATTERN) + (FIELDTYPE STRING)) + TAB + (ACTION (LABEL "Substitute") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + (FIELD (IDENTIFIER REPLACEMENT) + (FIELDTYPE SELECTION)) + (FIELD (IDENTIFIER PATTERN) + (PRELABEL "for") + (FIELDTYPE STRING)) + 3 + (TOGGLE (LABEL "Confirm")) + TAB + (TOGGLE (IDENTIFIER USENEWLOOKS) + (LABEL "Use New Looks")) + EOL + (ACTION (LABEL "Hardcopy") + (SELECTFN \TEDIT.DEFAULTMENU.FN)) + TAB + (FIELD (IDENTIFIER SERVER) + (PRELABEL "server:") + (FIELDTYPE SYMBOL)) + (FIELD (IDENTIFIER COPIES) + (PRELABEL "copies:") + (FIELDTYPE POSITIVENUMBER)) + 2 + (NWAY (IDENTIFIER SIDES) + (BUTTONS (One% Side Duplex))) + EOL TAB TAB (FIELD (IDENTIFIER MESSAGE/PHONE#) + (PRELABEL "Message/Phone#:") + (FIELDTYPE STRING]) + +(\TEDIT.EXPANDED.MENU + [LAMBDA (STREAM) (* ; "Edited 20-Aug-2024 15:46 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Feb-2024 08:11 by rmk") + (* ; "Edited 22-Sep-2023 20:00 by rmk") + (* ; "Edited 19-Sep-2023 08:51 by rmk") + (* ; "Edited 20-Aug-87 16:51 by jds") + (* ; "'27-Sep-84 01:04' gbn") + (LET (CHARMENUTEXTSTREAM (TEXTOBJ (TEXTOBJ STREAM))) + (\TEDIT.MENU.START (SETQ CHARMENUTEXTSTREAM (COPYTEXTSTREAM TEDIT.EXPANDED.MENU T)) + (\TEDIT.PRIMARYPANE TEXTOBJ) + "TEdit Menu" + (HEIGHTIFWINDOW 60 T) + 'EXPANDED) + (COND + ((OR (GETTEXTPROP TEXTOBJ 'CLEARGET) + (GETTEXTPROP TEXTOBJ 'CLEARPUT)) (* ; "initialise the button") + (MB.SET.TOGGLE "Unformatted" 'ON CHARMENUTEXTSTREAM]) + +(\TEDIT.DEFAULTMENU.FN + [LAMBDA (OBJ MENUSEL MENUW MENUSTREAM) (* ; "Edited 20-Oct-2024 10:02 by rmk") + (* ; "Edited 26-Aug-2024 09:32 by rmk") + (* ; "Edited 11-Aug-2024 11:31 by rmk") + (* ; "Edited 27-Jul-2024 11:42 by rmk") + (* ; "Edited 20-Mar-2024 11:03 by rmk") + (* ; "Edited 9-Mar-2024 11:43 by rmk") + (* ; "Edited 22-Feb-2024 23:26 by rmk") + (* ; "Edited 7-Feb-2024 23:07 by rmk") + (* ; "Edited 29-Jan-2024 17:22 by rmk") + (* ; "Edited 21-Oct-2022 18:46 by rmk") + (* ; "Edited 30-Mar-94 15:46 by jds") + + (* ;; "MBFN for the items of the default TEdit menu (the %"expanded%" menu). This sets up the context to call the \TEDIT.DEFAULTMENU.ACTIONFN, which actually interprets the button.") + + (PROG* ((MAINTEXTSTREAM (\TEDIT.MAINSTREAM MENUSTREAM)) + (EDITOPACTIVE (GETTOBJ (GETTSTR MAINTEXTSTREAM TEXTOBJ) + EDITOPACTIVE)) + FORM PROC) + (if (EQ EDITOPACTIVE T) + then (TEDIT.PROMPTPRINT MAINTEXTSTREAM "Edit operation in progress; please wait." T) + (RETURN) + elseif EDITOPACTIVE + then (TEDIT.PROMPTPRINT MAINTEXTSTREAM (CONCAT EDITOPACTIVE + " operation in progress; please wait.") + T) + (CL:UNLESS (EQ EDITOPACTIVE (IMAGEOBJPROP OBJ 'LABEL)) + (RETURN))) + (SETQ FORM (LIST (FUNCTION \TEDIT.DEFAULTMENU.ACTIONFN) + OBJ MENUSEL MENUW MENUSTREAM MAINTEXTSTREAM)) + (if [PROCESSP (SETQ PROC (WINDOWPROP (WINDOWPROP MENUW 'MAINWINDOW) + 'PROCESS] + then + (* ;; + "The MAIN window has a live process behind it; Evaluate the button fn there.") + + (PROCESS.EVAL PROC FORM) + elseif [PROCESSP (SETQ PROC (WINDOWPROP MENUW 'PROCESS] + then + (* ;; + "This menu window has a live process behind it; Evaluate the button fn here.") + + (PROCESS.EVAL PROC FORM) + else (ADD.PROCESS FORM)) + (TEDIT.BACKTOMAIN MENUSTREAM) + + (* ;; "Tell the menu button handler not to turn off this button--it's still active and will turn itself off.") + + (RETURN 'DON'T]) + +(\TEDIT.DEFAULTMENU.ACTIONFN + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM MAINSTREAM) (* ; "Edited 26-Nov-2024 23:30 by rmk") + (* ; "Edited 22-Oct-2024 10:54 by rmk") + (* ; "Edited 20-Oct-2024 15:40 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 2-Sep-2024 23:29 by rmk") + (* ; "Edited 28-Aug-2024 19:19 by rmk") + (* ; "Edited 12-Aug-2024 10:23 by rmk") + (* ; "Edited 9-Aug-2024 22:43 by rmk") + (* ; "Edited 27-Jul-2024 21:35 by rmk") + (* ; "Edited 7-Jul-2024 00:01 by rmk") + (* ; "Edited 30-Jun-2024 12:39 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 2-May-2024 13:48 by rmk") (* ; "Edited 27-Feb-2024 07:54 by rmk") (* ; "Edited 14-Dec-2023 21:03 by rmk") - (* ; "Edited 22-Sep-2023 20:09 by rmk") (* ; "Edited 20-Sep-2023 23:14 by rmk") - (* ; "Edited 9-May-2023 17:47 by rmk") (* ; "Edited 6-May-2023 23:11 by rmk") (* ; "Edited 18-Apr-2023 23:58 by rmk") (* ; "Edited 30-Mar-94 16:04 by jds") (* ;  "MBFN for TEdit default menu item buttons.") - (PROG (OFILE CH %#COPIES PRINTHOST PRINTOPTIONS %#SIDES MSG) - [ERSETQ (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE MAINTEXTOBJ) - '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) - '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - [RESETSAVE (PROG1 OBJ - (IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T)) - '(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL] - (SETTOBJ MAINTEXTOBJ EDITOPACTIVE (OR (IMAGEOBJPROP OBJ 'MBTEXT) - T)) - (* ; - "So we can tell the guy WHAT op is active.") - (SELECTQ (IMAGEOBJPROP OBJ 'MBTEXT) - (Put [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL SEL CH#] - [COND - (OFILE (* ; + (LET ((MENUTEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM))) + STATE) + [ERSETQ (RESETLST + [RESETSAVE (PROG1 OBJ + (IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T)) + '(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL] + (SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER) + (PUT (* ;  "Only try this if he really typed a file name") - (TEDIT.PUT MAINTEXTOBJ OFILE NIL (GETTEXTPROP TEXTOBJ - 'UNFORMATTEDPUT/GET]) - (Get [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL SEL CH#] - [COND - (OFILE (* ; - "Only try this if he really typed a file name") - (TEDIT.GET MAINTEXTOBJ OFILE (GETTEXTPROP TEXTOBJ - 'UNFORMATTEDPUT/GET]) - (Include [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL SEL CH#] - (COND - (OFILE (TEDIT.INCLUDE MAINTEXTOBJ OFILE)))) - (Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (GETSEL SEL CH#))) - [COND - ((ZEROP (NCHARS OFILE)) (* ; "NOTHING--HE HIT DEL.") - NIL) - (OFILE (* ; - "There's something to do. Go do it.") - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Searching..." T) - [SETQ CH (CAR (ERSETQ (TEDIT.FIND MAINTEXTOBJ OFILE NIL NIL - T] - (COND - (CH (* ; "We found the target text.") - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Done.") - (\TEDIT.SHOWSEL MAINSEL NIL) - (SETSEL MAINSEL CH# (CAR CH)) - (* ; - "Set up SELECTION to be the found text") - (SETSEL MAINSEL CHLIM (ADD1 (CADR CH))) - [SETSEL MAINSEL DCH (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] - (SETSEL MAINSEL POINT 'RIGHT) - (FSETTOBJ MAINTEXTOBJ CARETLOOKS ( - \TEDIT.GET.INSERT.CHARLOOKS - MAINTEXTOBJ - MAINSEL)) - (* ; - "Set the caret looks to match those of the new selection") - (\TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL - MAINTEXTOBJ) - (* ; "And never pending a deletion.") - (\TEDIT.FIXSEL MAINSEL MAINTEXTOBJ) - (TEDIT.NORMALIZECARET MAINTEXTOBJ MAINSEL) - (\TEDIT.SHOWSEL MAINSEL T)) - (T (TEDIT.PROMPTPRINT MAINTEXTOBJ "(Not found)"]) - (Substitute [PROG* ((SAVECH# (GETSEL SEL CH#)) - (REPLACEMENT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (GETSEL SEL CH#))) - (PATTERN (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ) - CHLIM))) - CONFIRM? KEEPLOOKS? LOC) - (SETQ LOC (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (GETSEL (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ) - CHLIM))) - [SETQ CONFIRM? (EQ 'ON (IMAGEOBJPROP (CAR LOC) - 'STATE] - [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ - (ADD1 (CDR LOC] - [SETQ KEEPLOOKS? (EQ 'ON (IMAGEOBJPROP (CAR LOC) - 'STATE] - (COND - ((ZEROP (NCHARS PATTERN)) - (* ; "NOTHING--HE HIT DEL.") - NIL) - (PATTERN (* ; - "There's something to do. Go do it.") - (CL:WHEN KEEPLOOKS? - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ SAVECH# T - ) - - (* ;; - "Get the replacement out of the menu to copy into the main text.") - - (SETQ REPLACEMENT - (\TEDIT.SELPIECES (fetch (TEXTOBJ - SCRATCHSEL - ) - of TEXTOBJ)))) - (RESETLST - (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE MAINTEXTOBJ PATTERN - REPLACEMENT CONFIRM?))]) - (Quit (* ; "He wants to QUIT the edit.") - (COND - ((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXTOBJ) - T) - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T)))) - (Page% Layout (* ; "Page layout menu") - (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) - (\TEDIT.PRIMARYW MAINTEXTOBJ) - "Page Layout Menu" - (HEIGHTIFWINDOW 135 5) - 'PAGE)) - (Para% Looks (* ; "Page layout menu") - (\TEDIT.EXPANDEDPARA.MENU MAINTEXTOBJ)) - (Char% Looks (* ; "Page layout menu") - (\TEDIT.EXPANDEDCHARLOOKS.MENU MAINTEXTOBJ)) - (All (* ; "Select the entire document.") - (COND - ((NOT (ZEROP (TEXTLEN MAINTEXTOBJ))) - (\TEDIT.SHOWSEL MAINSEL NIL) - (\TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL MAINTEXTOBJ) - (SETSEL MAINSEL CH# 1) - (SETSEL MAINSEL CHLIM (ADD1 (TEXTLEN MAINTEXTOBJ))) - (SETSEL MAINSEL DCH (TEXTLEN MAINTEXTOBJ)) - (SETSEL MAINSEL POINT 'LEFT) - (SETSEL MAINSEL SET T) - (\TEDIT.FIXSEL MAINSEL MAINTEXTOBJ) - (\TEDIT.SHOWSEL MAINSEL T)))) - (Hardcopy [SETQ PRINTHOST (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL SEL CH#] - (COND - ((NOT PRINTHOST) (* ; - "If he didn't specify a particular host, defer to his defaults.") - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Using default print server.") - )) - (SETQ %#COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER - TEXTOBJ - (GETSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - CH#))) - (* ; - "Grab the field that specifies number of copies.") - [COND - (%#COPIES (SETQ PRINTOPTIONS (LIST '%#COPIES %#COPIES] - (SETQ %#SIDES - (SELECTQ (IMAGEOBJPROP (CAR (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (GETSEL (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ) - CHLIM))) - 'STATE) - (One% Side 1) - (Duplex 2) - NIL)) - [COND - (%#SIDES (push PRINTOPTIONS %#SIDES) - (push PRINTOPTIONS '%#SIDES] - [SETQ MSG (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (GETSEL (fetch (TEXTOBJ - SCRATCHSEL) - of TEXTOBJ) - CH#] - [COND - (MSG (push PRINTOPTIONS MSG) - (push PRINTOPTIONS 'MESSAGE] - (TEDIT.HARDCOPY MAINTEXTOBJ NIL NIL NIL PRINTHOST PRINTOPTIONS)) - (ERROR)))] - (SETSEL SEL SET T) (* ; + (SETQ STATE (MB.GET 'PUTFILE MENUTEXTOBJ 'STATE MENUSEL)) + (if STATE + then (TEDIT.PUT MAINSTREAM STATE NIL (GETTEXTPROP MAINSTREAM + 'UNFORMATTEDPUT/GET)) + else (TEDIT.PROMPTPRINT MAINSTREAM "Put file not specified" T))) + (GET (SETQ STATE (MB.GET 'GETFILE MENUTEXTOBJ 'STATE MENUSEL)) + (if STATE + then (TEDIT.GET MAINSTREAM STATE (GETTEXTPROP MAINSTREAM + 'UNFORMATTEDPUT/GET)) + else (TEDIT.PROMPTPRINT MAINSTREAM "Get file not specified" T))) + (INCLUDE (SETQ STATE (MB.GET 'INCLUDEFILE MENUTEXTOBJ 'STATE MENUSEL)) + (if STATE + then (TEDIT.INCLUDE MAINSTREAM STATE) + else (TEDIT.PROMPTPRINT MAINSTREAM "Include file not specified" T + ))) + (FIND (SETQ STATE (MB.GET 'FINDPATTERN MENUTEXTOBJ 'STATE MENUSEL)) + (if (IGEQ 1 (NCHARS STATE)) + then (\TEDIT.KEY.FIND MAINSTREAM NIL NIL NIL NIL STATE) + else (TEDIT.PROMPTPRINT MAINSTREAM "Search pattern not specified" T) + )) + (SUBSTITUTE [LET* [(STATES (MB.GET '(REPLACEMENT PATTERN CONFIRM USENEWLOOKS + ) + MENUTEXTOBJ + 'STATE MENUSEL)) + (REPLACEMENT (LISTGET STATES 'REPLACEMENT)) + (PATTERN (LISTGET STATES 'PATTERN] + (CL:UNLESS (ZEROP (NCHARS PATTERN)) + (SETQ REPLACEMENT (CL:IF (EQ 'ON (LISTGET STATES + 'USENEWLOOKS)) + (\TEDIT.SELPIECES REPLACEMENT + NIL MENUTEXTOBJ) + (TEDIT.SEL.AS.STRING MENUSTREAM + REPLACEMENT))) + [TEDIT.SUBSTITUTE MAINSTREAM PATTERN (OR REPLACEMENT + "") + (EQ 'ON (LISTGET STATES 'CONFIRM])]) + (QUIT (* ; "Is it OK to quit the main edit?") + (\TEDIT.FINISHEDIT? MAINSTREAM)) + (PAGELAYOUT (* ; "Page layout menu") + (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) + (\TEDIT.PRIMARYPANE MAINSTREAM) + "Page Layout Menu" + (HEIGHTIFWINDOW 135 5) + 'PAGE)) + (PARALOOKS (* ; "Page layout menu") + (\TEDIT.EXPANDEDPARA.MENU MAINSTREAM)) + (CHARLOOKS (* ; "Page layout menu") + (\TEDIT.EXPANDEDCHAR.MENU MAINSTREAM)) + (ALL (* ; "Select the entire document.") + (TEDIT.SETSEL MAINSTREAM 1 (TEXTLEN (TEXTOBJ MAINSTREAM)) + 'LEFT)) + (HARDCOPY (LET* ((STATES (MB.GET '(SERVER COPIES SIDES MESSAGE/PHONE#) + MENUTEXTOBJ + 'STATE MENUSEL)) + (SERVER (LISTGET STATES 'SERVER)) + (COPIES (LISTGET STATES 'COPIES)) + (SIDES (LISTGET STATES 'SIDES)) + (MSG (LISTGET STATES 'MESSAGE/PHONE#)) + PRINTOPTIONS) + (CL:UNLESS (AND SERVER (SETQ SERVER (\TEDIT.MAKEFILENAME + SERVER))) + (TEDIT.PROMPTPRINT MAINSTREAM + "Using default print server.")) + (CL:WHEN COPIES + (SETQ PRINTOPTIONS (LIST '%#COPIES COPIES))) + (CL:WHEN SIDES + (push PRINTOPTIONS '%#SIDES (SELECTQ SIDES + (One% Side 1) + (Duplex 2) + NIL))) + (CL:WHEN MSG + (push PRINTOPTIONS 'MESSAGE (\TEDIT.MAKEFILENAME MSG))) + (TEDIT.HARDCOPY MAINSTREAM NIL NIL NIL SERVER PRINTOPTIONS))) + (ERROR)))] + (SETSEL MENUSEL SET T) (* ;  "Now turn the menu button highlighting off.") - (SETSEL SEL ONFLG T) - (\TEDIT.SHOWSEL SEL NIL) (* ; + (SETSEL MENUSEL ONFLG T) + (\TEDIT.SHOWSEL MENUSEL NIL MENUTEXTOBJ) (* ;  "And forget that anything is selected.") - (SETSEL SEL SET NIL]) + (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]) ) + + + +(* ;; "") + + + + +(* ;; "") + + + + +(* ; "PARAMENU") + (DEFINEQ -(\TEDIT.CHARLOOKSMENU.CREATE - [LAMBDA NIL (* ; "Edited 20-Aug-87 16:50 by jds") - (* ; "Creates the TEdit Expanded Menu") - (SETQ TEDIT.CHARLOOKS.MENU (\TEXTMENU.DOC.CREATE (APPEND (LIST (create MB.BUTTON - MBLABEL _ 'APPLY - MBBUTTONEVENTFN _ - '\TEDIT.APPLY.CHARLOOKS) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ 'SHOW - MBBUTTONEVENTFN _ - '\TEDIT.SHOW.CHARLOOKS) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ 'NEUTRAL - MBBUTTONEVENTFN _ - - ' - \TEDIT.NEUTRALIZE.CHARLOOKS - ) - (create MB.TEXT - MBSTRING _ " -")) - TEDIT.CHARLOOKSMENU.SPEC]) +(\TEDIT.PARAMENU.CREATE + [LAMBDA NIL (* ; "Edited 8-Nov-2024 08:35 by rmk") + (* ; "Edited 20-Oct-2024 23:46 by rmk") + (* ; "Edited 6-Oct-2024 15:35 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 31-Aug-2024 14:54 by rmk") + (* ; "Edited 25-Aug-2024 23:47 by rmk") + (* ; "Edited 24-Aug-2024 21:45 by rmk") + (* ; "Edited 15-Aug-2024 12:17 by rmk") + (* ; "Edited 14-Aug-2024 09:36 by rmk") + (* ; "Edited 11-Aug-2024 17:46 by rmk") + (* ; "Edited 5-Aug-2024 10:19 by rmk") + (* ; "Edited 29-Jul-2024 23:47 by rmk") + (* ; "Edited 27-Jul-2024 10:18 by rmk") + (* jds " 2-Aug-84 15:32") -(\TEDIT.EXPANDEDCHARLOOKS.MENU - [LAMBDA (STREAM) (* ; "Edited 27-Feb-2024 07:56 by rmk") + (* ;; "Creates the TEdit Expanded Paragraph Menu. (PROGN to suppress %"value of comment used? compile-time messages.)") + + (PROGN + (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") + + (FUNCTION \TEDIT.APPLY.PARALOOKS) + (FUNCTION \TEDIT.SHOW.PARALOOKS) + (FUNCTION \TEDIT.MENU.NEUTRALIZE) + (FUNCTION \TEDIT.TABTYPE.SET)) + (SETQ TEDIT.EXPANDEDPARA.MENU (\TEDIT.MENU.CREATE `((ACTION (LABEL APPLY) + (IGNORE T) + (SELECTFN \TEDIT.APPLY.PARALOOKS)) + 3 + (ACTION (LABEL SHOW) + (IGNORE T) + (SELECTFN \TEDIT.SHOW.PARALOOKS)) + 3 + (ACTION (LABEL NEUTRAL) + (IGNORE T) + (SELECTFN \TEDIT.MENU.NEUTRALIZE)) + EOL + (NWAY (IDENTIFIER QUAD) + (BUTTONS (Left Right Centered Justified + )) + (INITSTATE OFF)) + TAB + (3STATE (IDENTIFIER TYPE) + (LABEL "Page Heading")) + 2 + (FIELD (IDENTIFIER SUBTYPE) + (PRELABEL "type") + (FIELDTYPE SYMBOL)) + EOL + (FIELD (IDENTIFIER LINELEADING) + (PRELABEL "Line leading") + (POSTLABEL "pts") + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + (FIELD (PRELABEL " Para leading") + (POSTLABEL "pts") + (IDENTIFIER PARALEADING) + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + (FIELD (IDENTIFIER SPECIALX) + (PRELABEL " Special Locn: X") + (POSTLABEL "picas") + (FIELDTYPE PICAS) + (LABELFONT (HELVETICA 8))) + (FIELD (IDENTIFIER SPECIALY) + (PRELABEL " Y") + (POSTLABEL "picas") + (FIELDTYPE PICAS) + (LABELFONT (HELVETICA 8))) + EOL + (TEXT (STRING "New Page: ") + (FONT (HELVETICA 8))) + (3STATE (IDENTIFIER NEWPAGEBEFORE) + (LABEL "Before")) + 2 + (3STATE (IDENTIFIER NEWPAGEAFTER) + (LABEL "After")) + 4 + (3STATE (IDENTIFIER HEADINGKEEP) + (LABEL "Keep heading")) + (TEXT (STRING " Display mode: ") + (FONT (HELVETICA 8))) + (3STATE (LABEL "Hardcopy")) + 4 EOL (TEXT (STRING "Tab Type: ") + (FONT (HELVETICA 8))) + (NWAY (IDENTIFIER TABTYPE) + (BUTTONS (Left Right Centered Decimal)) + (IGNORE T)) + 3 + (TOGGLE (IDENTIFIER DOTTEDLEADER) + (LABEL "Dotted Leader") + (IGNORE T)) + (FIELD (IDENTIFIER DEFAULTTAB) + (PRELABEL " Default Tab:") + (POSTLABEL "pts") + (FIELDTYPE NUMBER) + (LABELFONT (HELVETICA 8))) + EOL + ((PROGN (TEDIT.INSERT.OBJECT + (MARGINBAR.CREATE -0.5 -0.5 -39.5 + NIL 12) + MENUTSTREAM CH# '(PROTECTED OFF)) + 1)) + EOL]) + +(\TEDIT.APPLY.PARALOOKS + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Oct-2024 10:02 by rmk") + (* ; "Edited 29-Sep-2024 14:57 by rmk") + (* ; "Edited 25-Aug-2024 09:15 by rmk") + (* ; "Edited 21-Aug-2024 12:28 by rmk") + (* ; "Edited 11-Aug-2024 18:31 by rmk") + (* ; "Edited 22-Apr-93 16:45 by jds") + + (* ;; "Handler for the Paragraph Menu's APPLY button. ") + + (\TEDIT.CHANGE.PARALOOKS (\TEDIT.MAINSTREAM MENUSTREAM) + (\TEDIT.MENU.PARSE MENUSTREAM)) + (TEDIT.BACKTOMAIN MENUSTREAM]) + +(\TEDIT.SHOW.PARALOOKS + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Oct-2024 11:11 by rmk") + (* ; "Edited 29-Sep-2024 14:59 by rmk") + (* ; "Edited 25-Aug-2024 09:15 by rmk") + (* ; "Edited 3-Aug-2024 19:05 by rmk") + (* ; "Edited 27-Jul-2024 17:26 by rmk") + (* ; "Edited 14-Jul-2024 11:57 by rmk") + (* ; "Edited 11-Jul-2024 11:14 by rmk") + (* ; "Edited 6-Jul-2024 23:40 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 18-May-2024 17:15 by rmk") + (* ; "Edited 27-Mar-2024 15:11 by rmk") + (* ; "Edited 20-Jul-2023 17:00 by rmk") + (* ; "Edited 3-May-2023 10:40 by rmk") + (* ; "Edited 22-Aug-2022 13:17 by rmk") + (* ; "Edited 30-May-91 22:17 by jds") + + (* ;; "Set the PARALOOKS menu from the fmtspec of the currently selected paragraph. MENUSTREAM is the displaystream of the paralooks menu window.") + + (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.") + (* ; "") + (LET* ((MENUTEXTOBJ (GETTSTR MENUSTREAM TEXTOBJ)) + (MAINTEXTOBJ (GETTSTR (\TEDIT.MAINSTREAM MENUSTREAM) + TEXTOBJ)) + (MAINCH# (GETSEL (TEXTSEL MAINTEXTOBJ) + CH#))) + (CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXTOBJ)) + (RESETLST + (TEDIT.DEFER.UPDATES MENUSTREAM) + (\TEDIT.PARAMENU.FILLIN MENUSTREAM (PPARALOOKS (\TEDIT.CHTOPC MAINCH# MAINTEXTOBJ)) + )) + (FSETSEL MENUSEL ONFLG T) + (\TEDIT.UPDATE.SEL (TEXTSEL MENUTEXTOBJ) + 1 0 'LEFT) + (\TEDIT.FIXSEL (TEXTSEL MENUTEXTOBJ) + MENUTEXTOBJ) + (TEDIT.BACKTOMAIN MENUSTREAM))]) + +(\TEDIT.EXPANDEDPARA.MENU + [LAMBDA (TSTREAM) (* ; "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 (COPYTEXTSTREAM TEDIT.EXPANDEDPARA.MENU T) + (\TEDIT.PRIMARYPANE TSTREAM) + "Paragraph-Looks Menu" + (HEIGHTIFWINDOW 141 T) + 'PARALOOKS]) + +(\TEDIT.PARAMENU.FILLIN + [LAMBDA (MENUSTREAM FMTSPEC) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 31-Aug-2024 11:29 by rmk") + (* ; "Edited 25-Aug-2024 23:48 by rmk") + (* ; "Edited 24-Aug-2024 21:46 by rmk") + (* ; "Edited 16-Aug-2024 08:36 by rmk") + (* ; "Edited 14-Aug-2024 00:15 by rmk") + (* ; "Edited 9-Aug-2024 12:00 by rmk") + (* ; "Edited 5-Aug-2024 00:40 by rmk") + + (* ;; "For the paragraph menu SHOW command, fills in the with values drawn from the FMTSPEC of the main documents selectiont. The strategy is to iterate through the image objects in the MENUTEXTOBJ and figure out from their property what aspect of FMTSPEC they depict.") + + (for PC OBJ VAL PROP SETSTATEFN inpieces (\TEDIT.FIRSTPIECE (fetch (TEXTSTREAM TEXTOBJ) + of MENUSTREAM)) + when [SETQ SETSTATEFN (AND (SETQ OBJ (POBJ PC)) + (SETQ PROP (IMAGEOBJPROP OBJ 'IDENTIFIER)) + (IMAGEOBJPROP OBJ 'SETSTATEFN] + do + (* ;; "These are the properties of the PARAMENU image objects. ") + + (SETQ VAL (SELECTQ PROP + (QUAD (FGETPARA FMTSPEC QUAD)) + (LINELEADING (FGETPARA FMTSPEC LINELEAD)) + (PARALEADING (FGETPARA FMTSPEC LEADBEFORE)) + (SPECIALX (* ; "0 means don't for these") + (CL:IF (AND (FGETPARA FMTSPEC FMTSPECIALX) + (IGREATERP (FGETPARA FMTSPEC FMTSPECIALX) + 0)) + (FGETPARA FMTSPEC FMTSPECIALX) + '**EMPTY**)) + (SPECIALY (CL:IF (AND (FGETPARA FMTSPEC FMTSPECIALY) + (IGREATERP (FGETPARA FMTSPEC FMTSPECIALY) + 0)) + (FGETPARA FMTSPEC FMTSPECIALY) + '**EMPTY**)) + (NEWPAGEBEFORE (FGETPARA FMTSPEC FMTNEWPAGEBEFORE)) + (NEWPAGEAFTER (FGETPARA FMTSPEC FMTNEWPAGEAFTER)) + (HEADINGKEEP (FGETPARA FMTSPEC FMTHEADINGKEEP)) + (HARDCOPY (FGETPARA FMTSPEC FMTHARDCOPY)) + (DEFAULTTAB (FGETPARA FMTSPEC FMTDEFAULTTAB)) + (TABTYPE (* ; "Doesn't change") + (IMAGEOBJPROP OBJ 'STATE)) + (TYPE (* ; "Presumably PAGEHEADING here") + (CL:IF (EQ 'PAGEHEADING (FGETPARA FMTSPEC FMTPARATYPE)) + 'ON + 'OFF)) + (SUBTYPE (FGETPARA FMTSPEC FMTPARASUBTYPE)) + (DOTTEDLEADER (* ; + "Ephemeral property of individual tabs") + 'OFF) + (MARGINBAR [\TEDIT.FMTSPECTOMARBAR FMTSPEC (fetch (MARGINBAR MARUNIT) + of (IMAGEOBJPROP OBJ + 'OBJECTDATUM]) + (TABTYPE (\TEDIT.THELP)) + (\TEDIT.THELP PROP))) + + (* ;; "Eventually, replace SHOULDNT with SETQ SETSTATEFN NIL") + + (CL:WHEN SETSTATEFN + (SETQ PC (APPLY* SETSTATEFN PC VAL MENUSTREAM)) + (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ))]) +) + + + +(* ;; "") + + + + +(* ;; "") + + + + +(* ; "CHARMENU") + +(DEFINEQ + +(\TEDIT.CHARMENU.CREATE + [LAMBDA (TSTREAM) (* ; "Edited 16-Dec-2024 23:41 by rmk") + (* ; "Edited 20-Oct-2024 22:22 by rmk") + (* ; "Edited 6-Oct-2024 15:34 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 15-Aug-2024 12:11 by rmk") + (* ; "Edited 14-Aug-2024 09:35 by rmk") + (* ; "Edited 11-Aug-2024 17:46 by rmk") + (* ; "Edited 9-Aug-2024 12:02 by rmk") + (* ; "Edited 7-Aug-2024 23:14 by rmk") + (* ; "Edited 29-Jul-2024 10:07 by rmk") + (* ; "Edited 27-Jul-2024 12:11 by rmk") + (* ; "Edited 24-Jul-2024 18:09 by rmk") + (* ; "Edited 20-Aug-87 16:50 by jds") + (* ; "Creates the TEdit Expanded Menu") + + (* ;; "Produces a CHARLOOKS menu specialized to TSTREAM") + + (PROGN + (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") + + (FUNCTION \TEDIT.APPLY.CHARLOOKS) + (FUNCTION \TEDIT.SHOW.CHARLOOKS) + (FUNCTION \TEDIT.MENU.NEUTRALIZE)) + (SETQ TEDIT.CHARLOOKS.MENU (\TEDIT.MENU.CREATE `((ACTION (LABEL APPLY) + (IGNORE T) + (SELECTFN \TEDIT.APPLY.CHARLOOKS)) + 3 + (ACTION (LABEL SHOW) + (IGNORE T) + (SELECTFN \TEDIT.SHOW.CHARLOOKS)) + 3 + (ACTION (LABEL NEUTRAL) + (IGNORE T) + (SELECTFN \TEDIT.MENU.NEUTRALIZE)) + EOL + ,@(\TEDIT.CHARMENU.SPEC TSTREAM]) + +(\TEDIT.CHARMENU.SPEC + [LAMBDA (TSTREAM) (* ; "Edited 22-Dec-2024 00:22 by rmk") + (* ; "Edited 20-Dec-2024 12:27 by rmk") + (* ; "Edited 17-Dec-2024 14:32 by rmk") + (* ; "Edited 8-Nov-2024 08:35 by rmk") + (* ; "Edited 22-Oct-2024 12:44 by rmk") + (* ; "Edited 20-Oct-2024 23:17 by rmk") + (* ; "Edited 19-Oct-2024 09:14 by rmk") + (* ; "Edited 6-Oct-2024 21:36 by rmk") + (* ; "Edited 29-Sep-2024 21:45 by rmk") + (* ; "Edited 31-Aug-2024 14:35 by rmk") + (* ; "Edited 28-Aug-2024 23:04 by rmk") + (* ; "Edited 15-Aug-2024 12:18 by rmk") + (* ; "Edited 13-Aug-2024 22:53 by rmk") + (* ; "Edited 11-Aug-2024 00:21 by rmk") + (* ; "Edited 9-Aug-2024 23:13 by rmk") + (* ; "Edited 3-Aug-2024 13:53 by rmk") + (* ; "Edited 31-Jul-2024 23:46 by rmk") + (* ; "Edited 27-Jul-2024 10:16 by rmk") + + (* ;; "This is shared by the CHARLOOKS and PAGE menus (for page numbers). ") + + (* ;; "Note: PAGEMENU.CHARLOOKS.STATEFN assumes that DISTANCE is a later object") + + (PROGN + (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") + + (FUNCTION \TEDIT.OFFSETTYPE.STATEFN) + (FUNCTION \TEDIT.OTHER.STATECHANGEFN) + (FUNCTION \TEDIT.OTHER.SELECTFN)) + (LET [(FAMILIES (APPEND '(Classic Helvetica Modern Terminal TimesRoman] + (CL:WHEN (TEXTOBJ TSTREAM T) + [SETQ FAMILIES (UNION FAMILIES (TEXTPROP TSTREAM 'FAMILIES] + (for C N in (FGETTOBJ (TEXTOBJ TSTREAM) + TXTCHARLOOKSLIST) + eachtime (SETQ N (L-CASE (OR (AND (type? FONTCLASS (FGETCLOOKS C CLFONT)) + (fetch (FONTCLASS FONTCLASSNAME) + of (FGETCLOOKS C CLFONT))) + (FGETCLOOKS C CLNAME)) + T)) unless (thereis F in FAMILIES + suchthat (EQ N (L-CASE F T))) + do (push FAMILIES N))) + (SORT FAMILIES) + (SUBST FAMILIES 'FONTFAMILIES `((TEXT (STRING "Props: ") + (FONT (HELVETICA 8))) + (3STATE (LABEL Bold)) + 3 + (3STATE (LABEL Italic)) + 3 + (3STATE (LABEL Underline)) + 3 + (3STATE (LABEL Strikeout)) + 3 + (3STATE (LABEL Overline)) + 3 + (3STATE (LABEL Unbreakable)) + EOL + (NWAY (IDENTIFIER FAMILY) + (BUTTONS FONTFAMILIES) + (MAXITEMS/LINE 7)) + EOL + (TOGGLE (LABEL Other) + (IGNORE T) + (STATECHANGEFN \TEDIT.OTHER.STATECHANGEFN) + (SELECTFN \TEDIT.OTHER.SELECTFN + (FUNCTION \TEDIT.OTHER.STATECHANGEFN))) + 3 + (FIELD (IDENTIFIER OTHERFAMILY) + (IGNORE T) + (PRELABEL "other font:") + (FIELDTYPE SYMBOL) + (EMPTYVALUE NIL)) + EOL + (FIELD (IDENTIFIER SIZE) + (PRELABEL "Size:") + (FIELDTYPE NUMBER)) + 3 + (NWAY (IDENTIFIER OFFSETTYPE) + (BUTTONS (Normal Superscript Subscript)) + (STATEFN \TEDIT.OFFSETTYPE.STATEFN)) + (FIELD (IDENTIFIER DISTANCE) + (PRELABEL " distance:") + (POSTLABEL " ") + (FIELDTYPE CARDINAL) + (INITSTATE 2) + (EMPTYVALUE 2) + (IGNORE T)) + 1]) + +(\TEDIT.CHARMENU.PARSE + [LAMBDA (MENUSTREAM CH#) (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 28-Aug-2024 16:12 by rmk") + (* ; "Edited 16-Aug-2024 08:37 by rmk") + (* ; "Edited 9-Aug-2024 17:59 by rmk") + (* ; "Edited 6-Aug-2024 10:43 by rmk") + (* ; "Edited 2-Aug-2024 18:00 by rmk") + (* ; "Edited 27-Jul-2024 21:57 by rmk") + (* ; "Edited 26-Jul-2024 16:29 by rmk") + (* ; "Edited 25-Jul-2024 12:02 by rmk") + (* ; "Edited 2-May-2024 13:48 by rmk") + (* ; "Edited 10-Apr-2024 10:18 by rmk") + (* ; "Edited 25-Feb-2024 22:26 by rmk") + (* ; "Edited 24-Jul-2023 17:10 by rmk") + (* ; "Edited 30-May-91 22:18 by jds") + + (* ;; "MBFN for TEdit charlooks menu buttons. For a new font, this does not change the menu if the font doesn't exist.") + + (LET ((TEXTOBJ (TEXTOBJ MENUSTREAM)) + NEWLOOKS TEXT OFFSET DISTANCE FONTCLASS) + [SETQ NEWLOOKS (for PC OBJ PROP STATE STATEFN inpieces (CL:IF CH# + (\TEDIT.CHTOPC CH# TEXTOBJ) + (\TEDIT.FIRSTPIECE TEXTOBJ)) + when [SETQ PROP (AND (SETQ OBJ (POBJ PC)) + (IMAGEOBJPROP OBJ 'IDENTIFIER] + join (CL:WHEN (SETQ STATEFN (IMAGEOBJPROP OBJ 'STATEFN)) + (SETQ PC (APPLY* STATEFN PC OBJ TEXTOBJ))) + (CL:UNLESS (IMAGEOBJPROP OBJ 'DONTAPPLY) + (* ; "Presumably used by someone else to set the menu, not the document directly, so we don't return anything") + (SETQ STATE (IMAGEOBJPROP OBJ 'STATE)) + (CL:WHEN (AND STATE (NEQ 'NEUTRAL STATE)) + (* ; + "Don't propagate NIL or NEUTRAL. OFF means off. LISTP CAR means a sub-property list") + (CL:IF (LISTP (CAR STATE)) + (APPEND (CAR STATE)) + (LIST PROP STATE))))] + NEWLOOKS]) + +(\TEDIT.CHARMENU.FILLIN + [LAMBDA (STARTINGPC CHARLOOKS MENUSTREAM) (* ; "Edited 20-Dec-2024 12:18 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 20-Oct-2024 00:03 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 28-Aug-2024 23:41 by rmk") + (* ; "Edited 16-Aug-2024 10:16 by rmk") + (* ; "Edited 9-Aug-2024 11:59 by rmk") + (* ; "Edited 7-Aug-2024 14:00 by rmk") + (* ; "Edited 6-Aug-2024 10:54 by rmk") + (* ; "Edited 3-Aug-2024 14:34 by rmk") + + (* ;; "Given a TEXTOBJ describing a charlooks(sub) menu and a source CHARLOOKS , fill in the menu fields. The strategy is to iterate through the image objects in the MENUTEXTOBJ and figure out from their property what aspect of CHARLOOKS they depict.") + + (* ;; "If the CHARLOOKS are not at the end of the file, the run of charlooks image objects should be followed by a fence post that causes a return with the fence post PC.") + + (CL:WHEN CHARLOOKS + (for PC OBJ VAL SETSTATEFN inpieces (CL:IF STARTINGPC + (NEXTPIECE STARTINGPC) + (\TEDIT.FIRSTPIECE (GETTSTR MENUSTREAM TEXTOBJ))) + when [AND (SETQ OBJ (POBJ PC)) + (SETQ SETSTATEFN (IMAGEOBJPROP OBJ 'SETSTATEFN] + do + (* ;; "These are the properties of the CHARMENU image objects") + + [SETQ VAL (SELECTQ (IMAGEOBJPROP OBJ 'IDENTIFIER) + (BOLD (FGETCLOOKS CHARLOOKS CLBOLD)) + (ITALIC (FGETCLOOKS CHARLOOKS CLITAL)) + (UNDERLINE (FGETCLOOKS CHARLOOKS CLULINE)) + (STRIKEOUT (FGETCLOOKS CHARLOOKS CLSTRIKE)) + (OVERLINE (FGETCLOOKS CHARLOOKS CLOLINE)) + (UNBREAKABLE (FGETCLOOKS CHARLOOKS CLUNBREAKABLE)) + (FAMILY (L-CASE (OR (AND (type? FONTCLASS (GETCLOOKS CHARLOOKS CLFONT)) + (fetch (FONTCLASS FONTCLASSNAME) + of (GETCLOOKS CHARLOOKS CLFONT))) + (FGETCLOOKS CHARLOOKS CLNAME)) + T)) + (SIZE (FGETCLOOKS CHARLOOKS CLSIZE)) + (OFFSETTYPE (CL:WHEN (SETQ VAL (FGETCLOOKS CHARLOOKS CLOFFSET)) + (if (IGREATERP VAL 0) + then 'SUPERSCRIPT + elseif (ILESSP VAL 0) + then 'SUBSCRIPT + else 'NORMAL))) + ((OTHER OTHERFAMILY) + NIL) + (DISTANCE (CL:UNLESS (ZEROP (FGETCLOOKS CHARLOOKS CLOFFSET)) + (ABS (FGETCLOOKS CHARLOOKS CLOFFSET)))) + (\TEDIT.THELP (IMAGEOBJPROP OBJ 'IDENTIFIER] + + (* ;; "Eventually, replace SHOULDNT with SETQ SETSTATEFN NIL") + + (CL:WHEN SETSTATEFN + (SETQ PC (PROG1 (APPLY* SETSTATEFN PC VAL MENUSTREAM) + (* ; "Provide OBJ's PC for the change") + (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC)))) finally (RETURN PC)))]) + +(\TEDIT.SHOW.CHARLOOKS + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 2-Nov-2024 20:16 by rmk") + (* ; "Edited 20-Oct-2024 09:55 by rmk") + (* ; "Edited 29-Sep-2024 14:59 by rmk") + (* ; "Edited 25-Aug-2024 09:13 by rmk") + (* ; "Edited 7-Aug-2024 13:58 by rmk") + (* ; "Edited 3-Aug-2024 19:06 by rmk") + (* ; "Edited 27-Jul-2024 17:26 by rmk") + (* ; "Edited 14-Jul-2024 11:57 by rmk") + (* ; "Edited 11-Jul-2024 11:14 by rmk") + (* ; "Edited 6-Jul-2024 23:40 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 18-May-2024 17:15 by rmk") + (* ; "Edited 27-Mar-2024 15:11 by rmk") + (* ; "Edited 20-Jul-2023 17:00 by rmk") + (* ; "Edited 3-May-2023 10:40 by rmk") + (* ; "Edited 22-Aug-2022 13:17 by rmk") + (* ; "Edited 30-May-91 22:17 by jds") + + (* ;; "Set the CHARLOOKS menu from the looks of the currently selected character. MENUSTREAM is the displaystream of the charlooks menu window, or the page-format menu that also has a character looks section for page numbers.") + + (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.") + + (LET* ((MENUTEXTOBJ (GETTSTR MENUSTREAM TEXTOBJ)) + (MAINTEXTOBJ (GETTSTR (\TEDIT.MAINSTREAM MENUSTREAM) + TEXTOBJ)) + (MAINCH# (GETSEL (TEXTSEL MAINTEXTOBJ) + CH#))) + (CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXTOBJ)) (* ; + "Fill in the menu objects and fields with that info") + (RESETLST + (TEDIT.DEFER.UPDATES MENUSTREAM) + (\TEDIT.CHARMENU.FILLIN (\TEDIT.FIRSTPIECE MENUTEXTOBJ) + (PLOOKS (\TEDIT.CHTOPC MAINCH# MAINTEXTOBJ)) + MENUSTREAM)) + (FSETSEL MENUSEL ONFLG T) + (\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT) + (\TEDIT.FIXSEL MENUSEL MENUTEXTOBJ)) + (TEDIT.BACKTOMAIN MENUSTREAM]) + +(\TEDIT.EXPANDEDCHAR.MENU + [LAMBDA (TSTREAM) (* ; "Edited 17-Dec-2024 00:04 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 27-Feb-2024 07:56 by rmk") (* ; "Edited 20-Sep-2023 23:13 by rmk") (* ; "Edited 10-Oct-2022 00:23 by rmk") (* ; "Edited 20-Aug-87 16:49 by jds") (* ;; "Open a character-looks menu.") - (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.CHARLOOKS.MENU T) - (\TEDIT.PRIMARYW STREAM) + (\TEDIT.MENU.START (\TEDIT.CHARMENU.CREATE TSTREAM) + (\TEDIT.PRIMARYPANE TSTREAM) "Character Looks Menu" (HEIGHTIFWINDOW 75 T) 'CHARLOOKS]) -(\TEDIT.APPLY.BOLDNESS - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:55") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'WEIGHT (CONS 'BOLD NEWLOOKS))) - (OFF (CONS 'WEIGHT (CONS 'MEDIUM NEWLOOKS))) - NEWLOOKS]) - (\TEDIT.APPLY.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:12 by rmk") + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Oct-2024 09:39 by rmk") + (* ; "Edited 6-Oct-2024 15:39 by rmk") + (* ; "Edited 29-Sep-2024 14:56 by rmk") (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 16-Feb-2024 21:21 by rmk") (* ; "Edited 18-Apr-2023 23:55 by rmk") (* ; "Edited 21-Oct-2022 18:47 by rmk") (* ; "Edited 30-May-91 22:17 by jds") - (* ;; "MBFN for TEdit default menu item buttons.") + (* ;; "Handler for the Character Menu's APPLY button. ") - (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - [MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) - of (WINDOWPROP W 'MAINWINDOW] - (CH# (ADD1 (FGETSEL SEL CH#))) - NEWLOOKS) - (\TEDIT.SHOWSEL SEL NIL) (* ; "Turn off the APPLY button.") - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "Skip over the SHOW button") - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "And over the NEUTRAL button.") - (SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ CH#)) - (* ; - "Now Parse the menu, to give us a looks spec.") - (TEDIT.LOOKS MAINTEXTOBJ NEWLOOKS) (* ; "Make the change in looks") - (* ; - "Leave him typing in the real document") - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) + (\TEDIT.CHANGE.CHARLOOKS (\TEDIT.MAINSTREAM MENUSTREAM) + (\TEDIT.MENU.PARSE MENUSTREAM)) + (TEDIT.BACKTOMAIN MENUSTREAM]) -(\TEDIT.APPLY.OLINE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'OVERLINE (CONS 'ON NEWLOOKS))) - (OFF (CONS 'OVERLINE (CONS 'OFF NEWLOOKS))) - NEWLOOKS]) +(\TEDIT.OFFSETTYPE.STATEFN + [LAMBDA (TYPEPC TYPEOBJ TEXTOBJ) (* ; "Edited 22-Oct-2024 12:53 by rmk") + (* ; "Edited 6-Oct-2024 17:44 by rmk") + (* ; "Edited 29-Sep-2024 12:57 by rmk") + (* ; "Edited 31-Aug-2024 14:15 by rmk") + (* ; "Edited 28-Aug-2024 19:14 by rmk") + (* ; "Edited 12-Aug-2024 10:23 by rmk") + (* ; "Edited 9-Aug-2024 23:15 by rmk") + (* ; "Edited 6-Aug-2024 10:39 by rmk") + (* ; "Edited 2-Aug-2024 13:22 by rmk") -(\TEDIT.APPLY.UNBREAKABLE - [LAMBDA (BUTTON NEWLOOKS) (* ; "Edited 24-Jul-2023 17:10 by rmk") - (* jds "30-Aug-84 13:56") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'UNBREAKABLE (CONS 'ON NEWLOOKS))) - (OFF (CONS 'UNBREAKABLE (CONS 'OFF NEWLOOKS))) - NEWLOOKS]) + (* ;; "STATEFN for the OFFSETTYPE NWAY button. This coerces the button's state from e.g. (OFFSETTYPE SUPERSCRIPT) to (SUPERSCRIPT 5) if DISTANCE is 5. Distance comes from the DISTANCE field later in the menu.") -(\TEDIT.SHOW.CHARLOOKS - [LAMBDA (OBJ SEL MENUSTREAM) (* ; "Edited 27-Mar-2024 15:11 by rmk") - (* ; "Edited 20-Mar-2024 11:03 by rmk") - (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 25-Feb-2024 23:27 by rmk") - (* ; "Edited 20-Jul-2023 17:00 by rmk") - (* ; "Edited 3-May-2023 10:40 by rmk") - (* ; "Edited 22-Aug-2022 13:17 by rmk") - (* ; "Edited 30-May-91 22:17 by jds") + [LET ((SELECTED (IMAGEOBJPROP TYPEOBJ 'SELECTED)) + DISTANCE) + (CL:WHEN SELECTED + (SETQ DISTANCE (IMAGEOBJPROP (MB.GET 'DISTANCE TEXTOBJ 'OBJECT TYPEPC) + 'STATE)) + (IMAGEOBJPROP TYPEOBJ 'STATE (CONS (SELECTQ (IMAGEOBJPROP SELECTED 'IDENTIFIER) + (SUPERSCRIPT (LIST 'SUPERSCRIPT DISTANCE)) + (SUBSCRIPT (LIST 'SUBSCRIPT DISTANCE)) + ((NORMAL NIL) + (LIST 'SUPERSCRIPT 0)) + NIL))))] + TYPEPC]) - (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that are updating an image object.") +(\TEDIT.OTHER.STATECHANGEFN + [LAMBDA (OTHEROBJ NEWSTATE MENUSTREAM MENUSEL) (* ; "Edited 22-Oct-2024 12:30 by rmk") + (* ; "Edited 20-Oct-2024 17:59 by rmk") + (* ; "Edited 19-Oct-2024 11:55 by rmk") + (* ; "Edited 7-Sep-2024 13:25 by rmk") + (* ; "Edited 31-Aug-2024 14:24 by rmk") - (* ;; "MENUSTREAM is the displaystream of the charlooks menu window.") + (* ;; "Don't turn OTHER on unless OTHERFAMILY looks good. If it's good, the OTHER.SELECTFN will move it to the FAMILY list and empty the OTHERFAMILY.") - (* ;; "Set the CHARLOOKS menu from the looks of the currently selected character.") + (CL:WHEN (EQ 'ON NEWSTATE) + (LET ((OTHERFAM (MB.GET 'OTHERFAMILY MENUSTREAM 'STATE MENUSEL))) + (if (NULL OTHERFAM) + then (TEDIT.PROMPTPRINT MENUSTREAM "OTHER font is not specified" T T) + 'DON'T + elseif (NOT (OR [AND (BOUNDP (U-CASE OTHERFAM)) + (type? FONTCLASS (GETATOMVAL (U-CASE OTHERFAM] + (FONTSAVAILABLE OTHERFAM '* '* 0 'DISPLAY T))) + then (TEDIT.PROMPTPRINT MENUSTREAM (CONCAT "Can't find OTHER font " OTHERFAM) + T T) + 'DON'T)))]) - (LET* ((TEXTOBJ (TEXTOBJ! (GETSEL SEL SELTEXTOBJ))) - [MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) - of (WINDOWPROP MENUSTREAM 'MAINWINDOW] - (MAINCH# (GETSEL (GETTOBJ MAINTEXTOBJ SEL) - CH#)) - (CH# (ADD1 (GETSEL SEL CH#))) - PC NEWLOOKS) - (CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXTOBJ)) - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "Skip over the NEUTRAL button.") - (\TEDIT.SHOWSEL SEL NIL) - (SETSEL SEL SET NIL) - (SETQ PC (\TEDIT.CHTOPC MAINCH# MAINTEXTOBJ)) (* ; - "The PIECE containing the text to describe") - (SETQ NEWLOOKS (PLOOKS PC)) (* ; - "Get the looks for those characters.") - (* ; - "Fill in the menu blanks with that info") - (TEDIT.DEFERRED-UPDATES TEXTOBJ (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# NEWLOOKS)) - (TTY.PROCESS (WINDOWPROP (\TEDIT.PRIMARYW MAINTEXTOBJ) - 'PROCESS)))]) +(\TEDIT.OTHER.SELECTFN + [LAMBDA (OTHEROBJ MENUDS MENUSEL MENUSTREAM) (* ; "Edited 22-Dec-2024 00:22 by rmk") + (* ; "Edited 7-Nov-2024 21:55 by rmk") + (* ; "Edited 22-Oct-2024 12:38 by rmk") + (* ; "Edited 20-Oct-2024 22:11 by rmk") -(\TEDIT.NEUTRALIZE.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 15-Mar-2024 14:23 by rmk") - (* ; "Edited 25-Feb-2024 23:30 by rmk") - (* ; "Edited 19-Dec-2023 13:40 by rmk") - (* ; "Edited 18-Apr-2023 23:55 by rmk") - (* ; "Edited 21-Oct-2022 18:50 by rmk") - (* ; "Edited 30-May-91 22:18 by jds") + (* ;; "If OTHER is selected, turn off any other family. Family is before, OTHERFAMILY is after.") - (* ;; "Handle the NEUTRAL button on a character looks menu. Sets all the menu settings neutral.") + (CL:WHEN (EQ 'ON (IMAGEOBJPROP OTHEROBJ 'STATE)) + [LET* ((FAMARG (MB.GET 'FAMILY MENUSTREAM '(OBJECT STARTPC) + MENUSEL T)) + (OTHERFAMARG (MB.GET 'OTHERFAMILY MENUSTREAM '(OBJECT STARTPC) + MENUSEL)) + (OTHERFAMOBJ (CAR OTHERFAMARG)) + (OTHERFAM (L-CASE (IMAGEOBJPROP OTHERFAMOBJ 'STATE) + T)) + (MAINTEXTOBJ (TEXTOBJ (\TEDIT.MAINSTREAM MENUSTREAM) + T))) + (APPLY* (IMAGEOBJPROP (CAR FAMARG) + 'SETSTATEFN) + (CADR FAMARG) + OTHERFAM MENUSTREAM) - (LET [(TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - (CH# (ADD1 (FGETSEL SEL CH#] - (\TEDIT.SHOWSEL SEL NIL) - (FSETSEL SEL SET NIL) - (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* ; - "Fill in the menu blanks with that info and update the menu's screen image") - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) + (* ;; + "Note: OTHER must be turned off before the OTHERFAM field is cleared: clearing moves MENUSEL.") -(\TEDIT.FILL.IN.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 20-Mar-2024 11:03 by rmk") - (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 13-Nov-2023 09:55 by rmk") - (* ; "Edited 24-Jul-2023 21:09 by rmk") - (* ; "Edited 18-Apr-2023 23:55 by rmk") - (* ; "Edited 30-May-91 22:28 by jds") - - (* ;; "Given a TEXTOBJ describing a charlooks menu, the CH# of the start of the charlooks menu, and a set of looks, fill in the menu fields.") - - (TEXTOBJ! TEXTOBJ) - (LET (PC OFILE CH NEXTB BUTTON TEXT OFFSET (SCRATCHSEL (FGETTOBJ TEXTOBJ SCRATCHSEL))) - (SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKS NIL TEXTOBJ)) - - (* ;; "Make sure the charlooks are in the proper internal format, so this fn can be called from every reasonable place.") - - [for PROP in (LIST (fetch (CHARLOOKS CLBOLD) of NEWLOOKS) - (fetch (CHARLOOKS CLITAL) of NEWLOOKS) - (fetch (CHARLOOKS CLULINE) of NEWLOOKS) - (fetch (CHARLOOKS CLSTRIKE) of NEWLOOKS) - (fetch (CHARLOOKS CLOLINE) of NEWLOOKS) - (fetch (CHARLOOKS CLUNBREAKABLE) of NEWLOOKS)) - do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - [COND - (PROP (* ; "Must set the property") - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - 'ON)) - (T (* ; "Must reset it.") - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - 'OFF] - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (* ; "Get to the start of the text.") - (SETQ BUTTON (CAR NEXTB)) - [for ITEM in (IMAGEOBJPROP BUTTON 'BUTTONS) - do (* ; - "Loop thru the font FAMILY name button list, looking for one that matches this text's looks") - (COND - ((STRING-EQUAL [COND - ((AND (type? FONTCLASS (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) - (NEQ (fetch FONTCLASSNAME of (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - 'DEFAULTFONT)) - (CONCAT (fetch FONTCLASSNAME of (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - '-class)) - ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) - 'FAMILY] - ITEM) - (IMAGEOBJPROP BUTTON 'STATE ITEM) - (RETURN))) finally (* ; - "This font wasn't found in the list. Add it.") - [MB.NWAYBUTTON.ADDITEM BUTTON - (COND - ((type? FONTCLASS (fetch (CHARLOOKS CLFONT) - of NEWLOOKS)) - (PACK* (fetch FONTCLASSNAME of (fetch (CHARLOOKS - CLFONT) - of NEWLOOKS)) - '-class)) - ((FONTP (fetch (CHARLOOKS CLFONT) of NEWLOOKS)) - (FONTPROP (fetch (CHARLOOKS CLFONT) of NEWLOOKS) - 'FAMILY] - (* ; - "Add this family to the list of items") - (IMAGEOBJPROP BUTTON 'STATE (U-CASE (FONTPROP (fetch (CHARLOOKS - CLFONT) - of NEWLOOKS) - 'FAMILY] - (* ; - "Now find which text button was 'on'") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL) (* ; "Clean out the 'other font' field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (fetch (CHARLOOKS CLSIZE) of NEWLOOKS)) (* ; "Set the value in the SIZE field") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#] - (* ; - "Move forward to the SUPERSCRIPT/SUBSCRIPT button") - (SETQ BUTTON (CAR NEXTB)) - (SETQ OFFSET (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS)) - (* ; - "Remember the offset value for later") - [COND - ((OR (NOT (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS)) - (ZEROP (fetch (CHARLOOKS CLOFFSET) of NEWLOOKS))) - (* ; - "There is no subscript or superscript. Mark the text NORMAL.") - (IMAGEOBJPROP BUTTON 'STATE 'Normal) - (SETQ OFFSET NIL) (* ; - "Mark there as being no offset value") - ) - ((ILESSP OFFSET 0) (* ; "SUBSCRIPTING") - (IMAGEOBJPROP BUTTON 'STATE 'Subscript)) - ((IGREATERP OFFSET 0) (* ; "SUBSCRIPTING") - (IMAGEOBJPROP BUTTON 'STATE 'Superscript] - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - (AND OFFSET (IABS OFFSET))) (* ; - "Now move up to the offset distance fill-in field.") - (\TEDIT.SHOWSEL SCRATCHSEL NIL) - (SETSEL SCRATCHSEL SET NIL) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 (GETSEL SCRATCHSEL CH#]) - -(\TEDIT.NEUTRALIZE.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 19-Dec-2023 13:40 by rmk") - (* ; "Edited 20-Jul-2023 17:00 by rmk") - (* ; "Edited 13-Sep-2022 12:06 by rmk") - (* ; "Edited 30-May-91 22:18 by jds") - - (* ;; - "Set all the fields in the CHARLOOKS menu specified by TEXTOBJ to neutral values, starting at CH#.") - - (LET (NEXTB BUTTON) - (TEDIT.DEFERRED-UPDATES TEXTOBJ - - (* ;; "PROP makes sure we mark the right number of property buttons") - - [for PROP in '(BOLD ITAL ULINE STRIKE OLINE UNBREAKABLE) - do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - 'NEUTRAL) - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* ; "Get to the start of the text.") - (SETQ BUTTON (CAR NEXTB)) - (IMAGEOBJPROP BUTTON 'STATE NIL) (* ; - "Now find which text button was 'on'") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL) (* ; "Clean out the 'other font' field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) (* ; "Set the value in the SIZE field") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#] - (* ; - "Move forward to the SUPERSCRIPT/SUBSCRIPT button") - (SETQ BUTTON (CAR NEXTB)) (* ; - "Remember the offset value for later") - (IMAGEOBJPROP BUTTON 'STATE NIL) (* ; - "Now move up to the offset distance fill-in field.") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL]) - -(\TEDIT.PARSE.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 10-Apr-2024 10:18 by rmk") - (* ; "Edited 25-Feb-2024 22:26 by rmk") - (* ; "Edited 24-Jul-2023 17:10 by rmk") - (* ; "Edited 30-May-91 22:18 by jds") - - (* ;; "MBFN for TEdit default menu item buttons. For a new font, this should not change the menu if the font doesn't exist...but it does.") - - (LET - ((SCRATCHSEL (GETTOBJ TEXTOBJ SCRATCHSEL)) - NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT UTEXT OFFSET FONTCLASS) - [for BUTTON in '(BOLD ITALIC UNDERLINE STRIKEOUT OVERSCORE UNBREAKABLE) - do (* ; - "Set the independent character properties") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SELECTQ BUTTON - (BOLD (SETQ NEWLOOKS (\TEDIT.APPLY.BOLDNESS (CAR NEXTB) - NEWLOOKS))) - (ITALIC (SETQ NEWLOOKS (\TEDIT.APPLY.SLOPE (CAR NEXTB) - NEWLOOKS))) - (UNDERLINE (SETQ NEWLOOKS (\TEDIT.APPLY.ULINE (CAR NEXTB) - NEWLOOKS))) - (STRIKEOUT (SETQ NEWLOOKS (\TEDIT.APPLY.STRIKEOUT (CAR NEXTB) - NEWLOOKS))) - (OVERSCORE (SETQ NEWLOOKS (\TEDIT.APPLY.OLINE (CAR NEXTB) - NEWLOOKS))) - (UNBREAKABLE (SETQ NEWLOOKS (\TEDIT.APPLY.UNBREAKABLE (CAR NEXTB) - NEWLOOKS))) - NIL) - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - - (* ;; "We're now at the start of the fonts.") - - (SETQ BUTTON (CAR NEXTB)) - (CL:WHEN BUTTON (* ; - "This has all the current fonts, plus Other") - [SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (Other (* ; - "Have to get and add in a new font.") - [SETQ TEXT (MBUTTON.NEXT.FIELD.AS.ATOM TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ UTEXT (U-CASE TEXT)) - (if (NOT TEXT) - then (TEDIT.PROMPTPRINT TEXTOBJ - "'Other' font not specified, font-family not changed" T) - elseif [FMEMB UTEXT (U-CASE (IMAGEOBJPROP BUTTON 'BUTTONS] - then - (* ;; "Family already in the list, select it") - - [IMAGEOBJPROP BUTTON 'STATE (find NAME in (IMAGEOBJPROP BUTTON - 'BUTTONS) - suchthat (EQ UTEXT (U-CASE NAME] - (TEDIT.DELETE TEXTOBJ SCRATCHSEL) - (* ; - "Delete the new font's name from the fill-in field.") - (TEDIT.OBJECT.CHANGED TEXTOBJ BUTTON) - (if [AND (BOUNDP UTEXT) - (type? FONTCLASS (SETQ FONTCLASS (GETATOMVAL UTEXT] - then (* ; "Fontclasses are global") - (push NEWLOOKS 'FONT FONTCLASS) - else (push NEWLOOKS 'FAMILY UTEXT)) - elseif (OR [AND (BOUNDP UTEXT) - (type? FONTCLASS (SETQ FONTCLASS (GETATOMVAL UTEXT] - (FONTSAVAILABLE UTEXT '* '* 0 'DISPLAY T)) - then - (* ;; - "A family or fontclass that exists but is not on the list, add it, select it, and update the menu ") - - (MB.NWAYBUTTON.ADDITEM BUTTON TEXT) - (IMAGEOBJPROP BUTTON 'STATE TEXT) - (TEDIT.DELETE TEXTOBJ SCRATCHSEL) - (* ; - "Delete the new font's name from the fill-in field.") - (TEDIT.OBJECT.CHANGED TEXTOBJ BUTTON) - (push NEWLOOKS 'FONT (OR FONTCLASS UTEXT)) - else - (* ;; "Tell him that the font doesn't exist, but don't update the menu") - - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Can't find Other font " TEXT - ", font-family not changed") - T))) - (PROGN (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) (* ; - "Not OTHER, skip over other-font fill-in") - - (* ;; - "Old funky code, font class indicated by e.g. DEFAULTFONT-class ?? Grab the name and evaluate it.") - - (if [type? FONTCLASS (SETQ FONTCLASS - (GETATOMVAL (CL:IF (STRPOS '-class (IMAGEOBJPROP - BUTTON - 'STATE)) - [SUBATOM (IMAGEOBJPROP BUTTON 'STATE) - 1 - (SUB1 (STRPOS '-class - (IMAGEOBJPROP - BUTTON - 'STATE] - (IMAGEOBJPROP BUTTON 'STATE))] - then (push NEWLOOKS 'FONT FONTCLASS) - else (push NEWLOOKS 'FAMILY (IMAGEOBJPROP BUTTON 'STATE]) - - (* ;; "Now interpret other buttons and fields") - - [SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - (* ; - "Read the contents of the SIZE menu field") - (CL:WHEN SIZE (* ; "He specified one. Set it.") - (push NEWLOOKS 'SIZE SIZE)) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - (* ; - "Get a handle on the SUPERSCRIPT/SUBSCRIPT button") - (SETQ BUTTON (CAR NEXTB)) - (SETQ SUPER (IMAGEOBJPROP BUTTON 'STATE)) (* ; "Decide which kind it is") - [SETQ OFFSET (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (CDR NEXTB] - (* ; - "And get the offset distance, in points.") - (SELECTQ SUPER - (Superscript (* ; - "Offset the characters by either the given distance or 2 pts.") - (push NEWLOOKS 'SUPERSCRIPT (OR OFFSET 2))) - (Subscript (* ; - " Offset the characters by either the given distance or 2 pts.") - (push NEWLOOKS 'SUBSCRIPT (OR OFFSET 2))) - (Normal (* ; - "NORMAL => Turn off all super and subscripting") - (push NEWLOOKS 'SUPERSCRIPT 0)) - NIL) - NEWLOOKS]) - -(\TEDIT.APPLY.SLOPE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'SLOPE (CONS 'ITALIC NEWLOOKS))) - (OFF (CONS 'SLOPE (CONS 'REGULAR NEWLOOKS))) - NEWLOOKS]) - -(\TEDIT.APPLY.STRIKEOUT - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'STRIKEOUT (CONS 'ON NEWLOOKS))) - (OFF (CONS 'STRIKEOUT (CONS 'OFF NEWLOOKS))) - NEWLOOKS]) - -(\TEDIT.APPLY.ULINE - [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (CONS 'UNDERLINE (CONS 'ON NEWLOOKS))) - (OFF (CONS 'UNDERLINE (CONS 'OFF NEWLOOKS))) - NEWLOOKS]) + (APPLY* (IMAGEOBJPROP OTHEROBJ 'SETSTATEFN) + MENUSEL + 'OFF MENUSTREAM) + (APPLY* (IMAGEOBJPROP OTHERFAMOBJ 'SETSTATEFN) + (CADR OTHERFAMARG) + NIL MENUSTREAM) + (CL:WHEN MAINTEXTOBJ (* ; + "Save families for future menu creation") + [\TEDIT.TEXTPROP MAINTEXTOBJ 'FAMILIES T (UNION (CONS OTHERFAM) + (\TEDIT.TEXTPROP MAINTEXTOBJ + 'FAMILIES])])]) ) + + + +(* ;; "") + + + + +(* ;; "") + + + + +(* ; "PAGEMENU") + (DEFINEQ -(\TEDITPARAMENU.CREATE - [LAMBDA NIL (* jds " 2-Aug-84 15:32") - (* Creates the TEdit Expanded - Paragraph Menu) - (SETQ TEDIT.EXPANDEDPARA.MENU (\TEXTMENU.DOC.CREATE TEDIT.PARAMENU.SPEC]) +(\TEDIT.PAGEMENU.CREATE + [LAMBDA (TSTREAM) (* ; "Edited 17-Dec-2024 00:08 by rmk") + (* ; "Edited 20-Oct-2024 23:47 by rmk") + (* ; "Edited 6-Oct-2024 15:35 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 15-Aug-2024 23:13 by rmk") + (* ; "Edited 14-Aug-2024 09:35 by rmk") + (* ; "Edited 10-Aug-2024 00:16 by rmk") + (* ; "Edited 30-Jul-2024 00:10 by rmk") + (* ; "Edited 27-Jul-2024 11:28 by rmk") + (* ; "Edited 24-Jul-2024 18:09 by rmk") + (* gbn " 8-Oct-84 18:25") -(\TEDIT.EXPANDEDPARA.MENU - [LAMBDA (STREAM) (* ; "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 (COPYTEXTSTREAM TEDIT.EXPANDEDPARA.MENU T) - (\TEDIT.PRIMARYW (TEXTOBJ STREAM)) - "Paragraph-Looks Menu" - (HEIGHTIFWINDOW 141 T) - 'PARALOOKS]) + (* ;; "Creates the TEdit Page Menu") -(\TEDIT.APPLY.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 20-Mar-2024 11:04 by rmk") - (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 9-Mar-2024 11:54 by rmk") - (* ; "Edited 1-Mar-2024 20:33 by rmk") - (* ; "Edited 26-Feb-2024 11:41 by rmk") - (* ; "Edited 17-Dec-2023 17:04 by rmk") - (* ; "Edited 18-Apr-2023 23:55 by rmk") - (* ; "Edited 7-Apr-2023 18:57 by rmk") - (* ; "Edited 3-Mar-2023 23:30 by rmk") - (* ; "Edited 10-Feb-2023 16:51 by rmk") - (* ; "Edited 21-Oct-2022 18:51 by rmk") - (* ; "Edited 6-Oct-2022 16:44 by rmk") - (* ; "Edited 1-Oct-2022 16:34 by rmk") - (* ; "Edited 22-Apr-93 16:45 by jds") + (PROGN + (* ;; "Hack so Masterscope knows that these otherwise quoted functions are here.") - (* ;; "Handler for the Paragraph Menu's APPLY button. Collects the specs from the paragraph menu and calls TEDIT.PARALOOKS to effect the change.") + (FUNCTION \TEDIT.APPLY.PAGELOOKS) + (FUNCTION \TEDIT.SHOW.PAGELOOKS) + (FUNCTION \TEDIT.PAGEMENU.CHARLOOKS.STATEFN) + (FUNCTION \TEDIT.PAGEMENU.HEADINGS.STATEFN) + (FUNCTION \TEDIT.PAGEMENU.CHARLOOKS.STATEFN) + (FUNCTION \TEDIT.CHARMENU.FILLIN) + (FUNCTION \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN)) + (SETQ TEDIT.EXPANDED.PAGEMENU (\TEDIT.MENU.CREATE `((ACTION (LABEL APPLY) + (IGNORE T) + (SELECTFN \TEDIT.APPLY.PAGELOOKS)) + 3 + (ACTION (LABEL SHOW) + (IGNORE T) + (SELECTFN \TEDIT.SHOW.PAGELOOKS)) + 12 "Paper Size: " + (NWAY (IDENTIFIER PAPERSIZE) + (BUTTONS (Letter Legal A4)) + (INITSTATE Letter)) + 8 + (TOGGLE (LABEL "Landscape")) + EOL "For page: " + (NWAY (IDENTIFIER PAGEID) + (BUTTONS (|First(&Default)| Other% Left + Other% Right))) - (LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of W))) - [MAINTEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of (WINDOWPROP W 'MAINWINDOW] - (CH# (ADD1 (FGETSEL SEL CH#))) - SCRATCHSEL QUAD OFILE CH NEWLOOKS SIZE SUPER SUB LINELEAD PARALEAD DEFTAB BUTTON MARUNIT - NEXTB BUTTONDATA L1 LN R PARATYPE SPECIALX SPECIALY) - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "Skip the SHOW button") - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "and the NEUTRAL button.") - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) (* ; - "Get the JUSTIFICATION button: Left/Right/Centered/Justified") - (SETQ BUTTON (CAR NEXTB)) - (CL:WHEN (AND (SETQ QUAD (IMAGEOBJPROP BUTTON 'STATE)) - (NEQ QUAD 'OFF)) (* ; "A justification was specified") - (push NEWLOOKS 'QUAD (U-CASE (MKATOM QUAD)))) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (* ; "Go to the 'Page Heading' button") - (SETQ BUTTON (CAR NEXTB)) - [COND - [(EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; - "A page heading of a particular subtype") - (push NEWLOOKS 'TYPE 'PAGEHEADING 'SUBTYPE (MKATOM (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (ADD1 (CDR NEXTB] - [(EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; - "This paragraph IS NOT a page heading.") - (push NEWLOOKS 'TYPE NIL 'SUBTYPE NIL) - (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB] - (T (* ; "No change specified.") - (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB] - (CL:WHEN (SETQ LINELEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (FGETSEL SCRATCHSEL CH#))) - (* ; "Get any line leading") - (push NEWLOOKS 'LINELEADING LINELEAD)) - (CL:WHEN [SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] - (* ; "Get any paragraph leading") - (push NEWLOOKS 'PARALEADING PARALEAD)) - (CL:WHEN [SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] + (* ;; "") + + (* ;; "Page numbers") + + EOL EOL "Page numbers: " + (NWAY (IDENTIFIER PAGENOS) + (LABEL "Page numbers: ") + (BUTTONS (No Yes)) + (INITSTATE Yes)) + (FIELD (IDENTIFIER PAGENUMBERX) + (PRELABEL " X:") + (INITSTATE 25.5) + (FIELDTYPE NUMBER)) + (FIELD (IDENTIFIER PAGENUMBERY) + (PRELABEL " Y:") + (INITSTATE 3) + (FIELDTYPE NUMBER)) + " Format: " + (NWAY (IDENTIFIER FOLIOFORMAT) + (BUTTONS (|123| xiv XIV)) + INITSTATE |123|) + EOL TAB (FIELD (IDENTIFIER STARTINGPAGE#) + (PRELABEL "Starting page #:") + (INITSTATE 1) + (FIELDTYPE POSITIVENUMBER)) + 3 "Alignment:" 2 + (NWAY (IDENTIFIER QUAD) + (BUTTONS (Left Centered Right)) + (INITSTATE Centered)) + EOL TAB (FIELD (IDENTIFIER FOLIOPRETEXT) + (PRELABEL + "Text before number:")) + 3 + (FIELD (IDENTIFIER FOLIOPOSTTEXT) + (PRELABEL "Text after number:")) + + (* ;; "") + + (* ;; "Margins") + + EOL EOL (TEXT (STRING "Margins: ") + (FONT (HELVETICA 10))) + (FIELD (IDENTIFIER LEFTMARGIN) + (PRELABEL "Left") + (POSTLABEL "picas") + (INITSTATE 6) + (FIELDTYPE NUMBER)) + (FIELD (IDENTIFIER RIGHTMARGIN) + (PRELABEL " Right") + (POSTLABEL "picas") + (INITSTATE 6) + (FIELDTYPE NUMBER)) + (FIELD (IDENTIFIER TOPMARGIN) + (PRELABEL " Top") + (POSTLABEL "picas") + (INITSTATE 6) + (FIELDTYPE NUMBER)) + (FIELD (IDENTIFIER BOTTOMMARGIN) + (PRELABEL " Bottom") + (POSTLABEL "picas") + (INITSTATE 6) + (FIELDTYPE NUMBER)) + + (* ;; "") + + (* ;; "Columns ") + + EOL + (FIELD (IDENTIFIER COLUMNS) + (PRELABEL "Columns:") + (LABELFONT (HELVETICA 10)) + (INITSTATE 1) + (FIELDTYPE POSITIVENUMBER)) + 4 + (FIELD (IDENTIFIER COLWIDTH) + (PRELABEL "Col width") + (POSTLABEL "picas") + (FIELDTYPE NUMBER)) + 4 + (FIELD (IDENTIFIER SPACEBETWEENCOLUMNS) + (PRELABEL "Space between cols:") + (POSTLABEL "picas") + (FIELDTYPE NUMBER)) + + (* ;; "") + + (* ;; "Page headings") + + EOL EOL (ACTION (IDENTIFIER HEADINGS) + (LABEL "Page Headings:") + (FONT (HELVETICA 8 BOLD)) + (SELECTFN NILL) + (STATEFN + \TEDIT.PAGEMENU.HEADINGS.STATEFN + ) + (SETSTATEFN + \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN + )) + ,@(\TEDIT.PAGEMENU.CREATE.HEADINGS 8) + + (* ;; "") + + (* ;; "Page number fonts") + + EOL EOL (ACTION (IDENTIFIER CHARLOOKS) + (LABEL + "Font for page numbers:" + ) + (FONT (HELVETICA 8 BOLD)) + (STATEFN + + \TEDIT.PAGEMENU.CHARLOOKS.STATEFN + (FUNCTION + \TEDIT.PAGEMENU.HEADINGS.STATEFN + )) + (SETSTATEFN + \TEDIT.CHARMENU.FILLIN) + ) + EOL + ,@(\TEDIT.CHARMENU.SPEC TSTREAM]) + +(\TEDIT.SHOW.PAGELOOKS + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 22-Oct-2024 11:04 by rmk") + (* ; "Edited 20-Oct-2024 17:32 by rmk") + (* ; "Edited 29-Sep-2024 15:10 by rmk") + (* ; "Edited 30-Aug-2024 23:58 by rmk") + (* ; "Edited 25-Aug-2024 09:06 by rmk") + (* ; "Edited 20-Aug-2024 15:26 by rmk") + (* ; "Edited 9-Aug-2024 13:51 by rmk") + + (* ;; "Set the page layout menu from the looks of the currently selected page-type. MENUSTREAM is the displaystream of the pagelooks menu window.") + + (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that update image objects.") + + (PROG [(PAGEID (MB.GET 'PAGEID MENUSTREAM 'STATE] + (CL:WHEN (MEMB PAGEID '(NIL OFF)) + (TEDIT.PROMPTPRINT MENUWINDOW "Please specify the page-type" T T) + (RETURN)) + (RESETLST + (TEDIT.DEFER.UPDATES MENUSTREAM) + (\TEDIT.PAGEMENU.FILLIN MENUSTREAM (\TEDIT.PAGEREGION.UNPARSE (\TEDIT.MAINSTREAM + MENUSTREAM) + PAGEID))) + (FSETSEL MENUSEL ONFLG T) + (\TEDIT.UPDATE.SEL MENUSEL 1 0 'LEFT) + (\TEDIT.FIXSEL MENUSEL (GETTSTR MENUSTREAM TEXTOBJ)) + (TEDIT.BACKTOMAIN MENUSTREAM]) + +(\TEDIT.PAGEMENU.FILLIN + [LAMBDA (MENUSTREAM PAGELOOKS) (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 16-Aug-2024 10:20 by rmk") + (* ; "Edited 9-Aug-2024 13:37 by rmk") + (* ; "Edited 3-Aug-2024 14:34 by rmk") + + (* ;; "Given a TEXTOBJ describing a page layout menu, and a PAGELOOKS property list from the main document, fill in the menu fields. The strategy is to iterate through the image objects in the MENUTEXTOBJ and figure out from their property what aspect of PAGELOOKS they depict.") + + (for PC OBJ SETSTATEFN inpieces (\TEDIT.FIRSTPIECE (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM)) + when [AND (SETQ OBJ (POBJ PC)) + (SETQ SETSTATEFN (IMAGEOBJPROP OBJ 'SETSTATEFN] + do + (* ;; "These are the properties of the PAGEMENU image objects. The SETSTATEFNs for HEADINGS and CHARLOOKS deal with their menu representations.") + + (CL:WHEN SETSTATEFN (* ; "Provide OBJ's PC for the change") + (SETQ PC (PROG1 (APPLY* SETSTATEFN PC (CDR (ASSOC (IMAGEOBJPROP OBJ 'IDENTIFIER) + PAGELOOKS)) + MENUSTREAM) + (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ))))]) + +(\TEDIT.PAGEREGION.UNPARSE + [LAMBDA (TSTREAM PAGEID) (* ; "Edited 30-Aug-2024 23:48 by rmk") + (* ; "Edited 15-Aug-2024 22:52 by rmk") + (* ; "Edited 10-Aug-2024 20:49 by rmk") + (* ; "Edited 8-Aug-2024 23:27 by rmk") + + (* ;; "The top PAGEREGION defines the page. Dimensions are height and width in REGIONSPEC, PAGESIZE (Letter...) and FOLIO information are in REGIONLOCALINFO. ") + + (* ;; "") + + (PROG* [(PAGEREGION (TEDIT.GET.PAGEFORMAT TSTREAM PAGEID)) + (PAPER (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)) + (LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) + (PAGELOOKS (LIST (CONS 'PAGEID PAGEID] + + (* ;; "The top PAGEREGION defines the page. Dimensions are height and width in REGIONSPEC, PAGESIZE (Letter...) and FOLIO information are in REGIONLOCALINFO. The paper dimension height/width are implied by PAPERSIZE, don't need to be saved. But are needed for the margins.") + + (CL:UNLESS (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION)) (* ; - "Get any special X position for the paragraph") - (push NEWLOOKS 'SPECIALX (FIXR (TIMES 12 SPECIALX)))) - (CL:WHEN [SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] + "Don't know what to do if not a page.") + (RETURN)) + (PUTASSOC 'PAPERSIZE (LISTGET LOCALINFO 'PAPERSIZE) + PAGELOOKS) + (PUTASSOC 'LANDSCAPE (LISTGET LOCALINFO 'LANDSCAPE?) + PAGELOOKS) + (PUTASSOC 'FOLIOFORMAT (SELECTQ (CAR (LISTGET LOCALINFO 'FOLIOINFO)) + (ARABIC '|123|) + (LOWERROMAN 'xiv) + (UPPERROMAN 'XIV) + '|123|) + PAGELOOKS) + (PUTASSOC 'FOLIOPRETEXT (CADR (LISTGET LOCALINFO 'FOLIOINFO)) + PAGELOOKS) + (PUTASSOC 'FOLIOPOSTTEXT (CADDR (LISTGET LOCALINFO 'FOLIOINFO)) + PAGELOOKS) + (for BOX REGION SPECS PAGENUMBERX PQUAD LEFT HEADINGS RIGHTINCR COLWIDTH (COLUMNS _ 0) + (INTERCOL _ 0) in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) + do + (* ;; + "Run thru the boxes on the page, calculating information about the page as a whole.") + + (SETQ REGION (fetch REGIONSPEC of BOX)) + (SELECTQ (fetch (PAGEREGION REGIONFILLMETHOD) of BOX) + (FOLIO (* ; + "A page-number (%"Folio%") region. Shoul be only one") + (PUTASSOC 'PAGENOS 'Yes PAGELOOKS) + (SETQ SPECS (fetch REGIONLOCALINFO of BOX)) + + (* ;; "This should be done whenever the pageframe is created.") + + (PUTASSOC 'CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (LISTGET SPECS + 'CHARLOOKS) + TEDIT.DEFAULT.FOLIO.LOOKS) + PAGELOOKS) + (SETQ PQUAD (LISTGET (LISTGET SPECS 'PARALOOKS) + 'QUAD)) + (PUTASSOC 'QUAD PQUAD PAGELOOKS) + (SETQ PAGENUMBERX (fetch (REGION LEFT) of REGION)) + + (* ;; "RMK: Very odd: why 4 and 2 inches here? The formatter knows how to shift. Problem is that X specifies the left edge of the page region?") + + (SELECTQ PQUAD + (LEFT) + (RIGHT (add PAGENUMBERX (ITIMES 4 PTSPERINCH))) + (CENTERED (add PAGENUMBERX (ITIMES 2 PTSPERINCH))) + NIL) + (PUTASSOC 'PAGENUMBERX (FQUOTIENT PAGENUMBERX PTSPERPICA) + PAGELOOKS) + (PUTASSOC 'PAGENUMBERY (FQUOTIENT (fetch (REGION BOTTOM) of REGION) + PTSPERPICA) + PAGELOOKS)) + (HEADING + (* ;; "A page-heading region, could be several. Their type/x/y values are collect in a flat list inside a HEADINGS property. \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN pops them off to fill in the successive heading blocks.") + + [SETQ HEADINGS (NCONC HEADINGS + (LIST (CONS 'HEADINGTYPE + (LISTGET (fetch REGIONLOCALINFO + of BOX) + 'HEADINGTYPE)) + (CONS 'HEADINGX (FQUOTIENT + (fetch (REGION LEFT) + of REGION) + PTSPERPICA)) + (CONS 'HEADINGY (FQUOTIENT + (fetch (REGION BOTTOM) + of REGION) + PTSPERPICA]) + (TEXT + (* ;; "A regular-text region=column. ") + + (add COLUMNS 1) + (SELECTQ COLUMNS + (1 (SETQ COLWIDTH (fetch (REGION WIDTH) of REGION)) + (* ; "All have same width (points)") + (SETQ RIGHTINCR (fetch (REGION LEFT) of REGION)) (* ; - "Get special Y positioning for the paragraph") - (push NEWLOOKS 'SPECIALY (FIXR (TIMES 12 SPECIALY)))) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (FGETSEL SCRATCHSEL CH#))) - (SETQ BUTTON (CAR NEXTB)) - (COND - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; - "This paragraph starts on a new page (or col or box, as apprpopriate)") - (push NEWLOOKS 'NEWPAGEBEFORE T)) - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; - "This paragraph IS NOT a page heading.") - (push NEWLOOKS 'NEWPAGEBEFORE NIL))) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (COND - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; - "The next paragraph starts on a new page....") - (push NEWLOOKS 'NEWPAGEAFTER T)) - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; - "The next paragraph DOESN'T START on a new page....") - (push NEWLOOKS 'NEWPAGEAFTER NIL))) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (push NEWLOOKS 'HARDCOPY T)) - (OFF (push NEWLOOKS 'HARDCOPY NIL)) - NIL) + "Left of first column relative to paper's edge") -(* ;;; "THE VARIOUS KINDS OF KEEP PROPERTIES (ONLY HEADING-KEEP FOR NOW THO)") + (* ;; "First column gives the left, bottom, and top margins. Note: no FIXR so e.g. 6.5 picas. right margin depends on columns") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (push NEWLOOKS 'HEADINGKEEP 'ON)) - (OFF (push NEWLOOKS 'HEADINGKEEP 'OFF)) - NIL) + (PUTASSOC 'LEFTMARGIN (FQUOTIENT RIGHTINCR PTSPERPICA) + PAGELOOKS) + (PUTASSOC 'BOTTOMMARGIN (FQUOTIENT (fetch (REGION BOTTOM) + of REGION) + PTSPERPICA) + PAGELOOKS) + (PUTASSOC 'TOPMARGIN (FQUOTIENT (IDIFFERENCE (fetch (REGION HEIGHT) + of PAPER) + (fetch (REGION PTOP) + of REGION)) + PTSPERPICA) + PAGELOOKS)) + (2 (* ; "More than 1, constant INTERCOL") + (SETQ INTERCOL (IDIFFERENCE (fetch (REGION LEFT) of REGION) + RIGHTINCR))) + NIL) (* ; + "INTERCOL starts at 0, for first/only column") + (add RIGHTINCR COLWIDTH INTERCOL)) + NIL) finally (CL:UNLESS (CDR (ASSOC 'PAGENOS PAGELOOKS)) + (PUTASSOC 'PAGENOS 'No PAGELOOKS)) + (PUTASSOC 'RIGHTMARGIN (FQUOTIENT (IDIFFERENCE (fetch (REGION WIDTH) + of PAPER) + RIGHTINCR) + PTSPERPICA) + PAGELOOKS) + (PUTASSOC 'COLUMNS COLUMNS PAGELOOKS) + (CL:IF (IGREATERP COLUMNS 1) + (PUTASSOC 'INTERCOL INTERCOL PAGELOOKS)) + (PUTASSOC 'HEADINGS HEADINGS PAGELOOKS)) + (RETURN PAGELOOKS]) - (* ;; "Default tab width") - - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (FGETSEL SCRATCHSEL CH#))) - (SETQ BUTTON (CAR NEXTB)) - (SETQ DEFTAB (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (CDR NEXTB))) - - (* ;; "If the MARBAR is next, we don't need the loop. If it isn't next, the original code would have looped forever.") - - (* ;; "This keeps the loop, but allows for the search to advance, in case in the future some other item is stuck in. But if it doesn't find a MARGINBAR, the following code will crash.") - - [bind (CHNO _ (FGETSEL SCRATCHSEL CH#)) while NEXTB until (type? MARGINBAR BUTTON) - do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CHNO)) - (SETQ BUTTON (CAR NEXTB)) - (SETQ CHNO (ADD1 (CDR NEXTB] - (CL:UNLESS (type? MARGINBAR BUTTON) - (SHOULDNT "MARGINBAR NOT FOUND")) - (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) - (SETQ MARUNIT (fetch MARUNIT of BUTTONDATA)) - (SETQ L1 (FIXR (TIMES (fetch MARL1 of BUTTONDATA) - MARUNIT))) - (CL:WHEN (IGEQ L1 0) (* ; - "The 1stleftmargin is set, and non-neutral.") - (push NEWLOOKS '1STLEFTMARGIN L1)) - (SETQ LN (FIXR (TIMES (fetch MARLN of BUTTONDATA) - MARUNIT))) - (CL:WHEN (IGEQ LN 0) (* ; - "The LEFTMARGIN is set, and non-neutral.") - (push NEWLOOKS 'LEFTMARGIN LN)) - (SETQ R (FIXR (TIMES (fetch MARR of BUTTONDATA) - MARUNIT))) - (CL:WHEN (IGEQ R 0) (* ; - "The RIGHTMARGIN is set, and non-neutral.") - (push NEWLOOKS 'RIGHTMARGIN R)) - (CL:UNLESS (MEMB (fetch MARTABS of BUTTONDATA) - '(NIL NEUTRAL)) (* ; - "If the tab settings are neutral, don't change anything.") - [push NEWLOOKS 'TABS (CONS DEFTAB (SORT (for TAB in (fetch MARTABS of BUTTONDATA) - collect (CONS (FIXR (TIMES (CAR TAB) - MARUNIT)) - (CDR TAB))) - (FUNCTION (LAMBDA (A B) - (ILEQ (CAR A) - (CAR B]) - (TEDIT.PARALOOKS MAINTEXTOBJ NEWLOOKS (GETSEL (FGETTOBJ MAINTEXTOBJ SEL) - CH#) - (GETSEL (FGETTOBJ MAINTEXTOBJ SEL) - DCH)) - (\TEDIT.SHOWSEL SEL NIL) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) - -(\TEDIT.SHOW.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 13:52 by rmk") - (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 25-Feb-2024 23:33 by rmk") - (* ; "Edited 20-Jul-2023 17:00 by rmk") - (* ; "Edited 6-Jun-2023 15:10 by rmk") - (* ; "Edited 18-Apr-2023 23:59 by rmk") - (* ; "Edited 9-Mar-2023 14:43 by rmk") - (* ; "Edited 11-Feb-2023 11:31 by rmk") - (* ; "Edited 21-Oct-2022 18:51 by rmk") - (* ; "Edited 22-Aug-2022 13:13 by rmk") - (* ; "Edited 6-Jul-92 09:42 by jds") - - (* ;; "Fill in the PARAGRAPH LOOKS menu from the para looks for a selected character. This function knows the order of items in the paragraph menu.") - - (* ;; "This only makese sense if you know that CH# in SCRATCHSEL gets updated down below MBUTTON.SET.NEXT.FIELD") - - (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - (CH# (ADD1 (GETSEL SEL CH#))) - BUTTON NEXTB BUTTONDATA PARALOOKS MARUNIT) - (CL:WHEN [SETQ PARALOOKS (TEDIT.GET.PARALOOKS (fetch (TEXTWINDOW WTEXTSTREAM) - of (WINDOWPROP W 'MAINWINDOW] - (\TEDIT.SHOWSEL SEL NIL) - (SETSEL SEL SET NIL) - [TEDIT.DEFERRED-UPDATES - TEXTOBJ (* ; - "Skip NEUTRAL, grab justifiers (QUAD)") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ CH#] - (SETQ BUTTON (CAR NEXTB)) - (for ITEM in (IMAGEOBJPROP BUTTON 'BUTTONS) - when (EQ (LISTGET PARALOOKS 'QUAD) - (U-CASE (CL:IF (LISTP ITEM) - (CAR ITEM) - ITEM))) do (IMAGEOBJPROP BUTTON 'STATE ITEM) - (* ; "Turn this button on.") - (RETURN)) (* ; - "Now find which text button was 'on'") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (* ; "Find the 'Page Heading' button") - (SETQ BUTTON (CAR NEXTB)) - (COND - [(EQ (LISTGET PARALOOKS 'TYPE) - 'PAGEHEADING) (* ; - "This IS a page heading. Turn the button ON and set the heading type field") - (IMAGEOBJPROP BUTTON 'STATE 'ON) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (LISTGET PARALOOKS 'SUBTYPE] - (T (IMAGEOBJPROP BUTTON 'STATE 'OFF) (* ; "Not a page heading, no type") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL))) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (LISTGET PARALOOKS 'LINELEADING)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (LISTGET PARALOOKS 'PARALEADING)) (* ; "Update the PARA LEADING field") - [MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (LISTGET PARALOOKS 'SPECIALX) - 0) - 3)) - 4))) - (COND - ((FIXP VAL) - VAL) - (T (FLOAT VAL] - [MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (LISTGET PARALOOKS 'SPECIALY) - 0) - 3)) - 4))) - (COND - ((FIXP VAL) - VAL) - (T (FLOAT VAL] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#] - (SETQ BUTTON (CAR NEXTB)) - (IMAGEOBJPROP BUTTON 'STATE (LISTGET PARALOOKS 'NEWPAGEBEFORE)) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (IMAGEOBJPROP BUTTON 'STATE (LISTGET PARALOOKS 'NEWPAGEAFTER)) - - (* ;; "HARDCOPY-DISPLAY MODE") - - [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (CDR NEXTB)) - (LISTGET PARALOOKS 'HARDCOPY] - - (* ;; "HEADING KEEP") - - [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (LISTGET PARALOOKS - 'HEADINGKEEP] - - (* ;; "DEFAULT TAB WIDTH") - - [MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB (CAR (LISTGET PARALOOKS 'TABS] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (GETSEL SCRATCHSEL CH#))) - (SETQ BUTTON (CAR NEXTB)) - (until (type? MARGINBAR BUTTON) do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB))) - (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) - (replace MARL1 of BUTTONDATA with (FQUOTIENT (LISTGET PARALOOKS '1STLEFTMARGIN) - (fetch MARUNIT of BUTTONDATA))) - (replace MARLN of BUTTONDATA with (FQUOTIENT (LISTGET PARALOOKS 'LEFTMARGIN) - (fetch MARUNIT of BUTTONDATA))) - (replace MARR of BUTTONDATA with (FQUOTIENT (LISTGET PARALOOKS 'RIGHTMARGIN) - (fetch MARUNIT of BUTTONDATA))) - (replace MARTABS of BUTTONDATA with (for TAB in (CDR (LISTGET PARALOOKS 'TABS)) - collect (CONS (FQUOTIENT (CAR TAB) - (fetch MARUNIT of - BUTTONDATA - )) - (CDR TAB] - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS)))]) - -(\TEDIT.NEUTRALIZE.PARALOOKS.MENU - [LAMBDA (OBJ SEL W) (* ; "Edited 25-Feb-2024 23:35 by rmk") - (* ; "Edited 20-Jul-2023 17:00 by rmk") - (* ; "Edited 21-Oct-2022 18:51 by rmk") - (* ; "Edited 30-May-91 22:18 by jds") - - (* ;; "Set all the fields of a PARAGRAPH LOOKS menu to neutral settings.") - - (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - (CH# (ADD1 (GETSEL SEL CH#))) - BUTTON NEXTB BUTTONDATA) (* ; "Get to the start of the text.") - (TEDIT.DEFERRED-UPDATES TEXTOBJ (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ CH# - 'NIL)) - (* ; - "Neutralize the justification N-Way button") - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) - (* ; "Find the 'Page Heading' button") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) (* ; "Update the LINE LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) (* ; "Update the PARA LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - NIL) - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - 'NEUTRAL)) (* ; "New page before") - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) - (* ; "New page after") - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) - (* ; "Hardcopy formatting mode") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) (* ; - "Update the DEFAULT TAB SPACING field") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (GETSEL SCRATCHSEL CH#))) - (SETQ BUTTON (CAR NEXTB)) - (while (NOT (type? MARGINBAR BUTTON)) do [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB))) - (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) - (* ; - "(IMAGEOBJPROP BUTTON (QUOTE IMAGECACHE) NIL)") - (* ; "Tell it to reformat itself.") - [replace MARL1 of BUTTONDATA with (COND - ((ILESSP (fetch MARL1 of BUTTONDATA) - 0) - (fetch MARL1 of BUTTONDATA)) - (T (IMIN -0.5 (IMINUS (fetch MARL1 of BUTTONDATA - ] - [replace MARLN of BUTTONDATA with (COND - ((ILESSP (fetch MARLN of BUTTONDATA) - 0) - (fetch MARLN of BUTTONDATA)) - (T (IMIN -0.5 (IMINUS (fetch MARLN of BUTTONDATA - ] - [replace MARR of BUTTONDATA with (COND - ((ILESSP (fetch MARR of BUTTONDATA) - 0) - (fetch MARR of BUTTONDATA)) - ((ZEROP (fetch MARR of BUTTONDATA)) - (IMINUS (IQUOTIENT (IDIFFERENCE (GETTOBJ TEXTOBJ - WRIGHT) - 20) - 12))) - (T (IMIN -0.5 (IMINUS (fetch MARR of BUTTONDATA] - (replace MARTABS of BUTTONDATA with 'NEUTRAL)) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) - -(\TEDIT.RECORD.TABLEADERS - [LAMBDA (BUTTON NEWSTATE TEXTSTREAM SEL) (* ; "Edited 30-May-91 22:18 by jds") - - (* Toggle the dotted-leader state of the margin bar tab-setter. - This is called when the user hits the "dotted leader" toggle button in the menu) - - (PROG* [(FLG (COND - ((EQ NEWSTATE 'ON) - T) - (T NIL))) - (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (MARGINBAR (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SEL] - (replace MARTABTYPE of (IMAGEOBJPROP MARGINBAR 'OBJECTDATUM) - with (SELECTQ (OR (fetch MARTABTYPE of (IMAGEOBJPROP MARGINBAR 'OBJECTDATUM)) - 'LEFT) - (LEFT 'DOTTEDLEFT) - (DOTTEDLEFT 'LEFT) - (CENTERED 'DOTTEDCENTERED) - (DOTTEDCENTERED - 'CENTERED) - (RIGHT 'DOTTEDRIGHT) - (DOTTEDRIGHT 'RIGHT) - (DECIMAL 'DOTTEDDECIMAL) - (DOTTEDDECIMAL 'DECIMAL) - (SHOULDNT]) -) -(DEFINEQ - -(\TEDIT.SHOW.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:15 by rmk") - (* ; "Edited 15-Mar-2024 13:34 by rmk") - (* ; "Edited 18-Jan-2024 08:33 by rmk") - (* ; "Edited 12-Nov-2023 23:40 by rmk") - (* ; "Edited 6-Nov-2023 22:33 by rmk") - (* ; "Edited 20-Jul-2023 17:00 by rmk") - (* ; "Edited 18-Apr-2023 23:59 by rmk") - (* ; "Edited 21-Oct-2022 18:51 by rmk") - (* ; "Edited 13-Sep-2022 12:07 by rmk") - (* ; "Edited 4-Feb-92 16:38 by jds") - -(* ;;; "Take a document's page formatting, and display it in the menu.") - - (LET* ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) - [MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) - of (WINDOWPROP W 'MAINWINDOW] - (CH# (ADD1 (GETSEL SEL CH#))) - FOLIOINFO NEWLOOKS NEXTB BUTTON PAGEID OPAGEFRAMES FIRST REST PFONT HEADING HEADINGS - PAGEPROPS STARTINGPAGE# PAPERSIZE) - - (* ;; "Start by turning off the selection--and leaving it off afterward.") - - (\TEDIT.SHOWSEL SEL NIL) - (SETSEL SEL SET NIL) - - (* ;; "What kind of page are we looking at the specs for?") - - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ BUTTON (CAR NEXTB)) - (SETQ PAGEID (SELECTQ (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - (|First(&Default)| - 'FIRST) - (Other% Left 'LEFT) - (Other% Right 'RIGHT) - (PROGN (TEDIT.PROMPTPRINT MAINTEXTOBJ - "First specify which kind of page you want to see." T) - NIL))) - - (* ;; "Now mark the menu for NO SCREEN UPDATES during the button-setting process.") - - (CL:WHEN PAGEID - [TEDIT.DEFERRED-UPDATES TEXTOBJ - - (* ;; "Now replace the button values, fill-in fields, etc.") - - (SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXTOBJ) - TEDIT.PAGE.FRAMES)) - - (* ;; " LISTP is already just a list of first-recto-verso frames") - - (CL:UNLESS (LISTP OPAGEFRAMES) (* ; - "Probably a parsed-up version of the thing. Fix it to a list.") - (COND - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of OPAGEFRAMES) - 'SEQUENCE) - (SETQ FIRST (CAR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES))) - (SETQ REST (CADR (fetch (PAGEREGION REGIONSUBBOXES) of OPAGEFRAMES))) - (COND - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REST) - 'ALTERNATE) - (SETQ OPAGEFRAMES (CONS FIRST (fetch (PAGEREGION REGIONSUBBOXES) - of REST] - (T (SETQ OPAGEFRAMES NIL] - (T (SETQ OPAGEFRAMES NIL)))) - (CL:UNLESS OPAGEFRAMES (* ; - "If the formatting isn't in our simplified 3-way format, punt out of this.") - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Format too complex to edit." T) - (SETQ PAGEID NIL)) - (SELECTQ PAGEID - (FIRST (SETQ NEWLOOKS (CAR OPAGEFRAMES))) - (LEFT (SETQ NEWLOOKS (CADR OPAGEFRAMES)) - (SETQ PAPERSIZE (LISTGET [CAR (FLAST (TEDIT.UNPARSE.PAGEFORMAT - (CAR OPAGEFRAMES) - 'PICAS] - 'PAPERSIZE))) - (RIGHT (SETQ NEWLOOKS (CADDR OPAGEFRAMES)) - (SETQ PAPERSIZE (LISTGET [CAR (FLAST (TEDIT.UNPARSE.PAGEFORMAT - (CAR OPAGEFRAMES) - 'PICAS] - 'PAPERSIZE))) - NIL) - (COND - (PAGEID (SETQ NEWLOOKS (TEDIT.UNPARSE.PAGEFORMAT NEWLOOKS 'PICAS)) - (SETQ PAGEPROPS (CAR (FLAST NEWLOOKS))) - [COND - ((EQ PAGEID 'FIRST) - (SETQ PAPERSIZE (LISTGET PAGEPROPS 'PAPERSIZE] - (SETQ CH# (ADD1 (CDR NEXTB))) (* ; "Move past the kind-of-page button") - (SETQ STARTINGPAGE# (LISTGET PAGEPROPS 'STARTINGPAGE#)) - (* ; - "Grab a potential starting page number.") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# STARTINGPAGE#) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (IMAGEOBJPROP (CAR NEXTB) - 'STATE - (OR PAPERSIZE 'Letter)) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - [IMAGEOBJPROP (CAR NEXTB) - 'STATE - (COND - ((LISTGET PAGEPROPS 'LANDSCAPE?) - 'ON) - (T 'OFF] (* ; - "Tell whether the page is to be landscape or not.") - (SETQ FOLIOINFO (LISTGET PAGEPROPS 'FOLIOINFO)) - (* ; "Page number fomratting info") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - [IMAGEOBJPROP (CAR NEXTB) - 'STATE - (COND - ((pop NEWLOOKS) - 'Yes) - (T 'No] - (SETQ BUTTON (CAR NEXTB)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - (pop NEWLOOKS)) (* ; "Page # X location") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Page # Y location") - (SETQ PFONT (pop NEWLOOKS)) (* ; "Skip the font info for now.") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (GETSEL SCRATCHSEL - CH#] - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ BUTTON (CAR NEXTB)) - (IMAGEOBJPROP BUTTON 'STATE (SELECTQ (pop FOLIOINFO) - (ARABIC 123) - (LOWERROMAN 'xiv) - (UPPERROMAN 'XIV) - 123)) - (* ; "The format for the page number") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ BUTTON (CAR NEXTB)) (* ; "How to align the page number") - (IMAGEOBJPROP BUTTON 'STATE (SELECTQ (pop NEWLOOKS) - (LEFT 'Left) - (RIGHT 'Right) - (CENTERED 'Centered) - 'Centered)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ CH# (pop FOLIOINFO)) - (* ; - "The text to surround the page number") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop FOLIOINFO)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Left Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Right Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Top margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Bottom Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "# of columns") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Column width") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop NEWLOOKS)) (* ; "Intercolumn spacing") - (SETQ HEADINGS (pop NEWLOOKS)) - (for HEADING# from 1 to 8 do - (* ;; - "Insert info about up to 8 headings (the # of spots in the menu)") - - (SETQ HEADING (pop HEADINGS)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (GETSEL SCRATCHSEL CH#)) - (pop HEADING))) - (CL:WHEN HEADINGS - - (* ;; "There were headings left over, so warn user.") - - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT - "Note: The menu shows only 8 of " - (IPLUS 8 (LENGTH HEADINGS)) - " headings") - T T)) (* ; - "The font for the page numbers to appear in.") - (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ (ADD1 (GETSEL SCRATCHSEL CH#)) - (OR PFONT (GETTEXTPROP TEXTOBJ 'FOLIO.LOOKS])]) - -(\TEDITPAGEMENU.CREATE - [LAMBDA NIL (* gbn " 8-Oct-84 18:25") - (* Creates the TEdit Expanded Menu) - (SETQ TEDIT.EXPANDED.PAGEMENU (\TEXTMENU.DOC.CREATE (APPEND TEDIT.PAGEMENU.SPEC - TEDIT.MENUDIVIDER.SPEC - [LIST (create MB.TEXT - MBSTRING _ - "Character Looks for Page Numbers: " - MBFONT _ - (FONTCREATE 'HELVETICA 10 - 'BOLD] - TEDIT.CHARLOOKSMENU.SPEC]) - -(\TEDIT.APPLY.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; "Edited 27-Mar-2024 15:20 by rmk") +(\TEDIT.APPLY.PAGELOOKS + [LAMBDA (OBJ MENUSEL MENUWINDOW MENUSTREAM) (* ; "Edited 20-Oct-2024 09:40 by rmk") + (* ; "Edited 29-Sep-2024 15:05 by rmk") + (* ; "Edited 25-Aug-2024 09:14 by rmk") + (* ; "Edited 21-Aug-2024 12:18 by rmk") + (* ; "Edited 10-Aug-2024 11:19 by rmk") + (* ; "Edited 29-Jul-2024 18:05 by rmk") + (* ; "Edited 27-Jul-2024 11:25 by rmk") + (* ; "Edited 2-May-2024 14:26 by rmk") + (* ; "Edited 29-Apr-2024 13:36 by rmk") + (* ; "Edited 27-Mar-2024 15:20 by rmk") (* ; "Edited 21-Dec-2023 12:31 by rmk") (* ; "Edited 8-Aug-2023 00:02 by rmk") (* ; "Edited 21-Oct-2022 18:51 by rmk") (* ;  "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") + (\TEDIT.CHANGE.PAGELOOKS (\TEDIT.MAINW MENUSTREAM) + (\TEDIT.MENU.PARSE MENUSTREAM)) + (TEDIT.BACKTOMAIN MENUSTREAM]) -(* ;;; "Change the page formatting for this document") - - (PROG ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) - [MAINTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) - of (WINDOWPROP W 'MAINWINDOW] - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - SCRATCHSEL NEXTB BUTTON OPAGEFRAMES PAGEID PX PY LEFT BOTTOM TOP RIGHT ALIGNMENT PAGENOS - COLS COLWIDTH INTERCOL PFONT NPAGEFORMAT HEADINGTYPE HEADINGX HEADINGY HEADINGS - HEADINGINVALID STARTINGPAGE# FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT PAGEOPTIONS - NFPAGEFORMAT PAPERSIZE LANDSCAPE?) - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "Skip the SHOW button.") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (SELECTQ (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - (|First(&Default)| - (SETQ PAGEID 'FIRST)) - (Other% Left (SETQ PAGEID 'LEFT)) - (Other% Right (SETQ PAGEID 'RIGHT)) - (PROGN (TEDIT.PROMPTPRINT MAINTEXTOBJ "Set KIND OF PAGE before APPLYing." T) - (RETURN))) (* ; "Find which page, for later.") - (SETQ STARTINGPAGE# (AND (EQ PAGEID 'FIRST) - (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#))) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ PAPERSIZE (OR (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - 'Letter)) (* ; - "Get the size of paper this is to be formatted for") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ LANDSCAPE? (EQ (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - 'ON)) (* ; - "Decide if this kind of page is to be printed landscape....") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ CH# (ADD1 (CDR NEXTB))) - (SELECTQ (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - (No (SETQ PAGENOS NIL)) - (Yes (SETQ PAGENOS T)) - NIL) (* ; "Find about page numbers") - (SETQ PX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ CH#)) - [SETQ PY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - [COND - (PAGENOS (* ; - "If he wants page numbers, make sure he said WHERE to put them.") - (COND - ((AND PX PY)) - (T (TEDIT.PROMPTPRINT MAINTEXTOBJ - "Please set the X and Y location for page numbers before APPLYing." - T) - (TEDIT.PROMPTFLASH MAINTEXTOBJ) - (RETURN] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - (* ; - "Get to the numbering-format button") - (SETQ BUTTON (CAR NEXTB)) - (SETQ FOLIOFORMAT (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (123 (* ; "arabic numbers") - 'ARABIC) - (xiv (* ; "lower-case roman numerals") - 'LOWERROMAN) - (XIV (* ; "Upper-case roman numerals") - 'UPPERROMAN) - 'ARABIC)) - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (* ; - "Get to the number alignment button") - (SETQ BUTTON (CAR NEXTB)) - [SETQ ALIGNMENT (U-CASE (IMAGEOBJPROP BUTTON 'STATE] - (* ; "PX PY PFONT ALIGNMENT") - (* ; "Margins: LEFT, RIGHT, TOP, BOTTOM") - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ FOLIOPRETEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ CH#)) - [SETQ FOLIOPOSTTEXT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - -(* ;;; "Now get the margins on the paper") - - [SETQ LEFT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL - ] - [SETQ RIGHT (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of - SCRATCHSEL - ] - [SETQ TOP (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - [SETQ BOTTOM (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (CL:UNLESS [SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify how many columns there should be." T) - (TEDIT.PROMPTFLASH MAINTEXTOBJ)) - [SETQ COLWIDTH (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - [SETQ INTERCOL (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (* ; "Col count, width, spacing") - (SETQ HEADINGS (for HEADING# from 1 to 8 - when (PROG1 [SETQ HEADINGTYPE (MBUTTON.NEXT.FIELD.AS.ATOM - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL - ] - [SETQ HEADINGX (MBUTTON.NEXT.FIELD.AS.NUMBER - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - [SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]) - collect (CL:UNLESS (AND HEADINGX HEADINGY) - (TEDIT.PROMPTPRINT MAINTEXTOBJ (CONCAT - "You need to say WHERE " - HEADINGTYPE - " headings go.") - T) - (TEDIT.PROMPTFLASH MAINTEXTOBJ) - (SETQ HEADINGINVALID T)) - (LIST HEADINGTYPE HEADINGX HEADINGY))) - (CL:WHEN HEADINGINVALID (* ; "Headings invalid.") +(\TEDIT.CHANGE.PAGELOOKS + [LAMBDA (MAINTEXTSTREAM PAGELOOKS) (* ; "Edited 20-Oct-2024 17:17 by rmk") + (* ; "Edited 30-Aug-2024 23:43 by rmk") + (* ; "Edited 15-Aug-2024 14:48 by rmk") + (* ; "Edited 12-Aug-2024 23:34 by rmk") + (* ; "Edited 10-Aug-2024 12:11 by rmk") + (PROG ((MAINTEXTOBJ (TEXTOBJ MAINTEXTSTREAM)) + (PAGEID (LISTGET PAGELOOKS 'PAGEID)) + [PAGENOS (STRING.EQUAL 'Yes (LISTGET PAGELOOKS 'PAGENOS] + PAGEPROPS) + (CL:UNLESS PAGEID + (TEDIT.PROMPTPRINT MAINTEXTSTREAM "Please specify a page type" T T) (RETURN)) - [SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL - ] + (for PLTAIL on PAGELOOKS by (CDDR PLTAIL) do (SELECTQ (CADR PLTAIL) + (ON (RPLACA PLTAIL T)) + ((OFF NEUTRAL) + (RPLACA PLTAIL NIL)) + NIL)) + (CL:WHEN [AND PAGENOS (NOT (AND (LISTGET PAGELOOKS 'PAGENUMBERX) + (LISTGET PAGELOOKS 'PAGENUMBERY] + (TEDIT.PROMPTPRINT MAINTEXTOBJ "Please set both X and Y locations for page numbers" T T + ) + (RETURN)) + (CL:UNLESS (LISTGET PAGELOOKS 'COLUMNS) + (LISTPUT PAGELOOKS 'COLUMNS 1) + (RETURN)) + (CL:UNLESS (OR (EQ 1 (LISTGET PAGELOOKS 'COLUMNS)) + (LISTGET PAGELOOKS 'COLWIDTH) + (LISTGET PAGELOOKS 'SPACEBETWEENCOLUMNS)) + (TEDIT.PROMPTPRINT MAINTEXTOBJ "Please specify the space between columns" T T) + (RETURN)) + [push PAGEPROPS 'STARTINGPAGE# (LISTGET PAGELOOKS 'STARTINGPAGE#) + 'LANDSCAPE? + (EQ 'ON (LISTGET PAGELOOKS 'LANDSCAPE)) + 'FOLIOINFO + (LIST (SELECTQ (LISTGET PAGELOOKS 'FOLIOFORMAT) + (|123| 'ARABIC) + (xiv 'LOWERROMAN) + (XIV 'UPPERROMAN) + 'ARABIC) + (LISTGET PAGELOOKS 'FOLIOPRETEXT) + (LISTGET PAGELOOKS 'FOLIOPOSTTEXT] -(* ;;; "Glom all the oddball options (starting page, folio format &c) together") + (* ;; "**EMPTY** may come from field values in the pagelooks menue") - (SETQ PAGEOPTIONS (AND STARTINGPAGE# (LIST 'STARTINGPAGE# STARTINGPAGE#))) - (push PAGEOPTIONS 'FOLIOINFO (LIST FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT)) - (COND - (LANDSCAPE? (* ; - "The pages are to be printed landscape. Remember that fact.") - (push PAGEOPTIONS LANDSCAPE? T))) - (SETQ NPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT (AND (NEQ ALIGNMENT - 'OFF) - ALIGNMENT) - LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS 'PICAS - PAGEOPTIONS PAPERSIZE)) - (SETQ OPAGEFRAMES (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXTOBJ)) - (CL:UNLESS (LISTP OPAGEFRAMES) - [COND - ((EQ PAGEID 'FIRST) (* ; - "Setting the first page sets them all") - (SETQ PAGEOPTIONS (COPY PAGEOPTIONS)) - (LISTPUT PAGEOPTIONS 'STARTINGPAGE# NIL) (* ; - "Starting page nubmer makes no sense on other than first pages.") - (SETQ NFPAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT PAGENOS PX PY PFONT - (AND (NEQ ALIGNMENT 'OFF) - ALIGNMENT) - LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS - 'PICAS PAGEOPTIONS PAPERSIZE)) - (SETQ OPAGEFRAMES (LIST NPAGEFORMAT NFPAGEFORMAT NFPAGEFORMAT))) - (T (* ; - "Otherwise, start from the default page layout") - (SETQ OPAGEFRAMES (COPY TEDIT.PAGE.FRAMES]) - (SELECTQ PAGEID - (FIRST (RPLACA OPAGEFRAMES NPAGEFORMAT)) - (LEFT (RPLACA (CDR OPAGEFRAMES) - NPAGEFORMAT)) - (RIGHT (RPLACA (CDDR OPAGEFRAMES) - NPAGEFORMAT)) - NIL) - (TEDIT.PAGEFORMAT MAINTEXTOBJ OPAGEFRAMES) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) + (TEDIT.PAGEFORMAT MAINTEXTOBJ (TEDIT.SINGLE.PAGEFORMAT PAGENOS (LISTGET PAGELOOKS + 'PAGENUMBERX) + (LISTGET PAGELOOKS 'PAGENUMBERY) + (LISTGET PAGELOOKS 'CHARLOOKS) + (LISTGET PAGELOOKS 'QUAD) + (LISTGET PAGELOOKS 'LEFTMARGIN) + (LISTGET PAGELOOKS 'RIGHTMARGIN) + (LISTGET PAGELOOKS 'TOPMARGIN) + (LISTGET PAGELOOKS 'BOTTOMMARGIN) + (LISTGET PAGELOOKS 'COLUMNS) + (LISTGET PAGELOOKS 'COLWIDTH) + (LISTGET PAGELOOKS 'SPACEBETWEENCOLUMNS) + (LISTGET PAGELOOKS 'HEADINGS) + 'PICAS PAGEPROPS (LISTGET PAGELOOKS 'PAPERSIZE)) + PAGEID]) -(TEDIT.UNPARSE.PAGEFORMAT - [LAMBDA (PAGEREGION UNITS) (* ; "Edited 12-Jun-90 18:59 by mitani") +(\TEDIT.PAGEMENU.CHARLOOKS.STATEFN + [LAMBDA (CHARLOOKSPC OBJ MENUTEXTOBJ) (* ; "Edited 28-Aug-2024 15:07 by rmk") + (* ; "Edited 9-Aug-2024 23:53 by rmk") -(* ;;; "Take a page layout and unparse it into a PList of specs.") + (* ;; "The STATEFN for the page-number CHARLOOKS piece. This accumulates the character properties from the following pieces and stores them in as the STATE of CHARLOOKSPC. Assumes that this is the end of menu, otherwise we have to be able to tell \TEDIT.MENU.PARSE the property of the last object it should examine (DISTANCE?), and it has to report that piece.") - (LET* ((PAPER (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)) - (PAPERWIDTH (fetch (REGION WIDTH) of PAPER)) - (PAPERHEIGHT (fetch (REGION HEIGHT) of PAPER)) - (REGIONS (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION)) - PX PY PFONT PQUAD PINFO LEFT RIGHT TOP BOTTOM (COLS 0) - COLWIDTH - (INTERCOL 0) - SPECS PAGENOS (OLDRIGHT NIL) - SCALEFACTOR HEADINGS) - [for REGION in REGIONS do - (* ;; - "Run thru the regions on the page, calculating information about the page as a whole.") - - (COND - ((EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) - 'FOLIO) (* ; "A page-number (%"Folio%") region") - (SETQ PAGENOS T) - (SETQ PX (fetch (REGION LEFT) of (fetch REGIONSPEC - of REGION))) - (SETQ PY (fetch (REGION BOTTOM) of (fetch REGIONSPEC - of REGION))) - (SETQ SPECS (fetch REGIONLOCALINFO of REGION)) - (SETQ PFONT (LISTGET SPECS 'CHARLOOKS)) - [SETQ PQUAD (CADR (LISTGET SPECS 'PARALOOKS] - (SELECTQ PQUAD - (LEFT) - (RIGHT (SETQ PX (IPLUS PX 288))) - (CENTERED (SETQ PX (IPLUS PX 144))) - NIL)) - [(EQ (fetch (PAGEREGION REGIONFILLMETHOD) of REGION) - 'HEADING) (* ; "A page-heading region") - (SETQ HEADINGS (NCONC1 HEADINGS - (LIST (LISTGET (fetch REGIONLOCALINFO - of REGION) - 'HEADINGTYPE) - (fetch (REGION LEFT) - of (fetch REGIONSPEC - of REGION)) - (fetch (REGION BOTTOM) - of (fetch REGIONSPEC - of REGION] - (T (* ; "A regular-text region.") - (add COLS 1) (* ; "Count columns") - (SETQ COLWIDTH (fetch (REGION WIDTH) - of (fetch REGIONSPEC of REGION))) - [SETQ RIGHT (IDIFFERENCE PAPERWIDTH - (ADD1 (fetch (REGION RIGHT) - of (fetch REGIONSPEC - of REGION] - (COND - ((EQ OLDRIGHT T)) - (OLDRIGHT (SETQ INTERCOL - (IDIFFERENCE (fetch (REGION LEFT) - of (fetch REGIONSPEC - of REGION)) - OLDRIGHT)) - (SETQ OLDRIGHT T)) - (T (SETQ OLDRIGHT (fetch (REGION RIGHT) - of (fetch REGIONSPEC of REGION))) - (SETQ LEFT (fetch (REGION LEFT) - of (fetch REGIONSPEC of REGION))) - [SETQ TOP (IDIFFERENCE PAPERHEIGHT - (fetch (REGION PTOP) - of (fetch REGIONSPEC of REGION] - (SETQ BOTTOM (fetch (REGION BOTTOM) - of (fetch REGIONSPEC of REGION] - (SELECTQ UNITS - ((POINTS NIL) (* If units are in printers points, - the default, do no scaling) - ) - (PICAS (* The units are in picas--12pts per. - Scale all values.) - (SETQ SCALEFACTOR 0.12)) - (INCHES (* The units are in inches, at - 72.27pts per. Set the scale factor) - (SETQ SCALEFACTOR 0.7227)) - (CM (* Units are in CM, at 72.27/2.54pts - per.) - (SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 0.7227 2.54)))) - (\ILLEGAL.ARG UNITS)) - [COND - (SCALEFACTOR (* We need to do the scaling.) - (AND PX (SETQ PX (FQUOTIENT (FIXR (FQUOTIENT PX SCALEFACTOR)) - 100))) - (AND PY (SETQ PY (FQUOTIENT (FIXR (FQUOTIENT PY SCALEFACTOR)) - 100))) - (AND LEFT (SETQ LEFT (FQUOTIENT (FIXR (FQUOTIENT LEFT SCALEFACTOR)) - 100))) - (AND RIGHT (SETQ RIGHT (FQUOTIENT (FIXR (FQUOTIENT RIGHT SCALEFACTOR)) - 100))) - (AND TOP (SETQ TOP (FQUOTIENT (FIXR (FQUOTIENT TOP SCALEFACTOR)) - 100))) - (AND BOTTOM (SETQ BOTTOM (FQUOTIENT (FIXR (FQUOTIENT BOTTOM SCALEFACTOR)) - 100))) - (AND COLWIDTH (SETQ COLWIDTH (FQUOTIENT (FIXR (FQUOTIENT COLWIDTH SCALEFACTOR)) - 100))) - (AND INTERCOL (SETQ INTERCOL (FQUOTIENT (FIXR (FQUOTIENT INTERCOL SCALEFACTOR)) - 100))) - (SETQ HEADINGS (for HDG in HEADINGS - collect (LIST (CAR HDG) - (FQUOTIENT (FIXR (FQUOTIENT (CADR HDG) - SCALEFACTOR)) - 100) - (FQUOTIENT (FIXR (FQUOTIENT (CADDR HDG) - SCALEFACTOR)) - 100] - (LIST PAGENOS PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS - (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION]) -) - - - -(* ; "Initialization Code") - -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.EXPANDEDPARA.MENU TEDIT.CHARLOOKS.MENU TEDIT.MENUDIVIDER.SPEC - TEDIT.EXPANDEDMENU.SPEC TEDIT.CHARLOOKSMENU.SPEC TEDIT.PARAMENU.SPEC TEDIT.PAGEMENU.SPEC - TEDIT.EXPANDED.PAGEMENU) + [IMAGEOBJPROP OBJ 'STATE (CONS (LIST 'CHARLOOKS (\TEDIT.MENU.PARSE MENUTEXTOBJ CHARLOOKSPC + 'DISTANCE] + (IMAGEOBJPROP OBJ 'PARSEENDPIECE]) ) (DEFINEQ -(\TEDIT.MENU.INIT - [LAMBDA NIL (* ; "Edited 12-Nov-2023 19:32 by rmk") - (* ; "Edited 24-Jul-2023 17:04 by rmk") - (* ; "Edited 6-Mar-2023 22:02 by rmk") - (* ; "Edited 10-Oct-2022 00:20 by rmk") - (* ; "Edited 29-Apr-2021 22:44 by rmk:") - (* ; "Edited 30-Mar-94 15:53 by jds") +(\TEDIT.PAGEMENU.CREATE.HEADINGS + [LAMBDA (N) (* ; "Edited 8-Nov-2024 08:36 by rmk") + (* ; "Edited 20-Oct-2024 17:21 by rmk") + (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 13-Aug-2024 19:50 by rmk") + (* ; "Edited 10-Aug-2024 11:45 by rmk") + (* ; "Edited 26-Jul-2024 17:58 by rmk") -(* ;;; "Initialize the descriptions for all TEdit menus") + (* ;; "Puts out N heading types 2 per line separated by tabs. The LASTHEADINGTYPEY property signals that the run of headings has ended (for \TEDIT.PAGEMENU.HEADINGS.SETSTATEFN). ") -(* ;;; "Divides between the main page layout menu and page-# font submenu") + (for I from 1 to N by 2 join [COPY '(EOL 3 (FIELD (IDENTIFIER HEADINGTYPE) + (PRELABEL "Heading Type:") + (FIELDTYPE SYMBOL) + (EMPTYVALUE NIL)) + (FIELD (IDENTIFIER HEADINGTYPEX) + (PRELABEL " X:") + (FIELDTYPE NUMBER) + (EMPTYVALUE NIL)) + (FIELD (IDENTIFIER HEADINGTYPEY) + (PRELABEL " Y:") + (FIELDTYPE NUMBER) + (EMPTYVALUE NIL)) + TAB + (FIELD (IDENTIFIER HEADINGTYPE) + (PRELABEL "Heading Type:") + (FIELDTYPE SYMBOL) + (EMPTYVALUE NIL)) + (FIELD (IDENTIFIER HEADINGTYPEX) + (PRELABEL " X:") + (FIELDTYPE NUMBER) + (EMPTYVALUE NIL)) + (FIELD (IDENTIFIER HEADINGTYPEY) + (PRELABEL " Y:") + (FIELDTYPE NUMBER) + (EMPTYVALUE NIL] + finally (PUTASSOC 'IDENTIFIER (CONS 'LASTHEADINGTYPEY) + (CAR (LAST $$VAL]) - (SETQ TEDIT.MENUDIVIDER.SPEC (LIST (create MB.TEXT - MBSTRING _ " +(\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN + [LAMBDA (HEADINGSPC HEADINGS MENUSTREAM) (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 16-Aug-2024 10:18 by rmk") + (* ; "Edited 9-Aug-2024 11:58 by rmk") -"))) + (* ;; "This is the SETSTATEFN for the HEADINGSPC. Its value HEADINGS is a list of type/x/y subsequences that are popped off as their respective imageobjects are encountered. So it looks like an ALIST, but its later values are uncovered as earlier ones are removed. The order of HEADINGS has to match the order of the image objects.") -(* ;;; "The principal expanded menu") + (* ;; "Return value is the piece containing the LASTHEADINGTYPEY object. ") - (SETQ TEDIT.EXPANDEDMENU.SPEC (LIST (create MB.BUTTON - MBLABEL _ "Quit") - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Page Layout") - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Char Looks") - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Para Looks") - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "All") - (create MB.TEXT - MBSTRING _ " ") - (create MB.TOGGLE - MBTEXT _ "Unformatted" - MBCHANGESTATEFN _ (FUNCTION - \TEDITMENU.RECORD.UNFORMATTED)) - (create MB.TEXT - MBSTRING _ " -") - (create MB.BUTTON - MBLABEL _ "Get") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Put") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Include") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " -") - (create MB.BUTTON - MBLABEL _ "Find") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ "Substitute") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " for") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " ") - (create MB.TOGGLE - MBTEXT _ "Confirm") - (create MB.TEXT - MBSTRING _ " ") - (create MB.TOGGLE - MBTEXT _ "Use New Looks") - (create MB.TEXT - MBSTRING _ " -") - (create MB.BUTTON - MBLABEL _ "Hardcopy") - (create MB.TEXT - MBSTRING _ " server:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " copies:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ "Print ") - (create MB.NWAY - MBBUTTONS _ '(One% Side Duplex) - MBMAXITEMSPERLINE _ 5) - (create MB.TEXT - MBSTRING _ " Message/Phone#:") - (create MB.INSERT))) + (for PC OBJ SETSTATEFN inpieces (NEXTPIECE HEADINGSPC) when [AND (SETQ OBJ (POBJ PC)) + (SETQ SETSTATEFN + (IMAGEOBJPROP OBJ 'SETSTATEFN] + do (CL:WHEN SETSTATEFN + (SETQ PC (PROG1 (APPLY* SETSTATEFN PC (CDR (pop HEADINGS)) + MENUSTREAM) + (TEDIT.OBJECT.CHANGED MENUSTREAM OBJ PC)))) + (CL:WHEN (EQ 'LASTHEADINGTYPEY (IMAGEOBJPROP OBJ 'IDENTIFIER)) + (RETURN PC]) -(* ;;; "The character-looks (font, etc.) menu") +(\TEDIT.PAGEMENU.HEADINGS.STATEFN + [LAMBDA (HEADINGSPC HEADINGSOBJ MENUTEXTOBJ) (* ; "Edited 29-Sep-2024 12:53 by rmk") + (* ; "Edited 29-Aug-2024 11:05 by rmk") + (* ; "Edited 16-Aug-2024 08:39 by rmk") + (* ; "Edited 10-Aug-2024 11:39 by rmk") - (SETQ TEDIT.CHARLOOKSMENU.SPEC (LIST (create MB.TEXT - MBSTRING _ "Props: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.3STATE - MBLABEL _ 'Bold) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ 'Italic) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ 'Underline) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ 'StrikeThru) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ 'Overbar) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ 'Unbreakable) - (create MB.TEXT - MBSTRING _ " -") - (create MB.NWAY - MBBUTTONS _ '(TimesRoman Helvetica Modern Classic - Terminal Other) - MBMAXITEMSPERLINE _ 5) - (create MB.TEXT - MBSTRING _ "other font:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ "Size: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " ") - (create MB.NWAY - MBBUTTONS _ '(Normal Superscript Subscript)) - (create MB.TEXT - MBSTRING _ " distance: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT))) + (* ;; "The STATEFN for the HEADINGS piece. This accumulates the heading properties for the following pieces (assuming type/x/y triples) until the LASTHEADINGY piece. The resulting list of triples is stored as the STATE of the HEADINGSPC") -(* ;;; "The paragraph-formatting menu (margins, etc.)") + (for PC OBJ STATEFN HEADINGS VALS inpieces (NEXTPIECE HEADINGSPC) + when [AND (SETQ OBJ (POBJ PC)) + (SETQ STATEFN (IMAGEOBJPROP OBJ 'STATEFN] + do (SETQ PC (APPLY* STATEFN PC OBJ MENUTEXTOBJ)) + (push VALS (IMAGEOBJPROP OBJ 'STATE)) + (CL:WHEN (MEMB (IMAGEOBJPROP OBJ 'IDENTIFIER) + '(HEADINGTYPEY LASTHEADINGTYPEY)) + (CL:WHEN (thereis V in VALS suchthat V) + (push HEADINGS (DREVERSE VALS)) + (SETQ VALS NIL)) + (CL:WHEN (EQ 'LASTHEADINGTYPEY (IMAGEOBJPROP OBJ 'IDENTIFIER)) + [IMAGEOBJPROP (PCONTENTS HEADINGSPC) + 'STATE + (CONS (LIST 'HEADINGS (DREVERSE HEADINGS] + (RETURN PC)))]) +) - (SETQ TEDIT.PARAMENU.SPEC (LIST (create MB.BUTTON - MBLABEL _ 'APPLY - MBBUTTONEVENTFN _ (FUNCTION \TEDIT.APPLY.PARALOOKS)) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ 'SHOW - MBBUTTONEVENTFN _ (FUNCTION \TEDIT.SHOW.PARALOOKS)) - (create MB.TEXT - MBSTRING _ " ") - (create MB.BUTTON - MBLABEL _ 'NEUTRAL - MBBUTTONEVENTFN _ (FUNCTION - \TEDIT.NEUTRALIZE.PARALOOKS.MENU)) - (create MB.TEXT - MBSTRING _ " -") - (create MB.NWAY - MBBUTTONS _ '(Left Right Centered Justified)) - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ "Page Heading") - (create MB.TEXT - MBSTRING _ " type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " -Line leading:" - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ "pts Para Leading:" - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ "pts Special Locn: X" - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ "picas, Y" - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ "picas -New Page: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.3STATE - MBLABEL _ "Before") - (create MB.TEXT - MBSTRING _ " ") - (create MB.3STATE - MBLABEL _ "After") - (create MB.TEXT - MBSTRING _ " Display mode: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.3STATE - MBLABEL _ "Hardcopy") - (create MB.TEXT - MBSTRING _ " Keep: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.3STATE - MBLABEL _ "Heading") - (create MB.TEXT - MBSTRING _ " -Tab Type: " - MBFONT _ (FONTCREATE 'HELVETICA 8)) - [create MB.NWAY - MBBUTTONS _ '((Left \TEDIT.TABTYPE.SET) - (Right \TEDIT.TABTYPE.SET) - (Centered \TEDIT.TABTYPE.SET) - (Decimal \TEDIT.TABTYPE.SET] - (create MB.TEXT - MBSTRING _ " ") - (create MB.TOGGLE - MBTEXT _ "Dotted Leader" - MBCHANGESTATEFN _ (FUNCTION \TEDIT.RECORD.TABLEADERS)) - (create MB.TEXT - MBSTRING _ " Default Tab Size:" - MBFONT _ (FONTCREATE 'HELVETICA 8)) - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ "pts") - (create MB.TEXT - MBSTRING _ " -") - (create MB.MARGINBAR) - (create MB.TEXT - MBSTRING _ " -"))) -(* ;;; "Page-layout menu for columns, page headings, page numbers, etc.") - (SETQ TEDIT.PAGEMENU.SPEC (APPEND (LIST (create MB.BUTTON - MBLABEL _ 'APPLY - MBBUTTONEVENTFN _ (FUNCTION - \TEDIT.APPLY.PAGEFORMATTING)) - (create MB.TEXT - MBSTRING _ " " - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) - (create MB.BUTTON - MBLABEL _ 'SHOW - MBBUTTONEVENTFN _ (FUNCTION - \TEDIT.SHOW.PAGEFORMATTING)) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ "For page: ") - (create MB.NWAY - MBBUTTONS _ '(|First(&Default)| Other% Left - Other% Right)) - (create MB.TEXT - MBSTRING _ " - Starting Page #: ") - (create MB.INSERT - MBINITENTRY _ 1) - (create MB.TEXT - MBSTRING _ " Paper Size: ") - (create MB.NWAY - MBBUTTONS _ '(Letter Legal A4) - MBINITSTATE _ 'Letter) - (create MB.TEXT - MBSTRING _ " ") - (create MB.TOGGLE - MBTEXT _ "Landscape") - (create MB.TEXT - MBSTRING _ " +(* ;; "") -") - (create MB.TEXT - MBSTRING _ "Page numbers: ") - (create MB.TEXT - MBSTRING _ " " - MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) - (create MB.NWAY - MBBUTTONS _ '(No Yes) - MBINITSTATE _ 'Yes) - (create MB.TEXT - MBSTRING _ " ") - (create MB.TEXT - MBSTRING _ "X: ") - (create MB.INSERT - MBINITENTRY _ 25.5) - (create MB.TEXT - MBSTRING _ " ") - (create MB.TEXT - MBSTRING _ "Y: ") - (create MB.INSERT - MBINITENTRY _ 3) - (create MB.TEXT - MBSTRING _ " Format: ") - (create MB.NWAY - MBBUTTONS _ '(123 xiv XIV) - MBINITSTATE _ '123) - (create MB.TEXT - MBSTRING _ " +(DECLARE%: DOEVAL@COMPILE DONTCOPY - ") - (create MB.TEXT - MBSTRING _ "Alignment: ") - (create MB.NWAY - MBBUTTONS _ '(Left Centered Right) - MBINITSTATE _ 'Centered) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ " Text before number: ") - (create MB.INSERT - MBINITENTRY _ "") - (create MB.TEXT - MBSTRING _ " Text after number: ") - (create MB.INSERT - MBINITENTRY _ "") - (create MB.TEXT - MBSTRING _ " -")) - (LIST (create MB.TEXT - MBSTRING _ "Margins: Left") - (create MB.INSERT - MBINITENTRY _ 6) - (create MB.TEXT - MBSTRING _ " Right") - (create MB.INSERT - MBINITENTRY _ 6) - (create MB.TEXT - MBSTRING _ " Top") - (create MB.INSERT - MBINITENTRY _ 6) - (create MB.TEXT - MBSTRING _ " Bottom") - (create MB.INSERT - MBINITENTRY _ 6) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ "Columns: ") - (create MB.INSERT - MBINITENTRY _ 1) - (create MB.TEXT - MBSTRING _ " Col Width: ") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Space between cols: ") - (create MB.INSERT - MBINITENTRY _ 1) - (create MB.TEXT - MBSTRING _ " -") - (create MB.TEXT - MBSTRING _ "Page Headings:" - MBFONT _ (FONTCREATE 'HELVETICA 10 'BOLD)) - (create MB.TEXT - MBSTRING _ " - Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " - Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " - Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " - Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Heading Type:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " X:") - (create MB.INSERT) - (create MB.TEXT - MBSTRING _ " Y:") - (create MB.INSERT]) +(GLOBALVARS TEDIT.EXPANDED.MENU TEDIT.CHARLOOKS.MENU TEDIT.EXPANDED.PAGEMENU TEDIT.EXPANDEDPARA.MENU) ) (DECLARE%: DONTEVAL@LOAD DOCOPY -(\TEDIT.MENU.INIT) +(\TEDIT.DEFAULTMENU.CREATE) -(\TEDITMENU.CREATE) +(\TEDIT.PARAMENU.CREATE) -(\TEDIT.CHARLOOKSMENU.CREATE) - -(\TEDITPARAMENU.CREATE) - -(\TEDITPAGEMENU.CREATE) +(\TEDIT.PAGEMENU.CREATE) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -4319,41 +2657,28 @@ Tab Type: " (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (10422 34987 (MB.BUTTONEVENTINFN 10432 . 11654) (MB.DISPLAY 11656 . 13613) (MB.SETIMAGE -13615 . 14569) (MB.SELFN 14571 . 16314) (MB.SIZEFN 16316 . 17294) (MB.WHENOPERATEDFN 17296 . 17730) ( -MB.COPYFN 17732 . 18190) (MB.GETFN 18192 . 18930) (MB.PUTFN 18932 . 19809) (MB.SHOWSELFN 19811 . 20844 -) (MBUTTON.CREATE 20846 . 22078) (MBUTTON.CHANGENAME 22080 . 22459) (MBUTTON.FIND.BUTTON 22461 . 23484 -) (MBUTTON.FIND.NEXT.BUTTON 23486 . 24829) (MBUTTON.FIND.NEXT.FIELD 24831 . 27365) (MBUTTON.INIT 27367 - . 28283) (MBUTTON.NEXT.FIELD.AS.NUMBER 28285 . 29217) (MBUTTON.NEXT.FIELD.AS.TEXT 29219 . 29645) ( -MBUTTON.NEXT.FIELD.AS.ATOM 29647 . 30448) (MBUTTON.SET.FIELD 30450 . 32656) (MBUTTON.SET.NEXT.FIELD -32658 . 34049) (MBUTTON.SET.NEXT.BUTTON.STATE 34051 . 34531) (TEDITMENU.STREAM 34533 . 34985)) (35291 -45827 (MB.CREATE.THREESTATEBUTTON 35301 . 36468) (MB.THREESTATE.DISPLAY 36470 . 39176) ( -MB.THREESTATE.SHOWSELFN 39178 . 42101) (MB.THREESTATE.WHENOPERATEDFN 42103 . 43444) ( -MB.THREESTATEBUTTON.FN 43446 . 44765) (THREESTATE.INIT 44767 . 45825)) (45928 65710 ( -MB.CREATE.NWAYBUTTON 45938 . 50007) (MB.NB.DISPLAYFN 50009 . 52277) (MB.NB.WHENOPERATEDFN 52279 . -53427) (MB.NB.SIZEFN 53429 . 57057) (MB.NWAYBUTTON.SELFN 57059 . 59167) (MB.NWAYMENU.NEWBUTTON 59169 - . 59756) (NWAYBUTTON.INIT 59758 . 60607) (MB.NB.PACKITEMS 60609 . 62588) (MB.NWAYBUTTON.ADDITEM 62590 - . 65708)) (65964 74882 (\TEXTMENU.TOGGLE.CREATE 65974 . 67464) (\TEXTMENU.TOGGLE.DISPLAY 67466 . -69899) (\TEXTMENU.TOGGLE.SHOWSELFN 69901 . 70501) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 70503 . 71853) ( -\TEXTMENU.TOGGLEFN 71855 . 73054) (\TEXTMENU.TOGGLE.INIT 73056 . 73887) (\TEXTMENU.SET.TOGGLE 73889 . -74880)) (75134 111443 (DRAWMARGINSCALE 75144 . 78603) (MARGINBAR 78605 . 85466) (MARGINBAR.CREATE -85468 . 88340) (MB.MARGINBAR.SELFN 88342 . 100358) (MB.MARGINBAR.SIZEFN 100360 . 100718) ( -MB.MARGINBAR.DISPLAYFN 100720 . 103522) (MDESCALE 103524 . 104064) (MSCALE 104066 . 104396) ( -MB.MARGINBAR.SHOWTAB 104398 . 106721) (MB.MARGINBAR.TABTRACK 106723 . 108108) (\TEDIT.TABTYPE.SET -108110 . 110556) (MARGINBAR.INIT 110558 . 111441)) (112460 127903 (\TEDIT.MENU.START 112470 . 117922) -(\TEDIT.MENU.BUTTONEVENTFN 117924 . 118408) (\TEXTMENU.DOC.CREATE 118410 . 127901)) (128213 149038 ( -\TEDITMENU.CREATE 128223 . 128519) (\TEDIT.EXPANDED.MENU 128521 . 129602) (MB.DEFAULTBUTTON.FN 129604 - . 133070) (\TEDITMENU.RECORD.UNFORMATTED 133072 . 133405) (MB.DEFAULTBUTTON.ACTIONFN 133407 . 149036) -) (149039 178832 (\TEDIT.CHARLOOKSMENU.CREATE 149049 . 151263) (\TEDIT.EXPANDEDCHARLOOKS.MENU 151265 - . 151975) (\TEDIT.APPLY.BOLDNESS 151977 . 152258) (\TEDIT.APPLY.CHARLOOKS 152260 . 154366) ( -\TEDIT.APPLY.OLINE 154368 . 154645) (\TEDIT.APPLY.UNBREAKABLE 154647 . 155045) (\TEDIT.SHOW.CHARLOOKS -155047 . 157831) (\TEDIT.NEUTRALIZE.CHARLOOKS 157833 . 159097) (\TEDIT.FILL.IN.CHARLOOKS.MENU 159099 - . 166720) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 166722 . 169295) (\TEDIT.PARSE.CHARLOOKS.MENU 169297 . -177983) (\TEDIT.APPLY.SLOPE 177985 . 178264) (\TEDIT.APPLY.STRIKEOUT 178266 . 178549) ( -\TEDIT.APPLY.ULINE 178551 . 178830)) (178833 205312 (\TEDITPARAMENU.CREATE 178843 . 179219) ( -\TEDIT.EXPANDEDPARA.MENU 179221 . 179783) (\TEDIT.APPLY.PARALOOKS 179785 . 190501) ( -\TEDIT.SHOW.PARALOOKS 190503 . 198351) (\TEDIT.NEUTRALIZE.PARALOOKS.MENU 198353 . 203999) ( -\TEDIT.RECORD.TABLEADERS 204001 . 205310)) (205313 240659 (\TEDIT.SHOW.PAGEFORMATTING 205323 . 218938) - (\TEDITPAGEMENU.CREATE 218940 . 219979) (\TEDIT.APPLY.PAGEFORMATTING 219981 . 232064) ( -TEDIT.UNPARSE.PAGEFORMAT 232066 . 240657)) (240964 268758 (\TEDIT.MENU.INIT 240974 . 268756))))) + (FILEMAP (NIL (5405 51363 (DRAWMARGINSCALE 5415 . 8874) (MARGINBAR 8876 . 16001) (MARGINBAR.CREATE +16003 . 19422) (MB.MARGINBAR.BUTTONEVENTINFN 19424 . 27092) (MB.MARGINBAR.SELFN.TABS 27094 . 32457) ( +MB.MARGINBAR.SELFN.TABS.KIND 32459 . 33394) (MARGINBAR.GETSTATEFN 33396 . 37274) (MARGINBAR.SETSTATEFN + 37276 . 37486) (MARGINBAR.NEUTRALIZE 37488 . 37901) (MARGINBAR.LOOKS 37903 . 41009) ( +MB.MARGINBAR.SIZEFN 41011 . 41614) (MB.MARGINBAR.DISPLAYFN 41616 . 44677) (MDESCALE 44679 . 45219) ( +MSCALE 45221 . 45551) (MB.MARGINBAR.SHOWTAB 45553 . 47876) (MB.MARGINBAR.TABTRACK 47878 . 49263) ( +MARGINBAR.INIT 49265 . 50335) (\TEDIT.FMTSPECTOMARBAR 50337 . 51361)) (52257 58474 (\TEDIT.MENU.START +52267 . 57898) (\TEDIT.MENU.BUTTONEVENTFN 57900 . 58472)) (58793 66497 (\TEDIT.MENU.CREATE 58803 . +60614) (\TEDIT.MENU.PARSE 60616 . 64305) (\TEDIT.MENU.NEUTRALIZE 64307 . 66160) ( +\TEDITMENU.RECORD.UNFORMATTED 66162 . 66495)) (66562 87931 (\TEDIT.DEFAULTMENU.CREATE 66572 . 73587) ( +\TEDIT.EXPANDED.MENU 73589 . 74880) (\TEDIT.DEFAULTMENU.FN 74882 . 78026) (\TEDIT.DEFAULTMENU.ACTIONFN + 78028 . 87372) (TEDIT.MENUSTREAM 87374 . 87929)) (87993 105320 (\TEDIT.PARAMENU.CREATE 88003 . 96405) + (\TEDIT.APPLY.PARALOOKS 96407 . 97295) (\TEDIT.SHOW.PARALOOKS 97297 . 100080) ( +\TEDIT.EXPANDEDPARA.MENU 100082 . 100856) (\TEDIT.PARAMENU.FILLIN 100858 . 105318)) (105382 132271 ( +\TEDIT.CHARMENU.CREATE 105392 . 108238) (\TEDIT.CHARMENU.SPEC 108240 . 114395) (\TEDIT.CHARMENU.PARSE +114397 . 117565) (\TEDIT.CHARMENU.FILLIN 117567 . 121743) (\TEDIT.SHOW.CHARLOOKS 121745 . 124852) ( +\TEDIT.EXPANDEDCHAR.MENU 124854 . 125778) (\TEDIT.APPLY.CHARLOOKS 125780 . 126777) ( +\TEDIT.OFFSETTYPE.STATEFN 126779 . 128742) (\TEDIT.OTHER.STATECHANGEFN 128744 . 130144) ( +\TEDIT.OTHER.SELECTFN 130146 . 132269)) (132333 163343 (\TEDIT.PAGEMENU.CREATE 132343 . 144389) ( +\TEDIT.SHOW.PAGELOOKS 144391 . 146186) (\TEDIT.PAGEMENU.FILLIN 146188 . 147738) ( +\TEDIT.PAGEREGION.UNPARSE 147740 . 156930) (\TEDIT.APPLY.PAGELOOKS 156932 . 158695) ( +\TEDIT.CHANGE.PAGELOOKS 158697 . 162499) (\TEDIT.PAGEMENU.CHARLOOKS.STATEFN 162501 . 163341)) (163344 +169147 (\TEDIT.PAGEMENU.CREATE.HEADINGS 163354 . 166166) (\TEDIT.PAGEMENU.HEADINGS.SETSTATEFN 166168 + . 167593) (\TEDIT.PAGEMENU.HEADINGS.STATEFN 167595 . 169145))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index 97d4215d8228fbc8c27931bbb1d5de11ab40eef4..5cc28f1196a09131bc1fc5d699ff801bbea9920a 100644 GIT binary patch literal 47015 zcmd^oeQ;dYb>Hp+q-aEf0E(t5gpr>h*#emm#(n`HmD+e%EVzsPc+l=bASfy@NI=8_ zOMnA{vE@3QI2p%@o3xD*S^lWg*tI8jYaxJ=P(&;q)@=OOD z&$OL(V)b{V34D?@GzjC$SSXy+}*PMRmZ_k#p6UFS@FZ^tyesN=ArH5&NvsijKNIKt#Ap| z>1;+PdbM1(GFZ)`rM1bjQ(r^LlQYGlV;4U-IN0wjE^MNe?W!H_KXF%`z01xy@!`|y z(bLWu>iMbhIcMX_s?&7_%`czLR!`MDXJE2i4RxS~QI;I&h3asqZ|#QRgmY%Pl6^Ao z%~VfKpolJXaL6CmMB>cQ$eDENZYL&nqHCh!&X(ND*?hU0aX}nsCPupkrk!D@?3KkV$C~`Svp062RQ%y@J+K`;RBCkIYUKXx{L0>qpPo9< zvHR||*IyqiHIA${I{E$kP+26>EHye_eR}Ip-a$7ze=d0rtu}fBc@|L?=lBn|8eL;Q zp6BB+7Kv;?*{S4^ zeK#~>-6coU_T6yGDS1z3@lrB9?2H#{)toz#b&`qG&U7VTj^iqBa>V0KwT9HQv-ycy z&Pfg>{WlV$L(YZC^VtgMF)?gENRIls;v*xf-1zXYE;o*v?Q-L(wDm?JVakmUo%SCf z6NUiXvFOA{f}=4^x0zyodKzuTy1)p5x1>_2+XeG=Qi-I#8X8hp$&pcgm8Q{~F1nel zlQ>Odr>@i1buwYn|?<>Ocly8ING~Rm`CG5O z)aabL{n`3_cN6zhw_baBWo)(4r+6lBKh5W4mOQYneMqgnnm|WiR z)_&2U7hLH{BlcS0J?X4GYv$?c&nR}NUa&K49c`P#>y}zj|M*?hGDWowRC+IjcvVKB%-qpxvD<&zQRDQ*Ued{i2y3eHJo6P$f- z=VT+cYE2E~(IFOKXc*@hV-eQea`(w+3%cgS*1Hy?z0pHsUQd?a=9eFcb?p8(VzR@h zhn&**pjoVg)tom=>vVXS`3spPD%h54FpY9!&;$R(fPuamMuUY0Vka zU^zBtOsBw03*-437`2m*GY9mAK-%WVsnOu8sgYEms8kyKjyZe^{7%V$RFYYzUt|h; zrpgsJ{5pkt0@5dWI_~r3OY?7%^5n%HwSKJp#Lm@GjfI??vRAK}y z&k{!oTYx2!wg`$3`LD&%*cR~sT^nsHNO8DHI>h=;r~Nb#10{_n{3OUSN*dwvCOrt2 z;j}})qOLn>OngX>1GOjx5*l-H+DSsViiU@QR#%W_`f4aJNRS=FklrH0hM@vzNiz(2 zrmsooEoWzH6}RZ5QJqOojyU=9^bF_*QdG%7OS+NH0Br(hM-r*>TyzDIe#ykBdY-_r z$nykluPn{d4G zDF~{W5^kXWj!&^n8~4sZCSkVR3KnQ>Zkhxc2Gp%6Z8)hOkvPK)x)qXW7<;$ELJbQ5 zSMd{0oPjc{A13WoP-+VfE1DC zoW4s0YXO_10@$>5pfLs-32Kr_SI?nL>F1IH!im%R)XjwTS*w!$2Fopu#cJPN}*_5Zj8^= zYF;_}Bo$Xi^AvT*p*E84Mj9B+3Mp3j9f5|%7sI4*At8+fzQ97F`=sOXZ$k7lq$r~g zS3?d>6LP8HqJ_aqpI$Y*N&o<0tT6DT`my0KhYMQEMOsJD97J`A6sbVMIpfo%x5@n4CX8-$xfnI>x`aINDrU z^bSY8!=QGuMCXq*mt8KJRIkokz0n7}M|nAUM>!exQsZQ!XOVMfCU_a_d{i_@UYU)1 z{&HpSx$Wq$c}KGRqWtBIU)+vv$gL{vrIq{-e{lDkr&hd2zl(dX-+Pp6 zyz!;1_o(N1$Gv0T(Yp6uS&B`My0`VKo)d0e-(9pW@`JXmi@X|W-ODRe)Vis8$8MeT zUEF&QdCnbMM}v;m9k*MDfqrGNaQnpr&4NG3Ut28R{>^5w(F1L+(bI73frZ8WoGRk$ zE2Z0CDE-n(>DJG|{4SPZeve`5j?gsq*zbIvW;o|&dB8Ex-lH_xp2Jh_9Y5BTF4lXv zWjkL-qx{A|3t#lQZ$H=cy4yBr=kJAQ`o{0J8Ofc$8yLs=p5}_zgQ5JG*E4_I9?Rq3 z#l6?(9lzsP65Ve7YGh!9G$qYQoDq_UPry(ch3YVo6)`?M3IoZl)=I#Fvge#(=qSK& zz)C&I-a(<)3CqA7#j!9 zSo2D-be%L{fuIVTEl!pP*{(~YLQ_0s#AN>qOEJTRD6xg)xx6rl4by0+a&p z@`oh}89>9597aYxEXj1z?rahwMOTvqK48XS&Pl?uHn-=1F`Nz!OA`9Dem6ntn9`r1 zc2Z*!RIQn#1PZ6d05J6%Lvq8aA`YEO7Z}GVnn!bB#wq{y99VI9j^ZhQj^dUI2QE&H ziHiao5}g<}78b;u@s5^jBAkQ58p31*nyG1$h>|L(Wu!GR2{F}@GYR?8l9(WAqiIi< z8HZ$RO@zYj&6Fpotq?@xQ$ToG|7sO;5E`1cl!QwRD_kRyrVEBF0U0pVffnc_7GxyZ z;yP(WUjP_l?1Cwla1iyfU=$?T_zBA_Ezp2>WQ();@`N|5C6~0=iGBK~B9V?Ul0dz^ zQTmNVU*g-27vsG{oqV~~Pe$Q^l6uaJ;qc3a-Fv2%`!0NJ>b8Hi+_Bs7t0dsOo{rsK@5te&Ul<=NF;~p>kOcIO3XmZJ2HCa!`eJG4 z!BSM-k_K_Bp4H|<2JweRU%-&aEw|L8euz#1_gu^;^k_58RuC_PU!y`SmW^}HeK z`Hxoop5yL<-&yn>)fW7O*XaK7V11<=w-0lhYI+IDtLApJ=?y>c4SS>L?dbe)(@V_{ zHNC;u{2=O&&HoH~dli5KmI-l6Ck$LxFkl@x=lc0X(^KSft!S26d~qK zwncCN><>wQscmY0*wKuf>oX=IIx<7B~ZV3dcaiEr<2OgPD6N@@-&l9VXTyK z4ne1`VA_l6o`9Iu#&!Y*ng#;m=wVAy5cT1-J27>cb8Wj2-(@?ScrfcLVkQ{Yd%}rK z#3GUCI$6tNBP`d&8`2w%nDV36{C5k6HIZA5I@$(jQ&LN^xn5w{g@!|oXfWLJ4kSnxbmq-;ue zXb986y)QZgfVFMGUFgLfw~g_LO_Q6f*>+*`YnO&b+|l+%#nH@j*(6dS(l6E z{|z(g-e?CbGjr34=jQI=d)P+%#!BJ#A8;WBuN#J0cXOqv5{f#Zq!LOhq0F<*mEL$a zzgw1B^c$mca)V;$Ienb}jw$L`Y!W0cwn37B+H3~Ti}27vPiMmSQ-J%i zTPR5=4L?)&;Cvb25ZMZrO#;$H9$HDze|gbBv)0Rl*AQrIauV9LE>G7*sH?dKC$wuz zpyN_6!Li}0Anp8m$%UsDFI5MvUz!0VmM@6yVvWb4;>rlbM*xo6%RNp)PAmS_nv<0q z2Q$YCCzX6u+9Y`$putpux`VzSuhy)Du+Hnm0aOoQiEG{(;1?F?#H@n!QXgrFcsAYObLxfIOkO2P_m;zD;Kpo6nzDfdU4viA){@3$_rN-X{*^ zc#R&*#h#XnW+`?-T@_C9RFHa>SH`RqI0)p ztjwkrYjqVf10!Aho5e`IZlWe~Z3%Y-h#|qXp#JXai0 z@x(YZL`eZyK|Ik$>j$kh6$ex!JWrS(s}cV%_+LOL2N&`&ZlL(=no;<1#EF6*v3sQv z)BcsHQV(;=HipY0=#PNp1Jl(o1n$5?>?$V^N>_B}{94Ih0Tl}GXulC_NZN0t;>u&s?jCgBxO>Rr z&~6|oU?v@!j3u0*#|LRugP^|kz$q&4@ElN=(w0l(TE$}}(+?>6Phaa$ z2oeFO32LVRh6H$l%&`%&z(Ulsu(*YgRZnPDGtC$Y8wd0y4=EZ^9*SgzA)_8pB#$z* z;#fbDdRpreXo;kxEx`@dSG^1r4vV5yVu8Q~3Q~(L$>F>RZYWMLNUpuOLwd;xL~dL9 z;=jdG|0twYhbz)Rf~Cfzaw`=5KnDvb<@F-x=#6*g$5;l*UzSQ=SnipU+o!;WZv5-9 zaWR_(+8r+lwt1`>OfS5=^(C+sidbpKN{Epf@DGI0HdD~W0{c??VgSV%d}_`KIgr8- z8d$JmiI^l}(g9ByW`HJ7;4(-S9q8g$pzt-BDlO~=^At->b3_JTWl?I#A&B*a)KJ!{=y0K|M$O_uQY!mosYV+C$lq8o0j-RX zDH*3SkenMwY)!1!iNf4V(vxMP^F4YLxk5B`UrU5oI9ia=ejHA(&#>z-3-CwgIj+ReQA969##g#>f0C{m2`BLYRBmuL0LKbMYsA?wN^5Q{xZ|#3aGJ<%? z{ffFPaEDgEJsN4QuIw%ExjPR^1}U1GA{y^laoMkkuVkELM2g&LW;Ck$LC(Y7p4i>w zU%xbWw_3Q_$vHSt3ORV?e=Krk1%6Vu`ppUQO!D^e&&s!tL=b#}h8HCi;pQNBzPa_q zIv2e48zkpaF#3w8G87n>0t{WN%?-j)o5@z;_r}`20B$u?$tns-!34#Mk~{Y2rl4LD z@$pR(fSV%O8AKCR5F(WnXMpua60%g)ATL4F74SO=oIhA!62>H(&Ilv~AuB+bq9lW@ zNC1_@`j=V|m{8%86Tojm`M_yHDQJJN&IHV77m8jcr#c-cmqeh`aWq*Tx)T#z6@~N* z%bSIpcN7?2CHuq-z{@z0uGW@;MF%T|R7Wle6ja}A4yf)A!(p@dS<+p-59SIm=g3#O1nl3bcK~S1 zZV8#deRY*d*g42tnpWe_`z9v5@?+3sKoB)zHPmp_pFpHqAS=bV1`_}_=zV1~k4#F@W&xG2u|fKoCZp$x0S`%xGHm zs4}p?MWAJ5tobisHWd?uBPEHq`%6n}*ZU!;PCNaz>|%ZMR6k?2a^uKT!XttS&=2f{ zAVUvMgtBzdW3(7sn`s+JdW?yz!5XiN2MSP92kp-IkHG}+yI=zJ;a~!0E|7qU58Q)CUMOe0at8GoDK(j|RAuZzHE|eeCr@U< z$L3DL6N|8S<%xk9%%3fL6|fq}4?W@W1Z*;u46lIKM}EVfc5O<(vl))V-nyuty}OySG&kkXtT4@;+j_sw)useT zJ^OSsFY3sz3&ngYFIq|t1l#q1v`WbKoF?0xAzNI{?RNaq_Uoms@4!xjamD;?&EeVPe~pb1dV+bOhn=M0PJ!ppT@(lL z365gDXzMO;qDky6mhEX2TpdT$h<+PXh&g56KvC+p%|!0i^6bL1Cu)d{Sp zErde0h^VZsU%uQ}QaPX^`P2=ik8D55iPbh)UurB)Z!A4i|FFt#`MyxIWCW{BRyVQ3 zndF_y2bsdH&A^te5|Oru4{OX7*Q8w=+Lg%U%k;`=idZQafOe3d%jK&zkTm*kNS7HY z-&#@JN>@`JEf70=2>N|UqK7)7k|MoFfin^<4m3|V8$DN0YG zAUL@VzDHGCgv4tUorcmEeA^lbex;Jlc$JC48ElrXl%R^hL#>3qsBcP6kxYOeRYsip zBVrw$co3|*L*lNu8)Ap-@nWO)LytxzzE;MGzBqt_Xlj@pDFnBe%8~bdP!OzE5-GYf z#TvI(!PL}31_zFkpx|oRUg6QxcE3;G)~i&lzkd>%26lH2(sKw(wHoaDCTR;R4E2El zSG3xJqC1WW?tkKXeY5|BGa$kns#^P(PhdfrS1o2djh!KIo_I4gl%a~8UbwvEG!~v+ zzy4NArjr8L8|4?ASzg$18tdz;*WOZ#vA2oBXZ&)f7d95&T)C>pZliG*E%FCYy*9J< z%=*Tag-x7ka2Kxw1Ic>8MnV&KcIoa$87D!2&pHFvn*Mj$Xc`EsTRRr@V8s@-%=*4OT8vfH%? zM}kaD6KkuKgLB5)7(pNHrlflP;ub-{H?H*Se(A>+0RxKwFAuHenQKccYs+9*P0iAbwD1K!%wdz@;0amksuezmdmVHjJ? zL#RXhbgBes3OxON(>d%pdnC}X($ckSVD0alUS3~YdL-09h*z8@fC`MVojqquC8e9h z9pdXGr+h06I*M;El1Mf>^v_WUsF>maML$R~QncB*97{-+m5ra3G?t!X0*mv3Ew?|g zu3tRNFK|XN+#uHx!38B0`qH2xFkmKNj7HEyeY0;7ENYvp&?72<;Z7^`H$SN~B_Me! z8@44wL7pQlfIxME*R8JGY6LctARYtI3Yiua@I#92<7+g4;#2jAlC~t;txjRdPZAz6 z9sRagp)JB~F_NHipbc&|tuvSqxO$;RvGz!6vWmPZIVO%-9c zTHsoTN8EtJNgcb;8}A5!5I5id((?IN@{9Go-)TymnE0Hphr?U*F3T8OqO@Ty73N#lN2}OmX7YyG7m8=`X1Ck4ub2Qx1pVazQ9$ zvbNekFp7Ya7*Ln6Fc>Wa@D66-OozvWF*!;AP(h)b0mwHFr9YS-rngE!e!wrG{P078 z8idLW6pLBcHVs=$z<{NtxP!q>JL9pt9BU5-x(ia$#*zKl_{(W})e3};NqbirY>XqG z$ns_o#wvB#lq9+dv`F4iKnf-RQ=%2JprOZ_a*4G2o%O3r8w;Ct7+5&->FUP%B!>FgR_Tck1Wp~_TS(~J+s1ZrQ{w{iiAhE7ITb> zu}cxtt9>bneM=6lgYF`MpIsHnL`BAVJk)ln_ApnV?{@|*NvWQRr2ItV01pjUDWX!p6fPuuPm{c=3cD$GzBEIcj}h5!Hy~!O zMsKv!49EddR9xA>d?z;pzjrMDy3F@dX+N@QkJ|Y<*acYo~ zXm{)ACj6!svU7k9v4@NtT_4tcElN+tBt7+8FL4q9l!SX!h6w!+|yAYF6lqIwuAPR;GaG$}niU9VFC< z#1VYrbeN2Wkf4|(ohN1xG?PNX(1lZQD?n!ftXqN_fZmqbe`=Y1a37LyjcsE159x3^ zU*OU)bkdC^xdVK9O<;qgJV*e)w#;g5sHPxCqAUccNtQTAju|Wfs3k>h@jXZ))duu~ zFg7p4v5ILY5CH<5H%~f%id%s~?9)8oX{)aJ| z{WI6y1F-xIKr4b|xWQXilJ?%mVK>|79q>!&=EGdPPhl%WeN6y9EdUG1JiO~ONfPi-G!s~+G{Sju)xFJk3nFU`OcGw}4Vb`%~` z3Y)SF+I>|@Z9UOhC>HQ8fOkL znNn$vyiAB9K`!z%VP~QS-*HC@>6tU-B5Ho(6!!^W_NfE0SfoDI8;j2LKHSODkYyqN zF|hpM<-SYz@DFY?JxfE9bWVcvX0q7{4yl3LjRrK_eHmAB9P=m=qtQyU9P6a*8(5`nJs-x~(PF>y z;D_3P(VjmLjU33>-gan$y*)A3!)E$=dpku1Jp6#mnN}%yNTQz9{X_bGS@tnVK0nBa z6%{RyDb|{F2k-?Yq4y$1AkfNgO(2KXv3*&2LW_p0N5x7n$6Y=R*Hw=9B#W{d& z%HvHqtIUk=kl`$loZ5SF0<;@~--#~nTnOd3a~aB=c;{kx@O;OkLKRy9NyKPPpd^Dw z7MGscbSm}B%bQMSX$^7!hdEDO2Ruze0HqB0UQ>8mk-#8jQsl7hxuDTRcH7~UTUuCz zgjBY;TI->;A>h}9hbsR_BRClVw(h`_ZOheyPn(=K_63lbkAv@P!7z_DgGLoO1+x+g-0;S_pN18htdbw>$Q|wR&11_K3{A9o6wf z6MMsw6RV}4ya%NFoN*jR^66~Gf$$8qp-T87NSPhaLRwqoIlct92k49mbN|=eNjP@U zLq#_3Ggu$=64aMAFXd!z3)$?n|4w0P>8i7=DFo@ke$j+E&P4s%Rd{EeE9;Bs;Tv~Q zwa53EP?Oq>T5aK?Q^SI~q{sCJ+)*ffeo&P=)i!q zSCFROl%{eA1s$uW(xv?|U-mq)HXe@blCVLgivUYyh?a(z_NozFtF$BZ{#}udNOYQY zoarYj-1VD1{6l^Bu@|j@z%YbJAw5|&Jd*?FoIw|b5I}}@_!8#X(w~E!)Y=!>z?K!# z1`g)qL5u}KDl~P1Iz$$U)uA@}^N+7EyweK73$5Bjy2j_1ju~R_>&})fLXo2&GPwm{>)K6q_H1#UrC^2eg4e z)l}dZ4JctyH;w5dVPs@;LY%E;f zSh%`;iXHy~SQt~23SzBQEjZ>}XFKv8ouA6@-;Vr|Jp8Qtt-c6tvDuFNQ=Q{; zP4`;^J(BoYQ^p_yRCSKetFTmNUR&2C4>k3;Tz-mwwj>gHYev8JJgRrl!Uz<%%fL!i3I$HiKHxw!K{j$)yU_jiAFEYBI62wYwK-8)9CF78;atEXPP z&#Lgk&Np>aa6;QkB&E6QHlnM^zm@)?;d?9)K7Sks_o?4;YCTpAe)Q zX_f|r2pjFhH(MZtH);NZZr>ahVcHB$lyH$?aN}LWB33bmna0UijwZp@;WWZu z_!d~fnRH9}BBHQDnAI1ciC9x8+bf{4jEV3=NQxDI!p!NbGN(78t#sr&cKaTXC?)Z6 zG69H3J9=J)*ne*7W<>OzuH6GuH)B%rE4kj@1I3Qr?&ZV(xPWsh^Rc+#*@UXjcYhamCKe~i;2r)LfD12aP2`uGB)1jYuQrueZ+U15nYb9Y^7t~=JL{pZM70y z0cHv+hamD{LN(m>BfKR_VoNSYf{{8fIa8LfaK(Arl_Epa3W;%E(??^S+g9^BHQsq< zeQh%wHK?PFd0&t?WZ3BS&n^NGb?Sg&*n(87Na6 zcEhP&M?liGOB?m8o4CFxSLnA4wKaUE5K?pLqXCquwYAvuUUSQtV2d4Rv3_lHVeOK% z+X4?1`BR)WOH6De1kgw)vRJ?ndm-a@7!Zta$Fm2!-M$eZFq=$ zBZjIzV#4f#BBS&m;1Ob!NF=aofkobOf}oqCb1Hs~Fs%lRIAi{AX{ zHUa`Pn}r|Q-<8DdnD!%S)lCv$90n4gxCQRP)%6ZMNPe}B6`J4!555}75QD#i1>2p} zXJ6<*FqvZta6s^1jm0qRVC78*A>afPOV6}6Y~fIO(K5m4TP1PO_=1S?Rac^jwlz3%y9JFw9J#@zWU`#`A|T!aCd+v1Kj#Y%gpv+PoHB8CU26YgyY-b-uwK znLwRl7e((^h8d?hVix@$D=nt%r~hoFbq-0sKef_gDy^x~cHY+%PoAQ*9pwPD#J;P= z{&wWo)LUdjb#8q`m+@ZQ9z4IeQ(w8QjIQ~WDScUEI@>C#%)h68f2+B?by`Sp=V82l z0l{bQDjw+glmuD*K9YDiwvH_Seak@Nw3iDzsod0fqoZ(t_jq3XkWv zwKIV-b;wa1s*zHX08XfN;x7x(Z3;F7_Q1fpqHo{$pK(c&IpI@m5{LfihVs^RZCwRk zV$(^90Vjb7B1>H29wrmoUP0UmbW-t|ClCllx?84_p9X*e#jHAmFE#3WY=-q^7$V9E zhr$ki+REr_W^shF8J!s1#pcOmRawul#zlC;b{d6ZIF1jy6!@qDL~Y>IaC~Z(v=X+1 z@`WsRdeIuknf~et-p|+EVm^bWwy~8M|1#CR?LaIb7_GKyFjjzB;FJMi_NOA98kl{8 zsk~BUwtn;8X;I1n&l*_H2tp0dh8e04OZ$}bV_>#sJbbg{Z!%`P@n$gF$L|8Ob#0us z>5BMPVfO^kVwh#++W;-1-ps0HfEJ*KN_eyQteKBH;}w zY*GOj%qtC-RAbUwNTHW&NHbiMz7qKa!eRnPts^XEN1#@9syTZwc#@f0z2x$>APStK z_ck5J}vIua@C6dUHiI_L#?Sj9D=FMi^(H zFmZ5c{)zeYgPLJUsEt5z`fw8z{Hpt;n+MK-AXT;d&6_4=9ANB>9A1U!R6dmy<{iH9 zs}8i%J{h}os4GGgL#{qog{U_S62AgcRJ4qXs!$>ZDvuEkT2r! zKH$pCcHoKY&n&DxMsc2Ni%NAOSOI&9aNb0}=u(_ezZQxh4bQ#CK9rR!o13&QLEC(E z3)rO9H?)MwsMYs?%5jfTbO|;0DMp(sifEXCB$`lv5YMNVSK;*Nw6H{`m_4#$BH!Ta z4AaWE{{BV0!%h{N0$><@nvBON82e=X)`4vc@L$FXd%?y-bRiMwx>3b~{Rt6U=Ysdr< zll9==fF)T50om*j6cYXI+X>`9wsMiSaJi3 zwIL118D)Tc0^ACv84B0o^>%z?&_5BaxA#xn%akS>#v%UUne|isD}J!(-?zKsJbnoc z1!La@eH>T49h%xf-65E?ZuI_rB*%cBr#s{}dAPp_GqL-t!VS5v;9*u@X^%)NCSJu> za)e0MX0urw7*?Dq;hVPsK>zB(r6uR$(&mSjme!n0>ka9>1(RQGjVjfUKc)lRvrVn2 zX*NGm%LS^+tT&tw)fYFHDID7GreIpp4O?4FB{ub(j zwjFYd%86wAI!5{QMD`u1`B(YT1_JRdqQJ(|Hp4dQ74sg^J?T#Ys;Dh}c+**+2xP^A z!GTYJ0Kxe8EeG3|+7@$>!=J5k5UGka+TxjOyIH_&6X1yqE*JfbTL$d1-)+<{uU)~$ zf-^Wi6sCTgrn3G-?gB{0M*>~O$!i;%v~`XJj~s8}6aO16O<+*1J>v0|6TwiGaW;N5 zo=ASw`EdQ`opbpo(IvkYesY37D%DSs+LL@b6vb1M)zqdp)C*aNEurx&GX0X1`z&4@ zzI(@V!x8`ILggmX_$HGog1MIF3lwkDIwIU)&&2-+L?)3rtsXN@<#lIn=~{5kIiU-? zU|V0M9h8dXS$Hbl0YwHxFm$Q*?aBwXs(f^^zHx1H;Jqr=`@}~b_Q1af0p!@jqOKKD zVr3v`rytYB#KRK?MJjxtQE_2y@!F*Y+HwL-0E@k42~4{L^oxtz3`22=c1)t)%W&Je zso;3XLy^lgB=BG3z#q88iD=$*R1QrOyVy|Kn-9vdN-?I13Wrt2zuoQts*$EK(ie$o zw10Y$HSs4{m*+oZm>PAQUSTY-1?s0Ka%40P6%?cp8{xDTZ=k{-1NJuqqOm6W+@{vR z03(nqCv`%q?^u8=b?U z&^U-k?^T7DO})~N+@OL>wE@@)Cp6I46rnx(@D*H>0tZvrlR*CxO>gaIrQL{Z>A)J2 zsUeFUphf?*oMI!JoS$_N0>j+l6mL2sRGz;B2*3cVH*DPn9p#`4qk@A5T7r^&x*{af zM=7xomOAL82}7|!Sn}4ieX6W`G=>;kfIT|I_T1Lsom{=2x4gRNZ~Su#$i49$tSQ7Z z1aKL!L>Xs+DNM*LoC$$^6mBLNeP0^J5WD29UW4K5mmKW57gsCB&@v|5MQYN>gx0W* zYN6A6#3rC2#nx^5dINSrROptz=D?f$=$s#rBu_rBaMCo#-Qp4_$D(i%cju4`6p1)P z%8xHZX3tW59UU4(--seKkv54`P$O=*X0jG=jfiuUqQhTM5gojq$1$RKhRR4D;7aOJ zrII&+Udoe`!HPMJ{ZD+hDW<+P<{zyUdr578=zN)%uG_cV_lio2aLOLO-oh7h!1QD4 zqhfE6q`!trC%=eGq0M`-XuCv{s+w_VWwH0S?nlHUL7oygQ#cyC@c_4g|JbF_H_W`_ zx0p-)zK6v|B&A*+fThdxhv=sZ$2%p-hN%Wy@yk@ALrM$UmuOmcT3O+eL3Az z*AeAIL62XNckQ<6T%GvhI;VSb9@1kUBo4{EPc=tB;9QU46YrA!sD6x3faBBcM^$Y% z9#$96H@zc`&QEgYz0cx0*2sPTRb-XdkF*X5KKw2pP*%gV9r;sL*3Q|cCsFdI+0q)7 z*rVRlx4InAPG2AQWgeRlJ}zz9`GwNzt4}Yk?(O^>eQQ1z#rM}ebmF*b+3`1SndIaz z(@~?T6nxqwFvp*4#P$$nMN^Mzj(ZQiT7DH(APRQ-ul^;D@qt2xvoa8)>Sdf^@N54D zyu-gCZlew=Pb2=-JV?V~Wo}Xkk??NLcD`S3ARW8&hB7>Nz$(?b+rgi{8`_^6w6IM&E;Otu2jh>h`iFBEXv z2E+_i9{Yj)I5kFipt56dZj60@&Pn0874yk0`kV?gYW|uEbLA9lQrQau|D{}@y_g(1 zO>Ms2h0!1c9HaD4~G^3*X82)>=`>V zo$F_W51*F;V-E)z;4^p#t;Ts%B^LqM@P&{aNS}}|db2t?;SVihm*569!h?`t1)6bW zkOh1I`9cWMIs;TxGc}I@BXbSt#A*>aTDavbY$QU+LIc>;x1LjIH=_k&gd#)B939fM_Q+|A0P*yxg%8BSUw;!`$i-m4g#{<4g`{V z0s#mO!0r>3qXj;xVI%Ma$ML~KI5LOT1tw2YF!X$p#v+vq6e|~y?R=2{N=_F>Ka;2i zszW5U3fK5C_e4T1dwVv?>Sp*nX}_ojeI$nI320t6+UhctS|sC4-mxn54jE^nB+*8A z%t;-wVymEph(6-SWa_78a~#EGs+e8zi$BJaLtV2x>3yU#|CKS86v~gi+~aPYT)Ys| zipFm@i}kH{DgoxlITrDW=~%2|_j^+abQB@>g8Kc6Iz&{Q>?ltj|DpV@vcY3gSNCr8 zs|+_D+@}D$)h*Y1c8Y2yRE6Ib*``WVKO{yA;!=7lHx+#L_S|t}3aYI8=!2e-yy~!O zo6&zRb6(Pa&hZt#CW25RoVKRSB#^sW!$~Y+Nvr}xE7C@7^Nb=9)eCm80fZI_M#v;A zC4CT>ZFvEjY<&$j0*D8749a(&%;prV>J%2e#Y5@rIbyBE=Pe#eAIl=vnuKuknM;yC z_<$2An2Q@7pT0rV#xDW(&g_;w2jK8@MjksX_^`Tw$fTpje2GfOW7(`Z39Z8tsPsuE zmQ?f=OkeuYCn{+`wIoa+IL5y}2T3rjn6QFuIi57YmJ^UiiW$>MX2PNAI6RvZ(^*?S zo2LDFv~3Ssj?a;4ub#R40Avb#qb1N9Eqnx$g=01B6by8`F{B-R#?qoVcRhyWE;rX` zqPd2Q^t%mrI5@R`e~$e5I#eCX7CGGEyyT6Cl8xlv2uo^of?fn7L@{g7Bih;I*TViL z^4S18LvXRlj#I}jVh;;Gvk3^#nZvgNF7dIo*IGQ4{eS|k7x{p*XPpHBmF2jZ7GvK~ zfc8D=XgLWU(ZLPGXDP^mj6U-Uhmj3pajP&gUcloL&LPXa4>~(v2`^w~3u_&NuMKLB zg@Eu2+=GIZRqo3a3?rhgSnu_}vxDuMIsguG(=-fLF2f>t#|Ryo3@%OF-^N?4;V{_v z+&i3ZANgAVE}~_jZQwjDXsoaZP4jog_F7^NbxFKV^bIqC%UCcSg!FA)$hr80@5NX%hCLj>^~@fQ zuUg2R$o!r6sgIWJv#leD_5HrV`e1PexCItR;2zeg2=yTLhjkR(Ljki;Q zTEokcqQFe>XIq}42P4QtDOL}WjHJLC3sp2*6`sPHEwNQb+2k{F#G`DktBcm$SKsrv ze-%IxeL!w(JMxD-sLX}VL-YH5E-w>ck9)E2Yt}3<@8TDB){0Me?2dg>_U9D(URk#D zso9#sw{Q89{}h<%L6uYtKGzey@y$|f>!mxPxBNY?^E{E?hZu;5`92wT6BT?Em=4-O zsIHzK77{qT*gS*L#)vtbYk@prQV1PsKXBvlt-$IOquN3aP)>bv z0Ayg_(e@b*u!HzllT7@Zyo0KE;=gk(g<{X941#6($b6>ZQ$!9(q8O{nwEM&p zLfR%7o0%oPN4{LC4mG{xz!81@8Y>Lfu3x>nzQLgZ_!xK*Uv7QR83e}C_W{PJE;<~R z_SvzB8t9TQSylaW7{EXg(&beUJc7Vo^a&BWkTUe?zkI#eZ6De4P0yyuQsJOF|3P1tFXL9&gI>-+G9P@NgysG{; zuLBPeDLz>qgg`?D`#cyd(BZ&-d4SdwjaiA7-@?!7AD4*2b$=8J6|4;YUu>}qq^aO( zN~Vv0a*x%I-8*u3kvtBz9x3vQ7I92O8 z#iBEWKw>%QF(tV|Ir3P^U?l!c$*mUD0-$q_*OoT0e_L@5HZy8V^bri^DrOnjRjQa$ zJ4w9Oc8W!XlFY4b{dOLj?61Tw|B{!Z0#fN!-4a!Y^+Yc}^~A)a(p!3{?Cg_ef1a%m z<(V&v$W+tY8dkDe7-}G)zjo_UCvo--j^iC48ylm4 zXYp?;C)aeJDdP|R3%~D+GhM>i1hUaTyy0fmHSS#x*Z417f);#^DZoW8`jN++)#n+k1+*oGP<8t;XCO9TiP-~wu zlP(H6i<0+kPhe=IoYv9JOpZ;wK{=rj+OMRsQm)MZ>=x-|6H+>8wnpLUJ25#qHfH}T zqCfiugyr_($oJW4TE;hs#M?BDpbYkhYwH w3eTO}faP)4E4rTNoyET&??1dz#+$jZvwj=)=S*Eb0}65`>p_q+@p-fV7pJ__eE~tOj965BIqXoT9MHJ8teudeIYyulA_e6(6I1m zks6Xp?1_`Hop|z?WG1pB+j3%i;=FdIl2j8QYAs84@7B~#ncht@yQ?H*GPRjWCR>?F zW)~dKK5A+#?)U%ydEMLH5aqGs$+C**d(J)Q-1GR)|33fepU6(;i`kQt`9k(&zBuW7 zhi5b6)0xv*uP4;kj&PVj(kD2xX6D=CfXG@Yw$S{nWxZiY;U(yuR4T z$;=B^PR0l0NxVLlN}Ni@`@H_X<;%~%uvS?qdzUYHecq2Q&15GE*>gYkcxCO`D;KYP z1po#p#$(d|%ap3*2q1Z8Re_t$S8yp-tHJCgV8|?F*y|Q9jT>0<|SFXPA zly`w^4{+`Ih0NT7w}x*`E*1)&+sMGcK%ZB>hz~YyJ=u5cp2l>KWANhXk-?FecZ!EL zcFw!<{D!yx)OapaJe{3Cx!`;Klg0V^&L8tm&CX@doWnzc9;kSn-s3msnJV1aF|Xxxq^0G)(dSz5Z$JI%jI@mH zr3cRH?r~nd%vl}l<9D|HpY@45TmNA^7rC?b*AuxYe*R*uqoqGF$^r18d;L(pUmr zEH&g&`Eh^toEJ-`LnRZK)55}hE`wQ%4JLwbN8;YtG^QLSyrFpTU3$<17|&-H7#h4( z=yhV4dT?&mpU?B!CSsI6YtjIM02rktDX_b6ZZ-=Lh^0sH4cY}>EQR{mgX8FBGKO54 zf;fP&cqR)36B``%074_f0Dsz}=^=uZ@yvKG>m{9M0GtLg0$l}Q8s5xs)OJjw(*Upl z+|lkN$WuKd@KfE%3nXI4{i8iCEfHrKoyX32TRz92mSdRt#(wpC|N3e#{+%yJrlJup z@RU@WX3&u5DSn=2c(|}$;9}}0r&7AP0vF9o?kE9IVnhQB?M(kn7AP+k8?vB66M{wa zCnqrx3=XtrDmjv(mqK2=;gR6-4TZ2mI;pm*Dv#yI(&me&m+}(}IWHayR*%SvMX_Yb$!*2_DqJNX;?M>AuU*8Dr# z1zG$~PLND)m6x@qD|D+0SVByJqOJ2ee~CIWl+rnq`LmP(01s^}Rf7-!3SitLgAUTg zMiFd{ZH3ng6$34RF3x#z>?e~MOVZpG&CKP`X9H8m8)J~C9uo!1ls}yVx}H0om+2c{ zoFhurfI^jM65YA$jL4L3b?10;B*hT@6{p;88|j>s%gZ*v zZ(=&QszpyU&kA`+W+O^CY$=*IBopJnb2=V|(j);V<2xWWh3>-ex|GWn{n_jsF?o9S zX|ieU2}b1|kyDy!f>;fy;~+3?V`Txh&(}uB*D?mOoJ(aSVG?!N=`jUPMT+m?~tkjXRp$V~B)@pE0q>rWN_T#(Fkp>p>xUmS?GZr`DGk6{~J$SlnGiy#hhfoH`74tp1Xn-{#1A@wjUyN6#7rA;;9ZQ4|v zof45T0f9sziA9@xoCr;(n?gHvWW zrB6c&0E7~x>dl6V;HUej4R3PJpYf(9=1-n1`U~FTe0Jgk5JCXqvy0!A6>YqDPA=Bb zuKNFfRy4&+L=r(@pV(&DV)Z`4Z*>*ewFvXugOYd*-kYi#Qwr>a7;JrElL6+~>HJs5Ksc7S9d+ejSK5@D3apz*q}ZVfMQL12za0D7-cHGG<}Ou+}7VLM+2ROAVt8wgwSP!)_Cc ztyynN02OLv_G&qPMk_swzvEf;a*OhzYxe4$;* zEEX21E;#ecdmZIv;7vb9Et(@;oYh2IuGG znK5^s77cUB6jKRHvB3~VdnIgo@O5i zC8|jQ4rTQ%t@!Wgy8w)CF2Bj>< zFiB$=+iu;Ejx$^dTIlSG=F0!LwdDJ6ruj z@LTBeG=CqQmpd9Bth~WEHJ_hb@X^N+GojGPG#_&jGZ7lNEQuK^cq1OFyF$MT?kk!Z zmEF=A$^FV|M@|OxGRAXmdmnfGuXrSz@0Sh2g?UAHww|fany$|p&PxLi)xUbTdi6@( ztIfZk&q>F6Y3C7>A#gG~zTl7NpgsuAVa(Z0VB#Su2BtWm6sebc?M@V)CbY4E7fowm zZv#sN0F3d<3=|DwCccDJC$hsR1riC=AyU*>W=>;pdIe_G793#!IJ>|~*9HId=|WbQ z^@gFxFfBr2M1u>txonnIC8kswxYCqL5lJ<#fEdiH`hCMNG?~v9CiLD(VW*JVq>v>p z7ph580-y9JPtNAEARDAU0f-WaLAuW@jOT>B0%ZXGK#=8~RS$MAfhlfPeEp%$SZikV zX7tY1iOlF4Ud zp4P?pdMI9)LGjmTsCc34sod1G;GhSg&}nHAS+u(+xAFUsFgDg9#pejf;$U9|$QEZw zLrk)f2h>@&+z_W(tR_aakeyuchKD$#;QQ0_-VpRNJU>A9R7`TgGf8gB+0n$43MtJO z^9wxf#eBhQAsMfQyS)3KGX8~1JlIZk-${QkChQvqTo73yFA%*;Xtf^moRH{*VBJhR|I zFwM#3< zEacgbP)C^GVup^WV*Sj%2XM9f%wmeZi=%7SPo|@W-N*Db!8M~q;&z7w5I$b@bL%@> z-T6JOpAn+;8suDn}BHh3dljpN!GWnjYrX4SIw*w(;41VjRf|OZo8pgfg7zt%F zu3{XWIg`~X%K~V~Ax0b9W>IV_(!A!{&@yaPV0!-keT1KRPC75{Rs6vP{d?o-TtW5< z?~JF)HwtA*k4`ftzPVTZKA?WP*97m5ag$G%`R5tT_PdIETDRXZD*4=62fy3=KjiC# zlp*lQPMLu22^N7^9NG)D0;Khpm-*s6n-5};Bc|09foWE|4U&(^HQN{SOZXl7LWSRz z<`wGoCYz8{NUE&jLeQ5$S=qdzlW_L2%62jTkXE3PiVq|kUD4*VA)5#wLjnl9SuGmm zRivSiNJW%as23r8&}~|Az>Qt>`aPY+9%<|JB8n|PTizTJ)=O*ct3asGnXkrEq_C(MkrbNH zRsm*MXd=h-c+BCzz5xzXZwn>NV2)bV1a$&qM9wkY6{)6{i*DQ^ycgn0iTQHC zfEQ0P&}+ahf0qZqP^=8?Y$-N<7S%89U$Z|4(3gnp5T1VOPwRHuYDeUprC17!b>yOF ztN#Y}ULrWU4Nq?>`XXz*q1q%H+k{xA=OJ&aWt_?6i%ZA$gW7}AKM4rVwPvLX_KO`ru*x&x77yh$>z z8x~lzGeBYA*bDu@>KVoy^ z;pH8)4)%3Hw5?CcD>3>_^D>=ZpW^o<3{Xp8+YKgEk1^sZK7qE~7($HW9 z(vBXU>1@02~frC;=&x*K@#%>d|)Qx2LnB@ zvx5<}(4u!HRAQ`M0U9Q3&eI1owfZ>p6Cqs+7}{Wt!az>bM&MGLV2C$Cnl}MdY1;Y0 zn5AJ+BR2@}i)30Ov5I>^f))0K*0wZtiHP*?Bjm&|C=hQSL;esG_vN->ujEo^BhSE{ zq15hFe0uwQ(QoIsUz6+^hWXkIL-6a$MqSgt$}C-5&okx!#{FWgb{#Cla9x{$f5p@^ z`&!@&+&}&!+Eb?s%8Ir5o*MaFgsO=Cv{pT(OC77J5>v%n8@Hu>za5Vo+!)=LBYH|=)or4dqR)T@c(P+jUh6vuv; z1=@#=1$Y8(16~}vKq-;qgGtgN$42x%iw#2wz@=j_5Q!Q&W-Xw!Q-j;ZBXg=&EW>ze zp4qt1fM2I>cK22TZ9mV9Y!mXBVY1#x;U5_aDg3wZA020CCts>BUvK%v27pMuKaG_5 z8U&wk>NK|xG-*V^WiMG3Hg01(YRDZ|rUIc3-|TJy3+DPcsjqMS6Wxti<1aLASbh1? zd+I$4K?#7b*$i=@(*Qum$v|v(6^a^vBv7wFQ9|gZC~X~E6fj^u5hitH7SU~@Qm{!y za0m$Mp*t}+XlxyEhy?zQq z5mwtF2_=apOJp%q9!}_N5 zinfN8A=WBr@k6k0>Rb{Uy#fISI&!=d zFoRZ}0$kd}+xJ_rAG8dEBI_(z$(j(&4ze3Wyj`iA_;{3IF-_0-FOYRXcKFSM&PIf7 z!Aa>Io~!YmJ)i%==#=Ot*y~6UTVWqF)-g$ZJs7(&@xD30KiW;?v(j31QxL)Cuk&y9 zS0Qo(LKha!k$!7DJ3r4n)dh%ii*s4!xC$}}g`Ol}T%Ti}j-Ilm%BMEI8WL z9WWZ${z+Q8MpDIS3+M;W)9!zos%4j(>12U%67$#KL)}yZYdiEep^SCD7Sziso9{qz zDRV9;=>b&=HxEV@i%a}0Fcpix^sEec^ymoUF!Sk3;FU~iSiLx#yf%lW1U+I|^Ap+Z zM`=xY4;D6TYn)U9C}yjV9oE@zTZE%+FR=Vgn#g8siy`vo?CuzSE*yv z@93O+$oE>eTYoxI>aY2STeo}szOM7E1dtY<;g%O7rQvE*j-FjoM-wg?&aVP$iI?)cvqopO}!kQ7D|I&}O zD6iG2&c28J0qN&p%|Fq)eg1$5x)?&{0CoIFeXq+Auk)4YEhjkv-s~Uyq8wx_R_cmO zY~1#{q8sa--G}{j>-JOrsjllSFGWi6nm?$7j`bNOkN9z#RF&%wL`wtcMYMFHcKz;p zq}0b#^0I%_Kk}_td>X&sr>Erl-48`dkJtQRKl!b#FZ!qa$BVb#D4nYL>1Zj9?2R`{ z!)WDWen-Ubh^}{bb^Av!&`(@%`MQ6!%N+v^Nt8B!?2N4FJiEFFR~rzT48Oyz!_(np zj62V(&a>a{Bt)u{B@piid7h9m9SlxK{eBuNflIV>V-2DqVM z2{2Z{jIi}P4Zpo$37C~a8A-B1o`%bD8XDffyVOXia0+J9V2QBLdkQQ;umq&3P)1yT zFa@Po;9U|u5HT=;Pb;Y}fq8()1q6h1AUG32v7jI)O#)}r zH*{^=Q=^hegO3m5$TX%}X-v|XWQ~5)Q2GWDbs9YtCM-LlkbD|KtB~$Ac!8qApk5j* zu{k& z#i7tbN?t*D4N0u17|KCyI2ywBK0lrT;jz?^`vlqqh6db643;_16GdsjJ3w=gP_!8e zsQ{aZ6)5C6vTouLqdzN;8d!*gCFR^qf>lbGZ9XhPw35}Td{9E1b@bGzxgshlU&LuN zA(WCN{gdttsi5Be!JNoH=m~0}f~qHnp?%B8&Y}CAGNtzI%j|Q<${Am35YZ2w@CsAzYz)LpB7lCdkO z1a|<0xlcN90;E{f_(Yz%{DGa#KK}%D#_zv1(kc zX+kYF5w=vsfz-@f^0omYVU!aKp9ms0-N8Ww;|>lYe_{s*g^@KdNB}266BodL=`bD+ zYrR6a7&s(QA6zE&%_zR)RE$-GHBb#;tXdpT5b{vcKE!yP9Y+zRF#x8Ltri19Q<#s1 zc*5#(N=YA~krae@*iN_@*3s%(bT;90S z!+R9^e*zvcZR%LS)<^WQg00J1=zPZ2?9@l)U#g3`I~NqVHEx91Z8 zSXSrP(@k(Hj@y_Eh{VRL9`SaiU8z;#0D z^hb0a2}KYuXo-^ME#P1B09ji3kK+?sK0!x>CNavFzVp#yq%~v_=BC}tbcC%3+Ny>b zoriz#Gzx%37&%FkPeou!tdh#+vuWQA(8|F}Qd1+od!tqWp=ImmcF?H|rXZm;ib{S&5r#nkZTjw8Sfl1!`J#M0x6aGPRihxt6i>|yhY$m~s zFySMHIamTHC6JNAY2gb+aypB9DeQl^jN`}+sE-nql3-fZBgrWufIvqlh>Ic<@ZR(i zFzBdqvB4l(rDM2(Z^9ZDNQYH^;5P#AiJrRhPS|IcwBqi2@V$X_J-JSkL5?xqIh+mF z8l$r~Aw)<|PMv#cGH)wYP#Q`oZd2%S45Q_7vwQ$uqBN#ZA*ec5GGL<}ka}FH#UtYfp+l3<1_8CWvkkwikDbSVV8(AJrhbvtX>HZVpcG<# zT3gkNkUr>;;?{w-dxcwvz6~)%F3nGxC4vcXa0V|6CZehO9)+MywioUCi^mJTap;P)1I4+C%@4bO`} z8q!7}9aat1+Y#bGu7-6d48^I3|P`x#F?>Oy_w5TgIp!7|`KqBX8A) z0nV26Idb}yNA4?ld%cy;LJg!|!RZ$)rhEu^Mhn&kiK1GWhBKRD7ehT(2sb|0CD)%jFwa@(5>~OBAmm} zIxIiOJctC)wLsNkbuo@fho*!KJTm_QM>3fv=1A{~G)K+nDS-CNOxs~{OZ7edmFWfBxo650viLs)@D#502b z3^D!mAchr{E1U%p0G4S8I)ikOF~1T>XfddQ+Eqjb_z?@TOv34U8L>7p+g;PYG?km~ zUF~J;dVZ=Sl8HVWt-U^)E8LoXY3yU`x4wO6>&W=_yQgp5mm7QIE7Lhu^tD{!jj!Z4 z-gve8dj8JVpF53wb@jFNb6=_c3;6WI`&98#fM@*(!mA#Y1Eh$3mSSfna1H<>ou=7( ztJAC~)`uRQUF*_vO;J%qT*~n9y)||zPzSmok2#H76ye2Ig8k}pFCPix4Zt(q+xaW| z9co+ZGS(}Y(0 z&w`@mS?ol%rYnMook-QOb|T3T@kXANDpe9<8yW@6^7brgZ~oa^SkkBfxTcU<>COL) zQ%cb9h)E?y4j>ZJCM8~Mu1O^Yy?1~cNQLcD$?y?el86FTk}yiLiiWfCuktUvL?SXwsv6Y4A2c$DAkbwa+Qdk0_vlZMDV113S z2G6RHVFx5OlmqmwZCsj@BM!td?!Z+(cwkdaxFQSRQx|wp$^QvxxNY@=WQb>s{kPxW zJq~|8yoz}R1{}aHW(u*AnwVE&DAkrxikF6xdLM*0T?{gNaASmb`CFg# z4~sRyy#gn}z)o`%8^*jE1L`s!?{y}~7yuJ}R9Xz^h1pdK0SSborOij8h4pr?KSvC` zIvp0EpegVsRxl0xp+1UT5{7(>sc+HcqmC%H@X&~vFoP73QF-l>YL+zyF)$^1KSGEP?F~{5=ig6?6 zBwU~P#y;ij4GzAsloptgR` zs~v(FH~$Czt^PB(t%YQOx9yrtQAx=)8GH%whT&_;&5N043RQ|tKwe*O*8@2``&Mc7 zHxdaVM9(=A1f!yQl~i3%LmM%uof5v?Mn=AO<&+5uQTIXD71_R|bJ4<;Xt+%PnX_)n z9)MTjejJZO+~*dCqir0zl6IzOi~yOMU;Trnod#?qh^CW zgpF#jJOvSKLJ@qj?XmQPumL6v63_;8;QAl}1m3B|;Sd?i6GVyB`NGg8F28uG>>+Vck);8UB|5hwQEcYn&S9cNL9Fv<$mWw0%M|IK5h8(5!qQy!G;5p| zDZ~k@_l|jy|M@=XnO22w;dztC&c0ThSVBbRN)MY!*5w^*n=|E&9oUFJj?>n7kI0XE zW(wc>^nvS=%#R8nrL|tG-@&fI9KA^kKcTbuT*csp~C2QLOC!mrtPs zxoLFZ@x~pH+`YFd2RACwV9y?S<7>r@H@;rolHUFIO?p=hcde-U_3H9%M3Z5hWXLdG33@zkm zXK`c!`$BjeQacIvnS@`SdLj{+k5wk%@2Z}_ks8YuJXXy!6g%b_T&{kmNYUmQQ=*^U zY-1~9UdzO%(wG!ycrs(y#zSz30-i09vsqd_LuSBshw39+oXAeF&oXkLKPmX|fX4XL zAq(IaLKPDdJ5`>!Autg9qChQyvNFoZ<6B&_fPgs^K3}3);E|lN7=t9KQ}f8dknk7! zJc$i}b{M@NEC7W~Ba9m89Y!||75C=-k(PZ9&dFpM-H*x7xcqcZ+&B4~qw*|Vh&sL@ zurA@?cr!j56>KkwwsHQI#NJBV^qp7MUaz#3r*Ge?K0FQNa_84;Yp+cRsuJ zwbSjDeYal&Q*-BYYhOpP{Owz>R@$cSe0~jnu1HVazV+4h(Tz&4LY1`rT5nf82YJxG z&sUC5=Whov8D&pZdZ(v?*~Lx&(#JfipyIjUR6?Mh3|2;2Bjt7Fgu;TVf?J?^uwe9vW#Bn6s#WM=a{OI^T=)0N)J zK2=U;lp&!OX!3}3Of{^6(oJyjoz3Hw=!Ua2AVd3@ZlPlWVdC&u%`_?J(zn_~^_^rx z*@uHYS+32MDQ@q-Biu?}L$L3eJ<5^;ZO=6LS&ebhkf})Y4&WHbrR1J}=C?kz!ofIO5Lb2_#EDG0d2`2Z2a~l@wBx zh7v=QlQfj_`ZT zecY&O;s9A)KMt5N&){P9a}0`6{R{xZEj-Zu<6uQnS_=}rdx&QXe+5JaTqG}ED_e+5 zE1(3?5i?^HLL77m6PlS*1PiOguZU)mkL(=>Y>J{LMd zWNLLHG~q~TZ6fwZ;46p&Kn);F5?v4y(rbc63Mdz`#dT$?X$QV6X0sFXinRb#Q-gfT zh}g*F83L^t4L70{-a#zP9_w0Tf*4=SFu}5f2a<@O5s)k>e{>e4J1zxwSY^S|1)VL_ zD^ON4bA%n~Gh+mnP?tgEL9T|)Vpt?pftv-;J%Qwiut<0UvSr>171%X{zs*nBR8$m^ zD~XxIYVcQp?xbyHxX>Pa2H=S=^YK;k;G@3gPm=>5<8Zmzi1~baOS?XNmyvVlk@E7} z^NqolmVJ)i(Rti%9~A<~!gS{+?q^6R!G;A8{?mHn{hfmk@MHBcBAXBTz5F^F;oZ@N zqc;9QxL9|?!@1`Ze)m!M*@2Y)q2JR*wW5*raz28YwEnRvIPghj$Y?vCS@#e90lD-I`iK7G)^B9tR1H65zt2Cq<{y{ch)$u8 z)t~hb^Cz6X_1;6@BEQ$LZ;}5t(6`str>Sq`gdXVI;Xfen?YMuqY2Rq-&^OQRTR!r7 zxp3#ko?5|9_t(lZcV2>k-2vXM(oyl;IfYpLvTEV$>%}|2QvAev@ph>lLbmU>L&_e* zxvPF!vJSTvr1Ssau0t~;NC zD}BR0ZT`I5wybl@CmPJ%wGy-0y<3dtf%bKcKS(N#FaATff$Lr3nVB zIOL6k$T;deg`>`;6R%`*{s{)DTFyVz1FeXEnEpn6kAI?mUr$Zs6lNwFba}*%SLzdR zi!UV#>(17ttbf8kYWZfI@TQL7+bTTU!?kdU>u-KtjsgUxV7BHLU-of33#MSURIK5E zK(6LbM)e5+9QU5{Pi(#mol_kUw7^6C)b%&71#*LZ=q;V_`+DJAT;G+1Gp&^<&+D7V zWPX0oUy%7ZTl42yw=ei-cz)j8ADo|W|0g>kn4eEw|MtJN8Mi2XJN#L+e?s}mmHMuK z`zw*s`I>)LYAJ|#rsiLG*}vdFgXwstbfM;-FP*9R3(?X7Iuk9;VLFzf#U!qsXbl2$ zgS6l?318{6z9q*2EyuoJ%$sMJi=J0TPpmw z;T4QvhRAeaAsP;qZZLEk9|RK;NaGuNsDmn`7-^J7p!XqWB`DvGz?CLA86!}MQD;XW zy*TX-<<1Rc4l155H~QJqz81;kc@d(|v?GvDtd1Y{BS z5I@eDEwOI^$xsYGkrHF1)8!!S*lb#RitAM{a*E83W2IVhgcFYyC`X|0)q?5>4)~h6 z(4QEFbm^QD7;^W#E;EE~)>Ta7gLRpt_^!)LU{lp)l2lut3HH1$6HRJI8w#7I4e1ad z*vFpbR1t99%^Ezi3TcVYV=AV+teJ751ol-bbU`clY@eM4g{(k)zjcd79 zDkr_A%sgzRe2_>7!zB12d4zheMQr73DP6?wYkDW>zaz7Ou(Ff& z)P*lNsq@u2D^kBEFGQrSiM{Ttk|#d5H5JFz{>sfj%!^9w*4h+H7drk*YZfh*V9d;Di5-VdIA>_xh=s6*vkiNZ}e_)<%?rZy~hQAImh1N=weX>Ihxh) zRZ>H_s|q^JDzOly!FHp{T2hYzStF@MbvncyXhcyfk=5Zd6L^U&7?9Pm#RBgk%Lmdx zS=4W73>!S~62zL*1T3Lm03<0kr7QB2(Usa_nIAOJSVJZBf#j35NBj7Yd~UZD zYu-*Ya*ih0#pq0f=^AfR*m{zsmdx+m-*Q1F1jA{82{>MOc<7 z%b3#m09`LEsFRx{b&;{3!fK5sJE+MDv_rU^<`0>#zlFVtlb}S;+ye_{hh#Ige6L3fytM<*qF>$A$JZDD=m+&;l2_uR)=0TWGOqpq)>H3 zmpNQpLYNYCy#905NvBXpvqF!Euy&(&zHte{G6_;so8yD92iSy*e<&8Lc|$>RZ339d zB!FMcGwm$hu+}#d8DY+hE+V7YoU)DzG7x(l8(fa^L8mA0c!?367CJzA171Pi2w>o7 z7nAWxWL zwb>+84zu$|r>Dmsn%+m(>JxZH^?L0vg)-z0olV`Xwf+v1z%)p{EwipZ;p~*ML^YED&HL za8)Sn;TWde@S6aHhJ{>~24}S$_S<2AaEj7la=-|O`CzC)0T)u;=+Y!E%t~AnsB$are)2*y<+3gUGEWZd`6BgRDr01drDRY=NCH z;Ed#4eL%rc7Eg|otp}9OG>%~Qw1g1DTsj-W-VA`0WhP_9_Lz&Vu+4427YHS?)9L0= zFq-VfLDm9b4qFO5wJa%=*!uPj*~eO%3i;wa4vH(&$#dHD51kLiKYst4BWhA zbLAe?aBI$OOtz?*V|U}It14jCvP?bYEn%ks3E)Y)oY7Wd7cjzkOG`j(u#AX_ETIG4 zkX39UzrZ)=l39#mDHJDsDhx>zjcH66`CqZK_GC8uM6da&>ydvhPjUrDcC`yxTbXUq zrKt;_dOEw>GMm0OaYZAyp1*sGY+d8qZIw?lyIzfpVsvlycO$QkZQsYdnV7qHJMo{F z^V?rutA2?t)cDNQd0mQMU694*6=z&q;746XvLrZwg&Og|DyT0LHh*@n)VuVbTE-=Q zh@{t5O77Fy`2AsZYguOVVJRR@b5}$oJX%<_AL1vOCvizE@Sqv*tIrQ`86Nh;_8R}% z)-u~Ub(2p#^8Ei@<}V1Y5nG`2fm@Jw@|9lxu`!_w639hqpKI0MUgJ+xKS#Ukuf!2|=7Bpa)cVY7s2{9FTj0y%{*3u@r%sTrgLH ze6pe0u+fd_yclzmtXk1200GY7b=I{8_I!z68t8G)t5V16y$SQ z{lE}o=(4=Tv13u3U}6M~EJ4q~?iJZ57wHxZptky+fhYz)3T%i{;)X`JID82V1#kwl zO&gGKa}qXugD7#kGtCm;^@(G7<`N|;>|O{5^prFq9oZWgISDWdxWjjTwvZ=50Q)`x z`AoN#fZmX=6(ys;$%G3w28|2X)C7@_pWJvKhjh!>gT77Zkf@SdG!A+Y%z#s(ZkWzU z!Y6>#BH$!R=W~{y>2OHFhr)Qg;1j7rm#2V-@{{K`=PWHirFnH$16 zeuJe@vZNr@C2*GS194JU3CX5Kpxj?AzqHyL;pA#}yKsyo4HyAVcp|-+?yXi}(Rh5a z=>QdKmNn^6$0R5G@sO_tE3H5~AeBQ)&qRdosbW4k_g?W2r17XrkU$tfCkQUVHjr0^ zjEL&O!S7$8@6lCI;EclLf@wh`MmIY9_Dr>I#}BBht$KKv7Nh1jAJT6apXC{$H?CFg+p1K~@A@(*OudhrkL?c`} z*Sv{{5lp}HCSKP=7^PmA-b)AgFPuI=Yg<~L-mNDu>Sp@QV0J5RB-7y95V#a_F_1A?p0*VG(8M8MJL$FN;jPT83bzDT766`E6coa_s(sD$MIxQ;ABO zYDo4-5BGZ-UW;mF^S?G-X}$F-KCpR4f8~pK$Wb=8RPCl7GpRRuruEia`W+Wg(4zC+ zc2RwhgzV9y#S^#dpd(FBSS9q)ott+kgMSQksD#72I8O)!0ZiA zn#VD3>VitTr^M|~3`^grxfryuwm&xBzY=)K*r{5CX*bv+ls^qygdRo;nv115kJsc=g3>HDuq7**rwnAALAtD+5=#TYz2!XLb{F=C9 zw+4MD3AylOVq_qNr=)jskRHH0@k0W9Yq)#@+b)#1A8;58XTr5CS(is~#6y)S`dmM| zoc5EAW{xAtkFL~!cP;!$nlDPaH z;2LNg2wFmD|aJb`zY-SEym$WGSjIVn@ z33?$Y5^aN}!2-Y^!0TJQ^r6dFp1*kQ8r?+<$tuXIV)r40ab~fwAe(RiT(VJ^Vz{D; zBaHwy7qf%(tT$wExf<%?B4eaGbpo9!63#z#>z7?1`xGeiNNfIPFK!-xVr}OOd0sY= zdRIG;x7nXB-+Y2|d12*M4R6H6$C*1f{?Pf1$om6Nu@~AW;%=No} z59~iMHZ2Hl1RBUvK>9eOAe8|f4?K5*Zy{pYw?Lw&^JlUHu2@gUuK-E{pXL^!IJk+R zluEt`&_T`Q=VAAUm|xcriDM9n?R`by27*lx1q>K)c45Y$UNRsz}f^Ce&T=q@I zLv`CXjsgqpyYHdAGXq0DG-6JM87Z0$l){D~Nw#iBWX9<_36g7tCI?UvU2t6`@I(`D;KY>;6UoywShhl=HfoO zr2d{t2Z+yHcHEzv7+5S$`g1do&tVr*lCbnpb&Z5dbKsq1O2J7GlOG11YL)%Q+e-9p zJIvYxb7P<`Z{wm-aIHY2SZn9wDEot0dL~g#7a}t_I2fZpar%?gSP>JSKXvLjZkiv@ zorGpSIg@5?$zGqeS%Y9IM6&UoirxEMgNL4w}rPesI&}m-r^Ke0fAneniX69)?Fpg3F93s9im`njaJ4z^CuyOKpGao<=at*@D zgEyf;t1}@W{|I{5^4^v`EfF3Y<5I?mK*6iMv%SkLPXanvB*Q|(QBbz~{NfmNK?~p= zppc;`hq&nlLx+=GCQoM{B?lieuQ+yKRG3E2 z=H!wOfS;KO3N|>M&Caq^^#MQ)tGVzC^sXj|j(9o~gm-`vTq`dc8CXqd>IGyb3z^dd zdU5YKR&6|+onRd<)`(O$RL}*jT^1Cx7z9y(7-bOIN8kmk9YjLTZ$Se`h;g1?Q_uwp zN`Xh=-vROsK?FkOcn-y|V~L~31E~hFHFEy^0wt5)``(KPnt24YL@I?81vTRYdET9- z+@ZR`A`{c7XZ)DgcDMZToBP4zH?Tncm}(?!8Ng)ich| z-|F7)B$tjyZX@dfmBmeWcP||(FCFGqx|2(Xmky~0^}`|ca_O*01s(49ok{q!npv~X z&OPB3?2PPP@+9QuO#y|Qa*bSPY=7eyrH+VQVVMOSg<0}&J()5zH!9Jk@6mZ0t^tLa zJ*}UWE1$PU{q`F_&&yZJW&2E7fP^d z!KIg7y*ya{Wo~I{5NKk#udbLthyw;{lYXkU@iWqe8*P>7a=g6RU0&*=7Nj|TZ2V2> zU$SuxTzphs8d&NR2gMFvd{9fo)l0(lJrv2#lZ9!c2gJ zj0f~^q-Sr`CtRNSHj)*65lP)!h$$qCZE zl>wrBAPu?Q^nGrcR^3>0-a9JEFZ{|pC0 zsBvC|ME_wljP37VT6v#0zgAvB()efb5e}!h7&IqZo`ZMapk>aXnSoGZKRn204)x(d zOr!e_3Ypx+E9K?OFMI@O7+rKVeFLg z)r(i&=M^qr-ni-wgLcebymHZ`0d=!9XTt`LG`dEl{nJ@OzTPn8m)VQYVQLB&KXUoS zYfzzDt;-O$(33Ah0Wt&|Kppx7sOYJpNFk)WHL>aFIw8t{>RtrLG@#cGAXXm zN~sjsdB+hYT|pBbaqg;-OU~rlr849=x9K?MCVy$U@*{37)TJ`hW+p#EK1(k!DGGLfi*TK8sh^ zEn~ou=5esLV}0yw z(>HPX(h4fk4YYmpD;KXUucGOJfq}mLq`2>g{lx1J?0`w^EB}y%(u$9JPm1LU5ka|Bw>Gh~P&3@OCw2I4!Bg zc!>Hi_=Qv$&=#HC6II%=#m-0Cm~(C*_;f*E_5i;m1tIoIh~0tWL32AGq4&V-08(JK z(|dxDSg=LB-(@oOJYu(?T1a~{T&K{GyVgV68`2Ar3WUObX}t(LOp^jdYh%d&(`r;` zQH(-`R6@|caI7y@*HHWjt>lr2DOO2Ir&9FRA^%Wv24%F%N+eON9Bl1tst3f!-5#p^mCUep^#NYm-V+NV+!1Cni>7s*EvhIs|_n$=;8_ij85 z76pQjMQZ`H1gdM_U@WvUN?qpSI9^!wVZ(SatFElZ>GmGt7nlR77*j8XJg= zy}kUN#p>0vPW}zl;cxf$^184r&l^V@e~CrFIP1*6(D*?#$jp*h6bDZv!I;(HfjXTa zN0?HZ!o<<3Hes*K%!$-PEJ)~uNI$S0^U*i#NXFnefQqwT1)LG^YdyIV8bt(@oaYG-#x487}J%lsQcj*8%a5?69^q$UeHKka(n{ zWc<~4Q-e)btzrHO=bYwndYE#6r%h{^FpxYLZTI&PHRHRh$rW8)Vyzm|TuW$1l|=<$ ztdFfc2559`<>E>x%A9G@h%n44T@IXpjnFJ>!ICJ%s*oTGZLsQ!5hz*1?TVoo3W&bx zB1RcnZ3Y7xFjT^Q#J62sz6MWw;oX?JY7^3c%pA=v?m3zlOsZ@};+qt(6`jJUqmK1g z>0Z7lIu;&qrngrGDgJ`pbd;GPtx53IBf3bs4TyP&It4CZN$!S)M94wSalnco2vk|U z5Q7t$+a#uIXcTrvjF}xKFBt|QYwdOED&z0L%--^M_=u9|1rIu=XdWMLb$Qp5q4O>{ zv6K-!o0F5W(5;=Xe|#!G%~hTD7-1+Ea+)m6R=~Ci$tP&(1sp@73K@Eh1DOmQe6fT`;a|~0XxV+ftV?ZCwsQVWK`uclz!s7E>@EI% z9EaPD@KD@$O-DnZV6iZ1uo7=&^&|AcTpPLHgv_7>4vHD#y$eee*|2$a!3_1bw6;WM zdFyTb{@D)EOV2(zXDrv|$S%c(gnGwzO(RIxnr)z}eiX`>OW(JBf}OcAagyBZG3DU=H^_UI+^bx?fD#Ub?k9V6{L-Ud651r!m#U23wNgJ z0ltI|*VxT1oCElS?5SS3dm-3s%@Tt*AICL{<2f*6U``<^2m6dXtA!xmSI;kAsMCT_ zg0i=|*xBy|hZ2EP+c?D6Vv7D6LpM?Kd4k@;Q>n8vniu>khi-1}{i-mqjBFp-GnKy? zMf{(Z&*lW70^L5P5OA2$oys%Hy->dSz|*njllF~_xARebE2O3Fh54O0~Y6d}rq$KZQoiehV+XUv6_CP1=m0*WUmVZQ|4QGp=XW@<-M8H~tMA9xt(Z!{q>4H;m? zUXa8`=QwOf8wzs(`W(=L0eayQq7e0?lF7a@A~C} z*fJU6`~x?^Gz4c)Hf}u|r9jEwP?au}BTozC&DgB7^9TIy*6qO=b*pp>U-Se!?3Z+g zV7dL4UA^A&YY{|@)bF{%W>P2J;yYXKZj{X*uD(~lV!U^wTPN*@{DWNbl^M?R4_1qQ zceK=vAalBG)2dvtCKYvI+b~z-2|6%JGo)^OROg$(g{vxUTxQhfbF(yqs=(e-yMEdn z)K4WW`BtCbfjEp0t^4hFHcv=D`1{pC{`lr!I(f2GtEKj8kKew2XY)YaJMJai4ce)_ zFZ=C3f#2I)EvJM9o_321Ml-h4Tn^j<#VA%Au@3d8;fEUBq)>@l;}Q1MfVHN;d*8;6 z<*k>3UN@jNO~F8@4N`RfVN*JgbnJVfuOy*j*7d@#(A~iI==_R0I-i74K$;HjSW*-W z_E5=yzL_=&?$Q)XC|wCK1Bl3Y;nb=5{LE}2dlGmb=H`=fc$AJ`+A5&KobVEu4dwJ2 zhx4o)o+a1YKo99MZ9SSgSt$nlTCg-bmo|}}9C{xT%E&|v?3yMcvN0c|VU==HWF2}D zUZq!;udKar%}bG)fbZT;0X~Z4kzT<`3nG9N7a&CzD3~u)VRmojd@ul3Vot$K;-qk_ z)uxgGdl6kS>b#@VB&MTujCL|JlPA>+yQ3*nJxr-eYKQy2DUtwtVOyeOvQCOjFx-EN zWUkswz%#%p0&9np!mONJu3Wr&6?PMxR;A$J2rD*^6g&jA&j34fD^Eo#0*5yN0#z2% z?vw>{;j{ya=e&akMt=@AFQ*vR-6;kc-gyUzweRSP#HFv2g$pZ z6sbH9V54kZ>^YkNQ)Lsdi`WE+yG@{*HqlV>Y03c*dlq{uQH~fP-m=YQI?LXPEJw7Q z+*gS%lk2KOyC)6Z2mkcz5je3v$r#d#daP`#9wT}RM^;Ac%WV!Z6{I`|>ae``0O;o} zQ>YwS-Y*nX=*E*&NIfnH`2z{5%TS-#r8a48*pprMeF*0fdmF?NKy=M93cy>x3^&AQ z#u|PD4k>|801fCy>TnhSI#3oM-K;F}@ni;NNQ9N#+4FEDa#Db4DFkbP))B+BBY7^+ zkrQh_>-X{tIB~JaN*qGg(^&|qbp5)caxmwuK*JUhdZ-XkNHdd4AgVmc|EreMn+`y8 z#YVbkF1KD@$7EU#m&{IvJErRiXh${VbX(?dg6a#y9AP7EU-qKSrY$HCNls+A-K zxEAoNtcSLYvIo9m^-57K-@(k0nc?dIommcGbP`>Fx3NF5T3}%4V|XI_3qQbYp=B4+ zt%&S`-Loh%45IYILyyE5j>|x+Y2+0`r_M?@T-4V4+DRd=Rui|`GfuqT@-u`Ke?Z9# zU-J(tJ^klvGZ7Int4e~{ak8d(`FCD1WkwoRJQ6N-z&|KipVJjzoiQ>CJYnztu& zXXk@{PwVy%t#%0w7|n6{+GtUJmBDm#L_L(cMFcv=ZTsEVBS#{oUW7^a<&@gaXZ+sn z?X~Kr-xDqMRDV;7b->A6HSnciLt78~Vgo5lK=3tj9^HJuzI?YPomF?!*TVf%-QZJn zpZD>dmt`9Kc3xi|luSwW$JOMD!pfNg9_i*|PR<55>tt||4Us~A*2$OYmpS>Y>dQY0 zSI+nLoQ+WGo_$9ADzvi+}IV;{ZtswMEG7i5B;ftbZM46JlD7`Sb za-45RKDJI>p*uTkHmHBmyMePw;O0KC2_mq zFF=O~Q($j{uferp=VuoD8Sv*s6z34v6gJOb%vo^kK{FYG$AQGE!eD`ejnZKfK{9eT zqV1|jw-zY}Jm-iXoj6z0P7*?%6o8&RJH9{~^5SV6AtT96UMN3Zy2mZ>T@un@Tx}$m z!IDEfFOJn@@&yTjgNY~KKbaWvf8r3MB&;DUr-VjIfFW?oKslt#fNO5p$vDK)Kqo0k zdZ3eW%yKZpevjO!g6~*UNQbJy#hL?=t&htOU1|;b>Ekjnr%OR=rN5 zJKSiJI>42aFny_*aqvbPK}>}tHj@?b5>OEsSyco}FA)?EvDpOzAeoZa1Gh_2`*m&% zXv4p@3VS`p$&&XmY_C`+k z+W{7w^g4Yf;9qy?+Q|=He15I+5$_WG?Uq+BUV4s>w3CB$-}uE#kHQC!JP)N?R2*&- zboRFIQOaEvOc7aZ zv4D%92!wc3S%ayXaT1dFO;dBJ8iQH7@5eZl3ER%Q9f#Pk?VGn4hhUuV;}|Ryg~wpu zG#djQ8ENQt_Fo*!!yZP_ZaU^$&0=}jDrzk1Gy;1nYOI~8%s5aG$c~(RuUvfY%EcE} zPd0Z&qDtJHqjTb*<71GAG8Au|1{)oXWFmJ~cbwSbMx>K%W!lklHJCLD>I-3ue5Z;& zJ%Nr2uV>8W6T9L!QniS!tJ!kgx*$e7Q=~H3fu+?BxoB^{WFxNNbDly z5nHA%$wNM(uxmLGuN)~Ia-_ry+kVdXjC>e=&7a-bbV7A+0@f5;9+wf;{2U6sGODcnwFx>d_f-;^_qrGw)7<{zYT zXpr7$;kHM;gQ2MI-HFW}Zol$?e?r3EHz+h<3k}p2V#%s*{$vOu%B@x3RX;j8a=EI% zW(W1XY)XlIpB0gB?dPPI_uds%|Cgmc*RFO;Bbx{Km;dNNnbl$Np@oyl>cxxBNRRJr z4ymi~HV@X%&{l8GA5^mo;KbE=07tr`?&bkq>!JEu|CDhu!xpZzQObZND#S3mjedkLm(PZ2_l5Kd$A|CHkEbQ8}>BAK#jjdFkyO zJ%r{FR2|;*ZWxT?hQahF{Pu^@Y6OjyOU} z6=0qo;3N3T%fZ1CJRRCWhTR;YE_3{2;P(gtCE(G3V<>!6QpnX2&c{YhA|Dq>2{>?K z&cs;~fCE)vrTsZNy-Ex_-HJ2u~;6!mj`6TVR-D~ON(%q zrK2#Rw?nXPnc|4)V$~6K%7vluF*UkT%Bc(HT8m;#!y3#hL!sYvsfH7jfaOC< zLge4Qr1QasP0@91yS700_BJlSYT!70ZvsOk(MjtRz**>6gyd~CZBz-nG)QrG0}ax- z0bRZh8gOtiRNB##)s@DMYTD9n25^9daXMlvAVgM^q1}J6{cI+c0%wT5jVW+^vIYaE zN@9bd1CLNH1aul^mkYx@XLJg#Wg}5?o_9l}~I--iB00Bw>&q#+cGm{7v zgiGPX%RU9vpj97qb+B6mfJ2RdFIDOfz5$y{jAd~&EsMjD6mAKoTTFo}gAuD%bQyp@ znn{vYh_xN$0$}*=1Svr@+f4?3%@AX9;Fy5}tcoS3bet|$UzBU8>7+Ar=X4Vs^?|N{ zlMlqfZ!-%_8asLw!(!`t6#bK?LCr9DcIZSXXg>wHMn7Y8j*0t;v%Knw!@jCBq(*}R z^$1>*T*mhxgYQ=2C z;?OfeknJ;a4tsS5p#Lqsts%&Gq?(4TA+C4LP4!~J68CEa!_!h3%=FOuv5bRh)nUYt zOZr+Caaa^W8q$;%K9FWBKRoXK#eMg+M3&l_Td>CbrS|etFEbUI&0p?z^>IRB7XR>5N3D$_ek+c;dvc)v(RCUz3}6 zr&~{o?s#arWlb6t3gj(!p?_VwWJy4AXAo{jc<7r4)wJ^)S>COOs96gD0Fvq(Zn5Qq zW&P2mgUn|CRSzB-=TQgaJb-bd0=*3 zp3cd0`8cukdb~l0MmXLy&=_^ z?q7IH!9S&8Rb+-Ijjp&1PZ}JU!``HUfrAWB3Ut_Icv9dyVA3;0$6H zyldrM0@LS|0(+!NkwwsO7ZkF|mLltm%WK4`Kjuquy6M^FJV1_}x8O@`iY}dGE(2R$ zaSnzZA~PSeBJ9YgSQm=+;Zz6XMtlbZQ>hJp*kw@AD)T2`qXf3+?U@~{|1SK%-g4zA^A^l1;SWZk@R4C#Jfn4z18N))M%3+RJL9irUg zhWL-)Zk)1IQNKgGW%=Sb!)KA4{%}1<-$DmOU3CkX`jEB-+;Ria4JbefUcnP2fj~aN z(`sVKR<2%jshMh^5$g&u&v}dOK}S}^ypPTxjEpfeaFB3O1&O5TWN1l~1WPdb4j&$a zJZKnkpnT_JwsDdn(-gN?m*ms5!ugZ=+u#QXGgL%#{J_wT1PkP43Ia>%XLqwY-fm`O z#*gtWU2U7Q?bhFoydWLeCpTNow*yVNthqU0LqS2X6>zI)HL|zf;r7Wh!sRaSeRAIN z)=2H*Gh63G`yFHiz7_m(C>3g4_{qKOu*%f!qhMC+8$KdK8Ic1jH z%IkBHJD)B`st@DgHe8KarJK9+Qtl`DsjFu$x;__;-1$ZPsrJ%ilTuU+zgGNfgYW3pnUR65vF>wj0U(DYJVg{KnAj1=cV(&{b`pj)}i16p`_0CU6-bkT`CAkYat7*0nuNlxJP$a7c>zJFVs zz=H$O#%ge_7DE$%Q_ugH`2+{^-Q{wAd|zWOC*B5b<-QqVdk(>_DUXU*`8wkv%c;y5 zMn#GhHJc*Aci)Oj!F~yFDFB!dmjaDbJ(mJIQ9~vLds^i~ya}ABr#pMKH@anUb_KB* zaTfqwhvs8HXqEw6OMPnBMuxEoOdSBfu1=zl*-TBi2Nm=mQWrT3zzl zlSs*@8zm$EWZ^W925{^66=q2BFXUVf2~1EjF&BcF;B0ZLwFTFU3#q)(x<+U9d5JqC zk^Hz}fSJ&OoJGZloRg$^sY^$;@8hxnVh#P+MI-`0*uu>g021 zD6-sEtDaK3^3%xpSwShAN1@6^^KDdyv#j7O=|`7)YfA??GX4*W zwDpQKPZbuy(Jw!+B;GWSE+3gcvvh=&+4EiE;1Lz`0DB{MwSoFQ%6++`L-3M+-&u{e01Kv4-I5lIZQ3J!?+S%Zm+4y-h6+p z@}rH%rK_mcb%kT1bEu|OhDO4#t0mjy-|BCx*PoH%pOhcSfyVM<7>W(gV*OohKPEVIQB1;`n!1xfJUbC%NUdGW*p8K5%sVL6L+RD7YA?8v?o*ol28P9Ecdqx*o!jtV0&9~0SXf~B36uj_vzY$Bn%)pQr@O4HeV{W8>l5`l3)4+td1 zP7;7!EY9*_PNvh$Sb$Ix+e^hLYEtuJmWo=SXC5E@WsX2y)H;IYw`|P_%u_ZsOko%d z<30>%a8ihSBad0N?om;sIMF*x$Og(7a zvR`yEjEpJ?@gAWl5CsHxo*xG@^#P9@MN};?+l3We!FUCc9xz*?Y?0$W4$~Be7RmBq zbf>IvTI4D+n;*~6{d;MrL=3a5@?j^^95dM73qF-M{L{oIKuXy>| z$|-MQb;Wyr<O-U3-DvueIzN6 zE=wr$B!I_tiV}ba=GyUy9ZB3h8M*|J*v3T-DG7so{3!{Mg491kFY)M}B8S8-2QSFe z-|n1Q$oAi%qkqer-Hz&qgnj1qn5(c)A`0|C1>gkY`_~=KEL;)=l}`W8I4pjMxjY$4 zzgw71;hKNmy_>X#FiYhd=b(x@;42a2Q0YibJ!`|+(K^FfpV3FDqW)2>k@EXkr$H(y zQVL)@Hq;@}wHVEmNO3H+)*{iZo~m3^Ntc|>>iH}}Cjn}@n-dAPyz>^=T)ozRbV9BMIQCK88>DbJ)E^Gfa1-oE$Zm8XkJJ~X#lmKFG;$6- zB#cSHSNiyCo}5wqi1#C_Ys;(N2AymKdVGOyAi%v8xRMj+8-Wt9uHd2pt+SwMX?Q?v znv_W&G=CUunOWzj%6|S~j+`REtvd0+c~|ithCUrB9OK5a)&~j)Ni%W60X+8E$;Zs_ zVN^`cLKdS2Yau|Uk7V)k(m3F`sa~0wKyow;E)@hvI`VQL+BS?1)H5J0X_abB#| z!MOqQvM?vW%xqCE&pvKK4F{se-N}3(h*x~^`DYQ$>XhesX1-Nm>L4^~JPs9?Q3C<@ zfjP090n(&^(Ha*dq1v3Z?Er@YG%0PP`opQ8(I-yh^Zhg^1O1g`;T}>NGIEr1NOV?| z!Q4iG7=R&E9m^NtXUWJL#wmv)K&`D(>d2W&sUv49Wlx=fr`7urpEQaeJi@$(GhB1y zKD%>*-}4Jg`3Z<+cn5u!Utj`6T+iuj5n%?9jmumL`O`%#8x07gN;WSZ0Vg;nfCpN6 zoYSA7XSIVlJR|iMZlKi70AX^qVogIe&b##WJ0wmXSV0YUG$fk4tZrrbrwI$U< zealMyR2pqsLfR^gH7%ezv)Nr+t@gO|a#h99`1D%oa7}lmBR4Hn+?-46@(*vm+wb^P zdF!2S?V1F&U9GDSib7eg{OAtCxO`a1ZYiCksEj;op@NL-N{8sRp6SwXU2jg+<#gBO z^w#C{)a4wk%kj1jHW(j{=!NE^uP)~Z>44%#{Yih~TZlLOmAV4QS9j|2PSm$NP}@4~ zpZK&tuys^=;vaXkJ4`Cntk>4)7}jzBgg-#Uqg1H*Q`L+i=wJv@V-zz=N zmHo6o?4P3V`;SwmKgMxs{)vAW@o~ERqv~86!lK@2^AGvmey`tylaHR?heK?G(!}Hb z=z|?ZBTM}%mh-|hP(S~OulC61ivPF(hI~`}IBMV7C!VPJ{r(eW>T$JuO*&me$k8PU z)%)d&%__Mk%pD9M8et%CbFTsKwgu*>kj#Okl!aW$^gErX(GeY_Pt(2B)LEm6KTWfT%(7Omxe2syOo8 z4wO#7TH3rcTxs3;6?jUZZ*H#4dcsk*279a~HQ{)aH!MIp#QJvQ@YMH9Z_y^>J z#dG`>2ch~>a@-*Fq$0NsV(Vx@4YMQ4un~x7q?H>X1z$iDGJ^S*;v!b;&wUu$sx=NsV&n1Rcab;Q&xf`Z+Is~ zs!F4hOhJq8q|kpSg%LO@czxIu#m8|{=!KJl{?bVS%0)Gq018n0(ga4KGGW`dg-J_p zQ*nHR6s2(>Q|L|Uw3}3lW4+-w9w!ABYduMWsZ^mc>xzzksAa@lYiS*;7?9S17nHP) zvvl%CN$XbAnQA1hYmav)IAcKDOS3L#dPJ5FL- zQCBjUuq?=45-bj?a3j!_D*Yy;P7)Zg_eo%coS8k1kY3acC7Vm&8S1>q>RNIo$(&-H zkVDd9F~2a6Cs!d3*M?!lBGDl)qn&r&(fP4==HNo`D*i+xUsbU%_r11y;pt~e?WK-V zSE;*nu+&pqM?}X}L~dAz7_?gQN`0jxrK6?(+Vu6va}+MK#~%#%IBc%3mHKKrGa7l_ zJVqm5)6Z=sk2%~&zwWDtXawp>&f5W#t-=iNyizM%ig>p!TyOb*^FF+PHPQ)LrwBtnF+)=O5X8rzsTikKD!tt(A^cXG~`4M8rR#YLco|e<6Yc3sWXl z8bJ33Xcf@-L0byl=&4ZvW}Jg~^K%&)|JG<`yRG_uNqmmwpVHCl$&8x1S86&-uJhaZ ztV;iMhPm*Xe-zSYTj5Iu|L9+F4!{4a*Jr*o6U_OV-?jM=$ti9zI%v_2?CwxDrsN>9 z4~DWam>y*JgtB`O(*xOuLfHroav0f%L)nLG6mO%ynw3}^!s4?7)GlId#s&^p_ac3AfL z2l_+*kn&8%dNLFL6AvvNy&RlwatRTk$nAqO?G@Un0Q;OcY7Y~nnq1Ev@aP*;AWv5x zbEj&X>V2soUz2aSgvIFB!?}4W)`D5EgI+ohawRPfGLPp$R&-gg%^EHba(lgO;qt%Dov1x(dnkGH+HX ztGGPKvci^C_&LapI#GaZT576zs)|ZwYdd*gx#sBpihwdrs? zcyn^{f4bJ|vyV~l>q{8XE5+8;vJT&M@oT%dQrq?P@4~c_7(o!7P4rcpb%fs9pH%~S z`VXc!7MR3g%gug(zNuIh_4PgSYblWib+zS>cA6330S>5k$%8Dks;ivxnJ5XFmcg#$ zp2R7sua;{PqgiaNDgRq#*3myO>q^|#ma$Q@sx?*e2P!O+G8O&5&GPjP{L&ID+x7pj z@DlqciMbkEYnWxq`FUk?tISXXoPsN|ts82_cjbTooq-n+wLj(M2Mg8yt4JwTY3W9j zg!-zW<*SswerSySL|fN_UWR2chQLE8Eth*>PWrM&RH|Es|7Cd9Dfd9rQ`YIx6V z|Nba_67bbb9=xeOHaKcv9zt_DjhIJ%jHb2Tng0DUB=3#?xrADk>o`=cUxnhj{28fh zmycFKSqJ^E@lN!=(jn2|@uBp{NONVS%_pd$wp)4!3UA#<7T?wOds)RXA&cpI`TM1)lTnVFK%fh&9sI+Hmm-Ej`I@Sbv zxG&XS!WXX&)$|^>4)XL~mA-fvsPq@7o>h2yoH8#jXJvVK8+BnNTx~zfuqr<7D!=e# zN;RDZSKvvvmcwt=(p&X(ZfIorcdOl}gUKwl$Dvmi>`GsnXxT+omj(5{PZr#+GLF5W znaXz1k!6`Xa)6ss<-{rva)zG;b;&pnq5;i<9FL|D+Cau*e!(ug4!Y}(!EniZbTQ-_ z9-J4if_8RcTLNVoqc)|XRLs*LVVTyqs}N{X_ehMqB{ zp)JnKagLhO>>5E?PAAD_S`W8kS-GBFTM4+xgKM5q zl=F)-Db3yqifQy&2D6LiwS=iN>^x1!_~A-!$M4FNFn91=SElW7sGpVFVWg!ryHJwK zVQ!PsPCV?rHOk%ykKfGi@9*GGR+;b`7U&r#ujrX*$)@UCLEg{=S!Ze$K;mf(uI?P z{3TcWxY>~j2YguKXdxK1b&(8?Ko@q(0QlQ!miKm$Az@UvJJ2LUwUbSLZJ0jdz3j?`dp$Ubu%XhH2hF26)Y|Uf zbThI|o71+EMr|ZmC<5nrFV1t~0@SV_BJD`b}ZEAi4I$$M}cB4v1OnF3(ga{Wa9#SETU_<83uB``)>ArJ|6uvdOsawa^!2X z$c(zLTVklYy54@oXax#G;{4C!`TG&iBeorj5<(_nx#1ci=oQ5b4{f_I7xT$aw4M{pjL*9FHAfWMXc0Ha?Co`I&7dF5>B4Vz=!n&L%Y9fqQ6_FN*oGeDu z$rTqRsz|hQBw8gBttt{Nkl4TBE+c+ED)qM*u?bmS*^PwVW%xRSMuWh_pSzXC{%*F` z-(>_D8Tw3H32@(6qs9dNY$@8$wuidkOXWdM_Os1l-*Jv9S>N^8JX>`=DoE8y{{Sf7 zP8+;C9r}>l_OSJ_Kow|%=D!0Pf=Bu`j!1#GvY7?<dLy~ajR=alyU6Diz@@H^ z*}IIXGCQMa8Mx$1%)O(_=%JmmX<7kX?;V%fVd|J&=10rG^%!`}z0Dj{=4K7L0(ggs zji)}brVsSJ6K(a*PqU#9=9%V`%iGb_m>cqopU2~wuIOX_twhFP^U1-@wD^8=A=z~1V_|1O`DH-W#*_aiYPo4~wD_8_nvN25<*cMINFk^~R znPM0{m9~WUl?T(w#~BV=7HV62myLO|(RlJi-we@>E&5xwEttKi1mjV-74F5wFhVgx z3x2fXeI|I)DXeWrduMZpF9c-s2TyiJQZh5r2IeGKmOO26Ro8ijgdQ`D_g*k}@H%?n z0$$3%7O#1Vjl|v6=yptmF|gICsgb6dGoI7&$I-MHY=d-H!{^Cca?gv)$zSkMBLuq| zJq?<2xfsnC*ipDMfZuxR4kBY?**ipTo040wP|J=6EMzfTjQ|AsqCRMEv!@r?_|)U` z78e;3p$os>F7TqmViP8P5}Z*K!_j-kmlVAu-#moRFg`g&Y>elMWIyH9ZlitM@Lmqv z27I&1ieG-BpB5YLe`#e>$rUS84|z`eGlX1`sD6`ru-OozCc~_STatNU=z*l16*Zr{ z9*=LGC@nGF@o0X1b#wa*=`FSF$>HSgc8W#K=bP)$KP`>Zf!JS}SPrVCyxqMkA-QiR zFnAO)$3wT1tI=KKZ2Yrzp;g1oB&sUm8SN3L25T&8C$>G*<`ZPugGJzrVYhPi_~0 z)fy;*kfikiAVNxOEl%9h+c(V{nJ3vh>S|pF>TL`spT~C>HyAM?NvD4vFQ8`eh7Ov~ zii7Fs?vAa)a6JD!nNh!u2I?~w7E~P#g^G12J$$lfE1glf?U0-$MTpKW*;VVM8EW- z-o&m~g^3n+VVXMB8;i-}eu1#sQ6UOTlZiK&8IRoWY;_ujqi&-&Pi9xs`)hJ?TitSQ zBPg41?-xjZF#~1w@=WvPSTT~uk}pbmH>1kWBS{EiGzXHmEzviaPWe((h>Dxn#{IQw*jdzuBTgSN#Gq1Ny2Cm=#4$YxeNZ*f;L{P6&D?F;ND ze2w&6Yb2sBNxyhI`0l$}G=dB7!#rkx^t;~|N4PE7Q~47V(}y}}lyUh6+eN*ey5WoB zORdDhZa1yT`0|y0L&-^HO2GDr{I!*%{@PYba`EWk{NhmX%vWTgjNvl@K$Je^;qMH~ zMh#6z^3CAj0!Jsl!DT6n`?{mU=l)p9r2xpX;7e*GtLRlUHoh(Xpdl+aX^a4zs_oyi z)R+}__qVq<^F@=KFR*K)Nsjf=AMve%VceObf+K!?G7FfAuYaF1# zzxT#}%&7>QXT^B)qDAvO$BT9p7WoWl@SoN*hz_yR4nY&Kd{a-S2igV!g+ zBMFr%D40p{pque&f|0T67jSAL6?7^Cb{)5#eLwmoXVh}!dwrN}Cga4Bb_tOx$& zkzYyvmDN2cGDN-cS9Sx-E|V8wGh1MIZu=+Mt+PJWIzH0>@M7@2Po!ouj?I019ise- zT_V0rktK&`Q9fN&vZc3X-W(oI-wO+qwEi~SQ`Zhm_i z^U8Qq5TUrd-@A#WRS{y$&N9mp9$3g@>@kJS8YF-5AOjfSh4=`z5o-?d8F-irljSWsA*aaloI#F6(=_4 z20`3aTlNIfgy|N)s5Y|H9~R{T(UwG&p~%!4m=2o6evQNa1cPCga4rKBcr&#0*Zc(K}ylHqsx-pJ+>?ndC#MHvEqz%UIoCrvwg0~zSjFNF|*|8 z<`RhPd^V*;SZkcdhniLut+ZvOuc-*zalbre)f+JkQNxRq*GK2?hSlhIYGsAYGMj#g zz)G*+!tcd7_U)A+^Z0e_*Jg3xHMVz z7(!*`(ox&i$pVea()ZbJ7T2OW5HB=yOuyd3{sC9c|W?Od7 z=mCa2;Ztm~Z8-c9z+qE@{>2>bydM{%;tCbqj2Q*VX@#EQW9JuA=3^8&3tZ}=&5vo9 z#m_hMpQPm1-sI=W;#2Wq!bTd^|4%v|(2OD%%BrOc_Oaz~iIS!MzFfp}t5H1PqP9ms)*3*8 z0J!?eZ{kt9}0NzZx9x@%NDU!&fJ-PWjbeeii>>@A$>wn9mm)XUBVLRXmtedit>TEDIT-OLDFILE.;11 73247 +(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}tedit>TEDIT-OLDFILE.;27 72985 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1) + :CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0) - :PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}tedit>TEDIT-OLDFILE.;10) + :PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}tedit>TEDIT-OLDFILE.;25) (PRETTYCOMPRINT TEDIT-OLDFILECOMS) @@ -46,7 +46,9 @@ (DEFINEQ (\TEDIT.GET.PCTB2 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk") + [LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Apr-2024 10:28 by rmk") + (* ; "Edited 20-Mar-2024 11:00 by rmk") (* ; "Edited 17-Mar-2024 12:41 by rmk") (* ; "Edited 15-Mar-2024 14:37 by rmk") (* ; "Edited 21-Jan-2024 10:21 by rmk") @@ -65,9 +67,10 @@ (* ;; "END = use this as eofptr of file. For use in reading files within files.") - (TEXTOBJ! TEXTOBJ) - (LET (PIECEINFOCH# (CURFILECH# (OR START 0)) - LOOKSHASH PARAHASH) + (LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + PIECEINFOCH# + (CURFILECH# (OR START 0)) + LOOKSHASH PARAHASH) (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) 8)) (SETQ PIECEINFOCH# (\DWIN TEXT)) @@ -167,8 +170,7 @@ PPARALOOKS _ OLDPARALOOKS PTYPE _ OBJECT.PTYPE PBYTESPERCHAR _ PCLEN)) - (\TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT) - PC TEXT CURFILECH# PCLEN) + (\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILECH# PCLEN) (add CURFILECH# PCLEN) (FSETPC PC PLOOKS (if (ZEROP (BIN TEXT)) then @@ -182,7 +184,7 @@  "There are new character looks for this object. Read them in.") (\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT)))) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB")) (CL:WHEN PC (* ;  "If we created a piece, save it in the table.") (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) @@ -273,7 +275,8 @@ (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE]) (\TEDIT.GET.SINGLE.CHARLOOKS2 - [LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:53 by rmk") + [LAMBDA (FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 16-Jan-2024 22:53 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 25-Nov-2023 23:22 by rmk") (* ; "Edited 7-Nov-2023 22:00 by rmk") @@ -298,7 +301,7 @@ [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) @@ -328,76 +331,68 @@ (RETURN LOOKS]) (\TEDIT.PUT.SINGLE.PARALOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk") + [LAMBDA (FILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Jul-2024 23:25 by rmk") + (* ; "Edited 28-Jul-2024 16:07 by rmk") + (* ; "Edited 16-Jan-2024 23:01 by rmk") (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 3-Mar-2023 23:23 by rmk") (* ; "Edited 30-May-91 20:33 by jds") (* ;  "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") - (PROG (DEFTAB TABSPECS OUTPUTFORMAT LEN) - (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) - (* ; + (PROG (DEFTAB TABS OUTPUTFORMAT LEN) + (\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;  "Left margin for the first line of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) - (* ; + (\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;  "Left margin for the rest of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) - (* ; "Right margin for the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) - (* ; "Leading before the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) - (* ; "Lead after the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) - (* ; "inter-line leading") - (SETQ DEFTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph") + (\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph") + (\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph") + (\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading") + (SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB)) + (SETQ TABS (FGETPARA LOOKS FMTTABS)) (COND - ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) - (OR DEFTAB TABSPECS)) (* ; + ((AND (OR DEFTAB TABS)) (* ;  "There are tab specs to save, or there is a default tab setting to save") (\BOUT FILE 3)) (T (* ;  "There are no tab looks. Just let him go.") (\BOUT FILE 2))) - (\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) + (\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD) (LEFT 1) (RIGHT 2) ((CENTER CENTERED) 3) ((JUST JUSTIFIED) 4) - (SHOULDNT))) - [COND - ((OR TABSPECS DEFTAB) (* ; "There are tab specs to save.") - (COND - (DEFTAB (\SMALLPOUT FILE DEFTAB)) - (T (\SMALLPOUT FILE 0))) - (\BOUT FILE (LENGTH TABSPECS)) - (COND - (TABSPECS (* ; "# of tab settings <256!") - (for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX of TAB)) - (* ; "And setting.") - (\BOUT FILE (SELECTQ (fetch TABKIND of TAB) - (LEFT 0) - (RIGHT 1) - (CENTERED 2) - (DECIMAL 3) - (SHOULDNT))) - (* ; "Tab type")] - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) + (\TEDIT.THELP))) + (CL:WHEN (OR TABS DEFTAB) (* ; "There are tab specs to save.") + (\SMALLPOUT FILE (OR DEFTAB 0)) + (\BOUT FILE (LENGTH TABS)) + (CL:WHEN TABS (* ; "# of tab settings <256!") + [for TAB in TABS do (\SMALLPOUT FILE (fetch (TAB TABX) of TAB)) + (* ; "And setting and type") + (\BOUT FILE (SELECTQ (fetch (TAB TABKIND) of TAB) + (LEFT 0) + (RIGHT 1) + (CENTERED 2) + (DECIMAL 3) + (\TEDIT.THELP])) + (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX) 0)) - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + (\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY) 0)) - (\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS)) - (\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS]) + (\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO)) + (\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE)) + (\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE)) + (\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE)) + (\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES)) + (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE)) + (\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER]) (\TEDIT.PUT.SINGLE.CHARLOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk") + [LAMBDA (FILE LOOKS) (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 16-Jan-2024 23:01 by rmk") (* ; "Edited 19-Dec-2023 10:14 by rmk") (* ; "Edited 30-May-91 20:26 by jds") (* ; @@ -468,7 +463,7 @@ NIL 4) (T 0)) (COND - ((fetch (CHARLOOKS CLSELHERE) of LOOKS) + ((fetch (CHARLOOKS CLSELAFTER) of LOOKS) 2) (T 0)) (COND @@ -484,69 +479,65 @@ (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE]) (\TEDIT.GET.SINGLE.PARALOOKS2 - [LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:54 by rmk") + [LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:07 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 5-Aug-2024 09:48 by rmk") + (* ; "Edited 29-Jul-2024 23:22 by rmk") + (* ; "Edited 28-Jul-2024 21:35 by rmk") + (* ; "Edited 16-Jan-2024 22:54 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 3-Mar-2023 23:18 by rmk") (* ; "Edited 1-Aug-2022 12:04 by rmk") (* ; "Edited 30-May-91 20:33 by jds") (* ;  "Read a paragraph format spec from the FILE, and return it for later use.") - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (LET ((FMT (create FMTSPEC)) + TABFLG DEFTAB TABS) + (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the first line of the paragraph") - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the rest of the paragraph") - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; "Right margin for the paragraph") - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* ; "Leading before the paragraph") - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* ; "Lead after the paragraph") - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* ; "inter-line leading") - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL))) - (* ; "Will be tab specs") - (SETQ TABFLG (BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read") - (SETQ DEFTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ - (SELECTQ (BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (CL:UNLESS (ZEROP DEFTAB) - (RPLACA TABSPEC DEFTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* ; + (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph") + (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph") + (FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph") + (FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading") + (SETQ TABFLG (BIN FILE)) + (FSETPARA FMT QUAD (SELECTC (BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (\TEDIT.THELP))) + (CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read") + (SETQ DEFTAB (\SMALLPIN FILE)) + (CL:WHEN (ILEQ DEFTAB 1) + (SETQ DEFTAB DEFAULTTAB)) + (FSETPARA FMT FMTDEFAULTTAB DEFTAB) + [SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (\TEDIT.THELP] + (FSETPARA FMT FMTTABS TABS)) + (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB) + (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB)) + (CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;  "There are other paragraph parameters to be read.") - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;  "Special X location on page for this paragraph") - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE] - (RETURN LOOKS]) + (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE)) + (FSETPARA FMT FMTUSERINFO (\ARBIN FILE)) + (FSETPARA FMT FMTPARATYPE (\ATMIN FILE)) + (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE)) + (FSETPARA FMT FMTSTYLE (\ARBIN FILE)) + (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE))) + FMT]) (\TEDIT.PUT.CHARLOOKS.LIST2 [LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk") @@ -600,7 +591,9 @@ (DEFINEQ (\TEDIT.GET.PCTB1 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk") + [LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Apr-2024 10:28 by rmk") + (* ; "Edited 20-Mar-2024 11:00 by rmk") (* ; "Edited 17-Mar-2024 12:41 by rmk") (* ; "Edited 21-Jan-2024 10:23 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") @@ -619,8 +612,9 @@ (* ;; "END = use this as eofptr of file. For use in reading files within files.") - (TEXTOBJ! TEXTOBJ) - (LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0))) + (LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + PIECEINFOCH# + (CURFILECH# (OR START 0))) (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) 8)) (SETQ PIECEINFOCH# (\DWIN TEXT)) @@ -675,8 +669,7 @@ PPARALOOKS _ OLDPARALOOKS PTYPE _ THINFILE.PTYPE PBYTESPERCHAR _ PCLEN)) - (TEDIT.GET.OBJECT1 (FGETTOBJ TEXTOBJ STREAMHINT) - PC TEXT CURFILECH#) + (TEDIT.GET.OBJECT1 TSTREAM PC TEXT CURFILECH#) (add CURFILECH# PCLEN) [COND ((NOT (ZEROP (BIN TEXT))) (* ; @@ -689,7 +682,7 @@  "No new looks; steal them from the prior piece.") (FSETPC PC PLOOKS (OR (AND OLDPC (PLOOKS OLDPC)) DEFAULTCHARLOOKS]) - (SHOULDNT "Impossible piece-type code")) + (\TEDIT.THELP "Impossible piece-type code")) (CL:WHEN PC (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) (SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ]) @@ -702,7 +695,8 @@ (\TEDIT.PARSE.PAGEFRAMES1 (READ FILE]) (\TEDIT.PARSE.PAGEFRAMES1 - [LAMBDA (PAGELIST PARENT) (* ; "Edited 7-Nov-2023 13:27 by rmk") + [LAMBDA (PAGELIST PARENT) (* ; "Edited 30-Aug-2024 15:43 by rmk") + (* ; "Edited 7-Nov-2023 13:27 by rmk") (* ; "Edited 8-Mar-2023 18:14 by rmk") (* ; "Edited 4-Oct-2022 16:57 by rmk") (* ; "Edited 1-Oct-2022 16:02 by rmk") @@ -736,10 +730,14 @@ collect (\TEDIT.PARSE.PAGEFRAMES1 ALIST PAGEFRAME))) PAGEFRAME) - (T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC NIL]) + (T (SETQ PAGELIST (CAR PAGELIST)) + (TEDIT.COMPOUND.PAGEFORMAT (\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST)) + (\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST)) + (\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST]) (\TEDIT.GET.CHARLOOKS1 - [LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk") + [LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 16-Jan-2024 22:55 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 25-Nov-2023 23:21 by rmk") (* ; "Edited 7-Nov-2023 22:02 by rmk") @@ -776,7 +774,7 @@ [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) @@ -805,7 +803,11 @@ (replace (CHARLOOKS CLFONT) of LOOKS with FONT]) (\TEDIT.GET.PARALOOKS1 - [LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk") + [LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 5-Aug-2024 09:48 by rmk") + (* ; "Edited 28-Jul-2024 22:00 by rmk") + (* ; "Edited 16-Jan-2024 22:55 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 27-Oct-2023 13:00 by rmk") (* ; "Edited 3-Mar-2023 23:20 by rmk") @@ -813,63 +815,57 @@ (* ; "Edited 30-May-91 20:34 by jds") (* ;  "Read a paragraph format spec from the FILE, and return it for later use.") - (LET ((LOOKS (create FMTSPEC)) - TABFLG DEFTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (LET ((FMT (create FMTSPEC)) + TABFLG DEFTAB) + (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the first line of the paragraph") - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the rest of the paragraph") - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; "Right margin for the paragraph") - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* ; "Leading before the paragraph") - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* ; "Lead after the paragraph") - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* ; "inter-line leading") - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL))) + (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph") + (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph") + (FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph") + (FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading") (* ; "Will be tab specs") (SETQ TABFLG (BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) + (FSETPARA FMT QUAD (SELECTC (BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (\TEDIT.THELP))) (CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read") (SETQ DEFTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ - (SELECTQ (BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (CL:UNLESS (ZEROP DEFTAB) - (RPLACA TABSPEC DEFTAB)) - (RPLACD TABSPEC TABS)) + (CL:WHEN (ILEQ DEFTAB 1) + (SETQ DEFTAB DEFAULTTAB)) + (FSETPARA FMT FMTDEFAULTTAB DEFTAB) + [FSETPARA FMT FMTTABS (for TAB# from 1 to (BIN FILE) + collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ (SELECTQ (BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (\TEDIT.THELP]) + (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB) + (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB)) (CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;  "There are other paragraph parameters to be read.") - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;  "Special X location on page for this paragraph") - (replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE)) - (replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE)) - (replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE)) - (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE))) - LOOKS]) + (FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE)) + (FSETPARA FMT FMTUSERINFO (\ARBIN FILE)) + (FSETPARA FMT FMTPARATYPE (\ATMIN FILE)) + (FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE)) + (FSETPARA FMT FMTSTYLE (\ARBIN FILE)) + (FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE)) + (FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE))) + FMT]) (TEDIT.GET.OBJECT1 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 27-Oct-2023 12:58 by rmk") + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk") + (* ; "Edited 27-Oct-2023 12:58 by rmk") (* ; "Edited 6-Aug-2022 09:11 by rmk") (* ; "Edited 12-Jun-90 18:17 by mitani") @@ -891,7 +887,8 @@ (FSETPC PIECE PLOOKS (if (PREVPIECE PIECE) then (PLOOKS (PREVPIECE PIECE)) elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) - else (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) + else (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT + DEFAULTFONT) TEXTOBJ))) (PCONTENTS PIECE]) ) @@ -903,7 +900,9 @@ (DEFINEQ (\TEDIT.GET.PCTB0 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 17-Mar-2024 12:41 by rmk") + [LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 29-Apr-2024 10:27 by rmk") + (* ; "Edited 17-Mar-2024 12:41 by rmk") (* ; "Edited 15-Mar-2024 14:47 by rmk") (* ; "Edited 21-Jan-2024 10:27 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") @@ -915,8 +914,9 @@ (* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") - (LET (OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0)) - (SBINABLE (fetch (STREAM BINABLE) of TEXT))) + (LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0)) + (SBINABLE (fetch (STREAM BINABLE) of TEXT))) (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) 8)) (SETQ PIECEINFOCH# (\DWIN TEXT)) @@ -943,8 +943,7 @@ (\TEDIT.GET.CHARLOOKS0 PC TEXT) (add CURFILECH# (PLEN PC))) (\PieceDescriptorOBJECT - (\TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT)) - PC TEXT CURFILECH#) + (\TEDIT.GET.OBJECT0 TSTREAM PC TEXT CURFILECH#) (add CURFILECH# (PLEN PC)) (* ;  "Only object--can't be followed by either of the others.") (FSETPC PC PLEN 1)) @@ -958,12 +957,13 @@ (\TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .") (add CURFILECH# (PLEN PC)) (AND TEXTOBJ (FSETTOBJ TEXTOBJ FORMATTEDP T))) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB")) (SETQ OLDPC PC) (\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ]) (\TEDIT.GET.CHARLOOKS0 - [LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 23:03 by rmk") + [LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk") + (* ; "Edited 16-Jan-2024 23:03 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 1-Aug-2022 12:04 by rmk") (* ; "Edited 30-May-91 20:26 by jds") @@ -1007,7 +1007,7 @@ [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS] [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) @@ -1027,7 +1027,8 @@ 'ITALIC]) (\TEDIT.GET.OBJECT0 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 6-Aug-2022 15:57 by rmk") + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk") + (* ; "Edited 6-Aug-2022 15:57 by rmk") (* ; "Edited 12-Jun-90 18:17 by mitani") (* ;; "Get an object from the file") @@ -1051,71 +1052,70 @@ (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) (\TEDIT.UNIQUIFY.CHARLOOKS ( - CHARLOOKS.FROM.FONT + \TEDIT.CHARLOOKS.FROM.FONT DEFAULTFONT) TEXTOBJ] OBJ]) (\TEDIT.GET.PARALOOKS0 - [LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:57 by rmk") + [LAMBDA (PC FILE) (* ; "Edited 23-Oct-2024 16:09 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 5-Aug-2024 09:47 by rmk") + (* ; "Edited 29-Jul-2024 23:23 by rmk") + (* ; "Edited 28-Jul-2024 22:23 by rmk") + (* ; "Edited 16-Jan-2024 22:57 by rmk") (* ; "Edited 19-Dec-2023 10:13 by rmk") (* ; "Edited 3-Mar-2023 23:14 by rmk") (* ; "Edited 1-Aug-2022 12:04 by rmk") (* ; "Edited 30-May-91 20:34 by jds") (* ;  "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFTAB TABCOUNT TABS TABSPEC) - (replace (PIECE PPARALOOKS) of PC with LOOKS) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (LET ((FMT (create FMTSPEC)) + TABFLG DEFTAB TABS) + (SETPC PC PPARALOOKS FMT) + (FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the first line of the paragraph") - (replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; + (FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;  "Left margin for the rest of the paragraph") - (replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE)) - (* ; "Right margin for the paragraph") - (replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE)) - (* ; "Leading before the paragraph") - (replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE)) - (* ; "Lead after the paragraph") - (replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE)) - (* ; "inter-line leading") - (replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL))) - (* ; "Will be tab specs") - (SETQ TABFLG (BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE) - (1 'LEFT) - (2 'RIGHT) - (3 'CENTERED) - (4 'JUSTIFIED) - (SHOULDNT))) - (COND - ((NOT (ZEROP TABFLG)) (* ; "There are tabs to read") - (SETQ DEFTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (BIN FILE)) - [SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB - TABX _ (\SMALLPIN FILE) - TABKIND _ - (SELECTQ (BIN FILE) - (0 'LEFT) - (1 'RIGHT) - (2 'CENTERED) - (3 'DECIMAL) - (SHOULDNT] - (OR (ZEROP DEFTAB) - (RPLACA TABSPEC DEFTAB)) - (RPLACD TABSPEC TABS]) + (FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph") + (FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph") + (FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph") + (FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading") + (SETQ TABFLG (BIN FILE)) + (FSETPARA FMT QUAD (SELECTC (BIN FILE) + (1 'LEFT) + (2 'RIGHT) + (3 'CENTERED) + (4 'JUSTIFIED) + (\TEDIT.THELP))) + (CL:UNLESS (ZEROP TABFLG) (* ; "There are tabs to read") + (SETQ DEFTAB (\SMALLPIN FILE)) + (CL:WHEN (ILEQ DEFTAB 1) + (SETQ DEFTAB DEFAULTTAB)) + (FSETPARA FMT FMTDEFAULTTAB DEFTAB) + [SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB + TABX _ (\SMALLPIN FILE) + TABKIND _ + (SELECTQ (BIN FILE) + (0 'LEFT) + (1 'RIGHT) + (2 'CENTERED) + (3 'DECIMAL) + (\TEDIT.THELP] + (FSETPARA FMT FMTTABS TABS)) + (CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB) + (FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB)) + FMT]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1666 38666 (\TEDIT.GET.PCTB2 1676 . 11742) (\TEDIT.GET.PARALOOKS2 11744 . 12333) ( -\TEDIT.GET.CHARLOOKS2 12335 . 13666) (\TEDIT.PARSE.PAGEFRAMES2 13668 . 16407) ( -\TEDIT.GET.CHARLOOKS.LIST2 16409 . 16916) (\TEDIT.GET.SINGLE.CHARLOOKS2 16918 . 20635) ( -\TEDIT.PUT.SINGLE.PARALOOKS2 20637 . 25388) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25390 . 29864) ( -\TEDIT.GET.PARALOOKS.LIST2 29866 . 30373) (\TEDIT.GET.SINGLE.PARALOOKS2 30375 . 35384) ( -\TEDIT.PUT.CHARLOOKS.LIST2 35386 . 37465) (\TEDIT.PUT.PARALOOKS.LIST2 37467 . 38664)) (38743 59003 ( -\TEDIT.GET.PCTB1 38753 . 45217) (\TEDIT.GET.PAGEFRAMES1 45219 . 45671) (\TEDIT.PARSE.PAGEFRAMES1 45673 - . 48049) (\TEDIT.GET.CHARLOOKS1 48051 . 52423) (\TEDIT.GET.PARALOOKS1 52425 . 57457) ( -TEDIT.GET.OBJECT1 57459 . 59001)) (59063 73224 (\TEDIT.GET.PCTB0 59073 . 62808) (\TEDIT.GET.CHARLOOKS0 - 62810 . 67397) (\TEDIT.GET.OBJECT0 67399 . 69349) (\TEDIT.GET.PARALOOKS0 69351 . 73222))))) + (FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) ( +\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) ( +\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) ( +\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) ( +\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) ( +\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 ( +\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203 + . 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) ( +TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0 + 62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960))))) STOP diff --git a/library/tedit/TEDIT-OLDFILE.LCOM b/library/tedit/TEDIT-OLDFILE.LCOM index aad6b3135ea00ce34b6c34b7679cb66b83d92627..a37f63a3ca8f7d31509b688449c5ba2c0d308a67 100644 GIT binary patch delta 5580 zcmcIoZ){uD6@Ru9H<;Eq&a<1k#<_JfH=#6ofBg?__{Fj7*V?|W^TL`E@L*ou&ckbr*9glz4@x9Yy;xYWyhmQ%IAR#`U=2B@Pd9jfS35jXs zi3ic(eVMUrSP zmsb{wTDG86?al;UMnXifpv)Iwrf6=$Y6+;K=CV1poX6S1VX_R$E>!6&q)iTKxzie+ zJ)w7;lSk(@c&{a}X?9N|=bHhB8CKj3{I$pFBfH^R9-ST5SCiw-Gno?}GBn#Lv@?Zv zIzu(y@G#4rvz^hL7kkUsf9@&VKy=RfYC$7I#ahV7p!YK9?b>*K#noA3jezA@}Qx3yXGt~&nis6~yF7~$xRWI+R? z#%2u}IO42DT5n-kYq+z9?X}p`VD)s*>Z{NKt1O<}X7sY7Hf0oX3{P1`V_-C9;7Mm~ zve|lT#o1Y#z~K!xQ>1UA<~ItBD`{rcvD~=gWsKIJVcq4<IR$Gf=ViTsWkMEk`q!Vyxb8(eA~Q@UN|J28hk;)!HkMS`-aJDF+kdU8G6uN%do4` zuxn$l=@abU7NTEi?HUeW!r}JbjSsP}^}$07GtDq`#K6Ig8?hHYjCb{uOJ@uAd#i#&(|eNW)#I9P9pf3yIrMkg2`A?CUj%M%ZtY{H;_xw+X7PfC;vBe~nNUn0lqJa;l11K@IOtQV zbb^$EskWSq_v8e4sNEk2KT)(2SwNCgeKLodT_p)tHcdimv?NZnBr#==io^ib6J-fm z&Mbn9Tb*Ke3TK-UIbr*u1i?P9&?E<@=J=$o&&O?Rylh+JMX+J&K{hod;{LRY1TGcg z-Irx+cc%%~+XMfU;V^T#tXfiv=pH$dLfKqd%T<9c$ngZKs>cf&l4ThVm)DR0$|n}) zH8rn-f{+ww3keWr-Dv{Et=WJOPg)iPF-|S4zcl{lP&0uvWtQYukqCqo2qa&FOmi+g z^Tp#JawuQYXo4j<7!qskl@!u3dU?YwMlHJ1jG( zbJ01dcW6+jdr;@dpiWN)Ef(}&Mv}LyjjKz`ohMhBpB0B)&lG8#LF?Jw+dI>^c6nv; zSA`So4CMI6sNew(pifN{o2-HT8)KL~8>;zhKEs6T*0Y$6LC$P_gnj;33MW|(lJd;+ zg_TK|udX<+LN+G@3S<2zNUpT?vx5m2A3H zghk!HXu-!!$;8tj-~f$fp(g@F+Px$SOa&=LM6Cq65;znUn;<888pO%1)I)=-9}@(j zHz<%O>l+0379o;t_ZCI2=cXbMP}93b036f1Io|T_!^FM$ls`sNo7#q6)5tukAL=tS`N#+dn~YF>+I zF<142v4aj(PsHSdD)zVCgt>eN7|A!cF%tdp*x{S7Kcnuo_(pK^W&M>H4z#<3!CxCU zT7O}t#8g6`I1+3E{`9?iB+7s>X2&*Gz#~xvgrb>RB;aa)Sitd~I&kb6%dyAWkN)e~Gy0>6*s*x8;s*w9SNs43eHA~s z3LvyV(0`W*G`Sx1>{0;O%;Ofv$yJBT0`16v zA~-_JMD$zWK6re45nMlE7rbWC7=oI91GbxQ(*1eU{j z&;k615@Sck0D|-BB_Pcha9b5s&wc%&^XDJ9cjZ2Pc;wb~?zX4*^o7H#_scfCe@0FW z#WU=ilH*Et8aXb)+jLqvd~oaJ68hN39n8W{Ae6zvHG$ubYn0^4eI!rrBYE&`s_GX>4I{!w hFj*c5eKib}T;0-zR9z+~w;a delta 6541 zcmeHLU2J2;74}d5)*HP3x$&B8>dZPJY+5$G|F#1a_r|_iJFzoa$AK(eaH)(GV(;?% zQWa!MA1G3*5^kZTKdPvBD1B)2(^T7*au=ym6;!dR6shdP3RY-UQMHwUhpJLxduHyP zYdb7e{~r249&*pjoH^&rc+NTBIZu4eyY~(6Q!7#acWI{mqo<+&o=y=3Hy#;HedX{>)`WIzy5N)qLi`J(qz zw_e+xNi@A!Hf}56<)z~}5RH;Ts^hfjX+fEm`6LRgKYC+R;3ot74kV)KTsm-U5eXSo z#CU!Q0hvYx@=@C}iajGCT+A(I$)boBvqfWpkOHclS~RjaXOIyO3-HaLrJ2HlK2s!< zX}a$&y{t1GDU>s2_2ptEo7c;1Ql(lXv^Wz#p==xJ>gomuWSOW(bXuF-$LfKfdh3E>g{&cW!ynX7wuZF>Lets-j< zConol?6Yv9zE@3Hc*Iv7*|>;7Q*Udl#1wHWAaaFBYkH{6U&0V%Msc!3<_q5Hgf)-H z@q{CD9Au7LIO(e5`oGx+pAZ+aYHJrfeydjJf>xE&<{XXOs~-Pa>pPgkk@fmx zYZpSu!oyqlU@}h(n8d?2wLOYCdi&02x2NIX15Noe@9(W_9A|7>Nw#%6PC1(%PkV=t z?!fWAl}*o!jB%^=&m`~FTU!r(=y-L`JyxTSo(m2fgfqga;T`C^Q<&58IDTC(-D&~3 zcMhh|>9y8&yx8mC8MI#nH@Jc55480T9)1Q7?+)(#1qV0&cpte?x?o{$=fFZ8-oX3M zt?KOBs>9aCpFGFZjBLKCa!1sZf|l}lxtLq1AXVYf>DfDsGG0WgY`#C3xE`s3(iyqH zBaCbXNon(Bf2>zT5-+W{hQ>uCrbM)4RCFXtD$>hk{S;6Fngz!`QOP3_B4KODJfG`7 zDx|@o38$b)4yPceT~0wV&-ca59}o8X1(7!&=syw#6Cl{-PzKD)-CkHgsf@XC!%$O} zi6G*$iS=tsVFJ*NROX7KZ!MCk03>YI6;B|Qbg6EfWalC(8vLI28xlI+CDRIIp7sd9G&n(lrtZWCZ*R7 zdpy2yD;U0iNV7xBuIE>$OK&xp_0lJ8z7b72l$T@Fm`fSlQJM1X z2E8ke@SyJ$qrRDczF=w%|KnQ2XX|1L9^;nK&G{{OiETTyJlOH1w&rlIneTA%pcgTt z;}8(d?+=X*IMRpBLqlUtTYHS|VVomfqeRyz(lz3`MyP9)q@&eP%^UW{G<=h{nzX72 zC));Ngv~#52YvV^^Zd}Q%@5x6982+Obb1CaS5S(VI^MmUa;8;DW)u%|dYLjS@EBY= zm1)x|_y*%q1fVM=B3yyz;nJeLw@DXV{c;AjQsJ@+@7AWk9~??x2FZ{e9T$>$W}B2@ zTckAL3c6WR*=9+B_s3jXOgXGga7S<-$}76!g$!6t=Y$ly8bM()1qse-uL?}Mz%wZ+ zW{%4E$+2w(j#7B`D%@Sp$QGI03GF{{hkim z*FpEVG}q^n(f)xp9S_(v(N+y|K@EM@S^Ux`(zndluT(>8t*19VKgXe7|F?07<~10< zXv3u1+2+-Eo;iE<>c#rSmo#)|JuC)s40G>oubG$l!d)W(33j4*1cVO*w!$$$DY1?3 z;gJcF1>eQ-$jimG)=wa-K3k-sU% zhMG3%@R$72>uIskpo{VQ@0PtN;h2JHw<%VwSTYg7dNx<`*7&5q^1n)mtICKAf4?T46 z=Nsl12Et}_;>khC8)dy@(9mvPnKk>N$ zXsknzlL(iveEyv`F@jhjD#G^WvA6m@&Kjh+{y1yc>48AqkF&=Aeb(51MLgm)U%vGY z^E2|qai!fhgJP7m%>dSQw9QCA4FH}Xm`}+=O`dkb(r9_fC|8WqBCMq7fPlVPTrTMZ zBLZ@CbCR+@C$%+oDH7YZbav=E8)>Lu@=Ef>V9&Y%~wzf2! zcosTur2XYe1%g6Ku+rAsUa}RQ)3>6ubM|CsS0`RgxOtKTM9Xb{@Hf^sdcJS`J`Hs9-iZk`nh zKh)7>eP6QCX^Aq3BRE7#l-Kn_lT;;8qQs#@i9!DlN8ksIK#3BcsK!W%!hLj!vI?19 zhN_d{9+_9$AV~zQ%@#yxSupejKaUJWHiOSi3DA!Vh^17@h0lruhyi)Ei)0a+3@*0_ z-9j5|i%{d*@EK}nhS){ubue1!C~5_zjp~I@cNFac)GKTQG$R-Z-3Ug?()Oj9ANl_Q D=Bitedit>TEDIT-PAGE.;175 113329 +(FILECREATED "11-Dec-2024 22:39:52" {WMEDLEY}TEDIT>TEDIT-PAGE.;198 121611 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY) + :CHANGES-TO (VARS TEDIT-PAGECOMS) + (FNS \TEDIT.FORMATPAGE \TEDIT.HARDCOPY.PAGEHEADINGS \TEDIT.FORMATTEXTBOX + \TEDIT.HARDCOPY-COLUMN-END) - :PREVIOUS-DATE " 4-Apr-2024 23:17:31" {WMEDLEY}tedit>TEDIT-PAGE.;174) + :PREVIOUS-DATE "11-Dec-2024 20:59:29" {WMEDLEY}TEDIT>TEDIT-PAGE.;196) (PRETTYCOMPRINT TEDIT-PAGECOMS) @@ -28,41 +30,43 @@ (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) - (INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (CHARLOOKS.FROM.FONT (FONTCOPY NIL - '(FAMILY MODERN SIZE - 10 WEIGHT - MEDIUM SLOPE - REGULAR] - [VARS (MAXPAGE# 65535) - (MINPAGE# 1) - (TEDIT.PAGE.FRAMES (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1 - ) - (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1) - (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL - 1] + (INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.CHARLOOKS.FROM.FONT + (FONTCOPY NIL + '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM + SLOPE REGULAR] + (VARS (MAXPAGE# 65535) + (MINPAGE# 1)) (COMS (* ;; "Creation, GET, and PUT of page frames.") (FNS \TEDIT.PARSE.PAGEFRAMES \TEDIT.PUT.PAGEFRAMES \TEDIT.UNPARSE.PAGEFRAMES)) - (COMS + [COMS (* ;; "Public functions for setting up page layouts") - (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT)) - (FNS TEDIT.FORMAT.HARDCOPY TEDIT.SKIP.SPECIALCOND) + (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT + TEDIT.GET.PAGEFORMAT) + (INITVARS (TEDIT.PAGE.FRAMES (TEDIT.COMPOUND.PAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT NIL + NIL NIL NIL NIL 72 72 72 + 72 NIL 1) + (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 + 72 72 NIL 1) + (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 + 72 72 NIL 1] + (FNS TEDIT.FORMAT.HARDCOPY) (COMS (* ;; "Perform page layout, based on a regular expression of typed regions.") (FNS \TEDIT.FORMATBOX \TEDIT.FORMATHEADING \TEDIT.FORMATPAGE \TEDIT.FORMATTEXTBOX - \TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX?) + \TEDIT.FORMATFOLIO \TEDIT.FORMAT.FOUNDBOX? \TEDIT.SKIP.SPECIALCOND) (* ;; "Aux function to capture page headings during line formatting:") - (FNS TEDIT.HARDCOPY.PAGEHEADINGS) + (FNS \TEDIT.HARDCOPY.PAGEHEADINGS) (* ;;  " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") - (FNS TEDIT.HARDCOPY-COLUMN-END)) + (FNS \TEDIT.HARDCOPY-COLUMN-END)) [COMS (* ;; "Handle varying paper sizes") @@ -222,19 +226,14 @@ (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) ) -(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS [CHARLOOKS.FROM.FONT (FONTCOPY NIL - '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM - SLOPE REGULAR]) +(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS [\TEDIT.CHARLOOKS.FROM.FONT (FONTCOPY NIL + '(FAMILY MODERN SIZE 10 WEIGHT + MEDIUM SLOPE REGULAR]) (RPAQQ MAXPAGE# 65535) (RPAQQ MINPAGE# 1) -(RPAQ TEDIT.PAGE.FRAMES - (LIST (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) - (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1) - (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1))) - (* ;; "Creation, GET, and PUT of page frames.") @@ -242,7 +241,8 @@ (DEFINEQ (\TEDIT.PARSE.PAGEFRAMES - [LAMBDA (PAGELIST PARENT) (* ; "Edited 13-Nov-2023 00:14 by rmk") + [LAMBDA (PAGELIST PARENT) (* ; "Edited 30-Aug-2024 15:40 by rmk") + (* ; "Edited 13-Nov-2023 00:14 by rmk") (* ; "Edited 4-Oct-2022 16:57 by rmk") (* jds "31-Jul-84 15:30") @@ -265,7 +265,10 @@ collect (\TEDIT.PARSE.PAGEFRAMES ALIST PAGEFRAME))) PAGEFRAME) - (T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES FRAMESPEC NIL]) + (T (SETQ PAGELIST (CAR PAGELIST)) + (TEDIT.COMPOUND.PAGEFORMAT (\TEDIT.PARSE.PAGEFRAMES (pop PAGELIST)) + (\TEDIT.PARSE.PAGEFRAMES (pop PAGELIST)) + (\TEDIT.PARSE.PAGEFRAMES (pop PAGELIST]) (\TEDIT.PUT.PAGEFRAMES [LAMBDA (LOOKSFILE PAGEFRAMES) (* ; "Edited 22-Dec-2023 09:03 by rmk") @@ -306,11 +309,13 @@ (TEDIT.SINGLE.PAGEFORMAT [LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS - PAGEPROPS PAPERSIZE) (* ; "Edited 13-Nov-2023 08:59 by rmk") + PAGEPROPS PAPERSIZE) (* ; "Edited 15-Aug-2024 23:01 by rmk") + (* ; "Edited 6-Aug-2024 12:06 by rmk") + (* ; "Edited 13-Nov-2023 08:59 by rmk") (* ; "Edited 10-Aug-2023 08:14 by rmk") (* ; "Edited 17-Dec-87 14:54 by jds") - (* ;; "Given a description in the args, create a pageframe to describe a single kind of page.") + (* ;; "Given a description in the args, create a pageframe to describe a single kind of page. This is a documented user entry, and the user gets to decide the units of the various specified parameters. But internally everything is stored as points, and oddly, the page layout menu doesn't reflect the original units, only picas.") (LET* ((LANDSCAPE? (LISTGET PAGEPROPS 'LANDSCAPE?)) (PAPERWIDTH (\TEDIT.PAPERWIDTH PAPERSIZE LANDSCAPE?)) @@ -325,23 +330,15 @@ HEIGHT _ PAPERHEIGHT) REGIONLOCALINFO _ (CONS 'PAPERSIZE (CONS PAPERSIZE PAGEPROPS] PAGEWIDTH SUBREGIONS FOLIOLEFT SCALEFACTOR HEADINGREGIONS) - (SELECTQ UNITS - ((POINTS NIL) (* ; + (SETQ SCALEFACTOR (SELECTQ UNITS + ((POINTS NIL) (* ;  "If units are in printers points, the default, do no scaling") - (SETQ SCALEFACTOR 1)) - (PICAS (* ; - "The units are in picas--12pts per. Scale all values.") - (SETQ SCALEFACTOR 12)) - (INCHES (* ; - "The units are in inches, at 72 pts per. Set the scale factor") - (SETQ SCALEFACTOR 72)) - (MICAS (* ; - "The units are MICAS, at 2540 to the inch.") - (SETQ SCALEFACTOR 0.02834646)) - (CM (* ; - "Units are in CM, at 72.27/2.54pts per.") - (SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 72 2.54)))) - (\ILLEGAL.ARG UNITS)) (* ; "We need to do the scaling.") + 1) + (PICAS PTSPERPICA) + (INCHES PTSPERINCH) + (MICAS PTSPERMICA) + (CM PTSPERCM) + (\ILLEGAL.ARG UNITS))) (SETQ PX (SCALEPAGEXUNITS PX SCALEFACTOR PAPERSIZE LANDSCAPE?)) (SETQ PY (SCALEPAGEYUNITS PY SCALEFACTOR PAPERSIZE LANDSCAPE?)) (AND LEFT (SETQ LEFT (HCSCALE SCALEFACTOR LEFT))) @@ -353,38 +350,40 @@ (SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT) LEFT)) (CL:WHEN PAGE#S? - (SELECTQ PQUAD + (SELECTQ (U-CASE PQUAD) (LEFT (* ;  "If the page number is flush left, set up the region to start where he specified.") (SETQ FOLIOLEFT PX)) (RIGHT (* ;  "If it's flush right, set up the region to END there") (SETQ FOLIOLEFT (IDIFFERENCE PX 288))) - ((CENTERED NIL) (* ; + ((CENTERED CENTER NIL) (* ;  "Otherwise, center the page number around the point he specifies") (SETQ FOLIOLEFT (IDIFFERENCE PX 144))) - (SHOULDNT)) + (ERROR "Invalid page number alignment" PQUAD)) (* ;; "Note that the folio charlooks is a charlooks spec-list, not a CHARLOOKS. The parse/unparse is just to get the priority union of PFONT with the defaults.") - [SETQ SUBREGIONS - (LIST (create PAGEREGION - REGIONFILLMETHOD _ 'FOLIO - REGIONSPEC _ - (create REGION - LEFT _ FOLIOLEFT - BOTTOM _ PY - WIDTH _ 288 - HEIGHT _ 36) - REGIONLOCALINFO _ `(PARALOOKS [QUAD ,(OR PQUAD 'CENTERED] - CHARLOOKS - ,(\TEDIT.UNPARSE.CHARLOOKS.LIST ( + (* ;; "RMK: Very odd to default here 4 inches and 1/2 for the folio region. ") + + [SETQ SUBREGIONS (LIST (create PAGEREGION + REGIONFILLMETHOD _ 'FOLIO + REGIONSPEC _ + (create REGION + LEFT _ FOLIOLEFT + BOTTOM _ PY + WIDTH _ (ITIMES 4 PTSPERINCH) + HEIGHT _ (IQUOTIENT PTSPERINCH 2)) + REGIONLOCALINFO _ + `(PARALOOKS [QUAD ,(OR PQUAD 'CENTERED] + CHARLOOKS + ,(\TEDIT.UNPARSE.CHARLOOKS.LIST ( \TEDIT.PARSE.CHARLOOKS.LIST - PFONT + PFONT TEDIT.DEFAULT.FOLIO.LOOKS - )) - FORMATINFO - ,(LISTGET PAGEPROPS 'FOLIOINFO]) + )) + FORMATINFO + ,(LISTGET PAGEPROPS 'FOLIOINFO]) (CL:WHEN HEADINGS [SETQ HEADINGREGIONS (for HDG LEFT in HEADINGS collect @@ -405,13 +404,14 @@ WIDTH _ (IMAX (IDIFFERENCE PAPERWIDTH LEFT) - 72) - HEIGHT _ 36) + PTSPERINCH) + HEIGHT _ (IQUOTIENT PTSPERINCH + 2)) REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR HDG] (SETQ SUBREGIONS (APPEND SUBREGIONS HEADINGREGIONS))) [COND [(OR (NULL COLS) - (IEQP COLS 1)) (* ; + (EQ COLS 1)) (* ;  "There is a single column, so treat it as just one text region bounded by the page margins.") (SETQ SUBREGIONS (NCONC1 SUBREGIONS @@ -426,32 +426,30 @@ BOTTOM] (T (* ;  "There are several columns. We need to create a text box for each col.") + (CL:UNLESS (OR COLWIDTH INTERCOL) + (ERROR "Can't default both Col width and spacing")) [COND [(NULL COLWIDTH) (* ;  "He wants us to fill in the column width, given margins and intercolumn spacing.") - (COND - [INTERCOL (SETQ COLWIDTH (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH - (ITIMES INTERCOL (SUB1 COLS)) - ) - COLS] - (T (* ; "Can't default both of them.") - (SHOULDNT "Can't default both Col width and spacing"] + (SETQ COLWIDTH (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH (ITIMES INTERCOL + (SUB1 COLS))) + COLS] ((NULL INTERCOL) (* ;  "Or else he wants to give us just the col width and have us calc the spacing.") (SETQ INTERCOL (FIXR (FQUOTIENT (IDIFFERENCE PAGEWIDTH (ITIMES COLWIDTH COLS)) (SUB1 COLS] - (for COL from 1 to COLS as CLEFT from LEFT by (IPLUS COLWIDTH INTERCOL) - do (SETQ SUBREGIONS - (NCONC1 SUBREGIONS - (create PAGEREGION - REGIONFILLMETHOD _ 'TEXT - REGIONSPEC _ - (create REGION - LEFT _ CLEFT - BOTTOM _ BOTTOM - WIDTH _ COLWIDTH - HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) - BOTTOM] + (SETQ SUBREGIONS + (NCONC SUBREGIONS + (for COL from 1 to COLS as CLEFT from LEFT by (IPLUS COLWIDTH INTERCOL) + collect (create PAGEREGION + REGIONFILLMETHOD _ 'TEXT + REGIONSPEC _ + (create REGION + LEFT _ CLEFT + BOTTOM _ BOTTOM + WIDTH _ COLWIDTH + HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) + BOTTOM] (replace REGIONSUBBOXES of PAGEREGION with SUBREGIONS) PAGEREGION]) @@ -473,88 +471,160 @@ REGIONSPEC _ (LIST 0 0 0 0]) (TEDIT.PAGEFORMAT - [LAMBDA (STREAM FORMAT PAGETYPE) (* ; "Edited 4-Feb-2024 22:10 by rmk") + [LAMBDA (TSTREAM FORMAT PAGEID) (* ; "Edited 22-Sep-2024 18:45 by rmk") + (* ; "Edited 3-Sep-2024 22:35 by rmk") + (* ; "Edited 30-Aug-2024 23:33 by rmk") + (* ; "Edited 12-Aug-2024 01:10 by rmk") + (* ; "Edited 4-Feb-2024 22:10 by rmk") (* ; "Edited 16-Jan-2024 14:25 by rmk") (* ; "Edited 21-Dec-2023 12:32 by rmk") (* ; "Edited 12-Jun-90 19:13 by mitani") - (* ;; "Programmatic interface for page formatting. If FORMAT is a single page format, it is applied only to PAGETYPE if not NIL. If NIL, it is applied to all pages. If FORMAT is a composite, then PAGETYPE must be NIL.") + (* ;; "Programmatic interface for page formatting. If FORMAT is a single page format, it is applied only to PAGETYPE if not NIL. If NIL, it becomes the FIRST/DEFAULT, overriding any LEFT or RIGHT that may already be there. If FORMAT is a composite, then PAGETYPE must be NIL.") - (* ;; "PAGETYPE argument was not documented. But this preserves the original semantics: a single format with no PAGETYPE is taken as the first and default, wipes out whatever else might have been there.") + (* ;; "PAGETYPE argument was not documented. But this preserves the original semantics: a single format with no PAGETYPE is taken as the first and default, wipes out whatever else that might have been there.") - (* ;; "FORMAT can also be another text, in which case its formats are take as FORMAT--essentially the copy case.") + (* ;; "Original code allowed (undocumented) list of 3 items to be passed around") - (* ;; - "Note that PAGETYPE and the TEXT-format case are extensions, not in the original documentation.") + (* ;; "FORMAT can also be another textstream, in which case its format is take as FORMAT--essentially the copy case.") - (LET* ((TEXTOBJ (TEXTOBJ STREAM)) - (OLDFORMAT (GETTOBJ TEXTOBJ TXTPAGEFRAMES)) - SUBBOXES) - (CL:WHEN (TEXTOBJ FORMAT T) + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + + (* ;; "Note that PAGETYPE and the textstream-format case are extensions, not in the original documentation.") + + (LET* ((TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ)) + (OLDPAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) + (OLDFIRST (TEDIT.GET.PAGEFORMAT OLDPAGEREGION '|FIRST(&DEFAULT)|)) + OLDLEFT OLDRIGHT NEWPAGEREGION SUBBOXES) + (CL:WHEN (TEXTSTREAM FORMAT T) (* ; "Get it from somewhere else") (SETQ FORMAT (GETTOBJ (TEXTOBJ FORMAT) TXTPAGEFRAMES))) - (if [AND (EQLENGTH FORMAT 3) - (for F in FORMAT always (AND (type? PAGEREGION F) - (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) - of F] - elseif (type? PAGEREGION FORMAT) - then (SELECTQ (fetch (PAGEREGION REGIONFILLMETHOD) of FORMAT) - (PAGE (SETQ FORMAT (LIST FORMAT FORMAT FORMAT))) - (SEQUENCE (* ; + (CL:UNLESS (type? PAGEREGION FORMAT) + (\ILLEGAL.ARG FORMAT)) + (SETQ NEWPAGEREGION (SELECTQ (fetch (PAGEREGION REGIONFILLMETHOD) of FORMAT) + (PAGE (SELECTQ PAGEID + (|FIRST(&DEFAULT)| + (* ; + "Try to maintain EQ for defaults; use NIL instead?") + (SETQ OLDLEFT (TEDIT.GET.PAGEFORMAT OLDPAGEREGION + 'LEFT)) + (SETQ OLDRIGHT (TEDIT.GET.PAGEFORMAT OLDPAGEREGION + 'RIGHT)) + (TEDIT.COMPOUND.PAGEFORMAT FORMAT + (CL:IF (EQ OLDFIRST OLDLEFT) + FORMAT + OLDLEFT) + (CL:IF (EQ OLDFIRST OLDRIGHT) + FORMAT + OLDRIGHT))) + (OTHER% LEFT (TEDIT.COMPOUND.PAGEFORMAT + OLDFIRST FORMAT (TEDIT.GET.PAGEFORMAT + OLDPAGEREGION + 'RIGHT))) + (OTHER% RIGHT (TEDIT.COMPOUND.PAGEFORMAT + OLDFIRST + (TEDIT.GET.PAGEFORMAT OLDPAGEREGION + 'LEFT) + FORMAT)) + (NIL + (* ;; + "Both LEFT and RIGHT default to FIRST, as indicated by EQ tests") + + (TEDIT.COMPOUND.PAGEFORMAT FORMAT FORMAT FORMAT)) + (\ILLEGAL.ARG))) + (SEQUENCE (* ;  "TEDIT.COMPOUND.PAGEFORMAT produces this complicated arrangement, don't know why") - (SETQ SUBBOXES (fetch (PAGEREGION REGIONSUBBOXES) of FORMAT)) - (if [AND (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) - of (CAR SUBBOXES))) - (EQ 'ALTERNATE (fetch (PAGEREGION REGIONFILLMETHOD) - of (CADR SUBBOXES))) - [EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) - of (CAR (fetch (PAGEREGION REGIONSUBBOXES) - of (CADR SUBBOXES] - (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) - of (CADR (fetch (PAGEREGION REGIONSUBBOXES) - of (CADR SUBBOXES] - then [SETQ FORMAT (LIST (CAR SUBBOXES) - (CAR (fetch (PAGEREGION REGIONSUBBOXES) - of (CADR SUBBOXES))) - (CADR (fetch (PAGEREGION REGIONSUBBOXES) - of (CADR SUBBOXES] - else (\ILLEGAL.ARG FORMAT))) - (\ILLEGAL.ARG FORMAT)) - else (\ILLEGAL.ARG FORMAT)) + (SETQ SUBBOXES (fetch (PAGEREGION REGIONSUBBOXES) + of FORMAT)) + (CL:UNLESS + [AND (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) + of (CAR SUBBOXES))) + (EQ 'ALTERNATE (fetch (PAGEREGION REGIONFILLMETHOD) + of (CADR SUBBOXES))) + [EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) + of (CAR (fetch (PAGEREGION + REGIONSUBBOXES) + of (CADR SUBBOXES] + (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) + of (CADR (fetch (PAGEREGION + REGIONSUBBOXES) + of (CADR SUBBOXES] + (\ILLEGAL.ARG NEWPAGEREGION)) + FORMAT) + (\ILLEGAL.ARG FORMAT))) - (* ;; "FORMAT is now a triple of new components.") + (* ;; + "NEWPAGEREGION is now a compound PAGEREGION with defautls installed, ready to install. .") - (SETQ FORMAT (SELECTQ PAGETYPE - (NIL (COPY FORMAT)) - (DEFAULT (LIST (CAR FORMAT) - (CAR FORMAT) - (CAR FORMAT))) - (FIRST (LIST (CAR FORMAT) - (CADR OLDFORMAT) - (CADDR OLDFORMAT))) - ((LEFT VERSO) - (LIST (CAR OLDFORMAT) - (CADR FORMAT) - (CADDR OLDFORMAT))) - ((RIGHT RECTO (LIST (CAR OLDFORMAT) - (CADR OLDFORMAT) - (CADDR FORMAT)))) - (\ILLEGAL.ARG PAGETYPE))) + (CL:UNLESS (EQUALALL NEWPAGEREGION OLDPAGEREGION) (* ; + "This doesn't catch the default relations, which are based on EQ to first. ") + (SETTOBJ TEXTOBJ TXTPAGEFRAMES NEWPAGEREGION) (* ; + "If NIL, this must be the call from OPENTEXTSTREAM, no history or dirt") + (CL:WHEN OLDPAGEREGION + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :PageFormat NIL NIL NIL + NIL OLDPAGEREGION)) + (SETTOBJ TEXTOBJ \DIRTY T))) + TSTREAM]) - (* ;; "FORMAT is now a new 3-part list with desired substituions, ready to install. This assumes that \TEDIT.APPLY.PAGEFORMATTING doesn't smash old formats, creates new ones (by calling TEDIT.SINGLE.PAGEFORMAT).") +(TEDIT.GET.PAGEFORMAT + [LAMBDA (TSTREAM PAGETYPE NOERROR) (* ; "Edited 30-Aug-2024 15:19 by rmk") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :PageFormat - THOLDINFO _ OLDFORMAT)) - (SETTOBJ TEXTOBJ TXTPAGEFRAMES FORMAT) - (SETTOBJ TEXTOBJ \DIRTY T) - STREAM]) + (* ;; "Returns a single PAGEREGION for PAGETYPE in TSTREAM. Essentially unravels the components that are slapped together by TEDIT.COMPOUND.PAGEFORMAT. To get the whole compound format, use GETTEXTPROP.") + + (* ;; "This also decodes a list of 3 single pageregions.") + + (LET ((PAGEREGION (if (type? PAGEREGION TSTREAM) + then TSTREAM + elseif (AND (TEXTOBJ TSTREAM T) + (FGETTOBJ (TEXTOBJ TSTREAM) + TXTPAGEFRAMES)) + elseif (LISTP TSTREAM)) + PAGETYPE) + REST) + (if (LISTP PAGEREGION) + then (* ; "Maybe this should be deprecated.") + (SELECTQ PAGETYPE + ((FIRST DEFAULT |FIRST(&DEFAULT)| FIRST/DEFAULT) + (CAR PAGEREGION)) + ((OTHER% LEFT LEFT) + (TEDIT.COMPOUND.PAGEFORMAT NIL PAGEREGION NIL) + (CADR PAGEREGION)) + ((OTHER% RIGHT RIGHT) + (CADDR PAGEREGION)) + (CL:UNLESS NOERROR (\ILLEGAL.ARG PAGETYPE))) + elseif (AND (type? PAGEREGION PAGEREGION) + (EQ 'SEQUENCE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION))) + then (SETQ REST (CADR (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION))) + (SELECTQ PAGETYPE + ((FIRST DEFAULT |FIRST(&DEFAULT)| FIRST/DEFAULT) + (CAR (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION))) + ((OTHER% LEFT LEFT) + (CAR (CL:IF (EQ 'ALTERNATE (fetch (PAGEREGION REGIONFILLMETHOD) + of REST)) + (fetch (PAGEREGION REGIONSUBBOXES) of REST) + REST))) + ((OTHER% RIGHT RIGHT) + (CADR (CL:IF (EQ 'ALTERNATE (fetch (PAGEREGION REGIONFILLMETHOD) + of REST)) + (fetch (PAGEREGION REGIONSUBBOXES) of REST) + REST))) + (CL:UNLESS NOERROR (\ILLEGAL.ARG PAGETYPE))) + elseif PAGEREGION + then (CL:UNLESS NOERROR (\ILLEGAL.ARG PAGETYPE]) ) + +(RPAQ? TEDIT.PAGE.FRAMES + (TEDIT.COMPOUND.PAGEFORMAT (TEDIT.SINGLE.PAGEFORMAT NIL NIL NIL NIL NIL 72 72 72 72 NIL 1) + (TEDIT.SINGLE.PAGEFORMAT T 72 756 NIL 'LEFT 72 72 72 72 NIL 1) + (TEDIT.SINGLE.PAGEFORMAT T 540 756 NIL 'RIGHT 72 72 72 72 NIL 1))) (DEFINEQ (TEDIT.FORMAT.HARDCOPY [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG - ENDPG) (* ; "Edited 5-Apr-2024 08:01 by rmk") + ENDPG) (* ; "Edited 30-Aug-2024 15:45 by rmk") + (* ; "Edited 10-Jul-2024 23:34 by rmk") + (* ; "Edited 29-Jun-2024 10:32 by rmk") + (* ; "Edited 5-Apr-2024 08:01 by rmk") (* ; "Edited 16-Mar-2024 09:31 by rmk") (* ; "Edited 7-Mar-2024 12:34 by rmk") (* ; "Edited 19-Jan-2024 23:39 by rmk") @@ -578,7 +648,7 @@ `(PROGN (CLOSEF? OLDVALUE]) TEXTSTREAM else (ERROR TEXTSTREAM "is not a Tedit stream"))) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTSTREAM)) + (PROG ((TEXTOBJ (FGETTSTR TEXTSTREAM TEXTOBJ)) [FORMATTINGSTATE (create PAGEFORMATTINGSTATE PAGE# _ (FIXP FIRSTPG#) FIRSTPAGE _ T @@ -591,19 +661,15 @@ (CDR FIRSTPG#)) PAGE#TEXT _ (AND (LISTP FIRSTPG#) (CAR FIRSTPG#] - PRSTREAM PAGEFRAMES SCRATCHFILE NPAGES WASOPEN TARGETFILENAME) + PRSTREAM PAGEREGION SCRATCHFILE NPAGES WASOPEN TARGETFILENAME) (CL:WHEN (EQ 'DON'T (APPLY* (OR (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN) (FUNCTION NILL)) TEXTSTREAM)) (* ;  "Do pre-hardcopy processing as indicated, or refuse") (RETURN)) - (SETQ PAGEFRAMES (OR (FGETTOBJ TEXTOBJ TXTPAGEFRAMES) - TEDIT.PAGE.FRAMES)) - (CL:WHEN (LISTP PAGEFRAMES) (* ; - "If it's a list, pack it into a real set of specs.") - (SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES) - (CADR PAGEFRAMES) - (CADDR PAGEFRAMES)))) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Hardcopy") + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (SETQ PAGEREGION (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) (SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION) (* ;  "Print in the usual region on the page") @@ -649,33 +715,26 @@ (* ;; "The right margin must be big enough to prevent line wrap on landscaped 14 inch paper, with Postscript's scaling of .01-point increments. (~ 101,000). This will cause a performance hit. Sigh. JDS 9/5/89") (DSPRIGHTMARGIN 131072 PRSTREAM) - [while (ILEQ (GETPFS FORMATTINGSTATE CHNO) + (while (ILEQ (GETPFS FORMATTINGSTATE CHNO) (FGETTOBJ TEXTOBJ TEXTLEN)) do (* ;; "Format pages according to the existing layout:") - (for PAGEREGION inside PAGEFRAMES do (\TEDIT.FORMATBOX TEXTOBJ PRSTREAM - (GETPFS FORMATTINGSTATE CHNO) - PAGEREGION FORMATTINGSTATE - IMAGETYPE)) + (\TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO) + PAGEREGION FORMATTINGSTATE IMAGETYPE) (CL:WHEN (EQ (GETPFS FORMATTINGSTATE STATE) :NEW-PAGE-LAYOUT) (* ;; "New page layout got specified. Prepare to re-enter the formatting code and skip to the equivalent page in the new format.") - (SETQ PAGEFRAMES (GETPFS FORMATTINGSTATE NEWPAGELAYOUT)) + (SETQ PAGEREGION (GETPFS FORMATTINGSTATE NEWPAGELAYOUT)) (* ;; "Set up the formatting state so code knows we're looking for an equivalent page, and which page it is. (The SUB1 is because we counted an extra page for the page on which the new payout was detected.)") (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE (SUB1 (GETPFS FORMATTINGSTATE PAGECOUNT))) (SETPFS FORMATTINGSTATE PAGECOUNT 0) - (SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE) - (CL:WHEN (LISTP PAGEFRAMES) (* ; - "If it's a list, pack it into a real set of specs.") - (SETQ PAGEFRAMES (TEDIT.COMPOUND.PAGEFORMAT (CAR PAGEFRAMES) - (CADR PAGEFRAMES) - (CADDR PAGEFRAMES)))))] + (SETPFS FORMATTINGSTATE STATE :SEARCHING-FOR-EQUIVALENT-PAGE))) (SETQ TARGETFILENAME (STREAMPROP PRSTREAM 'PDFTARGETINFO)) (CL:UNLESS WASOPEN (* ;  "Only if we created the image stream should we close it.") @@ -699,35 +758,6 @@ "")) T) (RETURN NPAGES)))]) - -(TEDIT.SKIP.SPECIALCOND - [LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 5-Jul-2023 14:19 by rmk") - (* ; "Edited 15-May-2023 22:36 by rmk") - (* ; "Edited 16-Feb-2023 00:08 by rmk") - (* ; - "Edited 25-May-93 13:44 by sybalsky:mv:envos") - - (* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). This is done by setting LINE:LCHARLIM to the last character of the heading so it will move the document ahead to the next real text.") - - (SETLD LINE LMARK 'SPECIAL) - (SETLD LINE 1STLN T) - (SETLD LINE LSTLN T) - (SETLD LINE LHEIGHT 0) - (SETLD LINE ASCENT 0) - (SETLD LINE DESCENT 0) - (SETLD LINE LTRUEASCENT 0) - (SETLD LINE LTRUEDESCENT 0) - (SETLD LINE LCHARLIM (SUB1 (IPLUS CHNO (for PC (HEADINGTYPE _ (fetch (FMTSPEC FMTPARASUBTYPE) - of PARALOOKS)) - inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM) - while [AND (EQ 'PAGEHEADING (fetch (FMTSPEC FMTPARATYPE - ) - of (PPARALOOKS PC))) - (EQ HEADINGTYPE (fetch (FMTSPEC - FMTPARASUBTYPE - ) - of (PPARALOOKS PC] - sum (PLEN PC]) ) @@ -738,6 +768,9 @@ (\TEDIT.FORMATBOX [LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE) + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:10 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") (* ; "Edited 13-Mar-2024 17:09 by rmk") (* ; "Edited 20-Jan-2024 12:16 by rmk") (* ; "Edited 28-Jun-2023 15:54 by rmk") @@ -850,7 +883,7 @@ FORMATTINGSTATE)))) (SELECTION (* ;  "Do one or another box, depending on some criterion.")) - (SHOULDNT)) (* ; + (\TEDIT.THELP)) (* ;  "For now, draw a box around it, too.") ) NIL) @@ -879,8 +912,8 @@ (* ;;  "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") - [SETQ CHNO (IMAX (OR CHNO 0) - (ADD1 (FGETLD LINE LCHARLIM]) + (SETQ CHNO (IMAX (OR CHNO 0) + (FGETLD LINE LCHARLIM)))) (push (GETPFS FORMATTINGSTATE PAGELINECACHE) LINE) (FSETLD LINE LTEXTSTREAM NIL)) @@ -893,7 +926,12 @@ (SETPFS FORMATTINGSTATE CHNO CHNO]) (\TEDIT.FORMATHEADING - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 17-Mar-2024 00:24 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 24-Nov-2024 11:46 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:10 by rmk") + (* ; "Edited 26-Oct-2024 10:43 by rmk") + (* ; "Edited 13-Jun-2024 17:14 by rmk") + (* ; "Edited 17-Mar-2024 00:24 by rmk") (* ; "Edited 15-Mar-2024 19:23 by rmk") (* ; "Edited 13-Mar-2024 09:00 by rmk") (* ; "Edited 6-Mar-2024 13:09 by rmk") @@ -938,8 +976,8 @@ (* ;; "Format the next line from HEADINGTEXTOBJ pieces") - (SETQ LINE (\TEDIT.FORMATLINE HEADINGTEXTOBJ CHNO NIL REGION PRSTREAM - FORMATTINGSTATE)) + (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ HEADINGTEXTOBJ STREAMHINT) + CHNO NIL REGION PRSTREAM FORMATTINGSTATE)) (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM) (GETLD LINE FORCED-END))) [SETQ YBOT (COND @@ -948,14 +986,14 @@ (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))) (T (* ;  "First line: position it at the top of the region.") - (IDIFFERENCE BOTTOM (FGETLD LINE DESCENT] - (SETYPOS LINE YBOT) - (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) - (* ; "Set the start of the next line") + (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT] + (SETYBOT LINE YBOT) + (SETQ CHNO (FGETLD LINE LCHARLIM)) (* ; "Set the start of the next line") LINE))]) (\TEDIT.FORMATPAGE - [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 17-Mar-2024 00:24 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 11-Dec-2024 22:39 by rmk") + (* ; "Edited 17-Mar-2024 00:24 by rmk") (* ; "Edited 13-Mar-2024 10:28 by rmk") (* ; "Edited 19-Jan-2024 23:10 by rmk") (* ; "Edited 11-Dec-2023 22:02 by rmk") @@ -1036,7 +1074,7 @@ (* ;; "Go thru any leading page heading paras on the page, collecting copies of those pieces in the FORMATTINGSTATE. The value is the first CHNO of the start of the first non-heading piece.") - (SETQ CHNO (TEDIT.HARDCOPY.PAGEHEADINGS TEXTOBJ CHNO FORMATTINGSTATE)) + (SETQ CHNO (\TEDIT.HARDCOPY.PAGEHEADINGS TEXTOBJ CHNO FORMATTINGSTATE)) (* ;; "") @@ -1091,7 +1129,14 @@ 1]) (\TEDIT.FORMATTEXTBOX - [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 15-Mar-2024 19:24 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 11-Dec-2024 22:37 by rmk") + (* ; "Edited 24-Nov-2024 11:46 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:16 by rmk") + (* ; "Edited 26-Oct-2024 10:46 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 13-Jun-2024 17:15 by rmk") + (* ; "Edited 15-Mar-2024 19:24 by rmk") (* ; "Edited 19-Jan-2024 23:37 by rmk") (* ; "Edited 4-Dec-2023 12:34 by rmk") (* ; "Edited 4-Jul-2023 08:02 by rmk") @@ -1110,212 +1155,217 @@ (* ;; "Only format text if we're really formatting.") - (LET* - ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) - (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION))) - (COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION)) - (RTOP (fetch (REGION TOP) of REGION)) - (FIRSTLINE T) - (FOOTNOTELINES (ffetch PAGEFOOTNOTELINES of FORMATTINGSTATE)) - FORCENEXTPAGE PAGEFOOTNOTES PRIOR-COLUMN-YBOT LINES ORPHAN FINAL-CHNO FOOTNOTE-REMNANTS) + (LET* ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) + (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION))) + (COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION)) + (RTOP (fetch (REGION TOP) of REGION)) + (FIRSTLINE T) + (FOOTNOTELINES (ffetch PAGEFOOTNOTELINES of FORMATTINGSTATE)) + FORCENEXTPAGE PAGEFOOTNOTES PRIOR-COLUMN-YBOT LINES ORPHAN FINAL-CHNO + FOOTNOTE-REMNANTS) - (* ;; "Account for lines carried over from prior columns:") + (* ;; "Account for lines carried over from prior columns:") - (bind LINE KEPT-ONE-LINE while (AND (ILEQ COLUMNBOTTOM RTOP) - (SETQ LINE (pop FOOTNOTELINES))) - do - (* ;; "Move as many potential footnote lines into this column as will fit. And move the bottom of the column up to account for them.") + (bind LINE KEPT-ONE-LINE while (AND (ILEQ COLUMNBOTTOM RTOP) + (SETQ LINE (pop FOOTNOTELINES))) + do + (* ;; "Move as many potential footnote lines into this column as will fit. And move the bottom of the column up to account for them.") - (CL:WHEN (IGREATERP (+ COLUMNBOTTOM (FGETLD LINE LHEIGHT)) - RTOP) + (CL:WHEN (IGREATERP (+ COLUMNBOTTOM (FGETLD LINE LHEIGHT)) + RTOP) - (* ;; "If we ran out of room for footnotes, put this line back on the queue") + (* ;; "If we ran out of room for footnotes, put this line back on the queue") - (TEDIT.SETQS (PAGEFOOTNOTES FOOTNOTE-REMNANTS KEPT-ONE-LINE) - (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION TEXTOBJ - FORMATTINGSTATE)) - (CL:WHEN KEPT-ONE-LINE - (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) - (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) - (RETURN)) - (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) - (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) - (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES) + (TEDIT.SETQS (PAGEFOOTNOTES FOOTNOTE-REMNANTS KEPT-ONE-LINE) + (\TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION + TEXTOBJ FORMATTINGSTATE)) + (CL:WHEN KEPT-ONE-LINE + (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) + (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) + (RETURN)) + (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) + (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) + (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES) (* ; "Remember any remaining footnotes") - [SETQ LINES - (bind LINE FMTSPEC LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE - COLUMN-YBASE (TEXTLEN _ (TEXTLEN TEXTOBJ)) while (AND (ILEQ CHNO TEXTLEN) - (NOT FORCENEXTPAGE)) - collect (BLOCK) + [SETQ LINES + (bind LINE FMTSPEC LHEIGHT PREVLINE SPECIALYPOS BREAKAFTERLASTPARA YBOT NEWPAGETYPE + COLUMN-YBASE (TEXTLEN _ (TEXTLEN TEXTOBJ)) while (AND (ILEQ CHNO TEXTLEN) + (NOT FORCENEXTPAGE)) + collect (BLOCK) - (* ;; "Grab a line descriptor from the recycling list, or create a new one.") + (* ;; "Grab a line descriptor from the recycling list, or create a new one.") - (SETQ LINE (pop (GETPFS FORMATTINGSTATE PAGELINECACHE))) + (SETQ LINE (pop (GETPFS FORMATTINGSTATE PAGELINECACHE))) (* ;  "Format the line, noting any form-feeds") - (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO LINE REGION PRSTREAM FORMATTINGSTATE)) - (SETQ FORCENEXTPAGE (AND (EQ (CHARCODE FORM) - (FGETLD LINE FORCED-END)) - 'USERBREAK)) - (SETQ LHEIGHT (FGETLD LINE LHEIGHT)) - (SETQ FMTSPEC (FGETLD LINE LFMTSPEC)) - (COND - ((FGETLD LINE LMARK) + (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) + CHNO LINE REGION PRSTREAM FORMATTINGSTATE)) + (SETQ FORCENEXTPAGE (AND (EQ (CHARCODE FORM) + (FGETLD LINE FORCED-END)) + 'USERBREAK)) + (SETQ LHEIGHT (FGETLD LINE LHEIGHT)) + (SETQ FMTSPEC (FGETLD LINE LFMTSPEC)) + (COND + ((FGETLD LINE LMARK) - (* ;; "This line is a placeholder for a page heading, OR for a conditional line that is to be skipped (e.g., an EVEN text para on an odd page). All it tells us is what character to skip to so we can continue.") + (* ;; "This line is a placeholder for a page heading, OR for a conditional line that is to be skipped (e.g., an EVEN text para on an odd page). All it tells us is what character to skip to so we can continue.") - (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) - LINE) - ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of FMTSPEC) - 'FOOTNOTE) + (SETQ CHNO (FGETLD LINE LCHARLIM)) + LINE) + ((LISTGET (FGETPARA FMTSPEC FMTUSERINFO) + 'FOOTNOTE) - (* ;; "This paragraph is a footnote para.") + (* ;; "This paragraph is a footnote para.") - (CL:WHEN FORCENEXTPAGE (* ; + (CL:WHEN FORCENEXTPAGE (* ;  "HELP in original code. SHOULDNT ?") - (SHOULDNT)) - (SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION - FORMATTINGSTATE)) - (SETQ CHNO (ADD1 (FGETLD (CAR (FLAST FOOTNOTELINES)) - LCHARLIM))) (* ; "Grab the lines of this footnote") - [COND - [(GETPFS FORMATTINGSTATE PAGEFOOTNOTELINES) + (\TEDIT.THELP)) + (SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION + FORMATTINGSTATE)) + (SETQ CHNO (FGETLD (CAR (FLAST FOOTNOTELINES)) + LCHARLIM)) (* ; "Grab the lines of this footnote") + [COND + [(GETPFS FORMATTINGSTATE PAGEFOOTNOTELINES) - (* ;; - "There are overflow footnote lines from this page already. Add to them.") + (* ;; + "There are overflow footnote lines from this page already. Add to them.") - (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES (COPY (APPEND (GETPFS - FORMATTINGSTATE - - PAGEFOOTNOTELINES - ) - FOOTNOTELINES] - (T - (* ;; + (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES + (COPY (APPEND (GETPFS FORMATTINGSTATE PAGEFOOTNOTELINES) + FOOTNOTELINES] + (T + (* ;;  "No overflow footnote lines yet. Try adding more footnotes to this page/column.") - (for LTAIL LINE on FOOTNOTELINES - do (SETQ LINE (CAR LTAIL)) - (add COLUMNBOTTOM LHEIGHT) - (CL:WHEN (IGREATERP COLUMNBOTTOM (OR YBOT RTOP)) + (for LTAIL LINE on FOOTNOTELINES + do (SETQ LINE (CAR LTAIL)) + (add COLUMNBOTTOM LHEIGHT) + (CL:WHEN (IGREATERP COLUMNBOTTOM (OR YBOT RTOP)) - (* ;; "This one overflows") + (* ;; "This one overflows") - (TEDIT.SETQS (PAGEFOOTNOTES FOOTNOTE-REMNANTS) - (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL - REGION TEXTOBJ FORMATTINGSTATE 3 (NOT FIRSTLINE) - )) - [SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES - (COPY (APPEND FOOTNOTE-REMNANTS (CDR LTAIL] - [SETQ FINAL-CHNO (IMAX CHNO (ADD1 (GETLD (CAR (FLAST LTAIL)) - LCHARLIM] - (RETURN)) - (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE] + (TEDIT.SETQS (PAGEFOOTNOTES FOOTNOTE-REMNANTS) + (\TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL + 1 NIL REGION TEXTOBJ FORMATTINGSTATE 3 + (NOT FIRSTLINE))) + [SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES + (COPY (APPEND FOOTNOTE-REMNANTS (CDR LTAIL] + (SETQ FINAL-CHNO (IMAX CHNO (FGETLD (CAR (FLAST LTAIL)) + LCHARLIM))) + (RETURN)) + (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE] - (* ;; "Don't accumulate footnote lines.") + (* ;; "Don't accumulate footnote lines.") - NIL) - (T - (* ;; "This line is not a page heading or a footnote, format it.") + NIL) + (T + (* ;; "This line is not a page heading or a footnote, format it.") - (SETQ SPECIALYPOS NIL) + (SETQ SPECIALYPOS NIL) - (* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.") + (* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.") - [SETQ YBOT (COND - ((AND (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) - (FGETLD LINE 1STLN)) + [SETQ YBOT (COND + ((AND (FGETPARA FMTSPEC FMTSPECIALY) + (NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY))) + (FGETLD LINE 1STLN)) (* ;  "There is a special Y location for this paragraph. Move there") - (SETQ SPECIALYPOS (ffetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) - ((AND COLUMN-YBASE (FGETLD LINE 1STLN) - (EQ (ffetch (FMTSPEC FMTCOLUMN) OF FMTSPEC) - 'NEXT)) + (SETQ SPECIALYPOS (FGETPARA FMTSPEC FMTSPECIALY))) + ((AND COLUMN-YBASE (FGETLD LINE 1STLN) + (EQ (FGETPARA FMTSPEC FMTCOLUMN) + 'NEXT)) - (* ;; + (* ;;  "This is the first line of a new column; back YBOT back down to match the prior column.") - (- COLUMN-YBASE (FGETLD LINE DESCENT))) - [YBOT + (- COLUMN-YBASE (FGETLD LINE LDESCENT))) + [YBOT (* ;; "We're into it; take account of this line's height. Original code did the complicated LHEIGHT calculation and threw it away. I assume that that was an error, that the new setting of LHEIGHT is for the benefit of the new YBOT value (which I pulled out of an alternative branch of a COND.") - (CL:WHEN (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - [SETQ LHEIGHT - (IPLUS (FGETLD LINE DESCENT) - (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - (COND - [(FGETLD LINE 1STLN) - (IPLUS (fetch (FMTSPEC LEADBEFORE) - of FMTSPEC) - (fetch (FMTSPEC LEADAFTER) - of (GETLD PREVLINE LFMTSPEC] - (T 0]) - (COND - ((\FIRST-COLUMN-START LINE FMTSPEC) - (IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT) - LHEIGHT)) - (T (IDIFFERENCE YBOT LHEIGHT] - (T (* ; + (CL:WHEN (FGETPARA FMTSPEC FMTBASETOBASE) + [SETQ LHEIGHT + (IPLUS (FGETLD LINE LDESCENT) + (FGETPARA FMTSPEC FMTBASETOBASE) + (COND + ((FGETLD LINE 1STLN) + (IPLUS (FGETPARA FMTSPEC LEADBEFORE + ) + (FGETPARA (GETLD PREVLINE + LFMTSPEC) + LEADAFTER))) + (T 0]) + (COND + ((\FIRST-COLUMN-START LINE FMTSPEC) + (IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT) + LHEIGHT)) + (T (IDIFFERENCE YBOT LHEIGHT] + (T (* ;  "Just starting out; find the line's position with respect to the top of the region to be filled.") - (IDIFFERENCE RTOP (IPLUS (FGETLD LINE LTRUEASCENT) - (FGETLD LINE DESCENT] - (COND - ((AND (ILESSP YBOT COLUMNBOTTOM) - (NOT SPECIALYPOS)) + (IDIFFERENCE RTOP (FGETLD LINE LTRUEHEIGHT] + (COND + ((AND (ILESSP YBOT COLUMNBOTTOM) + (NOT SPECIALYPOS)) - (* ;; "This line hangs off the bottom; (and isn't the first line of a specially-placed paragraph) punt it.") + (* ;; "This line hangs off the bottom; (and isn't the first line of a specially-placed paragraph) punt it.") - (SETQ FORCENEXTPAGE T) - (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) - (SETQ ORPHAN LINE) (* ; "Remember this potential orphan") - NIL) - ((AND (NOT FIRSTLINE) - (FGETLD LINE 1STLN) - (SETQ NEWPAGETYPE (OR (fetch (FMTSPEC FMTNEWPAGEBEFORE) - of (FGETLD LINE LFMTSPEC)) - BREAKAFTERLASTPARA))) + (SETQ FORCENEXTPAGE T) + (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) + (SETQ ORPHAN LINE) (* ; "Remember this potential orphan") + NIL) + ((AND (NOT FIRSTLINE) + (FGETLD LINE 1STLN) + (SETQ NEWPAGETYPE (OR (FGETPARA (FGETLD LINE LFMTSPEC) + FMTNEWPAGEBEFORE) + BREAKAFTERLASTPARA))) - (* ;; + (* ;;  "We're supposed to put this line at the start of a new page/column (any box, later)") - (SETQ FORCENEXTPAGE 'USERBREAK) - (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) - (SETQ ORPHAN NIL) - (CL:UNLESS (EQ NEWPAGETYPE T) (* ; + (SETQ FORCENEXTPAGE 'USERBREAK) + (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) + (SETQ ORPHAN NIL) + (CL:UNLESS (EQ NEWPAGETYPE T) + (* ;  "This isn't simply go to a new box; we need to set up the search for it.") - (SETPFS FORMATTINGSTATE STATE 'SEARCHING) - (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE)) - NIL) - (T (* ; "This line is good; use it.") - (CL:WHEN (AND (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC)) + (SETPFS FORMATTINGSTATE STATE 'SEARCHING) + (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE)) + NIL) + (T (* ; "This line is good; use it.") + (CL:WHEN (AND (FGETPARA FMTSPEC FMTNEWPAGEAFTER)) (* ;  "We're supposed to put the line after this one at the start of a new page/column (any box, later)") - (SETQ BREAKAFTERLASTPARA T)) - (SETQ PRIOR-COLUMN-YBOT (CL:IF PRIOR-COLUMN-YBOT - (IMIN PRIOR-COLUMN-YBOT YBOT) - YBOT)) - (SETYPOS LINE YBOT) - (CL:WHEN (\FIRST-COLUMN-START LINE FMTSPEC) + (SETQ BREAKAFTERLASTPARA T)) + (SETQ PRIOR-COLUMN-YBOT (CL:IF PRIOR-COLUMN-YBOT + (IMIN PRIOR-COLUMN-YBOT YBOT) + YBOT)) + (SETYBOT LINE YBOT) + (CL:WHEN (\FIRST-COLUMN-START LINE FMTSPEC) (* ;; "This is the start of a new group of paragraphs to be lined up in columns. Save the YBASE for these guys for the other columns.") - (SETQ COLUMN-YBASE (GETLD LINE YBASE))) - (SETQ FIRSTLINE NIL) (* ; + (SETQ COLUMN-YBASE (GETLD LINE YBASE))) + (SETQ FIRSTLINE NIL) (* ;  "Note that we have put text out on this page/column/box, for first line checking.") - (SETQ CHNO (ADD1 (GETLD LINE LCHARLIM))) + (SETQ CHNO (FGETLD LINE LCHARLIM)) (* ;  "Keep track of the next character...") - (SETQ PREVLINE LINE) - LINE] - (SETQ LINES (DREMOVE NIL LINES)) (* ; + (SETQ PREVLINE LINE) + LINE] + (SETQ LINES (DREMOVE NIL LINES)) (* ;  "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") - (TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION TEXTOBJ - FORMATTINGSTATE FINAL-CHNO)))]) + (\TEDIT.HARDCOPY-COLUMN-END LINES ORPHAN FORCENEXTPAGE CHNO PAGEFOOTNOTES REGION + TEXTOBJ FORMATTINGSTATE FINAL-CHNO)))]) (\TEDIT.FORMATFOLIO - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 15-Mar-2024 19:24 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 24-Nov-2024 11:46 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:16 by rmk") + (* ; "Edited 26-Oct-2024 10:46 by rmk") + (* ; "Edited 13-Jun-2024 17:15 by rmk") + (* ; "Edited 10-May-2024 12:32 by rmk") + (* ; "Edited 15-Mar-2024 19:24 by rmk") (* ; "Edited 13-Mar-2024 09:00 by rmk") (* ; "Edited 19-Jan-2024 23:28 by rmk") (* ; "Edited 18-Jan-2024 17:04 by rmk") @@ -1356,18 +1406,17 @@ LOOKS ,(LISTGET FOLIOINFO 'CHARLOOKS] (SETQ FOLIOTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of FOLIOSTREAM)) - (TEDIT.INSERT FOLIOTEXTOBJ (CONCAT PRETEXT PAGE# POSTTEXT) + (TEDIT.INSERT FOLIOSTREAM (CONCAT PRETEXT PAGE# POSTTEXT) 1 NIL T) (bind LINE YBOT FORCENEXTPAGE (TEXTLEN _ (TEXTLEN FOLIOTEXTOBJ)) (BOTTOM _ (fetch (REGION BOTTOM) of REGION)) (CHNO _ 1) while (ILEQ CHNO TEXTLEN) until FORCENEXTPAGE - collect (SETQ LINE (\TEDIT.FORMATLINE FOLIOTEXTOBJ CHNO NIL REGION PRSTREAM - FORMATTINGSTATE)) + collect (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ FOLIOTEXTOBJ STREAMHINT) + CHNO NIL REGION PRSTREAM FORMATTINGSTATE)) (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM) (GETLD LINE FORCED-END))) (* ; "Format the next possible line") - (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) - (* ; + (SETQ CHNO (FGETLD LINE LCHARLIM)) (* ;  "Keep track of the next character...") [SETQ YBOT (COND (YBOT (* ; @@ -1375,10 +1424,10 @@ (IDIFFERENCE YBOT (FGETLD LINE LHEIGHT))) (T (* ;  "Just starting out; find the line's position with respect to the top of the region to be filled.") - (IDIFFERENCE BOTTOM (FGETLD LINE DESCENT] - (CL:WHEN (ILESSP YBOT (IDIFFERENCE BOTTOM (FGETLD LINE DESCENT))) + (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT] + (CL:WHEN (ILESSP YBOT (IDIFFERENCE BOTTOM (FGETLD LINE LDESCENT))) (GO $$ITERATE)) - (SETYPOS LINE YBOT) (* ; "This line is still good") + (SETYBOT LINE YBOT) (* ; "This line is still good") LINE))]) (\TEDIT.FORMAT.FOUNDBOX? @@ -1411,6 +1460,34 @@  "We've formatted enough pages up to now.") (SETPFS FORMATTINGSTATE STATE 'FORMATTING))) T]) + +(\TEDIT.SKIP.SPECIALCOND + [LAMBDA (TSTREAM LINE PARALOOKS CHNO) (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:35 by rmk") + (* ; "Edited 26-Oct-2024 10:27 by rmk") + (* ; "Edited 5-Jul-2023 14:19 by rmk") + (* ; "Edited 15-May-2023 22:36 by rmk") + (* ; "Edited 16-Feb-2023 00:08 by rmk") + (* ; + "Edited 25-May-93 13:44 by sybalsky:mv:envos") + + (* ;; "This is a special-paragraph that should be skipped in this context (e.g. an EVEN para on an odd page). This is done by setting LINE:LCHARLIM to the last character of the heading so it will move the document ahead to the next real text.") + + (SETLD LINE LMARK 'SPECIAL) + (FSETLD LINE 1STLN T) + (FSETLD LINE LSTLN T) + (FSETLD LINE LHEIGHT 0) + (FSETLD LINE LASCENT 0) + (FSETLD LINE LDESCENT 0) + (FSETLD LINE LTRUEASCENT 0) + (FSETLD LINE LTRUEDESCENT 0) + (FSETLD LINE LCHARLIM (IPLUS CHNO (for PC (HEADINGTYPE _ (GETPARA PARALOOKS FMTPARASUBTYPE)) + inpieces (fetch (TEXTSTREAM PIECE) of TSTREAM) + while (AND (EQ 'PAGEHEADING (GETPARA (PPARALOOKS PC) + FMTPARATYPE)) + (EQ HEADINGTYPE (GETPARA (PPARALOOKS PC) + FMTPARASUBTYPE))) + sum (PLEN PC]) ) @@ -1419,8 +1496,9 @@ (DEFINEQ -(TEDIT.HARDCOPY.PAGEHEADINGS - [LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 17-Mar-2024 00:27 by rmk") +(\TEDIT.HARDCOPY.PAGEHEADINGS + [LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 15-Mar-2024 13:54 by rmk") (* ; "Edited 9-May-2023 17:46 by rmk") (* ; "Edited 7-May-2023 23:45 by rmk") @@ -1430,7 +1508,7 @@ (CL:UNLESS FORMATTINGSTATE (* ;  "If it isn't there, we would loose the headings") - (SHOULDNT "NIL FORMATTINGSTATE")) + (\TEDIT.THELP "NIL FORMATTINGSTATE")) (bind HEADINGSUBTYPE (PC _ (\TEDIT.CHTOPC CHNO TEXTOBJ)) while [AND PC (EQ 'PAGEHEADING (fetch FMTPARATYPE of (PPARALOOKS PC] do (SETQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE of (PPARALOOKS PC))) @@ -1459,9 +1537,14 @@ (DEFINEQ -(TEDIT.HARDCOPY-COLUMN-END +(\TEDIT.HARDCOPY-COLUMN-END [LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE - FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 19-Jan-2024 23:30 by rmk") + FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-Dec-2024 20:52 by rmk") + (* ; "Edited 24-Nov-2024 11:46 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:22 by rmk") + (* ; "Edited 26-Oct-2024 10:46 by rmk") + (* ; "Edited 19-Jan-2024 23:30 by rmk") (* ; "Edited 29-Oct-2023 18:40 by rmk") (* ; "Edited 4-Jul-2023 21:00 by rmk") (* ; "Edited 15-Feb-2023 23:45 by rmk") @@ -1486,7 +1569,7 @@  "Only worry about widows and orphans if there are really lines to worry about") [for LINE in LINES when (GETLD LINE LMARK LINE) do (DREMOVE LINE LINES) - (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO (ADD1 (GETLD LINE LCHARLIM] + (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO (GETLD LINE LCHARLIM] (SETQ LASTLINE (CAR (FLAST LINES))) (* ;  "Find the last line in this box (column or page)") (CL:WHEN (AND ORPHAN (GETLD ORPHAN LSTLN) @@ -1500,7 +1583,7 @@ (SETQ LASTLINE (CAR (FLAST LINES)))) (CL:WHEN (AND LASTLINE (GETLD LASTLINE 1STLN) (NOT (GETLD LASTLINE LSTLN)) - (ILESSP (GETLD LASTLINE LCHARLIM) + (ILESSP (GETLD LASTLINE LCHARLAST) (TEXTLEN TEXTOBJ))) (* ;  "The last line on the page is a widow. Remove it, too.") (SETQ LINES (DREMOVE LASTLINE LINES)) @@ -1513,27 +1596,30 @@ (* ;; "This is a 2- or 3-line paragraph, with only the first 1 or 2 lines fitting on ANY page. Just return the first 1 or two lines, and we'll have to eat the widow.") (SETQ LINES ORIGINAL-LINES) - (SETQ FINAL-CHNO (COND - (ORPHAN (GETLD ORPHAN LCHAR1)) - (T (ADD1 (GETLD (CAR (FLAST ORIGINAL-LINES)) - LCHARLIM] + (SETQ FINAL-CHNO (CL:IF ORPHAN + (GETLD ORPHAN LCHAR1) + (GETLD (CAR (FLAST ORIGINAL-LINES)) + LCHARLIM))] ([AND (NEQ FORCENEXTPAGE 'USERBREAK) (ILEQ CHNO (TEXTLEN TEXTOBJ)) - (OR (fetch (FMTSPEC FMTHEADINGKEEP) of (GETLD LASTLINE LFMTSPEC)) - (AND (fetch (FMTSPEC FMTKEEP) of (GETLD LASTLINE LFMTSPEC)) + (OR (GETPARA (GETLD LASTLINE LFMTSPEC) + FMTHEADINGKEEP) + (AND (GETPARA (GETLD LASTLINE LFMTSPEC) + FMTKEEP) (NOT (GETLD LASTLINE LSTLN] (* ;; "Only do widow/orphan detection if this is NOT a page break the user asked for. And this isn't the end of the document.") - (for LASTLINE in (REVERSE LINES) while [OR (fetch (FMTSPEC FMTHEADINGKEEP) - of (GETLD LASTLINE LFMTSPEC)) - (AND (fetch (FMTSPEC FMTKEEP) - of (GETLD LASTLINE LFMTSPEC)) + (for LASTLINE in (REVERSE LINES) while [OR (GETPARA (GETLD LASTLINE LFMTSPEC) + FMTHEADINGKEEP) + (AND (GETPARA (GETLD LASTLINE LFMTSPEC) + FMTKEEP) (NOT (GETLD LASTLINE LSTLN] do (* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.") finally (COND - ((AND LASTLINE (AND (NOT (fetch (FMTSPEC FMTHEADINGKEEP) of (GETLD LASTLINE LFMTSPEC))) + ((AND LASTLINE (AND (NOT (GETPARA (GETLD LASTLINE LFMTSPEC) + FMTHEADINGKEEP)) (GETLD LASTLINE LSTLN))) (* ;; "OK we found a line that DOESN'T need to be kept with the other paragraphs. Chop off the list starting AFTER it.") @@ -1552,26 +1638,26 @@ (bind (YBOT _ (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) (GETLD (CAR (FLAST FOOTNOTELINES)) - DESCENT))) for LINE in (REVERSE FOOTNOTELINES) - do (SETYPOS LINE YBOT) + LDESCENT))) for LINE in (REVERSE FOOTNOTELINES) + do (SETYBOT LINE YBOT) (add YBOT (FGETLD LINE LHEIGHT)))) (COND ((OR LINES FOOTNOTELINES) (* ;  "There really ARE lines in this column; take care of them.") (TEDIT.VALUES (APPEND LINES FOOTNOTELINES) REMOVED-LINES NIL)) - [(AND ORPHAN (NOT ORIGINAL-LINES) + ((AND ORPHAN (NOT ORIGINAL-LINES) (NOT DONT-KEEP-SINGLE-LINE)) (* ;  "If there's only one line left for this box, return it anyhow.") (TEDIT.VALUES (CONS ORPHAN FOOTNOTELINES) NIL - (ADD1 (GETLD ORPHAN LCHARLIM] + (GETLD ORPHAN LCHARLIM))) [(AND (NOT DONT-KEEP-SINGLE-LINE) REMOVED-LINES) (SETQ LASTLINE (CAR REMOVED-LINES)) (TEDIT.VALUES (LIST LASTLINE) (CDR REMOVED-LINES) - (AND LASTLINE (ADD1 (GETLD LASTLINE LCHARLIM] + (AND LASTLINE (GETLD LASTLINE LCHARLIM] (ORPHAN (* ;; "There's only the one line, so let's go back and try again.") @@ -1770,7 +1856,10 @@ (DEFINEQ (\TEDIT.FORMAT.FOOTNOTE - [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 15-Mar-2024 19:24 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:22 by rmk") + (* ; "Edited 13-Jun-2024 17:13 by rmk") + (* ; "Edited 15-Mar-2024 19:24 by rmk") (* ; "Edited 13-Mar-2024 17:00 by rmk") (* ; "Edited 19-Jan-2024 23:30 by rmk") (* ; "Edited 6-May-2023 20:38 by rmk") @@ -1789,7 +1878,9 @@ (* ;; "Grab a line descriptor from the formatting list, or create a new one.") - (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO (GETPFS FORMATTINGSTATE PAGELINECACHE) + (SETQ LINE (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) + CHNO + (GETPFS FORMATTINGSTATE PAGELINECACHE) REGION PRSTREAM FORMATTINGSTATE)) (* ;  "Format the line, noting any form-feeds") @@ -1797,7 +1888,7 @@ LEFT) (add (FGETLD LINE RIGHTMARGIN) LEFT) (* ; "Format the next possible line") - (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) (* ; + (SETQ CHNO (FGETLD LINE LCHARLIM)) (* ;  "Keep track of the next character...") (SETQ PREVLINE LINE) LINE finally (* ; @@ -1805,15 +1896,15 @@ (RETURN (DREMOVE NIL $$VAL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11920 15253 (\TEDIT.PARSE.PAGEFRAMES 11930 . 13430) (\TEDIT.PUT.PAGEFRAMES 13432 . -14256) (\TEDIT.UNPARSE.PAGEFRAMES 14258 . 15251)) (15316 31778 (TEDIT.SINGLE.PAGEFORMAT 15326 . 25544) - (TEDIT.COMPOUND.PAGEFORMAT 25546 . 26525) (TEDIT.PAGEFORMAT 26527 . 31776)) (31779 45010 ( -TEDIT.FORMAT.HARDCOPY 31789 . 42943) (TEDIT.SKIP.SPECIALCOND 42945 . 45008)) (45097 92020 ( -\TEDIT.FORMATBOX 45107 . 57887) (\TEDIT.FORMATHEADING 57889 . 61909) (\TEDIT.FORMATPAGE 61911 . 70331) - (\TEDIT.FORMATTEXTBOX 70333 . 85232) (\TEDIT.FORMATFOLIO 85234 . 89977) (\TEDIT.FORMAT.FOUNDBOX? -89979 . 92018)) (92100 94516 (TEDIT.HARDCOPY.PAGEHEADINGS 92110 . 94514)) (94625 101808 ( -TEDIT.HARDCOPY-COLUMN-END 94635 . 101806)) (101853 106794 (SCALEPAGEUNITS 101863 . 103004) ( -SCALEPAGEXUNITS 103006 . 103776) (SCALEPAGEYUNITS 103778 . 104549) (\TEDIT.PAPERHEIGHT 104551 . 105486 -) (\TEDIT.PAPERWIDTH 105488 . 106792)) (107210 110778 (ROMANNUMERALS 107220 . 110776)) (110814 113306 -(\TEDIT.FORMAT.FOOTNOTE 110824 . 113304))))) + (FILEMAP (NIL (11936 15548 (\TEDIT.PARSE.PAGEFRAMES 11946 . 13725) (\TEDIT.PUT.PAGEFRAMES 13727 . +14551) (\TEDIT.UNPARSE.PAGEFRAMES 14553 . 15546)) (15611 36874 (TEDIT.SINGLE.PAGEFORMAT 15621 . 25860) + (TEDIT.COMPOUND.PAGEFORMAT 25862 . 26841) (TEDIT.PAGEFORMAT 26843 . 34132) (TEDIT.GET.PAGEFORMAT +34134 . 36872)) (37161 47663 (TEDIT.FORMAT.HARDCOPY 37171 . 47661)) (47750 99231 (\TEDIT.FORMATBOX +47760 . 60863) (\TEDIT.FORMATHEADING 60865 . 65387) (\TEDIT.FORMATPAGE 65389 . 73919) ( +\TEDIT.FORMATTEXTBOX 73921 . 89845) (\TEDIT.FORMATFOLIO 89847 . 95201) (\TEDIT.FORMAT.FOUNDBOX? 95203 + . 97242) (\TEDIT.SKIP.SPECIALCOND 97244 . 99229)) (99311 101841 (\TEDIT.HARDCOPY.PAGEHEADINGS 99321 + . 101839)) (101950 109679 (\TEDIT.HARDCOPY-COLUMN-END 101960 . 109677)) (109724 114665 ( +SCALEPAGEUNITS 109734 . 110875) (SCALEPAGEXUNITS 110877 . 111647) (SCALEPAGEYUNITS 111649 . 112420) ( +\TEDIT.PAPERHEIGHT 112422 . 113357) (\TEDIT.PAPERWIDTH 113359 . 114663)) (115081 118649 (ROMANNUMERALS + 115091 . 118647)) (118685 121588 (\TEDIT.FORMAT.FOOTNOTE 118695 . 121586))))) STOP diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM index 72910bf2e50a01a6144aced5730e2d192f1b515d..d6d38872330165c885b34aa0200c79229396cfc4 100644 GIT binary patch delta 6644 zcmai3eQaCTb?2kxFWRwWnU<*!JJ*b(QjW#&y+=Os(Xp*3@{xQJ$tRPPC^?E1Nwgzb z@<&vsNSCB^+XNZ9Zm@IPG%cD2PKTsPGe8pSzn1i^`@p6EMb|DXl59i&D9{1h{*Wm?rlrU7DH6ys9JPo@{o&s@25b#CE&g`9u(>f#q4 zj*|&KI+!vGIjzKWkO?{^byw#uLrrQVnWvL&Hi&_)>@{iHazaI9q4mz&KgFG*3M7L`KV} z^Yvqn6QBm#RNR<875=~08`&SYA+>T0e+x$}hQ*7KCUD&e} zNq1K4*0-#M%urMQ+XH;o9+?zY>fOlDz4R|F)$~b}z-9)^{!K zvOqooC*W}2aei-A-nO)b8|eBYTWQimL!N`%7Md3_pVC3k_?}bgw(q3d=GWd_cKw_# zdxA~NLYDrUr%QO3Zr^?V*dyuoceyoub}Q|zb(p?%J4Sr+=_l#7f9LFJueH=g|7>?h ztJ#SjeV-gQpES??XKkGRdiNvM$yv+1aQi`XcD8f!!eqrVpPc__@=42_PJ7esAAdAC zZ7scL&h|`Ru$F#jR@yvlJ0?3Vvwb_G%uer4vz_g`Bu2R$E(UB2jv5iIYh5L#`j7Bz?&dNoFzVyJ!Ly{CB3|k6% z+A#CjS6M>Lj+H=35&Cq~fkUbqA{kvv8u@f-d{`%{tk&B^rB|8`?umsJdrVAL*$@&{ zVlGn=(dp%6T#LOmbGlz-H z8r;%hA~8B;6yS2hL}ZOk<3fD9&4EE;K$LYENs#qz1__B`sZiCmTrUxRw8Q0U>bFDH zRpC*!>f5(Z$gGyeIR^2N+ox^U<~a3+#$|26(zN@!_E#(t-?G`3W_P$8i~(}|i8bIf zRwT>VP+9%+hQ|Ba;LzI5%Jrea?AlH3dY0qqvTM~w!Igu9T7$6D`QEx-pEcOftvUVQ zd{?Vf9QyiBX5`Ydj=qa9GXcix&U1oeu+x*tySH$Zb7Zw**;(Ot(=X2+DrBx zJW({WEm?`#@>b5N~K~vu!EVyrL4?{$6XiKX4mG{-pklqY-Q$uaop7p zSPP3lAp52-8~LPJ4wj5kRwuFww6pn{3&0+;Fs>z&V29S(HaDn`B5Vjl2^}$$)sPs- z2%8Bbo7K}=HmDWSU|?7yLz1>gNRo(at=k<^*-sa6$(}r|mx9d0><9*wMA_}vB}N%e z;O-A@6$sNSzV50hMeoxOFudnLDBNTrmcW3Bc{$LMk??3ZG~oz!kC~a?x=^9!bqUN(3Y-3+`q0KL+`)ZTB$&v$J&TP@vg z?r&mHR%u$9wlq7!YlpO|LwOz6JDLMf)XE60cIP_p`_^n`mZM0ttVVsSuBISb__p{=AR$ab6AArmjUO8+ToABy2r@8aG zQ5XJ^qj=@;{X_>1X7ww}cTF3xS~EXs`r7i{0mgdFVYvb_Ty9g$$w(tMF~pF>;GoLT zz>Y-(h(qGwC3TYrNx117;vlx!-ElwLcbxuYQo~?aKZ)7{au2; zH~PN>mu%F6)Q)@pqmJVvs3P}rWMqBo5>b{$v1?aU8cnL=wnqxJ9-T0-VJ6)Do0`Zg z?1hRbkTxw8`@>C-ZMHnha#_r}ZYgr1O%ZpDhiyb&H#F?54N1j@Av_Z4%_E)kD+eB? zD+fBOh$^V%sF^~z*%)3zCRZ#mq)H*_sGn;J*$Ar-!Hf_iR}aP%0V*X5S}BondZXBf z!l+(=V2lhv_YkwdzO+&VdAAXdA49>{cAECJFzO(Ye znGK~ghs)kt?-@STjN2-A*1FG>_m-=^4b5BwS8kQw8nsi3;)aIXJ2<^haFx5~Gc9{t zxx|~xchypzdUS5aYn7mW`R?W7nRR2z?S+vCIBHmh3NujPno!lp0%)U({J#3-&4oOzJ7f+aJ^-2zS~DzS|MO#~DqvSv|do&!(go^9(wzLG3r z5K{geJjBQolxl3=N4PIL9;Cp>;a&C{2tg1z({LSfm=1P4>_!>?bjOh@&?=66oj>06 zWwmj0q(mgt1$ksqFdY|u3Ku@g!(_r79#5fkip1c$iIE(#u^{tJ*oX;|DcfUt?Smq3 zJ!0xEOpv%iQ_je1SrTDE%Cfmul_a!0HxFS=)M)KU=MG`JU8d1s*Bm|5?%j?u3;RWv zyVA6!`+(P3j}uLZjeltI&{((9?C+fM)5Y!=gFGlQ{F^%?b8*&*Qs8l;e&pq#uiR6c zDu<~5&^h5K{pz8|TaRYfR(yP%x%c+2@=^L9hx}B_kT{YUR+8hk4@cWT&s>DyO zUBOpajN$w0;@o9Ctg)s{{9nW`>U;>w$kNb@6ccnvA^wtHnY%_ZQ;U_ED_6fv%xA7$ zeTJ2aOs>xLd(f6h06v$_lR(3AjJCYSSHudwQ7t>7_x92t>8cHqKM-pF^3c`h7DpNh zVRo1(61^ktugwSkrb!4>@wmL}*K=*`o_GBZy>z@o_$__;cy1TXzJdyEa5YH(>G;`G zuU4A=baJmX`;vg~y!)r7jg3ePT4tB;?l(JoCRvDIHM>{$EWOSjUZhxv=r9MlKfO`( z(wFgMLvoKMclH}$Ctq-|e+mg(q94LBax!F~FNAU@6 zSn{*z$$eipL#yo^Q@+4${x9l{J-uHLCX<$7N*|4z@!QSj-a9K#(AQ!^kFNUWKmMSS zyK~FRO&+$EZkX+6a<-HE@MODX4!D=^K0B#c(Al{XFhlf+`jGI4R9DHd3ub&}6#P9a z$IRerE2BO(gCF*^UR=z;i&y-z^i zPv<6Mmg&1aLucX%`s4Va()EfNzq9hXwe*^Kyl3*5wfx!TS(J7P-bE%-XLSa4N(l9q z^LP~jG^Mf{vWy6Beg+>T0$*Hzhl;S;jNUriag?xUAufPdh7Ex*do|(;@JK{opE&3x zG9E%UIfoqLhec0(LEyT!14^NSsik*L9IL7bge_;NA}_PEA65R`0moE^&{`ppK~$0$ zLU{yv07o;t-LR)BmNrH4?6pO!f@&j=&_?*PS0S^MH<5ZY$&y@?PDTXbOLX>>C}imO zPW?a_r0VG-yWy{2HT|{chu|qwrymn;(;u7;d0#ZUd+;o{eD`_N*UGk6QbP1*aXh7|=X%~>x-mP%BLJJhuEu0R&zYl`SH!+Nh#PgwmZ+aQ8)WEPWTLU!zZTEBcQ}?& zZ8WyaQ#8)vHVY9NI7jH4qdhHn$7j#^ByfzJI6*x0FUx8AMpHW;@X1(!8e%~%Kh`FIwaIVE+`@YzcMrCVoHO%01W+3c~` hGc25@ce?fqb^Q`FPLz8c{e=E@w1dq+pPc;r{{tgawf_JB delta 5829 zcmai2eQX=ab>~t%TPMpBCDAlZ$@ZAGb&_M#+z;+@CEWp)1?$b5H*em|y!U(W?Ki)}HU6HvQ}LnbDeczkDIp?AC=wfs@MFC4 z>hiIP+t=q8Z=W~xM8-H(&{BH%46j5-QCA2F?FGCr#>d7)K7?wk*XM4o+*-VGeI8x^ z;H}jckB^bB4*Tn9@p%+Vma|#3bzL|d4x#y3*yFtwDxuM?kz^*T$BViKHlWaZnHfSK zuH^JYR-gXp*&BhUdwL8^P(uI`Y0V7g#|lM#Duc_VQwdNH+NJiH z1QBk4ovG{pRnN3buMJ=b73VIxoJMMA!H};aBxL@V_#=FP4#*ulh8d&IZ z!B4f{#J=^XasNWF>i-1pAFldLcgOlKvES<&;iEC~qmE!}mnZ6RHwAL8b3V6wxq7IP zevYo)_{@!N7@SE3=dJOdn>W(HIAM)myU8{<)Cg`0yk^?GSDvPGX6s)&f5Hi0O4#c^ zV`|l*#)!RKd!9q@z&Mbw821ui)^6MZ&MTdF_w4V0Su(U|x+k6L|BF=r@;gf#Z!}#$ zB_H1te#Sak&}?#Q-=#1vcC7oc(O*R-4r1g?Hoi!Hu;=BcMpFK@0GaLfDUD%f9J35; z_P6%qK+2cu|JgfK{cjk*<~L!W_jU028ov5ptsD-Ld)@D=F9aR6_}cQr>NOMBV5$Gn z!)ncJGzPGL7dElaKG+ zSC>^#?Cd8)&@nTjv8YW%d7GdPMJ<$+m`#YPO+;*AQI;(ZIJZRzs;y9v9YU~WcvS)G zk8M8^ACuZgvQNY-WVYwrK_0G%9=@ojGB^(rB#6k+pM^`}d6{^7_Z?PYaaz|BnS9Ea zF6c-VMQ4mufys2oz%sTfCPZP8|8NW}#n}wb&OGuGq6xZ_xn36z>7(mB%C4&N^^)86_m@wwGyJ|%jDx}9mt46e&37TvPiJ^4F*78kQ1PC%b z+PG^jSa4Z$r?1f)JZx>@bD8rQUzcf*+$Oto>wPqzK^_krbju3y`u5c&DdNO^I#V)m zaav0xkQ5QoOeUMvQ(88x6;nunD2wC5G&q>BeFlI)zm(M>w$cb(odyy09|&iMj5-t~ zO9^7c;Y$#6b>`#}Al6u6_POiHo2x6cw~@s2=p&vE21mA4`V>SKb;hF~K_UcnQI8uK zi4d4pz=%-+P3grF@FdX+9Z`q?+7wF$Sg)dlp47@&paJOGcu_|J#Bh6z1c_%uB#7Jj z!q#O-;H_CCM3k+|dDv--Ha-?ZS{4u?PxCh)vvfO9r9@Dj3L{>o7}3VC?I!VXppt&6 ztmoq(D#R@NcwxITewzw4VoAYkZBeXj8v#NYm+a?)OPq`+{~dw`}XB1>fyl*u{ZlteV$6*VKCwr5qit|B-C2=Wm$0eekSBaDoZ)t{nF zp4=JS2bNT{5{8UOS#W#BOy0l+1F}eoawL?%d7}ggla4GiHVx;&jUg^{gKn9JdJ53+ zb$73eE3?R4+(V;rYQ5tVP1m;>r{b;jtotkd3=mlu*I7_ZDacnH`i%0%j<6E0L~=0{7%4{b2#vK$!0N?0n_LJtz8CZxZ&5$ zS=ZBPHh=%yj=xIZUw9?W-A}u}UM@PixlF0jvzO%nu=AR0M1p{2g-)*#w!9WnArj>n z;SLPd1=aE_>!Dfl6L=L-F9BbM(gdEI21=obVGPw!LeDayCJ!BVOES5XKy_MLjpg+UYl}{0wP{=i^ovL+55Nv*5s;PyWPrWHuVoRfOu<6b2S6Iv^2|PpDXQ8E z9p26DvI3i&MvG6gi-Vhp(QqVhp*Zc={NQJojaqk`y zIwE_H1?P^DnIo^9Og}KzJ(cj4`Hs)ebCYiPwH@UfkaMk{N+eJjZp~H%(i6JMg~&?i ziZ_(qSPQUV#Xaj!S3=}bD0G>(O@Rx}72w$cBajr0LNd(9H6ZDO+9cp9?I793(UP~6 z85=9=CEY0JD;Yo$kyiG(DTb?JREEBD5P-6C9H5%2)r(;p#+VO5GTnwb0u=Dz1OSv! z!9lXyr1`rChRFAh)->>^ojU?-*^VQ`pscoFSD>zHli(u`3EuPkvHX;zq7XEif&%U4 z?VGgc1gs08TdRxDL(@u!JPN%Cf5BlvP*mA0C4<}M2j3a-nY^7MX`6Wq$;SLbaRBYEX?D<3Ft@H6Z9|0`i?w3$l0T9272Y6#u+$t2FJ7(1=;G+{vB5bE?#dsR< z45?sD8A>)*siBw(&896E14K#ISq-m1qwKKZo5fD;3V`e8wA2n;1%Pam50I6op9W}m z?J#99#i656Ht(=nRQLms(6EumP@RhKMvky3@U0JDh;rO2X^!(;g8cLN=SS!BS=_^l zlI4ZPy#R79*W?3t+RZKZ&GmsV_djlZ42N1TO_Hx_XSw_2H(JE^Njx-Mg-=pXUd910 z^#lQu!|91T`=IdHVT~Y*t%nnjIII@?PQ|sZn$nH5r{$M6R#^=I)UC?MiD}r++G;#u+IRhUuFQ>?VT<#Id*lWb@ytrW2@B#@tedit>TEDIT-PCTREE.;239 66617 +(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}tedit>TEDIT-PCTREE.;243 67795 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.INSERTPIECES) + :CHANGES-TO (FNS \TEDIT.DELETEPIECES) - :PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}tedit>TEDIT-PCTREE.;238) + :PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}tedit>TEDIT-PCTREE.;242) (PRETTYCOMPRINT TEDIT-PCTREECOMS) @@ -272,10 +272,15 @@ DELTA]) (\TEDIT.FIRSTPIECE - [LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 21-Aug-2024 16:07 by rmk") + (* ; "Edited 31-Oct-2023 19:37 by rmk") (* ; "Edited 11-Apr-2023 12:54 by rmk") (* ; "Edited 24-Aug-2022 12:45 by rmk") - (for (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by (ffetch (BTREENODE DOWN1) of NODE) + (for (NODE _ (CAR (GETTOBJ (if (type? TEXTOBJ TEXTOBJ) + then TEXTOBJ + elseif (type? STREAM TEXTOBJ) + then (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ)) + PCTB))) by (ffetch (BTREENODE DOWN1) of NODE) unless (type? BTREENODE NODE) do (* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).") @@ -284,7 +289,8 @@ NODE]) (\TEDIT.DELETETREE - [LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 17-Mar-2024 00:22 by rmk") + [LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 17-Mar-2024 00:22 by rmk") (* ; "Edited 31-Oct-2023 10:23 by rmk") (* ; "Edited 26-Oct-2023 12:50 by rmk") (* ; "Edited 30-May-2023 08:58 by rmk") @@ -313,7 +319,7 @@ (bind TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE)) first (SETQ OLDSLOT (\FINDSLOT PCNODE OLD)) - (CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE")) + (CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE")) (CL:WHEN (EQ OLDSLOT LAST) (* ; "Just shrink by one") (\FILLSLOT OLDSLOT NIL 0) (GO $$OUT)) @@ -504,18 +510,20 @@ (RETURN NODE]) (\TEDIT.SET-TOTLEN - [LAMBDA (PCNODE) (* ; "Edited 21-Oct-2023 17:22 by rmk") + [LAMBDA (PCNODE) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 21-Oct-2023 17:22 by rmk") (* ; "Edited 15-Aug-2022 17:15 by rmk") (* ; "Edited 9-May-93 15:40 by jds") (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths") - (HELP 'NOTCALLED) + (\TEDIT.THELP 'NOTCALLED) (replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN) of S]) (\TEDIT.MAKE.VACANT.BTREESLOT - [LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 16-Mar-2024 10:23 by rmk") + [LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 16-Mar-2024 10:23 by rmk") (* ; "Edited 7-Dec-2023 21:08 by rmk") (* ; "Edited 31-Oct-2023 10:32 by rmk") (* ; "Edited 10-Jun-2023 00:13 by rmk") @@ -563,7 +571,7 @@ (UNINTERRUPTABLY (replace (BTREENODE UPWARD) of BTNODE with PARENT) (RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB)) - (HELP "BTNODE NOT FOUND")) + (\TEDIT.THELP "BTNODE NOT FOUND")) PARENT))) (* ;; "Tree is still valid, but PARENT how has a needed empty slot.") @@ -643,19 +651,21 @@ NEW]) (\TEDIT.UNLINKPIECE - [LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk") + [LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 21-Oct-2023 17:24 by rmk") (* ; "Edited 30-May-2023 00:31 by rmk") (* ;; "Takes PC out of the piece chain, linking prev and next around it.") - (HELP 'NOTCALLED?) + (\TEDIT.THELP 'NOTCALLED?) (CL:WHEN PREV (freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC))) (freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC) (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV]) (\TEDIT.SPLITPIECE - [LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk") + [LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 17-Mar-2024 00:11 by rmk") (* ; "Edited 28-Dec-2023 22:17 by rmk") (* ; "Edited 7-Dec-2023 21:07 by rmk") (* ; "Edited 25-Nov-2023 11:50 by rmk") @@ -687,7 +697,7 @@ (CONSTANT (APPEND STRING.PTYPES FILE.PTYPES))) (* ;  "Dont' want the error under the UNINTERRABPTABLY. Remove when everything is good.") - (SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE")) + (\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE")) (* ;; "") @@ -817,7 +827,8 @@ PIECES]) (\TEDIT.DELETEPIECES - [LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk") + [LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 26-Nov-2024 10:50 by rmk") + (* ; "Edited 16-Mar-2024 10:00 by rmk") (* ; "Edited 25-Nov-2023 12:12 by rmk") (* ; "Edited 4-Nov-2023 23:03 by rmk") (* ; "Edited 22-Oct-2023 11:43 by rmk") @@ -837,10 +848,11 @@ (\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ) (for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL) - (SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES))) + (SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST))) (* ; "For incremental chain-update") - (SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES)) - (FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES + (SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST)) + (FGETTOBJ TEXTOBJ LASTPIECE))) + (FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES do (UNINTERRUPTABLY (\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC)) TEXTOBJ) @@ -856,9 +868,9 @@ (* ;;  "TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.") - (FSETPC (fetch (SELPIECES SPFIRST) of SELPIECES) + (FSETPC (GETSPC SELPIECES SPFIRST) PREVPIECE NIL) - (FSETPC (fetch (SELPIECES SPLAST) of SELPIECES) + (FSETPC (GETSPC SELPIECES SPLAST) NEXTPIECE NIL)) (\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ]) @@ -1057,12 +1069,13 @@ (\TEDIT.BTFAIL [LAMBDA (STRING VAL) - (DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk") - (HELP (CONCAT (OR TAG "") - " " - (OR MSG "") - ": " STRING) - VAL]) + (DECLARE (USEDFREE TAG MSG)) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 28-May-2023 08:45 by rmk") + (\TEDIT.THELP (CONCAT (OR TAG "") + " " + (OR MSG "") + ": " STRING) + VAL]) (\TEDIT.MATCHPCS [LAMBDA (NODE) (* ; "Edited 16-Mar-2024 11:07 by rmk") @@ -1085,13 +1098,13 @@ (GLOBALVARS BTVALIDATETAGS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) ( -\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) ( -\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) ( -\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE -35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) ( -\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 . -52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) ( -\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693 - . 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492))))) + (FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) ( +\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) ( +\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) ( +\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE +36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) ( +\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 . +53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) ( +\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729 + . 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670))))) STOP diff --git a/library/tedit/TEDIT-PCTREE.LCOM b/library/tedit/TEDIT-PCTREE.LCOM index f5b4ce066cbad8df28b24e982fd6f7c8f9861afa..1eda07122af7fb4d0d2e31a02339e78ecee8f932 100644 GIT binary patch delta 882 zcmZuvO-~a+7~UyOQ!65r3Z;=`(hH!p?#yiWD;~PgA-lS6Yr6;sIjCzwOCuNJfr~$Y z7;WaP2_~9oG@`2q69b7}s2`CZz)$e7Bzo}Xw%a8Toy$D)yieYF-g)M2eYf#&F)8J& z)w?;&V*z5KBCO(8L(K?e3MR5xI8sC^kyWI$w#OSKYEqk43_43|uzm+-=jKfl9#!Y_ z`7Cs9tlf70+Xj>DRAO?@FzIZSYBnvwEdJMsl!a^$OvD8OMM+W$Yz<7rg1gx!NT)E$ zm2a&D-g#aXuqp`bJ2)2+u=@u*i`=^iI1Us)bN*@-9|YiCq8RHC?R2nlU5%yF7CVVhn3OuU&yi2vH%d`r}Qp zujv8zcQg(9ulpk!cHY*hS#i(AMq}}iai{y&`;OHa%B0;-r}x33hCLoy1@mkmnTab} z<(KdEn*jEHQ5^6(NWnTo~>{m}iyr$cU(fHWv)5R9?v2hHcW$ zBQIe-G=^jpj0lk=hWcZ_9Ek;3^V19dJSvc*Ctm0cs1$lY7TuQ_edsVk_t*LD_+PWr B?&kmi delta 679 zcmZuv&ubGw7~R>#Wr>Q}bWPfbI7CZ-C1GZN@17cy3A?avW3q(`_7GgbuEm1%)T=kW zm=4~ppobnL?cza^dJw@J1pfv9gXAK5Gij2t1?TkM%*Xe=_rCca9&f$e$e_}l_S2Gt zBn4t@A>Bfq(8|l^5=<4O_#?7p)sj%>x>U@#=E9T!2A) z_hIn=HcDYBwODstQf-ooPipY|tg#Ti0O?P#z{@7oG!5%?7c6k&+4KO+idc_nmn;Qa zs!o4^WmYz#zu+Bf-2w~)Ryk&PdJGT%V}BjtS9Xut=>E1>dtCp(PCrUBp5vw#u?}zh zO+vi28i~>u6u`IawRN}V`B8(*ana7Dy+ky)@(0j?umc?0&gA)0B^B9^sj!j3l@(hzZG5=&!7}FWxw7Pgg{57R#_w_erx9 z3m3}BpdC?!!{wZ&4JB+$5yBIMO_hEV_oC|6yGiyFM;n(#dN_A;-kuo$knECE_;GT> zejbA_&T)|@@|*mZLGz7e?yq`tj$V8OY`CJdOfU7s3mo`ylP1+RqyQBIEZSg)LkB_ zN>oYR)9dvG3=wt^1Q8rK!G$9ixDvtL!GRmx_z#GH3lSWMSbo3vGP6qRUbE}q;DdW+ zdZet(moMM`lnk}O1PX^H}UYl{Wh{8NFgLEC`)rZyUqiXd*wHkCgy}*pSef()n zx@Is8x)VOY7*AfP5J(&!Wsc zy#Me~6QE_^!+5^F0Gv%Ss~&95%{+dN{YOzYPqSs1Od}I7R~eTAY)&|fIEl<=H4E2q za&E3JqQtDPSNt3%GZW>jXc~u$#kE;waUyeS>k9#sX6q2R<%{&nOnKNWT843wKQ5+* zYs1MAAfUi>4B};Yjt^(w zjHc_nX+clZ)iuvs%P&B^Mh@0Z*ZZbD96jv~Cf#vRH}foA8l~_$HA$K@^h*#tHCJ&m zORw^Mp_fc7p6BT%n*!-tdl9eB(lDFtn+X|JH-IBBn$;Gl1KwPlRB(;+d=ur(X0tlH zjIxVxv&gF_X%?BQGP<6Amyub8>xv*xS>@;LIc855IW){sUF7rirMcG+jSOzOs zv0}Z+5^xKL<93@Ih;iW}Px)mg92a~O$dr7`qcEFZ2!^vbhwNY1o7KrQOBayL^Luuz zdKg^+7KODT!Wx-;bC#tWNMr=sQ<5lrYy1n(VhGE1wWpFkgKz>d1JF|udvFXo@+`U* zhTt5l&AON@`asd&U4^5brRy~W0fMv&K?YF}6>X=f`wAS`a1)?sy2Jjfd2t}sFqN5C zq14eF8bs*?nbP^Z0ac(lC(tQ9XKtoxmO&z+g16{G7UdTq)wMbixrNSD$I%iRJ~OrF z^=;``Uw~rg7e+-KQw`KUgt|vfNDE9;^Qaq4x_!$?a-7Pce2$apVl#s4T^>O>GrsYtn2Mt#A&NTl>_&t^wTU4Eip(5X@!@DT*Kks$;NJn;d6S z@t>Qs4VaM7#w=k2F3J5IMr{#8kY~b^CAGx@6=9o$^HA@I`T=VN(8t~WNajwCho}7x z)F6vQKxXFb+H}X`;dtL{l0}r~=J%8|0oNS%kD3O?IWoyctS`=$gM?AzGR)!-)=Ml@ zXpIF-E!00Z7dYn``I<$u%`}1)2(c_$K~b(?6mkLI6lfwn?aN zSc50fatpRu9Yj}VzDcIEg`o)jNwf|r+xg>a=iYn9oWW|JLzGOXH#i*9&Omn0qkX8- zvq)``Y7c;m0D*>}G=zsL)rUqJHDa(6JRAnyhBSHR4kzCcB?p4kj&KTropDzy9$d&n zMBxl793_`=mL~K+_3H4w)QGtU%{!bw-9Xmq@B{_HFY)K92}pJpPM<09 zYL~g0n=jjO;LYK>F}16BF@qY<%q#cq;^=T7L<^c`o#3oqJ$K;3bC?d=5iWlJ{mR~_ z-me^OKXf}*-*|7|80wfc5_|y5jIYl5s2!mG&p=hWO(;T#A0u){M?p>pGH=$aUwN;& z1=Zs6;Q((zwJQO0{9XpaH^if2I~rw)BM@Dz(+np>fjlizb-kwMee`m( zSjQ^}9=v;$Y1}Z2=X3Z4@JjS1hf+fAC{JDmZSfh(8zKVC5(@7UtDwIy zLaouLJLs5jHp5z|4va_1X`~7Kh4s$2gkR#3#SaGe6xVbm0ade#gS{G@jykQNYY!8^ z*Lr+?sE9+6*w#VAuR+ai2;)uyzYA6h+R*)dGw9K^Q1YyhIAE}3!(cM%_ky5x(7$zG z?uGCmUN^GnoKj@>S0|wk6{bpk6(`#vFowc$W>=dUxVcFL669+eB^i|%ca`ROEO7)R z0q&wV35MgRmL9{yLj$!T_qdU>SzgLj3KM!o7Z)^yB&38$thk;MQRkZskf^HGcEYFG zqc{j&JcOh#A^uyl~58a##&ue_D1P3Lymq&GO~cbmoPefyw2JQ)p72c6O*n4(T^jBH^U zX3z9w4td(USxg&JL#6>N5y!)r)SxW&eb4oEyk10SVP@_&t02=+a10L}!K1-FEUxSR zl*H9>)9(Nho+IRifAbCsLOp7YTL)m!o9*M)cp@$wQ2}fy*j&t0g_?#4-$9rxJkP?_ z1;UCbd5=*x#e_sQF>{%N;v&Z!_oP&9?4DJd&(bU`BRFT~d8dr+xz{;IL*$fDd5CJlMuG)v}IVtN{iL$ABzk z@D2W*u@(k-8${;_bP=Epkkf8h{E}J?WgLc~X?hyYaDzL32bb8C>qh%($+U>Xjhq~j zo3`Gv46kX?%IZ?n8d53ChSq{Ch?`)6aez?%3``?)_HzB#enH0}p+X3*&& z=xaSK@w|{IO)C@=msT;NMQA3qKQK}Pf%1MerKTf4^2SoZPmI1ICkTm>Nquw95(hFP zaVb{k8TI%xTW^Gj8pa7~0^T|!j}U>y!5iy~wHg7t`a;umm?9;JN!2IGQdNw{@Jh&S z;Eb?=a~%)FAPanT;}$_(0->uN3{L|K3~89DI_+-{2WldCRvw)BOUmCQ|O?gn8K>;}4ofuHV$1G;or!*ClLtzm+gH%MIx$dgxg2b?udpf2#I z?}8D~Y#W42(g%R3w6ZSc5-}3T=Or`b3rJT5UZkh7iIQ5kZ>VYbTA8N?K)09& ziNeC|?;r&>BG;9?)u#v+rS9{PKp#VjkH+1RX*BA@iX}cN-|8_eKWc6YN(BSlwdjr{ zajCwG^0=)$T%}B^A!e5`(mT-AmiRo{zhi>VxOc!D)EW^fCL%{cqK^XKnxSI=`tAhJ zHcYw}`YBft`HI-EtcqBzJ8o)HJ@JCpIt;pFMqra$6mn9e+%CoTOoHk;VJ&g!IbuFM zfgVLD)xt_b*2i5q{r)7l!H!~Y5h9y}Q5p;B!6Lba0`;L|!T{7EP&C3OmuajuKF|Uc zkZFYS0SU_6AjGyTW<&BITrBj33uEiras;S^B!`HZvK0Bml2k*YM}(!=QJ5f7&@$u} z8g=x-NFo02G^2yo1%=tUUIE(aBvr8Q(mnXp|M<-N6((6Q zs}6EeA(*CQjh2VXMh12hY|gG?Bz2P7G3rN6BcnNWe%OUPJcOHZ6c8=N?cbu1TnR&@0K+Fi9 z8tRg^>vAo~x-`^+n$@pQ(lmMOeHMt%sE6eZT!WZ!&TGrijKF(5f)QcKg+9!czLa5F zii5T??vg^g2KKy0MI{)8MMxma#Z=adX!=ZUr{ub#xOchAV$@la<~NL~_IZT~B*cFC zn;E?_^C1BXMHvfaNK7Nxi$s4a=nFe8;`56I{z>Hkf^!WI2}3NXlWN8N zA(-v1>mW4(7@-nNfB=LtO?lNiT{#(&iE@XfcE|;xkU@|TPED&ZkV23ch+A&C!(z?? z1_kb#WsOK3?LMR$7jUeP;+hO~xB!?2Ly0;M$HS8X(}pufV%;^vJQ=>-m8trbm*x^z zL%wYwMpi>yDKJjQIdB!hu8Qzc2@qGY?1`^AJous`2pR?dFjpMOMD1xT;)0j84tV}JwUkTh?E-hMXEQL zo_{C+ND7zZx_7~{sgzZ5@sBDZB3z_tyuGix3rXq{Iwyn!S`>kY#04j)j&p)TQgB7# zk5#}Z+edW(H%mJ4AptV;Qk6Si?pH@hRQ<3KT5^^mKj6JD zVnR%*qR zB6ut0;y_k!@f7ob;690)Z3%yafQ6+FE&xi=n_`qob2A*-HE22w^X%bAyvWLvKqnYTKw^2 z@l&ecR5%h$s}3k1QKQbI45_-9d}-YAE7gYHM2HZa1o7OWtVm(r38WPV7YUXWbyJfX zFcGEwtc&hJ0`Zr%Ge!$qva<_dpBQ^9GNNwEdYbE%aqClsurV~)2!*`d7lAS4qfeax`Uv1*z1l(8vCt- zZr{qOH#IO6Xo1l?aQXy5wTL2^WW0e3NU6aW!1j$m5)OHh*5iU{Hh05WoXlHzwKC&? zRKH_)Vz&t7Y=kaBVko$dhLb?Q6=#HGuxKe4y&eNRmdeV0`Lr}(XevW&B{39QVNM(E z)}*V51C9ez9EztYU}+#Gcg9*dVJId}8Swd+MoiJ|BlT*icR}H1wKwR&D7*Q#Zc$v2$fK&L2jPi8ZW9%nu9UD;M}c)Nx?B?V z*HzNdV}>5gc5pagB=7le<9sddveFCJ3nL7`nk%xZW#bif!<;p&7& zD8CMH{W&NfjA^X$pB&WK3~9Nmiy*v0+Mz~SSpWmcZUmgDWm8b3W{OS2k%z8d@*_kk zbX96^Nm}LO2cZBjhME9&m%C+wu)PndDi?Lzp1~<2NG~hp?o9bm-d}H3bUo4vw26_T zY%`?Wbs{6%QXDl4b%eIL1QTI#v1%(Ra6@2)?k8H%b$ZS|EEbH*AYq#j0d6@n++8w0 z!lK4JT*mOEELrk=mS~KVh|M|fG7_sCwp7Jnb}eUAW9tLb zQW*fP0@$Bd^?I;_6c|I0+#NoyPBg=lbAmc(`m|lhB|qwwfJ@H+0;0#(K`QSy)2)+a z0FG`q;H_jwbTmWV5WHc#C~PYqS@{>EFDbD^=gJ-*$V%=mjF;N4qz*70M}y%Qc81t{ z-y*$8OgWJz!}>5GLT&}`60yL*uRaQ3NH%r;$B!Zca`CWuK`A85EkV;9f{Z?cLf1<0 zbkrqm@mw~#mHX!?!{!i~@Qh}d2i1_bNRO-%V+J$`$sVuyts(OJi-PTwM9gA9b)IYI zG}bprfsXVn7F(RPbFoBbV1#H4b7QvkxgL}SioGCC;cDnkA6HxLpa=26_1}TEV3JY3 z+O6hJU8Xm!Qs#5UOyw2@v;I?bK_3sFsOAp3r@&5by83yw_P6r1&lXWdUnMUG<)sO~gk()30QE(dzWZul^Z^SjNQ974Jc}B< zlVuHqaV8GuSYN=PRC_+5E9^<@>Fx5?kxq1iwq-PXGqFUYlVp$xuNIq}7rtt&AsbIf z9R`D9Owce}B9pa$X`)WwRTsd8f|Slik|iacz%D8g!FJLfoWQjSe1X^E8_>k%qvfAX zPmKJw$zLrFryj+T`&&Y_Z+jPpAOOB3W%|9qq3A|<&Rh>@nTh$^ey$Qp5&tjRok@zKro6 zq?`|_7Nmr6C124XeZ;m7HHydmquCi2#q>_l z2F50I1#@#t>#%*w1V=*up~KW-bY@f~V3!<0#C|4nPv;XNfLX zLlkds_iejE(Lf-SkS&dzQqVwAhD6k1O@7TC=}T~Z2c>0}F1oNO)Z}8xSnl2xJn!D6 zu5PVW537f!O$XUURk+j}ND10CoV732@UfR7c*8;*By3Q4sy$w*a?E3;RUHrBBgyrh z9(e_V0DVi)J%|I!k(9JE+U5wa#w0#V+BXh;_%wigD-h$IH>R<=#Lqr==(87yE zMQ@Aqn`7HK6DQai4TsWMg`O2ScVIz^l;Lk-!d%1!wN^`I7sf!k>sB?0(JaK$PNC&w z%)FJ)=!gW)46)_84~Fa;4-yFR!m0MdR-JA*}{iL)Uh!vq5TgRd}h?J_JcwM_m z72D*ET7q&6Cz7~auCi>NijH))G2#Zeh%F1FEJ;&o_a?fzl~qnNk?gTpfp9=BZ^}rN zREH{#2oi`R6_(ex<_5L~Ii+<6Lh1JLU}(^%E&t2NsLk)AwymoaWg)41*%C(vcLgGa zQZ*_QMX~{#VW{GVXdkktgE!C>l4bL?A>Y0uHAb&?pEiHGt2d78a7}!fW+7d}c3(dpX8uBdl2U#z~(;JicT|#wt zDQE-{%feTq7`N!_NCbmO8I7XbbEn}--#25QxJU%{r+GayYhbQ78 zXg0w!vI;J6#@eKh)?m555KIut`WlQ4@__Fg2{YR^RgP?v0eGY35#&B23xj4+tSy}U zq<`p&g&+}gH=t{kM$$LD>52DJ^u-4ja_KFQ&4{q$eOlbp(5wP2=1;hs;0quOb`=X- zYST6h5}pM>;ZX!<9Mc<9WsVGkwbIg$nc5zrAO!~3`WWE?o?YHIE#5Ked>#p z7>bRFu7zSPJ6iMglAhr)lz~Y#N_R>EpKmY-o z=0U+)kr7&f6h-rjbNN(vr7zo*?JLWARdMJIjCZ(7!k*O^)REw1)^{wD{sloE-97_d zATKcBR=eVc-5oytozQWHJGqcGVUIo_VJp{q(4M$ z$bEYvz37N2JH68rB8E52?arro+g!*(T26weKo_6t(m>b>wg?82Jow@x^ZD1z!`ENO ze|4RSLU#+v4^ksWX!eVwPvg_U01r5XwXZ)iUwrh)eBohvt=va(p)AIfFTG|Sec?6p z+Wq?qzK)fxK4?8)FyLqYuuKQEA2az!lF1)QcYn;rA5C4Y<3|kj$0|Qvc_5$cuNU_! zpDlmC?en9`rz@Y{`+nsUc)0iCOO?;=?R|gmwuz;&NBoR6zrg=K^qTvX`yY9qPk-b! zKLi2ZsJ!u!5z{p!)Q2a)aph~+=cBE;Upe^5xG8f!3PXix*ym@l^raVH{J*80AJ*kxxJ1ms{|0S@0ot_$q+`CHdKrv6pGLtkbK!T=IB2`!qZ}B z?t>pyD}C|;zP)@rKE;crC@vii{Bt+yQyBUGneQ5`O_G2R;zAoAd+scaum9 zLi0y^8K3X(4#<&St9XH@PrN*7ZU>&Et%8%UKP1*Z(H{zze;s)H5%3E&4 zP5FWw@KbJVy|*Q;m{;*?=tK`ms?P)ul)PoXWspX{{>ZCnc)Bc literal 0 HcmV?d00001 diff --git a/library/tedit/TEDIT-RENAMES b/library/tedit/TEDIT-RENAMES new file mode 100644 index 00000000..2b7745df --- /dev/null +++ b/library/tedit/TEDIT-RENAMES @@ -0,0 +1,172 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}tedit>TEDIT-RENAMES.;5 7187 + + :EDIT-BY rmk + + :CHANGES-TO (VARS TEDITSYMBOLMAP) + + :PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}tedit>TEDIT-RENAMES.;4) + + +(PRETTYCOMPRINT TEDIT-RENAMESCOMS) + +(RPAQQ TEDIT-RENAMESCOMS ( + (* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).") + + + (* ;; + "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)") + + (VARS TEDITSYMBOLMAP) + (VARS FORWARDEDFILES))) + + + +(* ;; +"TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)." +) + + + + +(* ;; "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)") + + +(RPAQQ TEDITSYMBOLMAP + ((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS) + (MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN) + (\TEDIT.BTFAIL BTFAIL) + (\TEDIT.BTVALIDATE BTVALIDATE) + (\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT) + (\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS) + (\TEDIT.CHECK-BTREE CHECK-BTREE) + (\TEDIT.CHECK-BTREE1 CHECK-BTREE1) + (\TEDIT.EQCLOOKS EQCLOOKS) + (\TEDIT.EQFMTSPEC EQFMTSPEC) + (\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM) + (\TEDIT.SAMECLOOKS SAMECLOOKS) + (\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE) + (\TEDIT.FORMATBOX TEDIT.FORMATBOX) + (\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO) + (\TEDIT.FORMATHEADING TEDIT.FORMATHEADING) + (\TEDIT.FORMATPAGE TEDIT.FORMATPAGE) + (\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX) + (\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0) + (\TEDIT.GET.OBJECT TEDIT.GET.OBJECT) + (\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0) + (\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0) + (\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0) + (\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT) + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE) + (\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES) + (\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN) + (\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE) + (\TEDIT.BACKFORMAT \BACKFORMAT) + (\TEDIT.CHTOPC \CHTOPC) + (\TEDIT.COPYSEL \COPYSEL) + (\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU) + (\TEDIT.DELETEPIECES \DELETEPIECES) + (\TEDIT.DELETETREE \DELETETREE) + (\TEDIT.DISPLAYLINE \DISPLAYLINE) + (\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS) + (\TEDIT.FILLPANE \FILLPANE) + (\TEDIT.FIRSTPIECE \FIRSTPIECE) + (\TEDIT.FIXSEL \FIXSEL) + (\TEDIT.FORMATBLOCK \FORMATBLOCK) + (\TEDIT.FORMATLINE \FORMATLINE) + (\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY) + (\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY) + (\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL) + (\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES) + (\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS) + (\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP) + (\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS) + (\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS) + (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS) + (\TEDIT.INSERT TEDIT.\INSERT) + (\TEDIT.INSERTCH \INSERTCH) + (\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND) + (\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY) + (\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION) + (\TEDIT.INSERTEOL \INSERTEOL) + (\TEDIT.INSERTPIECE \INSERTPIECE) + (\TEDIT.INSERTPIECES \INSERTPIECES) + (\TEDIT.INSERTTREE \INSERTTREE) + (\TEDIT.LASTPIECE \LASTPIECE) + (\TEDIT.LINKNEWPIECE \LINKNEWPIECE) + (\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT) + (\TEDIT.MAKEPCTB \MAKEPCTB) + (\TEDIT.MATCHPCS \MATCHPCS) + (\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT) + (\TEDIT.PCTOCH \PCTOCH) + (\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW) + (\TEDIT.SELPIECES \SELPIECES) + (\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM) + (\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT) + (\TEDIT.SELPIECES.COPY \SELPIECES.COPY) + (\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING) + (\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING) + (\TEDIT.SHOWSEL \SHOWSEL) + (\TEDIT.SPLITPIECE \SPLITPIECE) + (\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES) + (\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY) + (\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY) + (\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR) + (\TEDIT.TEXTBIN \TEXTBIN) + (\TEDIT.TEXTBOUT \TEXTBOUT) + (\TEDIT.TEXTCLOSEF \TEXTCLOSEF) + (\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH) + (\TEDIT.TEXTDSPFONT \TEXTDSPFONT) + (\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED) + (\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH) + (\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION) + (\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION) + (\TEDIT.TEXTEOFP \TEXTEOFP) + (\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR) + (\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR) + (\TEDIT.TEXTINIT \TEXTINIT) + (\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN) + (\TEDIT.TEXTOPENF \TEXTOPENF) + (\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN) + (\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN) + (\TEDIT.TEXTSETEOF \TEXTSETEOF) + (\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR) + (\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN) + (\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN) + (\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM) + (\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM) + (\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN) + (\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN) + (\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN) + (\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN) + (\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT) + (\TEDIT.UNLINKPIECE \UNLINKPIECE) + (\TEDIT.UPDATEPCNODES \UPDATEPCNODES) + (\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER))) + +(RPAQQ FORWARDEDFILES + ((PCTREE TEDIT-PCTREE) + (TEDIT TEDIT) + (TEDIT-FILE TEDIT-FILE) + (TEDIT-TEXTOFD TEDIT-STREAM) + (TEDITABBREV TEDIT-ABBREV) + (TEDITCHAT TEDIT-CHAT) + (TEDITCOMMAND TEDIT-COMMAND) + (TEDITDCL TEDITDCL) + (TEDITDEBUG TEDIT-DEBUG) + (TEDITFILE TEDIT-FILE TEDIT-OLDFILE) + (TEDITFIND TEDIT-FIND) + (TEDITFNKEYS TEDIT-FNKEYS) + (TEDITHCPY TEDIT-HCPY) + (TEDITHISTORY TEDIT-HISTORY) + (TEDITLOOKS TEDIT-LOOKS) + (TEDITMENU TEDIT-MENU) + (TEDITPAGE TEDIT-PAGE) + (TEDITSCREEN TEDIT-SCREEN) + (TEDITSELECTION TEDIT-SELECTION) + (TEDITWINDOW TEDIT-WINDOW) + (TFBRAVO TEDIT-TFBRAVO))) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN index f24afffd..08bf8109 100644 --- a/library/tedit/TEDIT-SCREEN +++ b/library/tedit/TEDIT-SCREEN @@ -1,29 +1,34 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Mar-2024 11:07:35" {WMEDLEY}tedit>TEDIT-SCREEN.;645 189050 +(FILECREATED "13-Dec-2024 23:51:30" {WMEDLEY}tedit>TEDIT-SCREEN.;839 186344 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.DISPLAYLINE \TEDIT.RAISE.LINES) + :CHANGES-TO (FNS \TEDIT.FORMATLINE \TEDIT.DISPLAYLINE \TEDIT.FORMATLINE.UPDATELOOKS) + (RECORDS LINEDESCRIPTOR) - :PREVIOUS-DATE "20-Mar-2024 07:27:05" {WMEDLEY}tedit>TEDIT-SCREEN.;644) + :PREVIOUS-DATE "13-Dec-2024 15:41:40" {WMEDLEY}tedit>TEDIT-SCREEN.;835) (PRETTYCOMPRINT TEDIT-SCREENCOMS) (RPAQQ TEDIT-SCREENCOMS ([DECLARE%: EVAL@COMPILE DONTCOPY - (EXPORT (RECORDS THISLINE LINECACHE) + (EXPORT (RECORDS TAB TABSPEC) + (RECORDS LINECACHE) (COMS (* ; "LINEDESCRIPTORS") (RECORDS LINEDESCRIPTOR) (I.S.OPRS inlines backlines) - (MACROS GETLD FGETLD SETLD FSETLD SETYPOS LINKLD)) - (MACROS HCSCALE HCUNSCALE) + (MACROS GETLD FGETLD SETLD FSETLD SETYBOT SETYTOP SETYBASE LINKLD + LINEDESCRIPTOR!)) + (MACROS HCSCALE HCUNSCALE SCALEUP SCALEDOWN) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) (ALISTS (CHARACTERNAMES EM-DASH SOFT-HYPHEN NONBREAKING-HYPHEN NONBREAKING-SPACE)) + (MACROS DIACRITICP) + (MACROS \TEDIT.LINE.TALLP) (COMS (* ; "Formatting slots held by THISLINE") - (RECORDS CHARSLOT) + (RECORDS THISLINE CHARSLOT) (MACROS CHAR CHARW PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT NTHCHARSLOT LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR CHARSLOTP) @@ -33,21 +38,21 @@ (* ;; "incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards.") - (I.S.OPRS incharslots backcharslots) - (MACROS DIACRITICP] + (I.S.OPRS incharslots backcharslots] (FNS \TEDIT.LINEDESCRIPTOR.DEFPRINT) (INITRECORDS THISLINE LINEDESCRIPTOR LINECACHE) (DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Not exported") (MACROS SPACEBREAK SAVEBREAK DOBREAK FORCEBREAK FORGETHYPHENBREAK FORGETPREVIOUSBREAK) (RECORDS PENDINGTAB)) (INITRECORDS PENDINGTAB) - (FNS \TEDIT.FORMATLINE \TEDIT.FORMATLINE.SETUP \TEDIT.FORMATLINE.HORIZONTAL + (FNS \TEDIT.FORMATLINE \TEDIT.FORMATLINE.SETUP.PARA \TEDIT.FORMATLINE.HORIZONTAL \TEDIT.FORMATLINE.VERTICAL \TEDIT.FORMATLINE.JUSTIFY \TEDIT.FORMATLINE.TABS - \TEDIT.FORMATLINE.SCALETABS \TEDIT.FORMATLINE.PURGE.SPACES \TEDIT.FORMATLINE.EMPTY - \TEDIT.FORMATLINE.UPDATELOOKS \TEDIT.FORMATLINE.LASTLEGAL \TEDIT.LINES.ABOVE) + \TEDIT.SCALE.TABS \TEDIT.FORMATLINE.PURGE.SPACES \TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN + \TEDIT.FORMATLINE.EMPTY \TEDIT.FORMATLINE.UPDATELOOKS \TEDIT.FORMATLINE.LASTLEGAL + \TEDIT.LINES.ABOVE) (INITVARS (TEDIT.LINELEADING.BELOW NIL)) (GLOBALVARS TEDIT.LINELEADING.BELOW) - (FNS \CLEARTHISLINE \TLVALIDATE) + (FNS \TLVALIDATE) (* ; "Consistency checking") (INITVARS *TEDIT-CACHED-FMTSPEC*) (* ; "Heuristic for \FORMATLINE") @@ -59,29 +64,18 @@ (* ;; "Machine independent version of \TEDIT.BLTCHAR") (MACROS MI-TEDIT.BLTCHAR)) - (FNS \TEDIT.UPDATE.SCREEN \TEDIT.BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \TEDIT.FILLPANE - \TEDIT.UPDATE.LINES \TEDIT.CREATEPLINE \TEDIT.FIND.DIRTYCHARS \TEDIT.LINES.BELOW - \FORMAT.GAP.LINES \TEDIT.LOWER.LINES \TEDIT.RAISE.LINES \TEDIT.VALID.LINES - \TEDIT.CLEARPANE.BELOW.LINE \TEDIT.INSERTLINE \TEDIT.INSURE.TRAILING.LINE - \TEDIT.MARK.LINES.DIRTY \TEDIT.LINE.BOTTOM \TEDIT.NCONC.LINES))) + (FNS \TEDIT.BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \TEDIT.UPDATE.LINES \TEDIT.PANE.CREATELINES + \TEDIT.SUFFIXLINE.CREATE \TEDIT.LINES.BELOW \TEDIT.MEASURED.LINES \TEDIT.VALID.LINES + \TEDIT.LASTVALIDLINE \TEDIT.NEXTVALIDLINE \TEDIT.CLEARPANE.BELOW.LINE \TEDIT.INSERTLINE + \TEDIT.LINE.BOTTOM \TEDIT.SHOW.AT.BOTTOMP \TEDIT.SHOW.AT.TOPP))) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(DATATYPE THISLINE ( - (* ;; - "Cache for line-related character location info, for selection and line-display code to use.") +(RECORD TAB (TABX . TABKIND)) - (DESC FULLXPOINTER) (* ; - "Line descriptor for the line this describes now") - TLSPACEFACTOR (* ; - "The SPACEFACTOR to be used in printing this line") - TLFIRSTSPACE (* ; "The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width.") - CHARSLOTS (* ; "Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT") - NEXTAVAILABLECHARSLOT) (* ; - "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") - CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) - CELLSPERCHARSLOT) - PTRBLOCK.GCT)) +(RECORD TABSPEC (DEFAULTTAB . TABS)) +) +(DECLARE%: EVAL@COMPILE (DATATYPE LINECACHE ( (* ;; "Image cache for display lines.") @@ -93,14 +87,6 @@ )) ) -(/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER) - '((THISLINE 0 FULLXPOINTER) - (THISLINE 2 POINTER) - (THISLINE 4 POINTER) - (THISLINE 6 POINTER) - (THISLINE 8 POINTER)) - '10) - (/DECLAREDATATYPE 'LINECACHE '(POINTER FULLXPOINTER) '((LINECACHE 0 POINTER) (LINECACHE 2 FULLXPOINTER)) @@ -127,10 +113,10 @@ LX1 (* ;  "X value of the left edge of LCHAR1 from the left margin, in stream natural units.") LHEIGHT (* ; - "Total height of hte line, Ascent+Descent plus leading") - ASCENT (* ; - "Ascent of the line above YBASE, adjusted for line leading") - DESCENT (* ; + "Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") + LASCENT (* ; + "Ascent of the line above YBASE, adjusted for line and paragraph leading") + LDESCENT (* ;  "How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ;  "The TRUE DESCENT for this line, unadjusted for line leading.") @@ -138,7 +124,7 @@  "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ;  "CH# of the first character on the line.") - LCHARLIM (* ; + LCHARLAST (* ;  "CH# of the last character on the line") FORCED-END (* ;  "NIL or character (EOL, FORM...) that forces a line break") @@ -153,12 +139,12 @@  "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (* ;  "The format spec for this line's paragraph (eventually)") - (LDIRTY FLAG) (* ; - "T if this line has changed since it was last formatted.") + (NIL FLAG) (* ; + "Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") - (DELETED FLAG) (* ; "T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)") - (LHASPROT FLAG) (* ; - "This line contains protected text.") + (NIL FLAG) (* ; "Was DELETED: T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)") + (NIL FLAG) (* ; + "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ; "This is a dummy line. Was: LHASTABS. But never fetched and this descriptions wasn't true: If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line.") (1STLN FLAG) (* ;  "This line is the first line in a paragraph") @@ -166,15 +152,43 @@  "This is the last line in a paragraph") ) (INIT (DEFPRINT 'LINEDESCRIPTOR (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT))) - [ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) - (FGETLD DATUM LHEIGHT))) - [LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT] - (LTRUEYTOP (IPLUS (GETLD DATUM YBOT) - (FGETLD DATUM LTRUEHEIGHT))) - (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) - (FGETLD DATUM LTRUEDESCENT] - LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL PREVLINE _ - NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL) + [ACCESSFNS ([YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) + (GETLD DATUM LASCENT)) + FAST + (IPLUS (FGETLD DATUM YBASE) + (FGETLD DATUM LASCENT] + [LTRUEYTOP (STANDARD (IPLUS (GETLD DATUM YBASE) + (FGETLD DATUM LTRUEASCENT)) + FAST + (IPLUS (FGETLD DATUM YBASE) + (FGETLD DATUM LTRUEASCENT] + [LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) + (FGETLD DATUM LTRUEDESCENT)) + FAST + (IPLUS (FGETLD DATUM LTRUEASCENT) + (FGETLD DATUM LTRUEDESCENT] + [LTRUEYBOT (STANDARD (IDIFFERENCE (GETLD DATUM YBASE) + (FGETLD DATUM LTRUEDESCENT)) + FAST + (IDIFFERENCE (FGETLD DATUM YBASE) + (FGETLD DATUM LTRUEDESCENT] + [LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) + (FGETLD DATUM LTRUEASCENT)) + FAST + (IDIFFERENCE (FGETLD DATUM LASCENT) + (FGETLD DATUM LTRUEASCENT] + [LCHARLIM (STANDARD (ADD1 (GETLD DATUM LCHARLAST)) + FAST + (ADD1 (FGETLD DATUM LCHARLAST))) + (STANDARD (SETLD DATUM LCHARLAST (SUB1 NEWVALUE)) + FAST + (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE] + (LNCH (STANDARD (IDIFFERENCE (GETLD DATUM LCHARLIM) + (GETLD DATUM LCHAR1)) + FAST + (IDIFFERENCE (FGETLD DATUM LCHARLIM) + (FGETLD DATUM LCHAR1] + LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0) ) (/DECLAREDATATYPE 'LINEDESCRIPTOR @@ -244,13 +258,23 @@ (PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE))) -(PUTPROPS SETYPOS MACRO [OPENLAMBDA (LINE BOTTOM) - (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) +(PUTPROPS SETYBOT MACRO [OPENLAMBDA (LINE BOTTOM) + (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) (FSETLD LINE YBOT BOTTOM]) +(PUTPROPS SETYTOP MACRO [OPENLAMBDA (LINE TOP) + (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT]) + +(PUTPROPS SETYBASE MACRO [OPENLAMBDA (LINE BASE) + (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT) + (FSETLD LINE YBASE BASE]) + (PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN LINE2 (SETLD LINE2 PREVLINE LINE1)))) + +(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) + (\DTEST LD 'LINEDESCRIPTOR))) ) (DECLARE%: EVAL@COMPILE @@ -263,6 +287,16 @@ (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))]) + +(PUTPROPS SCALEUP MACRO [OPENLAMBDA (SCALE ITEM) (* ; "List = region?") + (CL:IF (LISTP ITEM) + (for I in ITEM collect (FIXR (FTIMES SCALE ITEM))) + (FIXR (FTIMES SCALE ITEM)))]) + +(PUTPROPS SCALEDOWN MACRO [OPENLAMBDA (SCALE ITEM) (* ; "List = region?") + (CL:IF (LISTP ITEM) + (for I in ITEM collect (FIXR (FQUOTIENT I SCALE))) + (FIXR (FQUOTIENT ITEM SCALE)))]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -273,6 +307,24 @@ (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (NONBREAKING-SPACE "357,041")) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) + + (* ;; "An XCCS diacritic") + + (AND (SMALLP CHAR) + (IGEQ CHAR 192) + (ILEQ CHAR 207)))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) + (OR (IGREATERP (FGETLD LINE LHEIGHT) + 50) + (IGREATERP (FGETLD LINE LHEIGHT) + HEIGHT)))) +) @@ -280,10 +332,34 @@ (DECLARE%: EVAL@COMPILE +(DATATYPE THISLINE ( + (* ;; + "Cache for line-related character location info, for selection and line-display code to use.") + + (DESC FULLXPOINTER) (* ; + "Line descriptor for the line this describes now") + TLSPACEFACTOR (* ; + "The SPACEFACTOR to be used in printing this line") + TLFIRSTSPACE (* ; "The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width.") + CHARSLOTS (* ; "Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT") + NEXTAVAILABLECHARSLOT) (* ; + "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") + CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) + CELLSPERCHARSLOT) + PTRBLOCK.GCT)) + (BLOCKRECORD CHARSLOT (CHAR CHARW (* ;  "If CHAR is NIL, then CHARW is CHARLOOKS.") )) ) + +(/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER) + '((THISLINE 0 FULLXPOINTER) + (THISLINE 2 POINTER) + (THISLINE 4 POINTER) + (THISLINE 6 POINTER) + (THISLINE 8 POINTER)) + '10) (DECLARE%: EVAL@COMPILE (PUTPROPS CHAR MACRO ((CSLOT) @@ -414,16 +490,6 @@ repeatuntil (EQ I.V. $$CHARSLOTLIMIT] T) ) -(DECLARE%: EVAL@COMPILE - -(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) - - (* ;; "An XCCS diacritic") - - (AND (SMALLP CHAR) - (IGEQ CHAR 192) - (ILEQ CHAR 207)))) -) (* "END EXPORTED DEFINITIONS") @@ -431,32 +497,39 @@ (DEFINEQ (\TEDIT.LINEDESCRIPTOR.DEFPRINT - [LAMBDA (LINE STREAM) (* ; "Edited 2-Dec-2023 23:05 by rmk") + [LAMBDA (LINE STREAM) (* ; "Edited 19-Nov-2024 16:04 by rmk") + (* ; "Edited 17-Nov-2024 16:00 by rmk") + (* ; "Edited 10-Nov-2024 18:28 by rmk") + (* ; "Edited 4-Nov-2024 19:54 by rmk") + (* ; "Edited 4-Jul-2024 10:39 by rmk") + (* ; "Edited 10-May-2024 00:27 by rmk") + (* ; "Edited 2-Dec-2023 23:05 by rmk") (* ; "Edited 4-Oct-2023 21:18 by rmk") (* ; "Edited 3-Jul-2023 22:02 by rmk") (* ; "Edited 22-May-2023 14:42 by rmk") (* ; "Edited 21-May-2023 09:15 by rmk") (LET (INFO LOC) - (SETQ INFO (CONCAT (CL:IF (GETLD LINE 1STLN) + [SETQ INFO (CONCAT (CL:IF (GETLD LINE 1STLN) "*" "") (GETLD LINE LCHAR1) "-" - (GETLD LINE LCHARLIM) + (GETLD LINE LCHARLAST) (CL:IF (GETLD LINE LSTLN) "*" "") - (CL:IF (GETLD LINE FORCED-END) - " FE" - ""))) + (if (GETLD LINE FORCED-END) + then (CONCAT " FE" (CL:IF (GETLD LINE LDUMMY) + "D" + "")) + else (CL:IF (GETLD LINE LDUMMY) + " D" + "")] (SETQ LOC (LOC LINE)) - (CONS (CONCAT "{L" (CL:IF (GETLD LINE LDIRTY) - "D" - "") - ":" INFO " " (CAR LOC) + (CONS (CONCAT "{L" (CAR LOC) "/" (CDR LOC) - "}"]) + ": " INFO "}"]) ) (/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER) @@ -564,10 +637,10 @@ DX)) (SETQ SPACELEFT (IDIFFERENCE WIDTH (IDIFFERENCE TX OVERHANG]) -(PUTPROPS FORGETHYPHENBREAK MACRO (NIL (CL:WHEN PREVDHYPH (* ; - "Previous soft hyphen becomes invisible") +(PUTPROPS FORGETHYPHENBREAK MACRO (NIL (CL:WHEN PREVDHYPH (* ; "Previous soft hyphen is removed") (add TX (IMINUS (CHARW PREVDHYPH))) - (FILLCHARSLOT PREVDHYPH NIL 1)) + (SETQ CHARSLOT (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN + THISLINE PREVDHYPH CHARSLOT))) (SETQ PREVDHYPH (SETQ PREVHYPH NIL)))) (PUTPROPS FORGETPREVIOUSBREAK MACRO (NIL (FORGETHYPHENBREAK) (* ; "Forget hyphens") @@ -614,7 +687,23 @@ (DEFINEQ (\TEDIT.FORMATLINE - [LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + [LAMBDA (TSTREAM CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 13-Dec-2024 23:46 by rmk") + (* ; "Edited 12-Dec-2024 15:20 by rmk") + (* ; "Edited 9-Dec-2024 21:05 by rmk") + (* ; "Edited 23-Nov-2024 00:03 by rmk") + (* ; "Edited 17-Nov-2024 19:56 by rmk") + (* ; "Edited 31-Oct-2024 15:32 by rmk") + (* ; "Edited 26-Oct-2024 10:51 by rmk") + (* ; "Edited 2-Sep-2024 16:06 by rmk") + (* ; "Edited 27-Aug-2024 18:29 by rmk") + (* ; "Edited 4-Aug-2024 18:07 by rmk") + (* ; "Edited 29-Jul-2024 23:30 by rmk") + (* ; "Edited 28-Jun-2024 21:51 by rmk") + (* ; "Edited 25-Jun-2024 15:43 by rmk") + (* ; "Edited 13-Jun-2024 17:26 by rmk") + (* ; "Edited 21-May-2024 14:45 by rmk") + (* ; "Edited 10-May-2024 12:11 by rmk") (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 15-Mar-2024 19:43 by rmk") (* ; "Edited 14-Mar-2024 12:53 by rmk") @@ -626,12 +715,12 @@ (* ; "Edited 28-Oct-2023 13:14 by rmk") (* ; "Edited 24-Jul-2023 23:13 by rmk") (* ; "Edited 23-Oct-2022 09:11 by rmk") - (DECLARE (SPECVARS IMAGESTREAM FORMATTINGSTATE)) + (DECLARE (SPECVARS TSTREAM)) (* ;; - "Format the next line of text starting at CH#1. Return the LINEDESCRIPTOR; reusing LINE if given.") + "Note that lines lie within paragraphs, and all pieces within a paragraph have the same FMTSPEC.") - (* ;; "The SPECVARS are accessed and reset under the subfunctions, particularly \FORMATLINE.UPDATELOOKS. IMAGESTREAM and FORMATTINGSTATE are passed only for hardcopy. ") + (* ;; "The SPECVARS are accessed and reset under the subfunction\FORMATLINE.UPDATELOOKS, IMAGESTREAM and FORMATTINGSTATE are passed only for hardcopy. ") (* ;; "") @@ -639,9 +728,9 @@ (* ;; " LCHAR1: The CHNO of the first visible character/object of this line. LCHAR1=0 for empty/dummy line.") - (* ;; " LCHARLIM: The CHNO of the last character in the line-vector, including final EOL or last of run of spaces that overflows.") + (* ;; " LCHARLAST: The CHNO of the last character in the line-vector, including final EOL or last of run of spaces that overflows.") - (* ;; " LXLIM: The X coordinate of the right edge of character/object LCHARLIM") + (* ;; " LXLIM: The X coordinate of the right edge of character/object LCHARLAST") (* ;; " PREVSP: The slot position in THISLINE of the right most scalable space.") @@ -657,18 +746,13 @@ (* ;; "") - (* ;; "If a (visible) word crosses the margin |, then the line ends at the space just before the beginning of that word. For x==yz==ab|cd, LCHARLIM goes to the space before a, LXLIM is its right edge. The justifier will leave the spaces between z and a alone, but might fatten the spaces between x and y based on the SPACELEFT between z and margin |. The spaces after z OVERHANG. An EOL or FORM force a line-end and also overhang with along with any immediately preceding spaces--they are essentially treated as line-breaking spaces.") - - (* ;; " abc123#45|6 => abc[123]#$| (456 on next line--leading white space only after EOL)") - - (CL:UNLESS LINE - - (* ;; "Not needed until the end, but then we might not get the starting values for WRIGHT and WBOTTOM, if those change from piece to piece--check this.") - - [SETQ LINE (create LINEDESCRIPTOR - YBOT _ (SUB1 (ffetch (TEXTOBJ WBOTTOM) of TEXTOBJ]) - (PROG ((TSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (THISLINE (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) + (CL:UNLESS IMAGESTREAM + (SETQ IMAGESTREAM (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM) + 'DSP))) (* ; "For lower image objects?") + (CL:WHEN (type? TEXTOBJ TSTREAM) (* ; + "Still confused about textobj/stream. Not sure who uses TSTREAM freely ") + (SETQ TSTREAM (FGETTOBJ TSTREAM STREAMHINT))) + (PROG ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) (OFFSET 0) (TRUEASCENT -1) (TRUEDESCENT -1) @@ -679,11 +763,18 @@ (OVERHANG 0) (SPACELEFT 0) (TX 0) - LINETYPE DISPLAYSTREAM WIDTH WMARGIN SCALE FMTSPEC RIGHTMARGIN TABSPEC KERN FIRSTWHITEX - FIRSTWHITESLOT PC CHARSLOT PREVSP 1STLN PROTECTED CHNOB FORCED-END CHNO LX1 TX TXB FONT - CHARSLOTB TABPENDING PREVHYPH PREVDHYPH START-OF-PIECE UNBREAKABLE JUSTIFIED) - (DECLARE (SPECVARS LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT START-OF-PIECE KERN - UNBREAKABLE)) + (BOXSTREAM IMAGESTREAM) + THISLINE LINETYPE WIDTH WMARGIN SCALE FMTSPEC RIGHTMARGIN HASKERN PC CHARSLOT PREVSP 1STLN + CHNOB FORCED-END CHNO LX1 TX TXB FONT CHARSLOTB TABPENDING PREVHYPH PREVDHYPH + START-OF-PIECE UNBREAKABLE OLDPIECE OLDPCCHARSLEFT OLDCARETLOOKS) + (DECLARE (SPECVARS TEXTOBJ LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT + START-OF-PIECE HASKERN UNBREAKABLE)) + (CL:UNLESS LINE + + (* ;; "Not needed until the end, but then we might not get the starting values for WRIGHT and WBOTTOM, if those change from piece to piece--check this.") + + (SETQ LINE (create LINEDESCRIPTOR))) + (SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE)) (* ;;  "CHNO = Current character # in the text, CHNOB is the character at the last potential break") @@ -708,17 +799,29 @@ (* ;; "") - (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (LASTCHARSLOT THISLINE)) + (SETQ OLDCARETLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)) (* ; + "Restore at end--BIN changes things") + (SETQ OLDPIECE (ffetch (TEXTSTREAM PIECE) of TSTREAM)) + (SETQ OLDPCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)) - (* ;; "Start with LASTCHARSLOT just so STL debugger will show everything before the true end has been determined.") + (* ;; "") + + (* ;; "Make sure we have a visible starting piece. ") + + (SETQ PC (\TEDIT.CHTOPC CH#1 TEXTOBJ T)) (* ; + "Get the true staring piece and CH#") + (CL:UNLESS (VISIBLEPIECEP PC) + (CL:UNLESS (SETQ PC (\NEXT.VISIBLE.PIECE PC)) + (RETURN (\TEDIT.FORMATLINE.EMPTY TEXTOBJ CH#1 LINE))) + (SETQ CH#1 (\TEDIT.PCTOCH PC TEXTOBJ)) (* ; + "Unusual, simpler than keeping track on the fly") + (SETQ START-OF-PIECE CH#1)) + (SETQ CHNO CH#1) + + (* ;; "") + + (* ;; "We have the true starting piece and CH#1") - (SETQ LINETYPE (if IMAGESTREAM - then 'TRUEHARDCOPY - else (SETQ DISPLAYSTREAM (WINDOWPROP (CAR (FGETTOBJ TEXTOBJ \WINDOW)) - 'DSP)) - (SETQ IMAGESTREAM DISPLAYSTREAM) - 'TRUEDISPLAY)) (* ; - "DISPLAYSTREAM needed for HARDCOPYDISPLAY objects") [if (REGIONP REGION) then (SETQ WMARGIN (ffetch (REGION LEFT) of REGION)) (* ; @@ -731,78 +834,51 @@ (* ;; "") - (SETQ PC (\TEDIT.CHTOPC CH#1 TEXTOBJ T)) - (CL:WHEN (OR (NULL PC) - (EQ PC (FGETTOBJ TEXTOBJ LASTPIECE))) + (SETQ LINETYPE (if (NOT (DISPLAYSTREAMP IMAGESTREAM)) + then 'TRUEHARDCOPY + elseif (FGETPARA (PPARALOOKS PC) + FMTHARDCOPY) + then 'HARDCOPYDISPLAY + else 'TRUEDISPLAY)) + (SETQ IMAGESTREAM (\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ PC LINE IMAGESTREAM LINETYPE)) - (* ;; - "The dummy line is presumably the one that allows for the cursor to blink after a final EOL.") + (* ;; "The unchanging paragraph look has now been established and scaled appropriately. It is returned in the LFMTSPEC, the IMAGESTREAM is unmodified.") - (RETURN (AND (FGETLD LINE LDUMMY) - LINE))) - - (* ;; "") - - (* ;; "Make sure we have a visible starting piece. ") - - (CL:UNLESS (VISIBLEPIECEP PC) - (CL:UNLESS (SETQ PC (\NEXT.VISIBLE.PIECE PC)) - (RETURN (\TEDIT.FORMATLINE.EMPTY TEXTOBJ CH#1 LINE))) - (SETQ CH#1 (\TEDIT.PCTOCH PC TEXTOBJ)) (* ; - "Unusual, simpler than keeping track on the fly") - (SETQ START-OF-PIECE CH#1)) - (SETQ CHNO CH#1) - (SETQ IMAGESTREAM (\TEDIT.FORMATLINE.SETUP TEXTOBJ PC LINE IMAGESTREAM)) (SETQ FMTSPEC (FGETLD LINE LFMTSPEC)) - - (* ;; "Display stream could have switched for hardcopy font widths.") - - (CL:WHEN (AND (EQ LINETYPE 'TRUEDISPLAY) - (ffetch (FMTSPEC FMTHARDCOPY) of FMTSPEC)) - (SETQ LINETYPE 'HARDCOPYDISPLAY)) - (SETQ SCALE (ffetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)) + (SETQ SCALE (FGETPARA FMTSPEC FMTHARDCOPYSCALE)) (* ;; "This line starts a paragraph if it starts the document or it is at the beginning of a piece just after a last-paragraph piece. This assumes that only visible pieces matter; otherwise, use PREVPIECE.") - (SETQ JUSTIFIED (EQ 'JUSTIFIED (fetch (FMTSPEC QUAD) of FMTSPEC))) [SETQ 1STLN (OR (IEQP CH#1 1) (AND (IEQP CH#1 START-OF-PIECE) (OR (NOT (\PREV.VISIBLE.PIECE PC)) (PPARALAST (\PREV.VISIBLE.PIECE PC] - (* ;; "Account for first-line indentation from the true left margin (LEFTMAR), in natural units") + (* ;; "Account for first-line indentation from the true left margin (LEFTMAR)") (SETQ LX1 (CL:IF 1STLN - (ffetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) - (ffetch (FMTSPEC LEFTMAR) of FMTSPEC))) - (SETQ RIGHTMARGIN (if (ZEROP (ffetch (FMTSPEC RIGHTMAR) of FMTSPEC)) + (FGETPARA FMTSPEC 1STLEFTMAR) + (FGETPARA FMTSPEC LEFTMAR))) + (SETQ RIGHTMARGIN (if (ZEROP (FGETPARA FMTSPEC RIGHTMAR)) then (* ;; "RIGHTMAR = 0 => follow the window/region's width") WIDTH - else (ffetch (FMTSPEC RIGHTMAR) of FMTSPEC))) + else (FGETPARA FMTSPEC RIGHTMAR))) (SETQ WIDTH (IDIFFERENCE RIGHTMARGIN LX1)) - (SETQ TABSPEC (ffetch (FMTSPEC TABSPEC) of FMTSPEC)) - (CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) (* ; "Scale points up to hardcopy") - (SETQ LX1 (HCSCALE SCALE LX1)) - (SETQ WIDTH (HCSCALE SCALE WIDTH)) - (SETQ TABSPEC (\TEDIT.FORMATLINE.SCALETABS TABSPEC SCALE))) (* ;; "") - (* ;; "The unchanging paragraph looks have now been established. Set up starting piece for BINNING characters") - (* ;; "The LOOKSUPDATEFN will initialize the character looks of the starting piece PC. It is also called at piece boundaries to reset the character-looks variables when BIN (=\TEXTBIN) moves from piece to piece.") - (freplace (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM with (FUNCTION - \TEDIT.FORMATLINE.UPDATELOOKS)) - (freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with NIL) + (freplace (TEXTSTREAM APPLYLOOKSUPDATEFN) of TSTREAM with T) + (FSETTOBJ TEXTOBJ CARETLOOKS NIL) (* ; "Initialize variables to PC looks.") (SETQ CHARSLOT (FIRSTCHARSLOT THISLINE)) (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH#1 START-OF-PIECE)) (* ;; "") - (* ;; "Note: the character looks of the first piece establish the initial FONT, ASCENTC, DESCENTC in anticipation of the first as yet unseen character, and these are reset when the PLOOKS of each piece change. These character ASCENTC and DESCENTC values apply only to actual characters, not to image objects, which have their own intrinsic values. The character values and image values together determine the ASCENT and DESCENT for the line. But importantly: the initial character-looks or the looks at each piece-transition don't affect the line values until at least one character with those looks has been seen. That's why the line values are computed for each BIN, using character or object values as appropriate..") + (* ;; "The character looks of the first piece establish the initial FONT, ASCENTC, DESCENTC in anticipation of the first as yet unseen character, and these are reset when the PLOOKS of each piece change. These character ASCENTC and DESCENTC values apply only to actual characters, not to image objects, which have their own intrinsic values. The character values and image values together determine the ASCENT and DESCENT for the line. But importantly: the initial character-looks or the looks at each piece-transition don't affect the line values until at least one character with those looks has been seen. That's why the line values are computed for each BIN, using character or object values as appropriate..") (* ;; "") @@ -811,84 +887,79 @@ (* ;;  " INWORD=T if we haven't just seen a space, INSPACES=T if we are in the middle of a space run.") - (SETQ FIRSTWHITEX TX) - (bind CH DX BOX INSPACES (INWORD _ T) + (bind CH DX BOX INSPACES FIRSTWHITESLOT PREVCH KERN (FIRSTWHITEX _ TX) + (INWORD _ T) (LASTCHARSLOT _ (LASTCHARSLOT THISLINE)) + (JUSTIFIED _ (EQ 'JUSTIFIED (FGETPARA FMTSPEC QUAD))) (TEXTLEN _ (TEXTLEN TEXTOBJ)) for old CHNO by 1 while (ILEQ CHNO TEXTLEN) while (SETQ CH (BIN TSTREAM)) do - (* ;; "Get CH's X width and maintain line ascent and descent.") + (* ;; "Get CH's width DX and maintain line ascent and descent.") - [SETQ DX (COND - ((SMALLP CH) (* ; "CH is a character") - (SELCHARQ CH - ((EOL LF CR FORM Meta,EOL) (* ; + (if (SMALLP CH) + then (* ; "CH is a character") + (SELCHARQ CH + ((EOL LF CR FORM Meta,EOL) (* ;  "The reader should coerce LF/CR to EOL") - - (* ;; + + (* ;;  " Force an end to the line. BIN shouldn't produce CR or LF. Should FORM do morein display mode? ") (* ;; "If the EOL is the only character on the line, we want to use the current font's ascent/descent. But if only preceded by objects, use the objects values.") - (* ;; - "The minimum width (N?) is so that the terminator can be selected") + (* ;; + "The minimum width (M?) is so that the terminator can be selected") - [SETQ DX (IMAX (\FGETCHARWIDTH FONT (CHARCODE N)) - (\FGETCHARWIDTH FONT (CHARCODE EOL] - (FILLCHARSLOT CHARSLOT (CL:IF (EQ CH (CHARCODE FORM)) - (CHARCODE FORM) - (CHARCODE EOL)) - DX) - (CL:UNLESS (EQ CH (CHARCODE Meta,EOL)) - (SETQ FORCED-END (CL:IF (MEMB CH (CHARCODE (LF CR))) - (CHARCODE EOL) - CH))) - (* ; - "Remember whether EOL, FORM, but not") - (FORCEBREAK) + [SETQ DX (IMAX (\FGETCHARWIDTH FONT (CHARCODE M)) + (\FGETCHARWIDTH FONT (CHARCODE EOL] + (FILLCHARSLOT CHARSLOT (CL:IF (EQ CH (CHARCODE FORM)) + (CHARCODE FORM) + (CHARCODE EOL)) + DX) + (SETQ FORCED-END (CL:IF (MEMB CH (CHARCODE (LF CR))) + (CHARCODE EOL) + CH)) + (FORCEBREAK) (* ;; "The break does not set the ascent/descent, the rest of the line does that. If the line is empty except for an EOL, the font's ASCENTC is stuck in at the end. This is important for hardcopydisplay.") - (RETURN)) - NIL) - (SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS ASCENTC OFFSET))) - (SETQ TRUEDESCENT (IMAX TRUEDESCENT (IDIFFERENCE DESCENTC OFFSET))) - (\FGETCHARWIDTH FONT CH)) - (T (* ; "CH is an object, get its size.") + (RETURN)) + NIL) + (SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS ASCENTC OFFSET))) + (SETQ TRUEDESCENT (IMAX TRUEDESCENT (IDIFFERENCE DESCENTC OFFSET))) + (CL:WHEN HASKERN - (* ;; "If this isn't TRUEHARDCOPY, we want to do the imageobject in the displaystream with displaystream coordinates, because we don't know what internal size computations the imageobject might make based on its displaystream and fonts. But we do have to down-scale WIDTH (right margin) back to the units of the display stream.") + (* ;; "Unlikely for display--probably backs it up. The idea is to back up the starting point of CH by backing off the end of the previous character. We stick the kern inline so that various consumers (displayline, scanline...) can make the adjustments.") - (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) - CH - (CL:IF (EQ LINETYPE 'TRUEHARDCOPY) - IMAGESTREAM - DISPLAYSTREAM) - TX - (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) - (HCUNSCALE SCALE WIDTH) - WIDTH))) - (IMAGEOBJPROP CH 'BOUNDBOX BOX) - (SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE - (fetch (IMAGEBOX YSIZE) - of BOX) - (fetch (IMAGEBOX YDESC) - of BOX)) - OFFSET))) - (SETQ TRUEDESCENT (IMAX TRUEDESCENT (IDIFFERENCE (fetch (IMAGEBOX - YDESC) - of BOX) - OFFSET))) - (SETQ DX (IPLUS (fetch (IMAGEBOX XSIZE) of BOX) - (fetch (IMAGEBOX XKERN) of BOX))) + (SETQ KERN (\FGETLEFTKERN FONT PREVCH CH)) + (PUSHCHAR CHARSLOT 'KERN KERN) + (add DX KERN)) + (SETQ DX (\FGETCHARWIDTH FONT CH)) + (SETQ PREVCH CH) + else (* ; "CH is an object, get its size.") - (* ;; - "The external DX has to be upscaled from its displaystream coordinates. ") + (* ;; "If this isn't TRUEHARDCOPY, we want to do the imageobject in the displaystream with displaystream coordinates, because we don't know what internal size computations the imageobject might make based on its displaystream and fonts. But we do have to down-scale WIDTH (right margin) back to the units of the display stream.") - (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) - (HCSCALE SCALE DX) - DX)] - (CL:WHEN KERN (* ; "Unlikely for display") - (add DX KERN)) + (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) + CH BOXSTREAM TX (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) + (SCALEDOWN SCALE WIDTH) + WIDTH))) + (IMAGEOBJPROP CH 'BOUNDBOX BOX) + (SETQ TRUEASCENT (IMAX TRUEASCENT (IPLUS (IDIFFERENCE (fetch (IMAGEBOX YSIZE) + of BOX) + (fetch (IMAGEBOX YDESC) + of BOX)) + OFFSET))) + (SETQ TRUEDESCENT (IMAX TRUEDESCENT (IDIFFERENCE (fetch (IMAGEBOX YDESC) + of BOX) + OFFSET))) + (SETQ DX (IPLUS (fetch (IMAGEBOX XSIZE) of BOX) + (fetch (IMAGEBOX XKERN) of BOX))) + (CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) + (* ; + "Upscale DX from its display width. ") + (SETQ DX (SCALEUP SCALE DX))) + (SETQ PREVCH NIL)) [SELCHARQ CH (SPACE (* ;; "White space and EOL can overhang the right margin, but no visible character can. The only white-space leading a line must follow an [EOL]") @@ -924,7 +995,7 @@ (* ;  "Start with 0 width, then set up the next tab") (FILLCHARSLOT CHARSLOT CH 0) - (SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 + (SETQ TABPENDING (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE CHARSLOT LX1 TX TABPENDING)) (* ;  "Proper width is already in CHARSLOT") @@ -992,7 +1063,8 @@ (* ;; "We've seen at least one real character, line is not empty, but no good candidate break point. Back up to the last legal break (or add a real hyphenator). ") - (CL:UNLESS (\TEDIT.FORMATLINE.LASTLEGAL) + (CL:UNLESS (\TEDIT.FORMATLINE.LASTLEGAL THISLINE CH#1 LINETYPE + IMAGESTREAM) (* ;; "Didn't find one, the offender protrudes on this line") @@ -1021,7 +1093,7 @@ DX) (* ;  "Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.") (SETQ TABPENDING - (\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 + (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE CHARSLOT LX1 TX TABPENDING T)) (* ;  "Tab over to the LEFT side of the decimal point.") @@ -1042,8 +1114,8 @@ (CL:WHEN (EQ CH (CHARCODE SOFT-HYPHEN)) (SETQ PREVDHYPH CHARSLOT) (* ; - "Discretionary hyphen may become invisible") - (SETQ CH (CHARCODE)) + "Discretionary hyphen may be flushed") + (SETQ CH (CHARCODE -)) (* ;  "Otherwise, it shows as a real hyphen") (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE "-")))) @@ -1091,15 +1163,15 @@ (* ;; "End of character loop. ") (freplace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT)) - (freplace (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM with NIL) + (freplace (TEXTSTREAM APPLYLOOKSUPDATEFN) of TSTREAM with NIL) (* ;; "Fix up last tab?") (CL:WHEN TABPENDING (SETQ PREVSP (\TEDIT.FORMATLINE.PURGE.SPACES PREVSP)) (* ; "Don't justify spaces before tabs") - (add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ TABSPEC SCALE (FETCH (PENDINGTAB PTCHARSLOT) - OF TABPENDING) + (add TX (\TEDIT.FORMATLINE.TABS TEXTOBJ FMTSPEC SCALE (fetch (PENDINGTAB PTCHARSLOT) + of TABPENDING) LX1 (IDIFFERENCE TX OVERHANG) TABPENDING T))) @@ -1110,7 +1182,7 @@  "All the line information is now in our variables. Migrate to the LINE and THISLINE fields. ") (FSETLD LINE LCHAR1 CH#1) - (FSETLD LINE LCHARLIM CHNO) + (FSETLD LINE LCHARLAST CHNO) (FSETLD LINE LX1 LX1) (* ;  "Still maybe scaled for hardcopy display") (FSETLD LINE LXLIM (IPLUS LX1 TX)) @@ -1121,27 +1193,27 @@ (* ;; "For display, the value of LMARK (GREY) just causes the little grey box to show up in the left margin, but is not interpreted in any other way. The hardcopy code uses this field for other purposes.") (FSETLD LINE LMARK (CL:WHEN [AND 1STLN (NEQ LINETYPE 'TRUEHARDCOPY) - (OR (EQ (fetch FMTPARATYPE of FMTSPEC) + (OR (EQ (FGETPARA FMTSPEC FMTPARATYPE) 'PAGEHEADING) - (fetch FMTNEWPAGEBEFORE of FMTSPEC) - (fetch FMTNEWPAGEAFTER of FMTSPEC) - [AND (fetch FMTSPECIALX of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALX of FMTSPEC] - (AND (fetch FMTSPECIALY of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALY of FMTSPEC] + (FGETPARA FMTSPEC FMTNEWPAGEBEFORE) + (FGETPARA FMTSPEC FMTNEWPAGEAFTER) + [AND (FGETPARA FMTSPEC FMTSPECIALX) + (NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX] + (AND (FGETPARA FMTSPEC FMTSPECIALY) + (NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALY] 'GREY)) (FSETLD LINE FORCED-END FORCED-END) - (FSETLD LINE LHASPROT PROTECTED) (FSETLD LINE LEFTMARGIN (CL:IF 1STLN - (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) - (fetch (FMTSPEC LEFTMAR) of FMTSPEC))) + (FGETPARA FMTSPEC 1STLEFTMAR) + (FGETPARA FMTSPEC LEFTMAR))) (FSETLD LINE RIGHTMARGIN RIGHTMARGIN) (CL:UNLESS FONT (* ;; "Use TEXTOBJ defaults if empty charlooks. Maybe this never happens?") (SETQ FONT (FONTCOPY (OR (AND (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) - (fetch CLFONT of (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))) + (FGETCLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + CLFONT)) DEFAULTFONT) 'DEVICE IMAGESTREAM))) (CL:WHEN (EQ -1 TRUEASCENT) (* ; "Blank or only ") @@ -1160,18 +1232,18 @@ (FSETLD LINE LTEXTSTREAM TSTREAM)) (freplace (THISLINE DESC) of THISLINE with LINE) - (\TEDIT.FORMATLINE.VERTICAL LINE TSTREAM) + (\TEDIT.FORMATLINE.VERTICAL LINE TEXTOBJ) (\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ;; "Finally translate to the left edge, perhsps a specialx if true hardcopy.") (CL:WHEN [AND (EQ LINETYPE 'TRUEHARDCOPY) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC] + (FGETPARA FMTSPEC FMTSPECIALX) + (NOT (ZEROP (FGETPARA FMTSPEC FMTSPECIALX] (* ;; "Maybe SETQ instead of add ??") - (add WMARGIN (ffetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) + (add WMARGIN (FGETPARA FMTSPEC FMTSPECIALX))) (add (FGETLD LINE LEFTMARGIN) WMARGIN) (add (FGETLD LINE RIGHTMARGIN) @@ -1180,53 +1252,74 @@ WMARGIN) (add (FGETLD LINE LXLIM) WMARGIN) + + (* ;; "Restore TSTREAM to its condition before any BIN's we might have done.") + + (FSETTOBJ TEXTOBJ CARETLOOKS OLDCARETLOOKS) + (CL:WHEN OLDPIECE + (\TEDIT.INSTALL.PIECE TSTREAM OLDPIECE (IDIFFERENCE (PLEN OLDPIECE) + OLDPCCHARSLEFT))) (RETURN LINE]) -(\TEDIT.FORMATLINE.SETUP - [LAMBDA (TEXTOBJ PC LINE IMAGESTREAM) (* ; "Edited 16-Dec-2023 23:34 by rmk") +(\TEDIT.FORMATLINE.SETUP.PARA + [LAMBDA (TEXTOBJ PC LINE IMAGESTREAM LINETYPE) (* ; "Edited 22-Nov-2024 11:14 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 4-Aug-2024 15:08 by rmk") + (* ; "Edited 28-Jul-2024 21:01 by rmk") + (* ; "Edited 16-Dec-2023 23:34 by rmk") (* ; "Edited 14-Jun-2023 16:43 by rmk") (* ; "Edited 8-Mar-2023 22:15 by rmk") (* ; "Edited 7-Mar-2023 16:52 by rmk") (* ; "Edited 6-Mar-2023 00:25 by rmk") (* ; "Edited 2-Mar-2023 12:06 by rmk") - (* ;; "The paragraph looks of a line are the same for every piece of every line in a paragraph, only the character looks can change from piece to piece. We retrieve the para looks from the starting piece, or the stream's default. ") + (* ;; "The paragraph looks of a line are the same for every piece of every line in a paragraph, only the character looks can change from piece to piece. We retrieve the para looks from the starting piece, or the stream's default. The possibly-modified FMTSPEC of PC is stored in LINE.") - (* ;; "The global variable *TEDIT-CACHED-FMTSPEC* is a heuristic optimization") + (* ;; "The global variable *TEDIT-CACHED-FMTSPEC* is a heuristic optimization to speed up construction of the FMTSPEC for successive lines in the same paragraph (or maybe even in a sequence of same-format paragraphs.") (* ;; "In hardcopy-display mode, the verticals (lineleading etc.) are in screen points, only the horizontals are upscaled according to the points-to-hardcopy scalefactor installed in the retrieved FMTSPEC.") (* ;; "See comments in TEDIT-LOOKSCOMS about the style-cache variables. Probably not completely or correctly coordinated with this code.") - (* ;; "The global variable *TEDIT-CACHED-FMTSPEC* offers a heuristic optimization to speed up construction of the FMTSPEC for successive lines in the same paragraph (or maybe even in a sequence of same-format paragraphs. ") - - (LET [(FMTSPEC (OR (AND PC (PPARALOOKS PC)) - (GETTOBJ TEXTOBJ FMTSPEC] - (SETQ FMTSPEC (\TEDIT.APPLY.PARASTYLES FMTSPEC PC TEXTOBJ)) - (if (NOT (DISPLAYSTREAMP IMAGESTREAM)) - then (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC FMTSPEC IMAGESTREAM)) - elseif (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) - then - (* ;; "Coerce the image stream and FMTSPEC for chracter-width scaling. ") + (TEXTOBJ! TEXTOBJ) + (LET ([PLOOKS (PARALOOKS! (PPARALOOKS (OR PC (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ LASTPIECE)) + (FGETTOBJ TEXTOBJ LASTPIECE] + SCALE) + (SETQ PLOOKS (\TEDIT.APPLY.PARASTYLES PLOOKS PC TEXTOBJ)) + (SELECTQ LINETYPE + (TRUEHARDCOPY (SETQ PLOOKS (\TEDIT.HCPYFMTSPEC PLOOKS IMAGESTREAM))) + (TRUEDISPLAY (CL:UNLESS (FGETPARA PLOOKS FMTHARDCOPYSCALE) + (FSETPARA PLOOKS FMTHARDCOPYSCALE 1))) + (HARDCOPYDISPLAY + (* ;; "Coerce the image stream and FMTSPEC for HARDCOPYDISPLAY.") [SETQ IMAGESTREAM (OR (FGETTOBJ TEXTOBJ DISPLAYHCPYDS) (FSETTOBJ TEXTOBJ DISPLAYHCPYDS (OPENIMAGESTREAM '{NODIRCORE} 'POSTSCRIPT] - (SETQ FMTSPEC (create FMTSPEC using FMTSPEC FMTHARDCOPYSCALE _ (DSPSCALE NIL - IMAGESTREAM)) - ) - elseif (NULL (fetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC)) - then (* ; "Should be done at create") - (replace (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC with 1)) - (CL:UNLESS (OR (EQ FMTSPEC *TEDIT-CACHED-FMTSPEC*) - (NOT (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC))) + (SETQ SCALE (DSPSCALE NIL IMAGESTREAM)) + [SETQ PLOOKS (create FMTSPEC using PLOOKS FMTHARDCOPYSCALE _ SCALE RIGHTMAR _ + (SCALEUP SCALE (FGETPARA PLOOKS RIGHTMAR)) + 1STLEFTMAR _ (SCALEUP SCALE (FGETPARA PLOOKS + 1STLEFTMAR)) + LEFTMAR _ (SCALEUP SCALE (FGETPARA PLOOKS + LEFTMAR)) + FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA PLOOKS + FMTTABS) + SCALE) + FMTDEFAULTTAB _ (SCALEUP SCALE (FGETPARA PLOOKS + + FMTDEFAULTTAB + ]) + (\TEDIT.THELP "BAD LINE TYPE" LINETYPE)) + (CL:UNLESS (OR (EQ PLOOKS *TEDIT-CACHED-FMTSPEC*) + (NOT (FGETPARA PLOOKS FMTCHARSTYLES))) (* ;; "The cache of styles for the current paragraph is invalid; flush it, and note the new paragraph to cache for.") (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) - (SETQ *TEDIT-CACHED-FMTSPEC* FMTSPEC)) - (SETLD LINE LFMTSPEC FMTSPEC) + (SETQ *TEDIT-CACHED-FMTSPEC* PLOOKS)) + (SETLD LINE LFMTSPEC PLOOKS) IMAGESTREAM]) (\TEDIT.FORMATLINE.HORIZONTAL @@ -1300,12 +1393,14 @@ NIL]) (\TEDIT.FORMATLINE.VERTICAL - [LAMBDA (LINE TEXTOBJ) (* ; "Edited 20-Mar-2024 07:26 by rmk") + [LAMBDA (LINE TEXTOBJ) (* ; "Edited 29-Oct-2024 11:07 by rmk") + (* ; "Edited 26-Oct-2024 10:26 by rmk") + (* ; "Edited 20-Mar-2024 07:26 by rmk") (* ; "Edited 17-Dec-2023 00:43 by rmk") (* ; "Edited 6-Dec-2023 20:13 by rmk") (* ; "Edited 4-Dec-2023 12:13 by rmk") - (* ;; "Sets up vertical-alignment parameters taking into account the line and paragraph leading specifications. The vertical parameters (line-leading etc.) have not been up-scaled and don't need to be down-scaled. For other modes the vertical dimensions are already appropriately scaled.") + (* ;; "Sets up vertical-alignment parameters taking into account the line and paragraph leading specifications. The vertical parameters (line-leading etc.) have not been up-scaled and don't need to be down-scaled") (* ;; "This calculates vertical sizes based on inherent line/paragraph parameters.It cannot deal with base-to-base positioning because that is context dependent, involving the position and descent of the previous line (\TEDIT.LINE.BOTTOM).") @@ -1313,21 +1408,20 @@ (ASCENT (FGETLD LINE LTRUEASCENT)) (DESCENT (FGETLD LINE LTRUEDESCENT))) (CL:WHEN (FGETLD LINE 1STLN LINE) (* ; "Set pre-paragraph leading") - (add ASCENT (ffetch (FMTSPEC LEADBEFORE) of FMTSPEC))) + (add ASCENT (FGETPARA FMTSPEC LEADBEFORE))) (CL:WHEN (FGETLD LINE LSTLN) (* ; "Set post-paragraph leading") - (add DESCENT (ffetch (FMTSPEC LEADAFTER) of FMTSPEC))) + (add DESCENT (FGETPARA FMTSPEC LEADAFTER))) - (* ;; "Documentation says that lineleading goes above, which automatically makes for reasonable selection marking. It went below in the original implementation, selections were very odd for large line leadings. This flag is set to T when recently created files are loaded, we try to preserve the old (bad) behavior for older files.") + (* ;; "Documentation says that lineleading goes above the line, which automatically makes for reasonable selection marking. It went below in the original implementation, selections were very odd for large line leadings. Documentation also says that the lineleading is added to the paragraph leading, so we add it to the ascent even of the 1STLN. I.e. it is not just between-the-lines spacing.") - (CL:IF (FGETTOBJ TEXTOBJ TXTLINELEADINGABOVE) - (add ASCENT (fetch (FMTSPEC LINELEAD) of FMTSPEC)) - (add DESCENT (fetch (FMTSPEC LINELEAD) of FMTSPEC))) - (FSETLD LINE ASCENT ASCENT) - (FSETLD LINE DESCENT DESCENT) + (add ASCENT (FGETPARA FMTSPEC LINELEAD)) + (FSETLD LINE LASCENT ASCENT) + (FSETLD LINE LDESCENT DESCENT) (FSETLD LINE LHEIGHT (IPLUS ASCENT DESCENT]) (\TEDIT.FORMATLINE.JUSTIFY - [LAMBDA (LINE THISLINE PREVSP SPACELEFT LINETYPE) (* ; "Edited 7-Mar-2023 18:01 by rmk") + [LAMBDA (LINE THISLINE PREVSP SPACELEFT LINETYPE) (* ; "Edited 4-Aug-2024 11:43 by rmk") + (* ; "Edited 7-Mar-2023 18:01 by rmk") (* ; "Edited 2-Mar-2023 22:45 by rmk") (* ; "Edited 22-Oct-2022 00:06 by rmk") (* ; "Edited 29-Mar-94 12:36 by jds") @@ -1395,14 +1489,17 @@ (* ;; "The \DISPLAYLINE for displaystreams does its own (Maiko) BLTCHAR, so the TLSPACEFACTOR isn't actually used for display, but hardcopy streams make use of it.") - (add (ffetch (LINEDESCRIPTOR LXLIM) of LINE) + (add (FGETLD LINE LXLIM) SPACELEFT) (freplace (THISLINE TLSPACEFACTOR) of THISLINE with (FQUOTIENT (IPLUS NATURALWIDTHS SPACELEFT) NATURALWIDTHS))))]) (\TEDIT.FORMATLINE.TABS - [LAMBDA (TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP) + [LAMBDA (TEXTOBJ FMTSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP) + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 27-Aug-2024 18:29 by rmk") + (* ; "Edited 28-Jul-2024 20:49 by rmk") (* ; "Edited 17-Dec-2023 12:46 by rmk") (* ; "Edited 9-Mar-2023 23:25 by rmk") (* ; "Edited 5-Mar-2023 22:54 by rmk") @@ -1411,7 +1508,7 @@ (* ;; "PRIORTAB is the outstanding tab, if any, that has to be resolved. This will be a centered or flush right tab. ") - (* ;; "Specific tabs are relative to the true leftmargin; in that coordinate system the current position is LX1+TX (in properly scaled units. The TX entries in the prior tab are also in the scaled margin coordinate system. TABSPEC is also properly scaled.") + (* ;; "Specific tabs are relative to the true leftmargin; in that coordinate system the current position is LX1+TX (in properly scaled units. The TX entries in the prior tab are also in the scaled margin coordinate system. DEFTAB and TABS are also properly scaled.") (* ;; "") @@ -1431,7 +1528,9 @@ (add TX LX1) (* ; "Margin relative") (PROG (NEXTTAB NEXTTABTYPE NEXTTABX DFLTTABX GRAIN (PRIORTABWIDTH 0) - (THISTABWIDTH 0)) + (THISTABWIDTH 0) + (TABS (FGETPARA FMTSPEC FMTTABS)) + (DEFTAB (FGETPARA FMTSPEC FMTDEFAULTTAB))) (CL:WHEN PRIORTAB (* ;; "If there is a prior tab to resolve, do that first--it affects the perceived current X value, which affects later tabs") @@ -1452,7 +1551,7 @@ (* ; "Snug up against the tab X") (IDIFFERENCE TX (fetch (PENDINGTAB PTOLDTX) of PRIORTAB))) - (SHOULDNT))) + (\TEDIT.THELP))) (fetch (PENDINGTAB PTOLDTX) of PRIORTAB] (replace (CHARSLOT CHARW) of (fetch (PENDINGTAB PTCHARSLOT) of PRIORTAB) with PRIORTABWIDTH @@ -1461,24 +1560,22 @@ (CL:WHEN CLEANINGUP (* ; "Cleaning up at end of line.") (RETURN PRIORTABWIDTH)) (* ;  "Default Tab width, if there aren't any real tabs to use") - (SETQ NEXTTAB (find TAB in (CDR TABSPEC) suchthat (IGREATERP (fetch TABX of TAB) - TX))) + (SETQ NEXTTAB (find TAB in TABS suchthat (IGREATERP (fetch TABX of TAB) + TX))) (* ; "The next tab on this line, if any") (SETQ NEXTTABTYPE (OR (AND NEXTTAB (fetch TABKIND of NEXTTAB)) 'LEFT)) (* ;  "The type of the next tab is LEFT if we use the default spacing") - [SETQ NEXTTABX (COND - (NEXTTAB (* ; + [SETQ NEXTTABX (if NEXTTAB + then (* ;  "There is a real tab to go to; use its location.") - (fetch TABX of NEXTTAB)) - (T (SETQ DFLTTABX (OR (FIXP (CAR TABSPEC)) - DEFAULTTAB)) - (SETQ GRAIN (FOLDLO SCALE 2)) + (fetch TABX of NEXTTAB) + else (SETQ GRAIN (FOLDLO SCALE 2)) - (* ;; "No real tab; use the next multiple of the default spacing.") + (* ;; "No real tab; use the next multiple of the default spacing.") - (ITIMES DFLTTABX (ADD1 (IQUOTIENT (IPLUS GRAIN TX) - DFLTTABX] + (ITIMES DEFTAB (ADD1 (IQUOTIENT (IPLUS GRAIN TX) + DEFTAB] (* ; "The next tab's X value") (CL:WHEN (FMEMB NEXTTABTYPE '(DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL)) @@ -1505,26 +1602,22 @@ PTCHARSLOT _ CHARSLOT PTOLDTX _ TX]) -(\TEDIT.FORMATLINE.SCALETABS - [LAMBDA (TABSPEC SCALE) (* ; "Edited 7-Mar-2023 21:06 by rmk") +(\TEDIT.SCALE.TABS + [LAMBDA (TABS SCALE) (* ; "Edited 29-Jul-2024 14:36 by rmk") + (* ; "Edited 28-Jul-2024 10:11 by rmk") + (* ; "Edited 7-Mar-2023 21:06 by rmk") (* ; "Edited 5-Mar-2023 20:39 by rmk") (* ;; "Scales tab stops to hardcopy units (possibly hardcopy display)") - (CL:WHEN (type? FMTSPEC TABSPEC) - (SETQ TABSPEC (ffetch (FMTSPEC TABSPEC) of TABSPEC))) - (CL:UNLESS (CAR TABSPEC) - (SETQ TABSPEC (CONS DEFAULTTAB (CDR TABSPEC)))) - (if (EQ SCALE 1) - then TABSPEC - else (CONS (HCSCALE SCALE (CAR TABSPEC)) - (for TAB in (CDR TABSPEC) collect (create TAB using TAB TABX _ - (HCSCALE SCALE - (fetch (TAB TABX) - of TAB]) + (CL:IF (EQ SCALE 1) + TABS + [for TAB in TABS collect (create TAB using TAB TABX _ (HCSCALE SCALE (fetch (TAB TABX) + of TAB])]) (\TEDIT.FORMATLINE.PURGE.SPACES - [LAMBDA (PREVSP UNTILSP) (* ; "Edited 29-Oct-2023 19:11 by rmk") + [LAMBDA (PREVSP UNTILSP) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 29-Oct-2023 19:11 by rmk") (* ; "Edited 21-Mar-2023 11:28 by rmk") (* ; "Edited 10-Mar-2023 12:28 by rmk") (* jds " 9-NOV-83 17:12") @@ -1536,13 +1629,31 @@ (SETQ PREVSP (CHAR OPREVSP)) (CL:WHEN (SMALLP PREVSP) (* ; "Sanity check--shouldn't be 32") - (HELP 'PURGE PREVSP)) + (\TEDIT.THELP 'PURGE PREVSP)) (replace (CHARSLOT CHAR) of OPREVSP with (CHARCODE SPACE)))) PREVSP]) +(\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN + [LAMBDA (THISLINE PREVDHYPH CHARSLOT) (* ; "Edited 2-Sep-2024 16:09 by rmk") + + (* ;; "PREVDHYPH is the THISLINE character slot of a preceding soft hyphen that is now being discarded in favor of a later potential linebreak. This function purges it from THISLINE by moving the contents of all of the slots from the one after PREDVDHYPH backwards by one slot. The value is the new (one-back) last slot") + + (* ;; "THISLINE needed only to suppress unused reference in incharslots I.S.OPR.") + + (CL:WHEN PREVDHYPH + (for CS NEXT incharslots PREVDHYPH do (SETQ NEXT (NEXTCHARSLOT CS)) + (FILLCHARSLOT CS (CHAR NEXT) + (CHARW NEXT)) repeatuntil (EQ NEXT CHARSLOT) + finally (RETURN CS)))]) + (\TEDIT.FORMATLINE.EMPTY - [LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 15-Mar-2024 22:00 by rmk") + [LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 22-Nov-2024 22:29 by rmk") + (* ; "Edited 17-Nov-2024 16:00 by rmk") + (* ; "Edited 4-Aug-2024 14:51 by rmk") + (* ; "Edited 25-Jun-2024 14:51 by rmk") + (* ; "Edited 10-May-2024 00:24 by rmk") + (* ; "Edited 15-Mar-2024 22:00 by rmk") (* ; "Edited 26-Jan-2024 11:08 by rmk") (* ; "Edited 6-Dec-2023 20:15 by rmk") (* ; "Edited 3-Dec-2023 19:41 by rmk") @@ -1552,66 +1663,52 @@ (* ; "Edited 7-Mar-2023 23:11 by rmk") (* ; "Edited 5-Mar-2023 22:57 by rmk") (* ; "Edited 4-Mar-2023 21:40 by rmk") - - (* ;; "CH#1 is presumably beyond the end. This returns an empty line descriptor that is set up correctly wrt leading and font. This is used by \FILLPANE to create the dummy line at end of document when you hit an EOL there. (For safety, \FORMATLINE also calls this if CH#1 doesn't pick out a real piece.)") - (* ; ".") + (* ; "") (* ;; "NOTE: this follows the original in not distinguishing hardcopy-display mode. Presumably empty is empty, even thought the ASCENT/DESCENT/LHEIGHT are not scaled.") - (* ;; "Original code asked for the piece at TEXTLEN (last piece?) to get its looks, but those looks would be the TEXTOBJ default looks anyway. ") + (* ;; "Original code asked for the piece at TEXTLEN (last piece?) to get its looks, but those looks would be the TEXTOBJ default looks anyway. But it really wants to the looks of the preceding piece.") - (CL:UNLESS LINE - [SETQ LINE (create LINEDESCRIPTOR - RIGHTMARGIN _ (FGETTOBJ TEXTOBJ WRIGHT) - YBOT _ (SUB1 (FGETTOBJ TEXTOBJ WBOTTOM]) - (\DTEST LINE 'LINEDESCRIPTOR) - (LET (CHARSLOT FONT TRUEASCENT TRUEDESCENT LM FMTSPEC (THISLINE (FGETTOBJ TEXTOBJ THISLINE))) - (\TEDIT.FORMATLINE.SETUP TEXTOBJ NIL LINE (WINDOWPROP (CAR (FGETTOBJ TEXTOBJ \WINDOW)) - 'DSP)) - (SETQ FMTSPEC (FGETLD LINE LFMTSPEC)) - (SETQ CHARSLOT (FIRSTCHARSLOT THISLINE)) - (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT)) - (freplace (THISLINE DESC) of THISLINE with LINE) + (LINEDESCRIPTOR! LINE) + (LET (CHARSLOT FONT CLOOKS TRUEASCENT TRUEDESCENT LM PLOOKS (THISLINE (FGETTOBJ TEXTOBJ THISLINE) + )) + (\TEDIT.FORMATLINE.SETUP.PARA TEXTOBJ NIL LINE (WINDOWPROP (\TEDIT.PRIMARYPANE TEXTOBJ) + 'DSP) + 'TRUEDISPLAY) + (SETQ PLOOKS (FGETLD LINE LFMTSPEC)) - (* ;; "Get looks from the TSTREAM, so that \DISPLAYLINE works. ") + (* ;; "Get the current caret looks, so that LHEIGHT and \DISPLAYLINE work. Font preferences: the font of the previous piece, else the default (from the last piece). Previous code preferred the current caret looks, but that might have nothing to do with the end-of-document.") - (FILLCHARSLOT CHARSLOT NIL (OR (fetch (TEXTSTREAM CURRENTLOOKS) of (FGETTOBJ TEXTOBJ - STREAMHINT)) - (FGETTOBJ TEXTOBJ CARETLOOKS) - (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))) - - (* ;; "Not sure what might break if even an emptyTHISLINE doesn't start with charlooks. ") - - (* ;; - " Font preferences: the caret looks, else the default for this text, else the system default") - - (SETQ FONT (CL:IF (CHARW CHARSLOT) - (fetch CLFONT of (CHARW CHARSLOT)) - DEFAULTFONT)) + [SETQ CLOOKS (PCHARLOOKS (OR (\PREV.VISIBLE.PIECE (FGETTOBJ TEXTOBJ LASTPIECE)) + (FGETTOBJ TEXTOBJ LASTPIECE] + (SETQ FONT (GETCLOOKS CLOOKS CLFONT)) (SETQ TRUEASCENT (FONTPROP FONT 'ASCENT)) (SETQ TRUEDESCENT (FONTPROP FONT 'DESCENT)) (SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (FGETTOBJ TEXTOBJ WLEFT) - (fetch 1STLEFTMAR of FMTSPEC))) + (FGETPARA PLOOKS 1STLEFTMAR))) (with LINEDESCRIPTOR LINE (SETQ LDUMMY T) (SETQ LCHAR1 CH#1) - (SETQ LCHARLIM CH#1) + (SETQ LCHARLAST CH#1) (SETQ 1STLN T) (SETQ LSTLN T) (SETQ LMARK NIL) (SETQ LX1 LM) (SETQ LXLIM LM) (SETQ FORCED-END (CHARCODE EOL)) - (SETQ LDIRTY NIL) (SETQ LHASPROT NIL) - (SETQ LFMTSPEC FMTSPEC) + (SETQ LFMTSPEC PLOOKS) (SETQ LEFTMARGIN LM) - (SETQ RIGHTMARGIN (CL:IF (ZEROP (fetch RIGHTMAR of FMTSPEC)) + (SETQ RIGHTMARGIN (CL:IF (ZEROP (FGETPARA PLOOKS RIGHTMAR)) (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) \TEDIT.LINEREGION.WIDTH) - (fetch RIGHTMAR of FMTSPEC))) + (FGETPARA PLOOKS RIGHTMAR))) (SETQ LTRUEASCENT TRUEASCENT) (SETQ LTRUEDESCENT TRUEDESCENT) (SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT))) + (SETQ CHARSLOT (FIRSTCHARSLOT THISLINE)) + (FILLCHARSLOT CHARSLOT NIL CLOOKS) + (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT)) + (freplace (THISLINE DESC) of THISLINE with LINE) (* ;; "Just to initialize the rest of the fields--no intended transformations.") @@ -1620,7 +1717,11 @@ LINE]) (\TEDIT.FORMATLINE.UPDATELOOKS - [LAMBDA (TSTREAM PC) (* ; "Edited 17-Mar-2024 11:08 by rmk") + [LAMBDA (TSTREAM PC) (* ; "Edited 13-Dec-2024 17:09 by rmk") + (* ; "Edited 4-Aug-2024 15:09 by rmk") + (* ; "Edited 28-Jul-2024 20:52 by rmk") + (* ; "Edited 9-May-2024 10:28 by rmk") + (* ; "Edited 17-Mar-2024 11:08 by rmk") (* ; "Edited 15-Mar-2024 19:34 by rmk") (* ; "Edited 24-Dec-2023 22:54 by rmk") (* ; "Edited 23-Dec-2023 20:37 by rmk") @@ -1637,20 +1738,13 @@ (* ;; "Style sheets are undocumented, I suspect that this was never really thought through.") - (DECLARE (USEDFREE LINETYPE CHARSLOT CHNO PROTECTED OFFSET ASCENTC DESCENTC FONT IMAGESTREAM KERN + (DECLARE (USEDFREE LINETYPE CHARSLOT CHNO OFFSET ASCENTC DESCENTC FONT IMAGESTREAM HASKERN UNBREAKABLE)) (CL:UNLESS PC (* ;  "Ran off the end ? Skips the ENDOFSTREAMOP") (RETFROM (FUNCTION \TEDIT.TEXTBIN) NIL)) - (LET (PLOOKS INVISIBLERUN SCALE CLOFFSET) - - (* ;; "") - - (* ;; "We have to adjust the CHNO to pass over invisible pieces, and to record the number of characters we passed over in THISLINE's character vector. This maintains the correspondence between the indexing of actual characters in the vector and characters positions in the stream. This information isn't need for display, but TEDIT.SCAN.LINE requires that mapping.") - - (* ;; "Invisible runs are coded in a character slot, like other non-character entries (looks, objects) by putting a NIL in the CHAR field of a slot and putting the non-character information in the CHARWIDTH field. Thus, an invisible run is represented as a pair (NIL,runlength).") - + (LET (PLOOKS INVISIBLERUN CLOFFSET) (SETQ INVISIBLERUN (for old PC inpieces PC until (VISIBLEPIECEP PC) sum (PLEN PC))) (if (EQ 0 INVISIBLERUN) @@ -1658,15 +1752,16 @@ (* ;; "If the looks are the same as current looks, we don't need to change anything. APPLY STYLES AT PIECE CREATION??") (SETQ PLOOKS (PLOOKS PC)) - (CL:UNLESS (EQ PLOOKS (ffetch (TEXTSTREAM CURRENTLOOKS) of TSTREAM)) - (freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with PLOOKS) + (CL:UNLESS (EQ PLOOKS (FGETTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + CARETLOOKS)) + (FSETTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + CARETLOOKS PLOOKS) (* ;; "") - (SETQ OFFSET (OR (ffetch (CHARLOOKS CLOFFSET) of PLOOKS) + (SETQ OFFSET (OR (FGETCLOOKS PLOOKS CLOFFSET) 0)) - (SETQ FONT (fetch (CHARLOOKS CLFONT) of PLOOKS)) - (* ; + (SETQ FONT (FGETCLOOKS PLOOKS CLFONT)) (* ;  "CLFONT is a display font or a class") [if (EQ LINETYPE 'TRUEHARDCOPY) then (SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)) @@ -1674,49 +1769,30 @@ (SETQ ASCENTC (ffetch \SFAscent of FONT)) (SETQ DESCENTC (ffetch \SFDescent of FONT)) (CL:UNLESS (EQ OFFSET 0) - (SETQ OFFSET (HCSCALE (DSPSCALE NIL IMAGESTREAM) + (SETQ OFFSET (SCALEUP (DSPSCALE NIL IMAGESTREAM) OFFSET))) else (CL:WHEN (type? FONTCLASS FONT) (* ; "Display widths and verticals") (SETQ FONT (FONTCOPY FONT 'DEVICE 'DISPLAY))) - (SETQ ASCENTC (ffetch \SFAscent of FONT)) + (SETQ ASCENTC (ffetch \SFAscent of FONT)) + (* ; "ASCENT before switching fonts") (SETQ DESCENTC (ffetch \SFDescent of FONT)) (CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) (* ; "Switch widths to hardcopy") (SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)))] - - (* ;; "") - - (SETQ UNBREAKABLE (fetch (CHARLOOKS CLUNBREAKABLE) of PLOOKS)) - (SETQ KERN (LISTGET (ffetch (CHARLOOKS CLUSERINFO) of PLOOKS) - 'KERN)) - - (* ;; "Apparently, KERN's are given in display points, which seems odd. So here we scale up. Is there just a single kern value? Very strange.") - - (CL:WHEN KERN - (SETQ KERN (HCSCALE (DSPSCALE NIL IMAGESTREAM) - KERN))) - (STREAMPROP TSTREAM 'KERN KERN) - (CL:WHEN (ffetch (CHARLOOKS CLPROTECTED) of PLOOKS) - (* ; - "Mark the line as containing protected text") - (SETQ PROTECTED T)) + (SETQ HASKERN NIL) (* ; + "Set to T if FONT contains left-kern information") + (SETQ UNBREAKABLE (FGETCLOOKS PLOOKS CLUNBREAKABLE)) (PUSHCHAR CHARSLOT NIL PLOOKS)) - (CL:UNLESS T + else + (* ;; "Adjust the CHNO to pass over invisible pieces--they don't show up in the THISLINE vector or on the screen. Then recurse to here for the next visible piece.") - (* ;; "This (with higher spevars for FMTSPEC and TABSPEC) would allow tabspecs to change across a paragraph. But then what should the paragraph-looks menu show?") - - (EQ FMTSPEC (PPARALOOKS PC)) - (SETQ FMTSPEC (PPARALOOKS PC)) - (SETQ TABSPEC (ffetch (FMTSPEC TABSPEC) of FMTSPEC)) - (CL:WHEN (EQ LINETYPE 'TRUEHARDCOPY) - (SETQ TABSPEC (\TEDIT.FORMATLINE.SCALETABS TABSPEC (DSPSCALE NIL - IMAGESTREAM))))) - else (add CHNO INVISIBLERUN) + (add CHNO INVISIBLERUN) (\TEDIT.INSTALL.PIECE TSTREAM PC 0)) PC]) (\TEDIT.FORMATLINE.LASTLEGAL - [LAMBDA NIL (* ; "Edited 1-Feb-2024 16:51 by rmk") + [LAMBDA (THISLINE CH#1 LINETYPE IMAGESTREAM) (* ; "Edited 25-Jun-2024 15:44 by rmk") + (* ; "Edited 1-Feb-2024 16:51 by rmk") (* ; "Edited 2-Jul-2023 14:39 by rmk") (* ; "Edited 17-Mar-2023 05:36 by rmk") @@ -1729,8 +1805,7 @@ (* ;; "Once we find the break point, we have to sweep through from the beginning in order to accurately know the lines ascent and descent at the break point.") - (DECLARE (USEDFREE THISLINE TX CHNO CHARSLOT TRUEASCENT TRUEDESCENT LINETYPE IMAGESTREAM - TABPENDING)) + (DECLARE (USEDFREE TX CHNO CHARSLOT TRUEASCENT TRUEDESCENT TABPENDING)) (LET [(BESTSLOT (find SLOT PCS backcharslots (PREVCHARSLOT! CHARSLOT) suchthat (CL:WHEN (AND TABPENDING (EQ SLOT (fetch (PENDINGTAB PTCHARSLOT) of TABPENDING))) @@ -1768,36 +1843,45 @@ T)]) (\TEDIT.LINES.ABOVE - [LAMBDA (TEXTOBJ CHN YBOTN) (* ; "Edited 15-Mar-2024 19:22 by rmk") + [LAMBDA (TSTREAM CHN BOTTOMY) (* ; "Edited 24-Nov-2024 11:47 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 16:02 by rmk") + (* ; "Edited 2-Nov-2024 23:21 by rmk") + (* ; "Edited 28-Oct-2024 16:14 by rmk") + (* ; "Edited 27-Oct-2024 00:05 by rmk") + (* ; "Edited 13-Jun-2024 17:03 by rmk") + (* ; "Edited 18-May-2024 10:10 by rmk") + (* ; "Edited 3-May-2024 23:33 by rmk") + (* ; "Edited 15-Mar-2024 19:22 by rmk") (* ; "Edited 5-Apr-2023 09:13 by rmk") (* ; "Edited 1-Apr-2023 12:02 by rmk") (* ; "Edited 30-May-91 23:02 by jds") - (* ;; "Produces a chain of formatted lines where LCHAR1 of the first one either starts a paragraph or comes immediately after a forced end. LN, the last line of the chain includes CHN. The LCHAR's and X positions are good, and their Y positions are set relative to YBOTN, the intended YBOT of LN. ") + (* ;; "Produces a chain of formatted lines where LCHAR1 of the first one either starts a paragraph or comes immediately after a forced end. LN, the last line of the chain includes CHN. The LCHAR's and X positions are good, and their Y positions are set relative to BOTTOMY, if provided. This is the intended YBOT of LN. ") (* ;; "We assume this is not called on an empty text (TEXTLEN = 0), since we wouldn't know what to return. Caller should check that.") - (CL:WHEN (IGREATERP CHN (TEXTLEN TEXTOBJ)) - (SETQ CHN (TEXTLEN TEXTOBJ))) - (CL:UNLESS YBOTN (SETQ YBOTN 0)) - (bind L1 LN LINE HEIGHT (CHNO _ (\TEDIT.PREVIOUS.LINEBREAK TEXTOBJ CHN)) - first (SETQ L1 (\TEDIT.FORMATLINE TEXTOBJ CHNO)) (* ; - "CHNO is the first char of the top line") - (SETQ LN L1) - (SETQ CHNO (ADD1 (GETLD L1 LCHARLIM))) until (IGREATERP CHNO CHN) - do (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ CHNO)) (* ; - "The line immediately after a preceding known break") - (LINKLD LN LINE) - (SETQ LN LINE) - (SETQ CHNO (ADD1 (GETLD LINE LCHARLIM))) finally + (bind LTOP LBOT LINE HEIGHT CHNO (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) + first (CL:WHEN (IGREATERP CHN (TEXTLEN TEXTOBJ)) + (SETQ CHN (TEXTLEN TEXTOBJ))) + (SETQ CHNO (\TEDIT.PREVIOUS.LINEBREAK TSTREAM CHN)) + (* ; "The end-of-line character") + (SETQ LTOP (\TEDIT.FORMATLINE TSTREAM CHNO)) (* ; "A line containiing only the EOL") + (SETQ LBOT LTOP) + (SETQ CHNO (FGETLD LTOP LCHARLIM)) until (IGREATERP CHNO CHN) + do (SETQ LINE (\TEDIT.FORMATLINE TSTREAM CHNO)) + (LINKLD LBOT LINE) + (SETQ LBOT LINE) + (SETQ CHNO (FGETLD LINE LCHARLIM)) finally - (* ;; - "Fill in the YBOT's, given that YBOTN is the YBOT of LN.") + (* ;; + "We now have the line chain, but they aren't positioned. Set the YBOT of LBOT to BOTTOMY") - (for L (YB _ YBOTN) backlines LN - do (SETYPOS L YB) - (add YB (GETLD L LHEIGHT))) - (RETURN (LIST L1 LN]) + (CL:WHEN BOTTOMY + (for L (YB _ BOTTOMY) backlines LBOT + do (SETYBOT L YB) + (add YB (FGETLD L LHEIGHT)))) + (RETURN (CONS LTOP LBOT]) ) (RPAQ? TEDIT.LINELEADING.BELOW NIL) @@ -1807,32 +1891,21 @@ ) (DEFINEQ -(\CLEARTHISLINE - [LAMBDA (THISLINE) (* ; "Edited 7-Nov-2022 10:09 by rmk") - - (* ;; "This sets it up for a consistency checker to determine that something has gone wrong. Only called in an assertion.") - - (create THISLINE smashing THISLINE DESC _ 'NODESC TLSPACEFACTOR _ 'NOSPACEFACTOR TLFIRSTSPACE _ - 'NOTLFIRSTSPACE NEXTAVAILABLECHARSLOT _ (FIRSTCHARSLOT THISLINE)) - (for CHARSLOT _ (FIRSTCHARSLOT THISLINE) - (LASTCHARSLOT _ (LASTCHARSLOT THISLINE)) until (EQ CHARSLOT LASTCHARSLOT) - do (PUSHCHAR CHARSLOT 'BADCHAR 'BADCHARW)) - THISLINE]) - (\TLVALIDATE - [LAMBDA (THISLINE) (* ; "Edited 15-Mar-2024 19:33 by rmk") + [LAMBDA (THISLINE) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 15-Mar-2024 19:33 by rmk") (* ; "Edited 7-Nov-2022 10:16 by rmk") (* ;; "Check validity of THISLINE, either just before or anytime after \TEDIT.FORMATLINE.JUSTIFY") [with THISLINE THISLINE (CL:WHEN (EQ DESC 'NODESC) - (HELP "INVALID THISLINE" DESC)) + (\TEDIT.THELP "INVALID THISLINE" DESC)) (CL:WHEN (EQ TLSPACEFACTOR 'NOSPACEFACTOR) - (HELP "INVALID THISLINE" TLSPACEFACTOR)) + (\TEDIT.THELP "INVALID THISLINE" TLSPACEFACTOR)) (CL:WHEN (EQ TLFIRSTSPACE 'NOTLFIRSTSPACE) - (HELP "INVALID THISLINE" TLFIRSTSPACE)) + (\TEDIT.THELP "INVALID THISLINE" TLFIRSTSPACE)) (CL:UNLESS (CHARSLOTP NEXTAVAILABLECHARSLOT THISLINE) - (HELP "INVALID THISLINE" 'NEXTAVAILABLE))] + (\TEDIT.THELP "INVALID THISLINE" 'NEXTAVAILABLE))] (for CHARSLOT incharslots THISLINE do (if CHAR then (CL:UNLESS (OR (SMALLP CHAR) (CHARSLOTP CHAR THISLINE)) @@ -1840,12 +1913,12 @@ (* ;;  "CHARSLOTP if spaces haven't been instantiated") - (HELP "INVALID THISLINE" 'BADCHAR)) + (\TEDIT.THELP "INVALID THISLINE" 'BADCHAR)) (CL:UNLESS (SMALLP CHARW) - (HELP "INVALID THISLINE" 'BADCHARW)) + (\TEDIT.THELP "INVALID THISLINE" 'BADCHARW)) elseif (OR (SMALLP CHARW) (type? CHARLOOKS CHARW)) - else (HELP "INVALID THISLINE" 'BADCHARW]) + else (\TEDIT.THELP "INVALID THISLINE" 'BADCHARW]) ) @@ -1866,7 +1939,17 @@ (DEFINEQ (\TEDIT.DISPLAYLINE - [LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 20-Mar-2024 10:57 by rmk") + [LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 13-Dec-2024 23:51 by rmk") + (* ; "Edited 11-Dec-2024 23:14 by rmk") + (* ; "Edited 31-Oct-2024 09:56 by rmk") + (* ; "Edited 26-Oct-2024 10:43 by rmk") + (* ; "Edited 25-Aug-2024 23:18 by rmk") + (* ; "Edited 23-Aug-2024 22:52 by rmk") + (* ; "Edited 19-Jul-2024 23:17 by rmk") + (* ; "Edited 28-Jun-2024 11:43 by rmk") + (* ; "Edited 13-Jun-2024 17:08 by rmk") + (* ; "Edited 10-May-2024 00:24 by rmk") + (* ; "Edited 20-Mar-2024 10:57 by rmk") (* ; "Edited 15-Mar-2024 22:04 by rmk") (* ; "Edited 24-Dec-2023 22:05 by rmk") (* ; "Edited 2-Dec-2023 11:34 by rmk") @@ -1881,14 +1964,13 @@ (* ; "Edited 9-Mar-2023 14:06 by rmk") (* ; "Edited 7-Mar-2023 23:11 by rmk") - (* ;; "Display the line of text LINE in the edit window where it belongs.") + (* ;; "Display the line of text LINE in the edit window where it belongs. This constructs the line image in a scratch bitmap then copies it to PANE. Presumably this is to avoid the flicker of incremental updates.") (* ;; "Validate the incoming arguments so ffetch can be used consistently for all their field extractions.") (TEXTOBJ! TEXTOBJ) (\DTEST LINE 'LINEDESCRIPTOR) - (LET ((WINDOWDS (WINDOWPROP (FGETPANE PANE PWINDOW) - 'DSP)) + (LET ((WINDOWDS (WINDOWPROP PANE 'DSP)) (THISLINE (\DTEST (FGETTOBJ TEXTOBJ THISLINE) 'THISLINE)) (OLDCACHE (fetch (LINECACHE LCBITMAP) of (FGETTOBJ TEXTOBJ DISPLAYCACHE))) @@ -1915,23 +1997,21 @@ HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) DS)) (BLTSHADE WHITESHADE CACHE 0 0 NIL NIL 'REPLACE) (* ; "Clear the line cache") - (CL:WHEN [AND (IGEQ (FGETLD LINE LCHAR1) + (CL:WHEN (AND (IGEQ (FGETLD LINE LCHAR1) 1) (ILEQ (FGETLD LINE LCHAR1) - (FGETTOBJ TEXTOBJ TEXTLEN)) - (OR (IGEQ (FGETLD LINE YBOT) - (FGETTOBJ TEXTOBJ WBOTTOM)) - (IGREATERP LHEIGHT (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE] + (FGETTOBJ TEXTOBJ TEXTLEN))) - (* ;; "Only display the line if it contains text (CHAR1 > 0), appears before the end of the text, and is on-screen. Also display clipped lines if they are bigger than the window") + (* ;; "Only display the line if it contains text (CHAR1 > 0), appears before the end of the text. Original code also suppressed lines that were partially off-screen, which meant that large bitmaps wouldn't show.") (CL:UNLESS (EQ LINE (fetch (THISLINE DESC) of THISLINE)) (* ;  "No image cache -- re-format and display") - (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) + (FGETLD LINE LCHAR1) LINE)) (MOVETO (FGETLD LINE LX1) - (FGETLD LINE DESCENT) + (FGETLD LINE LDESCENT) DS) (SETQ DISPLAYDATA (ffetch (STREAM IMAGEDATA) of DS)) (* ; @@ -1961,8 +2041,8 @@ (SELCHARQ CHAR ((TAB Meta,TAB) (CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB)) - (ffetch CLLEADER of CLOOKS) - (EQ (ffetch CLUSERINFO of CLOOKS) + (FGETCLOOKS CLOOKS CLLEADER) + (EQ (FGETCLOOKS CLOOKS CLUSERINFO) 'DOTTEDLEADER)) (* ;; "Not just white space, have to fill in with dots.") @@ -1981,14 +2061,14 @@  "Make the displaystream reflect our current X position") (CL:WHEN CLOOKS (* ;  "Underline/overline/strike the just-finished looks run") - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS CLOOKS (FGETLD LINE - DESCENT))) + (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS CLOOKS (FGETLD LINE + LDESCENT))) (SETQ CLOOKS CHARW) - (DSPFONT (ffetch CLFONT of CLOOKS) + (DSPFONT (FGETCLOOKS CLOOKS CLFONT) DS) - (CL:UNLESS (EQ 0 (ffetch CLOFFSET of CLOOKS)) + (CL:UNLESS (EQ 0 (FGETCLOOKS CLOOKS CLOFFSET)) (* ; "Account for super/subscripting") - (RELMOVETO 0 (ffetch CLOFFSET of CLOOKS) + (RELMOVETO 0 (FGETCLOOKS CLOOKS CLOFFSET) DS)) (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)))) (PROGN (if (IMAGEOBJP CHAR) @@ -2000,7 +2080,7 @@ CURY DS) (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) CHAR DS 'DISPLAY (FGETTOBJ TEXTOBJ STREAMHINT)) - (DSPFONT (ffetch CLFONT of CLOOKS) + (DSPFONT (FGETCLOOKS CLOOKS CLFONT) DS) (* ;  "Restore the character font, move to just after the object.") (MOVETO (IDIFFERENCE TX XOFFSET) @@ -2013,6 +2093,8 @@ CHARSLOT THISLINE DS)) DISPLAYDATA DDPILOTBBT CLIPRIGHT) (SETQ CHARW 0) + elseif (EQ 'KERN CHAR) + then (RELMOVETO CHARW 0) else (* ; "Native charcodes") (MI-TEDIT.BLTCHAR CHAR DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT)) (add TX CHARW))) finally (replace DDXPOSITION of DISPLAYDATA @@ -2020,8 +2102,8 @@ (* ;  "Make any necessary looks mods to the last run of characters") (CL:WHEN CLOOKS - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS - CLOOKS (FGETLD LINE DESCENT)))]) + (\TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS + CLOOKS (FGETLD LINE LDESCENT)))]) (BITBLT CACHE 0 0 WINDOWDS 0 (FGETLD LINE YBOT) (FGETTOBJ TEXTOBJ WRIGHT) LHEIGHT @@ -2042,7 +2124,6 @@ 6 6 'PAINT)) (BLTSHADE WHITESHADE WINDOWDS 0 (FGETLD LINE YBASE) 6 6 'PAINT)) - (FSETLD LINE LDIRTY NIL) LINE]) (\TEDIT.DISPLAYLINE.TABS @@ -2171,30 +2252,10 @@ ) (DEFINEQ -(\TEDIT.UPDATE.SCREEN - [LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 22:00 by rmk") - (* ; "Edited 16-Dec-2023 23:52 by rmk") - (* ; "Edited 12-Oct-2023 15:27 by rmk") - (* ; "Edited 17-Sep-2023 11:50 by rmk") - (* ; "Edited 22-May-2023 22:19 by rmk") - (* ; "Edited 17-May-2023 08:58 by rmk") - (* ; "Edited 5-May-2023 13:16 by rmk") - (* ; "Edited 5-Oct-2022 21:30 by rmk") - (CL:UNLESS (GETTOBJ TEXTOBJ TXTDON'TUPDATE) - [LET ((DIRTYCHARS (\TEDIT.FIND.DIRTYCHARS TEXTOBJ))) - (if DIRTYCHARS - then - (* ;; "As long as we have this path, we don't want the line updater to update the selection. Updating the looks affects the line (so we need to know what characters changed), but the characters don't move around. We want the rest of the insertion callers to avoid this entry.") - - (\TEDIT.UPDATE.LINES TEXTOBJ 'APPEARANCE (CAR DIRTYCHARS) - (CDR DIRTYCHARS)) - else (for PANE inpanes TEXTOBJ do (\TEDIT.FILLPANE (fetch (TEXTWINDOW PLINES) - of PANE) - TEXTOBJ PANE] - (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))]) - (\TEDIT.BACKFORMAT - [LAMBDA (TEXTOBJ DY CH1 HEIGHT) (* ; "Edited 20-Mar-2024 06:46 by rmk") + [LAMBDA (TSTREAM DY CH1 HEIGHT TRUETOP) (* ; "Edited 26-Oct-2024 23:10 by rmk") + (* ; "Edited 3-May-2024 23:33 by rmk") + (* ; "Edited 20-Mar-2024 06:46 by rmk") (* ; "Edited 15-Mar-2024 19:44 by rmk") (* ; "Edited 30-Nov-2023 21:16 by rmk") (* ; "Edited 3-Nov-2023 12:02 by rmk") @@ -2208,113 +2269,80 @@ (* ;; "This computes block by block, where the first line of a block either starts a paragraph or comes immediately after a forced break.") - (bind L1 PAIR (CHNO _ CH1) until (IGREATERP HEIGHT DY) while (IGEQ CHNO 1) - do (SETQ PAIR (\TEDIT.LINES.ABOVE TEXTOBJ CHNO HEIGHT)) - (* ; "The block may go beyond DY") - (LINKLD (CADR PAIR) + (bind L1 PAIR BOTTOMNEWLINE (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) + (CHNO _ CH1) until (IGREATERP HEIGHT DY) while (IGEQ CHNO 1) + do (SETQ PAIR (\TEDIT.LINES.ABOVE TSTREAM CHNO HEIGHT)) + (CL:UNLESS BOTTOMNEWLINE + (SETQ BOTTOMNEWLINE (CDR PAIR))) (* ; "The block may go beyond DY") + (LINKLD (CDR PAIR) L1) (* ;  "This block's LN links to previous L1") (SETQ L1 (CAR PAIR)) - (SETQ HEIGHT (GETLD L1 YTOP)) + (SETQ HEIGHT (CL:IF TRUETOP + (GETLD L1 LTRUEYTOP) + (GETLD L1 YTOP))) (SETQ CHNO (SUB1 (GETLD L1 LCHAR1))) finally (* ; "Perhaps the break was beyond DY") - (RETURN (find L inlines L1 suchthat (ILEQ (FGETLD L YBOT) - DY]) + (RETURN (CONS (OR (find L inlines L1 suchthat (ILEQ (FGETLD L YBOT) + DY)) + (RETURN NIL)) + BOTTOMNEWLINE]) (\TEDIT.PREVIOUS.LINEBREAK - [LAMBDA (TEXTOBJ CHNO) (* ; "Edited 17-Mar-2024 12:05 by rmk") + [LAMBDA (TSTREAM CHNO) (* ; "Edited 18-May-2024 18:53 by rmk") + (* ; "Edited 3-May-2024 23:33 by rmk") + (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 11-Dec-2023 21:59 by rmk") (* ; "Edited 16-Oct-2023 23:19 by rmk") (* ; "Edited 31-Mar-2023 17:44 by rmk") (* ; "Edited 28-Mar-2023 09:03 by rmk") (* ; "Edited 26-Mar-2023 12:55 by rmk") - (* ;; "Returns the character number of the first character at or before CHNO that would follow a forced line-end or a paragraph end. Line-formatting from that character onward would be consistent with any earlier line-breaks (and wouldn't change if earlier breaks changed).") + (* ;; "Returns the character number of the first character at or before CHNO that FOLLOWS a forced line-end or a paragraph end. Line-formatting from that character onward would be consistent with any earlier line-breaks (and wouldn't change if earlier breaks changed).") (if (ILEQ CHNO 1) then 1 - elseif (AND NIL (FGETTOBJ TEXTOBJ FORMATTEDP)) - then - (* ;; "[Disabled] For a para-formatted object, back up to the prior linebreak (PPARALAST). But if EOL's are not always paragraph boundaries, this might back up way too far.") - - (CAR (\TEDIT.PARA.FIRST TEXTOBJ CHNO)) else (* ;; "Otherwise, move back thru the text until we find a for-sure line break. ") - (CL:WHEN (IGREATERP CHNO (FGETTOBJ TEXTOBJ TEXTLEN)) - (SETQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))) - (LET ((TSTREAM (FGETTOBJ TEXTOBJ STREAMHINT)) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) NCHARS) - (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; - "Start at (SUB1 CHNO) because fileptrs are one back from characters") - [SETQ NCHARS (find I from 1 - suchthat (MEMB (\TEDIT.TEXTBACKFILEPTR TSTREAM) - (CHARCODE (EOL FORM %#EOL Meta,EOL CR LF NIL] + (if (AND NIL (FGETTOBJ TEXTOBJ FORMATTEDP)) + then + (* ;; "[Disabled] For a para-formatted object, back up to the prior linebreak (PPARALAST). But if EOL's are not always paragraph boundaries, this might back up way too far.") - (* ;; + (CAR (\TEDIT.PARA.FIRST TEXTOBJ CHNO)) + else (CL:WHEN (IGREATERP CHNO (FGETTOBJ TEXTOBJ TEXTLEN)) + (SETQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))) + (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) + (* ; + "Start at (SUB1 CHNO) because fileptrs are one back from characters") + [SETQ NCHARS (find I from 1 + suchthat (MEMB (\TEDIT.TEXTBACKFILEPTR TSTREAM) + (CHARCODE (EOL FORM %#EOL Meta,EOL CR LF NIL] + + (* ;;  "If we didn't find a preceding EOL, we must have backed to the beginning of the file (NIL).") - (CL:IF NCHARS - (ADD1 (IDIFFERENCE CHNO NCHARS)) - 1)]) - -(\TEDIT.FILLPANE - [LAMBDA (PREVLINE TEXTOBJ PANE) (* ; "Edited 20-Mar-2024 06:43 by rmk") - (* ; "Edited 15-Mar-2024 14:39 by rmk") - (* ; "Edited 11-Jan-2024 19:32 by rmk") - (* ; "Edited 2-Jan-2024 12:45 by rmk") - (* ; "Edited 24-Dec-2023 22:00 by rmk") - (* ; "Edited 2-Dec-2023 23:05 by rmk") - (* ; "Edited 3-Nov-2023 12:03 by rmk") - (* ; "Edited 17-Sep-2023 14:51 by rmk") - (* ; "Edited 8-May-2023 21:59 by rmk") - (* ; "Edited 5-May-2023 10:54 by rmk") - (* ; "Edited 26-Apr-2023 21:02 by rmk") - - (* ;; "This executes whether or not TXTNEEDSUPDATE, callers decide that.") - - (LET (LINE) - - (* ;; "") - - (* ;; "Find the first on-screen line after PREVLINE, if any. If the scrolling and other algorithms are tidy, we shouldn't expect to find any lines hanging around above the pane. If none, start with PREVLINE, maybe the dummy. ") - - (SETQ LINE (find L (PHEIGHT _ (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE))) - inlines (GETLD PREVLINE NEXTLINE) suchthat (ILESSP (FGETLD L YBOT) - PHEIGHT))) - - (* ;; "") - - (CL:WHEN LINE - (SETQ PREVLINE (GETLD LINE PREVLINE))) - - (* ;; "") - - (* ;; "Format and display any lines that are still needed to fill out the pane. ") - - (SETQ PREVLINE (\TEDIT.LINES.BELOW PREVLINE NIL PANE TEXTOBJ)) - - (* ;; "") - - (CL:WHEN (\TEDIT.INSURE.TRAILING.LINE TEXTOBJ PREVLINE) - (\TEDIT.DISPLAYLINE TEXTOBJ (GETLD PREVLINE NEXTLINE) - PANE)) - - (* ;; "") - - (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE) - (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL]) + (CL:IF NCHARS + (ADD1 (IDIFFERENCE CHNO NCHARS)) + 1)]) (\TEDIT.UPDATE.LINES - [LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED DONTDISPLAY) + [LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED) (* ; "Edited 7-Dec-2024 21:52 by rmk") + (* ; "Edited 29-Nov-2024 22:56 by rmk") + (* ; "Edited 26-Nov-2024 03:35 by rmk") + (* ; "Edited 22-Nov-2024 17:57 by rmk") + (* ; "Edited 20-Nov-2024 14:52 by rmk") + (* ; "Edited 17-Nov-2024 19:52 by rmk") + (* ; "Edited 11-Nov-2024 23:51 by rmk") + (* ; "Edited 1-Nov-2024 22:05 by rmk") + (* ; "Edited 13-Sep-2024 22:27 by rmk") + (* ; "Edited 3-Jul-2024 15:42 by rmk") + (* ; "Edited 7-May-2024 10:41 by rmk") (* ; "Edited 20-Mar-2024 06:43 by rmk") - (* ; "Edited 24-Dec-2023 22:00 by rmk") - (* ; "Edited 18-Dec-2023 00:12 by rmk") - (* ; "Edited 16-Dec-2023 13:43 by rmk") (* ; "Edited 4-Dec-2023 20:37 by rmk") (* ; "Edited 22-Jun-2023 15:50 by rmk") - (* ; "Edited 11-Jun-2023 18:34 by rmk") (* ; "Edited 4-May-2023 10:29 by rmk") (* ;; "This updates the lines in each pane given that NCHARSCHANGED characters with respect to FIRSTCHANGEDCHNO have been modified. It tries to reuse formatting information and screen bitmap images that are valid after the change.") @@ -2322,370 +2350,218 @@ (* ;; "See line-segmentation comments in \TEDIT.VALID.LINES.") (CL:UNLESS (GETTOBJ TEXTOBJ TXTDON'TUPDATE) - (CL:WHEN (type? SELECTION FIRSTCHANGEDCHNO) - (SETQ NCHARSCHANGED (FGETSEL FIRSTCHANGEDCHNO DCH)) - (SETQ FIRSTCHANGEDCHNO (FGETSEL FIRSTCHANGEDCHNO CH#))) + [if (type? SELECTION FIRSTCHANGEDCHNO) + then (SETQ NCHARSCHANGED (FGETSEL FIRSTCHANGEDCHNO DCH)) + (SETQ FIRSTCHANGEDCHNO (FGETSEL FIRSTCHANGEDCHNO CH#)) + elseif (type? SELPIECES FIRSTCHANGEDCHNO) + then [SETQ NCHARSCHANGED (ADD1 (IDIFFERENCE (FGETSPC FIRSTCHANGEDCHNO SPLASTCHAR) + (FGETSPC FIRSTCHANGEDCHNO SPFIRSTCHAR] + (SETQ FIRSTCHANGEDCHNO (FGETSPC FIRSTCHANGEDCHNO SPFIRSTCHAR)) + else (CL:UNLESS FIRSTCHANGEDCHNO (SETQ FIRSTCHANGEDCHNO 1)) + (CL:UNLESS NCHARSCHANGED + (SETQ NCHARSCHANGED (FGETTOBJ TEXTOBJ TEXTLEN)))] (* ;;  "If DONTDISPLAY, we ensure lines that are properly formatted and positioned but not displayed.") - (for PANE VALIDS NEXTVALID LASTGAPLINE DELTA inpanes TEXTOBJ as VALIDS - in (\TEDIT.VALID.LINES TEXTOBJ FIRSTCHANGEDCHNO NCHARSCHANGED REASON) when VALIDS + (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) + (for PANE VALIDS LASTVALID NEXTVALID LASTGAPLINE UPPERBITMAPLINES BITMAPLINES inpanes TEXTOBJ + when (SETQ VALIDS (\TEDIT.VALID.LINES PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON + (FGETTOBJ TEXTOBJ STREAMHINT))) do - (* ;; "Create/format/display new lines between LASTVALID=(CAR VALIDS) and NEXTVALID ") + (* ;; + "Create/format/position/display new lines between LASTVALID and NEXTVALID exclusive") - (SETQ NEXTVALID (CDR VALIDS)) - (SETQ LASTGAPLINE (\TEDIT.LINES.BELOW (CAR VALIDS) - (AND NEXTVALID (SUB1 (FGETLD NEXTVALID LCHAR1))) - PANE TEXTOBJ DONTDISPLAY)) - (LINKLD LASTGAPLINE NEXTVALID) + (SETQ LASTVALID (CAR VALIDS)) + (SETQ NEXTVALID (CDR VALIDS)) (* ; "MEASURED.LINES creates, measures, and links the lines from LASTVALID to the last pre-NEXTVALID character, without displaying. They may be in the bitmap.") + (SETQ LASTGAPLINE (\TEDIT.MEASURED.LINES LASTVALID (CL:IF NEXTVALID + (SUB1 (FGETLD NEXTVALID LCHAR1)) + (TEXTLEN TEXTOBJ)) + PANE TEXTOBJ)) - (* ;; "The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below. But the Ypositions of NEXTVALID lines have not yet been adjusted, and their images have not been displayed. The top of NEXTVALID should align with the bottom of LASTGAPLINE: their Y positions are changed by DELTA. DELTA is positive if NEXTVALID is moving up (deletion ), otherwise insertion. Appearance can go either way.") + (* ;; + "The chain that ended at LASTVALID now continues thru LASTGAPLINE to NEXVALID and below.") + (LINKLD LASTGAPLINE NEXTVALID) (if NEXTVALID - then (SETQ DELTA (IDIFFERENCE (FGETLD LASTGAPLINE YBOT) - (FGETLD NEXTVALID YTOP))) + then (SETQ BITMAPLINES (\TEDIT.BITMAPLINES PANE NEXTVALID)) + else (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTGAPLINE)) + (\TEDIT.SHIFTLINES LASTVALID (FGETLD LASTVALID NEXTLINE) + PANE TEXTOBJ BITMAPLINES UPPERBITMAPLINES)))]) - (* ;; "Unless DONTDISPLAY, the bitmap for lines from NEXTVALID down has been preserved, even in the insertion case.") - - (* ;; "The gap is filled in with formatted and displayed lines, the last of which now links to NEXTVALID. NEXTVALID and later lines have good character positions and good bitmaps, but their YPOS are not correct and their bitmaps are not in the right place.") - - (* ;; "") - - (* ;; "In the deletion case, NEXTVALID's current YPOS will be at or below its target value as determined by the gap-filler, but the gap-filling hasn't disturbed the image. The bitmap can be raised and the pane filled in below.") - - (* ;; "") - - (* ;; "In the insertion case, the YPOS maybe above the target, but we don't know what it should be until we fill in and display the gap lines. The gap line-display may have smashed some of the display bits that we otherwise would be available to move down..") - - (* ;; "") - - (if DONTDISPLAY - then (for L inlines NEXTVALID do (\TEDIT.LINE.BOTTOM L)) - elseif (IGREATERP DELTA 0) - then - (* ;; "Deletion/appearance") - - (\TEDIT.RAISE.LINES NEXTVALID (FGETLD LASTGAPLINE YBOT) - PANE TEXTOBJ) - elseif (ILESSP DELTA 0) - then - (* ;; - "Insertion/appearance: bitmaps of NEXTVALID can be shifted down") - - (\TEDIT.LOWER.LINES NEXTVALID LASTGAPLINE PANE TEXTOBJ)) - else (\TEDIT.CLEARPANE.BELOW.LINE LASTGAPLINE PANE TEXTOBJ) - (\TEDIT.INSURE.TRAILING.LINE TEXTOBJ LASTGAPLINE))) - (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))]) - -(\TEDIT.CREATEPLINE - [LAMBDA (TEXTOBJ PANE FIRSTLINE) (* ; "Edited 13-Mar-2024 17:02 by rmk") +(\TEDIT.PANE.CREATELINES + [LAMBDA (TEXTOBJ PANE LCHARLAST YBOT) (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 20-Nov-2024 14:26 by rmk") + (* ; "Edited 17-Nov-2024 19:53 by rmk") + (* ; "Edited 10-Nov-2024 18:45 by rmk") + (* ; "Edited 4-Nov-2024 17:02 by rmk") + (* ; "Edited 26-Oct-2024 10:25 by rmk") + (* ; "Edited 29-Jun-2024 23:29 by rmk") + (* ; "Edited 28-Jun-2024 13:34 by rmk") + (* ; "Edited 21-Jun-2024 22:25 by rmk") + (* ; "Edited 19-Jun-2024 08:26 by rmk") + (* ; "Edited 17-Jun-2024 08:52 by rmk") + (* ; "Edited 13-Mar-2024 17:02 by rmk") (* ; "Edited 21-Feb-2024 23:36 by rmk") (* ; "Edited 2-Jan-2024 13:04 by rmk") (* ; "Edited 29-Dec-2023 15:48 by rmk") - (* ;; "Creates the initial dummy line PLINES for PANE. Connects it to FIRSTLINE if provided.") + (* ;; "Creates the initial dummy line PLINES for PANE. This covers all of the characters before the first character visible in PANE, which is LCHARLAST+1. LCHARLAST defaults to 0. The bottom of the dummy line is the top of PANE.") - (LET (DUMMYLINE) + (LET (PREFIX) - (* ;; "Initialize with a dummy empty first line with LCHAR1 and LCHARLIM=0 above the pane top. 0 means in particular that the LCHARLIM is just before the first character of the file (if there is one). ") + (* ;; + "Initialize with a dummy empty first line with LCHAR1 and LASTCHAR above the pane top. ") (* ;;  "1STLN and LSTLN are NIL, since we don't want to make end paragraph-boundary inferences") - (SETQ DUMMYLINE + (SETQ PREFIX (create LINEDESCRIPTOR LDUMMY _ T - YBOT _ (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE)) LCHAR1 _ 0 - LCHARLIM _ 0 + LCHARLAST _ (OR LCHARLAST 0) RIGHTMARGIN _ (SUB1 (FGETTOBJ TEXTOBJ WRIGHT)) LHEIGHT _ 0 LX1 _ 0 LXLIM _ (FGETTOBJ TEXTOBJ WRIGHT) FORCED-END _ (CHARCODE EOL) - ASCENT _ 0 - DESCENT _ 0 + LASCENT _ 0 + LDESCENT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC 1STLN _ NIL LSTLN _ NIL)) - (replace (TEXTWINDOW PLINES) of PANE with DUMMYLINE)(* ; "Install PANE's new dummy line") - (LINKLD DUMMYLINE FIRSTLINE) (* ; "Link the possible first line") - DUMMYLINE]) + (SETYBOT PREFIX (OR YBOT (PANEHEIGHT PANE))) + (FSETPANEPROP (PANEPROPS PANE) + PREFIXLINE PREFIX) + (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ PREFIX) + PREFIX]) -(\TEDIT.FIND.DIRTYCHARS - [LAMBDA (TEXTOBJ) (* ; "Edited 4-Jan-2024 23:34 by rmk") - (* ; "Edited 2-Jan-2024 12:15 by rmk") - (* ; "Edited 2-Dec-2023 23:06 by rmk") - (* ; "Edited 3-Nov-2023 12:04 by rmk") - (* ; "Edited 8-May-2023 13:18 by rmk") - (* ; "Edited 28-Apr-2023 15:30 by rmk") +(\TEDIT.SUFFIXLINE.CREATE + [LAMBDA (PANE TEXTOBJ PREVLINE) (* ; "Edited 29-Nov-2024 10:54 by rmk") + (* ; "Edited 22-Nov-2024 10:22 by rmk") + (* ; "Edited 20-Nov-2024 14:25 by rmk") - (* ;; "Returns a pair (firstdirty . ndirties) figuring the first and maxium range of dirty characters. For programs that mark DIRTY when they modify lines. The dirty LCHAR*'s are the same in all panes where they exist.") + (* ;; "A new suffix line is created, if needed, and linked whenever the bottom is reached. This gets the paragraph leading and height parameters from the previous line. This may already be formatted as a dummy, if LCHARLIM is past the end.") - (for PANE PLINES FIRSTDIRTYLINE (LASTDIRTYCHAR _ 1) inpanes (PROGN TEXTOBJ) - eachtime (SETQ PLINES (fetch (TEXTWINDOW PLINES) of PANE)) - when (SETQ FIRSTDIRTYLINE (find L inlines (GETLD PLINES NEXTLINE) - suchthat (FGETLD L LDIRTY))) - do - (* ;; "Some panes may have more lines than others--we want to get the largest dirty range.") - - [SETQ LASTDIRTYCHAR (IMAX LASTDIRTYCHAR (for L (PREV _ FIRSTDIRTYLINE) inlines - FIRSTDIRTYLINE - while (FGETLD L LDIRTY) do (SETQ PREV L) - finally (RETURN (FGETLD PREV LCHARLIM] - finally (RETURN (CL:WHEN FIRSTDIRTYLINE - (CONS (GETLD FIRSTDIRTYLINE LCHAR1) - (IDIFFERENCE (ADD1 LASTDIRTYCHAR) - (FGETLD FIRSTDIRTYLINE LCHAR1))))]) + (LET ([SUFFIX (LINEDESCRIPTOR! (\TEDIT.FORMATLINE TEXTOBJ (GETLD PREVLINE LCHARLIM) + (PANESUFFIX PANE] + EMPTYLINE) + (FSETLD SUFFIX LDUMMY T) + (SETYTOP SUFFIX (FGETLD PREVLINE YBOT)) + (FSETPANEPROP (PANEPROPS PANE) + SUFFIXLINE SUFFIX) + (LINKLD PREVLINE SUFFIX) + (CL:WHEN (FGETLD PREVLINE FORCED-END) + (SETQ EMPTYLINE (create LINEDESCRIPTOR using SUFFIX LDUMMY _ NIL LCHARLIM _ + (FGETLD SUFFIX LCHAR1) + FORCED-END _ NIL)) + (LINKLD PREVLINE EMPTYLINE) + (LINKLD EMPTYLINE SUFFIX)) + SUFFIX]) (\TEDIT.LINES.BELOW - [LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 15-Mar-2024 19:22 by rmk") + [LAMBDA (PREVLINE PANE TEXTOBJ) (* ; "Edited 24-Nov-2024 14:57 by rmk") + (* ; "Edited 22-Nov-2024 00:53 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 18-Nov-2024 21:12 by rmk") + (* ; "Edited 17-Nov-2024 16:03 by rmk") + (* ; "Edited 13-Nov-2024 12:20 by rmk") + (* ; "Edited 11-Nov-2024 23:01 by rmk") + (* ; "Edited 9-Nov-2024 11:22 by rmk") + (* ; "Edited 7-Nov-2024 22:21 by rmk") + (* ; "Edited 4-Nov-2024 16:49 by rmk") + (* ; "Edited 1-Nov-2024 22:11 by rmk") + (* ; "Edited 28-Oct-2024 21:28 by rmk") + (* ; "Edited 26-Oct-2024 15:49 by rmk") + (* ; "Edited 13-Sep-2024 22:24 by rmk") + (* ; "Edited 28-Jun-2024 15:21 by rmk") + (* ; "Edited 10-May-2024 00:20 by rmk") + (* ; "Edited 9-Apr-2024 10:13 by rmk") + (* ; "Edited 15-Mar-2024 19:22 by rmk") (* ; "Edited 23-Dec-2023 23:38 by rmk") - (* ; "Edited 17-Dec-2023 15:56 by rmk") (* ; "Edited 14-Dec-2023 12:46 by rmk") - (* ;; "Formats lines after PREVLINE down to the one that contains LASTCHAR and/or does not run off the bottom of PANE. ") + (* ;; "Formats and displays lines after PREVLINE down to the one is at least partially visible at the bottom of PANE. Each line is positioned with respect to its predecessor and linked to it. The last visible line is set as the BOTTOMLINE of PANE, PANE's suffix is adjusted to cover the bitmap and all the unseen later characters. Returns the last displayed line.") - (* ;; "Assumes that PREVLINE is correctly formatted and Y-positioned, and already displayed in PANE (if desired).") - - (* ;; "Sets the Y positions of all lines relative to PREVLINE, and returns the last properly formatted, positioned, and displayed line, perhaps PREVLINE itself if there was nothing below it.") - - (* ;; "Also displays the lines, unless DONTDISPLAY. This is an optimization: THISLINE caches the just formatted line, doesn't have to be formatted again if it is immediately displayed. Calling it with DONTDISPLAY NIL followed by DONTDISPLAY T gives exactly the same result as calling it once with DONTDISPLAY T.") - - (CL:WHEN PREVLINE - (SETQ LASTCHAR (CL:IF LASTCHAR - (IMIN LASTCHAR (FGETTOBJ TEXTOBJ TEXTLEN)) - (FGETTOBJ TEXTOBJ TEXTLEN))) - - (* ;; "If PREVLINE is LDUMMY (= PLINES of PANE), we pretend it has an LCHARLIM one before the LCHAR1 of its nextline, otherwise 0.") - - (for L NEXT (LCHARLIM _ (CL:IF (AND (FGETLD PREVLINE LDUMMY) - (FGETLD PREVLINE NEXTLINE)) - (SUB1 (FGETLD (FGETLD PREVLINE NEXTLINE) - LCHAR1)) - (FGETLD PREVLINE LCHARLIM))) - (YBOT _ (FGETLD PREVLINE YBOT)) - (PBOTTOM _ (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL PANE))) inlines PREVLINE - first (CL:WHEN (OR (IGREATERP LCHARLIM LASTCHAR) - (ILEQ YBOT PBOTTOM)) - (FSETLD PREVLINE NEXTLINE NIL) (* ; "Eliminate dangling garbage") - (RETURN PREVLINE)) while (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (ADD1 LCHARLIM))) - do - (* ;; - "L is formatted, positioned, linked, displayed. Next is the following line unless at the end.") - - (LINKLD L NEXT) (* ; "Put NEXT into the iteration") - (SETQ YBOT (\TEDIT.LINE.BOTTOM NEXT)) (* ; "Link needed for Y position") - (SETQ LCHARLIM (FGETLD NEXT LCHARLIM)) - (CL:WHEN (OR (IGREATERP LCHARLIM LASTCHAR) - (ILEQ YBOT PBOTTOM)) - (FSETLD L NEXTLINE NIL) (* ; "Overshot, flush link") - (RETURN L)) - (CL:UNLESS DONTDISPLAY (* ; + (for L NEXT YBOT (BOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines (OR PREVLINE (PANEPREFIX + PANE)) + eachtime (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (FGETLD L LCHARLIM))) + until (FGETLD NEXT LDUMMY) do (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT)) + (SETYBOT NEXT YBOT) + (CL:WHEN (ILESSP YBOT BOTTOM) + (* ; "Ran off the bottom") + (RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE) + then (LINKLD L NEXT) + (* ; "Keep it with partial display") + (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE) + NEXT + else (* ; "Overshot") + L))) + (LINKLD L NEXT) + (CL:WHEN (FGETLD NEXT LDUMMY) + (* ; "Suffix line") + (RETURN L)) + (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE) + (* ;  "Cached formatting is good for display") - (\TEDIT.DISPLAYLINE TEXTOBJ NEXT PANE)) finally + finally - (* ;; "Ran out of lines") + (* ;; "Ran off the end") - (RETURN (OR L PREVLINE))))]) + (RETURN L]) -(\FORMAT.GAP.LINES - [LAMBDA (VALIDS PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 15-Mar-2024 19:23 by rmk") - (* ; "Edited 4-Dec-2023 20:42 by rmk") - (* ; "Edited 20-Nov-2023 10:47 by rmk") - (* ; "Edited 3-Nov-2023 12:05 by rmk") - (* ; "Edited 15-May-2023 17:31 by rmk") - (* ; "Edited 28-Apr-2023 17:35 by rmk") - (* ; "Edited 26-Apr-2023 18:39 by rmk") +(\TEDIT.MEASURED.LINES + [LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "Edited 7-Dec-2024 16:55 by rmk") + (* ; "Edited 1-Dec-2024 11:26 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 18-Nov-2024 20:01 by rmk") - (* ;; "VALIDS is a pair (LASTVALID . NEXTVALID) as described in \TEDIT.VALID.LINES. Our job is to format and display the lines between LASTVALID and NEXTVALID, laying them out in the region starting below the given LASTVALID.") + (* ;; "Formats and positions lines following PREVLINE up to and including the line that contains LASTCHAR or the last line that would be visible in PANE. Returns the last formatted (and visible) line. Lines are not displayed.") - (* ;; "The screen has valid images for lines from the top down to LASTVALID (segment 1 as described in \TEDIT.VALID.LINES). We don't touch those lines or their bitmaps.") + (for L NEXT NEXTCHAR1 YBOT (PBOTTOM _ (PANEBOTTOM PANE)) inlines PREVLINE + eachtime (SETQ NEXTCHAR1 (FGETLD L LCHARLIM)) while (ILEQ NEXTCHAR1 LASTCHAR) + do (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ NEXTCHAR1)) (* ; + "Always a next if the while succeeds") + (SETQ YBOT (\TEDIT.LINE.BOTTOM L NEXT)) + (SETYBOT NEXT YBOT) + (CL:WHEN (ILESSP YBOT PBOTTOM) (* ; "NEXT runs off the bottom") + (RETURN (if (\TEDIT.SHOW.AT.BOTTOMP NEXT PANE) + then (LINKLD L NEXT) (* ; "Keep it with partial display") + NEXT + else (* ; "Overshot") + L))) + (LINKLD L NEXT) (* ; "Keeps the iteration going") + finally - (* ;; "We also don't smash the bitmaps for NEXTVALID lines whose initial YTOP is below the YBOT of the last formatted valid line. This is guaranteed for deletions, maybe not for insertions where the gap displaying can encroach on the valid bitmaps. The caller has to sort the bitmap overlaps.") + (* ;; "Ran out of characters.") - (* ;; "Returns the new LASTVALID whose NEXTLINE is the given NEXTVALID.") - - (CL:UNLESS PANE (SETQ DONTDISPLAY T)) - (for L LASTINVALIDCHNO PBOTTOM LCHARLIM YBOT (LASTVALID _ (CAR VALIDS)) - (NEXTVALID _ (CDR VALIDS)) - [PBOTTOM _ (CL:UNLESS DONTDISPLAY - (fetch BOTTOM of (DSPCLIPPINGREGION NIL PANE)))] inlines LASTVALID - first (SETQ YBOT (GETLD LASTVALID YBOT)) - (SETQ LCHARLIM (FGETLD LASTVALID LCHARLIM)) (* ; - "LCHARLIM=0 if change in document's first line") - (SETQ LASTINVALIDCHNO (CL:IF NEXTVALID - (SUB1 (FGETLD NEXTVALID LCHAR1)) - (FGETTOBJ TEXTOBJ TEXTLEN))) eachtime (SETQ LCHARLIM - (FGETLD L LCHARLIM)) - until (OR (AND PBOTTOM (ILEQ YBOT PBOTTOM)) - (IEQP LCHARLIM LASTINVALIDCHNO)) - do (if (AND PBOTTOM (ILEQ YBOT PBOTTOM)) - then (LINKLD LASTVALID NIL) (* ; - "Insertion ran off the bottom, flush now-invisible lines") - (RETURN LASTVALID) - elseif (IEQP LCHARLIM LASTINVALIDCHNO) - then - (* ;; "We reached the end of the gap. But we may have smashed the bitmaps of the initial NEXTVALID lines, so we have to format/display a little bit more until we clear the overlap. If we are displaying, we first move the non-overlapping bitmap downwards on the screen, out of danger, then reformat and provide fresh images for the overlapping lines.") - - (CL:WHEN (IGREATERP (FGETLD NEXTVALID YTOP) - (FGETLD LASTVALID YBOT)) - (BITBLT))) - (SETQ LASTVALID (\TEDIT.FORMATLINE TEXTOBJ (ADD1 LCHARLIM))) - (LINKLD L LASTVALID) - (SETQ YBOT (\TEDIT.LINE.BOTTOM LASTVALID)) - (SETQ LCHARLIM (FGETLD LASTVALID LCHARLIM)) - (CL:UNLESS DONTDISPLAY - - (* ;; "The THISLINE cache for NEXT is good if we display immediately after formatting") - - (\TEDIT.DISPLAYLINE TEXTOBJ LASTVALID PANE)) finally (LINKLD LASTVALID NEXTVALID) - (RETURN LASTVALID]) - -(\TEDIT.LOWER.LINES - [LAMBDA (NEXTVALID LASTVALID PANE TEXTOBJ) (* ; "Edited 15-Mar-2024 14:40 by rmk") - (* ; "Edited 20-Jan-2024 23:15 by rmk") - (* ; "Edited 2-Jan-2024 00:26 by rmk") - (* ; "Edited 4-Dec-2023 11:25 by rmk") - (* ; "Edited 24-Nov-2023 13:01 by rmk") - (* ; "Edited 11-May-2023 11:34 by rmk") - (* ; "Edited 28-Apr-2023 08:51 by rmk") - - (* ;; "NEXTVALID is the top line of a region in PANE that extends to the pane-bottom or text end--that is, the pane bitmap in that region correctly reflects the lines (and possibly empty space at text-end).") - - (* ;; "Insertion case. The inserted gap lines may cover some of the bitmap of the nextvalid lines. In that case NEXTVALID:YBOT is greater than the new LASTVALID:YBOT") - - (* ;; "If PANE has been moved so that it is not entirely within the screen, then don't try to find the relevant bits, just repaint the whole window.") - - (CL:UNLESS (\TEDIT.OFFSCREEN.SCROLL TEXTOBJ PANE 'VERTICAL) - - (* ;; "Completely on screen, we can take advantage of screen bitmap.") - - [PROG ((NEWTOP (GETLD LASTVALID YBOT)) - (PREG (DSPCLIPPINGREGION NIL PANE)) - (LTOP (GETLD NEXTVALID YTOP)) - (LVBOT 0) - LOWER PWIDTH LASTVISIBLE) - (SETQ LOWER (IDIFFERENCE LTOP NEWTOP)) (* ; "How far down to go") - (CL:UNLESS (IGREATERP LOWER 0) (* ; "Maybe it's not moving") - (RETURN)) - - (* ;; "Make the YPOS of the lowered lines consistent with the intended positions of their images. LASTVISIBLE is the last line that was previously visible (and whose image will be lowered). ") - - (for L (PBOTTOM _ (fetch BOTTOM of PREG)) inlines NEXTVALID - while (IGEQ (IDIFFERENCE (FGETLD L YBOT) - LOWER) - PBOTTOM) do (SETQ LASTVISIBLE L)) - - (* ;; "") - - (SETQ PWIDTH (fetch WIDTH of PREG)) (* ; "Width of the pane") - - (* ;; "Lower what we think is the image of NEXTVALID and all visible lines below it. This may lower some garbage, if the LASTVALID printer encroached on NEXTVALID's image.") - - (CL:WHEN LASTVISIBLE - (SETQ LVBOT (IDIFFERENCE (GETLD LASTVISIBLE YBOT) - LOWER))) - (BITBLT PANE 0 (IPLUS LVBOT LOWER) - PANE 0 LVBOT PWIDTH (IDIFFERENCE (IDIFFERENCE LTOP LVBOT) - LOWER) - 'INPUT - 'REPLACE) - - (* ;; "") - - (* ;; "The bottom of the pane is good. But if LASTVALID encroached into the bitmap of some of NEXTVALID and some of its descendants, those need to be redisplayed. And the ypositions of NEXTVALID and all lines down to LASTVISIBLE have to be lowered. ") - - (* ;; "") - - (CL:WHEN LASTVISIBLE (* ; "Smash the invisible tail") - (SETLD LASTVISIBLE NEXTLINE NIL)) - (for L YBOT inlines NEXTVALID do (SETQ YBOT (IDIFFERENCE (FGETLD L YBOT) - LOWER)) - (if (IGEQ (FGETLD L YTOP) - NEWTOP) - then (SETYPOS L YBOT) - (\TEDIT.DISPLAYLINE TEXTOBJ L PANE) - else (SETYPOS L YBOT))) - - (* ;; "Clear whatever might be left over below the last visible line") - - (CL:WHEN LASTVISIBLE - (BLTSHADE WHITESHADE PANE 0 0 PWIDTH (GETLD LASTVISIBLE YBOT) - 'REPLACE))])]) - -(\TEDIT.RAISE.LINES - [LAMBDA (LINE NEWTOP PANE TEXTOBJ) (* ; "Edited 20-Mar-2024 10:57 by rmk") - (* ; "Edited 20-Jan-2024 23:14 by rmk") - (* ; "Edited 2-Jan-2024 00:31 by rmk") - (* ; "Edited 14-Dec-2023 17:20 by rmk") - (* ; "Edited 4-Dec-2023 20:57 by rmk") - (* ; "Edited 24-Nov-2023 13:01 by rmk") - (* ; "Edited 14-May-2023 21:55 by rmk") - (* ; "Edited 11-May-2023 11:34 by rmk") - (* ; "Edited 28-Apr-2023 08:51 by rmk") - - (* ;; "LINE is the top line of a region in PANE that extends to the pane-bottom or text end--that is, the pane bitmap in that region correctly reflects the lines (and possibly empty space at text-end).") - - (* ;; "This raises the image of that region so that its new top is at NEWTOP. It then fills in and displays lines below the region's new location that may be neeeded to fill in the pane.") - - (* ;; "If PANE has been moved so that it is not entirely within the screen, then don't try to find the relevant bits, just repaint the whole window.") - - (TEXTOBJ! TEXTOBJ) - (PROG ((PREG (DSPCLIPPINGREGION NIL PANE)) - (LTOP (GETLD LINE YTOP)) - RAISE PWIDTH PBOTTOM LASTVISIBLE) - (SETQ RAISE (IDIFFERENCE NEWTOP (FGETLD LINE YTOP))) - (CL:UNLESS (IGREATERP RAISE 0) (* ; "Maybe it's not moving") - (RETURN)) - - (* ;; "Make the YPOS of the raised lines consistent with the new positions of their images. LASTVISIBLE is the last line that was previously visible (and whose image has been raised). ") - - (SETQ PBOTTOM (fetch BOTTOM of PREG)) - (for L inlines LINE while (IGEQ (FGETLD L YBOT) - PBOTTOM) do (SETYPOS L (IPLUS RAISE (FGETLD L YBOT))) - (SETQ LASTVISIBLE L)) - - (* ;; " ") - - (CL:UNLESS (\TEDIT.OFFSCREEN.SCROLL TEXTOBJ PANE 'VERTICAL) - - (* ;; "Completely on screen, we can work with screen bitmap. But first, are we at the end of the text? Just clear.") - - (* ;; "Lines are positioned, but images may not exist. Raise the image of LINE and all visible lines below it.") - - (SETQ PWIDTH (fetch WIDTH of PREG)) - (BITBLT PANE 0 0 PANE 0 RAISE PWIDTH LTOP 'INPUT 'REPLACE) - - (* ;; "") - - (* ;; "Now for the bottom of the pane. First clear it.") - - (BLTSHADE WHITESHADE PANE 0 0 PWIDTH (FGETLD LASTVISIBLE YBOT) - 'REPLACE) - - (* ;; "") - - (* ;; "If the last visible line in the pane (whose image is now elevated) is not the last line of the text, we build and display new lines to fill out the pane.") - - (\TEDIT.LINES.BELOW LASTVISIBLE NIL PANE TEXTOBJ) - (RETURN))]) + (RETURN L]) (\TEDIT.VALID.LINES - [LAMBDA (TEXTOBJ FIRSTCHANGEDCHNO NCHARSCHANGED REASON) (* ; "Edited 20-Mar-2024 06:46 by rmk") - (* ; "Edited 15-Mar-2024 19:44 by rmk") + [LAMBDA (PANE FIRSTCHANGEDCHNO NCHARSCHANGED REASON TSTREAM) + (* ; "Edited 22-Nov-2024 16:54 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 5-Jul-2024 22:58 by rmk") + (* ; "Edited 4-Jul-2024 10:48 by rmk") + (* ; "Edited 28-Jun-2024 15:27 by rmk") + (* ; "Edited 15-Jun-2024 17:32 by rmk") + (* ; "Edited 12-Jun-2024 23:59 by rmk") + (* ; "Edited 23-May-2024 12:48 by rmk") + (* ; "Edited 20-Apr-2024 22:11 by rmk") + (* ; "Edited 20-Mar-2024 06:46 by rmk") (* ; "Edited 22-Feb-2024 01:05 by rmk") (* ; "Edited 3-Nov-2023 12:07 by rmk") (* ; "Edited 14-Jun-2023 15:55 by rmk") (* ; "Edited 17-May-2023 09:32 by rmk") (* ; "Edited 15-May-2023 17:51 by rmk") - (* ;; "Called when changes have been made to the document that affect the lines displayed in each pane. If a change is not visible in a given pane, then NIL is returned for that pane. Otherwise, this divides the lines in the pane into 3 segments:") + (* ;; "Called when changes have been made to the document that affect the lines displayed in PANE. Return NIL if the change is not visible in PANE. Otherwise, this divides the lines in PANE into 3 segments:") - (* ;; " 1. a prefix of lines from the top visible line (next of PLINES) to the LASTVALID line, the line just before the first changed line.") + (* ;; " 1. a prefix of lines from the top visible line (next of PREFIXLINE) to the LASTVALID line, the line just before the first changed line.") (* ;; " 2. an intermediate sequence of lines that are (or may be) no longer valid because of the change.") @@ -2696,125 +2572,200 @@ (* ;; "") - (* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from PLINES to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID).") + (* ;; "The segmentation information is returned to the caller as a pair of lines (LASTVALID . NEXTVALID). Segment 1 is then the sequence of lines chained from PREFIXLINE to LASTVALID, segment 3 is the sequence beginning at NEXTVALID. The segment 2 lines originally between LASTVALID and NEXTVALID are useless, so here we just nuke them out (by smashing the NEXTLINE of LASTVALID).") (* ;; "") - (* ;; "This assumes that the change has already been installed in the piece table after character FIRSTCHANGEDCHNO. The LCHAR1/LIM valus for lines through LASTVALID are unaffected by the change, the values for all later lines are off by NCHARSCHANGED (negative for deletions, positive for insertions). The positions for NEXTVALID and beyond are adjusted so that they are correct with respect to the revised piece table. Note that this only deals with the character numbers of lines that will persist. Although the Y positions for segment 1 lines are good,segment 3 positions cannot be adjusted until the replacements for segment 2 lines have been calculated.") + (* ;; "This assumes that the change has already been installed in the piece table after character FIRSTCHANGEDCHNO. The LCHAR1/LAST valus for lines through LASTVALID are unaffected by the change, the values for all later lines are off by NCHARSCHANGED (negative for deletions, positive for insertions). The positions for NEXTVALID and beyond are adjusted so that they are correct with respect to the revised piece table. Note that this only deals with the character numbers of lines that will persist. Although the Y positions for segment 1 lines are good,segment 3 positions cannot be adjusted until the replacements for segment 2 lines have been calculated.") (* ;; "") (* ;; "Edge conditions:") - (* ;; "If the first visible line is changed, then there are no existing segment 1 lines and no existing LASTVALID line to return. If the first changed line is also the first line of the document, then LASTVALID is NIL. Otherwise, we fabricate a new a new line with LCHARLIM and YBOT just above the changed top line and returned it as LASTVALID. Either way, the next of PLINES is set to NIL to indicate that there is no chain of real segment 1 lines with valid formatting and reusable bitmaps. ") + (* ;; "If the first visible line is changed, then there are no existing segment 1 lines and no existing LASTVALID line to return. If the first changed line is also the first line of the document, then LASTVALID is NIL. Otherwise, we fabricate a new line with LCHARLAST and YBOT just above the changed top line and returned it as LASTVALID. Either way, the next of PREFIXLINE is set to NIL to indicate that there is no chain of real segment 1 lines with valid formatting and reusable bitmaps. ") (* ;; "") - (* ;; "If the last visible line is changed, then there is no NEXTVALID line, indicated by NEXTVALID=NIL. The next valid could be a currently non-existent line just below the pane if we are not at the end of the document. If LCHARLIM of the last visible line is TEXTLEN, there is at best a trailing line.") + (* ;; "If the last visible line is changed, then there is no NEXTVALID line, indicated by NEXTVALID=NIL. The next valid could be a currently non-existent line just below the pane if we are not at the end of the document. If LCHARLAST of the last visible line is TEXTLEN, there is at best a trailing line.") (* ;; "") (* ;; "Note that this is mostly an optimization to avoid unnecessary reformatting and redisplaying of still-valid lines in favor of bitbltting a block of their currently visible images. Smashing all lines to NIL and refilling each pane would also give the correct behavior, but slower. Intermediate would be smashing all lines below the last valid.") - (* ;; "") + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (LASTCHANGEDCHNO (SUB1 (IPLUS FIRSTCHANGEDCHNO NCHARSCHANGED))) + (PREFIXLINE (PANEPREFIX PANE)) + (SUFFIXLINE (PANESUFFIX PANE)) + (DELTA (SELECTQ REASON + (INSERTION NCHARSCHANGED) + (DELETION (IMINUS NCHARSCHANGED)) + ((CHANGED LOOKS) + NIL) + (\TEDIT.THELP "BAD REASONS FOR VALID LINES"))) + FIRSTVISIBLECHNO LASTVISIBLECHNO FIRSTCHANGEDLINE LASTCHANGEDLINE LASTVALIDLINE + NEXTVALIDLINE) + (CL:WHEN (EQ 0 (TEXTLEN TEXTOBJ)) (* ; "Empty document") + (RETURN (CONS PREFIXLINE))) + (CL:UNLESS SUFFIXLINE + (\TEDIT.THELP "NO SUFFIXLINE") + (RETURN NIL)) + (SETQ FIRSTVISIBLECHNO (FGETLD PREFIXLINE LCHARLIM)) + (SETQ LASTVISIBLECHNO (SUB1 (FGETLD SUFFIXLINE LCHAR1))) + (CL:WHEN (IGREATERP FIRSTCHANGEDCHNO LASTVISIBLECHNO) + (* ; + "Change after previously visible lines") + (CL:UNLESS (ILEQ LASTCHANGEDCHNO (TEXTLEN TEXTOBJ)) + (RETURN NIL)) (* ; + "Unless adding past the end, nothing to do ") - (for PANE PLINES FIRSTCHANGEDLINE LASTCHANGEDLINE LASTVALIDLINE NEXTVALIDLINE - (LASTCHANGEDCHNO _ (SUB1 (IPLUS FIRSTCHANGEDCHNO NCHARSCHANGED))) inpanes TEXTOBJ - eachtime (SETQ PLINES (\DTEST (fetch (TEXTWINDOW PLINES) of PANE) - 'LINEDESCRIPTOR)) - (SETQ LASTVALIDLINE PLINES) - (SETQ NEXTVALIDLINE NIL) - collect [SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD PLINES NEXTLINE) - suchthat + (* ;; "Adding at the end of the document: insert a new line") - (* ;; - "Either within a line or immediately after a line that did not end with an EOL") + (SETQ FIRSTCHANGEDLINE (\TEDIT.FORMATLINE TEXTOBJ FIRSTCHANGEDCHNO)) + (LINKLD (FGETLD SUFFIXLINE PREVLINE) + FIRSTCHANGEDLINE) + (LINKLD FIRSTCHANGEDLINE SUFFIXLINE)) (* ; + "Change is after PANE, nothing to do") - (OR (LINESELECTEDP L FIRSTCHANGEDCHNO LASTCHANGEDCHNO) - (AND (NOT (FGETLD L FORCED-END)) - (IEQP FIRSTCHANGEDCHNO - (ADD1 (FGETLD L LCHARLIM] - [SETQ LASTCHANGEDLINE (find L inlines (OR FIRSTCHANGEDLINE (FGETLD PLINES NEXTLINE)) - suchthat (OR (WITHINLINEP LASTCHANGEDCHNO L) - (AND (NOT (FGETLD L FORCED-END)) - (IEQP LASTCHANGEDCHNO (ADD1 (FGETLD L - LCHARLIM] - (CL:WHEN (OR FIRSTCHANGEDLINE LASTCHANGEDLINE) (* ; - "The change is visible in this pane. ") +(* ;;; "Change is visible in PANE, there's gotta be a FIRSTCHANGEDLINE") - (* ;; "Figure out the LASTVALIDLINE--somewhere before the FIRSTCHANGEDLINE. Could be PLINES as initialized above") + (SETQ FIRSTCHANGEDLINE (find L inlines (FGETLD PREFIXLINE NEXTLINE) + suchthat (FWITHINLINEP FIRSTCHANGEDCHNO L))) - (CL:WHEN FIRSTCHANGEDLINE + (* ;; "Updates may be required in lines before the FIRSTCHANGEDLINE, if words jump around.") - (* ;; "First changed line is visible. Rejustification could propagate changes backwards until a forced-end, so that's the clear last valid. That may overshoot and cause to much action on redisplaying. The only way we can tighten up is to then format lines forward from the break, stopping before the first line whose LCHARLIM would change.") + (SETQ LASTVALIDLINE (\TEDIT.LASTVALIDLINE FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM)) - (SETQ LASTVALIDLINE (find L backlines (FGETLD FIRSTCHANGEDLINE PREVLINE) - suchthat (FGETLD L FORCED-END))) - (CL:WHEN (AND (EQ LASTVALIDLINE PLINES) - (IGREATERP (FGETLD FIRSTCHANGEDLINE LCHAR1) - 1)) + (* ;; "Now for the after-change lines") - (* ;; "We ran back to the top of the pane without finding a forced-end. If it's not the beginning of the document, we need to insert a new line with the proper LCHARLIM and YBOT just above the pane. ") + (SETQ LASTCHANGEDLINE (find L inlines FIRSTCHANGEDLINE suchthat (FWITHINLINEP + LASTCHANGEDCHNO L))) + (CL:WHEN LASTCHANGEDLINE - [SETQ LASTVALIDLINE (CADR (\TEDIT.LINES.ABOVE TEXTOBJ - (SUB1 (FGETLD FIRSTCHANGEDLINE LCHAR1)) - (FGETLD FIRSTCHANGEDLINE YTOP] - (\TEDIT.INSERTLINE LASTVALIDLINE PLINES T))) + (* ;; + "Last changed line is visible, its changes may cause character to shift to or from lower lines.") - (* ;; "") + (SETQ NEXTVALIDLINE (\TEDIT.NEXTVALIDLINE LASTCHANGEDLINE TSTREAM))) + (CL:WHEN (AND NEXTVALIDLINE DELTA) - (* ;; "The next valid must be somewhere after the last changed line, and after a stable line break. But we will run out of lines if there is no visible paragraph break: the change reached the bottom, or the paragraph break after the change is below the pane, or the document ended. In that case the last line in the chain is not valid and presumably the gap filler will fill to the end of the window. ") + (* ;; "If the modification added or substracted to the number of characters, translate the character positions of the still-valid lines that are visible later than the change. ") - [SETQ NEXTVALIDLINE (for L inlines LASTCHANGEDLINE - when (OR (FGETLD L FORCED-END) - (GETLD L LSTLN)) - do (RETURN (FGETLD L NEXTLINE] + (for L inlines NEXTVALIDLINE do (add (FGETLD L LCHAR1) + DELTA) + (add (FGETLD L LCHARLAST) + DELTA))) - (* ;; "Translate the character positions of the still-valid lines that are visible later than the change. ") + (* ;; "") - (for L DELTA inlines NEXTVALIDLINE first (SETQ DELTA (SELECTQ REASON - (INSERTION NCHARSCHANGED) - (DELETION (IMINUS - NCHARSCHANGED - )) - (APPEARANCE (RETURN)) - (SHOULDNT - "BAD REASONS FOR VALID LINES" - ))) - do (add (FGETLD L LCHAR1) - DELTA) - (add (FGETLD L LCHARLIM) - DELTA)) + (CL:WHEN LASTVALIDLINE + (FSETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop off the now useless lines") + (RETURN (CONS LASTVALIDLINE NEXTVALIDLINE)))]) - (* ;; "") +(\TEDIT.LASTVALIDLINE + [LAMBDA (FIRSTCHANGEDLINE FIRSTCHANGEDCHNO PANE TSTREAM) (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 18-Nov-2024 23:16 by rmk") + (* ; "Edited 17-Nov-2024 19:08 by rmk") + (* ; "Edited 16-Nov-2024 13:25 by rmk") + (* ; "Edited 28-Oct-2024 16:05 by rmk") + (* ; "Edited 28-Jun-2024 15:22 by rmk") + (* ; "Edited 16-Jun-2024 08:27 by rmk") + (* ; "Edited 13-Jun-2024 22:09 by rmk") + (* ; "Edited 25-May-2024 00:28 by rmk") + (* ; "Edited 23-May-2024 12:47 by rmk") + (* ; "Edited 18-May-2024 10:13 by rmk") - (CL:WHEN LASTVALIDLINE - (SETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop off the useless lines") - (CONS LASTVALIDLINE NEXTVALIDLINE)))]) + (* ;; "We hope to return an existing line in PANE that is impervious to the change at FIRSTCHARCHANGECHNO. This would be the impervious line closest to FIRSTCHANGEDLINE, usually the immediately preceding line. That line is valid: it and lines above it do not need reformatting or redisplay. But if PANE does not contain an impervious line, and we are not at the beginning of the document, we have to construct lines above PANE until we get to an impervious line, so that we can format forwards.") + + (* ;; "A line L is impervious to a change in L+1 if it has a forced end, or if L has at least one separator (space, tab) prior to its change point. The change point is FIRSTCHANGEDCHNO for the first line. If we have to go to earlier lines, then any separator anywhere on the line (at or before LCHARLAST) will stop the back-propagation.") + + (LET* ((PREFIXLINE (PANEPREFIX PANE)) + (FIRSTPANECHAR (AND (FGETLD PREFIXLINE NEXTLINE) + (FGETLD (FGETLD PREFIXLINE NEXTLINE) + LCHAR1))) + PREV) + (if (bind (L _ FIRSTCHANGEDLINE) + (LIMCHAR _ (SUB1 FIRSTCHANGEDCHNO)) while (SETQ PREV (FGETLD L PREVLINE)) + do + (* ;; "The previous line is valid if its ending was forced, or if L has at least one space/tab earlier then the limit. Note that PREFIXLINE is always forced-end, it stops the iteration..") + + (CL:WHEN (FGETLD PREV FORCED-END) + (RETURN (if (NEQ PREFIXLINE PREV) + then PREV + elseif (EQ 1 FIRSTPANECHAR) + then (* ; "PANE is at the top") + PREFIXLINE))) + (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (FGETLD L LCHAR1))) + (CL:WHEN [find I from 1 to (IDIFFERENCE LIMCHAR (FGETLD L LCHAR1)) + suchthat (MEMB (BIN TSTREAM) + (CHARCODE (SPACE TAB] + (RETURN PREV)) + (SETQ L PREV) + (SETQ LIMCHAR (FGETLD L LCHARLIM)) repeatwhile L) + else + (* ;; "None of the existing lines above FIRSTCHANGEDLINE are valid. We return a valid line that is positioned just above PANE such that everything past its LCHARLAST is valid. That line has no current bitmap and will not be displayed, but it signals where the gap begins.") + + (* ;; + "Note that that line is not linked into the chain, PANEPREFIX doesn't know about it.") + + (* ;; "We could go forward from the CAR or backwards from the CADR to find the valid line just above the pane. Maybe fewer lines backwards, if we're working at the bottom of a paragraph?") + + (find L (PTOP _ (PANEHEIGHT PANE)) backlines (CDR (\TEDIT.LINES.ABOVE TSTREAM + (SUB1 FIRSTPANECHAR) + (FGETLD FIRSTCHANGEDLINE + YTOP))) + suchthat (IGREATERP (FGETLD L YBOT) + PTOP]) + +(\TEDIT.NEXTVALIDLINE + [LAMBDA (LASTCHANGEDLINE TSTREAM) (* ; "Edited 29-Nov-2024 23:31 by rmk") + (* ; "Edited 16-Nov-2024 11:00 by rmk") + + (* ;; "We know we can stop when we see a forced end-- characters won't move around after that. In the usual case, the forced-end is a also the last line of a paragraph, but we can't just take the first line of the next paragraph because we can't deal here with whatever paragraph leading it might have (and the venue sysout also screwed up in that case).") + + (* ;; "So we got for the second line of the next paragraph, if there is one") + + (* ;; "The line after a forced end is valid. But maybe we can figure out how to stop sooner?") + + (for L inlines LASTCHANGEDLINE when (FGETLD L FORCED-END) + do + (* ;; "If we reach the end of a paragraph, the next line may be the start of the next paragraph. We skip that one, because we don't know how to deal here with its paragraph leading. If forced but not last, presumably it was a meta-EOL linebreak, no special leading.") + + (CL:WHEN (FGETLD L LSTLN) + (SETQ L (FGETLD L NEXTLINE))) + (RETURN (AND L (FGETLD L NEXTLINE]) (\TEDIT.CLEARPANE.BELOW.LINE - [LAMBDA (LINE PANE TEXTOBJ) (* ; "Edited 20-Nov-2023 14:02 by rmk") + [LAMBDA (LINE PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 11:27 by rmk") + (* ; "Edited 20-Nov-2024 10:03 by rmk") + (* ; "Edited 11-Nov-2024 00:22 by rmk") + (* ; "Edited 4-Oct-2024 08:10 by rmk") + (* ; "Edited 26-Jun-2024 23:50 by rmk") + (* ; "Edited 13-Jun-2024 21:51 by rmk") + (* ; "Edited 20-Nov-2023 14:02 by rmk") (* ; "Edited 22-Sep-2023 20:33 by rmk") (* ; "Edited 25-Apr-2023 23:06 by rmk") (* ; "Edited 30-May-91 15:59 by jds") (* ;; "According to the manual, the user overflow function is called whenever a line falls out of the window (pane?), but it isn't told anything else. The use-case mentioned is coordination with the REGION property wherein TEDIT is running in part of a window. But how does the userfn know where it is?") - (CL:UNLESS (AND (GETTEXTPROP TEXTOBJ 'OVERFLOWFN) - (APPLY* (GETTEXTPROP TEXTOBJ 'OVERFLOWFN) - PANE TEXTOBJ)) + (CL:WHEN LINE + (CL:UNLESS (AND (GETTEXTPROP TEXTOBJ 'OVERFLOWFN) + (APPLY* (GETTEXTPROP TEXTOBJ 'OVERFLOWFN) + PANE TEXTOBJ)) - (* ;; "Clears the pane below LINE to white.") + (* ;; "Clears the pane below LINE to white.") - (LET ((PREG (DSPCLIPPINGREGION NIL PANE))) - (BLTSHADE WHITESHADE PANE 0 (fetch BOTTOM of PREG) - (fetch WIDTH of PREG) - (IDIFFERENCE (GETLD LINE YBOT) - (fetch BOTTOM of PREG)) - 'REPLACE)))]) + (LET ((DISTBELOW 0)) (* ; "See note in SHOWSEL.HILIGHT") + (BLTSHADE WHITESHADE PANE 0 (PANEBOTTOM PANE) + (PANEWIDTH PANE) + (IDIFFERENCE (IDIFFERENCE (GETLD LINE YBOT) + (PANEBOTTOM PANE)) + DISTBELOW) + 'REPLACE))))]) (\TEDIT.INSERTLINE - [LAMBDA (NEWLINE OLDLINE AFTER) (* ; "Edited 31-May-2023 00:18 by rmk") + [LAMBDA (NEWLINE OLDLINE AFTER) (* ; "Edited 17-May-2024 22:49 by rmk") + (* ; "Edited 31-May-2023 00:18 by rmk") (* ; "Edited 26-Feb-2023 22:36 by rmk") (* ; "Edited 24-Feb-2023 23:12 by rmk") (* ; "Edited 23-Feb-2023 22:41 by rmk") @@ -2834,85 +2785,28 @@ (CL:WHEN LINE (SETLD LINE NEXTLINE NEWLINE)) (SETLD NEWLINE PREVLINE LINE) (SETLD NEWLINE NEXTLINE OLDLINE) - (SETLD OLDLINE PREVLINE NEWLINE]) - -(\TEDIT.INSURE.TRAILING.LINE - [LAMBDA (TEXTOBJ LASTLINE) (* ; "Edited 15-Mar-2024 19:31 by rmk") - (* ; "Edited 16-Dec-2023 00:12 by rmk") - (* ; "Edited 15-Jul-2023 13:53 by rmk") - (* ; "Edited 8-May-2023 22:00 by rmk") - (* ; "Edited 5-May-2023 10:54 by rmk") - - (* ;; "Fabricates a final line to insure that there is a place for the caret to blink after the last EOL of the text. Something for \FIXSEL to move to.") - - (* ;; "\TEDIT.FORMATLINE may be overkill--maybe we really want to construct exactly what we want. But \TEDIT.FORMATLINE does get the LHEIGHT.") - - (CL:WHEN (AND (GETLD LASTLINE FORCED-END) - (IEQP (FGETLD LASTLINE LCHARLIM) - (FGETTOBJ TEXTOBJ TEXTLEN))) - (LET [(LINE (\TEDIT.FORMATLINE.EMPTY TEXTOBJ (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN] - (SETYPOS LINE (IDIFFERENCE (FGETLD LASTLINE YBOT) - (FGETLD LINE LHEIGHT))) - (LINKLD LASTLINE LINE) - LINE))]) - -(\TEDIT.MARK.LINES.DIRTY - [LAMBDA (TEXTOBJ FIRSTCHAR LASTCHAR) (* ; "Edited 11-Dec-2023 10:43 by rmk") - (* ; "Edited 2-Dec-2023 23:07 by rmk") - (* ; "Edited 3-Nov-2023 12:07 by rmk") - (* ; "Edited 28-May-2023 14:05 by rmk") - (* ; "Edited 20-May-2023 16:44 by rmk") - (* ; "Edited 7-Apr-2023 19:25 by rmk") - (* ; "Edited 30-May-91 16:05 by jds") - - (* ;; "Mark as dirty the lines that intersect the range FIRSTCHAR to LASTCHAR inclusive, and assert that all panes need to be updated.") - - [if (type? SELECTION FIRSTCHAR) - then (SETQ LASTCHAR (SUB1 (GETSEL FIRSTCHAR CHLIM))) - (SETQ FIRSTCHAR (GETSEL FIRSTCHAR CH#)) - elseif (type? SELPIECES FIRSTCHAR) - then (SETQ LASTCHAR (ffetch (SELPIECES SPLASTCHAR) of FIRSTCHAR)) - (SETQ FIRSTCHAR (ffetch (SELPIECES SPFIRSTCHAR) of FIRSTCHAR)) - else (SETQ FIRSTCHAR (IMIN FIRSTCHAR (TEXTLEN TEXTOBJ))) - (SETQ LASTCHAR (CL:IF (EQ LASTCHAR -1) - (TEXTLEN TEXTOBJ TEXTOBJ) - (IMIN LASTCHAR (TEXTLEN TEXTOBJ)))] - (for PANE inpanes TEXTOBJ do (for LINES inlines (find L inlines (fetch (TEXTWINDOW PLINES) - of PANE) - suchthat - - (* ;; - "The first line ending after FIRSTCHAR") - - (IGEQ (FGETLD L LCHARLIM) - FIRSTCHAR)) - do (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE T) - (for L inlines LINES while (ILEQ (FGETLD L LCHAR1) - LASTCHAR) - do - (* ;; "All the lines that begin before LASTCHAR") - - (FSETLD L LDIRTY T)) - (RETURN]) + (SETLD OLDLINE PREVLINE NEWLINE)) + NEWLINE]) (\TEDIT.LINE.BOTTOM - [LAMBDA (LINE) (* ; "Edited 4-Dec-2023 13:59 by rmk") + [LAMBDA (PREVLINE LINE) (* ; "Edited 17-Nov-2024 00:38 by rmk") + (* ; "Edited 7-Nov-2024 16:57 by rmk") + (* ; "Edited 26-Oct-2024 15:45 by rmk") + (* ; "Edited 16-Jun-2024 23:43 by rmk") + (* ; "Edited 4-Dec-2023 13:59 by rmk") (* ; "Edited 25-Apr-2023 23:00 by rmk") (* ; "Edited 23-Apr-2023 00:05 by rmk") (* ; "Edited 24-Sep-87 10:00 by jds") - (* ;; "Computes LINE's YBOT value relative to the Y position of the line before. Takes into account the (undocumented) BASETOBASE leading, as well as paragraph leadings.") + (* ;; "Computes LINE's YBOT value relative to the Y position of PREVLINE. Takes into account the (undocumented) BASETOBASE leading, as well as paragraph leadings.") (* ;; "BASETOBASE leading differs from normal LINELEADING in that the distance between the baselines of adjacent within-paragraph lines should be the given constant, whether or not the previous line has a non standard descent (a subscript) or the next line has a nonstandard ascent.") - (* ;; "We can't fetch the YBASE of PREV directly, since we") - - (\DTEST LINE 'LINEDESCRIPTOR) - (LET* ((PREV (\DTEST (FGETLD LINE PREVLINE) - 'LINEDESCRIPTOR)) - (PREVYBOT (FGETLD PREV YBOT)) - (FMTSPEC (GETLD LINE LFMTSPEC)) - (BASETOBASE (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC)) + (LINEDESCRIPTOR! PREVLINE) + (LINEDESCRIPTOR! LINE) + (LET* ((PREVYBOT (FGETLD PREVLINE YBOT)) + (FMTSPEC (FGETLD LINE LFMTSPEC)) + (BASETOBASE (GETPARA FMTSPEC FMTBASETOBASE)) NEWYBOT) [SETQ NEWYBOT (if (NOT BASETOBASE) then @@ -2924,64 +2818,64 @@ then (* ;; "This is the first line of a new paragraph, and the previous line must therefore have been a last. Both paragraph leadings apply in the gap, but the line leading is irrelevant.") - (IDIFFERENCE PREVYBOT (IPLUS (fetch (FMTSPEC LEADAFTER) - of (FGETLD PREV LFMTSPEC)) - (fetch (FMTSPEC LEADBEFORE) - of FMTSPEC) + (IDIFFERENCE PREVYBOT (IPLUS (GETPARA (FGETLD PREVLINE LFMTSPEC) + LEADAFTER) + (GETPARA FMTSPEC LEADBEFORE) (FGETLD LINE LTRUEHEIGHT))) else (* ;; "Between lines inside a paragraph, make the baselines BASETOBASE apart. Oldcode subtracted paragraph leading") - (IDIFFERENCE (IDIFFERENCE (FGETLD PREV YBASE) + (IDIFFERENCE (IDIFFERENCE (FGETLD PREVLINE YBASE) BASETOBASE) - (FGETLD LINE DESCENT] - (SETYPOS LINE NEWYBOT) + (FGETLD LINE LDESCENT] NEWYBOT]) -(\TEDIT.NCONC.LINES - [LAMBDA (HEADLINE TAILLINE HEADYTOP LASTBOTTOM) (* ; "Edited 1-Dec-2023 11:45 by rmk") +(\TEDIT.SHOW.AT.BOTTOMP + [LAMBDA (LINE PANE) (* ; "Edited 1-Dec-2024 11:27 by rmk") + (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 20-Nov-2024 10:17 by rmk") + (* ; "Edited 2-Nov-2024 18:46 by rmk") + (* ; "Edited 30-Oct-2024 18:03 by rmk") - (* ;; "The lines headed by HEADLINE and TAILLINE are linked in a single chain, and their Y positions are adjusted so that the top of HEADLINE is at HEADYTOP (if given) and it and all other lines are positioned relative to that, based on their LHEIGHTs. If LASTBOTTOM is provided, then lines below it will be chopped off. Returns the last line in the chain.") + (* ;; "True if LINE is displayable at the bottom of PANE, with the heuristic goal of showing whole lines but not if the line itself is too big to be shown at all. ") - (CL:WHEN HEADLINE - (CL:UNLESS HEADYTOP - (SETQ HEADYTOP (FGETLD HEADLINE YTOP))) - (CL:UNLESS LASTBOTTOM (SETQ LASTBOTTOM MIN.SMALLP)) - (for L (YBOT _ HEADYTOP) inlines HEADLINE do - (* ;; - "YBOT is the bottom of the previous line, move it down") + (CL:WHEN (IGREATERP (FGETLD LINE YTOP) + (PANEBOTTOM PANE)) (* ; + "For sure, the line's top has to be above PANE's bottom") + (OR (IGREATERP (FGETLD LINE YBOT) + (PANEBOTTOM PANE)) + (\TEDIT.LINE.TALLP LINE (PANEHEIGHT PANE))))]) - (SETQ YBOT (IDIFFERENCE YBOT (FGETLD L LHEIGHT)) - ) - (SETYPOS L YBOT) - (CL:UNLESS (IGREATERP YBOT LASTBOTTOM) - (* ; - "1 above the bottom or below, back up and chop off") - (FSETLD $$PREVLINE NEXTLINE NIL) - (RETURN $$PREVLINE)) - (CL:UNLESS (FGETLD L NEXTLINE) - (* ; "Concatenate, keep going") - (CL:UNLESS TAILLINE (RETURN L)) - (LINKLD L TAILLINE) - (SETQ TAILLINE NIL))))]) +(\TEDIT.SHOW.AT.TOPP + [LAMBDA (LINE TARGETY PHEIGHT) (* ; "Edited 21-Nov-2024 15:02 by rmk") + (* ; "Edited 2-Nov-2024 18:44 by rmk") + (* ; "Edited 30-Oct-2024 20:18 by rmk") + + (* ;; "True if LINE's true top is below TARGETY, or if the botom is below TARGETY and the line is very tall. ") + + (CL:UNLESS (FGETLD LINE LDUMMY) + (OR (ILEQ (FGETLD LINE LTRUEYTOP) + TARGETY) + (AND (ILEQ (FGETLD LINE YBOT) + TARGETY) + (\TEDIT.LINE.TALLP LINE PHEIGHT))))]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (24497 25906 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24507 . 25904)) (33264 111915 ( -\TEDIT.FORMATLINE 33274 . 68334) (\TEDIT.FORMATLINE.SETUP 68336 . 71727) (\TEDIT.FORMATLINE.HORIZONTAL - 71729 . 76125) (\TEDIT.FORMATLINE.VERTICAL 76127 . 78330) (\TEDIT.FORMATLINE.JUSTIFY 78332 . 84272) ( -\TEDIT.FORMATLINE.TABS 84274 . 91761) (\TEDIT.FORMATLINE.SCALETABS 91763 . 92766) ( -\TEDIT.FORMATLINE.PURGE.SPACES 92768 . 94078) (\TEDIT.FORMATLINE.EMPTY 94080 . 98910) ( -\TEDIT.FORMATLINE.UPDATELOOKS 98912 . 106178) (\TEDIT.FORMATLINE.LASTLEGAL 106180 . 109662) ( -\TEDIT.LINES.ABOVE 109664 . 111913)) (112032 114453 (\CLEARTHISLINE 112042 . 112711) (\TLVALIDATE -112713 . 114451)) (114647 134704 (\TEDIT.DISPLAYLINE 114657 . 126997) (\TEDIT.DISPLAYLINE.TABS 126999 - . 129622) (\TEDIT.LINECACHE 129624 . 130352) (\TEDIT.CREATE.LINECACHE 130354 . 131190) ( -\TEDIT.BLTCHAR 131192 . 133819) (\TEDIT.DIACRITIC.SHIFT 133821 . 134702)) (135319 189027 ( -\TEDIT.UPDATE.SCREEN 135329 . 137153) (\TEDIT.BACKFORMAT 137155 . 139197) (\TEDIT.PREVIOUS.LINEBREAK -139199 . 141502) (\TEDIT.FILLPANE 141504 . 144053) (\TEDIT.UPDATE.LINES 144055 . 149043) ( -\TEDIT.CREATEPLINE 149045 . 150888) (\TEDIT.FIND.DIRTYCHARS 150890 . 152902) (\TEDIT.LINES.BELOW -152904 . 156386) (\FORMAT.GAP.LINES 156388 . 160379) (\TEDIT.LOWER.LINES 160381 . 164748) ( -\TEDIT.RAISE.LINES 164750 . 168177) (\TEDIT.VALID.LINES 168179 . 177573) (\TEDIT.CLEARPANE.BELOW.LINE -177575 . 178893) (\TEDIT.INSERTLINE 178895 . 180153) (\TEDIT.INSURE.TRAILING.LINE 180155 . 181470) ( -\TEDIT.MARK.LINES.DIRTY 181472 . 184183) (\TEDIT.LINE.BOTTOM 184185 . 187025) (\TEDIT.NCONC.LINES -187027 . 189025))))) + (FILEMAP (NIL (28071 30287 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 28081 . 30285)) (37692 118979 ( +\TEDIT.FORMATLINE 37702 . 73174) (\TEDIT.FORMATLINE.SETUP.PARA 73176 . 77999) ( +\TEDIT.FORMATLINE.HORIZONTAL 78001 . 82397) (\TEDIT.FORMATLINE.VERTICAL 82399 . 84616) ( +\TEDIT.FORMATLINE.JUSTIFY 84618 . 90639) (\TEDIT.FORMATLINE.TABS 90641 . 98441) (\TEDIT.SCALE.TABS +98443 . 99234) (\TEDIT.FORMATLINE.PURGE.SPACES 99236 . 100663) (\TEDIT.FORMATLINE.FLUSH.SOFTHYPHEN +100665 . 101566) (\TEDIT.FORMATLINE.EMPTY 101568 . 106254) (\TEDIT.FORMATLINE.UPDATELOOKS 106256 . +112173) (\TEDIT.FORMATLINE.LASTLEGAL 112175 . 115715) (\TEDIT.LINES.ABOVE 115717 . 118977)) (119096 +121011 (\TLVALIDATE 119106 . 121009)) (121205 142369 (\TEDIT.DISPLAYLINE 121215 . 134662) ( +\TEDIT.DISPLAYLINE.TABS 134664 . 137287) (\TEDIT.LINECACHE 137289 . 138017) (\TEDIT.CREATE.LINECACHE +138019 . 138855) (\TEDIT.BLTCHAR 138857 . 141484) (\TEDIT.DIACRITIC.SHIFT 141486 . 142367)) (142984 +186321 (\TEDIT.BACKFORMAT 142994 . 145548) (\TEDIT.PREVIOUS.LINEBREAK 145550 . 148273) ( +\TEDIT.UPDATE.LINES 148275 . 152720) (\TEDIT.PANE.CREATELINES 152722 . 155714) ( +\TEDIT.SUFFIXLINE.CREATE 155716 . 157091) (\TEDIT.LINES.BELOW 157093 . 161455) (\TEDIT.MEASURED.LINES +161457 . 163229) (\TEDIT.VALID.LINES 163231 . 171874) (\TEDIT.LASTVALIDLINE 171876 . 176698) ( +\TEDIT.NEXTVALIDLINE 176700 . 178002) (\TEDIT.CLEARPANE.BELOW.LINE 178004 . 180110) (\TEDIT.INSERTLINE + 180112 . 181498) (\TEDIT.LINE.BOTTOM 181500 . 184496) (\TEDIT.SHOW.AT.BOTTOMP 184498 . 185608) ( +\TEDIT.SHOW.AT.TOPP 185610 . 186319))))) STOP diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM index 888b2eddfc8dfe307625c0baa7c687ea96655a96..9feea6bef8edfb14892efc3e8d9bb72f43b6dc51 100644 GIT binary patch literal 31362 zcmbV#3vgT4c_si-G|fm1K*0>n(DF4cvk)U8#Dfnhj)RK_g^Smr3D6W}*|0>&;medO z$w}iV8C!MTG|75n$9cG!*b_TW<7S(HpwNva+vs#3_4Ou>V>4Z{X*ynKo2K=)C8smp z$xIvV_n&j_0{~^W%NYXq{^xzp|NrNIodaJyF|Oqj2gbEb;((SLXUd)lHI`NnCzO6I zS4d1|wERTBvS%`(#tUjR(*TaD`GgV}+Sk$HqZ(q!R!GE^{y^wJ{N(I`;7~BE1Ve|0 z1BXI^e#O^6d+MHh=a){FlvB$}zw*iHY$BdX%zWzRrTG)5kDva;EoV=b=Fi@ODzw6Z zJZeki{2v+%9o(mM)KwW6IW#nOC^XWqoH%{btn=h=-Fy1XO^1|Yyu5#$O=i_X2BR|| zaf~IS&T!EDGU^tir zqny5HQRz4oORBlUiTr^AQ+(sOywU%69#PY<{ZkWhEJud1bbg=Wn@q&mWIV5Q(D>sC zOs_UkV3YflLlcvU+cY+nKS0?V20nZ!95@vIcZ_LxUx(~TeLH?&+QcMqN;woC>+nq| z0VTs?%7ikcaJSw#bk3hz@Kms}2q%cD3WZ4UgsGT>g=eD)MQKEyu-SnsyK z^cZ=SZS(e4ZnEWmWx!FNtAi>pUu)FSkh+U^<4ELc$~D95(VXJT#lMpLbJtarKG*AZ z_yS`=CB||wwV(usF)R!@5DuB3fRPHs3IxTlt+i1OHbF**`PA6*3Z-k8USct35<>?{h#W`_mI+m2m~4!2`T*_#P=`~KAFKoXjJK^uK-fxco-7zLwLvQ zSQy~(M87g}kg`$f!G0w)rt}}^SAxU5=)n#Gnn+^9X^9u3VIaVSGBT>96O%c58c_&C zV@Y}*R>rl-d|^7N6%zRjD-a9?a(S?=M4sM4N|YU;hoBPY-vLDw9a0L3BZW+Y>Ks0( zq^9x(ZCnGp!Yigj%@;s-ld{s`QB*n&f}zwATccFv@USv5LAW~{R&x9ybWmZLcubv4 z6ga&h4Z{X#A|@(Lj8j)JeFW1Iu>`%1C{wv8P(IB$D*(eF0d=x)fQ=t8Gllu+yR?eKyedF@SsvSLZILn9_V{i$s7sL!w8Dx z7(HQb*<>scKY;q^Jb;JGm1q?RXS zrnCU9wd5Lj#R}8d4k{cQGGflL47VjFiK8NER3XYq$Vz z4^j5D`SK5u&s7}3XKQg{Ve_#S$LnljM@zNk{EDN-p?gbg1Opa}Fz@Y6&UwR3thL@& z9E>m@M)4Cq&&)e-rYv1vYW?%qP=lM##b#1>dG3p`F#D~oXCq4S{^~N@&j#=Lm)ABc z?`QjU$Lcj~|B?bEVEaqD3m7q1++X7vig%SBTWMP<4%S%sp37^+aBZP@4%zquP$n-s zw^sDl*aJ_mv^|NpdpB0vzRFXdUb%b=>sz_};T_JWSDbs<{Y$$xSFguc$L4AefBPOj zcWyq%?q7E9+I)J&@i4nt-=jOK?^$3s&+$R&j+e9B0e2NAYb7?h^>mF*Qhx?{O^+?@ zd~j(O4P%gft%zMj`j%SRk@t2MKaF~MjqKBWf@>-E zX_piKF6RaYeiY+8O5;3=ffEp8KL*$_f*rfWKFzbboa@wW*|iIY*}0ZV*b_;ybLD}O zv-o(8DeTMfM-5T4k_zCyGC)P8Wgc3VD&PF_u&{Ez>Z#uw1`9GbQfj4>Qy zyh+xNNf=}!7;HpHlf_6Wq&z-XjMN_H{6ps$BB+e@ZG8m_e zq0Q0I?%(13+R~q}`?sD&KYz6K6*-F!Qn4+NVLv-xVeC-ln#{%QC3c7?cL+qyZXu*S zUm0NgtH=o|E_Ts8;oH69`UyL)I|N?tua)0Ix|h-yDD8O`eTK!c6o*!K17*+AQr$mC zq;Q2s?1j&PPWracp|HAD8K#vyC)QE&8o`3@EIo(b2FqCT)AD|maKTo$N!bz1 z;zLYsi>-n>0s2h|GE&;uxixQF{R+?TYN!5SZ85b?>&y|@WUSjD=ZbUZ(t%Cz>id`f z@uto1psUOOcq8@ob2XM+U4A!wjAOwhHVzh}SS2c5*$Z5c*Om?x@8`^_k^3G1p>NZb zZRe)Ey!?;-n-x&c(gCq3+pzNkgc^c~%ePP;ZrH5sL3M)WthF@q^lsY}Eza4^uM0Iy zh$Uq|3ol}WTKQFp2cjX&W$q0^-rcN+H{op;OF8H5 zWs%B|jZnRUI^{~Yb0T$bu!vkmTCS+-?T)grw8fAOEZS3aN>ymop%lHQxv`&AS_aH9V>CLs&J(o8hCn~%YO?kc1w6`nD z`n^7*(~n0Z-u@cviN5NHih)Kk#rs(ob3+K@yv)d2*@sqpDmT(+aREKOmMu_E7kE#f zV|yrJ4dP#v7Zaa)E8DY%p4vfe1Zt}Tbr7hd4%AMd_9V+ec1nFc!cvf4S!RQeD+=8` zcyQ>TVS9mwSx_?>zfjA9V?#sAvGJpcNd}Ez6sl&k^(DzBwWE;N)eLfkhquWAwWOdy z{ecd4FvK;r7@L^E8}v4_@)3JW!>|{~mSV{QgSr(ALm6#u99m%>X;8_U(m6G*a3#iNlz}zzB>N%^B(%2n<6TZO$Va2#c`oYaYnX6I;8s2PgkWlD zE(}}?1NTMMs zLXV~<6VqBQ&Zc1&kcEN$Fha~ssIWeE_=01Y)ds^^a0~{jCfG=mfh{d+w`njrfwPP#hbI%@ zF~gvz30NbNFzl10ZweLBjjdCm0@aUM$+Bb}~GHpo1U`y5u>{)VvVPKnJ^`SBIiR?>c3leSwSl7Z$eE@be z%%Zh7(BcV;k6#$KFl(}r01#TX9Kg)V$I+m2uC=9p&B+dS<2i*h?IQ&;HepGPRUuB! zfn?1MhR9f(nO{DsoIQ0)Svs}+Q9LMjpE`Zd@w0GqjA7P&7*Zg#ZyRf@-$sqnFpGW} zwmN0PuyVrYhh2z_Thvc(rPGv9gQd%6-r|`}OW8if6~4~l*db&owc6`(J0g19g`N0# zAW8OWSC_t#RI-umJT*_O(F&(Q8{`T9&&>bMYl_Cm+)hmJdNp7jqD_mYnL78~gL zT_ev+r5vnnsKEg-wAfi=?v~02Jwx5hUA}>JGPkVB2f-FK`B2mT^UOB@y@%`a`=Kpc zxnRI!T@aN~ovYYgBPFhzS9dMzMs;4+EvxfGyF+z;R2MwY`~%Q+d38ZlXXWZabv+Qv zHGL>0w7gzGdc8x`fFEKQEN*NMZ=jFuK?C@d4M1}oK?7klFm|4W2Z|%2fiW~-eY1b*XQ0xlU>uqmk{4HuP+AiY#2;Zvh6}Lk%2WH@&n%< z!*BwK2N09Y!g1Hn_xdmhmnVn7rNjf-zG)*S`V|l1gYv=Lnc>~Yi7he+D>l3f`3XS~ z0q{}=2F7`hq(v}h*>Ey8F=JS~;Q^9Rbz&kj!#BHpVJ4HvgJOv#*AqJ&4MWPHaEHd! zSQ4grS<@g~4OlrEVjEjA4%7&Y*^|q4h`AI3Kh^9ofz;1Q7&Iq#E+gMoG z@){67vm6R!tS5IA93W(_H#ZN1a^)sr@}LI=Gt{Jh*>UM&8U{W;4168wvQl!UqU6_4#;vkba^5ju1q7$LZDAKSaR zI>405wNO3#wYPs+T39dc`P*U-CG8>01MHx$75mEnV|P+_8ym|$F?+^B#GpUcLE2+$ zcY51%(w2VVKwV-->@DP%3m~g#2dvoXZD*ZeUmyBut_1nEW z({4vj%XHAcZ#&6PqJ|l#F{b1a)129kDv2XdjpBmGjwo5UB(;f*mXHkC;Id)xOX)|) z?rAS$=fqYXLTPg9OPB9Klf92Bu({;bEIE5e6wApEKe^EW@n)kfgjHm-EN9d+q~z4X z)TEl>fPAx*`tRZD&YQs1cSJA1dg#19wy?z?x;;ZKDLqyOqYEBaYr4{xN$ak(?s!hH zqcp_3wHNSyd-)fcuJ5ln{(E#`e!;W1BMa8#tz}`RbJJs2Ew{M#66-3#hQ6@*Em-X# z40f%7vu1V29p%4Zot53p`zHOx_-F2?>(4WH*Y~wb04;azV%?RSSPy(Py^#7??_2ao zoUM21`oAVd*A0%?UH;kbay-iUDF28h-~OfN#xB-ZIRNV#xFu8m?w7@Wz9n%s3i}`G z=x2NX7V;kFs(t03?5^WU zwIoD|Kak&FuO(zk$HrUbVF_LBl@H%*$o@53_TQ;-zr==F9#{$uW9w;P=JzGAJqZL! zB+<9p;m${s?$jLDJX)$BpF39iV#!s#ig)LZO!bq|w}8!Q=1#1qf4aE-7k6ewM^~>i z9=!75xvcEeS8K6l=he_?WWu-QcO@9jB{qQ7P*A8hJu@*4LYB7fb{4yx3AneqtG_+J za`^$~b*)@J>nwjM2Dcj5E3QW_kO=89j#?>8p$<9tV@k1C+iRr+c5L7;%yGt+$u$e$ zUm_rQ!j$K3f%Jtf}uA zc2l#L2yC+Dh4f&(VWLdpv?*MYEhT>$yMS>P{_F41fvLj@4NE;S0_Blt`9-MvxNSsTtUll1ptHRU<_fOleXmx z9c02NsheMLA3;!#18!H2l8SDAO9ObOysimZgGOsHc$?M)@xXvzVc5ck zE5`~l;2~zPn;8Zuhen!7zKhxOk7>?nyr6V2*;9^HO2W&EM<$Z zL`3v4&x7rexoBM|7GH3o-BEB+r^kIY8MWSvj|W*7tXi-=jY+%K&f80ZeLIedhnL%r zr8wl}tMA|pE20msvrgTyey3=2@kav==>UV5(R}KWPe^uKkBWSRdrv;)z~V$jIp}oa z39&J~@^Rruz9IR@I=wzKYpV%FOcFw>Ru`EY5lMHVXRTnLqMi)m$i!0?!DJGaUH9%Z zaA>A9M`)5Z6k@^>c;Lu2Cu-R@MnGiJUlH2Y8)7pqgutP8S)dm{)& zokkG2VIv3|T_XtFQX{BY_k&r#F;@U4vxb6!W_ggJj2m-7>1qTuyH3bz-k1wJcOz)X zbT&~+-7LcZPa%~yH_O;qBV<&lBZ7UPMY{{2abB*#!)$^0hE@fZoG~LuArj_p)AAb5 zS4>V(kSw+p(H>{lWM2n=l9t7B#BTGb-f;xF$|}Yw_SNL^ctef0SW^JROmSfsZy_`C z6))tOk#Vqig91}|@PUGO&ctTs2R)RM2b5Dh!GIon^G_7Vr2_L9^*?FIXr^*%DaM_ZfSQ;Vnzympn0 zLt#?_t#_TmCCOJ`c>6%ngbLyX3npwu;0EFWQk`X_hP%hi3v@uF`Zyf^z*z2Vl@3Cf znVO6pB*{vbR}lQd@FhYB<@Lb_p9g-K3FN@GD{u;=Si_+O!+>-k8csFSdPRngsFu3| z1zC=MDG6{qRVTSwLP$U)?t~12z_Yo}k1A0FT}vCmw$joBq$F+?rUM06a$j-UA$qhT zv<;R#POy+86b9WHbb{Hd8>G9(+oh9u)FL`{oztW(R9&zLj#q zKv?mLhH`g89&!B6Q663V1(NB|&NH>SE>EC?b#gPuv4z?FvqQ5%1W3>NBc5B`tlPA| zc8luUW_@N~V0fMO!P)>?^ue;R2VYDf;@%BA1Dp0QuFd*u(?LYv%m!;Kj(|RM>Y>WL52_c>VRq(mCT|b z-F9T7?&Z#^-K-bRDnuViXI1~UZn`(&ru#ixF4QilJoY*HU@-(VH$B99UT$Z-6hmg{ z$g@MW>HPp-O<;uBGcPHt-r4<_krM0Nd~}|q=ULy%uh$&DFi^oH(2!x?4Z#*F^cHMA zCNT$bI)=w>K((W9P)!(iNP|qnoTqb_e;B);q}Y%|LxaF^T11GzVyhv!f^b;A!EY@@ zlQ_3#L&SEqzjG(?db7#$o^!(PB@NvQg-pxts#YmQa&m7fz7T51k zw^n@;aw%2qN|!2s%h5IU>YiG<{4@TX_V(4ve-o{?X{lbf$8%Mxyr091ol-Gyv(6m0 zjNCeQj2y)6ov;#i3asB#{qx;r9iC8A!m;#4I&0J?9g+!L!>yfi@kGe7!LD4}WpVLkG_tgAm!-8XOS|U=mpFfOAt{?_ zGrq;Ci;K@EU)NsWTHQ@wn-}_%Z)k7)>(<=ng`VW=sn`E?tLmoj%?np2-$=ayc-QxM zpLx@=DUaHgGSqURB<;JZwOKC3G*y-c=efQ7 zDss$=ephZa`fGfPetTT)nb%n-dVUT6-n=l7d4qL|zP}$JH+8;?KWtv;K$?5|?o)3* z$H%mC`4e*xa>B4wNo*7jeDc2610dGc0Rlq}K7XKDT?QE0?C-#}5cnFr%!EKnh<0X! zU4?AM2dG#!eJhAVo3h9>f;a29B%DZQ4Z%9I2C-M8?jWio8;p9Js%7};J~}#SCI{#| zo{^WVjn)fBY`&o9<}M3Oeja$HL51drT9A!W`qSjd2yxag&Ojtx|ZH)i5#= zU6b`h0x@Aq7$lF=-<&?p1f1hUjNLZi;3(Yq&AEf{YHkC@iPmOl2c4*F29s3P3^fgm zaHi3~g*8zbM-=wv1N0T2Xg8iOFK@?A}wB!y53*JU=ZQZ87Kcy8RZZ2gJ_r)p!08 zK03sn04??*HkhU`0+sEBxY)%yBfI#_tT^Xa?_h(R{UX~*Ht;Rhm)$51U;y-hO`Yw1 zN@W9Swim;c;UGA6u~&D<*+VERyc>m zG*tRfJtm=F6OFHnnfTPZHhz9UN1lnL<9P#uLhz75{}O ze#kaFjgok9oK)?aHb~JCpGw(Ml5-;DG7Yh-pnwC%0m|ce}nCT z_SIpi0kYL$L}4I}G#SYD!}U?>bbdkR3uBbXH-o4%^a67bhQ`2+RuuTIgkc-Ch7v|3 zxlw7@vc%e_CqxnKQsc1h`49nrVdyPW_Hqdr3o90pWABOE$} z38%#p*hG4z;c5hGBJ$BLP6S~&G9&_u6}Mg}deBS>AZFa?Fx_4O1kS41IYN9(%x$XFK@TUi=~vh0(Y(&u6XQ|e5v0({FR$zMYk_e637;#Hx|kaWR@&PeoII zxv@SIjjV62s<9{3CI2=Ib;+-4sg3c&orm3=q1xUhL)B7in zXXHc6QB~V|Hk#V{M$#?xDXpY#eWRwPN>O}8`Lf*Zbs!ka2c|5@MMM{49^?%!f~A0o z8iWN+Mv$0|tdQL#7f}IM=|x#NN>IL(Ga-u7ldyMcz~mw2rW*waqnZLDJ0pvp=ngIU zPhUxO!5)z-N4OF0`lZs+dwH*4EM+0OypXQ$%FOlNeoAM8MsvbzolZQljAt+ zbUCZ7Ip?b`a?k%=4uiziBn^W^W|BYQCIG?T+$oelTK=mAq5=`nim_n-HQOcoxT&vNx+`+g9X>%@ zFjy4#mWeIh&<25DSllp<4Ut(7L5zfMfP`o}rjSM01L+DJ;xzmQ9J@781Q3vwkodpJ z3n-L=BDjE1WGA%S2cNpiJjtT>L@_Hdb?cc$ZR<-OcU!8w5Yb|s-(Si+op!yDcHL3E zF;%@L?YtPT+$4=Tu9WVT*MnqXA}s%Jj%+Ei5dOKDMId13Is&RCtb1|e`SRmZrRytw zv#YdvjgWuughscu`Zu}iKg^fk&d_~SmVJaKLt0WXn*lhS2x2$$(H%hzAZW#nAnXtg zpk_xfj28`gU{q;~rBUnuE)S_H;+Lk8kv8eeHaa_yzn4+yd%;>=Y33<1=n zrWQNP|CQ&+5TSlo2RW9XoQcL%Xxc)lKUzIsu25L4sW9-_lxr4%na_~1Y^xT){&+Zn zplCXwDoz3;E>C9UI-6MCfTa)Rr^X>+5!f#z0icdqB#TwRiPyMn6;5KaE;gM{WPosF zwWQK^CeTc}bQXb7fcgZ_FHDct8*~gq?#B5f)XI+p;V3#3p9C(5VIH9`z@mLT*wO2cu_CPqB^0tti3d&LIxECW!BhBrN%Qv9 zp!qLuT*L`JM1RVAuW(*N-+QT)Mr2fp2Sp*FlTzLEVO)~M>qKl+X@O#`=o1Io>MzYY zQi_$H6FwmqZp(S`nBmOHknDtzC|6Cj@C(5JY9z_gFv%qW)2O}8ib6zgKnvj+tk+kG zl|WFpR)$VNH>@q}xl&;kw~P4=33}9!#VkZ<7RZ{rCRZ$=@R&VnjB{a;k+TQl-W<+l z3sXVE8q<)q5)%U(h6PhE@}C!MOFKR!R~n15uujR()EfN60o& z(7yJBcus=glO++AroFl+DY%11Y~aVdkCeImB!8s5^1dkX>HFo>jY%u zx?Du5*a#X{lT@_^5S@x|1T`PZAs=pIuI3Xs0hrCNbQ&2OzJ+MbfoG8H8tMnjYJk8m zVO0TT&U$GKN5kk%eTOQ^`=hwyblTYZB$FWF&J2PjF_2D=lNiYH(BM&Z%)>xV;Nco+ zcQyirf)}YS*Z_PIYJ#Cpd&sQ~b73>|-fu-eN5q;>h=I3SsEA$6 zdVyBX5z3B_4STGqd+~jXWGX^Q+PX;XXhP5l6GJKf9$|?x>Pi@(#A*L}-w!rGs*Ue` zHuU`>t~T5;Cu|HZCk#@N^7~D^EZ?J5`%=|T6Zv{2@)3%b-?s9J_=Fk4!rP%m{4^%q z3<&n-Ncn<=g&A}X(@?u<MxwT0+L`8tvC2Ql&e=-lsdRgK$GJ@>r_aXJf|Urgar=Ja>0 zggJMLN9v?$tG`ptZB=fMxUmm%_W4*7p>3VvJ8A3xQ{xiOzS8RZx)9x?M#L?2#V%CGI?H~Z8J<^__2}LI zy0!WmJ@jm?zRY@XpGEbD^W|4;b?nBW>r!Q?BrZ)Tddt6Il-FeWHF`k#A5eL{`s4ZX ztIS(DoTDb*^bd%4}ds9D6{lcU*3&#ieH_>u;A|W3bTT_ zNz~&vuADLHx(>|)kP0Nh+en*2x+PSEgwPGsbpSB!`n?3Plyv|QVz`-)hnqK&FeI9K z8b+iBh0`opc1v(gE!+wlFUq7Tgam zV(}chGaS(+bnSy+A9>jSCxvx^cRp`j0#VNwB_qX}fl=WAkO<%#!QMwUzKoV77KCSv z7@ydwp=;nlaw6)i%wTAgG*u`KW24E_#QqN875JB(sZnu=ia!8@X%(@id|MP`B-j^X z!jgL51>6GBr*}UeLHI145Z3n`t+tk@^xh|vsm-TT<&3ttdEs!f9FK7>#A~VH5OMd$ zqQ}*i%l^}9Z%nbwPLJoR@0ouXhlTGf|6;D|(bQ*Cw-XD4J^tHsu>3{jwhyh-<7tm+ z;H@yz>YeLcb8>w~ddBrVrOGve0l0Ms>)fjRlDT2eqD|V0siH9&(U#=w+s-X2tzC5g zn9wFkxVCIswBcyo}(2`X(|UT%UC@plK2Bc;_GWI zIv_%hqD@b(>JS~~qmz7(Broj1^0}oKudh`3XFh93pf~<~lApC-{VQZRQr_UF>T%$? zd1ws~yQn}%h9_xILW|+X8AFxfPK$!jZn)>sRG4ih582_9_@RWB$c4LXm{{qxy&#HQ zjV`&8@9peby?MdobS|h1bJ9TJG#*@L*rWl$<-Z$zKNZ0{ZgNymJe?WQ0PjJQs~mQR zW+0AVH3Omb0XGO?gn^5*a^n@#1V(H4mzxd7P>bni_i-qHaBqui-o=Z3f(3h{Su&pFP*KO>_2KA%Yx#K|vLZ=O0f_q)(4Ylq5UmVLheqF#Cj=@)u)z!SC298JNd-*g zi+KCWgR;n;Bh?#ZPP2@PGBW3@dm=*lLz!B6U0~5Rk}I)tjKao);ZSXW;1;$92-czj z0xsVG*>3M@%!A2pCnh@zt34P6J6$EX%Uf@4N>F@0oN>?K2RQHxKndtq5vl|J z7OqM215!R*M1l(&tY5;R)9Co8-=b*zeH`wD29VlRe1pn|aFbpg@j*7xH2xjKn?UFzVOKjfWAr0;qUZQOK2#K zZ1wHku+OYiNyfxo63N&U3@i9$jSg|S#1tx_SGW>#$bC2i(nA0~dU%CH8a6QPj^gMB zN+M<-QTdn{2wR9Q#xJzsb{71oP$G+856UMI-ZWk~ATNE*G4bmr2%_2!#6y&AeK$SV z6V`Z)n?7j72ms1tD9yGg?1}^aLWvj z5DfVJA^aTH{POJF@zY`+XOAx{Cr&E&o#8*$we$&P{%&(lmH9Kuy{Avzd-62kCr;hB zTmqgeXXj2TCzn4qfBMw&JtvpX?x)Kpk?UjgB~)`SGK-wEb0=pPv0i>fVE`USVcC|s zJiZT`)&sdrr%o%!m5F#r zS!MRV)2GoFg*S?k;POl5W5<`~OY>(xq4>_6y62>FEQu)Ym~t$`=<9f?bo%6(GpJ-~ z_C8cNe`@*6NA~$S{aTZA`o3jB(jPy5x^%|h-+?)_k-U|W$liS0hrhbt^QtFf^9Qo1 zvYdvaGUE5T%xP)(;V#Yv3_kU)ypOZ69Hs=nl6LAee&CD z$2b!psAonh9>J{yb(@KR5XI10B5{n!;)~WXFB-XRP#v}tVD)oivjsF+2kdu}HYeJS z@*7;ks?2Ym<8Ll#+;`QSLYsr3)o}JHVi32fzV6PD=8Br`?r6>;?zz~eYWv~w=3>NZ z#0}UojgZO+>kxC!**y3IkDs7qs2p_Xuk@SnV1jM7gr=P4LYXJG03p2U=#PO+=Fglx zxjg#`L2DpzLNHo#-u(7=QOffD$&>e;M)CPsPN2uEWurPeY@5{;tFiq`p55^v=fnmQ zD`=Z5PC<$>?@a-8GN%!JW>#1iJdIxdTL_S5DtmkuObiTaxpea0llTC4`q;_SXTWHb zQ+FH4CY!U-XjVHQ7EmTNuo7GFlQ9&7D7i{0s8#m9E@DK&xC$yp&oRj8iDkJlLJExf z1)>SmLH z7M!`m_d&Ua6gSAj>3z3OG5m6u!GN*K0^p`db*5Itqb3?OR5 zP{>znmTpY5_o%7ncjyvA6|Pt*JdW>_hTn<>P9o?oulN;^U{i-t-kv4Eh4F@tH{=Ng zsh-9GG-L{oZPOSAVsC7_{xoFi*tSCrnW#e+VTJM5fz43<)T`ut^+Q7c$ER{46wJo9 zEf!=+!tcVh4Cz<$SGgATSc29J_DkIm+r53=_*@Dw;uq~)**2_q;-5At*KEt^%9XzD z?U*=33v2Y%slRR{6kKgML zC_dj_@9^G%!CuAFJA3q=d*>IAzW5;jWs~qId_m83F33Voc z?&(=+Rhx|TQ_iF^zl2K1_a_pHxv~BI{k=-=5ZY1K3Gv22@6O+$i^a=5p5#F()}Qsi8RPV**i93_e>~0CBeeVgyK~=32Dff%zze> ziiSLTc&B1{!Dg}8oQgHrX2IXo6qt?i3ul4^RNMt3pEl;xf!z$!C@`shFYM~)zN*l}2aQOxmDR3k+ zBTEo)W@dsvI3UKu=T|sQBqHN9UOu0~Zi}Qzgwd5(AufreGSsM1MK#hR`VAVTVR?hn zLrNySpUWFOg=>sIuEm463@B`Td@{nPM#)6ANlvKfu#z#P&LB+(XgGtp1zA8CYIsgd zVqr7N3@GWyK8>YtOK>U@KFq>)9}-?p!7LP0#+4C}cVt}MpU4nJ>{K={WvrIA&`SC) zk~KF3E1rclr_CD8X>Lo|mCL{BQOfjbDd*)&Pm%4Q+I+r0Vpm88@0Vdl?0c9Pv!Y0rJf zmGzfC6jVdJG6yf0y^o$-`8yOaJy`rcyRY=leBrI2o!)!cmQ6pXW`jZI4~=c+Iqji} zC)>w*cqi7sk$c^P_2LEDr84WQ?9T3Bef$*_hbWZ2Oaua^#}ERF9oX{X~OqH!Ou z*mHm8np-d3;&l8jvWg!nctqb%`(etfYPmYB!@JM%L zcj=vcX4&!_3$+x3PH&Kf3VuFs7%8Rj{hZZlRoM;}`UTH)WgjTBPnWJ_56pFEAAE>C z(3kym+166}A$!pEht*=)P?;$$#X+Zc43&J4Dv98(qF3^8nSBP8Jd8>{_YixyFZ&r$ z$>(?_vKYvN?P5FlJY{#4W4z~lz}?;AV$R*G(_}UfV}1<(4>$#|?ri_OeoK&RuwrwD z6D-L7bmRG$l08+riw&{BJ^%LBdht3oRI#jF&4v~gun`-|Rczpjx$IDx7s$@#PA#{c z$_C0Tc+aJa*nk_l z%f7zS#jn1L&&}&EvQtaeE$b-rMHa1Wt5`}`LHAmh8=!Y4oPoMWZ+Umn3r~RiHtib1i?Gw2fYa=>AmB+5@M)cZpDMFw(7dP6yyqTbPxWP=5d{34>kHLlC)sJL zarc+mX}0?!B~RrR6`FIrH&g622nQ2sn!mte>s#5ta_c7ch2jvKICCBA&a;V%ZH*Jz z#2gi!Sa1`Crm_h#$0j zve}zkKEHS+wepYO|K)kSdk(KQaf99&T3Ld`z<6H>T}^Dcf=l{DZa_IbmrayEBV?$B z21c+DQ#PJJQd!G(mh;OkK_-X7_P^)RwK?kAsZG`=7XK4FwedXY?ahrZ%O_9LV;j#b zTW@6E;;n4Fcn#|~&m0%nI5Fl&z_Tny4D2oTv7wTiDPYoU7rhtXoy)fW%Dfeepx2>t z;U~D?P51M3?;J}#%O;9@+4#y* z6Cq>n&V8HO=Q_{acNVU%SRP|{m)7SC|IF@2YxE)I{LR~R6R+*Mb{f%B%eHH4iY(jO zYpyZlf~2hLM1lP@w_hVNXr#I_OJETHkR`<2v~sROdFy>LOTW_wndfe+o#6Q`ygis& zjBCR*bLusO=4EIT!eepII%M&wrGL3;{UtPa>0h=}d%pmVSvmUN1UZ5ElH?f3rZ7qL zY;ijXeFDUDs@zPb?g8~(rY%hesIav3FTLwnj01~%1kW~+-g}5R#F!Uure@r@UfhQ2 z1kW|FdZD}Nt7wM4xc>DZ*WZMiROn~H1*|~Jzxr^+@&ubJK|}i0{QUB-jZo!~(w%a+McCN96oJpFpkm~LXv7oyv#6oU6 zK3MmvyFJ849$9!WpUuD72lVf=n|(@|Es6poq|sUaNSCoI zpVsv#DRfsps%I!G2lZs{%B^~`t9XNv%r52E|BNkdYAO2Jl2BN7>NmU3++-xP_d)}@ zn%%pp<;(0|Uha8L)DOtsCwPS6V$2lUr>6+K2Wdjg%hmYtwZo#35%k@Z5S>$(W-I>cKgJ}a%P z_afSD&T6Bqwwf$EW!Y=8+9|6&1Vm!MJL*#ojvt7m8JU+bhZ~Ib{wPap2VkP836y|! z*;oR0Sw@512dfm;JDD?KHZcREba=$5+&=IU9|#P? zjGs=!qy}0eQUfrgxrqw16C(rL**^jlf|v3GBory%C_or8WQ|fjKrD5G1PBOo*f0RK zZSVrONk)<(*ywn3T@9l|Znd*9>TO0+HFb`74Qc^U1VT*o3ovGQu-SNV2!apVFaRCi zzhN)o8yJ|OVLdTGCp3QJh=BG$`#>mU zX-VKdyjeg4m;%u1L3Cw*Ix?lD#@H0_xB(jQI@oT&2MDVnuMq+q@CAk%%Mqef3j=}{ zh8y!5VaEXi`|6+dqJ28lGvEc5R=ofj5tss?Ym9ULfY&=(o8un^CN~Bg84#L(bZ~^@ zQVGW5;OEdq`_d5-C3vKoO=NDA0q9h{05KUC!=UNv#Rw#m{>(7M z)C7n<3I_z?bpGKXQzgTAS50^PLl|C(>4B~wkAPxH#K-R^z)j$N{GJa&ul5?Cp7}n& z$FWEl%m#Vs!(5tf`i2QytQPhSpfY__C2R&<)=LoS{?r)Zq&`0etf7b>^H^C++EU9sgl%qrfKYe;Ac(g& zF~4*~IdSx;vUqgqqev)sA3b)@p%ZWu`Mh8h4|?Jo*r{M(d|v+71V!%`a!Gnis_dvK zfYoa-NfQu>mDU79!hup~u~=Hw(`v<0vP+$3uk%J*R1I={XIcP#FGj;$m6dicX_(dDJrS#eo-VAkQ?R2 zq58;s?yt{XLlu;x;!9{SQMV^do)pOQvB?PmHiOMmVomWY!@~*#1DX3@UD%`Hi5Y{S z{IxhVklsO^F4T#M#7zH$n#SrqlZZ@W-h7yq+9_4Yo3o2AhI_(lI0}?r*1ZezebBhI zKb;2POqGdZxC?2bHv=4Ql&r4=g2gCi5^|$nqAz(z5El7HCfH?HdO**DO3|lgG-XoubT^#vU`zoc_X&3br3SHYQaX7MN6DOt+*Qg_$SjqN1DQI4kq;EfWHV)LPAE=c*UQlw@n8d7L z3Aq3YIRFZ|A7YNatcyUQzhiFKXJiq#T_WvzUG3*zP3mL zSry6l><$2Ha1Ou}>;W|0i!ZigeWi~n#cN^p^lHESc`m=2-S$s}$@H*oWIy*1X3ds(D%z2k?QplV4l;De z^G50(R1=Z#lR85=ez@X90_r_akR~P)Sig7zZd(2g&TU)}Yjjn(0~<>SAL9&oj#k7v zIWh>Pzdj4{zdp;`P%1#qW5^b)VPi^Qq(OTOGu%BN%f#f?90#cK7DE!;;bxb`OR?7tUDiW%4q@ zS(1_NKF6AnicE3AJgh{fC)CuKkjFzx5^hCpBB4dn)LqD0DUkz^t-72ZsCmXLwX0=_ z{K-=+owuW0(9;{?SxqD+)g*arvHTj|d+5db3rLRZ??RA6GRabUJzgcHX7;Dm1kad+ zY&W@p|8G|S>rGezHiZa(vfdERZ}3E?(`y@(l4VyY@3ghXi#>^W#TKtvUKFA$4j<{o zS8;uN;b#fg%gdI(2<7MV&K>q7#F)FB1SaF4q^q1-xOjoNa?A|};5Pv`c0m4KgcMFz zEO!)s$U2H!nfqP(3-iy^k5*q{4%f?C(T6v?wy@6PO{_~>CAhkib^nC^ND6i@-tZ43 z6gwe3I}3lawJ;XqGM9gZqrd#QbGwW66!*Zb0?7&w+t0JTeEH%cm+hcBdfASD%5Edk zYk@%h!PXk72$AV-SEJ$8=r0erZ83;JUDkoX{IJvO*wGKQye+i#d+#VUbc-WrLIiI;|9LV*bh8A0XI4;*j`Q4fmWcPyn{(3ng@7ULVQW%uEE8Q~j z-MZpWn2P^FnS<_Y#`B=O9P8M4rp!8CmYMBQkU=DhR+aa4JQ8)NwmDF2*3m-vvE`w; z1Gz8dY^5uBn{JQs%+ILS0j1QsxZ`~2Cl`{b$ZGOO3#&go7#Hncxn57WW#YxSY~xqT z;U(*pz_{g&Z^`fC5Mub&z%yVGYMgr}tU(LYRvp%?%Nl{>$3-u`bl?2)rDM!tTfTJI zT6iQ3FVbD4SKNS-0Jn3j6IJJkEprL@A9CS0+RM2JmUUA2$>NT({fRNeN&qau>H;OW zYAQ=T*pDS|jAfve^RN*=G+~i|Y!&&2=?&9Pt_4Ooop8U~BTXe6SAOl8sH>eXdd zkt#eUxe{yvP=m+UNfrQ{BUk_i;a`h4n{* zj-VBhDq2f%yVKjM6|RYD!k2nBUb-SS*M0D0tnVDO%Vh-x%CIZ9p_mQ_n+e=4ITxK$#e!6qj# zR6DISRA=l?hb5R(*Z}Y*mjmF;q44V2Mmeps^1#Xow*n#l-6NC6M5{CcP)D3g_W_Af;x=T8dF9e+eVvQ&;{-!_-o@ zX_Fchn)H5(Z-salt)}%+M^7c>J&t$st|FY1;!{NcDbg}_7O7e&78xe23|A%;3|B)& z94jtJO^{KoxFWn9F~LZU)`TdJQ$(&23A|IWe&2qT#iqW*SDZPHy_TK#w&h<{3pa83 za@a=Uh2K%l!G+&Ws4!+n=}i6Y67eY0Ax0Q{5auo^`+0KC6_c+^=0Z+gqOM%%d*LBXd*Tylv;FI)S!1 zy;n|k7L?>vr&#;Rz;Xa>>%j8wdWd!O!Peqvo6Ge%qYz$Sh)%h=Vp8msFXeBR?}ccu zd9~iat@RC*-FV%G;M2MF**^5o&MW%hY*#U=H}%3)muzZRK}k(@y?;}ULbF|Efss#j z@wSztueSj zMG11`&fNh>3a<1F!0#;*P?Zg++z+;@`sc}~W;p8!Z6-L(2Ygv1z^2B7K6vkqvY_vD zBr^^-I~0}xOh6tfJ^-LbBp|@5{uX%jK*_@KH_`;%fmWtFaQvj|%A#mBe;+*PlYA?J zyx~LSfY}NK3kp<1a48zEJFkZI6a=xUIj{)1ugO@Y2=obQsmthIRS&)t9N<~1jl(X2 znaMC6(77LJc&#w1$Q@Qf2n?4Ph$u^s3A+;ssP19f@&JUK_Aqc>HcV1nnE-EGL1C-z zEWkCw9mx45wLWAB^ISq(xaQ_Az6rJGvIA3Wc8uVbSXQ{DjVl_+?LG*R|LF#IPI(YP z>$F;;XSPIh6${MWAD3F@UCu*oQGo}4tvt0$s8Q`G`HFtgc3!Jk&S@3ft5dt5)TVaJ zBI{q8o84WGbFG5&KIFg|4G-Rl5M0aW4sg@-OIj{TAz?sSTuz^zb#O4}aDKLb);sH; z+Pkne8<^VVyw$-v4NSUIyr7MkNpBC(=qV3DBJ^bgKr-cF3P~{p;S||aVBz9ypgiSg z+b+)f%ZTMgGp3g>U0bm{p5m7330SK4rj{?wRxH&9KZ9$H-@Y5S5967cn_~L9IRW)k=`=f0g=}Wk=OSS>+J)^ z1CjSG>qFRdwG`^_64G_(^Dw2x70vxdufVs#Rcg=dsQ~k)klCrBd`fNW2 z1!%(hBl8XtJD%m=d>?WK_N2k*0iZfkn8;uWvbznLfG8dj=>Z#;B0fkMfW&le4uE1M z(+0p3GC2U6tKnb7IGEUT0HGdcW*wF>J!9age&WS`&LCJ2O}YYwRv3zd52}E10dXLN zCV!sq?2#2fSE^dd3gSqNXCN+&G)6;Do8<#(CX@YY2wp24jD=DKP99WdXs<~Ch8^va zK~muDNC05v`(=~_ZSoO2c{uJg6Ji0il|#?w zX-kL7smZCf28Dlh=71o=u7%ZUbz{XNv(Lp!u6VBa_xxrIyGG)LRi2Jx^GM+zLr!N~ ztgwgY+$pS}iX)Z8dX!wna+FMoN;h9TFH_q}KiI0lq9;2WZi5Cr9)Nt4%&Nw(?Cm8;idXacNPxef1CynD^Exr6DyJrJ|cO601tz56*GHa9XC1&fuCZT z1c&%Jf=|k1it*&QiXbOw13qNX8bkZ1^q~;0e>AY*4wOvtr>xuwJ~HgW__)L^QWPjJ9S)Y<#TsBCXAewAK`9N6>>n zxz0rOdC|Yc{G5Fy`nLA=#>!UuT0hepeMfue*BjW%)D?X@_V%wgN)Gy7KXYaDo!C3b zcYT+)nZH`T%Bi-+#Jcqrx#y+Qc22&f{Q_JOa7WnA$5W&uKb1`$tCfCf)MiR9maSLquhJAil%ok|DHI?e!SStkSd zX-xv&556|2oE*2NB?2pw@sJ+|cJ+cZCf%I$qdIajsJE$Ff^Y7m$P44P53FFiF!7EL zJu>c~!HygO(-$)8rP?;0h9pGBgfc$(^Nx%CrFlKsr$r4j!QRB7FH3mKf9XOmj*rxCq@u zF&?F&qSv&D^X}KI;w_INf~iF?rEoopD3po?@Frghf)%;IB4@(++!nR6t=Nr^ibbth z)?kT4wac-tjc-Ezdx$PO@dV6u*2xXTgSpuHiYFHrQYN31IA*K-Zoz`x-L2nE<0Rpv+Ne#a^A)dN1H(JM8)-3a$n#AJLq%o!B78MH}Ku6uBZI zd_-2?p4|=aCRBJ2ec7-{5Wddcq{5$N9&EgOfq8P+Yj?W5sAN6Z)AS;);hb78j+B{) z64)59qq6xs_z=cCfg1O)U2%#*pQ{x+!Cc*sko3ibakq-UD3ar96GhVUSfUTYkel0#?n;iPBKR=_YgQ zB|X(uf@}znaI68q#xA(-4*(7^y~y<7vgL8M?eRGCh+bH}z&x9*#c6D!@@!yhg$KK+ zR$}eI==Ei^2UTMLdNuK4;M+6`pW4?}xW4Hfv0(vwZ*~XlmVx7wNF8^j&0@Ift&#fTMXr9yF4%W#>gnx)RQY#)oB)bsMRq;es?guEV6-7`p zNMY&u=ReP%SpU+}rArUysWRJQo0;0nDhJr}IUqfRtBhg^3nem>QFSb$i~x&}IxV)Y z$NTBri%HtcJ%XM1p?FBkpr|qeK`M-jBx3BwXN2e)hNoOUi$Wyya3aB|l7u*cJmePk z5U`oLB114^WY(CbB6<(|DEcR(8n(O-Ax`*mx3F~8RE!rLgjvS7Jn&Z!l1T>Z1V?=g zVxhu44oM8c4ayM!J<5L&>Y!c@fC9?RAdV2NK&J;GagD+VA{+wflaPf2SYz}`17vXV zjTh$e2tac*ns1z$BKLDZ8ITqEu`I}9)fjq?L7{pQ(i8CH3&a_#foZOMJ?{0t))u?fT`V1BWVPcm9+M*#Hm@beKuqa+$W0$e2>!67h+ zWFJB6wbaD^4B}2Pk>(|57^9a|wK!9T;As}AK}3w|*6|=h$z&Sg*Z~ZFRi_!i!5F&Z z8FWcOYo?{gPe!ew*O>KuLf(x#K7jgqJAG&;s5hx%8HFw(lYrZ+LjuFS`e=jag4SUk z+$?M*X;W9v!V&W-?ErL=86iVxIA68_D#`)WuvS+Ct!VAn7iNmyFsR`YY#;VN7!Z+@{_ zBd_CZD7G34#eTfDIui=6Zmg)`ud0jv{8p`GUF=u2*xLBMj(rXi%Uey?QnG5Xi-lK7 z{idKBN!q%|p_pW|WS~IgTFHRjKSCwrAzefb9N_`Q@$Vs_rHS|&Jgj3uWNO0mC+L_k z*ebOWAq&tJTvE-3My<~{5FR~Q?`Sg9QYPwZDJ39bjg#YbLcE2i@#XV+)I(DUo|Yf?>c8J2CAbV18y;djACQ?*z^7BKpzh zoM;W_DmMpzy8f-;PkG{EFRO=Ud<(NC-GP9-AT%$c79DYr znswV*VT4rL&&L4N#{ksFlItto@oyxeKj7xQkZ+C{oIo0cnjbfQ=F|eT5r*T-z znZ4pHF7ithw+gRX)Ec!3W$=p<`2cU&w31`%)?oh4X-k=FdybZ8wX<^%Yu2-x?Ufi8 z^PFmeF=4b6-hwu0s9ZRBF2P#|@72BtRx{eACp~Ps(3PDcu>}{Eq1)l;yD^Z5-XWq8 z0bNciKmzoY4@d>JnE-NBQ&1$DuCF1SnJ1JYeZ&yRz->|}Dm<{a4ofD8gw#0!&pZg*bz|kfC*U#y{Z#kX@X->`IYtIb zC1nu6C{BTc_Enz)&8n^p6wbPwhVTp2ZQv4(sIxwv;3%1s@b~ zSfGKGt*+@@@kZ%W*ml@b5MH_ipeVo!Yq8Sb%@_U_ab3cSJ8V%!DAJRvnqD4Z%ugO0JPOaw6fv z#Y7G(933Rpfz+`C2fe^J0Oa?n*a*PotcbG~Fd`vb#v{gzQ@|@Ccf=YEQa~^^XAOK{ z?Hl97!Et?=AvwecOGBOHhn|sbEGz}Z@~>clO=3cY@V+JVJpv=12vs&isDvtQ$T#4el$%-XG|2D6#T^K_QiUZN7+j)Tm$+Po3nHBMHfPwgBrKj|Z zt%d)X%5Quvf#+jEzU&m9%cnMqPbKh9aeW#B51gn|3Y&_gIr(6(b5#(Uj}7&~_|!{d zs`}v(%&;Wb_`Ru-j%JjPH6?Lh)dn|{D~L`$#R)((4P@qr@mxoZJm$HUKz%U%>q|9> z!-F~?=zvzn$q0^d6`+EiZ6<4>bqXq#R1KA2e=;e~StW_YiH?&ot!Yv|nQ85Nr1Lw2 zEq8&wEH~tMnC6^tlM;0K3O_~Lv3%ka4#Dc-e8wSs(<)atqI`XgmRzAyYg71UXgXC z1*Ar;(U(wN{Lt#ag%3$1iWY$Lk1IiZ(n#9y`6U4*r46mNB%cgb3DU(pqo*J}tP6%z zfFfJEI+6Q^V8qVo!fK+@xz_E-wLEin?%&sIb?2Opw)le*Rqx5YPu%jrvL#tSZ=r$(NTeeHsh)V68?7N~WOJ zdY)+XSJVE1T3({<3AH&mNr7@mQqud{BAER8UJrR&2Kr+|HN*b29z1S>to z>+nGmx^Oja39mTpEzMQoI}&pA|Wea?wCs#Jk?U}~j*k+0}PDMUNqRD*V)C4;PVMpsx)6Jmb;LG`pG+mNCGX3H_3a?rIDzlE;4L{?v7VR@viW|lAA?8=E>WaFC{@=SUDwq)ld>JHQ?i9CsNaYCDwQo_=oV2rAp5` zl`DgVUgpq)xyZjq&Px}?b5)htzO5;e*OwOap?ppc^AbKn;S??}Ut*>f2~VyC-dym{ zuQyhny38BG%pnABfmC4VCr!wmND+9U@VNO9@oSJXNV|cYDF8`ULQZ;)9}$ei5(&_c zzi}sqAJ%dm<@tf$>7Ecem#OY{Gd&7oyuK9dbG;G@9T9FHAHquN3gU3Bx}3%xB#q5( z+y*kF=zC_&jAFJLB%=ua5Vl^GCjutX4c$xU4|IZlu7EQ`LU0AQ?Dt)s6%1ApBM0$) z4vTNAz)B?oAW7bN_zDCoa_V0@0J`T&!KtXtdJyJSu&}pEQXry!=7@o!Xlqru8hwae zQJ~ijL9ch{Eb!Xa8jkzjC>Y`#Xg8FP#kG1qC=*r3VV?=!xPr_2gyc(m=MDGIEy~1Otesng;5`eTJk$=yMG1ypfU`WN72o zouv9+pS}oq;Bi0t7peJ~AmQ0s+#F1(*#oqY-_xUAKkwhS2K5nqd~4vTLQ* z7+C@5VFjEAwwvVB&UHIZK6gTT%^~8#>9{KO878B}d+1#84$8wm)7ezv7D1ZW(xR8> z{Po5QD)#1g@hF%|_sU=JtA$l)9L2M&v-Iclg$sINAYR+}xhx&uVGg2t>+P%qaqJKC z7Zmn2tNpvitGYIxrTXx)?iI?dAdHvZLb)%^7rv#xWm|4#)RlFm){DQxI-v4w6t@R? z0!v24g8!RW`HE!2w(FEQRh0M8QMg_^yecJ&ngTJK3%MqPZV94g$%M|}NsK152sxL6tI&?i^Z`5_1VLH(tjtm`67 zae1ldc2O=Jh``H2TmRrz9J}y!enqMrVpZJT@NL<-Z)^EC?Qm=@|HdYpRCtoY*Kz8E z+$PSCdXY>EFb`)`a$5D*p8utXaYMY<;QZj=K~zSMm=vACMhz*@Xod$67+?2bpm9YB zH0n`-Mztvb*S*P6K)Y?g$Po^vP$Z@38O3W1G_E`YjR!gmG|G^H#(q*LW?c_xb54C$ z<4#3Fvg%4TQz79qt}oR%vWRo2E7WK&L$KDB!P-nYgm>sx2<8$I7Wior#E?q)GYQXj zS^%J;c=dNmnnG!Et(6)isftZ49C|Yr$P6OITZD?p<SQ-`{+7<*lrp9q^6$Zg{iGkp!P>Sdk z#0u1n9SjOOh-(}=G=fqFO&565K!QxnB!@*z6ePG`QO6OE!DTrDC#ia*xwPasDg zvV*Om^<8a5=bP*uXc!=b_0|np6DDpb(?lh0sF_yf8d*~};y5a_&KFTX_NV}BwK3$9 zK0%GQbDx!vsoiJBRYF~CSYOV3IEbG^kR~uc^RHrwRyMDlozcw)Ee2&QM!J{^V>kB| zeM-!B?=N`xfRwXU+@zl$T7XVK)vE0nZAYlfX&l6QDPkTC9-BusObR!v4n^V_s2{KZ z@hM(mLK}%Tr8*+WQ&%LJ(oP){!bSUaayTveG>~Q6AJ^S8c8a*1H@0ZGr)vDubHFcKO-}018s63CT%~IY zZ}W*bSm{!sNB=BQ`sewAz#Ps67sx?|_=b4lI$r3GN@r-}yU7Lm;TQu2`^T+?KLH*A z0aCx_`5O%pf1_mfHBM?XIID453Dn>-2kC6!ne-D%@DT8AnRM8*$z6bD$m}~X(q?j? z`gG7l@&q}$rX^v8|8d z$10Xrgruo>+o&gW8C5uehHa=TX=7zFDwA!yq=Epnxz`>RMGT#3<5c-91A%gM0`VK$$WKXTd4t z{P*lQN-TeQ5SetGXnI1u^;Y4HG2Ku+9vlsnP}33o;9vxHSdi*~v!BDO{A6Vh&UwRm zSBfVc!Qq~WbJT-wc$0W|)=tGkZ&5t9mFp3RGVdY?g z(bu6|?%0vz$5F}R?8i{y{L!W3x9sfaJXIZ>V;@@*Z1($yj^&Q`_u4UrCN``VBvv%8 zP)M?)5mGp@6Mr>7>{-j+#_wyQkX=h@_$kdM5~M2BY6QyriY3lCDGU>SFZJj#{L(4$ zh+VdkGa2V>Wm3H@B2r^ad_!dn%Pb@zRs`o7H<3eJL_a{v^H8tea(i_LH+9|IDbt;r zF{vu3I-Xa}kq2rwIm6I&yiuc~Ye0C7xAX%$n^Z{$tTk%_oxpaPdo`z$HK|e@6V})Y z^XWH@cS*pApQw=ch-@S(f}hCcqspbUr|Rv*R%tpnU;3SSoLLirP8HRZ#2oS8ovqz! zjh+}=iBW=6QW(54fBeLerP=!h!-30*qG*bFW11hlEg!e{Mvr{#7@nV>%Ir zY2~?WHJAB)Tz%9{{yVYt!8CRvW?E*5&=#&$)#U3D)3TVs#bWah34z~+<*>Xb56wc7 zK}s#~4n#?mt{>ZGl@L9bFf+~6Zo?@31YI1hVhq?1l>aa4)>@ks9W_(;` zH3NO@`nyelhb)eqMuS}5YcNk`KJ`GiQ}i)1>D-XscF%|8tkbSlzGuvH>wf&otFc^S z{zQg{eqo0!ag6~(cd1x9cyX;%W6Y4(YJwK`g;_=jW8X$x| zYFIhz?wMz#?v{C8>Ta25r|y<%j+FX_05hz%r0zNRkuHDF+?4trV1K~nAH;d51{u}8 z5b*cq@A<2g*3b)tWL^Hj_h<}o;_7qty+G8ynKD4AbM{4ONx0J7PE^4U+ zZ_~vuHA5%@=6T~|DYAj`n5D9*Tkj=5Yt-Gkrsz$o|2DtJpdp%Ay{*+sYh;rt+f3}H zY%`skvdt83Qr&S@gSjbaf$15OEUFHLkIyh+D7Q%LfQGe3)#RHW1kQ5H<$hp=^j5xw G;{O1K!^%?t diff --git a/library/tedit/TEDIT-SELECTION b/library/tedit/TEDIT-SELECTION index 0f99c720..d0ecea0e 100644 --- a/library/tedit/TEDIT-SELECTION +++ b/library/tedit/TEDIT-SELECTION @@ -1,48 +1,50 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "21-Mar-2024 10:49:49"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-SELECTION.;461 130592 +(FILECREATED "17-Dec-2024 14:29:31" {WMEDLEY}TEDIT>TEDIT-SELECTION.;638 151180 :EDIT-BY rmk - :CHANGES-TO (FNS TEDIT.SCANSEL TEDIT.XYTOCH TEDIT.SELECT) - (VARS TEDIT-SELECTIONCOMS) + :CHANGES-TO (FNS \TEDIT.XYTOSEL) - :PREVIOUS-DATE "20-Mar-2024 11:08:55" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-SELECTION.;453) + :PREVIOUS-DATE " 6-Dec-2024 12:50:42" {WMEDLEY}TEDIT>TEDIT-SELECTION.;637) (PRETTYCOMPRINT TEDIT-SELECTIONCOMS) (RPAQQ TEDIT-SELECTIONCOMS - ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS SELECTION SELPIECES) + [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS SELECTION SELPIECES) (CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) - (EDITMOVESHADE -1) + (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800)) - (MACROS WITHINLINEP LINESELECTEDP) - (MACROS GETSEL SETSEL FGETSEL FSETSEL) + (MACROS WITHINLINEP FWITHINLINEP LINESELECTEDP + FLINESELECTEDP IBETWEENP) + (MACROS GETSEL SETSEL FGETSEL FSETSEL SELECTION!) + (I.S.OPRS inselpieces) + (MACROS GETSPC SETSPC FGETSPC FSETSPC SELPIECES!) (GLOBALVARS TEDIT.EXTEND.PENDING.DELETE) (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION - TEDIT.DELETESELECTION) - (I.S.OPRS inselpieces))) + TEDIT.DELETESELECTION))) (INITRECORDS SELECTION SELPIECES) (FNS \TEDIT.SELECTION.DEFPRINT) - (FNS \TEDIT.SET.GLOBAL.SELECTIONS) (P (\TEDIT.SET.GLOBAL.SELECTIONS)) + (FNS \TEDIT.SET.GLOBAL.SELECTIONS) (FNS \TEDIT.SELECTED.PIECES \TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START \TEDIT.WORD.BOUND) (INITVARS (TEDIT.EXTEND.PENDING.DELETE T)) (* ; "Setting for a %"Laurel%" mode") (COMS (* ; "Selection manipulating code") - (FNS \TEDIT.EXTEND.SEL \TEDIT.SELECT \TEDIT.SCAN.LINE \TEDIT.SCAN.LINE.WORD - \TEDIT.SELECT.LINE.SCANNER \TEDIT.SELECT.OBJECT) - (FNS \TEDIT.FIXSEL \TEDIT.CHTOX \TEDIT.COLLECTSELS \TEDIT.SELECTION.UNSET) + (FNS \TEDIT.EXTEND.SEL \TEDIT.SCAN.LINE \TEDIT.SCAN.LINE.WORD \TEDIT.XYTOSEL + \TEDIT.REGIONTYPE \TEDIT.XYTOSEL.INLINEP \TEDIT.XYTOSEL.LINE) + (FNS \TEDIT.FIXSEL \TEDIT.CHTOLINEX) (FNS \TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS) - (FNS \TEDIT.SHOWSEL \TEDIT.SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL \TEDIT.REFRESH.SHOWSEL - \TEDIT.UPDATE.SEL \TEDIT.SEL.L1 \TEDIT.SEL.LN \TEDIT.SEL.DELETEDCHARS) + (FNS \TEDIT.SHOWSEL \TEDIT.SHOWSEL.HILIGHT \TEDIT.UPDATE.SEL \TEDIT.CARETLINE + \TEDIT.SEL.L1 \TEDIT.SEL.LN \TEDIT.SEL.DELETEDCHARS) (FNS \TEDIT.COPYSEL \TEDIT.SEL.CHANGED?)) + (COMS (* ; "Image objects") + (FNS \TEDIT.SELECT.OBJECT \TEDIT.SHOWSEL.OBJECT \TEDIT.CLIP.OBJECT + \TEDIT.OPERATE.OBJECT)) (* ;; "SELPIECES") @@ -51,9 +53,12 @@ (* ;; "User entries to the selection code") - (FNS TEDIT.XYTOCH TEDIT.GETPOINT TEDIT.GETSEL TEDIT.GETSEL.PARA TEDIT.MAKESEL TEDIT.SCANSEL + (FNS TEDIT.XYTOCH TEDIT.SELPROP TEDIT.GETPOINT TEDIT.GETSEL TEDIT.GETSEL.PARA TEDIT.SCANSEL TEDIT.SET.SEL.LOOKS TEDIT.SETSEL TEDIT.SHOWSEL TEDIT.SEL.AS.STRING TEDIT.SEL.AS.SEXPR - TEDIT.SELECTALL))) + TEDIT.SELECTALL) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA TEDIT.SELPROP]) (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE @@ -69,8 +74,7 @@  "Was Y0: Y value of topmost line of selection") X0 (* ;  "X value of left edge of selection on the first line") - NIL (* ; - "Was DX: Width of the selection, if it's on one line.") + SELLINES (* ; "A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line.") CH# (* ;  "CH# of the first selected character") XLIM (* ; @@ -88,8 +92,8 @@  "Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ;  "T if this selection is real; NIL if not") - (SELTEXTOBJ FULLXPOINTER) (* ; - "TEXTOBJ that describes the selected text") + (SELTEXTSTREAM FULLXPOINTER) (* ; + "TEXTSTREAM that describes the selected text") SELKIND (* ;  "What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ; @@ -106,10 +110,11 @@  "A Place for the selected object to put info about selection inside itself.") ) (INIT (DEFPRINT 'SELECTION (FUNCTION \TEDIT.SELECTION.DEFPRINT))) - [ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of DATUM)) - (FIXP (fetch (SELECTION XLIM) of DATUM)) - (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) - (fetch (SELECTION X0) of DATUM] + [ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (GETSEL DATUM SELTEXTSTREAM))) + (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) + (SETSEL DATUM CHLIM (ADD1 NEWVALUE))) + (FAST (SUB1 (FSETSEL DATUM CHLIM)) + (FSETSEL DATUM CHLIM (ADD1 NEWVALUE] SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ 'LEFT L1 _ (LIST NIL) LN _ (LIST NIL)) @@ -157,26 +162,44 @@ (RPAQQ COPYLOOKSSELSHADE 30583) -(RPAQQ EDITMOVESHADE -1) +(RPAQ EDITMOVESHADE BLACKSHADE) (RPAQQ EDITGRAY 32800) (CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) - (EDITMOVESHADE -1) + (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800)) ) (DECLARE%: EVAL@COMPILE (PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) - (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of LINE)) - (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) + (AND (IGEQ CHNO (GETLD LINE LCHAR1)) + (ILESSP CHNO (FGETLD LINE LCHARLIM)) LINE))) -(PUTPROPS LINESELECTEDP MACRO [OPENLAMBDA (L CH# CHLIM) - (AND (IGEQ CHLIM (GETLD L LCHAR1)) - (ILEQ CH# (FGETLD L LCHARLIM]) +(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) + (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) + (ILESSP CHNO (FGETLD LINE LCHARLIM)) + LINE))) + +(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) + (AND (IGEQ (GETLD L LCHARLAST) + CH#) + (ILEQ (FGETLD L LCHAR1) + CHLAST)))) + +(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ; + "True if a CH#..CHLAST selection would include L") + (AND (IGREATERP (FGETLD L LCHARLIM) + CH#) + (ILEQ (FGETLD L LCHAR1) + CHLAST)))) + +(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) + (AND (IGEQ X LOW) + (ILEQ X HIGH)))) ) (DECLARE%: EVAL@COMPILE @@ -191,6 +214,47 @@ (PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE))) + +(PUTPROPS SELECTION! MACRO ((SEL) + (\DTEST SEL 'SELECTION))) +) +(DECLARE%: EVAL@COMPILE + +(I.S.OPR 'inselpieces NIL '[SUBST (GETDUMMYVAR) + '$$SELPIECES + '(BIND $$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY + DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST $$SPLENGTH) + FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) + 'SELPIECES) + [SETQ I.V. (SETQ $$SPFIRST (\DTEST (ffetch (SELPIECES + SPFIRST) + of $$SELPIECES) + 'PIECE] + (SETQ $$SPLAST (\DTEST (ffetch (SELPIECES SPLAST) + of $$SELPIECES) + 'PIECE)) + (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of $$SELPIECES + )) REPEATUNTIL (EQ I.V. $$SPLAST) + BY (\DTEST (NEXTPIECE I.V.) + 'PIECE] + T) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS GETSPC MACRO ((SP FIELD) + (fetch (SELPIECES FIELD) of SP))) + +(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) + (replace (SELPIECES FIELD) of SP with NEWVALUE))) + +(PUTPROPS FGETSPC MACRO ((SP FIELD) + (ffetch (SELPIECES FIELD) of SP))) + +(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) + (freplace (SELPIECES FIELD) of SP with NEWVALUE))) + +(PUTPROPS SELPIECES! MACRO ((SPC) + (\DTEST SPC 'SELPIECES))) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -201,23 +265,6 @@ (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION) ) -(DECLARE%: EVAL@COMPILE - -(I.S.OPR 'inselpieces NIL '[SUBST (GETDUMMYVAR) - '$$SELPIECES - '(bind $$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY - declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST $$SPLENGTH) - first [SETQ I.V. (SETQ $$SPFIRST - (\DTEST (OR (fetch (SELPIECES SPFIRST) - of $$SELPIECES) - (GO $$OUT)) - 'PIECE] - (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) - (SETQ $$SPLENGTH (fetch (SELPIECES SPLEN) of $$SELPIECES) - ) while I.V. repeatuntil (EQ I.V. $$SPLAST) - by (NEXTPIECE I.V.] - T) -) (* "END EXPORTED DEFINITIONS") @@ -260,19 +307,18 @@ (DEFINEQ (\TEDIT.SELECTION.DEFPRINT - [LAMBDA (SEL STREAM) (* ; "Edited 11-Feb-2024 08:58 by rmk") + [LAMBDA (SEL) (* ; "Edited 26-Nov-2024 02:59 by rmk") + (* ; "Edited 23-Aug-2024 00:16 by rmk") + (* ; "Edited 29-Apr-2024 12:47 by rmk") + (* ; "Edited 11-Feb-2024 08:58 by rmk") (* ; "Edited 9-Feb-2024 15:55 by rmk") (* ; "Edited 23-May-2023 00:06 by rmk") (* ; "Edited 21-May-2023 09:15 by rmk") - (LET ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) + (LET ((TEXTOBJ (TEXTOBJ SEL T)) WHICH INFO LOC) - (CL:WHEN TEXTOBJ - (SETQ WHICH (if (EQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - then 'SEL - elseif (EQ SEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - then 'SCRATCH - elseif (EQ SEL (fetch (TEXTOBJ SCRATCHSEL2) of TEXTOBJ)) - then 'SCRATCH2))) + (SETQ WHICH (CL:IF (AND TEXTOBJ (EQ SEL (TEXTSEL TEXTOBJ))) + 'SEL + "")) (SETQ INFO (if (GETSEL SEL SET) then (CONCAT (GETSEL SEL CH#) "-" @@ -287,16 +333,19 @@ (CHARACTER 127))) else "unset")) (SETQ LOC (LOC SEL)) - (CONS (CONCAT "{S:" (OR WHICH "?") - " " INFO " " (CAR LOC) + (CONS (CONCAT "{SEL:" WHICH " " INFO " " (CAR LOC) "/" (CDR LOC) "}"]) ) + +(\TEDIT.SET.GLOBAL.SELECTIONS) (DEFINEQ (\TEDIT.SET.GLOBAL.SELECTIONS - [LAMBDA (SELOPERATION SOURCESEL) (* ; "Edited 15-Mar-2024 13:38 by rmk") + [LAMBDA (SELOPERATION SOURCESEL) (* ; "Edited 7-Nov-2024 21:50 by rmk") + (* ; "Edited 4-Oct-2024 08:39 by rmk") + (* ; "Edited 15-Mar-2024 13:38 by rmk") (* ; "Edited 12-Feb-2024 08:15 by rmk") (* ;; "This sets the documented global selections (TEDIT.*SELECTION), and some that are not documented (COPYLOOKS, DELETE).") @@ -313,14 +362,13 @@ (NIL (for S in '(TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.COPYLOOKSSELECTION TEDIT.MOVESELECTION TEDIT.DELETESELECTION) unless (BOUNDP S) do (SETATOMVAL S (create SELECTION)))) - (SHOULDNT]) + (\TEDIT.THELP "UNKNOWN SELOPERATION"]) ) - -(\TEDIT.SET.GLOBAL.SELECTIONS) (DEFINEQ (\TEDIT.SELECTED.PIECES - [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 15-Mar-2024 14:15 by rmk") + [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 26-Nov-2024 10:54 by rmk") + (* ; "Edited 15-Mar-2024 14:15 by rmk") (* ; "Edited 28-Nov-2023 23:14 by rmk") (* ; "Edited 21-Jun-2023 20:30 by rmk") (* ; "Edited 9-May-2023 13:16 by rmk") @@ -331,58 +379,28 @@ (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result instead of the piece") + (NOTUSED) (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) - (CL:UNLESS SEL - (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (CL:WHEN (GETSEL SEL SET) - (LET ((SELPIECES (\TEDIT.SELPIECES SEL NIL TEXTOBJ))) - (for PC inselpieces (CL:IF CROSSCOPY - (\TEDIT.SELPIECES.COPY SELPIECES 'COPY TEXTOBJ) - SELPIECES) - collect (CL:IF PIECEMAPFN - (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 FNARG2) - PC)))))]) + (LET ((SELPIECES (\TEDIT.SELPIECES (OR SEL (TEXTSEL TEXTOBJ)) + NIL TEXTOBJ))) + (for PC inselpieces (CL:IF CROSSCOPY + (\TEDIT.SELPIECES.COPY SELPIECES 'COPY TEXTOBJ) + SELPIECES) collect (CL:IF PIECEMAPFN + (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 FNARG2) + PC)]) (\TEDIT.FIND.PROTECTED.END - [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 9-Jul-2024 18:19 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 7-Apr-2023 22:13 by rmk") (* ; "Edited 23-Oct-2022 17:44 by rmk") (* ; "Edited 5-Sep-2022 15:31 by rmk") (* ; "Edited 22-Aug-2022 13:21 by rmk") (* ; "Edited 18-Apr-93 23:49 by jds") - (* ;; "If LIMITCH# is given, the search will stop there.") + (* ;; "Returns the number of the last protected character before CH# but after LIMITCH#, NIL if nothing later.") (SETQ LIMITCH# (IMIN LIMITCH# (TEXTLEN TEXTOBJ))) - (LET (START-OF-PIECE) - (DECLARE (SPECVARS START-OF-PIECE)) - (for PC inpieces (\TEDIT.CHTOPC CH# TEXTOBJ T) until (IGREATERP START-OF-PIECE LIMITCH#) - do - (* ;; "Move forward thru the pieces of the document, looking for one that contains protected text. If that comes before the end of the region we're interested in, tell the caller about the earlier end to selectable text.") - - (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)) - - (* ;; - "We've found the beginning of a protected region, previous char is the last selectable. ") - - (RETURN (SUB1 START-OF-PIECE))) - (add START-OF-PIECE (PLEN PC)) finally (RETURN LIMITCH#]) - -(\TEDIT.FIND.PROTECTED.START - [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 17-Mar-2024 00:27 by rmk") - (* ; "Edited 24-Nov-2023 21:25 by rmk") - (* ; "Edited 7-Apr-2023 21:59 by rmk") - (* ; "Edited 4-Feb-2023 10:23 by rmk") - (* ; "Edited 23-Oct-2022 16:20 by rmk") - (* ; "Edited 2-Sep-2022 15:26 by rmk") - (* ; "Edited 22-Aug-2022 13:20 by rmk") - (* ; "Edited 30-Apr-93 01:39 by jds") - - (* ;; "Starting from a CH# in a selectable region, returns the char-number just after the end of the first preceding protected piece. This is used to limit selections to unprotected text, and to prevent selection of the protected text between two unprotected areas.") - - (* ;; "Will stop looking when it passes LIMITCH#, or at the beginning of the document.") - (LET (START-OF-PIECE) (* ;  "Gets us to the beginning of CH# piece") (DECLARE (SPECVARS START-OF-PIECE)) @@ -393,18 +411,48 @@ (* ;; "Return the CH# just AFTER this first protected piece.") (RETURN START-OF-PIECE)) - (add START-OF-PIECE (IMINUS (PLEN PC))) finally (RETURN LIMITCH#]) + (add START-OF-PIECE (IMINUS (PLEN PC]) + +(\TEDIT.FIND.PROTECTED.START + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 9-Jul-2024 18:17 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") + (* ; "Edited 24-Nov-2023 21:25 by rmk") + (* ; "Edited 7-Apr-2023 21:59 by rmk") + (* ; "Edited 4-Feb-2023 10:23 by rmk") + (* ; "Edited 23-Oct-2022 16:20 by rmk") + (* ; "Edited 2-Sep-2022 15:26 by rmk") + (* ; "Edited 22-Aug-2022 13:20 by rmk") + (* ; "Edited 30-Apr-93 01:39 by jds") + + (* ;; "Returns the number of the first protected character after CH# but before LIMITCH#, NIL if nothing earlier.") + + (LET (START-OF-PIECE) (* ; + "Gets us to the beginning of CH# piece") + (DECLARE (SPECVARS START-OF-PIECE)) + + (* ;; + "Move forward thru the pieces of the document, looking for one that contains protected text. ") + + (for PC inpieces (\TEDIT.CHTOPC CH# TEXTOBJ T) while (ILESSP START-OF-PIECE LIMITCH#) + do (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)) + + (* ;; "We found the beginning of a protected region. ") + + (RETURN START-OF-PIECE)) + (add START-OF-PIECE (PLEN PC]) (\TEDIT.WORD.BOUND - [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 27-Sep-2022 23:54 by rmk") + [LAMBDA (TEXTOBJ PREVCH CH) (* ; "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") - (CL:WHEN (AND (FIXP PREVCH) - (FIXP CH)) - (LET [(READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) - TEDIT.WORDBOUND.READTABLE] - (NEQ (\SYNCODE READSA PREVCH) - (\SYNCODE READSA CH))))]) + (if (AND (FIXP PREVCH) + (FIXP CH)) + then (LET [(READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) + TEDIT.WORDBOUND.READTABLE] + (NEQ (\SYNCODE READSA PREVCH) + (\SYNCODE READSA CH))) + else T]) ) (RPAQ? TEDIT.EXTEND.PENDING.DELETE T) @@ -421,155 +469,147 @@ (DEFINEQ (\TEDIT.EXTEND.SEL - [LAMBDA (X Y OSEL TEXTOBJ SELOPERATION PANE) (* ; "Edited 15-Mar-2024 13:38 by rmk") + [LAMBDA (NEWSEL CURSEL TEXTOBJ EVENIFPROTECTED) (* ; "Edited 11-Sep-2024 23:44 by rmk") + (* ; "Edited 9-Sep-2024 09:28 by rmk") + (* ; "Edited 28-Aug-2024 09:49 by rmk") + (* ; "Edited 22-Aug-2024 16:06 by rmk") + (* ; "Edited 13-Jul-2024 12:48 by rmk") + (* ; "Edited 29-Apr-2024 13:45 by rmk") + (* ; "Edited 15-Mar-2024 13:38 by rmk") (* ; "Edited 26-Dec-2023 11:46 by rmk") (* ; "Edited 15-Oct-2023 10:39 by rmk") - (* ; "Edited 5-Oct-2023 22:08 by rmk") (* ; "Edited 19-Apr-2023 17:36 by rmk") (* ; "Edited 19-Apr-93 13:49 by jds") - (* ;; "Note: CHLIM is one past the last character, hence ADD1/SUB1 in some places below.") + (* ;; "") - (* ;; "Obtain a new selection for the character/line that covers X,Y, and extend OSEL to include the additional characters. Return the extended selection.") + (* ;; "At entry the display is compatible with CURSEL. This function modifies CURSEL and the dispaly to reflect how CURSEL is extended by NEWSEL's coordinates. The strategy is to fix NEWSEL so that it describes the highlighting difference between the original and the extension, and to update the display accordingly.") - (* ;; "NEWSEL will be a paragraph selection if OSEL was.") + (* ;; "If NEWSEL is before or after CURSEL, the modified NEWSEL describes the intervening characters. If NEWSEL overlaps CURSEL, NEWSEL is reduced to describe the prefix or suffix that should no longer be highlighted. ") + (* ; "") (* ;; "The paragraph behavior feels a little odd. If you have 4 highlighted paragraphs and click on the 2nd one, the first paragraph is deselected, because the CH# has moved in to the second. If you click on the 3rd paragraph, the last one is deselected (the CHLIM has moved in).") (* ;; "Same behavior if you drag from the top or bottom. If you drag from the bottom, the bottom disappears when you enter the 3rd. But as you continue from 3rd to 2nd, the upper deselects. But you might think that dragging behavior would be consistent--as you keep going up (or down), the paragraph you are leaving goes away.") - (CL:UNLESS (ZEROP (TEXTLEN TEXTOBJ)) - (PROG (NPOINT NEWSEL OCH# OCHLIM NCH# NCHLIM SETOSELFLG (SELKIND (GETSEL OSEL SELKIND))) + (CL:WHEN (AND (FGETSEL NEWSEL SET) + (FGETSEL CURSEL SET)) + (LET ((CCH# (FGETSEL CURSEL CH#)) + (CCHLIM (FGETSEL CURSEL CHLIM)) + (NCH# (FGETSEL NEWSEL CH#)) + (NCHLIM (FGETSEL NEWSEL CHLIM)) + TEMP) + (CL:UNLESS EVENIFPROTECTED - (* ;; "LINE+WORDSELFLG iff PARA") + (* ;; "OLDSEL and NEWSEL do not cover any protected characters, but there may be protected characters between them. That's OK if we are copying, otherwise reduce NEWSEL to a point selection that excludes the protected characters..") - (SETQ NEWSEL (\TEDIT.SELECT X Y TEXTOBJ (SELECTQ SELKIND - ((LINE PARA) - 'LINE) - ((WORD CHAR) - 'TEXT) - 'TEXT) - (OR (EQ SELKIND 'WORD) - (EQ SELKIND 'PARA)) - SELOPERATION PANE T)) - (CL:UNLESS (AND NEWSEL (GETSEL NEWSEL SET)) (* ; "No new selection, return OSEL") - (RETURN OSEL)) - (\TEDIT.SET.SEL.LOOKS NEWSEL SELOPERATION) (* ; - "NEWSEL is the same as OSEL: regular, copy-source, etc.") - (SETQ OCH# (FGETSEL OSEL CH#)) - (SETQ OCHLIM (FGETSEL OSEL CHLIM)) - (SETQ NCH# (FGETSEL NEWSEL CH#)) - (SETQ NCHLIM (FGETSEL NEWSEL CHLIM)) - [SETQ NPOINT (COND - ((IGEQ NCHLIM OCHLIM) (* ; - "NEWSEL ends to the right of OSEL: adding on the right ") - 'RIGHT) - ((ILEQ NCH# OCH#) (* ; - "NEWSEL starts to the left of OSEL: adding on the left") - 'LEFT) - ((IGREATERP (IABS (IDIFFERENCE NCHLIM OCHLIM)) - (IABS (IDIFFERENCE NCH# OCH#))) + (* ;; "Protection may only be relevant for menus.") - (* ;; "New X (right click) is in the middle of an old selection. Must be shrinking from the left. This determines the relationships based on character positions. It might be more intuitive in PARA mode if this is based on paragraphs--if there are fewer *paragraphs* in front than behind, of any length.") + (if (IGREATERP NCH# CCHLIM) + then + (* ;; "New is later") - (SETQ SETOSELFLG T) - 'LEFT) - (T - (* ;; - "Must be shrinking from the right. Move OLDSEL's CHLIM back to NEWSEL's") + (CL:WHEN (SETQ TEMP (\TEDIT.FIND.PROTECTED.START TEXTOBJ CCHLIM NCH#)) + (\TEDIT.UPDATE.SEL NEWSEL CCH# NIL 'LEFT NIL TEMP)) + elseif (ILESSP NCHLIM CCH#) + then + (* ;; "New is earlier") - (SETQ SETOSELFLG T) - 'RIGHT] - (SELECTQ NPOINT - (LEFT (* ; - "Caret's to the new left, keep old right ") - (SETQ NCHLIM (IMAX NCHLIM OCHLIM)) - (FSETSEL NEWSEL CHLIM NCHLIM) - (FSETSEL NEWSEL XLIM (FGETSEL OSEL XLIM)) - (FSETSEL NEWSEL LN (COPY (FGETSEL OSEL LN))) + (CL:WHEN (SETQ TEMP (\TEDIT.FIND.PROTECTED.END TEXTOBJ CCH# (SUB1 NCHLIM))) + (\TEDIT.UPDATE.SEL NEWSEL CCH# NIL 'LEFT NIL TEMP))) + (SETQ NCH# (FGETSEL NEWSEL CH#)) + (SETQ NCHLIM (FGETSEL NEWSEL CHLIM))) - (* ;; "Only copying is allowed from a protected area (menu). Otherwise, only extend to its start. If CH# changes, L1 may also change (\FIXSEL)") + (* ;; "There are now no protected characters between NEWSEL and CURSEL.") - (CL:UNLESS (EQ SELOPERATION 'COPY) - (SETQ NCH# (IMAX NCH# (\TEDIT.FIND.PROTECTED.START TEXTOBJ (SUB1 OCHLIM) - NCH#))))) - (RIGHT (* ; - "Caret's to the new right, keep old left") - (SETQ NCH# (IMIN NCH# OCH#)) - (FSETSEL NEWSEL X0 (FGETSEL OSEL X0)) - (FSETSEL NEWSEL L1 (COPY (FGETSEL OSEL L1))) + (* ;; "") - (* ;; "Only copying is allowed from a protected area (menu). Otherwise, only extend to its end. If CHLIM changes, LN may also change (\FIXSEL)") + (* ;; "NEWSEL's ONFLG will be T if we think that a currently highlighted region needs to be turned off, NIL if it needs to be turned on. I.e. we show it with (NOT ONFLG).") - (CL:UNLESS (EQ SELOPERATION 'COPY) - [SETQ NCHLIM (IMIN NCHLIM (ADD1 (\TEDIT.FIND.PROTECTED.END - TEXTOBJ OCH# (ADD1 ( - \TEDIT.FIND.PROTECTED.END - TEXTOBJ OCH# - (SUB1 NCHLIM] - (SETQ NCH# (IMIN NCH# (SUB1 NCHLIM))))) - (SHOULDNT)) - (FSETSEL NEWSEL CH# NCH#) - (FSETSEL NEWSEL CHLIM NCHLIM) - (FSETSEL NEWSEL DCH (IDIFFERENCE NCHLIM (FGETSEL NEWSEL CH#))) - (FSETSEL NEWSEL POINT NPOINT) - (CL:UNLESS (EQ (FGETSEL OSEL SELOBJ) - (FGETSEL NEWSEL SELOBJ)) (* ; + (FSETSEL NEWSEL ONFLG NIL) (* ; + "Should always be off at start but...") + (if (IGEQ NCH# CCHLIM) + then + (* ;; "CCC...NNN: NEWSEL after. Make CURSEL run from CCH# to NCHLIM, NEWSEL run from (ADD1 CCHLIM) to (SUB1 NCH#)") + + (\TEDIT.UPDATE.SEL CURSEL CCH# NIL 'RIGHT NIL NCHLIM) + (\TEDIT.UPDATE.SEL NEWSEL CCHLIM NIL 'RIGHT NIL NCHLIM) + elseif (ILEQ NCHLIM CCH#) + then + (* ;; "NNN...CCC: CURSEL before. Make CURSEL run from NCH# to CCHLIM, NEWSEL run from NCH# to (SUB1 CCH#)") + + (\TEDIT.UPDATE.SEL CURSEL NCH# NIL 'LEFT NIL CCHLIM) + (\TEDIT.UPDATE.SEL NEWSEL NCH# NIL 'LEFT NIL CCH#) + elseif (IGREATERP (IABS (IDIFFERENCE NCHLIM CCHLIM)) + (IABS (IDIFFERENCE NCH# CCH#))) + then + (* ;; "CCN[N|C]NC New X (right click) is in the middle of an old selection. Must be shrinking from the left. This determines the relationships based on character positions. It might be more intuitive in PARA mode if this is based on paragraphs--if there are fewer *paragraphs* in front than behind, of any length.") + + (\TEDIT.UPDATE.SEL CURSEL NCH# NIL 'LEFT NIL CCHLIM) + (FSETSEL NEWSEL ONFLG T) (* ; + "So highlighting turns off in the reduction") + (\TEDIT.UPDATE.SEL NEWSEL CCH# NIL 'LEFT NIL NCH#) + else + (* ;; "O[O|N]NOOMust be shrinking from the right. ") + + (\TEDIT.UPDATE.SEL CURSEL CCH# NIL 'RIGHT NIL NCHLIM) + (FSETSEL NEWSEL ONFLG T) + (\TEDIT.UPDATE.SEL NEWSEL NCHLIM NIL 'RIGHT NIL CCHLIM)) + (CL:UNLESS (EQ (FGETSEL CURSEL SELOBJ) + (FGETSEL NEWSEL SELOBJ)) (* ;  "Keep object if it is in overlapping part?") - (FSETSEL NEWSEL SELOBJ NIL)) - (\TEDIT.FIXSEL NEWSEL TEXTOBJ) - (CL:WHEN SETOSELFLG (* ; - "It is wise to copy the new sel into the old one.") - (\TEDIT.COPYSEL NEWSEL OSEL)) - (RETURN NEWSEL)))]) + (FSETSEL CURSEL SELOBJ NIL)) -(\TEDIT.SELECT - [LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION PANE EXTENDING) - (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 2-Jan-2024 12:32 by rmk") - (* ; "Edited 26-Dec-2023 08:50 by rmk") - (* ; "Edited 23-May-2023 12:38 by rmk") - (* ; "Edited 9-Apr-2023 23:01 by rmk") - (* ; "Edited 30-May-91 23:07 by jds") + (* ;; "NEWSEL now describes the difference between the highlighting of the original CURSEL to the highlighting of the extended CURSEL, either putting up new highlighting or taking down old highlighting. ") - (* ;; "Select the character word, line, or paragraph the mouse is pointing at.") - - (LET ((SEL (\TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (fetch (TEXTWINDOW PLINES) of PANE) - REGION WORDSELFLG SELOPERATION PANE EXTENDING))) - (CL:WHEN (AND (type? SELECTION SEL) - (GETSEL SEL SET)) (* ; - "He pointed at something real; return that.") - (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) - (\TEDIT.FIXSEL SEL TEXTOBJ PANE) (* ; - "This PANE is good, fix all the other ones") - SEL)]) + (\TEDIT.FIXSEL NEWSEL TEXTOBJ) + (\TEDIT.SHOWSEL NEWSEL (NOT (FGETSEL NEWSEL ONFLG)) + TEXTOBJ) + (FSETSEL NEWSEL ONFLG NIL) (* ; "Restore its generally off state.") + (\TEDIT.FIXSEL CURSEL TEXTOBJ)))]) (\TEDIT.SCAN.LINE - [LAMBDA (TEXTOBJ LINE X Y WORDSELFLG SELOPERATION PANE EXTENDING) + [LAMBDA (LINE X Y NEWSEL SELOPERATION PANE BUTTON WORDSELFLG) + (* ; "Edited 6-Dec-2024 11:06 by rmk") + (* ; "Edited 4-Dec-2024 12:06 by rmk") + (* ; "Edited 30-Nov-2024 09:52 by rmk") + (* ; "Edited 28-Nov-2024 11:54 by rmk") + (* ; "Edited 21-Oct-2024 00:07 by rmk") + (* ; "Edited 18-Oct-2024 22:42 by rmk") + (* ; "Edited 17-Oct-2024 21:47 by rmk") + (* ; "Edited 3-Oct-2024 23:31 by rmk") + (* ; "Edited 6-Sep-2024 00:07 by rmk") + (* ; "Edited 1-Aug-2024 17:13 by rmk") + (* ; "Edited 20-Jun-2024 11:36 by rmk") + (* ; "Edited 29-Apr-2024 12:35 by rmk") (* ; "Edited 15-Mar-2024 19:22 by rmk") (* ; "Edited 27-Jan-2024 23:44 by rmk") - (* ; "Edited 26-Jan-2024 21:54 by rmk") - (* ; "Edited 22-Jan-2024 17:15 by rmk") - (* ; "Edited 3-Jan-2024 00:34 by rmk") (* ; "Edited 14-Oct-2023 10:46 by rmk") - (* ; "Edited 5-May-2023 00:18 by rmk") - (* ; "Edited 18-Apr-2023 23:09 by rmk") (* ; "Edited 9-Apr-2023 18:21 by rmk") (* ; "Edited 31-May-91 12:26 by jds") - (* ;; "Given that LINE meets the mouse-Y criterion, find the selection picked out by the mouse X coordinate. This may run to the right if the mouse-position is protected.") + (* ;; "Given that LINE meets the mouse-Y criterion, find the selection picked out by the mouse X coordinate. This may run to the right if the mouse-position is protected. This also expands to word selection in the current line, avoiding protected characters.") - (PROG (SCRSEL CHARSLOT CLOOKS CHNO TXB TX SELSLOT SELCHAR SELHERE PASTRIGHT - (THISLINE (FGETTOBJ TEXTOBJ THISLINE))) + (* ;; "") + + (* ;; "Earlier versions had more complexity because it not ony figured out the character pointed at but also %"fixed%" the selection on the fly to avoid the more generic \TEDIT.FIXLINE.The generic fixline would scan through the lines of a tall window to find the line containing the selected CH#, and then apply \TEDIT.CHTOX to scan its (presumably cached) THISLINE to set up the X0 and XLIM. But not a noticeable delay for user interaction--not worth the complexity.") + + (* ;; "The button pressed on an image object is decoded from the EXTENDFLG and WORDFLG.") + + (SELECTION! NEWSEL) + (FSETSEL NEWSEL SET NIL) + (PROG ((TSTREAM (PANESTREAM PANE)) + (TEXTOBJ (PANETOBJ PANE)) + CHARSLOT CLOOKS CHNO X0 XLIM SELCHAR PASTRIGHT THISLINE MOVED) + (SETQ THISLINE (FGETTOBJ TEXTOBJ THISLINE)) (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) (* ;  "Make sure the cache describes this line") - (SETQ LINE (\TEDIT.FORMATLINE TEXTOBJ (GETLD LINE LCHAR1) + (SETQ LINE (\TEDIT.FORMATLINE TSTREAM (GETLD LINE LCHAR1) LINE))) (* ;  "Convert X's display units to LINE's scale") - (SETQ TX (GETLD LINE LX1)) - (SETQ TXB TX) - (SETQ X (IMAX X TX)) (* ; - "Move over if the click was in the left margin.") + (SETQ XLIM (GETLD LINE LX1)) (* ; + "Pretend the %"last%" character ended at the margin") + (SETQ X (IMAX X XLIM)) (SETQ CHNO (FGETLD LINE LCHAR1)) (* ;; "") @@ -578,113 +618,135 @@ (CL:WHEN (SETQ PASTRIGHT (IGREATERP X (FGETLD LINE LXLIM))) (* ; - "Past the end, put it inside the last character") + "If not more than 20 past the end, put it inside the last character.") + (CL:WHEN (IGREATERP (IDIFFERENCE X (FGETLD LINE LXLIM)) + 30) + (RETURN NIL)) (SETQ X (SUB1 (FGETLD LINE LXLIM)))) - (for old CHARSLOT incharslots THISLINE - do (CL:UNLESS CHAR (* ; "Invisible or charlooks") - (CL:IF (SMALLP CHARW) - (add CHNO CHARW) - (SETQ CLOOKS CHARW)) - (GO $$ITERATE)) - (SETQ TXB TX) - (add TX CHARW) - (CL:WHEN (IGEQ TX X) - (if SELHERE - then (SETQ TX TXB) (* ; - "Now presumaby looking at }, we want a 0-char selection at TXB") - (SETQ X TX) - (RETURN) - else - (* ;; "Presumably the end of a selected region in a menu, probably {. It appears that we want to go one more") + [SETQ CHARSLOT (for CS incharslots THISLINE + do (if CHAR + then (add XLIM CHARW) (* ; "Start of the next character ") + (CL:WHEN (IGEQ XLIM X) + (RETURN CS)) + (add CHNO 1) + else (SETQ CLOOKS CHARW] (* ; "The running CHARLOOKS") + (CL:UNLESS CHARSLOT (* ; "Guardrail") + (RETURN)) + (CL:WHEN (FGETCLOOKS CLOOKS CLPROTECTED) - (SETQ SELHERE (fetch (CHARLOOKS CLSELHERE) of CLOOKS))) - (CL:UNLESS (fetch (CHARLOOKS CLPROTECTED) of CLOOKS) + (* ;; "Extensions can't run through protected characters, and they can't be deleted.") + + (CL:WHEN (OR (EQ BUTTON 'RIGHT) + (EQ SELOPERATION 'DELETE)) + (RETURN NIL)) + + (* ;; "Otherwise, if either CLSELAFTER or CLSELBEFORE, we move CHARSLOT, CHNO, XLIM,CLOOKS to the closest unprotected one. ") + + [SETQ CHARSLOT (if (FGETCLOOKS CLOOKS CLSELAFTER) + then (SETQ MOVED 'FORWARD) + (for CS incharslots (NEXTCHARSLOT CHARSLOT) + do (if CHAR + then (add XLIM CHARW) + (add CHNO 1) + (CL:UNLESS (FGETCLOOKS CLOOKS CLSELAFTER) + (RETURN CS)) + else (SETQ CLOOKS CHARW))) + elseif (FGETCLOOKS CLOOKS CLSELBEFORE) + then + + (* ;; "We back up through the charlooks keeping track of the next previous CLSELBEFORE (BEFORESLOT) while we look for the first one that is not CLSELBEFORE. When we find that one, we know that the PREVSLOT of BEFORESLOT is the one we want.") + + (SETQ MOVED 'BACKWARD) + (for CS (BEFORECHNO _ CHNO) + (BEFOREX _ XLIM) + (BEFORELOOKSLOT _ CHARSLOT) backcharslots (PREVCHARSLOT + CHARSLOT) + do (if CHAR + then (add XLIM (IMINUS CHARW)) + (add CHNO -1) + elseif (FGETCLOOKS CHARW CLSELBEFORE) + then (SETQ BEFORECHNO CHNO) + (SETQ BEFORELOOKSLOT CS) + (SETQ BEFOREX XLIM) + elseif BEFORELOOKSLOT + then (SETQ XLIM BEFOREX) + (SETQ CHNO BEFORECHNO) + (RETURN (PREVCHARSLOT BEFORELOOKSLOT]) + (CL:UNLESS CHARSLOT (* ; "Everything was protected.") + (RETURN)) + + (* ;; "CHNO and CHARSLOT: the character pointed to, X0 is the beginning of CHNO, XLIM the point after CHNO.") + + (SETQ SELCHAR (CHAR CHARSLOT)) + + (* ;; "NOTE: This preserves the HOW and HOWHEIGHT fields as set by the caller") + + (FSETSEL NEWSEL SELKIND 'CHAR) + (FSETSEL NEWSEL X0 (IDIFFERENCE XLIM (CHARW CHARSLOT))) (* ; - "If protected, we keep going beyond the given X") - (RETURN))) - (add CHNO 1) finally + "Setting X0 suppresses an extra scan in FIXSEL") + (FSETSEL NEWSEL XLIM XLIM) + (FSETSEL NEWSEL CH# CHNO) + (FSETSEL NEWSEL SELOBJ NIL) - (* ;; "We lose if all characters after X are protected.") + (* ;; "DCH=0 makes it a point selection, 1 picks out a single char. Original code produced 0 only for protected text and dummy lines. For copy/delete selections, it's more convenient still to select at least one character, at least until modern one-button swiping is implemented. ") - (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of CLOOKS) - (SETQ CHARSLOT NIL))) - (CL:UNLESS CHARSLOT (* ; "Everything after X was protected.") - (RETURN 'DON'T)) + (* ;; "If we end up in a protected piece, we want DCH=0. We then want to flash the caret iff we moved forward or backward") - (* ;; "CHNO and CHARSLOT: the character pointed to, CLOOKS the looks of that character.") - - (* ;; "CHNO and CHARSLOT are either flagged as CLSELHERE or are not flagged as CLPROTECTED.") - - (* ;; "TXB the end of CHNO-1, TX the end of CHNO. They both may be beyond X, if protected.") - - (* ;; "") - - (SETQ SELSLOT CHARSLOT) - (SETQ SELCHAR (CHAR SELSLOT)) - - (* ;; - " CHNO and SELSLOT define a selectable character/object SELCHAR that runs from TXB to TX. ") - - (* ;; "") - - (* ;; "The selection runs from TXB to TX and from CHNOB to CHNO. In the character case, CHNOB=CHNO and TX-TB is the selection width (DX).") - - (* ;; "If the selected piece is SELHERE (presumably in a menu), the selection is specialized in various ways..") - - (SETQ SCRSEL (FGETTOBJ TEXTOBJ SCRATCHSEL)) - (FSETSEL SCRSEL SELTEXTOBJ TEXTOBJ) - (FSETSEL SCRSEL SET T) - (FSETSEL SCRSEL SELKIND 'CHAR) - (FSETSEL SCRSEL X0 TXB) (* ; - "X and Y values will be reset by \FIXSEL, but we have to track X for word selection and image obj") - (FSETSEL SCRSEL XLIM TX) - (FSETSEL SCRSEL CH# CHNO) - (FSETSEL SCRSEL CHLIM (ADD1 CHNO)) - (FSETSEL SCRSEL SELOBJ NIL) - - (* ;; "0 makes it a point selection, 1 picks out a single char. Original code produced 0 only for protected text and dummy lines.") - - (FSETSEL SCRSEL DCH (CL:IF (AND (EQ SELOPERATION 'NORMAL) - (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) - 0 - 1)) - (FSETSEL SCRSEL POINT (if (OR SELHERE (AND PASTRIGHT (FGETLD LINE FORCED-END))) + [if (FGETCLOOKS CLOOKS CLPROTECTED) + then (FSETSEL NEWSEL DCH 0) (* ; "Protected: nothing shows") + [FSETSEL NEWSEL HASCARET (AND MOVED (EQ SELOPERATION 'NORMAL] + else (FSETSEL NEWSEL DCH (if (EQ 0 (TEXTLEN TEXTOBJ)) + then 0 + elseif (OR WORDSELFLG (NEQ SELOPERATION 'NORMAL) + (FGETTOBJ TEXTOBJ TXTREADONLY) + (type? IMAGEOBJ SELCHAR)) + then 1 + else 0 (* ; + "0 = point selection, character not underlined. But extension is confusing") + 1)) + (FSETSEL NEWSEL HASCARET (EQ SELOPERATION 'NORMAL] + (FSETSEL NEWSEL CHLIM (IPLUS (FGETSEL NEWSEL CH#) + (FGETSEL NEWSEL DCH))) + (FSETSEL NEWSEL POINT (if [OR PASTRIGHT (EQ MOVED 'BACKWARD) + (AND (IGEQ (CHARW CHARSLOT) + 3) + (IGEQ X (IDIFFERENCE XLIM (FOLDLO (CHARW CHARSLOT) + 2] then - - (* ;; "This is coordinated with the point selection in \FIXSEL. If we are past the end of an EOL-line, we want the caret to blink on the left but select and underline the EOL.") - - 'LEFT - elseif (AND (IGEQ (IDIFFERENCE TX TXB) - 3) - (IGEQ X (FOLDLO (IPLUS TX TXB) - 2))) - then - - (* ;; "To the right of an otherwise-protected insertion, past the middle of a selection that is wide enough (3 points) to discriminate, and not at the end of an EOL-terminated line. ") + (* ;; + "Beyond the line, or towards the end of a character that is at least 3 points wide.") 'RIGHT - else 'LEFT)) - (CL:WHEN (AND WORDSELFLG (NOT (FGETLD LINE LDUMMY))) + else 'LEFT)) (* ; + "Don't recognize an object that wasn't directly pointed at") + (FSETSEL NEWSEL SELOBJ (CL:UNLESS PASTRIGHT (IMAGEOBJP SELCHAR))) + (FSETSEL NEWSEL SET T) - (* ;; "Expand the selection to its word boundaries") + (* ;; "Single-char selection is good") - (\TEDIT.SCAN.LINE.WORD X TEXTOBJ THISLINE SCRSEL SELSLOT CLOOKS)) - (CL:WHEN (AND (type? IMAGEOBJ SELCHAR) - (NOT PASTRIGHT)) (* ; - "Don't interpret an object that X was backed up to.") - (\TEDIT.SELECT.OBJECT TEXTOBJ SCRSEL SELCHAR LINE X Y TXB PANE SELOPERATION - (COND - (EXTENDING 'RIGHT) - (WORDSELFLG 'MIDDLE) - (T 'LEFT)) - EXTENDING)) - (for L1 on (FGETSEL SCRSEL L1) as LN on (FGETSEL SCRSEL LN) as P inpanes TEXTOBJ - when (EQ P PANE) do (RPLACA L1 LINE) - (RPLACA LN LINE)) - (RETURN SCRSEL]) + (* ;; "") + + (CL:WHEN WORDSELFLG + + (* ;; "Expand the (unprotected) selection to its word boundaries. This is done here because it makes use of THISLINE and CHARSLOT") + + (CL:UNLESS (OR (FGETSEL NEWSEL SELOBJ) + (FGETLD LINE LDUMMY) + (FGETCLOOKS CLOOKS CLPROTECTED)) + (\TEDIT.SCAN.LINE.WORD X TEXTOBJ THISLINE NEWSEL CHARSLOT CLOOKS))) + (* ; + "We now have a complete char/caret selection") + (RETURN NEWSEL]) (\TEDIT.SCAN.LINE.WORD - [LAMBDA (X TEXTOBJ THISLINE SCRSEL SELSLOT SELLOOKS) (* ; "Edited 24-Dec-2023 22:04 by rmk") + [LAMBDA (X TEXTOBJ THISLINE NEWSEL CHARSLOT SELLOOKS) (* ; "Edited 7-Nov-2024 21:50 by rmk") + (* ; "Edited 4-Oct-2024 08:39 by rmk") + (* ; "Edited 28-Aug-2024 10:22 by rmk") + (* ; "Edited 3-Aug-2024 12:41 by rmk") + (* ; "Edited 16-Jul-2024 19:53 by rmk") + (* ; "Edited 13-Jul-2024 10:39 by rmk") + (* ; "Edited 24-Dec-2023 22:04 by rmk") (* ; "Edited 14-Oct-2023 10:33 by rmk") (* ; "Edited 26-May-2023 23:05 by rmk") (* ; "Edited 20-Mar-2023 23:42 by rmk") @@ -692,30 +754,34 @@ (* ; "Edited 2-Mar-2023 14:56 by rmk") (* ; "Edited 26-Feb-2023 15:55 by rmk") - (* ;; "SCRSEL is a character selection at the SELSLOT character in THISLINE. This expands it to its surrounding word boundaries. Looks are tracked for protection.") + (* ;; "NEWSEL is a character selection at the CHARSLOT character in THISLINE. This expands it to its surrounding word boundaries. Looks are tracked for protection. X is for accurate adjustment of the point--closest to the mouse X even if that's on the other edge of a wide character.") (* ;; " ") - (\DTEST SCRSEL 'SELECTION) - (CL:UNLESS (EQ 'CHAR (FGETSEL SCRSEL SELKIND)) - (SHOULDNT "Can only expand CHAR selections to WORD selections")) - (LET (CH# CHLIM X0 XLIM) + (* ;; "This uses X at the original point granularity and CHARSLOT to do a more precise determination of the POINT in a word with wide characters. Otherwise it would have to scan THISLINE to find the pivot character, so that it can savoid protected regions when scanning backward and forward. ") - (* ;; "CH# will be the first charno of the word selection") + (SELECTION! NEWSEL) + (CL:UNLESS (EQ 'CHAR (FGETSEL NEWSEL SELKIND)) + (\TEDIT.THELP "Can only expand CHAR selections to WORD selections")) + (LET ((CH# (FGETSEL NEWSEL CH#)) + (CHLIM (FGETSEL NEWSEL CHLIM)) + (X0 (FGETSEL NEWSEL X0)) + (XLIM (FGETSEL NEWSEL XLIM))) - (* ;; "CHLIM will be one past the last charno of the word selection") + (* ;; "CH# will become the first charno of the word selection") - (* ;; "X0 will be the X at the beginning of the first char") + (* ;; "CHLIM will become one past the last charno of the word selection") - (* ;; "XLIM will be the X at the end of last charL") + (* ;; "X0 will become the X at the beginning of the first char") - (SETQ CH# (FGETSEL SCRSEL CH#)) - (SETQ CHLIM (FGETSEL SCRSEL CHLIM)) (* ; "") - (SETQ X0 (FGETSEL SCRSEL X0)) - (SETQ XLIM (FGETSEL SCRSEL XLIM)) - (for CHARSLOT (CLOOKS _ SELLOOKS) - (LASTCHAR _ (CHAR SELSLOT)) backcharslots (PREVCHARSLOT SELSLOT) + (* ;; "XLIM will become the X at the end of last char") + (* ; "") + (for CSLOT (CLOOKS _ SELLOOKS) + (LASTCHAR _ (CHAR CHARSLOT)) backcharslots (PREVCHARSLOT CHARSLOT) do (CL:UNLESS CHAR + + (* ;; "CLOOKS is the looks AFTER the preceding char. We have to go back further to see if the current char is protected.") + (SETQ CLOOKS CHARW) (GO $$ITERATE)) (CL:WHEN (OR (type? IMAGEOBJ CHAR) @@ -729,8 +795,8 @@ (* ;; "And search forward for the end of the word") - (for CHARSLOT (CLOOKS _ SELLOOKS) - (PREVCHAR _ (CHAR SELSLOT)) incharslots (NEXTCHARSLOT SELSLOT) + (for CSLOT (CLOOKS _ SELLOOKS) + (PREVCHAR _ (CHAR CHARSLOT)) incharslots (NEXTCHARSLOT CHARSLOT) do (CL:UNLESS CHAR (SETQ CLOOKS CHARW) (GO $$ITERATE)) @@ -746,16 +812,16 @@ (add XLIM CHARW) (add CHLIM 1) (SETQ PREVCHAR CHAR)) - (FSETSEL SCRSEL SELKIND 'WORD) - (FSETSEL SCRSEL CH# CH#) - (FSETSEL SCRSEL CHLIM CHLIM) - (FSETSEL SCRSEL DCH (IDIFFERENCE CHLIM CH#)) - (FSETSEL SCRSEL X0 X0) - (FSETSEL SCRSEL XLIM XLIM) + (FSETSEL NEWSEL SELKIND 'WORD) + (FSETSEL NEWSEL CH# CH#) + (FSETSEL NEWSEL CHLIM CHLIM) + (FSETSEL NEWSEL DCH (IDIFFERENCE CHLIM CH#)) + (FSETSEL NEWSEL X0 X0) + (FSETSEL NEWSEL XLIM XLIM) (* ;; "Move the point to the intended side of the word: To the right of an otherwise-protected insertion, past the middle of a selection that is wide enough to discriminate, and not at the end of an EOL-terminated line. 3 is points.") - (FSETSEL SCRSEL POINT (if [OR (fetch (CHARLOOKS CLSELHERE) of SELLOOKS) + (FSETSEL NEWSEL POINT (if [OR (fetch (CHARLOOKS CLSELAFTER) of SELLOOKS) (AND (IGEQ (IDIFFERENCE XLIM X0) 3) (IGEQ X (FOLDLO (IPLUS XLIM X0) @@ -763,181 +829,190 @@ then 'RIGHT else 'LEFT]) -(\TEDIT.SELECT.LINE.SCANNER - [LAMBDA (X Y TEXTOBJ LINES REGION WORDSELFLG SELOPERATION PANE EXTENDING) +(\TEDIT.XYTOSEL + [LAMBDA (X Y NEWSEL TEXTOBJ SELOPERATION PANE BUTTON CURSEL REGIONTYPE) + (* ; "Edited 17-Dec-2024 10:10 by rmk") + (* ; "Edited 6-Dec-2024 12:00 by rmk") + (* ; "Edited 30-Nov-2024 14:15 by rmk") + (* ; "Edited 28-Nov-2024 14:39 by rmk") + (* ; "Edited 7-Nov-2024 21:49 by rmk") + (* ; "Edited 4-Oct-2024 07:57 by rmk") + (* ; "Edited 31-Jul-2024 00:13 by rmk") + (* ; "Edited 29-Apr-2024 12:33 by rmk") (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 26-Dec-2023 08:53 by rmk") - (* ; "Edited 3-Nov-2023 12:00 by rmk") - (* ; "Edited 14-Oct-2023 22:43 by rmk") (* ; "Edited 20-Jul-2023 20:38 by rmk") - (* ; "Edited 30-May-2023 14:17 by rmk") (* ; "Edited 27-May-2023 15:18 by rmk") (* ; "Edited 31-May-91 12:26 by jds") - (CL:WHEN (INSIDEP (DSPCLIPPINGREGION NIL PANE) - X Y) (* ; "Else, how did we get here? ") - (PROG (LINE SCRSEL PARAFIRSTCHNO PARALASTCHNO) - [SETQ LINE (find L PREV inlines (GETLD LINES NEXTLINE) - suchthat (SETQ PREV (FGETLD L PREVLINE)) - (ILEQ (FGETLD L YBOT) - Y) finally - (* ;; - "Y is below thelast line. Assume it points to the last. ") + (* ;; "Sets NEWSEL to the selection picked out by the X-Y coordinates in PANE. If unsuccessful, NEWSEL is unset.") - (RETURN (OR L PREV] - (CL:UNLESS LINE (* ; "Can this happen? Empty?") - (RETURN NIL)) - (SELECTQ REGION - ((TEXT PANE) (* ; + (* ;; "CURSEL is used to decide whether extensions go to words or paragraphs (and to turn off highlighting for objects).") + + (SELECTION! NEWSEL) + (TEXTOBJ! TEXTOBJ) + (FSETSEL NEWSEL SET NIL) + (PROG (LINE PARAFIRSTCHNO PARALASTCHNO SELFN) + (CL:UNLESS (SETQ LINE (\TEDIT.XYTOSEL.LINE X Y PANE TEXTOBJ)) + (RETURN)) + (SELECTQ (\TEDIT.REGIONTYPE BUTTON CURSEL TEXTOBJ REGIONTYPE) + ((TEXT PANE) (* ;  "We're in the regular text area, which character?") - (CL:WHEN (AND (IGEQ (GETLD LINE LCHARLIM) - (TEXTLEN TEXTOBJ)) - (IGREATERP (GETLD LINE YBOT) - Y)) + (CL:WHEN (AND (IGREATERP (GETLD LINE LCHARLIM) + (TEXTLEN TEXTOBJ)) + (IGREATERP (GETLD LINE YBOT) + Y)) - (* ;; + (* ;;  "Y is below the last line of the text: force selection past the very end of that line.") - (SETQ X (ADD1 (GETLD LINE LXLIM)))) - (RETURN (\TEDIT.SCAN.LINE TEXTOBJ LINE X Y WORDSELFLG SELOPERATION PANE - EXTENDING))) - (LINE (* ; - "We're in the line/paragraph region.") - (SETQ SCRSEL (FGETTOBJ TEXTOBJ SCRATCHSEL)) - (CL:WHEN (AND (GETLD LINE LHASPROT) - (NEQ SELOPERATION 'COPY)) + (SETQ X (ADD1 (GETLD LINE LXLIM)))) + (CL:WHEN (AND (\TEDIT.SCAN.LINE LINE X Y NEWSEL SELOPERATION PANE BUTTON + (SELECTQ BUTTON + (RIGHT (MEMB (FGETSEL CURSEL SELKIND) + '(WORD PARA))) + (MIDDLE T) + NIL)) + (FGETSEL NEWSEL SELOBJ) + CURSEL) - (* ;; "In a TEDIT menu, you can't select a whole paragraph or line.") + (* ;; "Run the buttonin function with CURSEL's highlighting turned off--its highlighting may be somewhere else ") - (FSETSEL SCRSEL SET NIL) - (RETURN SCRSEL)) - (FSETSEL SCRSEL SELTEXTOBJ TEXTOBJ) - (FSETSEL SCRSEL SET T) (* ; "Mark it valid.") - (FSETSEL SCRSEL SELOBJ NIL) (* ; "Not selecting an object just yet") + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.SELECT.OBJECT TEXTOBJ NEWSEL LINE X Y PANE SELOPERATION BUTTON))) + (LINE (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) - (* ;; "Get the lines selected in this pane. How does SCRATCHSEL know this?") + (* ;; "Except for fields, menus are completely protected. Confusing to deal with a field that spreads across several lines, so essentially disable the line region") - (for P inpanes TEXTOBJ as PL1 on (FGETSEL SCRSEL L1) as PLN - on (FGETSEL SCRSEL LN) when (EQ P PANE) - do - (* ;; "A word (middle button?) selection in the line region means the paragraph that contains the selected line. ") + (FSETSEL NEWSEL SET NIL) + (RETURN)) - (if WORDSELFLG - then + (* ;; "FIXSEL deals with other panes. LEFT because line-select area is on the left, but perhaps could be RIGHT if extending. ") - (* ;; "We have to find its first and last character numbers, whether or not they are visible in any pane. \FIXSEL will figure out the (sub?) set of lines that are visible in this pane, other panes are done at a higher level") + (\TEDIT.UPDATE.SEL NEWSEL (FGETLD LINE LCHAR1) + NIL + 'LEFT NIL (FGETLD LINE LCHARLIM)) (* ; "Not selecting an object just yet") + (FSETSEL NEWSEL SELKIND 'LINE) + (FSETSEL NEWSEL SELOBJ NIL) + (FSETSEL NEWSEL SET T)) + (PARA (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) + (FSETSEL NEWSEL SET NIL) + (RETURN)) - (SETQ PARAFIRSTCHNO (CAR (\TEDIT.PARA.FIRST TEXTOBJ - (FGETLD LINE LCHAR1) - T))) - (SETQ PARALASTCHNO (CAR (\TEDIT.PARA.LAST TEXTOBJ - (FGETLD LINE LCHARLIM) - T))) + (* ;; "Find its first and last character numbers, whether or not they are visible in any pane. FIXSEL figures out what's visible where") - (* ;; "If LINE is closer to the beginning of the paragraph, put the point before the first line. Otherwise after the last line. ") + (FSETSEL NEWSEL SELOBJ NIL) + (SETQ PARAFIRSTCHNO (CAR (\TEDIT.PARA.FIRST TEXTOBJ (FGETLD LINE LCHAR1) + T))) + (SETQ PARALASTCHNO (CAR (\TEDIT.PARA.LAST TEXTOBJ (FGETLD LINE LCHARLAST) + T))) - (\TEDIT.UPDATE.SEL SCRSEL PARAFIRSTCHNO (IDIFFERENCE - (ADD1 PARALASTCHNO) - PARAFIRSTCHNO) - (COND - ((ILEQ (IDIFFERENCE (FGETLD LINE LCHAR1) - PARAFIRSTCHNO) - (IDIFFERENCE (ADD1 PARALASTCHNO) - (FGETLD LINE LCHARLIM))) - 'LEFT) - (T 'RIGHT)) - NIL T) - (FSETSEL SCRSEL SELKIND 'PARA) - (\TEDIT.FIXSEL SCRSEL TEXTOBJ NIL PANE) - else (* ; - "Select just the line we're pointing at.") - (RPLACA PL1 LINE) - (RPLACA PLN LINE) - (FSETSEL SCRSEL SELKIND 'LINE) - (FSETSEL SCRSEL SET T) - (\TEDIT.UPDATE.SEL SCRSEL (FGETLD LINE LCHAR1) - (IDIFFERENCE (ADD1 (FGETLD LINE LCHARLIM)) - (FGETLD LINE LCHAR1)) - 'LEFT NIL T) + (* ;; "If LINE is closer to the beginning of the paragraph, put the point before the first line. Otherwise after the last line. ") - (* ;; "In the line-selection region, we know that the selection's X0 and XLIM are inherited from the LINE. Don't need to fix") + (\TEDIT.UPDATE.SEL NEWSEL PARAFIRSTCHNO NIL (CL:IF + (ILEQ (IDIFFERENCE (FGETLD LINE + LCHAR1) + PARAFIRSTCHNO) + (IDIFFERENCE (ADD1 + PARALASTCHNO + ) + (FGETLD LINE + LCHARLAST))) + 'LEFT + 'RIGHT) + NIL + (ADD1 PARALASTCHNO)) + (FSETSEL NEWSEL SELOBJ NIL) + (FSETSEL NEWSEL SELKIND 'PARA) + (FSETSEL NEWSEL SET T)) + (\TEDIT.THELP "Unknown text/line-bar region?")) + (CL:UNLESS (FGETSEL NEWSEL SET) (* ; "Invalid") + (RETURN)) + (CL:WHEN [AND (SETQ SELFN (GETTEXTPROP TEXTOBJ 'SELFN)) + (EQ 'DON'T (APPLY* SELFN TEXTOBJ NEWSEL SELOPERATION 'TENTATIVE] - (FSETSEL SCRSEL X0 (FGETLD LINE LX1)) - (FSETSEL SCRSEL XLIM (FGETLD LINE LXLIM))) finally (RETURN)) - (RETURN SCRSEL)) - (SHOULDNT "Unknown text/line-bar region?"))))]) + (* ;; "Declined by user function.") -(\TEDIT.SELECT.OBJECT - [LAMBDA (TEXTOBJ SEL OBJ LINE X Y TXB SELPANE SELOPERATION WHERE) - (* ; "Edited 15-Mar-2024 19:22 by rmk") - (* ; "Edited 24-Jan-2024 11:59 by rmk") - (* ; "Edited 14-Oct-2023 11:38 by rmk") - (* ; "Edited 10-Apr-2023 08:38 by rmk") - (* ; "Edited 29-Mar-94 13:28 by jds") - (SETSEL SEL SELOBJ OBJ) - (SETSEL SEL X0 TXB) - (CL:WHEN (AND (EQ WHERE 'LEFT) - (EQ (FGETSEL SEL DCH) - 0)) - (FSETSEL SEL DCH 1)) - (LET ([OBJBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ SELPANE 'DISPLAY] - (DS (WINDOWPROP SELPANE 'DSP)) - SELRES) - (RESETLST - (RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS TXB (DSPXOFFSET NIL DS)) - (fetch XKERN of OBJBOX)) - DS) - (LIST (FUNCTION DSPXOFFSET) - (DSPXOFFSET NIL DS) - DS)) - (RESETSAVE (DSPYOFFSET (IDIFFERENCE (IPLUS (GETLD LINE YBASE) - (DSPYOFFSET NIL DS)) - (fetch YDESC of OBJBOX)) - DS) - (LIST (FUNCTION DSPYOFFSET) - (DSPYOFFSET NIL DS) - DS)) - (RESETSAVE (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (IMIN (fetch XSIZE of OBJBOX) - (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT - ) - TXB)) - HEIGHT _ (fetch YSIZE of OBJBOX)) - DS) - (LIST (FUNCTION DSPCLIPPINGREGION) - (DSPCLIPPINGREGION NIL DS) - DS)) (* ; - "Go tell him he's being pointed at.") - (SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP OBJ 'BUTTONEVENTINFN) - OBJ DS SEL (IDIFFERENCE X TXB) - (IDIFFERENCE Y (GETLD LINE YBASE)) - SELPANE - (FGETTOBJ TEXTOBJ STREAMHINT) - WHERE SELOPERATION)))) + (FSETSEL NEWSEL SET NIL) + (RETURN)) + (FSETSEL NEWSEL ONFLG NIL) (* ; "New selection not yet displayed") + (\TEDIT.FIXSEL NEWSEL TEXTOBJ) + (RETURN NEWSEL]) - (* ;; "The clipping region is now restored.") +(\TEDIT.REGIONTYPE + [LAMBDA (BUTTON CURSEL TEXTOBJ REGIONTYPE) (* ; "Edited 6-Dec-2024 12:50 by rmk") - (CL:WHEN (LISTP SELRES) (* ; "If not a LIST, an ereror happened") - (SELECTQ (CAR SELRES) - (NIL (* ; "Do nothing untoward") - (FSETSEL SEL SELOBJ NIL)) - (DON'T (* ; - "The object declines to be selected. ") - (FSETSEL SEL SET NIL)) - (CHANGED (* ; "Update the screen") - (\TEDIT.FORMATLINE TEXTOBJ (GETLD LINE LCHAR1) - LINE) - (\TEDIT.DISPLAYLINE TEXTOBJ LINE SELPANE) - (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL))) - NIL))]) + (* ;; "Coerces the mouse region according to the button and current selection.") + + (CL:UNLESS REGIONTYPE + (SETQ REGIONTYPE (FGETTOBJ TEXTOBJ MOUSEREGION))) + (SELECTQ BUTTON + (MIDDLE (CL:WHEN (AND (EQ REGIONTYPE 'LINE) + (FGETTOBJ TEXTOBJ PARABREAKCHARS)) + + (* ;; "A middle-button selection in the line region means the line-containing paragraph. If there are no PARABREAKCHARS, we assume heuristically that there are no paragraphs, and a line is just a line. Otherwise, a middle click in such a document will select the whole thing, not very useful.") + + (SETQ REGIONTYPE 'PARA))) + (RIGHT (SETQ REGIONTYPE (OR [CAR (MEMB (FGETSEL CURSEL SELKIND) + '(LINE PARA] + 'TEXT))) + NIL) + REGIONTYPE]) + +(\TEDIT.XYTOSEL.INLINEP + [LAMBDA (X Y PANE TEXTOBJ) (* ; "Edited 30-Nov-2024 15:46 by rmk") + + (* ;; "If the last click points to a valid line in PANE, return that LINE. Allow clicks slightly beyond the end.") + + (LET ((LINE (\TEDIT.XYTOSEL.LINE X Y PANE TEXTOBJ))) + (CL:WHEN (AND LINE (ILEQ (IDIFFERENCE X (FGETLD LINE LXLIM)) + 30)) + LINE]) + +(\TEDIT.XYTOSEL.LINE + [LAMBDA (X Y PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 11:45 by rmk") + (* ; "Edited 30-Nov-2024 10:08 by rmk") + + (* ;; "Which line did the click go down in?") + + (AND (INSIDEP (PANEREGION PANE) + X Y) + (for L inlines (FGETLD (PANEPREFIX PANE) + NEXTLINE) when (ILEQ (FGETLD L YBOT) + Y) + do (* ; "Don't select an empty line") + (RETURN (CL:IF (ZEROP (FGETLD L LNCH)) + $$PREVLINE + L)) finally + + (* ;; "Y is below the last line. Assume $$PREVLINE points to the last. But maybe last is the end-of-document dummy") + + (CL:UNLESS (EQ L (PANESUFFIX PANE)) + (RETURN (if (AND L (IGEQ (FGETLD $$PREVLINE LCHAR1) + (TEXTLEN TEXTOBJ))) + then (FGETLD $$PREVLINE PREVLINE) + else $$PREVLINE)))]) ) (DEFINEQ (\TEDIT.FIXSEL - [LAMBDA (SEL TEXTOBJ AVOIDPANE ONLYPANE) (* ; "Edited 20-Mar-2024 10:55 by rmk") + [LAMBDA (SEL TEXTOBJ AVOIDPANE ONLYPANE) (* ; "Edited 1-Dec-2024 11:28 by rmk") + (* ; "Edited 28-Nov-2024 14:30 by rmk") + (* ; "Edited 25-Nov-2024 12:57 by rmk") + (* ; "Edited 19-Nov-2024 15:52 by rmk") + (* ; "Edited 17-Nov-2024 15:58 by rmk") + (* ; "Edited 3-Oct-2024 18:47 by rmk") + (* ; "Edited 9-Sep-2024 09:26 by rmk") + (* ; "Edited 3-Sep-2024 13:16 by rmk") + (* ; "Edited 6-Jul-2024 22:36 by rmk") + (* ; "Edited 4-Jul-2024 15:45 by rmk") + (* ; "Edited 28-Jun-2024 21:50 by rmk") + (* ; "Edited 24-Jun-2024 23:57 by rmk") + (* ; "Edited 16-Jun-2024 22:02 by rmk") + (* ; "Edited 21-May-2024 09:01 by rmk") + (* ; "Edited 29-Apr-2024 12:56 by rmk") + (* ; "Edited 26-Apr-2024 00:23 by rmk") + (* ; "Edited 20-Mar-2024 10:55 by rmk") (* ; "Edited 2-Mar-2024 23:38 by rmk") (* ; "Edited 16-Dec-2023 11:44 by rmk") (* ; "Edited 3-Nov-2023 12:01 by rmk") @@ -947,7 +1022,7 @@ (* ; "Edited 1-Jun-2023 17:41 by rmk") (* ; "Edited 31-May-91 12:26 by jds") - (* ;; "PLINES of each PANE heads the list of lines that are visible in that pane. This routine determines which of those visible lines contains characters between the first and last characters that are selected by SEL, if any. The first visible and selected line is stored in the L1 component of the selection that corresponds to PANE, and the last visible/selected line is stored in the LN. L1 and LN can both either be NIL (selection is not visible in a pane) or both be lines (if the pane shows a startiing selected line, it must necessarily show an ending line).") + (* ;; "The PANEPREFIX of each pane heads the list of lines that are visible in that pane. This routine determines which of those visible lines contains characters between the first and last characters that are selected by SEL, if any. The first visible and selected line is stored in the L1 component of the selection that corresponds to PANE, and the last visible/selected line is stored in the LN. L1 and LN can both either be NIL (selection is not visible in a pane) or both be lines (if the pane shows a startiing selected line, it must necessarily show an ending line).") (* ;; "") @@ -955,13 +1030,13 @@ (* ;; "") - (* ;; "Selections also used to contain starting and ending Y values, but those are pane-dependent and no longer made sense once multiple panes were introduced.") + (* ;; "Selections also used to contain starting and ending Y values, but those are pane-dependent and no longer made sense once multiple panes were introduced.") (* ;; "") (* ;; "AVOIDPANE is provided for a pane that may be skipped, e.g. the current selection pane. Its properties are already known, no point in doing extra work.") - (* ;; "ONLYPANE is specified in scrolling. to avoid disturbing and redisplaying panes that are not been scrolled.") + (* ;; "ONLYPANE is specified in scrolling. to avoid disturbing and redisplaying panes that are not being scrolled.") (* ;; "") @@ -973,18 +1048,19 @@ (* ;; "") - (* ;; "Each pane's PLINES is a constant (dummy) line somewhere previous to the first visible line in that pane. ") + (* ;; "Each pane's PANEPREFIX is a constant (dummy) line somewhere previous to the first visible line in that pane. ") (* ;; "") (* ;;  "If TXTDON'TUPDATE, the lines may not correspond to anything reasonable, don't try to find X.") - (\DTEST SEL 'SELECTION) - (CL:UNLESS TEXTOBJ - (SETQ TEXTOBJ (GETSEL SEL SELTEXTOBJ))) - (TEXTOBJ! TEXTOBJ) - (CL:WHEN (AND (FGETTOBJ TEXTOBJ \WINDOW) + (CL:UNLESS (type? TEXTOBJ TEXTOBJ) + (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (SELECTION! SEL) + (CL:WHEN (AND (FGETTOBJ TEXTOBJ PRIMARYPANE) (FGETSEL SEL SET) (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE))) @@ -992,110 +1068,71 @@ (* ;; "For a point selection, CHLIM=(ADD1 CH#) so CHNO=LASTCHNO, and the caret position is determined by POINT. Highlighting is determined separately by DCH, which is 0 for point selections.") - (for PANE PSTARTLINE PENDLINE X0 XLIM (CH# _ (IMAX 1 (FGETSEL SEL CH#))) + (for PANE PSTARTLINE PENDLINE X0 XLIM (FIRSTCHNO _ (IMAX 1 (FGETSEL SEL CH#))) [LASTCHNO _ (IMAX 1 (SUB1 (FGETSEL SEL CHLIM] inpanes TEXTOBJ as L1 on (FGETSEL SEL L1) as LN on (FGETSEL SEL LN) unless (EQ PANE AVOIDPANE) when (OR (NULL ONLYPANE) - (EQ PANE ONLYPANE)) when (SETQ PSTARTLINE (find L - inlines (GETLD (fetch (TEXTWINDOW - PLINES) - of PANE) - NEXTLINE) + (EQ PANE ONLYPANE)) when (SETQ PSTARTLINE (find L inlines (PANETOPLINE PANE) + first (RPLACA L1 NIL) + (RPLACA LN NIL) suchthat - (* ;; - "The first visible line in PANE that contains or follows CHNO. ") + (* ;; + "The first visible line in PANE that SEL selects. ") - (LINESELECTEDP L CH# LASTCHNO) - finally + (FLINESELECTEDP L FIRSTCHNO + LASTCHNO))) + do + (* ;; "For highlighting, if the PSTARTLINE for PANE is also the first line of the selection, then update the selection's X0. Similarly for XLIM and PENDLINE. For interior lines, SHOWSEL.HILIGHT uses their LX1 and LXLIM values. ") - (* ;; "Suchthat always comes here: start by asserting no visible lines, $$VAL=NIL if no visible lines in this pane") - - (RPLACA L1 NIL) - (RPLACA LN NIL))) - do [if (EQ 0 (FGETSEL SEL DCH)) - then - (* ;; "Point selection, CHNO=LASTCHNO, POINT determines whether the caret blinks before or after that character.") - - (CL:WHEN (AND (FGETLD PSTARTLINE FORCED-END) - (IEQP CH# (FGETLD PSTARTLINE LCHARLIM)) - (EQ 'RIGHT (FGETSEL SEL POINT)) - (FGETLD PSTARTLINE NEXTLINE)) - - (* ;; - "Point to the right of the EOL that forced a line. Advance to the beginning of the next line..") - - (SETQ PSTARTLINE (FGETLD PSTARTLINE NEXTLINE)) - (SETQ CH# (FGETLD PSTARTLINE LCHAR1)) - (SETQ LASTCHNO CH#) - (FSETSEL SEL CH# CH#) - (FSETSEL SEL CHLIM (ADD1 CH#)) - (FSETSEL SEL POINT 'LEFT)) - (SETQ PENDLINE PSTARTLINE) - (CL:UNLESS X0 (* ; - "May have been computed for a prior pane") - (CL:WHEN (WITHINLINEP CH# PSTARTLINE) - [SETQ X0 (\TEDIT.CHTOX TEXTOBJ PSTARTLINE CH# (EQ 'RIGHT - (FGETSEL SEL POINT] - (FSETSEL SEL X0 X0) - (FSETSEL SEL XLIM X0))) - else - (* ;; "For highlighting, if the PSTARTLINE for PANE is also the first line of the selection, then update the selection's X0. Similarly for XLIM and PENDLINE. \SHOWSEL.HILIGHT uses the l LX1 and LXLIM values for interior lines. (Except: If LASTCHNO is after a text-final EOL, X0 is the right-edge.)") - - [SETQ PENDLINE (for L (PBOTTOM _ (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION - NIL PANE))) - inlines PSTARTLINE do - (* ;; - "Stop when L is beyond the selection or below the screen. ") - - (CL:WHEN (ILEQ LASTCHNO (FGETLD L - LCHARLIM) - ) - (RETURN L)) - (CL:WHEN (ILEQ (FGETLD L YBOT) - PBOTTOM) - (* ; - "This can happen if LASTCHAR is not visible on the screen") - (RETURN $$PREVLINE)) - finally - - (* ;; - "If $$PREVLINE is NIL, we didn't advance--so we must have ended at the start") - - (RETURN (OR $$PREVLINE PSTARTLINE] - (CL:UNLESS PENDLINE (* ; - "Start could be the last line in the window, it ends there too.") - (SETQ PENDLINE PSTARTLINE)) - - (* ;; + (* ;;  "IMAX to use the first character of PSTARTLINE if it is not the first line of the selection ") - (CL:UNLESS X0 (* ; + (CL:UNLESS X0 (* ;  "May have been computed for a prior pane") - (CL:WHEN (WITHINLINEP CH# PSTARTLINE) - [SETQ X0 (\TEDIT.CHTOX TEXTOBJ PSTARTLINE (IMAX CH# (FGETLD PSTARTLINE - LCHAR1)) - (AND (IGREATERP CH# (TEXTLEN TEXTOBJ)) - (GETLD (FGETLD PSTARTLINE PREVLINE) - FORCED-END] - (FSETSEL SEL X0 X0))) + (CL:WHEN (FWITHINLINEP FIRSTCHNO PSTARTLINE) + [SETQ X0 (\TEDIT.CHTOLINEX TEXTOBJ PSTARTLINE (IMAX FIRSTCHNO (FGETLD + PSTARTLINE + LCHAR1)) + (AND (IGREATERP FIRSTCHNO (TEXTLEN TEXTOBJ)) + (GETLD (FGETLD PSTARTLINE PREVLINE) + FORCED-END] + (FSETSEL SEL X0 X0))) + [SETQ PENDLINE (for L (PBOTTOM _ (PANEBOTTOM PANE)) inlines PSTARTLINE + do + (* ;; "Stop when L is beyond the selection or below the screen. ") - (* ;; - "IMIN to use the last character of PENDLINE if it is not the last line of the selection ") + (CL:WHEN (ILESSP LASTCHNO (FGETLD L LCHARLIM)) + (RETURN L)) + (CL:WHEN (ILEQ (FGETLD L YBOT) + PBOTTOM) (* ; + "This can happen if LASTCHAR is not visible on the screen") + (RETURN $$PREVLINE)) finally - (CL:UNLESS XLIM - (CL:WHEN (WITHINLINEP LASTCHNO PENDLINE) - (SETQ XLIM (\TEDIT.CHTOX TEXTOBJ PENDLINE LASTCHNO T)) - (FSETSEL SEL XLIM XLIM)))] + (* ;; + "If $$PREVLINE is NIL, we didn't advance--so we must have ended at the start") - (* ;; "Fill in the selection") + (RETURN (OR $$PREVLINE PSTARTLINE] + (CL:UNLESS PENDLINE (* ; + "Start could be the last line in the window, it ends there too.") + (SETQ PENDLINE PSTARTLINE)) + (CL:UNLESS XLIM + (CL:WHEN (FWITHINLINEP LASTCHNO PENDLINE) + (SETQ XLIM (\TEDIT.CHTOLINEX TEXTOBJ PENDLINE LASTCHNO T)) + (FSETSEL SEL XLIM XLIM))) + + (* ;; "Fill in the selected lines that are visible in this pane") (RPLACA L1 PSTARTLINE) (RPLACA LN PENDLINE))) SEL]) -(\TEDIT.CHTOX - [LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 15-Mar-2024 19:22 by rmk") +(\TEDIT.CHTOLINEX + [LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 28-Nov-2024 14:41 by rmk") + (* ; "Edited 17-Nov-2024 15:58 by rmk") + (* ; "Edited 13-Jun-2024 17:12 by rmk") + (* ; "Edited 10-May-2024 00:26 by rmk") + (* ; "Edited 15-Mar-2024 19:22 by rmk") (* ; "Edited 23-Dec-2023 14:07 by rmk") (* ; "Edited 2-Dec-2023 10:01 by rmk") (* ; "Edited 16-May-2023 00:20 by rmk") @@ -1109,17 +1146,17 @@ (\DTEST LINE 'LINEDESCRIPTOR) (LET (X (THISLINE (GETTOBJ TEXTOBJ THISLINE))) - (CL:WHEN (OR (FGETLD LINE LDIRTY) - (NEQ LINE (fetch DESC of THISLINE))) + (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) - (* ;; "Reformat if LINE is dirty or not cached in THISLINE. ") + (* ;; "Reformat if LINE is not cached in THISLINE. ") - (\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + (\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT) + (FGETLD LINE LCHAR1) LINE)) (* ;; "Can avoid another loop if we are asking about the first or last characters.") - (if (AND AFTER (IEQP CH# (FGETLD LINE LCHARLIM))) + (if (AND AFTER (IEQP CH# (FGETLD LINE LCHARLAST))) then (FGETLD LINE LXLIM) elseif (AND (NOT AFTER) (IEQP CH# (FGETLD LINE LCHAR1))) @@ -1141,8 +1178,8 @@ (CL:WHEN CHAR (* ; "Ignore CHARLOOKS") (add CHNO 1) (add X CHARW)) finally (CL:WHEN (AND (IEQP CH# (FGETLD LINE LCHAR1)) - (IGEQ (FGETLD LINE LCHARLIM) - (FGETTOBJ TEXTOBJ TEXTLEN)) + (IGREATERP (FGETLD LINE LCHARLIM) + (FGETTOBJ TEXTOBJ TEXTLEN)) (EQ (FGETLD LINE LXLIM) (FGETLD LINE LX1))) @@ -1150,36 +1187,12 @@  "CH# not found in empty final line, return left margin") (RETURN (FGETLD LINE LX1)))]) - -(\TEDIT.COLLECTSELS - [LAMBDA (TEXTOBJ AVOIDSEL) (* ; "Edited 20-Mar-2024 10:56 by rmk") - (* ; "Edited 11-Feb-2024 09:21 by rmk") - (* ; "Edited 9-Feb-2024 15:55 by rmk") - (* ; "Edited 20-Sep-2023 17:02 by rmk") - (* ; "Edited 9-Sep-2023 17:15 by rmk") - (* ; "Edited 26-Mar-2023 20:30 by rmk") - (* ; "Edited 30-May-91 23:03 by jds") - - (* ;; "AVOIDSEL to avoid double hits on selections that we might be dealing with separately (e.g. SCRATCHSEL) MAYBE NOT USED") - - (TEXTOBJ! TEXTOBJ) - (DREMOVE AVOIDSEL (DREMOVE NIL (LIST (FGETTOBJ TEXTOBJ SEL) - (FGETTOBJ TEXTOBJ SCRATCHSEL) - (FGETTOBJ TEXTOBJ SCRATCHSEL2]) - -(\TEDIT.SELECTION.UNSET - [LAMBDA (SEL) (* ; "Edited 23-May-2023 13:52 by rmk") - - (* ;; "Unsets a selection, wiping out things that are no longer needed and might be confusing") - - (SETSEL SEL SET NIL) - (SETSEL SEL L1 NIL) - (SETSEL SEL LN NIL]) ) (DEFINEQ (\TEDIT.RESET.EXTEND.PENDING.DELETE - [LAMBDA (SEL TEXTOBJ) (* ; "Edited 9-Mar-2024 11:37 by rmk") + [LAMBDA (TEXTOBJ) (* ; "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") (* ; "Edited 4-May-2023 00:08 by rmk") @@ -1188,12 +1201,14 @@ (* ;; "Reset the 'Extend Pending Delete' status") - (CL:WHEN SEL - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL))]) + (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) + 'NORMAL) + (SETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL]) (\TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 12-Oct-2023 22:36 by rmk") + [LAMBDA (SEL OPERATION) (* ; "Edited 7-Nov-2024 21:50 by rmk") + (* ; "Edited 4-Oct-2024 08:40 by rmk") + (* ; "Edited 12-Oct-2023 22:36 by rmk") (* ; "Edited 23-May-2023 12:48 by rmk") (* ; "Edited 30-May-91 23:00 by jds") (\DTEST SEL 'SELECTION) @@ -1233,246 +1248,126 @@ (FSETSEL SEL HOW BLACKSHADE) (FSETSEL SEL HOWHEIGHT 16384) (FSETSEL SEL HASCARET T) - (SHOULDNT)) + (\TEDIT.THELP "UNKNOWN SELECTION OPERATION" OPERATION)) SEL]) ) (DEFINEQ (\TEDIT.SHOWSEL - [LAMBDA (SEL ON ONLYPANE TEXTOBJ) (* ; "Edited 20-Mar-2024 10:56 by rmk") + [LAMBDA (SEL ON TEXTOBJ ONLYPANE) (* ; "Edited 4-Oct-2024 10:29 by rmk") + (* ; "Edited 2-Oct-2024 14:20 by rmk") + (* ; "Edited 21-Aug-2024 16:11 by rmk") + (* ; "Edited 19-Jul-2024 23:46 by rmk") + (* ; "Edited 18-Jul-2024 12:14 by rmk") + (* ; "Edited 6-Jul-2024 22:44 by rmk") + (* ; "Edited 28-Jun-2024 22:34 by rmk") + (* ; "Edited 18-May-2024 19:56 by rmk") + (* ; "Edited 29-Apr-2024 13:01 by rmk") (* ; "Edited 9-Mar-2024 12:01 by rmk") + (* ; "Edited 20-Mar-2024 10:56 by rmk") (* ; "Edited 18-Feb-2024 15:24 by rmk") (* ; "Edited 24-Jan-2024 08:07 by rmk") (* ; "Edited 18-Nov-2023 11:27 by rmk") (* ; "Edited 14-Oct-2023 12:10 by rmk") (* ; "Edited 5-Apr-2023 09:13 by rmk") (* ; "Edited 22-May-92 16:11 by jds") - (\DTEST SEL 'SELECTION) + (CL:WHEN (TEXTSTREAMP TEXTOBJ) + (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ))) + (TEXTOBJ! TEXTOBJ) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (SELECTION! SEL) (* ;; "Highlight the selection SEL, according to HOW, turning it on or off according to ON. ONLYPANE is specified in calls from \TEDIT.SCROLLFN to confine operations to only the pane currently being scrolled. Other panes are neither unhighlighted or rehighlighted.") (* ;; "The selection's lines [L1...LN] are the subset of lines selected globally by CH# to CHLIM that are visible within each pane.") - (CL:WHEN (FGETSEL SEL SET) (* ; "Nothing to do if not set") - (PROG [(TEXTOBJ (TEXTOBJ! (OR TEXTOBJ (FGETSEL SEL SELTEXTOBJ] + (CL:WHEN (AND (FGETSEL SEL SET) + (NEQ ON (FGETSEL SEL ONFLG)) + (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)) + (FGETTOBJ TEXTOBJ PRIMARYPANE)) - (* ;; "This operation only makes sense if there is at least one pane to highlight in, and we are allowed to update.") + (* ;; "This operation only makes sense if the selection is set, it is not currently in the intended ON state, we are allowed to update, and there is at least one pane to highlight in.") - (CL:UNLESS (AND (FGETTOBJ TEXTOBJ \WINDOW) - (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE))) - (RETURN)) - (CL:WHEN (EQ ON (FGETSEL SEL ONFLG)) (* ; "No change, nothing to do") - (RETURN)) - (CL:WHEN (FGETSEL SEL SELOBJ)) + (if (FGETSEL SEL SELOBJ) + then + (* ;; "SELOBJ if the selection consisted only of a single image object. It presumably did its own buttonevent operations when it was selected, but is otherwise immune to normal highlighting. But it acts just as a normal character in all panes if it is part of a longer selection. ") - (* ;; "") + (* ;; "This does the WHENOPERATEDONFN once no matter how many panes the object appears in, and that function controls the highlighting. Not sure what happens in other panes. If we do the ordinary highlighting, then e.g. a whole NWAY image object gets underlines, even though only one toggle was selected.") - (if (FGETSEL SEL SELOBJ) - then - (* ;; "SELOBJ if the selection consisted only of a single image object. It presumably did its own operation when it was selected, but is otherwise immune to normal highlighting. But it does act just as a normal character in all panes if it is part of a longer selection. ") - - (for PANE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) - when (AND L1 (OR (NULL ONLYPANE) - (EQ PANE ONLYPANE))) - do (\TEDIT.OBJECT.SHOWSEL TEXTOBJ SEL L1 ON PANE)) - else (for PANE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN - in (FGETSEL SEL LN) as CARET in (FGETTOBJ TEXTOBJ CARET) - when (OR (NULL ONLYPANE) - (EQ PANE ONLYPANE)) - do (CL:WHEN (AND L1 LN (NEQ 0 (FGETSEL SEL DCH))) + (\TEDIT.OPERATE.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT) + SEL + (FGETTOBJ TEXTOBJ SELPANE) + (CL:IF ON + 'HIGHLIGHTED + 'UNHIGHLIGHTED)) + else (for PANE inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN + in (FGETSEL SEL LN) when (OR (NULL ONLYPANE) + (EQ PANE ONLYPANE)) + do (CL:WHEN (AND L1 LN (NEQ 0 (FGETSEL SEL DCH))) (* ; "Hilight if not a point selection") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 LN PANE SEL)) - (\TEDIT.SETCARET SEL PANE TEXTOBJ ON CARET))) - (FSETSEL SEL ONFLG ON)))]) + (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 LN PANE SEL)) + (\TEDIT.SETCARET SEL PANE TEXTOBJ ON))) + (FSETSEL SEL ONFLG ON))]) (\TEDIT.SHOWSEL.HILIGHT - [LAMBDA (TEXTOBJ L1 LN PANE SEL X0 XLIM) (* ; "Edited 22-Dec-2023 08:42 by rmk") + [LAMBDA (TEXTOBJ L1 LN PANE SEL) (* ; "Edited 1-Dec-2024 11:28 by rmk") + (* ; "Edited 20-Nov-2024 10:21 by rmk") + (* ; "Edited 28-Oct-2024 13:57 by rmk") + (* ; "Edited 4-Oct-2024 08:09 by rmk") + (* ; "Edited 12-Sep-2024 20:47 by rmk") + (* ; "Edited 6-Sep-2024 11:07 by rmk") + (* ; "Edited 13-Jun-2024 22:04 by rmk") + (* ; "Edited 22-Dec-2023 08:42 by rmk") (* ; "Edited 17-Dec-2023 17:44 by rmk") (* ; "Edited 22-Apr-2023 15:32 by rmk") (* ; "Edited 30-May-91 23:07 by jds") (* ;; "") - (* ;; "Do the actual highlighting and unhighlighting of a selection for \SHOWSEL. L1 is the first selected line to be highlighted in PANE, LN is the last selected line. There may be other selected lines visible in other panes but not here. X0 and XLIM are the x values to be use for the first and last lines of the selection, at the ends of the selection within those lines. LX1 and LXLIM are used for intermediate lines") + (* ;; "Do the actual highlighting and unhighlighting of a selection for \SHOWSEL. L1 is the first selected line to be highlighted in PANE, LN is the last selected line. There may be other selected lines visible in other panes but not here. X0 and XLIM are the x values to be use for the first and last lines of the selection, at the ends of the selection within those lines. LX1 and LXLIM are used for intermediate lines.") - (\DTEST L1 'LINEDESCRIPTOR) - (\DTEST LN 'LINEDESCRIPTOR) + (LINEDESCRIPTOR! L1) + (LINEDESCRIPTOR! LN) - (* ;; "If the first visible line (L1) is also the first line of the selection, then X0 is the left boundary of the highlight. Otherwise, the left boundary is the left boundary of L1 (its LX1). The test is (EQ L L1). ") + (* ;; "If the first visible line (L1) is also the first line of the selection (it contains CH#), then the highlight's left-boundary is SEL's X0, else the line's LX1. Similarly for the last visible LN/XLIM/LXLIM.") - (* ;; "") - - (* ;; "Similarly, if the last visible line (LN) is also the last line of the selection, in which case the last boundary of the highlight is XLIM. Otherwise it is LN's LXLIM.") - - (CL:UNLESS X0 - (SETQ X0 (CL:IF (WITHINLINEP (FGETSEL SEL CH#) - L1) - (FGETSEL SEL X0) - (FGETLD L1 LX1)))) - (CL:UNLESS XLIM - (SETQ XLIM (CL:IF (WITHINLINEP (SUB1 (FGETSEL SEL CHLIM)) - LN) - (FGETSEL SEL XLIM) - (FGETLD LN LXLIM)))) - (for L LEFT RIGHT (SHADE _ (OR (FGETSEL SEL HOW) - BLACKSHADE)) + (for L LEFT RIGHT DISTBELOW (CH# _ (FGETSEL SEL CH#)) + (LASTCHNO _ (SUB1 (FGETSEL SEL CHLIM))) + (SHADE _ (OR (FGETSEL SEL HOW) + BLACKSHADE)) (SHADEHEIGHT _ (OR (FGETSEL SEL HOWHEIGHT) 1)) - (PBOTTOM _ (fetch BOTTOM of (DSPCLIPPINGREGION NIL PANE))) - DISTBELOW first - (* ;; "DISTBELOW=1 gives a 1-pt spacing between the line-bottom and the selection underline. If 0, the slection line runs through the bottom; it makes 1-point horizontal rules invisible. However: 1 has to be coordinate with \TEDIT.SCROLLUP, so that the selection on the bottom line moves up when the line itself is bltted. I.e., the visible bottom is one point lower than the bottom of the line.") + (PBOTTOM _ (PANEBOTTOM PANE)) first - (SETQ DISTBELOW 0) - (CL:WHEN (AND (EQ SHADE BLACKSHADE) - (FGETTOBJ TEXTOBJ TXTREADONLY)) + (* ;; "DISTBELOW=1 would give a 1-pt spacing between the line-bottom and the selection underline, so that the line doesn't go through the last point of a descender. If 0, the slection line runs through the bottom of an image object, makes 1-point horizontal rules invisible and the selection line may not be so obvious for other image objects. However: 1 has to be coordinated with the scroll-up functions: If the highlight is below the descender of the last line in a pane, the highlighting will not move up when the line is bltted--it disappears. that the highlight on the bottom line moves up when the line itself is bltted. The highlighting would be 1 point below the bottom of the line.") + + (* ;; "At least some of the affected code can be located by (. WHO USES DISTBELOW). Setting it to 1 here and there still doesn't give the righ effects. An alternative might be to say that DESCENT has a 1-point minimum. Not sure what that would do to interline spacing. Maybe also subtract it from the line leading? TBD") + + (SETQ DISTBELOW 0) + (CL:WHEN (AND (EQ SHADE BLACKSHADE) + (FGETTOBJ TEXTOBJ TXTREADONLY)) (* ; "Make READONLY selections black.") - (SETQ SHADEHEIGHT 2)) inlines L1 while (IGEQ (FGETLD L YBOT) - PBOTTOM) - do (SETQ LEFT (OR (AND (EQ L L1) - X0) - (FGETLD L LX1))) - (SETQ RIGHT (OR (AND (EQ L LN) - XLIM) - (FGETLD L LXLIM))) - (BLTSHADE SHADE PANE LEFT (IDIFFERENCE (FGETLD L YBOT) - DISTBELOW) - (IDIFFERENCE RIGHT LEFT) - (IMIN SHADEHEIGHT (FGETLD L LHEIGHT)) - 'INVERT) repeatuntil (EQ L LN]) - -(\TEDIT.UPDATE.SHOWSEL - [LAMBDA (NSEL OSEL TEXTOBJ) (* ; "Edited 15-Mar-2024 13:37 by rmk") - (* ; "Edited 18-Feb-2024 15:25 by rmk") - (* ; "Edited 17-Nov-2023 23:03 by rmk") - (* ; "Edited 23-Oct-2023 23:18 by rmk") - (* ; "Edited 9-Oct-2023 23:02 by rmk") - (* ; "Edited 14-Jun-2023 16:35 by rmk") - (* ; "Edited 20-Apr-2023 12:49 by rmk") - (* ; "Edited 8-Apr-2023 22:49 by rmk") - (* ; "Edited 21-Oct-2022 18:41 by rmk") - (* ; "Edited 30-May-91 23:03 by jds") - - (* ;; "Update the selection highlighting and caret flashing to represent NSEL. Instead of normal \TEDIT.SHOWSEL, the goal is to avoid changing the highlighting on the screen for the pixels that are common between the 2 selections, to just flip whatever bits need to be flipped in order for the screen to reflect NSEL's highlighting. We know that both selections are from the same TEXTOBJ, and that they both implement the same operation (copy, delete) so have the same HOW and HOWHEIGHT. And we know that OSEL is ON.") - - (* ;; - "It is also the case that the lines of NSEL and OSELfor each pane are drawn from the same lists.") - - (* ;; "") - - (* ;; "There are 4 cases to consider:") - - (* ;; " 1. The NSEL operates on the first line of OSEL (NSEL POINT)=LEFT") - - (* ;; " a. (NSEL CH#) < (OSEL CH#). The old selection is growing to the left--more highlighting") - - (* ;; - " b. (NSEL CH#) > (OSEL CH#). The old selection is shrinking--less highlighting") - - (* ;; " 2. The NSEL operates on the last line of OSEL: (NSEL POINT)=RIGHT") - - (* ;; " a. (NSEL CHLIM) < (OSEL CHLIM). The old selection is shrinking at the bottom") - - (* ;; " b. (NSELC CHLIM) > OSEL CHLIM). The old selection is growing.") - - (* ;; "") - - (* ;; "The nicest implementation would be to create a selection that describes just the characters whose highlighting has changed (either on or off), and then do (\TEDIT.SHOWSEL of that selection)") - - (LET ((NPOINT (FGETSEL NSEL POINT)) - NEWLINES OLDLINES NCH# OCH# NLASTCH OLASTCH CARETXPOS) - (FSETSEL NSEL ONFLG T) - - (* ;; " ") - - (SELECTQ NPOINT - (LEFT (* ; "Case 1: NSEL changes OSEL top") - (SETQ NEWLINES (FGETSEL NSEL L1)) - (SETQ OLDLINES (FGETSEL OSEL L1)) - (SETQ NCH# (FGETSEL NSEL CH#)) - (SETQ OCH# (FGETSEL OSEL CH#))) - (RIGHT (SETQ NEWLINES (FGETSEL NSEL LN)) (* ; "Case 2: NSEL changes OSEL bottom") - (SETQ OLDLINES (FGETSEL OSEL LN)) - (SETQ NLASTCH (SUB1 (FGETSEL NSEL CHLIM))) - (SETQ OLASTCH (SUB1 (FGETSEL OSEL CHLIM)))) - (SHOULDNT)) - (CL:WHEN (FGETSEL OSEL HASCARET) (* ; "Take up the caret in every pane") - (for PCARET in (FGETTOBJ TEXTOBJ CARET) do (\TEDIT.UPCARET PCARET))) - (for NEWL in NEWLINES as OLDL in OLDLINES as PANE inpanes (PROGN TEXTOBJ) as PCARET - in (FGETTOBJ TEXTOBJ CARET) - do (CL:WHEN (AND NEWL OLDL) (* ; - "NSEL is passed just to provide the shade") - (SELECTQ NPOINT - (LEFT [if (ILESSP (FGETSEL NSEL CH#) - (FGETSEL OSEL CH#)) - then (* ; "1a: Selection-front is growing") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ NEWL OLDL PANE NSEL - (CL:WHEN (WITHINLINEP NCH# NEWL) - (FGETSEL NSEL X0)) - (CL:WHEN (WITHINLINEP OCH# OLDL) - (FGETSEL OSEL X0))) - else (* ; "1b: Selection-front is shrinking") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ OLDL NEWL PANE NSEL - (CL:WHEN (WITHINLINEP OCH# OLDL) - (FGETSEL OSEL X0)) - (CL:WHEN (WITHINLINEP NCH# NEWL) - (FGETSEL NSEL X0]) - (RIGHT [if (IGREATERP (FGETSEL NSEL CHLIM) - (FGETSEL OSEL CHLIM)) - then (* ; "2a: Selection-end is growing ") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ OLDL NEWL PANE NSEL - (CL:WHEN (WITHINLINEP OLASTCH OLDL) - (FGETSEL OSEL XLIM)) - (CL:WHEN (WITHINLINEP NLASTCH NEWL) - (FGETSEL NSEL XLIM))) - else (* ; " 2b: Selection-end is shrinking") - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ NEWL OLDL PANE NSEL - (CL:WHEN (WITHINLINEP NLASTCH NEWL) - (FGETSEL NSEL XLIM)) - (CL:WHEN (WITHINLINEP OLASTCH OLDL) - (FGETSEL OSEL XLIM]) - NIL)) - (\TEDIT.SETCARET NSEL PANE TEXTOBJ T PCARET]) - -(\TEDIT.REFRESH.SHOWSEL - [LAMBDA (TEXTOBJ SOURCESEL OLDSEL OLDOP NEWOP EXTENDFLG) (* ; "Edited 15-Mar-2024 13:38 by rmk") - (* ; "Edited 9-Mar-2024 12:02 by rmk") - (* ; "Edited 11-Feb-2024 00:06 by rmk") - (* ; "Edited 9-Feb-2024 15:48 by rmk") - (* ; "Edited 28-Jan-2024 23:27 by rmk") - (* ; "Edited 9-Oct-2023 11:48 by rmk") - (* ; "Edited 6-Oct-2023 12:00 by rmk") - (* ; "Edited 14-Jun-2023 16:35 by rmk") - (* ; "Edited 27-May-2023 15:11 by rmk") - (* ; "Edited 18-Apr-2023 23:54 by rmk") - (* ; "Edited 9-Apr-2023 13:24 by rmk") - (* ; "Edited 30-May-91 23:03 by jds") - - (* ;; "Update the screen hilighting to account for the changes that have taken place between OLDSEL and SOURCESEL.") - - (COND - ((AND EXTENDFLG (EQ OLDOP NEWOP) - (GETSEL OLDSEL ONFLG)) - - (* ;; "If we're extending a selection and the looks haven't changed, we can try doing it the fast way, to prevent flicker.") - - (\TEDIT.UPDATE.SHOWSEL SOURCESEL OLDSEL TEXTOBJ) - (\TEDIT.COPYSEL SOURCESEL OLDSEL) - (SETSEL OLDSEL ONFLG T) - OLDSEL) - (T (* ; - "Otherwise, we have to turn the old one off, change things, and turn the new one on.") - (\TEDIT.SHOWSEL OLDSEL NIL NIL TEXTOBJ) - (SETSEL OLDSEL SET NIL) - (CL:UNLESS (EQ OLDOP NEWOP) - (\TEDIT.SET.SEL.LOOKS SOURCESEL NEWOP)) - (\TEDIT.COPYSEL SOURCESEL OLDSEL) - (SETSEL OLDSEL ONFLG NIL) (* ; - "Make sure we can turn the highlighting on.") - (\TEDIT.SHOWSEL OLDSEL T NIL TEXTOBJ) - OLDSEL]) + (SETQ SHADEHEIGHT 2)) inlines L1 + while (IGEQ (FGETLD L YBOT) + PBOTTOM) do (SETQ LEFT (CL:IF (WITHINLINEP CH# L) + (FGETSEL SEL X0) + (FGETLD L LX1))) + (SETQ RIGHT (CL:IF (WITHINLINEP LASTCHNO L) + (FGETSEL SEL XLIM) + (FGETLD L LXLIM))) + (BLTSHADE SHADE PANE LEFT (IDIFFERENCE (FGETLD L YBOT) + DISTBELOW) + (IDIFFERENCE RIGHT LEFT) + (IMIN SHADEHEIGHT (FGETLD L LHEIGHT)) + 'INVERT) repeatuntil (EQ L LN]) (\TEDIT.UPDATE.SEL - [LAMBDA (SEL CH# DCH POINT DONTFIX) (* ; "Edited 15-Mar-2024 13:36 by rmk") + [LAMBDA (SEL CH# DCH POINT LOOKS CHLIM) (* ; "Edited 10-Jul-2024 17:25 by rmk") + (* ; "Edited 8-Jul-2024 00:11 by rmk") + (* ; "Edited 21-Jun-2024 14:21 by rmk") + (* ; "Edited 29-Apr-2024 13:28 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 5-Mar-2024 14:45 by rmk") (* ; "Edited 25-Feb-2024 17:30 by rmk") (* ; "Edited 16-Feb-2024 23:49 by rmk") @@ -1483,7 +1378,7 @@ (* ;; "Translates the selection SEL to new positions. DCH=0 means point selection with caret blinking either before or after CH#, depending on POINT. If CH# is a history event, that defines the new selection parameters. Otherwise, if any of the variables are NIL, the value for that field in SEL is not changed.") - (* ;; "Unless DONTFIX, \FIXSEL is called to figure out the pane-lines and screen coordinates.") + (* ;; "For convenience, If DCH is NIL and CHLIM is provided, DCH is computed from CH# and CHLIM instead of being left alone.") [if (type? TEDITHISTORYEVENT CH#) then (* ; "History is a pseudo-selection") @@ -1500,94 +1395,116 @@ (CL:UNLESS CH# (SETQ CH# (GETSEL SEL CH#))) (CL:UNLESS DCH - (SETQ DCH (FGETSEL SEL DCH))) + (SETQ DCH (if CHLIM + then (IDIFFERENCE CHLIM CH#) + else (FGETSEL SEL DCH)))) (CL:UNLESS POINT (SETQ POINT (FGETSEL SEL POINT)))] - (* ;; "Restrict CH# to [1..TEXTLEN], using POINT to designate below or above") + (* ;; + "If below 1, left of 1. We don't know TEXTLEN without the TEXTOBJ, so we can't test the length.") - (LET ((TEXTLEN (TEXTLEN (GETSEL SEL SELTEXTOBJ))) - CHLIM) - (CL:WHEN (ILESSP CH# 1) - (SETQ CH# 1) - (SETQ POINT 'LEFT)) - (CL:WHEN (IGREATERP CH# TEXTLEN) - (SETQ CH# (ADD1 TEXTLEN)) - (SETQ POINT 'LEFT)) + (CL:WHEN (ILESSP CH# 1) + (SETQ CH# 1) + (SETQ POINT 'LEFT)) - (* ;; "POINT=LEFT means before CH#, POINT=RIGHT means before CHLIM. If DCH=0, caret is between (and CHLIM - CH# is not DCH=0).") + (* ;; "POINT=LEFT means before CH#, POINT=RIGHT means before CHLIM. If DCH=0, caret is between (and CHLIM - CH# is not DCH=0).") - [SETQ CHLIM (CL:IF (EQ DCH 0) - (ADD1 CH#) - (IMIN (IPLUS CH# DCH) - (ADD1 TEXTLEN)))] - (SETSEL SEL CH# CH#) - (FSETSEL SEL DCH DCH) - (FSETSEL SEL CHLIM CHLIM) - (FSETSEL SEL POINT POINT) - (FSETSEL SEL SET T) (* ; "") - (FSETSEL SEL SELOBJ NIL) (* ; + (SETSEL SEL CH# CH#) + (FSETSEL SEL DCH DCH) + (FSETSEL SEL CHLIM (CL:IF (EQ DCH 0) + (ADD1 CH#) + (IPLUS CH# DCH))) + (FSETSEL SEL POINT POINT) + (FSETSEL SEL SELOBJ NIL) (* ;  "If we are moving around, we are moving away from any old object") - (CL:UNLESS DONTFIX (\TEDIT.FIXSEL SEL)) - SEL]) + (FSETSEL SEL SET T) + (CL:WHEN LOOKS (\TEDIT.SET.SEL.LOOKS SEL LOOKS)) + SEL]) + +(\TEDIT.CARETLINE + [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 7-Nov-2024 21:50 by rmk") + (* ; "Edited 4-Oct-2024 08:40 by rmk") + (* ; "Edited 24-Apr-2024 11:33 by rmk") + + (* ;; + "Returns the line in PANE that contains SEL's caret (NIL if the caret isn't showing in PANE).") + + (CL:WHEN (GETSEL SEL SET) + (SELECTQ (GETSEL SEL POINT) + (LEFT (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) + (RIGHT (\TEDIT.SEL.LN SEL PANE TEXTOBJ)) + (\TEDIT.THELP "ILLEGAL POINT" (GETSEL SEL POINT))))]) (\TEDIT.SEL.L1 - [LAMBDA (SEL PANE TEXTOBJ) (* ; "Edited 16-Nov-2023 23:43 by rmk") + [LAMBDA (SEL PANE TEXTOBJ) (* ; "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") - (for P inpanes (PROGN TEXTOBJ) as L in (GETSEL SEL L1) when (EQ P PANE) do (RETURN L]) + (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 16-Nov-2023 23:43 by rmk") + [LAMBDA (SEL PANE TEXTOBJ) (* ; "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") - (for P inpanes (PROGN TEXTOBJ) as L in (GETSEL SEL LN) when (EQ P PANE) do (RETURN L]) + (for L in (GETSEL SEL LN) as P inpanes (PROGN TEXTOBJ) when (EQ P PANE) do (RETURN L]) (\TEDIT.SEL.DELETEDCHARS - [LAMBDA (SELTOFIX TARGETSEL) (* ; "Edited 20-Feb-2024 17:31 by rmk") + [LAMBDA (SELTOFIX FIRSTCHAR LEN) (* ; "Edited 26-Nov-2024 22:31 by rmk") + (* ; "Edited 7-Jul-2024 12:09 by rmk") + (* ; "Edited 20-Feb-2024 17:31 by rmk") (* ; "Edited 15-Feb-2024 23:39 by rmk") (* ; "Edited 14-Feb-2024 20:59 by rmk") - (* ;; "Adjust SELTOFIX to reflect character number translations after NCHARSDELETED characters starting at FIRSTDELETEDCHAR have been (or would be) removed.") + (* ;; "Adjust SELTOFIX to reflect character number translations after LEN characters starting at FIRSTCHAR have been removed.") - (LET ((FIRSTDELETEDCHNO (FGETSEL TARGETSEL CH#)) - (LASTDELETEDCHNO (SUB1 (FGETSEL TARGETSEL CHLIM))) - (NCHARSDELETED (FGETSEL TARGETSEL DCH))) - (CL:WHEN (AND (FGETSEL SELTOFIX SET) - (IGEQ (FGETSEL SELTOFIX CH#) - FIRSTDELETEDCHNO)) + (CL:WHEN (type? SELECTION FIRSTCHAR) + (SETQ LEN (FGETSEL FIRSTCHAR DCH)) + (SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#))) + (CL:WHEN (IGEQ (FGETSEL SELTOFIX CHLIM) + FIRSTCHAR) - (* ;; - "Nothing to do if SELTOFIX is not set or the deletion happened after the selection.") + (* ;; "Nothing to do if the deletion happened after the selection.") - [if (ILESSP LASTDELETEDCHNO (FGETSEL SELTOFIX CH#)) + [LET ((LASTCHAR (IPLUS FIRSTCHAR LEN -1))) + (if (ILESSP LASTCHAR (FGETSEL SELTOFIX CH#)) then (* ;; - "All deleted characters are in front of SELTOFIX, just move SETOFIXL forward") + "All deleted characters are in front of SELTOFIX, just move SELTOFIX forward") (add (FGETSEL SELTOFIX CH#) - (IMINUS NCHARSDELETED)) + (IMINUS LEN)) (add (FGETSEL SELTOFIX CHLIM) - (IMINUS NCHARSDELETED)) + (IMINUS LEN)) else (* ;; " SELTOFIX starts after the last pre-deletion character and is shortened so that it only covers its still-remaining characters. Because of IMAX, this reduces to a point selection if all of SELTOFIX's characters (and more) have been deleted.") - (\TEDIT.UPDATE.SEL SELTOFIX FIRSTDELETEDCHNO - (IMAX 0 (IDIFFERENCE LASTDELETEDCHNO (SUB1 (FGETSEL SELTOFIX CHLIM])]) + (\TEDIT.UPDATE.SEL SELTOFIX FIRSTCHAR (IMAX 0 (IDIFFERENCE LASTCHAR + (FGETSEL SELTOFIX CHLAST])]) ) (DEFINEQ (\TEDIT.COPYSEL - [LAMBDA (FROM TO) (* ; "Edited 24-Jan-2024 09:37 by rmk") + [LAMBDA (FROM TO) (* ; "Edited 3-Sep-2024 22:44 by rmk") + (* ; "Edited 7-Jul-2024 11:21 by rmk") + (* ; "Edited 30-Jun-2024 23:21 by rmk") + (* ; "Edited 29-Apr-2024 12:35 by rmk") + (* ; "Edited 24-Jan-2024 09:37 by rmk") (* ; "Edited 25-Oct-2023 22:24 by rmk") (* ; "Edited 22-Oct-2023 23:05 by rmk") (* ; "Edited 23-Apr-2023 12:16 by rmk") (* ; "Edited 2-Mar-2023 14:55 by rmk") (* ; "Edited 21-Oct-2022 18:42 by rmk") + + (* ;; "This copies FROM to TO, but does not include the SELTEXTSTREAM.") + (\DTEST FROM 'SELECTION) - (if TO + [if TO then (\DTEST TO 'SELECTION) (FSETSEL TO X0 (FGETSEL FROM X0)) (FSETSEL TO CH# (FGETSEL FROM CH#)) @@ -1596,43 +1513,254 @@ (FSETSEL TO DCH (FGETSEL FROM DCH)) (FSETSEL TO L1 (COPY (FGETSEL FROM L1))) (FSETSEL TO LN (COPY (FGETSEL FROM LN))) + (FSETSEL TO SELLINES (COPY (FGETSEL FROM SELLINES))) (FSETSEL TO POINT (FGETSEL FROM POINT)) (FSETSEL TO SET (FGETSEL FROM SET)) - (FSETSEL TO SELTEXTOBJ (FGETSEL FROM SELTEXTOBJ)) + (FSETSEL TO SELTEXTSTREAM NIL) (FSETSEL TO SELKIND (FGETSEL FROM SELKIND)) (FSETSEL TO HOW (FGETSEL FROM HOW)) (FSETSEL TO HOWHEIGHT (FGETSEL FROM HOWHEIGHT)) (FSETSEL TO HASCARET (FGETSEL FROM HASCARET)) (FSETSEL TO SELOBJ (FGETSEL FROM SELOBJ)) (FSETSEL TO ONFLG (FGETSEL FROM ONFLG)) - else (SETQ TO (create SELECTION using FROM))) + else (SETQ TO (create SELECTION using FROM SELTEXTSTREAM _ NIL L1 _ (COPY (FGETSEL FROM L1)) + LN _ (COPY (FGETSEL FROM LN)) + SELLINES _ (COPY (FGETSEL FROM SELLINES] TO]) (\TEDIT.SEL.CHANGED? - [LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* ; "Edited 13-Jun-2023 21:50 by rmk") + [LAMBDA (NEWSEL OLDSEL) (* ; "Edited 19-Oct-2024 12:15 by rmk") + (* ; "Edited 11-Sep-2024 00:02 by rmk") + (* ; "Edited 18-Jul-2024 08:24 by rmk") + (* ; "Edited 10-Jul-2024 16:27 by rmk") + (* ; "Edited 8-Jul-2024 23:23 by rmk") + (* ; "Edited 7-Jul-2024 08:58 by rmk") + (* ; "Edited 29-Apr-2024 13:00 by rmk") + (* ; "Edited 13-Jun-2023 21:50 by rmk") (* ; "Edited 23-May-2023 12:22 by rmk") (* ; "Edited 9-Apr-2023 23:15 by rmk") (* ; "Edited 30-May-91 23:01 by jds") (* ;; "Decide whether there has been an interesting change in the selection, so we can decide whether to refresh its hilighting on the screen.") - (AND NEWSEL (GETSEL NEWSEL SET) - (NOT (AND (GETSEL OLDSEL SET) - (IEQP (GETSEL NEWSEL CH#) - (GETSEL OLDSEL CH#)) - (IEQP (GETSEL NEWSEL CHLIM) - (GETSEL OLDSEL CHLIM)) - (IEQP (GETSEL NEWSEL DCH) - (GETSEL OLDSEL DCH)) - (EQ (GETSEL NEWSEL SELTEXTOBJ) - (GETSEL OLDSEL SELTEXTOBJ)) - (EQ (GETSEL NEWSEL POINT) - (GETSEL OLDSEL POINT)) - (EQ (GETSEL NEWSEL HOW) - (GETSEL OLDSEL HOW)) - (EQ (GETSEL NEWSEL HOWHEIGHT) - (GETSEL OLDSEL HOWHEIGHT)) - (EQ OLDSELOP NEWSELOP]) + (SELECTION! NEWSEL) + (SELECTION! OLDSEL) + (NOT (AND (FGETSEL OLDSEL SET) + (IEQP (FGETSEL NEWSEL CH#) + (FGETSEL OLDSEL CH#)) + (IEQP (FGETSEL NEWSEL CHLIM) + (FGETSEL OLDSEL CHLIM)) + (IEQP (FGETSEL NEWSEL DCH) + (FGETSEL OLDSEL DCH)) + (EQ (FGETSEL NEWSEL POINT) + (FGETSEL OLDSEL POINT)) + (EQ (FGETSEL NEWSEL HOW) + (FGETSEL OLDSEL HOW)) + (EQ (FGETSEL NEWSEL HOWHEIGHT) + (FGETSEL OLDSEL HOWHEIGHT)) + (EQ (FGETSEL NEWSEL SELKIND) + (FGETSEL OLDSEL SELKIND)) + (EQ (FGETSEL NEWSEL HASCARET) + (FGETSEL OLDSEL HASCARET)) + (EQ (FGETSEL NEWSEL SELOBJ) + (FGETSEL OLDSEL SELOBJ]) +) + + + +(* ; "Image objects") + +(DEFINEQ + +(\TEDIT.SELECT.OBJECT + [LAMBDA (TEXTOBJ NEWSEL LINE X Y SELPANE SELOPERATION BUTTON) + (* ; "Edited 6-Dec-2024 11:09 by rmk") + (* ; "Edited 30-Nov-2024 00:01 by rmk") + (* ; "Edited 26-Nov-2024 03:45 by rmk") + (* ; "Edited 19-Oct-2024 20:09 by rmk") + (* ; "Edited 5-Oct-2024 22:45 by rmk") + (* ; "Edited 21-Aug-2024 15:29 by rmk") + (* ; "Edited 20-Aug-2024 10:12 by rmk") + (* ; "Edited 26-Jul-2024 14:31 by rmk") + (* ; "Edited 20-Jul-2024 09:16 by rmk") + (* ; "Edited 18-Jul-2024 12:17 by rmk") + (* ; "Edited 13-Jun-2024 17:11 by rmk") + (* ; "Edited 24-Apr-2024 09:50 by rmk") + (* ; "Edited 15-Mar-2024 19:22 by rmk") + (* ; "Edited 24-Jan-2024 11:59 by rmk") + (* ; "Edited 14-Oct-2023 11:38 by rmk") + (* ; "Edited 10-Apr-2023 08:38 by rmk") + (* ; "Edited 29-Mar-94 13:28 by jds") + (LET ((OBJ (FGETSEL NEWSEL SELOBJ)) + RESULT) + (RESETLST + (\TEDIT.CLIP.OBJECT OBJ (FGETSEL NEWSEL X0) + LINE PANE) (* ; + "Go tell him he's being pointed at.") + (* ; + "Note: SELOPERATION is undocumented") + (SETQ RESULT (ERSETQ (APPLY* (IMAGEOBJPROP OBJ 'BUTTONEVENTINFN) + OBJ + (WINDOWPROP SELPANE 'DSP) + NEWSEL + (IDIFFERENCE X (FGETSEL NEWSEL X0)) + (IDIFFERENCE Y (FGETLD LINE YBASE)) + SELPANE + (fetch (TEXTWINDOW WTEXTSTREAM) of SELPANE) + BUTTON SELOPERATION)))) + + (* ;; "The clipping region is now restored.") + + (if (OR (NULL RESULT) + (EQMEMB 'DON'T RESULT) + (EQMEMB 'DONT RESULT)) + then + (* ;; + "If NIL, an error happened. Maybe we should propagate the error, e.g. RETFROM the BUTTONEVENTFN?") + + (* ;; "If DON't the object declines to be selected. ") + + (FSETSEL NEWSEL SET NIL) + elseif (EQMEMB 'CHANGED RESULT) + then + (* ;; "The object may have updated its own image, within its coordinate system. But its box may have changed, and if so, the document also needs to reformat and the selection has to be adjusted. We know that CURSEL is currently displayed, we get it out of the way here, expecting that \TEDIT.BUTTONEVENTFN will synchronize CURSEL with NEWSEL.") + + (\TEDIT.UPDATE.LINES TEXTOBJ 'CHANGED (FGETSEL NEWSEL CH#) + 1) + (\TEDIT.SHOWSEL NIL T TEXTOBJ) + (FSETTOBJ TEXTOBJ \DIRTY T) + elseif (NULL (CAR RESULT)) + then + (* ;; + "NIL: Highlighting and selection have been taken care of, nothing for Tedit to do on this object.") + + (FSETSEL NEWSEL SELOBJ NIL) + else + (* ;; "Only non-NIL appears to matter: could be just T ?") + + (CAR RESULT]) + +(\TEDIT.SHOWSEL.OBJECT + [LAMBDA (TEXTOBJ SEL L1 ON PANE) (* ; "Edited 1-Dec-2024 11:52 by rmk") + (* ; "Edited 21-Aug-2024 15:31 by rmk") + (* ; "Edited 19-Jul-2024 23:15 by rmk") + (* ; "Edited 18-Jul-2024 12:19 by rmk") + (* ; "Edited 24-Jan-2024 09:27 by rmk") + (* ; "Edited 25-Nov-2023 15:48 by rmk") + (* ; "Edited 14-Oct-2023 12:12 by rmk") + (* ; "Edited 6-Jun-2023 15:28 by rmk") + (* ; "Edited 1-May-2023 14:36 by rmk") + (* ; "Edited 9-Apr-2023 15:37 by rmk") + (* ; "Edited 12-Jun-90 17:50 by mitani") + + (* ;; "We are hilighting (or dehilighting) a selection containing only a single image object if it appears in PANE ") + + (LET [(OBJ (FGETSEL SEL SELOBJ)) + (IMAGEFN (IMAGEOBJPROP (FGETSEL SEL SELOBJ) + 'WHENOPERATEDONFN] + (CL:WHEN (AND IMAGEFN (INSIDE? (PANEREGION PANE) + (FGETSEL SEL X0) + (FGETLD L1 YBOT))) + + (* ;; "The selection is in the pane and has an image function") + + (RESETLST + (\TEDIT.CLIP.OBJECT OBJ (FGETSEL SEL X0) + L1 PANE) + (ERSETQ (APPLY* IMAGEFN OBJ PANE (CL:IF ON + 'HIGHLIGHTED + 'UNHIGHLIGHTED) + SEL + (FGETTOBJ TEXTOBJ STREAMHINT)))))]) + +(\TEDIT.CLIP.OBJECT + [LAMBDA (OBJ X LINE PANE) (* ; "Edited 1-Dec-2024 11:54 by rmk") + (* ; "Edited 21-Aug-2024 15:38 by rmk") + (* ; "Edited 19-Jul-2024 18:21 by rmk") + + (* ;; "Resets the coordinate system of PANE to the coordinate system of the object. Original PANE coordinates are restored when an enclosing RESETLST is exited.") + + (* ;; "The 0,0 is the location of the bottom-left corner of the object, (width,height) is the upper-right corner of the object.") + + (* ;; "Gets the object's PANE Y position from LINE, X position from SEL.") + + (LET [(OBJBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) + (IMAGEBOX OBJ PANE))) + (DS (WINDOWPROP PANE 'DSP] + [RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS X (DSPXOFFSET NIL DS)) + (fetch XKERN of OBJBOX)) + DS) + `(PROGN (DSPXOFFSET OLDVALUE ,DS] + [RESETSAVE (DSPYOFFSET (IDIFFERENCE (IPLUS (GETLD LINE YBASE) + (DSPYOFFSET NIL DS)) + (fetch YDESC of OBJBOX)) + DS) + `(PROGN (DSPYOFFSET OLDVALUE ,DS] + (RESETSAVE (DSPCLIPPINGREGION (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ (IMIN (fetch XSIZE of OBJBOX) + (IDIFFERENCE (PANEWIDTH PANE) + X)) + HEIGHT _ (fetch YSIZE of OBJBOX)) + DS) + `(PROGN (DSPCLIPPINGREGION OLDVALUE ,DS]) + +(\TEDIT.OPERATE.OBJECT + [LAMBDA (TSTREAM SEL PANE OPERATION) (* ; "Edited 1-Dec-2024 11:55 by rmk") + (* ; "Edited 18-Oct-2024 13:44 by rmk") + (* ; "Edited 6-Oct-2024 23:09 by rmk") + (* ; "Edited 27-Aug-2024 10:03 by rmk") + (* ; "Edited 21-Aug-2024 15:57 by rmk") + (* ; "Edited 26-Jul-2024 14:50 by rmk") + (* ; "Edited 20-Jul-2024 23:46 by rmk") + + (* ;; "SEL is a selection on a single image object in PANE, presumably where the mouse went down (SELPANE). This executes that object's WHENOPERATEDONFN.") + + (* ;; "If OPERATION is SELECTED, the function sees the true coordinate system of PANE, with PANE positioned at the hot-spot of the object in the pane's coordinate system, simulating the setup in DISPLAYLINE..") + + (* ;; "Otherwise (the highlighting/showsel cases), the PANE's coordinate system has been restricted down to the object's: 0,0 is the lower-left corner, everything outside of the object is clipped.") + + (* ;; "This difference is odd: the WHENCHANGEDFN documentation is unclear about the set up for highlight vs. display. The WHENOPERATEDON interface maybe wasn't thought out so well.") + + (* ;; "PANE presumably is the SELPANE. ") + + (LET* ((OBJ (FGETSEL SEL SELOBJ)) + (WHENOPERATEDONFN (IMAGEOBJPROP OBJ 'WHENOPERATEDONFN)) + (TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + LINE) + (CL:WHEN WHENOPERATEDONFN + (SELECTQ OPERATION + (SELECTED + (* ;; "Called from BUTTONEVENTFN.DOOPERATION. Execute once, in PANE. SHOWSEL and FIXSEL do the updates across other panes. This runs in PANE's coordinate system. We can't do it if we can't determine from SEL where OBJ is located in PANE.") + + (CL:WHEN (SETQ LINE (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) + (TEDIT.PROMPTCLEAR TSTREAM) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (MOVETO (FGETSEL SEL X0) + (FGETLD LINE YBASE) + PANE) + (ERSETQ (APPLY* WHENOPERATEDONFN OBJ (WINDOWPROP PANE 'DSP) + OPERATION SEL TSTREAM)) + (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Restore highlighting") + (\TEDIT.SHOWSEL SEL T TEXTOBJ))) + ((HIGHLIGHTED UNHIGHLIGHTED DESELECTED) + + (* ;; "Execute in each pane where OBJ is visible, in OBJ's coordinate system. This may be duplicating the pane iteration in SHOWSEL?") + + [for L1 in (FGETSEL SEL L1) as P inpanes TEXTOBJ + when (AND L1 (INSIDE? (PANEREGION P) + (FGETSEL SEL X0) + (FGETLD L1 YBOT))) + do + (* ;; "The image object is visible in P's single line. ") + + (RESETLST (* ; "PROPAGATE THE ERROR?") + (\TEDIT.CLIP.OBJECT OBJ (FGETSEL SEL X0) + L1 P) + (ERSETQ (APPLY* WHENOPERATEDONFN OBJ (WINDOWPROP PANE 'DSP) + OPERATION SEL TSTREAM)))]) + (\TEDIT.THELP "BAD WHENOPERATEDON OPERATION" OPERATION)))]) ) @@ -1642,7 +1770,11 @@ (DEFINEQ (\TEDIT.SELPIECES - [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 17-Mar-2024 00:24 by rmk") + [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "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") + (* ; "Edited 17-Mar-2024 00:24 by rmk") (* ; "Edited 4-Mar-2024 22:47 by rmk") (* ; "Edited 12-Dec-2023 12:06 by rmk") (* ; "Edited 11-Dec-2023 10:05 by rmk") @@ -1656,6 +1788,10 @@ (* ;; "") + (* ;; "Returns NIL if the arguments don't cover a valid piece sequence.") + + (* ;; "") + (* ;; "A prefix of the piece containing FIRSTCHAR in TEXTOBJ may be split off, to provide a properly aligned suffix.") (* ;; "LIkewise, a suffix of the piece containing LASTCHAR may be split off, to povide a properly aligned prefix.") @@ -1670,30 +1806,36 @@ (LET (FIRSTCHAR LEFTPC RIGHTPC) (if (type? SELECTION SEL/FIRSTCHAR) - then (SETQ TEXTOBJ (FGETSEL SEL/FIRSTCHAR SELTEXTOBJ)) - (SETQ FIRSTCHAR (FGETSEL SEL/FIRSTCHAR CH#)) - [SETQ LASTCHAR (CL:IF (EQ 0 (FGETSEL SEL/FIRSTCHAR DCH)) - FIRSTCHAR - (SUB1 (FGETSEL SEL/FIRSTCHAR CHLIM)))] + 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)))] + else (SETQ FIRSTCHAR 0) + (SETQ LASTCHAR -1)) elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR) then (SETQ FIRSTCHAR (GETTH SEL/FIRSTCHAR THCH#)) (SETQ LASTCHAR (SUB1 (GETTH SEL/FIRSTCHAR THCHLIM))) else (SETQ FIRSTCHAR SEL/FIRSTCHAR)) + (CL:WHEN (AND (IBETWEENP FIRSTCHAR 1 (TEXTLEN TEXTOBJ)) + (IBETWEENP LASTCHAR FIRSTCHAR (TEXTLEN TEXTOBJ))) - (* ;; "Do the right first so that we retain the center piece when FIRTCHAR and LASTCHAR are in the same original piece.") + (* ;; "Do the right first so that we retain the center piece when FIRTCHAR and LASTCHAR are in the same original piece.") - (SETQ RIGHTPC (\TEDIT.ALIGNEDPIECE (ADD1 LASTCHAR) - TEXTOBJ)) - (SETQ LEFTPC (\TEDIT.ALIGNEDPIECE FIRSTCHAR TEXTOBJ)) - (create SELPIECES - SPFIRST _ LEFTPC - SPLAST _ (PREVPIECE RIGHTPC) - SPLEN _ (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) - SPFIRSTCHAR _ FIRSTCHAR - SPLASTCHAR _ LASTCHAR]) + (SETQ RIGHTPC (\TEDIT.ALIGNEDPIECE (ADD1 LASTCHAR) + TEXTOBJ)) + (SETQ LEFTPC (\TEDIT.ALIGNEDPIECE FIRSTCHAR TEXTOBJ)) + (create SELPIECES + SPFIRST _ LEFTPC + SPLAST _ (PREVPIECE RIGHTPC) + SPLEN _ (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) + SPFIRSTCHAR _ FIRSTCHAR + SPLASTCHAR _ LASTCHAR))]) (\TEDIT.SELPIECES.COPY - [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "Edited 11-Dec-2023 08:16 by rmk") + [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "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") (* ; "Edited 26-May-2023 00:28 by rmk") (* ; "Edited 21-May-2023 23:01 by rmk") @@ -1703,21 +1845,22 @@ (* ;; "FROMTEXTOBJ is optional. Providing a FROMTEXTOBJ that is different from TOTEXTOBJ is a signal that this is a cross-copy needing to create private copies of strings and files. ") - (CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ)) - (for PC NPC PREVPC NEWFIRSTPIECE inselpieces SELPIECES - do (SETQ NPC (\TEDIT.COPYPIECE PC FROMTEXTOBJ TOTEXTOBJ NIL OPERATION)) - (CL:UNLESS NPC (* ; "Was an object-copy disallowed?") - (RETURN)) + (CL:WHEN SELPIECES + (CL:UNLESS FROMTEXTOBJ (SETQ FROMTEXTOBJ TOTEXTOBJ)) + (for PC NPC PREVPC NEWFIRSTPIECE inselpieces 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") + (* ;; "Linke the new pieces together") - (if PREVPC - then (replace (PIECE NEXTPIECE) of PREVPC with NPC) - else (SETQ NEWFIRSTPIECE NPC)) - (replace (PIECE PREVPIECE) of NPC with PREVPC) - (SETQ PREVPC NPC) finally (RETURN (create SELPIECES - using SELPIECES SPFIRST _ NEWFIRSTPIECE SPLAST _ - PREVPC]) + (if PREVPC + then (SETPC PREVPC NEXTPIECE NPC) + else (SETQ NEWFIRSTPIECE NPC)) + (FSETPC NPC PREVPIECE PREVPC) + (SETQ PREVPC NPC) + finally (RETURN (create SELPIECES using SELPIECES SPFIRST _ NEWFIRSTPIECE SPLAST _ PREVPC) + )))]) (\TEDIT.SELPIECES.CONCAT [LAMBDA (SP1 SP2 TEXTOBJ) (* ; "Edited 3-Mar-2024 12:24 by rmk") @@ -1747,48 +1890,44 @@ SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2]) (\TEDIT.SELPIECES.CHARTRANSFORM - [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "Edited 3-Mar-2024 12:28 by rmk") + [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "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 smashes the pieces, use crosscopy \SELPIECES.COPY first to protect the document pieces.") + "This smashes the pieces, use crosscopy \TEDIT.SELPIECES.COPY first to protect the document pieces.") - (for PC PCONTENTS inselpieces SELPIECES + [for PC PCONTENTS 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)))) - (FILE.PTYPES (SETFILEPTR PCONTENTS (PFPOS PC)) - [if (AND NIL (\IOMODEP PCONTENTS 'BOTH T)) - then + (FILE.PTYPES [LET [(STR (ALLOCSTRING (PLEN PC] - (* ;; "Not clear whether \TEDIT.COPYPIECeS has set things up to allow us to actually smash the underlying stream. So for now, copy into string space.") + (* ;; "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 (\OUTCHAR PCONTENTS (APPLY* CHARFN (\PEEKCCODE PCONTENTS T) - TEXTOBJ))) - else - - (* ;; "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.") - - (LET ((FATP (NEQ THINFILE.PTYPE (PTYPE PC))) - STR) - (SETQ STR (ALLOCSTRING (PLEN PC) - NIL NIL FATP)) - (for I from 1 to (PLEN PC) - do (RPLCHARCODE STR I (APPLY* CHARFN (\INCCODE PCONTENTS) - TEXTOBJ))) - (FSETPC PC PCONTENTS STR) - (FSETPC PC PTYPE (CL:IF FATP - FATSTRING.PTYPE - THINSTRING.PTYPE)]) + [for I from 1 to (PLEN PC) + do (RPLCHARCODE STR I (APPLY* CHARFN (\TEDIT.PIECE.NTHCHARCODE + TEXTOBJ PC I] + (if (fetch (STRINGP FATSTRINGP) of STR) + then (FSETPC PC PTYPE FATSTRING.PTYPE) + (FSETPC PC PBYTESPERCHAR 2) + (FSETPC PC PBINABLE NIL) + else (FSETPC PC PTYPE THINSTRING.PTYPE) + (FSETPC PC PBYTESPERCHAR 1) + (FSETPC PC PBINABLE T)) + (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 - (HELP "SUBSTREAM PIECE ?")) - (SHOULDNT))) + (\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED")) + (\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC] SELPIECES]) (\TEDIT.SELPIECES.FROM.STRING @@ -1874,7 +2013,9 @@ SPLASTCHAR _ (NCHARS STRING]) (\TEDIT.SELPIECES.TO.STRING - [LAMBDA (SELPIECES OBJECTCHARCODE TEXTOBJ) (* ; "Edited 3-Mar-2024 12:24 by rmk") + [LAMBDA (SELPIECES OBJECTCHARCODE TEXTOBJ) (* ; "Edited 7-Nov-2024 21:50 by rmk") + (* ; "Edited 4-Oct-2024 08:41 by rmk") + (* ; "Edited 3-Mar-2024 12:24 by rmk") (* ; "Edited 2-Jun-2023 12:07 by rmk") (* ; "Edited 24-May-2023 20:00 by rmk") @@ -1900,8 +2041,8 @@ (CHARCODE ESCAPE))) (add I 1)) (SUBSTREAM.PTYPE - (HELP "SUBSTREAM PIECE?")) - (SHOULDNT)) finally (RETURN RESULT]) + (\TEDIT.THELP "SUBSTREAM PIECES NOT IMPLEMENTED")) + (\TEDIT.THELP "ILLEGAL PIECE TYPE" (PTYPE PC))) finally (RETURN RESULT]) ) @@ -1911,53 +2052,146 @@ (DEFINEQ (TEDIT.XYTOCH - [LAMBDA (X Y PANE) (* ; "Edited 20-Mar-2024 14:32 by rmk") + [LAMBDA (X Y PANE) (* ; "Edited 6-Dec-2024 11:55 by rmk") + (* ; "Edited 1-Dec-2024 11:28 by rmk") + (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 20-Nov-2024 11:27 by rmk") + (* ; "Edited 8-Jul-2024 22:25 by rmk") + (* ; "Edited 28-Jun-2024 15:21 by rmk") + (* ; "Edited 25-Jun-2024 15:24 by rmk") + (* ; "Edited 20-Apr-2024 13:00 by rmk") + (* ; "Edited 20-Mar-2024 14:32 by rmk") - (* ;; "Returns the character number of the character at coordinates X and Y in PANE.") + (* ;; "Returns the character number of the character at coordinates X and Y in PANE. X and Y can be keywords LEFT/RIGHT/TOP/BOTTOM or coordinates. Does not change the documents SEL.") - (LET ((TEXTOBJ (TEXTOBJ PANE)) - SEL) + (* ;; "Assumes that the keyword coordinates (as well as numeric X and Y) are relative to PANE's clipping region and not some subregion.") + + (LET ((SCRSEL (create SELECTION))) (* ;; "The X W fields should be good in all panes, not sure about the Y W fields. Maybe those are PANE-dependent.") (SETQ X (SELECTQ X - (LEFT (GETTOBJ TEXTOBJ WLEFT)) - (RIGHT (SUB1 (GETTOBJ TEXTOBJ WRIGHT))) + (LEFT (PANELEFT PANE)) + (RIGHT (* ; + "Region RIGHT has the SUB1, but also adds LEFT. Not sure") + (SUB1 (PANEWIDTH PANE))) X)) (SETQ Y (SELECTQ Y - (TOP (SUB1 (GETTOBJ TEXTOBJ WTOP))) - (BOTTOM (GETTOBJ TEXTOBJ WBOTTOM)) + (TOP (* ; + "Region TOP has the SUB1, but also adds BOTTOM. Not sure") + (SUB1 (PANEHEIGHT PANE))) + (BOTTOM (PANEBOTTOM PANE)) Y)) - (SETQ SEL (\TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (fetch (TEXTWINDOW PLINES) of PANE) - 'TEXT NIL NIL PANE)) - (CL:WHEN (AND (type? SELECTION SEL) - (GETSEL SEL SET)) (* ; - "He pointed at something real; return that.") - (GETSEL SEL CH#))]) + (\TEDIT.XYTOSEL X Y SCRSEL (PANETOBJ PANE) + PANE + 'NORMAL + 'LEFT NIL 'TEXT) + (CL:WHEN (FGETSEL SCRSEL SET) + (FGETSEL SCRSEL CH#]) + +(TEDIT.SELPROP + [LAMBDA X (* ; "Edited 31-Oct-2024 18:00 by rmk") + (* ; "Edited 23-Sep-2024 23:11 by rmk") + (* ; "Edited 22-Sep-2024 11:20 by rmk") + (* ; "Edited 19-Aug-2024 13:55 by rmk") + (* ; "Edited 7-Jul-2024 12:06 by rmk") + (* ; "Edited 29-Apr-2024 08:31 by rmk") + (* ; "Edited 6-Apr-2024 20:33 by rmk") + (* ; "Edited 5-Apr-2024 12:29 by rmk") + (* ; "Edited 2-Apr-2024 13:27 by rmk") + + (* ;; "User entry to get and set the properties of an external selection So that SELTEXTSTREAM is OK (A selection from TEDIT.GETSEL is a copy, TEDIT.SETSEL is needed to install it.)") + + (CL:UNLESS (IGEQ X 2) + (\ILLEGAL.ARG X)) + (LET ([SEL (if (type? SELECTION (ARG X 1)) + then (ARG X 1) + else (\DTEST (GETTOBJ (TEXTOBJ (ARG X 1)) + SEL) + 'SELECTION] + (PROP (ARG X 2)) + NEWVALUE) + (CL:UNLESS (FGETSEL SEL SET) + (ERROR "SELECTION NOT SET" SEL)) + (PROG1 (SELECTQ PROP + (CH# (FGETSEL SEL CH#)) + (CHLIM (FGETSEL SEL CHLIM)) + ((LENGTH DCH) + (FGETSEL SEL DCH)) + (POINT (FGETSEL SEL POINT)) + ((KIND SELKIND) + (FGETSEL SEL SELKIND)) + (CHLAST (if (EQ 0 (FGETSEL SEL DCH)) + then (FGETSEL SEL CH#) + else (SUB1 (FGETSEL SEL CHLIM)))) + (POINTCH# (TEDIT.GETPOINT (FGETSEL SEL SELTEXTSTREAM) + SEL)) + (SELOBJ (FGETSEL SEL SELOBJ)) + (TEXTSTREAM (FGETSEL SEL SELTEXTSTREAM)) + (SHADE (FGETSEL SEL HOW)) + (SHADEHEIGHT (FGETSEL SEL HOWHEIGHT)) + (\ILLEGAL.ARG PROP)) + (CL:WHEN (IGREATERP X 2) + (SETQ NEWVALUE (ARG X 3)) + (SELECTQ PROP + (CH# (FSETSEL SEL CH# NEWVALUE)) + ((LENGTH DCH) + (\TEDIT.UPDATE.SEL SEL NIL NEWVALUE)) + (POINT (FSETSEL SEL POINT (OR [CAR (MEMB NEWVALUE '(LEFT RIGHT] + (\ILLEGAL.ARG NEWVALUE)))) + ((KIND SELKIND) + (FSETSEL SEL SELKIND (OR [CAR (MEMB NEWVALUE + '(CHAR WORD LINE PARA VOLATILE] + (\ILLEGAL.ARG NEWVALUE)))) + (CHLAST (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE (ADD1 NEWVALUE) + (FGETSEL SEL CH#)))) + (CHLIM (\TEDIT.UPDATE.SEL SEL NIL (IDIFFERENCE NEWVALUE (FGETSEL SEL CH#)))) + (\ILLEGAL.ARG PROP)) + [\TEDIT.FIXSEL SEL (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (GETSEL SEL + SELTEXTSTREAM]))]) (TEDIT.GETPOINT - [LAMBDA (STREAM SEL) (* ; "Edited 5-Jun-2023 15:30 by rmk") + [LAMBDA (TSTREAM SEL) (* ; "Edited 31-Oct-2024 17:46 by rmk") + (* ; "Edited 29-Oct-2024 11:47 by rmk") + (* ; "Edited 4-Oct-2024 08:41 by rmk") + (* ; "Edited 29-Apr-2024 10:49 by rmk") + (* ; "Edited 5-Jun-2023 15:30 by rmk") (* ; "Edited 30-May-91 23:03 by jds") - (* ;; "Given a selection, tell the CHNO that type-in would be inserted in front of. IF SEL is given, use it to decide. Otherwise, use STREAM's current selection. SEL can also be a character number, which is simply returned.") + (* ;; "Given a selection, tell the CHNO that type-in would be inserted in front of. IF SEL is given, use it to decide. Otherwise, use TSTREAM's current selection. SEL can also be a character number, which is simply returned.") - (CL:UNLESS SEL - (SETQ SEL (TEXTSEL (TEXTOBJ STREAM)))) - (if (NOT (type? SELECTION SEL)) - then SEL - elseif (FGETSEL SEL SET) - then - (* ;; "LEFT and RIGHT are the same for a point (DCH=0) selection.") + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (if (FIXP SEL) + then (CL:UNLESS (AND (ILEQ SEL (ADD1 (TEXTLEN TEXTOBJ))) + (IGEQ SEL 1)) + (\ILLEGAL.ARG SEL)) + SEL + else (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) - (SELECTQ (FGETSEL SEL POINT) - (LEFT (FGETSEL SEL CH#)) - (RIGHT (FGETSEL SEL CHLIM)) - (SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."]) + (* ;; "LEFT and RIGHT are the same for a point (DCH=0) selection.") + + (SELECTION! SEL) + (SELECTQ (FGETSEL SEL POINT) + (LEFT (FGETSEL SEL CH#)) + (RIGHT (* ; + "CHLIM is probaby not set appropriately for a RIGHT point selection") + (CL:IF (ZEROP (FGETSEL SEL DCH)) + (ADD1 (FGETSEL SEL CH#)) + (FGETSEL SEL CHLIM))) + (\TEDIT.THELP "Selection's POINT is neither RIGHT nor LEFT." (FGETSEL SEL POINT]) (TEDIT.GETSEL - [LAMBDA (TSTREAM) (* ; "Edited 1-May-2023 21:07 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2024 11:18 by rmk") + (* ; "Edited 1-May-2023 21:07 by rmk") (* ; "Edited 30-May-91 23:03 by jds") - (create SELECTION using (fetch (TEXTOBJ SEL) of (TEXTOBJ TSTREAM]) + + (* ;; "This returns a copy of TSTREAM's current SEL for external use. The textstream never points to this selection. As long as this selection is alive, it holds down the TSTREAM.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (create SELECTION using (FGETTOBJ (TEXTOBJ TSTREAM) + SEL) + SELTEXTSTREAM _ TSTREAM]) (TEDIT.GETSEL.PARA [LAMBDA (TSTREAM) (* ; "Edited 16-Jan-2024 14:59 by rmk") @@ -1973,26 +2207,6 @@ (create SELECTION using SEL CH# _ PCH# CHLIM _ PCHLIM DCH _ (IDIFFERENCE PCHLIM PCH#) ONFLG _ NIL SET _ T]) -(TEDIT.MAKESEL - [LAMBDA (STREAM CH# LEN POINT) (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 9-Mar-2024 12:03 by rmk") - (* ; "Edited 16-Jan-2024 14:52 by rmk") - (* ; "Edited 23-May-2023 12:39 by rmk") - (* ; "Edited 18-Apr-2023 23:53 by rmk") - (* ; "Edited 21-Oct-2022 18:37 by rmk") - (* ; "Edited 30-May-91 23:03 by jds") - (LET* ((TEXTOBJ (TEXTOBJ STREAM)) - (SEL (FGETTOBJ TEXTOBJ SEL))) - (\TEDIT.SHOWSEL SEL NIL NIL TEXTOBJ) - (FSETSEL SEL CH# CH#) - (FSETSEL SEL CHLIM (IMAX CH# (IPLUS CH# LEN))) - (FSETSEL SEL DCH LEN) - (FSETSEL SEL POINT (OR POINT 'LEFT)) - (FSETSEL SEL SELTEXTOBJ TEXTOBJ) - (FSETSEL SEL SET T) - (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ]) - (TEDIT.SCANSEL [LAMBDA (TSTREAM) (* ; "Edited 21-Mar-2024 10:49 by rmk") (* ; "Edited 17-Mar-2024 12:07 by rmk") @@ -2010,8 +2224,10 @@ (FGETSEL SEL DCH))]) (TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 15-Mar-2024 13:34 by rmk") + [LAMBDA (SEL OPERATION) (* ; "Edited 18-May-2024 16:20 by rmk") + (* ; "Edited 29-Apr-2024 13:03 by rmk") (* ; "Edited 9-Mar-2024 12:04 by rmk") + (* ; "Edited 15-Mar-2024 13:34 by rmk") (* ; "Edited 12-Oct-2023 22:32 by rmk") (* ; "Edited 10-Jun-2023 13:35 by rmk") (* ; "Edited 20-May-2023 23:53 by rmk") @@ -2020,16 +2236,24 @@ (* ;; "Set what the selection should be displayed like, given what it's for (NORMAL, COPY, MOVE, etc.). This is a documented entry.") - (LET ((WASON (GETSEL SEL ONFLG))) - (\TEDIT.SHOWSEL SEL NIL NIL (FGETSEL SEL SELTEXTOBJ)) + (LET ((WASON (GETSEL SEL ONFLG)) + (TEXTOBJ (TEXTOBJ SEL))) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (\TEDIT.SET.SEL.LOOKS SEL OPERATION) - (\TEDIT.SHOWSEL SEL WASON NIL (FGETSEL SEL SELTEXTOBJ)) + (\TEDIT.SHOWSEL SEL WASON TEXTOBJ) SEL]) (TEDIT.SETSEL - [LAMBDA (STREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) - (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (TSTREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) + (* ; "Edited 26-Nov-2024 23:51 by rmk") + (* ; "Edited 30-Jul-2024 23:27 by rmk") + (* ; "Edited 7-Jul-2024 11:18 by rmk") + (* ; "Edited 15-Jun-2024 10:08 by rmk") + (* ; "Edited 23-May-2024 09:13 by rmk") + (* ; "Edited 19-May-2024 00:01 by rmk") + (* ; "Edited 29-Apr-2024 12:39 by rmk") (* ; "Edited 15-Mar-2024 13:38 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 9-Mar-2024 12:04 by rmk") (* ; "Edited 22-Sep-2023 18:09 by rmk") (* ; "Edited 3-Aug-2023 23:12 by rmk") @@ -2040,87 +2264,94 @@ (* ;; "Given a text stream or textobj, and a piece of text to select, set the internal selection, and return it.") - (LET ((TEXTOBJ (TEXTOBJ STREAM)) - SEL TEXTLEN PC) - (SETQ SEL (TEXTSEL TEXTOBJ)) - (SETQ TEXTLEN (TEXTLEN TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL NIL TEXTOBJ) (* ; "First turn the old sel off.") - [COND - ((type? SELECTION CH#) (* ; + (* ;; "For convenience, TSTREAM may be provided as an external selection (with its SELTEXTSTREAM as the actual TSTREAM). That selection is never installed in TSTREAM, to avoid circularity.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (SEL (TEXTSEL TEXTOBJ)) + (TEXTLEN (TEXTLEN TEXTOBJ)) + PC) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ; "First turn the old sel off.") + [COND + ((type? SELECTION CH#) (* ;  "He gave use a selection; just plug it in") - (\TEDIT.COPYSEL CH# SEL) (* ; + (\TEDIT.COPYSEL CH# SEL) (* ;  "And make sure it can be turned on.") - (SETSEL SEL ONFLG NIL)) - (T (* ; + (SETSEL SEL ONFLG NIL)) + (T (* ;  "Documentation doesn't allow NIL, but DINFO.SHOWSEL passes it") - (SELECTQ POINT - (LEFT) - (RIGHT) - (NIL (SETQ POINT 'LEFT)) - (ERROR POINT "is an illegal POINT")) (* ; "He fed us numbers; use them") - (SETQ LEN (IMAX 0 LEN)) (* ; "Length must be positive") - (SETQ CH# (IMIN (IMAX 1 CH#) - (ADD1 TEXTLEN))) (* ; + (SELECTQ POINT + (LEFT) + (RIGHT) + (NIL (SETQ POINT 'LEFT)) + (ERROR POINT "is an illegal POINT")) (* ; "He fed us numbers; use them") + (SETQ LEN (IMAX 0 (OR LEN 0))) + (CL:WHEN (ILESSP CH# 0) + (SETQ CH# (IPLUS 1 TEXTLEN CH#))) (* ; "Length must be positive") + (SETQ CH# (IMIN (IMAX 1 CH#) + (ADD1 TEXTLEN))) (* ;  "Starting character. If beyond TEXTLEN, then just after EOF") - (SETSEL SEL CH# CH#) - [SETSEL SEL CHLIM (IMAX CH# (IMIN (IPLUS CH# LEN) - (ADD1 TEXTLEN] + (SETSEL SEL CH# CH#) + [SETSEL SEL CHLIM (IMAX CH# (IMIN (IPLUS CH# LEN) + (ADD1 TEXTLEN] - (* ;; "LEN may have been reduced by TEXTLEN") + (* ;; "LEN may have been reduced by TEXTLEN") - (SETQ LEN (IDIFFERENCE (GETSEL SEL CHLIM) - (GETSEL SEL CH#))) - (SETSEL SEL DCH LEN) - (SETSEL SEL POINT (if (IGREATERP CH# TEXTLEN) - then 'LEFT - elseif POINT - else 'LEFT)) (* ; "Which side the caret should go on") - (FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN) (* ; "If CH# beyond TEXTLEN, LEN is 0") - (SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#) - TEXTOBJ)) - (CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC)) - (PCONTENTS PC)))] - (SETSEL SEL SELTEXTOBJ TEXTOBJ) (* ; - "Link it back to the associated textobj") - [COND - [PENDINGDELFLG (* ; + (SETQ LEN (IDIFFERENCE (GETSEL SEL CHLIM) + (GETSEL SEL CH#))) + (SETSEL SEL DCH LEN) + (SETSEL SEL POINT (if (IGREATERP CH# TEXTLEN) + then 'LEFT + elseif POINT + else 'LEFT)) (* ; "Which side the caret should go on") + (FSETSEL SEL SELOBJ (CL:WHEN (EQ 1 LEN) (* ; "If CH# beyond TEXTLEN, LEN is 0") + (SETQ PC (\TEDIT.CHTOPC (GETSEL SEL CH#) + TEXTOBJ)) + (CL:WHEN (EQ OBJECT.PTYPE (PTYPE PC)) + (PCONTENTS PC)))] + [COND + [PENDINGDELFLG (* ;  "This selection is to be a pending-deletion sel.") - (SETTOBJ TEXTOBJ BLUEPENDINGDELETE T) (* ; + (SETTOBJ TEXTOBJ BLUEPENDINGDELETE T) (* ;  "Warn TEdit that there's a deletion pending") - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL] - (T (* ; + (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL] + (T (* ;  "This selection is to be a pending-deletion sel.") - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] - (SETSEL SEL SET T) (* ; + (\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ) + (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] + (SETSEL SEL SET T) (* ;  "Mark the selection as valid for others to use") - (CL:UNLESS LEAVECARETLOOKS (* ; + (CL:UNLESS LEAVECARETLOOKS (* ;  "And set the insertion looks to follow.") - (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))) - (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; + (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))) + (\TEDIT.FIXSEL SEL TEXTOBJ) (* ;  "Update the selection's screen location") - (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ) (* ; "Highlight it on the screen") - SEL]) + (\TEDIT.SHOWSEL SEL T TEXTOBJ) (* ; "Highlight it on the screen") + SEL]) (TEDIT.SHOWSEL - [LAMBDA (STREAM ONFLG SEL) (* ; "Edited 15-Mar-2024 13:36 by rmk") + [LAMBDA (TSTREAM ONFLG SEL) (* ; "Edited 7-Jul-2024 11:25 by rmk") + (* ; "Edited 18-May-2024 16:28 by rmk") + (* ; "Edited 29-Apr-2024 12:27 by rmk") (* ; "Edited 9-Mar-2024 12:06 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 3-May-2023 09:23 by rmk") (* ; "Edited 18-Apr-2023 23:54 by rmk") - (* ; "Edited 21-Oct-2022 18:36 by rmk") + (* ; + "Edited 21-Oct-2022 18:36 by rmk; Edited 30-May-91 23:04 by jds") (* ;; "He's giving us a selection to highlight and to connect it to this textobj.") - (* ; "Edited 30-May-91 23:04 by jds") - (LET ((TEXTOBJ (TEXTOBJ STREAM))) + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) (CL:UNLESS SEL (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) (CL:WHEN SEL - (SETSEL SEL SELTEXTOBJ TEXTOBJ) (\TEDIT.FIXSEL SEL TEXTOBJ) - (\TEDIT.SHOWSEL SEL ONFLG NIL TEXTOBJ))]) + (\TEDIT.SHOWSEL SEL ONFLG TEXTOBJ))]) (TEDIT.SEL.AS.STRING - [LAMBDA (TSTREAM SEL) (* ; "Edited 17-Mar-2024 12:05 by rmk") + [LAMBDA (TSTREAM SEL CODEFOROBJECT) (* ; "Edited 14-Jul-2024 00:12 by rmk") + (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 27-Jan-2024 22:57 by rmk") (* ; "Edited 23-May-2023 12:36 by rmk") (* ; "Edited 8-Sep-2022 23:35 by rmk") @@ -2145,11 +2376,18 @@ (\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL CH#))) (* ;  "Starting point for the string is start of selection.") - (for I from 1 to LEN do (RPLCHARCODE RESULT I (BIN TSTREAM))) + (for I C from 1 to LEN do (SETQ C (BIN TSTREAM)) + (CL:WHEN (AND (IMAGEOBJP C) + CODEFOROBJECT) + (* ; + "RPLCHARCODE will cause an error on objects") + (SETQ C CODEFOROBJECT)) + (RPLCHARCODE RESULT I C)) RESULT]) (TEDIT.SEL.AS.SEXPR - [LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 17-Mar-2024 12:05 by rmk") + [LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 29-Apr-2024 10:49 by rmk") + (* ; "Edited 17-Mar-2024 12:05 by rmk") (* ; "Edited 25-Dec-2023 18:52 by rmk") (* ; "Edited 9-Jul-2023 09:37 by rmk") (* ; "Edited 22-Apr-93 16:44 by jds") @@ -2159,8 +2397,7 @@ (* ;; "This backs up to the beginning of the word that precedes the caret, then READ's from there. A little tricky to point to the paren in front of an atom, to get a complete list structure and not just the initial atom.") (SETQ TSTREAM (TEXTSTREAM TSTREAM)) - [\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST (TEXTOBJ TSTREAM) - (TEDIT.GETPOINT TSTREAM SEL) + [\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST TSTREAM (TEDIT.GETPOINT TSTREAM SEL) (TEDIT.ATOMBOUND.READTABLE (OR RDTBL *READTABLE*] (READ TSTREAM RDTBL FLG]) @@ -2170,25 +2407,34 @@ (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (TEXTLEN (TEXTOBJ TEXTSTREAM))) 'LEFT]) ) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA TEDIT.SELPROP) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (13044 14909 (\TEDIT.SELECTION.DEFPRINT 13054 . 14907)) (14910 16170 ( -\TEDIT.SET.GLOBAL.SELECTIONS 14920 . 16168)) (16207 22010 (\TEDIT.SELECTED.PIECES 16217 . 17725) ( -\TEDIT.FIND.PROTECTED.END 17727 . 19331) (\TEDIT.FIND.PROTECTED.START 19333 . 21345) ( -\TEDIT.WORD.BOUND 21347 . 22008)) (22144 54189 (\TEDIT.EXTEND.SEL 22154 . 29251) (\TEDIT.SELECT 29253 - . 30744) (\TEDIT.SCAN.LINE 30746 . 38862) (\TEDIT.SCAN.LINE.WORD 38864 . 42984) ( -\TEDIT.SELECT.LINE.SCANNER 42986 . 50150) (\TEDIT.SELECT.OBJECT 50152 . 54187)) (54190 69409 ( -\TEDIT.FIXSEL 54200 . 64830) (\TEDIT.CHTOX 64832 . 67934) (\TEDIT.COLLECTSELS 67936 . 69089) ( -\TEDIT.SELECTION.UNSET 69091 . 69407)) (69410 72578 (\TEDIT.RESET.EXTEND.PENDING.DELETE 69420 . 70286) - (\TEDIT.SET.SEL.LOOKS 70288 . 72576)) (72579 94114 (\TEDIT.SHOWSEL 72589 . 75959) ( -\TEDIT.SHOWSEL.HILIGHT 75961 . 79474) (\TEDIT.UPDATE.SHOWSEL 79476 . 85910) (\TEDIT.REFRESH.SHOWSEL -85912 . 88414) (\TEDIT.UPDATE.SEL 88416 . 91653) (\TEDIT.SEL.L1 91655 . 91943) (\TEDIT.SEL.LN 91945 . -92233) (\TEDIT.SEL.DELETEDCHARS 92235 . 94112)) (94115 97209 (\TEDIT.COPYSEL 94125 . 95819) ( -\TEDIT.SEL.CHANGED? 95821 . 97207)) (97237 114256 (\TEDIT.SELPIECES 97247 . 100358) ( -\TEDIT.SELPIECES.COPY 100360 . 102235) (\TEDIT.SELPIECES.CONCAT 102237 . 104116) ( -\TEDIT.SELPIECES.CHARTRANSFORM 104118 . 107144) (\TEDIT.SELPIECES.FROM.STRING 107146 . 112169) ( -\TEDIT.SELPIECES.TO.STRING 112171 . 114254)) (114309 130569 (TEDIT.XYTOCH 114319 . 115470) ( -TEDIT.GETPOINT 115472 . 116421) (TEDIT.GETSEL 116423 . 116743) (TEDIT.GETSEL.PARA 116745 . 117694) ( -TEDIT.MAKESEL 117696 . 118938) (TEDIT.SCANSEL 118940 . 119888) (TEDIT.SET.SEL.LOOKS 119890 . 121059) ( -TEDIT.SETSEL 121061 . 126369) (TEDIT.SHOWSEL 126371 . 127416) (TEDIT.SEL.AS.STRING 127418 . 129120) ( -TEDIT.SEL.AS.SEXPR 129122 . 130235) (TEDIT.SELECTALL 130237 . 130567))))) + (FILEMAP (NIL (15576 17397 (\TEDIT.SELECTION.DEFPRINT 15586 . 17395)) (17434 18939 ( +\TEDIT.SET.GLOBAL.SELECTIONS 17444 . 18937)) (18940 24809 (\TEDIT.SELECTED.PIECES 18950 . 20470) ( +\TEDIT.FIND.PROTECTED.END 20472 . 22141) (\TEDIT.FIND.PROTECTED.START 22143 . 24001) ( +\TEDIT.WORD.BOUND 24003 . 24807)) (24943 58882 (\TEDIT.EXTEND.SEL 24953 . 32041) (\TEDIT.SCAN.LINE +32043 . 43671) (\TEDIT.SCAN.LINE.WORD 43673 . 49034) (\TEDIT.XYTOSEL 49036 . 56035) (\TEDIT.REGIONTYPE + 56037 . 57056) (\TEDIT.XYTOSEL.INLINEP 57058 . 57513) (\TEDIT.XYTOSEL.LINE 57515 . 58880)) (58883 +72045 (\TEDIT.FIXSEL 58893 . 68506) (\TEDIT.CHTOLINEX 68508 . 72043)) (72046 75583 ( +\TEDIT.RESET.EXTEND.PENDING.DELETE 72056 . 73029) (\TEDIT.SET.SEL.LOOKS 73031 . 75581)) (75584 91884 ( +\TEDIT.SHOWSEL 75594 . 80054) (\TEDIT.SHOWSEL.HILIGHT 80056 . 84677) (\TEDIT.UPDATE.SEL 84679 . 88178) + (\TEDIT.CARETLINE 88180 . 88894) (\TEDIT.SEL.L1 88896 . 89402) (\TEDIT.SEL.LN 89404 . 89910) ( +\TEDIT.SEL.DELETEDCHARS 89912 . 91882)) (91885 96591 (\TEDIT.COPYSEL 91895 . 94361) ( +\TEDIT.SEL.CHANGED? 94363 . 96589)) (96622 109302 (\TEDIT.SELECT.OBJECT 96632 . 101138) ( +\TEDIT.SHOWSEL.OBJECT 101140 . 103302) (\TEDIT.CLIP.OBJECT 103304 . 105308) (\TEDIT.OPERATE.OBJECT +105310 . 109300)) (109330 127559 (\TEDIT.SELPIECES 109340 . 113288) (\TEDIT.SELPIECES.COPY 113290 . +115328) (\TEDIT.SELPIECES.CONCAT 115330 . 117209) (\TEDIT.SELPIECES.CHARTRANSFORM 117211 . 120169) ( +\TEDIT.SELPIECES.FROM.STRING 120171 . 125194) (\TEDIT.SELPIECES.TO.STRING 125196 . 127557)) (127612 +151011 (TEDIT.XYTOCH 127622 . 130006) (TEDIT.SELPROP 130008 . 133764) (TEDIT.GETPOINT 133766 . 135686) + (TEDIT.GETSEL 135688 . 136422) (TEDIT.GETSEL.PARA 136424 . 137373) (TEDIT.SCANSEL 137375 . 138323) ( +TEDIT.SET.SEL.LOOKS 138325 . 139704) (TEDIT.SETSEL 139706 . 145976) (TEDIT.SHOWSEL 145978 . 147258) ( +TEDIT.SEL.AS.STRING 147260 . 149511) (TEDIT.SEL.AS.SEXPR 149513 . 150677) (TEDIT.SELECTALL 150679 . +151009))))) STOP diff --git a/library/tedit/TEDIT-SELECTION.LCOM b/library/tedit/TEDIT-SELECTION.LCOM index e1c7e1c3f8df5978cee5efbb05387cd59f268bc1..ac94532b8b1112b8f6aafc25a453bbd099bd640d 100644 GIT binary patch literal 29809 zcmd^odvIIVnI8yJG{wjaNWn70Fw8YAJCtM51i+V+hjH;Baq+q|3F=`xp(R5NNYHXB zJ5935PL!;(NxI#(cH+G3)FV62W}Qs}fn>*)Y-47(ofeulPN(Xwm}X|%q|-lJa5A$y zJ8h!=zVAEd-U|?NoXyVc&eR(7-h1x3=kcBI{e9YJBQ=E}6(CPyX)v*H=%UJ9X}pAH>I2 zLH-_IN}|DnW#`A=HyxQhWb}@Prai4r9Suc}P8=CEPM7^xuNkB zCkr;3F;>yr+;TQ+cv~1BA0IV}ryj>>+BF@Dj2?PRv-(YDVT7haq1g%JD9!V5?4)t- zk+RWyG@df^^U0;d1=|>#%P+MI|B!KXVKI5kvX_?*CjehS&I^d}(W!}}li^XL_cs{H z%%NTdBNxm-g@r{dx^Xly+dH;kM2xH*Hx`Vr!HBV7gpA`UE1p8pgi%PIDA=*IVc{N4 z95Q?xT|Qq&bhX!q|N29nsp|e{s+%6_Lyf0DLN`x5N`FsAx%5iVx7OIm%R{}JU#W+E z-iKhBTl5wUmm5#>^Y5>JW-m2)^G)B>oe!kqywMs()-&km7 z(umvnxLGhlk!hZEC>(K$LNf-|XVHv<8jRUlBVS0-voWn<05myrgn%IEYG8fchv^y5 z!_=hbVKU@-2+z`k5jx^&6xcdzjQ;K@t|4Re9$fMLDE@^eQO?(}G5RTdcNAseBgW{* z&OUbLaokVfer41+65(o?-soZA3>v{Df+t|Mv-*Yc`K%o?v*XT~mox%kfLLGrwU-y; zNgAJ8ZF?cPXcB2++5ZyD?vL{NHvTwTl$&R3Cd2nuT9<&7J>xC4UTrOsU zeW(!h*BI4mDgTMeOWXms3KR*4Cp1wOQpqf6VuF^kP_P${nOHUeHD)j86QGfaDP1#e zFPtQx%|=>FrYBoVCc~{Iz(BP|svV$NXa+QyoCBVs{-?V-oh2)rTu9#jX(JRO!USs> zPXHSWv}6h=k4zgMepsM)M-XO`SrGgH8NRccHVE>c@L`?6azYk zW{t7dmeg}=-%{*M!tGgJG*3m!T0nKkLmLFWWMX{5N&@{gRZJNR#1)yy)f)>_nai7t z^I(<6q}+yZ8!@;-&Rm$w<1uW+7wx4b1`gAeqA0~nK}?^y$>;0tAruxacG_od^%fNu zEk)l(Z~8lYv1e0^$Wm}V)qh{NwbfOb;)*q^?&F)+th%3XUXOnx7fmGByW(%}JD+|yj=OKdXIck`E%bGR@UJTS()KDk2&HH0pO~p&KM`6U=qt& zSYApd2vfshnLBYqu4>GL)Xj957Fc}`E-1(n0kfU|JIsywoPJv@}#-eq9zrQ0@w054XSp%oL`i)LA zy2=p#VtOr8@7}(8DO2w)R^P>txtxyeYz}1V`}pZfw*lexlQgjg2U_tI*g+h_2d5*#ztQ2$BW2aQufA;6d-N<`iKQ?Lt7#TLO_2%?}~iT!D#)CjC% znvm1;$wJCpN*U7;eT$VjB6AfDch>tbHO)|vH{X zH_MCE0f9fCJdWE#M#mz!Ojnc@u%|9|q)dJHL9^a%)_bG%?r6QYf3iEiaWrl1d_88R znJoT!Dzj5HVyR4do1Y&f4X?zEsFb~#7p;bGFX7|M(X}^5e6_VA0B@ytHVji&%;<`i z`Z9CT_k~O`g*r7et;#H2Nf)Flr>*VR)^a-+a-UnvZKqS)udn5IF62MAmfzl~-m&|` zGIj5aE?v2O_W-0yrlm`>J`$~uG`?+?f+MwPj1etbyfOl1wS<2$p1Egsrc?=(fL)P@ zBeUnM69o1MR$lYcluh6_!bfIxk*XA)aahRm0x9^65@9HN>QiqiG{oJdA+XdorD3OY zPYbi{nw@rPw&A#wPM0k&nQwu5!cY|!t@%^|R4}dYparn15)Orw&H@1-$_r*DH>e}u zg`i~1-3%0PXgFSOxfD0^<5^g#noJ;Dh%+50>JU~-cOZ%-B9mDomYlN}p+Z2n$=U@f zn^9#a=wVtt#8Y{jo}sR&)OoPyoKcM2_3AaT0$+#tHnLfJn?I4;h_9gFatRoJlp#3Nce?l4+Px z-E%8kc#tpsPxV^$*_DB)Js`!t#zruu*!BTYLr(k7tAgGSn?+D(t$5lWtsi*MjMjU0 zRsz*q=w^F;War6J0C(l>)Bc)0&~LuoK2ZEK;``sI*$1Tg?v+8jlKY;Ok(xbN_pJ=k z#lJF)i#^iVIA{-5gL!-S>g#5H=LLJP63mvbzWO|PnK*<*mnU3BrU z++DNp`c{6;zI*%X>)A)HUwySQXy45pYz${t3{+Y!iR(m>^%_QC3o zJ^H$BylNjr`<4I2om5^b-G4s4+4;GPzxq%bUG&9yfWg6dK3(^32mSGUuqU1kcE`aW z1+p81@wMQ-THFp+V+ydpD|dpCR}aX*pEWIeAf8qtDGm-kbHveu9Ii7?WN6Gp zW(_L`zZjezApdF2Z^3DDW`Vf^YCyR-4wcnD4uK3ZpJ^@tQ=0)#X5KdgMlS4Q`Us3i z_}q@0=w=#fi5Nx3^b|}8)g!bOZ7dnnu~<9a z?{wZo(5UADd`PzzhB|~v^60`aT$LFah8?JQH;huJHn}R?hbhlMj$qAc z*o(%@Y-`Chd@8!%DMw#4CL@O8iV(1*+^8qW0ngJEF+(wT+e!~vN9Eg6P8|{oBJY~5rBU#mqm4s3 zZh@I@b=V$wJ-ucJVN9jKnO?R7Mf*VG`HQ|ksO{(OiQC2p>|sX&3~LE6qC4*a_p(RO zIXKw}ItL#cu@5$?_I`&qrNECYunQ}-9o!dBgG*(=rIIob;_p@Pj!b%cXXC@sO#0f- zez~);%;2dk@jNeHztc9h_S&P6JC%@3=>^jsvJIKj*KCo4GN~_R?9r>2t@71ZY=flI z2#K4Ki`Q4U$p?eMEGvVKp64-?LSctj0iq=ctT_X z_Lit!P_5ib;mHYB9iS39z!~Y@dl-aPnwsg4 z^s&+Ssk89(uYb~jU;fnDBKKlEc4qy|!;h~%diF8n@keE#ZjtMm)V_Pi8BLl{9#jX% z0=%(8W}?7x!JM^7gvTYK?|`UgVWQ2$Pf7kUJOY&39D0lDluKb@SG5YUY9%E1@8C?> zD>Ng77jyNh{%B{^Ovd+-ZgYY}s_)gg`M&skfJ=&sKGhX8@r9bQT?fn8K%_g>A@%Gt zcb-+ZJ>_eseYI57jKN)BRNp>VoA0X+vd5COxGzf6o1LpSvoi^8|14G?!R5cs_u=n< zneQvb8MABg7}`oE=A`09-z%!g>IZ7^E3*)m-{A?B0n&uAg~{ZYR~{=Z4BA$8MXHTM?|^WF zdE*RVNm-PkDW?TTX@OM}F>=XV%zzA54S7fb6t4;unX!EZzB36&Pr}Z>r(jINkb-}r z06#x@dogw)zzBpi%?W`7ZM{XH`7pBz!+PU)VYp3LCkjVq)GH_$ToS^3b5;UzKNwls zS|qP|i*^95sHLQ>zQC5y6bZ}%yG9&C}Zsq+>IGfe^>m) zSUq^UyQbqF)ptP4Rb(<=i`56J@8KsEE2+N2^wM+3)=m8ObT=ufP_bxbv0Ch+$Gj)C zE*3eW;je+MV2#QK)?|#Apm};41FSr~To5Chv<@%tQwFDp^ZDKdA6^&uknlG+>r$J2 z(Ue$t7gFpHaU`JbgL*jBo42waH<knd0X8(Me`E1XL-7ASICp=N)c)y-X0;zKpOylMOe?=+B>-*2WtJA=S!-bdK@q_; ztQGu`EyxcK4Xpt&p(O*lxBCDxY^e+Cc3)#)&I4NZxYpT2rS)OZAL+uV9JAqO$k78- z5W2u^Lvk02Zx+sJXuZn8F)OMp{M&G2(h%?x^v_-)^{6}*97|@sn8h;;3P)JeD%<(& zNg5-TJZzZ9Y%8IjTyj={N9eeJ-H$alSw;JmVUXGt#@th zx!7^+HTys(8p_*2y3FT_F&Ob3ch}-y&lTg;#cj3zz|A?PRxkc(78eBb0D+xqCK<~Sp5TgNPl#yH1J_a?SBhncs`x49{_^hiz~kQ<<91Gelr4t z7{$`||Y>X=8{r4(RhyJAg1}DaT{;cl6&D$X9OXIx9mLuYZcv zY9>_tu;gM9|VfVquWA|lNrMCg} zHW2K=MDsLJyKk_z3ot!f?}`eg!ON3D_uSO;7q5T99;rO}njK_YB$qElLP}Xk6~-NGjte&3lqf? z#PA?P*Rhac(Q3PtXj-Y;uxW`u@L!K%K%{LVG`z@kEmp3K9|ewe4+&WZEA28F*OUiw zw!gna2YY;tKZ(}I&H4dh@U{52Vi1noYmG0P^`1cddw4n^PrU&|FYuJ=kM}6b{dz4c zINbf3R-i!zxw`N594yJcTFwqMHV!Li)W*9qF|_oJ_|s{;y&6ad@?X!CuU<~ueOE8# zVB~$M^6yn|nt&X)t>B;~x(W@muyIvU5A&d_IKFxx%_1-+OBCyc^Xa)%w|}ulc>x!mu7d zYn757!#kVWaK~5*n5vgMZcu}58I$>PAPRU>C`AEWI|agEU{?NEauG=hh-rZFxVaP| z1k#mjE(Du}Q#6{=IbaWPpdIYZSt2nlD36CSFyJ=uW?(2@;Vh18nrp*D@d>C7q#uBR zk$M2fnTYZhxvo)!{8k*rP%GWx1A%tMSeyE$ay|{7?m92G5bQBWuxp9#`%h+6MdZkZ z{%0|k?`&Yd9IJQn%?}a9tB%C#ZL0h;UIG?QwaO!+3&i>(d(v9Ury=FLDvOsb zD0r1j$E%cFREc-I7XNAn(!F|TEnB@cR}Dt%`_>xYi)C|}=*@e8r-(FWVy3j4afwJ6 zPtR7*{;2uQ@|P}K{#R1|mn+|1qr3x)>`!Zeywj{eQkbko4k1|WQe50zOp^8ImWlN@ zp0cv+0}7!5Rb7@WsZB=V_Tn>LAbN$z(-j%v3GY)V;_6%>yjjkt&^q@(I0viL`;2Tk z2ZfAgHXz-3Ig`Q~XTS=3U~gJWg&5*kBx!UQkYo;7!8#vNyp0${{r;4M@+6Hnjc-Ibvhn=7|FT(mFjwz=-4ahI=}F(Wa-!ONCAYaJaXwe? zf$&Mk^N>V#VB7A?Z)bA#eQ>W9?SY-ApkXl@NnT@(w9F@KUle>ArhGTP{ZQSPg(~=q zl-te5KTWBAphA5nN0e~=lZm?j;`NV#gM$UcvIT(^h<%ragw+bc3d)9Qd?TheJ`ST+#rl2s_b2YH|JGhe@u=yJ1FDCZlXvd{awAxZ2E@)B{zBeK)x^ z1@fmhUW~FuUp9B1DdQC{7+LtdHfFFp8Vl}=#?~5NHOrqjw<|v~V+d$P9!L}2FFjA;3A&eg8vBq$$EO{*`~KiX-D zJgVM-RKBjtyE`sr%*K=H0E9;y=>l$W8FK2UmA`>`)DnTjcmWKT*JGmY1N-+xZEK#Q zV-YCuDMtObnor;#+I&Pu0>eOfO|KLj8#-vm>4Qm;4$4V^2%zFA1sh&r*em}8Zl_LR zEYFzC43IcQUI}0Ul z3PeqvRspHAeQ7Pdb0K|xP3VD;Jp`|eLS~mwVx19QbrBkhpZfp<*L{HP>OQ~|>ppm1 zpg9KzNM}SPP2128YzD{NqMd^`CV-Sft)_2f9|CdvqD+~^(vJ=RAQFz3L`x)D!`UK! zGgT6xk}lT$R7qED;I!Wq0aru9h#&3>T)Kl`)JPhEI{}y8U@u+vA$I^5=>x6fURp<9 zH}0j~U>Ds7k@F3uk@g&1K$d}MVBo;kK+U9)qRJqG7`O}}Ssa&Pq>kf*;ieCen?N5x zwM48#>7Z_Ntk7M&p2Q+SK8msp=bYRiCeJsBqVW}u48H1exH0mweI^X>BRuD>3|72N zuJ;Yr3!jYxxv`xjaj&~*c9s%}c;R#wpzo7dE4_3gvlu+3#^x!&8yF2!c=H(HbiJ2u zGXOZSoo=H5s96s-HfI1YINlnY$gd-n z*T+6!sI2ZZZ#*FgH>Jy(6B835`V-c)ix#Y-NAJSsjd*t_OpnsN7b5Jr=?$jJ~PnBym2Zi(m>apZ?EFlyeK?rb; zU7{rTa3|x)XJO*rcNlvDmXU7doA2D~_pL_z2mDK}S#W8ozzARWEg$b&Mo!J~f#X43 z3L*fRdX60rtnW>~y{|O%@B#i3l#kd{vw;AG`$4#omluXV&D<5?WnT$ zU`~<@QmGU049OH(8NmJ?G65Z;mqqcyT)>?-b4h{ea-RA;jBY43n}7{9gn%s&n9G{; zR2VYuLX~(jnE>pUl1uKYcp)YHm6tJ_H1o>~v{*S*_AZpOIHEe@9fC*6rR8h^x9~xe z(Mb!{(jivip3ZJx$5Ns02fW!x>ks%I0`mKg2Zs9l{T8o=DBO+B&eXue`v7g&L9Wiw z76Dy*i`@4LSb!q54GnV;H33D<)eDImLR;fCVr%5dfioQ&zR0R(=yI6?4(k@!op*wi zHHNhU2O&P8H^sZ1oI$qKTntwECJZ&wswr0xIV$)o`af<$njSnR5+F?ASDga3m-lq| z;QShazizqzwl2n1hA02&At=`lc6aQzs`ps@vaxZeRqXtxsLR&y#-J+xK1z|8#&xXW zXG}MW9#A!YKsA!OM)j!dIRc+5^P-kkqbwz(SMCPSE;Uvg8@EJdHyV`fyHzF_Y;CLK zMN00a8$?-UebD(D7-_9!)qgSLD}FB=8geSFxg#; zozs)NR0S;Hoo2$X!9+Nni+DGi+KP{pL4}xX0m)%+Fd+K9SA+@@s+O$er31waa5 z^4}E?4J#fhIwde;lKeV^ARe4&PKZKAKU`_kkm#I5tIVyydJNxP{+pOn`a6)t;q}%W zJKk3xU*B^)z|62$F+-LfFl#)7*5av%cpVkL1{i<;%#DOIL9T^)G2mcPXa)yBy|;6Z zFf#zAiJ2|8<7LFiTJhM6fFeq7$jPR?0QRiv4LMm8qWw0kOkoDtn&xE^*kCrr?nCe? z^4_opfve-iVK{nOR0=E#o_W$d7<*X2LIJck!zD4i5iE<p$-MIMfe$o`ZjUU|@P}h~Ndq!w z6OUIU+r;dtTwqO7mwLU+BW-|rKkn@CbqUjD5N_>_iW@Ah)ETHb3}E+%^!vAK; z;!m!n{CIDDPn0Lv@A>kreYjRkb!h*bzr)1J4Tz8fKQ=KDUgE-~lp*ewe0lTvhY1Lg|KEWi^Z)y_5Z;Oq{p}>^ZroRE|92)qn|p9@ zit^1o)&OF7tqhtB0P?bX>;c++MCm$^lN3(jFPhD>-3kWj;u;LhA!3p<%F^(NYlm>5yzbU}V9Pp_fuCul&yN%V*cnJOV>uyG{5I`39lTV! zY;oZ4=T2VTV$F=n&cz4#On<||r3{e(#4;m0h zczCzVfYLx()R!>%5tOkKhErH6FwK}Kieh*IDiPW1R6whY~6Ebw;mXzosaW0r>g94~2X4rfOqMPuOe*Z}+-nEyJ}TI2_aR7HY7A_Cz${;r z?9cmCay|JF(a^h#7JR$udhct+9Qlt^+vRJo7xQoh7qL^MRy5&8CfyH8nnD~CA#UVo z$r%Eqezhsbk`P*mFIJ$f&fNgv?Fx|@P$730V#C(%LRbyE3q8R;ulfP(k*?)P2DREa zdLen7mrG{AX&BhQq|QjlD>T4`lz;M%YUC!~T!0f#jB-K)FW+W7kp6%Jp8yl;if*2Y zzYwE9Xa9YBQpk_^0JElAN}W3KN=ltN@tPHnl}t&Hxc@>akl8wvez2C#{HV8J|akkq?<`+X@O4u0JIiDfYUiThe2Vt?}8an5oX_o zD6&ueX5ANr%gl${AN2~lMse5ypG5%>3_vca2R}zgkj{Ed6(BeQdQ%VGRJBJv5I(b0 z#5ov-r?sRHhGGAU6p@2QBhd|Jir`pb(abNAr%~%5@Yb*zflxc;WPo$wI?08Q?l?b* zHVcrQ35W`sxk$w-K3q=-KU4HbHY@RwC`|~~u?#WT6{S;sMBMo(=k|kq|B5Q|UzVGi zMej!IzDw2>UuSW>v+-hay{l1uZ>^l}AL!0yS!#Y5`8wHreBE!py^jTbjrQeMe!d?Y zVv5-Hi-Uq18$-o)KejU$*WcFolj3?$A0qtP&4RhVV-If2{r(=}LBH65 zdIqT-H>P~+-AEO`mZYG!e681MrL?FMpKz2D+fPi*G8n2d~;18O8k`tei9eRxLQ6!-tUYxYE3pOJ>pVmR~WFiQs7<`tp+<6>$10so8 zc|JmqX@mxiV#Hxi;-Dtz$^>8#2l=_My^Rhpz?1Cn)lYP8Kr)^IS)vyvB$viONepr* z%m4cpCyOcmqFIlEStoEkdK$sgt=r1$ovZyX?9&Gf6=nbXtwqM7%Kj@y;XdE^=_*oO zDt{go)cx9e*DIw<>;9Kx$Z+4!TB|Va2l3n~Ev@yR4o2o+&PV;@|j zPJ{v5BOTDUi*_H$Ap0N<#vUSdp^Rb5{E+5VMDjcstvz}twxU*ELcN~a#p}N#O{iH$ z(SrJblewJlQ$K;;UbKVMb_&GqnU_0nn&AVgy$p?orlTy za-jMW`cpej0%DhQ_CUvzU=(cxGwm)zF%ylFU13b2O-;&}zoVB=>}&Y|JIC-svK|rg zXfNXmb_>bR7-^?YjnH~W?g4lE4z&T zQA#>>MV#+{^8IC1ctEPPGB#-UL5B5J{>T1GhJ;S_ zJ?PBb)3LSRvuWzIf2(W#oz6EW+KVC@wCWPd-jfzY(E}H+-vc|<-DRmH5AsNrL{SA$ zX{O6l#{1MaEKGo#Eth zqfo$>cOd)z8)YLYp79orJyZ%KGH-D7p?W}K4j+Hm-{IFA6u((h`|3I>w=$D$JgW-e z!7p#0kK$-Lm9h7nu1e1R@^(cX*YOQqzvH}#gJ8_G2ZIFnWly~nb04z5SdQjQb2iEg z>3X;1N4q`)wP6s72xEokzzsSevyD#zj@&k-$ZpqkT1SWD;ix$B6G+}6Wz5pCjzBWLPAY~6m04|G zzx~t9#sohI|7fG3LJ%b)0z-%ZQY zAA2k9yXgCuPNm>Q-|w|ndKxVaR?1SR8pHv0YmKj<@yZD_3Y5A}xAqJw9*`JL<^56} z^+qZax&pOypmLk@YN&FHe)Sc+8h(POnOgVnK*Rs>dgrOj`t{dpRwjt)JSX2e6F`@x z3^O|nT#fLZR)zt>@aWj;$#AQ|VC9sW*-N_B>M)vZS9h>7C5=6Y=F8VGSvgg$GNM2I z7Io~D%fO-5%Mz)Bl7xh0S>Vx_bUkKz13N;952}3Cahy;I50ta_+f5)eCfx&0J*5$3 z6*hew0jl$^@(A&8Z?h4wK6&FNJa}3P(+OkV`eA76g3Vy;lF5zK=j7rd4u*kbcjyU& z^?U{*m}I|-xGN?p8Y|Q`2@wE<7mC4j=xi1`U}X}b19#BZkp|4xW(J8%Mg*=Oxxpbl z(tTtCaW=4B(l@fn{CokoP?;#FJPd`#yX7E^NUo&OhvDz^5P6t9^VrIO?3)lab#cSg zKnMd>qX;1}8&$Y-%E*@+j8{fMJ`5TKZN5;W0H=|;U;{ig2F=NxDd%K)8>xpU*BU>xu=$z}DOB69|C;iDt_7ID@Ff!hdG@dlO&SHFpn7{YWp;T`s!36V zdrvqrTynyRJ+LO2hJa3^OZo(p_dKRnZS^tZ?3vZaOJ~lh@6SGZjvE;F!VZ8Ho=u`# z$pt{^4s4|F5GDV#Pt36T5Lh+K^b}927)6dM<^?oyd|=RJG?j?1tH911@D?xNW&Er0Wy-#Y~lLG&UOw?tvGn{wGzByj2&C%! zSfK&wYYZhNA?YZrt&8cwK+<2GRn|m_Pg^%t(%R`YqhTL6mpEspjdK_HH{s@Rt6g=1 zj8G1vC5t6rR5m6?Q|b}R;))R+n{l=H<{<%T)l79wck2Ow&F)BtYk6knfxI%r#O?xH zya9G1?ZFdtBoa1{C1rn#@}~gLojsFsuA<`7Y}HZA;+~X!L=KI1d;vz>O%9E!W#&u& zKfX!1CV~HTKgA(SDF&L_dUUHPm|hd&Amqk5JUU9b@ov!qaERWPWVfB}mUC^GUTQH! zM_yga?p(;8UxQ0#&D{A~IepE%hUf}d=mqn98As&6oq`;f9Ll5*>^{!BX7Z zlYwJ@qG*11)48!4a;SWa(rbd?Yjh8SPjabeyb@u`IvHBJ~ubDbEvhKF^b=E~?WIbPe|%{SblY3EgtzI4n`5C2blc`=zOx=sBuA z@BlqK^r~;Y>PS!xxi-oNPm4(x`EYz(s#n0?4j!$% zln|@2t-YjgbQQlPm=!Yxvk0-AmDhbyBCqH^3aw<>*sY|Fv2kp&adWA~rv&X0oC=4% zFuwveQMNiUWMMS4B?PB<*^A31!fS0j01VNt7G@W(S|AR>_{#Ke8x0&S$5O&CafRKIm|7YRonWj!)npqv$p zA_&2i7r2ZWy@F&kCTFUVaD>wdt$21Gwt&RV%H?AKMQK5ZMuu2Akg*V`GVAJd4fl_!XZdoElMT z3APGnzVnW$F)XURSTM#GlW{sA*~6JIFbVq{GRAOrY#zHOC?+|kxUiUPh!f35P=N|r z6yU4oH#ATFr3l((jxEzToRur!BYHKD2pNu;nVp!x@m{@SIg@_X!8lI4X4Mf|bKVEu zB%qQ<7J!4aXTW*1VmL82nanSsZPk!y=a?14c}^aC4N5sBz{|IA3*ClKtnsCBdtq@2 zzi@;z6hFFp=HWAsHMa!0L?7b9EzwmyqagtnHPkCV0&|SQ2eQsU4QNW^%}0o!=B|p) zfHZ=%{w9Z_$#%cJ;avkIDWrGVrs*_&2#_AL@)m6U8?JdTs(5}p$@vzipUCeT;r)U! z=8^fke)xuZX=OqdxB9-P9Q9@XE z;2c@hTyc9*Ib%F}dJTuFK1QodOXukXWTiGCIE^*$($J%KH?ir8%_)Ei z&)$b$O9L(l>(KqVQTklm0GKzlyho4!N2r=P=lLwjv`PAjf5x>qOQHJXv!;^Sc)W^z& zpqujA>P{K8pdQp-GyN*-Q7YT%HcmYe_n5IOK55Swi_okMRU~1z7pF?TE()jVH51r& z03k4z&zduK8Zt(YdXNGTFl8K)Id+fg5x-nva#F+CealEFa|IPXmXa}caU!MU zH@)`$x({f-sX@Q+2i1Uow(y2sa7|sw`vCOr)#Dt)f+%r>L=b5avv5lhh-*^{=R%uO zq?$UVy>1goCUJ`0QY7WHEpFc-49<47d!dlEE2jjOHhsb%yFu|70Vrlcg&H?V+3`Xk zZ1j2o-u$xtxZtU4+tCe%h0|DjZ#)2K(Cr#S@tceqmW2L@rXy$>nd~Jz)@p(-b`}K{ z=a%yviu3R_!4Frtcyme+w&ryCRw=<9Y0FZm(w3D_rL%^n hG*-9-JotG}%+2AlZB!z>CWZc9#U5^?r|`M2{|_|ov_=2` literal 26531 zcmcJ2dvIIVnI8Z?#2_*PfG|xn41G<@4&{_I@t{O083z{+5*M#alb}f2iWo`Yh9qd& zm6c}G?50ZUO|t3s59i^;anc>x>ty5YW@{J!se=V&aIo-vB)@fjnZ9yf|JrZzIC zCv*C2S{pTrrSyE>SeP5tM&{Fcs-!3K9oY$eA+3cck9xgh)It))O6im~8VQdV&R!gk zOh#gOeR68@WO!;+8yh|U%+t?qY^{~GXD(=?n)h?5h1_p{Z1K6Zi_bk?Is5F^*$a>7 zpE-Ya>+z@8%3EunjZREG{+VYkRyHntYFy+zzO`}g;@OLzef-i|dE?UK_?A%`Ur6K2 zCBrOEd^C0}d{py}MkXDf51))hPELhKwTo-k=huGo*{zN98<(~|`|wGPTbWo$>P57q zZJ=i}i}}3fY-D0$VpJ=i#a9n*{rKq7_nv{+iIcGtzorpu;ppVliHLTRXCtwqc`rU) z(M~2adT}zkbZ z($+tFAHBTi5dD3g^PY@z)>E7?>WBE3|77`Z&MkgC{BsW%ULW$i#v3l|*a;2fGOs7W@me@CsTE5Z$^cb|qnIu=<61ZzaimV1a3rRWITFXCj>Iv% zNzUt~WG13b9kUi9c3fp^(P=9;!fk^4teh#kDf9<#j%%a8J&NB+ZS=8GEqo#hS%Tkb z?X2yA7S!{ zsIguix>nAH{Pb|WoD2C-AmnKFAZ96@GR6#^>{c)t)QT2SU$S3?W7=H0m@=oTRpX#7cbiTEAl$#Ir^) zTjqFHeGT#0DAq=jFBRjd^j3HB1HQ|}8~OSN3hP6suNTXvuk~WiUwGuL>d%{fXR5c? zLG{N^D8j@vi5l=S)1xH&V`LVYbs^ATlDl_ZSzCL5&O(MI*yB z{mLVo_F!ZI&20@NvuQMYcW=F6G`-eP-pnNSYCkvHhO(Q%Kp<6=NK*reK~g|nih)33 z?i@Sn}v(|bGgM@0IO_wtILPk3lRgYL2 z;7l5+umz@_321iv4HnZ*fDbJD0pKhqB_+)XPsxP!Rtq~B#UgJYH;^=GVl{ijGbIxl zGx=E%!Evpa%z&Knc#Iw&!o!pXXe;t!^hkM8t(ab-W(Xq|=S;$mQmo~`LYVm}ZB8$y z@jwbKZz*(SL=_9;Iik_G@etNl@OM&MKB~F@(ud_p-c5kHs|m4IgMoi@Ph3w5Y1R6n zA)&#G4HjR&BYx!D`upTVD!p+JYu=~IFP8;x5yX5U;m@UbffLQ%(}||{6X3`*xu$p3 zS1^5hwL~$$_kC`+`Z3d2*j)`aHqGGPD`xPY<9D~1-(3wMCxo03azeX%FKw*)MHjwe zJv~{LeXQjgrmtMsyV58?g62$L$lJ&znth=@`th@@26jmC7h4e8Un(XGmE9ssi`9Wf z*&Nt=rC|=7sa8ah+L>ZG55bau8}&T^8u;;vW_+rdow(^s=978TSJ~x;D!1j&>L6Mi z-1}O?97K1DRA3c|#vG!op)=3(gf()-P%n2Ce=s|{p~JasD3oZ9vVhJ(Zy_KhP`Fzo zLjFaF(+E+JB5~kV^kzaxpc5A8LLO9t7D0~r8bv``{Adbg~gKr(|>Y9OE?ThP)874(u z_9P6-S)VYQ2!{MylCW1F6jD+^j{Z!Vi)IotOobVy6dS=xs=yK*xH7OhtbCfl37Qi2 zJrv3EVoAFMNn|cTo6li-fNaIY&|m;1?F6hi)Lm$sLijMaMI|Q5>VvdiA|WSaH9bvY z7GVMN%Fk&GMl$L7G+r?jp&EE*sIibYNkYPCTgDHB^Kt^eK(v{ni3c<>V7NY9}Vtz~mMaK)?io~yMJit9q;4(PmA z=RB8XhWAYQ6Nz#Wf~P-8+_ga(a5$YT^keMUaiYve1pLtX=7&PWTP`|bG6llb-vo0lu0!-g5$ zdB6;PLvIf4+_%+LEbQ+6aiUnb{nx+PdyR`f&woRqRP8?f<|EKK-%G?Z21MySJdB3v z=SiwPW`=e?5;si0o=6sE(zCvAa>d_EiC@tSn2T4UVKn_l(Om&#`;%G&5d7E^Q>wO^GH|iZ_LrI+FzNE%(PxINA*GE(VtNdRX^gX z{wc(E#KC;bWN`bC6pS9XLAv6U36@!qNlI*!305K!Bj$^e(I?zSF<4}5Y{tMz1tXP$ zFEj>0DA*`EJ*gQ5xJ}8!6a`G@qER>-q<}pUlhz$%tzb$m5}njiX7R%$o<)}6rSP=y z#>f<5e{hye!JfAG30AE24CjaSjIYuFQfV-uF;_C@33GMiU=XVOff7W_ixkFTXeK2_ z1h4~R1FAVW9)<>^SC$skwVyy6lX9{-C>Z2*cA_v0X$0oFlg-}c zWYfC>X!m5Y+4odB)pVtv{<|LslJ5r^V(NdnA;DcA@&TY^su!5Y^n+Q0^y2~6GK2L) zX6QzBlB?~+bTcT>(azC=5DO#*YQtvm?JVK3Th}sA-?{aM=?8Rby|V547ma@YJS0RQ z88nA22{p{Mo4uf?RHOC$I=_+|tj2Y-y1M_M(rKPgyxFqsMUCXJ9cX=H$klG%_a znG5wL)1o6JpKASEUAgS;-p-kLE=w|DXOZhx7kHf8cOC(^zRw(mAgqSPkY3fzAyZ>6 z-}#m~=or-R=FHJs*Nw`pH^JIN=nV$3Ir3gv;hqPFYDVKc$Qtr*mi3uUU1 z7ic&N77$zqoI=zj2qTKBHfLH48zJY8RVWe@_yL><5>fO*9!4t>KH+#1hQrdXO*qW@ z1l*uj9mpH&84$sGmh3L*7m|rQhV0qYMw4eRU~^>avl_N2&R!_-XgAU4`IsdFTFh;gvYu9J!Hiy7axB|C+D=@9JMm1LgHp zSulLx2 zAyRimh z7!!@%j-(mNK(P+skNujVhJgmr7Bx7q%M)lflxccl#i0b*gl33E-hgNO&PQyKDl99I zk#Zi#;0Bf2cX5ukmDtd4Go{$lB5k_ATm+s9nM<@gLBtDRtL1FsOeSEsiLDROZl6HP z__$GAFj8qkys3q`WZsyYgS8<@lRyA=2!vdL^N$HW8k=Ue(4tY;84RPNFy6RO1nnuv z5I!y~x-iVEPW?MIDH;pIHtT!`Chf?AMc0wTW*2}k%r5$#2HUcu1gwSj9Fj3Hm|>%f z7b+K?`OF3F(%NrcdTeXs!rJ(`vlp>H`YDK*kMENw0zK)Ilapck6SIs9ZNWHs@=@$5 zB{Spm>C)nSaeQXpEIbN90`raDr4|c?mGK#Kew<4^s?9*e5JZ}Rz)3CO2O@!Oj~Un) zWH8KN6_)WA&T^O@E#14K*hgmqJ_b%YMMOK6HMV zE07Ct$`bg}PMbQRofPhSP({bQQ}+{#*c~aRPo;|`>`jumx4c`zq?>R|vzXzcUPy~+ zTr84JI4&K$G{0hGkBXtqv~jB1afNHU#HVY(O63zUb+>6ijGoy5xJ(|U1nj@GAu z!n7E?CRhntym@SMl&p8hY26ZL``V!EC?yt%XpNq1jKyoy(IqUvzw7C9xrN+V>4R9Zqe0&`n(! zYWrls@A)K2!ll8XK%hG(HX^tmt*c$x;Q1iY!L%ik_OGH~mM|D|pIE^xg%8Mua}`Bb z%$XU?yasXONKH*UQ!q^MZdsND5OSnM)AAh%jW$LVZHBRpM7hg?NUSo zymIu5>)0PVn5vb?n1aT~(BQ{H@PI|dPC_FprkImufH3krFmn@)5&j2tl4y~HXh1j! z;b92Jg)JY*(|`q$&LZ+&B-mUaH$sfv2+}!4c!T880b5g`W%5|bu7GZD^txSM;Xp`) zM#RHR$TJ%hMDZQHd3dw+4IM^xBf(ir-1QG6W__GwOgt;xn@tzw&#AzJJ^Y4gi~k6h z<&j=@f41xDT-IHFO$S(5_e-Givd-JJn`Ls+i_cztG%n1S=0H-|*74-5Pd-U^#|Za? z>6NqvZFdT3GXW5bAdwU{%Pm4qVaR!Xh1r>Q&i5I{8g2VSK=85&(WJq=JzY43*(zzU zUS*a2EJ4n}(@?jI^J(GbA}=9BXOb*Xs|rR-sTu|kh*rq`6^1{ygBHW^$68~6l`HJ& zX(1k+9VGS<1Jh82w;kw{WEhJbWXE^dth8XcMbXl=rw}!WgNPCcI$=V#)7}FV4(CBP zNvtiQwlrj?g&_-ojO`4bU~;X^v0GOr$yo|H%51<^v4r8m;Dz!m=2s+HM>PGEX{2Pz z7Q1BHV$zOkp7TMMt6Ml(^!j1xZ5fbTsCqM4%g2RRGo{~LCUfs&@h1FAzId}2?$1hQ z?@H!!B^YmdE4z-gB&uNGcMcnXtQkPoe7!sF?|LWj=g#+bB^k*n|W@mic{Uw(1@U`Vsu>pYdci?Sn z4({#zxj9_#+JGfl{fjuU9$N!nEjEX0)7c`hF2?g%ycrT~Qae&?4%Z&QpEJ#YC$Gn| zq25M3ORlj-oJ%11p@>}s(~sVEWs5?);B(l;_*<34UcJ5i5lj?>Bw5 zdv!STHbku;dLLxuUZkZkefVpE_`koOTY*0zhw;!{+5oJ}jCv%TtD*urdrF3GnLx5HFC1UrZb+lQ_l7dl!H0z=_zxa0U!!39TRY>XPq?N&luMwcmy+Mi z;_WSe)?fT~u5#;o*7V)FR)90=6V-n&zjpP0^Z}6%zu5cN=mkED_&)plvOY>)8RDJ4xGVDU~GJa8x8qO*xbM9a#+OH1Ln9>yo# z;*&N|5$W}iboZ}^Xc~(~9xgjpR6^6z9;Ma#-Kdx~`h?gKoRFbYGPp}XOqveG7IwEZ zo{4fz*l#>=L6n>C&bS%^O##eXTe}z;`5?q@Dj{fl8(`WF(z1A~t+?F}CmfX;+4Z;F z6PBa8az5SPh;uAn9ASBJ4$$Mx9EtC0gYgTW`Alet-)>U)p6IVteF)XLz?KK~9VMjV zyFdOk0{!9_;;#1BRs+N8`<+GBRTn-eJ17d+U0nC;@*@x2r3B+ye;m*=0+U6#d@!XE zh*+a|Dm@Q4%AuN$K)5g@vJB4)gO8Xr+hXwu^zjBbf;c#2?r!vg4|2GN!fdFg!&5;r z4T6_38bm9(L&+~HfEU=0GGZ!i$uqE*Epyp$u(4Pez>L`sWP?zU350@3;3W_iK*dP1 z-V<*M=K_RarWqu_;_k~Z^kVSxcY6Hh2t?z0i-ITqFSxaq1RRs1Ef^T>$#&Jdo_F8K z)qDD@pX_=y_tyIJIrm#R&-Fqrl=yl+(Rw)(M+o6PJ)kpJBkOsx`r}M9B2b;xOzIxf zkMPjyh?~5PK6>nT15y;x_?O+}nh(~!{c*jvTB&{l8*xFPJoq7lZr;G~z#EzPrWs1K zYUAcW?StlE?LNj|Kgs|x44R?1{CXT7L~I7gl<8*&rjNvO(ew89ozHKsygTA*7&Kh+ z2}Tf?Y#9zEu}%>iSIDKD$QXI{xP=i>%rQf%R2Ur;^X1>$#p z#L}0r9ZCs!plB!knAGRwJ!ci~@SaR?kRK4#>FPx*AZ)K}vP$!LO&9o-aay zo%1$ksEPpe8R>mim1I&>N(5g>T}EurxxLfnMk8JC$v3?>^5p~)GnD9i+ejARpErHG z*niIEn}?yq%ch^gc!UTNG4KtlQ+u^h{UN9YOPt7;#H3QdFRy`t>2gHXTZ~S-z z!n^@Gt?a7kE&b*&1mezpiDu+qmfZn&pDDu3`aNCsJ!EDLNwvX1$`7j(vg`pCVIg`9 zxnVq-K_S<$4?0LR35hm{ZBj_IK{tNQK@Vh~IRxYM%jPitenIsacHZ0QbuT*mi@n;D z32bZ*ng8rrWmr{Ry-> zgm$e$WcLkNDQb6^;3wL(K87OD5bs)PwoLyN-zSUmP4r>gwIgO1gQ#L&F{yjCC)B5k zj{fZoSSjmMeV5k@&QY#eDHx5*_{?Iw*;j?*L(GWvmV0ictQkRb);G9_m2!SjGI`t_ zNo<&!QX2yvQc}VQ4U+EJ{`(KY;Dk-ssVt_z;wn$DlC3P@+LW&rC9jZYN$x;_7pGu| zcJS~Nc8fZ*V03k6P42S>V`#dgRBZnSP;7tmG2r3OidKkT6vtUQUXu0PnHAk9i=z8G z9f2L$Q8BXL&r2e}1yU?6Rb}XA$ymU&t`Sc86d}c!GT7{RVaaGP2MMG;z?@6kRdsFX)2=!&&0#DDnwK^eAeEiK_NkqKv128itD_o34;5&JS*yZs zXrA+FLMQBMEx{$qOJr+^6vwaI#|iKetjd4va=ChRw!&*i6R%6K(v5Jqq)K?s^)_UF z?>P^`N#b1mJHmRz!4FqMe_bZ1K;kukPHF(ZA=H(x1`vP!pr@kmy<9;d7J<}oX776$ zY~b5D334!0ZvUR1xQ!P$^Mokm?22ea5B0_qp~G>6#>A7M5VV;Ju#3YPpL$IkR$-$C zd&6>Vgm;)$pl#B_#E{G$Dzdii&>SK}tYy%!hiKtbI}Czj(BQJC4H0vGg|`r`!$fVF z96aAylFayyJm-4j>l3hdc&+o=nEhGUKx7XI!xc+-oKAztN%mPfca#pA!6LbCux5SL zxVHYh;l5^g-puN)7jk|&GWOqvvG3TLy&L+bz7&7OzW9HAeGxV&D4Nd0N^XF~$!Ylx zzzR?g7|SZlezQr9BMzLI?3uuEDeQhpPYr%cCddYpTYdX80KH%+>P=`)dQb|sCLEK z8*|R13sa$?1G~V9j-Ot5=3^dQIDU)*j&Spbw&Ws*0BRThv3DB4NXTQu2e2> z(jKot%xeUx)&L@K@G}@1q@N+2e#Fl(&O)LJp-j69yey*12qJZ)QEtB_t2MZN$8?P$ z2!n>KsqKD>fQw@m+lA|t<2)R8 z-<%{$A$pE_ZLUUn0#7PQ+KabK!ddG`I31LLm-d@BM!}|q{RX?3c0!zHRv&V-=Hwa_ zm*@N}A;UWc^2{Zv4|&v02I3)7w$mCDwjICVuRLZI1u47;@zRAzR-saB9|9{tbArX* zV8_i1ndezfobyzV$s%f@P(s)`y;u9yll<+zjYxUV7vpb0jS5KhWJdh1FlRqdHo$q= zrkBnUgQGLMmD_KX^P%oW8F8nLvJS>3uw_iG+-r(gPsSxSJ#v?%0c~A9 znoO+g!peH`%DO*SpU9q;r($#OcpKU4M!C?cJ=EaE6k-~yhqL0ennGGa{rYB1T8iR5pLWgC|-5)Uk5!whDaP zfz(7ct|6_oFh_@$!6$RLF2r?_PJ>FKc3si^QV_YW#IY9+t?UY62grrTcf5kIR38H-70kICQi_xls>nu;?1pM-m0-u!T zaeE2vM=6{Ff40G{AsqCFqRlUAzMg_H4WUSJQRPxasOD zZ*{d^D{pnTY9DD-vVmZ4ApY8#EL(d_1m4QiEK%Yi^2&i1b3G&kFJ@GK%(33$9_$PE5$M>G9qD9f=o&aarE z%B|H<^}qGwKnvjq)AzNl?k{Y0z3b}gul}R*R&VR~8;ROOMpje`xvB$OJ+1H9QLggv zp;6AYUWog_Bina^Sq$ypWKB=YJGstnG6`C%~%Sq+W^5We6>I};VO2oCIxE-WVS zJ-Q=BlxdF&73)1g;%Y*6OKC1_qbTtPFeHc!CufA5g9igpIc?^JdlHaHfN79mOtZ2f z2PxiMe3*$dVHEl9Ap+ZT#3QJHkjfQY>3|zIXx>1Sv|)qTb-KaatZa2{1YSLCT~%`YCL1(=FQ~ajq%Uh||x3;?9T)(#Ec_RV8Vn17>LXw_Fx=XaQ88{b; zo5Pjc`PE?t=s51A6e!3Ij_^l7f#xIpnH%K-bf-*Ye)4v?2w_}K0u`52IC+cvJ$#VR z<`D?+a`pv4;CKBRUE$H)SUqBn)d~AOZys446P7W5mcLo=HizD#BO+S;DRXpvXjLQ6 zD7z>y4%_E!i5z$2xdq}t=1Sf&{v(y=Lh*W$9-4x>!zI;;l=IA4< zTBG{9c?7BLJO8w8lyS5mD+JL<(5j#L3AUZeW{BF((1j%Sxa@J$2%nPe<)|;Dq-1k^ z?zp2*d~#R-kQlg4l3@(dX!0=%GhIC*oJ>8!7b71dR88EH!+c6dNI*zL*%V|cOHn+F zdL-^+wqiC0icv4%C7kAtDmrP$WJ6Qg>mSz5Rs*tE;cnbGi%$Jy54e(vN z8W#I@me`Z~_2N6w%m1$rdby&|CX;_W5bd#U^?>^L56r9A)wLcsO&bH(zu>#O^f$ni!#r<4dvK~)?weZ`;c45Ko4Lbg!Bu`D07gs=KP z`>P333AGR71A33U-tUP2Jm;x*Z++0JvwRmtkptLz!GNN8YWq$Kih}GFOHm+7krf5` zTAk9K!iV5cAX!EMlL$t{c|)fn0j=1I1g#)aK`9QHt|%%*9~q|(9Rn((m|?LzBxMO5 z+lr$do?&N-wFtb-b`b}DVU+?^(5X^LqcFIhke8524Z>eyg0V$3okHT+BIo(-Zxd`w z@QPqNU0s~?9d(lD(dxZ&>&ePG0)xe+!XCb>3O-WVtqRfH`nH5EW0&=Fp17WIEF;VA z^>RWS`&kj;M^^_8CP22M|4=+Pdxe7qN>6P@utTNeq&GGs+Tz^W*e;CwL@=4kY!nb! zrRda~{SMm?G*1+hOTK!9h}q{)U^&bEXly^I*@QsC?JE=nt8yR@WPqAo75JLWPAr~U zCG=K!c_pG2>%=_EKmiP!bCDOT9uRVuXNE59VLvY6YM!Q@F})d*EAx#8d|ooh1mRv@ zzm1=G60s*?F@d#>k3JzPK=c@-$j((b+#Pdb4UK3ILmypG=jT5BoF)db@tk&HZR67V z+C|yYg=a2uQxg_hN>7~}E^J2d3IGwt`61jK;BFfvqGMV4WLQgbFaxAJikH&3@=VP% zx`RCuA(F*vD!gxR^0!Sm#xy~oMuB=j9Oa8A3CmZS9KxDFs*uQY>P^e{H>LTMs z2o#>FmGyFljRpfd0)}2r@IJwnMi%Gku|HrW>*CVCP{_!%pTie)U~H_5`j{WEr4k2n zTL)0RZR>!pyz409q#TL?ZRbdJW2F?F;1%ftv?(=eQ!4J(5*#_$9HP4|Y{B)Tcm`@t ztbC?a9s(F_ z65W=5Vi^yG9>=jg*Bs#Wi0e$1@eINmWe%p;ak@|KoLQr2?}p=o08x@;iY-ALw1s*O z(vq-7pctYfGDzq>N5@*O8iZXq21SxoKb7XV3}u~wk#Pb5I1oDo>cWy=PND7#hYq9g4^1=)o={KV3>1KEf&vBDB)C_j2w5TJj91AU zx>!RzgL_on?A|LjAK?IMrFC^!QfjYYqo)AkfUd6gf%X+|J7Y_6MVuuU-z&B?f`~|2p8~mIO~c)mo}b6n4uA^kjoeuV zbX4Dx9d^nQy8Xw}`~WE+UnyRr*vypSlyrX9rcf<{{S8$of+In8orv=`AB6DA&CUp% zx^|&3!m1o87*389#GoV90eqbA09aYqBMw3+e+u8ComE8U+bv*pb^^gtvfE&3zTy*l z9|!C=wzk$jb#_ZA1xw+py?RTYsv(osK%?w8FpGj;A*z(#n1HmBwmigCqV9!~J=a~X zi6|iuYC@1zLbug{O)u)JKw)y#BuzONjiI|-r#9)7pU@XN>@kGAv0QSPUP|SOK{(OD zKjC|CS?2*7*ZY-@u)v#mI7|Vno2@^}lzX~rAujIlb@?+}8Z*v{x^Tx*C$OGyfyB@L z#K^_Poe&K~+&@+QDRCCX_ByQ{XiUuryQgg}PQ-^rP?KRZgv}%Z#9C}I2y37#zA4mI(^I+4 z(wX%)250p|YFN5HmA5)T-dGn4>WsmiSSqdH`e|{~Gk3q^T59ju{G9&86JluX@3gV8 zR63bQOe8M)PU8r8oLYkKluinkc<*)$i)_x9w6Xbg68D!aI0y$Mq`VPhUeFv4>XD0l zOm1_F;8R?_JsriZ*_6rB9<|!vQ2Yho!pafA6BifrE#A_^#?;aUitQ&R+Di($u$e}t zJ8!cU+3k1A%8xiFK&li`T7*GZP2;=9#KMF*H@|?})^U-^vm0yY*Pc5{vtSeraAfB? zcv06{2)fH$={Kdja0W!&1db-!-XCy_Gm6Yllsl9&A+xKLV&I`pXaQCvR1uy*MZ?!(u91NQ1!?cve<*-u|w+j@9Z zd-|F3+9-Bj8R}SFa>u zYEN2mr0OFoW~RM#XJn&nL>0#5s%Aydl`~azPP{zQBqER6J19kuvn9YxI>Y^ONhBYI zzeBML5d>bLd6QC~2Y*tNEMWaaWM>i+z;J;!~`w`~pWt8BTD(K}EzI=qN~0zzB6 zaOvX48eee)$BcdHk){aNOG6PNrR^Usu#}m2C*`3tA-pIeN4X0`N*U2ohCznfC%@#k zq@0!I<&w*k#0g?+u04;jgOw%J=TR@N+8%pMswCWXqw{Xo*b|G`>9-XR=0)U;u~CQ} zfM503`^zfOogo_iI~P!X{11KH^%GoD6>=s(Z(h~UF(EGKlsEHFwD#qX|kF00|Qs zt984h@KJi56W%^O2ltEO9S-{bUAl!k8nKMFs(x=yu=M?}#tC*O$Hr{f&`Fe{ahP>#Y)q;$w__<}ZpTW< k+-Xg58p9XSSNwxG7@H;b4#FS;vVL4jn7e6xFM;s?4}AEoL;wH) diff --git a/library/tedit/TEDIT-STREAM b/library/tedit/TEDIT-STREAM index a9c4d3a8..81d92175 100644 --- a/library/tedit/TEDIT-STREAM +++ b/library/tedit/TEDIT-STREAM @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 1-Apr-2024 09:45:47" {WMEDLEY}TEDIT>TEDIT-STREAM.;690 150536 +(FILECREATED "22-Dec-2024 00:24:17" {WMEDLEY}TEDIT>TEDIT-STREAM.;835 172312 :EDIT-BY rmk - :PREVIOUS-DATE "31-Mar-2024 11:44:49" {WMEDLEY}TEDIT>TEDIT-STREAM.;689) + :CHANGES-TO (FNS \TEDIT.TEXTPROP) + + :PREVIOUS-DATE "20-Dec-2024 12:19:41" {WMEDLEY}TEDIT>TEDIT-STREAM.;834) (PRETTYCOMPRINT TEDIT-STREAMCOMS) @@ -12,12 +14,13 @@ (RPAQQ TEDIT-STREAMCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS PIECE TEXTOBJ TEXTSTREAM) - (MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PLOOKS PCHARSET PPARALOOKS - PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR) + (MACROS NEXTPIECE PREVPIECE PLEN PTYPE PCONTENTS PLOOKS PCHARLOOKS PCHARSET + PPARALOOKS PPARALAST PFPOS PBYTELEN PNEW PBINABLE PBYTESPERCHAR POBJ) (MACROS SETPC FSETPC GETPC FGETPC) (MACROS THINPIECEP) (MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE) (MACROS GETTOBJ SETTOBJ FGETTOBJ FSETTOBJ TEXTLEN TEXTSEL TEXTOBJ!) + (MACROS GETTSTR SETTSTR FGETTSTR FSETTSTR TEXTSTREAM!) (CONSTANTS * PTYPES) (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV))) (INITRECORDS PIECE TEXTOBJ TEXTSTREAM) @@ -50,10 +53,10 @@ (* ;; "Low-level generic stream operations") (FNS \TEDIT.TEXTCLOSEF \TEDIT.TEXTDSPFONT \TEDIT.TEXTEOFP \TEDIT.TEXTGETEOFPTR - \TEDIT.TEXTGETFILEPTR \TEDIT.TEXTOPENF \TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR - \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION \TEDIT.TEXTLEFTMARGIN - \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH \TEDIT.TEXTDSPSTRINGWIDTH - \TEDIT.TEXTDSPLINEFEED) + \TEDIT.TEXTSETEOFPTR \TEDIT.TEXTGETFILEPTR \TEDIT.TEXTSETFILEINFO \TEDIT.TEXTOPENF + \TEDIT.TEXTSETEOF \TEDIT.TEXTSETFILEPTR \TEDIT.TEXTDSPXPOSITION \TEDIT.TEXTDSPYPOSITION + \TEDIT.TEXTLEFTMARGIN \TEDIT.TEXTRIGHTMARGIN \TEDIT.TEXTDSPCHARWIDTH + \TEDIT.TEXTDSPSTRINGWIDTH \TEDIT.TEXTDSPLINEFEED) (COMS (* ;; "Editing support") @@ -61,12 +64,19 @@ (MACROS \INSERTCH.EXTENDABLE)) (FNS \TEDIT.DELETE.SELPIECES \TEDIT.INSERTCH \TEDIT.INSERTCH.HISTORY \TEDIT.INSERTEOL \TEDIT.INSERTCH.INSERTION \TEDIT.INSERTCH.EXTEND) + (FNS \TEDIT.NEXTCHANGEABLE.CHNO \TEDIT.LASTCHANGEABLE.CHNO) (FNS \SETUPGETCH)) (* ;  "Deprecated, maybe still external callers") (FNS \TEDIT.INSTALL.PIECE) - (COMS (* ; "Support for TEXTPROP") - (FNS GETTEXTPROP PUTTEXTPROP TEXTPROP)) + [COMS (* ; "Support for TEXTPROP") + (FNS TEXTPROP GETTEXTPROP PUTTEXTPROP GETTEXTPROPS PUTTEXTPROPS \TEDIT.TEXTPROP) + (FNS \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN \TEDIT.TEXTOBJ.PROPSTOREFN) + (* ; "For TEXTOBJ inspection") + (DECLARE%: DONTCOPY (* ; "Only if the declaration is loaded") + (ADDVARS (INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES + \TEDIT.TEXTOBJ.PROPFETCHFN + \TEDIT.TEXTOBJ.PROPSTOREFN] [COMS (* ;; "Support for error handling: The old error handler for the stream-not-open error. This is here, because you only want to do this ONCE, even if you load TEXT-STREAM multiple times (as, e.g., in development)") @@ -108,7 +118,13 @@  "High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;  "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") - [ACCESSFNS ((POBJ (IMAGEOBJP (PCONTENTS DATUM] + [ACCESSFNS ((POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) + (type? IMAGEOBJ (PCONTENTS DATUM)) + (PCONTENTS DATUM))) + (PCHARLOOKS (PLOOKS DATUM) + (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) + FAST + (freplace (PIECE PLOOKS) of DATUM with NEWVALUE] PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC) (DATATYPE TEXTOBJ @@ -118,10 +134,10 @@ PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") - PANES (* ; "A list of panes (subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC") + PRIMARYPANE (* ; "A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC") LASTPIECE (* ;  "The last (end-of-stream) piece of the textstream, for easy insertion at the end") - NIL (* ; + CHARFN (* ;  "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#") HINTPC (* ;  "Was: Space left in the type-in piece") @@ -130,19 +146,20 @@ INSERTSTRING (* ;  "A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ; "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece.") - (TXTLINELEADINGABOVE FLAG) (* ; "NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL.") - \WINDOW (* ; - "The window-pane where this textobj is displayed") + (NIL FLAG) (* ; " Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL.") + (TXTREADONLYQUIET FLAG) (* ; + "T => don't print READONLY abort messages") + PARABREAKCHARS (* ; "Characters that cause a paragraph break.Was \WINDOW. The window-pane where this textobj is displayed. Now chained through PRIMARYPANE") MOUSEREGION (* ;  "Section of the window the mouse is in.") - NIL (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES.") + LOOPFN (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES.") DS (* ;  "NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed") SEL (* ;  "The current selection within the text") - SCRATCHSEL (* ; - "Scratch space for the selection code") - SCRATCHSEL2 (* ; + NIL (* ; + "Was: Scratch space for the selection code") + NIL (* ;  "Was MOVESEL: Source for the next MOVE of text") NIL (* ;  "Was SHIFTEDSEL: Source for the next COPY") @@ -160,8 +177,8 @@  "-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ;  "T => The guy has asked the editor to go way") - CARET (* ; - "Describes the flashing caret for the editing window") + NIL (* ; + "Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ;  "Font to be used for inserted text.") WINDOWTITLE (* ; @@ -190,6 +207,8 @@ EDITPROPS (* ;  "The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection") + (TXTHISTORYINACTIVE FLAG) (* ; + "T if history events are not recorded (e.g. for transcript files)") TXTHISTORY (* ;  "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ; @@ -207,8 +226,7 @@  "List of all the CHARLOOKSs in the document, so they can be kept unique") TXTPARALOOKSLIST (* ;  "List of all the FMTSPECs in the document, so they can be kept unique") - (TXTNEEDSUPDATE FLAG) (* ; - "T => Screen invalid, need to run updater") + (TXTAPPENDONLY FLAG) (* ; "Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW.") TXTRAWINCLUDESTREAM (* ;  "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") @@ -222,11 +240,9 @@ (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))] SEL _ (create SELECTION) - SCRATCHSEL _ (create SELECTION) - SCRATCHSEL2 _ (create SELECTION) - TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL - MOUSEREGION _ 'TEXT THISLINE _ (create THISLINE) - MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL) + TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ 'TEXT THISLINE _ + (create THISLINE) + FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR))) (ACCESSFNS TEXTSTREAM ( @@ -247,17 +263,13 @@ (replace (STREAM F1) of DATUM with NEWVALUE)) (* ;  "Runs from PLEN to 0: piece exhausted") - (CURRENTLOOKS (fetch (STREAM F10) of DATUM) - (replace (STREAM F10) of DATUM with NEWVALUE)) - (* ; - "The CHARLOOKS that are currently applicable to characters being taken from the stream.") + (NIL) (* ; "Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ.") (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with NEWVALUE)) (* ; "The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone.") - (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) + (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) - (* ; - "Function to be called at every piece change when line-formatting.") + (* ; "Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) [TYPE? (AND (type? STREAM DATUM) @@ -303,12 +315,12 @@ '22) (/DECLAREDATATYPE 'TEXTOBJ - '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER - FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER - FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER - POINTER POINTER) + POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG + POINTER FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG + POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG + POINTER POINTER POINTER) '((TEXTOBJ 0 POINTER) (TEXTOBJ 2 POINTER) (TEXTOBJ 4 POINTER) @@ -319,6 +331,7 @@ (TEXTOBJ 14 POINTER) (TEXTOBJ 16 POINTER) (TEXTOBJ 16 (FLAGBITS . 0)) + (TEXTOBJ 16 (FLAGBITS . 16)) (TEXTOBJ 18 POINTER) (TEXTOBJ 20 POINTER) (TEXTOBJ 22 POINTER) @@ -353,6 +366,7 @@ (TEXTOBJ 68 POINTER) (TEXTOBJ 70 POINTER) (TEXTOBJ 70 (FLAGBITS . 0)) + (TEXTOBJ 70 (FLAGBITS . 16)) (TEXTOBJ 72 POINTER) (TEXTOBJ 74 FULLXPOINTER) (TEXTOBJ 76 POINTER) @@ -388,6 +402,9 @@ (PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC))) +(PUTPROPS PCHARLOOKS MACRO ((PC) + (PLOOKS PC))) + (PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC))) @@ -411,6 +428,9 @@ (PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC))) + +(PUTPROPS POBJ MACRO ((PC) + (ffetch (PIECE POBJ) of PC))) ) (DECLARE%: EVAL@COMPILE @@ -435,14 +455,14 @@ (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) - (OBJECT.PTYPE T) NIL))) ) (DECLARE%: EVAL@COMPILE (PUTPROPS VISIBLEPIECEP MACRO [(PC) - (NOT (OR (EQ 0 (PLEN PC)) - (fetch (CHARLOOKS CLINVISIBLE) of (PLOOKS PC]) + (AND PC (NEQ 0 (PLEN PC)) + (NOT (FGETCLOOKS (PCHARLOOKS PC) + CLINVISIBLE]) (PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) @@ -475,6 +495,25 @@ (PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ 'TEXTOBJ))) ) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS GETTSTR MACRO ((TSTR FIELD) + (fetch (TEXTSTREAM FIELD) of TSTR))) + +(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) + (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE))) + +(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) + (ffetch (TEXTSTREAM FIELD) of TSTR))) + +(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) + (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE))) + +(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) + (AND (\DTEST TSTR 'STREAM) + (TEXTOBJ! (FGETTSTR TSTR TEXTOBJ)) + TSTR))) +) (RPAQQ PTYPES ((THINFILE.PTYPE 0) @@ -492,7 +531,8 @@ UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) - (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)))) + (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) + (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))) (DECLARE%: EVAL@COMPILE (RPAQQ THINFILE.PTYPE 0) @@ -526,6 +566,8 @@ (RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) +(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)) + (CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) @@ -542,7 +584,8 @@ UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) - (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))) + (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) + (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -577,12 +620,12 @@ '22) (/DECLAREDATATYPE 'TEXTOBJ - '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER POINTER + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER - FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER - FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG POINTER - POINTER POINTER) + POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER POINTER POINTER FLAG + POINTER FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG + POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG FLAG + POINTER POINTER POINTER) '((TEXTOBJ 0 POINTER) (TEXTOBJ 2 POINTER) (TEXTOBJ 4 POINTER) @@ -593,6 +636,7 @@ (TEXTOBJ 14 POINTER) (TEXTOBJ 16 POINTER) (TEXTOBJ 16 (FLAGBITS . 0)) + (TEXTOBJ 16 (FLAGBITS . 16)) (TEXTOBJ 18 POINTER) (TEXTOBJ 20 POINTER) (TEXTOBJ 22 POINTER) @@ -627,6 +671,7 @@ (TEXTOBJ 68 POINTER) (TEXTOBJ 70 POINTER) (TEXTOBJ 70 (FLAGBITS . 0)) + (TEXTOBJ 70 (FLAGBITS . 16)) (TEXTOBJ 72 POINTER) (TEXTOBJ 74 FULLXPOINTER) (TEXTOBJ 76 POINTER) @@ -652,6 +697,12 @@ (\TEDIT.TEXTBIN [LAMBDA (TSTREAM) + (* ;; "Edited 21-Oct-2024 00:26 by rmk") + + (* ;; "Edited 3-May-2024 14:57 by rmk") + + (* ;; "Edited 28-Apr-2024 11:30 by rmk") + (* ;; "Edited 18-Mar-2024 23:34 by rmk") (* ;; "Edited 3-Feb-2024 14:27 by rmk") @@ -723,7 +774,7 @@ (* ;; "We are here because BIN punted. If it punted because it reached the end of a binable piece, then we have just advanced to the next piece. If it's binnable, then try running the opcode on the new situation. If it punted because we were not working on a binnable piece then and we are looking at one now, then again we must have advanced.") (BIN TSTREAM) - else (ADD (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM) + else (add (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM) -1) (* ;  "Where we will be when the operation completes") (SELECTC (PTYPE PC) @@ -731,14 +782,20 @@  "This counts offset in characters, not bytes") (PROG1 (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM) (ffetch (STREAM COFFSET) of TSTREAM)) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) + (add (ffetch (STREAM COFFSET) of TSTREAM) 1))) (FATFILE2.PTYPE (PROG1 (create WORD HIBYTE _ (BIN (PCONTENTS PC)) LOBYTE _ (BIN (PCONTENTS PC))) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) - 2))) + (add (ffetch (STREAM COFFSET) of TSTREAM) + 2) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch + (TEXTSTREAM + PCCHARSLEFT + ) + of TSTREAM))))) (OBJECT.PTYPE (* ;;  "Return the object as BIN's result, and make sure we'll go to the next page next time.") @@ -750,33 +807,47 @@ of TSTREAM) 'OBJECTBYTE) (PCONTENTS PC)) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) + (add (ffetch (STREAM COFFSET) of TSTREAM) 1))) + (UTF8.PTYPE (PROG1 (UTF8.BINCODE (PCONTENTS PC)) + (add (ffetch (STREAM COFFSET) of TSTREAM) + (PBYTESPERCHAR PC)) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + (\TEDIT.INSTALL.FILEBUFFER TSTREAM + (ffetch (TEXTSTREAM PCCHARSLEFT) + of TSTREAM))))) (FATFILE1.PTYPE (PROG1 (create WORD HIBYTE _ (PCHARSET PC) LOBYTE _ (BIN (PCONTENTS PC))) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) - 1))) - (UTF8.PTYPE (PROG1 (UTF8.BINCODE (PCONTENTS PC)) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) - (PBYTESPERCHAR PC)))) + (add (ffetch (STREAM COFFSET) of TSTREAM) + 1) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch + (TEXTSTREAM + PCCHARSLEFT + ) + of TSTREAM))))) (THINFILE.PTYPE (* ;  "Fall through when the underlying stream is not binable") (PROG1 (BIN (PCONTENTS PC)) - (ADD (ffetch (STREAM COFFSET) of TSTREAM) - 1))) - (SUBSTREAM.PTYPE (* ; "A substream stored as an object") - (BIN (IMAGEOBJPROP (PCONTENTS PC) - 'SUBSTREAM))) + (add (ffetch (STREAM COFFSET) of TSTREAM) + 1) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ffetch + (TEXTSTREAM + PCCHARSLEFT + ) + of TSTREAM))))) (PROGN (* ;; "For pieces not listed because they require more work. Assumes the function updates COFFSET and that multi-byte characters are safe: don't cross buffer boundaries.") - (HELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC]) + (\TEDIT.THELP "\TEXTBIN UNKNOWN PTYPE" (PTYPE PC]) (\TEDIT.TEXTPEEKBIN - [LAMBDA (TSTREAM NOERROR) (* ; "Edited 19-Mar-2024 19:14 by rmk") + [LAMBDA (TSTREAM NOERROR) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 19-Mar-2024 19:14 by rmk") (* ; "Edited 16-Mar-2024 12:44 by rmk") (* ; "Edited 1-Feb-2024 11:13 by rmk") (* ; "Edited 9-Aug-2022 10:19 by rmk") @@ -844,13 +915,14 @@ LOBYTE _ (\PEEKBIN PCONTENTS))) (SUBSTREAM.PTYPE (* ; "A substream stored as an object") (\PEEKBIN (IMAGEOBJPROP PCONTENTS 'SUBSTREAM))) - (SHOULDNT "UNKNOWN PIECE TYPE"))) + (\TEDIT.THELP "UNKNOWN PIECE TYPE"))) elseif NOERROR then NIL else (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM]) (\TEDIT.TEXTBACKFILEPTR - [LAMBDA (TSTREAM) (* ; "Edited 1-Feb-2024 11:25 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 1-Feb-2024 11:25 by rmk") (* ; "Edited 5-Jan-2024 17:57 by rmk") (* ; "Edited 28-Dec-2023 13:34 by rmk") (* ; "Edited 23-Dec-2023 12:19 by rmk") @@ -940,49 +1012,68 @@ (SUBSTREAM.PTYPE (* ; "A substream stored as an object") (BIN (IMAGEOBJPROP (PCONTENTS PC) 'SUBSTREAM))) - (SHOULDNT "UNKNOWN PIECE TYPE")))]) + (\TEDIT.THELP "UNKNOWN PIECE TYPE")))]) (\TEDIT.TEXTBOUT - [LAMBDA (TSTREAM CHAR) (* ; "Edited 17-Mar-2024 11:59 by rmk") + [LAMBDA (TSTREAM CHAR) (* ; "Edited 17-Nov-2024 10:05 by rmk") + (* ; "Edited 6-Sep-2024 13:06 by rmk") + (* ; "Edited 27-Aug-2024 14:50 by rmk") + (* ; "Edited 13-Aug-2024 08:28 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 22-May-2024 21:02 by rmk") + (* ; "Edited 18-May-2024 18:56 by rmk") + (* ; "Edited 10-May-2024 22:37 by rmk") + (* ; "Edited 8-May-2024 22:51 by rmk") + (* ; "Edited 17-Mar-2024 11:59 by rmk") (* ; "Edited 15-Mar-2024 14:38 by rmk") (* ; "Edited 23-Dec-2023 12:14 by rmk") (* ; "Edited 18-Oct-2023 21:14 by rmk") - (* ; "Edited 15-Oct-2023 15:31 by rmk") (* ; "Edited 17-Jun-2023 12:18 by rmk") (* ; "Edited 23-Feb-2023 15:26 by rmk") (* ; "Edited 12-Aug-2022 23:26 by rmk") (* ; "Edited 10-May-93 16:59 by jds") - (* ;; "Do BOUT to a text stream, which is an insertion at the caret. Unlike EOL's that are typed in at \TEDIT.INSERT, EOL's here don't create paragraph breaks. We would get a new piece after every line of an image stream") + (* ;; "Do BOUT to a text stream, which is an insertion at the caret.") + + (* ;; "Unlike EOL's that are typed in at \TEDIT.INSERT, EOL's here don't create paragraph breaks. We would get a new piece after every line of an image stream") (* ;; "ADD1 to convert from %"byte%" indexing to TEDIT selection-indexing.") (* ;; "Seems foolish to use \TEXTGETFILEPTR here to map from the current piece to the absolute character index, just so \INSERTCH can map backwards from the character number to the piece.") - (CL:UNLESS (\CHARCODEP CHAR) + (* ;; + "NOTE: This does not replace the character, it inserts in front. Perhaps calls TEDIT.RPLCHARCODE?") + + (CL:UNLESS (OR (\CHARCODEP CHAR) + (IMAGEOBJP CHAR)) (\ILLEGAL.ARG CHAR)) - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) - (CH# (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM))) - INSERTPC WINDOW) - (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY) (* ; - "Maybe should cause an error--stream not open?") - (CL:WHEN (SETQ WINDOW (FGETTOBJ TEXTOBJ \WINDOW)) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#)) - (CL:WHEN (SETQ INSERTPC (\TEDIT.INSERTCH CHAR CH# TEXTOBJ)) + (PROG [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (CHNO (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM] + (CL:WHEN [OR (FGETTOBJ TEXTOBJ TXTREADONLY) + (AND (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + (ILESSP CHNO (FGETTOBJ TEXTOBJ TEXTLEN] + (* ; "The generic GETSTREAM missed this, because a textstream that isn't BOTH can't even be filled in. Although perhaps OPENTEXTSTREAM can fill in the stream, then reset the access bit if that's what the props say.") + (ERROR "FILE NOT OPEN" TSTREAM) + (RETURN)) + (if (ILEQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN)) + then (TEDIT.RPLCHARCODE TSTREAM CHNO CHAR) (* ; + "Replace in the middle, add at the end") + elseif (AND (\TEDIT.INSERTCH CHAR CHNO TEXTOBJ (MEMB CHAR (FGETTOBJ TEXTOBJ + PARABREAKCHARS))) + (\TEDIT.PRIMARYPANE TEXTOBJ)) + then (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CHNO 1)) - (* ;; "We inserted 1 char. Whether or not we introduced a new piece or extended an old one, we want to be positioned at the first character of the next piece. ") + (* ;; ";; We inserted 1 char. Whether or not we introduced a new piece or extended an old one, we want to be positioned so that the next BOUT will insert after this one (if nothing else is changed). Do this after potential redisplay, in case the BINS in reformatting change the position.") - (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE INSERTPC) - 0) - (CL:WHEN WINDOW - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE INSERTPC) - 0)))) (* ; - "Reformatting advances the stream, go back to the insertion.") - CHAR]) + (* ;; "If the selection points to a later character, should the selection be updated, so it selects the same characters?") + + (\TEDIT.TEXTSETFILEPTR TSTREAM CHNO) + (CL:WHEN NIL (FSETTOBJ TEXTOBJ CARETLOOKS OLDCARETLOOKS)) + CHAR]) (\TEDIT.INSTALL.FILEBUFFER - [LAMBDA (TSTREAM PCCHARSLEFT) (* ; "Edited 18-Mar-2024 22:01 by rmk") + [LAMBDA (TSTREAM PCCHARSLEFT) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 18-Mar-2024 22:01 by rmk") (* ; "Edited 17-Mar-2024 19:37 by rmk") (* ; "Edited 28-Dec-2023 17:53 by rmk") (* ; "Edited 7-Dec-2023 16:10 by rmk") @@ -1003,7 +1094,8 @@ PCBYTESLEFT) (CL:UNLESS (MEMB (PTYPE PC) FILE.PTYPES) - [HELP "FILE BUFFER FOR NON-FILE PIECE" (LIST PC (\TEDIT.PCTOCH PC (TEXTOBJ TSTREAM]) + [\TEDIT.THELP "FILE BUFFER FOR NON-FILE PIECE" (LIST PC (\TEDIT.PCTOCH PC (TEXTOBJ + TSTREAM]) (CL:UNLESS (AND PFILE (\GETSTREAM PFILE 'INPUT T)) (* ;  "The file was closed for some reason; reopen it.") (SETQ PFILE (\TEDIT.REOPEN.STREAM TSTREAM PFILE))) @@ -1109,12 +1201,13 @@ (\TEDIT.TEXTBACKFILEPTR STREAM]) (\TEDIT.TEXTFORMATBYTESTREAM - [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 19-Mar-2024 16:13 by rmk") + [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 19-Mar-2024 16:13 by rmk") (* ; "Edited 24-Jun-2021 16:47 by rmk:") (* ;; "BYTESTREAM might come in with a textstream external format, but that's presumably a mistake. If STREAM is a text stream, then it traffics in XCCS characters, it's format should be relatively vanilla.") - (HELP) + (\TEDIT.THELP) (REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF STREAM]) (\TEDIT.TEXTFORMATBYTESTRING @@ -1134,6 +1227,18 @@ (OPENTEXTSTREAM [LAMBDA (TEXT WINDOW START END PROPS) + (* ;; "Edited 21-Nov-2024 00:18 by rmk") + + (* ;; "Edited 1-Sep-2024 09:20 by rmk") + + (* ;; "Edited 30-Jun-2024 16:17 by rmk") + + (* ;; "Edited 25-Jun-2024 11:59 by rmk") + + (* ;; "Edited 10-May-2024 22:42 by rmk") + + (* ;; "Edited 6-May-2024 12:38 by rmk") + (* ;; "Edited 31-Mar-2024 11:43 by rmk") (* ;; "Edited 17-Mar-2024 12:05 by rmk") @@ -1183,7 +1288,7 @@ (SETQ TEXT NIL)) (RESETLST (LET ((TSTREAM (TEXTSTREAMP TEXT)) - TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMARYW) + TEXTOBJ TEDIT.GET.FINISHEDFORMS PRIMPANE) (DECLARE (SPECVARS TEDIT.GET.FINISHEDFORMS)) (* ;  "Undocumented, but available for special-purpose actions specified somewhere below.") (if TSTREAM @@ -1199,22 +1304,16 @@ TEXTOBJ) TEXTOBJ))) (\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS) - (SETQ PRIMARYW (WINDOWP (\TEDIT.PRIMARYW TSTREAM))) - (if [AND WINDOW (NEQ WINDOW PRIMARYW) - (NEQ WINDOW (CAR (WINDOWPROP PRIMARYW 'TYPED-REGION] - then (SETQ WINDOW (\TEDIT.CREATEW WINDOW TSTREAM PROPS)) - (* ; "Set up a new window") - (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS) - elseif PRIMARYW - then (OPENW PRIMARYW) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 -1) - (* ; - "Clean and reuse the existing window") - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (SETTOBJ TEXTOBJ \DIRTY NIL)) + (SETQ WINDOW (if [AND (SETQ PRIMPANE (OPENWP (\TEDIT.PRIMARYPANE TSTREAM))) + (OR (NULL WINDOW) + (EQ WINDOW (CAR (WINDOWPROP PRIMPANE 'TYPED-REGION] + then (* ; "Reuse the existing window/region") + PRIMPANE + else (\TEDIT.CREATEW WINDOW TSTREAM PROPS))) + (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS) (\TEDIT.REOPENTEXTSTREAM TSTREAM) else (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM PROPS)) - (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (SETQ TEXTOBJ (FGETTSTR TSTREAM TEXTOBJ)) (CL:WHEN TEXT (* ;  "Verify/open the file before the window") (SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS)) @@ -1235,9 +1334,14 @@ (CL:WHEN WINDOW (* ; "Connect to the window") (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS)) - (\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM)) + (\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM) + (\TEDIT.SCROLL.CARET TSTREAM)) + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTPAGEFRAMES) + (TEDIT.PAGEFORMAT TEXTOBJ TEDIT.PAGE.FRAMES)) (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) - (\TEDIT.TEXTSETFILEPTR TSTREAM 0) + (SETFILEPTR TSTREAM (CL:IF (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + -1 + 0)) TSTREAM))]) (COPYTEXTSTREAM @@ -1315,7 +1419,8 @@ TSTREAM]) (\TEDIT.OPENTEXTSTREAM.PIECES - [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 20-Mar-2024 10:58 by rmk") + [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 26-Sep-2024 22:27 by rmk") + (* ; "Edited 20-Mar-2024 10:58 by rmk") (* ; "Edited 27-Dec-2023 13:33 by rmk") (* ; "Edited 23-Oct-2023 13:47 by rmk") (* ; "Edited 28-Sep-2023 10:17 by rmk") @@ -1366,31 +1471,36 @@ (FSETTOBJ TEXTOBJ TXTREADONLY READONLY) (FSETTOBJ TEXTOBJ TXTHISTORY NIL) (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Get)) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Get)) (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NIL))) TSTREAM]) (\TEDIT.OPENTEXTSTREAM.PROPS - [LAMBDA (TEXTOBJ PROPS) (* ; "Edited 23-Jan-2024 08:36 by rmk") + [LAMBDA (TEXTOBJ PROPS) (* ; "Edited 21-Nov-2024 11:28 by rmk") + (* ; "Edited 31-Aug-2024 20:21 by rmk") + (* ; "Edited 30-Aug-2024 14:47 by rmk") + (* ; "Edited 14-Jul-2024 10:30 by rmk") + (* ; "Edited 23-Jan-2024 08:36 by rmk") (* ; "Edited 22-Sep-2023 21:57 by rmk") (* ; "Edited 17-Sep-2023 09:41 by rmk") - (* ;; - "Install the props, reversing to get the priorities right (overrides, including NILs, come later.") + (* ;; "Install the props, with earlier ones overriding the defaults.") - (* ;; "After this, all values should be retrieved by GETTEXTPROP") + (* ;; "After this, all values should be retrievable by GETTEXTPROP") - (for PROPTAIL on (REVERSE (APPEND PROPS TEDIT.DEFAULT.PROPS)) by (CDDR PROPTAIL) - do (PUTTEXTPROP TEXTOBJ (CADR PROPTAIL) - (CAR PROPTAIL))) - (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ) - (CL:WHEN (GETTEXTPROP TEXTOBJ 'PAGEFORMAT) (* ; - "Impose the default page formatting, if specified.") - (TEDIT.PAGEFORMAT TEXTOBJ (GETTEXTPROP TEXTOBJ 'PAGEFORMAT)))]) + [PUTTEXTPROPS TEXTOBJ (APPEND PROPS TEDIT.DEFAULT.PROPS `(READTABLE ,TEDIT.READTABLE] + (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS TEXTOBJ]) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL - [LAMBDA (TSTREAM) (* ; "Edited 15-Mar-2024 13:38 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 25-Nov-2024 14:33 by rmk") + (* ; "Edited 20-Nov-2024 23:56 by rmk") + (* ; "Edited 29-Sep-2024 10:51 by rmk") + (* ; "Edited 7-Jul-2024 11:42 by rmk") + (* ; "Edited 5-Jul-2024 17:15 by rmk") + (* ; "Edited 18-May-2024 16:25 by rmk") + (* ; "Edited 12-May-2024 21:40 by rmk") + (* ; "Edited 15-Mar-2024 13:38 by rmk") + (* ; "Edited 29-Apr-2024 12:40 by rmk") (* ; "Edited 15-Dec-2023 23:05 by rmk") (* ; "Edited 12-Oct-2023 22:48 by rmk") (* ; "Edited 17-Sep-2023 12:52 by rmk") @@ -1400,79 +1510,104 @@ (* ;; "This sets up the initial SEL for TEXTOBJ according to the SEL PROPS entry. If SELPROP is NIL, the default is 1-0-LEFT--just before the first character. This doesn't show the selection--this stream may not yet have a window.") - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) - SELPROP SEL) - (SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL)) - (for S in (\TEDIT.COLLECTSELS TEXTOBJ) do (FSETSEL S SELTEXTOBJ TEXTOBJ) - (FSETSEL S SET NIL)) - (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (FSETSEL SEL SET T) - (\TEDIT.SHOWSEL SEL NIL) - (CL:UNLESS (EQ SELPROP 'DON'T) - (if (type? SELECTION SELPROP) - then (* ; + (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ)) + SELPROP) + (SETQ SELPROP (GETTEXTPROP TEXTOBJ 'SEL)) + (FSETSEL SEL SET T) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ) + (CL:UNLESS (EQ SELPROP 'DON'T) + (FSETSEL SEL SELKIND 'CHAR) (* ; "Default, maybe reset below") + (if (type? SELECTION SELPROP) + then (* ;  "We came in with an explicit initial selection. Set it up.") - (\TEDIT.COPYSEL SELPROP SEL) - (FSETSEL SEL SELTEXTOBJ TEXTOBJ) - elseif (LISTP SELPROP) - then - (* ;; "Default to POINT selection") + (\TEDIT.COPYSEL SELPROP SEL) + elseif (LISTP SELPROP) + then + (* ;; "Default to POINT selection") - (\TEDIT.UPDATE.SEL SEL (CAR SELPROP) - (OR (CADR SELPROP) - 0) - (OR (CADDR SELPROP) - 'LEFT)) - (FSETSEL SEL SELKIND 'CHAR) - else - (* ;; "Default to before the first character") + (\TEDIT.UPDATE.SEL SEL (CAR SELPROP) + (OR (CADR SELPROP) + 0) + (OR (CADDR SELPROP) + 'LEFT)) + (FSETSEL SEL SELKIND 'CHAR) + elseif (FIXP SELPROP) + then (\TEDIT.UPDATE.SEL SEL SELPROP 0 'LEFT) + elseif (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + then + (* ;; "Default to after the last character") - (\TEDIT.UPDATE.SEL SEL (OR (FIXP SELPROP) - 1) - 0 - 'LEFT) - (FSETSEL SEL SELKIND 'CHAR)) - [FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET) - then (* ; + (\TEDIT.UPDATE.SEL SEL (FGETTOBJ TEXTOBJ TEXTLEN) + 0 + 'RIGHT) + else + (* ;; "Default to before the first character. UPDATE.SEL screws up the CHLIM=CH#+DCH invariant when DCH=0, it adds 1, But UPDATE.SEL adds 1 when DCH=0. That's wrong for the initial caret, so brute-force fix it here. Maybe it's wrong in general?") + + (\TEDIT.UPDATE.SEL SEL 1 0 'LEFT) + (FSETSEL SEL CHLIM 1)) + [FSETTOBJ TEXTOBJ CARETLOOKS (if (FGETSEL SEL SET) + then (* ;  "An initial selection implies initial caret looks.") - (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL) - else (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (GETTOBJ TEXTOBJ + (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL) + else (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (GETTOBJ TEXTOBJ + DEFAULTCHARLOOKS - ] - (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) (* ; + ] + (CL:WHEN (OR (FGETTOBJ TEXTOBJ TXTREADONLY) + (FGETTOBJ TEXTOBJ TXTAPPENDONLY)) (* ;  "Don't blink for read-only, but do highlighting") - (FSETSEL SEL HASCARET NIL)) - (\TEDIT.SHOWSEL SEL T)) - SEL]) + (FSETSEL SEL HASCARET NIL)) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.SHOWSEL SEL T TEXTOBJ)) + SEL]) (\TEDIT.OPENTEXTSTREAM.WINDOW - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 17-Mar-2024 12:06 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 21-Nov-2024 00:18 by rmk") + (* ; "Edited 1-Sep-2024 09:06 by rmk") + (* ; "Edited 28-Jun-2024 23:06 by rmk") + (* ; "Edited 16-Jun-2024 15:40 by rmk") + (* ; "Edited 13-Jun-2024 17:57 by rmk") + (* ; "Edited 19-May-2024 00:26 by rmk") + (* ; "Edited 6-May-2024 21:16 by rmk") + (* ; "Edited 17-Mar-2024 12:06 by rmk") (* ; "Edited 15-Mar-2024 14:38 by rmk") (* ; "Edited 26-Oct-2023 11:02 by rmk") (* ; "Edited 18-Sep-2023 23:22 by rmk") (* ; "Edited 17-Sep-2023 11:53 by rmk") - (* ;; - "Associates WINDOW with TSTREAM. Brute force, doesn't let this window stuff change the fileptr ") + (* ;; "Associates WINDOW with TSTREAM. Brute force, doesn't let this window stuff change the fileptr. Maybe should unsplit all panes if WINDOW is split.") (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) (FILEPTR (\TEDIT.TEXTGETFILEPTR TSTREAM))) - (if WINDOW + [if WINDOW then (\TEDIT.WINDOW.SETUP WINDOW TSTREAM PROPS) - (\TEDIT.UPDATE.SCREEN TEXTOBJ) - (SETTOBJ TEXTOBJ \DIRTY NIL) - (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) - (for CARET in (GETTOBJ TEXTOBJ CARET) do (\TEDIT.UPCARET CARET)) - (TEDIT.NORMALIZECARET TEXTOBJ)) + (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) + NIL TEXTOBJ) + (\TEDIT.FIXSEL (FGETTOBJ TEXTOBJ SEL) + TEXTOBJ) + (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) + T TEXTOBJ) + (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) + (for PANE inpanes TEXTOBJ do (\TEDIT.UPCARET (GETPANEPROP (PANEPROPS PANE) + PCARET)))) (\TEDIT.TEXTSETFILEPTR TSTREAM FILEPTR) elseif (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW) then (* ;; "There is no window for the session, but he has passed in a promptwindow to use, install it in the textobj") - (SETTOBJ TEXTOBJ PROMPTWINDOW (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW]) + (SETTOBJ TEXTOBJ PROMPTWINDOW (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW] + (SETTOBJ TEXTOBJ \DIRTY NIL) + WINDOW]) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS - [LAMBDA (TEXTOBJ) (* ; "Edited 11-Nov-2023 16:13 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 20-Dec-2024 11:56 by rmk") + (* ; "Edited 16-Dec-2024 13:14 by rmk") + (* ; "Edited 21-Nov-2024 14:35 by rmk") + (* ; "Edited 29-Aug-2024 09:46 by rmk") + (* ; "Edited 31-Jul-2024 12:09 by rmk") + (* ; "Edited 29-Apr-2024 11:05 by rmk") + (* ; "Edited 11-Nov-2023 16:13 by rmk") (* ; "Edited 17-Sep-2023 07:43 by rmk") (* ; "Edited 3-Aug-2023 23:02 by rmk") (* ; "Edited 26-Apr-2023 14:29 by rmk") @@ -1484,25 +1619,27 @@ (* ;; "Find the default font for this TEXTOBJ -- either what the guy tells us, the one from TEDIT.DEFAULT.PROPS, or his DEFAULTFONT.") - (SETQ FONT (GETTEXTPROP TEXTOBJ 'FONT)) + (SETQ FONT (OR (GETTEXTPROP TEXTOBJ 'FONT) + DEFAULTFONT)) (SETQ CHARLOOKS (GETTEXTPROP TEXTOBJ 'LOOKS)) (SETQ CHARLOOKS (OR (AND CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST CHARLOOKS NIL TEXTOBJ)) (AND (type? CHARLOOKS FONT) FONT) - (AND FONT (CHARLOOKS.FROM.FONT (FONTCREATE FONT))) - (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (\TEDIT.CHARLOOKS.FROM.FONT FONT))) (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS CHARLOOKS TEXTOBJ)) (SETQ PARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (\TEDIT.PARSE.PARALOOKS.LIST (OR (GETTEXTPROP TEXTOBJ 'PARALOOKS) (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC) - )) + ) + NIL TEXTOBJ) TEXTOBJ)) (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS CHARLOOKS) (SETTOBJ TEXTOBJ CARETLOOKS CHARLOOKS) (SETTOBJ TEXTOBJ FMTSPEC PARALOOKS]) (\TEDIT.OPENTEXTFILE - [LAMBDA (TEXT PROPS) (* ; "Edited 20-Dec-2023 10:49 by rmk") + [LAMBDA (TEXT PROPS) (* ; "Edited 21-Nov-2024 11:38 by rmk") + (* ; "Edited 20-Dec-2023 10:49 by rmk") (* ; "Edited 28-Oct-2023 10:33 by rmk") (* ; "Edited 26-Sep-2023 18:00 by rmk") (* ; "Edited 24-Sep-2023 23:13 by rmk") @@ -1524,9 +1661,9 @@ (FORMAT ,(LISTGET PROPS 'FORMAT] elseif (\GETSTREAM TEXT 'INPUT T) else - (* ;; "Perhaps this should be an error--remove T from the \GETSTREAM?") + (* ;; "Don't know what it is") - TEXT))]) + (ERROR TEXT " does not identify a Tedit document")))]) (\TEDIT.CREATE.TEXTSTREAM [LAMBDA (PROPS) (* ; "Edited 16-Mar-2024 09:52 by rmk") @@ -1547,7 +1684,8 @@ TSTREAM]) (\TEDIT.REOPEN.STREAM - [LAMBDA (TSTREAM PIECESTREAM) (* ; "Edited 16-Mar-2024 10:03 by rmk") + [LAMBDA (TSTREAM PIECESTREAM) (* ; "Edited 14-May-2024 18:00 by rmk") + (* ; "Edited 16-Mar-2024 10:03 by rmk") (* ; "Edited 23-Jan-2024 00:28 by rmk") (* ; "Edited 9-Nov-2023 17:05 by rmk") (* ; "Edited 8-Sep-2023 00:23 by rmk") @@ -1561,28 +1699,32 @@ NEWSTREAM) (CL:UNLESS PIECESTREAM (SETQ PIECESTREAM (FGETTOBJ TEXTOBJ TXTFILE))) - [SETQ NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL `((TYPE TEXT) - (FORMAT ,(STREAMPROP PIECESTREAM - :EXTERNAL-FORMAT] + (if (\GETSTREAM PIECESTREAM 'INPUT T) + then PIECESTREAM + else [SETQ NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL + `((TYPE TEXT) + (FORMAT ,(STREAMPROP PIECESTREAM :EXTERNAL-FORMAT] - (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:") + (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:") - (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (EQ (PCONTENTS PC) - PIECESTREAM) - do (FSETPC PC PCONTENTS NEWSTREAM)) + (for PC inpieces (\TEDIT.FIRSTPIECE TEXTOBJ) when (EQ (PCONTENTS PC) + PIECESTREAM) + do (FSETPC PC PCONTENTS NEWSTREAM)) - (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:") + (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:") - (CL:WHEN (EQ (FGETTOBJ TEXTOBJ TXTFILE) - PIECESTREAM) - (FSETTOBJ TEXTOBJ TXTFILE NEWSTREAM)) + (CL:WHEN (EQ (FGETTOBJ TEXTOBJ TXTFILE) + PIECESTREAM) + (FSETTOBJ TEXTOBJ TXTFILE NEWSTREAM)) - (* ;; "Return the new value for the stream:") + (* ;; "Return the new value for the stream:") - NEWSTREAM]) + NEWSTREAM]) (\TEDIT.TEXTINIT - [LAMBDA NIL (* ; "Edited 19-Mar-2024 18:16 by rmk") + [LAMBDA NIL (* ; "Edited 4-Sep-2024 22:05 by rmk") + (* ; "Edited 22-May-2024 14:53 by rmk") + (* ; "Edited 19-Mar-2024 18:16 by rmk") (* ; "Edited 17-Mar-2024 12:25 by rmk") (* ; "Edited 10-Mar-2024 13:50 by rmk") (* ; "Edited 7-Mar-2023 15:01 by rmk") @@ -1627,6 +1769,10 @@ IMCHARWIDTH _ (FUNCTION \TEDIT.TEXTDSPCHARWIDTH) IMSTRINGWIDTH _ (FUNCTION \TEDIT.TEXTDSPSTRINGWIDTH) IMSCALE _ (FUNCTION (LAMBDA NIL 1] + (FONTPROFILE.ADDDEVICE 'TEXT 'DISPLAY) + (ADDTOVAR IMAGESTREAMTYPES (TEXT (FONTCREATE \CREATEDISPLAYFONT) + (FONTSAVAILABLE \SEARCHDISPLAYFONTFILES) + (CREATECHARSET \CREATECHARSET.DISPLAY))) (* ;; "Maybe more functions later. The INCODE and BACK functions possibly need to count. If \TEXTBACKFILEPTR takes a count variable, the extra level wouldn't be needed. But INCCODE wants to go through the BIN opcode") @@ -1657,11 +1803,12 @@ (replace (STREAM ACCESS) of STREAM with 'BOTH) STREAM] - SETFILEINFO _ (FUNCTION NILL) + SETFILEINFO _ (FUNCTION \TEDIT.TEXTSETFILEINFO) BACKFILEPTR _ (FUNCTION \TEDIT.TEXTBACKFILEPTR) SETFILEPTR _ (FUNCTION \TEDIT.TEXTSETFILEPTR) PEEKBIN _ (FUNCTION \TEDIT.TEXTPEEKBIN) GETEOFPTR _ (FUNCTION \TEDIT.TEXTGETEOFPTR) + SETEOFPTR _ (FUNCTION \TEDIT.TEXTSETEOFPTR) GETFILEPTR _ (FUNCTION \TEDIT.TEXTGETFILEPTR) EOFP _ (FUNCTION \TEDIT.TEXTEOFP) FDBINABLE _ T @@ -1675,7 +1822,7 @@ (LET ((STREAM (STREAM-ERROR-STREAM CONDITION))) (COND [(AND (BOUNDP 'ERRORPOS) - (TEXTSTREAMP STREAM)) (* ; + (TEXTSTREAMP STREAM)) (* ;  "This happened in the error handler, and it happened to a TEdit stream, so try the fix:") (LET ((XCL::RESULT (\TEDIT.REOPENTEXTSTREAM STREAM))) (CL:WHEN XCL::RESULT @@ -1696,7 +1843,9 @@ (DEFINEQ (\TEDIT.TTYBOUT - [LAMBDA (TSTREAM BYTE) (* ; "Edited 17-Mar-2024 11:39 by rmk") + [LAMBDA (TSTREAM BYTE) (* ; "Edited 26-Nov-2024 21:18 by rmk") + (* ; "Edited 24-Jun-2024 00:05 by rmk") + (* ; "Edited 17-Mar-2024 11:39 by rmk") (* ; "Edited 18-Mar-2023 20:08 by rmk") (* ; "Edited 31-May-91 14:18 by jds") @@ -1704,11 +1853,10 @@ (* ;; "IS THIS BEING USED ?? INSTEAD, SPECIAL CASES IN \TEDIT.TEXTOUTCHARFN") - (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))) (if (EQ BYTE ERASECHARCODE) - then (\TEDIT.CHARDELETE TEXTOBJ (fetch (TEXTOBJ SEL) of TEXTOBJ)) - elseif (EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch (TEXTOBJ TXTTERMSA) - of TEXTOBJ) + then (\TEDIT.CHARDELETE TSTREAM) + elseif (EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (GETTOBJ TEXTOBJ TXTTERMSA) \PRIMTERMSA) BYTE))) else (\TEDIT.TEXTOUTCHARFN TSTREAM BYTE]) @@ -1784,8 +1932,30 @@ (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) TEXTLEN]) +(\TEDIT.TEXTSETEOFPTR + [LAMBDA (TSTREAM LEN) (* ; "Edited 25-Nov-2024 20:13 by rmk") + (* ; "Edited 7-Jul-2024 11:43 by rmk") + (* ; "Edited 23-May-2024 08:33 by rmk") + + (* ;; "Eliminate all trailing bytes so the file contains the first LEN characters") + + (LET* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)) + (SEL (FGETTOBJ TEXTOBJ SEL)) + (TAILSEL (\TEDIT.COPYSEL SEL))) + (CL:UNLESS (IGEQ LEN TEXTLEN) + (RESETLST + [RESETSAVE (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + `(PROGN (PUTTEXTPROP ,TEXTOBJ 'APPEND OLDVALUE] + (FSETTOBJ TEXTOBJ TXTAPPENDONLY NIL) + (\TEDIT.UPDATE.SEL TAILSEL (ADD1 LEN) + (IDIFFERENCE TEXTLEN LEN)) + (\TEDIT.FIXSEL SEL TEXTOBJ) + (\TEDIT.DELETE TEXTOBJ TAILSEL)))]) + (\TEDIT.TEXTGETFILEPTR - [LAMBDA (TSTREAM) (* ; "Edited 19-Mar-2024 14:19 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 7-May-2024 21:14 by rmk") + (* ; "Edited 19-Mar-2024 14:19 by rmk") (* ; "Edited 17-Mar-2024 00:25 by rmk") (* ; "Edited 21-Oct-2023 20:57 by rmk") (* ; "Edited 2-Sep-2022 17:45 by rmk") @@ -1803,6 +1973,12 @@ (* ;; "Not set or off the end") (FGETTOBJ TEXTOBJ TEXTLEN) + elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then + (* ;; "Replace a lingering piece from a delete-everything?") + + (freplace (TEXTSTREAM PIECE) of TSTREAM with (FGETTOBJ TEXTOBJ LASTPIECE)) + 0 else (* ; "Somewhere inside the document") (SETQ PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)) (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM) @@ -1821,6 +1997,16 @@ (IDIFFERENCE (PLEN PC) PCCHARSLEFT]) +(\TEDIT.TEXTSETFILEINFO + [LAMBDA (TSTREAM ATTRIBUTE VALUE DEVICE) (* ; "Edited 22-May-2024 14:58 by rmk") + (LET ((TEXTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + SEL) + (SELECTQ ATTRIBUTE + (LENGTH (* ; + "Delete the tail if LENGTH is shrinking") + (\TEDIT.TEXTSETEOFPTR TSTREAM VALUE)) + NIL]) + (\TEDIT.TEXTOPENF [LAMBDA (TSTREAM ACCESS) (* ; "Edited 16-Mar-2024 10:03 by rmk") (* ; "Edited 7-Dec-2023 21:01 by rmk") @@ -1869,7 +2055,8 @@ (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))]) (\TEDIT.TEXTDSPXPOSITION - [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 17-Mar-2024 12:15 by rmk") + [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 17-Mar-2024 12:15 by rmk") (* ; "Edited 3-Jan-2001 17:27 by rmk:") (* ;  "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") @@ -1877,7 +2064,7 @@ (* ;;  "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") - (LET ((WINDOW (\TEDIT.PRIMARYW TSTREAM))) (* ; + (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))) (* ;  "If there is no window, estimate from character position") (CL:IF WINDOW (DSPXPOSITION NIL WINDOW) @@ -1886,13 +2073,14 @@ (POSITION TSTREAM)))]) (\TEDIT.TEXTDSPYPOSITION - [LAMBDA (TSTREAM YPOSITION) (* ; "Edited 17-Mar-2024 12:15 by rmk") + [LAMBDA (TSTREAM YPOSITION) (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 17-Mar-2024 12:15 by rmk") (* ; "Edited 31-May-91 13:59 by jds") (* ;;  "Simply returns the YPOSITION of the primary window's display stream, this is a read-only function") - (LET ((WINDOW (\TEDIT.PRIMARYW TSTREAM))) + (LET ((WINDOW (\TEDIT.PRIMARYPANE TSTREAM))) (IF WINDOW THEN (DSPYPOSITION NIL WINDOW) ELSEIF (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1)) @@ -1905,7 +2093,8 @@ FMTSPEC]) (\TEDIT.TEXTRIGHTMARGIN - [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 21-Sep-2023 12:38 by rmk") + [LAMBDA (TSTREAM XPOSITION) (* ; "Edited 28-Jun-2024 22:07 by rmk") + (* ; "Edited 21-Sep-2023 12:38 by rmk") (* ; "Edited 31-May-91 14:03 by jds") (* ;;; "Returns the right margin of the textstream's default paralooks. If XPOSITION is given, the default looks and the linelength of the string are updated. ") @@ -1919,7 +2108,7 @@ (* ;; "If \TEDIT.MINIMAL.WINDOW.SETUP sets WRIGHT, maybe that's enough? I.e. the right margin is either the width of the window or calculated from the LINELENGTH. It wouldn't depend on the default FMTSPEC or the FMTSPEC of the current piece.") (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) - (if (FGETTOBJ TEXTOBJ \WINDOW) + (if (FGETTOBJ TEXTOBJ PRIMARYPANE) then (LET* ((FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC)) (RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) LEFTMAR NEWPOS) @@ -2002,56 +2191,61 @@ (DEFINEQ (\TEDIT.DELETE.SELPIECES - [LAMBDA (TEXTOBJ TARGETSEL) (* ; "Edited 17-Mar-2024 00:22 by rmk") + [LAMBDA (TEXTOBJ FIRSTCHAR LEN) (* ; "Edited 26-Nov-2024 22:31 by rmk") + (* ; "Edited 22-Sep-2024 18:34 by rmk") + (* ; "Edited 7-Jul-2024 09:09 by rmk") + (* ; "Edited 7-May-2024 21:14 by rmk") + (* ; "Edited 17-Mar-2024 00:22 by rmk") (* ; "Edited 13-Feb-2024 00:13 by rmk") (* ; "Edited 11-Dec-2023 09:51 by rmk") (* ; "Edited 21-Oct-2023 23:50 by rmk") (* ; "Edited 3-Jun-2023 22:31 by rmk") (* ; "Edited 29-Jan-99 17:28 by kaplan") - (* ;; "Delete the characters selected by TARGETSEL. If any of the pieces contains an objecting object, nothing is done.") - - (CL:UNLESS (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - - (* ;; "Only delete characters if changes are permitted. ") + (* ;; "Delete LEN characters starting at FIRSTCHAR in TEXTOBJ. If any of the pieces contains an objecting object, nothing is done.") + (CL:WHEN (type? SELECTION FIRSTCHAR) + (CL:UNLESS LEN + (SETQ LEN (FGETSEL FIRSTCHAR DCH))) + (SETQ FIRSTCHAR (FGETSEL FIRSTCHAR CH#))) + (CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY) (\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'START TEXTOBJ) (LET (SELPIECES PREVPC) - (SETQ SELPIECES (\TEDIT.SELPIECES TARGETSEL)) - (CL:WHEN (AND (fetch (SELPIECES SPFIRST) of SELPIECES) - (for PC inselpieces SELPIECES always (OBJECT.ALLOWS PC 'DELETE TEXTOBJ))) - - (* ;; "First deleted piece still points back into the TEXTOBJ sequence") - - (SETQ PREVPC (PREVPIECE (ffetch (SELPIECES SPFIRST) of SELPIECES))) + (CL:WHEN (AND (SETQ SELPIECES (\TEDIT.SELPIECES FIRSTCHAR (IPLUS FIRSTCHAR LEN -1) + TEXTOBJ)) + (for PC inselpieces (PROGN SELPIECES) always (OBJECT.ALLOWS PC + 'DELETE TEXTOBJ))) + (SETQ PREVPC (PREVPIECE (FGETSPC SELPIECES SPFIRST))) (\TEDIT.DELETEPIECES SELPIECES TEXTOBJ) - (FSETTOBJ TEXTOBJ \DIRTY T) (* ;; "If the the effect of the deletion is to concatenate a (non-empty) prefix of one paragraph with a (non-empty) suffix of another, propagate the prefix PARALOOKS all the way through to the end of the newly combined paragraph. All the pieces of a paragraph must have the same PARALOOKS.") (CL:WHEN (AND PREVPC (NOT (PPARALAST PREVPC))) (* ; "Retained a non-empty prefix") - (for PC (PPLOOKS _ (PPARALOOKS PREVPC)) inpieces (NEXTPIECE PREVPC) + (for PC (PARALOOKS _ (PPARALOOKS PREVPC)) inpieces (NEXTPIECE PREVPC) do (* ;;  "(NEXTPIECE PREVPC) is the first retained piece linked in after the deletion") - (FSETPC PC PPARALOOKS PPLOOKS) repeatuntil (PPARALAST PC))) + (FSETPC PC PPARALOOKS PARALOOKS) repeatuntil (PPARALAST PC))) (\TEDIT.BTVALIDATE '\TEDIT.DELETE.SELPIECES 'END TEXTOBJ) (* ;; "") - (* ;; "The pieces are now properly linked with the proper looks. For the history, SELPIECES knows where it came from") + (* ;; "The pieces are now properly linked with the proper looks. SELPIECE holds the deleted pieces needed for undoing.") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Delete - THCH# _ (FGETSEL TARGETSEL CH#) - THLEN _ (FGETSEL TARGETSEL DCH) - THDELETEDPIECES _ SELPIECES)) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Delete FIRSTCHAR + (FGETSPC SELPIECES SPLEN) + NIL NIL NIL SELPIECES)) T)))]) (\TEDIT.INSERTCH - [LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 17-Mar-2024 12:41 by rmk") + [LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 22-Nov-2024 13:48 by rmk") + (* ; "Edited 22-Sep-2024 12:32 by rmk") + (* ; "Edited 13-Aug-2024 08:30 by rmk") + (* ; "Edited 18-May-2024 19:04 by rmk") + (* ; "Edited 6-May-2024 10:28 by rmk") + (* ; "Edited 17-Mar-2024 12:41 by rmk") (* ; "Edited 21-Jan-2024 14:06 by rmk") (* ; "Edited 9-Dec-2023 13:14 by rmk") (* ; "Edited 18-Oct-2023 21:16 by rmk") @@ -2116,7 +2310,7 @@  "The hint has been used, but becomes invalid until the updates are complete.") (SETQ PREVPC (PREVPIECE INSERTPC)) (if (AND PREVPC (\INSERTCH.EXTENDABLE PREVPC INSERTION INSERTPTYPE) - (EQ (PLOOKS PREVPC) + (EQ (PCHARLOOKS PREVPC) (FGETTOBJ TEXTOBJ CARETLOOKS)) (NOT (PPARALAST PREVPC))) then @@ -2127,8 +2321,8 @@ PTYPE _ INSERTPTYPE PCONTENTS _ INSERTION PLEN _ ILEN - PLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS) - PPARALOOKS _ (PPARALOOKS INSERTPC) + PCHARLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS) + PPARALOOKS _ (PPARALOOKS (OR PREVPC INSERTPC)) PNEW _ T)) (SELECTC INSERTPTYPE (THINSTRING.PTYPE @@ -2162,51 +2356,57 @@ (RETURN INSERTPC]) (\TEDIT.INSERTCH.HISTORY - [LAMBDA (TEXTOBJ PREVPC CH# ILEN) (* ; "Edited 8-Jun-2023 08:39 by rmk") + [LAMBDA (TEXTOBJ PREVPC CH# ILEN) (* ; "Edited 22-Sep-2024 18:36 by rmk") + (* ; "Edited 8-Jun-2023 08:39 by rmk") (* ; "Edited 28-May-2023 00:01 by rmk") (* ; "Edited 25-May-2023 09:13 by rmk") (* ;; "Fix the history to reflect the character/string insertion by extending the event for previous characters in an insertion run. Backspace removes individual characters, Undo removes the whole sequence.") - (LET ((EVENT (\TEDIT.LASTEVENT TEXTOBJ))) (* ; "Immediately prior edit event.") - (CL:UNLESS (type? TEDITHISTORYEVENT EVENT) (* ; + (if (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE) + then + (* ;; "Maybe the first event after setting the textprop--now's the time to flush") + + (FSETTOBJ TEXTOBJ TXTHISTORY NIL) + (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) + else (LET ((EVENT (\TEDIT.LASTEVENT TEXTOBJ))) (* ; "Immediately prior edit event.") + (CL:UNLESS (type? TEDITHISTORYEVENT EVENT) (* ;  "Don't do composites, fall thru to add.") - (SETQ EVENT NIL)) - (if [AND EVENT (EQ PREVPC (GETTH EVENT THFIRSTPIECE)) - (FMEMB (GETTH EVENT THACTION) - '(:Insert :Replace] - then - (* ;; "We're continuing a prior insertion, just continue the old history event too. Critical that insertions and replacements save PREVPC as THFIRSTPIECE") + (SETQ EVENT NIL)) + (if [AND EVENT (EQ PREVPC (GETTH EVENT THFIRSTPIECE)) + (FMEMB (GETTH EVENT THACTION) + '(:Insert :Replace] + then + (* ;; "We're continuing a prior insertion, just continue the old history event too. Critical that insertions and replacements save PREVPC as THFIRSTPIECE") - (add (GETTH EVENT THLEN) - ILEN) - else (* ; + (add (GETTH EVENT THLEN) + ILEN) + else (* ;  "A new insertion/replacemen requires a new history event.") - (if (AND EVENT (EQ (GETTH EVENT THACTION) - :Delete) - (IEQP CH# (GETTH EVENT THCH#))) - then (SETTH EVENT THACTION :Replace) (* ; + (if (AND EVENT (EQ (GETTH EVENT THACTION) + :Delete) + (IEQP CH# (GETTH EVENT THCH#))) + then (SETTH EVENT THACTION :Replace) + (* ;  "Upgrade the deletion to a replacement") - (SETTH EVENT THCH# CH#) - (SETTH EVENT THLEN (PLEN PREVPC)) - (SETTH EVENT THPOINT 'RIGHT) - (SETTH EVENT THFIRSTPIECE PREVPC) - else - (* ;; "This insertion is unrelated to the previous user action, we push a new event to support undo sequences.") + (SETTH EVENT THCH# CH#) + (SETTH EVENT THLEN (PLEN PREVPC)) + (SETTH EVENT THPOINT 'RIGHT) + (SETTH EVENT THFIRSTPIECE PREVPC) + else + (* ;; "This insertion is unrelated to the previous user action, we push a new event to support undo sequences.") - (* ;; "A deletion followed by a first insertion got converted to a replace above. We are now adding a character to the end. We want to start where it started before, and end one beyond where it ended before. Why aren't we in the above :Replace case?") + (* ;; "A deletion followed by a first insertion got converted to a replace above. We are now adding a character to the end. We want to start where it started before, and end one beyond where it ended before. Why aren't we in the above :Replace case?") - (* ;; "In the replace case above, maybe the PREVPC test isn't right?") + (* ;; "In the replace case above, maybe the PREVPC test isn't right?") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ :Insert - THLEN _ (PLEN PREVPC) - THCH# _ CH# - THFIRSTPIECE _ PREVPC - THPOINT _ 'RIGHT]) + (\TEDIT.HISTORYADD TEXTOBJ (\TEDIT.HISTORY.EVENT TEXTOBJ :Insert CH# + (PLEN PREVPC) + 'RIGHT PREVPC]) (\TEDIT.INSERTEOL - [LAMBDA (CH CH# TEXTOBJ) (* ; "Edited 17-Mar-2024 11:41 by rmk") + [LAMBDA (CH CH# TSTREAM) (* ; "Edited 29-Apr-2024 10:46 by rmk") + (* ; "Edited 17-Mar-2024 11:41 by rmk") (* ; "Edited 11-Aug-2023 15:49 by rmk") (* ; "Edited 5-May-2023 17:00 by rmk") (* ; "Edited 31-May-91 14:00 by jds") @@ -2215,22 +2415,21 @@ (* ;; "") - (* ;; "RMK: Is it really necessary to convert to formatted? If \FORMATLINE forces a line break when it seems a meta-EO, then it is only EOL that forces the PARALAST for paragraph formatting and paragraph selection. meta-EOL can be treated just as an ordinary character and not come through (if meta-EOL can appear with the same significance in an otherwise plain-text file.") - - (CL:UNLESS (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (LET (INPC) - (CL:UNLESS (OR (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - (EQ (CHARCODE EOL))) (* ; + (PROG [INPC (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) + (RETURN NIL)) + (CL:UNLESS (OR (FGETTOBJ TEXTOBJ FORMATTEDP) + (EQ (CHARCODE EOL))) (* ;  "Inserting a meta-EOL into an unformatted document. Start by setting up para breaks.") - (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ)) - (SETQ INPC (\TEDIT.INSERTCH (CHARCODE EOL) - CH# TEXTOBJ)) (* ; "Put the EOL in") - (CL:WHEN (AND (EQ CH (CHARCODE EOL)) - (PREVPIECE INPC)) (* ; + (\TEDIT.CONVERT.TO.FORMATTED TSTREAM)) + (SETQ INPC (\TEDIT.INSERTCH (CHARCODE EOL) + CH# TEXTOBJ)) (* ; "Put the EOL in") + (CL:WHEN (AND (EQ CH (CHARCODE EOL)) + (PREVPIECE INPC)) (* ;  "It's really an EOL, rather than a meta-EOL so do para breaking.") - (freplace (PIECE PPARALAST) of (PREVPIECE INPC) with T) - T) - INPC))]) + (FSETPC (PREVPIECE INPC) + PPARALAST T)) + (RETURN INPC]) (\TEDIT.INSERTCH.INSERTION [LAMBDA (CH TEXTOBJ) (* ; "Edited 20-Oct-2023 23:57 by rmk") @@ -2301,8 +2500,37 @@ ) (DEFINEQ +(\TEDIT.NEXTCHANGEABLE.CHNO + [LAMBDA (CHNO TEXTOBJ) (* ; "Edited 25-Nov-2024 23:54 by rmk") + + (* ;; "Returns the number of the first visible character at or after CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.") + + (LET ((FIRSTPIECE (\TEDIT.CHTOPC CHNO TEXTOBJ))) + (find PC inpieces FIRSTPIECE until (GETCLOOKS (PCHARLOOKS PC) + CLPROTECTED) when (VISIBLEPIECEP PC) + do (RETURN (if (EQ PC FIRSTPIECE) + then CHNO + else (SUB1 (\TEDIT.PCTOCH PC TEXTOBJ]) + +(\TEDIT.LASTCHANGEABLE.CHNO + [LAMBDA (CHNO TEXTOBJ) (* ; "Edited 26-Nov-2024 00:00 by rmk") + + (* ;; "Returns the number of the first visible character at or before CHNO, NIL if the first visible character is protected. Almost always CHNO--PCTOCH is the unusual case.") + + (LET ((FIRSTPIECE (\TEDIT.CHTOPC CHNO TEXTOBJ))) + (find PC backpieces FIRSTPIECE until (GETCLOOKS (PCHARLOOKS PC) + CLPROTECTED) when (VISIBLEPIECEP PC) + do (RETURN (if (EQ PC FIRSTPIECE) + then CHNO + else (IPLUS (SUB1 (PLEN PC)) + (\TEDIT.PCTOCH PC TEXTOBJ]) +) +(DEFINEQ + (\SETUPGETCH - [LAMBDA (CH# TEXTOBJ) (* ; "Edited 17-Mar-2024 00:27 by rmk") + [LAMBDA (CH# TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 29-Apr-2024 12:14 by rmk") + (* ; "Edited 17-Mar-2024 00:27 by rmk") (* ; "Edited 23-Dec-2023 12:14 by rmk") (* ; "Edited 22-Aug-2022 13:04 by rmk") (* ; "Edited 10-Aug-2022 17:20 by rmk") @@ -2316,17 +2544,16 @@ (* ;; "NOBODY CALLS IT WITH A PIECE. CALLS |INSTALL.PIECE INSTEAD") - (COND - ((TYPE? PIECE CH#) - (HELP "\SETUPGETCH CALLED WITH PIECE") - (\TEDIT.INSTALL.PIECE (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - CH# 0)) - (T (LET (START-OF-PIECE PC) - (DECLARE (SPECVARS START-OF-PIECE)) - (SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T)) - (\TEDIT.INSTALL.PIECE (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - PC - (- CH# START-OF-PIECE]) + (SETQ TEXTOBJ (TEXTOBJ)) + (LET ((TSTREAM (TEXTSTREAM TEXTOBJ))) + (COND + ((TYPE? PIECE CH#) + (\TEDIT.THELP "\SETUPGETCH CALLED WITH PIECE") + (\TEDIT.INSTALL.PIECE TSTREAM CH# 0)) + (T (LET (START-OF-PIECE PC) + (DECLARE (SPECVARS START-OF-PIECE)) + (SETQ PC (\TEDIT.CHTOPC CH# TEXTOBJ T)) + (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE]) ) @@ -2336,7 +2563,10 @@ (DEFINEQ (\TEDIT.INSTALL.PIECE - [LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 18-Mar-2024 22:26 by rmk") + [LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 18-May-2024 22:39 by rmk") + (* ; "Edited 9-May-2024 22:34 by rmk") + (* ; "Edited 18-Mar-2024 22:26 by rmk") (* ; "Edited 1-Feb-2024 00:23 by rmk") (* ; "Edited 21-Jan-2024 13:00 by rmk") (* ; "Edited 5-Jan-2024 10:30 by rmk") @@ -2350,27 +2580,22 @@ (* ;; "Makes PC be the current piece in TSTREAM. set up so that the next character is at CHOFFSET relative to the start of the piece. ") - (* ;; "Note that, since we are setting up the TSTREAM looks here, the LOOKSUPDATEFN doesn't need to do that part.") - (* ;; "SHOULD PARTS OF THIS BE UNINTERRUPTABLE? ") (CL:WHEN PC (PROG (PCCHARSLEFT (PCONTENTS (PCONTENTS PC)) - (PLEN (PLEN PC)) - (LOOKSUPDATEFN (ffetch (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM))) + (PLEN (PLEN PC))) - (* ;; "The LOOKSUPDATEFN is non-NIL only for calls from \FORMATLINE and \TEDIT.HARDCOPY.FORMATLINE. It updates their formatting variables and skips invisible pieces. ") - - (if LOOKSUPDATEFN - then (SETQ PC (APPLY* LOOKSUPDATEFN TSTREAM PC)) - (CL:UNLESS PC (* ; "Invisible to the end?") - (RETURN NIL)) - else (freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with (PLOOKS PC)) - (freplace (TEXTSTREAM CURRENTPARALOOKS) of TSTREAM with (PPARALOOKS PC))) - - (* ;; "Install PC and its looks in TSTREAM.") + (* ;; "Install PC in TSTREAM. ") (freplace (TEXTSTREAM PIECE) of TSTREAM with PC) + (CL:WHEN (ffetch (TEXTSTREAM APPLYLOOKSUPDATEFN) of TSTREAM) + + (* ;; "Called from \TEDIT.FORMATLINE to update formatting variables at piece boundaries. Otherwise, the call is from one of the external-format functions. Early versions of the code set CARETLOOKS as pieces were encountered, but it makes more sense for CARETLOOKS to change only by explicit movement of the caret.") + + (SETQ PC (\TEDIT.FORMATLINE.UPDATELOOKS TSTREAM PC)) + (CL:UNLESS PC (* ; "Invisible to the end?") + (RETURN NIL))) (* ;; "") @@ -2392,21 +2617,13 @@ with (IPLUS (ffetch (STRINGP OFFST) of PCONTENTS) PLEN))) (OBJECT.PTYPE (freplace (STREAM CBUFSIZE) of TSTREAM with 1)) - (SUBSTREAM.PTYPE (* ; - "Maybe just set PC to the piece of the (freplace (STREAM BINABLE) of TSTREAM with NIL)substream?") - (CL:UNLESS LOOKSUPDATEFN - (freplace (TEXTSTREAM CURRENTPARALOOKS) of TSTREAM - with (ffetch (TEXTSTREAM CURRENTPARALOOKS) of PCONTENTS)) - (freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with (ffetch (TEXTSTREAM - CURRENTLOOKS) - of PCONTENTS)))) NIL) (freplace (STREAM BINABLE) of TSTREAM with (PBINABLE PC)) (freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (ffetch (STREAM COFFSET) of TSTREAM)) (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT) (CL:WHEN (ILESSP PCCHARSLEFT 0) - (HELP "INSTALL.PIECE PCCHARSLEFT LESS THAN 0")) + (\TEDIT.THELP "INSTALL.PIECE PCCHARSLEFT LESS THAN 0")) (RETURN PC)))]) ) @@ -2416,83 +2633,189 @@ (DEFINEQ +(TEXTPROP + [LAMBDA NARGS (* ; "Edited 30-Jul-2024 12:48 by rmk") + (CL:UNLESS (IGEQ NARGS 2) + (\ILLEGAL.ARG NARGS)) + (\TEDIT.TEXTPROP (TEXTOBJ (ARG NARGS 1)) + (ARG NARGS 2) + (IGEQ NARGS 3) + (AND (IGEQ NARGS 3) + (ARG NARGS 3]) + (GETTEXTPROP - [LAMBDA (TEXTOBJ PROP) (* ; "Edited 20-Mar-2024 10:58 by rmk") - (* ; "Edited 2-Mar-2024 07:09 by rmk") - (* ; "Edited 14-Jan-2024 16:35 by rmk") - (* ; "Edited 31-Oct-2023 23:32 by rmk") - (* ; "Edited 21-Sep-2023 09:48 by rmk") + [LAMBDA (TSTREAM PROP) (* ; "Edited 30-Jul-2024 12:40 by rmk") + + (* ;; "Gets values for document properties. ") + + (\TEDIT.TEXTPROP (TEXTOBJ TSTREAM) + PROP]) + +(PUTTEXTPROP + [LAMBDA (TSTREAM PROP VALUE) (* ; "Edited 30-Jul-2024 12:41 by rmk") + + (* ;; "Stores VALUE as the PROP value of TSTREAM ") + + (\TEDIT.TEXTPROP (TEXTOBJ TSTREAM) + PROP T VALUE]) + +(GETTEXTPROPS + [LAMBDA (TSTREAM PROPNAMES) (* ; "Edited 30-Jul-2024 12:37 by rmk") + (* ; "Edited 11-Jul-2024 12:14 by rmk") + (for PROP (TEXTOBJ _ (TEXTOBJ TSTREAM)) inside PROPNAMES join (LIST PROP (\TEDIT.TEXTPROP TEXTOBJ + PROP]) + +(PUTTEXTPROPS + [LAMBDA (TSTREAM PROPS) (* ; "Edited 30-Jul-2024 12:44 by rmk") + (* ; "Edited 14-Jul-2024 10:27 by rmk") + (* ; "Edited 11-Jul-2024 12:14 by rmk") + + (* ;; "The %"when%" is to only do the first if there are multiple instances of the same property, so that the first ones take effect, laters ones can act as defaults. ") + + (* ;; "E.g (FOO T FOO NIL) => T. ") + + (for PTAIL (TEXTOBJ _ (TEXTOBJ TSTREAM)) on PROPS by (CDDR PTAIL) + when (EQ (CADR PTAIL) + (LISTGET PROPS (CAR PTAIL))) do (\TEDIT.TEXTPROP TEXTOBJ (CAR PTAIL) + T + (CADR PTAIL]) + +(\TEDIT.TEXTPROP + [LAMBDA (TEXTOBJ PROP SETNEWVALUE NEWVALUE) (* ; "Edited 22-Dec-2024 00:23 by rmk") + (* ; "Edited 23-Nov-2024 09:47 by rmk") + (* ; "Edited 21-Nov-2024 11:53 by rmk") + (* ; "Edited 18-Nov-2024 16:37 by rmk") + (* ; "Edited 15-Nov-2024 18:07 by rmk") + (* ; "Edited 22-Sep-2024 08:41 by rmk") + (* ; "Edited 31-Aug-2024 17:56 by rmk") + (* ; "Edited 29-Aug-2024 12:28 by rmk") + (* ; "Edited 26-Aug-2024 15:50 by rmk") + (* ; "Edited 13-Aug-2024 08:27 by rmk") + (* ; "Edited 5-Aug-2024 16:01 by rmk") + (* ; "Edited 30-Jul-2024 12:40 by rmk") + (* ; "Edited 25-Apr-2024 00:00 by rmk") + (* ; "Edited 21-Sep-2023 09:54 by rmk") (* ; "Edited 9-Feb-89 11:20 by jds") - (* ;; "Gets values for document properties. Used by TEXTPROP.") + (* ;; "Internal function for getting/setting properties. Called by TEXTPROP, GETTEXTPROP, PUTTEXTPROP. Puts the special code for built-in properties in once place.") (TEXTOBJ! TEXTOBJ) (SELECTQ PROP ((READONLY READ-ONLY) - (FGETTOBJ TEXTOBJ TXTREADONLY)) + (PROG1 (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) + (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) + 'QUIET + T)) + (CL:WHEN SETNEWVALUE + (FSETTOBJ TEXTOBJ TXTREADONLY NEWVALUE) + (FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE)) + (\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF)))) ((BEING-EDITED ACTIVE) - (FGETTOBJ TEXTOBJ TXTEDITING)) - (READTABLE (FGETTOBJ TEXTOBJ TXTRTBL)) - (BOUNDTABLE (FGETTOBJ TEXTOBJ TXTWTBL)) - (DON'TUPDATE (FGETTOBJ TEXTOBJ TXTDON'TUPDATE)) - (NOTSPLITTABLE (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE)) - (\WINDOW (FGETTOBJ TEXTOBJ \WINDOW)) - (DIRTY (FGETTOBJ TEXTOBJ \XDIRTY)) - (LENGTH (FGETTOBJ TEXTOBJ TEXTLEN)) - (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS) - PROP]) - -(PUTTEXTPROP - [LAMBDA (TEXTOBJ PROP VALUE) (* ; "Edited 20-Mar-2024 10:59 by rmk") - (* ; "Edited 15-Mar-2024 18:08 by rmk") - (* ; "Edited 9-Mar-2024 22:18 by rmk") - (* ; "Edited 2-Mar-2024 07:09 by rmk") - (* ; "Edited 14-Jan-2024 16:35 by rmk") - (* ; "Edited 31-Oct-2023 23:33 by rmk") - (* ; "Edited 21-Sep-2023 09:48 by rmk") - (* ; "Edited 9-Feb-89 11:19 by jds") - - (* ;; "Put a value on prop list for a textobj. Some properties affect the fields of TEXTOBJ, but all go into EDITPROPS so that they can be retrieved as a whole.") - - (TEXTOBJ! TEXTOBJ) - (CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS)) (* ; + (PROG1 (FGETTOBJ TEXTOBJ TXTEDITING) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTEDITING NEWVALUE)))) + (READTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTRTBL) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTRTBL NEWVALUE)))) + (TERMTABLE (PROG1 (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of NEWVALUE)) + (CL:IF SETNEWVALUE + (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of NEWVALUE))))) + (BOUNDTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTWTBL) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTWTBL NEWVALUE)))) + (DON'TUPDATE (PROG1 (FGETTOBJ TEXTOBJ TXTDON'TUPDATE) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NEWVALUE)))) + (NOTSPLITTABLE (PROG1 (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE T)))) + (DIRTY (PROG1 (FGETTOBJ TEXTOBJ \XDIRTY) + (CL:IF SETNEWVALUE (FSETTOBJ TEXTOBJ \DIRTY NEWVALUE)))) + (LENGTH (PROG1 (FGETTOBJ TEXTOBJ TEXTLEN) + (CL:IF SETNEWVALUE (ERROR "TEXT property LENGTH is read-only")))) + (APPEND (PROG1 (CL:WHEN (FGETTOBJ TEXTOBJ TXTAPPENDONLY) + (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLYQUIET) + 'QUIET + T)) + (CL:WHEN SETNEWVALUE + (FSETTOBJ TEXTOBJ TXTAPPENDONLY NEWVALUE) + (FSETTOBJ TEXTOBJ TXTREADONLYQUIET (EQ 'QUIET NEWVALUE)) + (\TEDIT.HISTORY.PROP TEXTOBJ T 'OFF)))) + (HISTORY (\TEDIT.HISTORY.PROP TEXTOBJ SETNEWVALUE NEWVALUE)) + (PARABREAKCHARS + (PROG1 (for C in (FGETTOBJ TEXTOBJ PARABREAKCHARS) + collect (SELCHARQ C + (EOL 'EOL) + (LF 'LF) + (CR 'CR) + (FORM 'FORM) + (CHARACTER C))) + (CL:WHEN SETNEWVALUE + (FSETTOBJ TEXTOBJ PARABREAKCHARS (MKLIST (CHARCODE.DECODE NEWVALUE)))))) + (FILENAME (PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTFILE) + (fetch FULLFILENAME of (FGETTOBJ TEXTOBJ TXTFILE))) + (CL:WHEN (AND SETNEWVALUE (NEQ NEWVALUE NIL)) + (ERROR "FILENAME cannot be changed")))) + (PAGEFORMAT (PROG1 (FGETTOBJ TEXTOBJ TXTPAGEFRAMES) + (CL:WHEN SETNEWVALUE + (CL:UNLESS (type? PAGEREGION NEWVALUE) + (\ILLEGAL.ARG NEWVALUE)) + (FSETTOBJ TEXTOBJ TXTPAGEFRAMES NEWVALUE)))) + (LOOPFN (PROG1 (FGETTOBJ TEXTOBJ LOOPFN) + (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ LOOPFN NEWVALUE)))) + (CHARFN (PROG1 (FGETTOBJ TEXTOBJ CHARFN) + (CL:WHEN SETNEWVALUE (FSETTOBJ TEXTOBJ CHARFN NEWVALUE)))) + (PROG1 (LISTGET (FGETTOBJ TEXTOBJ EDITPROPS) + PROP) + (CL:WHEN SETNEWVALUE + (CL:UNLESS (LISTP (FGETTOBJ TEXTOBJ EDITPROPS)) + (* ;  "Make sure we have a list to smash, no matter what.") - (FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL))) - (PROG1 (GETTEXTPROP TEXTOBJ PROP) - (SELECTQ PROP - ((READONLY READ-ONLY) - (FSETTOBJ TEXTOBJ TXTREADONLY VALUE) - (CL:WHEN NIL (* ; - "This has to be done after the file is initially read in") - (replace (STREAM ACCESS) of (FGETTOBJ TEXTOBJ STREAMHINT) with 'INPUT))) - ((BEING-EDITED ACTIVE) - (FSETTOBJ TEXTOBJ TXTEDITING VALUE)) - (READTABLE (FSETTOBJ TEXTOBJ TXTRTBL VALUE)) - (TERMTABLE (FSETTOBJ TEXTOBJ TXTTERMSA (fetch (TERMTABLEP TERMSA) of VALUE))) - (BOUNDTABLE (FSETTOBJ TEXTOBJ TXTWTBL VALUE)) - (DON'TUPDATE (FSETTOBJ TEXTOBJ TXTDON'TUPDATE VALUE)) - (NOTSPLITTABLE (FSETTOBJ TEXTOBJ TXTNOTSPLITTABLE T)) - (\WINDOW - (* ;; - "If VALUE is a window, we really should do a full set up. And if NIL, detach it.") + (FSETTOBJ TEXTOBJ EDITPROPS (LIST PROP NIL))) + (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS) + PROP NEWVALUE)))]) +) +(DEFINEQ - (FSETTOBJ TEXTOBJ \WINDOW (MKLIST VALUE))) - (DIRTY (FSETTOBJ TEXTOBJ \DIRTY VALUE)) - (LENGTH (ERROR "TEXT property LENGTH is read-only")) - NIL) - (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS) - PROP VALUE))]) +(\TEDIT.TEXTOBJ.PROPNAMES + [LAMBDA (TEXTOBJ) (* ; "Edited 4-Jul-2024 11:08 by rmk") + (* ; "Edited 30-Jun-2024 09:04 by rmk") -(TEXTPROP - [LAMBDA X (* ; "Edited 21-Sep-2023 09:54 by rmk") - (* ; "Edited 9-Feb-89 11:20 by jds") - (CL:UNLESS (IGEQ X 2) - (\ILLEGAL.ARG X)) - (LET [(TEXTOBJ (TEXTOBJ (ARG X 1] - (PROG1 (GETTEXTPROP TEXTOBJ (ARG X 2)) - (CL:UNLESS (EQ X 2) - (PUTTEXTPROP TEXTOBJ (ARG X 2) - (ARG X 3))))]) + (* ;; "Stick the user properties at the end with --USERPROPS-- separator. INSPECTABLEFIELDNAMES does the sort for defined field names, the UFIELDS have to be sorted here.") + + (LET ([TFIELDS (REMOVE 'EDITPROPS (INSPECTABLEFIELDNAMES (OR (RECLOOK 'TEXTOBJ) + (SYSRECLOOK1 'TEXTOBJ] + (UFIELDS (for X in (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) by (CDDR X) collect X))) + (CL:UNLESS (OR (EQ T INSPECTDONTSORTFIELDS) + (MEMB 'TEXTOBJ INSPECTDONTSORTFIELDS)) + (SETQ UFIELDS (SORT UFIELDS))) + (APPEND TFIELDS (CONS '--USERPROPS--) + UFIELDS]) + +(\TEDIT.TEXTOBJ.PROPFETCHFN + [LAMBDA (TEXTOBJ PROPNAME) (* ; "Edited 4-Jul-2024 11:53 by rmk") + (if (EQ PROPNAME '--USERPROPS--) + then '------ + elseif (MEMB PROPNAME (RECORDFIELDNAMES 'TEXTOBJ)) + then (RECORDACCESS PROPNAME TEXTOBJ (OR (RECLOOK 'TEXTOBJ) + (SYRECLOOK1 'TEXTOBJ) + 'FETCH)) + else (GETTEXTPROP TEXTOBJ PROPNAME]) + +(\TEDIT.TEXTOBJ.PROPSTOREFN + [LAMBDA (TEXTOBJ PROPNAME VALUE) (* ; "Edited 4-Jul-2024 11:49 by rmk") + (* ; "Edited 30-Jun-2024 08:52 by rmk") + (if (EQ PROPNAME '--USERPROPS--) + elseif (MEMB PROPNAME (RECORDFIELDNAMES 'TEXTOBJ)) + then (RECORDACCESS PROPNAME TEXTOBJ (OR (RECLOOK 'TEXTOBJ) + (SYRECLOOK1 'TEXTOBJ)) + 'REPLACE VALUE) + else (PUTTEXTPROP TEXTOBJ PROPNAME VALUE]) +) + + + +(* ; "For TEXTOBJ inspection") + +(DECLARE%: DONTCOPY + +(ADDTOVAR INSPECTMACROS (TEXTOBJ \TEDIT.TEXTOBJ.PROPNAMES \TEDIT.TEXTOBJ.PROPFETCHFN + \TEDIT.TEXTOBJ.PROPSTOREFN)) ) @@ -2516,27 +2839,31 @@ (ADDTOVAR LAMA TEXTPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (33937 60490 (\TEDIT.TEXTBIN 33947 . 42725) (\TEDIT.TEXTPEEKBIN 42727 . 48164) ( -\TEDIT.TEXTBACKFILEPTR 48166 . 53726) (\TEDIT.TEXTBOUT 53728 . 56486) (\TEDIT.INSTALL.FILEBUFFER 56488 - . 60488)) (61388 65319 (\TEDIT.TEXTOUTCHARFN 61398 . 62954) (\TEDIT.TEXTINCCODEFN 62956 . 63695) ( -\TEDIT.TEXTBACKCCODEFN 63697 . 64289) (\TEDIT.TEXTFORMATBYTESTREAM 64291 . 64877) ( -\TEDIT.TEXTFORMATBYTESTRING 64879 . 65317)) (65366 75866 (OPENTEXTSTREAM 65376 . 71602) ( -COPYTEXTSTREAM 71604 . 75089) (TEDIT.STREAMCHANGEDP 75091 . 75393) (TXTFILE 75395 . 75864)) (75867 -100813 (\TEDIT.REOPENTEXTSTREAM 75877 . 77229) (\TEDIT.OPENTEXTSTREAM.PIECES 77231 . 81611) ( -\TEDIT.OPENTEXTSTREAM.PROPS 81613 . 82669) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 82671 . 86165) ( -\TEDIT.OPENTEXTSTREAM.WINDOW 86167 . 87762) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 87764 . 89611) ( -\TEDIT.OPENTEXTFILE 89613 . 91212) (\TEDIT.CREATE.TEXTSTREAM 91214 . 92148) (\TEDIT.REOPEN.STREAM -92150 . 94269) (\TEDIT.TEXTINIT 94271 . 100811)) (100851 101970 (\TEDIT.TTYBOUT 100861 . 101968)) ( -102088 118131 (\TEDIT.TEXTCLOSEF 102098 . 103422) (\TEDIT.TEXTDSPFONT 103424 . 104394) ( -\TEDIT.TEXTEOFP 104396 . 106151) (\TEDIT.TEXTGETEOFPTR 106153 . 106476) (\TEDIT.TEXTGETFILEPTR 106478 - . 108802) (\TEDIT.TEXTOPENF 108804 . 109735) (\TEDIT.TEXTSETEOF 109737 . 110353) ( -\TEDIT.TEXTSETFILEPTR 110355 . 112396) (\TEDIT.TEXTDSPXPOSITION 112398 . 113306) ( -\TEDIT.TEXTDSPYPOSITION 113308 . 113937) (\TEDIT.TEXTLEFTMARGIN 113939 . 114316) ( -\TEDIT.TEXTRIGHTMARGIN 114318 . 117280) (\TEDIT.TEXTDSPCHARWIDTH 117282 . 117586) ( -\TEDIT.TEXTDSPSTRINGWIDTH 117588 . 117894) (\TEDIT.TEXTDSPLINEFEED 117896 . 118129)) (119178 138817 ( -\TEDIT.DELETE.SELPIECES 119188 . 122290) (\TEDIT.INSERTCH 122292 . 129521) (\TEDIT.INSERTCH.HISTORY -129523 . 132609) (\TEDIT.INSERTEOL 132611 . 134692) (\TEDIT.INSERTCH.INSERTION 134694 . 137531) ( -\TEDIT.INSERTCH.EXTEND 137533 . 138815)) (138818 140326 (\SETUPGETCH 138828 . 140324)) (140384 145479 -(\TEDIT.INSTALL.PIECE 140394 . 145477)) (145517 150001 (GETTEXTPROP 145527 . 146874) (PUTTEXTPROP -146876 . 149499) (TEXTPROP 149501 . 149999))))) + (FILEMAP (NIL (36657 67258 (\TEDIT.TEXTBIN 36667 . 47417) (\TEDIT.TEXTPEEKBIN 47419 . 52969) ( +\TEDIT.TEXTBACKFILEPTR 52971 . 58644) (\TEDIT.TEXTBOUT 58646 . 63048) (\TEDIT.INSTALL.FILEBUFFER 63050 + . 67256)) (68156 72204 (\TEDIT.TEXTOUTCHARFN 68166 . 69722) (\TEDIT.TEXTINCCODEFN 69724 . 70463) ( +\TEDIT.TEXTBACKCCODEFN 70465 . 71057) (\TEDIT.TEXTFORMATBYTESTREAM 71059 . 71762) ( +\TEDIT.TEXTFORMATBYTESTRING 71764 . 72202)) (72251 82942 (OPENTEXTSTREAM 72261 . 78678) ( +COPYTEXTSTREAM 78680 . 82165) (TEDIT.STREAMCHANGEDP 82167 . 82469) (TXTFILE 82471 . 82940)) (82943 +112098 (\TEDIT.REOPENTEXTSTREAM 82953 . 84305) (\TEDIT.OPENTEXTSTREAM.PIECES 84307 . 88737) ( +\TEDIT.OPENTEXTSTREAM.PROPS 88739 . 89841) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 89843 . 94778) ( +\TEDIT.OPENTEXTSTREAM.WINDOW 94780 . 97461) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 97463 . 99990) ( +\TEDIT.OPENTEXTFILE 99992 . 101705) (\TEDIT.CREATE.TEXTSTREAM 101707 . 102641) (\TEDIT.REOPEN.STREAM +102643 . 104979) (\TEDIT.TEXTINIT 104981 . 112096)) (112136 113324 (\TEDIT.TTYBOUT 112146 . 113322)) ( +113442 131819 (\TEDIT.TEXTCLOSEF 113452 . 114776) (\TEDIT.TEXTDSPFONT 114778 . 115748) ( +\TEDIT.TEXTEOFP 115750 . 117505) (\TEDIT.TEXTGETEOFPTR 117507 . 117830) (\TEDIT.TEXTSETEOFPTR 117832 + . 118922) (\TEDIT.TEXTGETFILEPTR 118924 . 121646) (\TEDIT.TEXTSETFILEINFO 121648 . 122156) ( +\TEDIT.TEXTOPENF 122158 . 123089) (\TEDIT.TEXTSETEOF 123091 . 123707) (\TEDIT.TEXTSETFILEPTR 123709 . +125750) (\TEDIT.TEXTDSPXPOSITION 125752 . 126769) (\TEDIT.TEXTDSPYPOSITION 126771 . 127512) ( +\TEDIT.TEXTLEFTMARGIN 127514 . 127891) (\TEDIT.TEXTRIGHTMARGIN 127893 . 130968) ( +\TEDIT.TEXTDSPCHARWIDTH 130970 . 131274) (\TEDIT.TEXTDSPSTRINGWIDTH 131276 . 131582) ( +\TEDIT.TEXTDSPLINEFEED 131584 . 131817)) (132866 153517 (\TEDIT.DELETE.SELPIECES 132876 . 136303) ( +\TEDIT.INSERTCH 136305 . 144099) (\TEDIT.INSERTCH.HISTORY 144101 . 147565) (\TEDIT.INSERTEOL 147567 . +149392) (\TEDIT.INSERTCH.INSERTION 149394 . 152231) (\TEDIT.INSERTCH.EXTEND 152233 . 153515)) (153518 +155022 (\TEDIT.NEXTCHANGEABLE.CHNO 153528 . 154243) (\TEDIT.LASTCHANGEABLE.CHNO 154245 . 155020)) ( +155023 156727 (\SETUPGETCH 155033 . 156725)) (156785 161243 (\TEDIT.INSTALL.PIECE 156795 . 161241)) ( +161281 169493 (TEXTPROP 161291 . 161638) (GETTEXTPROP 161640 . 161884) (PUTTEXTPROP 161886 . 162143) ( +GETTEXTPROPS 162145 . 162589) (PUTTEXTPROPS 162591 . 163495) (\TEDIT.TEXTPROP 163497 . 169491)) ( +169494 171564 (\TEDIT.TEXTOBJ.PROPNAMES 169504 . 170456) (\TEDIT.TEXTOBJ.PROPFETCHFN 170458 . 170974) +(\TEDIT.TEXTOBJ.PROPSTOREFN 170976 . 171562))))) STOP diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM index 93369ffe9baf94af5e76b720447b2d53b5b33387..78f60163fbfa0d717cb846cff27e17a6e854f299 100644 GIT binary patch delta 13131 zcmb7L3ve69dBy=0NkJ41k|0e{53XoSA{CLw;SJc5aR3j*ksts8;7d|$Qvxl%Ov;kd zjO!$@oo3uj+Oe&*KR{GW>)<-9tZg>CS%!z)t%k3pDSJ>?h%Ynxh zg4=^0UmvmexaAGaaxm<1KlWNj@mO9R)bay)buypHrZZ%2iS)$Bl1Wng!N9;k4=GHa zohe*@B!5qzy*I8U)mT_-%`G$4^h6zV8rSk(|e|L?Q>= z9@$O8Y&HGSDRTOr1!51!5=v@F&GqNgq&J?*k!x1lN5Yw`IvQ={(j?SmhIm6Rqe7!Y4XswMhql!1 zuz3PrdZ=Oh%^r7%jOF9OfvA>>r3Y2w4u;5(nm5J3?f0;bHdzj_C;g-Ca53m1xjYy= zO1!>6wJ4iKchD@lyhhOzGHX44^D~dv{LBOH>*IQ`53}epiteD7q@%+fYAhd}0+ZbV za~QYJPfK+VSVMs|Wz&MxWXK02!rI09k4w@M)ZKX7P@=_QOBBvOFjBS`)^@ZWxoCUn zg47ThE|lvR-rB;bSQ?(ZV0oA``e zsE^2C>V_(M$Cj>onZy#QG<{;r%|&XpSgcB6lk`MsUb*_TvY9dA1@R~eeJFQEcr-=nlS6oP6N`6Lf^T&W0CDa7pSoegO`D%mQr&>c7wkHHZxgp zK0B3BQYyCYF{-sxPR-_H2_n0Kf;S;A5np68Nq}0GD;-F#X0z!m@dW5IO*f|8kSr~k zREL!0fRY^|vac#w09YCNB}UfLDTs*9B(xB4tcS@CNu~27ol#Q&WO{o;*V^x!Vp5}_ z71Z7QSOez|T1zL|*M8CbT21Ryjvv;sozQz)mW#Q(lFgGi2@y3lh^Oq*H;{p(55%*| zsG92|l6zCVMVe^lG;NV>iS@H%ygVr&v-9PN=Jm|@x`M~R`1)=^{F46A%K5Ko6C75d ze-|u2NsI|yTzRXQm~c$Aj&0q=%r7^dmLR&j(>4{g!7#bApxOBR&HOoy85Gq3CF@)8lRm@LJ^ae zG$vuI7bjX5uAo@cipFQg%_SMD7Q4Fe{(*wjBGo1NoNZRy`oAYMF0{|x^Zo<#eBuN! z+v9?ksd-c5gD#?uE3mtMhUN5a_l?xiPKs`yiR8k#P7t>zWC+@znpE>D*To#_O##dS z|CoZJ5{%RNzp*nATCcBmmV+FZCbZOGdSVPRoatjef$aBjp_*VtbGQw%@AJ?%+HO3= z@DB>&ks&OTd4LYI!c-zAm#mr#s$8Al*jI>Nb#_Yu+S1;=AC^MbFo;_`ogG#3#8+K$ zESpXy2VzQA&C^@jGd4L8SbM1bp-obJZPWICDO0F2SrB~w@}#3QU#QGh80q0?=zC9S zxqLc1r3?-dj|-S9Ce>>P)N!mB_QpkjxMSDa<2xFq25>DrG;?m^sl-*Js*OA zS|iF`cv$$XyfoX@#V4-*2rR?wUKb-3edp$_BOWiwjG0Ck%mQPT49GO-CUE17GShv( zfgh?em{+1ubwDkQvHs$xj}x_tn;$R2U3vg_s9R|Ej^ z1s>5BE;}uyg?Z3Nn@w;v80MR)oV#EtYrN>}EDe8)?eeq30xVbNh6}dUeI;#J8n#O7 zw)tTz9u2&+K-H}A<;v|I@{Be-Uu|3I*O9!9VRmhUQ(LHcEolo*dkGrk1nmD!L8H&^ z-dQ{^zI|Sszr4dz(h__VC2dZuTmzBaeiNf}iSz{MLENy!I)CHZB(GtBD>%+YDVa`> zoSr zota`|Ru?YzQcRMK4g>_m4Lvh;E+~_v8qY&p{UoamB~XIDC92$h7-1y~@$rfpX7~Xk zu{^UX{*Y+(1<7DKwT}ruYsEOUz$BV2L=CsDS=Nxl0#7_~%_ZXHn95i?5jeBgfEj4nC&KT#cRU`zmFc+yWNhJ=^LZd zd!5Cqy~-%roGO%v>sk`55!0F zxr`bkh#mSrR%g>+nZJ6|$C$f>l_*@_2?)ovnk%*2LtXnOHa}pIEY?V2^<(tWeM{T6 zM!1v71q;|ByM4OfMs2;X_sMXg5gjkjoFPlgXUSY)X6fwQ-S?4clAkHeokh!ukKBX0 z9{Tsaxwb4MP~s+{yTBjLF!lC*Xl=f)NowHJI9u25+utD7`4CsYpKovX!8OpyIjW4P z8H7Q^M=Q>*BDc0ahAj{rB?fz+BR=K@z{;xGl#4IyX8VR_UYm!FXZtX}p*{TvTCoa*GFT}*1dJkk`e>^EsPqx~Qh%3y zj%&$dibJ8L{_!G4Hx)da%Zq>r_{sLJM_xctQQ{~8C_M(rHrfmZfE|E*@i|x#Hh9;s zGY|4#s$^EqD+-Rb*_nnJL_oyH)X;S?eyXtk^tfDNJsz#s}hg_>`b!3+svS7sH0 z@*D|-pfkn<(ezk;3U#0ZA0YsXXf`rvfO3%lI2&dQ)Y%t+BP@C&L>2|+u?Y}j{nT_k zLjtmoMRq#^H3=Fv2Ap;@BhdGU0`$?lJ8b@7knRq)+aOdd_O$uobH0AObC}=|9}sRt)%vA0aDWgCCkM3cx5)faMmOK>(ZL49gKe7{Xh9NY01?08}rS zV8bS4!W<{Qs#C)%V@W7AYW*C+uO8`2`e)>!awP3 zX_1uq%K6Azd5aPg>(MK0V$YLP67vR6!QQC8K6Qgs+~H?5_`s_FjLO^A%^R(8Ik42w1q zD)6%5U;U;Hh7x*&1=l!Ja7PDo8AdVj{R|718cc6A|g%kXf0wu0i}t`pV_f=7!89<#aP!j-X{NEzlce9M_Ef3W?U z*e5sw6*btTM;w4rU39AsKlm1^4Fj=QAnQ6L?&iNfzIt3tTCkQW;Qc#Gf=9b;{G~BU$ z+J{^(R>&7UmSR!@Tp-6r$GKBj4Vbt_8-S^}TrT7pO^ne)B+!Z_ls67Xr9<23OHEs7 zMDcsh)YSySx|;21>9J`~BL1weJfTr6*MYyIh%OF|Y_hGp=@%5&2w(i__rw?I>D)07 zP6IZN#gC{gITAE^496@TOJFH-HH{76H0-@h$)=rj>!Gc5Io43*5Uz8M$LrV78_>mV zDoE}ooZp-YN}qGRB24J$zVok*wF>D%Jy!DYH~adRYUNGAfnDr|OCZ4g_qpK*66 zpWr0BG5QtR1F z{A97dvg#Zui@Z%_mM1Nqoqc$ukgTl6N^`9j58`yDY@bSq{Ia$lyms=4$TT6zTsK=N zB(^qUIt!=xoTJ>xXF9r4eDYE=Lf+MHYh_1EOTD(@Ivu4HZ+bjcZe0Jjwv{g- zbKx?DyCyj$Gl>&MZ)0)_nJ=RununZd{2WZK0u7*OYc)rR)Es?%#94$lqYnqQ*HeX6 z%UvA_!r}H9-l-d2vG7x6gjM0enZ=p2Gd$zLa>OjzppPlwZ=gD~4Btq{M5Y{>F@Ac0 zLk=-qkf$K@Wx(GR$!G61a9T4SWZ8fw;GB`Ypu6)<`rG8P^ddbn`bXvAyBIUN3(3nC zTd9yjf~zp>tS?2&-a8$ok#*Z>*>PucsgQ048wv}T9cZ6-*0CQeY8}od`bg@doz-N2 zl`61aKAM@`hVwKZ4X5AVjDQdn@FGBtW@yj5Tp2ILk*IhvGV4s>&oS%JwKE~XxYK{m zq;Kukg(nI@=W?ZN<#HhumKSx=tgQYts%P%%-+~~$Nk4V?HpZ8YBEhnlEcd#xR%9_5 zBW3EyI=8Znut*BIT|U~9by`DSJlZ86-JNT14v=tm=G5Z!3C3ABZ})}RquC1&*xlNSF77i$u=jw zBiB+ye3Rm6Qfq=>*mW#r<|vl9iDL*5mskctaa&Z7tdl=LWRWU*cGiIc)bD&$WP=vB zDk4uf6F=sGa;Acc};Vp+&ZY-?IeC1Q+ zCjPusPv$EZcWQ;z-|*AOUuni^@RH zk?nwZa6LmqpIz^oR5&L8e|D0&W+#uZgH%my=L&XX|Nrjh4Yr$VKK285f)X$C#(fq4~JAU^u)HZf#cEMM%t`A`zMAA-|e_kpac9AfgXx;hYllMpV#H+xD^tvMc+CSng4-Bfl({Kf!U7R z2WuULMQi2j1zc8mv9Q=!`Ep@#bLFX0L^$m$6NN=v<@v&5U1fE!6iHmN0VtTNS~j>qAiA`|WYlPX}W(JQLtR1)Hs4|0gvbO{w{2$ruI5RNlvKc}K`42qb@ z$hNSIqAm|eU5OIxBY8QuRvB#+}(L~ItfM89`u*WN|z^r9_sb+#gY zFK$}2O>^hK00@o`bo*Tg=<`Rr59u=yOEZK>kEnzyFby^F*qqkP)c4sDbJNZb_a8Bb za9{|V2+EYXs4;0Zzx)A%Fm0~Mn&u27LSFk_(gr+b`(=5QoN&C%`EG%z8B1pF@Os^_ zqhNdP)!9!h65FDb(H ztE^6xBHTUwdgPJ=O7uK$e`xN3+30f@tp5~=JqFETHyE_bVMj@8Ek$BtglfG*)X(vH zjx{Am?JPx$rLuYxn+A$FTVdn=^@ec?8(072=}0-sdMrd@&S=SDF0&UC3kzxCt8w0j zk66d3S&ypfAcL%JF9sPb6|1ALRZL=+Vik?GtH23sbrq`}SglL%C%qF{xEyxXEGC3u z*f9_vMtUP=yy3i2T8qTE$YH%YiHe}z0UY$1d&KBvE7m9dWfg#GMrRyh*F>(z5oydE z7Na7t|37d9^v5j(oiv|~L}S7pn511SwM1-@a_h=aK{{H1SMg+tvu|bpqP=on6uU=Q z!+Fv0$YN9F310sx5n=wFw%(AK?K<*cV(-hiGVsbU98@w09kRYxzZ*1xFk#a|L^&qM`Kt&;W zsKcOrsA~lOBjvcVFS@!NPuo`_%50&l%NfVGaYfLg1f&bVjc2ht%TNd4WNx_2;x{k5 z_<_#Mg0rmMz@W-+!mvCft5ae)x4`Lx>G_Lb=fKo}Ko*wB-53S&dN|(3O&VN^dUT|t zSk1Q@;S%czBM<;~v6*lSD}ZTWM>4F4po?8>$*M#A6qKdJs}~Ra$n^@qM5fitk3bld z5?=@bEz(ZJhhsXVEq!oslgNwu{6(Usac=8z@nATLbNUfBDNbkL5a=r+K9`HYDB=Lh zPYxp@$|JMxHcBvDBIAQtBcw;?IGsQOP0QwSI*kN24qA}h)bb+T=SK36AK5YkS!CDb zkQzryHl^PXaKp%gxTCx`Fc-mB?JJHT%vXeRo|?M_GUx=xXyfe8frms@Ej857EFdm= z%E-pBJs=9zx8Pv~EAD0d;n?0i#E+aFznR1dc4B&I2}fkdXUK`!>7|o1g&yKX4D#Te zdu#8ZBH_f@EzFf}qrGG-uBpkv9P9=1R(hEyLG&CI2+yuZ;m|J+I^=WdtlkTD{m(Yx z9F)s7|KUot-c&7b<{B>ia-5b5or*tFkT&Qg6!Z7Ptu5BNvAN1xJO5hTGI~K=_W7nb zXrAp#@{#xt_W&TZ#TG0gC?93Jw)Mv;qxsAcD-C>2=;!kEhR zB!{ug=s^F7vm~w}PN1jy=cF2fgJ?ZGfai|ss}9W)L;LCh(WF3A1sWp=BEUzlXUD*vELP3#j{b?mB$ z%X&CmG6Hb%6fkS6Tgq?&QfG;}?x0c^4= zPF8RSv_`HF{g||>IbgmHv3hZDJD;D5rAKj%495X<;;wZnP4C}t&#*hbJpT;mi)3(s z#7|jxHIzHcaFk@g8Jd|6H`+%P+y%=KdTx4h*3JS9F6(R+Yz+2fd2M}FyKyL^f54n& zU^kko_>GdCUODck<&!tky(gTKeJymI_W!j*3aHV-_W*EWwy6fH+~{B!Ay*u{x01`pP1d{`{1O+ z{}SfYug-SS@65{QrrPP2xvg~D+)kJdJvyq1CpO5?#z3P+x^jkbHilq_WgBnpgKst1 zUK2SO4e_E5F~+KO*72`&eZsJyIqb^vX@j%)e+y?$&73$px4hJYX1EneTn^k5W+pMu z4hh63_MY_8;(cW9ZgO^Zh7@K_EKZ-EW*?EcGh}gjx-e5HvhR^e!$~)It7EV(H2i=N zE3Mt9v2cOT*ITs#n%CK_u^}7+Vpc9rYj@6lvW^CpchJ|CcGJ?5gMR;>7CbxY+e@41 z%*XvPGp#K-umn1+aZX%PdRDiOrs5_1N6YzE~^~mjk!~uXjD$M(NCP(MW0&ULcelq zzs>G(^VWYk)k)7Sx6;;od$!n(VUaCllODde-Rkwyfiqq7llQjPG>d^(?-if^^4@Mt z@L%_O=@*t8Y3Ot>-lk8x>A}-m=oe4##oM<}v$oCDcBT(+2hQxI{b!nK@N6?poauCM lVpR8Lr>D;3*-%@MwAQQb^k=BM;cQcb>}N!>(?e(9`yW!!KN|o5 delta 8932 zcmZ`<3vgT2nbwsY$957&a+EkRNqpiwoy3Z+boH>BW_9)Qy|OF`Nq&VCNKnAB4dm4( zysE@WfF0VU>DfSelon`9UvwNRo-MFjLD`*F=~Bb&w$lvT1%_eDc81n;I_>UuTlPEW zTs=%uW+I<+?s@#@e}4aec=ciPOTU)BFl;Ask9zoMkIU&&h_g4Kcmf{z{Dl8HZ?ChP zv~;=Uo`L_V~6gzjU2jzbj1b}2~t1N;c#@3{Qlzy^Vi(L z5>yb`Uo;hpr!%QEaVt(Tn2Y%xAw3yRMWV#z zRY+enmy3?%_yk#&dg-o)>*%`;*B6{_k{t|Xb70s2ar@CTnm%8(>2Xz?inrR7YZGL- zGV1cznm$i;)YD5qUNoEwje@DJ+J^LvMJLU&r`X>(AvI;S)L1Tt z+~@?Gf7CyF`Ox%_imx`WkqQc_975c^u8%R!=O+8o(P%#yN8BDoaFGp!86RU9bT8zj z8@%5aQp5dB=hC?harO4rws0xzT^^$>T<3NbWUN7UmMOIw&%#yB~z{Z*YTniZG zc2zm=sx@W5v%*-}hYJaT$)2k0WZ6T)nwm+ZQvF%_hb2D9+p)Ag(<_s0PAgSKbqCo!JnK zmz&1LX#dO#&Df|qs6y`aa#U-pZT-HPi1%=*ei-5z#ZbQQ~&e;EDG2;M_hvk%;!G35S~LgFC769qpo{^(Kj4 zSbn~^-THHhHnqLppk_vg>3_7{S%@YhBu0864mFeOCQ@qAB9k=S%I{#4E!ynOgSpCxhG( z+|pXohgdsf`qwIwzNJo>y z#3FlLwCB@nHp)t`VT-UnrF!dh2JRnP$P60vw$r(u#^o|xGP7iOUDE3z^qo)J?f&YL z$~}AvU+~m*jS``6*@;;ZI}}!VEpRx+@2{F#BxQ@ASlc57Z)Qr^ndf4+n@UE*ToRHQ zpBu53#`E)I^GrrASdp+rP0!|1nNc+oDPCH)UD}19k%-1}keZ(a`VJmPLnik&SomyX za&#z~%;iSY(T(>O-&=o4Dx`^%Fb?NbJwbGM9@fdC<*eMXo0tY9=7l(woFuM2)Aqbg zG6glWq)A){SD2ws9|)fmtf}y&6+v+!zLfvq9&oOVuAZDDjrbZ%Wd_t7fn4f?smHUR zs|b$%iL^#sBt2LcbUg&XBAUrUADm>Lnucs6F8CA#=epfJxM}Sy56y0fF5}LYsU?f< z^i)Sj;W9j~RB^D(xzuhlDvbK`dFcl2r>jc+<8u%e?);%v?%123V7-ZPh$$|NTIVb0 zi}&cSGWmX4kMqly;#fTG)Gc3$>ymDkW-a5o8Goz~#C136nzc-f^My;# z{IVS`&vdsF<)xwuldrI_lwmfRrq5j6}Ol9)O|8|BAA_Ix}MPYMmgDl3w0h$3<2jEf?43} zyuQkCMIIswd+BdCucB+W1k6qs{lb>-#x7VSlVo$6>x^)uu05K6EI$_Hmz~|9aozl) zHruW}DTwFSnQh9_&urZ;HPdIe?vP|Uw{;zUKiImyAUnMzDV&^(_!k;1aIHc3U{b$+ z5L#BJPcZJPayep|)PN(FO2XzD*fH=_-7w$;`z#J3NF|Jo3uzU0UfUKxBbx*2tyeAR zP<@wa8nmmbX>NC|4WwTkhqn|G0v=Td6FEn0AeT)?!vydWZdCL(g@yMd@c1A_2{mlVman^D{^3?cH}QvIL` zjy+I9*KeZX9XpyCAjppae-tNov`UsSdu#FZ&c%|`>#Rn$3QQ9y%~Qi~18RRXjf{YJ zdfi6cT3qnLp0m-M8b-9v5)TrEeTZVwOj1o4{udd@KES?IID~)w;F||VSmBQc@!i0~ z9=MKBDhJS~_<&^vyNJi_C$UI$h$!F(~PPUK+-O)R&7GK}Q-S#Cv82u$J@e#7N;F>zIWhaoT55@-dF zkFwuIOOBOZ=z-`1TU=v-TLe!8PIeDt7uiRKfBC*_dU_iaZBfa*`BeLQIW%DkO+=ah#v!UcyqC81$r`!vSy$e#K1>_pUO# z{q&W4?QO&l4%Z~*cX{addRGsaZc?rPCg zERFCcv-HL7t>IgCZNyCW8HuUa%dc5U@G4oU*P}4c-{4h%5r5OvzRU|RCQgC8=xO)L zf>$WS1F9w(084e0GxLhUJga__ksMCI zsxXS=luwP-Wu%^3%w|(rn(jdw!1q>QacmHV?ctsfMsC=Hg1}6lw5?vQC;MQ|eiDYs zf*%-LyH;VATvHT?h=~HZzT$DyJCCn61JS(_SlOV!80ah3mCF^T^6VrbpyJ%_cg-{y z)Yso+X1>&j>&)85QN_uNen$)aO0aLg@Cp?n)XwrbSuD`htVU{AWORs(2Ko$gSwE+S zkWfH_Y8@yHqlN)}mrU1hT1TfN4fIp$TQnGoOG)}rXwB}8L6t+a8oDhR_@K>ZGwZVr zE3A3TGcS&vkzUlzFQ^6voPHk=*iHWu+HF=m#i8(x5>1>~LMQvYTQcw~RRC(-c`Z7K;P z_%#pwkJMKDzk$UTyPxn^#aa+rl(J>H#z`q`<2UtX^dL zHNQRo5tzajvpgk(p*2ruXpXKN%zDABaY2pnz{1QH*1iKKp=C zsSA#AH2n0~0|WWw{LG2cp|(p$P{u2_jA}v7`5*^uWAlgRpAQO5TnbLG5US6nK2Bkf z2isb{rIs6C%*XAGCAGZtr9!^n-cZVG_STQ(VTY{crcWWSzT65JKJz`jY_-{%^y$_7 z9yeK2t#)fEW#wNlq%e2({T0&>nzp%WHdss8h>U1um_{gvR9oj2Q5o^DU<@ySek?sT z#up^wGAby>II^C^r~|6X?5heOAw(lR7jcwnO6@>siwh}&2sbVmAL5}OXbQeO5IHz` z@c2Ox+RIFyTk+L7B=T<`VbvKHQ+H-NGN|zg0tqfyI~;(Z)&WWsC!#P=8%0p5b>NtJ zt%sT2&g`1zsvXjAXU|CAppM)h_nbAPn3ywJO8F$qo0$wlW#uM_4&qo^8Yo+DvZ8H; zXpo;-F=dVI!K24XukUI_L*>t?RuI&4uHFe@@ajQCoj}GQ965hw zf1UzB|Le6FFCf?00BFG2bt$i~@S+Lxj(ayZIvMH;)8)B!`%FQUMJypMMBxwJHmj-9 zhm&|D#B-_AeyD}h*Yk(GPia3>Jtc-(FGDk);ZpBdkim3&UwW!V1H6OJl@K*GEeq#Px z`APHq*VrS{L|n=W0+R<_^uiP%&g1`sk|oU!=p$?f%y#pNCW)30H`ZXh_TwN zo(VC%4c)R7&`!ybd8aqTtu`R&ThXWC1_(0OQ|4dq&WE?_O`Z5K`N2;TnHS%lAe zNz8gA7%JF97fsJs_IwIk8WGIC`=aSWb(%eL(eyxN*37B}C!>_Dw@r^#=1$B7oYQ+N zbH9wKdCRl;^J5+Mw&}2#G}9fbfV;wc(HRW!3oh7{!MwIv=U@&u~EFosrQvg^p#Lu27g!ma+s)`@^<3jP{fnkCC zWeB-W{xV)YQGyxZ3V^2vUXL=mP$qw!b|3%-4fQ}yQ?DKj?=davNhK3_Z9{NHhqtR? zgWDr8+KI_6n<_V|yh7H(1*;W|@L)lAk!! zI=pznr4#v`^xWZpp@T;{Thi=N8Z09%^s`5_i zWLMMQpWN0~d94-UIGRGW*>RVjK6_UiCeGd^(_h`S0j;LH*HOpatD7q9EIxM6=NjlA zPdVx9_cbl}xBQgN=r_|-rx($uPx)7nbV^S`@+~BmQ2Y1~?L74fN=_}Jf4Z-kUb$~6 zeg4#9oFku-F}i_1ecEnraZ-6|1udW6LtRrV%ualrvQy{O9{SMK@!km9e>1jgqQ5-LZv2<& r+STEDIT>TEDIT-STRESS.;70 15296 +(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}tedit>TEDIT-STRESS.;71 15583 :EDIT-BY rmk - :CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK) - (VARS TEDIT-STRESSCOMS) + :CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM) - :PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}TEDIT>TEDIT-STRESS.;54) + :PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}tedit>TEDIT-STRESS.;70) (PRETTYCOMPRINT TEDIT-STRESSCOMS) @@ -25,6 +24,7 @@ (STRESSHC [LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP) + (* ; "Edited 21-Oct-2024 00:26 by rmk") (* ; "Edited 19-Mar-2024 21:33 by rmk") (* ; "Edited 14-Mar-2024 15:15 by rmk") (* ; "Edited 13-Mar-2024 00:23 by rmk") @@ -83,7 +83,7 @@ T)) (CLOSEF? TSTRM) (CL:WHEN SINGLESTEP - (HELP (CONCAT "Just hardcopied " F " to " HCFILE)))] + (\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))] (PRINTOUT T " Hardcopied " N " files without failure" T) finally (RETURN (LIST R N]) @@ -121,7 +121,8 @@ T)) finally (RETURN (LIST R N]) (STRESSPUT - [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 19-Mar-2024 21:34 by rmk") + [LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 19-Mar-2024 21:34 by rmk") (* ; "Edited 12-Mar-2024 09:48 by rmk") (* ;; "Opens, puts, reopens and tests for equivalence") @@ -142,13 +143,13 @@ (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1") (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1")) (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP))) - (HELP "Get of put not equivalent" F)) + (\TEDIT.THELP "Get of put not equivalent" F)) (CLOSEF TSP)) else (SETQ TSTRM (OPENTEXTSTREAM F)) (TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1") (SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1")) (CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP))) - (HELP "Get of put not equivalent" F)) + (\TEDIT.THELP "Get of put not equivalent" F)) (CLOSEF TSP)) then (CLOSEF TSTRM) (add N 1) @@ -242,7 +243,8 @@ (DEFINEQ (EQTEXTSTREAM - [LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk") + [LAMBDA (TS1 TS2 STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk") + (* ; "Edited 11-Mar-2024 16:53 by rmk") (AND (IEQP (TEDIT.NCHARS TS1) (TEDIT.NCHARS TS2)) (OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I)) @@ -255,8 +257,8 @@ (AND (IMAGEOBJP C1) (IMAGEOBJP C2) (EQUALALL C1 C2))) do (CL:WHEN STOP - (HELP "Different characters: " - (LIST I C1 C2))) + (\TEDIT.THELP "Different characters: " + (LIST I C1 C2))) (RETURN NIL) finally (RETURN T]) (SYSOUTRING @@ -293,7 +295,7 @@ finally (CL:UNLESS NORECLAIM (RECLAIM]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) ( -STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695 -)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271))))) + (FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) ( +STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864 +)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558))))) STOP diff --git a/library/tedit/TEDIT-STRESS.LCOM b/library/tedit/TEDIT-STRESS.LCOM index 3b9adf97bb98667b83351c8f605f5894a86fa6e5..27f0a84aeb393ee125494c0695369fd6f8e5a794 100644 GIT binary patch delta 415 zcmX>a+8;V0T*Syw*FU*L*T}%gM8Uwo%E;Wx#C&45ie5=-N@j^&h^vcdh;DF5kZW+T zp0&B5rUI9ekpV)7k&%^=rIo4q#J#HZ0ihuZu7M%05g{P;j=l<+c?wEyp*}te$U5}& z^pq61QWAmYE1(-?Y+z+zsHDlI;pXY%>I^gkXgyF778fchREPVzy7;(8*4pG`CKV+X zRm$37cd~+^si}qWV>fhHFus63n}UldE-e3>bog(C(WhI%2Jt=K1UA$X?*J(&?aVbQ6A2;K@c GSr!1=nR00W delta 442 zcmeAVJsLV8T*S~)*Eg|9*T}%gM8U|=%Gkup*mz>Lie8ATi)V-(nA8mp333e%*0VM@ z&{W`3GBii%FtoHXwFGLKxL374$kES50irY@Gz7}>4{-H^GJ{+lT@<*W3S3>i6*BV_ zl-xpnd=!vP)YH>bQbM&^Vy$fQq0Vn0%d)Pp>-M*VV6yuFWlip3IxCicA&UT%;z; F0sx{QdX)eG diff --git a/library/tedit/TEDIT-TFBRAVO b/library/tedit/TEDIT-TFBRAVO index 98f2b06d..0f95ea72 100644 --- a/library/tedit/TEDIT-TFBRAVO +++ b/library/tedit/TEDIT-TFBRAVO @@ -1,15 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Mar-2024 18:27:18"  -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153 91304 +(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;163 92210 :EDIT-BY rmk - :CHANGES-TO (VARS TEDIT-TFBRAVOCOMS) - (FNS \TEDIT.NAMEDTAB.INIT) + :CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS) - :PREVIOUS-DATE "17-Mar-2024 12:41:56" -{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152) + :PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;162) (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) @@ -124,7 +121,7 @@ (WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72))) NUM)) (NIL NUM) - (HELP "UNKNOWN DIMENSION" DIMENSION)))) + (\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION)))) NUM))) ) @@ -303,7 +300,8 @@ (SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC]) (\TFBRAVO.READ.USER.CM - [LAMBDA (USER.CM) (* ; "Edited 18-Aug-2023 22:26 by rmk") + [LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk") + (* ; "Edited 18-Aug-2023 22:26 by rmk") (* ; "Edited 10-Aug-2023 13:02 by rmk") (* ; "Edited 7-Aug-2023 12:52 by rmk") (* ; "Edited 1-Aug-2023 22:11 by rmk") @@ -330,7 +328,9 @@ LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) USER.CM USER.CM.RDTBL))) - (RETURN ALIST)) (* ; + (CL:UNLESS (ASSOC 'DefaultTab ALIST) + (push ALIST (CONS 'DefaulTab DEFAULTTAB))) + (RETURN ALIST)) (* ;  "If the '[BRAVO]' section is the last one") (COND ((NULL LINE) (* ; "ignore blank lines") @@ -378,7 +378,9 @@ (GO LLP)))]) (\TFBRAVO.INIT.PARALOOKS - [LAMBDA (ALIST) (* ; "Edited 13-Aug-2023 11:27 by rmk") + [LAMBDA (ALIST) (* ; "Edited 4-Aug-2024 22:17 by rmk") + (* ; "Edited 28-Jul-2024 21:36 by rmk") + (* ; "Edited 13-Aug-2023 11:27 by rmk") (* ; "Edited 8-Aug-2023 23:51 by rmk") (* ; "Edited 7-Aug-2023 14:59 by rmk") (* ; "Edited 31-May-91 15:26 by jds") @@ -400,8 +402,8 @@ (SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST)) 0)) (SETQ LEADAFTER 0) - (SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST)) - 36))) + (SETQ FMTDEFAULTTAB (OR (CADR (ASSOC 'DefaultTab ALIST)) + DEFAULTTAB)) (SETQ FMTSPECIALX 0) (SETQ FMTSPECIALY 0)) INITFMTSPEC]) @@ -491,7 +493,8 @@ (DEFINEQ (\TFBRAVO.PARSE.PARA - [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 14-Nov-2023 13:03 by rmk") + [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 14-Nov-2023 13:03 by rmk") (* ; "Edited 7-Nov-2023 21:53 by rmk") (* ; "Edited 21-Aug-2023 23:41 by rmk") (* ; "Edited 20-Aug-2023 22:48 by rmk") @@ -540,14 +543,18 @@ (^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC BSTREAM TEXTOBJ)) (SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PSTART PLEN))) (NIL) - (SHOULDNT "Bravo paragraph not ending in ^Z, CR, EOF")) + (\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF")) (create PARA PARAFMTSPEC _ FMTSPEC RUNS _ RUNS FORMATPTRS _ FORMATPTRS]) (\TFBRAVO.READ.PARALOOKS - [LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 9-Sep-2023 21:40 by rmk") + [LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 19-Dec-2024 23:42 by rmk") + (* ; "Edited 21-Oct-2024 00:27 by rmk") + (* ; "Edited 27-Aug-2024 21:59 by rmk") + (* ; "Edited 28-Jul-2024 21:39 by rmk") + (* ; "Edited 9-Sep-2023 21:40 by rmk") (* ; "Edited 21-Aug-2023 21:43 by rmk") (* ; "Edited 20-Aug-2023 15:48 by rmk") (* ; "Edited 18-Aug-2023 23:08 by rmk") @@ -560,55 +567,55 @@ (* ;;  "Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC is used just for its tabs.") - (bind LMFLAG 1LMFLAG COMMAND TABX TABNAME TABDEFAULT NAMEDTABS (NEWFMTSPEC _ - (create FMTSPEC - using USER.CM.FMTSPEC)) - first (CL:UNLESS (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE) of OLDFMTSPEC)) + (\DTEST OLDFMTSPEC 'FMTSPEC) + (bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC + FMTDEFAULTTAB)) + (NEWFMTSPEC _ (create FMTSPEC using USER.CM.FMTSPEC)) + first (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE)) (* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?") - (SETQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of OLDFMTSPEC))) + (SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB) + (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB))) (* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ") - (SETQ NAMEDTABS (COPY (fetch (FMTSPEC FMTUSERINFO) of OLDFMTSPEC)))) + (SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO)))) do (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) (l (SETQ LMFLAG T) - (replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T - 'MICATOHALFPICAPOINTS))) + (FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS))) (d (SETQ 1LMFLAG T) - (replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T - 'MICATOHALFPICAPOINTS))) - (z (replace (FMTSPEC RIGHTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T - 'MICATOHALFPICAPOINTS))) - (x (replace (FMTSPEC LINELEAD) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T))) - (e (replace (FMTSPEC LEADAFTER) of NEWFMTSPEC with 0) - (replace (FMTSPEC LEADBEFORE) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T))) + (FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS) + )) + (z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS))) + (x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM? BSTREAM T))) + (e (FSETPARA NEWFMTSPEC LEADAFTER 0) + (FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T))) (y (* ; "vertical tabs are supported") - (replace (FMTSPEC FMTSPECIALX) of NEWFMTSPEC with 0) - (replace (FMTSPEC FMTSPECIALY) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T))) - (k (replace (FMTSPEC FMTHEADINGKEEP) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T))) + (FSETPARA NEWFMTSPEC FMTSPECIALX 0) + (FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T))) + (k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T))) (w 'HardcopyMode) - (j (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED)) - (c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED)) + (j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED)) + (c (FSETPARA NEWFMTSPEC QUAD 'CENTERED)) (q (* ;; "Profiles are marked here but then interpreted at the top") - (replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with 'PROFILE)) + (FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE)) (%( (* ; "Collect the named tabs") (SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position") (* ;; "Tabs apparently round down/truncate, not up.") (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) - (%) (SETQ TABDEFAULT (FIXR (FQUOTIENT TABX MICASPERPT)))) + (%) (SETQ TABDEFAULT (HCUNSCALE MICASPERPT TABX))) (%, (CL:WHEN (IGREATERP TABX 14) - (HELP TABX " is not a legal tab-name")) + (\TEDIT.THELP TABX " is not a legal tab-name")) (SETQ TABNAME (ADD1 TABX)) (* ; "Adding 1 to align with t1, t2...") (SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (CL:UNLESS (EQ (CHARCODE %)) (BIN BSTREAM)) - (HELP "MISSING CLOSING ) IN TABSPEC")) + (\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC")) (* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete that the named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.") @@ -618,23 +625,22 @@ else (RPLACD [OR (ASSOC TABNAME NAMEDTABS) (CAR (push NAMEDTABS (CONS TABNAME] (create TAB - TABX _ (FIXR (FQUOTIENT TABX MICASPERPT)) + TABX _ (HCUNSCALE MICASPERPT TABX) TABKIND _ 'LEFT]) - (HELP "ILLFORMED BRAVO TAB SPEC"))) + (\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC"))) (SPACE) ((CR \) (CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;  "If there was a Left margin but no firstline left then default it") - (replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (fetch (FMTSPEC LEFTMAR) - of NEWFMTSPEC))) - (replace TABSPEC of NEWFMTSPEC with (CONS TABDEFAULT)) - (replace (FMTSPEC FMTUSERINFO) of NEWFMTSPEC with (DREVERSE NAMEDTABS)) + (FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR))) + (FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT) + (FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS)) (CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;  "Read the \ separator, but leave the terminating CR") (\BACKFILEPTR BSTREAM)) (RETURN NEWFMTSPEC)) - (HELP (CHARACTER COMMAND) - '" is not a legal Bravo paragraph-format character"]) + (\TEDIT.THELP (CHARACTER COMMAND) + '" is not a legal Bravo paragraph-format character"]) (\TFBRAVO.CREATE.RUNS [LAMBDA (BSTREAM PSTART PLEN) (* ; "Edited 14-Nov-2023 13:01 by rmk") @@ -654,7 +660,8 @@ (SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN]) (\TFBRAVO.READ.CHARLOOKS - [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 9-Sep-2023 21:39 by rmk") + [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 21-Oct-2024 00:27 by rmk") + (* ; "Edited 9-Sep-2023 21:39 by rmk") (* ; "Edited 20-Aug-2023 16:15 by rmk") (* ; "Edited 18-Aug-2023 20:11 by rmk") (* ; "Edited 31-May-91 15:25 by jds") @@ -709,8 +716,8 @@ (SETQ LEN PLEN)) (* ;  "Otherwise, PLEN is what's left for the final substantive run") (GO $$OUT)) - (HELP (CHARACTER COMMAND) - " is not a legal Bravo command character look")) + (\TEDIT.THELP (CHARACTER COMMAND) + " is not a legal Bravo command character look")) finally (* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length") @@ -1087,7 +1094,9 @@ NEWPARAS]) (\TFBRAVO.RUN.TABSPEC - [LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 by rmk") + [LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 27-Aug-2024 22:02 by rmk") + (* ; "Edited 28-Jul-2024 21:30 by rmk") + (* ; "Edited 15-Mar-2024 19:42 by rmk") (* ; "Edited 22-Aug-2023 16:54 by rmk") (* ; "Edited 19-Aug-2023 15:47 by rmk") @@ -1105,41 +1114,43 @@ (* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1. t0 doesn't match.") - (LET ([LASTTAB (CAR (LAST (CDR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC] - (TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC)) - (TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC))) + (DECLARE (USEDFREE USER.CM.FMTSPEC)) + (LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS] + (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO)) + (TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB) + (FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB))) (RUNTABS (fetch (RUN RUNTABS) of RUN)) - TAB TABSPEC) + TAB TABS) (CL:WHEN (AND TABDEFS (NULL RUNTABS)) (SETQ RUNTABS (CONS (CAAR TABDEFS)))) (CL:WHEN (AND TABDEFS RUNTABS) (CL:WHEN (EQUAL RUNTABS '(0)) (* ;  "If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.") (SETQ RUNTABS '(1 2))) - [SETQ TABSPEC (for TABNAME in RUNTABS - collect + [SETQ TABS (for TABNAME in RUNTABS + collect - (* ;; + (* ;;  "For t0 we try to find the tab after the one last used in the previous run.") - (if (CDR (ASSOC TABNAME TABDEFS)) - elseif [AND (EQ TABNAME 0) - (for TDTAIL TD on TABDEFS - eachtime (SETQ TD (CAR TDTAIL)) - when (EQ LASTTAB (CDR TD)) - do [SETQ TABDEFAULT (fetch TABX - of (CDR (CADR TDTAIL] - (RETURN (CDR (CADR TDTAIL] - else (GO $$ITERATE] + (if (CDR (ASSOC TABNAME TABDEFS)) + elseif [AND (EQ TABNAME 0) + (for TDTAIL TD on TABDEFS eachtime (SETQ TD + (CAR TDTAIL)) + when (EQ LASTTAB (CDR TD)) + do [SETQ TABDEFAULT (fetch TABX + of (CDR (CADR TDTAIL] + (RETURN (CDR (CADR TDTAIL] + else (GO $$ITERATE] (* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.") - [SETQ TABSPEC (SORT (for TAB in TABDEFS collect (CDR TAB)) - (FUNCTION (LAMBDA (T1 T2) - (ILEQ (fetch (TAB TABX) of T1) - (fetch (TAB TABX) of T2] - (SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT TABSPEC)) - )) + [SETQ TABS (SORT (for TAB in TABDEFS collect (CDR TAB)) + (FUNCTION (LAMBDA (T1 T2) + (ILEQ (fetch (TAB TABX) of T1) + (fetch (TAB TABX) of T2] + (SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _ + TABS))) PARAFMTSPEC]) (\TFBRAVO.INSTALL.PAGEFORMAT @@ -1220,10 +1231,12 @@ (DEFINEQ (\TFBRAVO.ASSERT - [LAMBDA (X Y) (* ; "Edited 9-Aug-2023 10:32 by rmk") + [LAMBDA (X Y) (* ; "Edited 21-Oct-2024 00:27 by rmk") + (* ; "Edited 9-Aug-2023 10:32 by rmk") (* gbn "19-Sep-84 21:39") (CL:UNLESS (EQ X Y) - (HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))]) + (\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y + " was found.")))]) (\TEST.CHARACTER.LOOKS [LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk") @@ -1332,7 +1345,9 @@ (DEFINEQ (\TFBRAVO.ADD.NAMEDTAB - [LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 9-Sep-2023 21:44 by rmk") + [LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 4-Aug-2024 18:05 by rmk") + (* ; "Edited 28-Jul-2024 21:29 by rmk") + (* ; "Edited 9-Sep-2023 21:44 by rmk") (* ; "Edited 18-Aug-2023 18:42 by rmk") (* ; "Edited 15-Aug-2023 00:26 by rmk") (* ; "Edited 13-Aug-2023 19:56 by rmk") @@ -1344,38 +1359,38 @@ (* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ") (* ;; "") - (* ; "") (* ;; "THIS IS NOT USED, TO BE REMOVED. RUNTABOFFSETS DOESN'T EXIST") + (NOTUSED) (LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN)) - (TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC)) - (TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC))) + (TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO)) + (TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)) (TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN)) - TAB TABNAMES TABSPEC) + TAB TABNAMES TABS) (SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS)) (CL:WHEN TABDEFS [if TABNAMES - then (SETQ TABSPEC (for TN in TABNAMES eachtime (add TN -1) - when (SETQ TAB (CDR (ASSOC TN TABDEFS))) - unless (EQ TAB T) until (EQ TN -1) collect TAB)) + then (SETQ TABS (for TN in TABNAMES eachtime (add TN -1) + when (SETQ TAB (CDR (ASSOC TN TABDEFS))) + unless (EQ TAB T) until (EQ TN -1) collect TAB)) elseif (CDR TABDEFS) then (* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ") - [SETQ TABSPEC (SORT (for TD in TABDEFS collect (CDR TD)) - (FUNCTION (LAMBDA (T1 T2) - (ILEQ (fetch (TAB TABX) of T1) - (fetch (TAB TABX) of T2] + [SETQ TABS (SORT (for TD in TABDEFS collect (CDR TD)) + (FUNCTION (LAMBDA (T1 T2) + (ILEQ (fetch (TAB TABX) of T1) + (fetch (TAB TABX) of T2] elseif (EQ 0 (CAR (CAR TABDEFS))) then (* ;;  "No name and 0, make it be the default. How else would we decide where the second tab goes?") (SETQ TABDEFAULT (fetch (TAB TABX) of (CDAR TABDEFS] - (CL:WHEN [OR TABSPEC (NEQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC] - (SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT - TABSPEC))) + (CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))) + (SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT + FMTTABS _ TABS)) (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ))) PARAFMTSPEC]) @@ -1450,18 +1465,18 @@ (AND NIL (\TEDIT.NAMEDTAB.INIT)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 ( -\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM -17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) ( -\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 ( -\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651 - . 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) ( -\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) ( -\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) ( -\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 . -74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) ( -\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 ( -\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB -88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE -89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136))))) + (FILEMAP (NIL (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 ( +\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM +17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) ( +\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 ( +\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896 + . 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) ( +\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) ( +\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) ( +\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 . +75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) ( +\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 ( +\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB +89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE +90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042))))) STOP diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM index bf118a3a7103a45716b1fe40d4e569b5537cbc65..eb3077bb16d1cc08999d146ca88217bf8c96b27f 100644 GIT binary patch delta 2668 zcma)8U5p!7750piW#eQmuQQ&k+*NYoX0vO`y7TAXBC->E+?~WT*R^M}Nm$}!cb4vM zoZWW2hz5cTeL|6nnhv0ffCRJ(hzH~!EI~@@w+bVqBGIaV!~;?#Kz*5lcx=p>vG-4@ zRQ%w3&bjB_bMAM~`R=^_9`)NlQLkLArKfYtOVa`;NFazANzBC45txcBZQOWnwYqG= z#yUjc>+_nDD=3$~@%ifN;^wu@n_n=LoNDy{r;YsCl6-;0p5hZ?6nqhW&z^iTBXSuY z_gvgu-r02d#pgC(n8?6_VMR=~wu&+GbAxVvZh^xXa1$wOKYc+TolICFO!j=E~DK3&T)t6AaNw0SDGP6J%*V zVXX%*7ZW_>mcM-MD^=s#B8YKrpl!LTn1GB(@Zjr`}S*1|4itx7;o(C0*kOW=EdUo?E zLc&SRG2l$xkuRbkL6&HmtmjY`fiGzJg8Vef0_=!9=*s+d%p!2k(wvf)=L&}Pos-9F zya01$r4-9*v4K|<=x-mPJoL@raL~k`eQTQSbJ!GtQ-6F zOqV_6xK;ce85YcH)o!w#)%&Wv>iQmb<`}yELDjUIq189hUfVO_ssEv1R=;L9na=(d z2kNcri}qbKy3rY5{dII)b{*H4VaK~aF;u@@y@_UZjTzguh8w*t^uLZVcZ_$ge{=1f zu%}V$U9NuB#(Fi-W6i$XQQd@?K%*yDm+T+xsscJZzw0pG=s|VL{%M0^2GJk5M~>P} zt)rRVW~wvF`Lz0HO=^@nOxO+Q>>s-51S^3K3APWBz)HAQVO}DE)0JR{_O{*| zwDw_rB~1L`ik}*!DE%KfK9ZvKWKX_R2J;!6PqQeu;wxYBxaG$hN;L{dNFmyWQ4#|W&#Cd0+MC-%^ zYc)`v=J|J<);jz2{0tQ5ea}JFz*#C--aNx5dpvSqnvZ3Zx z)Oh4uq`L#ab8$!TLW+0B2#Cp@^?Vv`9q0aOX5AsIHzB61f1i%i@w644 z96ugMe8hN6NG6jhkkTpN9!(Uj3zHE_vTjZu_a}BIL^08NZF0psyp34%iTjbD%RhT* ztZcobmCryPdG%2u^8C|}L?m}Pw?Zhn%gQd-jCW%*G}R|2-{`4>*1R66`E+ml2=NCW zjB>+jeS@knDoeK$gjutjGwSHc5yDo+s7km)#=O4@&5|%}H;>KZa8M zuh@E`O1Kh0GSlfR^*2cHG&XMiza~Y$Mf~kyY^6%zTl#67$KL&rCIO2g$8zR5 ztaMXjxDLL1c<(#c2m+UcGAS9z>;<`O;I#_8_~;ejM~?N(a%j?dD|x(dx9SUooG;@F zNC+^6)+of|FvUfqKI>mY;{oXme zPP=vDs*{uK5>+2P9no8)&$<@bg^{slv*aKD~N%WB2Of*4oq7+V-Npv%Y36UfC#F8`p&eY4O>e-L3NWQ}dmj zMXUVe?%MA4#cLa-^0h@%O=;%5nLd?Q&KL`yB9br%zG))Q2M5_PHBC_Ra&y9dvpiaX zGGN+5-k6Kt*n1<3Cp4y4;J4h#7nx6AT(weR&^QwYb!AUXz^*j8p9mW3lmLN_9 zUbLTMCLcPZ(GQ&{MS>ZA#gB&6v7gLyjV z!@?TF?7v2sqCFHS&HidLpzRISJnu12dGN3GwVLOa#%%eVMStf5`^CWfM|?{GPec%? z9T-18uJAlhLEs5o%qER&k^+rO_KhI-Nf9pgzV&I<%qe*#QvfPPKXRMI?AyWff)Im5 z*2rfR9Rxz4pd}Jny`Y+p&FAt)QdLv)Nu{6yjSM#-PnkXb4c z$Y@E$G;)TPHF1MR!BkEa@NSEc-r2r}mr3dxQVh~Y)&wF_m`MPkF_^gkgz)yzn9Ne% zUL2cZ6WhZNf!HD5NuHA*UwsY})u7_rmb8 z!jiG7r`)rNom=N@Km2@6hOClNQ*JpqaO+B`X=PP6AqSFErsGFjbnLTe2!OXHqhwQP zQy_XKtt+R|Mh1E&4_Wo`ZhkvHb)pi3)qE@R|Eg z9(LC6PIf+UW3s#UGw*aQZrA}7{Y?cflq{=NKi(|=c*%`Y%5KzA2M}Vbf3QledboVk zaaKH@yS$$2&sIv-bFKP=&5wvZRQ-e+`Km8r%tovJa5v_1=tw`h136r4 zZ&}w{^%I@Q%b|%bprVvJh;XgFjHhg2Wp~HEy!GYFzYKe7?MJO=@v66H5Oo=A=%U=t zLV;TQn6=(|y>onT@8BPZedfd1$=bmmtw`&Qn&&m8Tye9%?Q%BfAoU%GrCTnUPt*?H zvOdwOm-Uk6|NA#xkBe{WTff`yR*tdOTy zVZ$FT`k8(fM;;-{3-;e0ov@YJhghDsFU?K{ML7$8Op((#b}wphIQ}QK;FRB( zD2AEhWYY+He>A>iOtLt@Mwn$-=BE2Ix;I>X0Illpi=n15x;JWsHp9iyVxVdG*`mMt zh7p=Ajy9{e?e_V|WBZq!$yeNoUCxBxDP?h(@cE>8m3!9>A1Db5Mjl@w0d%EcB5zb6 z_t1$r9_$->I4s27iP8;Y1)sOUWx%lr%yLI%0U`wG97LmyTiN%98vAB)C_ur?;=9p# z3mqm$&R?zkdBo%KB2D*D=ZW{aWfZLP%Ch2|qc-ltW= zB?es%nZriFLBC)G91dCU-d~K6J$Ye5{NZx{qqZ7TcaoY#>1&n@Kl1t{d&(tRaR{c8 z4I{@tLs3!sM3boO5{(3tc>G?1No>F+iBhn?e(w0kaA+L)>X1za1JQ>%*PM!tKVA4> Ftedit>TEDIT-WINDOW.;407 201953 +(FILECREATED "17-Dec-2024 23:43:52" {WMEDLEY}TEDIT>TEDIT-WINDOW.;739 230830 :EDIT-BY rmk - :CHANGES-TO (FNS \TEDIT.PROCEXITFN \TEDIT.BUTTONEVENTFN) + :CHANGES-TO (FNS \TEDIT.SHIFTLINES) - :PREVIOUS-DATE "21-Mar-2024 21:27:34" {WMEDLEY}TEDIT>TEDIT-WINDOW.;405) + :PREVIOUS-DATE "13-Dec-2024 09:00:10" {WMEDLEY}TEDIT>TEDIT-WINDOW.;738) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) (RPAQQ TEDIT-WINDOWCOMS - [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITCARET TEXTWINDOW PANE) - (MACROS FGETPANE GETPANE SETPANE FSETPANE) - (I.S.OPRS inpanes))) - (INITRECORDS TEDITCARET PANE) + [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITCARET TEXTWINDOW PANEPROPS) + (MACROS FGETPANEPROP GETPANEPROP SETPANEPROP + FSETPANEPROP) + (MACROS PANEPROPS PANEPREFIX PANESUFFIX PANETOPLINE + PANECARET PANESTREAM PANETOBJ PANEBOTTOMLINE + \TEDIT.PREFIX.LCHARLIM) + (MACROS PANETOP PANEWIDTH PANELEFT PANEBOTTOM + PANEHEIGHT PANEREGION) + (I.S.OPRS inpanes backpanes) + (MACROS ALLBUTTONSUP))) + (INITRECORDS TEDITCARET PANEPROPS) (FILES ATTACHEDWINDOW) - (FNS \TEDIT.CREATEW \TEDIT.WINDOW.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.ADD.CARET - \TEDIT.CLEARPANE) + (FNS TEDIT.DEFER.UPDATES) + (FNS \TEDIT.CREATEW \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.PRIMARYW \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT - \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN \TEDIT.PANEREGION) - (FNS \TEDIT.BUTTONEVENTFN \TEDIT.DO.SELOPERATION \TEDIT.TTY.TEXTOBJP - \TEDIT.BUTTONEVENTFN.SELOPERATION \TEDIT.BUTTONEVENTFN.INACTIVE - \TEDIT.BUTTONEVENTFN.INTITLE \TEDIT.COPYINSERT) - (P (MOVD? 'NILL '\TEDIT.COPYINSERT)) - (FNS \TEDIT.PANE.SPLIT \TEDIT.SPLITW \TEDIT.UNSPLITW) + \TEDIT.MAINW \TEDIT.MAINSTREAM \TEDIT.PRIMARYPANE \TEDIT.PANELIST \TEDIT.NEWREGIONFN + \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN \TEDIT.PANEREGION) + + (* ;; "Button events") + + (FNS \TEDIT.BUTTONEVENTFN \TEDIT.BUTTONEVENTFN.DOOPERATION \TEDIT.BUTTONEVENTFN.GETOPERATION + \TEDIT.BUTTONEVENTFN.CURSEL.INIT \TEDIT.BUTTONEVENTFN.INACTIVE + \TEDIT.BUTTONEVENTFN.INTITLE \TEDIT.COPYINSERTFN \TEDIT.FOREIGN.COPY) + (FNS \TEDIT.PANE.SPLIT \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.LINKPANES \TEDIT.UNLINKPANE) (P (MOVD? 'NILL 'GRAB-TYPED-REGION) (MOVD? 'NILL 'REGISTER-TYPED-REGION)) (INITVARS (\TEDIT.OP.WIDTH 12) (\TEDIT.OP.BOTTOM 12) - (\TEDIT.LINEREGION.WIDTH 8)) + (\TEDIT.LINEREGION.WIDTH 12)) (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM \TEDIT.LINEREGION.WIDTH)) (CURSORS BXCARET BXHICARET \TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR @@ -51,11 +61,11 @@ (FNS \TEXTSTREAM.TITLE \TEDIT.DEFAULT.TITLE \TEDIT.WINDOW.TITLE \TEXTSTREAM.FILENAME \TEDIT.UPDATE.TITLE)) (COMS (* ; "Screen updating utilities") - (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.REPAINTFN \TEDIT.AFTERMOVEFN OFFSCREENP - \TEDIT.RESHAPEFN \TEDIT.PANEWITHINSCREEN?) - (FNS \TEDIT.SCROLLFN \TEDIT.SCROLLFLOAT \TEDIT.SCROLLUP \TEDIT.SCROLL.SHOWSEL - \TEDIT.SCROLLDOWN \TEDIT.OFFSCREEN.SCROLL \TEDIT.WHERE.SEL \TEDIT.WHERE.SEL1) - (FNS \TEDIT.ONSCREEN \TEDIT.ONSCREEN? \TEDIT.PANE.SCREENREGION)) + (FNS TEDIT.DEACTIVATE.WINDOW \TEDIT.RESHAPEFN \TEDIT.REPAINTFN) + (FNS \TEDIT.SCROLLFN \TEDIT.SCROLLCH.TOP \TEDIT.SCROLLCH.BOTTOM \TEDIT.SCROLLUP + \TEDIT.TOPLINE.YTOP \TEDIT.SCROLLDOWN \TEDIT.SCROLL.CARET \TEDIT.VISIBLECARETP + \TEDIT.VISIBLECHARP \TEDIT.BITMAPLINES \TEDIT.SETPANE.TOPLINE \TEDIT.SHIFTLINES) + (FNS \TEDIT.ONSCREEN? \TEDIT.ONSCREEN.REGION \TEDIT.AFTERMOVEFN OFFSCREENP)) (COMS (* ; "Process-world interfaces") (FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN)) (COMS (INITVARS (\CARETRATE 333)) @@ -134,30 +144,29 @@ TCCURSORBM _ BXCARET TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET)) -(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM 'TEDIT-NEXT-PANE-DOWN) - (PUTWINDOWPROP DATUM 'TEDIT-NEXT-PANE-DOWN NEWVALUE)) - (WTEXTSTREAM (GETWINDOWPROP DATUM 'TEXTSTREAM) +(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM 'TEXTSTREAM) (PUTWINDOWPROP DATUM 'TEXTSTREAM NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) - (WLINES (GETWINDOWPROP DATUM 'LINES) - (PUTWINDOWPROP DATUM 'LINES NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM 'TEDIT.CURSORREGION) (PUTWINDOWPROP DATUM 'TEDIT.CURSORREGION NEWVALUE)) - (PLINES (GETWINDOWPROP DATUM 'LINES) - (PUTWINDOWPROP DATUM 'LINES NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM 'TEDIT-CLOSING-FILE) (PUTWINDOWPROP DATUM 'TEDIT-CLOSING-FILE NIL)) - (WITHINSCREEN (GETWINDOWPROP DATUM 'TEDIT-WITHIN-SCREEN) - (LET ((NV NEWVALUE)) - (PUTWINDOWPROP DATUM 'TEDIT-WITHIN-SCREEN NV) - NV)))) + (PANEPROPS (GETWINDOWPROP DATUM 'PANEPROPS) + (PUTWINDOWPROP DATUM 'PANEPROPS NEWVALUE))) + [TYPE? (AND (WINDOWP DATUM) + (TYPENAMEP (fetch (TEXTWINDOW PTEXTOBJ) of DATUM) + 'TEXTOBJ]) -(DATATYPE PANE ((XPWINDOW FULLXPOINTER) - PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER)) - (ACCESSFNS (PWINDOW (PROGN DATUM)))) +(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") + PREFIXLINE (* ; + "Dummy line that covers all the characters above the first visible line") + SUFFIXLINE (* ; + "Dummy line that covers all the characters below the last visible line") + PCARET NEXTPANE (PREVPANE XPOINTER) + PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION)) ) (/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER @@ -175,31 +184,114 @@ (TEDITCARET 20 POINTER)) '22) -(/DECLAREDATATYPE 'PANE '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER) - '((PANE 0 FULLXPOINTER) - (PANE 2 POINTER) - (PANE 4 POINTER) - (PANE 6 POINTER) - (PANE 8 POINTER) - (PANE 10 XPOINTER)) - '12) +(/DECLAREDATATYPE 'PANEPROPS + '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER) + '((PANEPROPS 0 FULLXPOINTER) + (PANEPROPS 2 POINTER) + (PANEPROPS 4 POINTER) + (PANEPROPS 6 POINTER) + (PANEPROPS 8 POINTER) + (PANEPROPS 10 XPOINTER) + (PANEPROPS 12 POINTER) + (PANEPROPS 14 POINTER) + (PANEPROPS 16 POINTER) + (PANEPROPS 18 POINTER) + (PANEPROPS 20 POINTER) + (PANEPROPS 22 POINTER) + (PANEPROPS 24 POINTER)) + '26) (DECLARE%: EVAL@COMPILE -(PUTPROPS FGETPANE MACRO ((P FIELD) - (ffetch (PANE FIELD) of P))) +(PUTPROPS FGETPANEPROP MACRO ((P FIELD) + (ffetch (PANEPROPS FIELD) of P))) -(PUTPROPS GETPANE MACRO ((P FIELD) - (fetch (PANE FIELD) of P))) +(PUTPROPS GETPANEPROP MACRO ((P FIELD) + (fetch (PANEPROPS FIELD) of P))) -(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) - (replace (PANE FIELD) of P with NEWVALUE))) +(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) + (replace (PANEPROPS FIELD) of P with NEWVALUE))) -(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) - (freplace (PANE FIELD) of P with NEWVALUE))) +(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) + (freplace (PANEPROPS FIELD) of P with NEWVALUE))) ) (DECLARE%: EVAL@COMPILE -[I.S.OPR 'inpanes NIL '(inside (fetch (TEXTOBJ \WINDOW) of BODY] +(PUTPROPS PANEPROPS MACRO ((PANE) + (fetch (TEXTWINDOW PANEPROPS) of PANE))) + +(PUTPROPS PANEPREFIX MACRO ((PANE) + (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) + PREFIXLINE)))) + +(PUTPROPS PANESUFFIX MACRO ((PANE) + (GETPANEPROP (PANEPROPS PANE) + SUFFIXLINE))) + +(PUTPROPS PANETOPLINE MACRO ((PANE) + (FGETLD (PANEPREFIX PANE) + NEXTLINE))) + +(PUTPROPS PANECARET MACRO ((PANE) + (\DTEST (GETPANEPROP (PANEPROPS PANE) + PCARET) + 'TEDITCARET))) + +(PUTPROPS PANESTREAM MACRO ((PANE) + (fetch (TEXTWINDOW WTEXTSTREAM) of PANE))) + +(PUTPROPS PANETOBJ MACRO [(PANE) + (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) + of PANE]) + +(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) + (GETLD (PANESUFFIX PANE) + PREVLINE))) + +(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) + (FSETLD (PANEPREFIX PANE) + LCHARLAST CHNO))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS PANETOP MACRO [(PANE PREG) + (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE]) + +(PUTPROPS PANEWIDTH MACRO [(PANE PREG) + (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE]) + +(PUTPROPS PANELEFT MACRO [(PANE PREG) + (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE]) + +(PUTPROPS PANEBOTTOM MACRO [(PANE PREG) + (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE]) + +(PUTPROPS PANEHEIGHT MACRO [(PANE PREG) + (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE]) + +(PUTPROPS PANEREGION MACRO ((PANE PREG) + (OR PREG (DSPCLIPPINGREGION NIL PANE)))) +) +(DECLARE%: EVAL@COMPILE + +[I.S.OPR 'inpanes NIL '(bind $$BODY _ BODY declare (LOCALVARS $$BODY) + first (SETQ I.V. (OR (CL:IF (TYPENAMEP $$BODY 'TEXTOBJ) + (FGETTOBJ $$BODY PRIMARYPANE) + $$BODY) + (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) + NEXTPANE) + (GO $$OUT] + +[I.S.OPR 'backpanes NIL '(first (SETQ I.V. (OR (find P inpanes BODY + suchthat (NULL (GETPANEPROP (PANEPROPS P) + NEXTPANE))) + (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) + PREVPANE) + (GO $$OUT] +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS)))) ) (* "END EXPORTED DEFINITIONS") @@ -221,20 +313,49 @@ (TEDITCARET 20 POINTER)) '22) -(/DECLAREDATATYPE 'PANE '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER) - '((PANE 0 FULLXPOINTER) - (PANE 2 POINTER) - (PANE 4 POINTER) - (PANE 6 POINTER) - (PANE 8 POINTER) - (PANE 10 XPOINTER)) - '12) +(/DECLAREDATATYPE 'PANEPROPS + '(FULLXPOINTER POINTER POINTER POINTER POINTER XPOINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER) + '((PANEPROPS 0 FULLXPOINTER) + (PANEPROPS 2 POINTER) + (PANEPROPS 4 POINTER) + (PANEPROPS 6 POINTER) + (PANEPROPS 8 POINTER) + (PANEPROPS 10 XPOINTER) + (PANEPROPS 12 POINTER) + (PANEPROPS 14 POINTER) + (PANEPROPS 16 POINTER) + (PANEPROPS 18 POINTER) + (PANEPROPS 20 POINTER) + (PANEPROPS 22 POINTER) + (PANEPROPS 24 POINTER)) + '26) (FILESLOAD ATTACHEDWINDOW) (DEFINEQ +(TEDIT.DEFER.UPDATES + [LAMBDA (TSTREAM AFTERPROPS) (* ; "Edited 11-Jul-2024 12:26 by rmk") + + (* ;; "Suppresses selection/display updates (but not line layout) until a RESETLST is exited. At that point the display is updated (unless suppressed by a higher deferral).") + + (* ;; "After props are installed after the display is updated.") + + (* ;; "This can be used to improve performance when a program is trying to construct an initial Tedit document, and also to avoid temporarily inconsistent updates while a document is being modified.") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T) + `(PROGN (PUTTEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE) + (\TEDIT.FILL.PANES ,TEXTOBJ) + (PUTTEXTPROPS ,TEXTOBJ ',AFTERPROPS]) +) +(DEFINEQ + (\TEDIT.CREATEW - [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 20-Mar-2024 09:57 by rmk") + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 1-Jul-2024 22:55 by rmk") + (* ; "Edited 29-Jun-2024 23:16 by rmk") + (* ; "Edited 5-May-2024 21:54 by rmk") + (* ; "Edited 20-Mar-2024 09:57 by rmk") (* ; "Edited 14-Jan-2024 22:13 by rmk") (* ; "Edited 18-Dec-2023 23:01 by rmk") (* ; "Edited 25-Nov-2023 10:37 by rmk") @@ -261,7 +382,7 @@ (* ;; "Reusing an existing Tedit window, undo its splits.") - (for P in (REVERSE (CDR (FGETTOBJ WTEXTOBJ \WINDOW))) do (\TEDIT.UNSPLITW P))) + (for P backpanes WTEXTOBJ do (\TEDIT.UNSPLITW P))) [SETQ TITLE (OR (WINDOWPROP WINDOW 'TITLE) (LISTGET PROPS 'TITLE]) (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) @@ -287,7 +408,8 @@ (* ;; "If we can get an intended region first, we don't bother the user with a prompt") (SETQ REGION (if (REGIONP WINDOW) - then (PROG1 WINDOW (SETQ WINDOW NIL)) + then (PROG1 (COPY WINDOW) + (SETQ WINDOW NIL)) else (GRAB-TYPED-REGION REGIONTYPE))) (CL:UNLESS REGION (CLRPROMPT) (* ; "System promptwindow") @@ -320,9 +442,7 @@ TEDIT.PROMPT.FONT))) (SETTOBJ TEXTOBJ PROMPTWINDOW PWINDOW) (CL:WHEN [WINDOWP (OR PWINDOW (SETQ PWINDOW (CAR (MKLIST PWINDOW] - (WINDOWPROP PWINDOW (WINDOWPROP WINDOW 'PROMPTWINDOW) - 'PAGEFULLFN - (FUNCTION \TEDIT.PROMPT.PAGEFULLFN)) + (WINDOWPROP PWINDOW 'PAGEFULLFN (FUNCTION \TEDIT.PROMPT.PAGEFULLFN)) (WINDOWPROP PWINDOW 'TEDIT.PROMPTWINDOW T)) (* ;; "Make the window's dimensions available thru TSTREAM even though it hasn't yet been configured for the text") @@ -332,14 +452,16 @@ WINDOW]) (\TEDIT.WINDOW.SETUP - [LAMBDA (PANE TSTREAM PROPS AFTERPANE FIRSTLINE) (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 9-Feb-2024 10:51 by rmk") + [LAMBDA (PANE TSTREAM PROPS AFTERPANE LCHAR1) (* ; "Edited 25-Nov-2024 20:10 by rmk") + (* ; "Edited 21-Nov-2024 21:12 by rmk") + (* ; "Edited 18-Nov-2024 21:14 by rmk") + (* ; "Edited 4-Nov-2024 19:47 by rmk") + (* ; "Edited 3-Nov-2024 07:49 by rmk") + (* ; "Edited 5-Jul-2024 11:38 by rmk") + (* ; "Edited 18-May-2024 16:50 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") (* ; "Edited 29-Jan-2024 17:10 by rmk") - (* ; "Edited 11-Jan-2024 19:33 by rmk") - (* ; "Edited 2-Jan-2024 19:15 by rmk") (* ; "Edited 12-Oct-2023 23:41 by rmk") - (* ; "Edited 10-Oct-2023 00:30 by rmk") - (* ; "Edited 4-Oct-2023 22:59 by rmk") (* ; "Edited 10-May-2023 23:47 by rmk") (* ; "Edited 5-Nov-2022 23:13 by rmk") (* ; "Edited 11-Jun-99 15:48 by rmk:") @@ -348,67 +470,88 @@ (* ;; "Set up PANE for display of TSTREAM's contents, treating PANE as a new (and possibly the only) pane. \TEDIT.MINIMAL.WINDOW.SETUP has initialized PANE and installed it in its proper place.") (CL:WHEN (EQ PANE AFTERPANE) - (HELP "PANE=AFTERPANE")) + (\TEDIT.THELP "PANE=AFTERPANE")) (\DTEST PANE 'WINDOW) - (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) - (MENUPROP (LISTGET PROPS 'MENU)) - SEL PLINE) (* ; + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (MENUPROP (LISTGET PROPS 'MENU)) + (SEL (TEXTSEL TEXTOBJ)) + LASTVISIBLE) (* ;  "The Command menu, or list of items for it") - (COND - ((type? MENU MENUPROP) (* ; "A menu. just use it.") - (WINDOWPROP PANE 'TEDIT.MENU MENUPROP)) - (MENUPROP (* ; + (if (type? MENU MENUPROP) + then (* ; "A menu. just use it.") + (WINDOWPROP PANE 'TEDIT.MENU MENUPROP) + elseif MENUPROP + then (* ;  "Presumably a list of menu items. Force a new menu on next middle button.") (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS MENUPROP) - (WINDOWPROP PANE 'TEDIT.MENU NIL))) + (WINDOWPROP PANE 'TEDIT.MENU NIL)) - (* ;; "") + (* ;; "") - (\TEDIT.CLEARPANE PANE) - (SETQ PLINE (\TEDIT.CREATEPLINE TEXTOBJ PANE FIRSTLINE)) - (\TEDIT.ADD.CARET TEXTOBJ PANE AFTERPANE) - (SETQ SEL (TEXTSEL TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL (AND AFTERPANE PANE)) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL (AND AFTERPANE PANE)) - (FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) - (\TEDIT.SHOWSEL SEL T (AND AFTERPANE PANE]) + (\TEDIT.PANE.CREATELINES TEXTOBJ PANE (AND LCHAR1 (SUB1 LCHAR1))) + (CL:UNLESS (OR LCHAR1 (EQ 0 (TEXTLEN TEXTOBJ))) + (LINKLD (PANEPREFIX PANE) + (\TEDIT.FORMATLINE TEXTOBJ 1))) + (CL:WHEN (PANETOPLINE PANE) + [SETYBOT (PANEPREFIX PANE) + (IPLUS (FGETLD (PANETOPLINE PANE) + LLEADBEFORE) + (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION NIL PANE]) + (\TEDIT.CLEARPANE PANE) + (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ (\TEDIT.LINES.BELOW NIL PANE TEXTOBJ)) + (CL:WHEN AFTERPANE + (for PANE inpanes (PROGN TEXTOBJ) as L1 on (GETSEL SEL L1) as LN + on (GETSEL SEL LN) when (EQ PANE AFTERPANE) do (push (CDR L1) + NIL) + (push (CDR LN) + NIL))) + (FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) + (\TEDIT.FIXSEL SEL TEXTOBJ NIL (AND AFTERPANE PANE)) + (\TEDIT.SHOWSEL SEL NIL TEXTOBJ (AND AFTERPANE PANE)) + (\TEDIT.SHOWSEL SEL T TEXTOBJ (AND AFTERPANE PANE)) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) (\TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (WINDOW TSTREAM PROPS AFTERPANE) (* ; "Edited 20-Mar-2024 11:22 by rmk") + [LAMBDA (PANE TSTREAM PROPS AFTERPANE) (* ; "Edited 30-Nov-2024 13:32 by rmk") + (* ; "Edited 4-Nov-2024 19:46 by rmk") + (* ; "Edited 26-Oct-2024 11:10 by rmk") + (* ; "Edited 27-Aug-2024 10:11 by rmk") + (* ; "Edited 6-Jul-2024 17:00 by rmk") + (* ; "Edited 1-Jul-2024 09:20 by rmk") + (* ; "Edited 30-Jun-2024 08:55 by rmk") + (* ; "Edited 25-Jun-2024 00:04 by rmk") + (* ; "Edited 13-Jun-2024 21:51 by rmk") + (* ; "Edited 20-Mar-2024 11:22 by rmk") (* ; "Edited 22-Feb-2024 23:14 by rmk") (* ; "Edited 26-Jan-2024 13:14 by rmk") - (* ; "Edited 20-Jan-2024 23:24 by rmk") (* ; "Edited 2-Jan-2024 17:27 by rmk") (* ; "Edited 21-Dec-2023 17:19 by rmk") - (* ; "Edited 17-Dec-2023 17:14 by rmk") - (* ; "Edited 9-Dec-2023 20:14 by rmk") - (* ; "Edited 3-Dec-2023 20:25 by rmk") (* ; "Edited 20-Nov-2023 10:40 by rmk") (* ; "Edited 4-Oct-2023 09:48 by rmk") - (* ; "Edited 30-Sep-2023 17:36 by rmk") - (* ; "Edited 21-Sep-2023 14:10 by rmk") (* ; "Edited 18-Sep-2023 23:44 by rmk") (* ; "Edited 30-May-91 23:33 by jds") - (* ;; "Do the minimum setup so that WINDOW becomes a pane of TSTREAM and TSTREAM and WINDOW know about each other. Does NOT include mouse interface or scrolling/lines") + (* ;; "Do the minimum setup so that the window PANE becomes a pane of TSTREAM and TSTREAM and PANE know about each other. Does NOT include mouse interface or scrolling/lines") (* ;; "If AFTERPANE is non-NIL, the new pnae will be placed after AFTERPANE in the TEXTOBJ's pane list. This maintains an ordering of panes, for splitting and unsplitting.") - (\DTEST WINDOW 'WINDOW) + (\DTEST PANE 'WINDOW) (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) - DS PROP OLDPANES) (* ; - "The displaystream for flashing the caret") - (FSETTOBJ TEXTOBJ PANES (CONS (create PANE - XPWINDOW _ WINDOW))) - (* ; "NOT IMPLEMENTED YET") - (FSETTOBJ TEXTOBJ SELPANE WINDOW) - (WINDOWPROP WINDOW 'PROCESS NIL) (* ; + [PANEPROPS (create PANEPROPS + PWINDOW _ PANE + PCARET _ (create TEDITCARET + TCFORCEUP _ T + TCCARETDS _ (WINDOWPROP PANE 'DSP] + DS PREG OLDPANES) (* ; "The displaystream for flashing the caret. Caret starts off, so it doesn't flash before its position is known") + (replace (TEXTWINDOW PANEPROPS) of PANE with PANEPROPS) + (SETQ DS (WINDOWPROP PANE 'DSP)) + (FSETTOBJ TEXTOBJ SELPANE PANE) + (WINDOWPROP PANE 'PROCESS NIL) (* ;  "For the moment, this pane has no process") - (replace (TEXTWINDOW WTEXTSTREAM) of WINDOW with TSTREAM) + (replace (TEXTWINDOW WTEXTSTREAM) of PANE with TSTREAM) (* ; "TSTREAM is accessible from WINDOW") - (replace (TEXTWINDOW CURSORREGION) of WINDOW with (CREATEREGION 0 0 0 0)) + (replace (TEXTWINDOW CURSORREGION) of PANE with (CREATEREGION 0 0 0 0)) (* ; "Used by CursorMovedFn") - (SETQ DS (WINDOWPROP WINDOW 'DSP)) (DSPRIGHTMARGIN 32767 DS) (* ;  "So we don't get spurious RETURNs printed out by the system") (FSETTOBJ TEXTOBJ DISPLAYCACHE (CAR (\TEDIT.CREATE.LINECACHE 1))) @@ -424,100 +567,135 @@ BOTTOM _ 0 WIDTH _ 100 HEIGHT _ 15) - (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) (* ; "Remember its size, too.") - [COND - ((SETQ PROP (LISTGET PROPS 'REGION)) (* ; "Use the callers subregion") - (FSETTOBJ TEXTOBJ WTOP (fetch PTOP of PROP)) - (FSETTOBJ TEXTOBJ WRIGHT (fetch RIGHT of PROP)) - (FSETTOBJ TEXTOBJ WBOTTOM (fetch BOTTOM of PROP)) - (FSETTOBJ TEXTOBJ WLEFT (fetch LEFT of PROP))) - (T (* ; - "Otherwise, default to the whole window") - (FSETTOBJ TEXTOBJ WLEFT (fetch LEFT of (DSPCLIPPINGREGION NIL DS))) - (FSETTOBJ TEXTOBJ WBOTTOM (fetch BOTTOM of (DSPCLIPPINGREGION NIL DS))) - (FSETTOBJ TEXTOBJ WTOP (fetch HEIGHT of (DSPCLIPPINGREGION NIL DS))) - (FSETTOBJ TEXTOBJ WRIGHT (fetch WIDTH of (DSPCLIPPINGREGION NIL DS] - (WINDOWPROP WINDOW 'CURSORMOVEDFN (FUNCTION \TEDIT.CURSORMOVEDFN)) - (WINDOWPROP WINDOW 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN)) - (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP WINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP WINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) - (WINDOWPROP WINDOW 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN)) - (WINDOWADDPROP WINDOW 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) - (WINDOWADDPROP WINDOW 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) - (CL:UNLESS (WINDOWPROP WINDOW 'SCROLLFN) - (WINDOWPROP WINDOW 'SCROLLFN (FUNCTION \TEDIT.SCROLLFN))) - (WINDOWPROP WINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) - (WINDOWPROP WINDOW 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN)) - (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW) - T) (* ; "Clean up when the pane is closed") - (WINDOWPROP WINDOW 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) - (* ; - "Grab the TTY when the mouse clicks in the pane") - (WINDOWPROP WINDOW 'OFFSCREEN (OFFSCREENP WINDOW)) (* ; "In case it is created off-screen") - (CL:UNLESS (WINDOWPROP WINDOW 'ICONFN) - (WINDOWPROP WINDOW 'ICONFN (FUNCTION \TEDIT.SHRINK.ICONCREATE))) - (* ; - "Set up to create a shrink icon if nobody else has.") - (WINDOWADDPROP WINDOW 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) - (* ; - "Always give up control of the keyboard on shrinking.") - (WINDOWADDPROP WINDOW 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) - (CL:UNLESS (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN) (* ; "The default menu fn") - (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN (OR (LISTGET PROPS 'TITLEMENUFN) - (FUNCTION TEDIT.DEFAULT.MENUFN)))) - (SETQ OLDPANES (FGETTOBJ TEXTOBJ \WINDOW)) - (CL:UNLESS (EQMEMB WINDOW OLDPANES) (* ; "Don't ") - (FSETTOBJ TEXTOBJ \WINDOW (if AFTERPANE - then (* ; "Put it after AFTERPANE ") - [RPLACD (FMEMB AFTERPANE OLDPANES) - (CONS WINDOW (CDR (FMEMB AFTERPANE OLDPANES] - OLDPANES - else (* ; - "Otherwise, just add it at the end of the list") - (NCONC1 OLDPANES WINDOW)))) - WINDOW]) + (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) -(\TEDIT.ADD.CARET - [LAMBDA (TEXTOBJ PANE AFTERPANE) (* ; "Edited 10-Mar-2024 15:01 by rmk") - (* ; "Edited 2-Jan-2024 19:21 by rmk") - (* ; "Edited 9-Oct-2023 22:40 by rmk") - (* ; "Edited 4-Oct-2023 23:38 by rmk") - (* ; "Edited 30-Sep-2023 23:57 by rmk") + (* ;; "") - (* ;; " Adds a caret to TEXTOBJ that correspond to a new pane, maybe the very first one. TCFORCEUP is T to prevent the caret from flashing before its position is known. ") + (SETQ PREG (OR (LISTGET PROPS 'REGION) + (DSPCLIPPINGREGION NIL DS))) + (WITH PANEPROPS PANEPROPS (SETQ PANEHEIGHT (fetch (REGION HEIGHT) of PREG)) + (SETQ PANEWIDTH (fetch (REGION WIDTH) of PREG)) + (SETQ PANELEFT (fetch (REGION LEFT) of PREG)) + (SETQ PANERIGHT (fetch (REGION RIGHT) of PREG)) + (SETQ PANEBOTTOM (fetch (REGION BOTTOM) of PREG)) + (SETQ PANETOP (fetch (REGION TOP) of PREG)) + (SETQ PANEREGION PREG)) + (WITH TEXTOBJ TEXTOBJ (SETQ WTOP (fetch (REGION PTOP) of PREG)) + (SETQ WRIGHT (fetch (REGION RIGHT) of PREG)) + (SETQ WBOTTOM (fetch (REGION BOTTOM) of PREG)) + (SETQ WLEFT (fetch (REGION LEFT) of PREG))) - (* ;; "The OR handles the case where the CARET list has not yet been set up for the first pane.") + (* ;; "") - (if AFTERPANE - then (for P inpanes (PROGN TEXTOBJ) as CTAIL on (FGETTOBJ TEXTOBJ CARET) - when (EQ P AFTERPANE) do [PUSH (CDR CTAIL) - (create TEDITCARET - TCFORCEUP _ T - TCCARETDS _ (WINDOWPROP PANE 'DSP] - (RETURN T)) - else (FSETTOBJ TEXTOBJ CARET (CONS (create TEDITCARET - TCFORCEUP _ T - TCCARETDS _ (WINDOWPROP PANE 'DSP]) + (WINDOWPROP PANE 'CURSORMOVEDFN (FUNCTION \TEDIT.CURSORMOVEDFN)) + (WINDOWPROP PANE 'CURSOROUTFN (FUNCTION \TEDIT.CURSOROUTFN)) + (WINDOWPROP PANE 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) + (WINDOWPROP PANE 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) + (WINDOWPROP PANE 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) + (WINDOWPROP PANE 'HARDCOPYFILEFN (FUNCTION \TEDIT.HARDCOPYFILEFN)) + (WINDOWPROP PANE 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) + (WINDOWPROP PANE 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) + (WINDOWPROP PANE 'AFTERMOVEFN (FUNCTION \TEDIT.AFTERMOVEFN)) + (WINDOWPROP PANE 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) + (WINDOWPROP PANE 'OFFSCREEN (OFFSCREENP PANE)) + (WINDOWPROP PANE 'SCROLLFN (OR (WINDOWPROP PANE 'SCROLLFN) + (FUNCTION \TEDIT.SCROLLFN))) + (WINDOWPROP PANE 'ICONFN (OR (WINDOWPROP PANE 'ICONFN) + (FUNCTION \TEDIT.SHRINK.ICONCREATE))) + (WINDOWPROP PANE 'TEDIT.TITLEMENUFN (OR (WINDOWPROP PANE 'TEDIT.TITLEMENUFN) + (LISTGET PROPS 'TITLEMENUFN) + (FUNCTION TEDIT.DEFAULT.MENUFN))) + (WINDOWADDPROP PANE 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) + (WINDOWADDPROP PANE 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) + (WINDOWADDPROP PANE 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) + (WINDOWADDPROP PANE 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) + + (* ;; "Our CLOSEFN must be first in order to stop closing if the stream is busy.") + + (WINDOWADDPROP PANE 'CLOSEFN (CL:IF AFTERPANE + [FUNCTION (LAMBDA (P) + (PUTWINDOWPROP P 'CLOSEFN NIL) + (\TEDIT.UNSPLITW P] + (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + T) + (CL:UNLESS (thereis P inpanes TEXTOBJ suchthat (EQ P PANE)) + (* ; "Don't re-add ") + (if AFTERPANE + then (* ; "Link it in after AFTERPANE ") + (\TEDIT.LINKPANES AFTERPANE PANE) + else (FSETTOBJ TEXTOBJ PRIMARYPANE PANE))) + PANE]) (\TEDIT.CLEARPANE - [LAMBDA (PANE PBOTTOM) (* ; "Edited 2-Jan-2024 11:13 by rmk") + [LAMBDA (PANE PBOTTOM) (* ; "Edited 1-Dec-2024 11:43 by rmk") + (* ; "Edited 20-Nov-2024 11:31 by rmk") + (* ; "Edited 2-Jan-2024 11:13 by rmk") (* ;;  "Clears PANE's clipping region. PBOTTOM is usually NIL, but can focus clearing on a subregion.") - (LET ((PREG (DSPCLIPPINGREGION NIL PANE))) - (CL:UNLESS PBOTTOM - (SETQ PBOTTOM (fetch (REGION BOTTOM) of PREG))) - (BLTSHADE WHITESHADE PANE 0 PBOTTOM (fetch (REGION WIDTH) of PREG) - (IDIFFERENCE (fetch (REGION PTOP) of PREG) - PBOTTOM) - 'REPLACE]) + (CL:UNLESS PBOTTOM + (SETQ PBOTTOM (PANEBOTTOM PANE))) + (BLTSHADE WHITESHADE PANE 0 PBOTTOM (PANEWIDTH PANE) + (IDIFFERENCE (fetch (REGION PTOP) of (PANEREGION PANE)) + PBOTTOM) + 'REPLACE]) + +(\TEDIT.FILL.PANES + [LAMBDA (TSTREAM ONLYPANE) (* ; "Edited 29-Nov-2024 13:29 by rmk") + (* ; "Edited 27-Nov-2024 13:51 by rmk") + (* ; "Edited 21-Nov-2024 21:10 by rmk") + (* ; "Edited 19-Nov-2024 23:27 by rmk") + (* ; "Edited 18-Nov-2024 21:14 by rmk") + (* ; "Edited 28-Oct-2024 16:29 by rmk") + (* ; "Edited 26-Oct-2024 15:38 by rmk") + (* ; "Edited 6-Jul-2024 16:57 by rmk") + (* ; "Edited 30-Jun-2024 17:12 by rmk") + (* ; "Edited 25-Jun-2024 08:53 by rmk") + (* ; "Edited 17-Jun-2024 09:36 by rmk") + (* ; "Edited 12-May-2024 21:36 by rmk") + (* ; "Edited 15-Mar-2024 13:36 by rmk") + (* ; "Edited 30-Nov-2023 10:02 by rmk") + (* ; "Edited 11-May-2023 11:35 by rmk") + (* ; "Edited 30-May-91 23:34 by jds") + + (* ;; "TSTREAM is a particular pane/window on calls for SHAPEW and REPAINT, but this refreshes that pane and all sister panes, in keeping with the illusion that each pane is one part of a larger %"window%".") + + (* ;; + "If called with a pane, the window system has cleared the bitmap, but we don't count on that.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + SEL WASON) + (CL:WHEN TEXTOBJ + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (SETQ WASON (AND (GETSEL SEL SET) + (GETSEL SEL ONFLG))) + (FSETSEL SEL ONFLG NIL) (* ; + "No highlighting for SEL to worry about: SEL and display will both be off.") + (for P inpanes (PROGN TEXTOBJ) when (OR (NULL ONLYPANE) + (EQ P ONLYPANE)) + do + (* ;; + "Take down the caret, and even clear PANE again, in case the timer had put it up again") + + (\TEDIT.SETCARET SEL P TEXTOBJ 'OFF) + (\TEDIT.CLEARPANE P) + (\TEDIT.SUFFIXLINE.CREATE P TEXTOBJ (\TEDIT.LINES.BELOW NIL P TEXTOBJ)) + (\TEDIT.FIXSEL SEL TEXTOBJ NIL P) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ P)) + (CL:WHEN WASON (\TEDIT.SHOWSEL SEL T TEXTOBJ ONLYPANE)))]) ) (DEFINEQ (\TEDIT.CURSORMOVEDFN - [LAMBDA (PANE) (* ; "Edited 20-Mar-2024 11:00 by rmk") + [LAMBDA (PANE) (* ; "Edited 1-Dec-2024 11:55 by rmk") + (* ; "Edited 22-Nov-2024 23:53 by rmk") + (* ; "Edited 16-Nov-2024 20:18 by rmk") + (* ; "Edited 28-Jun-2024 15:07 by rmk") + (* ; "Edited 25-Jun-2024 14:53 by rmk") + (* ; "Edited 13-Jun-2024 22:29 by rmk") + (* ; "Edited 20-Mar-2024 11:00 by rmk") (* ; "Edited 26-Jan-2024 12:48 by rmk") (* ; "Edited 1-Oct-2022 16:07 by rmk") @@ -528,14 +706,14 @@ (TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of PANE))) (CURSORREG (fetch (TEXTWINDOW CURSORREGION) of PANE)) LINE LEFT) - (CL:UNLESS (INSIDE? (DSPCLIPPINGREGION NIL PANE) + (CL:UNLESS (INSIDE? (PANEREGION PANE) X Y) (CURSOR T) (RETURN)) (CL:UNLESS (INSIDE? CURSORREG X Y) [if (AND (IGEQ X (SETQ LEFT (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) \TEDIT.OP.WIDTH))) - (IGEQ Y (IPLUS (FGETTOBJ TEXTOBJ WBOTTOM) + (IGEQ Y (IPLUS (PANEBOTTOM PANE) \TEDIT.OP.BOTTOM)) (NOT (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE))) then @@ -544,12 +722,13 @@ (CURSOR \TEDIT.SPLITCURSOR) (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) (* ;  "PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.") - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH) + (replace (REGION LEFT) of CURSORREG with LEFT) + (replace (REGION WIDTH) of CURSORREG with \TEDIT.OP.WIDTH) else - (* ;; "Not in the split region. Are we in the line-select region on the left?") + (* ;; "Not in the split region. Are we in the line-select region on the left? Don't call PANEPREFIX, because that tests for LINEDESCRIPTOR") - (SETQ LINE (find L inlines (fetch (TEXTWINDOW PLINES) of PANE) + (SETQ LINE (find L inlines (GETPANEPROP (PANEPROPS PANE) + PREFIXLINE) suchthat (ILEQ (FGETLD L YBOT) Y))) (CL:WHEN LINE (* ; @@ -568,18 +747,20 @@ (CURSOR \TEDIT.LINECURSOR) (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE) - (replace LEFT of CURSORREG with 0) - (replace WIDTH of CURSORREG with LEFT) + (replace (REGION LEFT) of CURSORREG with 0) + (replace (REGION WIDTH) of CURSORREG with LEFT) else (* ;;  "Not in the line-select region, not in the split region, must be the main text. ") (CURSOR T) (FSETTOBJ TEXTOBJ MOUSEREGION 'TEXT) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) - (IPLUS LEFT - \TEDIT.LINEREGION.WIDTH])]) + (replace (REGION LEFT) of CURSORREG with LEFT) + (replace (REGION WIDTH) of CURSORREG with (IDIFFERENCE (FGETTOBJ TEXTOBJ + WRIGHT) + (IPLUS LEFT + \TEDIT.LINEREGION.WIDTH + ])]) (\TEDIT.CURSOROUTFN [LAMBDA (PANE) (* ; "Edited 20-Jul-2023 20:32 by rmk") @@ -617,36 +798,47 @@ (TTY.PROCESS (WINDOWPROP W 'PROCESS]) (\TEDIT.MAINW - [LAMBDA (TSTREAM) (* ; "Edited 19-Sep-2023 08:41 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 20-Oct-2024 09:18 by rmk") + (* ; "Edited 26-Aug-2024 12:16 by rmk") + (* ; "Edited 25-Aug-2024 08:55 by rmk") + (* ; "Edited 28-Jun-2024 22:26 by rmk") + (* ; "Edited 19-Sep-2023 08:41 by rmk") (* ; "Edited 11-Sep-2023 09:37 by rmk") (* ; "Edited 6-May-2023 17:29 by rmk") (* ; "Edited 5-Nov-2022 12:21 by rmk") (* ; "Edited 30-May-91 23:33 by jds") - (* ;; "The Tedit stream TSTREAM may have panes that are attached to other windows. The typical case is a Tedit menu stream attached to a primary editing window (\TEDIT.PRIMARYW), although in that case we wouldn't expect TSTREAM to have multiple panes. This returns the main window of that attachment (which may not be that editor's primary pane, if menus can be attached to window-splits (this should not be allowed).") + (* ;; "If TSTREAM's window is an attached window whose main window is also a textstream, returns that main window. Most likely TSTREAM is a menu.") - (* ;; "The MEMB test deals with the fact that the panes of a split text stream are attached to each other--the MAINWINDOW of a later pane is the pane before it--the primary (first) pane doesn't itself attach to a pane (although perhaps it could be attached to something else).") + (LET ((PRIM (\TEDIT.PRIMARYPANE TSTREAM))) + (OR (AND PRIM (WINDOWPROP PRIM 'MAINWINDOW)) + PRIM]) - (LET ((PANES (FGETTOBJ (TEXTOBJ TSTREAM) - \WINDOW))) - (for PANE M inside PANES do (SETQ M (WINDOWPROP PANE 'MAINWINDOW)) - (if M - then +(\TEDIT.MAINSTREAM + [LAMBDA (TSTREAM) (* ; "Edited 20-Oct-2024 09:31 by rmk") + (LET ((MAINW (\TEDIT.MAINW TSTREAM))) + (CL:WHEN MAINW + (fetch (TEXTWINDOW WTEXTSTREAM) of MAINW))]) - (* ;; "This is attached to something. If what it is attached to is one of TSTREAM's panes (e.g. the preceding split), we keep going. Presumably we eventually arrive at TSTREAM's main window (e.g. the menu window), and its MAINWINDOW presumably is the primary window of an original text stream. I.e. we don't want to return one of our earlier panes.") - - (CL:UNLESS (MEMB M PANES) - (RETURN M)) - else (RETURN PANE]) - -(\TEDIT.PRIMARYW - [LAMBDA (TSTREAM) (* ; "Edited 19-Sep-2023 08:21 by rmk") +(\TEDIT.PRIMARYPANE + [LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 21:36 by rmk") + (* ; "Edited 25-Jun-2024 11:57 by rmk") + (* ; "Edited 19-Sep-2023 08:21 by rmk") (* ; "Edited 30-May-91 23:33 by jds") - (* ;; "This returns the first pane in the list of panes associated with TSTREAM. Presumably this is the original pane, before any splitting. Note that this is different than \TEDIT.MAINW: that maps from attached windows (e.g. menus) back to a pane that they are attached to (presumably the first/original pane).") + (* ;; "This returns the first pane in the sequence of panes associated with TSTREAM, the original pane, before any splitting. Note that this is different than \TEDIT.MAINW: that maps from attached windows (e.g. menus) back to the primary pane.") - (CAR (MKLIST (GETTOBJ (TEXTOBJ TSTREAM) - \WINDOW]) + (GETTOBJ (TEXTOBJ TSTREAM) + PRIMARYPANE]) + +(\TEDIT.PANELIST + [LAMBDA (TSTREAM/PANE) (* ; "Edited 30-Jun-2024 22:36 by rmk") + + (* ;; "Returns the panes as a list of windows, primarily so that \MODERNIZED.TEDIT.BUTTONEVENTFN can get the region without knowing about the internal PANEPROPS record.") + + (for P inpanes (if (type? TEXTWINDOW TSTREAM/PANE) + then TSTREAM/PANE + else (TEXTOBJ TSTREAM/PANE)) collect P]) (\TEDIT.NEWREGIONFN [LAMBDA (FIXEDPOINT MOVINGPOINT WINDOW) (* jds "24-FEB-83 17:43") @@ -687,7 +879,12 @@ (RETURN MOVINGPOINT]) (\TEDIT.SET.WINDOW.EXTENT - [LAMBDA (TEXTOBJ PANE) (* ; "Edited 11-Jan-2024 19:29 by rmk") + [LAMBDA (TEXTOBJ PANE) (* ; "Edited 1-Dec-2024 11:28 by rmk") + (* ; "Edited 29-Nov-2024 10:59 by rmk") + (* ; "Edited 17-Nov-2024 18:59 by rmk") + (* ; "Edited 28-Jun-2024 15:11 by rmk") + (* ; "Edited 13-Jun-2024 22:38 by rmk") + (* ; "Edited 11-Jan-2024 19:29 by rmk") (* ; "Edited 20-Nov-2023 11:09 by rmk") (* ; "Edited 3-Nov-2023 12:09 by rmk") (* ; "Edited 22-Sep-2023 19:57 by rmk") @@ -702,15 +899,14 @@ (CL:UNLESS (GETTEXTPROP TEXTOBJ 'NOEXTENT) (CL:WHEN PANE - (LET (FIRSTLINE LASTLINE PHEIGHT PBOTTOM TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT - (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)) - (PREG (DSPCLIPPINGREGION NIL PANE))) - (SETQ PHEIGHT (fetch HEIGHT of PREG)) - (SETQ PBOTTOM (fetch BOTTOM of PREG)) + (LET ((TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)) + (PHEIGHT (PANEHEIGHT PANE)) + (PBOTTOM (PANEBOTTOM PANE)) + FIRSTLINE LASTLINE TOPCHAR BOTCHAR EXTHEIGHT EXTBOT YBOT) (* ;; "First visible line") - (SETQ FIRSTLINE (find L inlines (fetch (TEXTWINDOW PLINES) of PANE) + (SETQ FIRSTLINE (find L inlines (PANEPREFIX PANE) suchthat (ILESSP (FGETLD L YBOT) PHEIGHT))) @@ -729,7 +925,7 @@ (* ;; "There IS a last line on the screen. Grab its last character as the bottom character on the screen, and set the lowest-Y position to the bottom of that line") - (SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLIM))) + (SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLAST))) (SETQ YBOT (FGETLD LASTLINE YBOT))) (T (* ;; "Everything is off the top of the screen. Bottom character is also the last char in the document, and the lowest Y we encountered is the top of the edit window.") @@ -758,7 +954,7 @@ (WINDOWPROP PANE 'EXTENT (create REGION BOTTOM _ EXTBOT HEIGHT _ (IMAX 1 EXTHEIGHT) - WIDTH _ (fetch WIDTH of PREG) + WIDTH _ (PANEWIDTH PANE) LEFT _ 0)))))]) (\TEDIT.SHRINK.ICONCREATE @@ -817,10 +1013,12 @@ (TTY.PROCESS T]) (\TEDIT.PANEREGION - [LAMBDA (PANE) (* ; "Edited 10-May-2023 23:15 by rmk") + [LAMBDA (PANE) (* ; "Edited 1-Dec-2024 11:44 by rmk") + (* ; "Edited 10-May-2023 23:15 by rmk") (* ;; "Value may be a shrunken version of PANE's clipping region, reduced to the subregion that is visible on the screen in its original coordinates. That is, if the bottom is now 100 points below the screen, then 100 is added to BOTTOM and taken away from HEIGHT.") + (NOTUSED) (LET [(PREG (DSPCLIPPINGREGION NIL PANE)) (WREG (WINDOWPROP PANE 'REGION] (if (OR (ILESSP (fetch (REGION LEFT) of WREG) @@ -851,306 +1049,382 @@ (IPLUS BDIFF TDIFF] else PREG]) ) + + + +(* ;; "Button events") + (DEFINEQ (\TEDIT.BUTTONEVENTFN - [LAMBDA (PANE) (* ; "Edited 27-Mar-2024 12:25 by rmk") - (* ; "Edited 20-Mar-2024 11:01 by rmk") - (* ; "Edited 16-Mar-2024 00:22 by rmk") - (* ; "Edited 9-Mar-2024 11:59 by rmk") + [LAMBDA (PANE) (* ; "Edited 6-Dec-2024 11:33 by rmk") + (* ; "Edited 1-Dec-2024 12:03 by rmk") + (* ; "Edited 27-Nov-2024 20:21 by rmk") + (* ; "Edited 3-Nov-2024 07:19 by rmk") + (* ; "Edited 21-Oct-2024 00:18 by rmk") + (* ; "Edited 19-Oct-2024 23:16 by rmk") + (* ; "Edited 6-Oct-2024 20:48 by rmk") + (* ; "Edited 24-Sep-2024 23:06 by rmk") + (* ; "Edited 12-Sep-2024 17:51 by rmk") + (* ; "Edited 20-Jul-2024 15:23 by rmk") + (* ; "Edited 28-Jun-2024 22:52 by rmk") + (* ; "Edited 25-May-2024 13:49 by rmk") + (* ; "Edited 29-Apr-2024 13:43 by rmk") (* ; "Edited 24-Feb-2024 15:29 by rmk") - (* ; "Edited 22-Feb-2024 14:57 by rmk") - (* ; "Edited 19-Feb-2024 14:50 by rmk") - (* ; "Edited 17-Feb-2024 15:40 by rmk") (* ; "Edited 20-Jul-2023 21:52 by rmk") (* ; "Edited 9-Apr-2023 22:59 by rmk") (* ; "Edited 19-Sep-2021 22:58 by rmk:") - (* ;; "Handle button events for a TEdit pane. ") - - (* ;; "RMK: 2021/9 TOTOPW was in (almost) all the conditional branches, I moved it up so that it always happens, even if the click is perhaps in a menu. There were cases where a second click in the window was needed to bring it above an overlapping window that it was under. I think perhaps it was because the mouse button may not have been seen as down on the first click, so it would return before it raised the window. But that was really bizarre--maybe the click was to see what was obscured by the overlapping window.") + (* ;; "Handle mouse buttons that are clicked in a TEdit pane. ") (TOTOPW PANE) - - (* ;; "Original code tested a global variable TEDIT.SELPENDING to prevent a selection happening while another one was pending, perhaps in a different Tedit. That variable held the textobj so that only the right command loop would act. But now we set a variable directly in the command-process associated with this text, so no other Tedits will see our selection.") - (CL:WHEN (MOUSESTATE (OR LEFT MIDDLE RIGHT)) (* ;; "If no button is down, we got control on button-up transition, so ignore it.") - (RESETLST - [PROG ((TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of PANE)) - (DS (WINDOWPROP PANE 'DSP)) - (X (LASTMOUSEX PANE)) - (Y (LASTMOUSEY PANE)) - SOURCESEL SELOPERATION SELFN) - (CL:UNLESS TEXTOBJ (* ; "Not a Tedit window") - (RETURN)) - (TEXTOBJ! TEXTOBJ) + (RESETLST (* ; + "Getting TTYPROC here allows HELP in debugging") + (bind (TTYPROC _ (TTY.PROCESS)) + (TSTREAM _ (PANESTREAM PANE)) + (X _ (LASTMOUSEX PANE)) + (Y _ (LASTMOUSEY PANE)) + (DS _ (WINDOWPROP PANE 'DSP)) + (OLDX _ MIN.SMALLP) + (OLDY _ MIN.SMALLP) + (PREG _ (PANEREGION PANE)) + TEXTOBJ CURSEL NEWSEL CUROPERATION NEWOPERATION PENDINGDEL READONLY + declare (SPECVARS CURSEL) first - (* ;; "Pick off and return from a bunch of peripheral situations, then fall through to the complexities of normal text selection.") + (* ;; "Pick off and return from a bunch of peripheral situations, then fall through to the complexities of normal text selection.") - (CL:WHEN (OR (\TEDIT.BUTTONEVENTFN.INTITLE Y PANE TEXTOBJ) - (\TEDIT.BUTTONEVENTFN.INACTIVE TEXTOBJ PANE) - (\TEDIT.PANE.SPLIT TEXTOBJ PANE)) - (RETURN)) + (CL:UNLESS TSTREAM (RETURN)) + (SETQ TEXTOBJ (TEXTOBJ! (FGETTSTR TSTREAM TEXTOBJ))) + (CL:WHEN (OR (\TEDIT.BUTTONEVENTFN.INTITLE Y PANE + TEXTOBJ) + (\TEDIT.BUTTONEVENTFN.INACTIVE TEXTOBJ + PANE) + (\TEDIT.PANE.SPLIT TEXTOBJ PANE) + (NOT (\TEDIT.XYTOSEL.INLINEP X Y PANE + TEXTOBJ))) + (RETURN)) - (* ;; "") + (* ;; "") - (* ;; "The usual case -- he's really selecting something in this pane. And there's nothing else going on now.") + (* ;; + "The usual case -- a valid click in this pane. And there's nothing else going on now.") - (\CARET.DOWN) (* ; - "Make sure the caret isn't being displayed.") + (* ;; "Make sure the caret isn't being displayed, then change to the special tall one so it is easier to see during typein") + + (\CARET.DOWN) + [RESETSAVE (\TEDIT.CARET TEXTOBJ BXHICARET) + `(\TEDIT.CARET ,TEXTOBJ ,BXCARET] + + (* ;; "") + + (SETQ READONLY (FGETTOBJ TEXTOBJ TXTREADONLY)) + (SETQ CUROPERATION 'NORMAL) + (SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION + READONLY NIL)) + (CL:UNLESS (SETQ CURSEL ( + \TEDIT.BUTTONEVENTFN.CURSEL.INIT + NEWOPERATION TEXTOBJ)) + (RETURN)) + (SETQ NEWSEL (\TEDIT.COPYSEL CURSEL)) (* ; - "Make the caret be the special, tall one so he can see it.") - (RESETSAVE (for CARET in (GETTOBJ TEXTOBJ CARET) - do (replace TCCARET of CARET with (\CARET.CREATE BXHICARET))) - (LIST '\TEDIT.CARET (GETTOBJ TEXTOBJ CARET))) - (SETQ SELFN (GETTEXTPROP TEXTOBJ 'SELFN)) + "Gets line-chains and consistent initial looks") + eachtime (BLOCK) (* ; "Give other processes a chance") + (GETMOUSESTATE) (* ; + "And get the new mouse and key info") + (\TEDIT.CURSORMOVEDFN PANE) + (SETQ NEWOPERATION (\TEDIT.BUTTONEVENTFN.GETOPERATION READONLY CUROPERATION)) - (* ;; "") + (* ;; "We're done if keys and buttons are up") + until (AND (EQ NEWOPERATION 'NORMAL) + (ALLBUTTONSUP)) unless (AND (IEQP OLDX (SETQ X (LASTMOUSEX DS))) + (IEQP OLDY (SETQ Y (LASTMOUSEY DS))) + (EQ CUROPERATION NEWOPERATION)) + do + (* ;; "Polling loop, track the mouse until the buttons and modifier keys come up, i.e. NORMAL Nothing to do until the mouse moves or the operation changes. .") - (* ;; "Polling loop, track the mouse until the buttons/keys come up.") + (* ;; "First and always: CURSEL is ON at this point and matches the display. NEWSEL may not be well-defined.") - (SETQ SELOPERATION (\TEDIT.BUTTONEVENTFN.SELOPERATION TEXTOBJ)) - (bind (OSELOP _ SELOPERATION) - (OLDX _ MIN.SMALLP) - (OLDY _ MIN.SMALLP) - (PREG _ (DSPCLIPPINGREGION NIL PANE)) - OSEL EXTENDFLG first (SETQ SOURCESEL (FGETTOBJ TEXTOBJ SCRATCHSEL)) - (* ; "Get the storage and looks") - (SETQ OSEL (FGETTOBJ TEXTOBJ SCRATCHSEL2)) - (AND T (SETQ OSEL (create SELECTION - SELTEXTOBJ _ TEXTOBJ))) - (* ; - "TAKE THIS OUT WHEN SELTEXTOBJ GOES") - (\TEDIT.SET.SEL.LOOKS OSEL SELOPERATION) - (SELECTQ SELOPERATION - ((NORMAL DELETE) - (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL) - SOURCESEL) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - NIL) - (\TEDIT.COPYSEL (FGETTOBJ TEXTOBJ SEL) - OSEL)) - (\TEDIT.SET.SEL.LOOKS SOURCESEL SELOPERATION)) - (FSETSEL OSEL CH# 0) - while [OR (SHIFTDOWNP 'SHIFT) - (SHIFTDOWNP 'CTRL) - (SHIFTDOWNP 'META) - (KEYDOWNP 'MOVE) - (KEYDOWNP 'COPY) - (NOT (ZEROP (LOGAND LASTMOUSEBUTTONS 7] - do (* ; - "Poll the selection & display its current state") - (if (ZEROP (LOGAND LASTMOUSEBUTTONS 7)) - then (* ; - "No mouse buttons are down; don't try anything.") - (SETQ OLDX MIN.SMALLP) - else (SETQ SELOPERATION (\TEDIT.BUTTONEVENTFN.SELOPERATION TEXTOBJ))) - (if (AND (NOT (AND (IEQP OLDX (SETQ X (LASTMOUSEX DS))) - (IEQP OLDY (SETQ Y (LASTMOUSEY DS))) - (EQ OSELOP SELOPERATION))) - (INSIDEP PREG X Y)) - then - (* ;; "Only do selection if the mouse is inside the window proper and either the mouse has moved or the kind of selection has changed") - - (* ;; "Must precede the scroll-region test, so that we don't try to scroll while the mouse is inside the main window, even if the scroll bar overlaps the window (at left edge of screen, say)") - - (SETQ OLDX X) - (SETQ OLDY Y) - (SETQ EXTENDFLG NIL) - (if (\TEDIT.MOUSESTATE LEFT) - then (* ; "Left selects char/point") - (SETQ SOURCESEL (\TEDIT.SELECT X Y TEXTOBJ (FGETTOBJ - TEXTOBJ - MOUSEREGION - ) - NIL SELOPERATION PANE)) - elseif (\TEDIT.MOUSESTATE MIDDLE) - then (* ; "Middle selects word/line") - (SETQ SOURCESEL (\TEDIT.SELECT X Y TEXTOBJ (FGETTOBJ - TEXTOBJ - MOUSEREGION - ) - T SELOPERATION PANE)) - elseif (\TEDIT.MOUSESTATE RIGHT) - then (* ; - "RIght button extends last SOURCESEL") - (CL:UNLESS (EQ SELOPERATION OSELOP) - - (* ;; "Things changed since the last selection. Grab the prior selection info, so that the extension is taken from the selection NOW being made, rather than the last existing old-type selection.") - - (CL:WHEN OSEL (\TEDIT.COPYSEL OSEL SOURCESEL))) - (SETQ SOURCESEL (\TEDIT.COPYSEL SOURCESEL)) - (CL:WHEN (AND TEDIT.EXTEND.PENDING.DELETE - (EQ SELOPERATION 'NORMAL)) - - (* ;; - "Simulate Laurel bluependingdelete: black, deletes on type-in") - - (SETQ SELOPERATION 'PENDINGDEL) - (\TEDIT.SET.SEL.LOOKS SOURCESEL 'DELETE)) - (SETQ SOURCESEL (\TEDIT.COPYSEL (\TEDIT.EXTEND.SEL X Y - SOURCESEL TEXTOBJ - SELOPERATION PANE))) - (SETQ EXTENDFLG T)) - (CL:WHEN [AND SELFN SOURCESEL (FGETSEL SOURCESEL SET) - (EQ 'DON'T (APPLY* SELFN TEXTOBJ SOURCESEL - SELOPERATION 'TENTATIVE] - - (* ;; - "The selfn vetoed this selection, so mark it un-set and break out of the polling loop.") - - (\TEDIT.SHOWSEL SOURCESEL NIL) - (FSETSEL SOURCESEL SET NIL) - (RETURN)) - (CL:WHEN OSEL - (if (\TEDIT.SEL.CHANGED? SOURCESEL OSEL OSELOP SELOPERATION) - then - (* ;; - "Something interesting about the selection changed. We have to re-display its image.") - - (SETQ SOURCESEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ - SOURCESEL OSEL OSELOP - SELOPERATION EXTENDFLG)) - (SETQ OSELOP SELOPERATION) - elseif (AND (FGETSEL OSEL SET) - (EQ (FGETSEL OSEL SELKIND) - 'VOLATILE)) - then - (* ;; - "THIS MAY BE OLD, FROM A GLOBAL SET ELSEWHERE ?? MENU?") - - (* ;; "There is an old selection around, but it is VOLATILE -- i.e., it shouldn't last longer than something is pointing at it. Turn it off.") - - (\TEDIT.SHOWSEL OSEL NIL) - (FSETSEL OSEL SET NIL))) - (CL:WHEN SOURCESEL (* ; "Maybe clicked in the boonies?") - (SETQ OSEL (\TEDIT.COPYSEL SOURCESEL OSEL))) - elseif (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY) - then (* ; "Mouse moved to scroll bar") - (SCROLL.HANDLER PANE)) - (BLOCK) (* ; "Give other processes a chance") - (GETMOUSESTATE) (* ; "And get the new mouse info") - (\TEDIT.CURSORMOVEDFN PANE)) - - (* ;; "End Polling loop") - - (* ;; "") - - (CL:UNLESS (AND SOURCESEL (FGETSEL SOURCESEL SET)) - (* ; - "Bail if we didn't end up with an active selection") - (RETURN)) - (CL:UNLESS (INSIDEP (DSPCLIPPINGREGION NIL PANE) + (CL:UNLESS (INSIDEP (PANEREGION PANE PREG) X Y) (* ; - "Didn't end inside the window, abort cleanly") - (\TEDIT.SHOWSEL SOURCESEL NIL) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - NIL) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - T) - (RETURN)) - (CL:UNLESS (FGETTOBJ TEXTOBJ MENUFLG) (* ; - "Globals are documented, unfortunately. ") - (\TEDIT.SET.GLOBAL.SELECTIONS SELOPERATION SOURCESEL)) - (CL:UNLESS (MEMB SELOPERATION '(NORMAL PENDINGDEL)) + "The mouse left the window: cleanup and leave. ") + (CL:UNLESS (EQ CUROPERATION 'NORMAL) (* ; + "Take down the copy/delete/copylooks highlight") + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.SHOWSEL NIL T TEXTOBJ)) (* ; "Go back to original selection?") - (* ;; "If this is a normal selection, then the display now corresponds to SOURCESEL and is now correctly displayed. Otherwise, the selection in this TEXTOBJ is only a transient for this operation, turn it off here. ") + (* ;; + "Scroll if mouse moved to scroll bar (and scroll bar doesn't overlap the window)") - (\TEDIT.SHOWSEL SOURCESEL NIL)) + (CL:WHEN (IN/SCROLL/BAR? PANE LASTMOUSEX LASTMOUSEY) + (SCROLL.HANDLER PANE)) + (RETURN)) - (* ;; "Execute the SELOPERATION in the TTY process (maybe here)") + (* ;; "") - (\TEDIT.DO.SELOPERATION SOURCESEL SELOPERATION TEXTOBJ PANE) - (CL:WHEN (AND (FGETSEL SOURCESEL SELOBJ) - (IMAGEOBJPROP (FGETSEL SOURCESEL SELOBJ) - 'WHENOPERATEDONFN)) - (APPLY* (IMAGEOBJPROP (FGETSEL SOURCESEL SELOBJ) - 'WHENOPERATEDONFN) - (FGETSEL SOURCESEL SELOBJ) - PANE - 'SELECTED SOURCESEL (FGETTOBJ TEXTOBJ STREAMHINT))) - (CL:WHEN SELFN (* ; "Maybe for logging of selections?") - (APPLY* SELFN TEXTOBJ SOURCESEL SELOPERATION 'FINAL))]))]) + (* ;; "Ready to track the selection.") -(\TEDIT.DO.SELOPERATION - [LAMBDA (SOURCESEL SELOPERATION TEXTOBJ PANE) (* ; "Edited 21-Feb-2024 20:08 by rmk") + (SETQ OLDX X) + (SETQ OLDY Y) + (CL:UNLESS (EQ NEWOPERATION CUROPERATION) (* ; "Keys changed ") + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Switch to new highlighting") + (\TEDIT.SET.SEL.LOOKS CURSEL NEWOPERATION) + (\TEDIT.SET.SEL.LOOKS NEWSEL NEWOPERATION) + (CL:WHEN (EQ NEWOPERATION 'NORMAL) + + (* ;; "Switching from e.g. COPY to NORMAL with button down. Since we didn't start out NORMAL, the original normal selection is still on the screen. We take it down here, and establish the current (off) CURSEL as the new restoration selection") + + (\TEDIT.SHOWSEL NIL NIL TEXTOBJ) + (\TEDIT.COPYSEL CURSEL (TEXTSEL TEXTOBJ))) + (\TEDIT.SHOWSEL CURSEL T TEXTOBJ) + (SETQ CUROPERATION NEWOPERATION)) + + (* ;; "Update NEWSEL each time around. Note that \TEDIT.XYTOSEL fixes but doesn't show the selection, we do that here. MOUSEREGION is set by \TEDITCURSORMOVEDFN, below.") + + (if (\TEDIT.MOUSESTATE RIGHT) + then (* ; + "Right button: NEWSEL extends last CURSEL") + (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'RIGHT CURSEL) + (CL:WHEN (FGETSEL NEWSEL SET) + (CL:WHEN (AND TEDIT.EXTEND.PENDING.DELETE (NOT PENDINGDEL) + (EQ CUROPERATION 'NORMAL) + (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) + + (* ;; "Switch to simulation of Laurel bluependingdelete: Black, deletes on type-in. Coerce CURSEL and display for pending looks. Otherwise, CURSEL is already BPD and stays on to avoid flicker in extending") + + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (* ; + "Take down old looks, change, re-show") + (\TEDIT.SET.SEL.LOOKS CURSEL 'PENDINGDEL) + (\TEDIT.SET.SEL.LOOKS NEWSEL 'PENDINGDEL) + (\TEDIT.SHOWSEL CURSEL T TEXTOBJ) + (SETQ PENDINGDEL T)) + [\TEDIT.EXTEND.SEL NEWSEL CURSEL TEXTOBJ (MEMB CUROPERATION + '(COPY COPYLOOKS]) + (* ; "No valid selection, go to cleanup") + else (if (\TEDIT.MOUSESTATE LEFT) + then (* ; "Left selects char/point. ") + (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'LEFT CURSEL) + elseif (\TEDIT.MOUSESTATE MIDDLE) + then (* ; "Middle selects word/line") + (\TEDIT.XYTOSEL X Y NEWSEL TEXTOBJ CUROPERATION PANE 'MIDDLE CURSEL + )) + (CL:WHEN (AND (FGETSEL NEWSEL SET) + (\TEDIT.SEL.CHANGED? NEWSEL CURSEL) + (OR (NOT (ALLBUTTONSUP)) + (FGETSEL NEWSEL SELOBJ))) + + (* ;; "Selection has changed while at least one button is down. Take down current CURSEL highlighting, switch to NEWSEL. If the mouse condition is removed, the secondary selection can be lost if the mouse moves while the operation keys are still down. But if the copy isn't done when NEWSEL picks out an object, the object will be lost. ") + + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.COPYSEL NEWSEL CURSEL) + (\TEDIT.SHOWSEL CURSEL T TEXTOBJ))) + + (* ;; "CURSEL now matches the display and CUROPERATION.") + finally + + (* ;; "Out of Polling loop") + + (CL:UNLESS (FGETSEL NEWSEL SET) + + (* ;; ".Here to restore when no valid selection, maybe an unhappy image object?") + + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Turn off CURSEL") + (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) + 'NORMAL) (* ; "Restore TEXTSEL") + (\TEDIT.SHOWSEL NIL T TEXTOBJ) + (RETURN)) + (\TEDIT.BUTTONEVENTFN.DOOPERATION CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC))))]) + +(\TEDIT.BUTTONEVENTFN.DOOPERATION + [LAMBDA (CURSEL CUROPERATION TSTREAM PANE PENDINGDEL TTYPROC) + (* ; "Edited 25-Nov-2024 22:22 by rmk") + (* ; "Edited 4-Nov-2024 13:09 by rmk") + (* ; "Edited 3-Nov-2024 07:20 by rmk") + (* ; "Edited 17-Oct-2024 22:01 by rmk") + (* ; "Edited 7-Oct-2024 08:31 by rmk") + (* ; "Edited 4-Oct-2024 10:26 by rmk") + (* ; "Edited 2-Oct-2024 10:01 by rmk") + (* ; "Edited 12-Sep-2024 17:46 by rmk") + (* ; "Edited 10-Sep-2024 17:39 by rmk") + (* ; "Edited 27-Aug-2024 14:35 by rmk") + (* ; "Edited 24-Aug-2024 00:11 by rmk") + (* ; "Edited 19-Jul-2024 23:50 by rmk") + (* ; "Edited 22-Apr-2024 23:52 by rmk") (* ; "Edited 19-Feb-2024 00:13 by rmk") - (* ;; "Executes SELOPERATION in the TTY process. If the TTY process is a Tedit process (either this one or another one) and doesn't demand a COPYINSERT, this is accomplished by setting variables in that process' command loop.Otherwise, does a COPYINSERT into the TTY. ") + (* ;; "Executes CUROPERATION in the given TTY process. Calls FOREIGN.COPY if the TTY process is not a Tedit process (either this one or another one). ") - (LET* [(TTYPROC (TTY.PROCESS)) - (TTYW (PROCESSPROP TTYPROC 'WINDOW)) - (TTYTEXTOBJ (AND TTYW (fetch (TEXTWINDOW PTEXTOBJ) of TTYW] - (CL:WHEN (AND TTYTEXTOBJ (OR (GETTEXTPROP TTYTEXTOBJ 'COPYBYBKSYSBUF) - (FGETTOBJ TTYTEXTOBJ EDITOPACTIVE))) - (SETQ TTYTEXTOBJ NIL)) - (SELECTQ SELOPERATION - (COPY (CL:UNLESS TTYTEXTOBJ - (\TEDIT.COPYINSERT TTYW SOURCESEL) (* ; "Copy is done, nothing more to do") - (SETQ SELOPERATION NIL))) - (MOVE (CL:UNLESS TTYTEXTOBJ - (\TEDIT.COPYINSERT TTYW SOURCESEL) (* ; - "Copy is done, have to delete source") - (if T - then (* ; - "A remaining mystery: we should be able to execute this in PANE's Tedit process ") - (SETQ SELOPERATION NIL) - (\TEDIT.DELETE TEXTOBJ SOURCESEL) - else (SETQ SELOPERATION 'DELETE)))) - (PENDINGDEL (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T) - (SETQ SELOPERATION 'NORMAL)) - NIL) - (FSETTOBJ TEXTOBJ SELPANE PANE) - (CL:WHEN (AND SELOPERATION TTYTEXTOBJ) + (* ;; "NOTE: TTYPROC is passed in so that you can break or HELP without it changing to the break window. ") - (* ;; "Order of variables matters: SELOPERATION must be last.") + (* ;; "On entry, CURSEL's highlighting is on the screen") - [PROCESS.EVAL TTYPROC `(PROGN (SETQQ SOURCESEL ,SOURCESEL) - (SETQQ SELPANE ,PANE) - (SETQQ SELOPERATION ,SELOPERATION])]) + (CL:WHEN (FGETSEL CURSEL SET) + (LET* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (TTYW (PROCESSPROP TTYPROC 'WINDOW)) + (TTYSTREAM (AND TTYW (fetch (TEXTWINDOW WTEXTSTREAM) of TTYW))) + [TTYSEL (AND TTYSTREAM (TEXTSEL (GETTSTR TTYSTREAM TEXTOBJ] + (SELFN (GETTEXTPROP TEXTOBJ 'SELFN)) + (TEXTSEL (TEXTSEL TEXTOBJ))) -(\TEDIT.TTY.TEXTOBJP - [LAMBDA NIL (* ; "Edited 8-Feb-2024 16:52 by rmk") + (* ;; + "TTYSTREAM guaranteed EQ to TSTREAM for NORMAL and DELETE. TTYSEL is NIL for foreign copy.") + + (SELECTQ CUROPERATION + (NORMAL (\TEDIT.COPYSEL CURSEL TEXTSEL) + (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TEXTSEL)) + (if (FGETSEL TEXTSEL SELOBJ) + then (\TEDIT.OPERATE.OBJECT TSTREAM TEXTSEL PANE 'SELECTED) + else (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE PENDINGDEL) + (\TEDIT.SETCARET TEXTSEL PANE TEXTOBJ T))) + (DELETE + (* ;; "\TEDIT.DELETE converts TTYSEL (= TEXTSEL) to a point-caret.") + + (\TEDIT.COPYSEL CURSEL TEXTSEL) + (CL:WHEN (\TEDIT.DELETE TEXTOBJ TEXTSEL) + (* ; + "Make sure the caret blinks in the position of a successful deletion") + (FSETSEL TEXTSEL HASCARET T)) + (\TEDIT.SETCARET TEXTSEL PANE TEXTOBJ T)) + (COPY (CL:IF TTYSEL + (\TEDIT.COPY CURSEL TTYSEL TSTREAM TTYSTREAM) + (\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM)) + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ)) + (MOVE (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (if TTYSEL + then (\TEDIT.MOVE CURSEL TTYSEL TSTREAM TTYSTREAM) + else (\TEDIT.FOREIGN.COPY TTYW CURSEL TSTREAM) + (* ; "TEXTSEL moves to deletion point") + (\TEDIT.UPDATE.SEL TEXTSEL (FGETSEL CURSEL CH#) + 0 + 'RIGHT) + (\TEDIT.DELETE TEXTOBJ CURSEL) + (\TEDIT.SHOWSEL TEXTSEL T TEXTOBJ))) + (COPYLOOKS (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (if TTYSEL + then (if (EQ 'PARA (FGETSEL CURSEL SELKIND)) + then (\TEDIT.CHANGE.PARALOOKS TTYSTREAM + (PPARALOOKS (\TEDIT.CHTOPC (FGETSEL CURSEL CH#) + TEXTOBJ)) + TTYSEL) + else (\TEDIT.CHANGE.CHARLOOKS TTYSTREAM + (PCHARLOOKS (\TEDIT.CHTOPC (FGETSEL CURSEL CH#) + TEXTOBJ)) + TTYSEL)) + else (if (EQ 'PARA (FGETSEL CURSEL SELKIND)) + then (\TEDIT.CHANGE.PARALOOKS TSTREAM + (PPARALOOKS (\TEDIT.CHTOPC (FGETSEL CURSEL CH#) + TEXTOBJ)) + CURSEL) + else (\TEDIT.CHANGE.CHARLOOKS TSTREAM + (PCHARLOOKS (\TEDIT.CHTOPC (FGETSEL CURSEL CH#) + TEXTOBJ)) + CURSEL)))) + (\TEDIT.THELP "Bad selection operation" CUROPERATION)) + (CL:UNLESS PENDINGDEL + (\TEDIT.SET.SEL.LOOKS (TEXTSEL TEXTOBJ) + 'NORMAL)) + (CL:WHEN SELFN (* ; "Maybe for logging of selections?") + (APPLY* SELFN TEXTOBJ CURSEL CUROPERATION 'FINAL)) + (CL:UNLESS (FGETTOBJ TEXTOBJ MENUFLG) (* ; + "Globals are documented, unfortunately. ") + (\TEDIT.SET.GLOBAL.SELECTIONS CUROPERATION CURSEL))))]) + +(\TEDIT.BUTTONEVENTFN.GETOPERATION + [LAMBDA (READONLY CUROPERATION) (* ; "Edited 30-Sep-2024 08:34 by rmk") + (* ; "Edited 25-Sep-2024 11:48 by rmk") + (* ; "Edited 23-Sep-2024 22:29 by rmk") + (* ; "Edited 11-Sep-2024 14:45 by rmk") + (* ; "Edited 27-Aug-2024 22:29 by rmk") + (* ; "Edited 19-Aug-2024 00:47 by rmk") + (* ; "Edited 20-Jul-2024 13:01 by rmk") + (* ; "Edited 27-Jan-2024 12:55 by rmk") + + (* ;; "Look at the mode keys to figure out the new operation.") (* ;; - "Returns the TEXTOBJ of the TTY process, if it is a TEDIT command-loop process, otherwise NIL.") + "In a read-only document you cannot move or delete. Selection is NORMAL if no keys are down. ") - (LET* [(TTYPROC (TTY.PROCESS)) - (TTYW (PROCESSPROP TTYPROC 'WINDOW] - (CL:WHEN TTYW - (fetch (TEXTWINDOW PTEXTOBJ) of TTYW))]) + (CL:WHEN [AND (EQ 'MOVE CUROPERATION) + (NEQ (SHIFTDOWNP 'SHIFT) + (SHIFTDOWNP 'CTRL] -(\TEDIT.BUTTONEVENTFN.SELOPERATION - [LAMBDA (TEXTOBJ) (* ; "Edited 27-Jan-2024 12:55 by rmk") - (COND - ((KEYDOWNP 'COPY) (* ; - "In a read-only document, you can only copy.") - 'COPY) - ((AND (KEYDOWNP 'MOVE) - (NOT (GETTOBJ TEXTOBJ TXTREADONLY))) (* ; - "The MOVE key is down, so set MOVE mode.") - 'MOVE) - [(SHIFTDOWNP 'SHIFT) (* ; - "the SHIFT key is down; mark this selection for COPY or MOVE.") - (COND - ((AND (SHIFTDOWNP 'CTRL) - (NOT (GETTOBJ TEXTOBJ TXTREADONLY))) (* ; "CTRL-SHIFT select means MOVE.") - 'MOVE) - (T 'COPY] - ((SHIFTDOWNP 'META) (* ; - "He's holding the meta key down , do a copylooks selection") - 'COPYLOOKS) - ((AND (SHIFTDOWNP 'CTRL) - (NOT (GETTOBJ TEXTOBJ TXTREADONLY))) (* ; - "Note that he's holding the control key down.") - 'DELETE) - (T 'NORMAL]) + (* ;; "If both were down (MOVE) and now they're in different states, wait a bit to see what the other one will do.") + + (DISMISS 50 NIL T)) + (if (AND (SHIFTDOWNP 'CTRL) + (NOT READONLY)) + then (if (SHIFTDOWNP 'SHIFT) + then 'MOVE + else 'DELETE) + elseif (OR (SHIFTDOWNP 'SHIFT) + (KEYDOWNP 'COPY)) + then 'COPY + elseif (SHIFTDOWNP 'META) + then 'COPYLOOKS + else (* ; "No keys down") + 'NORMAL]) + +(\TEDIT.BUTTONEVENTFN.CURSEL.INIT + [LAMBDA (NEWOPERATION TEXTOBJ) (* ; "Edited 30-Nov-2024 15:45 by rmk") + (* ; "Edited 27-Nov-2024 20:23 by rmk") + (* ; "Edited 22-Oct-2024 23:10 by rmk") + (* ; "Edited 20-Oct-2024 23:38 by rmk") + (* ; "Edited 2-Oct-2024 09:59 by rmk") + (* ; "Edited 12-Sep-2024 17:14 by rmk") + + (* ;; "Create and initialize CURSEL according to NEWOPERATION. Start with copy of TEXTSEL so line-chains correspond to the number of split panes. TEXTSEL maybe taken down but is otherwise not modified.") + + (* ;; "NILvalue signals abort") + + (PROG [(CURSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ] + (SELECTQ NEWOPERATION + (NORMAL + (* ;; + "Operating in this document. Our initial CURSEL is consistent with TEXTSEL and display.") + + (FSETSEL (TEXTSEL TEXTOBJ) + ONFLG NIL) (* ; + "Transferred display status to CURSEL, restore later if needed") + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) (* ; "Take down current hilight") + (if (\TEDIT.MOUSESTATE RIGHT) + then + (* ;; "Extending the current selection: coerce to PENDINGDEL/black") + + (\TEDIT.SET.SEL.LOOKS CURSEL 'PENDINGDEL) + elseif (FGETTOBJ TEXTOBJ BLUEPENDINGDELETE) + then + (* ;; + "Not extending: turn off BPD highlighting and reduce to a point selection at the caret.") + + (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE NIL) + (\TEDIT.UPDATE.SEL CURSEL (TEDIT.GETPOINT TEXTOBJ CURSEL) + 0 NIL 'NORMAL) + (\TEDIT.FIXSEL CURSEL TEXTOBJ) + (\TEDIT.SHOWSEL CURSEL T TEXTOBJ)) + (\TEDIT.SHOWSEL CURSEL T TEXTOBJ)) + (DELETE + (* ;; + "Deleting (CTRL) somewhere else. Turn off CURSEL's highlighting, which was transferred from TEXTSEL") + + (\TEDIT.SHOWSEL CURSEL NIL TEXTOBJ) + (\TEDIT.SET.SEL.LOOKS CURSEL 'DELETE)) + ((MOVE COPY COPYLOOKS) + (* ;; "Source text from here, TTY target maythat be here, another Tedit, or foreign. TEXTSEL remains visible ") + + (CL:WHEN (\TEDIT.MOUSESTATE RIGHT) (* ; "Funny to copy while extending") + (RETURN)) + (\TEDIT.SET.SEL.LOOKS CURSEL NEWOPERATION) + (FSETSEL CURSEL SET NIL)) + (FSETSEL CURSEL SET NIL)) + (RETURN CURSEL]) (\TEDIT.BUTTONEVENTFN.INACTIVE - [LAMBDA (TEXTOBJ PANE) (* ; "Edited 16-Mar-2024 00:22 by rmk") + [LAMBDA (TEXTOBJ PANE) (* ; "Edited 24-Apr-2024 09:45 by rmk") + (* ; "Edited 16-Mar-2024 00:22 by rmk") (* ; "Edited 9-Feb-2024 00:00 by rmk") (* ; "Edited 27-Jan-2024 11:40 by rmk") @@ -1185,66 +1459,95 @@ (* ;; "Why do we need a Middle-button menu to restart a dead window. If it's clicked in, just restart it.") (SETTOBJ TEXTOBJ EDITOPACTIVE NIL) - (TEDIT (GETTOBJ TEXTOBJ STREAMHINT) + (TEDIT (fetch (TEXTWINDOW WTEXTSTREAM) of PANE) PANE) NIL]) (\TEDIT.BUTTONEVENTFN.INTITLE - [LAMBDA (Y PANE TEXTOBJ) (* ; "Edited 27-Jan-2024 10:42 by rmk") + [LAMBDA (Y PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 12:02 by rmk") + (* ; "Edited 13-Jun-2024 22:10 by rmk") + (* ; "Edited 27-Jan-2024 10:42 by rmk") (* ;; "Special behavior if Y is the title region of PANE?") - (LET ((PREG (DSPCLIPPINGREGION NIL PANE)) - USERFN) - (CL:WHEN (IGREATERP Y (fetch TOP of PREG)) - [COND - ((\TEDIT.MOUSESTATE RIGHT) - (DOWINDOWCOM PANE)) - ((AND (OR (SHIFTDOWNP 'SHIFT) - (KEYDOWNP 'COPY)) - (MOUSESTATE LEFT)) - (bind THING unless (OR (SHIFTDOWNP 'SHIFT) - (KEYDOWNP 'COPY)) - do (GETMOUSESTATE) - (CL:UNLESS (INSIDEP PREG (LASTMOUSEX PANE) - (LASTMOUSEY PANE)) - (CL:WHEN [SETQ THING (OR (GETTOBJ TEXTOBJ TXTFILE) - (GETTEXTPROP TEXTOBJ 'ITEM-NAME] - (COPYINSERT (CL:IF (STREAMP THING) - (MKSTRING (FULLNAME THING)) - THING)))) - (RETURN))) - ((MOUSESTATE (OR LEFT MIDDLE)) - (CL:WHEN (AND (SETQ USERFN (WINDOWPROP PANE 'TEDIT.TITLEMENUFN)) - (NEQ USERFN 'DON'T)) - (ADD.PROCESS (LIST USERFN (KWOTE PANE))))] + (LET (USERFN) + (CL:WHEN (IGREATERP Y (PANETOP PANE)) + [if (\TEDIT.MOUSESTATE RIGHT) + then (DOWINDOWCOM PANE) + elseif (AND (OR (SHIFTDOWNP 'SHIFT) + (KEYDOWNP 'COPY)) + (MOUSESTATE LEFT)) + then (bind THING unless (OR (SHIFTDOWNP 'SHIFT) + (KEYDOWNP 'COPY)) + do (GETMOUSESTATE) + (CL:UNLESS (INSIDEP (PANEREGION PANE) + (LASTMOUSEX PANE) + (LASTMOUSEY PANE)) + (CL:WHEN [SETQ THING (OR (GETTOBJ TEXTOBJ TXTFILE) + (GETTEXTPROP TEXTOBJ 'ITEM-NAME] + (COPYINSERT (CL:IF (STREAMP THING) + (MKSTRING (FULLNAME THING)) + THING)))) + (RETURN)) + elseif (MOUSESTATE (OR LEFT MIDDLE)) + then (CL:WHEN (AND (SETQ USERFN (WINDOWPROP PANE 'TEDIT.TITLEMENUFN)) + (NEQ USERFN 'DON'T)) + (ADD.PROCESS (LIST USERFN (KWOTE PANE))))] T)]) -(\TEDIT.COPYINSERT - [LAMBDA (TTYW SOURCESEL) (* ; "Edited 17-Feb-2024 12:52 by rmk") +(\TEDIT.COPYINSERTFN + [LAMBDA (INSERTION PANE) (* ; "Edited 27-Aug-2024 10:38 by rmk") + (* ; "Edited 7-Jul-2024 09:26 by rmk") + (* ; "Edited 29-Apr-2024 13:37 by rmk") + (* ; "Edited 22-Apr-2024 23:47 by rmk") + (* ; "Edited 17-Feb-2024 12:52 by rmk") - (* ;; "Inserts the information in SOURCESEL into the TTY window.") + (* ;; "The COPYINSERTFN of Tedit windows. INSERTION is inserted into the TSTREAM of PANE.") - (if (AND NIL (WINDOWPROP TTYW 'COPYINSERTFN)) - then - (* ;; "This is a stub for a definition that knows how to do a looked string object, given that the destination TTY window has a COPYINSERTFN. OBJECTFROMSEL is in {LFG}tedit/UNBREAKABLESTRING") + (* ;; "IRM says that it should use BKSYSBUF for strings.") - (COPYINSERT (OBJECTFROMSEL SOURCESEL)) - else - (* ;; "Have to go character by character because COPYINSERT does (PRIN2 BKSYSBUF), which creates undesired string quotes.") + (LET ((TSTREAM (TEXTSTREAM PANE))) + (for I inside INSERTION do (if (IMAGEOBJP I) + then (TEDIT.INSERT.OBJECT I TSTREAM) + elseif (OR (STRINGP I) + (LITATOM I)) + then (TEDIT.INSERT TSTREAM I]) - (for CHNO CH (SOURCETOBJ _ (GETSEL SOURCESEL SELTEXTOBJ)) from (FGETSEL SOURCESEL CH#) - to (SUB1 (FGETSEL SOURCESEL CHLIM)) while (SETQ CH (TEDIT.NTHCHARCODE SOURCETOBJ CHNO)) - do (CL:IF (IMAGEOBJP CH) - (COPYINSERT CH) - (BKSYSBUF (CHARACTER CH)))]) +(\TEDIT.FOREIGN.COPY + [LAMBDA (TTYW SOURCESEL SOURCESTREAM BKSYSBUFP) (* ; "Edited 27-Aug-2024 13:38 by rmk") + (* ; "Edited 7-Jul-2024 09:26 by rmk") + (* ; "Edited 29-Apr-2024 13:37 by rmk") + (* ; "Edited 22-Apr-2024 23:47 by rmk") + (* ; "Edited 17-Feb-2024 12:52 by rmk") + + (* ;; "Inserts the information in SOURCESEL into a non-Tedit TTY stream.") + + (CL:WHEN (IGREATERP (GETSEL SOURCESEL DCH) + 0) (* ; "If empty, nothing to do") + [if (AND NIL (NOT BKSYSBUFP) + (WINDOWPROP TTYW 'COPYINSERTFN)) + then + (* ;; "This is a stub for a definition that knows how to do a looked string object, given that the destination TTY window has a COPYINSERTFN. OBJECTFROMSEL is in {LFG}tedit/UNBREAKABLESTRING") + + (COPYINSERT (OBJECTFROMSEL SOURCESEL)) + else + (* ;; "Have to go character by character because COPYINSERT does (PRIN2 BKSYSBUF), which creates undesired string quotes.") + + (for CHNO CH from (FGETSEL SOURCESEL CH#) to (SUB1 (FGETSEL SOURCESEL CHLIM)) + while (SETQ CH (TEDIT.NTHCHARCODE SOURCESTREAM CHNO)) + do + (* ;; "Maybe should apply the preprintfn ?") + + (CL:IF (IMAGEOBJP CH) + (COPYINSERT CH) + (BKSYSBUF (CHARACTER CH)))])]) ) - -(MOVD? 'NILL '\TEDIT.COPYINSERT) (DEFINEQ (\TEDIT.PANE.SPLIT - [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 27-Jan-2024 11:39 by rmk") + [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 23-Oct-2024 09:50 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 27-Jan-2024 11:39 by rmk") (* ; "Edited 1-Oct-2023 23:30 by rmk") (* ; "Edited 12-Oct-2021 15:01 by rmk:") @@ -1298,110 +1601,127 @@ (\TEDIT.UNSPLITW WINDOWTOSPLIT)) (MOVE (* ;  "Moving the divider between two panes.") - (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T)) - (SHOULDNT))) + (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T T + )) + (\TEDIT.THELP))) (T (CURSOR T] T)]) (\TEDIT.SPLITW - [LAMBDA (OLDPANE Y) (* ; "Edited 20-Mar-2024 11:01 by rmk") - (* ; "Edited 15-Mar-2024 22:00 by rmk") + [LAMBDA (OLDPANE Y) (* ; "Edited 1-Dec-2024 11:27 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 18:59 by rmk") + (* ; "Edited 5-Jul-2024 11:37 by rmk") + (* ; "Edited 30-Jun-2024 21:59 by rmk") + (* ; "Edited 28-Jun-2024 21:08 by rmk") + (* ; "Edited 21-Jun-2024 22:47 by rmk") + (* ; "Edited 19-Jun-2024 08:57 by rmk") + (* ; "Edited 17-Jun-2024 09:01 by rmk") + (* ; "Edited 13-Jun-2024 17:34 by rmk") + (* ; "Edited 18-May-2024 16:24 by rmk") + (* ; "Edited 24-Apr-2024 09:42 by rmk") + (* ; "Edited 5-May-2024 23:13 by rmk") + (* ; "Edited 20-Mar-2024 11:01 by rmk") (* ; "Edited 8-Feb-2024 23:38 by rmk") (* ; "Edited 2-Jan-2024 19:21 by rmk") (* ; "Edited 4-Oct-2023 10:37 by rmk") - (* ; "Edited 1-Oct-2023 11:58 by rmk") - (* ; "Edited 22-Sep-2023 20:53 by rmk") (* ; "Edited 5-Nov-2022 23:51 by rmk") (* ; "Edited 30-May-91 23:38 by jds") (* ;; "Split window OLDPANE at window-relelative Y into 2 panes that can scroll independently.") + (* ;; "Note that TSTREAM and TEXTOBJ are the same for all panes.") + (* ;; "Original code was goofy: after carefully setting things up, attached menus and prompts would move into the main-window space. Setting and reseting the ATTACHEDWINDOWS property seems to fix that.") - (LET ((WREG (WINDOWPROP OLDPANE 'REGION)) - (TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of OLDPANE))) - (NEXTPANE (fetch (TEXTWINDOW NEXTPANE) of OLDPANE)) - ATTACHEDWINDOWS NEWPANE PROPS NEWFIRSTLINE SEL) - (CL:UNLESS Y - (SETQ Y (LASTMOUSEY OLDPANE))) (* ; "Get the Y-position where we're to make the split--it's either supplied or we use the mouse's Y position.") - (CL:WHEN NEXTPANE (* ; + (LET* ((WREG (WINDOWPROP OLDPANE 'REGION)) + (TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of OLDPANE)) + (TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (SEL (TEXTSEL TEXTOBJ)) + (NEXTPANE (GETPANEPROP (PANEPROPS OLDPANE) + NEXTPANE)) + ATTACHEDWINDOWS NEWPANE PROPS NEXTCHAR1) + (CL:UNLESS Y (* ; + "Y-position of the split, either supplied or mouse.") + (SETQ Y (LASTMOUSEY OLDPANE))) + (CL:WHEN NEXTPANE (* ;  "If there's already a pane below this one, detach it for the moment.") - (DETACHWINDOW NEXTPANE)) - (SETQ ATTACHEDWINDOWS (WINDOWPROP OLDPANE 'ATTACHEDWINDOWS NIL)) - (SHAPEW OLDPANE (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM of WREG) - Y) - HEIGHT _ (IDIFFERENCE (fetch HEIGHT of WREG) - Y))) - (* ; - "Reshape the original window to form the upper pane. This fixes/displays the current selection.") + (DETACHWINDOW NEXTPANE)) + (SETQ ATTACHEDWINDOWS (WINDOWPROP OLDPANE 'ATTACHEDWINDOWS NIL)) - (* ;; "Attach the new window, without disturbing the pre-existing attached windows") + (* ;; "Reshape the original window to form the upper pane. This fixes/displays the current selection in all existing panes") - (ATTACHWINDOW (SETQ NEWPANE (CREATEW (create REGION using WREG HEIGHT _ Y) - NIL NIL NIL)) - OLDPANE - 'BOTTOM - 'JUSTIFY - 'MAIN) (* ; "and attach a lower pane.") - [WINDOWPROP OLDPANE 'ATTACHEDWINDOWS (APPEND ATTACHEDWINDOWS (WINDOWPROP OLDPANE - 'ATTACHEDWINDOWS] + (SHAPEW OLDPANE (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM of WREG) + Y) + HEIGHT _ (IDIFFERENCE (fetch HEIGHT of WREG) + Y))) - (* ;; "[end of attached-window hackery to prevent disturbance while short]") + (* ;; + "OLDPANE has now been shrunk, redisplayed with new lines, and highlighted. The selection is on.") - (* ;; "") + (* ;; "Attach the new window, without disturbing the pre-existing attached windows") - (WINDOWPROP NEWPANE 'TEDITCREATED T) - (DSPFONT (fetch (CHARLOOKS CLFONT) of (FGETTOBJ TEXTOBJ CARETLOOKS)) - NEWPANE) (* ; + (SETQ NEWPANE (CREATEW (create REGION using WREG HEIGHT _ Y))) + (ATTACHWINDOW NEWPANE OLDPANE 'BOTTOM 'JUSTIFY 'MAIN) + (* ; "and attach a lower pane.") + [WINDOWPROP OLDPANE 'ATTACHEDWINDOWS (APPEND ATTACHEDWINDOWS (WINDOWPROP OLDPANE + 'ATTACHEDWINDOWS] + + (* ;; "[end of attached-window hackery to prevent disturbance while short]") + + (* ;; "") + + (WINDOWPROP NEWPANE 'TEDITCREATED T) + (DSPFONT (GETCLOOKS (FGETTOBJ TEXTOBJ CARETLOOKS) + CLFONT) + NEWPANE) (* ;  "Set the font on the display stream to be the current one from CARETLOOKS") - (* ;; "Not sure if same PROPS as for PANE (which this would inherit from primary window)") + (* ;; + "Not sure if same PROPS as for OLDPANE (which this would inherit from primary window)") - [SETQ PROPS (APPEND '(NOTITLE T PROMPTWINDOW DON'T TITLEMENUFN NILL) - (COPY (FGETTOBJ TEXTOBJ EDITPROPS] - (\TEDIT.MINIMAL.WINDOW.SETUP NEWPANE (FGETTOBJ TEXTOBJ STREAMHINT) - PROPS OLDPANE) + [SETQ PROPS (APPEND '(NOTITLE T PROMPTWINDOW DON'T TITLEMENUFN NILL) + (COPY (FGETTOBJ TEXTOBJ EDITPROPS] + (\TEDIT.MINIMAL.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE) - (* ;; "Insert L1 and LN cells for NEWPANEafter OLDPANE's cells in each selection. The selections were created when the original textsteam was opened.") + (* ;; "Insert L1 and LN cells for NEWPANEafter OLDPANE's cells in each selection. The selections were created when the original textsteam was opened.") - (for S in (\TEDIT.COLLECTSELS TEXTOBJ) do (for PANE inpanes (PROGN TEXTOBJ) as L1 - on (GETSEL S L1) as LN - on (GETSEL S LN) when (EQ PANE OLDPANE) - do (push (CDR L1) - NIL) - (push (CDR LN) - NIL))) + (* ;; "Create the first line of NEWPANE starting at the character just after the last line of the now-shrunken OLDPANE. ") - (* ;; "Create the FIRSTLINE of NEWPANE starting at the character just after the last line of the now-shrunken OLDPANE.") + [SETQ NEXTCHAR1 (for L (BOTTOM _ (PANEBOTTOM OLDPANE)) inlines (PANEPREFIX OLDPANE) + unless (AND (FGETLD L NEXTLINE) + (IGEQ (FGETLD (FGETLD L NEXTLINE) + YBOT) + BOTTOM)) + do + (* ;; + "If we run off the end of the text, start with at least the last line (which may just be EOL's).") - [SETQ NEWFIRSTLINE (for L inlines (fetch (TEXTWINDOW PLINES) of OLDPANE) - unless (FGETLD L NEXTLINE) - do (RETURN (\TEDIT.FORMATLINE TEXTOBJ (ADD1 (FGETLD L LCHARLIM] - (\TEDIT.WINDOW.SETUP NEWPANE (FGETTOBJ TEXTOBJ STREAMHINT) - PROPS OLDPANE NEWFIRSTLINE) - (CL:WHEN NEWFIRSTLINE - (\TEDIT.FILLPANE (GETLD NEWFIRSTLINE PREVLINE) - TEXTOBJ NEWPANE)) - (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL NEWPANE) - (CL:WHEN (GETSEL SEL ONFLG) - (SETSEL SEL ONFLG NIL) (* ; + (RETURN (if (AND (IGEQ (FGETLD L LCHAR1) + (TEXTLEN TEXTOBJ)) + (FGETLD L PREVLINE)) + then (FGETLD (FGETLD L PREVLINE) + LCHAR1) + else (FGETLD L LCHARLIM] + (\TEDIT.WINDOW.SETUP NEWPANE TSTREAM PROPS OLDPANE NEXTCHAR1) + (* ; " OLDPANE covers everything before") + (WINDOWPROP NEWPANE 'PROCESS (WINDOWPROP OLDPANE 'PROCESS)) + (CL:WHEN (GETSEL SEL ONFLG) + (SETSEL SEL ONFLG NIL) (* ;  "Turn it off, so we can turn it on for NEWPANE") - (\TEDIT.SHOWSEL SEL T NEWPANE)) - (WINDOWPROP NEWPANE 'PROCESS (WINDOWPROP OLDPANE 'PROCESS)) - (replace (TEXTWINDOW NEXTPANE) of OLDPANE with NEWPANE) - (* ; - "Tell the this pane about the new pane just below it") - (CL:WHEN NEXTPANE (* ; + (\TEDIT.SHOWSEL SEL T TEXTOBJ NEWPANE)) (* ; + "Tell NEWPANE about the old pane below it") + (CL:WHEN NEXTPANE (* ;  "There was already a pane below this one. Attach it to the new lower pane.") - (ATTACHWINDOW NEXTPANE NEWPANE 'BOTTOM 'JUSTIFY 'MAIN) - (* ; - "Tell the lower pane about its lower, lower pane..") - (replace (TEXTWINDOW NEXTPANE) of NEWPANE with NEXTPANE))]) + (ATTACHWINDOW NEXTPANE NEWPANE 'BOTTOM 'JUSTIFY 'MAIN))]) (\TEDIT.UNSPLITW - [LAMBDA (PANE) (* ; "Edited 20-Mar-2024 11:01 by rmk") + [LAMBDA (PANE) (* ; "Edited 1-Jul-2024 08:50 by rmk") + (* ; "Edited 29-Jun-2024 09:00 by rmk") + (* ; "Edited 18-May-2024 16:21 by rmk") + (* ; "Edited 12-May-2024 20:58 by rmk") (* ; "Edited 15-Mar-2024 18:30 by rmk") + (* ; "Edited 20-Mar-2024 11:01 by rmk") (* ; "Edited 21-Feb-2024 08:31 by rmk") (* ; "Edited 11-Feb-2024 11:14 by rmk") (* ; "Edited 2-Jan-2024 21:11 by rmk") @@ -1410,36 +1730,26 @@ (* ; "Edited 2-Sep-2023 16:18 by rmk") (* ; "Edited 18-Apr-2023 23:41 by rmk") (* ; "Edited 6-Nov-2022 00:06 by rmk") - (PROG* ((TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW WTEXTOBJ) of PANE))) - (PANES (GETTOBJ TEXTOBJ \WINDOW)) - (PRIMARYPANE (\TEDIT.MAINW PANE)) + (PROG* ((TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)) + (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) (SEL (FGETTOBJ TEXTOBJ SEL)) - PRIORPANE NEXTPANE ATTACHEDWINDOWS) - (CL:WHEN (EQ PANE PRIMARYPANE) - (TEDIT.PROMPTPRINT TEXTOBJ "Can't UNSPLIT the main window" T) - (RETURN)) - [SETQ PRIORPANE (find P in PANES suchthat (EQ PANE (fetch (TEXTWINDOW NEXTPANE) - of P] - (SETQ NEXTPANE (fetch (TEXTWINDOW NEXTPANE) of PANE)) - (\TEDIT.SHOWSEL SEL NIL) (* ; - "Turn off selections during the unsplit.") - (FSETTOBJ TEXTOBJ SELPANE PRIMARYPANE) - (for P in PANES as CARET in (GETTOBJ TEXTOBJ CARET) as SL1 in (GETSEL SEL L1) as SLN - in (GETSEL SEL LN) when (EQ PANE P) do (change (GETTOBJ TEXTOBJ CARET TEXTOBJ) - (DREMOVE CARET DATUM)) - (change (GETSEL SEL L1) - (DREMOVE SL1 DATUM)) - (change (GETSEL SEL LN) - (DREMOVE SLN DATUM)) - (RETURN)) + PREVPANE NEXTPANE ATTACHEDWINDOWS) + (CL:WHEN (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (RETURN)) + (SETQ PREVPANE (GETPANEPROP (PANEPROPS PANE) + PREVPANE)) + (SETQ NEXTPANE (GETPANEPROP (PANEPROPS PANE) + NEXTPANE)) + (FSETTOBJ TEXTOBJ SELPANE (FGETTOBJ TEXTOBJ PRIMARYPANE)) + (for P inpanes TEXTOBJ as SL1 in (GETSEL SEL L1) as SLN in (GETSEL SEL LN) + when (EQ PANE P) do (change (GETSEL SEL L1) + (DREMOVE SL1 DATUM)) + (change (GETSEL SEL LN) + (DREMOVE SLN DATUM)) + (RETURN)) (WINDOWPROP PANE 'CURSOROUTFN NIL) - (WINDOWPROP PANE 'CURSORMOVEDFN NIL) (* ; "Disconnect") - (replace (TEXTWINDOW WTEXTSTREAM) of PANE with NIL) - (SETTOBJ TEXTOBJ \WINDOW (DREMOVE PANE PANES)) - (replace (TEXTWINDOW NEXTPANE) of PANE with NIL) - (\TEDIT.FIXSEL (TEXTSEL TEXTOBJ) - TEXTOBJ) - (replace (TEXTWINDOW NEXTPANE) of PRIORPANE with NEXTPANE) + (WINDOWPROP PANE 'CURSORMOVEDFN NIL) + (\TEDIT.UNLINKPANE PANE) (* ; "Disconnect") (* ;; "") @@ -1451,19 +1761,53 @@ (* ;; "Original code moved the promptwindow and attached menus down into the region of the main window, shrinking the overall footprint. This code only unsplits the target pane, leaving everything else unchanged.") (DETACHWINDOW PANE) - (SETQ ATTACHEDWINDOWS (WINDOWPROP PRIORPANE 'ATTACHEDWINDOWS NIL)) - [SHAPEW PRIORPANE (UNIONREGIONS (WINDOWPROP PANE 'REGION) - (WINDOWPROP PRIORPANE 'REGION] - (WINDOWPROP PRIORPANE 'ATTACHEDWINDOWS ATTACHEDWINDOWS) + (SETQ ATTACHEDWINDOWS (WINDOWPROP PREVPANE 'ATTACHEDWINDOWS NIL)) + [SHAPEW PREVPANE (UNIONREGIONS (WINDOWPROP PANE 'REGION) + (WINDOWPROP PREVPANE 'REGION] + (WINDOWPROP PREVPANE 'ATTACHEDWINDOWS ATTACHEDWINDOWS) (CL:WHEN NEXTPANE (* ;; - "PANE had a yet lower pane attached to it. Promote it to PANE's position in the NEXTPANE chain") + "PANE had a yet lower pane attached to it. Promote it to PANE's position in the attachment chain") (DETACHWINDOW NEXTPANE) - (ATTACHWINDOW NEXTPANE PRIORPANE 'BOTTOM 'JUSTIFY 'MAIN)) - (CLOSEW PANE) - (\TEDIT.SHOWSEL SEL T]) + (ATTACHWINDOW NEXTPANE PREVPANE 'BOTTOM 'JUSTIFY 'MAIN)) + (CLOSEW PANE]) + +(\TEDIT.LINKPANES + [LAMBDA (PANE1 PANE2) (* ; "Edited 1-Jul-2024 08:39 by rmk") + (* ; "Edited 29-Jun-2024 00:12 by rmk") + + (* ;; "Splices PANE2 into the pane sequence after existing PANE1") + + (LET ((PPROPS1 (PANEPROPS PANE1)) + (PPROPS2 (PANEPROPS PANE2)) + PANE1NEXT) + (SETQ PANE1NEXT (GETPANEPROP PPROPS1 NEXTPANE)) + (SETPANEPROP PPROPS2 PREVPANE PANE1) + (SETPANEPROP PPROPS2 NEXTPANE (GETPANEPROP PPROPS1 NEXTPANE)) + (SETPANEPROP PPROPS1 NEXTPANE PANE2) + (CL:WHEN PANE1NEXT + (SETPANEPROP (PANEPROPS PANE1NEXT) + PREVPANE PANE2)) + PANE2]) + +(\TEDIT.UNLINKPANE + [LAMBDA (PANE) (* ; "Edited 28-Jun-2024 23:47 by rmk") + + (* ;; "Removes PANE from its PANE sequence") + + (LET ((PANEPROPS (PANEPROPS PANE)) + NEXT PREV) + (SETQ NEXT (GETPANEPROP PANEPROPS NEXTPANE)) + (SETQ PREV (GETPANEPROP PANEPROPS PREVPANE)) + (CL:WHEN PREV + (SETPANEPROP (PANEPROPS PREV) + NEXTPANE NEXT)) + (CL:WHEN NEXT + (SETPANEPROP (PANEPROPS NEXT) + PREVPANE PREV)) + PREV]) ) (MOVD? 'NILL 'GRAB-TYPED-REGION) @@ -1474,7 +1818,7 @@ (RPAQ? \TEDIT.OP.BOTTOM 12) -(RPAQ? \TEDIT.LINEREGION.WIDTH 8) +(RPAQ? \TEDIT.LINEREGION.WIDTH 12) (DECLARE%: DONTEVAL@LOAD DOCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -1503,16 +1847,16 @@ (DEFINEQ (TEDITWINDOWP - [LAMBDA (WINDOW) (* ; "Edited 22-Jan-2024 10:57 by rmk") + [LAMBDA (WINDOW) (* ; "Edited 28-Jun-2024 22:16 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 22-Jan-2024 10:57 by rmk") (* ; "Edited 15-Sep-2023 21:03 by rmk") (* ; "Edited 16-Jan-89 10:28 by jds") - (* ;; "If WINDOW is or denotes the window of a text stream, returns that textstream's window. The test is that the returned window has a TEXTOBJ property, and the TEXTOBJ thinks this is its window.") + (* ;; "If WINDOW is or denotes the window of a text stream, returns that textstream's primary pane. The test is that the returned window has a TEXTOBJ property, and the TEXTOBJ thinks this is its primary pane.") - (LET* [(TEXTOBJ (TEXTOBJ WINDOW T)) - (CHECKED-WINDOW (AND TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ] - (AND CHECKED-WINDOW (MEMB CHECKED-WINDOW (FGETTOBJ TEXTOBJ \WINDOW)) - CHECKED-WINDOW]) + (LET ((TEXTOBJ (TEXTOBJ WINDOW T))) + (CL:WHEN TEXTOBJ (GETTOBJ TEXTOBJ PRIMARYPANE]) ) @@ -1568,6 +1912,8 @@ (\TEDIT.MAKEFILENAME [LAMBDA (STRING) + (* ;; "Edited 29-Jun-2024 16:26 by rmk") + (* ;; "Edited 18-Dec-2023 22:45 by rmk") (* ;; "Edited 9-Sep-2023 17:13 by rmk") @@ -1579,6 +1925,8 @@ (CL:UNLESS (STRING.EQUAL STRING NIL) (CL:STRING-TRIM `(#\Space) + STRING) + (CL:UNLESS (EQ 0 (NCHARS STRING)) STRING))]) ) @@ -1690,7 +2038,8 @@ 2]) (\TEDIT.PROMPT.PAGEFULLFN - [LAMBDA (PROMPT-DISPLAY-STREAM) (* ; "Edited 18-Nov-87 14:44 by jds") + [LAMBDA (PROMPT-DISPLAY-STREAM) (* ; "Edited 21-Jun-2024 23:21 by rmk") + (* ; "Edited 18-Nov-87 14:44 by jds") (* ;; "Given a TEdit promptwindow, expand it to be a line taller--called when a message overflows the window.") @@ -1704,10 +2053,10 @@ (ATTACHEDMENUS (REMOVE PROMPT-WINDOW (ATTACHEDWINDOWS MAINWINDOW] (GETPROMPTWINDOW MAINWINDOW %#LINES) (* ; "Get the new window") (SETQ \CURRENTDISPLAYLINE (CL:1- %#LINES)) (* ; "Set this so the page-full code will fire again at the end of THIS line, rather than waiting for another screen-ful. There ought to be an interface to this.") - [SETQ NEWTOP (fetch (REGION TOP) of (WINDOWPROP PROMPT-WINDOW 'REGION] - [for WINDOW in (REVERSE ATTACHEDMENUS) when (>= (fetch (REGION BOTTOM) - of (WINDOWPROP WINDOW 'REGION)) - OLDBOTTOM) + [for WINDOW [NEWTOP _ (fetch (REGION TOP) of (WINDOWPROP PROMPT-WINDOW 'REGION] + in (REVERSE ATTACHEDMENUS) when (>= (fetch (REGION BOTTOM) of (WINDOWPROP WINDOW + 'REGION)) + OLDBOTTOM) do (RELMOVEW WINDOW (CREATEPOSITION 0 (IDIFFERENCE NEWTOP OLDTOP] (WINDOWPROP PROMPT-WINDOW 'TEDIT.NLINES %#LINES]) ) @@ -1779,7 +2128,8 @@ TITLE]) (\TEDIT.WINDOW.TITLE - [LAMBDA (TEXTOBJ DIRTYFLAG TITLE) (* ; "Edited 2-Dec-2023 16:41 by rmk") + [LAMBDA (TEXTOBJ DIRTYFLAG TITLE) (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 2-Dec-2023 16:41 by rmk") (* ; "Edited 21-Oct-2023 15:02 by rmk") (* ; "Edited 18-Oct-2023 00:44 by rmk") (* ; "Edited 22-Sep-2023 19:51 by rmk") @@ -1790,7 +2140,7 @@ (* ;; "This puts * or clears * in the title of a tedit window. TITLE may override the current window title (e.g. for get and put)") (CL:UNLESS (GETTOBJ TEXTOBJ MENUFLG) - (LET ((W (\TEDIT.PRIMARYW TEXTOBJ))) + (LET ((W (\TEDIT.PRIMARYPANE TEXTOBJ))) (CL:WHEN (AND W (NOT (GETTEXTPROP TEXTOBJ 'NOTITLE)) (WINDOWPROP W 'TEDITCREATED)) (* ;  "Only change the title if there IS a window, and it isn't suppressing title changes.") @@ -1840,21 +2190,30 @@ (PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))]) (\TEDIT.UPDATE.TITLE - [LAMBDA (TEXTOBJ FILENAME) (* ; "Edited 20-Dec-2023 23:44 by rmk") + [LAMBDA (TEXTOBJ FILENAME) (* ; "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") + (* ; "Edited 20-Dec-2023 23:44 by rmk") (* ; "Edited 18-Oct-2023 09:56 by rmk") (* ; "Edited 1-Sep-2023 23:55 by rmk") (* ;; "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) + MENUSTREAM PC STATEFN) (\TEDIT.WINDOW.TITLE TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE (OR FILENAME TITLE))) (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) - (CL:WHEN (AND MENUSTREAM (type? LITATOM TITLE)) (* ; + (CL:WHEN (AND MENUSTREAM (LITATOM TITLE)) (* ;  "if we have a filename then put it in the GET and PUT fields of the menu") (SETQ FILENAME (PACKFILENAME 'VERSION NIL 'BODY TITLE)) - (MBUTTON.SET.FIELD MENUSTREAM 'Get FILENAME) - (MBUTTON.SET.FIELD MENUSTREAM 'Put FILENAME))]) + (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)))]) ) @@ -1864,8 +2223,12 @@ (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (W) (* ; "Edited 20-Mar-2024 11:02 by rmk") + [LAMBDA (PANE) (* ; "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") (* ; "Edited 15-Mar-2024 13:34 by rmk") + (* ; "Edited 20-Mar-2024 11:02 by rmk") (* ; "Edited 17-Oct-2023 08:54 by rmk") (* ; "Edited 10-Oct-2023 10:23 by rmk") (* ; "Edited 30-Sep-2023 13:42 by rmk") @@ -1874,244 +2237,122 @@ (* ; "Edited 5-Nov-2022 23:29 by rmk") (* ; "Edited 16-Oct-2021 18:51 by rmk:") - (* ;; "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 for to unsplit panes. The actual window-clsoing is done by setting the flag EDITFINISHEDFLG to T and giving control to the edit process. The flag causes the command loop to exit.") + (* ;; "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 ((TEXTOBJ (TEXTOBJ W T))) - (CL:UNLESS TEXTOBJ (* ; + (PROG* [(TSTREAM (TEXTSTREAM PANE T)) + (TEXTOBJ (AND TSTREAM (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (CL:UNLESS TEXTOBJ (* ;  "Return NIL if not an editing window (rather than error?)") - (RETURN)) - (TEXTOBJ! TEXTOBJ) + (RETURN)) + (TEXTOBJ! TEXTOBJ) - (* ;; "Return DON'T If we don't close the window. if previously quit, the window is closed already, and would be reopened to reclose it.") + (* ;; "Return DON'T to signal (to CLOSEW) that the window shouldn't be closed. if previously quit, the window is closed already, and would be reopened to reclose it.") - (CL:WHEN (GETTOBJ TEXTOBJ EDITOPACTIVE) - - (* ;; "If something is going on, DON'T CLOSE THE WINDOW") - - (TEDIT.PROMPTPRINT TEXTOBJ "Not closed; edit operation in progress" T) - (RETURN 'DON'T)) - (CL:UNLESS (\TEDIT.QUIT W T) - (RETURN 'DON'T)) - (SETTOBJ TEXTOBJ EDITFINISHEDFLG T) (* ; - "This causes the command loop to return to \TEDIT1, where the closing actually happens") - (CL:WHEN (AND (GETTOBJ TEXTOBJ PROMPTWINDOW) - (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW))) - (CLEARW (GETTOBJ TEXTOBJ PROMPTWINDOW))) - (\TEDIT.SHOWSEL (TEXTSEL TEXTOBJ) - NIL) (* ; + (CL:WHEN (\TEDIT.FINISHEDIT? TSTREAM T) + (RETURN 'DON'T)) + (CL:WHEN (AND (GETTOBJ TEXTOBJ PROMPTWINDOW) + (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW))) + (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.") - (CL:WHEN (AND (\TEDIT.WINDOW.TITLE TEXTOBJ) - (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW)) - (OPENWP W) - (EQ W (\TEDIT.MAINW TEXTOBJ))) (* ; - "Reset the window's title to a known 'inactive' value") - (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]")) - (for PANE in (REVERSE (CDR (GETTOBJ TEXTOBJ \WINDOW))) do + (CL:WHEN (AND (\TEDIT.WINDOW.TITLE TEXTOBJ) + (OPENWP (GETTOBJ TEXTOBJ PROMPTWINDOW)) + (OPENWP PANE) + (EQ PANE (FGETTOBJ TEXTOBJ PRIMARYPANE))) - (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world. Presumably we run through backwards because it looks better if the windows close from the bottom up.") + (* ;; + "Reset the window's title to a known 'inactive' value, in case somebody else also has the window.") - (\TEDIT.UNSPLITW PANE)) - (SETTOBJ TEXTOBJ \WINDOW NIL) - (CL:WHEN (type? STREAM (GETTOBJ TEXTOBJ TXTFILE)) (* ; + (\TEDIT.WINDOW.TITLE TEXTOBJ NIL "Edit Window [Inactive]")) + (for PANE backpanes TEXTOBJ do (\TEDIT.UNSPLITW PANE)) + (SETTOBJ TEXTOBJ PRIMARYPANE NIL) + (CL:WHEN (type? STREAM (GETTOBJ TEXTOBJ TXTFILE)) (* ;  "Close the file that this window was open on.") - (CL:UNLESS (fetch (TEXTWINDOW CLOSINGFILE) of W) - (replace (TEXTWINDOW CLOSINGFILE) of W with T) - (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE)))) - (replace (TEXTWINDOW WLINES) of W with NIL) - (WINDOWPROP W 'PROCESS.EXITFN NIL) - (WINDOWPROP W 'PROCESS.IDLEFN NIL) - (WINDOWPROP W 'BUTTONEVENTFN 'TOTOPW) (* ; "And the button functions") - (WINDOWPROP W 'RIGHTBUTTONFN 'DOWINDOWCOM) - (WINDOWDELPROP W 'CLOSEFN 'TEDIT.DEACTIVATE.WINDOW)(* ; "To avoid a loop") - (WINDOWPROP W 'SCROLLFN NIL) - (WINDOWDELPROP W 'RESHAPEFN '\EDITRESHAPEFN) - (\TEDIT.INTERRUPT.SETUP (WINDOWPROP W 'PROCESS) - T) (* ; "Restore any disarmed interrupts.") - (for MENUW in (ATTACHEDWINDOWS W) when (TEDITMENUP MENUW) do - (* ; "Detach all the TEDITMENU windows.") - (SETTOBJ (TEXTOBJ MENUW) - EDITFINISHEDFLG T) - (* ; + (CL:UNLESS (fetch (TEXTWINDOW CLOSINGFILE) of PANE) + (replace (TEXTWINDOW CLOSINGFILE) of PANE with T) + (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE)))) + (WINDOWPROP PANE 'PROCESS.EXITFN NIL) + (WINDOWPROP PANE 'PROCESS.IDLEFN NIL) + (WINDOWPROP PANE 'BUTTONEVENTFN (FUNCTION TOTOPW))(* ; "And the button functions") + (WINDOWPROP PANE 'RIGHTBUTTONFN (FUNCTION DOWINDOWCOM)) + (WINDOWDELPROP PANE 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW)) + (* ; "To avoid a loop") + (WINDOWPROP PANE 'SCROLLFN NIL) + (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) + do (* ; "Detach all the TEDITMENU windows.") + (SETTOBJ (TEXTOBJ MENUW) + EDITFINISHEDFLG T) (* ;  "Mark it finished so it closes itself") - (WINDOWPROP MENUW 'TEDITMENU - NIL) - (* ; + (WINDOWPROP MENUW 'TEDITMENU NIL) (* ;  "And mark it no longer a menu window") - (GIVE.TTY.PROCESS MENUW) - (* ; + (GIVE.TTY.PROCESS MENUW) (* ;  "Then give it a chance to kill itself off") - (DISMISS 300)) - (* ; "This closes up the other menus") - (GIVE.TTY.PROCESS W) (* ; "Now kill this one") - (DISMISS 300) - [SETTOBJ TEXTOBJ \WINDOW (CL:WHEN (LISTP (GETTOBJ TEXTOBJ \WINDOW)) - (* ; "It's a list; remove this pane") - (DREMOVE W (GETTOBJ TEXTOBJ \WINDOW)))] - (WINDOWPROP W 'CURSOROUTFN NIL) - (WINDOWPROP W 'CURSORMOVEDFN NIL) (* ; "Disconnect") - (replace (TEXTWINDOW WTEXTSTREAM) of W with NIL]) - -(\TEDIT.REPAINTFN - [LAMBDA (PANE) (* ; "Edited 20-Mar-2024 06:43 by rmk") - (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 13-Dec-2023 23:27 by rmk") - (* ; "Edited 30-Nov-2023 10:02 by rmk") - (* ; "Edited 11-May-2023 11:35 by rmk") - (* ; "Edited 30-May-91 23:34 by jds") - - (* ;; "If PANE is a pane of a split window, all sister panes will be refreshed, in keeping with the illusion that PANE is one part of a larger %"window%".") - - (LET ((TEXTOBJ (fetch (TEXTWINDOW PTEXTOBJ) of PANE)) - SEL WASON) - (CL:WHEN TEXTOBJ - (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (SETQ WASON (AND (GETSEL SEL SET) - (GETSEL SEL ONFLG))) - - (* ;; - "The window is clear before this is called, so no highlighting to worry about. Tell the selection.") - - (FSETSEL SEL ONFLG NIL) - (for P PLINES inpanes (PROGN TEXTOBJ) do (\TEDIT.LINES.BELOW (fetch (TEXTWINDOW PLINES) - of P) - NIL P TEXTOBJ)) - (CL:WHEN WASON - (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; - "Account for new lines and highlighting") - (\TEDIT.SHOWSEL SEL T)))]) - -(\TEDIT.AFTERMOVEFN - [LAMBDA (PANE) (* ; "Edited 20-Jan-2024 23:22 by rmk") - (* ; "Edited 21-Dec-2023 17:18 by rmk") - (* ; "Edited 20-Dec-2023 00:33 by rmk") - - (* ;; "If PANE was partly off screen before this move, then repaint it. If it is still off screen after this move, record that for the next move.") - (* ; "Edited 17-Dec-2023 17:31 by rmk") - (CL:WHEN (WINDOWPROP PANE 'OFFSCREEN) - (\TEDIT.REPAINTFN PANE)) - (WINDOWPROP PANE 'OFFSCREEN (OFFSCREENP PANE]) - -(OFFSCREENP - [LAMBDA (WINDOW) (* ; "Edited 19-Mar-2024 23:30 by rmk") - (* ; "Edited 20-Jan-2024 23:23 by rmk") - (* ; "Edited 21-Dec-2023 17:17 by rmk") - (* ; "Edited 17-Dec-2023 17:27 by rmk") - - (* ;; "Returns a list indicating which boundaries of the window is offscreen. Also includes VERTICAL or HORIZONTAL, if one of those respective dimensions is off.") - - (LET ((REGION (WINDOWREGION WINDOW)) - (SCREEN (fetch (WINDOW SCREEN) of WINDOW)) - RESULT) - (CL:WHEN (ILESSP (fetch LEFT of REGION) - 0) - (PUSH RESULT 'LEFT)) - (CL:WHEN (IGREATERP (fetch RIGHT of REGION) - (fetch (SCREEN SCWIDTH) of SCREEN)) - (PUSH RESULT 'RIGHT)) - (CL:WHEN (OR (MEMB 'LEFT RESULT) - (MEMB 'RIGHT RESULT)) - (PUSH RESULT 'HORIZONTAL)) - (CL:WHEN (IGREATERP (fetch TOP of REGION) - (fetch (SCREEN SCHEIGHT) of SCREEN)) - (PUSH RESULT 'TOP)) - (CL:WHEN (ILESSP (fetch BOTTOM of REGION) - 0) - (PUSH RESULT 'BOTTOM)) - (CL:WHEN (OR (MEMB 'TOP RESULT) - (MEMB 'BOTTOM RESULT)) - (PUSH RESULT 'VERTICAL)) - RESULT]) + (DISMISS 300)) (* ; "This closes up the other menus") + (GIVE.TTY.PROCESS PANE) (* ; "Now kill this one") + (DISMISS 300) + (WINDOWPROP PANE 'CURSOROUTFN NIL) + (WINDOWPROP PANE 'CURSORMOVEDFN NIL) + (\TEDIT.UNLINKPANE PANE) (* ; "Disconnect") + (replace (TEXTWINDOW WTEXTSTREAM) of PANE with NIL]) (\TEDIT.RESHAPEFN - [LAMBDA (PANE BITS OLDREGION) (* ; "Edited 20-Mar-2024 06:46 by rmk") - (* ; "Edited 16-Mar-2024 00:02 by rmk") - (* ; "Edited 20-Jan-2024 23:02 by rmk") - (* ; "Edited 2-Jan-2024 12:43 by rmk") - (* ; "Edited 14-Dec-2023 11:32 by rmk") - (* ; "Edited 20-Nov-2023 11:04 by rmk") - (* ; "Edited 3-Nov-2023 12:10 by rmk") - (* ; "Edited 11-May-2023 00:39 by rmk") - (* ; "Edited 18-Apr-2023 23:46 by rmk") - (* ; "Edited 5-Apr-2023 09:23 by rmk") - (* ; "Edited 30-May-91 23:34 by jds") - - (* ;; "Will eventually do the right thing w/r/t text margins. For now, it's a place holder.") - - (* ;; "This is called after the window has been reshaped, we have to redisplay") - - (PROG ((TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of PANE)) - (PREG (DSPCLIPPINGREGION NIL PANE)) - NEWPHEIGHT PLINES LINE) - (CL:UNLESS TEXTOBJ (* ; "Not a Tedit window") - (RETURN)) - (CL:UNLESS (SETQ PLINES (fetch (TEXTWINDOW PLINES) of PANE)) - - (* ;; "Should always be a dummy line, but...") - - (RETURN)) - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - NIL) (* ; - "Turn off the selection while we make changes") - (SETQ NEWPHEIGHT (fetch HEIGHT of PREG)) - (FSETTOBJ TEXTOBJ WTOP NEWPHEIGHT) (* ; - "Save new height/width for later use") - (FSETTOBJ TEXTOBJ WRIGHT (fetch WIDTH of PREG)) - (FSETTOBJ TEXTOBJ WBOTTOM (fetch BOTTOM of PREG)) - (FSETTOBJ TEXTOBJ WLEFT (fetch LEFT of PREG)) - - (* ;; "Hunt for the first line that had been visible, so we can find the CH# that has to appear at the top of the pane. THIS SHOULD JUST BE (NEXTLINE PLINES), IF WE ALWAYS FLUSH UNSEEN LINES.") - - (SETQ LINE (find L (OLDPHEIGHT _ (fetch HEIGHT of OLDREGION)) inlines (GETLD PLINES - NEXTLINE) - suchthat (ILESSP (FGETLD L LTRUEYTOP) - OLDPHEIGHT))) - (SETLD PLINES YBOT NEWPHEIGHT) - (CL:WHEN LINE (* ; - "If nothing visible then, nothing now") - (CL:WHEN (IGREATERP (FGETTOBJ TEXTOBJ TEXTLEN) - 0) - [SETQ LINE (CADR (\TEDIT.LINES.ABOVE TEXTOBJ (FGETLD LINE LCHAR1]) - (CL:UNLESS (EQ LINE PLINES) (* ; - "Forget the old chain of line descriptors") - (LINKLD PLINES LINE)) (* ; - "Fix the line to appear at the top of the pane") - (SETYPOS LINE (IDIFFERENCE NEWPHEIGHT (FGETLD LINE LHEIGHT))) - (\TEDIT.DISPLAYLINE TEXTOBJ LINE PANE) (* ; "Actually display it") - (\TEDIT.FILLPANE LINE TEXTOBJ PANE)) - (\TEDIT.FIXSEL (FGETTOBJ TEXTOBJ SEL) - TEXTOBJ) (* ; - "Fix up the selection to account for the line shuffling") - (\TEDIT.SHOWSEL (FGETTOBJ TEXTOBJ SEL) - T]) - -(\TEDIT.PANEWITHINSCREEN? - [LAMBDA (PANE) (* ; "Edited 20-Nov-2023 13:43 by rmk") - (* ; "Edited 10-May-2023 23:37 by rmk") - - (* ;; "True if PANE is completely within the screen and therefore that it is safe to reuse image-bits that were previously displayed anywhere within PANE's clipping region.") - - (* ;; " \TEDIT.AFTERMOVEFN should record this as a property on the PANE. Also, if this is false after a move, then the aftermovefn should force a redisplay. ") + [LAMBDA (PANE BITS OLDREGION) (* ; "Edited 30-Nov-2024 13:30 by rmk") + (* ; "Edited 4-Nov-2024 17:44 by rmk") + (* ; "Edited 6-Jul-2024 17:00 by rmk") + (* ; "Edited 28-Jun-2024 15:14 by rmk") (* ;; - "Since TEDIT doesn't (yet) support horizontal scrolling), we only test the vertical dimension") + "This tries to display the current top line at the same position relative to the top of PANE.") + (* ; "Edited 25-Jun-2024 15:53 by rmk") + (LET* ((TEXTOBJ (GETTSTR (fetch (TEXTWINDOW WTEXTSTREAM) of PANE) + TEXTOBJ)) + (PREG (DSPCLIPPINGREGION NIL PANE)) + (PANEPREFIX (PANEPREFIX PANE)) + (PANEPROPS (PANEPROPS PANE))) - (* ;; " ") + (* ;; + " Horizontal parameters are common to all panes. The vertical parameters are not common. ") - (LET [(PANEREG (WINDOWPROP PANE 'REGION] - (AND (IGEQ (fetch (REGION BOTTOM) of PANEREG) - 0) - (OR T (IGEQ (fetch (REGION LEFT) of PANEREG) - 0)) - (ILEQ (fetch (REGION PTOP) of PANEREG) - SCREENHEIGHT) - (OR T (ILEQ (fetch (REGION PRIGHT) of PANEREG) - SCREENWIDTH]) + (WITH PANEPROPS PANEPROPS (SETQ PANEHEIGHT (fetch (REGION HEIGHT) of PREG)) + (SETQ PANEWIDTH (fetch (REGION WIDTH) of PREG)) + (SETQ PANELEFT (fetch (REGION LEFT) of PREG)) + (SETQ PANERIGHT (fetch (REGION RIGHT) of PREG)) + (SETQ PANEBOTTOM (fetch (REGION BOTTOM) of PREG)) + (SETQ PANETOP (fetch (REGION TOP) of PREG)) + (SETQ PANEREGION PREG)) + (WITH TEXTOBJ TEXTOBJ (SETQ WRIGHT (fetch (REGION WIDTH) of PREG)) + (SETQ WLEFT (fetch (REGION LEFT) of PREG)) + (SETQ WBOTTOM (fetch (REGION BOTTOM) of PREG))) + [SETYBOT PANEPREFIX (IPLUS (FGETLD PANEPREFIX YBOT) + (IDIFFERENCE (PANEHEIGHT PANE) + (fetch (REGION HEIGHT) of OLDREGION] + (CL:WHEN (PANETOPLINE PANE) + (SETYTOP (PANETOPLINE PANE) + (FGETLD PANEPREFIX YBOT))) + (\TEDIT.FILL.PANES PANE]) + +(\TEDIT.REPAINTFN + [LAMBDA (WINDOW REGION) (* ; "Edited 26-Oct-2024 11:12 by rmk") + + (* ;; "Ignores REGION, repaints all the panes") + + (\TEDIT.FILL.PANES WINDOW]) ) (DEFINEQ (\TEDIT.SCROLLFN [LAMBDA (PANE DX DY) + (* ;; "Edited 29-Apr-2024 15:04 by rmk") + + (* ;; "Edited 27-Apr-2024 11:31 by rmk") + + (* ;; "Edited 24-Apr-2024 11:28 by rmk") + (* ;; "Edited 20-Mar-2024 11:02 by rmk") (* ;; "Edited 10-Mar-2024 22:23 by rmk") @@ -2124,145 +2365,157 @@  "Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for panes that are partially off-screen") (TOTOPW PANE) - (PROG [(TEXTOBJ (TEXTOBJ! (fetch (TEXTWINDOW PTEXTOBJ) of PANE] - (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) - then - (* ;; "Don't scroll a zero-length file") + (PROG* [(TSTREAM (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)) + (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM] + (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then + (* ;; "Don't scroll a zero-length file") - (RETURN) - elseif (FGETTOBJ TEXTOBJ EDITOPACTIVE) - then - (* ;; "Don't scroll while something interesting is happening!") + (RETURN) + elseif (FGETTOBJ TEXTOBJ EDITOPACTIVE) + then + (* ;; "Don't scroll while something interesting is happening!") - (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T) - (RETURN)) - (CL:UNLESS (\GETSTREAM (FGETTOBJ TEXTOBJ STREAMHINT) - 'INPUT T) - (\TEDIT.REOPENTEXTSTREAM TEXTOBJ)) - (CL:WHEN (GETTEXTPROP TEXTOBJ 'PRESCROLLFN) - (DOUSERFNS (GETTEXTPROP TEXTOBJ 'PRESCROLLFN) - PANE)) (* ; + (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T) + (RETURN)) + (CL:UNLESS (\GETSTREAM TSTREAM 'INPUT T) + (\TEDIT.REOPENTEXTSTREAM TEXTOBJ)) + (CL:WHEN (GETTEXTPROP TEXTOBJ 'PRESCROLLFN) + (DOUSERFNS (GETTEXTPROP TEXTOBJ 'PRESCROLLFN) + PANE)) (* ;  "Turn off selections during the scroll.") - (if (FLOATP DY) - then (\TEDIT.SCROLLFLOAT TEXTOBJ PANE DY) - elseif (IGREATERP DY 0) - then (\TEDIT.SCROLLUP TEXTOBJ PANE DY) - elseif (ILESSP DY 0) - then (\TEDIT.SCROLLDOWN TEXTOBJ PANE DY)) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE) - (CL:WHEN (GETTEXTPROP TEXTOBJ 'POSTSCROLLFN) (* ; "For user subsystem cleanup") - (DOUSERFNS (GETTEXTPROP TEXTOBJ 'POSTSCROLLFN) - PANE))) + (if (FLOATP DY) + then (\TEDIT.SCROLLCH.TOP TSTREAM PANE (IMAX [IMIN (SUB1 (TEXTLEN TEXTOBJ)) + (FIXR (FTIMES DY (TEXTLEN TEXTOBJ] + 1)) + elseif (IGREATERP DY 0) + then (\TEDIT.SCROLLUP TSTREAM PANE DY) + elseif (ILESSP DY 0) + then (\TEDIT.SCROLLDOWN TSTREAM PANE DY)) + (CL:WHEN (GETTEXTPROP TEXTOBJ 'POSTSCROLLFN) (* ; "For user subsystem cleanup") + (DOUSERFNS (GETTEXTPROP TEXTOBJ 'POSTSCROLLFN) + PANE))) NIL]) -(\TEDIT.SCROLLFLOAT - [LAMBDA (TEXTOBJ PANE DY) (* ; "Edited 20-Mar-2024 06:46 by rmk") - (* ; "Edited 15-Mar-2024 22:00 by rmk") - (* ; "Edited 22-Jan-2024 10:43 by rmk") - (* ; "Edited 20-Jan-2024 23:13 by rmk") - (* ; "Edited 2-Jan-2024 11:02 by rmk") - (* ; "Edited 13-Dec-2023 23:24 by rmk") - (* ; "Edited 4-Dec-2023 11:25 by rmk") - (* ; "Edited 28-Nov-2023 12:10 by rmk") - (* ; "Edited 24-Nov-2023 13:00 by rmk") - (* ; "Edited 22-Nov-2023 14:42 by rmk") - (* ; "Edited 20-Nov-2023 14:19 by rmk") - (* ; "Edited 3-Nov-2023 12:10 by rmk") - (* ; "Edited 30-Mar-2023 23:38 by rmk") +(\TEDIT.SCROLLCH.TOP + [LAMBDA (TSTREAM PANE CHNO) (* ; "Edited 17-Nov-2024 14:05 by rmk") + (* ; "Edited 10-Nov-2024 11:54 by rmk") + (* ; "Edited 2-Nov-2024 23:34 by rmk") + (* ; "Edited 31-Oct-2024 14:35 by rmk") + (* ; "Edited 2-Oct-2024 23:55 by rmk") + (* ; "Edited 28-Jun-2024 15:16 by rmk") + (* ; "Edited 18-May-2024 16:20 by rmk") + (* ; "Edited 25-Apr-2024 11:08 by rmk") - (* ;; "Thumb scrolling, DY is FLOATP.") + (* ;; "Scrolls so that the line containing CHNO is at the top of PANE. This is the body of the earlier \TEDIT.SCROLLFLOAT. This is called for an explicit FLOATP scroll or normalize caret.") - (LET ((CH# (IMAX [IMIN (SUB1 (TEXTLEN TEXTOBJ)) - (FIXR (FTIMES DY (TEXTLEN TEXTOBJ] - 1)) - (PREG (DSPCLIPPINGREGION NIL PANE)) - (SEL (FGETTOBJ TEXTOBJ SEL)) - PHEIGHT NEWTOP) - (SETQ PHEIGHT (fetch HEIGHT of PREG)) (* ; "Height of the pane") + (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + (PANEPREFIX (PANEPREFIX PANE)) + TARGETLINE) + (CL:UNLESS (AND (PANETOPLINE PANE) + (WITHINLINEP CHNO (PANETOPLINE PANE))) + (if (SETQ TARGETLINE (\TEDIT.VISIBLECHARP CHNO PANE TEXTOBJ)) + then + (* ;; "A valid line containg CHNO is on-screen, scroll it to the top of PANE. ") - (* ;; - "Does any currently formatted line include the target char? This will become the new top line") + (\TEDIT.SCROLLUP TSTREAM PANE TARGETLINE) + elseif (SETQ TARGETLINE (CDR (\TEDIT.LINES.ABOVE TSTREAM CHNO))) + then + (* ;; + "No existing CHNO line. Construct one and install it as PANE's top line.") - (SETQ NEWTOP (find L inlines (GETLD (fetch (TEXTWINDOW PLINES) of PANE) - NEXTLINE) suchthat (WITHINLINEP CH# L))) - (COND - (NEWTOP + (\TEDIT.SETPANE.TOPLINE PANE TARGETLINE (\TEDIT.TOPLINE.YTOP TARGETLINE NIL + PANE TEXTOBJ)) + (\TEDIT.FILL.PANES TEXTOBJ PANE)))]) - (* ;; - "If so, convert to an integer scroll so the screen is not blanked and reformatted unnecessarily") +(\TEDIT.SCROLLCH.BOTTOM + [LAMBDA (TSTREAM PANE CHNO BOTMARGIN) (* ; "Edited 1-Dec-2024 11:26 by rmk") + (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 21-Nov-2024 10:40 by rmk") + (* ; "Edited 20-Nov-2024 00:37 by rmk") + (* ; "Edited 11-Nov-2024 22:40 by rmk") + (* ; "Edited 10-Nov-2024 12:27 by rmk") + (* ; "Edited 26-Oct-2024 11:05 by rmk") + (* ; "Edited 28-Jun-2024 15:15 by rmk") + (* ; "Edited 21-Jun-2024 23:17 by rmk") + (* ; "Edited 21-May-2024 15:40 by rmk") + (* ; "Edited 16-May-2024 23:42 by rmk") + (* ; "Edited 2-May-2024 00:27 by rmk") + (* ; "Edited 29-Apr-2024 11:18 by rmk") + (* ; "Edited 25-Apr-2024 11:08 by rmk") - [SETQ DY (COND - [(ILEQ PHEIGHT (GETLD NEWTOP YBOT)) - (* ; - "NEWTOP is off the top of the window") - (IMINUS (for L inlines (GETLD NEWTOP NEXTLINE) - while (ILEQ PHEIGHT (FGETLD L YBOT)) - sum - (* ;; - "sum the heights of all lines between the NEWTOP and the present top line") + (* ;; "Scrolls so that the line containing CHNO is at the bottom of PANE. Presumably this is only called when typing at the bottom of a pane, doesn't have to be efficient. ") - (FGETLD L LHEIGHT] - (T (* ; - "NEWTOP is in the window or below, raise it up") - (IDIFFERENCE (IDIFFERENCE PHEIGHT (GETLD NEWTOP YBOT)) - (GETLD NEWTOP LHEIGHT] - (if (IGREATERP DY 0) - then (\TEDIT.SCROLLUP TEXTOBJ PANE DY) - elseif (ILESSP DY 0) - then (\TEDIT.SCROLLDOWN TEXTOBJ PANE DY))) - (T - (* ;; "There is no current line to be moved to the top of the pane. The line containing CH# becomes the new topline of the pane") + (LET ((TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ))) + (BOTTOM (PANEBOTTOM PANE)) + TARGETLINE TOPLINE NEWLINES PANETOPLINE) + (CL:WHEN BOTMARGIN (add BOTTOM BOTMARGIN)) - [SETQ NEWTOP (CADR (\TEDIT.LINES.ABOVE TEXTOBJ CH# (fetch BOTTOM of PREG] - (SETYPOS NEWTOP (IDIFFERENCE PHEIGHT (GETLD NEWTOP LHEIGHT))) - (LINKLD (fetch (TEXTWINDOW PLINES) of PANE) - NEWTOP) (* ; - "New block lines replace previous pane lines") - (\TEDIT.CLEARPANE PANE) + (* ;; "0 if PANE starts at the beginning of the stream, can't scroll down. If it's current visible, we scan scroll down to its new position. If not visible, we have to search for a new top line somewhere above the CHNO target line such that putting that line at the to will cause the target line to appear at the bottom.") - (* ;; - "Maybe replace the rest of this with \TEDIT.REPAINTFN ? \FILLPANE adds the dummy lines") + (if (SETQ TARGETLINE (\TEDIT.VISIBLECHARP CHNO PANE TEXTOBJ)) + then + (* ;; "CHNO currently visible ") - (\TEDIT.FILLPANE (fetch (TEXTWINDOW PLINES) of PANE) - TEXTOBJ PANE) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE) - (CL:WHEN (FGETSEL SEL ONFLG) + (CL:WHEN (OR (FGETLD TARGETLINE NEXTLINE) + (IGREATERP (FGETLD TARGETLINE LCHARLIM) + (FGETTOBJ TEXTOBJ TEXTLEN))) - (* ;; "Tell the selection that none of its hilighting is current onscreen (BLTSHADE above), then restore it. ") + (* ;; "Don't scroll if TARGETLINE is already PANE's last line, unless it's the last line of the document. ") - (FSETSEL SEL ONFLG NIL) - (\TEDIT.SHOWSEL SEL T PANE))]) + (\TEDIT.SCROLLDOWN TSTREAM PANE (IDIFFERENCE BOTTOM (FGETLD TARGETLINE YTOP)))) + else + (* ;; "CHNO is not in PANE. Create a line that is PHEIGHT above a line containing CHNO--that's the new top. We want to make sure that the bottom of the line containing CHNO is visible") + + (SETQ NEWLINES (\TEDIT.BACKFORMAT TSTREAM (PANEHEIGHT PANE) + CHNO BOTTOM)) + + (* ;; "TARGETLINE with CHNO is at bottom if TOPLINE is at top") + + (SETQ TARGETLINE (CDR NEWLINES)) + (SETQ TOPLINE (CAR NEWLINES)) + + (* ;; "Special case where TARGET line is already at the top but it's bottom is not visible. Scroll up just a bit. (Presumably this is the tall-object case).") + + (if (AND (EQ TARGETLINE TOPLINE) + (SETQ PANETOPLINE (PANETOPLINE PANE)) + (EQ (FGETLD TARGETLINE LCHAR1) + (FGETLD PANETOPLINE LCHAR1)) + (ILESSP (FGETLD PANETOPLINE YBOT) + BOTTOM)) + then (\TEDIT.SCROLLUP TSTREAM PANE (IDIFFERENCE BOTTOM (FGETLD PANETOPLINE YBOT)) + ) + else (CL:WHEN (FGETLD TOPLINE NEXTLINE) (* ; "Lift one line down") + (SETQ TOPLINE (FGETLD TOPLINE NEXTLINE))) + (\TEDIT.SCROLLCH.TOP TSTREAM PANE (FGETLD TOPLINE LCHARLAST]) (\TEDIT.SCROLLUP - [LAMBDA (TEXTOBJ PANE DY) (* ; "Edited 20-Mar-2024 06:43 by rmk") - (* ; "Edited 15-Mar-2024 19:23 by rmk") + [LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Dec-2024 11:32 by rmk") + (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 22-Nov-2024 17:33 by rmk") + (* ; "Edited 21-Nov-2024 15:04 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:00 by rmk") + (* ; "Edited 15-Nov-2024 20:19 by rmk") + (* ; "Edited 11-Nov-2024 22:26 by rmk") + (* ; "Edited 9-Nov-2024 23:26 by rmk") + (* ; "Edited 7-Nov-2024 16:58 by rmk") + (* ; "Edited 2-Nov-2024 19:00 by rmk") + (* ; "Edited 26-Oct-2024 15:55 by rmk") + (* ; "Edited 28-Jun-2024 15:18 by rmk") + (* ; "Edited 9-May-2024 07:43 by rmk") + (* ; "Edited 20-Mar-2024 06:43 by rmk") (* ; "Edited 14-Dec-2023 00:00 by rmk") - (* ; "Edited 4-Dec-2023 20:49 by rmk") - (* ; "Edited 30-Nov-2023 00:07 by rmk") - (* ; "Edited 28-Nov-2023 22:55 by rmk") - (* ; "Edited 28-Apr-2023 08:55 by rmk") (* ; "Edited 24-Apr-2023 23:48 by rmk") - (* ;; "Scrolling up, with positive integer DY. We first have to find a line that is or would be DY below the top of the pane, then we move that line to the top and fill in beneath.") + (* ;; "Scrolling up, with positive integer DY. We find a line that is or would be DY below the top of the pane, then move that line to the top and fill in beneath.") - (PROG ((PREG (DSPCLIPPINGREGION NIL PANE)) - (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN)) - PBOTTOM PHEIGHT PLINES OLDTOPLINE NEWTOPLINE LASTVISIBLE WHERESEL DELTA) - (SETQ PHEIGHT (fetch HEIGHT of PREG)) (* ; "Height of the pane") - (SETQ PBOTTOM (\TEDIT.ONSCREEN? PANE 'BOTTOM)) (* ; "Effective bottom") - (SETQ PLINES (fetch (TEXTWINDOW PLINES) of PANE)) - (CL:WHEN (IGREATERP (GETLD (GETLD PLINES NEXTLINE) - LCHARLIM) - TEXTLEN) - (HELP 'TOP)) (* ; "Currently formatted PANE lines") + (PROG ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (OLDTOPLINE (PANETOPLINE PANE)) + NEWTOPLINE NEWPANEYBOT BITMAPLINES) (* ;; "Find the first line at least DY below the top of the pane. ") - (* ;; "The initial scan from PLINES is needed in case invisible lines have been kept in the chain above the current top line. ") - - (SETQ OLDTOPLINE (find L inlines (GETLD PLINES NEXTLINE) - suchthat (ILEQ (FGETLD L YTOP) - PHEIGHT))) (CL:UNLESS OLDTOPLINE (* ;; "Relative scrolling doesn't make sense if there isn't at least one visible line currently at the top of the pane.") @@ -2271,427 +2524,646 @@ (* ;; "") - (SETQ WHERESEL (\TEDIT.WHERE.SEL TEXTOBJ OLDTOPLINE PANE)) + (* ;; "Walk down the sequence of lines until we arrive at a line whose top is at least DY below the top of PANE. If we run off the bottom of existing lines, keep formatting until we finally exhaust DY or reach the end of the text. Unlike the scroll-down case, we know we are starting from a properly broken line, we don't have to search for a stable paragraph break.") - (* ;; "") + [SETQ NEWTOPLINE (if (type? LINEDESCRIPTOR DY) + then (PROG1 DY (SETQ DY NIL)) + elseif (IGREATERP DY 0) + then (for L NEXT TARGETY (SUFFIX _ (PANESUFFIX PANE)) + (PHEIGHT _ (PANEHEIGHT PANE)) + (TEXTLEN _ (TEXTLEN TEXTOBJ)) inlines OLDTOPLINE + first (SETQ TARGETY (IDIFFERENCE PHEIGHT DY)) + do (CL:WHEN (OR (\TEDIT.SHOW.AT.TOPP L TARGETY PHEIGHT) + (IGREATERP (FGETLD L LCHARLIM) + TEXTLEN)) + (RETURN L)) + (CL:WHEN (EQ L SUFFIX) - (* ;; "Walk down a sequence of lines until we arrive at a line that is DY from the top. If we run off the bottom of existing lines, keep formatting until we finally exhaust DY or reach the end of the text. Unlike the scroll-down case, we know we are starting from a properly broken line, we don't have to search for a stable paragraph break.") + (* ;; "Continue by formatting a new, undisplayed line. This can happen if DY (say from an explicit SCROLLW call) picks a line that is somewhere below the pane. The newline is linked in as L's NEXTLINE, but its NEXTLINE is NIL, so we keep running through here. The new lines are positioned propely with respect to the current OLDTOPLINE (so are all lines we have crossed over or formatted, but those will be thrown away.)") - [SETQ NEWTOPLINE (for L NEXT inlines OLDTOPLINE - first (CL:WHEN NIL - (ILESSP (IPLUS DY (FGETLD OLDTOPLINE LTRUEYTOP)) - PHEIGHT) - - (* ;; "If the old truetop would still be visible after raising DY, then move it up by DY. This effectively discounts the white space of paragraph leading. Maybe we also want to discount the white space of line-leading below, by using LTRUEHEIGHT instead of LHEIGHT to determine the new bottom line") - - (SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (FGETLD OLDTOPLINE - LCHAR1))) - (LINKLD NEXT (FGETLD OLDTOPLINE NEXTLINE)) - (SETYPOS NEXT (IPLUS DY (FGETLD OLDTOPLINE YBOT))) - (RETURN NEXT)) - do (add DY (IMINUS (FGETLD L LHEIGHT))) - (CL:WHEN (OR (ILEQ DY 0) - (IGEQ (FGETLD L LCHARLIM) - TEXTLEN)) - (RETURN L)) - (CL:UNLESS (FGETLD L NEXTLINE) - - (* ;; "Continue by formatting a new, undisplayed line. This can happen if DY (say from an explicit SCROLLW call) picks a line that is somewhere below the pane. The newline is linked in as L's NEXTLINE, but its NEXTLINE is NIL, so we keep running through here. The new line is positioned properly with respect to the current OLDTOPLINE (so are all lines we have crossed over or formatted, but those will be thrown away.)") - - [SETQ NEXT (\TEDIT.FORMATLINE TEXTOBJ (ADD1 (FGETLD L LCHARLIM] - (LINKLD L NEXT) (* ; + (SETQ NEXT (\TEDIT.FORMATLINE TSTREAM (FGETLD L + LCHARLIM)) + ) + (LINKLD L NEXT)(* ;  "So we find NEXT on the next iteration") - (\TEDIT.LINE.BOTTOM NEXT))] + (SETYBOT NEXT (\TEDIT.LINE.BOTTOM L NEXT)))] (CL:UNLESS NEWTOPLINE (* ;  "If nothing found, nothing can be done") (RETURN)) - (CL:WHEN (EQ OLDTOPLINE NEWTOPLINE) (* ; "Move at least one line") - (SETQ NEWTOPLINE (FGETLD OLDTOPLINE NEXTLINE))) - (CL:UNLESS (AND NEWTOPLINE (ILEQ (FGETLD NEWTOPLINE LCHARLIM) - TEXTLEN)) - (RETURN)) (* ;; "") - (* ;; "NEWTOPLINE is good to go. ") + (CL:UNLESS (SETQ NEWPANEYBOT (\TEDIT.TOPLINE.YTOP NEWTOPLINE DY PANE TEXTOBJ)) + (RETURN NIL)) - (* ;; "Lines above NEWTOPLINE are chopped off, it and all lines below must be repositioned to the top of PANE, and new lines must be created to fill the space after the last visible line is raised. ") + (* ;; "Position and display lines such that NEWTOPLINE's top is at YBOT of the pane prefix. ") - (LINKLD PLINES NEWTOPLINE) (* ; - "Chop off lines above that are no longer visible") + (\TEDIT.SETPANE.TOPLINE PANE NEWTOPLINE NEWPANEYBOT) + (\TEDIT.SHIFTLINES (PANEPREFIX PANE) + NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE NEWTOPLINE) + T) + (\TEDIT.SETCARET (TEXTSEL TEXTOBJ) + PANE TEXTOBJ 'ON]) - (* ;; "") +(\TEDIT.TOPLINE.YTOP + [LAMBDA (NEWTOPLINE DY PANE TEXTOB) (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 11-Nov-2024 22:30 by rmk") + (* ; "Edited 9-Nov-2024 23:51 by rmk") - (CL:UNLESS (IGEQ (GETLD NEWTOPLINE YBOT) - PBOTTOM) (* ; - "Not visible, SUB1 to display not quite at the top, then raise") - (\TEDIT.LINE.BOTTOM NEWTOPLINE) - (\TEDIT.DISPLAYLINE TEXTOBJ NEWTOPLINE PANE)) + (* ;; "Return a value of YTOP value for NEWTOPLINE such that at least part of it will be visible at the top of PANE if it is shifted up by DY points (unless DY is NIL). NEWTOPLINE is already known to be the plus-DY target line and it is already known that at least some part of it can be displayed.") - (* ;; "") + (* ;; "Constraints: ") - (* ;; "Raise NEWTOPLINE so that its top is at PHEIGHT, and reposition all lines below. DELTA presumably is (or is close to) the original DY.") + (* ;; " 1. If the document isn't empty, at least (a piece of) one line should be visible.") - (SETQ DELTA (IDIFFERENCE PHEIGHT (FGETLD NEWTOPLINE YTOP))) - (for L inlines NEWTOPLINE while (IGEQ (FGETLD L YBOT) - PBOTTOM) do (SETYPOS L (IPLUS DELTA (FGETLD L YBOT))) - (SETQ LASTVISIBLE L)) + (* ;; + " 2. If the line is tall with respect to PANE, then it is OK to show only part of the line.") - (* ;; "") + (* ;; "NIL is returned if NEWTOPLINE is already at the target level.") - (* ;; "The effective PBOTTOM is the bottom of the clipping region that is onscreen") + (PROG ((PHEIGHT (PANEHEIGHT PANE)) + NEWTOP NEWBOT) + (CL:UNLESS (AND DY (\TEDIT.LINE.TALLP NEWTOPLINE PHEIGHT)) + (* ; "Case 1 and 3") + (RETURN (IPLUS PHEIGHT (FGETLD NEWTOPLINE LLEADBEFORE)))) - (BITBLT PANE 0 PBOTTOM PANE 0 (IPLUS PBOTTOM DELTA) - (fetch WIDTH of PREG) - (FGETLD NEWTOPLINE YTOP) - 'INPUT - 'REPLACE) - (CL:WHEN LASTVISIBLE + (* ;; "The tall line maybe coming up from below, or it may already have been at the top.") - (* ;; "Clear any garbage left over below the (repositioned) LASTVISIBLELINE, and display new lines needed to fill the space") - - (BLTSHADE WHITESHADE PANE 0 0 (fetch WIDTH of PREG) - (FGETLD LASTVISIBLE YBOT) - 'REPLACE) - (\TEDIT.LINES.BELOW LASTVISIBLE NIL PANE TEXTOBJ)) - (\TEDIT.SCROLL.SHOWSEL 'UP WHERESEL PANE TEXTOBJ LASTVISIBLE]) - -(\TEDIT.SCROLL.SHOWSEL - [LAMBDA (DIRECTION WHERESEL PANE TEXTOBJ VISIBLELINE) (* ; "Edited 15-Mar-2024 13:36 by rmk") - (* ; "Edited 18-Feb-2024 15:24 by rmk") - (* ; "Edited 28-Nov-2023 22:58 by rmk") - - (* ;; "This synchronizes the selection hilighting and caret to correspond to lines that up- or down-scrolling has newly revealed. It assumes that the hilighting of previously and still visible lines have been carried along with BITBLT. VISIBLELINE is the last visible line (above or below) that bounds the region that needs to be redisplayed.") - - (CL:WHEN WHERESEL (* ; "SEL was on, but now off.") - (LET ((SEL (FGETTOBJ TEXTOBJ SEL))) - (if (OR (EQ 'BELOW (CAR WHERESEL)) - (EQ 'ABOVE (CDR WHERESEL))) - then - (* ;; - "No lines previously visible, they might come from above or below, in the ordinary way.") - - (FSETSEL SEL ONFLG NIL) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE) - (\TEDIT.SHOWSEL SEL T PANE) - else - (* ;; - "Old lines were visible and therefore highlighted, newly revealed lines may need to catch up. ") - - (FSETSEL SEL ONFLG T) - (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE) - (SELECTQ DIRECTION - (UP - (* ;; "lastline is not highlighted when it comes up") - - (CL:WHEN (AND (EQ 'BELOW (CDR WHERESEL)) - VISIBLELINE - (FGETLD VISIBLELINE NEXTLINE) - (\TEDIT.SEL.LN SEL PANE TEXTOBJ)) - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ (FGETLD VISIBLELINE NEXTLINE) - (\TEDIT.SEL.LN SEL PANE TEXTOBJ) - PANE SEL))) - (DOWN (* ; - "First line is not highlighted when it comes down") - (CL:WHEN (EQ 'ABOVE (CAR WHERESEL)) - (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ (\TEDIT.SEL.L1 SEL PANE TEXTOBJ) - (FGETLD VISIBLELINE PREVLINE) - PANE SEL))) - (SHOULDNT)) - (\TEDIT.SETCARET SEL PANE TEXTOBJ T))))]) + (SETQ NEWBOT (IPLUS DY (FGETLD NEWTOPLINE YBOT))) + (CL:WHEN (IGREATERP NEWBOT PHEIGHT) (* ; "Case 2: Bring it back down") + (SETQ NEWBOT (IDIFFERENCE PHEIGHT 2))) + (RETURN (IPLUS NEWBOT (FGETLD NEWTOPLINE LHEIGHT]) (\TEDIT.SCROLLDOWN - [LAMBDA (TEXTOBJ PANE DY) (* ; "Edited 19-Mar-2024 23:34 by rmk") - (* ; "Edited 15-Mar-2024 22:02 by rmk") + [LAMBDA (TSTREAM PANE DY) (* ; "Edited 1-Dec-2024 20:46 by rmk") + (* ; "Edited 29-Nov-2024 09:14 by rmk") + (* ; "Edited 22-Nov-2024 17:33 by rmk") + (* ; "Edited 17-Nov-2024 10:13 by rmk") + (* ; "Edited 15-Nov-2024 19:55 by rmk") + (* ; "Edited 11-Nov-2024 23:58 by rmk") + (* ; "Edited 7-Nov-2024 11:59 by rmk") + (* ; "Edited 1-Nov-2024 15:40 by rmk") + (* ; "Edited 28-Jun-2024 15:19 by rmk") + (* ; "Edited 29-Apr-2024 15:06 by rmk") + (* ; "Edited 19-Mar-2024 23:34 by rmk") (* ; "Edited 20-Jan-2024 23:13 by rmk") - (* ; "Edited 2-Jan-2024 00:25 by rmk") (* ; "Edited 1-Dec-2023 16:11 by rmk") (* ; "Edited 11-May-2023 11:53 by rmk") - (* ; "Edited 26-Mar-2023 20:55 by rmk") - (* ; "Edited 3-Apr-2023 10:00 by rmk") (* ; "Edited 26-Mar-2023 20:55 by rmk") (* ;; "Add new lines that fill DYat the top of PANE. The needed lines are first constructed, then pushed in front of any old lines. The NEWTOPLINE is positioned at the top of the window, and all other lines are then positioned relative to it. The current Y positions of all lines are ignored, new positions are determined based on LHEIGHTs.") - (* ;; "The bitmap corresponding to the old-line positions are moved so that they correlate with their new positions, and resulting garbage at the bottom of the window is cleared, and then the newlines are displayed to fill the space at the top.") + (* ;; "The bitmap corresponding to the old-line positions are moved so that they correlate with their new positions, resulting garbage at the bottom of the window is cleared, and then the newlines are displayed to fill the space at the top.") (* ;; " ") - (SETQ DY (IMINUS DY)) (* ; "Now positive") - (PROG ((PREG (DSPCLIPPINGREGION NIL PANE)) - (VBOTTOM (\TEDIT.ONSCREEN? PANE 'BOTTOM)) - (PLINES (fetch (TEXTWINDOW PLINES) of PANE)) - PHEIGHT PBOTTOM OLDTOPLINE TOPOFOLD NEWTOPLINE WHERESEL LASTVISIBLE) - (SETQ PHEIGHT (fetch HEIGHT of PREG)) (* ; - "Height of the pane. Presumably there are no old lines above it, but...") - (SETQ PBOTTOM (fetch BOTTOM of PREG)) - (SETQ OLDTOPLINE (find L inlines (GETLD PLINES NEXTLINE) - suchthat (ILESSP (FGETLD L YBOT) - PHEIGHT))) + (PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + (PBOTTOM (PANEBOTTOM PANE)) + (PHEIGHT (PANEHEIGHT PANE)) + (OLDTOPLINE (PANETOPLINE PANE)) + NEWLINES NEWTOPLINE NEWPANEYBOT) + (CL:UNLESS (OR OLDTOPLINE (EQ 0 (TEXTLEN TEXTOBJ))) + (RETURN)) - (* ;; - "Look backwards from the line before OLDTOP. IMAX and HEIGHT+1 to scroll at least one line") + (* ;; "Look backwards from the line before OLDTOP. ") - (CL:WHEN (AND OLDTOPLINE (ILEQ (GETLD OLDTOPLINE LCHAR1) - 1)) - (RETURN)) + [if (type? LINEDESCRIPTOR DY) + then (SETQ NEWTOPLINE DY) + (SETQ DY 0) + else (CL:WHEN (EQ DY 0) + (RETURN)) + (SETQ DY (IMINUS DY)) (* ; "Now positive") + (if (AND (IGREATERP (IDIFFERENCE (IDIFFERENCE (FGETLD OLDTOPLINE YTOP) + DY) + PHEIGHT) + (FGETLD OLDTOPLINE LLEADBEFORE)) + (\TEDIT.LINE.TALLP OLDTOPLINE PHEIGHT)) + then + (* ;; "OLDTOPLINE must have a big image object. If it's top is still above the window when it is brought down by DY, then just shift the image here. Otherwise, code below will bring down the line above. ") + + (SETQ NEWTOPLINE OLDTOPLINE) + + (* ;; "We want to show DY more at the bottom of the large line") + + (SETQ NEWPANEYBOT (IDIFFERENCE (FGETLD NEWTOPLINE YTOP) + DY)) + else (SETQ NEWLINES (\TEDIT.BACKFORMAT TSTREAM DY (IMAX 1 (SUB1 (FGETLD + OLDTOPLINE + LCHAR1))) + 0)) + (CL:UNLESS NEWLINES (* ; "Should always find one, but...") + (RETURN)) + (SETQ NEWTOPLINE (CAR NEWLINES)) + (CL:WHEN (IEQP (FGETLD NEWTOPLINE LCHAR1) + (FGETLD OLDTOPLINE LCHAR1)) + (* ; "BACKFORMAT can produce a copy") + (SETQ NEWTOPLINE OLDTOPLINE)) + (CL:WHEN [AND (EQ 1 (FGETLD OLDTOPLINE LCHAR1)) + (OR (ILEQ (FGETLD OLDTOPLINE LTRUEYTOP) + PHEIGHT) + (NOT (\TEDIT.LINE.TALLP OLDTOPLINE PHEIGHT] + + (* ;; + "Top line of document, only pull it down if it is tall and had been scrolled up.") + + (RETURN)) + (LINKLD (CDR NEWLINES) + OLDTOPLINE) + (SETQ NEWPANEYBOT (if (EQ NEWTOPLINE OLDTOPLINE) + then + (* ;; "Top line that passed the tall test") + + (IDIFFERENCE (FGETLD OLDTOPLINE LTRUEYTOP) + DY) + elseif (\TEDIT.LINE.TALLP NEWTOPLINE PHEIGHT) + then + + (* ;; "Try to show just DY at the bottom of the tall line. Maybe the tall-line branches should be collected under a single condition?") + + (IPLUS (FGETLD NEWTOPLINE LTRUEHEIGHT) + (IDIFFERENCE PHEIGHT DY)) + elseif (IPLUS PHEIGHT (FGETLD NEWTOPLINE LLEADBEFORE] + + (* ;; "NEWTOPLINE is the top of a chain at or above OLDTOPLINE. ") (* ;; "") - (SETQ NEWTOPLINE (if OLDTOPLINE - then (SETQ TOPOFOLD (FGETLD OLDTOPLINE YTOP)) - (\TEDIT.BACKFORMAT TEXTOBJ (IMAX DY (ADD1 (FGETLD OLDTOPLINE - LHEIGHT))) - (SUB1 (FGETLD OLDTOPLINE LCHAR1)) - (FGETLD OLDTOPLINE LHEIGHT)) - else + (\TEDIT.SETPANE.TOPLINE PANE NEWTOPLINE NEWPANEYBOT) - (* ;; "If we didn't find a visible line, we must be looking at the tail end of the text. We will need to bring down some of its final lines. ") + (* ;; "All needed lines have been constructed and linked, although there may still be some unneeded lines at the bottom. ") - (\TEDIT.BACKFORMAT TEXTOBJ DY (FGETTOBJ TEXTOBJ TEXTLEN) - 0))) - (CL:UNLESS NEWTOPLINE (RETURN)) - (SETQ WHERESEL (\TEDIT.WHERE.SEL TEXTOBJ OLDTOPLINE PANE)) + (\TEDIT.SHIFTLINES (PANEPREFIX PANE) + NEWTOPLINE PANE TEXTOBJ (\TEDIT.BITMAPLINES PANE OLDTOPLINE) + T) + (\TEDIT.SETCARET (TEXTSEL TEXTOBJ) + PANE TEXTOBJ 'ON]) - (* ;; "NEWTOPLINE is at least one new line in front of OLDTOPLINE. We concatenate them into a single chain with Ypositions adjusted so that the top of NEWTOPLINE is at PHEIGHT. ") +(\TEDIT.SCROLL.CARET + [LAMBDA (TSTREAM) (* ; "Edited 21-Nov-2024 10:39 by rmk") + (* ; "Edited 17-Nov-2024 19:00 by rmk") + (* ; "Edited 11-Nov-2024 22:07 by rmk") + (* ; "Edited 26-Oct-2024 11:06 by rmk") + (* ; "Edited 3-Oct-2024 08:53 by rmk") + (* ; "Edited 1-Jul-2024 18:30 by rmk") + (* ; "Edited 28-Jun-2024 15:26 by rmk") + (* ; "Edited 22-Jun-2024 00:10 by rmk") + (* ; "Edited 21-May-2024 15:40 by rmk") + (* ; "Edited 16-May-2024 23:42 by rmk") + (* ; "Edited 2-May-2024 00:27 by rmk") + (* ; "Edited 29-Apr-2024 11:18 by rmk") + (* ; "Edited 25-Apr-2024 11:08 by rmk") - (SETQ LASTVISIBLE (\TEDIT.NCONC.LINES NEWTOPLINE OLDTOPLINE PHEIGHT PBOTTOM)) - (LINKLD PLINES NEWTOPLINE) + (* ;; "Makes sure that the line containing the caret is visible in PANE, assuming that the caret and the current lines both reflect the same character numbers. For tall lines we want to be sure that the line's base is visible, that's where the caret flashes.. ") - (* ;; "All the needed lines have been constructed, linked, and positioned; some trailing lines may have been chopped. We now try to be clever and flicker-free about updating the display, although at this point a simple repaint will give the proper display. ") + (* ;; "If the caret is above the pane, move it down to the top line. ") - (CL:UNLESS (\TEDIT.OFFSCREEN.SCROLL TEXTOBJ PANE 'TOP) - (CL:WHEN (AND OLDTOPLINE (IGEQ (FGETLD OLDTOPLINE YBOT) - (FGETLD LASTVISIBLE YBOT))) + (* ;; "If the caret is visible in PANE, nothing to do.") - (* ;; "The images for at least OLDTOPLINE and any lines below are currently in the bitmap. Move it down. ") + (* ;; "If it is below the pane, then move its line to the bottom.") - (BITBLT PANE 0 (IPLUS VBOTTOM (IDIFFERENCE TOPOFOLD (FGETLD OLDTOPLINE YTOP))) - PANE 0 VBOTTOM (fetch WIDTH of PREG) - PHEIGHT - 'INPUT - 'REPLACE)) - (CL:WHEN LASTVISIBLE (* ; - "Clear out any cruft in the bitmap that lowering might have produced.") - (BLTSHADE WHITESHADE PANE 0 PBOTTOM (fetch WIDTH of PREG) - (FGETLD LASTVISIBLE YBOT) - 'REPLACE)) + (TEDIT.PROMPTCLEAR TSTREAM) + (PROG ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)) + PANE CARETCHNO) + (SETQ PANE (OR (FGETTOBJ TEXTOBJ SELPANE) + (\TEDIT.PRIMARYPANE TSTREAM))) + (CL:UNLESS PANE (RETURN)) + (CL:WHEN (\TEDIT.VISIBLECARETP PANE TEXTOBJ) + (RETURN)) + (SETQ CARETCHNO (TEDIT.GETPOINT TSTREAM)) + (if (ILEQ CARETCHNO (FGETLD (PANEPREFIX PANE) + LCHARLAST)) + then (* ; "Caret is above PANE") + (\TEDIT.SCROLLCH.TOP TSTREAM PANE CARETCHNO) + else + (* ;; + "CARETCHNO must be below PANE. Make a line to contain it at the bottom of PANE. ") - (* ;; - "Display the new lines. No need to clear the rectangle first, \DISPLAYLINE fills the bitmap") + (\TEDIT.SCROLLCH.BOTTOM TSTREAM PANE CARETCHNO 3]) - (for L inlines NEWTOPLINE until (EQ L OLDTOPLINE) do (\TEDIT.DISPLAYLINE TEXTOBJ L PANE - )) - (\TEDIT.SCROLL.SHOWSEL 'DOWN WHERESEL PANE TEXTOBJ OLDTOPLINE))) - NIL]) +(\TEDIT.VISIBLECARETP + [LAMBDA (PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 11:26 by rmk") + (* ; "Edited 29-Nov-2024 13:28 by rmk") + (* ; "Edited 18-Nov-2024 15:49 by rmk") + (* ; "Edited 17-Nov-2024 14:07 by rmk") + (* ; "Edited 11-Nov-2024 21:47 by rmk") -(\TEDIT.OFFSCREEN.SCROLL - [LAMBDA (TEXTOBJ PANE BOUNDARY) (* ; "Edited 19-Mar-2024 23:34 by rmk") - (* ; "Edited 15-Mar-2024 22:00 by rmk") - (* ; "Edited 20-Jan-2024 23:12 by rmk") - (* ; "Edited 2-Jan-2024 12:36 by rmk") - (* ; "Edited 4-Dec-2023 20:57 by rmk") - (* ; "Edited 11-May-2023 11:35 by rmk") - (* ; "Edited 30-May-91 23:34 by jds") + (* ;; "Returns the line in PANE that contains the caret, if the caret is currently positioned in PANE, even though it may temporally be suspended. This ssumes that the caret is positioned at the base of its line, and that the caret's base position can be retrieved from the line. If the line has a forced-end, the caret is presumably blinking at the front of the next line, so this returns NIL") - (* ;; "Returns NIL if PANE if PANE is not all or partially offscreen because of a previous move. Otherwise, this replaces the normal incremental screen update of the calling function. Essentially, it applies a version of the repaint function for the one offscreen PANE of TEXTOBJ that is being scrolled.") + (LET ((CARETCHNO (SUB1 (TEDIT.GETPOINT TEXTOBJ))) + (PCARET (PANECARET PANE)) + CARETLINE) - (CL:WHEN (EQMEMB BOUNDARY (WINDOWPROP PANE 'OFFSCREEN)) - (LET (SEL WASON PREVLINE) - (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) - (CL:WHEN (SETQ WASON (GETSEL SEL ONFLG)) - (\TEDIT.SHOWSEL SEL NIL)) (* ; - "Turn off the selection while we make changes") + (* ;; "Maybe X has to be in the Text region?") - (* ;; "Find the precursor of the target top line.") + (CL:WHEN (AND (fetch (TEDITCARET TCCARETY) of PCARET) + (fetch (TEDITCARET TCCARETX) of PCARET) + (IGEQ (fetch (TEDITCARET TCCARETX) of PCARET) + 0) + (IBETWEENP (fetch (TEDITCARET TCCARETY) of PCARET) + (PANEBOTTOM PANE) + (PANEHEIGHT PANE))) + (CL:WHEN (AND (IGREATERP CARETCHNO (TEXTLEN TEXTOBJ)) + (IGREATERP (TEXTLEN TEXTOBJ) + 0)) + (SETQ CARETCHNO (TEXTLEN TEXTOBJ))) + (SETQ CARETLINE (\TEDIT.VISIBLECHARP CARETCHNO PANE TEXTOBJ)) + (CL:WHEN NIL + (AND (FGETLD CARETLINE FORCED-END) + (FGETLD CARETLINE NEXTLINE)) + (SETQ CARETLINE (FGETLD CARETLINE NEXTLINE))) + (CL:IF (AND CARETLINE (IBETWEENP (FGETLD CARETLINE YBASE) + (PANEBOTTOM PANE) + (PANEHEIGHT PANE))) + CARETLINE))]) - [SETQ PREVLINE (for L (PHEIGHT _ (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE))) - inlines (fetch (TEXTWINDOW PLINES) of PANE) - when (ILESSP (FGETLD L YBOT) - PHEIGHT) do (RETURN (FGETLD L PREVLINE)) - finally (RETURN (fetch (TEXTWINDOW PLINES) of PANE] - (\TEDIT.CLEARPANE PANE) - (\TEDIT.FILLPANE PREVLINE TEXTOBJ PANE) - (CL:WHEN WASON - (\TEDIT.FIXSEL SEL TEXTOBJ) (* ; - "Account for any line shuffling and re-highlight") - (\TEDIT.SHOWSEL SEL T))) - T)]) +(\TEDIT.VISIBLECHARP + [LAMBDA (CHNO PANE TEXTOBJ) (* ; "Edited 1-Dec-2024 11:26 by rmk") + (* ; "Edited 29-Nov-2024 09:15 by rmk") + (* ; "Edited 17-Nov-2024 19:01 by rmk") + (* ; "Edited 11-Nov-2024 16:52 by rmk") + (* ; "Edited 2-Oct-2024 23:52 by rmk") -(\TEDIT.WHERE.SEL - [LAMBDA (TEXTOBJ TOPLINE PANE) (* ; "Edited 20-Jan-2024 22:17 by rmk") - (* ; "Edited 28-Nov-2023 11:48 by rmk") - (* ; "Edited 25-Nov-2023 15:47 by rmk") - (* ; "Edited 24-Nov-2023 12:47 by rmk") + (* ;; "Returns a visible line in PANE that contains CHNO, if any. ") - (* ;; "Returns the position of the selection in PANE relative to the first visible line in PANE, TOPLINE. NIL if the selection isn't set aand on. ") + (CL:WHEN (IGEQ CHNO (FGETLD (PANEPREFIX PANE) + LCHARLIM)) + (find L (TOP _ (PANEHEIGHT PANE)) + (BOTTOM _ (PANEBOTTOM PANE)) inlines (PANETOPLINE PANE) + suchthat (AND (WITHINLINEP CHNO L) + (ILEQ (FGETLD L LTRUEYTOP) + TOP) + (IGEQ (FGETLD L YBOT) + BOTTOM))))]) - (CL:WHEN TOPLINE - (LET (WHERESEL (SEL (FGETTOBJ TEXTOBJ SEL))) - (CL:WHEN (AND (FGETSEL SEL SET) - (FGETSEL SEL ONFLG)) - (SETQ WHERESEL (\TEDIT.WHERE.SEL1 SEL TOPLINE PANE)) - (CL:UNLESS (OR (EQ 'BELOW (CAR WHERESEL)) - (EQ 'ABOVE (CDR WHERESEL))) +(\TEDIT.BITMAPLINES + [LAMBDA (PANE STARTLINE ENDLINE) (* ; "Edited 1-Dec-2024 11:28 by rmk") + (* ; "Edited 29-Nov-2024 22:45 by rmk") + (* ; "Edited 24-Nov-2024 14:39 by rmk") + (* ; "Edited 22-Nov-2024 17:08 by rmk") + (* ; "Edited 19-Nov-2024 23:24 by rmk") + (* ; "Edited 16-Nov-2024 21:15 by rmk") + (* ; "Edited 11-Nov-2024 23:43 by rmk") + (* ; "Edited 8-Nov-2024 17:08 by rmk") + (* ; "Edited 5-Nov-2024 12:54 by rmk") - (* ;; - "At least partly visible. Only flush the caret, leave (perhaps partial) highlighting for BITBLT") - - (\TEDIT.SETCARET SEL PANE TEXTOBJ 'DISABLE)) - WHERESEL)))]) - -(\TEDIT.WHERE.SEL1 - [LAMBDA (SEL TOPLINE PANE) (* ; "Edited 24-Nov-2023 12:49 by rmk") - (* ; "Edited 18-Nov-2023 23:52 by rmk") - - (* ;; "Determines the relationship of the start end end of SEL to the lines that are visible PANE. This assumes that TOPLINE is the first currently visible line. We search PANE for the last selected line, since we don't trust LN.") - - (* ;; "The value is a pair (ABOVE/IN/BELOW, indicating whether the start/end of the selection is above, in, or below the pane.") + (* ;; "This returns the completely visible top and bottom lines of PANE's on-screen bitmap, from STARTLINE (or its next, if it isn't completely visible) to the bottom of PANE.") (* ;; - "This is used to do incremental highlighting that avoids flickering with wheel-scroll spinning.") + "If the top of the top line is above PANE, its bitmap has been clipped. Go to the nextline.") - (LET (LASTVISIBLE) + (CL:WHEN STARTLINE + (CL:UNLESS (GETLD STARTLINE LDUMMY) + (CL:WHEN (AND STARTLINE (IGREATERP (FGETLD STARTLINE YTOP) + (PANEHEIGHT PANE))) + (SETQ STARTLINE (FGETLD STARTLINE NEXTLINE)) + (CL:WHEN (EQ STARTLINE (PANESUFFIX PANE)) + (SETQ STARTLINE NIL))) + [for L (PHEIGHT _ (PANEHEIGHT PANE)) + (PBOTTOM _ (PANEBOTTOM PANE)) + (VHEIGHT _ (\TEDIT.ONSCREEN? PANE 'HEIGHT)) + (VBOTTOM _ (\TEDIT.ONSCREEN? PANE 'BOTTOM)) inlines STARTLINE + first + (* ;; "Visible height and visible bottom are in PANE's coordinate system. The bitmap is only good for onscreen lines, so we have to calculate the onscreen height and onscreen bottom.") - (* ;; - "Our search ends either when we run off PANE or we encounter the last line of the selection.") + (* ;; "PANE could be offscreen on the top, bottom, or both. ") - (* ;; "If we stop at the last SEL line, we will determine that the it is not BELOW") + (if (IEQP VBOTTOM PBOTTOM) + then + (* ;; "Bottom is on screen, VHEIGHT is good") - [SETQ LASTVISIBLE (for L (CHLAST _ (SUB1 (FGETSEL SEL CHLIM))) - (PBOTTOM _ (fetch BOTTOM of (DSPCLIPPINGREGION NIL PANE))) - inlines TOPLINE do (CL:WHEN (WITHINLINEP CHLAST L) - (RETURN L)) - (CL:WHEN (ILESSP (FGETLD L YBOT) - PBOTTOM) - (RETURN (OR $$PREVLINE TOPLINE))) - finally (RETURN (OR $$PREVLINE TOPLINE] + elseif (IGREATERP PHEIGHT (IPLUS VBOTTOM VHEIGHT)) + then + (* ;; "Top is offscreen, VHEIGHT is good") - (* ;; "(Don't put comment between ifs--they go into the CONS)") + else + (* ;; "Top is onscreen, VBOTTOM shouldn't figure into height") - (CONS (if (ILESSP (FGETSEL SEL CH#) - (FGETLD TOPLINE LCHAR1)) - then - (* ;; "SEL begins above TOPLINE, the first visible line") + (SETQ VHEIGHT PHEIGHT)) - 'ABOVE - elseif (IGREATERP (FGETSEL SEL CH#) - (FGETLD LASTVISIBLE LCHARLIM)) - then - (* ;; "") + (* ;; "It wouldn't be harmful to let the bitmap include lines at the bottom that are below the screen, if we are moving down. No sense in formatting and displaying those lines. Or include lines above the screen so that they wouldn't be formatted either.") + when (ILEQ (FGETLD L LTRUEYTOP) + VHEIGHT) do (RETURN (CL:WHEN (IGEQ (FGETLD L YBOT) + VBOTTOM) - 'BELOW - else 'IN) - (if (ILESSP (SUB1 (FGETSEL SEL CHLIM)) - (FGETLD TOPLINE LCHAR1)) - then - (* ;; "SEL ends above TOPLINE (presumably SELBEGIN is also ABOVE)") + (* ;; "If a first line is visible, there must be a last.") - 'ABOVE - elseif (IGREATERP (SUB1 (FGETSEL SEL CHLIM)) - (FGETLD LASTVISIBLE LCHARLIM)) - then - (* ;; "Not above, not displayed: must be below.") + (CONS L (find LL (TOOFAR _ (CL:IF ENDLINE + (FGETLD ENDLINE NEXTLINE) + (PANESUFFIX PANE))) inlines L + until (EQ LL TOOFAR) + suchthat (ILESSP (FGETLD LL YBOT) + VBOTTOM) finally (RETURN $$PREVLINE)))) + ]))]) - 'BELOW - else 'IN]) +(\TEDIT.SETPANE.TOPLINE + [LAMBDA (PANE TOPLINE PREFIXYBOT) (* ; "Edited 7-Nov-2024 08:50 by rmk") + (* ; "Edited 4-Nov-2024 23:05 by rmk") + + (* ;; "Install TOPLINE as the PANETOPLINE of PANE, setting PANE's YBOT to PREFIXYBOT if given or the YTOP of TOPLINE. In the PREFIXYBOT case, the pane will be inconsistent until either the line or the pane is adjusted. But before that, the difference between the PANE YBOT and TOPLINE YTOP may be useful.") + + (LET ((PREFIX (PANEPREFIX PANE))) + (SETLD PREFIX YBOT (OR PREFIXYBOT (FGETLD TOPLINE YTOP))) + (LINKLD PREFIX TOPLINE) + (\TEDIT.PREFIX.LCHARLIM PANE (SUB1 (FGETLD TOPLINE LCHAR1))) + TOPLINE]) + +(\TEDIT.SHIFTLINES + [LAMBDA (PREVLINE NEXTLINE PANE TEXTOBJ BITMAPLINES SCROLLING) + (* ; "Edited 17-Dec-2024 23:40 by rmk") + (* ; "Edited 3-Dec-2024 16:08 by rmk") + (* ; "Edited 1-Dec-2024 11:31 by rmk") + (* ; "Edited 24-Nov-2024 11:45 by rmk") + (* ; "Edited 22-Nov-2024 18:00 by rmk") + (* ; "Edited 19-Nov-2024 23:23 by rmk") + (* ; "Edited 17-Nov-2024 10:25 by rmk") + (* ; "Edited 11-Nov-2024 23:51 by rmk") + + (* ;; "BITMAPLINES contains the first and last lines of the currently resuable PANE bitmap. PANE is refilled from the next of PREVLINE to the bottom, using BITMAPLINES and BITBLT to translate the images for lines that are already known. This skips formatting and redisplaying of those lines, but more importantly, it suppresses flicker. ") + + (LINKLD PREVLINE NEXTLINE) + + (* ;; "Take down the caret, but importantly, don't take down the selection--that would wipe out the bitmap-highlighting that we want to translate.") + + (LET ((SEL (TEXTSEL TEXTOBJ)) + LASTVISIBLE) + (\TEDIT.SETCARET SEL PANE TEXTOBJ 'OFF) + (if BITMAPLINES + then [LET* ((VLEFT (\TEDIT.ONSCREEN? PANE 'LEFT)) + (PBOTTOM (PANEBOTTOM PANE)) + (BMTOPL (CAR BITMAPLINES)) + (BMTOPY (FGETLD BMTOPL YTOP)) + (BMBOTL (CDR BITMAPLINES)) + (BMBOTY (FGETLD BMBOTL YBOT)) + DELTA) + +(* ;;; " REPOSITION all lines in the chain properly with respect to PREVLINE. ") + + [for L (Y _ (FGETLD PREVLINE YBOT)) inlines NEXTLINE + do (SETYTOP L Y) + (SETQ Y (IDIFFERENCE Y (FGETLD L LHEIGHT] + +(* ;;; "TRANSLATE the bitmap to be consistent with its new line positions. This is done before any display operations, to be sure that the bitmap isn't corrupted.") + + (SETQ DELTA (IDIFFERENCE (FGETLD BMTOPL YTOP) + BMTOPY)) + (BITBLT PANE VLEFT BMBOTY PANE VLEFT (IPLUS BMBOTY DELTA) + (PANEWIDTH PANE) + (IDIFFERENCE BMTOPY BMBOTY) + 'INPUT + 'REPLACE) + (SETQ BMTOPY (FGETLD BMTOPL YTOP)) + +(* ;;; "Display any lines ABOVE the top of the translated bitmap, presumably for scroll down and insertion. Lines exist and have been formatted and positioned, but not yet displayed.") + + (for L inlines NEXTLINE while (IGEQ (FGETLD L YBOT) + BMTOPY) + do (\TEDIT.DISPLAYLINE TEXTOBJ L PANE)) + +(* ;;; "Deal with lines BELOW the bitmap. First. clear to the bottom--important to clear before displaying") + + (for L backlines BMBOTL while (AND (ILESSP (FGETLD BMBOTL YBOT) + PBOTTOM) + (NOT (\TEDIT.SHOW.AT.BOTTOMP BMBOTL PANE)) + ) do (SETQ BMBOTL (FGETLD BMBOTL PREVLINE) + )) + (\TEDIT.CLEARPANE.BELOW.LINE BMBOTL PANE TEXTOBJ) + [SETQ LASTVISIBLE (if (EQ BMBOTL (PANESUFFIX PANE)) + then (PANEBOTTOMLINE PANE) + elseif (IGEQ (FGETLD BMBOTL YBOT) + PBOTTOM) + then + (* ;; + "Bitmap didn't fill the pane. Maybe more lines needed below (scroll up or deletion).") + + (\TEDIT.LINES.BELOW BMBOTL PANE TEXTOBJ) + else + (* ;; + "Bit map went below the bottom, back up to the previous visible line. (scroll down or insertion)") + + (find L backlines BMBOTL + suchthat (IGREATERP (FGETLD L YBOT) + PBOTTOM] + (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE) + + (* ;; "Lines are now properly linked, positioned, and displayed.") + +(* ;;; "") + +(* ;;; "The part of the current SELECTION within the bitmap retains its correct highlighting, but highlighting has to be applied to lines above or below.") + + (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE) + (CL:WHEN (AND (FGETSEL SEL ONFLG) + (NEQ 0 (FGETSEL SEL DCH))) + + (* ;; "Restore the highlighting for selected lines that are above or below the bitmap. The lines within the bitmap retained their proper highlighting. Above is first.") + + (for L (L1 _ (\TEDIT.SEL.L1 SEL PANE TEXTOBJ)) + (SEL1 _ (FGETSEL SEL CH#)) + (SELN _ (FGETSEL SEL CHLAST)) backlines (FGETLD BMTOPL PREVLINE) + first (CL:UNLESS (AND L1 (NEQ L1 BMTOPL) + (IGREATERP (FGETLD L1 YTOP) + BMTOPY)) + + (* ;; "Selection's L1 is below the bitmap's new top.") + + (RETURN)) when (FLINESELECTEDP L SEL1 SELN) + do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L1 L PANE SEL) + (RETURN) repeatuntil (EQ L L1)) + (for L (LN _ (\TEDIT.SEL.LN SEL PANE TEXTOBJ)) + (SEL1 _ (FGETSEL SEL CH#)) + (SELN _ (FGETSEL SEL CHLAST)) inlines (FGETLD BMBOTL NEXTLINE) + first (CL:UNLESS (AND LN (ILESSP (FGETLD LN YBOT) + (IPLUS BMBOTY DELTA))) + + (* ;; "Selection's LN is above the bitmap's new bottom") + + (RETURN)) when (FLINESELECTEDP L SEL1 SELN) + do (\TEDIT.SHOWSEL.HILIGHT TEXTOBJ L LN PANE SEL) + (RETURN) repeatuntil (EQ L LN)))] + else + (* ;; "No useful bitmap bits, just create/display lines below PREVLINE") + + (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ) + (SETQ LASTVISIBLE (\TEDIT.LINES.BELOW PREVLINE PANE TEXTOBJ)) + (\TEDIT.SUFFIXLINE.CREATE PANE TEXTOBJ LASTVISIBLE) + (\TEDIT.FIXSEL SEL TEXTOBJ NIL PANE)) + (CL:WHEN SCROLLING + + (* ;; "If scrolling up or down, we brute force wipe out whatever is above PREVLINE. If not scrolling, those are the lines from the top to lastvalid that are preserved.") + + (BLTSHADE WHITESHADE PANE (PANELEFT PANE) + (FGETLD PREVLINE YBOT) + (PANEWIDTH PANE) + (PANEHEIGHT PANE) + 'REPLACE)) + + (* ;; "Caller is responsible for turning the caret back on") + + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE]) ) (DEFINEQ -(\TEDIT.ONSCREEN - [LAMBDA (PANE) (* ; "Edited 19-Nov-2023 20:23 by rmk") - - (* ;; "If the clipping region is entirely onscreen, this returns the BOTTOM and TOP of the clipping region.") - - (* ;; "If it is off the screen at the bottom or top, this returns the effective bottom and top, in clipping region coordinates, of the part of the region that is visible on the screen.") - - (* ;; "This assumes that the clipping region is in the window's coordinate system.") - - (LET ((PREG (DSPCLIPPINGREGION NIL PANE)) - (YOFFSET (DSPYOFFSET NIL PANE))) - (LIST (if (IGEQ YOFFSET 0) - then - (* ;; "Bottom is not below screen, could be above the top") - - (fetch BOTTOM of PREG) - else - (* ;; "Bottom is below screen") - - (IDIFFERENCE (fetch BOTTOM of PREG) - YOFFSET)) - (if (ILEQ (IPLUS YOFFSET (fetch TOP of PREG)) - SCREENHEIGHT) - then - (* ;; "Top is not above screen, could be below the bottom") - - (fetch TOP of PREG) - else - (* ;; "Top is above screen") - - (IDIFFERENCE SCREENHEIGHT YOFFSET]) - (\TEDIT.ONSCREEN? - [LAMBDA (PANE PROP) (* ; "Edited 29-Nov-2023 23:39 by rmk") + [LAMBDA (PANE PROP) (* ; "Edited 1-Dec-2024 11:50 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 13-Jun-2024 22:12 by rmk") + (* ; "Edited 15-May-2024 09:27 by rmk") + (* ; "Edited 25-Apr-2024 22:23 by rmk") + (* ; "Edited 22-Apr-2024 21:56 by rmk") + (* ; "Edited 9-Apr-2024 16:57 by rmk") + (* ; "Edited 29-Nov-2023 23:39 by rmk") (* ;; "If the PROP of PANE is on screen, returns that property of its clipping region (equivalent to (fetch PROP of (DSPCLIPPINGREGION NIL PANE).") - (* ;; " But if that property is off screen, the value gives the position in the clipping region that is still visible. E.g. if the bottom is below the screen by N points (REG's bottom is -N), the return will be the clipping regions bottom _N.") + (* ;; " But if that property is off screen, the value gives the position in clipping region coordinates that is still visible. E.g. if the bottom is below the screen by N points (PREG's bottom is -N), the return is the clipping regions bottom -N.") - (LET [VAL (PREG (DSPCLIPPINGREGION NIL PANE)) + (LET [VAL (PREG (PANEREGION PANE)) + (REG (fetch (WINDOW REG) of PANE)) (BORDER (OR 0 (WINDOWPROP PANE 'BORDER] (SELECTQ PROP - (BOTTOM (SETQ VAL (fetch (REGION BOTTOM) of (fetch REG of PANE))) + (BOTTOM (SETQ VAL (fetch (REGION BOTTOM) of REG)) (if (ILESSP VAL 0) - then (IPLUS BORDER (IDIFFERENCE (fetch BOTTOM of PREG) + then (IPLUS BORDER (IDIFFERENCE (fetch (REGION BOTTOM) of PREG) VAL)) - else (fetch BOTTOM of PREG))) - (TOP (SETQ VAL (fetch (REGION TOP) of (fetch REG of PANE))) + else (fetch (REGION BOTTOM) of PREG))) + (TOP (SETQ VAL (fetch (REGION TOP) of REG)) (if (IGREATERP VAL SCREENHEIGHT) - then (IDIFFERENCE (IDIFFERENCE (fetch TOP of PREG) + then (IDIFFERENCE (IDIFFERENCE (fetch (REGION TOP) of PREG) (IDIFFERENCE VAL SCREENHEIGHT)) (WINDOWPROP PANE 'BORDER)) - else (fetch TOP of PREG))) - (LEFT (SETQ VAL (fetch (REGION LEFT) of (fetch REG of PANE))) + else (fetch (REGION TOP) of PREG))) + (LEFT (SETQ VAL (fetch (REGION LEFT) of REG)) (if (ILESSP VAL 0) - then (IPLUS (WINDOWPROP PANE 'BORDER) - (IDIFFERENCE (fetch LEFT of PREG) - VAL)) + then + (* ;; "I don't understand why the border is subtracted instead of added. But this makes \TEDIT.SCROLLUP and \TEDIT.SCROLLDOWN ") + + (IDIFFERENCE (IDIFFERENCE (fetch (REGION LEFT) of PREG) + VAL) + (WINDOWPROP PANE 'BORDER)) else (fetch (REGION LEFT) of PREG))) - (RIGHT (SETQ VAL (fetch (REGION RIGHT) of (fetch REG of PANE))) + (RIGHT (SETQ VAL (fetch (REGION RIGHT) of REG)) (if (IGREATERP VAL SCREENWIDTH) - then (IDIFFERENCE (IDIFFERENCE (fetch RIGHT of PREG) + then (IDIFFERENCE (IDIFFERENCE (fetch (REGION RIGHT) of PREG) (IDIFFERENCE VAL SCREENWIDTH)) (WINDOWPROP PANE 'BORDER)) - else (fetch RIGHT of PREG))) - (SHOULDNT]) + else (fetch (REGION RIGHT) of PREG))) + (HEIGHT (* ; "Height of the onscreen subregion") + (IDIFFERENCE (\TEDIT.ONSCREEN? PANE 'PTOP) + (\TEDIT.ONSCREEN? PANE 'BOTTOM))) + (WIDTH (IDIFFERENCE (\TEDIT.ONSCREEN? PANE 'PRIGHT) + (\TEDIT.ONSCREEN? PANE 'LEFT))) + (PTOP (SETQ VAL (fetch (REGION PTOP) of REG)) + (if (IGREATERP VAL SCREENHEIGHT) + then (IDIFFERENCE (IDIFFERENCE (fetch (REGION PTOP) of PREG) + (IDIFFERENCE VAL SCREENHEIGHT)) + (WINDOWPROP PANE 'BORDER)) + else (fetch (REGION PTOP) of PREG))) + (PRIGHT (SETQ VAL (fetch (REGION PRIGHT) of REG)) + (if (IGREATERP VAL SCREENWIDTH) + then (IDIFFERENCE (IDIFFERENCE (fetch (REGION PRIGHT) of PREG) + (IDIFFERENCE VAL SCREENWIDTH)) + (WINDOWPROP PANE 'BORDER)) + else (fetch (REGION PRIGHT) of PREG))) + (\TEDIT.THELP]) -(\TEDIT.PANE.SCREENREGION - [LAMBDA (PANE) (* ; "Edited 19-Nov-2023 23:58 by rmk") +(\TEDIT.ONSCREEN.REGION + [LAMBDA (WINDOW) (* ; "Edited 1-Dec-2024 11:50 by rmk") + (* ; "Edited 21-Oct-2024 00:27 by rmk") + (* ; "Edited 13-Jun-2024 22:02 by rmk") + (* ; "Edited 16-May-2024 17:40 by rmk") + (* ; "Edited 6-May-2024 11:31 by rmk") - (* ;; "For scrolling when the window is partially offscreen.") + (* ;; "This returns the intersection of WINDOW's clipping region and the screen region, in window coordinates. This is the part of the clipping region that is visible on the screen, and presumably has a valid bitmap.") - (* ;; "If the clipping region is entirely onscreen, this returns the clipping region.") + (* ;; "If WINDOW is entirely onscreen, the result will be a copy of the clipping region.Otherwise, this returns the subregion of the clipping region that is actually visible.") - (* ;; "If it is off the screen at the bottom or top, this returns the subregion of the clipping region that is actually onscreen.") + (* ;; "For example, if the bottom of the PANE is below the screen by N points (PREG's bottom is -N), then VBOTTOM is clipping region's bottom + |N|.") - (* ;; "This assumes that the clipping region is in the window's coordinate system.") + (\TEDIT.THELP "FIX WIDTH AND HEIGHT") + (NOTUSED) + (DECLARE (USEDFREE SCREEN)) + (if (WINDOWPROP WINDOW 'OFFSCREEN) + then (LET ((CREG (DSPCLIPPINGREGION NIL WINDOW)) + [BORDER (OR 0 (WINDOWPROP WINDOW 'BORDER] + (REG (fetch (WINDOW REG) of WINDOW)) + VAL VLEFT VBOTTOM VWIDTH VHEIGHT) + (SETQ VAL (fetch (REGION BOTTOM) of REG)) + (SETQ VBOTTOM (if (ILESSP VAL 0) + then (IPLUS VAL BORDER (IDIFFERENCE (fetch (REGION BOTTOM) + of CREG))) + else (fetch (REGION BOTTOM) of CREG))) + (SETQ VAL (fetch (REGION LEFT) of REG)) + (SETQ VLEFT (if (ILESSP VAL 0) + then + (* ;; "I don't understand why the border is subtracted instead of added. But this makes \TEDIT.SCROLLUP and \TEDIT.SCROLLDOWN ") - (LET ((PREG (DSPCLIPPINGREGION NIL PANE)) - (YOFFSET (DSPYOFFSET NIL PANE)) - BOTTOM HEIGHT) - (if (AND (IGEQ YOFFSET 0) - (ILEQ (IPLUS YOFFSET (fetch PTOP of PREG)) - SCREENHEIGHT)) - then - (* ;; "Top and bottom are on the screen") + (IDIFFERENCE (IDIFFERENCE (fetch LEFT of CREG) + VAL) + BORDER) + else (fetch (REGION LEFT) of CREG))) + (SETQ VAL (fetch (REGION WIDTH) of CREG)) + (SETQ VWIDTH (if (IGREATERP (IDIFFERENCE (fetch (REGION RIGHT) of REG) + BORDER) + (fetch (SCREEN SCWIDTH) of SCREEN)) + then (IDIFFERENCE (\TEDIT.ONSCREEN? WINDOW 'PRIGHT) + VLEFT) + else VAL)) + (SETQ VAL (fetch (REGION HEIGHT) of CREG)) + (SETQ VHEIGHT (if (IGREATERP VAL SCREENHEIGHT) + then (IDIFFERENCE (\TEDIT.ONSCREEN? WINDOW 'PTOP) + VBOTTOM) + else VAL)) + (create REGION + LEFT _ VLEFT + BOTTOM _ VBOTTOM + WIDTH _ VWIDTH + HEIGHT _ VHEIGHT)) + else (DSPCLIPPINGREGION NIL WINDOW]) - PREG - else (SETQ BOTTOM (IMAX 0 (IDIFFERENCE (fetch BOTTOM of PREG) - YOFFSET))) - (SETQ HEIGHT (IDIFFERENCE (IMIN (fetch PTOP of PREG) - (IPLUS SCREENHEIGHT YOFFSET)) - BOTTOM)) - (create REGION using PREG BOTTOM _ BOTTOM HEIGHT _ HEIGHT]) +(\TEDIT.AFTERMOVEFN + [LAMBDA (PANE) (* ; "Edited 6-Jul-2024 16:58 by rmk") + (* ; "Edited 20-Jan-2024 23:22 by rmk") + (* ; "Edited 21-Dec-2023 17:18 by rmk") + (* ; "Edited 20-Dec-2023 00:33 by rmk") + + (* ;; "If PANE was partly off screen before this move, then repaint it. If it is still off screen after this move, record that for the next move.") + + (CL:WHEN (WINDOWPROP PANE 'OFFSCREEN) + (\TEDIT.FILL.PANES PANE)) (* ; + "This repaints all PANE's sister, maybe not needed?") + (WINDOWPROP PANE 'OFFSCREEN (OFFSCREENP PANE]) + +(OFFSCREENP + [LAMBDA (WINDOW) (* ; "Edited 13-Jun-2024 21:59 by rmk") + (* ; "Edited 19-Mar-2024 23:30 by rmk") + (* ; "Edited 20-Jan-2024 23:23 by rmk") + (* ; "Edited 21-Dec-2023 17:17 by rmk") + (* ; "Edited 17-Dec-2023 17:27 by rmk") + + (* ;; "Returns a list indicating which boundaries of the window is offscreen. Also includes VERTICAL or HORIZONTAL, if one of those respective dimensions is off.") + + (LET ((REGION (WINDOWREGION WINDOW)) + (SCREEN (fetch (WINDOW SCREEN) of WINDOW)) + RESULT) + (CL:WHEN (ILESSP (fetch (REGION LEFT) of REGION) + 0) + (PUSH RESULT 'LEFT)) + (CL:WHEN (IGREATERP (fetch (REGION RIGHT) of REGION) + (fetch (SCREEN SCWIDTH) of SCREEN)) + (PUSH RESULT 'RIGHT)) + (CL:WHEN (OR (MEMB 'LEFT RESULT) + (MEMB 'RIGHT RESULT)) + (PUSH RESULT 'HORIZONTAL)) + (CL:WHEN (IGREATERP (fetch (REGION TOP) of REGION) + (fetch (SCREEN SCHEIGHT) of SCREEN)) + (PUSH RESULT 'TOP)) + (CL:WHEN (ILESSP (fetch (REGION BOTTOM) of REGION) + 0) + (PUSH RESULT 'BOTTOM)) + (CL:WHEN (OR (MEMB 'TOP RESULT) + (MEMB 'BOTTOM RESULT)) + (PUSH RESULT 'VERTICAL)) + RESULT]) ) @@ -2771,7 +3243,9 @@ 10 NIL X Y]) (\TEDIT.FLASHCARET - [LAMBDA (TEXTOBJ) (* ; "Edited 19-Dec-2023 11:31 by rmk") + [LAMBDA (TEXTOBJ) (* ; "Edited 28-Jun-2024 22:59 by rmk") + (* ; "Edited 25-May-2024 13:59 by rmk") + (* ; "Edited 19-Dec-2023 11:31 by rmk") (* ; "Edited 12-Oct-2023 23:31 by rmk") (* ; "Edited 16-Sep-2023 22:51 by rmk") (* jds "16-Jul-85 12:35") @@ -2779,10 +3253,11 @@ (* ;;  "Unless the caret is constrained to be INVISIBLE/UP, give it a chance to flash in every pane.") - (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY) - [bind (FIRSTTIME _ T) for CARET in (FGETTOBJ TEXTOBJ CARET) unless (fetch (TEDITCARET - TCFORCEUP) - of CARET) + (CL:UNLESS (AND NIL (FGETTOBJ TEXTOBJ TXTREADONLY)) + [bind (FIRSTTIME _ T) for PANE CARET inpanes TEXTOBJ eachtime (SETQ CARET (GETPANEPROP + (PANEPROPS PANE) + PCARET)) + unless (fetch (TEDITCARET TCFORCEUP) of CARET) do (* ;  "The caret need not stay invisible.") (if FIRSTTIME @@ -2815,12 +3290,19 @@ (DSPYPOSITION Y (ffetch (TEDITCARET TCCARETDS) of CARET)))]) (TEDIT.NORMALIZECARET - [LAMBDA (TSTREAM SEL EVEN.IF.VISIBLE) (* ; "Edited 21-Mar-2024 21:27 by rmk") - (* ; "Edited 20-Mar-2024 06:46 by rmk") - (* ; "Edited 15-Mar-2024 22:00 by rmk") - (* ; "Edited 9-Mar-2024 23:39 by rmk") + [LAMBDA (TSTREAM SEL EVEN.IF.VISIBLE) (* ; "Edited 9-Nov-2024 14:40 by rmk") + (* ; "Edited 29-Oct-2024 11:45 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 21-Jun-2024 23:58 by rmk") + (* ; "Edited 19-Jun-2024 14:37 by rmk") + (* ; "Edited 16-Jun-2024 10:08 by rmk") + (* ; "Edited 16-May-2024 23:04 by rmk") + (* ; "Edited 7-May-2024 23:01 by rmk") + (* ; "Edited 1-May-2024 22:59 by rmk") + (* ; "Edited 29-Apr-2024 15:12 by rmk") + (* ; "Edited 9-Apr-2024 19:31 by rmk") + (* ; "Edited 21-Mar-2024 21:27 by rmk") (* ; "Edited 21-Feb-2024 20:43 by rmk") - (* ; "Edited 18-Feb-2024 23:35 by rmk") (* ; "Edited 2-Jan-2024 11:09 by rmk") (* ; "Edited 20-Nov-2023 14:22 by rmk") (* ; "Edited 5-Oct-2023 22:38 by rmk") @@ -2829,138 +3311,106 @@ (* ;; "This ensures that the caret is visible in the pane where the selection SEL was made. Other panes are left alone (caret may or may not be visible), presumably because you don't want all the panes to jump to the caret when you are working in just one of them.") - (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) - (CL:UNLESS (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE) - (CL:UNLESS SEL - (SETQ SEL (\DTEST (FGETTOBJ TEXTOBJ SEL) - 'SELECTION))) - (CL:WHEN (AND (FGETSEL SEL SET) - (IGREATERP (FGETTOBJ TEXTOBJ TEXTLEN) - 0)) (* ; - "If the selection isn't set, don't bother.") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (LET* ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (SELPANE (FGETTOBJ TEXTOBJ SELPANE))) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (\DTEST SEL 'SELECTION) + (CL:WHEN (AND SELPANE (FGETSEL SEL SET) + (IGREATERP (FGETTOBJ TEXTOBJ TEXTLEN) + 0)) + (CL:WHEN (OR EVEN.IF.VISIBLE (NOT (\TEDIT.VISIBLECARETP SELPANE TEXTOBJ))) - (* ;; "This is essentially %"find selpane in panes%" and the corresponding L1/LN in SEL. SELPANE is the pane of the last selection") + (* ;; "Move the caret character to top of SELPANE.") - (for PANE CH# CARETYBOT TOPLINE PREG PHEIGHT PBOTTOM (SELPANE _ - (OR (FGETTOBJ TEXTOBJ - SELPANE) - (\TEDIT.PRIMARYW - TEXTOBJ))) - inpanes TEXTOBJ as L1 inside (FGETSEL SEL L1) as LN inside (FGETSEL SEL LN) - first (CL:UNLESS SELPANE (RETURN)) when (EQ PANE SELPANE) - do - (* ;; - "Find the YBOT in SELPANE of the line with the selected character, if known.") - - (SETQ PREG (DSPCLIPPINGREGION NIL PANE)) - (SETQ PHEIGHT (fetch PTOP of PREG)) - (SETQ PBOTTOM (fetch BOTTOM of PREG)) - - (* ;; - "Find the selected character either at the beginning or end of the selection.") - - [SETQ CH# (IMAX 1 (IMIN (TEXTLEN TEXTOBJ) - (SELECTQ (FGETSEL SEL POINT) - (LEFT (FGETSEL SEL CH#)) - (RIGHT (SUB1 (FGETSEL SEL CHLIM))) - (SHOULDNT] - (SETQ CARETYBOT (SELECTQ (FGETSEL SEL POINT) - (LEFT (AND L1 (GETLD L1 YBOT))) - (RIGHT (AND LN (GETLD LN YBOT))) - NIL)) - - (* ;; - "We don't want to jump around if the caret is already visible in SELPANE, unless EVEN.IF.VISIBLE ") - - (CL:WHEN (OR EVEN.IF.VISIBLE (NOT CARETYBOT) - (IGEQ CARETYBOT PHEIGHT) - (ILESSP CARETYBOT PBOTTOM)) - - (* ;; "Not visible, work to do: Make sure the line containing CH# is linked in and scrolled to the top of the pane. This should be replaceable by \TEDIT.SCROLLFN, with the appropriate DY.") - - (\TEDIT.SHOWSEL SEL NIL SELPANE TEXTOBJ) - (SETQ TOPLINE (CADR (\TEDIT.LINES.ABOVE TEXTOBJ CH# PHEIGHT))) - (SETYPOS TOPLINE (IDIFFERENCE PHEIGHT (GETLD TOPLINE LHEIGHT))) - (LINKLD (fetch (TEXTWINDOW PLINES) of SELPANE) - TOPLINE) - - (* ;; - "Lines are established and positioned. Clear the window, display the first (caret) caret line.") - - (\TEDIT.CLEARPANE PANE) - (\TEDIT.DISPLAYLINE TEXTOBJ TOPLINE SELPANE) - (\TEDIT.FILLPANE TOPLINE TEXTOBJ SELPANE) - (* ; - "And fill out the window from there.") - (\TEDIT.FIXSEL SEL TEXTOBJ NIL SELPANE) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ SELPANE) - (\TEDIT.SHOWSEL SEL T SELPANE TEXTOBJ)) - (RETURN))))]) + (\TEDIT.SCROLLCH.TOP TSTREAM SELPANE (SELECTQ (FGETSEL SEL POINT) + (LEFT (FGETSEL SEL CH#)) + (RIGHT (SUB1 (FGETSEL SEL CHLIM))) + (\TEDIT.THELP))) + TSTREAM))]) (\TEDIT.SETCARET - [LAMBDA (SEL PANE TEXTOBJ DISPOSITION CARET) (* ; "Edited 15-Dec-2023 23:37 by rmk") + [LAMBDA (SEL PANE TEXTOBJ DISPOSITION) (* ; "Edited 1-Dec-2024 11:51 by rmk") + (* ; "Edited 22-Nov-2024 11:39 by rmk") + (* ; "Edited 20-Nov-2024 12:37 by rmk") + (* ; "Edited 17-Nov-2024 19:01 by rmk") + (* ; "Edited 21-Oct-2024 00:33 by rmk") + (* ; "Edited 9-Sep-2024 13:49 by rmk") + (* ; "Edited 28-Jun-2024 22:36 by rmk") + (* ; "Edited 25-May-2024 13:57 by rmk") + (* ; "Edited 15-Dec-2023 23:37 by rmk") (* ; "Edited 17-Nov-2023 23:55 by rmk") - (* ; "Edited 26-Oct-2023 08:42 by rmk") - (* ; "Edited 24-Oct-2023 11:50 by rmk") (* ; "Edited 16-Sep-2023 23:09 by rmk") (* ; "Edited 20-Apr-2023 09:26 by rmk") (* ; "Edited 30-May-91 23:35 by jds") - (* ;; "Sets SEL's caret in PANE. CARET is optional. If not given, then PANE's caret in TEXTOBJ is used. Caret will be located relative to L1 or LN in SEL, depending on POINT. ") + (* ;; "Sets SEL's caret in PANE. Caret will be located relative to L1 or LN in SEL, depending on POINT. ") (* ;; "DISPOSITION: NIL/OFF: suspend it temporarily but retain position, DISABLE: move it out of the pane until reenabled, otherwise: flash at POINT.") - (CL:WHEN (FGETSEL SEL HASCARET) - (CL:UNLESS CARET - (SETQ CARET (for P inpanes (PROGN TEXTOBJ) as PCARET in (FGETTOBJ TEXTOBJ CARET) - when (EQ P PANE) do (RETURN PCARET)))) - [SELECTQ DISPOSITION - (DISABLE (\TEDIT.UPCARET CARET -10 -10)) - ((NIL OFF) (* ; - "Originally, no X Y, like DISABLE. But that left turds") - (\TEDIT.UPCARET CARET -10 -10)) - (LET (LINE X Y PREG) (* ; "Is the caret on a visible line?") - (for P inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN - in (FGETSEL SEL LN) when (EQ P PANE) - do (SELECTQ (FGETSEL SEL POINT) - (LEFT (CL:WHEN (AND L1 (WITHINLINEP (FGETSEL SEL CH#) - L1)) - (SETQ LINE L1) - (SETQ X (FGETSEL SEL X0)))) - (RIGHT (CL:WHEN (AND LN (WITHINLINEP (SUB1 (FGETSEL SEL CHLIM)) - LN)) - (SETQ LINE LN) - (SETQ X (FGETSEL SEL XLIM)))) - (SHOULDNT)) - (RETURN)) - (if LINE - then (SETQ Y (FGETLD LINE YBASE)) - (SETQ PREG (DSPCLIPPINGREGION NIL PANE)) - (COND - ((AND (ILESSP Y (fetch PTOP of PREG)) - (IGEQ (FGETLD LINE YBOT) - (fetch BOTTOM of PREG))) - (* ; - "Move to right position even if not flashing") - (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY) - (\TEDIT.UPCARET CARET X Y) - (\TEDIT.DOWNCARET CARET X Y))) - (T - (* ;; "Caret line is not in PANE, make it go away") + (LET + ((CARET (PANECARET PANE))) + (CL:WHEN (FGETSEL SEL HASCARET) + [SELECTQ DISPOSITION + ((NIL OFF DISABLE) + (\TEDIT.UPCARET CARET -10 -10)) + (LET (LINE X Y) (* ; "Is the caret on a visible line?") + (for P inpanes (PROGN TEXTOBJ) as L1 in (FGETSEL SEL L1) as LN + in (FGETSEL SEL LN) when (AND L1 (EQ P PANE)) + do + (* ;; "If L1 then at least one line of the selection is visible in PANE, and there is also a last visible line LN. But the caret shows only before the first character of the selection (X0) or the last character of the selection (XLIM)--we have to test to make sure we aren't look at intermediate lines.") - (\TEDIT.UPCARET CARET -10 -10))) - else - (* ;; + (SELECTQ (FGETSEL SEL POINT) + (LEFT (CL:WHEN (SETQ LINE (WITHINLINEP (FGETSEL SEL CH#) + L1)) + (SETQ X (FGETSEL SEL X0)))) + (RIGHT (CL:WHEN (SETQ LINE (WITHINLINEP (SUB1 (FGETSEL SEL CHLIM)) + LN)) + (if (AND (FGETLD LINE FORCED-END) + (IEQP (FGETSEL SEL CHLIM) + (FGETLD LINE LCHARLIM)) + (FGETLD LINE NEXTLINE)) + then + + (* ;; "Selection ends at an end-forcing character: caret flashes at the beginning of the next line, if there is one. If not,we must be at the bottom of the pane or the end of the document. We can create the line (maybe a dummy), but we also then have to scroll up so that it is visible. On input, TEDIT.NORMALIZECARET would do that. But for selection, that would have to be in the DO.SELOPERATION code") + + (SETQ LINE (FGETLD LINE NEXTLINE)) + (SETQ X (FGETLD LINE LX1)) + else (SETQ X (FGETSEL SEL XLIM))))) + (\TEDIT.THELP)) + (RETURN)) + (if LINE + then (SETQ Y (FGETLD LINE YBASE)) + (if (AND (ILESSP Y (fetch (REGION PTOP) of (PANEREGION PANE))) + (IGEQ (FGETLD LINE YBOT) + (PANEBOTTOM PANE))) + then (* ; + "Move to right position even if not flashing") + (CL:IF (AND NIL (FGETTOBJ TEXTOBJ TXTREADONLY)) + (\TEDIT.UPCARET CARET X Y) + (\TEDIT.DOWNCARET CARET X Y)) + else + (* ;; "Caret line is not in PANE, make it go away") + + (\TEDIT.UPCARET CARET -10 -10)) + else + (* ;;  "Disable if the intended line isn't visible. Maybe leave it at current position?") - (\TEDIT.UPCARET CARET -10 -10]) - CARET]) + (\TEDIT.UPCARET CARET -10 -10]) + CARET]) (\TEDIT.CARET - [LAMBDA (CARETS) (* jds "12-Jul-85 11:18") - (* Reset the caret to its normal state - state, from the selection caret) - (for CARET inside CARETS do (replace TCCARET of CARET with (\CARET.CREATE BXCARET]) + [LAMBDA (TEXTOBJ CARET) (* ; "Edited 30-Nov-2024 11:45 by rmk") + (* ; "Edited 27-Nov-2024 19:43 by rmk") + (* ; "Edited 28-Jun-2024 23:01 by rmk") + (* jds "12-Jul-85 11:18") + + (* ;; "Change the shape of the caret in each pane") + + (for P inpanes TEXTOBJ do (replace TCCARET of (PANECARET P) with (\CARET.CREATE CARET))) + CARET]) ) @@ -3004,7 +3454,13 @@ (UPDATE/MENU/IMAGE MENU]) (TEDIT.DEFAULT.MENUFN - [LAMBDA (W) (* ; "Edited 20-Mar-2024 11:02 by rmk") + [LAMBDA (PANE) (* ; "Edited 27-Jul-2024 20:24 by rmk") + (* ; "Edited 30-Jun-2024 12:38 by rmk") + (* ; "Edited 25-Jun-2024 11:59 by rmk") + (* ; "Edited 18-May-2024 16:50 by rmk") + (* ; "Edited 12-May-2024 21:38 by rmk") + (* ; "Edited 20-Mar-2024 11:02 by rmk") + (* ; "Edited 24-Apr-2024 09:47 by rmk") (* ; "Edited 15-Mar-2024 18:35 by rmk") (* ; "Edited 9-Mar-2024 11:35 by rmk") (* ; "Edited 29-Feb-2024 17:02 by rmk") @@ -3018,114 +3474,73 @@ (* ;;  "Default MENU Fn for editor windows--displays a menu of items & acts on the commands received.") - (PROG ((TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of W)) - (WMENU (WINDOWPROP W 'TEDIT.MENU)) - THISMENU CH OFILE OCURSOR LINES SEL ITEM) - (TEXTOBJ! TEXTOBJ) - (COND - ((EQ (FGETTOBJ TEXTOBJ EDITOPACTIVE) - T) + (PROG* ((TSTREAM (TEXTSTREAM PANE)) + (TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (WMENU (WINDOWPROP PANE 'TEDIT.MENU)) + THISMENU ITEM) + (CL:WHEN (FGETTOBJ TEXTOBJ EDITOPACTIVE) - (* ;; - "We're busy doing something, but not sure what. Give a general 'please wait' msg:") + (* ;; "We're busy doing something, tell him to wait") - (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T) - (RETURN)) - ((FGETTOBJ TEXTOBJ EDITOPACTIVE) - - (* ;; "We know specifically what's happening. Tell him:") - - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (FGETTOBJ TEXTOBJ EDITOPACTIVE) - " in progress; please wait.") - T) - (RETURN))) - (SETQ THISMENU (COND - (WMENU) - ((SETQ WMENU (WINDOWPROP W 'TEDIT.MENU.COMMANDS)) - (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU WMENU)) - (WINDOWPROP W 'TEDIT.MENU WMENU))) - (TEDIT.DEFAULT.MENU))) - (SETQ ITEM (MENU THISMENU)) - (ERSETQ (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) - '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - (SETTOBJ TEXTOBJ EDITOPACTIVE (OR (CAR ITEM) - T)) (* ; - "So we ca ntell the guy WHAT op is active.") - [SELECTQ (CAR ITEM) - ((Put |Put Formatted Document|) - (TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT))) - (Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T)) - ((Get |Get Formatted Document|) (* ; + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (CL:IF (EQ T (FGETTOBJ TEXTOBJ EDITOPACTIVE)) + "Edit" + (FGETTOBJ TEXTOBJ EDITOPACTIVE)) + " operation in progress; please wait") + T) + (RETURN NIL)) + (SETQ THISMENU (COND + (WMENU) + ((SETQ WMENU (WINDOWPROP PANE 'TEDIT.MENU.COMMANDS)) + (PROG1 (SETQ WMENU (\TEDIT.CREATEMENU WMENU)) + (WINDOWPROP PANE 'TEDIT.MENU WMENU))) + (TEDIT.DEFAULT.MENU))) + (SETQ ITEM (MENU THISMENU)) + (ERSETQ (RESETLST + [SELECTQ (CAR ITEM) + ((Put |Put Formatted Document|) + (TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT))) + (Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T)) + ((Get |Get Formatted Document|) (* ;  "Get a new file (overwriting the one being edited.)") - (TEDIT.GET TEXTOBJ NIL (GETTEXTPROP TEXTOBJ 'CLEARGET))) - (Unformatted% Get - (TEDIT.GET TEXTOBJ NIL T)) - (Include (* ; "Insert a file where the caret is") - (TEDIT.INCLUDE TEXTOBJ)) - (Quit (* ; "Stop this session.") - (\TEDIT.QUIT W)) - (Substitute (* ; "Search-and-replace") - (RESETLST - (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE TEXTOBJ))) - (Find (* ; + (TEDIT.GET TEXTOBJ NIL (GETTEXTPROP TEXTOBJ 'CLEARGET))) + (Unformatted% Get + (TEDIT.GET TEXTOBJ NIL T)) + (Include (* ; "Insert a file where the caret is") + (TEDIT.INCLUDE TEXTOBJ)) + (Quit (* ; "OK to stop this session?") + (\TEDIT.FINISHEDIT? TEXTOBJ)) + (Substitute (* ; "Search-and-replace") + (RESETLST + (RESETSAVE (CURSOR WAITINGCURSOR)) + (TEDIT.SUBSTITUTE TEXTOBJ))) + (Find (* ;  "Case sensitive search, with * and # wildcards") - [SETQ OFILE (TEDIT.GETINPUT TEXTOBJ "Text to find: " - (\TEDIT.GET.TARGET.STRING TEXTOBJ - 'TEDIT.LAST.FIND.STRING] - (CL:WHEN OFILE - (SETQ SEL (TEXTSEL TEXTOBJ)) - (\TEDIT.SHOWSEL SEL NIL) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING OFILE) - NIL NIL T)) - (COND - (CH (* ; "We found the target text.") - (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (SETSEL SEL CH# (CAR CH)) - (* ; - "Set up SELECTION to be the found text") - (SETSEL SEL CHLIM (ADD1 (CADR CH))) - [SETSEL SEL DCH (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] - (SETSEL SEL POINT 'RIGHT) - (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ) - (* ; "And never pending a deletion.") - (\TEDIT.FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\TEDIT.SHOWSEL SEL T) - (* ; "And get it into the TEXTOBJ") - (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING OFILE)) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") - (\TEDIT.SHOWSEL SEL T))))) - (Looks (* ; + (\TEDIT.KEY.FIND TSTREAM TEXTOBJ)) + (Looks (* ;  "He wants to set the font for the current selection") - (\TEDIT.LOOKS TEXTOBJ)) - (Hardcopy (* ; "Print this document") - (TEDIT.HARDCOPY TEXTOBJ)) - (Press% File (* ; - "Make a hardcopy file with this document in it.") - (TEDIT.HCPYFILE TEXTOBJ)) - (Expanded% Menu (* ; + (\TEDIT.LOOKS TEXTOBJ)) + (Hardcopy (* ; "Print this document") + (TEDIT.HARDCOPY TEXTOBJ)) + (Expanded% Menu (* ;  "Open the expanded operations menu.") - (\TEDIT.EXPANDED.MENU TEXTOBJ)) - (Character% Looks (* ; + (\TEDIT.EXPANDED.MENU TEXTOBJ)) + (Character% Looks (* ;  "Open the menu for setting character looks") - (\TEDIT.EXPANDEDCHARLOOKS.MENU TEXTOBJ)) - (Paragraph% Formatting (* ; + (\TEDIT.EXPANDEDCHAR.MENU TEXTOBJ)) + (Paragraph% Formatting (* ;  "Open the paragraph formatting menu") - (\TEDIT.EXPANDEDPARA.MENU TEXTOBJ)) - (Page% Layout (* ; "Open the page-layout menu") - (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) - (\TEDIT.PRIMARYW TEXTOBJ) - "Page Layout Menu" 150 'PAGE)) - (CL:WHEN (CAR ITEM) (* ; + (\TEDIT.EXPANDEDPARA.MENU TEXTOBJ)) + (Page% Layout (* ; "Open the page-layout menu") + (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T + ) + (\TEDIT.PRIMARYPANE TEXTOBJ) + "Page Layout Menu" 150 'PAGE)) + (CL:WHEN (CAR ITEM) (* ;  "Apply a user-supplied function to the text stream") - (APPLY* (CAR ITEM) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))])]) + [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ T) + '(PROGN (\TEDIT.MARKINACTIVE OLDVALUE] + (APPLY* (CAR ITEM) + (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))])]) (TEDIT.REMOVE.MENUITEM [LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06") @@ -3147,7 +3562,8 @@ (T NIL]) (\TEDIT.CREATEMENU - [LAMBDA (ITEMS) (* ; "Edited 16-Oct-87 14:21 by jds") + [LAMBDA (ITEMS) (* ; "Edited 3-Apr-2024 13:30 by rmk") + (* ; "Edited 16-Oct-87 14:21 by jds") (* ;; "Create a TEdit command menu, given a list of menu items.") @@ -3155,8 +3571,8 @@ ITEMS _ ITEMS CENTERFLG _ T MENUFONT _ (FONTCREATE 'HELVETICA 10 'BOLD) - WHENHELDFN _ '\TEDIT.MENU.WHENHELDFN - WHENSELECTEDFN _ '\TEDIT.MENU.WHENSELECTEDFN]) + WHENHELDFN _ (FUNCTION \TEDIT.MENU.WHENHELDFN) + WHENSELECTEDFN _ (FUNCTION \TEDIT.MENU.WHENSELECTEDFN]) (\TEDIT.MENU.WHENHELDFN [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 4-Oct-2022 09:17 by rmk") @@ -3228,34 +3644,37 @@ (RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (13090 32895 (\TEDIT.CREATEW 13100 . 19541) (\TEDIT.WINDOW.SETUP 19543 . 22359) ( -\TEDIT.MINIMAL.WINDOW.SETUP 22361 . 30738) (\TEDIT.ADD.CARET 30740 . 32284) (\TEDIT.CLEARPANE 32286 . -32893)) (32896 54069 (\TEDIT.CURSORMOVEDFN 32906 . 36789) (\TEDIT.CURSOROUTFN 36791 . 37236) ( -\TEDIT.ACTIVE.WINDOWP 37238 . 38289) (\TEDIT.EXPANDFN 38291 . 38854) (\TEDIT.MAINW 38856 . 40996) ( -\TEDIT.PRIMARYW 40998 . 41638) (\TEDIT.NEWREGIONFN 41640 . 44156) (\TEDIT.SET.WINDOW.EXTENT 44158 . -49021) (\TEDIT.SHRINK.ICONCREATE 49023 . 51563) (\TEDIT.SHRINKFN 51565 . 51974) (\TEDIT.PANEREGION -51976 . 54067)) (54070 78734 (\TEDIT.BUTTONEVENTFN 54080 . 69847) (\TEDIT.DO.SELOPERATION 69849 . -72131) (\TEDIT.TTY.TEXTOBJP 72133 . 72557) (\TEDIT.BUTTONEVENTFN.SELOPERATION 72559 . 73948) ( -\TEDIT.BUTTONEVENTFN.INACTIVE 73950 . 76163) (\TEDIT.BUTTONEVENTFN.INTITLE 76165 . 77684) ( -\TEDIT.COPYINSERT 77686 . 78732)) (78769 93880 (\TEDIT.PANE.SPLIT 78779 . 82999) (\TEDIT.SPLITW 83001 - . 89562) (\TEDIT.UNSPLITW 89564 . 93878)) (95236 96021 (TEDITWINDOWP 95246 . 96019)) (96058 99046 ( -TEDIT.GETINPUT 96068 . 98511) (\TEDIT.MAKEFILENAME 98513 . 99044)) (99095 107084 (TEDIT.PROMPTWINDOW -99105 . 99419) (TEDIT.PROMPTPRINT 99421 . 101857) (TEDIT.PROMPTCLEAR 101859 . 103578) ( -TEDIT.PROMPTFLASH 103580 . 105512) (\TEDIT.PROMPT.PAGEFULLFN 105514 . 107082)) (107322 115201 ( -\TEXTSTREAM.TITLE 107332 . 108022) (\TEDIT.DEFAULT.TITLE 108024 . 110403) (\TEDIT.WINDOW.TITLE 110405 - . 112462) (\TEXTSTREAM.FILENAME 112464 . 114134) (\TEDIT.UPDATE.TITLE 114136 . 115199)) (115244 -131492 (TEDIT.DEACTIVATE.WINDOW 115254 . 121837) (\TEDIT.REPAINTFN 121839 . 123638) ( -\TEDIT.AFTERMOVEFN 123640 . 124394) (OFFSCREENP 124396 . 126003) (\TEDIT.RESHAPEFN 126005 . 130314) ( -\TEDIT.PANEWITHINSCREEN? 130316 . 131490)) (131493 160656 (\TEDIT.SCROLLFN 131503 . 133408) ( -\TEDIT.SCROLLFLOAT 133410 . 138238) (\TEDIT.SCROLLUP 138240 . 145938) (\TEDIT.SCROLL.SHOWSEL 145940 . -148691) (\TEDIT.SCROLLDOWN 148693 . 154301) (\TEDIT.OFFSCREEN.SCROLL 154303 . 156647) ( -\TEDIT.WHERE.SEL 156649 . 157869) (\TEDIT.WHERE.SEL1 157871 . 160654)) (160657 165779 (\TEDIT.ONSCREEN - 160667 . 162122) (\TEDIT.ONSCREEN? 162124 . 164437) (\TEDIT.PANE.SCREENREGION 164439 . 165777)) ( -165821 168438 (\TEDIT.PROCIDLEFN 165831 . 167368) (\TEDIT.PROCENTRYFN 167370 . 167815) ( -\TEDIT.PROCEXITFN 167817 . 168436)) (168517 182211 (\TEDIT.DOWNCARET 168527 . 169320) ( -\TEDIT.FLASHCARET 169322 . 171139) (\TEDIT.UPCARET 171141 . 172245) (TEDIT.NORMALIZECARET 172247 . -177942) (\TEDIT.SETCARET 177944 . 181784) (\TEDIT.CARET 181786 . 182209)) (182245 195923 ( -TEDIT.ADD.MENUITEM 182255 . 184546) (TEDIT.DEFAULT.MENUFN 184548 . 193263) (TEDIT.REMOVE.MENUITEM -193265 . 194262) (\TEDIT.CREATEMENU 194264 . 194701) (\TEDIT.MENU.WHENHELDFN 194703 . 195608) ( -\TEDIT.MENU.WHENSELECTEDFN 195610 . 195921))))) + (FILEMAP (NIL (18257 19153 (TEDIT.DEFER.UPDATES 18267 . 19151)) (19154 42196 (\TEDIT.CREATEW 19164 . +25879) (\TEDIT.WINDOW.SETUP 25881 . 29994) (\TEDIT.MINIMAL.WINDOW.SETUP 29996 . 38198) ( +\TEDIT.CLEARPANE 38200 . 38917) (\TEDIT.FILL.PANES 38919 . 42194)) (42197 64911 (\TEDIT.CURSORMOVEDFN +42207 . 47080) (\TEDIT.CURSOROUTFN 47082 . 47527) (\TEDIT.ACTIVE.WINDOWP 47529 . 48580) ( +\TEDIT.EXPANDFN 48582 . 49145) (\TEDIT.MAINW 49147 . 50427) (\TEDIT.MAINSTREAM 50429 . 50696) ( +\TEDIT.PRIMARYPANE 50698 . 51468) (\TEDIT.PANELIST 51470 . 51966) (\TEDIT.NEWREGIONFN 51968 . 54484) ( +\TEDIT.SET.WINDOW.EXTENT 54486 . 59740) (\TEDIT.SHRINK.ICONCREATE 59742 . 62282) (\TEDIT.SHRINKFN +62284 . 62693) (\TEDIT.PANEREGION 62695 . 64909)) (64943 96398 (\TEDIT.BUTTONEVENTFN 64953 . 77506) ( +\TEDIT.BUTTONEVENTFN.DOOPERATION 77508 . 84231) (\TEDIT.BUTTONEVENTFN.GETOPERATION 84233 . 86075) ( +\TEDIT.BUTTONEVENTFN.CURSEL.INIT 86077 . 89314) (\TEDIT.BUTTONEVENTFN.INACTIVE 89316 . 91658) ( +\TEDIT.BUTTONEVENTFN.INTITLE 91660 . 93495) (\TEDIT.COPYINSERTFN 93497 . 94629) (\TEDIT.FOREIGN.COPY +94631 . 96396)) (96399 113508 (\TEDIT.PANE.SPLIT 96409 . 100888) (\TEDIT.SPLITW 100890 . 108349) ( +\TEDIT.UNSPLITW 108351 . 112165) (\TEDIT.LINKPANES 112167 . 112930) (\TEDIT.UNLINKPANE 112932 . 113506 +)) (114865 115756 (TEDITWINDOWP 114875 . 115754)) (115793 118896 (TEDIT.GETINPUT 115803 . 118246) ( +\TEDIT.MAKEFILENAME 118248 . 118894)) (118945 127055 (TEDIT.PROMPTWINDOW 118955 . 119269) ( +TEDIT.PROMPTPRINT 119271 . 121707) (TEDIT.PROMPTCLEAR 121709 . 123428) (TEDIT.PROMPTFLASH 123430 . +125362) (\TEDIT.PROMPT.PAGEFULLFN 125364 . 127053)) (127293 136119 (\TEXTSTREAM.TITLE 127303 . 127993) + (\TEDIT.DEFAULT.TITLE 127995 . 130374) (\TEDIT.WINDOW.TITLE 130376 . 132545) (\TEXTSTREAM.FILENAME +132547 . 134217) (\TEDIT.UPDATE.TITLE 134219 . 136117)) (136162 144365 (TEDIT.DEACTIVATE.WINDOW 136172 + . 141965) (\TEDIT.RESHAPEFN 141967 . 144137) (\TEDIT.REPAINTFN 144139 . 144363)) (144366 186365 ( +\TEDIT.SCROLLFN 144376 . 146621) (\TEDIT.SCROLLCH.TOP 146623 . 148734) (\TEDIT.SCROLLCH.BOTTOM 148736 + . 153066) (\TEDIT.SCROLLUP 153068 . 158587) (\TEDIT.TOPLINE.YTOP 158589 . 160258) (\TEDIT.SCROLLDOWN +160260 . 167092) (\TEDIT.SCROLL.CARET 167094 . 169932) (\TEDIT.VISIBLECARETP 169934 . 172228) ( +\TEDIT.VISIBLECHARP 172230 . 173321) (\TEDIT.BITMAPLINES 173323 . 177243) (\TEDIT.SETPANE.TOPLINE +177245 . 178036) (\TEDIT.SHIFTLINES 178038 . 186363)) (186366 197235 (\TEDIT.ONSCREEN? 186376 . 190927 +) (\TEDIT.ONSCREEN.REGION 190929 . 194580) (\TEDIT.AFTERMOVEFN 194582 . 195479) (OFFSCREENP 195481 . +197233)) (197277 199894 (\TEDIT.PROCIDLEFN 197287 . 198824) (\TEDIT.PROCENTRYFN 198826 . 199271) ( +\TEDIT.PROCEXITFN 199273 . 199892)) (199973 213127 (\TEDIT.DOWNCARET 199983 . 200776) ( +\TEDIT.FLASHCARET 200778 . 202889) (\TEDIT.UPCARET 202891 . 203995) (TEDIT.NORMALIZECARET 203997 . +207215) (\TEDIT.SETCARET 207217 . 212497) (\TEDIT.CARET 212499 . 213125)) (213161 224800 ( +TEDIT.ADD.MENUITEM 213171 . 215462) (TEDIT.DEFAULT.MENUFN 215464 . 222012) (TEDIT.REMOVE.MENUITEM +222014 . 223011) (\TEDIT.CREATEMENU 223013 . 223578) (\TEDIT.MENU.WHENHELDFN 223580 . 224485) ( +\TEDIT.MENU.WHENSELECTEDFN 224487 . 224798))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 250b4c9076937e30d5f9292410a2672848173911..e2d41afe358cdc86c0979f45a1a88727e1218193 100644 GIT binary patch literal 65130 zcmeIbdvsjKc_-N2fG7%N{Jz1`5m<3D!KS~k(Q>ej92SKqt78kopV=F8c^$$T+8m@iMd z&cW&Q_*D8>*6GieXR|ZKd}X@dIXII|Pt2w>#Xxo@UCBDJ!-qOL2B?N{6r0UXIQ_BF z!HLClgYm=hq!UjZO(u>GC;FX%{&N@4Us_&UtU4DjIQ`ClF<;6~6tfF|@7LCrAG>_^ z@<$)U$N5?LJ2;;&Pq_0#?;lMZIplQstBf5z96Opg-0wVgdC}Cl_>oJOuiSIgInA{U zRdV^s*&+s4ahB2AzB8tQkdXRo3+Eo)EqAA0jq#oxv#FcXKz5{I3mG|0is zf^+%&s?%|FJeMvX%T@+wU1wmjTxst9A?N7yO!j!*ovRE^V16;Z32%B2A31vX@X;9N zqT{X3=h&eRnIbHHc4la9nrf{$M<>QQ2Bw|E&TRI?teYt~c_-$iCjkW0GwyT+NxZ7e zVvS4ABwkhWM~~h&ldWWDC*7G+<-S8s=;3fU6iM9@!hhZ2&dis?_8uSG%y z*qNT2rC~_V6EQujfYRd7bee!7Hf9%cVhIO@kCjoa1E?JskgBZu4>@je;&{3^mpyc- zLjjpU{JfsKSlpS$|6*t#|2yK$>#3Y}(ArEEEtIBb@oLnW7Wl^Vh(mh^55vw(_E_F6 z<1tB{K~d^Ik_q)@c43+d#+}*xEPoPnrgPc+u^iQDFC6-z)(lgp){NFq8a?Dh{`j^~ zs4dMawbK3ZTV%~%ycT*U#VgQ33$Ta&GuxmoZO7)%_DNS71Dm&G`1Si<7NFoR zZFZ!piPZM>w$!PdbnpI03tz2f_@!O&bd^8e-pE$DvD)p$Go4;@kw_%Ge#lqx2WVWI zZL9ptb$_qp&-mMyq)Sg<3+>3$7v*Q^u~7Y!Q(WYc&9;wU3w?Vp)lp|)=W4iH^{LI9 zgIU3Jx%OZ%iz|?c3cf0Hw$*}FcFoDJIX9+w2R#xlMeu+ACx0T?Xnkk8>d1`HzwkqouyQeml@x$UM9{==9`Qz`zuF0kNsZMMmdbUQc3i)vnvT7VMf{+#LDxF@yylya44 zI_t7-ZfCUUc2>V$ZToWdsinT~nNF^w*6+$HaVydbl_OoKr_veDmgWoc%s2vjVQy9c zoVU%$kt2HBm-6L&DP0^=GzBPY4*Tv1wyFP%(UD-z@Tl4|C?6koj%8^}Vq>b^J93!w zG^%li$FS*{aA7--C8)e4=PH6mo#Ejlfi{Mdao*k)VA?_2;S+-j4-5lwX$+GbJwmmq zH_4F^;6WhfyptRr#%9l#V@@(T>=2nNr%S+r3Bov>9S6QpWn-8m&P*I36hW^OG-!Fk zVAWF+4HpUT6S_*o(ez9@(bGY-f1n zh|p7K80*6IX^t*ALV#ldesb7fC*X|~|i&co}~aV{!cb@bZP~#Sc4|7eBas@d7ddW&N{@ z)#a;rPL4YL(`$=ouPi!OE-jv0e*B}(SqB`jf>AYnf;bhU7#ntq#H+-TP7&+I92CZc zrz1`=U70Fo-IZc0_hx1STDE95f8)LWRF?z4Lo8`1sVTNKMc1aRq0Pu=ZgUglXv<~rB! zbUSPB)+r%Al3J2PE;UhoYITbf6B{GBMr37s;{hpRaZC|zKesAO$pW(mKPvFg|F}!x z#(~EgcmEkMchNHk>u#?wd!NNqqkZ$h`f)Cw|G~lfwbzgEb0K;F&-b3` ztGfr=Y9sD}wpz^X!-CY_Rd)|8xd$SBci`2MdypSQ0I;TN?`GFNw=4Jkqg^Z8wcA(M z_fbs;BGiL}kuwL^zrFJ44-bUu<(2KFZIoLY2j_Pyu_&dx@OP2Uvn(>^TL$ z09;M{v0Ji0nZt2IO)5Eeo&aL)8obb^mM*_%#cKjjo=33kS_vM z$YwRTObpmUcO24Lnk8Xu(I7#K0ZXfL)CbjV5u0O&A%^%Eq$Akpz6>B6jgx>5R7JD7 zY;hX6C<(^KLtn{+ol1b6p;jzJo){Tz$^!n^^(W9479cx5OCnMtcEn1>M}a~7wZ*{< z1+$1H!XO2u#8ID}iZ>OlGx3<;@<$LlQd%KQ^6Y`Pis1-a0*jQsan|IWeA|$kM6Da%=a*1QW?>DPjx;Ty|rGQ z?}>KQtIN?n^|i=*)Z0kC$4i9jJt}(-p5l9C)%p(b=H_pF)Bif_0BH?J%d**t$z?JcM#NUX)@(R=GE zhvi%@eYeg+bp!f29KBEG!V@h2-zTNcr z=lF|H@ZV*Iu|jwEUP$($CIU6@gqmm{zqjdr^;nh0pNxV3RWt?Ib4oV<7^u3R`i+6c3WiHhOfdBug+v(00c{QBfItLtAm;{h zi1qgoyb%y?)4CDrM@E5={N;d?4n{*s;5V01l4GEmh3=fDUa^2}H zFfY;iIK&+)#?}RhV@7h8oFSsD5g)Q^qjirxh>ftNUZ#M^bwFnBUm z92jOi54#oW8$Oay7y}~3%mU>=(pKe|!z#JQxgZddFAdpS6@yhE4O1I^3mj#ounklZ zQnNvym7U>Iz+3(dsE1TR$j}q?jtmM^ArM+H3raN^wRwSZKy!A|lUXt_qqyblaSRXj zC84R{y(QU{1AUBYJ5Ur_nLv)WM&olc6?ev+<2qr)@uf+5Cq0yGnn41yBy>`N93U{g zUy^Z;@l7&_i47}(y`sw`&?llH!v80*U9D8o=GRH%X}u#;k@uZX5Qq~xH1FcTBwB1^ z;Rg!~{(Fp>e}$sr1i;d{m{DEHz%)JrTBIUM#Y3VT!CbaNY9w2TLN7no-o}%~oGK}g z@A?>7wvcUlrE_7i6XTtxdp7^=NujLWA$`kq#>L{7*zQM_f%ShV912C!-_$CH@MDqs zN@^vo(~+=xg7Gg0?w47#p7a(||J!aRZW&Y^^PVZr0;5c1p?7LU09s{^H5VjVf)sYs z#q@aA9*kw>Q@Sb$viKj^gmi`NYnThxNO{0PBX-Nh1sbVs>cpsDfnh{hH6IHpPPw=H zy^&lMT9hw0`W7Vb`_T}oDXzaW&phh)4|4Kke&vS;L-my^Ugf&G+ou#~bgDiD#%S(4 z>1T@7^mgt2^?XrmC(K0Ei=xUZ=9Y?<+NPdIS_k)$}sj@wI ziviE-in6mJeFc=7F%T*P&JOPfv*k!h0p`eoysfttwz8!tNLUHrIio2xqNg9JD1aGp zNMQ*fKRZdbRZ%bC0YsIN7q%(`lx`F1PiFx+hn*8N0=7)HS6tp1v0P*SSLDZWd6t9(iqN za7D!Bf6vBT91+%$<}rQZ5fB*G=Hg`Vr~QbMQ&agpCra^r#O z#$?aw+8tAoVk5+#;o;WadhxSG=nvmfXxt|aK9bw1Juu%TAnvua!k?7ZM|hNvHbVKG zjjxtBe}8%XTQaJqUSV7%sdB4#34k6ariZ5!Ors_j@cL+ib;uB^Tntu;W*!vUDG=QJ zMD`(=33X9y8J!7cy7?mzX2bIHmV)NRp8?jDG~*?>a%2|>x^&_M&{x9S2m}^F48ZeE z%;umk6ifvjVGB(cfE6Er(3tJjR6z`cnldeY8=1|lT@~14Mw{nOt3JfYt%9&)%+r(N zrJ@p^LeqSJ@-`t?)Xg$x0ZV8aC)9hl%_*#cqD;~Y;N`y)f+9*F!`c!IJPp|?3W)iK z@E}_sMa1I;(yRw&pF4X3#!j*u;TJ?(?`=?Q-A$q0&D~@cT{Gy@T5)Al7x-SF%VQv* zN_S>$pkAVvEHGccQ`smE6CqKe{}68!^nVyqi7*1dNLXvXjWeJWCW!Ln34n$k4x~vn zoB*0N7}0R^X2z-SchGd}E;Vd8sbT|l z_ONKNcPoZ@B%>N#*T{Zse8 z{0~pRQrP_4sinS?FSTGz{vwawLPYYTMT?IYo4;?1ssu(uY7RsAeb|fb)r#Xc;|C4U zkPeL1dbVx(SFLx#S(wNcXVXmIPw2-O>(>Pv6Pdr~E_ae7)%M80ua1%*cxb&tb< zGwl-lPqPf3DLcVQ%<)`1xn8}H>grClrNgQ4*2#1v71=tqQrP)cIu%}X3Og?p{;M_T zw~;vilfuqZh2K2?lN-JDl_`23S#zd#UYL^ik@G*9+Ieb<-rte#3ek@8@2Y0Iml`A- z28h8q;w%7v<6#UU{H#2V(xbA7liD4*WSm7IfSEh3oN;kBJ_ zy1l2Rq63@%X5ZB2zsx;StnJSg;R_e7SKa8&(=d>J7d+0#bKlLwkX+7fk@>PjKhL>6 zt6MNI=i%zKKALxXwsL<~E^Sp;cV4Kk{vV9J@W$=oH|4G1JNi_Hv*LEGx}7^Ox}8t1 zp4ng5Lym;q{j7v%cCU-Lo&@=K_>^?Mf z4k#S>hRTfWYNo`pOj2Ou-Wi@ar!T14j-DstKm?{1OgF z5$qUL3sixuBMG#DN=S*@T!|t-x)SuRMIq{;Y2JYc&?FGqF|g(UQT>P=!0SzPfjKlY zcIE*fF`Eo)GFoKH<`TlEOVSntkHz2@hY5h4hGSs6IVU!v^?H=l)5FXxDUq#AOs(vR z^z1At%_pRp3bcTlT0%8yjg`1`t-S@?WI?pd^Dy_IdCx&-$6JkPBeg%zXrFsaXrEZh zUNAFl0)>sC4SWXtq$BkNJCO+Y#Dqf1r@m5c=xz-JD7=@tsU&FC^*!C0n^vm%@Xp4ed<1{{^Wi*M zCqF<%cQ*DR6KRuCJHL_-Z@mn9|3cx(l@+|*dIiM&g{dcz&mY1n%HM8%XQjCFLJ|4& zxn#Y%QrdZ;^yEr+`z^U}`3CfCZYTam!ezJX#un?`+)lUW#+GP*h%t@C-Gfly}weiNA3n5f2KfKr@643;6WNC{5_xm1$sJsc6N*Y?u*)WR@Uz)y{rh}~BC zP{ADY<%8HXvvBvg4@-tUNk>pfK}RXbLD}*ISS)a7l#Y`f!!sBm2mY&bpiA0>gq*`v zMznq+(etOCl*dl_vhwU|Kn=m}R-8D22hvF52dp9f#-Zaug~lO`ec7O8h2+D~!ebx> z7qGyfoQ(i2Aa_WB5j{aa6*xOVxwi8GY=D^)xjbvb;Ct|RcY8>df4<-2b>{mSvHO1- zA@&xpF3tBdyVU)Kt~}`}{~JX^gwKH$e!k!BVx+xs#qCmsH0n?g!kI)GL40 zK=6sXUwy;1KrO|fzjpJ_&Kz9Xe)?MEUGBk~+P>%>D z-tCRwfkFB!YK#SOpV%08_e<>??{a%EZXsYx%lc_v8s(Px9WkP>=XEEqz5eTkSEs(~ z_PYDGH;!91xIJz!_Z~c=d6Lr*+qHKuRdxL+r~L2wRPi3uw%d!DUsi?JZO{SNY<#*Zyz*kk;2(+5VR6 z+|>3Z*Wtzeyc=yCM2SDMyRW|l8?C48+H3zv%|z{fyQrRGYm8=zm%1>z{a8`AFLxX7 z3*x57Jky*HQw>eH9zGd^j#&xxTBA;uU7ZE}IWWyo(RHUP&KUN)exck7$+{cN0$o;F zWWgguH41A|uoRhSCr@U{g?7|avQuM_%W#ft;vpDPP30#RX5nd7bVeW_tD2ZYo}lg_ zHwmG(lyOEtX#)+70AK1X-)M$m18n`G*~l>L*$8w`k~kotKUb5Hgz8>p>5-GWd9aja zul02(>7DK(X_ux#<~`Xwss!d8R0-DJAsfaE@qNzXh4$LOYcPe9=t z=uiU8m8gS37eF1G>1P65n$hqsunyNGPdIVnXw_22y}|im4*a4Aba8K_qP*6o(Kv)F zlw`GXWtK#bIH*mg=#EdpCBjU&p52&d%l5ZMwPN~kSOzkjw^05C$I;_TM9d|7m?4wOKuLVv%YYhk~82)Qkm z0w4LbkvPa<)&fgoEz}A4@Ovz|5^l-qs7!veMQ6-XrH&@RH)=dvN*;=vbOH)30P)L^Kl>@^G1&{4h*O&B41bi2wxB%JisxRLT{_N6Son~)f?;8XMfkHeGpXHx2Ies}K&ZiL0jHzob1>ISLZDJ& zvl!^(&S?z<_ux!N8z}LflwxYaf16Q!D^&hjkBE1N!}+SEa_{bLD^#CXMdhdO73(Zw zclS;D@W-oZbu_e=s;5fA1Ldmn5KY!gje}pxl*YL!VRpg~<|dw6eRAc8lQ>Z^o)a&} zYvBPdvR%8|R3deJuCz)=7QB+7pPLr%s!u(en#vTo;@`@ruq#-0_gll7cX$EpUal-0Ni05AcRdKZfQob3BchR zW#ve}jg1;CJ)NFOtJ2tR{?ZBffSDX(!K}Iy7E>p66PERt_Ug9yj&W7mbGOrMW&)z2 zs=#D<9+8S55a*!^$=P`3_u?Mugj9-S<7J#C0FsU41gI)a90l8$15MCrieQ#EZ~odm zwp42OyveXi;@?5mXjPr+G0_l}W7rgE^K_f$LyyT8z9>5c(gJ{h#BVA9hXN*p+~usL zu(%D~0Ejb+5_w|v98flrmgx!X7RmJRyHZ>LF|P=h0VW`cWmF_jj^YZ5OJd$>J)Hy{ zT;vDvL)4x?PaLd)5NguJ%Va}&!Sh5KJUtoUHU!QQOaq^&mTrM3zo)_GivkohyrLi|4N5NT74^(&FW_^yHlh@zK~JAMdA> zdjU-g;c~620Tulw`A%s}B)SWxmW&JdY5VJI@g;S*+slRZapMjzDQ@OnoFRYt+l?d> zWv^U!ygmQZpZ;|1<~)SSt(R8|fAyVLin*!(>1Qk3Ppv$;+Ox84*Ti+$8Kf%%?%>cN z#J&=f3c#PrE|78xo{)2;3}gl@gjEDfV5KmtRtk*FM7~nWS1ROCV7(w65CtgVRc}2C% z&J>B|Xp(SJbw@tj4+*GJOdp9H1Ycp%O6IF}X*wxUcC9KxWUQ?w_ytg6xv>oW{0 z+qGWPid}h9tQXrG%8ar7HI-4jU6{Yf_ESq;n$+f2ei#jrdNpnx0Q5+v0{b>e0j*!mXZxCYT7Uo8$lV+41p&M z9ziY>BI1Y*sKDR~ksT43qpf5xnn7-e%Af$9oa{YT5eTuV1+cpstS}eqGlTJVhgBmi z8XTpVP{Xvs+8kxK&c@-VuZ3PpH6FxIP0kEAhVcBKBf4M@)lnAER@4|?FcF&qHR@4i}Q z8e6t#Y{}5r71CG#fh{t(gZcu(zXcBrtJeP*s1+J-*aO`CT(!HO>V~5PTp<1m9v1M5 zfUXt_a81cU0yd=$H7e=3{1vmtol11PfAcmu|He>$rg!tEed`bMK6uXUmAln;%lS@~xN2|-*-%50CzJtf6qFHf`_4Pl6a|S3dj-?sD zI6B5`*i3EP#W8XA9kqo1IP|OpX2QsVdjL|M0!K$HPp7F&pcmrah0}wm4lA5*_d&0S z3gE|zcebvIR9=>*2---9H^M5<&{ zgWdA)U2wk6gL^RonKx8TK>=K-~1f!HFAE5J2M$ZXX=I zw?>HnU=7>&SCnUS^uf40K^!y$0z)Suo~M zq#~IDh3-jhsTn(ZNo+cz;!MJ1t+Gq$sjUC_f#Dd5TKQiYxm=y#m+C-8#@gCL5n&q| z61NRe*x;FWkIK87(fN=0FaHs!Z0uowJvucG0JRb8%|NUh@5)Ir`72IH8^bL!K~t_* zWWfqraQJXNEem`t^t)2CRsSlg|L41_;(Fxg2lpzr3_gzXZebA z;o?>2ql;Ia<@1-;7SAtUK-5xCN5g$JzVpzUif6C!!G&f4$b#?_6j~H|64qn#W*H$l zox4E@Jm?NaPA~MGD!>{keB^P?Yzt5*n#=+0Hbuy4ff1C7)&bP;jc$ zPbdy|$PMv(@{&r^YtH9={b*I{;V$tX34Ehbl zF6pLpMY*93aqlG32A@9Mc$XwtuQIh4Td`(|p6_a0A(S?ER5)1-%p zBLNgjnl)mMQ5VP7Yvrwq-Rm1jjGQ8LE##AFx@I{17;uSih6vY+Qy%9%u;cQbkFg>)#(e#c0*J{3+CMauF`Dk!7B+bB7v6#=tKPc3Tg0H&NZ)d4H@ea4k#FFd6S zkaByrYf1Umjp{lWl_HLi%HOZ@#ibBIg%G>Xa%z(f>}5jnUn*s;Pzn{(Rwo443jVB5 zF*=l2FHI?=x@U^ZH1=>0_>U?m2X5;H#3be-%Bc~adLCNkCqdQq^*`ewN1)XxN4|UQ z^>(m@&|}GxX|xHQk`K=%0Aw7-V;+KT&?!CvHbS8d3PLvr(ohzmp#qEv#AhP{i8<%b zfgZt+Y~s*X_}V9~OR+n1jcAsPY)$86X_6kc`HW3!YD&As0|S zN|EA1uuSZb6Z!)7p?!?SQlmj9uG|9lo)ix7mF}*armElTxUe1iS?Zr&c<1Xs`-?y6 zs86kRtls!1sekq-p?y+Je-+&;PwD91LM<**81GKr``lD+U)#wGnywM8pSt<;y^w zx(#+$Lnv!rDl(Bk0l+&;?_tu7!HAYGL2)^QP*?1-Mnr-mU}HyL^tSlY(#v_RNqKkOGJ{?pl(J0J)}4)aEAm#g$}DZODDh-|q51_0uwT!A zg4I4kQPY{F{N~M^A(q*36$5`s+}2OZM{E7twZX#q*Lf}};S|;)=YP&}%*(n022P>M z1=_ao;q}v=7-_)gGHU3gp|;dy!NRx5M3us*LK^Tu6~}9E z{{^&3z^a2?3pc$ zIIKxrKO!1IrBysC6$}EJOHfNlYAE~gTpGq_KG95Peg^J3UAc7j+#-5o>&w*An9gVx z-3bv`>4*hIfQ~iU>X@`$59{5m^GHPN*m-n34dn@9^3TrAlm{m<)pQ~WgQhb)6LY1~ z0v+-h}1l)%Q`C1WV`eY0zRE*pd2`#4( z19V1j)!ur=!`9dD6%FV5!HqkQU%z8^scOB{dvs>0?_39eLkNoHM<2X^f3hJGiywq~ zz=>4?*bE%oQEiO}ILZoG&;~-4zvh6)_ue?!#V%xdFWFpmNe5%wW=h z=PESuGH>_E#7!2{$0#%D+=sfxv$#899Cs3NL1?Uk6HLsEwFu13DDYuPNv##(T-032 zJp{}O@suJo(<6LoDsmu@RuxbxSK*8{HBJ$J-e?%uDW62J9}6k-_BdG^?Cxq~tU2G= zx6IpTzN@dhZI7I25(x)-_o<%n!jpOaruLr9GxAg)e>T6mCSIFbGv39OaY5f(&StDj z7?pSs&=DX=@a#NrH7Rt+&%%trAzTdNyj=?DS7A(uGx8-?gg}|BM%EfD|K=dl)O&K%HXwXAhYlZFgM@MLsm%zQ~@l)BlxB4ejjW!10mM_ zAT*F_Tl3N^RmG_o8+DJ~s3JZ2h7NpelM)OP$XQKB)28C_Xf6Y65RofV{^}EsCcpz+ z6XtmbP18@}4dE6AAgd7G^KZXc(+L%+AjR3kjZd6ae9|d@bdXx`pi>V zs~B+C_e#}Wt9R7be+$kzWRW3^gedZmOkqGQ&tq92Iw(~DNudD-2@H222W+xmJ3vHV zV8Yzi60^l0qsWA+6U0Eaxyfv5k}v_0N*tSob*cFSFlG8Zm~- ziLg^(?4ZMyXFz`79uTt5+x5uJDCEEC+eFZ>S`+}9MEQo#B%!a`4DR~|Q=@T?9P3a} zjY5Xx5X!+Cyd9LoI8<*@xC4Vf)Z79~-G(x0`!BYiUncQT4Y0}@;>sv)horb#N;rM? ztlzjd$586Qu}A^Er?m7^Tv&HqHm)M&{sJPUPZgE5mBKd-9 zAaYBBp1R|Z#Y>d~Z(#%vSr|0T1-Pcu&_>N5u8Mj`wP3mH?=a_+y1T=cY=%3`R&R8N zBeLRTaci53gb~9J0SMsog`+S?zG{8Y9p00ZE5&$ayTdn^#WAF?`r~u^U5N;&YqPz_ zx_dg@t~OlZA(hExTwPG-GOWS$A1=N2*Bency5jZ}x43ftgM;FcGhOR{1PFp%dL~;W z)f=oJ#7Karn$4PkD>1Bd08cfA&?Y@jpbR!W)E`-#W^~}f7lcWej+7R%g+5Sh(gE}a zKaW5QmIlKhLBv%Rlt+jQfbPRAFiTiq!vYs^M}l`WfNG{v#qUs%NgU|Wqj%p;fn1fO zz_!;Dvm65?h!g~L03i=T?$-zba)0Cgh3ZKU0c_k^_`?wX`=T9oMflpvsdfD&px-tmV?9` zvUNr2H(<3U&Vfda;e8pyQ%4KlM>~ME{hvwm2;cWP9>6C=0^PiYf7dTDTz*N2{sP=j z-j~0rZSzh^*WN3?xOq^nt6UeSl-f__<3tL3%F;8M`BM%sdpF;q=PxDqJus{jnuMwv zG7SVoxVw@QzdS-n@}`yyi0UvfwuB$pAZ-aeVg(SfTjXZUKc-quF!`kF)rdjV*NXsW zT>VJ=fpX{qp)@Y8z?d|{v`B=_`{((NsD1~k2=ff9sCfp8l{=$wpA>5EuPiP$UlZk9 zSfEvwqP&%y$j{6!fNprA6x85Y&`l`T+GIB6I2gHIe_63;P_(fd_UA0S)6>^NpS1AU z^^atpm!zDlTi>UU)_{WN$J*=Z)c5b_xV+mN$I{R7%4T?-)(>SEI@a#nuDv&-h}@d9 zU5jSc+PH*QiQPzs^%*Tf$dmt{r<4LZ@F}Ihzi6ctX+Q)dD0aBdKtnoDpHZbXFU2U1 zXdQ?MI0xgu4{6O8@=yg?a)^%Vv(k*Dw6ztM4{gvi^p!ya5ZvDn@eq)3A66bguho7w z7|X8|B0&QEVR>QJ;3={#vD#8z*}O~))+=aHa8VIDM6$NLRM1Pxll!=*gZMNH9?&iG zg|nY%_b!}`wWZ}O&nFlKyrg)U`(IvqMey47lX6!`WA8~zoz1I$s``1QV0k*f-j}ZR zPR;U~KQFet?cd`nU*W&XOvuj#i5o$i9J_(8PB!y^9VEdOMw~fTO5m10MqPwUC-d3j z1Xu@;K_T`v<4!=qhn-5Ki(LPR12+Ta4T{NhfGg-bgywfLGwI_l0>@jW$hTZ@Fu5_w z6SLT&ha#*)aycCaLuFW9V+>N~M|`^%SVJAAhGmQ>fVe^75#UXs1~?ls`Z%)aq!M@} zX_Lv4!QN(C^vcSX|Ip3GH3&Q_Jk$}%lNW>qCWWZ0*ONKE^>vWve2M=`n6k$ryoK}p zm%r(L@17!T$xB_~N5Wi?*YVLW;wIE|eyy#H!=}Z^>GgjR8o4j>8ApjhX0sz{3u*eQz zvT#6wCVXagdi)UXF>nT`qd*QujnRBhgwd!`zm<&7JCe*Gyj%+W@Qe|vfzbj{0UX6n zV|9$B0~A)v3cU-Emc#!SixBmkSVGh>I>k&BYX|icFX!{VR9&U|Qh8n?aZ6JAtowaM zaUUO7P`f>qhcCi&`6X|u>)lsC$$x}enRd(|SrUy6D_-oAN;c3$9; zc5!a8F(eD3?xE`L-cxGZ%&2RX>lecJziGdk3t%@r%DJ^65fpfWmZOL3;zy=>B=5X7 zN|8s_KMA!v)DQX;_ZZfYEh#z(>FEV&>E81a}qC!tgI_aXti zvA;}$g4_BCe+%b1uw{WVq{sDt1sPZ_fk9LovJ?5<(wP#!Fis9|fgJBxqVZX3b^oBH z6yj0F$hD7G4bj8PING7{BSa~svLaote)LqE{?h2Pss(sb&W>XdmHG>8jQZYlz{T(!+t;Mr8ayt{G8 zr_M^j*`=Z{mPw#SnT%#Eoq(B9U(}O;?an?1LsugDFI*vS7l{UfGv;u1@!ijoz?d-m zWI!BJH`F8me>y9BB2PE2Brw?;@zW_I?${u80n)@E5o$hQ)G8a(pvfP0j;RFVoq2|0 z&$F_VD~*++ovU3M5SYkLk<+C2E=D`ml$6+(!oHA&LbnA1PB%aB+{#;UMEWI|E&T`& zAN|P3jLNvwmr1&+QZr0MZOK~PpT(WHjz~hzsr-erI353?#Ya2=)>~yoVr|a?iZ3aB z2bXsOq?Oi$Z;SAzovccpa)_kcOnz2`Tly3}({y>P9VJ#MQZKHvRX)Vf(g?k<2$pyd zcZc^{Z@R;`xIO%}Xr*y6pOvPo`Am{7=kpS*lUDchncN87&}XHjPIXD2$&dC5@6A<2 z?>1My;}SmejG6}E6xh(AG)X;`p+8$UURD>XG`jKy++thcTWp!mHH{Vb=00Q%R%S`2 zp>e?NYJ|S~NVz1rw{Cssl)fEzs)%}v-tD;H-wDC0EsZTugo2QCbqUDC0fZZW{MWW(=lVYs!@vDqD}QC|P2XpLNs7coIzQ{`h6J#3FbiTsFbinS+eLAlsY`dW*#%9GYk7GQ3Ix7q<}o^7c5HjJ*^*GQ1SHWG_LK z(UgNV+e?7r1iDD7LQ|GJAWQ<7NFg%87=}m~VaU6Pi}yI~QKicz23eL7I*Yx~psBMB z03zn{Nv-FBQ1CRIp$Q6gcpd_NCLDx-&QU;Q_AZn`dw)s6LFQJ@hxsB`1ZLpIF`=^k4 zb+U~38E|~T)*#T5Z3jNePSc?$%_}h71tEn54WRbr&OuBC?egV~=Y~jSPoXwAEIRqx zOwb)I+%S3E_!`>V-s)Q5r#Yql>6_ zo9F=CNq2bz3K7rj`tCcYlq326*LJ=(g#iCMFBUh(GU*&c@5wKu(#oij5-nlm-4Af~OEip0PmX@G-68L$w+8zC#eoY5nwtRckg1T1<&29>J}r8BUR zAlsaek$ER@2I^F`AJ13v8N|neXBGI4CJNNV?gzMiz!``{0Espe3Ll;DkqIzefv+(< z59?Cs2!n#5Ne-0tdu!ShfMOnCSCO~0hFJ8~;A#Vc$_%HVQ20wd({i3|o@WzW8St)J zf@v^g0dO_uJR4MTM%mT3in3df99?b+xc>uq4s}_y0$dfQAQDEb@bS;&$A9#afwIk0 zIy3__L3vh(oUTSr7Q?3sQ`@yuyMpf{wTB9g{iVkK?b=95?z9+6rSo{)V$ker;6?yC zM3!qrcCO!pS2)B~Xms9CucsOZK7)U+q|#H3Uiku=OwVR(CYC{R#BfNGF9;TTPYv6Q zb^(!1XS2L7Go&JAJuhyPY;j)8ljMA`40)^RY!^Xm6AbxI8u`4g-x3U=^9p#VIODJd z01GUP+WlRht|WM*t4x^PH_kK=CHOKtWaBJV9^k^;yutvdPFt!QSLoyp*_a6+sR?B` zR!JN13@bpJ$B!Yy3l!W#S)h7%g_G`?J$bgCd@sZ5tIubaU<<*K>I_cJla=M0O`o=F zfCWnq=;=<}n%}(XTIfk;rYTTIS7z%>FUPo65v{+D^MC*~w`b=wZghR#jaJ>x?OGNG zdN`kPHU$KaZf4y5)!*TY+~^MuBIXAodq~9Z?>?eg^imltdYM>sbN+F2|5DG%YIWld zIi~3Dj~=M6(@qP8&P1=h{!wfw-a4nQ|0J!Vd^ZhCWP?IFmlhNEvMBJCt)MS0+z?ko zEQoa;(I_Ai9=_!O4}wt=kp9&^u-83q9|jb@h3tF62cSwHF^J>Dh}Lx@2fx&)O^ zjp-xC79S&9ieV>4#%fhRA}kN3XNlP0svoeDO?NFf(TL!o9c;1$IA_=*5-?e5Buruv zHD-wjjnX65xRjrlH2)QJ+~IwI*9@|0LLxDQ@0jO z7^ka2(7AC#FZrry4_%qF;|iOx7mW8Bgx=sp%wJ1-`bKE&vydkYTEl=fG77_)ML*M2 zgm-8Ax?_7w-vH)9SW${oaZE7Z7c)41x5CKp-(^Td3JmVgZWJ@0DpF4=W9!Cu({5*(sk^#bs)>DeJAn`- ze62!=N>9^h!iY&aS7^|esATE1u+F29KD3>nI{|B`a&3&50NwYCIi$AKp9e6a6&BRy z9De%$1U3+tzLv_1g!B*bu-0Y>rzaE}9#SCzsJr!IGry=LN3e)~sLB zbaH3o@9J_U)P#N@blG-OacT!Qi{3m{!cWijQm&eYWbj-ae^+)si@ztHL||sd6(_6L z@2}$4J<<7?tG!7?X{x8KprqfH`w&apv=O0bH{9$3UjY1e;#r5P!`%WZ(m!__L|vrNi7+)=(J{}dUGfF)=OY^WF(y9hKq?i#|?Lb z)ie1ve;0QUQiQt1d>wmksFZXY%lz72EOVL|hHYM!@83%?&`BKoNxE7~G$Lv68hZa> z+wEL`Pr7m7G5bWdAcgkr>o+YSpJ9bIsQ$=~@nE5r?r3`&;TAr^Uw>yR4>skixv9d9 zofmR17aO>%Lp1y*5^zKav5dfDqnh}q8Nz5T1n?P zUq?giBSkw?cNJluRjmhHAI zE`8jSdREv^TK)9q{J3C_KC)wFth+ZRUc450)e7DUc~1+%VK_ETgdc50$^gFZSjR*J zVXH!jumTCVyZhGk`Z2CEMUeI)KjH>DTm~mC-MaP4Nv&xrOhMB$#hNC(Z``^?N-9RTT)^G3bdZ!!xlzUK>scz(ZUdoKCa5uT}r3`cV zxU=IR=oKXB+j5Ot`Jo+)$Nk9RW)b-s@i@EpVG0j!_O7pT)|rDC(oXF~_u%F?me;>3 zdH2>`r#9s}p;wQu&TKIxHjtE%Sy%momw9r_q%uR{QkJ>xc6pqI;>9Ay|?N* z+fUU$r8>NM*S=jk@-B?_z~*i13#!%i-;;--x;s#ta0e*h8CDh(KI#r}yZ2GMLumJY zYIn#Tu-hG~x&vOj2R8Ta!+-0CRh{d9kkZSdA6iXgwsv?WqhKiv;Pt@DJVn9+S2vTY zvpz160G4bF2h+4Hh4}JfIUK^iqf40So~lf77KZ{Svbck;mG*Cp0`fHL1i^{5$OWZV zZK=rfqi}K1t+UdbHu#XZlEXLI#G9w=%1|a-bmyH>2>NMK`Xczw85KF>#!Hd2$pgR%qrFs^aF~srbR;}isnqu zw&<}^o`FRxv_Z+nK$PI{P)v_!ai4J$l^ty+izCh67Id8;&6TAT9)b56NCj$M2&oguN>aQ|Q%w?9>p%hWuWQP()hVQl^2m4s455{R+22Yv^Jb*O57Zuq zr&%zo1@mZ4D;e;`{vHEc7x*^TJm=(t5G+OffPaFCF%D#5hcP)PM@x9ep$l5n46duq z!gv6pI2gz~xaS5S3AS`*0%4GeJ~)rZN0AxTk29fl@H-S?S&fDTguG zcI{ntTz7m5w;g}JfPkG-P+8+g#Z#}1n~RchPVrRr1BC8&Y7R1&YkrBqaxm|Ap04_7ylR0AF8?;#(O)*It@f&=2c|Om$Bd$yq-CWzu~5 zbI5C0p)U_;D6(2}Cd@v~nV#Oq`W$v1e=8h`*w+)jiN}}I(x?IbE}T?ZZj_6u6A%e~ zX`IA_o{&fiS+?Yr61Wn?jq|rEgDz~E2G7hMvAnI~IE|-1r`UMXMx2jsaO6z7%2U38 zbfIezUtox`Qk-N%yGt?nu}P2U6cINAQODO2^1QV>2Gq{o!hswKa0#NKoYE|vl%C-s z<+`T!_Nb-5z*!UN6bS{Mio+8MJVYS7AHJ#@A#eawImIV!I~4dt`gzC+{o}njq0HW9 z>>b8XXKe!3bbLmsDpoYM=&syc5Df8bHBYyjFKylUIDQ@}@P2-V_H%ygH*?|Bv{g?P z!UeTs^IP*GTsGQwp0}DQZaq2mC}W6IRfSTXS5Y9DPcPw`iDC&c8|Y5!zAjOsU~|yX z+fcSy`)ndT28HYQ`A6XWgLP7~}dX8M_NkkZ zjG$CCkCI@{9}@@19{)K57+6hDKt&8v@SG$m)RbYO^t@p7U?0qv08jJGl*^=y&xS9U znwk)jVp}(I-^(5~P)hZ7@12xk0Q#o&?0u`zG-#IkdXM+@ z3IN(mS>Ly+tBa$afz9OOgml*iKLD-C`9cJ~rAwUk!pmR@bbwWGj%*gU$QPkXF#4q! zAd_$hh5gaU0~!a;f@`CiH)vLJ?o9rqTb{+|FmDN{p-#q6z(0~f(H9sofq9iz5H*@H z5g3JWbtJ*SmMZ0h{!a=*$ml^~0|6)tte_+PBc3M4Bv0eUCSU5C%oTW9Z+_#_#)sej zClk`4#t?U+Htb7U7>DIQ<@Ut~nZF_>VIxrw6vf4eZvHbIai9o=1NgXM;4LVL*(l6> zQP4R1EL9A4#{ek>uS(NT_ZY(W6{yNbMTyaDx|{`{H01#T?F(B#!o2HSfB;b`?wNTA z;Zwbs`8drArc+1I$Hf4xP%3-ad)E=rwg*1bOlutCfLP%WD$YL9!+wt(t(#8F`tM$W z9}P#DZN8L+j;KN}27a4+&xk}#H_uUdc4ooDf9#Z{=8pAPaEMSz&^LnE7QWwsLt#Nb z3;teC;;5ZK&Smpt6~ap5PU2})?Qqo$(2Qfer|Y+*=0dXp^}90GN;tPGA7W z6T%L*}Nc+@+*pK9!-DF5kbm%5!Vm5KIb z#HO5Digvo#J#^VQ_j+R=tc!eoA?GCP|uDStX~F2yi@hl1!J;$DASUIJF*mS7w_T|X+3^czw2 zyI1{osox&aiCOU>1PkoNeLPms4awYdN`5;x{?}aXYfJw)P-k?h8mwJrYW)SUC6HGA za|M3fzt-5|{tWC~`;(#cF@zc-7{Cz>Zx%ri>`BG`@+YyC?ZOb|t>hboz6G0N6zIfz zn*=0Ps|JeAX;zc~z)A&sf_Ll0AzdM zLA95+90RRRV6%aM`alvW#0E)Bm!4$WI5fL{YqK>T?luo^NTMhryp<1R*;qgm#Y%XM z3Tf*hs!e$)KRKk8^dy9fk{-yzxOrTP&@g#?kA;+;yO(05Gzu>vcv-H|_n4Sv^4Ife zzG{0TMXpji*NM5uDw^e>JaHcG-A!RjwO1}R&zxS|yB>8XK;=jF2tHV|l?mgU7O z#uk`1AeRxJIgS5~@J&m@Kw;#kO9~V`C|?a=I3OROVVs9#wbicHdh`V+^*#v?+-5H{ z<+p*D2H!s*TJnSAUlPm4_E**KbGh^Xu_}7|YoXV>5AR7ey5Px|fv>IGW5VV4AY48i zZ~rO#+_urdi2B!l{xdqmXJiYHc+n*z*r@)yyK=424t7$EnWNMp}shb*H(%QetyMX9By_>xC0Xt zcuCAWZwTl`HF5x10MMp!`h%`0gKR{`M+=35-g^yN&-U&K;2>g25NnW$Co?C8O1i)= zkrW{mMI;}p=RhQnECd%?wgE4?L{q}?(I#iIy_=0R5G>T9{)zUu0tgrgH9`T0d?nC# zM91)kHbDy#_8@rjaeYm7Qug%c#il5O%as> z7x5J^Lll@Yt+X2LOi>`VJe6*%Mblwl_KD4yq;)RtkmT|RI-#=mu5N!x9+#qf*6&P5 z?pU8xulB5ND_iOkLb9vOj!5Lf`?`9qq@7-Zy;Fz-2k`?omdGy;Q12h$m?#|Cx=dk- z;to8cD(Ona9jEw)Bx+`7F!6M8E0qV=K)Lh)8@D`w&6fuNF+afPkAI;%<6lUR{0o&i z|Kdm*|Kidvnn2QE$;|5@DwI80=J2faCr*D5gLq=BV}K)3b4=1XsMpF9gV=DhusGa@ zl~F;O$qZATo2D?$C4>f^)cH6qmz_14#ybxS=!7C6F}i(#h#XT==!cg2ru)u?9_FO* z-_lJE^pu~S1B^nMBas3yiX+Z^8Z@MQOmaYK%&RvW;G2z&m|5<=-24s7CUIHqArVPK z!1(DC5Gv%-K%S649^`&z;%1J3ApX}BuCYYK6~uio z>=|t*1TsQ2A>dR)@@(%}vU!nkO~_D*-`0(U*%MgpiR{EQ?#N`!$Tz|$%Bf${DMaII)E0U8}b*$Ecrc!G2CLCZ$5mG{uzk65vviNApCKo+9+gJLo{+ zWNs&XVcLKm5 z2QQz!v~-U%dGYf3vsbUuwSjzFUt4~~A1Pw?y4?lsR z85Eu)f8pHP6IEma`_El?TslOp9m55N&`z;YoTd>r*^g14>hogNnYeiF3A)|zV?=-G z6|{@fYiE})49+fo1Y^Zb4ix#ArWX9n$EGpd;gTAO3X^_VA`b)o=4! z0pbERF4ySUj;;-=HF%SbD?Zo#-uB(_To1yG%SGHo!my5kjRXar*+&|Fcca6YWbADn z9GOHie`R>zdJ6UIK@UgMg~CbY5@_TL^b%WkAFblvceTW!cxI1vE>cbG2a9vc#2CZ%}Z|} zbQxFyo~Na65lUME91{Aq!H%wD@#-2HcT04!3F1O%8099wgDU==I5DFjaKPmDJ1s*Q zyx+l?*2|8+S1A8LPFz}2QkUO2%3bp4Qgpwy^Qb)p=MzT`s~5IDs~ zCQp!NHXdeq73!Gc4>Rws=0!!0#W@{;0L8?Eh;kZcN10FI%y}O-gO}2^;kIAQMFo53 zGz7yi!}EKpDabF?WyBj|M6@PXkT3&>`%H4xJfaQt2qy<8Q1!51KRET3>V@BUy~;*e zRlcK6+)kVWzYC0`TcGsg#Tjg3x;V*mIH1lC&F2s*l>LVIVmHt%O$7AY9Kvuy-48Y- z16n|8bL1Sy9ZlnDaO)pyZ=-rBO7C4Cv!}q+uD&-qM-?5DAcCilPz}uursmTj(#d@` zmDpSRdwcO5N+~w>^L0iU>t}^Wd`420;A`>W+*YrX!Pj^BzE%iFp(P1}EK-XHFwmx{ z{Y70>BOz0^OeVNNcoBl{G1H3~AUAc*D}dQpUR$L5l5~y(n#$DON7i%wPX21AHL3*B?S z5Pp0G7Ujy~h3XY9#a~>#h`KIa#udtomxua0=+^1}tS+%g!M&~^hRO293;h&b6ETd> zUOu;k4xm+hc;za-{2(v^b#3YFg%9Elb>Q)f7p^{VW%=(eKCpQ8+z@r^9Qw=L)s=n( zw(oHIF-983g~bm`*U!qAy6X-)M$KagU`)`i?vq{MEPv{m*aNDdeN%raX)09Mw8xG^x39f$i!Md}dU5+Q8mw9sKRF^8OiQW{$1iZcl^ zqqB+Rm}hm)0pL3AOj-%=Q(d&8G(3F#f!okw8o&m?@GTl(JWGe@GbQxUBgY+~2eFoO zVTDNKM8yy^-MGOvk8Q3y&5e*roxW2JHh5yKomUmVRZc>bt8DkqKz^t)dPFO za1nxPCe4P6mIbhZyb>)d9wH?bJgf`yb8$@I>)O4y9W* zf2<5HZhAotQq@IsGQ>C9>$cVP_UgTfLaM9BcH~QG4U~E@U{UilcBFe85yb}{o`YJ@ z;cJ+6;@C_&Gf32Z0=K)-Jsq@(e8uVVIT(4=$5f~SC#k?Ucu#Y6oUXIeVx~I{;Fy@r zK`V;as_)3u4mXr*jX>>u?;E`KP%2?jMyo|PJpr6581-1u&7_Oms#m`>s%!QdR3!*^ z$xx*!8nEajD^BKwV80CXh4N&5B!xT>2g;mPd8!ocR$eN9wpuTLCfy=vm8DLAzBmKe z15QW(+?B=4gKO9VYtB9W%S1x)=Pd9OQSJ}(1qBb?)9*a~#03QAym$ez$SedVND26` zMV(hadT9|s%&t6f>C(l^SACz+DRXhp*2A$bIt*5pzIyd67>24defi?~OS(_GUVneo z`Ey0z1jpJ8mYu^0((zqx$nFe!C&+i!-8C4b2YGf)a{18!U6G_vkOE^u$xfQvj3W66SJ)?66pDLwm^ zW0LBLwiXMN1w27i8E_dsT+9itNa+!TXLkqjN%6n>%jEs?|Y-e$mZ(tmaN;-DcUI*3Qs7q_bSuPf#*ixXg)I1PS%&V3={Mo@? z_}@B^Sp6FR*2V$SbZZ*|WC#4$K?8oXwE#PX+cXE1Jy>;+3G*Q*0}oUaOF5y~!cPYwHhoX_vHRtr~!qQs>ijbjWL5tRl)-C#$ z%_`lxO?%NgtjeuLv)hD|R;%%lPm)@CZ{p%3w8D(6SP=AIOoCTF(G}>=lU!R!x^Gl` z7eQC_e;!L`$+*q0JV`h3E+~VNh}_|$JiDk6ElEUi97f9a(yCd_yaXGg86+j9k#?2% z>z9)5x(}ykfOrq3-r|30lpD{|#$BMQ-{>DT zd(3Jwm+|*G&;`&D(*-qaG)GE4f8(yGo{Z!782-8F82*jp-!c5-^c3>)$U~C;VG8&k z`j;vOX9Fhu*l@5jmRdloCVs)SanYw7X0Fvgde<~D-r8t}HlWgY)7il&cmL1s4?PFd zZ{8ojF6Ecgn?g2~%45aoA3f7-y~Ww_D{+2_t5pIN(LcR%Z`_}U6yKt>BYeU58)`mC z@u6{&usrgqPl3Vgqb?N?3Ka^GZ*6hrZHXj7VS+@KR^BXcMNvb@V~Mk zj$pR?X8EZ!HZ0MAR1W_W#EhS&dR%&m{9LM3z#}1M`Y)4`2CVYAW0K$xN`%;@xC`y7TOaA08<3cz&drR;$a&QHG>-@|v`RQHidAt2gwO*If zF8wKux9(4=yi5Lgq4l^@le^@%uIFvf|8DcJTYhnub=;-@rCs`8%Duh*?>4Sq1f$%*a6ai-ZIYND5WGs(=PHCy&nV(*fka&5*{iD&jv z18h=LGrMJTzyJTwx%b@L4Lv-bsoGk}Ci>oU&-?u6f1m#hO{ZtFrS$MjwvZmqmS$}0 zz-)3VpFEbf2D7C~dajTy&kkA#=F-XON-|aOC8v_*v=tpa*xfxuHB2E}B|U8o#wLf0 zXD$uLMq^`Ebo^*6esnxGXblaXy>Ra0%KCEEx^Uhaw0>csn4T`A7ysS|)>odmbmr1W zAGxwzUAgiIs>oJ`7qX>kdtv1LW22J?t?t3ts8MC~=veINcy!Qu;?lBH=kiA`Ub_6i zQR_69ADNxAr_v{~m6?*Yg4Sl{3kA!pWMpJy(5jw6lbvgy96b1zM)j6Qf!3o(#^cse z9$sqEx^!;M>OMM^NtTYK%fl7h8k#AUJ9J+SC^cWH*roLGbO~cRXdRuMOCQhL^X1`b zOgiQ~>P}EBdNek9G(I+Hb+>nqr>AX_#}9U^c4QS7tfSM1yN716yw)uKcf?w#q)$}r zR1PnPEi{e^F3wi)HfhbuV&QqhB0#{yxHXqPmbFWG97Ar(ioaA-Tz#o5&QivhRmoPk zNYt9mq_f8|ROhIrTgxH`l`LCXD{58B6#!Wg&!d(!de91e;$4A2SMs(1{#)(+rP~tx z)HsxQic-4i&u;qD>R;;HJSSgULz}my`1?aIXWV?7-HB>Ev30F0aVjHa9{ynNYt2i0J2u-lIC%id7e=JwT_zu;;0L)5>` zt~LJUhX1Vl`<(qH>F={w1OJCSeKt{hBGCL~p1(f6+4W0T1K-?3#hVxC?}z9Qcek0} zyw#uNe=jv2@h5QwTzOlCB~CV4F!HWj*>&rB9xD+DJRU5D@PGa%e?kNJZz3(1LGI5|&&C6ZooAD4 zSn6rYdfGjag56X7y=vE2s-LM11ebcaj>fRvV^qv-@t@nNZ%td4R(jJ+BvV|e6v)YQ zI50F3$4;292v{<(PsGOcelBK9*?Rpop+ zJtwJ?P9|%7Y?N{!9Xm{I!|@oW(GHUQqhq>KYwXD34mFNVVv~BhJ~lqd`?L%qFicx@ zdRT4fv9SqDUH6n6~1;e<~T1rSrxx z3zByfGssV|Bftjogu$w(aWq_@DImNP8$;7`$&|Nqv3OLW7hslH)ERaxI%WxS$$zlku8^kvBf!t<#E+5g9Ub#C^kv0|2}^u)917 zF~EQ~0YKnQ7zIhgh^N!#sk!WI#hxQN?istxNECzHc}Akx8fLv}MxvNp4NbrWn2QP~ zBZ~cMX0{GHOK(kR^2u;-jpGZG&v@KYq%lVQIH3q7Km`*O2e*a)$I--~_2h+1_!|R! z3|b#vIbXf-Ve8WJQ!5wFBN4qEtPm51=ZTm#IJ>@l=JK+2`Qq}~l_x)How2|aDK^d$@zvAc*&k>YR<~+fxfLfbNJA9p zP|aI8V=vI$MB|5b(oFUQrvMN7GXeTkQgV8FWGXqAu2}BQmdzq_e)x#aIaNp}Wh!Z3 zd$9V%5nlrE4FLoa70@bvR1byz?$dp|yCQH+0Yg}&#&IH8F zzj5^&)6|N95!h;w*75H+3+{qcM;hsXmR*>pf@Ov-1yNB8t$P9Mt$~t2FL=k_*cAxu zQm~`A#NKFE=0gNF_f`|%4m4{6kzJX@w{rqF0xI&HWKfXj)oQiM&>(3HNv*)*`Cq)5 zWo|69#!10QDN~hpO7aun^vEo;8=2ND=U%O@SJ&^X5!a-X6ilCN{9Gm%3g(E3x*mD3 znaR;}@cOx%*CY4iEfkClQDWp!eKJ#%w(-)`&+=V;ph~C?=QW5rWIWs*V|@P|-(~I& zZ0z;-aHNUm-o@TY{IXvy( z*xSrZZQhwr)CRb8q%RT9?@vtS_lE}VZszOT;3mOtoGwk-rKy-TF$&t}*~sIQ2BY9I zhM-;o*}xXOMaHo;eJR+MzPdmbIxv~-ZH|sw_RI|EU^-obSa%ro*VCynhcDI5kAXh< z^2GfpXbkwlmj`6p%NE6tO!$ToKdiYi-Buhdgts2%5IjAM6N}(YX=B0T7^XK*3~Y)o z1;lZ>JUdm$&dz2_#}o;VjZJn+#e{dri&3|yMuA{EqynQN)t*hyB`YLTM`K4g8|zzu zQXMHn2*LkKLlE%117=jep=e1$6-RAgFveTd z5izhMZRYF8K)9WkI7BE_M=8A^Yl&LoSOCvEmfLBnoJr17e@J|rOFM7l&Man>_D-C?Dh_e-gM&SzzY_@`2egUm-oHHa%J`D~?^kz$(eq0#>GTRQ-i&q1`nrOv@A!_yYK5=X2 zm24HM|8uqL#g}Wp9DF$&dMV#^jnqzml1pth=JSeGT8Z>Dh5K#=Uab})dzuSjrsS_x zi;+mPy3iN79e=}-?q+o*vb(t+y7ybvQY1tVP|sAMnF%!WAb%_2e5n5EM2Bj7L%~cn zi<q$s4O}qM@2>h+ik9}%ebo*2I2(}$zrB#sDDNANehb=iv zL~k&V{M}3__(Z6=npjO{z}VppKVS`$H<%Z><5uEnF=kMyRH1^+J)MTWwvF7NM?j%K zG==0;+S5JWRC>3lE>2hkfa4a>K?M(EyfyF;S6hktPXMZ6kVL{oq>Nf87&aM5XP`q? zo17IdvVSasSCz~gj@v(I1>bjTC=e7TPW|Np@eo_~bflli&-7By3uEHi#zTVdd= zh4U)m*{gwno5{8AXSloZ_>Z?Y4rg<%A%4A%w?nztkB+WxH3k<%W!TJdqX6xEu^)gN z;+$6lpY09rHX8nvV)OS`H)i@yH}1}d3atR=$HVRY&BAXMTDvyim1`Z6mLAV+H{Pef z+h}5yixle}2ua!3c=}P?%WFSUf=?;cclqzrZ*Rbj_pma5_F$kLKF$$dJ z@P5oOMuD5vM<7Zlr?S)OM=c;il?a-w6R}g;pvM9w^HvBn=S={bDa3>KRR%zFrn^b9eWz|R zo1>YWS#2&dbv)qEfu;@vO$FOK3yhUv<;=Bvl!9fnwsq}J+0d;K-ks<_D~y?50=f8E zS11!apoLj9rwb+t8rj6QJW6cX=R&6q+inzqB#p!gRlH`dwp&v!3DEo~j>Vfy#GbCMPE9oLlm{vD2 z-2}OUfHrFr=SJOyt}Q*yuUOuBOlMc}g+#bF(UlA)f;UbkLy6FhQ>(e{KS(Bm>sD_2 zh1@?}w|*Tj=l(Lc{h8b+&i&=}{^n|)zK7PW{PqiZ`5rp=m-+3_pdWN1_#~ zC55~;ZqE|0aXK3cKHeL?BgyE8KmDpbAkeVC`nA53_?D~3IALj^6)608yYcVrfz5xv zQva*gzPjanDE@f+8}`5{RdVw`?9FZdyUYjkjs8p?X54*X7x!&H+qCzAbIi8_&t&jh zScrvp?RyTo2*rg+9~T%mb8iVZ6Jyd3THB== zlMmq~uyt*Z@P!0D=!U_Uw6P&W&=Z|Da+qBp5}?>twcoLR)7hCB5S_!;oO%K&QcplD z>Is@=k@g(1)nQw|3Ahd_0ZjFJcW>&J)oM1ly>SpkV|!yT8ziiHod>hMu@{L<7H6h7jhq8UB%ZMuYe4{kpDQ+xgabcT=vGRtA*_s3P>l4BuTHW7Pnt0etfle z*KL_#={iJXy9a+m!IB-meuKqiyT|UkeuKAgID>MT583ofN zZR3SDTM~q2filhW9U39yv$+%=^;U9p6n1A`5_Y91XOA8|G+!bZ9L6T8q^Bx}h)-gc zAq`z=fd%hL3yMe95s{@^gz<3;wlosLK}zs+f}Y}>kIl5$E3Cpm@`Q!L07sJW@#Jct ziP0$A^K(#SaqZyLs1^wIL=xJJa-$Y^mlPb>;KMWaT(NuzXdW6(W;s9)R2FC*(-r4C zsAK9xCd=J9Xzlv?d%6O_g`+NWq0sxnQAX6QfO=3ry?@)+JNoVn)K^_6IA?z0Xok`4 zvsb&)nT4Z_ZSj1>cplz^%@p7!lw1-6o!5``yUCYppZze`x9|wJ8;Oup*T1h-2L={C zFmUz*hBML!Go0h`D!W-#YpTuO`}b#B`(Mqp4lGSH8AR``X1)!!W{nKU)wRg}X7&8d zn~{NLb@e;Yi;1@xbPZ@jDa*qA90n&8hUTrh3QgM5M3G0-EOPg^zOH^7_hniG1^I-h zn)75&@Z+x(R5^QM6`DCN%-sfk{A17ChUe{fx#w=u(m)fukv;IkAO3LtR(oLm*1sYK zYR&HZ5jZyD&i2{;cI2P`6>R0JA75MD+Boa4;Qr>)VAH-|D!893*pCYK|7gi-E*)sv zmOW@6Fe(`23XpHfc7OtlrM6&H>Q zMSt~b;FDZ+<2hdTrP2CxYn1ifl5@q)SwAH`4AE!1Xpd}t&7NSVzONOyidXr2<2`yQ zBRt)&i94JuWG-LGP>l?dQfLKzEInJ;JY-LR_4x+{djdmZ+}1dekvIFW6nM3`G*VxA zJrckK{Y9oA?X2%A-6=kATa9lO6u=Z16!#XY&vWi;S88DeR9A1#+Y?fSWlyyFxsO|o zh&`c-02if4c0SKbp>?1!fj``J&eV9w^SX4XiFbv33Ypf( z`YraMJA0ZXl7)WqpFK0zy!w;B1_g-%wL@G!mWG~}`4~7>O!`y69w{Z#v_0a%vG6H# z^q-E`$SABCEW<-1<$i^1d8}Zk;9rOuKnY+ZggRo>wV%1=#~r1Wn}&X>KDcS%fJDy+ zggy#|VJ9gCOpPihIwh?ej*dbi0dvMGzH)_FdL+f5cDAST))A=q%51V4f$uXcYI87C z9!6{LlhpU6l5>w*M_hM2GB^>LIbxdo#Ea&LtL@Xd4nqv{jpndha4tPVhOH4j(8Gp> zFkKiCZ|vzut;1x4R;oPJ{G{u6!_v|;O|~`ZS_nzRN76{aw)16c($y#Gu1%7LNGg?e zvL@i7b9&}vnjEAiz!3Ys61cDi7GGiIbu^_=o5H&1yq>VesUE4>!!>vzYMd5dwMH(V zr}ODWVkY2MK3_~>9mWV6{fTjaTsf1SslXo}c7O8BGhYE@<}0~0>LHrb5r@O4`k<#H z-tO>3E^5A9G1s%nJHha#?*x^udG8HoA_`Xp04Oo*vNNgM9wQF`R;SRoE!Ub#9LosX zDXg8^%9cbsiZ#{4@pcC4D0bU}z~HRnB0Tlnw-eBE`xs6r&K-$|dJSGNN{)p%!jXhS z8Ck9btZ)V+8pV7sWYQ(!+0t+=1RnPfkL)1O^mpH>6mTknKv~_t3*hbWlJ;?H`qG zM3)2?>NG6#RkkMJZP1oDPFj22MV)gTTe&T9j4T(}!0cgqnmz-(1tpEa&5|&d6+Z%~ z_k4;&*2A_)0@z`@ugn!-=_X+gn*f|DyfI{`WUNqQi($934UFs$F!{+s01s>1E~X1< zv<9$+^DGFHO)ElR$S!zTVdvTK>R`7&sE(X(*nx5mLR8#JKg{lR==qT9le-EBfoP6c z!xQ7i5nInZyvd-G!iP=>fkiKidR24tZZd?`!(BnG zwHC52JkPCQ1UK$2_udzBSx9DIB-8!7gREAAxsn>@c17MHBl_v$akPxp=)A#1S`ux5 zL4^Q+HuRdJoM;!)9TCWUE6J8e}20?F+wTG=A(mNbu$%;g} zX`PcaVgLwNq$1JY5vee1Kj?yIBF_{l`dz-HHyDJhashpw z`gSgPEtR|WsPu|6@gKOe4Gg%iQ{LAkz0yDNd1E~VJc+~`VkCW>a2POvLjP)uMX@Ce zf&glmo~u|uSSI$y9&gVBwB^B;fP3ATLY|}y@+?6V3>P5&vB!{?o(jBbQM9H~L7|-` zg3`>%4IGC$k708|QKoiZ6vC^!1IZJMkqrrxgY9F<)t#jjvGk7_a1E?&sV{A?r&6 zLL&;LsTR!IdZU4sY1~8*&r~l8a!;@+94$EuFjXXVF#~fH#MvnXIFUlw#N08k8!kP= z@eMA5qF!1H|0o83O{cw|O$6)(6^F-CV1nHyIM#rd;9kH>DA5{)CgY_<>k<4kl#|j3 zp8t!n6ztOUAKZ1q=kI&o{wL4dx861|p~AoawhL`24F>54o|m4lgvF4+Lh8o2`7)%( z#`|L9ZW&%J@`yaNM#Net?jW=@&~USnN+Ds=0|J$Lw48LJ%EYxXpi$2|_!Kb6Y$?Wp z02skRoP9tCk*_@sey0Zb0( zvnM!KywC|9KYa(n76``!`t4x?VX9z=CHcei0UndQ4al#Pcthe)gf(=){f)p@IDf@G zK&xEIfK_I_DOoI7+v;f0z5Id$;EOQKUbzD%0BwK0`mTiI?*&EpHXCS17~Iwgc0MnV z(YzWI<%|HxxDOt`^;(G$X~{sOMF)|tZb6syvM^^-^Dc030PC;zhHrN_$Hss1)vA?$ zqSf2STD=}<^?H5;?I0Oo`|OAv*612M;ij~akv_{`)(&mllM-g<;mte5(VjQKQvc>H zd+VZ${i5B^W8*)cP%q8;56y1hf^L6PcpEOixVdX3%mdik_|Ms7^;)F5vh@e?@aDTX zk@yz;pKEN^{}&KM@bcu1sdf##R{0d9>;Y|cf}Fq`$KXC=06;=@iiwGlkdX)Bq~(uc zJ2=NAV~|dTpkhZ(cn@>N!0~FGKnzT*1JQtX0KfAJ`B8SN(E)NVZ`+$uC`ZiA)>aBM zpsf%(Wt2e;CJN}FEW&<>gU@+v9)=3|8|h_h09FJ}Fk^6%qunFJ&fy+z0{K^Mz@+q{Kie1%iMPaYUGoYaxbvCdQ@ulh`srJBR7#~T`r9a}JkMARaJ?oaqb-{!qctn7I(FI|e71a4CY0F$3 z1Kt3NPY30kAZ@ji6N7WUELz~uowpOvs`z?BI$x80!p0%Y&U{1+{Z=yp-QKwSY^wbn zbO+2Rr9eiU7WLOCblkFu=wxa8XY6nJ3?*;dSGcOHDRTT=-Lt5!cPnU%KN~cX4${S$ z17f$G6pR!^?65UhzPP?}W%%NSmGf7ua~FPo<@{6D%4O^Pg)7!am#M2bxlhR2=>_fvIh_05GC(`=9SUCRCo5)@ znvHZb?5aRGX%UzS=i20ODGr1_7AA>-cT3B3UzhAqjpW#L_s8;G zj*6a2WXKgi$?gX1X^>=x0}hG7><51*X9RNF4{>@;9VR_3HSuQUKN2iMQu9VPxFY6} z#4;#5INKVNZU@8$#+y6an&HuLk;eFA zbTz(h_b13oI8d_(=-i{dzh?6RNW4S9yzufmh>2FEqp|tsTvn?3J ztJzwChhX<`?$-~HHM3v6t$ybKh45G@@ccAog0$}pr%9jXd#>8JU$XdTT~a09hnkK9 zSyk!Pn;+$tmkzY{KYR6NA!{FK^{-v$Ilg)`PlVaA){%EZQrt4f-IG=DN)mO`I8;bp z@2hcaMFDOhpw>9fK6$gysWo2;nZZm{1Tn=SrrP>7M&h2JZgmKqPGhPRX$&eE3RM!v z-Urf^G}?baVWc}CPbk%^n2UR-a2^dZ82ASqa}wV%rs17}pb!&#Iyp8mVDlA0fswY-H=8d zBnm@<&k93&MW->I8K2z-m~kA0!tZ^F+43i8%fK+9tzp7j!)$vR2V+nE*a*83wQ}?2 zN_GYoK&Y#g+wZtOed#YaCSfP|xY-!-?AkhPQ4|;B4Hfu06GspkaSx3Fk~G?n!Q$l> zqcbJO8=#W-N2M%+gB?Sb%rGoc&}R8jbQC19Ee+GngC)^i50<2JHCRlgzX*&P+?0R# zN{`Bl0dTXTTm_dwqmehJS|GJBnTS|kA>!gjLJ?b+DV)HoyKvAkoH(3~7Uwam1@e~y z5i1vtCU?V=;#-N_)|WB{BUlS(dwciTJzbm0THk9% zZLgNJFH!E>xu!bl6jr}I+Gi@;I~}(ByEY%Fr$JDf30q`s?$6e92=nyKmHO}7J)xzZ z`j>-*_xE*e?yBD%B*GHu+U)vtkX(QI@bpVp1K(ASvO-*a@jG~&>Wj3V5Y{@<=gq0Q zHjv>?D1Rx1%7rqhG^y;BqGkw+iZS4FW?}IYY8E#8RQZy2LlMSXIo9}TO0)jwLHIT$ z?18ODQF>+X*AvI}M`CJX?E`vZB^|COyo|P`CtlLS@ILv0-5+x4Z6rj_SA8LnOX;NZ0>VB4_{~G&9Ir=V zSc*t9UxHL9vSAq-0sqmSIK%@l`67hmtC6+W1_kPLbl; zkcck@C%3#Q6eh|`0^Czphl5OiW}+>?S7YRd?Ba1~ zXN)(@y72~mi17x+kw)Wml-zkHGdK|!GJ|V;OM$%1UGO3;_gdKx=O(ZyiSU#x@yMm<1DLFd2*RfX8`siAtpqK7!FuiwX5%!Lb zzRvC~azY$4n5=B0gabuqz_5K<9)+>TwRAar+~H z#cT;stb4%5e#9vQA;FjhBz;5$p()aZY!OPhIYgLXgFo85}2w;t_LPfgV`q3If4`JqHd6JScmo z5#MD&1;Piy7c7Jy!E#An#cN~NBZ-z4$zUcN&R)=l;3H27(oD$GOBP{cof=FzJ_?5~ zlx41w50sc3Q53u=`VNIEXL4DkD6Hw8775WxcSmrBVmeK+qCgiqB%(@Tw18F|a7C;r zC`L#P2_$#~>Lf@KF5^Y&Ksw05+F)kBXy?e(1JvX!qHrhQU{*$a8rY)*4Et2!sN@|6 z;1-D)V*nmWKQ^B%sI7t_T0`$WUA}nc>@pgb$@7fRX;*WTR)8Q#pU^A-N{o3`=K;-n z80j0H{j~Ym%VsKxgMNs(Sec(I4bNcy$+sWlBd7oA`C@UAeCUTc7yHrcNo7T+u+PXn%?R3LALVfb6j(@`tI5Ewt=s$%8}p<6}lW%;{a(-z>X3?%IQ*j;tTp zxaat_yDPP-@lkKbx!SDkqAclIVgAl0CUyv7Qf>rav- z;VWR4^xPc6M2;9a6;S!G2#?@rvik{&9N1_FLahA(XcpDB=B24sB|;iD>TbPJMUml~ z3lG)6Ac2R~WVCH69*<@y*x70pFwSvg@jIacu;LMRPx6q1o`rtmZwR-@Af9@@?H6s^ z0UAMiwjb>vRwA`+p(AY-%n+q{lRfkwZwm!Ny zp+Vl-NQjnlwKQOAJJ0{$0Vl!k!QnSL0LRDQsFt6oamA0n0)RH3f{KW2bGr5Pb4{+!4t(9)%>)cR3{I2IVyc9!GNr$9oV1+2&4S zTa$zdh*VNQN<-Lk3V{F8-@!1OWZ2z^fN4@57LzB+*^@Z603HreDdicE?~4R0zPqjr zry{|^BgV6dAZ{BJ0OlZRyCmv02x(?t6dJ_TXq*E9&m}5;l!G;RJ1B>7sNSLoIYAMv zL_Xks<_2=t##$tMg%cOm0IRIK@hB*2W+Nd?Js-T;cu)>nxv;O4Pp7KS$x~smZe_lp z<$y)KSu|=|d{%Sb>ml9;0=9VETY?d_uOtqYVMnJZlH_ zh@K!YE&37O2MXOnh3w7ONC|tX2p0QsJ`Y3;8CJZ6_XPL>GMS8>tx_V zn?{%iSghd5jC|OS1!!$lu>BaqVF+B&!b!{OE(PWyRLV5GwhPI{VTWj7-@%qfH3ADl zl@9TG4&MDLAJvHE{^M>Z@Dhom?#d!`{n~XnAj^saBL%zip&)`H;Xp6kk$QV?!Ru>A zf!^TmjD(ZtmF*4QTFUWLZtZ(#_vvaD^%-E)aW-O0;HBQ)+w5@HW_Yhur|dDor9Q@q zu+#^OKmMDIh~2lk5GmZ?O8HOI4u_V)^?wBzg1A4IE|4|>sEZtOIUt}DtRM<8-iN7x zJABv-*uaSl4w&@jhog@lD!ENoxuHS5*0Q=d=sP2wMr}(IBc>2X)L{!6xybM~~irKb>DtvI46HPE`2(ydNzHAOS`mfsn5R zAQJLh4=+|vx`48APwr13AqBpm?1+0d`+h}In%L~jePWZ7)&|XzY)8z3+I8qJ+e~oe z1b&8O;ua+g>__Se6ND#l?W8Be5h-iXwK40slpgQ9j)MfgkEGf+} zEfV4L!37ROK4?Mj;5pTO=N?39ZTn-n5<>mHB|A9Ll*1LK zU>3rHZX!HYm&_)UE%pQciel1m@PgkzYZyIXhyJ92$*z4Q^(A?gTOsOu74{lZ@chKC zW-{^m!>~x#wzf8oCBMiko8onjTL~f4;&Wzm(^?wtkm?Ug5uz zRO9EI9NVTHj*UjQH97O3j|PJgo@bo|E*N3FMTm4Jn=VXykSTGmDI0+xNHb1%T#%by z6pVl~VBVdWObR(qD~%I;R%$MJ+_rQ)A}&Mz&k7YgTc0^><)2MTbdVjgiJ~&Vg=;>Y zrOS)Fgh#@AsS26QID6O`sa`DE!V6H7>m}(8CThveF4=?P+`-emSiLru;k$i?c^YLh zC1lSNAvql-@!ZX4%rca(MRB_#PlyqjMyNL16CreXmV>R&7&kF=BWgULY+mmQ*%jE0 zD%ne>*u~KSc+QLI0|PPp^c4%sd<-5{&`$6wLi?c>k!M)=fc9v_ioAm{K(|QzhCWIh zq|D91QD#C9F?+A<55R>GSc5-cfL4(HNF!nzig{+k%3#s>8_Bd18PzO)AMbzchRLjsLI3hyjPe;)gL3@n-> zK5%czf~C-oy$fBOUq`oQA$TPR53LbBM0Jav%uqQ7%3k1CK*+rjYQM6AD)wl*fR( zO@s0nxElvB4I}WF;Q<>b|7HSMiYKAMrsE)i@rD7Eb!hfDd@FWB$#Kk?4iHa%59V2l zIP`7)i0Bv$pJIk0197;_YXRYk&AKPrZzC#LeGG7`w%~}m5HSWUDD5_Npqedr8&>W(io=>)gqC%7N%BbW;Y38 zBmiY%CL|LimXrOuoK*(Z1J?*?B8~ftED;o|b8Ggol?5#17b@zRB-E-hca>`IMpynRJCF}+&70_4No=0dUz#)(aL z91F|oktkf)5i9VkK&BlWu}DO&Hj1r*MY$D*gXmBkT#=92k+rsUGRr=!t5t{)8p-$G zcT0Zr-FtJ_!ddZR$_kkXcYP)QYVDbP@YQ_i6;TE=ajX@D*=g2a2kVG6ReOs^Gm^qd zbm&5`rd||52loVQ^;U&4Q>7?}8Z4%#4Ay~cIxi6*#lP4@t<(l-5j1) zC8KM=ZB9XO)y^~b+Ie%%Vtd>xfD{lO4iH0^EU3dVhS$gMxf&ED<;QyaLaUkJ_VY}| za|17v%ebi4lpbZ5`%Uujnt#K1cFXFx@KCC$(!1T#tMFBK-;DB|>I${p8$XG z108svFvAe~_*dU%AcH0NfJqp=#vC`gLEmV8Pt?{u2#Pe>p!ksgE?fxII!>!2b_3L&I;`RO!JU0KwmHKOi z{MH}lH%o=;=Q(fw+XtG39Aetv_}1gj+JkDagHP%|b>!p!K z*UyVAh&TApJ@VV85m3kmoxAtQGr!bRm2-?W)e#GH?X?> zIsNkMt10&dS-6;4-?jGo_+&oTbeir)z)^6Vo`7dQppg)Y@a$sna^InnQBY0l3B{)) zH^+*mgRP2u^91v00`gY%q|O7q!X3<$HdC-ka}3Ps_Jv%&JbeL9Hs1l*s*brd@$l41 z1%hg+~p(K*#N&?E_0q#etY8_(pF6_z7TQHv{`~ zxbMg>u8&?FmFgR4gxha`sD;24!cul*6-QiNQ8maDr@$BH8o#B)nKu?&N{(jWes&-rn0wb)gn;BG2jk`*0)5 zzi{6Aw>SRCj#L|)o3E|ZU*;O&eO|QtTd3qN3j5i*{kwGXOAa2i_HX{c-q%-;I8EJ9 zZQg$4iCtCfA$`Si7<-7R-KU+DL=L7z=I27e4_0*zx8K0Y0vrUB(S#AqHw@B);J%l zp9GxZOQPdn{v_;Se-f~oKM770{v@C{gGK5g?i0IKx1YyjfA+`QU$Oh^e+SR|H-0WbN$Qv-ogC`loU{k3zs05Per!=& zh3znU^HtzE?#=DR(pF<{v9~oX` zCjT9WByH5AFHwrQh>oCICr2sjjxY(vd0FGCOWr;dFU*2Ak1j55KbQ&on5qJ{J7zp_ zkySf(!ww$9j>op8!%*ttGaQg~E%(OxH6j!l;KcYed))gB%Jq{V}2a-N&0wEeq3)%5-ag z!_K7SGVn%v3h(+Ym607(7tsMmeBF`8d!}@z>DB?A@0mTk8SzEDZ?W;BZeUq3@G2%K zyfL6}ljs^zgToi5VkDC-u*!qfoeIJ+sUtXVN=KS?ia#@~|N0YUCR?w&=OqOSTa`sI zE3OV+>;JIRJz22g6!J^>4st+ZR)da@u}Tr}g^dOHP#IuAru23=;bNL@g8qVXfx;qU zk4qMPG*kT57<`Ci0%+|SC|f!bOouW;ePdEg0bkH(>$sBz(yxfVZ$vPE5%AQtngYM7 zm~4YO8jrod+|7ja6$r_%_J-e;`-HtuA@%CUyZat*94yM~zP0U*fvdrXg-q;g1@cg} zd=G&Yey~#iesS}1g4q032I8e2CSM_!m;$>O^AZ68XFMec#qZcX?3?tD6Ve@KnL*E9 zFK&X2GzLH@3QQ>ayo3Usw0o`w{&6c%1SR`cB88u|>)`#Xc4YfSoX9P<_O0DO;?TpP|adBH0V>aPFnClAO|vf_2w!+6EEfL8Q z1i}VFrz>>*Nf@Xvi6R$kN*4nLQUWpL3!O^G^@$EZ-{30?oxU%nyGSp{4o(B*N6GiG;XA01yQ@49QZ2OpRSa- zBkA(jtbrKicXStoxTsQh8+AFCdv3;z z)V^0mzHAnhSlP_~c222(a-!;75h)V)c;ce7#w(@Pf%?A&DR5;)4aekH=Rvoul5tX$ z_-Fu~D=bn-BQMa2>c~*5z`olCaUB$*08FPM!vqp-zlD>$`DEQGYLXW)6`NEBXJy!a zCVZw7H8giaX_DY_0wmJt<#+f5EgpHaB!N8X2$R<`qyd34P_C#rk`d`Xnn?;buvo1I zg?-q-y(?A4LHuDelM=-uW8Eyf+_@HUhgehi5@A%GPDcUkAkDx$NfPM54GQ%GOW8*K z+(KGv#P$NPd&Rk_43R=4V<#Il(Zed4Q-JvakMshfpLXG}N`fNG)x_lx=77On$$x}f z^B{=)e*QGWJVcDU3!7cZz7q+=pKC$8(-4lPew4qzk`)yYecAYz`UPsAm-E%eKdZlv zQkho&w&@JVZE{u5@!Zz$;uL?j0b+qV=+`lW5!#R&yhv)f+* z3-Ap7Wp98ws;ik{f>ZZf{ehYGD<2{)T$fgA%V3+}ZLJ@V z^Jk=Or|GnA`gE`W=7cJ78b09KQ#&;4*jmHPy<Zy46P-vB8QsK9h}Z-GikR+shqY9d0d^uf59vTx z(urgfq9uL^hHEg#~-8P50!T@cjFY6ocT_I5Kq%%6+ z9Yb<3O+Q?l0AE0OzRxgKwS}oA(b*r18tw{a=vuInZcKHst#sOtZagOqwvHDI7im$^ zazILihwQ+qL!p5Yxe+S?H5Aa2Y)Rs$`A~jSb^0o6rBzi65d?mCK*V zR?JqYTBa4SDVJwawZ&C4K(mI@eY$p=auX(W>gefwZNmEL2NM#`1qMKuFl^ZRTyq^X zU`OWF(vvPlZG((w9v;*Q&|1>$*AfN=^W~Jk3S!C$IVRWME!H%Rj?lB6pSQ~QD`9&uFZ*|g+s6tcjzEk zG!8uzmJ>XVhYX)o;~TcV`Q|AHvETRxZItl_3g^C=J7#{?nCP7VV;rEY&Iz^lF!~mT zVkOd(ytW@u(w79lFqAW#=oi{j1aSrwfWDYeK*k|8I|QpVH=Yr;fe4RcM1o=9l(Nxz zzy=s$c18rk0`mq$X_|#hvopAE=3SA8IRN5~sepnrbs0HO9T}sMF4P-OKxFD>6r$}K z!O^^>kEcr`*_jcovLmMrk<^e+&>aHT|Mgy)NuI*q$8O2Iega3MSflml$<5p04a5@1 z6CoDXa0}xr?4QILu4Y=f%{>_|s{J67t)65n-20n-CFK27EsT((J_`bg?}MW?JHjiw zv>%q0{iF!EPBH25hTv`JU$PZZ%Hz*A5y88zLQ8*^LwbwS_oZr@1w46&LJk;PtsT&l#(+cA;|&42Vw-jiYMr3Vf8?lxuNN6<_`sm?eJ_tm`5U z#HdM<0VtNLO2S^}Brp_uzd~xk)>P&cgYYy^9rKdRIFkBEe^z9RSy#9qE7@%nxs1n|Z$OmEzq zYQ@x*4}HCZT_9y$&jeq|ZXT%hJ+Y@br42R@HK))0r>X#NeWmLw*_Uh2WP>kfLoel$ zThHd}-zDnwFP@*0E%sYR<`49K=(a>FoM`np&BX7N0F)6Y0OhAR0A>GXW^ZBh4yW*R zxE1=AQVjydPy`MRssY>p^~v`OP>v%7`jYRYm>^?B|8lxms{bi4O+Sp)z%>0F?ovWE z4kYP%jn9Io(4%@k5KQAALbb9Kww0kB>K8;8{sr4f=%;sFko)4*o6Gk8S79S~?dr`_ zGS0>$_5q|9S?{vcrz0s#9h0y>tI*0^$3vX=KKlUb*n>LmBCaq1&3umv+RQ;Dajz+c zz!QD-W)R!k)nmJCRvaE$?yf;JhW1?(bsf_*@x^VWdROWs*ELh6fHczG8$Qq{UB5rc z1%2gzVra-??FQSJb{;kZ24Wb{^WY?sqsXJf)56c2?1Pv7DlX08Da#hFxyCKloC_@4 z10lK$kF=51e-f^Cz4%h?mxC{5LVqN_0&|RuanW=AhZJvL^97JjaZVDA!jR_UVFY8* zbtEKb(G3||GUuq~IDUu?1_eKTpiWUPbmObwb19BZQmI9DF?t7#ekR$~h$Mra+|~49-Y5C6gvM>izrp>I#l|$L5$A#{x)}%eZO}><+n{r^!``%#xHJ{0*hj0~Syo zz}CnENCrR9F;B_@;|Bl2>dwDdeg1`(mwyqJAK7^MW#;vPO-i0AaWp6T6Qe%}SvGyR zdx&GyQ4E*1``Q`x(FdYeo}1Bu5-FWLgxu@UUGO8(3b8nNqko8YD#Hz5R5LqpHt-m~ zifE-s8l4KyR_5s{UL8&oqrl;`Bv5ndn4Eqh#63S(wrTowz_gtP_-12+N(sg!bpLH# zAjzX{n+<|`k)t_?9c(`ow{9wfALxh)v?=_VP3MF01a(e_xucK(9NWaXu@do-mv-$5 z1o=RIMb99DI-TvSFhjG@6Wr`ti9CW|g_OUpk@HmFi-jM=|j})+x_Puk`El3&N}E_lC8w4=0GY7usI4I z-eRgZJjXnn>tflEISB(uu0`+%v2WCDj;!VH>>>FN2VxY%Nmv4B!IN_p9HDm%M=t9K z-jH-b1no*aL^rmo!s!#x!cM2BXK|?yV|$JV@B8RPU{^U@vZ{;A2Xc85)R38)UF4lZ zCu~(xa&DS+Qe!R+may&=H(s@7&W%bj-gVCZTasRS)6bGmEKrQTrG=?Ciye2eI5V8DT< zcsS}_+ZZjDy4W^`Igt8xLcl^{495jNCQHT#DVHrx73QZ2-zyCQ1^opL)B}*QK zP+;lg6ecYXy@2mR0cSZ~2@JtL@^afXh{ia4+BB*jr$8dfW3Yc}tqfL8AedueF+HVI zya?<7a8hd%hcKl_5r@nqQdAsjSVv?+tVfU;EkJPqbK?!VX!ni0oONw@QSU~?v|$DYRVRpN27=g+P`T}2{v@$=`O zlnJBRpy&|f8oG8Ww$Igp!~}Mf@Lh=gI}^NlejE1cX7TO^PQxq_#Uj zp>rcByudiR?LjBtW`{kb*<^BgF}M`i$^6U%aWW3mK&mjw@-}1il08~ql}+3WHDiXV z1XDhIiw@E`-+SM#oydA0Vs_rnABn+(q1Oj1uv};)q7{k2k26U`_h!^@a;aD*Y(O1p z5F5-_*^Ydmo;`)d{J}X9N0asRW^i0#%giBTE@5yX_RYNRiDbDlQXqaQt`yWmF?Zwy z1h$V>glr6qLTEu2)RU{u&nCRcXorEx+L*_r2+iUe3DZQ8Wh=vg-#a8^+ zVIZy1pQ*MUVK#tk5Kaj?R_aa@15(%E{+T5KD)&C}#{M*KV$>G8= zM|?lQPRS*00gN0*S=YR2LRW50St4K8)>23l;LUO0Dt&R!>VUwl`a{}ZP+D;P? z;>_WU1(uPtqI}PUtGuQm@mHKQ;2S8&M*_aa;31H59307qlZSBR18!+$sY7(Fgv6Dz68R+^?6!uA zNjQK**9yu*NkoD87n~jclD{73wT7}I^wUDR5jdc33~B0~hJMoG6#!=n8RA z1_8LFAG5k!B7nhXL$@LUoKzV{524=S&mm?m6i`W+M&BWG{UHMo$d6=+U0`js(?prS zxK+@cO10jRd0m85wbM48@xp2Hxg=YVbic`0NC{QW;5-$0i>cbYIUIRGSL**P!TD5K zf=W>+pxd*6IQuxlMh?l9)_g0RerYd25Y}w~3r&H#Ls?~3SD>ml9ggeGS~@nDObrvY znZ{iqy>#h*vF8Id{WGWB9E4<=zh4Z6*`PF6{$0rYjli zFb&w<;k2oFm*Z^wG`6^G@M8r#l`L?hZuL@LFNoWo%HeN`+7Th4tZgj#&43yMGijKm zLQ0a*74vkfG*vZisSe3%DSUaomr+wEfbOiJL)QDP?!o!X%a?}Nmw$eF-FjdUci&#A z;m;W$FbX&&_dq@Rz@YWy)8`SI>cV-15Re_tEUVhEJTQNqS3Y`i8DXj}KYj7yg-cgF z#oP;>^l*#|a{QGguUt8Ewg%~c_R@uO7j>U>z25#Py_Z6_!d08}-b`Utf#ta=hy9rJ zLP$9y5IP3#0-jluMA9E}88^MR0K5puk2`v-?&v6u%PggkuJVD#o}>&0n3;K{1vAA{ z+L^L$Uev+L$`x=HXNmEkU}3~VJbkeWE<~>ard>-GDombQ2rYVhkcnzb(g-M>vP5dw zV5Eu*i!N0bS1+$DBYv3xlv;`QAfT#lH_DYtFym}FhjbkL z3O$Jmbf>ow;W1AH8P%|=4qmhp)y4bH5i&eU^Rq6s@E+vyWaDE{D#huZKBcA7o%0kL z=$wQoI%gtb?Fg?k>i0)=f?#P-Gwt*2n}6({vtSE{KYZcRdKKIRn8zp2AO)B>$)sB^qm%CP!{|vHS}+^O_cx$Gp=NI&asJ5zdNY)z@H)vm6KJTaMEDt_? z8ES0mI2IQ7toiDv6_<}D#{jkdI>_b}Q8il12_?c@$Q%F>G^N7q2(KLeJ z9eSVIst6^XBwkn#h{qv_Nhb}>+U#PEfKhMnxBE>B&>V;)FeDs_U`P1ON<;YUb_dGq zj>%(|ZpND(F1(#;foh~vG88VI)7@4 z4vHOv@+!*hbijRAt!hTo-xkd`sg@j}Pf3A-qV!&T?;%)DU@SeDc#Hofk#8y^|7Hq_ z1pO<_Bof`uQWN@y4T^3e)g92%<{Ni`s(zz?)a)^%$xO=IXI~e9c%3e&Su@1kH|~n+ z$rOH%;h&9;;olVg9m79<&m%31G`!M3OacEx{}KiNY{0w{9rt&}l%(IZH>h>z|7`Rr zgPH5}kG{1{jJr0PG4x6HKfC@=`)2>%T7SGMg`Z7ta_K}Oixs1P^h~q$)_OxX>HfD_ ztsPvlJG22)Fa0;zom2eq$st6rL4*R z|5vc^-8;HS{7hK*?lZlp58D3!N`lDz$@ZJ2Cz9B(L<15T{7(=we%k7>=_ArJiDC|q zgqZ2SR6-gs@@J083l}I7VwdbTkT~IVt_ewf-3C!Na;yWio8&IVoEx|&8R<| zt~&Nk`v1S?XS(yc7Yoy!=iykYbNY0tb9!Qj`gce#{EX_y-s#w%VrGZ*nH|QJE_AG? zFugNl5Hu_A)P;TN+*Wxopj8=JM$o5@XkEE zGY=+0cn2QdfroeC!JL7g8Xh|FC`5O5O7Fm;FrDhe)3D;DQ$?u%r)7e)rjjj^JLxIk dz{IN6k)n8PvunPAq19XRzq7Tq8@7+`{}NcHKoOF`ywA*zYf3<1c)OC}(O+$g?j3wE|ZaUK~G@H89`VVPmJDbilJDGNO z3Te652cJjD_=?#a#nG6(AZl@nNuY*k!!0?n8lP48Qs_2Jw!bu(X5o3G6tig!&3{V zhNGj=F=KS%;CSTV_~@W9G|vkOjV3qO12?8+w(8prtYk;8UjYGm3f z6idb;UNb$H%NgEIMn*;kjq-_e7{*q;M`MHge(ZF{FoYjJd?PYGHW7WeWviFxDf zvsL3@GHvD$rHaEPyW1F=&KEb2d!KP|wvc+e5aGb6q4B7Z%uiVbV{E^1$SkE(1@&fQEMmx#)7@xH zHH#eZ)E+Q!FO@9Wh55WWliJsvw{qP>Mr_;|#ELDR8^&rcpFOuSa-vonG-9L1phBL9 z`Szdzc^E|@IhC5CnWH#PZ&%l2247eJ62k@UC;edh z{H?)2Fuu`wxUcs_S9+t<3U|Dbey8%qbnu;Y=F8LH1<*kMc9E`rv9Kcs$(5*>|* z`m5RdFR%VmU?>ua@GOkU2#=KDHf^PHQ^x)=14NCfVP=yCQ8pC>u0sd*8+2ui$BcwM zHE)bf7>}n4Ma#|`(MbWt|VqZ5SF{6n&IyxE=IC2j~>)^o$=kkZG{M7Jl!7gF> z9t1D}H-n(Zx0AV)nV*{-p0*1!#RnPXxW14orbW4p zoC+0Ica?*^!9ZHDQ+{@aIyU~MBFIQ9oU~_Vjj?f_)^x$1F{1koytrh~5&=X;jYGPC zxke+#e5z)44;&7(dF_ZP3sN6*YJ+#S&5MEJ$k8{0Jn(P>-Z7FsErF=9WNo zu?`TOOKZj6dqO-@o)-VvPB_!JuPeCIZH6h19WXvQV#H$nLLP&xg%Leq9GiI@Z!8h9 zwXff#k;oS3i;1~uOb9ec!}UCkN@FZ$44HW|H-9u`04=P%Z+XVRm%u9-B{UEs1`r_0 zi(e|1AP;7M0x_zbE#fL_OxgKTan?MH-T)#(8T&9}Nhx)t1SotE3IsZnpQf2Ix}WUo zH3S6~lLG@MyW-}?HU>+joV@K8YIa0$<76oDYT6WrBqWqB*LRi|TfZL*Z+wCuNmm92 z%u0Cx|G4~-f3|)ySzhn=^_N6{_&+dk+cp}=e3?5mnI|Us`hhnsUO5ZP6dgTaluGj> z1fWzA=ruXUz``|w$A}z=80OTJbANwKNrs3q9??Q#wqVVeh51=CpEAbA40|>ODSbqP z8hCunoJHMKl+bt-=$0}c2WHQs_X8T*k^TFP$L2t$Mg(1`tLTJ&1#qBb7E053BNAnt z<`T%(h(sogv{{&9EJ4Y+%bG!CbOPuB77cQW3Tpw2k?!|TI&%RhFA*a*qN7G4W#tbI z6JkPZKs{ZJKqWEfawUSpY>{crGeae}qQ(&>F@--wSS7-*h>^Ebg@RoWloAYl6lnD) zoq<58H{KEdLt3eNf4qx+o4dLAV*Fy@b-D9Wyg70)@Rc~P+Qwe_eOZ2fMSj+|%kTWg z1MiFXV%;3E1A`MEVq%mb(EW~Z_6}C zE>w<`H+s$Ai!;@8PhnzhQ7~bdYy^xR3{0RQ$b|Lu*Gxonf@WDFv4n?p6Yw*A2{x_903OCHhger+a=$USxMG}MK4+Xz7*}3C zb^h6f)909JX`-1G)Mk+6!zV!Kh=mYF*wuBP<07^ zm>Kl;-;%L@w02+Ic#_MnWvd@t$vpev2S@)^E;GYCzmchaaCG%Q<*J!%_1bl=+UR)x zV&I1!aV;;aKa_4h#NE{I)K?8$xQnmH5Dz=!nrtM#mT+5a?BZ+p55MqaXF4G&P^HBc z2@!^^dckeUSA4gvjt9!BX>Vv-I&b$>7DdSB1tNBj{Nm0)SOHG+LvW-RyQnEG3|TifmH|5e1(iQKyTsEuM%0t>xW< zTDX?xz!q9AEFOYiNfazr?Ra11Q2F&!~0wf}APQ8}IB6C|1R1CsX zKpH(TX5>?cjpzi_IJ=a_#hCH)c^l?S(k`Ta0s5_K0KO~@#@iaeI)e1+gD_AT+tWQh?tl~5%3i&j|GFl1yxrFSFQ*SfVfPPLaz2Tud6k3$%3 zY2QA;5XPI?ARjC<4_aS)h()LylLI4dd;D-HvmM$IBdQq`j{YS6lgK8yLLX3c^LBh{;C zz;X_Lt{1%AWU5~Uw}Anu4U^trFy3o+W%yn_+t+)~t#;2wXF5z)pJj)e@%}jf9_&BJ zzlr_?|4#K!@$XapPc`fwQFeo$roQhk^G|=cQC{lrqCcJVC)DV@x5wUnd{4vf@7VZR zdv|kt#bRnlKRtFI^Bq;@>zx-r{CU3k%Eb?7OffSzwwqjaGSs;E;en1fGVfKsmwuy25zPY^h*qk*z&yJc1 ziGTw#`G**R zldyz4msohQv}&aL%tVqeA%?)|c-UmW%J?B}Ad$$g;RO&t z)&>V-!dWu{$pP3;)8hT$=Z1@^lvd@?wNmB4eps2oBz+bw@f=wBqlSXsG)&)pMqnrq z#NTw;h|ap*_{?1 zSWMw5*u5@pDno|QlTGEMSxA*~ww)Dk1;iDvDj|>GLWnYoGDic8H_I{O>y5aXAg=^N zpz-;QZRzH~$q<*)!l*EJ*ivflYAmcllijOu)R_&2J+}2MguJ(!#hCb4k_8(+UY?XQ z6)4R%*aTGzNZTg#1}1cirZ`#f*UY#kDzp4zZ2PNPBwUb-^%ePr>08l85`d8aFzS06 z=|t5_pc+*=fB7wiJp(5@FC@4+A@=hwGZCL+G)b=C8c&L)n`WI<`E>|;BICql31YBI zW@bxpi4YmUxu=ne9qc2-TV*99P@8<5(SS2Vy3jy}g+c9$2XiCjQ**FXydz>ZLl|hBhB`$o#sDLC9%N2FI9ppdv9e&SEYucG zkqLXIcH-26@$~Xp<6LC{k&Tswv*#9(nz7(nB?U$Rf;eE_DyCCYQ2L?I`TQU-nEVw8gn0e4 z5HkMzKuZm0^4EG{NWR)O7#d(x$GrUkJ(UNBeXXu1*aPhu`*BA)flL2?C98RC{|{v~ zXc#DY*qVa9s022-ejv7p77;}ySZmSyq2zYG7?_9;=BF))zFt}Q?2)M*&Azj=U4c5L-8t?*CwZ4db0R<7OJda+Tv?-xahP;b4?F$L&3B)0@gkqJbCK4}&T z=KL^e<-_^8nMA6cy#mP#OEn`-wei2A+NX5wwYXee z3zuu*R^4jE%eC8DZ_%GO%eC%S{SLVg(OBzB-}pv4T^(u5k9$&b&y|wn2%)O}bZLRuFU!QB=L8rI2>VH}tiS`vrpqrY4TN<*mhz5Rr|7MAxGNFN zuXp{;uieU3G6jiNons zKAE%0^UxlM#Hh&=;sX;j=tK&JGEzE*;DHqWubBy^^OKzovm!Y4m5afSPXpj^+ts?>4|Fuj@%})gT!rT@-5h(jJk!6U zQRW8X&{Mv=qn;qpvHBn{70a_mrgjT;lgTMMX@=01dP9|5ff?#Q1AkySLGHl>d~3X_ zXEU|FNFi%6N{)8N zw2X3iMF&Zv9EO+YBhZAEvmmm6lstCMki}~U(sf)W5qQH~5@H)w%nu32Yu6t_#eUBp zg=Ia1@v6me&BLH_JI&iA0Ax0oLQoX5b_^}HbA-k;pOSnPBq6u~Kb~_N;lhy#M(^jo zzd^Bn?a9z)EYnDDq{G~R2{JG*B(oRZ?M%Hafh-XbvuA9$PnT{Ib@-qAPYFb(SeXrTO`t?d!mCIrjlMh1+09X{R55qBheYN163au0_ zM?fyB#)Hc)UXsTTD`FscF1Q6NXiB>*5WaVClHya+LV!=y1tLQ(1`@|~+{(3e97Lql z4|mBC>Zb+7T5)*FMMMXWeHJ+>pY103X@g|m2?#u6`Q#ED9+bxyF$R+-PCszYczW@4 z*;qNVaBA`CMM@s!7OvyNJ3A!|U;wHlB#(m+lnqRwz!cOMX7QVG=QM2APK`Ut%Vl|d zTgf-U15b7}5*sQ6f3h=qW9|NgFv*jh>wA*wva2^7OnliYCtEKxzJMS`XC=%?cgeJx zfmZ#8if4i$l50pUCxV|gOdL0akxU~+Eos2zp<1X4$FuEa8_tp`+tgVvsCMGfM`oK- zsimn0d?N{@2p&d;k4uG{;5cTOhfIsyq9DyEcjsPdjrVxyyascPN$ zhIOF|h-%($3mI2ttzvzijwK+s}CX0S7|M_*6v74Y%pDY|DiymO11E1N#2t3;1ciC zOvlgV9G)g#k`W27L`EId*Am!WEXDmOuv|2dKDU|MVcGmE?G;auj+)^?s<{jedafoV z*jBQTtcb%oJeaJUIQ@*ng*dE-iaP)IiSB^Z(LoH1t=-z{pALJXT&6T;|uN0GnxgST^FS`Fop6!)5r zG(z7{K$W<=1Ph&nFMtXrD2xy!@OU5zel8>dsZ^LFGhko0w;KYKG*EUM1s_?Dft7eK zkXn0G;Y;iw>JHA!)V^xLvlvc?j;#JQVt<>5=GblOZF%&%>18Z27`)Cq$%+e^&F$s- z9Sq5nAqC3+My^bi1%?nQ5868&$z|{cYBgQMr%P!`FxmGTvt+x8*@3c~;(#0x%Emxl z%qY-L6w8hu3fFPecb4+dRqg}qZzmp%M&m}oI+QNS^GI2SvMAS-wSkleDIjl?S`|`< zkX0v{4%E^uQ^q?dV@U%-!_9dV97pnHP7wHX$^>ks-|Pb;>bGf|_69&LiSZb@NSEecpV}9i4~aAz4f(TXT}7 zn|K{V+*X@QF}SK=FR7xkx+nvV$W}oZ_Ai3@Dz$=4USWe#B#fmOPLvl{oywQiW;J@`X=&SnB3UXdYzDk`Fy%(93ym0FfkBR|ZT3#)GMtZ4@WYoLPX4vwXVt-0<*;lh}c|P{yv*Ndr#%pM|#uOUv!fLSD7E zLf~6kX^(?SwNaGiwO#K3L{*a6i}B_Ty}KbqMmx<|i#bYzR(>Yt%K{5;=CxwQNbt)| zQEY@6F>Bn&4n~1;MBoM*wx@?h+Oi=gp-(8=oBcAAyz!dJ4)zaV%Zb|@2@X~B#+y`q<7M$iH4?1ZeOrEhM}8Vf z&MN**krhktcLy3vWfVjEk12`a<&Mq}ANfsy}C? zn_aE7vkCY1v9&ThR-#nDOIH%k;7)2Ct>3yB{8R#=Sp4p{YMm63u$JBr8x5-#>hEb- zRTo$-`*GlvU zE(ZQEgRym8Uuyk9!^%jApSfc1TZc6f(r^ zHaY>PInuXMhfHilfdeIqBn25-1Z>jFDQIV;_oWf!qs^pd60Bv*1*~&54CQ{syL`Rl z5%=BLtfFVYJL`Nc-GGy3v+d5>@%`f}XhVD6#$o#$EG%&LUvjy;fXy^+PzlD6ME->b z!Gsa-t}oZyn++F%!yoQXaxK805Q*-?Bu9;*m@!77V#XaWD6~GinO8bukY!`LV`_ym zzp!st!us_n_C+#1y=_9`O`2eJ;O^aDj5oWg*TL=Z`}a4#X`<@yZ>$Y0t@eup{%vB3 zV14Gb>NRq2nK#ycnpq)eLvuE>dd-rZR-80P8S84LHe*u+CX{~}p=fHY4uL*bym%5f zJ>o?{#?{k4iqQvlaZZDi(2<4@_Nxp4l4F7$LJL}odw|~Vt=c>fN3@xvvYCXag0X1VWemW|iwh!U|qVmR8#R6{Jn79o57Q#I2_i zX0wYf9x`YXz zUt|83Mw$X&G{WU7<>zdAsv}*^wm*dw(`|p5HmbaM%Wg*fSzMt{k(;glXl5F5f`D)qQTvn88{GT69| z7?t8>wCh~zK-{VhY>%rb6_}r7GL>+_rZ@SVy+6e2Np1b%Jl_C!MWrux?8q6H6Hmj9$=H34_l2iPlWP-@FjT8 zDCN`Niz~I0m)tjy{}AlNhHyLpUqTbXdJv1^bdMz2TK;tdgNEIu!i{`(gwA3|-h@I1 zT2G0HK{E1i;C%kyVT2t`vCV07KA6|v$Qu5h{BYGZmFTjYyjsn^D`~Y+4z1r!vrYd^ z75GQ`JFoR6dHVIZm5yika3HKvg=0Dk{dY&a_pw`ZZ8@j#qWG(t0d}__@ieCsPv7&k zP>HA5>1OxjZ>-&G_q}3=?H;6`evy8^`($>{S7$bETl})!Q@w_hVg91h2NnKT<5q9s zcDt|r_3*{`>+pW;s~f=k?LIvKxMlpU^ceP{rM>&c+K9dP6>QHN;6dQ`yT^Cg{pqaC z-yXm?@Sc7+&-)vz@9+FFpd+~v02^) z`Hv)}HIi$?LNiuIUTG?MG0=L|RB_10)cUQW-xISPM{c9S{34^wh-4IvAr`LdRrb-? zM<~=|@ExkAo-~UwZ2fKTz|}f@vC9|&jLO!Hx!VZ^ML{Mp__kC}ZXGl;ohwV2uTyxV z$j9;J*hb-#)(s`e7NgY_I)xV@QC;QjjP^PEI@_EN47Q@5)Scn9iT2Tw14!xWNU-0O z$wV3UqExDMDmRV6QGQ`3C=fxfbvgrw8G~O>D`#Uqm3RymjpT{JxdV3v#j+5i(6XW3 zH=u^#O|6I8#ojbxPn2*$j0&8_hNl2m$iK2B6^l3(YT;^N+lX~3@_$jlQ`9Nti-Sy| zr(BMNxGfsGWw;NKDM?X#wd;-?h{54)lx@OHN?4T=K0BB>?R1#ai7tudHg~@VMeJR( zx#JzP*?*;S^in!sVM6=L#lT<16)iF0{L=f=Fq!jm#?9)(x`RrdUn@kXouA^?8#$(P#U8?q*vr%BBLV#IpdF5q{(vcW~ zmpY{&>h7J@`GT&23}uOu1xa#ZTVNFKEcLWdE!|TXK?e<}dz9&F9m-2)U=#+VK756u zR$h5d#{j8k6qQ5{I2@*s!YM6DY+`m^5rJ=04<2KZN7%!K?Z9rfgU>S%Ar((1>;NHx zy|BL5df(w{4H`h693@@lg4`LM%oc>}j!;3y-Nmfk-5_z&W)IH56APd^B#lD@p$pB< zC+79>RGg&96D5Nfz~LRO&S?xdPePMEG)0U>ofZRK#4UUTQ{bMIJw*gesuvMG5wAn# zFrZKr@B2T3$^%ysPE%Cg+(G%(ORbID(zkT1ZxuOMTR%lkTIGDP=-bRU8CgVTIG8JdCLd9Rw7k>KG-I)?WZb(<` ze1>wW7uYLWDce-l>qJHJllUo(j@-~yKDzQC_9nWD&<+#nXA6qJ-WB~?FVRsBmL|Fg zFxp3S?iLCMogJdnHLl2RLvUALaBgq}SVpK39G01JZ2D*lN;`0!j!IHOi#+aa7>>|} zAhnZ?3x~Q=Z$AQcHv>Z9F&x#dz=BVV_AnDpi*O?aox~kH0i112F%HavjUp{>Nl3{W zIP*iW=`WCN)FH+Y5cba%!uBIaEYaMd1XpKoe`lg1cm+L<5wbp>u%Op5-tr%%(Akdm8KYnQFMJ#4~a zoDHLzQ*d70CY4773zRjD#*(s5E=)lw&r4zcsY+q}9=7csD5EjhL20dS5z~dTDla5Q zsKZw2U>6w@F}%ynW%1%L=K)& zA`}Y3!ZBJWGPenu4%eo1E>5WfBF}Pu2GAS4A8F=<_>9UrvyLoC0VWV0x*a^jaxw(j zka~!O{?34a_{+?{*K2A^hembv8|dBHp=`q^G$+k8yM=2e*9?SU({j9<$;Xa=I?bx8LGFUH(QHkIUj_26i z@`$Ayw$}Q~%6*x(UZ`GJB2!jOUExx4Ef~`7En2_Bl%vShy-65 zwy~00Q25jpa&Gj3IotNUYfT(bc$xMhF@|8JH_I&D5v?~gY))18`|!TNxl8PHUHdsj zqU_xfcl5v$^1I`5<&rpf*7RwNJE}Kc$~L<$t=@0`MqJ2OB6j~;l@Ly3>YQJ{y?Qx~ zUBE9h?f#e;6oRgn%Y8 z%7aktiS@O&ceZpm?YEKwwAn`vO8}n{!bDWf;k<}4c?!H+QIcPPZ4Nd#yqQ!NVF-#^ z@kTy9yf8N_`$TCii-jcEGas|esZeTX0bo-svhrh5z7;9n?CcbMn|BuCq%9IkWMj|e z(Si;b7XGbrV!RqUg*aeZ*RalAW&%NQBu;SxlbEt)gle%Xu7U%m$`x#gd!jddOSb&S zeWzQ2A5{MA^z9%1;IF>d*T~lTs@MLs^5@?R?3|BNumf?cJqT2+{ZttdhwqeYpP=o) z+i5#6HtGIcBMk@Kcj8E}W{eP>eQmeLkHz71Mv=?1pN|{5f21j+7i`{&oB;&=CWB7n z%})N`6{lE)!ZV!pwfYFfU@(NvR(-eHg`{%o0!#p_yD5~u3nBQxl$l5g=PTFe&~Fl< z_U4YOT?QsLWFgh!9fpx4iI$h%??Nuu()*!sL+NHaR`;e6&qhOC(Lf=r3Srud9&_W* z&IwkoV2Q!2tgzO(OO!9FNX%8Gwz|viWau!Z6!JgaWK5*3k^%j1@=dLPI03Mr4@3>fW7JD`SRYS)OHY#(-_Vvc`rCt3`PTT(VS6}OYPpzVGkiv z&R87M>0ok2r+FO&ai$75J(dU=;CAZfuB)=q|O_6kKR&z2PU z95IJHxd$jr{|9lDTas@iuvI6nPp^DM(gs(D8RuKVI#=)3w_ldqzbtpx<%nk{2Rb^W zey`r$KO#DN>s!i5#^JcNj`Zz4zpCohQN0)9^JO=KrGEF+Mn^&&Z0A-BnO5{Umi0$H zJ8h33gH9}7rle*-nL8u;y|qrf)$METvh0-DpyOeOqCj>hum|S`av><8fH&?#C34SV zB^6vPj`w($2pp@<^Az-nKy4N&AS;8$bmkEpSqkTAQ%!C-$=_o@TusszfXqY(blyLt zg11B9NfdHOi_<7l;`B8gOUGNgZJ_cL@PTld`7;^Oa)Cg)ZVoSy5@UEyS3=pNF60LF z0oI^e!O=#yL^0(4p>j%zwhz)hGN9=p@C0_+BEm?orJ>N?m{~g9jNNcUQ0E^g@sU^i zU^pO~&scsM$0H$MP4)=N>A$tw@@E&y_~-*|(Dgp!5QZ9?q6uI)?S3FSXG;R=6*>OM zlz@O_G346L`h+mYl)wfpJjY527y!rw1o7L@LOad3lsbak=Z3z-A@6c>T75umIK2c9 z@8!gs@bS{#@n-**&C5x(#Rudh$BMUJL~hgbnS=zU=i@3RYdtO)oRPzq;#U6{cKWap zp2h=Wg0uWke%th-_<2QZp*&AYBTxv*r+kkP6GPNcZHrd^MgZIO;;1M}gwD$m9M#?* zIQ3MG$AFEvyN3YHHU}o~(Eo&N?Q(s-vQi$S*WCmTw!PV?c6a)1bsLBjL3mU2AKF#R z-IJ~XFBPjt$PnRQu~D^W(a9CTd4US&(Upr%o6IVQ+bX38f=it@0Htd#nM^@XL?l*H zFhJaPfs~lQValV4Z}gbu`fM{yi5IKMt38Nj*8dj5mm<`w{jAT_4)GBjrCn|v7nBoGgb!KiHxSeK-U6Q?}mF<;e_YQE?`A|tr!E> zw#U|UK!%#w3l5c&wymbZ1pl#f+3%eTgBGMKbTeP3{LHnVawcSDEN4Pw3b+|~dP)wd z@RVpEIE8ofj67_4tI6rZtt@O6RI{Q3_c@490WHsIU5LNCM|VY~5faPEQ6dirf71+{ z?5n&Dh~fNQzkT(iZG@666rH0&l$;LXY_HxR;^?2M56gykTrRdGJ^guHv$*7S7SYSX z9$68cR&QU|%tqf%(SniDBX>I9n8B&DGePV~cvsz8`-=?rnO@5;wl>1~_1kjsbh$ZQ z>&)NYb9uEP=K0#b^wk4IBlpPfH?2kR%f;4r`1OnFW=`Cazmdg;*tNkdE57_fo=5B3 zSrPei5?O;zZ)4ve7=`yZuPE7fK4BiEy`t(MHWu25+0Nh_J~-|bA7Q~MILKz)EX2WK zv<#p0+52L9lK>&79fY!cDVv&tNO-a|`Dl5jJ;j*?8+x z0Jhg32nIs4ujmsP;`*x|5Kj~8iw6g={UZmzI&(4SZDejR8*_HslDWDm&70|sgSjN< zS+KhjpZ$U&xiL`Ta*jxc#Cq6iijjT=sM68yM$2*b9_%>`L7*!7|zSmv7zIva! z{Zp#0>xjDOM8d-t<8Pa9q@fb14ej&FFMgEq@@^~iPB}-0V2DnL!EqHqD+uO-Ls;PR zw)7UjF4QBdq-=*_(t_i-?mz;`2v68`8*m*@1IU1&4U8I0OaP~h8YokYsy_cO44uuD zSo_VDpbhk>#3ejI`r6By-BD=f1v`qiMq_Urv?@f?ajn)5S8yP-uO!7XM10Yrf%M2R zkeb3NBX*Y8jvXj|RqWb!atJmHxr6K2EU({(!@lcxHM@XJJL%TduF<8|%Q$%-o3r1;-|mfno6TRxzO4;m z#{*b*Qsfmq@%jpMNO4!SDu3Da3#$_+D2vaHRY6^MtXyc#dP5>&>CQ^hK0E0h?qmmh zXt#}9pwC2TyxO$#jFU=gZL#q9`W7FmjP+zRfD-zXLxMlLc_g??t$j!%!FJkk0HS_S z*8MeeUK~rScS^-eW)n1zQ;+?tzAF73|JXGZRJb$obw4V+gyQy%f0xZ)L(˨eQM zHbdWFpg@76AL+$)!%}jbh<|ZO;5d#KLJe6)-nD@e=pfgk&$9IM8JEo2tu^o9eQ^^&*nqF(xDyf(>9; zc?@e_^>K5vx&v;}3yb)ci2&=PhxUf*_Tifx+E>k5=o-FQ0`2SXs;mE#c9)NnQbT74 zVylN>9wjb=vr`rhoi~#}c4rJOE!`}Nlw(3rX%>}ySMGomEYBS}8ANwL4ien~MJ3#3 z5qRzN9Yj>!8=wQNdO+N}8PVWWwBel^it{=K8`D#QHcutxxTGVxC3iW-$*;~sAWQcl zI%mvNf*-;yQ38qO`WGH{QLZi`io&V8VNp*2^^HEg&v4eU`^*C~qg95L)9?oFr&Hu`f zAq&T!rlpu~o72Y;Fo!XPfW0}Ma4b6Kin7z15L$?y^5OM+us_Vb;qC_`3~ZxWFHyyi z&fpSA>>o$7LYG2TQBacGA)UrRC1C=T_~g*6@E&=He3I@%6ufs!>daO}v^eU;C0aN> zKZa;sSFPq0tXmD?(>SnC=|h+79OfQSqEF}*X3fVQlRl{i;Q{%1(0Ifc%q^cNpFd-) zoIC&Y(}Vkrp~oplpP!~^9X@KqAF2I_@5uT;txB9mzOss^@R^ewzNUZ=^TGlxrEu6$ zoW8`#C3Yh_)ih=b3=UyDkKm)cCGy}tvv6+3@P4wkhH=7J{cL67v<%PpL0dc_4QLAT z7zR!gzz>3o{Q1r~d{EHn_H>HihmF#OpQXHTQSiWfM70y8EBU=7*)H;nT(u$u!gIh3;#W{y!InNB6M>J!3p9}ZGN z3px^rTMTX8gue2GX8H~AWWYS5kJ{LWi+o3xN8k!Oq=1jBNI?;k6fjQOxT0?%9*4Xh zxn(AB_U+@Uz_hpz-&B?{aSMF?2LgF+c4WrJU~SNAGHVP;NY7s<->LLHgfaSNsWwQ` z?l}acaZo#)4`?9I=r82J3PnB&-N7vn6s48>>=sYq0b1^EV{q>DO6|l-1=#-d`O~N9 zaD$Z*!&yK zJBR3OJNd}}2$s)(z>~VY)%hptow{o$xm7(vQj5PggBE@W(5?Fm0N=_97ZMbgVK5)jw`E&eLoaM9Sg|mDPjOQ!y zaAud=?vkcJ^0ET=H@yh&JW*SG<}^i#yJ_f5cZ{vWMD6mvVdV@}C2FKDk)PoyDM!6L z?mEn*T$)Z4%*Sz@n-tT@*?H9o5wf~W%;DpNn#B(j8`tm5XH)Yedp*pKJ2Hyr&z!-j zEI5S{p9p%Ez4gTIx}jA;O;*YuKKETp%}mh;%7^GL3piKbb8pkqyRYaTq;tXqC>9v% z*{AU-B33f!Q$#Dzt(;qU);M(n=U?K8UK~*Xo#X@#?ZsifbaD)a4))7soY`v(VbiBb zXx3AySMoVSO%sriKy~qiSXrrHq7gps0lf|al)q3fQkNt&{qt$KGEQlrLF-d4v@=@W zM0TF5QEaJssI~Gev46qE3Xlc$E&fNZql;A2yrf&;gCE;G*x}Q96h09Qc;ZYWGL)Z~ zO2zhrK?hH$SO+jzvxG52o?;yy!>O@sVc>B_ z8P*4qC(fKZe|CXg$`7mnvnW3 z0+}a+M4EI<&O02O9yA6qeXf@G5;S1t@PRA}h;%KKVhnLwM-CJwS4Dgu9wb+q_k9uE z3F6~r{D3r@LV`WIGP*teLd!Q4Bw&Kthw@-8su`$6z6-@KH-?-IT^KVS;-w+JMd3u_ z%!y|fD$BJp-AU#S&gEgc6}#QF^eEb?!iXf4KnWItWqzd}A^-wDWCdfKdT;_3TA&gy z6JOz7Aa2oLsSla}XBN-U>vX-a7?->pg-m0!5^8?&xrrWsVvjNIF*7BK{<{X>{H$8Y~H-kHGV=pIONmZU|~Wl56`ZID(LrJ+rl5No?3bkVu(vd-?%p&7PeXtz$@fMO`H zb>BJX-b+$;HWXOUiuXM3x##@P@Bjbfr=GLD{A=s81t*b)mHW;P%O2TBJi#&F$e1Vi zTuCbXy@3P7G2oSklPC0HNgng~$E48#a`Nn{yBAL1H#>i-NKQR;-`NNDjgd18=VoTl z+)HN9kb(GAB0(Bob-UdIqS=HF;dSspmx7>sL)SR@-$^06rC9=O5A{PbJa-5pj9>T3$C%b003QbSQ6z7T5rv(mvB}8I(q463b@OSt5By$#^VZ&{ENKA(KsKh~)9C z=^6ErLOh#JMss9jghaJmCZSB{@}NpGL(2Xj!F!QdF6S1j5Wj5nWQY&%inT#Z$?qZg z*x`ISJV7L%OvD=4gUq{)rYxF#mgF~Qc}9)Lpuax9B}oEa`XxueHZofIsiSLCSte|= z87+oA5uAs_*-9CLZ?gvtJ^3_#Jbc~(V!2?qSZpC>b`v8~<&%n_Voyl_?dY_HW;pE> z@e|s}CUUB)+Gh5Ar1H?ToL!S}dVc1ax2X1+RZ?LnOdpE5leuxmJdaFL>1b7pW+7l`ZMuM_ItHshH$kk!BC|d3Pt$Nt4dgna=G9v^_%3?Qn^?*579S{5mB|X<|B@P zUGXC^rkOZlDxxac9PtL3Drl+k4DotMa#A$F0)qsgjLu|eX*8WmOfwEjBaQs>c+J^C zsD#kVtzXp`oOrr3ykzbqm21^^lU7ig8^vW$H9N z*5BjkT+XPRFVpms{n@hQ@iD`c)N;^-5#!75xR%m#YAl)|f#8}g;FxRn6d?Khw7Gvj zw61B-&>Q`1+)TcI+*~ zxLUp@@{A@7hHCAwtxxi2ZeyL6s%WJ&b@f&4u^E@sQB{+sm6hTCboEfRTt1zhR-#cN zjUHtDX*RxaczTy%eBtkmNlgY=@{KYJ+%473scy9-nHlBnJD_mpn+dlVj0%N@_5NYH z+cp}Y|CR2ujmXS;r{OK@^9}25nnc4tK!}W4y2mg(8mzbM_fqLl*Jc?Gc`Ui`;3*hy z>N(_`lV#Ix61l;E$ey|}k)S=M--hCt&oI!sO9%+j<(>crPq+v8?z(#zW$vN!^3EOh z4cPirBAUuq{(SfS)=FCXx7NTe2$M~S=q2VxzaCOJyOfYHuN=12bkIcEFaEuIT1S{7i?rhgtG#bC=smRSUzeX!GkYTkKVB#@U8Hi+2cY@TZaQ;8>Q* z*CM=KU3`Of9aQa+B^Nz@u(ve~e#(A{o<6p{EW`OTo#$TP&5)`)o`$`b5kasA09Lq; zx=V-8VAGXIJ_fW7 zuzbUQX44v%1%j`yrEfTrj>Z5t;MSUEnydxBXgnGjHIO?b>3~C+Rj7P-7^vadPxr1T zW6^+Pkp40*p>V|;Ma>e6;&P^q>3 zL?7q;q+>B}SqcV-3KUHw*gBIsJYvF8#R%v&m5&G9S}MZG6$dKzffKn{p2d-wJU9pw z+t>~?HyJ``n2m5Ul~)=6BMz(wN=iX5VdUF^ZAc_H6&AP%&dXD89i+ARlvSKm%DYVyp15RtdOo^(yuF%AUaJhH+h0t#rGD_fnxQ&INn)Ze81}%P>N$gopf)9FWmxm%&g9?z7-Y$Xf<5Ae2b+T7Lo15jDUEG zI&r0Rb&hv(8aKqT4SW$xXn#<&c38KD(>pm)yKMH-$|{S3{E`W|Am4hXzzw9&u&ys? zLKXwn_&DTXp`HL3+L0I!mWVIVfQlLeVBbiPl1V3`k>`p%DIek@-2w`T?apiYM2z?( z$q1r+h#B-LLUf@G-cfTW^*+G2AMWZN^}_odMXn^Qm)KP zx6zS~$8k_-DgD8&ZRJtub>piNFp@Eozbe778Xd-~2-nu`FBs(BK-l77ouoSQGlR!9 zMB57(D=aWJkx6Tyx!+6;=vc~6yNdg4UXbrV7yZXOoH-xNnvU*#aP3)bTm`FOk_2UV z%#W0e0V^0_@QzAk5HN-P&vO9A&ePb0b)c=OXs5IXiaS!ZTdJl&~-)OAqO|OtpR!8HR{321ei8;$ect3?gJO!UWOM z(O!$QMITn3wrY6B=vFsdicn!)G5B{es{abPXMhdHUuTyg#1g>v+AgojRHg@@o}Ryv zfM=Najv$C|g-lpy09{io^|hHR@IsVDLPn45^%w!cFvI#=;VQ7c-WeEWeQl!wGL}7c z-~5TYPmxg`66{8X!7%557seyvcjJ-LLnm4dhWz@_&3!MnFl<$Xse4WYV3uY36BjKP zW~jR$mxX;$wTNy%YA#hojWe?%?W5eq4C1b$!Gxj)!WUKN`f72)xuL4}+p3(xjIv04 z=wxgR*N~6Wd#5rixyp!10zMW<*++tercWV~^3cm&-DMWc3;Az?LuNY3&z^Sw6Aj|>sNQ<2>p>Kf)<_zENd4vQF?SRJAm4hW|1o=DRO~I@>Gb9ha>r77> zPz}j5Bh#mNJRX_-@e63gJaJAN8yf=nkEp}Q6isDQ!wfMFao^0xqEpG_^l&_#9p*5y)80Prn@bgH|#gR{7Z=@2CyW59ZVx`Omc}fVs^(Zh-0s`N}Q^4y(wpN>E zHq>FWW^?%$ILj{ZzlREKHTV3wLi^UX8Q0wo-q&v75FIBUGbA%ercx?Q2VkfQ`Z3dB zGzZWI#Sb`i-rRs3^wySvTM@1>GKihW6UsO{zn2X0bWALYljmYN)`yI8^9f`0u9ocv z0^(<73uR*<0Z5j_OYGoGZrGs@>xMTDh;$gyBiJqo5l$awEs0Ezh?h*W zAK!I*LZ`oMC=#go<8_-XR!*uy`xM6oHOq|4kXLB>-UHZd&3@)gfzEkN_H6_rjZ_yHXiywzdeM@VlK~W zLkyX7L2r~#WG+bp6_>-z>|lx>dN7IP8A2BEK?WI^HweXa!ypsW31((60n&@V9wylu zW^>!Xye+8D5Pd?zPaVt~wx5f=xdBMy(-;T(c;(oikA(tl|e9TpoB|$Ntvj z^69x^G+pnD)*rctRy7Vum&YgS11r4^4S@8C=)5i6wzch8cx88?r(?H+zOt^jJkzd= zc?v4?*WX zgA^r8#@CNGuAdJvDPI-x04abLh0{~1D3gv64`NaQ*@DP2NAm!;9#T+asdOfm#m*7Y z#Z&b64*#yTllD>Sa3#epBV#^gb*7hq=x& nxrorrs_uNQKAQztjCaC9i zL>yPT+9BE1xogW~s-DK1Uc6 z(b;^Ywwbg0(t0wty8N%0fvnMwCd^(BvH{;wCXgt8U0r+~(S`{abo_+;*Y#KdRU*AJ zqUO^$Fbp_%@$T{1od!%cjkl|z1O$6!^k$BzE7^)C9iM>AW#hIG$YSz70f;{2vc^v;b|n{R}s zkM-NUUgX;PZPJKHxj{=(LS1FVXr>iVGMU6QGtE#P8RZ>4;V2_6WclmxbRM`(g4u`0 zq>MZZLOk)vwVEaS8%LR2g5DdG`FA%lJ0UX%6_lyxcsEPwiZjVFYUeyLCt+7(EE>+H zlmvrwNtW=17~h~1`I=Y(vN{T7hgP#f`opPoRLe%v+1R7(8UjftVESa1lF3YA9S^*Q zc#;8Q>35HJ*u0*~-yDC(irWS+o+w+(NY#p*5VA--odfHHjE@fbxyt8}ZxmJ6=7jD; zD6ZN?I;OH90xjg+kXopmC@Hng*D6OsH5YPv3}c9(Nmu#hP>90QCJxPAq;O%P^ng^ST6cmSyX{&>$GXHyTbJ;Lt4scw_M-i@cW0io zzMHUpOYg1x{lx5Q<)_Kn)s@cV^41XY*=n&CpKnQSZF_t1+bYlTRQ9Ns$^md>X}gBm zJ$U8odg)rNCAbHEoE3DdsOTgGRq#lw*wqQ!>7ro{5k zjqr>heQJV36ih|ER0=fLRHYHqZrA5P&Xc%56N7fb86^pDAmor4521l;ZmTeJ0;8eV zRoO)sUUE%fGP|R~($bLZo4`+=)WicKGo4|L7f+1rwO-T}8jZynq@cf^-Cs7tmO?s< z%qhR0VBk98Hjz4IJ~N@@@;r-r9lC-@+zRcniA004(h5yEY2$>2>+G;H*SRyK7b6r+ z)vlJVaCSk1@)rEZGi#<;>zk-w`e=xYVRLlhXWK<#9Bv)SDbwExvy4hwFWqsEgZ|>4 zcGv`c=j;&th2Q!V>4_89OCla{R0$~w0AtaLEM?b z)stG!$(CxUw*DKT+Gg0Np%6V$dZ^n>$YfAvaq~4%hy7)#XB)GYb{Gq8qjP$&@8^jW zn=iofDK?*n{m@hMzi<5s{m(N)bjRt#$CKJ(ytZL6$MySo+od+9dx7vP={6Iw0LLut zN1Fke-iCf4nHN*6|AY7N*Rk^6Wa?_VZKWa%tc&TIM6Y!^=|7#8wm^OAZj<($`Ox}4 z_VB>Ai2mUmw}mG!~GM(K4p7Bw2kL;yGgge!Sjq^9SjFpWRNs|6qT)5!QL3Ho7nO!ilmM@=6$K zWElpop@k@;p#`8`Z?W1rYw5Rqki9m*0V|W63mUbv`~+VgsonaRP6PeRBk(Cols6FF zv5Pw_OU|^KV}G|fO6Wqco9;X(ui>m}edYh;Ecn@xYn>=6*Iv75JzwQqu9lj3dqLU^o(8dUh z;~GZ5d1C~r1!JHEp|S*?y4Zy()+wmx#a+gRmQTDOc;jU$I)1AWky0c5f!i8hk|7iI zC1jwjdW$(Z)-srlTtZo_$go_)JUF#_OOGVP4x6@%3lAnc{|{z2l*!FnJawE{Pw(5OShvx4_l36{)34dMri(KUx@G?^Yd;;{?@}lA zKwSU;P2ex)d>F?JP^H%(7=46Ht|>wQ?XujqO-Ayw==9gC7typkjB8#1*->PKbT8I` z1x#Fr8#cHX<3i!HDU`0?TA_b8wQbHX@S4O_t)ACG1*V||ZWtL3$%o~5>5|tgZeZ~d zKIn2WifpM_a`lhU-Og=RnT|PK^fQCb?LNX(Q3rnbn8>>@+1W#{?cD~4%6b@j7R$l? zzXP7=Q8PH9tmM_2Yg$;>ow%r=tZZ$(W7u9tV@He2Hz}pW*0yD$UxI48vzlDFQ!QOS zY^j!5VNWotox_Qxuc*plZj_JUj!Lb6dZHwXf#PMwxznh8{AEv76NqE+$;NMA{LOj$ zmy++zTu55qOWNK|l`aoj7N14dWyH(wsdUvNY~!MoOg}6*lPtCq;(*I|Q9ThxjJyR1 zf<%icLx!tIuog=ZWbK>y3}1`dRJKvlS$?O1tt>@ivYbU~W&>q-ojC}L%x;e7;L!hQ zXqTPf0_G=%2G)^#X3suA-yXUt!6G7-6EnDG1gykzGed19pc~6)s!wUM~@b2wM)w3%s+{~oLW4IK?>ht`|R0{Xd z>Tq}YrF!^}`d3H0UGVpbNqn#}-#J}eY2y`Oz8QmuN7RWTXS9d}c(qp#pQ;cQRC^7L z7onM0)94d&AX?>`OD}ct!@Z+Svco+!x$?~H;!`*vLfJKjfM0bmST8Ov*Av9eoUUJE zGISkw+Q6&)`nbC+>bDFih&2&HOuAW)Eayh-o1bRaWA&j-B%fx*+@O9f!yIVHW;IKZ z5s|aY)}~?Lk}Gbj2S$gCekLlU{{KY4>+q;k* zNahrNT_{ITXgNRzsrzBKoeVnYEf-?+=)*g$4*IEwUG#;AqjBCFjHu}#=Mxtd9{OkH9(ufdGfkax9n|}ID6Ky?gjUz} z7`Zf1ft|-e_dRxOBN>dOlQ~9^A3ZVwf-z{+Xm=cR;?ezG>=oR{$(e*caG-MGu`Vlp zgP6kP%1a=Z~Ma($i1w*v!`%RwJ2deCEX`U%;qX`Z|s{2D2IE_WE!NnSJe0 zjB~4b47Y=nsYIUL4bE_G(!CeboqSt~v=TM9MvpxGH1^d=tkaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120 47172 +(FILECREATED "14-Dec-2024 11:45:45"  +{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196 52876 :EDIT-BY rmk - :PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}TEDIT>tedit-exports.all;118) + :PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}TEDIT>tedit-exports.all;195) (PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION PRINT)))))))) (FILESLOAD (FROM LOADUPS) EXPORTS.ALL) (PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) ( -HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)))))))) +\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS) +))))))) (GLOBALVARS CHECK-TEDIT-ASSERTIONS) (RPAQ? CHECK-TEDIT-ASSERTIONS T) (PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) ( \TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ)))) -(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:26")) +(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48")) (RPAQQ \BTREEWORDSPERSLOT 4) (RPAQQ \BTREEMAXCOUNT 8) (CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8)) @@ -52,23 +53,24 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO (\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE))))) (I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE))) by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE))))) -(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:07")) +(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27")) (DATATYPE SELECTION ((* ;; "Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT." ) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;; "If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#." ) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ; -"X value of left edge of selection on the first line") NIL (* ; -"Was DX: Width of the selection, if it's on one line.") CH# (* ; "CH# of the first selected character" -) XLIM (* ; "X value of right edge of last selected character on the last line") CHLIM (* ; +"X value of left edge of selection on the first line") SELLINES (* ; +"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line." +) CH# (* ; "CH# of the first selected character") XLIM (* ; +"X value of right edge of last selected character on the last line") CHLIM (* ; "Last character is at (SUB1 CHLIM)") DCH (* ; "# of characters selected (can be zero, for empty/point selection.) This controls highlighting") L1 (* ; "-> line descriptor for the line where the first selected character is") LN (* ; "-> line descriptor for the line which contains the end of the selection") NIL (* ; "Was YLIM: Y value of the bottom of the line that ends the selection") POINT (* ; "Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ; -"T if this selection is real; NIL if not") (SELTEXTOBJ FULLXPOINTER) (* ; -"TEXTOBJ that describes the selected text") SELKIND (* ; +"T if this selection is real; NIL if not") (SELTEXTSTREAM FULLXPOINTER) (* ; +"TEXTSTREAM that describes the selected text") SELKIND (* ; "What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ; "SHADE used to highlight this selection") HOWHEIGHT (* ; "Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ; @@ -76,44 +78,50 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE))))) "If this selection is inside an object, which object?") (ONFLG FLAG) (* ; "T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ; "A Place for the selected object to put info about selection inside itself.")) (INIT (DEFPRINT (QUOTE -SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of -DATUM)) (FIXP (fetch (SELECTION XLIM) of DATUM)) (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) (fetch - (SELECTION X0) of DATUM))))) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ ( -QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST NIL)) +SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) +of (GETSEL DATUM SELTEXTSTREAM))) (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) (SETSEL DATUM CHLIM ( +ADD1 NEWVALUE))) (FAST (SUB1 (FSETSEL DATUM CHLIM)) (FSETSEL DATUM CHLIM (ADD1 NEWVALUE)))))) SET _ +NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST + NIL)) (DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR)) (DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT)) (RPAQQ COPYSELSHADE 30583) (RPAQQ COPYLOOKSSELSHADE 30583) -(RPAQQ EDITMOVESHADE -1) +(RPAQ EDITMOVESHADE BLACKSHADE) (RPAQQ EDITGRAY 32800) -(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800)) -(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of -LINE)) (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) LINE))) -(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLIM) (AND (IGEQ CHLIM (GETLD L LCHAR1)) (ILEQ CH# ( -FGETLD L LCHARLIM))))) +(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800)) +(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (GETLD LINE LCHAR1)) (ILESSP CHNO +(FGETLD LINE LCHARLIM)) LINE))) +(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) (ILESSP +CHNO (FGETLD LINE LCHARLIM)) LINE))) +(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (AND (IGEQ (GETLD L LCHARLAST) CH#) (ILEQ ( +FGETLD L LCHAR1) CHLAST)))) +(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ; +"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ ( +FGETLD L LCHAR1) CHLAST)))) +(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH)))) (PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S))) (PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE))) (PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S))) (PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE))) +(PUTPROPS SELECTION! MACRO ((SEL) (\DTEST SEL (QUOTE SELECTION)))) +(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (BIND +$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST +$$SPLENGTH) FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) (QUOTE SELPIECES)) (SETQ I.V. (SETQ $$SPFIRST ( +\DTEST (ffetch (SELPIECES SPFIRST) of $$SELPIECES) (QUOTE PIECE)))) (SETQ $$SPLAST (\DTEST (ffetch ( +SELPIECES SPLAST) of $$SELPIECES) (QUOTE PIECE))) (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of +$$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE PIECE)))))) T) +(PUTPROPS GETSPC MACRO ((SP FIELD) (fetch (SELPIECES FIELD) of SP))) +(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) (replace (SELPIECES FIELD) of SP with NEWVALUE))) +(PUTPROPS FGETSPC MACRO ((SP FIELD) (ffetch (SELPIECES FIELD) of SP))) +(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) (freplace (SELPIECES FIELD) of SP with NEWVALUE))) +(PUTPROPS SELPIECES! MACRO ((SPC) (\DTEST SPC (QUOTE SELPIECES)))) (GLOBALVARS TEDIT.EXTEND.PENDING.DELETE) (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION) -(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (bind -$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST -$$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIRST) of $$SELPIECES) ( -GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH - (fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE -I.V.))))) T) -(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55")) -(DATATYPE THISLINE ((* ;; -"Cache for line-related character location info, for selection and line-display code to use.") (DESC -FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ; -"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; -"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width." -) CHARSLOTS (* ; -"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT" -) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") -CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT)) +(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42")) +(RECORD TAB (TABX . TABKIND)) +(RECORD TABSPEC (DEFAULTTAB . TABS)) (DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ; "The bitmap that will be used by this instance of the cache") (LCNEXTCACHE FULLXPOINTER) (* ; "The next cache in the chain, for screen updates."))) @@ -125,12 +133,13 @@ CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK. RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ; "X value of right edge of LCHARLIM character on the line (may exceed right margin, if char is a space.). In natural stream units" ) LX1 (* ; "X value of the left edge of LCHAR1 from the left margin, in stream natural units.") -LHEIGHT (* ; "Total height of hte line, Ascent+Descent plus leading") ASCENT (* ; -"Ascent of the line above YBASE, adjusted for line leading") DESCENT (* ; +LHEIGHT (* ; +"Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") LASCENT +(* ; "Ascent of the line above YBASE, adjusted for line and paragraph leading") LDESCENT (* ; "How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ; "The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ; "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ; -"CH# of the first character on the line.") LCHARLIM (* ; "CH# of the last character on the line") +"CH# of the first character on the line.") LCHARLAST (* ; "CH# of the last character on the line") FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ; "Was CHARTOP: CH# of the character which forced the line break (may be less than CHARLIM)") NEXTLINE (* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ; @@ -141,19 +150,27 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ; ) NIL (* ; "Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ" ) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC ( -* ; "The format spec for this line's paragraph (eventually)") (LDIRTY FLAG) (* ; -"T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") ( -DELETED FLAG) (* ; -"T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)" -) (LHASPROT FLAG) (* ; "This line contains protected text.") (LDUMMY FLAG) (* ; +* ; "The format spec for this line's paragraph (eventually)") (NIL FLAG) (* ; +"Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ; +"Was FORCED-END flag") (NIL FLAG) (* ; +"Was DELETED: T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)" +) (NIL FLAG) (* ; "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ; "This is a dummy line. Was: LHASTABS. But never fetched and this descriptions wasn't true: If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line." ) (1STLN FLAG) (* ; "This line is the first line in a paragraph") (LSTLN FLAG) (* ; "This is the last line in a paragraph")) (INIT (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION -\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) (FGETLD DATUM LHEIGHT)) -) (LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYTOP (IPLUS ( -GETLD DATUM YBOT) (FGETLD DATUM LTRUEHEIGHT))) (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) (FGETLD -DATUM LTRUEDESCENT))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL - PREVLINE _ NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL) +\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) (GETLD DATUM +LASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM LASCENT)))) (LTRUEYTOP (STANDARD (IPLUS ( +GETLD DATUM YBASE) (FGETLD DATUM LTRUEASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM +LTRUEASCENT)))) (LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)) +FAST (IPLUS (FGETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYBOT (STANDARD ( +IDIFFERENCE (GETLD DATUM YBASE) (FGETLD DATUM LTRUEDESCENT)) FAST (IDIFFERENCE (FGETLD DATUM YBASE) ( +FGETLD DATUM LTRUEDESCENT)))) (LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) (FGETLD DATUM +LTRUEASCENT)) FAST (IDIFFERENCE (FGETLD DATUM LASCENT) (FGETLD DATUM LTRUEASCENT)))) (LCHARLIM ( +STANDARD (ADD1 (GETLD DATUM LCHARLAST)) FAST (ADD1 (FGETLD DATUM LCHARLAST))) (STANDARD (SETLD DATUM +LCHARLAST (SUB1 NEWVALUE)) FAST (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE)))) (LNCH (STANDARD ( +IDIFFERENCE (GETLD DATUM LCHARLIM) (GETLD DATUM LCHAR1)) FAST (IDIFFERENCE (FGETLD DATUM LCHARLIM) ( +FGETLD DATUM LCHAR1)))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _ + 0) (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT)) (I.S.OPR (QUOTE inlines) NIL (QUOTE (bind $$PREVLINE declare (LOCALVARS $$PREVLINE) first (SETQ I.V. ( \DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$PREVLINE I.V.) (\DTEST (OR ( @@ -165,18 +182,39 @@ fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR)))))) (PUTPROPS FGETLD MACRO ((L FIELD) (ffetch (LINEDESCRIPTOR FIELD) of L))) (PUTPROPS SETLD MACRO ((L FIELD NEWVALUE) (replace (LINEDESCRIPTOR FIELD) of L with NEWVALUE))) (PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE))) -(PUTPROPS SETYPOS MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) ( +(PUTPROPS SETYBOT MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) ( FSETLD LINE YBOT BOTTOM))))) +(PUTPROPS SETYTOP MACRO (OPENLAMBDA (LINE TOP) (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT))))) +(PUTPROPS SETYBASE MACRO (OPENLAMBDA (LINE BASE) (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT) +(FSETLD LINE YBASE BASE))))) (PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN LINE2 (SETLD LINE2 PREVLINE LINE1)))) +(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) (\DTEST LD (QUOTE LINEDESCRIPTOR)))) (PUTPROPS HCSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR ( FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM))))) (PUTPROPS HCUNSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR ( FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE))))) +(PUTPROPS SCALEUP MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I in +ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM))))) +(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I +in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE))))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) (ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") ( NONBREAKING-SPACE "357,041")) +(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR + 192) (ILEQ CHAR 207)))) +(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP ( +FGETLD LINE LHEIGHT) HEIGHT)))) (* ; "Formatting slots held by THISLINE") +(DATATYPE THISLINE ((* ;; +"Cache for line-related character location info, for selection and line-display code to use.") (DESC +FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ; +"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; +"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width." +) CHARSLOTS (* ; +"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT" +) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)") +CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT)) (BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS."))) (PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT))) (PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT))) @@ -224,9 +262,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) -(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR - 192) (ILEQ CHAR 207)))) -(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35")) +(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31")) (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)." @@ -243,37 +279,39 @@ PNEW FLAG) (* ; XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ; "High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ; "The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS (( -POBJ (IMAGEOBJP (PCONTENTS DATUM))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ +POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) ( +PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace ( +PIECE PLOOKS) of DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC) (DATATYPE TEXTOBJ ((* ;; "This is where TEdit stores its state information, and internal data about the text being edited.") -PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PANES (* ; -"A list of panes (subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC" +PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ; +"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC" ) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end") -NIL (* ; +CHARFN (* ; "Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#") HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ; "Was # of characters already in the piece.") INSERTSTRING (* ; "A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ; "Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece." -) (TXTLINELEADINGABOVE FLAG) (* ; -"NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL." -) \WINDOW (* ; "The window-pane where this textobj is displayed") MOUSEREGION (* ; -"Section of the window the mouse is in.") NIL (* ; +) (NIL FLAG) (* ; +" Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL." +) (TXTREADONLYQUIET FLAG) (* ; "T => don't print READONLY abort messages") PARABREAKCHARS (* ; +"Characters that cause a paragraph break.Was \WINDOW. The window-pane where this textobj is displayed. Now chained through PRIMARYPANE" +) MOUSEREGION (* ; "Section of the window the mouse is in.") LOOPFN (* ; "Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES." ) DS (* ; "NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed") -SEL (* ; "The current selection within the text") SCRATCHSEL (* ; -"Scratch space for the selection code") SCRATCHSEL2 (* ; -"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY") -NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ; -"Right edge of the window (or subregion) where this is displayed") WTOP (* ; +SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code" +) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ; +"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was DELETESEL: Text to be deleted imminently") +WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") WTOP (* ; "Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ; "Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG) (* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ; "-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ; -"T => The guy has asked the editor to go way") CARET (* ; -"Describes the flashing caret for the editing window") CARETLOOKS (* ; +"T => The guy has asked the editor to go way") NIL (* ; +"Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ; "Font to be used for inserted text.") WINDOWTITLE (* ; "Original title for this window, of there was one.") THISLINE (* ; "Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ; @@ -292,7 +330,8 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ; "The READTABLE to be used to decide on word breaks") EDITPROPS (* ; "The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ; "T if the next insertion in this document is to be preceded by a deletion of the then-current selection" -) TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ; +) (TXTHISTORYINACTIVE FLAG) (* ; "T if history events are not recorded (e.g. for transcript files)") +TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ; "The pane in which the last 'real' selection got made for this edit; used by TEDIT.NORMALIZECAREET") PROMPTWINDOW (* ; "A window to be used for unscheduled interactions; normally a small window above the edit window") @@ -302,7 +341,9 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL ) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.") TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique") TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") ( -TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ; +TXTAPPENDONLY FLAG) (* ; +"Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater" +) (TXTDON'TUPDATE FLAG) (* ; "T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW." ) TXTRAWINCLUDESTREAM (* ; "NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ; @@ -310,9 +351,8 @@ TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TU "Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ ( (\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM )) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create -SELECTION) SCRATCHSEL _ (create SELECTION) SCRATCHSEL2 _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0 -WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL MOUSEREGION _ (QUOTE TEXT) THISLINE _ ( -create THISLINE) MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL) +SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _ + (create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR))) (ACCESSFNS TEXTSTREAM ((* ;; "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;; "The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3) @@ -320,23 +360,25 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i (PIECE (fetch (STREAM F5) of DATUM) (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE)) (* ; "The PIECE we're currently fetching chars from/putting chars into") (PCCHARSLEFT (fetch (STREAM F1) of DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") ( -CURRENTLOOKS (fetch (STREAM F10) of DATUM) (replace (STREAM F10) of DATUM with NEWVALUE)) (* ; -"The CHARLOOKS that are currently applicable to characters being taken from the stream.") ( -CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with +NIL) (* ; +"Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ." +) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with NEWVALUE)) (* ; "The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone." -) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ; -"Function to be called at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM -F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? (AND (type? STREAM DATUM) (type? -TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create STREAM BINABLE _ NIL BOUTABLE _ NIL -ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 - _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL))) +) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ; +"Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting." +) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? +(AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create +STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ +\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS +IMAGEDATA _ NIL))) (PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC))) (PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC))) (PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC))) (PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC))) (PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC))) (PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC))) +(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS PC))) (PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC))) (PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC))) (PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC))) @@ -345,16 +387,16 @@ ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ (PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC))) (PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC))) (PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC))) +(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC))) (PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE))) (PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE) (freplace (PIECE FIELD) of PC with NEWVALUE))) (PUTPROPS GETPC MACRO ((PC FIELD) (fetch (PIECE FIELD) of PC))) (PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC))) (PUTPROPS THINPIECEP MACRO ((PC) (* ;; "Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care." -) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) (OBJECT.PTYPE -T) NIL))) -(PUTPROPS VISIBLEPIECEP MACRO ((PC) (NOT (OR (EQ 0 (PLEN PC)) (fetch (CHARLOOKS CLINVISIBLE) of ( -PLOOKS PC)))))) +) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL))) +(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC) +CLINVISIBLE))))) (PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat ( VISIBLEPIECEP NPC)))) (PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC) (find PPC backpieces (AND PC (PREVPIECE PC)) suchthat ( @@ -366,12 +408,18 @@ VISIBLEPIECEP PPC)))) (PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ))) (PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ))) (PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ)))) +(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR))) +(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE))) +(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) (ffetch (TEXTSTREAM FIELD) of TSTR))) +(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE))) +(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR +TSTR TEXTOBJ)) TSTR))) (RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) ( FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) ( UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) ( BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE -THINSTRING.PTYPE)))) +THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))) (RPAQQ THINFILE.PTYPE 0) (RPAQQ FATFILE1.PTYPE 1) (RPAQQ FATFILE2.PTYPE 2) @@ -388,14 +436,15 @@ UTF16LE.PTYPE)) (RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) +(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)) (CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) ( FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) ( UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) ( BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE -THINSTRING.PTYPE))) +THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))) (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV) -(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37")) +(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:17:20")) (RPAQQ NONE.TTC 0) (RPAQQ CHARDELETE.TTC 1) (RPAQQ WORDDELETE.TTC 2) @@ -414,10 +463,10 @@ THINSTRING.PTYPE))) (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)) -(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 (IEQP LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1) -)) (RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2))) (SHOULDNT)))) +(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)) +) (RIGHT (QUOTE (EQ LASTMOUSEBUTTONS 2))) (SHOULDNT)))) (PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for 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)))))) @@ -431,15 +480,16 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST ( (RPAQQ NEWCHAR-IF-SPLIT.LB 32) (CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16) (NEWCHAR-IF-SPLIT.LB 32)) -(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:16")) +(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "28-Nov-2024 10:03:03")) (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 "20-Mar-2024 11:06:52")) -(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42")) +(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 23:00:13")) +(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28")) (DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") -CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;; +(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ; +"The font descriptor for these characters") CLNAME (* ;; "Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT." ) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") ( CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; @@ -450,9 +500,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; "T if small caps, else NIL") (CLINVERTED FLAG) (* ; "T if the characters are to be shown white-on-black") (CLPROTECTED FLAG) (* ; "T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ; -"T if TEDIT is to ignore these chars; else NIL") (CLSELHERE FLAG) (* ;; -"T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED." -) (CLCANCOPY FLAG) (* ;; +"T if TEDIT is to ignore these chars; else NIL") (CLSELAFTER FLAG) (* ; +"T if TEDIT can put selection after this char (for menu fields).") (* ;; "Was CLSELHERE. ") (CLCANCOPY + FLAG) (* ;; "T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)" ) (CLUNBREAKABLE FLAG) (* ; "Spaces are treated as nonbreaking spaces") CLSTYLE (* ; "The style to be used in marking these characters; overridden by the other fields") CLUSERINFO (* ; @@ -461,7 +511,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; "For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs." ) (CLMARK FLAG) (* ;; "Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document" -)) CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)))) +) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields).")) +CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)))) (DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.") 1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ; "Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ; @@ -471,8 +522,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ; "Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented." ) FMTBASETOBASE (* ; "The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING") -TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ; -"How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ; +NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width") +QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ; "The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ; "The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)" ) FMTUSERINFO (* ; "Space for a PLIST of user info") FMTSPECIALX (* ; @@ -492,17 +543,28 @@ TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default t ) (FMTHARDCOPY FLAG) (* ; "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (* ; "T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output." -) FMTHARDCOPYSCALE) (* ; -"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)" -) (INIT (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 -LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL)) +) FMTHARDCOPYSCALE (* ; +"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T" +) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT ( +DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ +0) (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)) (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT)) (PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A )) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) ( \PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V))) (PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF))))) -(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29")) +(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE))) +(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F))) +(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F))) +(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE))) +(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL))) +(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE))) +(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL))) +(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE))) +(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC)))) +(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS)))) +(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46")) (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 @@ -513,64 +575,79 @@ the caret up during screen updates) TCCARETX (* X position in the window that th TCCARETY (* Y position in the window where the caret appears) TCCARET (* A lisp CARET to be flashed ( eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCCURSORBM _ BXCARET TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET)) -(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP -DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) ( -PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch ( -TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW -WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES -) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM ( -QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM -(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP -DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN)) - (LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV)))) -(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER)) - (ACCESSFNS (PWINDOW (PROGN DATUM)))) -(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P))) -(PUTPROPS GETPANE MACRO ((P FIELD) (fetch (PANE FIELD) of P))) -(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE))) -(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE))) -(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY)))) -(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27")) -(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ; -"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in") -MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ; -"Button's initial state.")) MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD))) -(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) MBBUTTONEVENTFN _ (QUOTE MB.DEFAULTBUTTON.FN) -MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD))) -(TYPERECORD MB.INSERT (MBINITENTRY)) -(TYPERECORD MB.MARGINBAR (ignoredfield)) -(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) MBFONT _ ( -FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD))) -(TYPERECORD MB.TEXT (MBSTRING MBFONT)) -(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) MBFONT _ (FONTCREATE (QUOTE -HELVETICA) 8 (QUOTE BOLD))) -(RECORD MBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) ( -QUOTE MB.DISPLAY)) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.THREESTATE.DISPLAY)) (EQ ( -IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY)))))) -(RECORD NWAYBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE - MB.NB.DISPLAYFN))))) -(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ ( -IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN))))) -(RECORD TAB (TABX . TABKIND)) -(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06")) -(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12")) -(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55")) -(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37")) +(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (PUTWINDOWPROP DATUM ( +QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) +of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) ( +CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE +TEDIT.CURSORREGION) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) ( +PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (PANEPROPS (GETWINDOWPROP DATUM (QUOTE PANEPROPS) +) (PUTWINDOWPROP DATUM (QUOTE PANEPROPS) NEWVALUE))) (TYPE? (AND (WINDOWP DATUM) (TYPENAMEP (fetch ( +TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ))))) +(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ; +"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ; +"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE +XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION)) +(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P))) +(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P))) +(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE))) +(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE))) +(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE))) +(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE)))) +(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE))) +(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE))) +(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET)))) +(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE))) +(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW +WTEXTSTREAM) of PANE))))) +(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE))) +(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO))) +(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))) +(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE)) +))) +(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))) +) +(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE +))))) +(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE +))))) +(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE)))) +(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. ( +OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR + (GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT))))) +(I.S.OPR (QUOTE backpanes) NIL (QUOTE (first (SETQ I.V. (OR (find P inpanes BODY suchthat (NULL ( +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 "13-Dec-2024 09:00:10")) +(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22")) +(RPAQQ PTSPERPICA 12) +(RPAQQ PTSPERINCH 72) +(RPAQQ PICASPERINCH 6) +(RPAQQ MICASPERINCH 2540) +(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54)) +(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) +(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH)) +(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 " 7-Dec-2024 21:21:48")) +(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12")) +(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32")) +(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23")) (DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* ; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?") THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ; "First piece involved") THOLDINFO (* ; "Old info, for undo") NIL (* ; "Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) (ACCESSFNS -TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT THCH#) of DATUM) (IPLUS (fetch ( -TEDITHISTORYEVENT THCH#) of DATUM) (fetch (TEDITHISTORYEVENT THLEN) of DATUM)))))) (INIT (DEFPRINT ( -QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT)) +TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (TEDITHISTORYEVENT THCH#) of DATUM) 0) (OR (fetch ( +TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION +\TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT)) (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT)) (PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) -(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) (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 "20-Mar-2024 11:05:20")) +(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55")) (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." @@ -601,9 +678,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R (PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS))) (PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE)) ) -(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40")) -(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40")) -(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18")) +(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 22:39:52")) +(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21")) +(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50")) (DECLARE%: DONTCOPY (FILEMAP (NIL))) STOP diff --git a/lispusers/DOC-OBJECTS b/lispusers/DOC-OBJECTS index 7bbf658a..6754b73b 100644 --- a/lispusers/DOC-OBJECTS +++ b/lispusers/DOC-OBJECTS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "27-Mar-2024 23:42:37" {WMEDLEY}DOC-OBJECTS.;36 52788 +(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}DOC-OBJECTS.;58 52672 :EDIT-BY rmk - :CHANGES-TO (FNS DOCOBJ-INCLUDE-EDIT-WINDOWP) + :CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX) - :PREVIOUS-DATE "19-Mar-2024 19:36:25" {WMEDLEY}DOC-OBJECTS.;35) + :PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}DOC-OBJECTS.;57) (PRETTYCOMPRINT DOC-OBJECTSCOMS) @@ -17,7 +17,7 @@ (* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.") (FILES (SYSLOAD) - TEDIT TEDIT IMAGEOBJ) + TEDIT IMAGEOBJ) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) (VARS (DocObjectsMenu NIL) (DocObjectsConfirmEditMenu NIL)) @@ -28,7 +28,7 @@ (FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE - DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN)) + DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN)) [COMS (* ;; "Eval'd Form") @@ -108,7 +108,7 @@ (FILESLOAD (SYSLOAD) - TEDIT TEDIT IMAGEOBJ) + TEDIT IMAGEOBJ) (DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD TEDIT-EXPORTS.ALL) @@ -167,44 +167,37 @@ (GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM]) (DOCOBJ-GET-LOOKS - [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 19-Mar-2024 19:36 by rmk") + [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 5-Apr-2024 12:20 by rmk") + (* ; "Edited 19-Mar-2024 19:36 by rmk") (* ; "Edited 29-Oct-2022 21:30 by rmk") (* Koomen " 4-Feb-87 23:37") (* ;;; "Adapted from {ERIS}TEDITLOOKS.;30 dated '15-Oct-85 16:51:10' to return looks itself, rather than a proplist.") (* jds "10-Jul-85 16:02") (* ; "Return a PLIST of character looks") - (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) - LOOKS FONT NLOOKS) - [COND - ((type? CHARLOOKS CH#ORCHARLOOKS) (* ; + (LET ((TEXTOBJ (TEXTOBJ TEXTOBJ))) + (if (type? CHARLOOKS CH#ORCHARLOOKS) + then (* ;  "He handed us a CHARLOOKS. Unparse it for him.") - (SETQ LOOKS CH#ORCHARLOOKS)) - ((ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) (* ; + CH#ORCHARLOOKS + elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then (* ;  "There's no text in the document. Use the extant caret looks.") - (SETQ LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))) - [(FIXP CH#ORCHARLOOKS) (* ; + (FGETTOBJ TEXTOBJ CARETLOOKS) + else (PLOOKS (\TEDIT.CHTOPC (if (FIXP CH#ORCHARLOOKS) + then (* ;  "He gave us a CH# to get the looks of. Grab it.") - (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN) - CH#ORCHARLOOKS) - TEXTOBJ] - [(type? SELECTION CH#ORCHARLOOKS) (* ; + CH#ORCHARLOOKS + elseif (type? SELECTION CH#ORCHARLOOKS) + then (* ;  "Get the looks of the selected text") - (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN) - (GETSEL CH#ORCHARLOOKS CH#)) - TEXTOBJ] - ((NULL CH#ORCHARLOOKS) (* ; + (GETSEL CH#ORCHARLOOKS CH#) + elseif (NULL CH#ORCHARLOOKS) + then (* ;  "Get the looks of the selected text") - (SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN) - (GETSEL (FGETTOBJ TEXTOBJ SEL) - CH#)) - TEXTOBJ] - (RETURN LOOKS) - -(* ;;; "Now break the looks apart into a PROPLIST") - - (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS)) - (RETURN NLOOKS]) + (GETSEL (FGETTOBJ TEXTOBJ SEL) + CH#)) + TEXTOBJ]) (DOCOBJ-REGISTER-OBJECT [LAMBDA (OBJECT) (* ; "Edited 23-Oct-87 14:48 by Koomen") @@ -218,8 +211,9 @@ OBJECT]) (DOCOBJ-STRING-IMAGEBOX - [LAMBDA (STRING IMAGESTREAM) (* Koomen " 9-Feb-87 17:22") - (DECLARE (SPECVARS CHNO TEXTOBJ)) + [LAMBDA (STRING IMAGESTREAM) (* ; "Edited 9-Dec-2024 21:04 by rmk") + (* Koomen " 9-Feb-87 17:22") + (DECLARE (USEDFREE CHNO TEXTOBJ)) (PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT) (SETQ LOOKS (DOCOBJ-GET-LOOKS TEXTOBJ CHNO)) (SETQ CLOFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS)) @@ -230,10 +224,10 @@ (SETQ HEIGHT (FONTHEIGHT FONT)) (SETQ DESCENT (FONTPROP FONT 'DESCENT)) (RETURN (create IMAGEBOX - XSIZE _ (STRINGWIDTH STRING FONT) - YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET)) - YDESC _ (IDIFFERENCE DESCENT CLOFFSET) - XKERN _ 0]) + XSIZE _ (STRINGWIDTH STRING FONT) + YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET)) + YDESC _ (IDIFFERENCE DESCENT CLOFFSET) + XKERN _ 0]) (DOCOBJ-WAIT-MOUSE [LAMBDA (STREAM) (* ; @@ -245,108 +239,104 @@ (LASTMOUSEY STREAM))) then (RETURN NIL)) finally (RETURN T]) -(DOCOBJ-INVOKE-IMAGEOBJFN - [LAMBDA (CH# PIECE IMAGEOBJFNNAME) (* ; "Edited 28-Jun-2023 19:45 by rmk") - (* ; "Edited 9-Sep-2022 16:10 by rmk") - (* ; "Edited 7-Sep-2022 23:11 by rmk") - (* ; "Edited 6-Sep-2022 10:05 by rmk") - (* ; "Edited 15-Oct-87 23:35 by Koomen") - - (* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ") - - (CL:WHEN (AND (type? PIECE PIECE) - (EQ OBJECT.PTYPE (PTYPE PIECE))) - (LET ((IMAGEOBJ (PCONTENTS PIECE)) - IMAGEOBJFN) - (SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME)) - (CL:WHEN (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN)) - (APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE))))]) - (DOCOBJ-BEFOREHARDCOPYFN - [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 16-Mar-2024 10:05 by rmk") + [LAMBDA (TEXTSTREAM) (* ; "Edited 8-Dec-2024 15:48 by rmk") + (* ; "Edited 12-Jul-2024 12:46 by rmk") + (* ; "Edited 7-Jul-2024 00:09 by rmk") + (* ; "Edited 8-May-2024 00:05 by rmk") + (* ; "Edited 6-May-2024 22:50 by rmk") + (* ; "Edited 5-Apr-2024 08:03 by rmk") + (* ; "Edited 16-Mar-2024 10:05 by rmk") (* ; "Edited 16-Jul-2023 16:53 by rmk") (* ; "Edited 10-Jul-2023 22:29 by rmk") (* ;  "Edited 25-May-93 13:07 by sybalsky:mv:envos") - (* ;; "This is the only BEFOREHARDCOPYFN, provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and the piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.") + (* ;; "This is the only BEFOREHARDCOPYFN provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and te piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.") + + (* ;; "This runs through the file applying the BEFOREHARDCOPYFN of every object that has one. For example, an include object will replace the object by its target file.") + + (* ;; "This records all of the history events created during the object pass into a single composite even so that the DOCOBJ-AFTERHARDCOPYFN can restore the stream to its original state.") (RESETLST (* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces. ") - (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T) - `(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE)) - (LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY)) - (OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY)) - (PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ))) - FAILED) + (TEDIT.DEFER.UPDATES TEXTSTREAM) + (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) + (OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY)) + (PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ))) + FAILED EVENTS) - (* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.") + (* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.") - [bind OBJ FN PREVPC (CH# _ 1) - (PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC - do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC)) - (SETQ OBJ (PCONTENTS PC)) - (SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN)) - (DEFINEDP FN)) - then (SETQ PREVPC (PREVPIECE PC)) - (CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#) - (SETQ FAILED T) - (RETURN)) - (if PREVPC - then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC)) - then - (* ;; + [bind OBJ FN PREVPC (CH# _ 1) + (PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC + do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC)) + (SETQ OBJ (PCONTENTS PC)) + (SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN)) + (DEFINEDP FN)) + then (SETQ PREVPC (PREVPIECE PC)) + (CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#) + (SETQ FAILED T) + (RETURN)) + (push EVENTS (\TEDIT.POPEVENT TEXTOBJ)) + (* ; "Accumulate undo events") + (if PREVPC + then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC)) + then + (* ;;  "Nothing affected this PC, advance") - (add CH# (PLEN PC)) - PC - else - (* ;; + (add CH# (PLEN PC)) + PC + else + (* ;;  "Otherwise investigate its replacement") - PREVPC)) - elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ)) - then (add CH# (PLEN PC)) - (NEXTPIECE PC) - else - (* ;; + PREVPC)) + elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ)) + then (add CH# (PLEN PC)) + (NEXTPIECE PC) + else + (* ;;  "Investigate the replacement of the previous first piece.") - (\TEDIT.FIRSTPIECE TEXTOBJ)) - else (add CH# (PLEN PC)) - (NEXTPIECE PC] (* ; "Restore previous settings") + (\TEDIT.FIRSTPIECE TEXTOBJ)) + else (add CH# (PLEN PC)) + (NEXTPIECE PC] (* ; "Restore previous settings") (* ;  "The history event may restore SEL, but...") - (SETTOBJ TEXTOBJ \DIRTY OLDDIRTY) + (SETTOBJ TEXTOBJ \DIRTY OLDDIRTY) - (* ;; "Make a single undoing event for the after fn") + (* ;; "Make a single event for the afterfn to undo") - (for ETAIL on (GETTOBJ TEXTOBJ TXTHISTORY) until (EQ ETAIL PREVEVENTS) - collect (CAR ETAIL) finally (SETTOBJ TEXTOBJ TXTHISTORY (CONS $$VAL PREVEVENTS))) - - (* ;; "In case something screws up, at least redisplaying will show something correctly (even if we aren't \DIRTY)") - - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ)) - (CL:WHEN FAILED - (DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM TEXTOBJ) (* ; "UNDO whatever was saved") - (SETTOBJ TEXTOBJ SEL PREVSEL) - 'DON'T)))]) + (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS) + (CL:WHEN FAILED + (DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM) (* ; "UNDO whatever was saved") + (SETTOBJ TEXTOBJ SEL PREVSEL) + 'DON'T)))]) (DOCOBJ-AFTERHARDCOPYFN - [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 15-Mar-2024 14:24 by rmk") + [LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2024 00:07 by rmk") + (* ; "Edited 5-Jul-2024 22:59 by rmk") + (* ; "Edited 3-Jul-2024 09:55 by rmk") + (* ; "Edited 8-May-2024 10:42 by rmk") + (* ; "Edited 7-May-2024 08:20 by rmk") + (* ; "Edited 5-Apr-2024 08:05 by rmk") + (* ; "Edited 15-Mar-2024 14:24 by rmk") (* ; "Edited 15-Jul-2023 15:57 by rmk") (* ;  "Edited 25-May-93 13:08 by sybalsky:mv:envos") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (RESETLST - (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T) - `(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE)) - (LET ((PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE))) - (TEDIT.UNDO TEXTOBJ) - (SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ)) - (\TEDIT.UPDATE.SCREEN TEXTOBJ)))]) + [RESETSAVE (TEXTPROP TSTREAM 'DON'TUPDATE T) + `(PROGN (TEXTPROP ,TSTREAM 'DON'TUPDATE OLDVALUE) + (\TEDIT.FILL.PANES ,TSTREAM] + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE))) + (TEDIT.UNDO TSTREAM T) + (SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)))]) ) @@ -750,11 +740,10 @@ IMAGEOBJ]) (DOCOBJ-INCLUDE-EDIT - [LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:") - (* ; "Edited 9-May-2018 10:35 by rmk:") - (* ; - "Edited 26-Oct-87 19:57 by Koomen") - (DECLARE (SPECVARS TEXTOBJ)) + [LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 12-May-2024 09:03 by rmk") + (* ; "Edited 9-May-2018 11:09 by rmk:") + (* ; "Edited 9-May-2018 10:35 by rmk:") + (* ; "Edited 26-Oct-87 19:57 by Koomen") (SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU (create MENU TITLE _ "Edit Include" @@ -771,41 +760,38 @@ CENTERFLG _ T MENUOFFSET _ '(-1 . 30) CHANGEOFFSETFLG _ 'Y] - (NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch - (INCLOBJ FILENAME) + (NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TSTREAM "Enter new file name: " (fetch (INCLOBJ + FILENAME) of INCLOBJ] (if [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME)) - (NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ] + (NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ] then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME) - T))) + T))) (EDIT.FILE (for W in (OPENWINDOWS) - bind [FULLNAME _ (OR [FINDFILE (fetch (INCLOBJ FILENAME) of INCLOBJ - ) - T - (CONS (PACKFILENAME.STRING 'HOST - (FILENAMEFIELD (FETCH TXTFILE - OF TEXTOBJ) - 'HOST) - 'DIRECTORY - (FILENAMEFIELD (FETCH TXTFILE - OF TEXTOBJ) - 'DIRECTORY] - (INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ] + bind [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS + (fetch (INCLOBJ FILENAME) of INCLOBJ) + (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD + TXTFILE + 'HOST) + 'DIRECTORY + (FILENAMEFIELD TXTFILE 'DIRECTORY)) + DIRECTORIES) + *TEDIT-EXTENSIONS*) + (INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ] first (if (NULL FULLNAME) - then (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T) - (TEDIT.PROMPTPRINT TEXTOBJ (fetch (INCLOBJ FILENAME) - of INCLOBJ)) - (RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP - FULLNAME W)) + then (TEDIT.PROMPTPRINT TSTREAM "Can't find " T) + (TEDIT.PROMPTPRINT TSTREAM (fetch (INCLOBJ FILENAME) + of INCLOBJ)) + (RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W)) do (TOTOPW W) - (GIVE.TTY.PROCESS W) - (RETURN) finally (TEDIT (MKATOM FULLNAME)))) + (GIVE.TTY.PROCESS W) + (RETURN) finally (TEDIT (MKATOM FULLNAME)))) (ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ)) then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T) - T)) + T)) (DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ) then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL) - T)) + T)) NIL]) (DOCOBJ-INCLUDE-EDIT-WINDOWP @@ -842,56 +828,51 @@ (DEFINEQ (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN - [LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 16-Feb-2024 23:47 by rmk") + [LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 13-Sep-2024 15:13 by rmk") + (* ; "Edited 12-May-2024 08:48 by rmk") + (* ; "Edited 7-May-2024 23:33 by rmk") + (* ; "Edited 16-Feb-2024 23:47 by rmk") (* ; "Edited 23-Jul-2023 22:45 by rmk") (* ; "Edited 16-Jul-2023 11:14 by rmk") (* ; "Edited 10-Jul-2023 22:18 by rmk") (* ; "Edited 22-Jun-2023 16:44 by rmk") - (* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the lookos of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.'") + (* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the looks of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.") (* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.") (* ;; "Not sure why the INCLUDEDP property. If enabled, it's included.") - (if (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM)) - then (LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM] - (TXTFILE (GETTOBJ TEXTOBJ TXTFILE)) - INCLSTREAM) - [SETQ INCLFILE (FINDFILE INCLFILE T (AND TXTFILE (CONS (PACKFILENAME.STRING - 'HOST - (FILENAMEFIELD TXTFILE - 'HOST) - 'DIRECTORY - (FILENAMEFIELD TXTFILE - 'DIRECTORY)) - DIRECTORIES] - (if INCLFILE - then - (* ;; "No point in prompting: it just flashes by") + (CL:WHEN (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM)) + (LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM] + (TXTFILE (GETTOBJ TEXTOBJ TXTFILE))) + (SETQ INCLFILE (FINDFILE-WITH-EXTENSIONS INCLFILE + (AND TXTFILE (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD + TXTFILE + 'HOST) + 'DIRECTORY + (FILENAMEFIELD TXTFILE 'DIRECTORY)) + DIRECTORIES)) + *TEDIT-EXTENSIONS*)) + (if INCLFILE + then (* ; "Don't update/show until end") + (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) + CH# 1 'LEFT) (* ; "Deletes this include-object") + (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)) + (TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included " INCLFILE)) - (AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE "...") - T)) - (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ) - CH# 1 'LEFT T) (* ; "Set the destination") - (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ) - T) - (TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE) - (AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE - "...done"))) - else - (* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.") + (* ;; "Succeeded as intended") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME - ) - of OBJ) - " not found") - T T) - NIL)) - else - (* ;; "Succeeded as intended") + T + else + (* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.") - T]) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME) + of OBJ) + " not found") + T T) + NIL)))]) (DOCOBJ-INCLUDE-CLEANUPFN [LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; "Edited 15-Mar-2024 14:08 by rmk") @@ -919,12 +900,13 @@ (DOCOBJ-INCLUDE-BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) + (* ; "Edited 12-May-2024 09:01 by rmk") (* ; "Edited 23-Oct-87 00:46 by Koomen") - (if (AND (EQ BUTTON 'MIDDLE) (DOCOBJ-WAIT-MOUSE WINDOWSTREAM)) then (ALLOW.BUTTON.EVENTS) - (if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) + (if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM) + HOSTSTREAM) then (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ) 'CHANGED]) @@ -1011,30 +993,29 @@ (PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7682 21029 (DOCOBJ-ACQUIRE-OBJECT 7692 . 8693) (DOCOBJ-INIT 8695 . 9323) ( -DOCOBJ-TEDIT-MENU-ENTRY 9325 . 9747) (DOCOBJ-GET-LOOKS 9749 . 12364) (DOCOBJ-REGISTER-OBJECT 12366 . -13020) (DOCOBJ-STRING-IMAGEBOX 13022 . 13970) (DOCOBJ-WAIT-MOUSE 13972 . 14432) ( -DOCOBJ-INVOKE-IMAGEOBJFN 14434 . 15557) (DOCOBJ-BEFOREHARDCOPYFN 15559 . 20205) ( -DOCOBJ-AFTERHARDCOPYFN 20207 . 21027)) (21059 21326 (DOCOBJ-ACQUIRE-EVALED-OBJECT 21069 . 21324)) ( -21526 21668 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21536 . 21666)) (22007 26803 (DOCOBJ-EDIT-TIMESTAMP 22017 - . 22546) (DOCOBJ-MAKE-TIMESTAMP 22548 . 22959) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22961 . 24031) ( -DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24033 . 24564) (DOCOBJ-TIMESTAMP-COPYFN 24566 . 24891) ( -DOCOBJ-TIMESTAMP-DISPLAYFN 24893 . 25186) (DOCOBJ-TIMESTAMP-GETFN 25188 . 25428) ( -DOCOBJ-TIMESTAMP-IMAGEBOXFN 25430 . 25786) (DOCOBJ-TIMESTAMP-PREPRINTFN 25788 . 26019) ( -DOCOBJ-TIMESTAMP-PUTFN 26021 . 26390) (DOCOBJ-TIMESTAMP-TO-STRING 26392 . 26801)) (27097 31404 ( -DOCOBJ-MAKE-FILESTAMP 27107 . 27448) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27450 . 28492) ( -DOCOBJ-FILESTAMP-COPYFN 28494 . 28809) (DOCOBJ-FILESTAMP-DISPLAYFN 28811 . 29099) ( -DOCOBJ-FILESTAMP-GETFN 29101 . 29454) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29456 . 29794) ( -DOCOBJ-FILESTAMP-GET-FULLNAME 29796 . 30414) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30416 . 30889) ( -DOCOBJ-FILESTAMP-PREPRINTFN 30891 . 31100) (DOCOBJ-FILESTAMP-PUTFN 31102 . 31402)) (31727 34224 ( -DOCOBJ-MAKE-HRULE 31737 . 32151) (DOCOBJ-EDIT-HRULE 32153 . 32625) (DOCOBJ-HRULE-INIT 32627 . 32959) ( -DOCOBJ-HRULE-GET-WIDTH 32961 . 33772) (DOCOBJ-HRULE-BUTTONEVENTINFN 33774 . 34222)) (34643 43315 ( -DOCOBJ-MAKE-INCLUDE 34653 . 35054) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35056 . 36061) ( -DOCOBJ-INCLUDE-CREATE-OBJ 36063 . 36831) (DOCOBJ-INCLUDE-EDIT 36833 . 41432) ( -DOCOBJ-INCLUDE-EDIT-WINDOWP 41434 . 42290) (DOCOBJ-INCLUDE-RESET-OBJ 42292 . 43313)) (43316 52247 ( -DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43326 . 47048) (DOCOBJ-INCLUDE-CLEANUPFN 47050 . 48569) ( -DOCOBJ-INCLUDE-BUTTONEVENTINFN 48571 . 49105) (DOCOBJ-INCLUDE-COPYFN 49107 . 49325) ( -DOCOBJ-INCLUDE-DISPLAYFN 49327 . 50079) (DOCOBJ-INCLUDE-GETFN 50081 . 50804) ( -DOCOBJ-INCLUDE-IMAGEBOXFN 50806 . 51815) (DOCOBJ-INCLUDE-PREPRINTFN 51817 . 52036) ( -DOCOBJ-INCLUDE-PUTFN 52038 . 52245))))) + (FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) ( +DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 . +12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) ( +DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 ( +DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965 +)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) ( +DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) ( +DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) ( +DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) ( +DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) ( +DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) ( +DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) ( +DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) ( +DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) ( +DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) ( +DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) ( +DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 . +34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353) +(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) ( +DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) ( +DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789) +(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) ( +DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN +49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) ( +DOCOBJ-INCLUDE-PUTFN 51922 . 52129))))) STOP diff --git a/lispusers/DOC-OBJECTS.LCOM b/lispusers/DOC-OBJECTS.LCOM index 7cf44377e72e6cd20177dd7674621bceda7b6c87..ff23b3dda617c65e4caff1fae6c8826f01d4c9d5 100644 GIT binary patch delta 2701 zcmZ`*-EZ606(=Rzag@|nJSTA!7d=th#Li-s-=u_K6(dn16N%(V%Cb9SSrU1*<4hTb zWPNA>1;c=?*f1o$81}Fg1-7>W9URM98?37e6a%VsK=-geVXwnfY!CZ**v`F_KhkA_ zAf9{fxgY2Je&h%RlkQ9)_f}j^f`TmBSQH^;>WuKT83W8Qp z_51J7k{@K!Ut4cOw$iB8V1H09m&-!y>h0CmQ&#H*LCVgj<|QI?UrqFl+2Jii2Z`<2SeR^a)dLS&s@ zioA=LFm+vl(8BB^$8$l+?;mt$#(q6Qeso9|^FR~DU3@U0;^IRGT#io-m{*08eHw=f zSc{e$h2(FC<_|;`JA`~YJ=+oR%%v!du*mg!;Qo^0Ilei~G8sOw3ijjk+>OE7;E^4t zl!?o8YGlKXE$N`!g)ccfaf3G>aBtWS%erSfTd!_x-fn|OuR zq{Cvaq#sVy-Tv60e&_bbzrOiiT*$w={nVAIp6yMz^_wGJdUE1d>%ZOnMSNr}^MN<@ zbJv^dj}N-P_og;KapQ?W_r2KIeE-I0=eeF;V@F)xK0eGR&f(H@hF;(RhnPr`KzRFj z2Wc(rpkq5>9meH>(x`=2Q3+x<>qoqt_HlfEAW1Za!49H8{&V12(m6Cs1U*HfNrBv(JjL_m)Kr!Hb8=%wWUOkq zxYR=K#1z4EkT54Z5)9b_6_6ox3Wall6=k+rxSafPrbdxfsma=z(WA>?~9v$%QO zF{}nPC-j#nUoiPIN$j6kJ+5(B(C0uFS&>+c8gA2Z%Yay{)E99X;v!P!9XAC*5Ly54 z_F`&I)Vg=4MxH$(?w;l#7LHr0QOql#k+)u)Igf@8(NaXE5^V#{F)l1%%9b0Vcu-LI zm9Zq3SR}m{mpg}9p<4`r!Isc789+szfpLUSTx$LD0rxW&^fEPnT;%_b{rvsnrJ42g za2dLP+8d|n6?wK%Gj3-F*#9^V)4*@gpG-5IW#>FRSma~Cr$%et6Y(8lKJ-lTk#IdL zs8Dqlty~l>=MaXH6^0k)o6Wugj@vdzcL*yG@Z!aS0|7JgY?8>9YMyJn&p~x>{Y8)#tzrM=+RJUeT(7g zHAB|f^~*>K$E{*#<26}BR;|c!{YC_N73!ATKq|>p1Dw#jh;Yf+!*~oeB{a)UfO_xM z0|$91Vy;6+u#6*d|Hu%*_K-dzCLbHB2JA#e0};vOTFo3Ckl!TE;08LpK9ZzYh?afp z^y`$<61GgXbhUl*q&B@gtY$pmkc$9k?4 zFj6eFwk{TjZ`kgQC6G3ZEIJbSg6H#&1_Px1Nq&CeLQruInwf$r`E$ zRq7ZRWK`Wpv2a{0qVbXdCC@FHXlqnBsFpqvfjYAjpitSR0kjbtWt4weB0n_F%qst% zSO)n}JodbG#xNqMsJ6?jFI_GC>&Uev4#-b~ojF-&8J8k8zJWfY?h0s$(nilg;*2z(5^68wx5Y5k@*n^MJJ!y>vm6_RX3?(%QIt-KlrF8_Dp6ro*Bn8j+?R&(w#uO z30|nS;-!)$K%x>ag!{llt5Tpvq7qUz&LY13zyoqYMF{=?g!%-Cx>9+7mvZhMe}rro z`(f@q_uPBW`JLZ6=f3r0{&&axx0(xLE@|$*kQCEm21Kct5sOmp=s=1|@(P3!=T-%( zaP-qSdBb|-)2%inv_`cGXO&W^R06!+JA2+o@0JrQp=Hges^z+>xM~H?U%?C@&+tpL zk_=ffm(P=1{58CAVPyr1wYs`x*bOIH!Of5m3KQdnLQ#^7Vm1LGqVP`!q-^&e{JVj; z1Xk6yHyo&e2%2rVI1s=Wk$0w&otGctxIpOwhrj6VjPe^gI8q{dKXBvLpnI)49lZCL z;z@7^f94jl`E4ZrnW5e}d zd)E6$ot`yTFe2QtAQs>TB4fCzvhLcoG8A&>1acZ~XwRv2yM_pzTg!s0KI__R*AZty z$bh3F)~;b&kQdKPa>8iR{o(YRQys(FvNzPEVJhn?Zq_U)R`Q``3e_1|4btN&7>MU& z%~DJiMFP|ewM<88DCDM(M(EA> z+pFBI!Tw+*iTS*|6g+6g{h>H(c9$+0W6i<0?{Z&l#tnvK4+kghgX2Tf2l`~u>~o)e z&0?1_jh*nlaMkS3{P~w=fA%xSKfyyg9Cz}b*$?eRaJywz52x(##qbYWzc_xyj=W;p zk^bzU`;Hws{-ZfGV$elRX3lZ%)*n_moDCg_Ds%SyPAvExJLc(wlfr1lUeIF;`lV(Z z{pbgn_Zz3NCN$$AdOrfh4!FJ$W2Q#vaY&@ zRcp9Vkik@~22J1$CYs?WYiNQb3V?Uhp(tPtG3wZY?K+kp%yJg&4n|%mV0#-c3Hbu( zw&NntC^D>tgOHPl!fXy01k6PtErO*sQ*45mVUtuERhL?#qhDA95wdc%?xP5q9BgAd zd}%63HQeo*y0rEZnvBS%AyM9KU%LaJZ?!#0U_lTep|1i+q?(br|!W^-eOwrC9lZ9nhMaW{mdy9WkGWC4Jv>{FVJk ziRFsIvkyC`<@tP$wCGz4pF#IiOOWwtU|VGcgOSNV)Ylj~LMcK1EN5Rg^V>%eB18CZW9W=;es${c1DKbOG zNRxskisYZUD+z1`325KOu-<;L?O|B)nV2xzHxFO*@L^7)+I=S92z*jT{ASm~49x+) z&RA-nUiAybBuKt^&VM5_F=Ce?|6YA8Amzz>MVA-IcOO~pe(B@#1@d~ud?>V~)E!vv feo%RypTGZUNo>uW4r!JH-S25X3w7Pit?B;)<9rG* diff --git a/lispusers/EQUATIONS b/lispusers/EQUATIONS index 6b8f3160..da184426 100644 --- a/lispusers/EQUATIONS +++ b/lispusers/EQUATIONS @@ -1,24 +1,22 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED " 3-Mar-88 13:51:10" {ERINYES}LYRIC>EQUATIONS.;1 86057 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS EQIO.Put EQIO.Get) +(FILECREATED "28-Jun-2024 22:11:21" {WMEDLEY}EQUATIONS.;2 85831 - previous date%: "27-May-87 11:20:49" |{IE:PARC:XEROX}LYRIC>LISPUSERS>EQUATIONS.;1|) + :EDIT-BY rmk + :CHANGES-TO (FNS EQN.WindowFromText) + + :PREVIOUS-DATE " 3-Mar-88 13:51:10" {WMEDLEY}EQUATIONS.;1) -(* " -Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. -") (PRETTYCOMPRINT EQUATIONSCOMS) -(RPAQQ EQUATIONSCOMS +(RPAQQ EQUATIONSCOMS ( (* ;;; "EQUATION module: Part 1 of 3") (* ; "functions for image object") - (FNS EQIO.CreateFns EQIO.Create EQIO.Imagebox EQIO.Display EQIO.ButtonEventIn EQIO.Copy EQIO.CopyList EQIO.Get EQIO.Put EQIO.WhenDeleted EQIO.SelectRegion EQIO.Selection EQIO.DefaultSelectFn EQIO.MakeSelectionMenu) @@ -32,7 +30,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (* ;;; "functions to handle equation specification info") - (FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined + (FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined EQIO.GetBox EQIO.GetDataSpec EQIO.GetDataSpecList EQIO.GetDataPosition EQIO.GetDataSelectRegion EQIO.MakeSpec EQIO.MakeDataSpec) @@ -46,7 +44,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. [P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation] (P (* ;  "needed to force the getfn to be recognized before any new eqns defined") - (SETQ EquationImageFns (EQIO.CreateFns))) (VARS UnknownEquationData) (PROP ARGNAMES EQIO.TypeProp EQIO.NumPieces EQIO.AllProps EQIO.EqnProperty) @@ -61,7 +58,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (* ;;; "EQUATIONEDIT module: Part 2 of 3") (* ; "functions to edit data pieces") - (FNS EQN.AbortEdit EQN.StopEdit EQN.ContinueEdit EQN.FinishEdit EQN.MakeEditWindow EQN.SetUpEdit EQN.StartEdit EQN.StartNextEdit EQN.UpdateEdit EQN.DefaultData EQN.TypeMenu) @@ -69,7 +65,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (* ;;; "hooks to control behavior of equation subeditor") - (FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn + (FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn EQN.TEditSpecialChar EQN.SnuggleWindows EQN.SnuggleMainWindow) @@ -680,25 +676,27 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (RPAQ? EquationInfo NIL) (RPAQ? EquationDefaultSelectFn 'EQIO.DefaultSelectFn) + [TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation] + (* ;  "needed to force the getfn to be recognized before any new eqns defined") -(SETQ EquationImageFns (EQIO.CreateFns)) +(SETQ EquationImageFns (EQIO.CreateFns)) (RPAQQ UnknownEquationData (((Gacha 10) "[unknown equation]"))) -(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue}) +(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue}) args)) -(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue}) +(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue}) args)) -(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue}) +(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue}) args)) -(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue}) +(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue}) args)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -1316,13 +1314,12 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (EQN.ResultWindow window]) (EQN.WindowFromText - [LAMBDA (textObjORStream) (* thh%: "28-Jun-85 14:32") - (* gets window corresponding to a text - object or stream) - - (* note%: \WINDOW field actually is a list whose only element is the window) + [LAMBDA (textObjORStream) (* ; "Edited 28-Jun-2024 22:11 by rmk") + (* thh%: "28-Jun-85 14:32") - (LET [(w (fetch \WINDOW of (TEXTOBJ textObjORStream] + (* ;; "gets window corresponding to a text object or stream") + + (LET [(w (\TEDIT.PRIMARYPANE (TEXTOBJ textObjORStream] (OR (WINDOWP w) (WINDOWP (CAR w)) (ERROR "EQN.WindowFromText: unable to find window for textobj/stream = " textObjORStream @@ -1477,22 +1474,22 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. ) (TimesRoman 12) NIL)))) -(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow}) +(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow}) args)) -(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg}) +(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg}) args)) -(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber}) +(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber}) args)) -(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj}) +(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj}) args)) -(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow}) +(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow}) args)) -(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow}) +(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow}) args)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS @@ -1797,37 +1794,37 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved. (* ;;; "Now load EQUATIONFORMS") + (FILESLOAD EQUATIONFORMS) -(PUTPROPS EQUATIONS COPYRIGHT ("Xerox Corporation" 1986 1987 1988)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4524 19553 (EQIO.CreateFns 4534 . 5067) (EQIO.Create 5069 . 6335) (EQIO.Imagebox 6337 - . 6749) (EQIO.Display 6751 . 8362) (EQIO.ButtonEventIn 8364 . 12205) (EQIO.Copy 12207 . 12588) ( -EQIO.CopyList 12590 . 13161) (EQIO.Get 13163 . 13571) (EQIO.Put 13573 . 14128) (EQIO.WhenDeleted 14130 - . 14624) (EQIO.SelectRegion 14626 . 15773) (EQIO.Selection 15775 . 17279) (EQIO.DefaultSelectFn 17281 - . 18519) (EQIO.MakeSelectionMenu 18521 . 19551)) (19627 25629 (EQIO.EqnType 19637 . 19888) ( -EQIO.EqnDataList 19890 . 20230) (EQIO.SetDataList 20232 . 20629) (EQIO.EqnData 20631 . 20810) ( -EQIO.EqnProperty 20812 . 21740) (EQIO.AllProps 21742 . 22257) (EQIO.Specify 22259 . 22756) ( -EQIO.GetInitialProps 22758 . 23890) (EQIO.NumPieces 23892 . 25135) (EQIO.NewStructure 25137 . 25627)) -(25696 30158 (EQIO.AddType 25706 . 26219) (EQIO.GetInfo 26221 . 26571) (EQIO.SetInfo 26573 . 27214) ( -EQIO.TypeProp 27216 . 28162) (EQIO.ResetTypeProps 28164 . 28486) (EQIO.IsDefined 28488 . 28773) ( -EQIO.GetBox 28775 . 28995) (EQIO.GetDataSpec 28997 . 29330) (EQIO.GetDataSpecList 29332 . 29477) ( -EQIO.GetDataPosition 29479 . 29619) (EQIO.GetDataSelectRegion 29621 . 29765) (EQIO.MakeSpec 29767 . -30003) (EQIO.MakeDataSpec 30005 . 30156)) (31711 48815 (EQN.AbortEdit 31721 . 32233) (EQN.StopEdit -32235 . 32682) (EQN.ContinueEdit 32684 . 36336) (EQN.FinishEdit 36338 . 37071) (EQN.MakeEditWindow -37073 . 38492) (EQN.SetUpEdit 38494 . 39671) (EQN.StartEdit 39673 . 42974) (EQN.StartNextEdit 42976 . -43493) (EQN.UpdateEdit 43495 . 44892) (EQN.DefaultData 44894 . 47579) (EQN.TypeMenu 47581 . 48813)) ( -48882 56790 (EQN.Equation 48892 . 50151) (EQN.NextPiece 50153 . 50878) (EQN.FinishEqn 50880 . 51409) ( -EQN.NoUpdateAbort 51411 . 51824) (EQN.PreventUpdate 51826 . 52261) (EQN.CharFn 52263 . 54348) ( -EQN.TEditSpecialChar 54350 . 55069) (EQN.SnuggleWindows 55071 . 55662) (EQN.SnuggleMainWindow 55664 . -56788)) (56844 58583 (EQN.EquationFontNumber 56854 . 57613) (EQN.EquationFont 57615 . 57957) ( -EQN.GetEqnFont 57959 . 58140) (EQN.MakeFS 58142 . 58581)) (58612 61753 (EQN.AdjustWindow 58622 . 60582 -) (EQN.CheckWindowSize 60584 . 61751)) (61754 67638 (EQN.SubEditorP 61764 . 61997) (EQN.WindowFromText - 61999 . 62656) (EQN.EditWindow 62658 . 63736) (EQN.ResultWindow 63738 . 64288) (EQN.ResultObj 64290 - . 64758) (EQN.PieceNumber 64760 . 65309) (EQN.ContinueFlg 65311 . 65874) (EQN.ValidEditWindow 65876 - . 66310) (EQN.ObjEditWindow 66312 . 67636)) (67639 68756 (EQN.Make 67649 . 68754)) (69964 85899 ( -FS.Box 69974 . 72220) (FS.Copy 72222 . 72862) (FS.Display 72864 . 75850) (FS.Get 75852 . 76321) ( -FS.Put 76323 . 76794) (FS.ItemFont 76796 . 77157) (FS.ItemValue 77159 . 77565) (FS.ItemShift 77567 . -77947) (FS.MakeItem 77949 . 78371) (FS.Extract 78373 . 82297) (FS.ExtractFont 82299 . 82902) ( -FS.ExtractShift 82904 . 83467) (FS.Insert 83469 . 85458) (FS.AllowedChar 85460 . 85697) ( -FS.RealStringP 85699 . 85897))))) + (FILEMAP (NIL (4439 19468 (EQIO.CreateFns 4449 . 4982) (EQIO.Create 4984 . 6250) (EQIO.Imagebox 6252 + . 6664) (EQIO.Display 6666 . 8277) (EQIO.ButtonEventIn 8279 . 12120) (EQIO.Copy 12122 . 12503) ( +EQIO.CopyList 12505 . 13076) (EQIO.Get 13078 . 13486) (EQIO.Put 13488 . 14043) (EQIO.WhenDeleted 14045 + . 14539) (EQIO.SelectRegion 14541 . 15688) (EQIO.Selection 15690 . 17194) (EQIO.DefaultSelectFn 17196 + . 18434) (EQIO.MakeSelectionMenu 18436 . 19466)) (19542 25544 (EQIO.EqnType 19552 . 19803) ( +EQIO.EqnDataList 19805 . 20145) (EQIO.SetDataList 20147 . 20544) (EQIO.EqnData 20546 . 20725) ( +EQIO.EqnProperty 20727 . 21655) (EQIO.AllProps 21657 . 22172) (EQIO.Specify 22174 . 22671) ( +EQIO.GetInitialProps 22673 . 23805) (EQIO.NumPieces 23807 . 25050) (EQIO.NewStructure 25052 . 25542)) +(25611 30073 (EQIO.AddType 25621 . 26134) (EQIO.GetInfo 26136 . 26486) (EQIO.SetInfo 26488 . 27129) ( +EQIO.TypeProp 27131 . 28077) (EQIO.ResetTypeProps 28079 . 28401) (EQIO.IsDefined 28403 . 28688) ( +EQIO.GetBox 28690 . 28910) (EQIO.GetDataSpec 28912 . 29245) (EQIO.GetDataSpecList 29247 . 29392) ( +EQIO.GetDataPosition 29394 . 29534) (EQIO.GetDataSelectRegion 29536 . 29680) (EQIO.MakeSpec 29682 . +29918) (EQIO.MakeDataSpec 29920 . 30071)) (31648 48752 (EQN.AbortEdit 31658 . 32170) (EQN.StopEdit +32172 . 32619) (EQN.ContinueEdit 32621 . 36273) (EQN.FinishEdit 36275 . 37008) (EQN.MakeEditWindow +37010 . 38429) (EQN.SetUpEdit 38431 . 39608) (EQN.StartEdit 39610 . 42911) (EQN.StartNextEdit 42913 . +43430) (EQN.UpdateEdit 43432 . 44829) (EQN.DefaultData 44831 . 47516) (EQN.TypeMenu 47518 . 48750)) ( +48819 56727 (EQN.Equation 48829 . 50088) (EQN.NextPiece 50090 . 50815) (EQN.FinishEqn 50817 . 51346) ( +EQN.NoUpdateAbort 51348 . 51761) (EQN.PreventUpdate 51763 . 52198) (EQN.CharFn 52200 . 54285) ( +EQN.TEditSpecialChar 54287 . 55006) (EQN.SnuggleWindows 55008 . 55599) (EQN.SnuggleMainWindow 55601 . +56725)) (56781 58520 (EQN.EquationFontNumber 56791 . 57550) (EQN.EquationFont 57552 . 57894) ( +EQN.GetEqnFont 57896 . 58077) (EQN.MakeFS 58079 . 58518)) (58549 61690 (EQN.AdjustWindow 58559 . 60519 +) (EQN.CheckWindowSize 60521 . 61688)) (61691 67455 (EQN.SubEditorP 61701 . 61934) (EQN.WindowFromText + 61936 . 62473) (EQN.EditWindow 62475 . 63553) (EQN.ResultWindow 63555 . 64105) (EQN.ResultObj 64107 + . 64575) (EQN.PieceNumber 64577 . 65126) (EQN.ContinueFlg 65128 . 65691) (EQN.ValidEditWindow 65693 + . 66127) (EQN.ObjEditWindow 66129 . 67453)) (67456 68573 (EQN.Make 67466 . 68571)) (69805 85740 ( +FS.Box 69815 . 72061) (FS.Copy 72063 . 72703) (FS.Display 72705 . 75691) (FS.Get 75693 . 76162) ( +FS.Put 76164 . 76635) (FS.ItemFont 76637 . 76998) (FS.ItemValue 77000 . 77406) (FS.ItemShift 77408 . +77788) (FS.MakeItem 77790 . 78212) (FS.Extract 78214 . 82138) (FS.ExtractFont 82140 . 82743) ( +FS.ExtractShift 82745 . 83308) (FS.Insert 83310 . 85299) (FS.AllowedChar 85301 . 85538) ( +FS.RealStringP 85540 . 85738))))) STOP diff --git a/lispusers/EQUATIONS.LCOM b/lispusers/EQUATIONS.LCOM index 24d4e821db4a691258a7c5f1187736ad9eb12458..b0511f102534ef5d914600977b876167070e5f31 100644 GIT binary patch delta 1512 zcma)+Urbwd6vrttk?T~Dc7Xi*adFTtwA|YQD|cY&pL^*or7i7+Qr1FSdJAo7Vf=AM zU4*$8qgmX3FWX$)Tzp#0)KoJiF={j}*^7%l5Ro{IF}THOd@#lr^_<42BtCc_KIePR z@BGd^zhBSo$sNt^mzoZ}OO#}vXq05HXq0`DpR@$*&Jp{tNLbmYh(WI$3b1Et8r%+h zNF+RGU>H3nJA zrnp(YsnIZWt>Owe_4~TY!HAXJ6&Sn!XW-oaXMnr=KY@j758Q{z*B`tD3_r9BAzQTp zLd8tYk7y=qJ(%#jwuOGE9Vn?OU_^HUxTQ-02M&B+#pnZsBkHjNebGHgvvnfG->AC` z1;*-6W1X)XKEgV$HoghYM3WJnQ_WDSc)R%sI*qNr0&7VgxIqHITw62!iLjs^ZksIm zPT=cpjuPuB!?uDt#7e+p>@aYuy^U_Oc)F?fkD+wyqgV0tH#;h^h0i);=y8W^XqLJL z@k*|7o8V;lZOm|4K1HMLy@lqxzIVXTm#ue8K+T#va-xc-7T3fvZ(tGhI1WtyR? zGI&a$RZ{yfPsCu*AB3qTVcF;MhXaJ~|3`8p3LlZIm;yn0)E^_n75=ER;{0@(S z@yT9BPb|GOEje*=d?qoKSq*0jsm0@^$tk`kHDMbY?kB0@?kcG(C9cwQviUD%^Ynpw z+;bB8{>>v``#s(XG|!KYz?IT1|3z?C1D*GPb1@`fDC7aM3hJ2R1zuHbz`IHTQX}K# zm>QjYAJ`PR0HN!V^H^#uinDe)x&-_qsshzm0(c`90k%y~1J|dI0(YiIfJ4(dIyi&x z;*+)Xr5T)`nR|6q6SsqM#>au@I50Y5Dbr$!m z&BlPA&qje<3McJ&3j6pX6$bKZ9C%ip0NznCM@nO_ucdKbZzpZkHP;9#K8N24`W5pH zpjzg!>eKU6z^!?#)SYPpdNcKvj6N8!kJ%{4G(ext5IvmG)0>%2P&)~j`fN3*#w_0A z(X11ADT`>Pm1ipC}L>{w-k+4Dc}Yhnx&qeGAC-607rC X`qcv7M|B?WGn&WBm-7w#O4IWvwV6u{}mc*#}RDDRDL7v@?*>%HBh?Pag7z1?otwRiV+teq=c*WPX2y57xS9 z&pF?B&;4$FZvaM#c>^k8#6Br#l?!=NQo6LfnPjrs{-j>W zm0E*9)@Fyohb#^|;d#NvVQ+*vJR^yM>{8r9SX6@H#ReYKe$>n3r?mdCd9j>3tHGwd z=^PO}4u;+_{9<5=-rF)(w_eLj_|CXa|h5z~7At z;Nbe(D;JAv`_gnsYNao35W#4{@L^~=DD)vA{hCt7Bt?dhNQ*6t9PT} z-1Y~MC)2>QL?0Z-xf)621yyY*4D0z2DLoZQulM{|{10OL6S9Y%~ce2K!=^c9M7 z`y~+ceaEjQa`YSL3D9D~5#UW^F}ZsJL%weL3HWX+oK3N@tqxxvY>%S2)Ug=@uDgx` z!<}Qm4?3TR1((~2>oXoJu3r#)f%nDgN~>YX5<|zzCGadmd{Ig3yxWBaA}UHyAq^ZE zkOH3IfJ|)sL$!&7#BeCs>4Wj-xyKCBV5g_N?sYIj0jrou<_D7LgnpnjL&cxHTd{Vp zl&3Y)GCJG6>!D>WX>UESCw$GIo%PK_!)%X$eMkL!P`uOI17~?geiiiByG1lug9anzv4r{NCKzpTmtKtX#+r4hmqZr#k76xr3+PQ-nMSU#zz zrSzCi0+Qbh`%U5rjKoazUa}svEt4joXA*lnI_U;}KIsCkn(6@dOm#0?Oh!+;s_5HO z0dW2~wFziUNxFg}#L@p|?Km0lG_N$wBHN>ElG tE~vyEl;NiA>JGuBAJ($^LE_f489iIt0ZVwNqZt9Wp3~tln;F;-^DkG-*=Ya( diff --git a/lispusers/GITFNS.PDF b/lispusers/GITFNS.PDF new file mode 100644 index 0000000000000000000000000000000000000000..2fdd1a99bd5fcf072c566d8abdd85ddcf58dc70e GIT binary patch literal 30511 zcmce-1yo(jvM7o}aCe6Q!4|H;-Q8Ul?kouI?j9sSaM$1vf`;J1-CctOmpmYQ@3YT2 z_ug^-9sj+tM$g$&Rb5?OT~%v#_iIH_aRz2aHu%?lhq1ZvuU|{qx!Ri;fh_Iqct{>Tnu^#H zq_B{xh$Jb4v#6N5l!zFggQ?j&Crc3Usm2*(YVQK#6L`uhxPTm7K;o7*z~|zB(vtu@ zJ1G;Xy|ESi+qVE&pq)9$f|TQ_Mj7x#1q5^=1&G@ifq)P$O&j<3-9(J zT64iELlV_{hpzCl_cDcj5NthRUOL%iP@lT?!>n6k1q}+EIQlE&BycSy+oLb`SBRv7 z@`sz9AglTNbS=>ABtVKH5?G8uH+DI}) z&N9Bz_{z-t>PuIlAm3=TKaf@TLN+@n+|jE$G3v+9tXuL>=*f^WhlhQhwhxONw=``0 zxG7Q%VA}&HM2T(^dDovRC>0y^WBWx0LVGIq?))yHJwW1m%s5V7 zCu*lNMs0JY7&jPt2ZupF%g1h@cARKW2G*!dZ8Us>n3$AXLdsh*OL@i{Sv&G(iXIk* zjD1PwR+cCsBF;zRdeY8_h>zjZT@{Y9)5>oPUjZaVL6fk;g@$T#Z<;?yFjG5|Nztnx zNEY4%B+0lXnmNG4CFuwyfcSUNb4E;)`eZcGoSPitQ$(9#&0vReQ%Ed+Q5r;&GXyWb z*^QCWTQOy?>lptYmTQFNEh4k(t(vc!pd2Tc<)D?MlofZxLfh|^*axI_VxkKNb4#G~ z%GxgRX^tZ14u7xI{(VynU)9zHY+OijqfT=J;=IHb@;iJqkp)}u>^Dtbp9t5at%P4R zYmd2}-eLaAyp|h1F+*J75QA*Xrtw3rrv0BTyb{;Y9&v#g#iCC2gtTy2Y${}e^Yv-M z8Cv$WQIe0|-H{1ao3zJQgomQ9M_r3h?{lO=8JyC}miDB+=EeoLJIAerj&oBfsfT^G zlO|(PMCl>NzM%*cbc~5e>u1yYsKBak$33cqA`!d}1k~m(0tvTr39le|Oocv9p{J&> zq@GA*g|lx%*x?J~Be7#g&bPb59ti}{ba1WH6nvZHt+1@7bq99<*Gr0@4o-fs)n*hj zA^m8(yqJe-X86gYk7;@H+ zh*S9yWQ4H8KEav2biyNIS>07`ZOxiFV?tz(bung^Fjzr2OYr-5Y$xe7duQsOyW1|t z5cIm6*Rg+^%q(gb7Zi=#OUf;a~`Ly8V#?^C5FovGi1e57DVQb`tx(@3ZiE!ndk zV9cVg@hKVS5<#-8xtkRBb{z){=S-U6X(-n$C>u>yNVBI1hrxw@^XnHbubvi?2B-I` zVo%8Lp~p6-(a#{$>yOUP4E$}aR@Dx3RaENvZjuP*k$Ss-xKz;e5P za#jegaJt<&Jl8t5`ml7gFy<~orkt)@AImznoq7*v;HhulLpNclXEL>&r{;AE~zL)=A@gQpp+JWG*&v zHq`)6SQmF+Ym7NY1te1Ca`z7-E)Y{)l~d(BY|>>2)~oZF1;8K9r3@iiud6!GC=bA0 zE{Qf*@~^Ltj!MFpm)tNpZbcV58VOez_zhWV+4-Tqq z#dZ(CD%nRp;`dVQDC@M5T(W!Rq3w^&#`cAH61l0EvFh4w$tCcno+Qr8Vxrc2A6n0c zpV56;3X1S2vK2ZjIHM=CeU(SN5pnkh07}Wt&yaQL`~TJIM?aht*JT|L#X^mvEktCRSP5^#o zY#7R!@X}Z(JEPPR$vsT?)pYRWPjI~6>?VzBz_h5^<)mAi zE0zPY{LM0#l63?FUny3-!-K(}nsT?HQinRjB%F$0^<1=(YCa2ue@|~n>2RG$4D9a; zxE)Mi3jm7>?Y}7MoT4F=d$d!)erPkaBVswkRKOB~ZIRX+;Atc-fhhr~`u?~!yhrK1 z+T{n@nf~D-pK{M`_1T#|znQt1IpP1PW9IxfpUcekpE%u2%?0I!C#O53A$uAyS4)Mz zlsumw0UhdMYy&~wul_Bt8rp(FMl`{3R`t=_v$7?^D zuG;8{Qq#D2(J5^-$qgS%oE(IW5RJ!!DSmsJ!S{niMbD}U4X8Z=dK6RC8siUOXOT5a;q;;zcP12W`zb#R33L?Y_1^C?iJI?3HYVmd__*;1 zdG<}5e=dW}Vut!@`F6rptexg-I5Ul$@#N%gqzk@FU5epqB)*1mnQ#5bqfiQ4PJEy`O=V{)HK+U(Y^7H zy?g@Hv82S>h)91^J(LWQW?^z{T|D{xG*; z%O-pW6)fM_xdp0`fB+InM1aqWGu|)9JIl}1e_y>mtU)S0*X1X>_>|rvMSd_tk(zWU z7VVIC{4XT(&7?EFL+-dHwZJR7kK2(BP9QfQuQ9v$XThk(AkN!^N!E8QL!ARuB2XPalK2F46&2*5$f+peUEz7Fqslase&k2H( zv&r!WjhH7Mp-C3^Md?Z5kY_f*v6fbIsIx6w8MB|}@$bZrU_uoHM>#*0?|zw4^hJ|U zYwNO+@YCesD#;yMwQFLG#d&o|bCKYbCeQ=DiVr-|sDPg7fhec^iCU2121bm*6Ux9V z|2~hXX9;HATWb)e>C;W~nLE8l^O0sMm#rvHoK20~K<~Dy>}oQ(B#mOCJ%4kt&@;Boau`b{twPnR`%IWWCVq zpNlK=%k6CY#0eWY(l4$>jZ#bbwNg6&rSbgifjk!P2aBi_cXcr-br!z@FTC9hWvtQ= z62fap8iw-=d_e~Ae72R`ibJCt@8nIbq=v%v;-;nYjq-$OylF2<^;``0(%r_u2Y)+5 zWqy_*?i>r&cEH9k?U%tjRkFC2jqrKjFe}R%fp_rWU0{q#F0kPN!Cpm{ti`(;Q+lee zY`or!+r5GOnOKCfm{ws%$6Ui;p|n+xCu9HtpOcY4iY`1VWhaO3ID&`IkYLmJxtWn9 z;kx3}Uhmvi@1|Fgb7^81?$Rc7#21N!J2qn0Ib8&KO&G$C0C0J>9`p-sf+%DmKFh~d z%!ixSf!zzm=$`njg@OpXE*i8{TNKZ%48a4`%<%d)8V2Xi{G#wp{8@F;+olXDD^nBH z@l0?nth?9q+r2ZCtynbk^tyu)>xX1-&Z4A)(;S_-U;*e*2})uxxJXekOp?v;hq008 z?^aQ7B0oF=CtUUxZEz*t&1F0sK~EZ*c?sL;ljw!Or(56@_8^6O+yrj}{2Y z7>D%>6mpnmYhgT|cp4xomE%Et&iBN@l*1I_;NR`tNdSo%K_lF0xVs?_vW>j3o8U4B z``Sm41TBU`6@8u<1mwTwkAh63PT8s(arnt~MIT+#s2q8cl>CPo;gxor=f^lv)vgW#rlJ6hizt1Au@$iu3+_qrb>s zT&q>1zd5wlZNYTMC7}YWUD*XiDlGlgkxIY^J2G$K=;D=Q%cQfKp*0XR^Ikj}|JeQ@ zEv*F7W#u^ogUnGOHOQ=645V9X46QzF@y`i(59{~ zwNSzX{pAn|i6H`@(I{9IA^_f6DSnT{@Z+(=Wg=f!VBI}(`Ns@e!!J4rPk~4MJDlL} z1pfaPBE0ziml%PYoB7Wefra_sVgweJ|0G6;*6Md6kU;;uK}QQ><`%;AGytW-rRQQg zDCWy`p<$5SDq3LrVSD;}kbO%%{lfdHVHwQoFz}mr-u~2}R~jHvAWY2Gce` zOo&>y|Pac$ie3-Z-ot27V2$+-)PxODRI0tnrflaYAMxZ z=LtB1+6M|J)Y7<(Pv*brJGf=OApdmi`{VdM=ZpqQHu0}^)iQnM3#5$Mtj$pb3&TY2 z@4Is;6zy($+n(wLy(#4r@C~$ONi#uM*0oZs*KZhB1BXL2+AO|t*us_TQS$1?3QDlS zZ^Y5to0~_j-@n%q)#HRofO`84=6V;5T6&G%B|>xx$>`2Ig{oX?&{#Obws-Q3I{wfV zgd}4r*WTEqD>N`{ww!cs*0@0b6zWWiOf5Ff}$-5`>w$y{f$UhXPr%Nw&*7#AA<_B%fI@Bp7dqR9NAWbXlAbr>&8Lh`G@ zTF%vKyH!{>*jI}hTkqV0(QCn21|ake4{+4kYz9y1uczqgP)s4UlHX%#e4l)D4x{dp zjttSbi{P|Le)@cJRbr3cmE%tV-j(8v$NG&5?VyEzAA#Jj5Q4<6&i<2){wYZXysTP# zbyUJ@(e$e?lBqEHS1Nw=HAFrrVFrm)86RCSr%-!72DVfsI3n+b@n?Dqz7^ewzdJ`! z*x4-8VoorwdDA21gRoo(~)~I`lSyFeRAy zIBdoSAe*?7A3*Z!-8+D9N0EX#Z6WmF&BP5i6NK8<;X?i5cGdZplrI-by>Wbwly$X> z1?e(TcQJFlAL&|x5HOhq9Ut5qRi;I%F8W5cwn+P8hx}6JbzQ?)c$FSuu zyz;i9L+W9Rcr6=`OuQ-bHeqC94z5hXB`RmcW@4SioIU>()gE`R6s@FGNj*^{5FgQK z$=H&)hhR5PL^Z^_3k;ly@f`zPuHDrgdctRaY4CL-O43QN+VwUt?`Z~8&PmMgQHQ-A!o^ho4v83`|eH8UN|pe=8C}@D#gm~YH7O}JNW;7OE+WSS71r@>WXLj;#;xnvfsWBhP{Z38Gi^^;ka!03A>5&% zdEQEIbUtFu6-x~!3+#eO76M}VS8C4QcY}QR$|-VIen&!?@FDDi>3$mz*bs%K_+G6hD|re<7-j?9mL2K!jMdZNm~#>Dc_3Hy*!V*kUX7U6?4 zejOD#6C8XZjybd>hq|P#{7?`PlpfW_?Q-}<_DF1P7Pj>V{_2hHISu>7bd-7uHak=g zihJr9p+~tGo0&$JcTDTx1cvghX`Q*N;-WlZ)6P9afnMvC3t23EnRtD1{$fU48>aRo z{w173gdjGWz4@N*ST4yEt3m4{JXPp^9fl>i`4A$KPfVH+a>16?A21z*bIYB+hkfYW zxyNe3wt|5rWKOfu%-xn$3$@}w&d!HdxE+iS6qZAb_7GJ|JcpOUO=WXIW+t|E?<_0P zKY}9)yX-Byy2f-t4?&ia;be?9L*mT;DkFj@KZ5V1+*z5Bx~EOc{&>&IC6@ z#8P^~O&0tIfi}xn%CFlH35tEajNR-H%c=nw;U*6@1Ms{SuCQW2Y&8tWr?1-&ypQKUdq3SAo{JeySY0u5;Ptr#=V;> z7f&7c{Mz$v6w3e

?3dFmx*9EsAyP5Wx0tAyw98h=`jlO#Worc@pEc>uXihH zs9ppgaTFfUdNRE@`yjW`g{TQm$6IkYPqn$^@a9ENx4xO_RvAY=WzKR-Yc*I^fiGyy zq1)8BsU!v~TR(~5nBuAf5Z{KJw4TJV1Nn!AV?!cl7VZwp7BKLbJ_q;pck4R8UG(~F zu>3*tG16p4PDx<-3MCQ{*_vnoEB*SSt0c-^uoLETe%VrIT(1;bLRZT^MMxylSGt(s zXt-r^wQ9d6N9TL&B}Ry@()7p)0G5PIzcP5D(1glkYQ%?Vg-Ar4uUohRWF)J}f0QHp z$`}j|@huG+tS!6)=?}Y8wB6Ed0}l=F3cb1;>1m@GU4Y=YCzZQLOJ_8h(mn@xm6pAB z+n{JJ#%xDj8FT0+@vB=kPf(eOEiIf0gU5$?>xLM%|iRqFA6BC;VGL`4T8T2b3)AY+Qc@ zl>ffb!}1^P^dxI7I1x0XdGBa^ycAQG?iqPVkZ#+W)edcKI807;Ql94b6N&pUrP~B1 zURzuLE6YwdgjHm~bpQpspX~PI-OoM9lXvS%*>2aPj|P*hu{P#kM!g;wYkpy|-}E_M zKFCGb({r+(S1Sk$6bcD;1<@bOxr1u%k%$K_4u)-rgZO>YJ@B+D&3ArWx2!8{<25R7 z?yvE z>(nPTHqCB5-LrZsa_5!sopO*Bp~OPNq^8UCZzuv!T%|9k1AVQlin%pYQR1c1q< z-rmJnzER#^KL>2KXCe*W3m}bcvvq8}w|5*ZXyXb*`d+@0E%7Opp2Ua~auy@XQPz0{ z;jjUz&Qbp3JO}krh^7scN||dL**zO3=;}O-BY;`&vBeEl_F59=a z_~K?p+2Uy-TA!%9N~J(3m%BHKNc}10T&iH%nG)dTsDcTQ_?y*OJ=*obT5nD)J~TZD z$tI!%9y_H+F%_MX;SDk;Yzjty*;tkud(}xGMy%tAQvWG(Sx+}XT~_0gY}C?9qpAJ& z`r%^g3-y7-92?m9hJ{Op0gkRYsiYG;(MQ&gufWS@f2{2oiRR7H6DtA;3jLClLu;$> zX{MD%uj3WY7X$8e=8{THlfA~+hTR}b7CK(9fn8`waL=1PF$<=r(tro3TF@a6*GlXNen{9W$dLJfgC_9fPFw!i00)BvG zpdnErwK?C^vFC^hrC5cSkFk8y-=@!`3uWh9J~Lz}Uqdov)5lGet@J8eV(=RB?Lom; zs~GzSKBEL~LB-R%XvKjWX)1~h%y;!eGJ%fhL=;bUI$CScO&JgH+hNVr9RX7~{-iI_a#2c0Hy>4|9rs<E+z4o&uxsRqgm9D8}o^uc*qI!#XTjSk+ zYm~6Y-#P6?bdv+-C^tuyAIurZtPlaTu=H4hSfx=r@#DRYWW}D`bH-oeOy& z|Fwu)Q1V4PR)mr4uEpg?1WFlA^yL8lb!8rx8fZ4DT3Y9iWxGR7EDjw;7UvZRjx0c? zkqgYg_17b9e%`W(EEtqYVEW0Ao`j=EVusF`P6lAu& zl?tU6GeiT)MD$ecfzaIph#C{w$SL&&C`_YDq7HZHFex%2ex=h#kdImwM;YbHM=2r+ zP;U%pRXOO9n>mn6HONc9kGAc8((Gp$Wnw1gLzGdv~P&vy$cIz*%zd*(E$bR zW=b)yeaA}ANKe}lul0rjH)KTW1Z@zGofC+!S18?5f?EeD6>I6^Q2jy;3PQfjWz+(QeQT2K7~~# z$34FsLnQ`!J!4L}x?4)a5!y%VFBk?jdZkdDE{1j%$Ojf!dLrQQXDB;WZv|*9U+r5je$j;9a@$O7~PL*sF&baCTX%PU%p=&%&yudv0MHH zy09_^ICBP*QS_N17FweFBB`+uZc0eJNvAU4Gt6@6?PnsJiEJFjvtoTXRm_fAB8yUy zGiv+AHH5N4%RT_-`U;M9BrXeQGZ;9vn1ac$itv_|Iaf`W>tY&2l#~CH_T&1 zwT&E=H>{zuPeh+L?^4()c+9b7KG^$tbEySdOJg%O7V?`fzD^RQiNsH|?^fm!a=sRu zn>R6?&d?aSbzd#N$5Nz&?d92T_ZRRjMkrff;>_J0?_VsG{c6)+l;!CZqi~vWWumyW z-5cTf_;WJj16DahRn+vnN;yi_VnY!_X{+b%jl&+J4-97fhgaScd9LV-i$Cwti&k;z zc{-4Yt{%-CUG8ic3n|0bQE_lHX_p!81nv(m_qQ+SpdUJjh5;`Ar<-dRu=|taJ{~p& z%+(z(JF!2i-j7yhUkzeZ!h5{S8C~_5mc^FK!TA+?yOc@t&KC@itN1Gk$uPMu|0gKp z_|R77S=F~AS$nuvv8E!tX%fd4))`HP<81W=5*5{QMLGxQ)F)^+nX+2`4++ARI*b{t zKzrqE2cK3YJ@7gDG>v0zibxOID0wpvyEP?)OshVquc9kUI{?F`5$mNn0F??gZt3po zNO3lc`Wf<~KzpS0r#0{W{6$7(13I1$VpRP*_;M}-u@`&rMpoRthG zV2p^|js;%g>{}#j+?pdW1;>Rw(zt?1FejGtZAc;k_dfojoaCstlL9VzYay-CrM|0N z-XN3?36JffkSzm#BST@+Mtn0nP#j9Y;Vx;F@8u2fQb48Mn(W`B%s;m_S=c$a|B5oX z|LwCSE7O1S*)myUE@puP^J#1IgaO%*b)H^EaE#nC1wTzbJu2`g8K6#7OO|pB?G1tW zci$hMbvIv6Rj0_g(-HU;fMd>Y4z>uu8%fcQn#>ISS0_aHsSg zF}s6MP;$aBb87qpX<5x?1XC^1rqZeZq!VemZMYp*i5P-OE~kJrH=^zl&>-AL;&3gu z2P^iyL(34+kBL?k`r27lt4f97Nd04+)8jTMlDK9>5bP~ zqRi1~oQ$Qgb8Ci#^LoY+pbci99v+Bk{YGkKj<)*&I&ujl2~+PmRILnd-W;j9fh-l_ z=?ez(oUp^7>9%x?R0~0&H8D&)daSCsS*vc_+I%Bb%&di;z=XmfBqh?MDK_`Zv#Em} zk{=u>BnEA|zHUua2)Dc6ocwaM48Tal>cC#1E+6XU*GYDLWAOBO#~HmNPFnf!=_Z<` zgrtMzAx$c&(`c@&g;5)N1?V+&hHt~p9a1ly5Hgp?;H6fDX#fs8@u6izM3)jf zo}o=Zt^jWTUOR`=JBCFuO#la4B`vz0H^y`N^ow17QYZcHu$<-UYG`I>uh077U6Jpc zlQOlF+G&b42|{H4H;WH^RN?10cJM{vIY+-R3mY^stKy=ddk&H?5AZ`%Kxx5B+umt~ zJJq|X<6dsl%yC6B&^e5W-2&_(soJq}$6H!#f`)U|K7B{ZHp$RiG764s^dOdWISPC| zDDh1{TSJtpl03m5>}PPiGFubFO;tv)seRxxO;xy1Nw1U8X#BtN@*iF=) zoB{c0z@>apr{FjQmP%Q5v}JYbzUg0+>nCRsy%N)+b4{V}P7>{Rq**)Y0RN$6LD~R- zMgB>q?8(f-r8#24eIn$~Aon4_st^-lYyn0}z*Q&Jw0m9)XQ{Mfs4Lm{7@3>XK^~Jg zZI9wR{OQJB8QVgR;R73;uEy=5-iAydZNXk}u#mo;n^|{4jhGek>AM&C>NJB#)@N*D3CjL$J74O_4^e4}fn+a+muQyEB`fgi+UR2Bo z!@Me1!kdZ)ezbVs&5prmNb}rLp+Ty|Cw4uatAoWqK{E{N1Znjjl?sM?Ge1CYFTj@% zIV!lu<<@Eht4iC5(f#b#|lme6KWC#+tcICV4N9Uq~7E%^k_6wBR2^Qx8m9D8Q&|Y#_EBd$SL*< zdUMl+;zZ$su*!{OKm7*kos^%1b)Y)T0@Z5cAE*8dCQSch-7WC}&oe=_eOS;61+;G~p`2hu9#qxQ$B3 zc&NEZUG@#^5im~WVQDD%nIXF%7p#cyPDiEsj?tcB#K;rO6XtzQS}vJ!DO%^FU+-4! zr<(^7|IG!wnD&>QD>gQcKV1OZKRke{y8{rQXk-oq$N^0)jfCypNOhjQ0S7Y+DJM6J z9y~zV9`tm)l$7ZS$_Z!(B4vH{6;IVbXL}bX6QJ|csZ>QLdlMBPNC)tAyp|N83UmWK z;fdQn0W&{;(olwfI+h9$c`85QJCpuZ^~CH8XMcLBCrbaf*?IPT|H978QJ~8|8BZio{v5Ki+ouAb-q}h4?_LFkq_(h7VE$A^Vb~y zF<;Lz{LRjj?mek9>5D!)lLBNcO`S<~;Ge~(4A1=XB@O;%a+Tp(epkK>MHya?^hrBi zp4657SyTU1%fHC}K~=;EWMpG+{wMiA)`1)lWMul(LdyDbKJ4!Vo(1=ZoRpba;hA4B z0Lq;3FH#05bHl$31)$8#4A1;B(!cfowW2KB4vJ=vEK&b8T`q>SUNd_ zL@bP)NLg6`vPOU8nOWEY8kVLY3uhg84yG4V_VRqrJ(;zq{GaJx%TM+2e{cOe+;8lE zwEofdH~2rH|3AF{#^3*h^}E+UpMU4^f5Q52+Wwn9|9NEpRC+SyVs=k=3oPx-Nm+k? zj#hCo20iN4EdjUfaf{>tDs?NCuHYr`Bz!g(##C_>STp!@>EI zIG?CLr&$PLo`g?(V>hHOZ>7Q_(d*Wt$ULODSd+OyczMg3P znSY`E2hY!Adrr@NJ-?s(`2+5+aXpXqrTv+wXS^raXI`G)eIAvT@jX-6O)#pQ?;}OIx`5{+nD~VvM@gjPx-&LFPxlzw=c|p+Lu42 z{v_%D@%LBzv;5fpWu~6z;|2RKsDIFUlJDOn`qb?|FP#5Iv@fpYUyZB0x`d3j_&?Ul ze=URG$Cv(t74w%2;Q!+Pzmvg#F|KD_d3J_>{QiJ=)~e?kj(=JQzhVAd0ngU&1?GAE zybSbr`JbLoFwc^HZvXrHxzFdi=k(0=Z_b~eTwL6Lw!r_U%KB9EjQc0fbN=_*e9HZA z=Hz*S{M|G@8>D}Dw-;rUH?n;)ssHW-g`a}*rt zgq%&Dqw=T9rx4r7K@#|EI7!(#pNh})pWB`>;Q>-l(Tk;tke#{BQ!oz?PyqpL)t};X z?k5ti<}V)e*)zfegn9iCVRfB>L(_5c^aJAfO&{msinKHu(pau_d* z=^q~KrTm8q{Jy#O_ltW^6Y_VbD)Q$|KQ?YIZhrp1?(}79zEZ{5na=`C!=s~pjf`%? zT8!C?v_EY{r#+{ur3)rh7bX)g7heqrM|s%Y9;61@L{{liA&gO0Z&iVnq;oKBRng!= z*Ld`>viEE2avAW->}%Gt=i_;HcR$%p!#nro9q)Dp;aN>I^zfidX+wK133%;wfn z8yz>kdcL-im5I{-C6sVZ8OvG3RVD9yOyYQ{-^%Ub-S&y@k=otXrt51{{i)RBm}6OT zMkdbd9%?RFMo0ZN*Uu~*ET>xr!9>4&%~7G&&h@=^KLl;*6MXhY_vXBNJ*+m8k&WI= z>T=OlS1e|IKLb;ap!=(HefKp%%2)bGq!hu(2LxW5k*$2a163njS9lq*Re8>J$w99w_pt6Dlfn z{vh5p88=j)o{Sz{V`ApCR0UZwY*dx-;2t((v{URgg*Lfz(!+2#VexWG+%Eq()ajms zpn#9BQg8*iFse|0pa;S!7&9>kRa1C5PQwuhOZnx0i>OVvcA596yn}+&$W@StnAtpcDa`24ktfzkUEo}rHcx`PNxHES=?EL%;c|I!6Fc9( zU(_R}8BJ*Xc5!BYKhb%wA`k0CbT}n-omL$;M%FwTD?6fIU_Vx@t$9MKvu~B2QEQ!a z2!qbBW1UYEp=wsvXj8(9tdnRFL#CW=sIOEsUdtq}xhCg>==7%81yP#RH~90o)wtJc zBhMWIDbkq8XP?wV;4LGx%{9v1&aZ7jNrUU)S|R@GDdMdpbmc z10)ls(`4;ND%ESh;kS<4_X(j#3nRoK(8nFKYWbN{e)=Zu&=3P|hOK2HF1Jxab z3YEwNE^I^&pUjBkPMID*N0Nw36tsJ2^pO~O-`PRaC(xgVN;WA1VN-$AiFuMfdWD8pa!gaAR>pXZO#dD7kd;Abw{1@KO#ETF5 z@Fp#yV;o^(60Q|>6crt;nrCjx@ZHPUBW0iQBRV-bim;eo9auPkg&Jf9@*z6ziLh`0 zl5Q?851BWXPeCr3rxz1_jrRQJ!{Ecy(jSQcUm%kahx~ag5t=`@HDz37+)>kvQyQ)EF6GRnwXoM_onj(9vmW1DzV?IP~J)3ez@<{MYbpYV+!=5?uf67 z=yhqB8_7s^mQc=22Qd=(Wuy$Rf_M4sr?SfMvOEGOD^}H;V5@rLx!e;`ff(_m1=f#q zcJSYR_<;345EuzzMT}2csbNTP&RCp`sjEhox(;HixkfOnTeKsK@2&>eWsbDtZQ^#1 zI@J0E)!=qlk|X-A0BPVTfCBK0^b|Vm58UthoI)wjCf7e@cyQw%WmLcgt^N3|5 zZHVceLK~u#*8#(gIbo5Ay5y>CA7*+jsi+uRcKlh(zuXc~YB4z(PF(Oa+kZFTH#fF- z8P5>g5Q@8kOvS1;Bg5KC2eV_f*dj_vO1)f29@hbuuh?{=7$!D`?OF+f3MrnPaL{K> zql0a{7GEpRIq7DTc**MNe6W`>r|O1Vu8^ry3N7Df#-iXOaX#W}9r=)EKM&d0%c*LS zW9+cgaV)V#f`|5e%({cNDo3-rnL6sK-DA=Caw@j^a#j?rHF8=QgTW4T9CBH2E>(;# zF<=aL+Z|Y%srq(9E&(6jUezYjK?SuRQrcj_6ZQ}LJqRNB?&j8W)$SPXG#k|hGhyo+ zrPs3K6+)V&y4ta1(JheNt)=~p>|RT@A6?=}a$+hBUi#i5|Ebu?$<`;lmR~M$=^OiZ ziIF;k9}jLDR){loR%#{!x>d@xGu2~zY24g+Vs1rxV{`}ak=|tzalGqpnEh;N^Twja`||;eG7C@u0d|5{PYLc?wlo$q{C1CE5;^L8p~x1r&!p7u7wnORL0wVn>O9X!Q3gqv`%W@li~JQ-v3;rRqT(XT2`3tst?gc z%4bpCr;iIwL!~<@{{i|}-nC>!G1e@6+jO{a9E>oJ*atH@)y!$sH+B}eMBQXxA!7NR z=h*i|1bJi|LatnzD86UWvu8DSV#Oz!oVElddDppVDR$kjty!ZOt?)Y*&_hiI4}8Ph z3HYM)tqtIueav-NQ+#^#75sDWjA3|F(@3W3+iW*m%Y+z>l$4>bvNcosiNYy=$5^iWKeM4uhZ2Geihm%w78Q*$0bg%j zL?|>8RW0|8@nt&F&55ZBni$VXBN~Oi0Z-IS8#s?#rCu`E8P)A_xk?+p_lu)6h{+OnLJ^=WJ@e)r)c5R^q!=MR!bOzM(T;)}RLl6>3A{dVe z=73$r7lRi_lhtRS3$IE&!Y)HAkcGEzB6KBph)5b5qBltmilH^4Lxiiv5s}9;#A!l@ zn``=M%6Cz2hIoy&D%VRw_XnS+#52KfGNDHfqK+X-7>P69kc+IOvryJe7c|vBM(LE% zt6GrBv?7W%HHT>V?A=8qW$I75Gd|8c;GVUi=m%>oWs&i!yLN>lgz4c)2JWCO%9%Gu zpZ_H68{o(P5#Bo(osk;?f9}A~@+)YwLYRpJkDM>a@C>awVlq7^s^8+RRsPVtAD~00 zUW3JF*X2zuhM0hgzzu|D1x=ZHmr#);8@Qg}v4fC@FqExys**zccble+MHW{X z-2g<4DYQkxu+Hn21vg5GA&hspk6Xz{p(E9v_0bCsUy4VkZPa#fN>n4Z&>p4q3Hgj& z6;|v&&phrNzqfv`QCsk4YF`{dVeqYNaOu}ztFd&#@#vZq~2;K^n#8?T)0nt)wK`e^ii1?7ZcQ+ z?LOtzU~6f_QMI*;{#BMmP&83kk`)U~p`vsa|36X2J403 zROHl@m_R>GHiHOPQvG1aB;wk@4^?nyZ*pq9x3Dm`O0bk1^#{Q0FgeeiwlTELC%mq1 zsRbNjo0bdYSS=#a`3rWIWY-^f0(BilfZus7cqHQ?qdE%A1A+I5ZU}RJ6voly#NQ;s z1gj{hQA~r)bv*sB5Mgg9s$pK;1rVHkR)mmlJJ4Sa@ej^z(R53B>tejJ6S{yfwS%SB zyQTX^g45E9;9!b94QL~qY!AegXdTt#$k5|iT9k}_>xgsF6q#<=SX?r6Oic+OGEHNj z6T;x5Vl`BNc<9!M^-Z6Sq@*9Xi~V_7yB=Ul@GU@Ta^}4-_Ry8yCH5WlUd$M1ViDZ# z)aT@#+0;#(UTXQ6-{}V0qt{zvnCjZ)vcd`St;bd4C27OIoig`C5?Up^!h_>us zOG{n$7HJ4SCdK;28&c<#`i&d3{g?Io?%j|M-r3uupa9BOstkT*c{@Jz`f<3=8U8#| zaNxjv*gLjHBT*DQUS4SXT$}6NcRY{MOz~mb4N|_Ba}~-9G6r4my}ov`%<{!&CVoQ~ zX@@4fZOvoDF%y#~@sfVdVGt@=zDkD!Y;~9a)u8 z@T(CUvX|p}oI8ELnXrY@!E6=^p^`XYlDO0(CF5AGF^b2x<+~k|nP*(9#i)R&y9+hY zTkKx#E3A~Kelb-$R2fy-Cx_cZra6gw^7i0x9^A1ysGWq=HBQT9j(tJ&g`Bq^rV?Ek zbTS$#Of)=H2ysO2MvyL251nt7+jBL`Dy4QT@@R}43mvoFb500o<|LH*_|<%v2@i>N zJquU7Sgc?PTKRH3%s%@b748qqWe_wTZ_e+Hj{1V`%FfH)tI|j-ThU9m#g3=H`Pus! z?FuIG;LFeA=*n~ArgB7i)zkarvM3(6Vo7b*&AeRenF!*sdvZ`xEl6971XD1%*PGSI zhF_g8IJ`Ojc9dUG&4i>=Jrix0pt3WP!DD-zdp$rtCUufz^&^&)M!^RF~@R;LSjC1hF%4KYA{Wi<$&$a>*KUOeshI6eO-;5p1BA>0F#Xe~C z*}jTZw&BN{K<^)`^;FXJ@;KDic5w9*0lZSbHzY+2Ecm?n`p~sPG9zr!M-qm>OK%mW z1ce*ofiCDOk^lN296#@B8;3%_*Ws?A(KV?tSxv)f7-ZsVtF0*7^aWx#zsaJ&NkmCH zUV7MeZQOctKKDVaLYguCtI16DbD4V`|p5;9os@PS+nRMu?-l*2Kj>U*Ey zR}UKjm0vE|nxdb!agk@3vp=-_+~aKQB(|wPS~UL|n|R#B2rmt1P$nt0h~HN*u9bcm za=Twz=p=T2GaBRFIp*8i=Jt4J8IG}Hy5jRLB{uep^byzlcdZn|yN*acy83#W!mfhl(-BhZDQ^}?gFt&|-5%n*A?sfsjb6753M!&fHVs9i+q z!IA!1<;)rN;$52A%APuNL`zjYWltwBr)e|B(qC_ay0R3T=4t4UP`4PAT{e0ZN>p1l zH@Kfp0bzG5S~5ZNf)FDpj9$O(xZ-F7h9EN@7?Q`dMiN`qpyYVrK+Zu}el#ggmaQ7L zD=(+1DA)L4!>8?;l=tHUQaXo6`^xoevI^=hEj1S(OGXKEGjnq@Hd8{?+7={|BHykt zrp?w+QpoZ1Q!AUOD~ z@hO>!837%ksjIe2=?2QA2MJ{cWd@p^DyhEEwxaU|3QD*k`=<{?&{m3%B;<Nx^x~ zy{%D3H>nH$-XKZCB8vR_fOwt8E_4C$a$Gk(M35rhhPecqA2r&L{xL&h2-8Hj4SwM` zS~?OT0-*`Q-O41Sp{Av_Kpx!gyYXbS7i_~669S9#AiOjJS98SR@Tdk34i9#^x&8$f8HQMHggaMYsioPnH^YhbqEnPc1s{ou@ z?LeAiB)gyf@k^4m6s6*7_8z>}#Waiz<)#lE9GB+DoX0aU?PW~W<+b@qWgiJ@+0w)r zhrgdO&SyIo;ysw~Ny-5_f)Qsk1zZE}A|CfX%Y3tPlzzlV5mRrUlyG~?E4$}fr;*vg zEpYYNwHijl#uRmtLq8f>7N4Z`zBnp;E)9f>v6Yi)dw2P|p^~$=bhm}QEi!tvqvIRk z4eg*wRjxl#r6yTy6wy(r4Z?XuWRn-qC&t#C%2KOQ*It)uehA8|cgOBO?b{9OZ^BAl z>CB@b@yqX)=7o{N!LpgxJBrvq3f^>HeokNO%B1kK!bcZ0Fk_t$RfOJbpDBU8Uz_;O)dd~Ac z=ly=~{$qZ7-?R40z3$m_t?Rm%38#(1K~DR@+jrePZ#B|{PLedz+9*GnJw~*pWt7Un zP<0`x<2b}_cb8?4uGjj3ZS3ro)F+6UgYRL-gf<{g*M)x$9C8ZW{~JvAAJ?hQP+e|7 zSj-IvJ_O(bAbuq54_ue;Ph1x;{)p?IUH*mZ!chMS*M%YhB=<+`7Qnd)Ab()Dya)jH z{SVmfKO?tVzah5&gw~#dvUUJk`u_>d{%chBe~rspVbB0Rdxp-s|Ax;(ydYj^jN?x* z?b)jQ4>0ZN_5U8Gh4CYQglV;`waMFu*WDMT1H|KzIg5nnsieqpkZ&o`xaTiOONsm6 zzYo73Y!~W$JA-`r5or~5Bhg?rD5MdD7uwg7)y-JhhEGJ$I+FIWkSi6$aYGWvvBd$8zzv`V;G{q{HR{L*~p6P)A0HF9+eM zsQ`&j#lG91AxUUc{&zN3l@c5K!?OB;*Vx$kxvxc^92orkv(`Ct}GKJq;cc?nk?gs6Y5XAb{i!LCdKGX z^n`iOqiZy5G!)c67K0se@GSZ3wq0#NWIEcUq@4v-;6K?V(feX;9z<0Pz8KGjE#WzN zGv|PT;7wA!n{;$ruR=0A+@Bc^m}JXlk1VWj^KR>HZ_FEKLtT(z$WFd*AG)CZ==r86 zxh$7t*8R&dbu63@(exQ=9NgKGfxUr z0T@D_`FQ7JMUrdY#XT$I%(mBRxXHCn$yu{*FD_V(TDY!R4K0Ml%B}P%JXf%a^L?Tf z{Plf`qZMsf(P!UeSJADeex)PQ2wNTcdhi<=yxHZxr8V%5;sS$eCQg)cj$vYAbZosy z!gn>2bqeFl^O(?)gmG=9;;hng4c7ft_rCPx`cYgWA2^D`kh~;0jA*a zggBti11DKB!)3!0_6{OBf0a38e=qDHG%bc&z9DtS)cpoo8h`k zt3_Js4t_VDHrESyM9P<&m?S&;v^#z@vp>I@MsyXx-KDdnswE;U7qPL|7+>&^9-*8k4=DAP$v^1l* zduPu3B21_?bIBEb*)a;H)YBatbgy-!uaE~2h)ue;XKn^Nd4NB^<$+?CCmI~}Q$)&q zSCss^(&8+r({Lfll8KyJS%PQYm_>OON+H^_Jf)34>j4e&#}^x&bE4ZT5=lurEbdkO zA}+#oKe76eR5m1TrH5nOk(CE^#rR<~0_yKm^3{x1xnelERwt{;Qb1UCgK2kqw}rrt z?BmB->SMfl(8*q(QXZ4x>hO*9K!)B9V+LW$mMY%Bs&r-7eroqRm9Q)t|I62d44WEW z_g}uo?IT_K95a6+sn+V`-?w^%1U}S&B<37z`=ibmFl) z*6YEU*m)e=N9mi7blcyx(o5pxF8LSwz+qBRm!umm`uZ!#md&T6@0CNqO}8rYST+)y z<^-&U;^MOMePY1$!ZDd2T=)H(88x?gRvGNP#IV|)?S`*gdySROUY~fz8IkFin$0K~ zZD!LT=yEdEx-0!E3UkzFN3_~|qb9KEntUkfh4a%%L^?HGm2rYZ5%IL@hC3-39Um`7 zni-}|Drn#mXeBgBGtc{7(FGy9UFy3a%lSn5t3sV(ln6Y%Z4_;r894Z$CbMkEZ@XH= zB@E=w_e$esgOb>KOrs&zuzcK1Ab9`6@qlr+jDftP;NDo#J#}`y>aQMlJe)VYw_~2l zQOp=BzH_k+$Em!d#=p9hGGLMW_KFKv3!GoSoufz_vg<+g_+<96>ih>n_axhaCZi~V z26uHm!-=kMPV@Ted0!z}M#4`TP3v^y_GFHvBs`(_kosl!QKjMWZKgv0RF#xSsAcs%x81Ab4f&>!2(WnCeRw5> zIr>F*;fE6PEhbq@S_l0CYE;g$n3K6utGKUn0^6cs$CuA_3N8SJTYL$m0Or(G99I8oh= ztoqj$1Ie$gZV*V02gvk9_Z!S#bm?$lm4eCm6Oo;Fs+BpR?C7>5UJY_Cl5rOyrX4pqQ0(mS#5NZ9X^HqINU8 zO1u11=Ap8TT=CA=4DuKuoJrgfcU>+&1+3-6ndP>;LBohcj`@ArffB-=Ru^2mH^lO_ z8`yd>Z{86HD-cVB^=)6dI#gp>naYv(*<+GwPqe}91@2aa;{_!(BDuIhe8^HuGZ52F zCKWQnYUlrAPB`hZ*uy}eh<{Q%(7AD!_ylPu;{bTi4K&f>hMRd8f%15nzG_DarTkC6{56FyS z&5d5dANZ8StvG6b`dI22UoK^oG=-JP8u*0IBmFYZOFhoE5O>ya4}sPlp)F^MMosOH z4<41ixIOmzdYFcWvzyLHAH8c<#vxB?hsjEdm0p7eMO77tWohbYRS+>WbmpZELCNEdR`{(G<_b7C_Ts*C&{4C3PPU*EF%Rd@>pz zp)Sp2bpXCjoY#KNB}qY`^l0$?XKCZ79(_BnKXtlPq_=w3pQ5XgtJxiK|qSm&}evM?~nr@!IojWWKp1#^sqcmeDwKp-82g}ZrMySzYYG2pnEPO@%_bF zvrR@9^_n@>kDTTvzD*n4B2b;>?+@5LTx)GHUeciJ5edmlon=fdH_n9@!j7dtvlNPe z7Hln4`IrfO5Y3JFK1Nu=LevkG#be7o1Khu#&3_Jas}vIYpZ4_u}JN zD*g5g;=}y&IdqZY4@GtGWOjz~W7@hqQ$jbj88#N1uu%8w0((8KYZu=myQ@``=g_zW zYPow=q_DL8_U60lT(#`>`upgTf=>r(s6KJP|b0qB-$y?i3F`r9?v{sXz zk(b6_o~a+xk5QlJQdo0spc~L{xi|Up$s>*_SG=Jek}e82OMN5#J%zE5VzvnKuJl9y zpykkm=2hdZUZ)$^{jmdV1F>~|FgUS+=o;FsYH!~ZbBEBotuh%w<+$dv>!OX&q)Cr& zJGXs^AT&2myywOx2O}JcZNrO08_17zND}-W1ed>;8-MK$J_t4O81eN!d=oM^WE9H} zs$X#r&}vzZ>ot!yBd<*SVmQOMDl8*!c2WzPHMfwOGOY?Q7 z`$H43{v7%(E7u@mcIA86!Dyt?SZ#*nL-vIBM*UJfX?4l>vme59nE99Jr5!o-Ra+dX zZ6-1*C-v2da0sRbd6cM@a^<$* zQV3<+Nt7!8O1RwCzQaLH?Qkiyzm7=HWWqya^Ci6;x1N68=lNr^EF;a-YQO!*3EIVM z2i74M^4#=>y~zz*E@NGKoQ!lOwR`nO>rK7xrq84`OLm}Bb$3a4{Cjbq7x&Ax-#);V z3d{Y`hDS|f~e@NX34L7hWF=i+=8cq@G58i)KC1H1s2QP7%UT-K`@_{Ic%2Sof zy|5fyYXerR398~Z3zZ7Mrwo`a(zm+4*6FR~n~BD6cc^woLu4eC zR13U5Q2+~?yrdc9h6|xA1PC?J`DfJ=ci#`C@f@>#9LOwe>DLcXZB)j?4+n!eOB2OI zEafDv1HEf*xmx+K`gfbhc8tQwgFwRACZB~+^A}(n{Mu9{1_UX1`lQu^4`M0pE}p-~ z#^>H!;**v-XvoiX#in}pdeCE^d*y4#9X7eZ>a{J)bncbUUZyt}%qVm6^0C)OX0hgm z!90&O-X}bZeN4F-R(&4VByjEAH%q#iZ@02pUV5L8@c`j865_m1CxKt(I*=})oESD$ zk`lEk?NnV|cpyth2B*$cyeePj^y>1*Z>*%M6iaIeEQIF-Ts!ah z&95kA2krZZ){x+3Gc$_HEG zfx)tJPA-J!D3JUecRHi0{u|)wpGmKO@(H250PY0vA^G|Kz?~5AKY=H}`XlgkcKH|Z z1O@1Y|4b-E05H?fz|$%D@DJb#$^Rp1P~nWoXZH(l?vyI2`U4>I19kG>^XB*wKhfqQ zjcz?tp>FG`s__ZZ?=0)fz^r6^gnkP$c6+ib#>pLXwc`-6B{{ZFzR~de;~G z+ChbHT{5k@Dn!`b%sDvX%-Up9D&pi*w4WEpq~*j7JigZV>}-GcG`whj>s&K5KFfl( z{qshd-gPQX5uMh^A+j==&>U-?d+zz+^X%tTZ#`i)vvPO3>R=d38#7bO71;=Vh%5KX zC4yFQac6sYqjIE{?o*!43-`|K?hE4tv3n7jlg(S7@@NVjd~-e*?CH{K&2hmdIN$H+ z`cGQq_3@OPP#nt~8KKVI_{3Q>UvMtUpU4<8iW}7tmWp?`r3euE@iptua5nqbX^h$hHdz3T4*t>tB;eJu$E5*`;{QS9a+0OiL9>vpi zU03PIo?Xr^O)1d$dO4_h>zw-gHSt-yn73Vo&xAZPU3tW^IhX6n);)1$@h1d^Mq+C( znyDM-!tAqTOr!hKBvWd~H)O!ZAvZy8v&zoJtkT@VLSvK; zTeM6fEh+S+(n?IX*d|`O(i`j;itR9y`taomynVde77#+xB`Vy<)~VRL&B!_El~vl| z(x`LqK==XrvGZ%Xe20hz#g;ooN|~%TCpo<5nRtQ`QbDnKobT+5%5%tu2nWTSCT$g8 z);-jYtn#f#+T1a}V@Dp*tyWIplKXgBbm3z`gxS`TEYYJGW{q>#FFrN1BA4z;Rwsaz z%F&%1wexGUv>H^YQ@X0`vN0XV5D6!4e&OF2h$Ai)eXrrTCC8Jn3N&IJK_@9mfc1k)%{s>V2;3)nJLJa`T|LiE> zfG7CbQT&8ZBY#AwCC^yJvS)1KQy%dtd-xC7`IHN60dRk<&d9!Yzq5Ruek1DsPSJIP zoC3f<({s;cZ9lk~AJkg^-p#<_DE=RDUrlRuaxF^V3$AXt_SY-fs9)wA+_)hvPeKuq z$&AD!jn#D0a)(YLZ(}#1E;?OZ_(-M>lCV>TIe;!w;iw0PvXoh8EYf`mx6nsaOYLg* ztju?<$S7=k_znsb8`jl+ncSG#c-0CLqHTf7H@va3*L}$(3imE3Hl#(5VW^U+or52t z1}U%9<+esKkw(J<(3RR29!|F$C(kXu40_;eycn@cZDIQ6yZ6Y$o#qcR5ex{m)VL>f zjI@@@KFb1Aw<(^ad!0xvP$iQwCZ=K1!(LhyimFg08{>tHNI%ccL4L#s7IvymoKEhh zoj{Nhx1!Thl@isV#o`Q`23N2N!PTh@swF3|mw_BQ}Px!fbW-r!! zC}oE7{Ntux=J_y-47RtI?||+hiE~xX5lEFQlWa>gT45zTk|6O<>V>`om1SP`NCSr_ z==7+MdXAD$d?<5!N$*H&^J?gQAJ1fwCi62KxyQ1CI*xoHYcYp%bI(0cxbK4ooZLR# zS)X>2;=$qzW#|PrqSCIamyoFwhbCB*hVpCmO-!h^uGv~Dy6FqN7Sxty=uMt}4!UH+ zlC<&kdE~7u(|&pmB9n9Yug~GD$zGoKe@98vS}q*FDnUJ~G+2y>#TfUUhGbu&WJL(B z@s@?`cu(L9G!}ZYG(hS0`i@I|rdnj8DIxSmSCC)VRi`T6BWd|Le%|8z;grD-boZV@ z<5)<|L06^A-o~bZc*yNY-qxDDV&!9D@CHK8Y zNQS~Nk=3-Qq#O+ol;asM@ndV~=W+4Gy4)?5U z)}pPpQrSw z(42b3?v2ph4vucdZr1bs7F9Dnps?^=-RT}O&NS+?VI~5Vw~M!J-4zVb0ipiF+>CT#w<7EnkTy2>+w3kJu)PV*15)37IS09 zw*Yc-vqH6$U7ItAWz=e$AKo3~)spBc?0lk(Z5Pt{2I3ErDtJnw6$7>K+ay*|@00EnC~gr4iaqq*pe`lv-+wLf8vFBH+n3M7$-!&eHf4fK)i7X>A7(@fk$-7# zRsPW=sUQ1TmxfA5m=o)92J6wL;9T~R-g_6l)a_U6TAD_!Bby-_2Wluzh4E=arBn|@ z1lO!x)@;(?8(+PBw>v5->oLXAld6-$0k4r=cM7zZIB*np7Lm9Q;}##pTS+2%-Bn-B0?g~!V_EgaFs;w(o{cPzxVLTH2749S@0cln zyw)(azK_d0$>XK6JnfM$dw2SpkKTZ@N5v=kohLpzxvlRq!tHIHg>SCw1u-~u=7b4k za2u6cUeKIt4N-AHLHAG>h7NgcrtB%<%!PN?Mo!6!u#y4s&^;@cS~< z*4OJvt9ELj;|rn(Nt9;Uo#ybQTRhz7wCXkmj}{U*MN))NQdj1dgim&p732h`+(~;p zrbr~plP**oGeD$YPfgi|5;WL9xgY>doYtCn!ffVgX{s3N?f z%=J5N(5meCY$WF;zk=@#K4Qm;`se-dqFyhF#QJA!zhm^hK0f~Vo=4W6@+>DCOwU6% zLhHmALLBLiYs7Y|j!XJVk-T8TrZOlS+lBA3yiw7|ajq78 z`j!_4t>&euZsuicCSVR06D1H9GXX+Kpt(IwoVYE{c0+Rk0irh%W=U0f8RpXjo`RnC zPWFICALMCo=inmfDFQybMG!bYHABFlvm~yzB4BL=Wss|*qn)j_D+tabzysrkA-F&m z7(kcj;fS#X!Fc$h}*oYjd3U{FA;wIMJbDCCcV{?G^lax~Cs z!6v4sJIOIK|DFr5$=p9@1AGDGg8-TboCyK}I?Ub7&=?W$O=Wq|O)Ezi*WZNoAORj; z1P=lX`Mq8Lr8uB3|G79|0DiBwFpx%20g#JZ+>rvbc%pD99LWuXal;YnFsL9eLJ-c& z4Mhn;p~8?~QUZeo+$wn{;rlnY{*dyATOBd#zz~Wm15H#riyZ)x!T<_E3`o+^>CTzV z55z9X0fGsjP~5;E!9kj62RAgx#K9co=xT+=xcpYHv&?_bOBiz6^FMUWzw9g%Ck2K7 zxx4J`PoKZjbb?ZjW^VR?T2od^1nlN!Z7yhrL_^K_(I{>-4ETV-EKInez`>0`qfN~O z5GF9B$-f>qbF)9|;pB#~J9|RS%^-mA^0Y`7VCY~#Ma<0vEgUiSCa%C7adHC0qGuZ; zLVyPdEGi6q>1qu~GDXjxe{nn4-%jkTPoG3VI}-;>5wIt>IoiU+&CV4pdRIeHR@(>S zYVQQGN1NNB?{EXzaKrfd;0RuR7%v}i3PthpI04;#+PQYtqQ9M-WeoYNuz%?KGZQcY zfl+|`IlV;*K>tU_|6N9Z`80q!CIa?2^;mx+k^S&D{f}A7{?C(?1Hj`>CkNmPPNxUE zl;G*yg2CVj7?c-rHm$%=C>TfvOuzqgK^CCjY%mz=G+4{&0dn}=1{Xk_1{?Xw27~dR ziphVmK~EzO{bYkefee4O!J&LWw1A(|!QlL-L6d&A3GkkVIQZFyfTMtL7(dzINIpeepkGjbx50RUfC@j|3xz`g5&JJTB#ifO z^@9l@e{Ba0hJgNBXDAZr=wI{W;}`hV1_Qk6-}6KMtsPK4)M-qYpX&@X_it^3L;uz` z7>xJtZ4*H9|E*l8fWWV1z~Dd+{!%Us2#)pZn8SgZ{n|D-@-*bd&vgc3E1pKr`KcW+ zIN#~J(9bpm(9yrx;QYXA!e2I5j0qqe#{hw+KoB)+FElVeKtTL0M<9;YDJBkr$U0a! zf=)dK5P(Zo3Zy42B`(E>l#+qN`J`a{D1;PD8ZIs%DGikYfOZ&C3L*O6Qy83vEOK!* X0X8B#os@6^UVeUHXIyC|8G`=@M7MDq literal 0 HcmV?d00001 diff --git a/lispusers/GREP b/lispusers/GREP index 489fae23..2f2db259 100644 --- a/lispusers/GREP +++ b/lispusers/GREP @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}GREP.;31 6115 +(FILECREATED "10-Sep-2024 12:54:27" {WMEDLEY}GREP.;34 6309 :EDIT-BY rmk - :CHANGES-TO (FNS DOGREP) + :CHANGES-TO (FNS TGREP) - :PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}GREP.;29) + :PREVIOUS-DATE "16-Mar-2024 11:16:38" {WMEDLEY}GREP.;31) (PRETTYCOMPRINT GREPCOMS) @@ -115,9 +115,15 @@ OUTSTREAM)]) (TGREP - [LAMBDA (STRS FILES) (* ; "Edited 20-Jan-2024 14:14 by rmk") - (TEXTSTREAM (TEDIT (GREP STRS FILES (OPENTEXTSTREAM)) - 'TGREP NIL '(READONLY T]) + [LAMBDA (STRS FILES DONTDEFER) (* ; "Edited 10-Sep-2024 12:54 by rmk") + + (* ;; "TSTREAM to return the text stream") + (* ; "Edited 20-Jan-2024 14:14 by rmk") + (TEVAL (PROGN (GREP STRS FILES) + TSTREAM) + 'TGREP + `(TGREP ,STRS ,FILES) + DONTDEFER]) ) (MOVD? 'NILL 'TEDIT.FORMATTEDFILEP) @@ -130,6 +136,6 @@ (RPAQ? PHONELISTFILES ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE -5878 . 6061))))) + (FILEMAP (NIL (495 6024 (DOGREP 505 . 4543) (GREP 4545 . 5595) (TGREP 5597 . 6022)) (6062 6257 (PHONE +6072 . 6255))))) STOP diff --git a/lispusers/GREP.LCOM b/lispusers/GREP.LCOM index 1a87767d357f25fdb9566b3a66fde17d7587dc04..05f3ce808d3321abf67b0f4fe8b34e7911752394 100644 GIT binary patch delta 1160 zcmZvc-)qxQ6vvaTcC}M*2$L0rv*<%JT**z7EQv2>%k37HHCgUWZNZmehYiB?VGn{r z!GAz!{s)o0$?&;eLhNVMO18?!sB))C?2D$jXe!}-NnnG~~S}%`dxGn2+IvR{m&QHg8uXi-P+3rO# z-OFgeX$Ts*>js~n)-72ew0<;yx1 z;n(^`t*kYIa=)=T4QVgPW8O>p9D2|NaVW!?1tF&JE6p&nfk!;1ICFsUjOn0!QdSi8 zoq|t#UyPGhYtlMyyZIhQrd(#kmj7zAy2a;1Y#$SDOhk8EI0TS zq?_~;`9;J#9qQondw6-D_picx<+ZP#?alG^ZiNy!E)A>g!CjU4tPVelSv_XK_+u;O z*>NtqxVnMc>ZK|E`f9bBi{aq@eE5HZ$R&=~N>Xu@i>4G@jqLgYLP`U5Vq@>OH9_3X z#c7iDiYnJGxHOopLc^FfVm}%`Y?oO?9GLP{vcbCL?K4Qxm%2frank>il>medley>gmedley>lispusers>MODERNIZE.;7 30816 +(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}MODERNIZE.;50 30912 + + :EDIT-BY rmk :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN) - :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}frank>il>medley>gmedley>lispusers>MODERNIZE.;6 -) + :PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}MODERNIZE.;49) (PRETTYCOMPRINT MODERNIZECOMS) @@ -499,7 +500,8 @@ (FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN]) (\MODERNIZED.TEDIT.BUTTONEVENTFN - [LAMBDA (W STREAM) (* ; "Edited 29-Jul-2023 10:48 by rmk") + [LAMBDA (W STREAM) (* ; "Edited 30-Jun-2024 22:29 by rmk") + (* ; "Edited 29-Jul-2023 10:48 by rmk") (* ; "Edited 13-Oct-2021 21:43 by rmk:") (* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.") @@ -510,8 +512,8 @@ NIL (WINDOWPROP W 'MODERNIZE.TITLEPROPORTION) [APPLY (FUNCTION UNIONREGIONS) - (bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION) - repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN] + (for PANE in (\TEDIT.PANELIST (CENTRALWINDOW W)) collect (WINDOWPROP PANE + 'REGION] (WINDOWPROP (CENTRALWINDOW W) 'TITLE]) ) @@ -614,11 +616,11 @@ (ADDTOVAR LAMA MODERN-ADD-EXEC) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW -9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) ( -11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . -21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW -22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 ( -\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 -29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053))))) + (FILEMAP (NIL (5066 11428 (MODERNWINDOW 5076 . 6616) (MODERNWINDOW.SETUP 6618 . 9567) (UNMODERNWINDOW +9569 . 9963) (MODERNWINDOW.UNSETUP 9965 . 10777) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10779 . 11426)) ( +11493 22459 (MODERNWINDOW.BUTTONEVENTFN 11503 . 18530) (NEARTOP 18532 . 19460) (NEARESTCORNER 19462 . +21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW +22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 ( +\MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460 +29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149))))) STOP diff --git a/lispusers/MODERNIZE.LCOM b/lispusers/MODERNIZE.LCOM index 48ef25e8e9607c16abe3c6125fe5af2bd634bb87..c7e06501e73d20c60ea305a5bccec5c021c2a7b3 100644 GIT binary patch delta 511 zcmZvY-Acl66u`GBhLa$LZUpHtO6G<7chhvE3zz$wvpL6{48t2sNhv?Df*>M-pe~C& zK@SiVBGe;z(`8T4gETEd!E6JyU$m zO|U}Je)DW-bw#UG4QwfzT(%&SfE?CLLsI_|=@dx1uGSzaz+x%C4Rz;biW!?;qAC>= O_=H^yg+~vePu~xht9jc1 delta 564 zcmZ1*bS-E?c)gLiu2*87u91O}iGrcAm9d4Dv5As`hEj5VZb4>FYKlUBo`RABSG7y9 zcdboEer~E=T2W$Nwq0h9U2bYhPHLrHI+V`IEG{T5PAw|7^YwRe4f6Aha@Dgo*HlnK zx5CiM*hopC1Y|>whkA-aW}X6KNkcGI>9vgdf?iR4_KMFf>!(vU2ut^mBI&)(!Dj(3srA=;CMu3=lI40>EtZPsRYL zcmst1M?Y5uPX$AT;1HmTeSu5^g>X#;h6EM{1}2Ae1|Z0QP+TB3Sipf3#1u4S_5d?Z zvhDWTYT%tA6}8g?EDu&0vGs}Pl_gE(@Jy diff --git a/lispusers/REGIONMANAGER b/lispusers/REGIONMANAGER index dbe89ceb..a591907f 100644 --- a/lispusers/REGIONMANAGER +++ b/lispusers/REGIONMANAGER @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}REGIONMANAGER.;133 41064 +(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}REGIONMANAGER.;134 41230 :EDIT-BY rmk - :CHANGES-TO (FNS RM-CREATEW) + :CHANGES-TO (FNS CLOSE-TYPED-W) - :PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}REGIONMANAGER.;129) + :PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}REGIONMANAGER.;133) (PRETTYCOMPRINT REGIONMANAGERCOMS) @@ -248,15 +248,17 @@ REGION]) (CLOSE-TYPED-W - [LAMBDA (TYPE) (* ; "Edited 14-Sep-2023 07:39 by rmk") + [LAMBDA (TYPE) (* ; "Edited 27-Oct-2024 21:59 by rmk") + (* ; "Edited 14-Sep-2023 07:39 by rmk") (* ; "Edited 29-Dec-2021 15:58 by rmk") (* ; "Edited 27-Nov-2021 11:50 by rmk:") - (* ;; "Closes all windows whose regions are of type TYPE") + (* ;; "Closes all windows whose regions are of type TYPE (case-independent)") (CL:WHEN TYPE - (for W R in (OPENWINDOWS) eachtime [SETQ WT (CAR (WINDOWPROP W 'TYPED-REGION] - when (AND WT (EQMEMB WT TYPE)) do (CLOSEW W)))]) + (for W TRPROP in (OPENWINDOWS) eachtime (SETQ TRPROP (WINDOWPROP W 'TYPED-REGION)) + when (STRING.EQUAL (CAR TRPROP) + TYPE) do (CLOSEW W)))]) ) (RPAQ? TYPED-REGIONS ) @@ -730,11 +732,11 @@ ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) ( -REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) ( -RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 ( -RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760 -29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 ( -RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779) -(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692))))) + (FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) ( +REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) ( +RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 ( +RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926 +29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 ( +RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945) +(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858))))) STOP diff --git a/lispusers/REGIONMANAGER.LCOM b/lispusers/REGIONMANAGER.LCOM index 861da4c599897c6d8c897647d7c49859d2684dad..73f93ab4ae069995003d144a2a0655f42970d40e 100644 GIT binary patch delta 348 zcmdnwz1Mp}xQLOtu77fgu91O}iGq=#m8qqbvGK%g^Li6a1ui8cGlZm}p_QSDm5H&E zLQ+v`a(-?>W=?8~LTW`pQL(C(g0qi*u&ZuJWPq!SZn#2bo`RBFsE>~VvH^N}dP)i@ zi6uZ?SWUK2(&W-`^Yn3b4svyr3~_Z)P{QiCYISxK1rtLfV}r@*j0$EbHft(a1q8W< zdHRP2>$*6GxGE?q80q@umx26etYBnpWny7vWTB+MHL+HG^FzjkoYEmd0YUx&3IPg+ z3gHT#3I+-wKWHj27&9|Wp3g0B5XI=g#Q+4;JUKzseh;RI4R;tcOpGC34p%TXQwRZ4Y1khME delta 340 zcmdn%y~%q*xQK$0u3vtcu91O}v4WAYm5GIwk;TMp^Lk@V1ui9INkbzmATqL0Qb;OF zP0r6P$jnJiQAo~6%u7!#R<%+H^3`TNp@Esne85-#NCzn8d2lRlYm4WHx-Hhr?MwXkOFfQVh4N?eDFjNRv@Ki8R2#E}E zRd7=TEDIT-PF-SEE.;119 8322 +(FILECREATED "31-Oct-2024 17:27:44" {WMEDLEY}TEDIT-PF-SEE.;124 10208 :EDIT-BY rmk - :CHANGES-TO (FNS PF-TEDIT) + :CHANGES-TO (VARS TEDIT-PF-SEECOMS) - :PREVIOUS-DATE "25-Dec-2023 12:29:39" {WMEDLEY}TEDIT-PF-SEE.;118) + :PREVIOUS-DATE "31-Oct-2024 17:25:56" {WMEDLEY}TEDIT-PF-SEE.;123) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) -(RPAQQ TEDIT-PF-SEECOMS - [(FNS PF-TEDIT) - (COMMANDS ts tf) - (FILES (SYSLOAD) - REGIONMANAGER) - (P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA]) +(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT) + (COMMANDS ts tf) + (FILES (SYSLOAD) + REGIONMANAGER) + (P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION) + (MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION)) + (TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT)) + (TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT))) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS + (NLAMA) + (NLAML) + (LAMA]) (DEFINEQ (PF-TEDIT - [LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Mar-2024 23:45 by rmk") + [LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Aug-2024 13:03 by rmk") + (* ; "Edited 27-Mar-2024 23:45 by rmk") (* ; "Edited 25-Dec-2023 12:24 by rmk") (* ; "Edited 5-Dec-2023 23:50 by rmk") (* ; "Edited 12-Oct-2023 00:19 by rmk") @@ -80,6 +84,8 @@ (SETFILEINFO ISTREAM 'FORMAT ENV) (SETQ TSTREAM (OPENTEXTSTREAM)) (DSPFONT DEFAULTFONT TSTREAM) + (PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM) + "]" T) (PRINT-READER-ENVIRONMENT ENV TSTREAM) (IF REPRINT THEN (SETFILEPTR ISTREAM (POP LOC)) @@ -126,6 +132,26 @@ ELSE (printout T FN " not found on " LOC "." T))) (SETQ *LAST-DF* FN) ELSE (PRINTOUT T FN " has no function definition" T]) + +(PF-TEDIT-FROM-TEXT + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 26-Aug-2024 23:13 by rmk") + + (* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.") + + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:UNLESS SEL + (SETQ SEL (TEDIT.GETSEL TSTREAM))) + (LET [[FILENAME (OR (TEXTPROP TSTREAM 'FILENAME) + (AND (\TEDIT.PRIMARYPANE TSTREAM) + (CADR (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM TSTREAM) + 'TF] + (FN (MKATOM (TEDIT.SEL.AS.STRING TSTREAM SEL] + (if (EQ 0 (NCHARS FN)) + then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T) + elseif FILENAME + then (PF-TEDIT FN FILENAME) + else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found") + T]) ) (DEFCOMMAND ts (FILE WINDOW FORMAT) @@ -140,6 +166,12 @@ REGIONMANAGER) (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION) + +(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION)) + +(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT)) + +(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -149,5 +181,5 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (782 7802 (PF-TEDIT 792 . 7800))))) + (FILEMAP (NIL (1243 9524 (PF-TEDIT 1253 . 8506) (PF-TEDIT-FROM-TEXT 8508 . 9522))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index 95a8b77b61e8ea462a3ac568760fe2535dd1d0d6..a40d9f66cf78e07fa78012f97be82e1b042f9790 100644 GIT binary patch delta 1923 zcma)6&2Jk;6t`W{(4`T9!lf$cu_%>Ss;!;bFUOUN*WPuq;Qe5C>?EQ{xUth3Tsul! z2_)1N{{d(ZTtFPSa6(9dbI*t~9QX%%<;amYv)wdbLiNErZ{ElJ=J(!j{(k%Sn_q9e zp^;j+yQoo>>Oia}wVJyA&1XhRbp<5(j8|2gswKm{gYoYC;r?Vg9>MtY{e#1`Cd}rG z2b0--n9M-#_Io`znOd*cWf%J#^>2&Eq|CJK{p3M1wUlQxB)hj2glb-&SqjxU-QBDnAg}eTs=Oqjb&48%S zw!FXzx1uq-?5-^B~u(w(6ASAy--DaWR4*P*qM;;tzw|g$=>(=v7y`kly zpj!kwVbHM|=%xvr@@s+ZV>}+i+&GFo(21EnUb>z()&b3cIc^s;3vr>Lfo5tawsiz# zw?Wf5Fp;g%JdI*28zPc`rkc>%w1W+|8wLz0V&laq(1vx&VHFwFG}9u+$fF5RYJihO zc@3mOpaZH}$GgN-fpY+aT9CMm4@bmeY`vaG*SOb>Yi=;`;xO=CgtKlG*c-+178VCY zNWfABNrEGjiXsFImESu1^0J*8v;nM(J35FK6zr?uG1sr<+!_>^$9PweubyiUT*h|L z$iap|4-HM{b%;g91=zIw-42N_`RVEz!lnu(TzUqaE6fnr7RH3-O6 z85(GQEQ4W!{85*uWCzPi#j>*RmpAeAZ>ZK>G`&<}8CBMCu`+t42 zHIhmxZa?=`%B{8t5_zvx%AQz!`pci&DY`F5M=e0wQExBZg?mhJFqw0SOJ`g?E0&>Q>gmkz#J{&+FG#bl@!ap!R`o+_QrRrncs^5XxKvmaJ&Ns@!_P$!Ib l;ONhlugd9#;ExfUJ_=7#kl=HhFN*zw)Y^+d$77LK=|9hu)GGi0 delta 844 zcmZuuO>5Lp6eX?wATC;I-IOASV5MW3A@99>&dPN1Vgs2ZWZrZvbYX3$P_(v=3PKmf ze_+iYQ2YtqyA%X}fg88(#FblbCSq%Gb>F@B+;i?d@AI9nx84jEx!dgSjGEl!7Px3z zc3b#okL^?DH=r9=x{Ltaz@yP{_vrBW;K^_g!&k?n=PPaGQB%nj5fbll>tJ6+aCYh(7f76z=X@@nS{V27`*7^SAC+*boY;1Qoleni~ zc_#9{8pLUs4e}z(VL2WKQIU1S9=#cqe4y%v?NCCuw*r-Q*Ry^aw&;vd1?!1~W${Z; z?$uCO%t0qhI{`^ChRU&pH0VkQl2NkAiwrlEUOwc!5Dd5W6T=Oz+4ky zFCTL-vZCrMFq>agO&gU5a5;KXRbQK{0+wH6o8|kNh4R<*y~1(@R75WM7(4gJG+`rF zvfHdJ@m;7`k(q+dOk}VrmD+-!@2WJiG@-=xD;~z&^4-khglAGP)=Ucqus=FFq$n6= z4TDT@DWk~h$b1LJ>f71I1o^!-yFuZ@%h{>&+1y6?W$t$Qb8bn~%j@%^{62qICpp#0 R@-67+%Qs$Y*U~uAe*-$E(IEf; diff --git a/lispusers/TEDIT-PF-SEE.TEDIT b/lispusers/TEDIT-PF-SEE.TEDIT index d8de5635dbc1827dd432e741a3de6e0a355a9c56..7d5996e23305f6a5a831d75b70190fbc703338db 100644 GIT binary patch delta 1457 zcmbW0&ubG=5XU!7)0*A*qheL8g@IO@Kogo!q!bTLn@tTSX-qaClpbEQukGq)H*7Y9 z6iV?RJ&L@WAc)|_oAl<*KfxbIPhP$FC-~+iZ%I&wSr^W|r(3d|k+vsAJfpq#o=Q9l#A|Xl z%K`t0LSN)jV)|s?rr^8KAe}Z3c+sQ>mSg!ApUOQD6w?X5pwh2IcyI+-2rq-m1kbdG)p}7+ZRVEnBpOBw~t?++T>6q$t>8R+3;-ImUwYk>LF} yh)JMH6Y-b8X&y)ttw|ALv6fI{_F59`fc=AKG7571^Y5Z%k=qB&h7q6QV=z=$7^V8lvn3^_FzKZr>!0fP!51{;Zj(L$^&!dCta zNoQwaVXK}0z)t)H?wdG^@vHLSW@q2NnKv`Lk7Ji!YOSwk4T~RqXrG{iuoybiqs2V*(YOiNH-Y-IH z8)-kcE?i=>2?$5KA#5%EOE^Kb9f{Q~@pBAlA_yY_v<7r!*GjIC^%Ki}erf%G0_&vE zGHsH!#;8mZWH!;WzsFBtmax>TMAX.;10 25460 +(FILECREATED "29-Apr-2024 10:01:10" {WMEDLEY}TMAX>TMAX.;11 25484 :EDIT-BY rmk - :CHANGES-TO (FNS TSP.LIST.OF.OBJECTS) + :CHANGES-TO (FNS TSP.SETUP.FMMENU) - :PREVIOUS-DATE "19-Jul-2023 09:14:13" {WMEDLEY}tmax>TMAX.;9) + :PREVIOUS-DATE " 4-Mar-2024 16:23:18" {WMEDLEY}TMAX>TMAX.;10) (PRETTYCOMPRINT TMAXCOMS) @@ -212,14 +212,13 @@ OBJMENUW]) (TSP.SETUP.FMMENU - [LAMBDA (WINDOW) (* fsg "24-Aug-87 16:04") - (* * Here to set up things like the FreeMenu, hasharrays, etc. - the first time through.) + [LAMBDA (WINDOW) (* ; "Edited 29-Apr-2024 09:56 by rmk") + (* fsg "24-Aug-87 16:04") + +(* ;;; "Here to set up things like the FreeMenu, hasharrays, etc. the first time through. WINDOW is the primary window of a text stream") (OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW) - (TSP.FMMENU (OR (CAR (NLSETQ (TEXTSTREAM WINDOW))) - (with STREAM (with TEXTOBJ TEXTOBJ STREAMHINT) - FULLNAME]) + (TSP.FMMENU (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW]) (TSP.FMMENU [LAMBDA (STREAM) (* ; "Edited 2-May-97 17:02 by rmk:") @@ -554,14 +553,14 @@ (TSP.FUNCTION.HOOKS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8081 15296 (TSP.DISPLAY.FMMENU 8091 . 8656) (TSP.SETUP.FILENAMES 8658 . 9909) ( -TSP.SETUP.FMMENU 9911 . 10371) (TSP.FMMENU 10373 . 11559) (TSP.FM.APPLY 11561 . 11880) (UPDATE.ALL -11882 . 12554) (DOWNDATE.ALL 12556 . 12926) (TSP.FUNCTION.HOOKS 12928 . 14358) (TSP.GETFN 14360 . -14920) (TSP.PUTFN 14922 . 15294)) (15342 17591 (AutoUpdate.TOGGLE 15352 . 15588) (UPDATE? 15590 . -15735) (NGROUP.Menu.TOGGLE 15737 . 16119) (NGROUPMENU.ENABLED? 16121 . 16357) ( -NGROUP.Text-Before.TOGGLE 16359 . 16609) (TEXTBEFORE.ENABLED? 16611 . 16774) (NGROUP.Text-After.TOGGLE - 16776 . 17024) (TEXTAFTER.ENABLED? 17026 . 17187) (Manual.Index.TOGGLE 17189 . 17428) ( -MANUALINDEX.ENABLED? 17430 . 17589)) (17625 23098 (GET.TSP.FONT 17635 . 18799) (GET.TSP.FONT.FAMILY -18801 . 19649) (GET.TSP.FONT.SIZE 19651 . 20139) (GET.TSP.FONT.FACE 20141 . 20840) (ABBREVIATE.FONT -20842 . 22342) (TMAX.SHADEOBJ 22344 . 23096)) (23138 24048 (TSP.LIST.OF.OBJECTS 23148 . 24046))))) + (FILEMAP (NIL (8079 15320 (TSP.DISPLAY.FMMENU 8089 . 8654) (TSP.SETUP.FILENAMES 8656 . 9907) ( +TSP.SETUP.FMMENU 9909 . 10395) (TSP.FMMENU 10397 . 11583) (TSP.FM.APPLY 11585 . 11904) (UPDATE.ALL +11906 . 12578) (DOWNDATE.ALL 12580 . 12950) (TSP.FUNCTION.HOOKS 12952 . 14382) (TSP.GETFN 14384 . +14944) (TSP.PUTFN 14946 . 15318)) (15366 17615 (AutoUpdate.TOGGLE 15376 . 15612) (UPDATE? 15614 . +15759) (NGROUP.Menu.TOGGLE 15761 . 16143) (NGROUPMENU.ENABLED? 16145 . 16381) ( +NGROUP.Text-Before.TOGGLE 16383 . 16633) (TEXTBEFORE.ENABLED? 16635 . 16798) (NGROUP.Text-After.TOGGLE + 16800 . 17048) (TEXTAFTER.ENABLED? 17050 . 17211) (Manual.Index.TOGGLE 17213 . 17452) ( +MANUALINDEX.ENABLED? 17454 . 17613)) (17649 23122 (GET.TSP.FONT 17659 . 18823) (GET.TSP.FONT.FAMILY +18825 . 19673) (GET.TSP.FONT.SIZE 19675 . 20163) (GET.TSP.FONT.FACE 20165 . 20864) (ABBREVIATE.FONT +20866 . 22366) (TMAX.SHADEOBJ 22368 . 23120)) (23162 24072 (TSP.LIST.OF.OBJECTS 23172 . 24070))))) STOP diff --git a/lispusers/tmax/TMAX-DATE b/lispusers/tmax/TMAX-DATE index e7499d96..b2c2727b 100644 --- a/lispusers/tmax/TMAX-DATE +++ b/lispusers/tmax/TMAX-DATE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}tmax>TMAX-DATE.;4| 14846 +(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}tmax>TMAX-DATE.;8| 15021 :EDIT-BY |rmk| :CHANGES-TO (FNS DATE.GETFN) - :PREVIOUS-DATE "17-Mar-2022 23:03:32" |{WMEDLEY}tmax>TMAX-DATE.;3|) + :PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}tmax>TMAX-DATE.;7|) (PRETTYCOMPRINT TMAX-DATECOMS) @@ -82,19 +82,15 @@ (prin1 (|fetch| display.date |of| (|fetch| objectdatum |of| obj)) stream))) -(date.imageboxfn - (lambda (obj stream currentx rightmargin) (* |ss:| "27-Jun-87 15:38") - (* * |Return| |the| |ImageBox| |for| |the| |date| |string.| - |The| |size| |is| |determined| |by| |the| |stream's| |current| |font.|) - - (dspfont (current.display.font stream) - stream) - (|create| imagebox - xsize _ (stringwidth (|fetch| display.date |of| (|fetch| objectdatum |of| obj)) - stream) - ysize _ (fontprop stream 'height) - ydesc _ (fontprop stream 'descent) - xkern _ 0))) +(DATE.IMAGEBOXFN + (LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 25-May-2024 20:34 by rmk") + (* |ss:| "27-Jun-87 15:38") + (|create| IMAGEBOX + XSIZE _ (STRINGWIDTH (|fetch| DISPLAY.DATE |of| (|fetch| OBJECTDATUM |of| OBJ)) + STREAM) + YSIZE _ (FONTPROP STREAM 'HEIGHT) + YDESC _ (FONTPROP STREAM 'DESCENT) + XKERN _ 0))) (date.putfn (lambda (obj stream) (* |ss:| "27-Jun-87 15:38") @@ -102,9 +98,11 @@ stream))) (DATE.GETFN - (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:45 by rmk") + (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:45 by rmk") (* |fsg| "20-Aug-87 14:56") - (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ)) + (DECLARE (USEDFREE TSTREAM)) + (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM)) (APPLY (FUNCTION DATEOBJ) (OR COPY.OBJECT (CADR (READ STREAM)))))) @@ -148,19 +146,20 @@ (DEFINEQ -(current.display.font - (lambda (stream) (* \; "Edited 12-Mar-88 15:28 by drc:") +(CURRENT.DISPLAY.FONT + (LAMBDA (TEXTOBJ) (* \; "Edited 25-May-2024 20:36 by rmk") + (* \; "Edited 9-May-2024 10:05 by rmk") + (* \; "Edited 12-Mar-88 15:28 by drc:") -(* |;;;| "Return the current font. This function is here instead of TMAX because the DATE code is also used in the LetterHead code.") +(* |;;;| "Return the current font. This function is not now used in TMAX, but the comment says \"this code is also used in the LetterHead code.\" ") - (let ((current.font (|fetch| clfont |of| (|with| textstream (textstream textobj) - currentlooks)))) - (cond - ((typenamep current.font 'fontdescriptor) - current.font) - ((typenamep current.font 'fontclass) - (|fetch| displayfd |of| current.font)) - (t (shouldnt "Can't get current font")))))) + (LET ((CURRENT.FONT (|fetch| CLFONT |of| (GETTOBJ TEXTOBJ CARETLOOKS)))) + (COND + ((TYPENAMEP CURRENT.FONT 'FONTDESCRIPTOR) + CURRENT.FONT) + ((TYPENAMEP CURRENT.FONT 'FONTCLASS) + (|fetch| DISPLAYFD |of| CURRENT.FONT)) + (T (SHOULDNT "Can't get current font")))))) (CHANGE.DATE.FORMAT (LAMBDA (DATE TEMPLATE) (* \; @@ -350,10 +349,10 @@ ) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (1378 6167 (DATEOBJ 1388 . 2155) (DATEOBJP 2157 . 2591) (DATE.DISPLAYFN 2593 . 2915) ( -DATE.IMAGEBOXFN 2917 . 3544) (DATE.PUTFN 3546 . 3744) (DATE.GETFN 3746 . 4095) (DATE.COPYFN 4097 . -4629) (DATE.BUTTONEVENTINFN 4631 . 6165)) (6211 8864 (CURRENT.DISPLAY.FONT 6221 . 6927) ( -CHANGE.DATE.FORMAT 6929 . 8862)) (8917 13316 (FINDTIME 8927 . 10706) (FINDHOUR 10708 . 11069) (AMPM -11071 . 11370) (FINDDAY 11372 . 11643) (NUMP 11645 . 11874) (FINDMONTH 11876 . 12992) (FINDYEAR 12994 - . 13314)) (14028 14594 (MAKE.DATEOBJ.IMAGEFNS 14038 . 14592))))) + (FILEMAP (NIL (1378 6194 (DATEOBJ 1388 . 2155) (DATEOBJP 2157 . 2591) (DATE.DISPLAYFN 2593 . 2915) ( +DATE.IMAGEBOXFN 2917 . 3422) (DATE.PUTFN 3424 . 3622) (DATE.GETFN 3624 . 4122) (DATE.COPYFN 4124 . +4656) (DATE.BUTTONEVENTINFN 4658 . 6192)) (6238 9039 (CURRENT.DISPLAY.FONT 6248 . 7102) ( +CHANGE.DATE.FORMAT 7104 . 9037)) (9092 13491 (FINDTIME 9102 . 10881) (FINDHOUR 10883 . 11244) (AMPM +11246 . 11545) (FINDDAY 11547 . 11818) (NUMP 11820 . 12049) (FINDMONTH 12051 . 13167) (FINDYEAR 13169 + . 13489)) (14203 14769 (MAKE.DATEOBJ.IMAGEFNS 14213 . 14767))))) STOP diff --git a/lispusers/tmax/TMAX-DATE.LCOM b/lispusers/tmax/TMAX-DATE.LCOM index c26862d8ca07206923b81b25dfd3d864445691af..0fb3ea8b09a4848bee8cb9c8c46a9f30cb7083a9 100644 GIT binary patch delta 405 zcmZwAu}Z^G7zN;aH7y#!sUSH01cYR0&Ha-!Z3ZzWw>C8O2=~!hwp)Xn0F^Nbn3mEt2&x!14GX=J+vlcce_;>plWFU zuV{Hz+hfhi^X}<<-)J;6C`QBU@u*mOL8ck1-icx!WZV}#1Z|nBfqbPqYpnv9V&Jc~lnEj?^QCrw1i^B{}*BFzBV zV&lj!<*{1+xPL64Dnq63Cw#h5yQ?OoQ;#|;OM60PL2-# z0ul!ke}I##nSU~Mv#11l z8Ed~?Tr)Jypz7pl?{raD6h($;G`Jj(qU9@^T*?>guIE^RV{*p^d5NnogLpwZt1JS{ zs;nZ;(Ln+0KmG&=HB@R)BA!tZ(dieuSy^L}B&E$<93}CY+7#F6tv=BqbW*= z0LEa4?YiIMpn=s50;k0l+YQ^E*;f)dW@8wV%yvR6aNFDufYQGT*2P=;G3%Uh|L|B` zWd^7>{m9&>c4ITgY(gC{@Oifc(mp~G>de5h3EitKZgY4Tqc!}lXU|}g>G^Vkz-ES) kXNDnAeW4)L|0rNJ%)s;glMt|)yc-k5M?fRfjl8w~4JChd-T(jq diff --git a/lispusers/tmax/TMAX-ENDNOTE b/lispusers/tmax/TMAX-ENDNOTE index fefcb004..d1ae6d34 100644 --- a/lispusers/tmax/TMAX-ENDNOTE +++ b/lispusers/tmax/TMAX-ENDNOTE @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}tmax>TMAX-ENDNOTE.;4| 23729 +(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}tmax>TMAX-ENDNOTE.;6| 23878 :EDIT-BY |rmk| :CHANGES-TO (FNS REGMARK.GETFN) - :PREVIOUS-DATE "26-Jun-2022 18:15:33" |{WMEDLEY}tmax>TMAX-ENDNOTE.;3|) + :PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}tmax>TMAX-ENDNOTE.;5|) (PRETTYCOMPRINT TMAX-ENDNOTECOMS) @@ -387,9 +387,11 @@ STREAM))) (REGMARK.GETFN - (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:45 by rmk") + (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:45 by rmk") (* |fsg| "20-Aug-87 14:58") - (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ)) + (DECLARE (USEDFREE TSTREAM)) + (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM)) (APPLY (FUNCTION REGMARKOBJ) (OR COPY.OBJECT (CDR (READ STREAM)))))) @@ -451,8 +453,8 @@ INSERT.ENDNOTES.TEXT 5286 . 6715) (DELETE.ENDNOTES 6717 . 7708) (NOTESREGIONP 77 SET.ENDNOTE.STYLE 7974 . 10647) (MAP.ENDNOTE.LOOKS 10649 . 11416) (GET.ENDNOTE.FONTS 11418 . 12026)) ( 12029 15944 (ENDNOTEP 12039 . 12380) (NOTE.PUTFN 12382 . 13034) (NOTE.GETFN 13036 . 13616) ( NOTE.BUTTONEVENTINFN 13618 . 14398) (NOTE.WHENSELECTEDFN 14400 . 15942)) (16702 19106 (AUX.TEDIT 16712 - . 17674) (AUX.TEDIT.AFTERQUITFN 17676 . 18119) (AUX.TEDIT.TITLEMENUFN 18121 . 19104)) (19191 23089 ( + . 17674) (AUX.TEDIT.AFTERQUITFN 17676 . 18119) (AUX.TEDIT.TITLEMENUFN 18121 . 19104)) (19191 23238 ( REGMARKOBJ 19201 . 19608) (REGMARKOBJP 19610 . 19804) (REGMARK.DISPLAYFN 19806 . 20052) ( -REGMARK.IMAGEBOXFN 20054 . 20405) (REGMARK.PUTFN 20407 . 20878) (REGMARK.GETFN 20880 . 21234) ( -REGMARK.COPYFN 21236 . 21774) (REGMARK.BUTTONEVENTINFN 21776 . 23087))))) +REGMARK.IMAGEBOXFN 20054 . 20405) (REGMARK.PUTFN 20407 . 20878) (REGMARK.GETFN 20880 . 21383) ( +REGMARK.COPYFN 21385 . 21923) (REGMARK.BUTTONEVENTINFN 21925 . 23236))))) STOP diff --git a/lispusers/tmax/TMAX-ENDNOTE.LCOM b/lispusers/tmax/TMAX-ENDNOTE.LCOM index e41e9d7f1ab007af3fd8ebda3d40c4d43579bd6c..0a0b86755c7f3abfc02467a11c578a2da5cee955 100644 GIT binary patch delta 200 zcmbOjI3;jGpoo#Fu2*TEu91O}iGrb#m4Shkk@3V-D=D)YO$9C`BNK$Ik+GGrrIn%C z#GOWL5b=p0MJ+K^7#S*Qa%s4E`nWm=xjKfpx+o}Nvt+V8qZWr*je?P}g}KG#LPjSs tG`kF}Ow5%OxF$O?YA~8^{>1oRnk_g4Xrk}r=duYb0gisIn?2+_xd8DkGYw_}dHT3I2e~?ixVk7PVOnBhKG~j8i^HTw!N}O$$Z~Qaqm!7K zu2*Ru$R$P!h89+aK)Z~U6u2fkGHNgyZ~nyiUYgA{BE;XxYw~m11jg{q-g2H?08BeF AEC2ui diff --git a/lispusers/tmax/TMAX-INDEX b/lispusers/tmax/TMAX-INDEX index 2dc053c1..632ca011 100644 --- a/lispusers/tmax/TMAX-INDEX +++ b/lispusers/tmax/TMAX-INDEX @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Mar-2024 07:51:29" |{WMEDLEY}tmax>TMAX-INDEX.;4| 46587 +(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}tmax>TMAX-INDEX.;6| 46698 :EDIT-BY |rmk| - :CHANGES-TO (VARS TMAX-INDEXCOMS) - (FNS INDEX.DISPLAYFN) + :CHANGES-TO (FNS INDEX.DISPLAYFN) - :PREVIOUS-DATE "20-Feb-97 17:58:09" |{WMEDLEY}tmax>TMAX-INDEX.;1|) + :PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}tmax>TMAX-INDEX.;5|) (PRETTYCOMPRINT TMAX-INDEXCOMS) @@ -123,12 +122,14 @@ 'indexobj)))) (INDEX.DISPLAYFN - (LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 16-Mar-2024 07:46 by rmk") + (LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:46 by rmk") (* \; "Edited 14-Feb-97 09:30 by rmk:") (* |fsg| "17-Sep-87 11:14") (* |;;| "Display an Index imageobject. If the stream-type is display, then just type Index or Extended Index followed by their args. Otherwise the stream-type is hardcopy. In this case, type nothing and replace the CAR of the hash array entry with a list of page numbers in which this index appears.") + (DECLARE (USEDFREE TSTREAM)) (SELECTQ (IMAGESTREAMTYPE IMAGESTREAM) (DISPLAY (CL:UNLESS (EQ 'INVISIBLE INDEXDISPLAYAPPEARANCE) (DSPFONT |GP.DefaultFont| IMAGESTREAM) @@ -139,7 +140,7 @@ (PRIN3 (INDEX.STRING OBJ) IMAGESTREAM))))) (LET ((PGS/IMOBJS (GETHASH.INDEX OBJ IMAGESTREAM)) - (CURRENT.PAGE (INDEX.PAGE.NUMBER (\\TEDIT.PRIMARYW TEXTOBJ)))) + (CURRENT.PAGE (INDEX.PAGE.NUMBER (\\TEDIT.PRIMARYPANE TSTREAM)))) (COND ((LISTP (CAR PGS/IMOBJS)) (OR (MEMB CURRENT.PAGE (CAR PGS/IMOBJS)) @@ -866,17 +867,17 @@ (* |;;;| "IMAGE OBJECT for causing the index to be written, without using the menu") (DECLARE\: DONTCOPY - (FILEMAP (NIL (3112 10886 (INDEXOBJ 3122 . 4145) (INDEXOBJP 4147 . 4595) (INDEX.DISPLAYFN 4597 . 6265) - (INDEX.IMAGEBOXFN 6267 . 7813) (INDEX.PUTFN 7815 . 8245) (INDEX.GETFN 8247 . 8638) (INDEX.COPYFN 8640 - . 9275) (INDEX.BUTTONEVENTINFN 9277 . 10884)) (10925 18798 (INSERT.INDEX 10935 . 11522) ( -INSERT.INDEXENTRY 11524 . 14291) (INSERT.KNOWN.INDEX 14293 . 16370) (SUBITEM.SELECTFN 16372 . 17366) ( -ADD.NEW.INDEX 17368 . 18796)) (18864 22795 (CHANGE.INDEX 18874 . 19442) (CHANGE.INDEXENTRY 19444 . -20194) (CHANGE.XINDEX.KEY 20196 . 20754) (CHANGE.XINDEX.ENTRY 20756 . 21389) (CHANGE.XINDEX.FONT 21391 - . 22260) (CHANGE.XINDEX.NUMBER 22262 . 22793)) (22837 30558 (GETHASH.INDEX 22847 . 23514) ( -INDEX.PAGE.NUMBER 23516 . 25095) (INDEX.MANUAL.DELIMITER 25097 . 25788) (INDEX.STRING 25790 . 26800) ( -GET.INDEXENTRY.NUMBER 26802 . 27822) (INDEX.LIST.REFS 27824 . 29314) (LIST.OF.INDEXENTRIES 29316 . -30556)) (30600 40804 (CREATE.INDEX.FILE 30610 . 32489) (DUMP.INDEX 32491 . 34911) (VIEW.INDEX.FILE -34913 . 36177) (GET.INDEX.FILE 36179 . 36569) (WRITE.INDEX.FILE 36571 . 38972) ( -WRITE.INDEX.PAGENUMBERS 38974 . 40174) (RESET.INDEX.PAGENUMBERS 40176 . 40802)) (41002 45056 ( -SELECTION.TO.STRING 41012 . 43844) (SELECTION.TO.INDEX 43846 . 45054))))) + (FILEMAP (NIL (3074 10997 (INDEXOBJ 3084 . 4107) (INDEXOBJP 4109 . 4557) (INDEX.DISPLAYFN 4559 . 6376) + (INDEX.IMAGEBOXFN 6378 . 7924) (INDEX.PUTFN 7926 . 8356) (INDEX.GETFN 8358 . 8749) (INDEX.COPYFN 8751 + . 9386) (INDEX.BUTTONEVENTINFN 9388 . 10995)) (11036 18909 (INSERT.INDEX 11046 . 11633) ( +INSERT.INDEXENTRY 11635 . 14402) (INSERT.KNOWN.INDEX 14404 . 16481) (SUBITEM.SELECTFN 16483 . 17477) ( +ADD.NEW.INDEX 17479 . 18907)) (18975 22906 (CHANGE.INDEX 18985 . 19553) (CHANGE.INDEXENTRY 19555 . +20305) (CHANGE.XINDEX.KEY 20307 . 20865) (CHANGE.XINDEX.ENTRY 20867 . 21500) (CHANGE.XINDEX.FONT 21502 + . 22371) (CHANGE.XINDEX.NUMBER 22373 . 22904)) (22948 30669 (GETHASH.INDEX 22958 . 23625) ( +INDEX.PAGE.NUMBER 23627 . 25206) (INDEX.MANUAL.DELIMITER 25208 . 25899) (INDEX.STRING 25901 . 26911) ( +GET.INDEXENTRY.NUMBER 26913 . 27933) (INDEX.LIST.REFS 27935 . 29425) (LIST.OF.INDEXENTRIES 29427 . +30667)) (30711 40915 (CREATE.INDEX.FILE 30721 . 32600) (DUMP.INDEX 32602 . 35022) (VIEW.INDEX.FILE +35024 . 36288) (GET.INDEX.FILE 36290 . 36680) (WRITE.INDEX.FILE 36682 . 39083) ( +WRITE.INDEX.PAGENUMBERS 39085 . 40285) (RESET.INDEX.PAGENUMBERS 40287 . 40913)) (41113 45167 ( +SELECTION.TO.STRING 41123 . 43955) (SELECTION.TO.INDEX 43957 . 45165))))) STOP diff --git a/lispusers/tmax/TMAX-INDEX.LCOM b/lispusers/tmax/TMAX-INDEX.LCOM index 58f9c29d5d26deaa6cfe8bbc7b4859d856adf2b7..546ccc8138462254fb680af5d9aa0de8e3ce905b 100644 GIT binary patch delta 272 zcmey-#rU?1aYCSok*Tg%X`Zf;fsu)Vp^=q=ft8W*#8iuVvl>kWE+r!qgshRVm9eFj zp_!6GO;S;6a(-?>W=?8KjY3UoML|)qRgHqDpNngRo{ML2fRAIOo1a2WW?qegl3S>c zj{>qedU|?5BT^DeK$@{xVPvSJsm!I}=IP_=9OUX4;_9NHgw2_gEg3a9%xV-&%*-q; zCTB9rO`glBCWhu>11l4AB?Yd@){JV5rknpUE@5N~4gs3#J9!23W0n9%KiADYEN>hD D2)9Yf delta 264 zcmaFc#rUI(aYCSop_#64Vv(+qfsu)Vfw`5bp_P&4#8eAElNwD0E+s=#gsh>Zm8q$f zv4N68O;S;6a(-?>W=?8KjY3UoML|)q6_AmaUy_lTmkwlQ=G7=DxrO@pC_qe@_)*jn zi&>^hnp_%go<6S5L9UJ=t}Y5n*qk%jo>7Ctq(;HS%+$hsaz3M+NSI?#utJEhV}!1! zpNngRv%hb!=HzZh4G{xfx6~wEOLGN7pjRxc3@nutxF$O?sxcaF{=m3|k8AR0O8w7+W-In diff --git a/lispusers/tmax/TMAX-NUMBER b/lispusers/tmax/TMAX-NUMBER index ff89d130..4bae9822 100644 --- a/lispusers/tmax/TMAX-NUMBER +++ b/lispusers/tmax/TMAX-NUMBER @@ -1,13 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}tmax>TMAX-NUMBER.;3| 33943 +(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}tmax>TMAX-NUMBER.;6| 34833 :EDIT-BY |rmk| :CHANGES-TO (FNS NUMBER.DISPLAYFN NUMBER.PREPRINTFN NUMBER.IMAGEBOXFN NUMBER.PUTFN NUMBER.GETFN NUMBER.COPYFN) - :PREVIOUS-DATE "18-Mar-2022 07:06:06" |{WMEDLEY}tmax>TMAX-NUMBER.;2|) + :PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}tmax>TMAX-NUMBER.;5|) (PRETTYCOMPRINT TMAX-NUMBERCOMS) @@ -94,13 +94,15 @@ 'ngroup)))) (NUMBER.DISPLAYFN - (LAMBDA (IMAGE.OBJ STREAM) (* \; "Edited 16-Mar-2024 07:46 by rmk") + (LAMBDA (IMAGE.OBJ STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:46 by rmk") (* |fsg| "24-Sep-87 14:56") (* |;;| "Display function for numberobjs. Allows different formats for display according to the use to which the numberobj is being put. If no specific action is specified, displaying defaults to printing out as a plain number.*") + (DECLARE (USEDFREE TSTREAM)) (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| IMAGE.OBJ) - (LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)) + (LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM)) (IMAGE.TAG (IMAGEOBJPROP IMAGE.OBJ 'TAG)) (OLD.FONT (DSPFONT NIL STREAM)) (NBR.FONT (SELECTQ USE @@ -140,14 +142,16 @@ (DSPFONT OLD.FONT STREAM))))) (NUMBER.PREPRINTFN - (LAMBDA (IMAGE.OBJ) (* \; "Edited 16-Mar-2024 07:47 by rmk") + (LAMBDA (IMAGE.OBJ) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:47 by rmk") (* \; "Edited 18-May-99 22:51 by rmk:") (* |fsg| "24-Sep-87 14:56") (* |;;| "Returns string that represents the number object, for plaintext put. If no specific action is specified, displaying defaults to printing out as a plain number.*") + (DECLARE (USEDFREE TSTREAM)) (WITH NUMBEROBJ (FETCH OBJECTDATUM OF IMAGE.OBJ) - (LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)) + (LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM)) (IMAGE.TAG (IMAGEOBJPROP IMAGE.OBJ 'TAG))) (AND IMAGE.TAG (OR (TSP.GETCODEVAL IMAGE.TAG MAIN.WINDOW) (TSP.PUTCODE IMAGE.TAG IMAGE.OBJ MAIN.WINDOW))) @@ -159,46 +163,51 @@ NIL))))) (NUMBER.IMAGEBOXFN - (LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 16-Mar-2024 07:47 by rmk") + (LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 25-May-2024 20:46 by rmk") + (* \; "Edited 16-Mar-2024 07:47 by rmk") (* |fsg| " 4-Aug-87 14:56") -(* |;;;| "For Endnote numbers, the YSize is the current font height plus 0.25 times the Endnote number font height. We do this so the the Endnote number will be superscripted but not too much.") + (* |;;| "For Endnote numbers, the YSize is the current font height plus 0.25 times the Endnote number font height. We do this so the the Endnote number will be superscripted but not too much.") -(* |;;;| "The YSize is computed as the current font height plus half of the NOTE or NGroup font. The reason is weird. Ask Sami for more details.") + (* |;;| "WHY ARE THE NOTES HUNG AS WINDOWPROPS INSTEAD OF TEXTPROPS ") - (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ) - (LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)) - (IMOBJ.STRING (MKSTRING NUMSTRING)) - (NBR.FONT (SELECTQ USE - (NOTE (|fetch| (ENDNOTEFONTS NUMBER.FONT) |of| (GET.ENDNOTE.FONTS - MAIN.WINDOW))) - (NGROUP FONT) - (ERROR "Undefined USE field" USE)))) - (AND (EQ USE 'NGROUP) - (PROGN (AND (STRINGP TEXT.BEFORE#) - (SETQ IMOBJ.STRING (CONCAT TEXT.BEFORE# IMOBJ.STRING))) - (AND (STRINGP TEXT.AFTER#) - (SETQ IMOBJ.STRING (CONCAT IMOBJ.STRING TEXT.AFTER#))))) - (AND (FONTP NBR.FONT) - (DSPFONT (FONTCREATE (FONTPROP NBR.FONT 'FAMILY) - (FONTPROP NBR.FONT 'SIZE) - (FONTPROP NBR.FONT 'FACE)) - STREAM)) - (|create| IMAGEBOX - XSIZE _ (STRINGWIDTH IMOBJ.STRING STREAM) - YSIZE _ (SELECTQ USE - (NOTE (FIX (PLUS (TIMES (DSPSCALE NIL STREAM) - (FONTPROP (CURRENT.DISPLAY.FONT STREAM) - 'HEIGHT)) - (TIMES 0.25 (FONTPROP STREAM 'HEIGHT))))) - (FONTPROP STREAM 'HEIGHT)) - YDESC _ (FONTPROP STREAM 'DESCENT) - XKERN _ 0))))) + (DECLARE (USEDFREE TSTREAM)) + (LET* ((NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ)) + (IMOBJ.STRING (MKSTRING (|fetch| (NUMBEROBJ NUMSTRING) |of| NUMBEROBJ))) + (USE (|fetch| (NUMBEROBJ USE) |of| NUMBEROBJ)) + (FONT (SELECTQ USE + (NOTE (|fetch| (ENDNOTEFONTS NUMBER.FONT) |of| (GET.ENDNOTE.FONTS ( + \\TEDIT.PRIMARYPANE + TSTREAM)))) + (NGROUP (|fetch| (NUMBEROBJ FONT) |of| NUMBEROBJ)) + (ERROR "Undefined USE field" USE))) + (HEIGHT (FONTPROP FONT 'HEIGHT))) + (CL:WHEN (EQ USE 'NGROUP) + (SETQ IMOBJ.STRING (CONCAT (OR (STRINGP (|fetch| (NUMBEROBJ TEXT.BEFORE#) |of| + NUMBEROBJ + )) + "") + IMOBJ.STRING + (OR (STRINGP (|fetch| (NUMBEROBJ TEXT.AFTER#) |of| NUMBEROBJ) + ) + "")))) + (|create| IMAGEBOX + XSIZE _ (STRINGWIDTH IMOBJ.STRING FONT) + YSIZE _ (SELECTQ USE + (NOTE (FIX (PLUS (TIMES (DSPSCALE NIL STREAM) + HEIGHT) + (TIMES 0.25 HEIGHT)))) + HEIGHT) + YDESC _ (FONTPROP FONT 'DESCENT) + XKERN _ 0)))) (NUMBER.PUTFN - (LAMBDA (OBJ STREAM) (* \; "Edited 16-Mar-2024 07:48 by rmk") + (LAMBDA (OBJ STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:48 by rmk") (* |fsg| " 5-Aug-87 08:24") - (LET ((WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)) + (DECLARE (USEDFREE TSTREAM)) + (LET ((WINDOW (\\TEDIT.PRIMARYPANE TSTREAM)) (USE (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ) USE)) (OLD.FONT (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ) @@ -215,14 +224,16 @@ (ERROR "Unknown NUMBER ImageObject type" USE))))) (NUMBER.GETFN - (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:48 by rmk") + (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:48 by rmk") (* |fsg| " 3-Sep-87 15:17") (* |;;;| "If COPY.OBJECT is non-NIL then we are COPYing it to this window.") + (DECLARE (USEDFREE TSTREAM)) (LET ((NBROBJ.DATUM (OR COPY.OBJECT (CDR (READ STREAM)))) (NEWOBJ (NUMBEROBJ)) - (WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))) + (WINDOW (\\TEDIT.PRIMARYPANE TSTREAM))) (TSP.SETUP.FMMENU WINDOW) (AND (ILESSP (LENGTH NBROBJ.DATUM) 3) @@ -255,14 +266,15 @@ NEWOBJ))) (NUMBER.COPYFN - (LAMBDA (IMAGE.OBJ SOURCE.STREAM TARGET.STREAM) (* \; "Edited 16-Mar-2024 07:48 by rmk") + (LAMBDA (IMAGE.OBJ SOURCE.STREAM TARGET.STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:48 by rmk") (* |fsg| " 4-Aug-87 09:46") (* |;;;| "Here to COPY a Number Image Object. If we are copying to our own window, we delete the TAG if any so we don't get two ImageObjs with the same TAG name.") + (DECLARE (USEDFREE TSTREAM)) (SELECTQ (IMAGESTREAMTYPE TARGET.STREAM) - (TEXT (LET ((SOURCE.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)) - (TEXTOBJ (TEXTOBJ TARGET.STREAM))) + (TEXT (LET ((SOURCE.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM))) (APPLY* (IMAGEOBJPROP IMAGE.OBJ 'GETFN) TARGET.STREAM (LIST (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| IMAGE.OBJ) @@ -585,12 +597,12 @@ ) ) (DECLARE\: DONTCOPY - (FILEMAP (NIL (2562 18335 (NUMBEROBJ 2572 . 3678) (NUMBEROBJP 3680 . 4220) (NGROUPP 4222 . 4576) ( -NUMBER.DISPLAYFN 4578 . 7583) (NUMBER.PREPRINTFN 7585 . 8717) (NUMBER.IMAGEBOXFN 8719 . 11110) ( -NUMBER.PUTFN 11112 . 12284) (NUMBER.GETFN 12286 . 14471) (NUMBER.COPYFN 14473 . 16156) ( -NUMBER.BUTTONEVENTINFN 16158 . 18063) (NUMBEROBJ.TEDIT-TO-TEX-FN 18065 . 18333)) (18336 27507 ( -COPY.NGROUP.BRANCH 18346 . 19802) (DUMP.NGROUP.GRAPH 19804 . 20680) (NGROUP.BUTTONEVENTINFN 20682 . -21382) (NGROUP.DEFINE.TAG 21384 . 21987) (NUMBER.DELETE.TAG 21989 . 22248) (NGROUP.SHOW.TAG 22250 . -22572) (CHANGE.INSERTED.NGROUP.FORMAT 22574 . 24369) (CHANGE.NGROUP.FORMAT.#TEXT 24371 . 25957) ( -SHOW.INSERTED.NGROUP.FORMAT 25959 . 27505))))) + (FILEMAP (NIL (2562 19225 (NUMBEROBJ 2572 . 3678) (NUMBEROBJP 3680 . 4220) (NGROUPP 4222 . 4576) ( +NUMBER.DISPLAYFN 4578 . 7732) (NUMBER.PREPRINTFN 7734 . 9015) (NUMBER.IMAGEBOXFN 9017 . 11607) ( +NUMBER.PUTFN 11609 . 12930) (NUMBER.GETFN 12932 . 15266) (NUMBER.COPYFN 15268 . 17046) ( +NUMBER.BUTTONEVENTINFN 17048 . 18953) (NUMBEROBJ.TEDIT-TO-TEX-FN 18955 . 19223)) (19226 28397 ( +COPY.NGROUP.BRANCH 19236 . 20692) (DUMP.NGROUP.GRAPH 20694 . 21570) (NGROUP.BUTTONEVENTINFN 21572 . +22272) (NGROUP.DEFINE.TAG 22274 . 22877) (NUMBER.DELETE.TAG 22879 . 23138) (NGROUP.SHOW.TAG 23140 . +23462) (CHANGE.INSERTED.NGROUP.FORMAT 23464 . 25259) (CHANGE.NGROUP.FORMAT.#TEXT 25261 . 26847) ( +SHOW.INSERTED.NGROUP.FORMAT 26849 . 28395))))) STOP diff --git a/lispusers/tmax/TMAX-NUMBER.LCOM b/lispusers/tmax/TMAX-NUMBER.LCOM index ce014f7dd2352f0e1f467f49ff460be4040bbeef..9224fad97270d3fd23b2f7e5c279f77636deda3e 100644 GIT binary patch delta 1159 zcmZWnJ#5oJ6!y8l2~tT!h)|&L8X;&@TG_tXN!q1Oa*drI$F*IcRoRM&I)E6E5EP}b zAXTcMcw?Ya7dBM-BS3&yL4plctVpn;E-Xx(?~=CA8_sv%``-7??|aYhtloY+8B^5Z z@~!K`iln4LRz@Xh6yuevxrDZmf^bqv??)9pigTl~w(|NxH^=>P6w4i^C~`6t9-J_% zq~H+UBSlCauA*Rn8Kru(1;FVn_TQr?(f^ese+gYc>gKYzA$GeS)v9fhuAz=jTeryO z&E5!Vq5i|rZwC7J!cH~~1~E&92R2}ss9V87fhm{JuMB3bo-dD3HPb3lKmu#3mM0Dc z{Xb#cRKeqwQXqWpLPFK;{W@(SBMEX8aE{sE5!GSiD@h3U05;tieMt2->S zy7P7Z+hVmFf{`>Q+JbK*m}tMw=$9 zd*@6Rh~v~9NNc{-8*k3eQh!Zv#CFV@?o0>HfSiR|g$vU;kaOIHB5@0jX?rwR)-YIg zk3dcXtK`(DY{+JqRR>6Fx*fv`XRFjay+o*0RF+neK#GkhDt$MGWRgy=5_~d>KM(@{ zY~N&iX72WlAwC|jj{a{d34*O6-c>R=0a9jl`AE{mQv_ zV#oH6n*S>{fJ{Gf{KS~t>b9(D{O9>_deb&-GtTTa#CGb`CrN@5@eJKHAgB7@PsN*A z6=r93+a^{~fs6)K)AdGlt3X`pg9~`SrA$GQDgCgaE!KYRz*gGywjJ~-3V3=6_C4d# ae&!Zn_O1zwz7RZe*<}lf+6q3oC)5A#xuL5x3sIv)?KiymYqH(-_%XN*okK6FkF1nd!$L|{GN88E%7(R zxILKj(^tx5GXL<*D#@Yr%gVoGl73c=uUHVaV|{BJ3W$J0Fv1Ew5pfXq5HMlHf>56X zVRt-9SI%074MMeT0?|*A(y7g*60ToMHBu6l%&Za8*GO(^=~t)yS-G!iLEbmc{sEqFhg{y+wvirfS+p?#`o^PJbda;?zI2thdUN}p0svsu& z$%{Ox{_(ynD!kus|M@w~o%~(7JzdAOTDnXf6FNI_%tN7fgCrWVUBxA}9q1-e(qTgm zGfG`hoKAwS=mRzVEGk*2CWXvUa|dd8(v9LV(%*6y9N$@RJXM7`t^=KM*kJ-p$H=!q z*m6(cnOSTffo}tk<8cgj3wm7WJnV*J!R4tFpdO62^XX&J&6}viKft{#tJp*~h0yI-;j=IcZrR6}jJKh?v!#W&qY(f&;K*PrlY!nQ40Z9mZ z@pvZ!$15z`P=yXEmi0J_7S9IM#Sc=a4tNeUcJA!$zw_Rm{XIyHNw&~;^TPpME?&rS^Ic;{IFFsmbS^XFBOW$y42>6FYS@O>?d9F%j)QGc{p8v>yzQj zkG1mQUt#*sg-c|R*6J_L{Ctw8XDJqNaGZ_AZiMvN_6ajeN~kNGcb_GFFp+JMM0z%V z#jMWam?6^?N6w-MML_|lIt&t_v#`SxoO1$p_J2@pW6$h=;TP-x%}W2Tmh`B;b`>RA d)SxC?AXpDvvl!!I)bdhtu}-}C+QrH%{{e1)IT-)| diff --git a/lispusers/tmax/TMAX-XREF b/lispusers/tmax/TMAX-XREF index 8b0debc6..ff8ca52c 100644 --- a/lispusers/tmax/TMAX-XREF +++ b/lispusers/tmax/TMAX-XREF @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Mar-2024 07:55:53" |{WMEDLEY}tmax>TMAX-XREF.;7| 23813 +(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}tmax>TMAX-XREF.;13| 24116 :EDIT-BY |rmk| - :CHANGES-TO (VARS XREF.DISPLAY.METHODS) - (FNS XREF.BUTTONEVENTINFN XREF.GETFN XREF.GET.TOOBJ) + :CHANGES-TO (FNS XREF.GETFN XREF.GET.TOOBJ) - :PREVIOUS-DATE "16-Mar-2024 07:52:25" |{WMEDLEY}tmax>TMAX-XREF.;6|) + :PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}tmax>TMAX-XREF.;12|) (PRETTYCOMPRINT TMAX-XREFCOMS) @@ -110,20 +109,18 @@ (prin1 (xref.get.display.text obj) stream))) -(xref.imageboxfn - (lambda (obj stream) (* |ss:| "27-Jun-87 16:39") - (* |Returns| |the| |size| |of| |an| xref |imageobject| |based| |on| |the| - |string| |that| |will| |be| |used| |to| |display| |it| |which| |is| |found| - |using| xref.get.display.text.) +(XREF.IMAGEBOXFN + (LAMBDA (OBJ STREAM) (* \; "Edited 25-May-2024 20:34 by rmk") + (* |ss:| "27-Jun-87 16:39") - (dspfont (current.display.font stream) - stream) - (|create| imagebox - xsize _ (tedit.stringwidth (xref.get.display.text obj) - stream) - ysize _ (fontprop stream 'height) - ydesc _ (fontprop stream 'descent) - xkern _ 0))) + (* |;;| "Returns the size of an XREF imageobject based on the string that will be used to display it which is found using XREF.GET.DISPLAY.TEXT.") + + (|create| IMAGEBOX + XSIZE _ (TEDIT.STRINGWIDTH (XREF.GET.DISPLAY.TEXT OBJ) + STREAM) + YSIZE _ (FONTPROP STREAM 'HEIGHT) + YDESC _ (FONTPROP STREAM 'DESCENT) + XKERN _ 0))) (xref.putfn (lambda (obj stream) (* |fsg| "29-Jul-87 09:08") @@ -132,9 +129,11 @@ stream))) (XREF.GETFN - (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:49 by rmk") + (LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:49 by rmk") (* |fsg| "20-Aug-87 14:59") - (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ)) + (DECLARE (USEDFREE TSTREAM)) + (TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM)) (LET* ((XREF.ARGS (OR COPY.OBJECT (CDR (READ STREAM)))) (XREF.OBJ (XREF (CAR XREF.ARGS)))) (IMAGEOBJPROP XREF.OBJ 'REFERENCE.BY (OR (CADR XREF.ARGS) @@ -155,6 +154,7 @@ (XREF.BUTTONEVENTINFN (LAMBDA (XREFOBJ STREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) + (* \; "Edited 20-Apr-2024 12:56 by rmk") (* \; "Edited 16-Mar-2024 07:55 by rmk") (* \; "Edited 26-Dec-2023 11:56 by rmk") (* \; "Edited 9-Nov-97 08:09 by rmk:") @@ -186,7 +186,7 @@ 'RIGHT NIL T 'INVERTED) (AND NIL (TEDIT.SHOWSEL HOSTSTREAM T) (TEDIT.NORMALIZECARET HOSTSTREAM)) - (RETFROM (FUNCTION \\TEDIT.SELECT.LINE.SCANNER) + (RETFROM (FUNCTION \\TEDIT.XYTOSEL) (TEDIT.GETSEL HOSTSTREAM)) ELSE (TEDIT.PROMPTPRINT STREAM "Reference has no definition!" T)) NIL)) @@ -252,12 +252,14 @@ "/" reference.by ">")))))) (XREF.GET.TOOBJ - (LAMBDA (TAG) (* \; "Edited 16-Mar-2024 07:49 by rmk") + (LAMBDA (TAG) (* \; "Edited 25-Jun-2024 11:59 by rmk") + (* \; "Edited 16-Mar-2024 07:49 by rmk") (* |fsg| "13-Jul-87 11:13") + (DECLARE (USEDFREE TSTREAM)) (* |;;| "This function is called in a specific context where a reference must be displayed. It is called by an XREF object and should return the IMAGEOBJECT that the XREF object is referencing.") - (GETHASH TAG (WINDOWPROP (\\TEDIT.PRIMARYW TEXTOBJ) + (GETHASH TAG (WINDOWPROP (\\TEDIT.PRIMARYPANE TSTREAM) 'TSP.CODE.ARRAY)))) (tspobj.gettype @@ -476,14 +478,14 @@ (FILESLOAD (COMPILED SYSLOAD) TMAX) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3691 11273 (XREF 3701 . 4268) (XREFP 4270 . 4657) (XREF.DISPLAYFN 4659 . 5093) ( -XREF.IMAGEBOXFN 5095 . 5747) (XREF.PUTFN 5749 . 5995) (XREF.GETFN 5997 . 6526) (XREF.COPYFN 6528 . -7138) (XREF.BUTTONEVENTINFN 7140 . 10246) (XREF.WHENDELETEDFN 10248 . 10822) (XREF.TEDIT-TO-TEX-FN -10824 . 11271)) (11274 13249 (XREF.GET.DISPLAY.TEXT 11284 . 12568) (XREF.GET.TOOBJ 12570 . 13098) ( -TSPOBJ.GETTYPE 13100 . 13247)) (13250 19624 (UPDATE.XREFS 13260 . 15643) (INSERT.REF 15645 . 16057) ( -GET.REF 16059 . 17114) (GET.REFERENCE.BY 17116 . 18103) (TSP.LIST.REFS 18105 . 18557) (TSP.GET.INCODE -18559 . 19213) (TSP.GETCODEVAL 19215 . 19437) (TSP.PUTCODE 19439 . 19622)) (19716 20687 ( -XREF.ADD.DISPLAYFN 19726 . 20240) (XREF.GET.DISPLAYFN 20242 . 20685)) (20747 23109 ( -NGROUP.XREF.DISPLAYFN 20757 . 21717) (NGROUP.XREF.DISPLAY.TEXT 21719 . 22355) (NOTE.XREF.DISPLAYFN -22357 . 23107))))) + (FILEMAP (NIL (3626 11427 (XREF 3636 . 4203) (XREFP 4205 . 4592) (XREF.DISPLAYFN 4594 . 5028) ( +XREF.IMAGEBOXFN 5030 . 5655) (XREF.PUTFN 5657 . 5903) (XREF.GETFN 5905 . 6583) (XREF.COPYFN 6585 . +7195) (XREF.BUTTONEVENTINFN 7197 . 10400) (XREF.WHENDELETEDFN 10402 . 10976) (XREF.TEDIT-TO-TEX-FN +10978 . 11425)) (11428 13552 (XREF.GET.DISPLAY.TEXT 11438 . 12722) (XREF.GET.TOOBJ 12724 . 13401) ( +TSPOBJ.GETTYPE 13403 . 13550)) (13553 19927 (UPDATE.XREFS 13563 . 15946) (INSERT.REF 15948 . 16360) ( +GET.REF 16362 . 17417) (GET.REFERENCE.BY 17419 . 18406) (TSP.LIST.REFS 18408 . 18860) (TSP.GET.INCODE +18862 . 19516) (TSP.GETCODEVAL 19518 . 19740) (TSP.PUTCODE 19742 . 19925)) (20019 20990 ( +XREF.ADD.DISPLAYFN 20029 . 20543) (XREF.GET.DISPLAYFN 20545 . 20988)) (21050 23412 ( +NGROUP.XREF.DISPLAYFN 21060 . 22020) (NGROUP.XREF.DISPLAY.TEXT 22022 . 22658) (NOTE.XREF.DISPLAYFN +22660 . 23410))))) STOP diff --git a/lispusers/tmax/TMAX-XREF.LCOM b/lispusers/tmax/TMAX-XREF.LCOM index 50915cf92a03018896802e677781237afc3c3918..00eec93a5fcb893c87ca49c6c57e1e72e0c0798f 100644 GIT binary patch delta 486 zcmZXP%}T>S6os)g72>MsMijXOgceN5O!}jPo3xpt;Oyx_ndpqcRyNF_I$F1i*jQ$kgWmuPw1R~-38LF}lNvS+KWp%v{KsPO#uyLCyp5e0plRtw1(-^D3Q63gut=dGp=zMSplT8usGH%@o2DIrY7k zOw&Sgklt@21f1StO2B-}skJSG)uFhkR}3rgY&}#M?J)i^E`sSg%%DNlw>;+hfXe?i v+?5xT_w;9mM^e3+yb2F#Pj~2~lz9=>J0WueYEQm40%7hTS%2nu%Ie!c2!@03 delta 465 zcmZvYJxjw-6o!-9SdA1~{Gtx!5GXW5V?LV3W{b&xyk?+HAOp+u4;_>KWGLCup?}9FfeBJeYWMgDe zsaa{+6f&ZLfs7rB=f@NbY2nD z>Shn4z86NM;iMUh5vr-`pAl?pme0MiWtm}^oVA)x#^SS?yf4+ZRSnXL9+e2iUT`q* z9NGcJNUHU%E+`5(r00eK1s&`NV-(QuYMCq+>zV=C<{)BYuSY`+YWt6pQerVV&p$1r uAr1ErlZd-!2eTLMmRlz%{S%dZFF+Eptsp>ncC|*hFZ8j5Q*^g%RXzYT33uZF diff --git a/lispusers/tmax/TMAX.LCOM b/lispusers/tmax/TMAX.LCOM index a807e5459747596ec31c2ffe535786129624bc4c..f2adb0bd24557a0b8bd9b343cff33313c65afc3b 100644 GIT binary patch delta 411 zcmeA#Utc^ST*Syy*Rh~T*T}%gM8VL&%D~Xd&|qS=T78JGV}u=u(6cr))KuV7GO|EY zXk=w*VP$Bpq>xmUnw+0okeQR3qL5lqP*kjHr4SMvpcm{K5*ncA=IiU~7pjn%r=a8( z>f@t;Y=)kmo{~aJVhKmQaOH;urAjmb$(?2v=*9B<7WK~8TUSw|@ zY`)L?X<>VL1_lO3hjbvxzy%_<3L$YgK_UVS8b%giuR}d;WUS!s8WQg5=i(ne vd9SFHDwl>KP=RYiNN@?ymk$UV5NV3J3aDlWVgTN2oCXN=Rm| delta 898 zcmaJ;O>Wab7>yH%AW~722!yiwWI+{2*c#hOS`VnIYmXCG{t06{X?6{5R3chhC9SB0 zP>ujqPJlQ7i_$}I1vZEiz!4bRNflIyS-qKg-^}~@I{EnSQ*ZW#D|6cAn>BoPJh<2l zU42)2E+YX7Jk&*ZFcuZ0)Bz!^BHYk;cr_mGpB$f#j)n&?yf__Cp5och!b3883%nIM z4lIvJlElNo;EZu^zb9i<=Y>MmvK?YjqKCwsedeB({}BR8quxZb0r#Zu*g+`ymgH~m z5F-o(z#U4uwjTwe$%cWKHF4+sC>E>&(y&~|vdY8zo=Z%J^gp~f8cj~mC&Te%bLk6B zD9kR`%2&U+AGxWH5Rw6#8-;2IWC(1GYla>gZIO~NqMm3`->pFhPhcQ^qRHrh6knDy* z$l`E?m8z@(_I&E<4%-MTVbGD-V^K%4T$gy!La7Qh!}m-(w0%!(>mIX9#cd|T_F6$K zS4rijQY=Sr#fLJ~I@C7^F`4>+FyeG!Y*{nd%n*aaag7w4|>y7!3?&dPw zR^qr2+rDlWS2KGtiYmj=NesG`VlHPV>68-UpKrN#iMy`!9^~Wu?^2Pwa{0&zt1a8xbXEeDqLJNs3BJY8q)CMiQR&77%&dSekcC~3pX+RXp} diff --git a/lispusers/tmax/TMAX.pdf b/lispusers/tmax/TMAX.pdf new file mode 100644 index 0000000000000000000000000000000000000000..01cc7406981d54c5739e802f17879fd1b8f67115 GIT binary patch literal 51894 zcmb5#Q+qP}nwyV0#uWZ}4*=5_d%`V%vU1zTS?{jYE&HAr0M`S*kw{Jwo zAX5|-r(>dLg(e%lj4Oa9Ba^aqwKFz!wy?A1CbTznHfJz%BBWEKBcwA?5fT?u{$~`i zv-xMi!pOqf!r4O>;0mzj`{w{cI*0$=C$FF=q^2VF&rV?>RS`)-Iww&vbtw@sK6?{W zH%AL+z&{ZuXA?UYXFh>{rV1|3_Abui7S@3OeEv5#2|%+EG7{PuSwi#jGROjK&792% z+5d?sGyHRkGr*CMLEPHV86XNUwle|n^Fup1I|2-Cpxyt(Xllo8u%r0A)Dk`y7o$3p6I$Nd)h3rF94W>074PyRQOLvncf z_uEgSBXiua19FsG5^IEUy|j9kImyJhHQ&uPT2iN!@Z@Kr3BS(3jky#pKE=4Zc(V~mrv>Z}Rf1*Ad9ew;h&TlYY^vUgRDEzo-CYL-7hI>h9 z9^l6uQ>;T}68)cg1AiAAacPTPuo=5M#W$omYqZRFvNyKZK(0*2;jF{YTgRjfljwW_5A zfRWTm?#ig)nWRvWT<i`7ZBn_rV5Oe&zaw4i6Rp)0;^gt$SoaW}_a)DTHNfm~az_Ny-5d+EfcA!>>9Dy~(!0XZ9LVTxfvYB+g;$`L?|9OCRtG6)V8eAJJ#dULc{E23 zJ0{H1ExADX>N$&xAZ3IGhfnNB*Yaa480!V@`{3K)mTsjLA?K%tMj^AKx=QXPuN1y^ z-Im&R?F(Ld^k9zS=5-2_SROm<7%x_{SJHG;`#t>;Hm1s^(>4pkh9;*S5_d%M=WwBh z2lY$3mAxu%=nKdJAZg9BoBwDeI2jO^NSVW>DA`q6-9!oIFS3S3`h~`8Kr7s|1PSah zt45J=Iq-y1cY?~MQTj(Emw%`G=kYDuz3p3c+r=Q&_{V#hZjh+v6vh0geIGu-!w&QZ zmu8p;K%fU%*%N?i5K4nAsl)kN%>`tMb$3o*a}ZA8bVxM3Msi=mSCCGp0=(OLOFEiP zU3cKWDXudt>UH;mg&?onu9AFD)1_en6kSopl`+vZ)yO}yZIeR&=Xdl9#9Odpq2M#~ zWYi|J{+hUYNnY|B{M*xId|(hbTl=j+!A2*KC}|ub4M?vEG=6b15Hw~yeuPXxT%uJ9 zu-0-2@k;=e%Q)!RUFm+&<&v5MauT6ge1LOd7g9dWD)t_3T`fE% z{ZCJt#@f#kB`?DKR8h8))fUK66du4UY?0#0ojIE?Dv{HjopNZJnvLvhZL?N(GSK=qOl4~sZF!2s&u&xcf6IAhZ zi_d7TU4h3+%Yym!M(T5FDJR{2KB$lrZ3ai4I4cs)!thg3%8iso7rEaDc0qyf#U`t* zZj@Y;bfE4j#4vWSJnyz`efR?XUM&@S?@`G}t_?|6l0wK5t@LQ|Hw1AMyJ?%CwpRYMO+#SCNm&QhS*lcfZ(;%&Wfls;`jAXoo461lBIZ9G!)% zXh8MC4P=%r&}($L_0+pL2x{aM6ZBV{I^>%1>XptU=fgu`22FDEY|fI=B6ZFDK#Gam zY$8yp5a8Vv8g-Y&7$-HoD9nFv$U!0nHT(lZ8DSBiG}tY-(<1}ca`I|Id6G??>_Qg+ zvX9J-<&=f64kimTOR+gis6ki^SN}e4Bl|f3zhECm9sU5#32*M2%S^6O_ zuG<%G1ccUmT#eaw^R8pESZjsD=4vvD5tCw6wf+U`?;FL7BixDNj-|N^#UWJvJ9&8q zifW+oT3C^l3A=HVABu4Z8RYw)2hfly9WJ@5m9LsNP__RLCJ?B7+h>9c5KVg5V# zey%8h_sEjtg|IBNowuH(s)My7BrWcO!FFC7*qL}I_tD7Z$=VZSe_ou@il{rHc*T@^ z{8u%BpGtIZ>){oKKz2;`TR1e)Nh1)X2DUXfzZFv?b=XG;^qw!bE@%(&)iFgVh*w$KIq5 zbm(n!r@sr!-Ha&}^ER-i4nt zQozM~yjWIqYTWs++a%JLm%OYqCT)LC2 zeohBrv^(s?JL)5(DK%STteG}xj$RM~#6~4jO!rXEzJ`S!a7Kg9(qy)G;Ls7*>S-iz zZ&@pReF4`p_<$+;1$-*LdR1hLuAWq^zH#Fq4l)22W>V*s>i*g)A6!ysYak?eo#%G} zm(X)2`y70=r^v6q7}4E@OzEWI@b+MWPH@v^#(8FU`##(o#mr}cA5g7+NREKPR{ zbd_Hv(f(smn-|$t;MqGZR{}kj^mkU}t{$iQPJE3vFp=WL6W?i@#0LF3vFj)y=y%=q zR><#R9n4UL6K;euqUiyB0}kN7Ohjva8cPN$RqQq9bzw^5ht5mC7?a&+y@mYpGZ!QWkVuMAe+Z2eYr3ztj)qQgz1i)|kS<9d z%<;6I@OU38n%`?ZDXOtQ2)dA7zC1m95Dp>Cy{~(}zwpGv--TE7jRvkwQ-4}vc8t2z z^X^z^VFng%99zcIOF?h;%kUn)jFweCD!W~RCjAFZMSwr|W)wwpnrCu$MZYTub;RJh z`MOd%p3_M8`S`Fsj!TDkD}uSN#^WqPlD4#U=UDJG53#VbJ5_g%LKDlUrvqHNR|~P; z??bQgc{$(A@@MY}fWO6KZdYTRz z&kOx>`A(=&?vQ)*y~#09GsvWneVo|f)>eljD=*CQeQ%%oGRNFfqxDVT$fmyyd5bPo z^uv=7+vroSG+TPxi}CYh?iz(o+|!sv5{N70FP&`H8-kEyHt)YRDHW{Yvg>JGu|%r= zfayX4^6YUe+SV7?`MY&89rh(hQF_vNU1j$P!rjvu{Wh)vsfB3`SratGvFm)7|2ohF znPyB+&Ntf;TJHMSK1;M!a?5F5fZ_)jBy}ntU~BTf`2T12pM>E*X~KU-7DhHM=>Lr| zas4ZsU}pU9(us}44R&Oo+*-l6VaJrvW3iR>(ujkihUS*W*p|fVY#)C~Nnu%JW}w)r zUIn)U;drNrNww!_(SlBeT>dRMKY&GIJ?c-J-{dhlU^J_i1IuS(QvfjNySml&)isRZ z8iw;>KeEiF&7fhuvN?6n(J5fZ4&&NMnFzO`#=+vt53_CY+4Y-DGhtu*RxGo~s-<&t zDqU&n59r0=ok=?P97A!1+N8U7{Z?3~z-ow0;hK=kWre4=P_7sig2u?2&~m|1jN~eX zdq946YwpU-ptjvTJ4s<D?V69LgzuK8@k~~-wPE}?1A(9SkA#u#WaO?7HtuZF z{rB|h6LGWNtSd#pj>!dS+%BCXj`Vc1Awt)+4X^Aulw=mI6bNYJ>^>p)d}`pAJ>G^k zUBQD{GH!HJNf#bxmqUC(4WXP%HGKnLAYW5xIn4(=JR5!}uO_-NY7-;4p42KrH&exM z>vV)3c-riFm8M_lBYVLW(sSd2)-{m*OO9{wmJv!FP01Jl2V+QA7sXLC5nyqhumMYI z0R4TAi*#+aFXXIo3)6+NBkjQMf33He*+&@t^o2t#Tb>Edzj)vuuZj+AHs2`;ew&4R zZrbSb4UoD{q}+gb5;NDp@h|4DY#9(K=Z6o>>IuSL73&I7&?>SD(;F;BXh4qCl^;`a z9N54n1E$rX0@lNRBlOPH<{Tkdt*F^^;Y8>uOoMMoc~4$_-Cf)aeGX_9E%HvFO=Yj) z9oNyR3EU?n{JTqA^oh;*g<5Pfh&1mb&GP^(1c~*yBiJYWZz*3TvDL< z64)$*7o5<;{o!FA9UGI=`dT)iVXBa>`v{aH9hZlCswlHOkoJBq zV8^_-IsI;jtCp%~IpFE1TDW6S8)1ydf`RsdZbb8WY+rYjg0f7V5NrJkX7fa7QsvZY z&oRdHN`m5hH|PcxSar!^;PHF~K|$8Lt$^b_0BQ{lPh*WsQMY z^wf~qT;x6RLSe7|V66;a;vWOi05;}W<13bv7LdGvN~$yvljT}lm~OzLVIUP!>T*qB z^7V!6t+TuBD%G(9u5hD+2UG1a%cJNPZD8SR^IxgYjl|$P_L1lZ;+ruPYg0K2G8GnD zwudy|w!2&g?hyajuI6BZ>WGEH8kbZ96C^$O)QcKE%%j(Wi|OUUm(7RV|)B#R?A%%?e>zk z$d0EG2ksdw%33~#US0|?d6B-Rz@6|y1vD>qC51wB3)x5`n1=~xuIMP7WE15<)%qG< zefj}!IBx_|Px}74j6(*Df+d~vuL zjzL4)Ma(3`)3Q;VM)BX(MFQRJ2rv?jAvVLaCV3pMXIECjk zB(d8Fw4wS)twZvri!!W*vIBIa-1%T1QQRv?lPXzF0%!LTo)3gp7*6fM%n$;GQrXgh zU{WUdG4{QcTW7ltfEzpOTvTRV4NOQ1A!#lXcToGF0-sY&WsQuw|r}gCJyK4su~0)x1z; z_R3TgMkyH_%jn!6dEw_HpcH*sOzI!TBuqW{qD1K$;fXS_n+#|LlA@iCS5U#J1k-cV-)* zkXb#$)m9H*@^wNWo3chFTtvps72M9n`SsSwDoR}NM_sEf?ZXSNV0vN#71EIhxo;K zU!L8F`m+vQV^FKhzu6sA4j;qURJ**_aLKh-J8tA>YH!c(!#dE%x6?ia`xwn+#$0cN z8D-%rEk8ndM@xdkiDd;h0?jzo6Tx~T70L4q4w2&Z(35+xbI|k`PH^OT>apM) zRw7ooY_pL!i78X2&iTGJDK%y4pm+BZ;;>HnkkCMWFvQa(hG2SZf1F^V?}BUSk8NBC z*^ZoWC_x-2&tEpHaPPx%G|DE;2rWz+j^t&YR>wXDTV-grjmLG+1S};lh5@)w`-~>% zmsB5`-e=->KSHlK3vzrR)e&Q}P5MI?%YbTc7K0o9uXla-MR0805sB%(erZNHWA#X{ zvhL}OzN>5Kp#8PZHIG9_3hXDu_cc;lcnIZ+MKf4MzLoYh_d1 z7(OVXz3OhO=7RUte3q%h0w?@NclgaX69sM`@f=QX8E_MS^qmxTi9(#B7a@$&)@ongN(5vC_%7e60$&o zgIt=LpGbD8k)_@3RAG^s9W1v4MRyVdobt6nDi!MpPtrzc6}I~{^Hf08~*S>uO2Gt zk}9Od$oe~-?OrQ35B=6`9^3pUA_+BYUlUq|mv3CzI)w|;DSlr>yJbR>&NXb`+=K%E z2KuhvuI2SSBAMJldjER+2%-1jSRu~t?AaTME}zDBXx`EA ziBm1!`D3r}6%5!mUxh1`271s>T1VaMQ_CVBU}e&oG+0S+cSr~2{+di`B&Ih`Xw{5v zfm-U2T1TJZGw?wdyRWkuM-Xm57r|Q}WLCv>L95m014ZMrGTwbD$%+HQ()cv7o+RpY zvQjBe(=--jF)GimQLz#fqh*rdu5SgnN#fAHFlt$QTZVaDcc;?J*sM&PsiqcsS0`$q z2=_>=zJwM5;*S#czJG=+6ldz=Th6y^P5|SxckdnYaGRB`o2{*Fw)wn7u|4kX z6zwapN7(Ktseh8`uv~6dG=h_QU{^ON89XUn%RX6?WJ$akbw7vFE-xbni@Gk&a0^T9 z6L^))yJ0V>TxCl!4z48^VxyGanOO{dY?oQJ&}qyYnc#>?H8E`Tgi~Qx;o?XG16gCY9K6d6sZvI4kuo(e72OBPr(5;SwJSwR^6SLtuKC8-#qq zZRVA1Ty@3P)};QrRl9|u9UnvhZ;xlvfV4M0r?cq4VGoz{EV162k@~U}s4BPGMVmv5 zfT^rikW@=zOvG6Fp}UtSe^i8!%!X64N__2o?ODKJlg?Wy*CWdi5_63i=gv|BJ|o!o zMTFSJUP4&s#{&1LO?a(mBx0`vj3k6<@D3XhG@%&gFMwp)#WBX%2~s#6zuSsg?9K?G zBtw476EVm4;h=X2UP9BAHk_jUQqvruP@8C-*5vkoU7*?*6|$~wVyiaKwWMm%t^Xj75ywfMS0NP+ zX+Vy%gU}bs9bvDH-CC?rs)$wWvYfQkNSAKb$dta$ghqUIwy(B7^m1hen5(3aS(rtY zxSutR@*KkOR5KS%FNH3!@H*s}L{UO{`p35gH&gw*x{{Yo*)XN0@GlQ%xNMZi=Bf6V zJdcMqy70x(e1lpoMR@A+EzC1P(9F{qqpj#+5u?gu6`;37?jhOIs!C`>9onNq0!P|` z*G9%K-(V^rv01`14ho+2EQARWC35%wUR|)SXhz-E!hBoO*)2H{%s3HzphVku+j$IH zdoLK(-94Sfl`(go--dXET!kFG{S*2G=|i%Sb6@NqHU5BK@4asREaAh8s%;VP!4{~c z++7f*Z*}dj41p`v;Hy+0dh59|9%w$5tWc)T{a(Oj!Il828(^EGTc8}PGmDLYOY2yM z3R5ij?(Q<~vWjKGLzc!>_I)N;{*Am^u2ZGp&BmkyYv>@`PjfZ52>n!XSt*}|^#Ncj zAh$3GAWZ0hNLoIw5cDO04b(kiP+kcA4onLVd4_H4G3c&C#Mv0&6cM-YcvMw|(maL! zc16nEJqyVPlBrQ{a&8Z29^Ja>$(p=)Dx2JFuaaJ#=gw7Ef$5MV#*%1CCbFQwvpelb z8C+Jr>Kk4sDC@Eo)gGEXu}j-LHt2jJEpbS0mkN=A!>&j&t={9Ovzim%t530^(qeIC zPV^PV1>%og^m_MWYpN)meBS46vP!!=c!N0&dECm;kA{!`E8J+wfpvJgH~y-Q8`p4J z=2VZbSFm#6f*GmbH>ZR*N;q_o!Q~uIv$gCuJoN@JZ6A)#U#W-5a+^s@_0$0>sKme9 z{3G9Bpc<_m1*fW%%0AqJpAan6iSN(}eW{^C2@JT3(D-spIUbqk_Q^g5Z%4Mqy{o{k z6jt%h@HZ1}Y=`(&0lgwp%cQFQep(SA5?)WF}O!eK(U24T_F?UzHB zc~*|n#_^f%t++lgO^vL>4mC6UUp*xjs9-N9>@?j;p{LDz;HzcZLtg_zAhLTJj)nOc zj0JA4N61-wiX=^*qUkZZ2QmL&`)h|@@bD=RgTTOnoSTa6G1eozXs-VTzVgSv;HvF1zL|QZ#+kK`ivmNREFM zC@1^nX)n-j3{Hc^S+aR9nB6C&PEl??=diV)4O?3+;B~R7r!7JHLi0Lfp8N0`b^-yT z>__Br;-=pwlwU-VEKGv+wDb)|iEBlS!P_H2`?Biq6g#KzNHjo3a!Qtn zu*7l_`HlF^;{9s>V!m(nsps#)G;);wOF#i`Fh|HEM=}W=w|qilwT(upJXU6RfSPsOguV-WTRqs(v%s{KG zn7r|7g$Bf2zFN;bg+MtyM)m(ju%AhGM?1p!b*<9RqNI-7@u`(pzmSm&hYzGI(E<|r zv55b*@hweHi|f|jaAP?L&%-(7dbY+Gg-D!9;$FkZLjiGc?=W(B`RSI9Xb!tWme-}2n3D^C;jxL&IHmP~5 zd^WT>{HYHGh%5`PdoiIUHd$)QX*U7OTS;cHSBa-Ni?6pNe>nOcm7&{Qh;bP%0)vlI zzw4FWwAB>f(hWk)U3?PyrvA>U(NLuB$xDl@7trMoW32u-q0^k0D597A#wr`rMn%N zzKU&z8!UcDPWJA*j-5khI@alq?~KQfg`)!2w%-wcKM-(!_QwC#|9@2fKl#LAXIQQ!U1m(Z%~g1O;1B#OEgy@P1|a! z>fKRU!brrPc1M~ToRTEHa6MlvKfWQ3MMnA?_mQ1@ZRF7Q@kPI<5b}|dJJfl#m9@kE z*zf9R#vngLjaF$*)l%BIw!idzvE@yr$8bEaWgXSI*14TtLVp3`(`4*9KoKk znsZ}1fGa~MT_|5r)qEa}-hh5{QD7U5OtI#pk{u78MwRfQTWTrN>+(0EWxkjyiyK+n z`^=6=q_(SM$X6LKjuG3ReL}tNS zD&wFztJo=VOp77FAoG z7^%ELQdMI!6Rq#OCF3u5@mnY2qLdTLP0NOx$-3)5f`cyFD52LGPJ1x#d3=j4T-sdv zR;YXKj_J!~>CR_5AUDqZwwy$YxAeLx!@C|# z9qV96cOs*S3Q(FW)=~LKPCYXahW)S3RxtnGa(rux(h$CNU!2lw%bNBr`07HV3hxyG zq~XtbS|{y9szU?pR$bj&p7IXp6R7Ela*zi0KoBQeHU<7e)f)s(7RR|^gjG6G>MmJs z3+Fl~c~iR_v;L;}5wh2La|Stob{wZE`7@w&x=ktY1%#yI8~RI!^@-s&sYd*_>~TXT zsObl^?GQ<(P!oOd5x2ZIWJJ)43%)f(P=^mlcDZ5cn;5rGX92}fnr|<|yv8n}iOyuy zVAX-M-Rg(R<9URDRFgB+Fv{4frd|p7q>46`BO<*EavCC*(X*7|LV&yfDFw3Ka1RGx z%?~^(u@LGG9RsZ;#Kd}_*8_ zfgJ_Ok%)>hJkfW~v75yY=#kQ>tMpyWd+k0;>&_ru;Fhw6fPE6t#w5^`6!+W*x*~#V&3IB~C+=#8D%tp96ZQgzr+IM))_;L3>YLAE%nv(zi zr!(fB*9p){BS+C0W$vo4god{md9>EfhA}6F9BRdw{k3RmhOer(iO31lOhK#Y8e1Hg z^6BoeOUlRS7~hd}$W4_&5b}h5>$1&-W`s4RW=#Fd{5f|u+c`OvGZN1#5S0fka<6X| zIel(g3drcGpDZ9eA@9OEtQ`{e5DxaFn@Xy-56i}66g4M4-kHQT6CafJV~So3{`N%1 z!s$XeX3CY}k>YaFQdlV#W&|EJ5*UskxdV~hl^Z=~M;^iVxyvsp)1-tS^vaT(ARx717 zLz2`Bew+g#wmX>TG8I;8?&s{W!R=Pg9pv4qRO-S`b zX(YUwjP4RCK(F~RYfdR;M|F;{#*DOap{W-4Dtn@!EO~gEu*Sb7LD<2yTSgtfV~%7a>pj1`!SNKbYVI) z9#91A0~*&D%3(Sd#L7zHx|X6%u0WwSH=r%lcwGxPfDVA4r4YJn;h3gVP>;`_6zV3q zEb;X|LJRmTVU4PT=aZdaYbo#0YVb*sKHE6 z$$5#zNc#EJOU$#%ouj`bX==}*kdzqnlw|=A;jbUW)<>vAurWd;rl|N5Cf_pZ_3lZG zU9o{wV9W+ZQiaU0>wEI_jPNjYiqlKyCX$gIuOb zd$1!;=1_}OLw{R3@p(a?3?{g-e(N(!6hqF4PDF zvS$DzW9doif-RYqHv`-*sQxRQsbfiMQq_AY{$>^*T7M>6} zQ4hAHnC0~pjFJ5u&iVn#ifb-MZZb%MH62D3n&=vF2+ZVXR_m2dNLf@;kZgas%stC- zt@zXX7`DPUtFA{)(ThtmVg=mj=Z1sG)i?g?F>{#hCo)sQwCszp3fH4O$v|#gS1syv z`Loi#78$f$wCTT;)`w>URvwC+x%JC2G6}A#BFs^-MNJa;+V-!Gi1!1FOqq`m-zFCB z4~h?hQWyc^buv?SmVF7FXl2H7&MbYiIXb_&#oF1P;U9@|Q*S+LN?fAKcA`vLII$3B za<;T2q+Of3WTp4jO2s21IY?Eok-6chh&*C)VZG16b_6~u3x$^j0<3pr?EnVD-`jEL zXWfHqGnen6Rss0iwB$GPjQz)fvpz#S`~~hF!CR<8P-Hh;NTSfE`#UhYy~v5L7*^!9 zs^0NXK*D|xz#|_>Tb?Q)aJ4Yv_EH6_m2pApDz%Tr3;#OcqVAXlMm`lU}^3a(7sJ7mgoZv*g3J5^xp)bD3`)!%@+PJ5tx|eb*$328DEnm?G7ss+&zN78IPRQ6t zl2`#V&=hv(H`l|G2m6`VvMc#TG?&$W#L4dbTR}T^H{T(-0>9Q~=(qk&_5Tq3|0~pU zvHoAGvoQUO>MYFv9o7Hoq#r@^U8%)<9kvpjL=#g=I~t)=s!G|bWO^Cy+d-+^Y>UIZ z3g?F`3oRF>7^Oo{ZO`cOWf7&;5{Kh(eKL#W8aJM2;C=bED49L^$J4(Wui=9_B}!d-v`6U;%?nQno1beYHU2v{?Poq6c3irmm0LgNzvuKt zZxiA+k3EJEY!35BP2hIu3rRzbA%TVwlBvW(`Hz2HuEO)zN3`78N+|Gt9++4bIN=S~ zhcU;ZLy1TwbA5d3U@r+fuR$?pR90RQsuSKCEVkD#VFiWdC9B({0Y-3z$R_d;sxSep zyywt!VEmI^k>gB_9P3(DYiL^{b`?Pu#LW~tz&H>|YZFc9RX8U{D=IAebjm;H-I(Px ze}lzw3xHm)S3_#pqQfy4>D*nIGYf`q=Z!`@b1GBOSTsEDHrY&TrYdV@$i7DbNPG4R z48-^Dz~Wnm@yC+Uwf;;964XL}?!}W)J;JZIJmNZwhYC^S>Dp7AGc!}{F&48e z5D@rWfXTMHwsLrX%0A1V3k2%!_o8pwT%lrv8X-OeOH={<}M7YI*4Q zeOdSN2EiP`wDC-i0mfnbiH)Q-8u)6OpQfr{SR;B(v?~=>+1zgM)9UzH78SOw^G3-P zZp@H^*gALgc@ZUS0DLK23tTcOf|1d8X(j6dKtniRO8sFvf77L69__83+l=};8kXt= zO`UpgU1D}hA0t@VXH!MXxw+$3iY>NEVu>H_oGBmZp^U;!m%nTT7IZi$V3SaY6Q(y@XzZk%|{(!zURyky5Wma{B5ES34+|^27pNNHW3GLv1^Yo!yBS<1S zT^-^B8Z!pucS)uB!3MbThWx3ncvkf&P(v!S;8BNC@i^WRoRD*ps0HtwFS};G4E3+O zGA>%Nwq`zT;Db3XGph<=cyIPHiCY2|l&=;z|6Leneo@Dj^SM*(4q$ghRkICFxK(^k zk>Nsj9n>?iB9TMa*6bEYrv4i?)hlYr2@KZN<(sW;;ea(0Lf9J2Il(;PUe6R}oZC#T z%#hV5_%CR&5M&&Pgn%v4Ukjs!mic6No$Yx>JOIbDqlEYQK(k$?zdF666lK~y9i|I6 zTEOUW=e%J$i7iB--69=5%(ptNO9zg3u2~SnlbfOGCNc9fvN8BIK%FRObS+AM+|M$i zc)8VgJh9#;23*pqwU4=}E#uY2_)vdH`>|$5@8QW|%(kAax0S$cghoM5X!dkiXQd~7 zJdcxeh{IDuQGL<+%=1)L#cVhcuKE9A60K)g;3Iai6Ydo-ZhLw^!Y)>)aQYB>Y0$fe z^*a=JSbqn;H{OeBJ*Vxg)4s<_oJ^FYfdx_VuiZv4fiW$Bg=hUI4BwPfN7H~38n7D= zl7JCQ_1Fg5@~^u>PW;Jn#w^+(_B|eG*|rU$6iw9y6;I`~eIFnL9}@=iDc+4n;MOv} z!*Gi|!p7bcY@0Ib*`-+uuY{lHT#^c>Yk^lf3J1=kTO|23HONB7_i_xsAI~zgZw%rX zUS9O8_QjQeRitv(^K|3|bm-SUhDv^1!FC0xn*msaRf7`#b(mQUA=4N5L|UNNMGB5< zP)y-p$ewHi;M&dIO{6+*l`~m{V+Ygd)sH^H`^3HW{I^`tHrl-D)LN!5Jx{zoA(~Rl zN^>3p^}K1%eR!1S7mP&USJ8aeFdwA;r5_%{%)fu#W=T2Dl10`n(3-3kX{L=Wn@!QV z1#)-=sbgWz)=ZdcLL9hcj|0O>fU{E^`M(J6c#k%N$4I%tZsCyEv`L_{_IJGv7ltC^ zg7S@;(iVDnolA{?`SUuH1dnJvcnFtt%Mc5$L5hP2Iaabxwbw7gGosv%{B?zpHW&#b z(a1ybKh5eW@2VO4Q_OMH*WcIIn(;=HpG z5iD^7OuYWS{K3;|7_Xb}FHH0OtqswB6UGM40SwghjtORWc}ukYl?j&t(cR6ovzt74 zhJ&%!x-nVU%DXW9eYhs*u5ITH{=6;!bLTWB+8rua5YXdRHSug&XkwH zpPH=|z*}HUw|{!o5`?O$YP|L9=>Bde9M1p8k=o#AoYk9WEEpfsk zqYaXDV>lR0zK)6|L!dAQ8hUgEm-%7J40sje0E-?4y>WCFJAhC=FZdDg!gLTl z7akYF?`o8)6I|}E2@wnAM4)RRa|ko}YrW8L|5UF1P%yt5Wx%)`ZrvcSk<0CJXVwfU z+}ua-CL1{}oK2ofL8Pm8pMZKE_H}r-f~U7iK+(mi>QJ=*Bz_e&ZvEi;^8wm3t1)R% z`Fv(ll2o$f;X8~o38)LA*mXqhd!IBZNo=H75N9(h zR>9D;_`|&sMZJDlb%}&OhRdK9qxO2w)$N17@L^_gT%n^Mq}^yZ{WSo}!yqXrZ2zr?fN*~U}W0?{hr%`6>V#3CG?%%;t;dEjB!n8Mr zl{I`OF;sshSXR1Ft`N)_fzl;l)Qa)D5okB)R>+5H&E zN*xyxYF)SZ9!%0@-PD)`yEa{n8smghoX@W_kDvS$sWhL z^=oDT?FJSy0N&}_0$f4o&K7p@`{d;(Sa-bu_)$Xp@AQI>iHrII*m^1lNgfuC05m<7 zih*&pAzP0~T7_80FDq!37NBfL%h---9JXzQeOQnux*L<)HnWzMu+6C-hd%;q4gDZ} zE^b@M;7Y6QVwJ`<3f>Fy`gn|Ei1w=j_Zfjw;jZKNI(Ty^Qrjhh$PQ9w?>Tm+BD|Gg zh>jFUt&r-DyrZy2<3I`b$wpLcQmM+1vJt%UOB=Vg%rR z@be%W*g?W1O78GDqb>Y6Qnt1F1Kw9ty3V-1eQwWTknSXQ8paz0uM+<0KLIM>)f3j` zE&b%5>p z1p&b^$KAxelGPVmoufPBx7jkp4nwnFtXDL!!7!RZs-n0z%*pMlWTaI;CEB=V#D9rL z*yCnwue92y_XA*nAlxOFCX!)aSx$2e4j%=<>a5=xwZ_c(z{LBxjX#G1Z0dBL1DaM{ z0!YteWR_TAOAub|7JcZ0%9-Vm%lrcJP_>vj>`7!~xp#dmlhB>pffCr|>7j(l!+v23 zAMDON+4*Da>Om(q=%k$jeP15e``{UR9Z*t%Dk3U>VR}WBndjhL+{; zXu9<{TA;lO-W5uzb83rSM!ABG^pQK8BAC!L_MVexN5Z-9x!Of;(5=HZ-&5ZA=eV~p z4OH2U!*gD`X>+?C+l(qp#TdKu_QWa6^*qY;+VBHi6?d*mgQb083OfrJ<|JHAmlhL|;3|c?;xurr_tHQc1y{_UlF~SqxD|r`x3I z)eF(&{$90{#f!Inz8D4#qrG`{&WaZ&e%ejNlf}zouFYPtz20`q!x#SED~W>%K<|(L zyU;H1w^05rY+4rqCy>2sXyzGUA{t%h9!#>WXv$r2_+5vPt$?wMv7kd^nD}hg$DeB3 z@YndANWhMYfnqmeng^Vevv^;>kg<&YmRrWWZ3yzE0wT3$WW0UY+7?A!wT8Gn55k-@ zux?&=!!0qrB5e`z)YYq)#+RmwRi$CNa5hI@%uuNaY>wJd_xF+Dj#emJ^-M zdwXIo!^GK^ksf3Ly!fsLdJ^_PA6Ti=MW!YLAa=y$3tcc9P|^%lW(ISl8$!jK&QKuf zpm(e{VgIhL9z!!7B2-Up{i+Zl+LR^+DpdC6cyblX?0JkGM}$At(Bp9KYo@qaiFPuw zeeIT0E8>pTtsBMKW$&bCqZ>W$kE7yxJ*OR{6#n0H5DzU`MuKd>%p+Vk;&l^QiI4VRBU{>qad!y>cZZF;I|O%vySoQ>2pWPDT!L#LIKkbW;E>=R9Kzi&NhWjV zeCMD4d+t5Yrs?jbwN|}VT~)jHT3(Vi9&1q$*Gk?cQ|R$3b$#C>QpXfeZn-yKTwZd? z@yMBFUN#<51hsht=C_NXH?5VDg!y^_c zTEmW72gfAw=dj{Dl%5?fjDtE$t)9xV?fR-vDYz+^*?vt!Fs;MFF5;fkN`lD2mn>A>F?RT47> zHgX4%)xx(aYf0c{zJeZF6N&9d3eChATENmZM<89sTdOqqqU$sY;o#!Y%$Jq~$xi1@ zEXWygj^FFYs6Fad*@z<-t+*9SIaw0#2eQ#_l@sbSAUFa8;5DIr-P*)#9OKsY3LUwp zuJR0;E=X3y*MFdIN_AJ@!)SxpOJw4&=sZEKXV~8i_srr8^WJdZlq(p8I^+r&puCo` zieysQCM@XhMeE7RuYM9MACvIX4KG~RU}Ioi_uSoR<+AmK1-FHY2Ec}YeF+S%Pj z`_<E&mh1vIv73^&Qyy-vmIwW=Q& zpX}vstVMz)-I)knL;8GÍW{kwVjD{jfg&ivE7Wc_>GlJy_OEr&Hf$4yG2d0(ne z;Zk(y*yvbGoy{;JynukG+en#@+D@ugskVw$CD2*8I^tj{k^Weh?eCFH6ktnN!hB|& z@iwJf&$^$lu1ny;>{T-TyzRy8P_BH+{TqV0h~fPUqX0td)0FG#UNxb<&RDS$w$FH` zXWQ3bN9Sc@=}tP+7+0A-8`oT$R#d;`Nhm#uV_7)ekPNa;mFcQ+@v zr-OF^;h=R*>RiF#;`OldcW3V=j?4glFFNImhJidATmRXX_BuxzC3pxtS(@+4 zeNwuLqJ9r@tQZ7B#3#{ovPI;ktaeWlgHPyK#YbrhFFYKHiYHW2GTf9*3gq7{Rh1QH z35u#xgOV%t7nDh-g*A?LB?@o*H4+<*fWAd7&LCPJ_q!b*xH_SD55qjXn=7O0W7=_3 z3-T7)V@{gRejI@Wt6S=w6-Bg!rs>svu4I{uS-yziMlTa`02xx04Kgap=WUjZ)d@LM zuG=!YDN5MNsp=eVl=5mK=vxcnd&aN2r|Huur}>w%(^-R%H*kI>sR;{E2iGX)$$Ke7 zVp^OzUT@me&)>l;N?l{#!vzqo+LfP_5q`Bp@rL*HCV(D!I9dhVS&A(av$$iO*!%FM zH}QEGVk9w`6BXeT24txZ<>w!-2EkGbK;INfjGD+FDqW;6b!9Ea zA&mS`+8sD#ORLFoEUSGs%VtKbs=NcJ0{#VsKg`RW37?L zMN+0M^6QQhTKF~jw&k*{X?O~_I!DqO_`bs>k5P6E4}Go!U9wtiXeq~|YrEiNN@vZ5 z+iM$7+&m#m#*>`HYGdI#4Q_gQQl>wbf#c9-#2ugh#kjn;c0jOUJa@lhtOUDm+dSJeW%gcFQYTTJYT5gx^fFw=W*K0NzLOUF@8oeqVR9G2>- z1KT5P)?%GXh}VcDJnkw@WSxU>&D|RH^ki03T;C$tNgoEz=RbW#2wCW?0-4BC$jcGc z0a4SpQQL}0*+Dnr{fx7P@0#c?UZwW7$1LJa@rWR6#~JmtwkwX+^3fS=S$Dnab{W-N zAc)Hnn0^@R!|};Sw~DK#S;8a!JNUL{{~2gF=uJZI%KF5S$UAJeI?mlN4LPzdy}$rx zk`p$3?6Ys)*OG70P?lTieZ=CdO;q7L!)?=gYvaR1ZUobWSKeUJ-&kda?!CXZ6M_e= zHIY~N7VrTqt%t}X1C)Mg@SCzt7X<(U!Eww+5S|z_dAK+@E@)*^8g3R{g2`EIyHL;u zp((Ktk3P~~<8}l9%^F3+i0t;My%-gDg+?d=k}^@5M;&FczDm9_*ESX`01B3>Eigsq zGY+hwU$xq;?5AbXQm9TuIz6>o5D+8q$r~5m$blVJ8`^ECu|^@;Jju($JrV17-PG*O zX&c((9wX@-*Q&HAO@7(DHt=hS%1U=-5I%U$1&$a+w;uEk2r^X`HEc0L+B{H8LFh}3 z8e#-`ny^Io5aG-&Q}cdItA5k^_8l(8dhNq3NzCs$^;JF=6<2}X9y3hGpjPi48-AJt zmk>IO*5-c$FG0L$wKDP*aJe3)tlRaRH4n||y=hyaa0jaZ&aDN(X%cArX=}Xe)qbiy z=knW+)$t7hHLEKH7mXPP3iDa)%gv*9+$EQ1!?#J7qg{YK(^X=g5NjPmfRdC z$5yNpYDz-Md3jSZv9PFSQ;p*Fn>KpjA*myqPuJnEokXK&(EG`3Ah@HAnJOn6LaYj; zlrrQM96i`76Nwwx^@@$Nx#i-_9J(WWm?jGNP8HkG^O~;cjPF~_5VI_4`|TGwd_&Qh zr=Kgr)m9GH6}hZK)fhhRUBcNak|@#q$e@oM?L6n?Q!CB-ya)t+0%nYLZfszNcy^Y# zICMTCI+pF-Gk}eSIAGtiLWl~Y;QK6;Oy>xKyGHGS7Jxze!=)d$=pwi#(Xd2r3@a#^ zKU}0G(1(k{O&AoB=%;ec2A^?e*;xon^C5^3LPG1Bf5@UjqL<7@?P_HQL2Cw`_Q(vF zJ};sFe1^)-o5V-OH1}O+RS}F-LPGM6d6#G*MLR%rS^qv+S@d0tFe-xzb*PlIi)P6} z;cD<66aW-7s`a7HzH*OG$N)h}x8rT=22PK1=$;rxM@=_e1gup1{aJVAmo!IhZ3GKM zG_UKpLN~g|hNJW7`9ZkFfOkxw@2o2e;HjBegH?9SXcSDhMHyi7V1oTb_hGjn`rYBJ zka!MMEvfBDnZUJ%=XqpHa?BeS74rq5--^k(txl;CXXlx_!`o_Cu}e7TD)uAE*iint0chJ9UwqvPADZ&IVSfLqwuG>!JG#hpzu57G{}yotFq2`|f;ukJak(Eey0 zJlQRGGN_SW)&<6R#KViNlfJ}f#9XaQ&3TF`A$;b$G1fAAfVi2Nqy z$6bVHKoEy=ciIvzS_Ey7T@l;b##xw14u{T$d%0aiF}_|hyf1LP^)NC2Ug>XU;gh-d z6m?|fV*F(m{(W6I)_=G#9PrIk@yC@M%(o5b!Bg1*jTC(%`|0k`Qr4wq-4vgiKlIIn zF^NrBI~o)Bwb`kj2QS5&vLAQ4i^|RJ6f3`HxEUZJsDXJ%$(%o-FpS~QvopMjPa&Lt z)3UVOeEp#vx$YMC-f>6`R*OE-+Os*OT+i;IUMgwdHRF`+^H&b#ap^m{jI(R7<&YSX z*4OhF&MYQNLd@jRaj=jN6_|HhQW*Jj32~U1e66 z-q0EG%YPf6ysVy-$L}H6W8lC&ONOm$8H_j_zL+KSHM-4-XQ@WZz?OKCQ9hJuEzk-t zFJnm1`-YA4X7aNKnuEJL?q08ee>j}&m5zH4ouTYHwhk}%2_ zi2H8#*H!BHJYnpkyI&)P%r$k*?iJPWKlghtNhj7SIg6c3B0aCRI z>&m^_bXC;^vQ}kEpAqosQz*zpJ@;3Ooc4V(-KneGST3`NeJxM7t%8CwmZB+{m6zd^ z9{!=W#A2@cgv%dYRZecpeZ+MeVbo zIs;qtLS6_84aa6ef7}>fCZ3!#(7XO2nCCS`S9{QV?BxRh$D|wdxU>B%o7sNr0KEOc zo;rb^B48a;Z}K+Tah0JnXgZcWInG&2F%es{nJG_Nk$T?sm^5j{&s@*5h`S3ZMmY5~ z%|`+>nQ0qJr{T0$F>dNFA#Ib2*mvFaL2{3b00M@stV49grTb2}-U9U)8c{N=Q5dT# zeZn%ZeOM^sGwDRLqlm{~fw8w52+1j|c5e_Cs zQdQTUqV6humy_(V``R>q;Vbc$U56#jTZadV;_(JZ=?U9gL*E^HgeKoH}@QFI`_wDk9 zoH{z7Sk%#?Xk&Lqlc*Nf{u3IM0)uA|*t0vAt3oEVgX41x&W-ZC4iiS2AWG&qh5eb% zq!(ft52@OieBRs&Io*0|lvIRPma5K>Qm9}@2@EoyYi6Yltd?$q`d)1nFQKN)SbA zQz=F4QeekQ0}BcAlNcl;ms0Q}cxTJ-$x`X7`0)|#8J7;}Qn z@}H7IboaC$;6V)KjX`2|5$?oh)xU6D-#f;x5qePRpR^yXdZoyNL8aa?mrlLoE74I0 zz0};}6ADt3j*2+MQHQ1KS}^ko)8rW4jLH`f{?3--+(gx0D>C^xV+Y0BYe$4KTB%TF z5~XgdQ2E2+az1%Ujn{H17z=1}`#X@e=(A`pbhsnF{??-9z9j9S28VflHb((M)p&hY z>9|otulXd!A@i}b6eTud?8Bt^``bC#C3*%x)pPW(hta3fx*0E4O#*AAti7Z_*{Eq0 zDryWi*|02I-(c@DM!ljaizUO^A;Q5W#c?r$>ltezcsT}r&*faQ>B(%211s-p_LX|9 zT+jtqFt#WOm23u8*eq!`4GQqmD5XT#_{nkb~M6OqK= zxA5u$X4a?Ku616N?S!N$2bpooB418VvA>JgiHVPBy31O0%ogmjMCFd6 zy~-#GUZ9SsJo8FkSo^xhHjRnGKNvsVfn+R#$~UcGPnnr5=l{_`1mu0D{c3V^nbxOs zd22=cY)%CtEoa5LJ% zTj4}5MB2hkVzkLGcf-3C4rIE{8S?~mU+d_*5+LcVbZPDlTJ9hC{FaEXo4|GUGWU=I z2=q-$V5&{TO-446zD#uoIn9&iMc!*qzaOyC(6vTgewl<8OgxUYF>bgG+NUY)8SxH6 z2;)@{ERK&r^tbHtHhD^oJj)WjHomIFG_s1nvk4A&ug2k?_;krx zgyem~{Ct3ah{^^rCkU5zDf0OOn~M|t_$Q5If^DkSRT_|8J1t&J&hFU|E!*zH52PB7 z9aRJSQg3VfjtEj~JyiPF)yJO89cv+<-Dt z&A!5%WP2Gyv^dH3#>s0|7Lb5aamn;NmvJ9}#kcOe0Fo>gnG|oe-9c{qE7_&g>6g2S zrDwJHX(5dkjReO&d?*fN#;=@2Bb?qpH&8f`rpI?|uix?92v3-8)dGc|w%1mUrG(B7 zvFV?lFdAZX`6OHH(oM6yfPCYLI~$Hzas^-1=sc{!Ah83P6MW{8|^gImi9_?vUy^ zx5jQD0U@!@RMECQMw4hE`q=lMn0MHl?S|N+P6R`+SuXTx2%P0-u5!x?jlT^nQ zFXSKe$La~IdWUa(A?Bes-#8VOEfQnX?!#}C#?!lIaG&+Yy%AuqdND-U@NPkF}@JDVRk1eRD4XUNWXXc@ekyQwFGfQEXw{Y3EvhXS`s4L!>(tV&f_iM#;qOAz?Cni8Qq>yySNw}oZyV=hD|m+7a{$4!ZlfdHw_sk;7qi-9*kZ~-fx_F6O?xa9zL(C+sjBC#(lA+ohFn|f z`2A}d@>`EjAnRv@*eR)Y;$BL=fvutK3DT9<`kRO8SKU*dI~`kuI2^1FY?`BQubH6~ zo^w=!f7}8cOo;&lmF)WZF_S+$m*Is$@hO?HW-4j+R~ZPz<1_3_@6Ut9Z^-Y;6jp+k z*K1!g6<9NIl34|-Qz}57fhH!PhA6EoB8$U2C?TB%g{;>eqj)iL0>6!cv?jWC59cE? zLPc{SLssi|Zq$XOO56wc#jNymvm&S8RMH|uyaUx9lGQ0ua!gI&q3Q1N?#}@P*JVbP z3unZi+qy@zqw1`EF{#$h-=WcG(yAnVcU+f>?$DHPj8X9FAc(I}+fJTuG267~U6-(p zi86OYis!lh5LQ)whevlb#M?5`JNA!Ssd;Y|wkC~tZVv$4&&IFg<)I2ZOR`mvPf<}n zgDI$%bJAzx4vvlwgP?Gvenivudw-#pAphF)`*3J}va!n8WN`gJwef3tqk=yC6+6Rp z7zZs(9QyBIw%@Gq_0s9yCiuEQNY#Fm41oz+H0$HSHnhC}F*CSL@GY%X?hq_Nb?fpg zE5eUo>nsZF!g8q&zv_RTThZJdk67!aWUy8k5UUF^?@VKVkfsRQ@kw1}Tpz*%Ng9xp zIE;sJSK+9g%V&Hf@%fW!{JHw7BeAYS)YT$%?lNh}WTSG?A%NPVns?wWW+)CE_WD`b zx!hNt@Jb)&V_8is1*lb#AxtOu0_xxoEzpLc<evFT6)a#886H zvh(bnm8Cwp!`@gWLiqZE(<;uab{k$;tsxJ_98wC(!_@9}+FIoM?`^h{Nu9QX>1Qc*d} zNGlV?Kqm?vfqP)5Y}B66he!X65S z2)>q%GjJ|uwuc>@av9Pfm1KE0M3wBRMIi6jwF7!_Uj?(o>`u&=pvQkbDnpQYC zq=Y{fL@Z}X-Diad=tEDCbA+N(KKe^^ClF5%PtcloaV(RD5uYyg?-a zI${v5kL@msZx9>|VNd;eQ*dw(-ReQ!KSChffdE$nyKPrOyL@wbK*KC$fOXwB832Q9 ztn+0=#mq*ViF&z~ZCo>pNsq0SR8FX2_k(q}%FNU5X7=FviP_Lz;&cuE=EX zTFMyNgHQIoMuw^*)tIkK?toEb#9cH%fXU-;15xa0HLa*$@1rewDB*PW0}T+!>h%ND zIhCHI#LoC&$n>m)DIV@_Wc3okr*nnnsvn#FMjKq{olral`pOHzp!7m7w7|0Hw^}Kg zJo62`$suKS2+SIZFo#;o&o<1)*IR|dPM$vqlO(4bB*}L&$SsrV)GnJ%E>o?=LD7%Y zhQg)4fUbw@DwFd|-TBtfs^;Q?b-1U7B@>%Y0ueXiV;4{xP6y2y!&p^Wa`(Ki*=dHu z>Ks|-RR$)4@*d@o;D$#7(rZpaMMn@? z;9>&$dXed+mTlDv9VAA0gyKL#FHFhlcgKB57E6=nhw8m6FXqDK7}JW3>_En^ni;_L ztD!a;WQy7lR2OhMVG;yx+$rw9Dj*&R2|X-X#Eo=DxI43qxgAim#0!*+f%__4m2IoRnqaz~T)AARc_CoWWVO5341#92e&fp;@0BZ^Z}5Z}P<6~q$?dQAmDJRYH6vL`6aR1QtAN5_)eBjkag1L;9nQ-Xtc(c6E#_%&?dYh?Y`r^YyQ_w|i#jgEEi85A^) zEBynh=I;(xNS$EQnbV>KZ*;$#ozXJ5Ea_Mtcs~1BXQkpHSwnEw-Y_(-DHz%;|A$W13(q*^YT)tMNeK$)guZf^~ z$AO~ht9V|I?gbb@L0)K_*S-U7`wktKheq}{1NO-}TS&AgGMX-sf7P3n-ISV<1FhXRj2MJP3!>2aK z1KG6fISJQiKfmkE)>oC)b>diR($O2Bqh_AqKcP7k21X42Isy!oT!3n^H|y#peCb-b|jeWgA&HZ;x;YB_*$w1&U*d@g?TJo~2$cZut;w zd+EP}={o84Z9qjPNn68WA5>n5@)EADSVgUtD~D1QJ}`;tJ}t*Cbpw|*h<3 zRZcXhY!WFco{no;vW(+H^RqLLMmg+HGISvYZxt-*wiKRE6)OO^)wA&LydRD?mM%Iw zUC-n{b=>aCSG;^L8xdtXu9t2BFF_Vc@T#3**JPNe$C)$?mBfbP1QM%CGNf*8Qy!iC zVjb-hrGs0hO&&c(afsMP+RP*ppUP=5yQ&4zl4N$v%xv9t#r>w!LS8o@VtR-GCoCL zk5|?_ZnD|EQD_JMq^(4CBWtX@j?+y*H!fI6y%xCoV| z>qVVsl(hP3!o~pU2u9r;1gv+?KG-H)iZ==-T-Fk9EI4lJ>-%kDq>`a=s5GCmY(W>4 zVbH1y=UW-6?G(EeX8OBo$Vr>(ZH~KpcnipJ*}to!oy{IL9+`FZ*^^Y8P+^52^umVYxpEdM$`tpC0FVf{lG z{~}&bZ%zI_Kde7h!2f&vu>P8hKk>}^i-$k(!}{NoceZ~c@2tOg_=6s{|DL?F{hEtE z=jX|e{GDHa+Lb_E3RKTTPx{%32=Kzf*ojCB?#amfLu)F*Jt-^T>FEUs;D#4Z^7|wa zN^nm=1fKq=@HFkf1&p8GpoP;R0#e}esG%7jwewF^{8z~amN9TPu(mV%Nx~1^FKgm# zU<}M5V*iD|pA9?$;D>HdVq$}1dKxf5iHQl0>4_HrB@VbJkN}jp;GQ@E%w&OMdTQuT zLY@@$&vyPV|JL0jCI6=KzxMoRjVI0YpK7qMz_C0H>OT+kNu&H;GSk-}&={m_OTl!pV>Jgbkcb9*qZp$_qIOB^g>t6Khu! zXA2_(dSN?jV|hbs3kMgIC-Xwo#L39f!rs}=k%;L@0RFHa9xDUw4+}>pXAyG)MNN95ctGCis5G8{lLd^~=Z=6GuP z&-OWiP)t7(a$y?&zziGPptsUz&(~@ zBw_)k{4D)P%2P`~YfQ`*xJ{;otr>9ewnDZ}7QgP5T@0NcZNNuO!}J?N9-I4DhDgY& zXsRpG0u_g&g^A6>4;(Uen=)zJJG z-25xGkE~bv_r(4cFTbe$2Y3N;1@3YF|H<)_qfdPQ4MRV%^a~@uVd*jNk*`1T1jHHK zW4S*N_^ZZasi)LG{{J0Wk8M2C`1AZo%j5Oq@dv^lbN?B}9!oyr{nwZo8UGi2e1iAC z;!R9RL;j`sZ;bpOgrDW<3HR@r$;I&}@|c*JenIaya)HzL_<2nEIaSO*gc+FjLuA>2 zF#Y56hoA%R{};pj?K$%cu0k(gNJ~imIm&-UD$`@P{|KsVKS%cisw_Zz~v zmM4e-|Nq8wBKAKN-v6LMpK^a7`pK>RrE(uR|Lf*o^|7dhsi_Ij(FS_fT5v2}00$R4 z;AY1bX6DX1ziH=3%i>?9MeT)%ilPdwiiM4d6TOn1je+gokn|tqgq7(xIbq`biKJgx zc?2QzV<7bL;q+rx9?!pje(>dwv>$Twd;VXp|3N-0koS*$Jf8oo`sji>GOnGq3?ZB>%rG5@BEf1sFe}X9fl}xPYE22P>1#<382E z?X_80;Q&HTz}0n~A5($x5CeNjlSjV(ar@ZaW8Py`IDiz;?6xoxvNf{?Mqc0m%FZS> zYD7$Iz)M*RCnw-@{K4OaZ3Ahd96jU=6SV*aGYT_5gbz%Iu5*jsPcslf8kF3BVcP0&u5(8vNtF z-9RCEva$X|;nV$(Y5QYO?%%iM22%aIX(94+4{v66E;fGtU%Pdut9dA3m_0i}EwG7d z7v$jthf}U5DHL*O*+6X;l!ZW5AqglX%GE{!2j7Na(e7;Ks<*>NVGVG!5{(Q-nE{ub zDrM>^WMbM=vLzQ&UG$daub#KfTikEcQdU0qzV}`_YFPpPd6Epcf{~+z_w5_VQ zv8d29v>G!!(FVTg7zSza3zyyU-T4V@k#u*qd4kut@KN{aebMO&`gKU3Xm>Ve15cY| zbY!@ESX894jdItaymb6gSlEkrc!oZX5)wlU=IomX zNWOFiekRGq;0XvYGQ=88@>HCn8_0Cb1uHz5LZS&f%?c<=pVGF(#}xKZ#4UoHq8Lb8 z5T-9kRCrN@Tx1g;gr>-BNyGNGH?}%oO*txuEhie5g;I2W?lZ<*b2Vb6YM6Ss>N@)? zVtgTAfpIHC7?!~KPZ}wQQvPr0-ojDRQoJ{+S(3!icq8U%Tcg^Q-p&<=!z>YbG~py+ z*xeOMkbbFETIn5mH>va?DfWQ%l|kBEv`D4ni!t_*-B0A}i#yglw(ASz#_Q%y*k8Wc z;GxvGWvX53Hf$_HA*Qao*UZF&?qv197*)M~Gn#*wA9`i?qO1tY(%4>Sye5~MO`y9J ziV#K)W_h3z-YO#u@?nhNV@mV*|2omm>&R9e{t z1*H4k=p`Klo^Qv}v#WfR+q}y~yxxWMc?;0kr-=9Oyhtp%F%7llE=4-Sb2@wQjF5~2 zmC|BUo_Cp zawxY$YPU^0J)DxrY%8gF^`|q+m)t3&jFMD z+r(lV<#Z=<3|z}^vYancEvC-wZT*o+glCyb?=}UlMH{#eKY(YNWo$!hJnb4@glgCq&5kKp8mp}fKEnHjBJ`dW`%%r z94JD0zJ!n>gg@gsHtLm9ELA%52)nO@8S7u#24zHqfN+C zqIfcu=gIHSQlUqO1Vd7N1mCDyYX|6Myc(Z5dUf5NeqnZu26cf|W-=Dcu7>?0J4`4s zEaQ#ICcbd+kltGLt2KfSFay7#s}6KZeD3!)!xn+WS9kmBG1blazPSg-o(Tz`xyf*P zxY!p-4&#m4mLhAqd0Uu_>)g@HF3?u;IpWM-$!0*w^{onuSclfpeB`cx8W9S--XPhN zSCZ8&AO?>kZXx;@88g%MKv&@S;#_wBjgLs1T(+2+oSln1gNhB<>{=LlgKK*j;96;@ zu0rN>tyRRCt;t4$w2_og;2z(d8mE_?v$UU(7k`KDtk z+n%v4DZ;1s=d-uZT|a*3+&s3kke$DNjsS48=1O^86*qk;jOc+3Sniq3vv(F8MhuhM=X`bdCjPc1w(UHGn?Ow4+Qpr0$`@{H zr!Q%9Z}y8b3bpdN80$@dHF@b=)82gydzVKioW{bw+c`|C6& zL_#>2taE6eEic%sA>h=$9yfaD_Kqv)tw%yLIn^egOk%tXmbM>KJ+6zJ*`$G$s1#Lc z$fcpMz{2jwBpEQb5E<_}1pMQJHK7j&Zo~}Vs*>wB15*}w(}j9zMU0&;#6&6qA<3vuIOAsS7Or{*(?U*EwgLo%vsVYHWf@tu&-6WsIyNNm~kWCwSuOA>F^t6zg@ z`iGCQQuzyug7`{q}ru?SrQ?gw-qna>e zVEioo=~jakx(JvKn80fvLiSImv};#t>++V=Jl{ypBe|#gXYDf6%XaW37@!3 zND#ImDN3RDZy#$|#E8OXBWa0UJsbJ>Jf#zy$x0<@9p6zOv~MPe?NT+BW=OTXf-^mq z{4m#{q5qYOZt+lT``e*mGFkP|EkV+63GDx0=Js-y6S0y<2V5%f039 zc6aynz8&6XG8972hA)2*@okJie&H!_xLq1w<#skWIE*=xj##|y9LNsnoDRL?^~pc2 zSlWUXnt_;pE=JSZW+wD3ZwvTJ{LI_zlli=?eif)%=Iw}sd94(sWMj1e00eCy7)xVL zT1Nzn%<~@SIRsC1aQ3rF>2sr#WSUhOW6?zsUhFfb*U?IwW!+8gg@qQbEbRu=Q~BmJ+rd$P<4^; zynk>1{4mJptC1`nuch4T`?UE@8xBK4UG!O}J~q*m*qlhCId#P~DNrFf(QnS^0~tQv z1s_MhSROS%+e4R^EY#Jq?7slC65W2@xCkbg|42D}?tXF7%nB1oN?Egjm{^6=H08Wz zsA?h(f7Zu8e3&U@;JW5iz?#zuX!Rr&$%2c}oQj2|wkMZxn zZXpf)`tzT;1pg)`_R|Rf1~u6jf!-?<`%fQ$9q4-kjr1RG05IcsH{j{^mm2^KVgGwC zfCHEz(5S|GU}!#k_xt%l~HH z{}x;O=jJ`I$KR}bBV&C7Lw#f8P5Ti5{eTQTSXHgBB+K_$gB#+(MV+(UtzNguAMe1uFCO<#$J2fXnI z?mMZJ52hmCPF~B&!Y40;*hlqZxF66bJ4|~rI3!C$uXa2Jxck_tK z1Dn1ts{Dtqm~03)kfF1fCT>NM4|zQ{mk*AFS3JH}Z1eY=bZkeb+Uff^7i)Vc>e#wL zO5A@4NnxRoPhA3VY;9N3n>BKkXCR$Q7t&3z#DA=;a&tMivP?X_%JvBL7MlD}TwD;s z+@S56Mb38XL$^fvt<%GI#K&O`ens8)f%@gln1&7?;&$F_I>%iTKIgmiyU0M&ujLVm zR;hC{pC^VDXU7!O`EqT&^Y6aj>A2iBa`Tq6o^~M1m1;EYRZgL&ozWPe zPB-*Bk|)%vE}i4K2wuu&%yBpbEZz)jeZ_-rJhCtKbv2RG4fb-7_0W>$fSwy%nfKQ< zT^YR#yl+a_wsXb0V3q_KPI@TsWcTG}^*e2?sSt!vUq)u)t6Nd^71ijRYXdA(-tZ(H zcrIS{me$N&6`MT(H(AiJzBzqvecN#1V3*d>S!2VD3;+iQ**1S(`FC-Bj4S;U2mXH! z4gVBcX5jk(oXo8MJI@^`+y8ewcM*UnKnx)M;#|T7#95nf*7lk*@Bcfv$d;A!*7C z7ebCiV@^Rs6tE5kN2Mm_3V~%`Qaw;Ch=Jl?EM~dqI9?YfET*ZVElA!+0z;z`fr(ma zJNNqjrPfEwl7NhUw@Ln$bbYJLmCQDQ)6J3LVXm!=OTHs6((F8Ns&G-mef0F$XX!X? zG=>39+{Dt0)#!BO9bupylHftp3$8X$^i)w)#>Re;c@h%IHf-pnvO-1(MHKNWBn}t4 z@m5Xl;}Z@S7aLo}v!-Ody*>HG1v07od9Q~QT5iR@pr)e{rsY)=M|{|ZIA7@6&YSvl z)zx=SU7Qt`hmo*-t2cUtc>f@yjKStDH^J<7zF13;(XUIrT(svs$u4^JUSecW12gtH zCN`gdsgU(z&Q;bbTLgL{nOrJw_qfF_YeG%Lo^xn823u;Xe1novA!IyeZESUcbs>=@ z9j45@QbZAXJbrEbOYsKfjiN8WpaIx9@fRU31zIY3OOh{QvN_E~{qe|OUT`V-#G|t% zq)N!D{##4_g(Q9-f=ty4K!QjuqeD0WiA55zGS$P_+@K$eys&Z{nTiVKf(mf8Xd z1x z2*dw2pY=9`6wwT~;5qyAW%j!Y#k}#(_HU~Rfk%U(eX|341D;VfktMRFvUjp1vdmf9 zoA2mq!{i?J{30?$(2eyq-Ot^Cgp5+;UO+pxZk|sO4qn;rYn>TEd4!50~W0 z+~7(=GxG|qZ3Jwv{ngmSTzdO6cUl54EsOnbLFVu9X1fUH_GW&e0HNTvy!HsxTqtD? zN&a$u%NcN21vs@i?9vdLn^!|?{AZ+%D(-4dYEJuFQ?G5s^;|8CF*}AsjB3^C$AUK_ z-XyH0ngp|;MjSEehstuOg3+(EYQxHoT+JWR`#ge=bG2NP1Mhg14aasb5 zyMfO=c0VrE;;gDK3R;Fg_q|t~$EiFU_4b8_ox7WGee4E}M%f-Fc~vBL+?_x@|T0&Xpfu zeAAe}KAmnDIlB7(4xU<{W{2XsRfgn)C-WegVZ%!S_WoI4<& zO!~Ab{g7PZyD2sJO&o5<>-2y{#^H$7worvrJ|^hrW9{vfgOyL%*P0B=l8D5Uo{$+lQ&W=5e$`#rM%SlcyLh?NDj)N9a%gMrcuUY; z$ZhOP$L{Oh*PUC6ERCq@M~VS_0ECEvm1^jOYD${dY20!JUdg%fRuM`DFfyc7<)n9o znAcUp*zIettl=h8Y~ES4Wn1Q{k;qKtN5;Vp%biNMv&ZFetv-s|5NkcQ0Rz9Us#zEg}Gi;a!u&EhX z0YVw>2u)vlcWt~DX}XN3*6U+Gm}_K#uVR|N#qr>DlP>^3iQF0*cnZvZ`;y6^k^+xo zxcWv$@rdx*8k;~>jt;D^e!_@kNYsM2U(2-0g-xwe)sP-V=;`-eJM@#VSqjIwLpy|6 zb9JzaVPb``vAM){H2fH7xaRthU~WX&(!9HiI2Esn9 z7C`>ib7!obp{ovWIBd9Yxt=LaekCAQU2QDUpg1zWy)U}f>hktpdhkueR{wD9tINcI z7!B-ED!5}A$<2ZaxD$;O=e)+c4_9ekCPo<)mxDUNo*{b)>dg;4{I*+%i-GdT_^B|+ zt)!eCn%h}blz}D3^fHi$Zi1&6S?pxoFHwpUNSWv?fxgCcfiNTC{*&glB}>(%Q4@)!j5o^_IUT zvHQTx<--Jj&5Rv1>ZBu^VPvE3j%u;Jecw`b7E;KY!@3AaydzpBKf_P#V6Tc7 zoe9#<$H(Y_b71uP-^V?eFVG^O?8W4-m~CXa3|YU za)u`4yt5!_S=mtPSv#pMJc82=K@1T@=2u3z(N10Y9zS#hZ)d`KFaj;cl#Jb4p|JBX zb5AFSqXuwHueI>g4om0f_&QqK?E|$RZ)<$<_a(7N6)9m3@DQeJCxZe$!5(}l$KU@D z&M6xby4`rfn4Q*BbOh6w-iPNLYaYa?7_7~R*o3Ve39J7B1%j2ICNL19^&#zY!*|O& zmvID7rK=Hci^YMSSfaU~uijw}f~P5Iq)2;!)-ln%yrR{1J{$)r)7AhJ);*R{12E9M zzR8(0m_gg<<2yg+B65u!!yW#NH8u^#bLiav^G+Rey&6%}ln{be-+0MqE$n-U$Q9`z zG|3Ie({U^+tXeO}|I^x6$3@k3ZHt6-OUKYT%rFDY4BaIqASK=1-Q6W2pnxI*N+TsH zDIfx(bc3KM2uO+&-$9@IxsCgM-sk&$-~4rEowfH~XXngX*Sb!y$Bj+A5}ly!93;cF z8c6=0C%H;!Cq#Jh_MYB=WwZhtM5gT39dueXN4~Soon*YtN)E$?h&SW9qk`I3^F<;) zP4X?{J-9jEb1#W1AxbEsR(=>@g$mB+pNK_vkS5(|(Y@<4^3ixK!C$SxtHCSRFTyze z9m(EI)!;J+`CiVRcS}rkREx9;C8jMOENVz@x16F8F72E$g5JkD-(q(4-z`_)Eqi1* z8Ry<40Pov<#?8Yy)%2Ff>K?C~uBIA|IlXi@`{&?Vx~-3al5Af@*YBZBd2ZFcMnC%8{U`ridd`-=0`-J7QYpTaDM=vF!A)XGYkQ)XDdDSKjJn z`)4SD`xjEU8#?be1<;oUaN8StG+y}9tP$Bg3!l0^8CrrvutMXV=4X7i*m;h>tsB}W8t3DE zZu4kmKQn~jGd+E#O=Ye~yO3d=*Vnv_%<=7em~j1j=QmXRDpYXdH7Z-GzdR*kCeyuS zP|w5~`ziH<*R0}{LWX8WJ174H%!v+xcU*yELQI`2PHo24WgV4VLNV#@(<>@D|ES`` z(cxgSH-#8q!Srmj`%4vzaGL-hhM9puT(S$2c<;taKG7?rfW^kk@`owRq*}TKR1f)H zl+Sstq|dHXf8{@l3FiO&{HfcF-;B z5}VUZi&as|oaz^3U(ymyy!tx(2!V(|tkzrI&z|N}jHEThn@LJ`6l*+|Wi@y)jE9G} zpH$IYuNtQSMfvW(!os^vUnx9Nk9OT%RGnGN9nQ`vd20u?IJ{TMSt_&X z<26{^90}ROPJ}#bHF6|wsUFa>(MVhBJ334oHiIAghU=w+05#Scc7dm$HAwInRyL=i7R(A37M2eX&J%*3q{}X9Or7}X6!F*=DYy1-gz+@eUSk-!gz}GUF12^D zpHW_nuQG3AJgshK+pn}a5YQAY{8Ww;;1o=QXPsGcNO5}?(=T9`F!PpfhOI>7T3O13 zv+fx;@2apvmhcF^$;bE4J_f3f-25 zIV$6>=sc5y7h|>E?cfL*3dT~wLUY017iVEv+DpRH z8auz#RDdA-(=GEIHS^#2W&R`5>u=W#fO&*nfOAlPIaJ}We|u8_>CfKO?_dAzP5lp` z3K;x9f-2w_wf+UF_~CM~0URnW08GLM;`fXH^gEpSCr`*vV6Xq)6T%M{K>h3qNe@!d z(k1U$EM#ouGNU!JAt@O;bJdz67ffrqua+C38ZRuK+gU@Q99EC{H4I!YImiPRtFOZ} zFvz$~5r0*iZkGx4=5hLCw{CT8K5H2=%A**5{RNg3wt!Ud?Bd{%s`Iewu-JQ_U`n~{ z>)7!R+&-AwW$N89;0%OZV+B`eCr}n{3}9p!UX^R_y`(HIfr41vDzhMtHIu}zwYXZw zlf2Wawp2wrGfB)IUu-uMelgdIDrQLDJ;*L*3W)UeW z1RV5;^x7bgrFoOG1~=K`%#)EQcQy$bHo)RDj$N11^DH{4RNWVu3X#lC1+wv=Z>f%} zpeJ}rGK5Smw>(+N^ySGUv$2zl3+_DXzW$8A0UDi+Yt7=ueY^GH9rpC%(P`Am0$oI4 zgy>)qso5ugl6p!A{F+qs^~4YK7<lFPcj8lE?a`HnI~*h0r0->Y>T zE8pucs&SCSAs5M#_KDA|S5BuRl)9efOnh_~{S{8(R$TJvl26-dw-oOxj&OHqZ`$pm zqqpq$l-|eAHNE8EK^`e0s0Y0;9Ko-mRjm>$X2FlRNh|pHuCGanV-NS6=*&&-d`%SB zx<>!p?;T7yg+^DpLdvXsoc`7a)~5>(8b31ODGTGDCh?Ww87|e;PZ`vxZenHDQ+TF& zwVNta+OI$HM3*oB7Ia5XTz{ga$zv!vIZ)j%piLs*W5m8u2&EIg_{M9+my^nlKKeTH z@sak7st{eGX}G_G7=?%lez4|Sg@J1>qI z;Xlm2+h36%RZ%YY&SzlNZhwM~e=kESS=}`$$r>tib?hlGLmB<%tGcJa+x>d17?N=A zUwtkYp>LciW2SqlHzp&9CO%Bex^e$$tFeoX>njlq7S}D?maZ_yvXTw>O*e-&xxwy) zv9AJeM4n$Zd~mMK#EWcR)O_CYm8`3Evvfiw1ck)rM2+ko9$VI&VJ|3xT1MxWqP*8P))R8EkJW@sJll3= zOs8VNahY#9FyHiehtS#O-0Vat#=f^QwC}zLn?OJOOif|KTH&J+EU_#!7nhhg-ws!) zUS@k4UwkO9?OaqyDyyNv^G1i(-oD6cGL~UM>%|CtMD0his0!{F(p5>hPbII$R=8y{ zn@9;G9%>;>@m~>OhIR0r^TXF&4n&%>SPNHE-ZkxK(+ph7dJSP^U?yOvhumVI4Pj~&jV`hpROG7QE*oWuSA)G}TQZ8z;=J4SZi4B%z8uzV_+ ztup0uoW3%RX$QhkQt)zdDtS!nzhu2+w%GW-oiRnF3nRC3mwb97nfiXR4q+n=WvAwD z3&xT2A@dw*$XpPO6aKUkLMN}3;YMWSg6}XzOy!JmUNyaDZw$=ibpjVwE74;cjCA)z zk21b7CtQxXP>1EXYt{tnY85YrmeCKD%zQ1A;LRwunbIO9J&+CP{0?7a3|I_`r&VyP zAi-jJ0NUv%AN>5SrPgzmEl{r37gj#iH!IIZ#fC_&22_|-b zYr>z$(sxAde{(GTBQ*E>aRdecem_utFx1bn0wALI{|NGf0yx3{0P_3gJh}k+{T(V$ z1mJ%E94ycU!Ug(3z`)E2K>2x?Ia>mu19Nu(syB`+lZsJcSOf()a{?2H3pb9dTmfYk7XIAt6&X_LC=OSC?hR(q7v%SCm|Uk>Qq$xXAfw-M>> z^mI%9(C4DkmZk$yRYT-SV(BYA=Fur;E3&}?tKMw2uKzIiWq<{|QhlD6{kdMRYC}T-C!9O`j#Q2o6A+(B#w~iTWj2Ok&v(Ej znDXR)*W);C3@ar$%{?xn7xD2AL>~`m3#`fMYw>3wtYnTg8Zsb)QM-jFTmjsn?)R;= zv>v0z1h`Z0s9|1D&Je$Pjama{k0zM5!X@(}Hcg|D(?VG}skn}l%pPCxwmBE7_d2dU zXOU`?Mso&jkpe-9yap4i>na-ucUChfhj}0^mkQ>n_#$_m<(^%=) zWrM7SBC_?PM7G-4rk8cqg;TPJmjW_rhx|NZkW|7}wiB-;>hkJRY!Uc)G!0%;pUo9jN+?=z5Gkz989A@cC17jkwGp0|C;tQvmL{p<`WT*2UjCU8VUWMj zlnqr#KA+~welm}SVDGnTsO01Z4@Yd6T~WIckj|ot;l!|uX3J~kie1^!sUc-?C#-^M z$2dudz>*H{fH-2q&Xn4%h}4_QEbsMwBg{{wpv+sFMlDR7Io6&BuD!jlce@O^Z_YjNQ`{!H9VZ&wYEi|D zVZFQUY-z2lG52<>@t){Ui&%M;CpdU+;$ymr)ZVDJ&&=?aF=`}F#w!wSs77=fPqp;X zv4_iTi)3S>X)T)a$c53KpG4CN^{`0KJC=7FNMSwss*|~*zF45lb~W*Sc#JudZ^yap z${vga?{-)%4NSLySpz(vjeDv*a5Yogi3=o7Pvr6GHsuzAhw15{ZbLrmJ`R(7a!_)KOH~Q}S7;L+TQS4?3PT!KB93cre*Q$dM)GoPxz zz81!Vke|SA^7vwd$g37-pjfqZpqxPKHuDWqfPD7F(Zp@cNHfla%CmhEjI70fiAJ-U zN}#WYw~EvV8-bM)vA4S7S=T_fZm|(|g~7p}k-a7=BBKQLtZ(R|hI(LLl`RM!hqinw z_ZNK_gC(Xk0j7-{*7u*9csyvA4pXo74WG%`uJGxEm6LsRbRpZP+Lzoe=^G)Bu&dL; z@l#g1r;J;>i~|XLFcx^(FT6st_N~kvjYng?Q2(6_)~_>N6;W727?dp2>O+jRC&-(Z zu<8+^^UuZ1tQtgig(w{ba1;`<`kuN!Nu?~$zx1%0=6nOgx1y(N0H;`4bs6ilUWDV771 zj3+Bg6R_d@=_s$e(q_CkBabSdPded2au{`yjEAQ}r`X)^%68Av56*U9Tj|}!4whBe z9JQotG~IJ7H8VQ)o(5xCTEeGXUt2nEZs{77)^T}b+h+&QJM>!f)|ZA@#{0EF=HXL>C$t=yZ)>`vwkt1vHl?~ws{GB8}GJi8b_Yymph?? zSD&L++>G0w*{bC1yxxD#viRxC&A8U6)448EKSP%Rno zL@cM1f=1Vo`)L}}%Te-Cz)w+ytxM49zjW0jX&l)Z&oB~LS_5N4r^PDozdMpM89o${ zL?C8bYC6l^G)3@Dq^Rp?{G|Ak$%Bg6Yv-FwIG86rrGXC6ZHhW}e*Jd;wdZx8ZW&VU z9gM7T%n~21cg1t|(g;bQY}&Tj%iH+g53X%Q=oCF?G8z7;w)0KIOQA}z{~4~tEkA;w zn8Pj3<2&7C9a#!ILhr3D`BaTg^aWNfr>RXELBJnotJddzY;^~Mx75GdaVVki+Lz6! zj;C2*pNO$0af~(41<}XO)d^Jb>S9sf7+txSsfdhsGO<(82)nU}P}n3ZcoAbYC=yS!!)ZpO zd?)uAjP*JihkkZwg6}ve5917xm-?wmdHEsz`!-B=YH#Z^r)7n`kMu+G3}z^@uLIt3hiQUUzTpUK&0~x zT*mHM`P~^?b@v?#@$>4=*-Rf8_fYds?GmW%HHfq~{HD^0zdy^^)h`zRL1kfI?z3@h zZO##~eCTL>gUL-k$l;Vs?7L3T98o}IRlq~(c%~jaNr(FidC`6pC4p4QTI1bzD$oxk zp$@XJrucOp`tuL zM_MzTRMSnmnb>yE94C9ejLW%PyMN+X)YPq#c;tx0SwN$I*mVBc>$g?AVJegr!DB4_ z0S`ZpT51I(#gDGzar=kc+7Yp=+xxHkpi4PpK4W*a&BP8c6-yCrfBK}-{Dao}nYh(2 zIO#RyEfz=O@aju>!|bN<*m^nQH3Pw%m%+$}75Br(;F4X3CVJJA$y0*H7UH9aogq)m zL#uikbSp^-Nx7jq?{|+XaL#P&pe317UAbq0sq%bq6<*h| zIxA^AS%l`MAv*HFwK!{l67GOqyR|ig~P%8N)qnBp&h< zcYe*ZT#JW+qi<3+nNp?B6d_yP=EXleOv3MN{&i)a;uR%4alg)E-nDXEQAoZTWc||8 z>a_9gTjdkg>X!@-7L?x}OlOkB$3MN3=&&wS%G(qeb92D_O^>2S6&o7@F<8RCsMmmn z7GW?t(l=r(Y7$gU(&?J)NZIj1^Ycf^_LArHv=-BWJ~5B46NSax5=_bGKC4(%e5Yt2 z92c10fUj-ELE`ejlLuAfXH;;aH=K`O7fGApD&|p{;$xDE5-}hw5qI~>HBf3BXWBqij{i0A>kafg8SB)q)5pxn~e5k3_?7DLvYi3$`{Fy7adaW*Qr1)&kXT&;-ASs@i=d%=G32_SC|a3 zZ}#FFP*0YKC0lu`UKDq>QV6{r#9%BkDk9FqYLM^Ga+VEQv20l2^d9d*&7tdT6IDr} zk8R*HrBay=FOA+Y-elb;Mc)yC(OrvvhmS#aGuXzod56?c03so@Y~z%6El6X6BZ|}u zww)6G=C*9#&~R?#jxC|fMu(_gSW%jGKReWDPxLT3P)W64NusC8zU|SIp1sd2PnF0j zEKH>Ed$bRpfp}k6Br_9SZ@huafg|shs2&_RM#w=ZQiJKOuT($_obr7Ha!SYED`Vaz z3D<{?=ZKOvvLA&XT+skuIdcqtAMZdSCqY5~O=`^WjJI?? z>8pI8T%g~oPp~cSE{n1li(Pm4r`4~$o8@O8SKBQVAmsi!j0CE4v!3F{jg)`_gur%VRgME*~eaz~c??Atdg7bJU>57OTJte=t%qqBwzH zw#4-;i_5~;*l5XA#3jGN%JJYEgj{wZdP_;TuJvULs_35L9L`99>1J)l9lH|pCmcTU zBV%)n1T47>=46iIZ>ZH5*tgAa`L>1Ij}(`q2Ky>mDl51ryn@y2%`43hp0Al;t$Cn# zgsZk-2xB+UFAZ3XFzf_QIN&t&vq2wWJZ#e>y{S! z4iU3UTPR9c^J(7`^F()p&|H4`JO)F}J)vT~pILqzZ@%_{?fCIdz+?Iz+dW;EPEwT$ zlNJ8!I2&&$c$7hRqIn`f9eG0T-)E^mlpZN9Yy>ZjU_f40*}L4r&P7}l2bhRBAa^U}AHO827o zJHa_O@YW*&cl#74)GIf?oYQKr1&=a=;&4$jrEs4(6)61>8My;8_awWgF8)YST*he_iUC?%>FdC z6kSY?3nMO)NN(9f|_e6KRS;?I0alb4Cur{ZgtL~Z>@^JC&T>POTNe^)umBZ68EvNR@(IN_iyy> zaYY^PtFY?_zB<5+SL$UDunshVDz|9ImDptWq#4xi&*~@9(P5%guEwk+PRYp$9*9QrP6(#(1l2MFOxgd3NRqFDmE?oD`N4MTSUeU;9@(H}P zz9n(H3+u^X$&@W2p`bnzY)NVU%j~(N!)*>YzqK%qQ6HMe|R$Oet1Ox@Phsg%J%*__6V5& ztLyS7`j-ET*dssc7Zi4ygNl|7Ro}=m`7j9&;QBE37xp52Pdui&Vx@%@OPh$pd^N|N zzesyM>NVbN9bV9@c8&YwsWkVC3~`erxk%8+V0l?NNI3;w~C&|Z2;$!UiukKxsx)u}2 z#XyVZh+nOLn8YiLJu}g*xu*;ei#LLQP6h-ks;%nfN$4p-WeMiO= z)gj#-^hfqVSG=mxi*O$c5UPGWnHv{E=fuJ)EOk4IdQFGyrP2!cjgWl-MUNu z-qJvLi<6&A;m*H?Ou7{P=jl5BOn$Wc;PT0{Mc9k1u5k(^^7#e-}5)bE! zpAO%@=>c{0Hrnyx{(z=X2B{cBlhz*d1X^(m)k~J#5%8aeb{-pXQeNlDG$MVAG?$uSD14oudtbZh6s&?uKnopS_HOGAmu4?qC6-@lERZ)C* z7bzuY9q)i1A$^-|l`IljG<*aX=5zxb<$!_(|y;qIj?l~!4eKh=Tcel4W(5bvFZR6CULku%Et5Nd- zVSaM#jOuHJb<0Ifd$IP`%80SD7O9=ji90xOZu}UJT#@^4ru4l{KA;Gbi33tNWCsN( zZ1_@c*^a_yi{6y&RX#4xANEX9Nqx&=)Yz$R`ovOYqRN}R(Xt-?R)TJu=4)v}Gg(rK#`u9#KA$;zfeZc^uX!rWs@(DO<^*36Y9bKn*y z`SEMMsIq6X(~~AsU?#ge2gcw_e7sIpk=DGX48qCqpu#E#+s)5a=q_l6Xr_u=cf}G= zWKo1+Ep?IKm}@wyj;i-;_spsZ9NVka^I6Y}K?wGog1gkh!u2Y~dxt@;q3xN<4&gQi zr=n*bJYv>D0maE}xKd}Aeb!~`|2!DJGt>QiF#N??_ctwto~p`UoD}>p!M`~vL?wIy z{tF=T1v0m?v2zyV*lu~o0kX3cgTh;ittYJfalTpS(jJV7u%6dymBAI=N1b_YmEd|cceK>U0{96*)sme#_W z0O#tD3W0B89JZdGuEG$AkB<+Z51h}%-3G#sLZKi~7z73b0~%ltKW9%fU$C!pdEYLqS6Yq+sjf;rXLl5QC}9{13`Gb-p`wuAG=aeaipqSC zWBxZqf71M^sEa#5=kF-40X(AC_nrgEx&vWScaV&WtKaw7CWupp3&f8?BEi5Q!9Y4z z&R$j^AUq3l@w5dd&=0%5SN^ZML?IVF|5Mlemz`zis;c^*yUWSxV*Xv|3Cp@zcsT)F zG)l5!99~{_mckZDYb!IjfHl|*%5MSY=eITkLxB$%ZYE%94l@@5l3LCG+i|nB__rOd zUhaDyi@TGVC$L6bT>&Z_vx{j50VWWKxF~Sb(+-GH zi+`X0QjVTKE*$MHW}>j8nX`=;hcDRD%G%7!(UU_w;D(x#UJ%67$ra*cW$9?;2L`GE z^CJWW`C%{wKN2h?0ENQ%T!HSs=v+rT@gEo8D~9~t*gtgrcM-4vfl+|`dwGlFg8n~! z{{L0<_nro1I*W1mTAZA2Jvcagh&x@c}viOC|_~U2snRB7-3X0RqO~WC;EXvdmxf zpiq9~@AX09KCElm$55E*N8fl|hA|zn2x@M_e%P{-Os%AuisO`-==N zAantT`BerCFM;{;&z<;aX$^rn*-|GYV;DX)xmo}h6 zFes2x`il&PL|(A?{whNVTre^JA_K|-=$zkVsPFt?zvuz=p?=qcAq0_s*aA%L-}Qh! zMCgxxMxrjTBfqwRK)`<21Ii+Q9}j+ke;9Kp9PxX7z@8=eN57z;e~cyYv_gN_EP%S; zul>b7U_bmr4~ByNF;8Jg=mlBt?`2WH+XsUJOeDYQ!BG4cugLhNEDXsn`1`m4Wf8x( z0fX}k{oYp>@00ueIbcZmA8P?9i~OSvLDZk~6!lMIDe%V}hY6xCxRrl>4g~)N`|__c zfCBD!`v6n^(1Q#7IYw}xjo)n+fd08h2mn+3_kIyT2tj}EKR7=W_=WMSeF8{eA^k1$ zbTADISPLAY.;12 245350 +(FILECREATED "19-Dec-2023 11:23:08" {WMEDLEY}ADISPLAY.;13 245192 :EDIT-BY rmk - :CHANGES-TO (VARS ADISPLAYCOMS) - (FNS SCREENREGIONP) + :CHANGES-TO (FNS \CARET.FLASH?) - :PREVIOUS-DATE " 1-Mar-2023 07:49:03" {WMEDLEY}ADISPLAY.;11) + :PREVIOUS-DATE " 2-Nov-2023 23:35:15" {WMEDLEY}ADISPLAY.;12) (PRETTYCOMPRINT ADISPLAYCOMS) @@ -751,9 +750,10 @@ \CARET.TIMER]) (\CARET.FLASH? - [LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* AJB "17-Jul-85 12:47") + [LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* ; "Edited 19-Dec-2023 11:22 by rmk") + (* AJB "17-Jul-85 12:47") -(* ;;; "Flashes the CARET at the ONRATE/OFFRATE at the X,Y position in the current TTY window. If CARET is NIL, uses \CARET.DEFAULT as the caret. Takes either a display stream or a textstream as the destination stream to flash the caret. The caret is not flashed on a shift-selection in a window") +(* ;;; "Flashes the CARET at the ONRATE/OFFRATE at the X,Y position in the current TTY window. If CARET is NIL, uses \CARET.DEFAULT as the caret. Takes either a display stream as the destination stream to flash the caret. The caret is not flashed on a shift-selection in a window") (COND (\CARET.UP [COND @@ -765,10 +765,7 @@ NIL) ((AND (OR CARET (SETQ CARET \CARET.DEFAULT)) (TIMEREXPIRED? \CARET.TIMER) - [OR [DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM] - (AND (IMAGESTREAMTYPEP STREAM 'TEXT) - (SETQ STREAM (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM))) - 'DSP] + [DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM] (\CARET.FLASH CARET STREAM OFFRATE (OR (KEYDOWNP 'LSHIFT) (KEYDOWNP 'RSHIFT) (KEYDOWNP 'COPY)) @@ -4437,40 +4434,40 @@ (ADDTOVAR LAMA UNIONREGIONS INTERSECTREGIONS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (10558 10752 (SCREENREGIONP 10568 . 10750)) (12196 19557 (\BBTCURVEPT 12206 . 19555)) ( -19558 29374 (CREATETEXTUREFROMBITMAP 19568 . 21498) (PRINTBITMAP 21500 . 22851) (PRINT-BITMAPS-NICELY -22853 . 26704) (PRINTCURSOR 26706 . 27739) (\WRITEBITMAP 27741 . 29372)) (29417 31965 (\GETINTEGERPART - 29427 . 30972) (\CONVERTTOFRACTION 30974 . 31963)) (32102 32974 (CURSORP 32112 . 32331) (CURSORBITMAP - 32333 . 32379) (CreateCursorBitMap 32381 . 32972)) (37336 46379 (CARET 37346 . 39106) (\CARET.CREATE -39108 . 39286) (\CARET.DOWN 39288 . 40640) (\CARET.FLASH? 40642 . 42456) (\CARET.SHOW 42458 . 43027) ( -CARETRATE 43029 . 43687) (\CARET.FLASH.AGAIN 43689 . 44855) (\CARET.FLASH.MULTIPLE 44857 . 45380) ( -\CARET.FLASH 45382 . 46377)) (46380 51452 (\MEDW.CARET.SHOW 46390 . 51450)) (51816 53651 ( -\AREAVISIBLE? 51826 . 52750) (\REGIONOVERLAPAREAP 52752 . 53297) (\AREAINREGIONP 53299 . 53649)) ( -53700 66176 (CREATEREGION 53710 . 54046) (REGIONP 54048 . 54194) (INTERSECTREGIONS 54196 . 56966) ( -UNIONREGIONS 56968 . 59119) (REGIONSINTERSECTP 59121 . 59729) (SUBREGIONP 59731 . 60376) (EXTENDREGION - 60378 . 62535) (EXTENDREGIONBOTTOM 62537 . 63179) (EXTENDREGIONLEFT 63181 . 63800) (EXTENDREGIONRIGHT - 63802 . 64355) (EXTENDREGIONTOP 64357 . 64898) (INSIDEP 64900 . 65668) (STRINGREGION 65670 . 66174)) -(66421 71695 (\BRUSHBITMAP 66431 . 68148) (\GETBRUSH 68150 . 68461) (\GETBRUSHBBT 68463 . 70491) ( -\InitCurveBrushes 70493 . 71559) (\BrushFromWidth 71561 . 71693)) (71696 74763 (\MAKEBRUSH.DIAGONAL -71706 . 71986) (\MAKEBRUSH.HORIZONTAL 71988 . 72382) (\MAKEBRUSH.VERTICAL 72384 . 72696) ( -\MAKEBRUSH.SQUARE 72698 . 72975) (\MAKEBRUSH.ROUND 72977 . 74761)) (74764 75929 (INSTALLBRUSH 74774 . -75927)) (76330 87732 (\DRAWLINE.DISPLAY 76340 . 86447) (RELMOVETO 86449 . 86836) (MOVETOUPPERLEFT -86838 . 87730)) (87733 111218 (\CLIPANDDRAWLINE 87743 . 94189) (\CLIPANDDRAWLINE1 94191 . 105939) ( -\CLIPCODE 105941 . 107315) (\LEASTPTAT 107317 . 107915) (\GREATESTPTAT 107917 . 108545) (\DRAWLINE1 -108547 . 109663) (\DRAWLINE.UFN 109665 . 111216)) (115748 161795 (\DRAWCIRCLE.DISPLAY 115758 . 124571) - (\DRAWARC.DISPLAY 124573 . 124863) (\DRAWARC.GENERIC 124865 . 125618) (\COMPUTE.ARC.POINTS 125620 . -127885) (\DRAWELLIPSE.DISPLAY 127887 . 143556) (\DRAWCURVE.DISPLAY 143558 . 145847) ( -\DRAWPOINT.DISPLAY 145849 . 147045) (\DRAWPOLYGON.DISPLAY 147047 . 150575) (\LINEWITHBRUSH 150577 . -161793)) (161796 193488 (LOADPOLY 161806 . 162366) (PARAMETRICSPLINE 162368 . 172565) (\CURVE 172567 - . 178169) (\CURVE2 178171 . 189502) (\CURVEEND 189504 . 189986) (\CURVESLOPE 189988 . 192471) ( -\CURVESTART 192473 . 192797) (\FDIFS/FROM/DERIVS 192799 . 193486)) (206017 220353 (\FILLCIRCLE.DISPLAY - 206027 . 216775) (\LINEBLT 216777 . 220351)) (220397 222397 (SCREENBITMAP 220407 . 220884) (BITMAPP -220886 . 221120) (BITMAPHEIGHT 221122 . 221498) (BITSPERPIXEL 221500 . 222395)) (223038 224031 ( -DSPFILL 223048 . 223731) (INVERTW 223733 . 224029)) (224032 227675 (\DSPCOLOR.DISPLAY 224042 . 225339) - (\DSPBACKCOLOR.DISPLAY 225341 . 226720) (DSPEOLFN 226722 . 227673)) (228108 232762 (DSPCLEOL 228118 - . 228994) (DSPRUBOUTCHAR 228996 . 229428) (\DSPMOVELR 229430 . 232760)) (232892 234010 ( -\CURSOR.DEFPRINT 232902 . 234008)) (234422 242996 (TEXTUREOFCOLOR 234432 . 235694) (\PRIMARYTEXTURE -235696 . 236278) (\LEVELTEXTURE 236280 . 236781) (INSURE.B&W.TEXTURE 236783 . 238178) ( -INSURE.RGB.COLOR 238180 . 239608) (\LOOKUPCOLORNAME 239610 . 239880) (RGBP 239882 . 240647) (HLSP -240649 . 241024) (HLSTORGB 241026 . 242166) (\HLSVALUEFN 242168 . 242994))))) + (FILEMAP (NIL (10520 10714 (SCREENREGIONP 10530 . 10712)) (12158 19519 (\BBTCURVEPT 12168 . 19517)) ( +19520 29336 (CREATETEXTUREFROMBITMAP 19530 . 21460) (PRINTBITMAP 21462 . 22813) (PRINT-BITMAPS-NICELY +22815 . 26666) (PRINTCURSOR 26668 . 27701) (\WRITEBITMAP 27703 . 29334)) (29379 31927 (\GETINTEGERPART + 29389 . 30934) (\CONVERTTOFRACTION 30936 . 31925)) (32064 32936 (CURSORP 32074 . 32293) (CURSORBITMAP + 32295 . 32341) (CreateCursorBitMap 32343 . 32934)) (37298 46221 (CARET 37308 . 39068) (\CARET.CREATE +39070 . 39248) (\CARET.DOWN 39250 . 40602) (\CARET.FLASH? 40604 . 42298) (\CARET.SHOW 42300 . 42869) ( +CARETRATE 42871 . 43529) (\CARET.FLASH.AGAIN 43531 . 44697) (\CARET.FLASH.MULTIPLE 44699 . 45222) ( +\CARET.FLASH 45224 . 46219)) (46222 51294 (\MEDW.CARET.SHOW 46232 . 51292)) (51658 53493 ( +\AREAVISIBLE? 51668 . 52592) (\REGIONOVERLAPAREAP 52594 . 53139) (\AREAINREGIONP 53141 . 53491)) ( +53542 66018 (CREATEREGION 53552 . 53888) (REGIONP 53890 . 54036) (INTERSECTREGIONS 54038 . 56808) ( +UNIONREGIONS 56810 . 58961) (REGIONSINTERSECTP 58963 . 59571) (SUBREGIONP 59573 . 60218) (EXTENDREGION + 60220 . 62377) (EXTENDREGIONBOTTOM 62379 . 63021) (EXTENDREGIONLEFT 63023 . 63642) (EXTENDREGIONRIGHT + 63644 . 64197) (EXTENDREGIONTOP 64199 . 64740) (INSIDEP 64742 . 65510) (STRINGREGION 65512 . 66016)) +(66263 71537 (\BRUSHBITMAP 66273 . 67990) (\GETBRUSH 67992 . 68303) (\GETBRUSHBBT 68305 . 70333) ( +\InitCurveBrushes 70335 . 71401) (\BrushFromWidth 71403 . 71535)) (71538 74605 (\MAKEBRUSH.DIAGONAL +71548 . 71828) (\MAKEBRUSH.HORIZONTAL 71830 . 72224) (\MAKEBRUSH.VERTICAL 72226 . 72538) ( +\MAKEBRUSH.SQUARE 72540 . 72817) (\MAKEBRUSH.ROUND 72819 . 74603)) (74606 75771 (INSTALLBRUSH 74616 . +75769)) (76172 87574 (\DRAWLINE.DISPLAY 76182 . 86289) (RELMOVETO 86291 . 86678) (MOVETOUPPERLEFT +86680 . 87572)) (87575 111060 (\CLIPANDDRAWLINE 87585 . 94031) (\CLIPANDDRAWLINE1 94033 . 105781) ( +\CLIPCODE 105783 . 107157) (\LEASTPTAT 107159 . 107757) (\GREATESTPTAT 107759 . 108387) (\DRAWLINE1 +108389 . 109505) (\DRAWLINE.UFN 109507 . 111058)) (115590 161637 (\DRAWCIRCLE.DISPLAY 115600 . 124413) + (\DRAWARC.DISPLAY 124415 . 124705) (\DRAWARC.GENERIC 124707 . 125460) (\COMPUTE.ARC.POINTS 125462 . +127727) (\DRAWELLIPSE.DISPLAY 127729 . 143398) (\DRAWCURVE.DISPLAY 143400 . 145689) ( +\DRAWPOINT.DISPLAY 145691 . 146887) (\DRAWPOLYGON.DISPLAY 146889 . 150417) (\LINEWITHBRUSH 150419 . +161635)) (161638 193330 (LOADPOLY 161648 . 162208) (PARAMETRICSPLINE 162210 . 172407) (\CURVE 172409 + . 178011) (\CURVE2 178013 . 189344) (\CURVEEND 189346 . 189828) (\CURVESLOPE 189830 . 192313) ( +\CURVESTART 192315 . 192639) (\FDIFS/FROM/DERIVS 192641 . 193328)) (205859 220195 (\FILLCIRCLE.DISPLAY + 205869 . 216617) (\LINEBLT 216619 . 220193)) (220239 222239 (SCREENBITMAP 220249 . 220726) (BITMAPP +220728 . 220962) (BITMAPHEIGHT 220964 . 221340) (BITSPERPIXEL 221342 . 222237)) (222880 223873 ( +DSPFILL 222890 . 223573) (INVERTW 223575 . 223871)) (223874 227517 (\DSPCOLOR.DISPLAY 223884 . 225181) + (\DSPBACKCOLOR.DISPLAY 225183 . 226562) (DSPEOLFN 226564 . 227515)) (227950 232604 (DSPCLEOL 227960 + . 228836) (DSPRUBOUTCHAR 228838 . 229270) (\DSPMOVELR 229272 . 232602)) (232734 233852 ( +\CURSOR.DEFPRINT 232744 . 233850)) (234264 242838 (TEXTUREOFCOLOR 234274 . 235536) (\PRIMARYTEXTURE +235538 . 236120) (\LEVELTEXTURE 236122 . 236623) (INSURE.B&W.TEXTURE 236625 . 238020) ( +INSURE.RGB.COLOR 238022 . 239450) (\LOOKUPCOLORNAME 239452 . 239722) (RGBP 239724 . 240489) (HLSP +240491 . 240866) (HLSTORGB 240868 . 242008) (\HLSVALUEFN 242010 . 242836))))) STOP diff --git a/sources/ADISPLAY.LCOM b/sources/ADISPLAY.LCOM index aa5ec1646a6302d3c336065a26f2e787e2556454..c15326934126b61e838a77b53692bae4ea99d80b 100644 GIT binary patch delta 531 zcmZvYJ5K^Z6oo-0QA%I&LFBrL0SeZgnH_{}6qnhsVc8|Si%O(WfhfUO)Xu`h%2KnH z|H5ZsXZ#CRwzgXN1B?TP2$3mnCgYcUa%8RiU!8xxZaIo>QQ#rfuemnvr(0i%{POK`R;t zbRtAi6rj3!!uNWzsSpcBHQivUJTvQ`p<8D?@Nz?;#N!W z0uygxvcTbnrRF4%CDIiHB!N5>9*H6e$~jgt(|P7vW--6aY``@2PxKm-7iThULo8FY zc|DMEvMsrKp6|*SgQl+)Kt|2<)@6SkLKC1`g%S{opv;f$@?6JlQiw#scCxzW@-Hvc WWnwCW(K3hm>3FkF_x^e+^8EuVnu?+T delta 657 zcmZutJ#Q015cP=!f<+aDkDwrpPC|(bAA7s^;k(M0^PY3$zO=g+$07xGVuc7uP(ZYi zs3<|#@G}w_3OXvJG&B^5|A6Re5PN4?a)8xpH9K$Sy*KmmbnesH+?(DK;AV34vWXEU zfQd^?S2y22zITEfP*-O`9lP@4mI}k;(eBaHX9rJ4d$9XxaJWBue%A%=GfERiyJ4DS zaBv7}kVg^BQfQi{!rtJ8?E4=#!D^$v7K9P?**x_G?G*16>k44QBqk~zC@aa9$2fSM zkY|zC_tTg+U@b`aMezo>8KYZan)7By(trwjGaejIhD5e&I4&Y8)QeN)j-rphC=1t> zAH}yDUjt?3VNIT^<@5g1t25#pj#f zvF*T)AEo{#0>dz6>@g~|AoBPI7>K~mChaF)OhuaH@j7Kd3bee`B}o4l!nUjr6P`2L z3zJUT18gA>bX%nB_vL1wXZ|LMyh+ O8Q-Le$BVaDfBylaxTk0U diff --git a/sources/UFS b/sources/UFS index a7455a02..26c9bf9e 100644 --- a/sources/UFS +++ b/sources/UFS @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "16-Sep-2023 09:22:55" {DSK}briggs>Projects>medley>sources>UFS.;2 78813 +(FILECREATED "10-Dec-2024 14:53:34" {WMEDLEY}UFS.;36 78539 - :EDIT-BY "briggs" + :EDIT-BY rmk - :CHANGES-TO (FNS \UFSCloseFile) + :CHANGES-TO (VARS UFSCOMS) - :PREVIOUS-DATE "29-Mar-2022 11:29:33" {DSK}briggs>Projects>medley>sources>UFS.;1) + :PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}UFS.;33) (PRETTYCOMPRINT UFSCOMS) @@ -89,8 +89,6 @@ (HTML . TEXT) (HTM . TEXT) (TEX . TEXT) - (PS . TEXT) - (PDF . TEXT) (DCOM . BINARY) (SKETCH . BINARY) (TEDIT . BINARY) @@ -797,8 +795,6 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (HTML . TEXT) (HTM . TEXT) (TEX . TEXT) - (PS . TEXT) - (PDF . TEXT) (DCOM . BINARY) (SKETCH . BINARY) (TEDIT . BINARY) @@ -1156,23 +1152,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8909 10462 (\UFSCreateDevice 8919 . 9284) (\UFS.CREATE.DEVICE 9286 . 10142) ( -\UFSOpenDevice 10144 . 10321) (\UFSCloseDevice 10323 . 10460)) (14725 51227 (\UFSOpenFile 14735 . -18029) (\UFS.OPENP 18031 . 18528) (\UFS.RECOGNIZE.FILE 18530 . 19283) (\UFS.DIRECTORY.NAME 19285 . -20028) (\UFSCloseFile 20030 . 21935) (\UFSGetFileName 21937 . 22136) (\UFSDeleteFile 22138 . 22678) ( -\UFSRenameFile 22680 . 23845) (\UFSReadPages 23847 . 24982) (\UFSWritePages 24984 . 26204) ( -\UFSTruncateFile 26206 . 27703) (\UFSDirectoryNameP 27705 . 28759) (\UFSEventFn 28761 . 29423) ( -\UFSGetFileInfo 29425 . 31707) (\UFS.CREATE.PROPS 31709 . 32062) (\UFSSetFileInfo 32064 . 33293) ( -\UFSGenerateFiles 33295 . 40175) (\UFS.NEXTFILEFN 40177 . 47815) (\UFS.FILEINFOFN 47817 . 49266) ( -\UFS.VALID.PROPP 49268 . 49560) (\UFS.REGISTER.GFS 49562 . 49817) (\UFS.UNREGISTER.GFS 49819 . 50402) -(\UFS.ABORT.DIRECTORY 50404 . 50752) (\UFS.ABORT.CL-DIRECTORY 50754 . 51041) (\UFS.CLEANUP.GFS.TABLE -51043 . 51225)) (51262 57946 (\UFSMakeUnixFormatName 51272 . 52293) (\UFSParseNameString 52295 . 52669 -) (\UFSParse-Directory 52671 . 53212) (\UFS.PARSE.BODY 53214 . 53759) (\UFS.ADJUST.HOST 53761 . 53920) - (\UFS.FULLNAME 53922 . 55130) (\UFS.ADD.HOST.FIELD 55132 . 55492) (\UFS.REMOVE.HOST.FIELD 55494 . -57164) (\UFS.HANDLE.RELATIVEDIRECTORY 57166 . 57944)) (58762 59375 (CHDIR 58772 . 59373)) (59447 60433 - (\DEVICEFILE.EOSERROR 59457 . 60431)) (60506 61743 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60516 . 61361) - (\UNVISIBLE.FLUSH.OPEN.STREAMS 61363 . 61741)) (61776 63402 (\UFSError 61786 . 63400)) (63446 65861 ( -\UFSGetFileType 63456 . 64057) (\UFSSetFileType 64059 . 64656) (\UFSeol 64658 . 65859)) (74508 75632 ( -\UFSGetPrintFileType 74518 . 74930) (\UFSGetFileTypeConfirm 74932 . 75380) (\UFSPrintTypeMenu 75382 . -75630)) (75662 78500 (\UFStoOtherCopyMess 75672 . 77350) (\UFStoOtherRenameMess 77352 . 78498))))) + (FILEMAP (NIL (8676 10229 (\UFSCreateDevice 8686 . 9051) (\UFS.CREATE.DEVICE 9053 . 9909) ( +\UFSOpenDevice 9911 . 10088) (\UFSCloseDevice 10090 . 10227)) (14492 50994 (\UFSOpenFile 14502 . 17796 +) (\UFS.OPENP 17798 . 18295) (\UFS.RECOGNIZE.FILE 18297 . 19050) (\UFS.DIRECTORY.NAME 19052 . 19795) ( +\UFSCloseFile 19797 . 21702) (\UFSGetFileName 21704 . 21903) (\UFSDeleteFile 21905 . 22445) ( +\UFSRenameFile 22447 . 23612) (\UFSReadPages 23614 . 24749) (\UFSWritePages 24751 . 25971) ( +\UFSTruncateFile 25973 . 27470) (\UFSDirectoryNameP 27472 . 28526) (\UFSEventFn 28528 . 29190) ( +\UFSGetFileInfo 29192 . 31474) (\UFS.CREATE.PROPS 31476 . 31829) (\UFSSetFileInfo 31831 . 33060) ( +\UFSGenerateFiles 33062 . 39942) (\UFS.NEXTFILEFN 39944 . 47582) (\UFS.FILEINFOFN 47584 . 49033) ( +\UFS.VALID.PROPP 49035 . 49327) (\UFS.REGISTER.GFS 49329 . 49584) (\UFS.UNREGISTER.GFS 49586 . 50169) +(\UFS.ABORT.DIRECTORY 50171 . 50519) (\UFS.ABORT.CL-DIRECTORY 50521 . 50808) (\UFS.CLEANUP.GFS.TABLE +50810 . 50992)) (51029 57713 (\UFSMakeUnixFormatName 51039 . 52060) (\UFSParseNameString 52062 . 52436 +) (\UFSParse-Directory 52438 . 52979) (\UFS.PARSE.BODY 52981 . 53526) (\UFS.ADJUST.HOST 53528 . 53687) + (\UFS.FULLNAME 53689 . 54897) (\UFS.ADD.HOST.FIELD 54899 . 55259) (\UFS.REMOVE.HOST.FIELD 55261 . +56931) (\UFS.HANDLE.RELATIVEDIRECTORY 56933 . 57711)) (58529 59142 (CHDIR 58539 . 59140)) (59214 60200 + (\DEVICEFILE.EOSERROR 59224 . 60198)) (60273 61510 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60283 . 61128) + (\UNVISIBLE.FLUSH.OPEN.STREAMS 61130 . 61508)) (61543 63169 (\UFSError 61553 . 63167)) (63213 65628 ( +\UFSGetFileType 63223 . 63824) (\UFSSetFileType 63826 . 64423) (\UFSeol 64425 . 65626)) (74234 75358 ( +\UFSGetPrintFileType 74244 . 74656) (\UFSGetFileTypeConfirm 74658 . 75106) (\UFSPrintTypeMenu 75108 . +75356)) (75388 78226 (\UFStoOtherCopyMess 75398 . 77076) (\UFStoOtherRenameMess 77078 . 78224))))) STOP diff --git a/sources/UFS.LCOM b/sources/UFS.LCOM index 5e3d3c43ff4460c0fbe09b024336dac4bda62e23..ac246dbff6d8e23670f9f318ebd00946f2626790 100644 GIT binary patch delta 521 zcmex5kEwee(}ak616`NYWL+ZzBNGKf6Dw0=D`Rsd1r4R-{M>@foYWMB{5%CEh3ar$ zR~H}G$Xc7?{L-T2)MC3(w_rVMV>3;lq$R=xBO@yl3o8>dB?YdeqExsUsTBo9#i~{c zdHE$7nR)37nLsn$LVbJ`6fElzn)USbloV1DOMsSQG1SyhNs~*%&C|!#Imp#9#MMPX z$q>`+CV1ScU~XY*Y^h-7>f#xq>lCR_l$)(!rRnV9=;!VltQ+F5pb_R66s*7n^qRB3 zZ?L9 ziOk1JGAI`cZo1WFq2Pb;C%E%3xNs?Y(h3FX!rgl=_q^|O-gn0{KaXeLZ;lnA9ljP6 zNl`(OsH)QC8Udd4!{P2A@I44$0f7Uyy1vnzh7nV|$s#Pj26WE?Q21_0c(9m*QEjatP@;6%)MFL)L4-+plSRoaTx0)?e z-!SWrX|Qo=etZVy#(orQ+tFZWC)T=A_|ot1#h1b2BWmQ=3>Cv<{1@EBBDmF)eJMZcL zk>t~p(&5`1T^mGj%uS~PeAlp;JGsrw1WFwHIH|Kw$sJU`QC&|LP(3RQwwvBU^&u^@ z@5MFtC9UK1JimE`*E{Pru-S~_Lp!_24l)7N=S*VXvPD!sia9o$mzk7{IBn(C)1&larry>il>medley>sources>WINDOW.;2 222381 +(FILECREATED "29-Jun-2024 00:18:05" {WMEDLEY}WINDOW.;21 221668 - :EDIT-BY "lmm" + :EDIT-BY rmk - :CHANGES-TO (VARS WINDOWCOMS) + :CHANGES-TO (FNS WFROMDS) - :PREVIOUS-DATE " 9-Jul-2022 11:10:09" {DSK}larry>il>medley>sources>WINDOW.;1) + :PREVIOUS-DATE "10-Apr-2023 07:05:18" {WMEDLEY}WINDOW.;20) -(* ; " -Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation. -") - (PRETTYCOMPRINT WINDOWCOMS) -(RPAQQ WINDOWCOMS +(RPAQQ WINDOWCOMS [(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE \TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM HASTTYWINDOWP TTYINFOSTREAM CREATESCREEN \INSURESCREEN \BITMAPTOSCREEN MAINSCREEN) @@ -1390,23 +1386,23 @@ Middle button down moves closest corner.") ) (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP 'LSHIFT) +(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT) (KEYDOWNP 'RSHIFT) - (KEYDOWNP 'COPY] + (KEYDOWNP 'COPY]) -[PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS))) +(PUTPROPS WSOP MACRO [ARGS (LET ((METHOD (CADR (CAR ARGS))) (DISPLAY (CADR ARGS)) (OTHERARGS (CDDR ARGS))) `(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS) of ,DISPLAY)) ,DISPLAY - ,@OTHERARGS] + ,@OTHERARGS]) ) (* "END EXPORTED DEFINITIONS") -(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS)) +(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS)) (DECLARE%: EVAL@COMPILE (RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT)) @@ -1807,7 +1803,8 @@ Middle button down moves closest corner.") (DEFINEQ (WFROMDS - [LAMBDA (DS DONTCREATE) (* ; "Edited 7-Jan-94 12:12 by nilsson") + [LAMBDA (DS DONTCREATE) (* ; "Edited 29-Jun-2024 00:17 by rmk") + (* ; "Edited 7-Jan-94 12:12 by nilsson") (* ;; "Finds or creates a window for a display stream") @@ -1822,9 +1819,9 @@ Middle button down moves closest corner.") [COND ((IMAGESTREAMTYPEP DS 'TEXT) - (* ;; "generalize this mess!!!") + (* ;; "generalize this mess!!! (If type TEXT exists, then these functions exist)") - (RETURN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ DS] + (RETURN (\TEDIT.PRIMARYPANE (TEXTOBJ DS] (SETQ DD (\GETDISPLAYDATA DS DS)) (RETURN (COND ((AND (SETQ HINTW (fetch (\DISPLAYDATA XWINDOWHINT) of DD)) @@ -1834,7 +1831,7 @@ Middle button down moves closest corner.") [(AND (EQ DS \DEFAULTTTYDISPLAYSTREAM) (EQ (TTYDISPLAYSTREAM) \DEFAULTTTYDISPLAYSTREAM))(* ; - "assume this process is doing something with T.") + "assume this process is doing something with T.") (COND ((NOT DONTCREATE) (\CREATE.TTYDISPLAYSTREAM) @@ -1842,7 +1839,7 @@ Middle button down moves closest corner.") ([SETQ HINTW (for WINDOW in (OPENWINDOWS T) thereis (EQ DS (fetch (WINDOW DSP) of WINDOW] (* ; - "(OPENWINDOWS T) returns all windows on all screens") + "(OPENWINDOWS T) returns all windows on all screens") HINTW) ((NOT DONTCREATE) (CREATEW NIL NIL NIL T]) @@ -1869,15 +1866,15 @@ Middle button down moves closest corner.") (DECLARE%: DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -[PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X) +(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X) (COND ((type? WINDOW X) (fetch (WINDOW DSP) of X)) - (T (\ILLEGAL.ARG X] + (T (\ILLEGAL.ARG X]) -[PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) +(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST) (UNINTERRUPTABLY - (\INTERNALTOTOPW FIRST) . REST)] + (\INTERNALTOTOPW FIRST) . REST))) ) (* "END EXPORTED DEFINITIONS") @@ -2043,7 +2040,7 @@ Middle button down moves closest corner.") (* ; "Compiled WINDOWPROP") -(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U)) +(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U)) (DEFOPTIMIZER WINDOWPROP (&REST ARGS) (CWINDOWPROP ARGS)) @@ -3512,7 +3509,7 @@ Middle button down moves closest corner.") (DECLARE%: EVAL@COMPILE DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -[PUTPROPS WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS)) +(PUTPROPS WINDOWOP DMACRO [ARGS (LET ((OPNAME (CAR ARGS)) (METHOD-DEVICE (CADR ARGS)) (TAIL (CDDR ARGS))) (COND @@ -3523,7 +3520,7 @@ Middle button down moves closest corner.") of ,METHOD-DEVICE) ,METHOD-DEVICE ,@TAIL] - (T (ERROR "OPNAME not quoted: " OPNAME] + (T (ERROR "OPNAME not quoted: " OPNAME]) ) (* "END EXPORTED DEFINITIONS") @@ -3938,42 +3935,40 @@ Middle button down moves closest corner.") (FILESLOAD PAINTW) -(ADDTOVAR WindowMenuCommands (Close '\INTERACTIVE.CLOSEW "Closes a window") - (Snap 'SNAPW "Saves a snapshot of a region of the screen.") - (Paint 'PAINTW +(ADDTOVAR WindowMenuCommands + (Close '\INTERACTIVE.CLOSEW "Closes a window") + (Snap 'SNAPW "Saves a snapshot of a region of the screen.") + (Paint 'PAINTW "Starts a painting mode in which the mouse can be used to draw pictures or make notes on windows.") - (Clear 'CLEARW "Clears a window to its gray.") - (Bury 'BURYW "Puts a window on the bottom.") - (Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.") - (Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN." - (SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE - "Puts image on a file; prompts for filename and format" - ) - ("To a printer" 'HARDCOPYIMAGEW.TOPRINTER - "Sends image to a printer of your choosing"))) - (Move 'MOVEW "Moves a window by a corner.") - (Shape 'SHAPEW "Gets a new region for a window. + (Clear 'CLEARW "Clears a window to its gray.") + (Bury 'BURYW "Puts a window on the bottom.") + (Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.") + (Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN." + (SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE + "Puts image on a file; prompts for filename and format") + ("To a printer" 'HARDCOPYIMAGEW.TOPRINTER + "Sends image to a printer of your choosing"))) + (Move 'MOVEW "Moves a window by a corner.") + (Shape 'SHAPEW "Gets a new region for a window. Left button down marks fixed corner; sweep to other corner. Middle button down moves closest corner.") - (Shrink 'SHRINKW - "Replaces this window with its icon (or title if it doesn't have an icon." - )) + (Shrink 'SHRINKW "Replaces this window with its icon (or title if it doesn't have an icon." + )) -(ADDTOVAR BackgroundMenuCommands (SaveVM '(SAVEVM) - "Updates the virtual memory.") - (Snap '(SNAPW) - "Saves a snapshot of a region of the screen.") - (Hardcopy '(HARDCOPYW) - "Send hardcopy of screen region to printer." - (SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE) - +(ADDTOVAR BackgroundMenuCommands + (SaveVM '(SAVEVM) + "Updates the virtual memory.") + (Snap '(SNAPW) + "Saves a snapshot of a region of the screen.") + (Hardcopy '(HARDCOPYW) + "Send hardcopy of screen region to printer." + (SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE) + "Writes a region of screen to a file; prompts for filename and format" - ) - ("To a printer" '(HARDCOPYREGION.TOPRINTER) - - "Sends a region of screen to a printer of your choosing" - )))) + ) + ("To a printer" '(HARDCOPYREGION.TOPRINTER) + "Sends a region of screen to a printer of your choosing")))) (ADDTOVAR WINDOWUSERFORMS ) @@ -3998,7 +3993,7 @@ Middle button down moves closest corner.") (* ;; "Arrange for the proper compiler") -(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE) +(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -4007,45 +4002,43 @@ Middle button down moves closest corner.") (ADDTOVAR LAMA PROMPTPRINT WINDOWPROP DOWINDOWCOM) ) -(PUTPROPS WINDOW COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991 -1992 1993 1994 1999 2000 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (11535 26175 (WINDOWWORLD 11545 . 15298) (WINDOWWORLDP 15300 . 15600) (CHANGEBACKGROUND -15602 . 16639) (CHANGEBACKGROUNDBORDER 16641 . 17192) (TILE 17194 . 17786) ( -\TTY.CREATING.DISPLAYSTREAM 17788 . 18335) (\CREATE.TTY.OUTCHARFN 18337 . 18637) ( -\CREATE.TTYDISPLAYSTREAM 18639 . 21678) (HASTTYWINDOWP 21680 . 21960) (TTYINFOSTREAM 21962 . 22486) ( -CREATESCREEN 22488 . 25431) (\INSURESCREEN 25433 . 25682) (\BITMAPTOSCREEN 25684 . 26045) (MAINSCREEN -26047 . 26173)) (26822 44105 (WINDOW.MOUSE.HANDLER 26832 . 39627) (\PROTECTED.APPLY 39629 . 39877) ( -DOWINDOWCOM 39879 . 41899) (DOBACKGROUNDCOM 41901 . 43059) (DEFAULT.BACKGROUND.COPYFN 43061 . 44103)) -(44186 76069 (BURYW 44196 . 44484) (CLEARW 44486 . 44876) (CLOSEW 44878 . 45652) (\CLOSEW1 45654 . -46007) (\OKTOCLOSEW 46009 . 46368) (\INTERACTIVE.CLOSEW 46370 . 47193) (OPENW 47195 . 48250) ( -DOUSERFNS 48252 . 49413) (DOUSERFNS2 49415 . 49911) (\USERFNISDON'T 49913 . 50184) (\OPENW1 50186 . -50536) (CREATEW 50538 . 51802) (CREATEW1 51804 . 54082) (\CREATEW1 54084 . 55303) (OPENDISPLAYSTREAM -55305 . 55628) (MOVEW 55630 . 55845) (PPROMPT3 55847 . 56175) (\ONSCREENCLIPPINGREGION 56177 . 56728) -(RELMOVEW 56730 . 57028) (SHAPEW 57030 . 61949) (SHAPEW1 61951 . 64653) (\SHAPEW2 64655 . 67341) ( -RESHOWBORDER 67343 . 67854) (\RESHOWBORDER1 67856 . 72782) (TRACKW 72784 . 73899) (SNAPW 73901 . 75574 -) (WINDOWREGION 75576 . 76067)) (76070 76766 (MINIMUMWINDOWSIZE 76080 . 76764)) (78391 101656 ( -ADVISEWDS 78401 . 86344) (SHOWWFRAME 86346 . 88098) (SHOWWTITLE 88100 . 92134) (\STRINGWIDTHGUESS -92136 . 92495) (RESHOWTITLE 92497 . 97138) (TOTOPW 97140 . 97379) (\INTERNALTOTOPW 97381 . 98471) ( -\TTW1 98473 . 101073) (WHICHW 101075 . 101654)) (101785 104623 (WFROMDS 101795 . 103793) (NU\TOTOPWDS -103795 . 104231) (\COERCETODS 104233 . 104621)) (105248 112048 (WINDOWP 105258 . 105404) ( -INSURE.WINDOW 105406 . 105745) (WINDOWPROP 105747 . 106179) (WINDOWADDPROP 106181 . 107915) ( -WINDOWDELPROP 107917 . 108343) (GETWINDOWPROP 108345 . 108895) (GETWINDOWUSERPROP 108897 . 109324) ( -PUTWINDOWPROP 109326 . 109791) (REMWINDOWPROP 109793 . 110848) (WINDOWADDFNPROP 110850 . 112046)) ( -112248 119812 (CWINDOWPROP 112258 . 113263) (CGETWINDOWPROP 113265 . 118483) (\GETWINDOWHEIGHT 118485 - . 119393) (\GETWINDOWWIDTH 119395 . 119810)) (119813 120472 (WINDOW.BITMAP 119823 . 120470)) (120498 -135946 (OPENWP 120508 . 120786) (TOPWP 120788 . 121071) (RESHAPEBYREPAINTFN 121073 . 131325) ( -\INBETWEENP 131327 . 131543) (DECODE/WINDOW/OR/DISPLAYSTREAM 131545 . 133585) (GROW/REGION 133587 . -134150) (CLRPROMPT 134152 . 134556) (PROMPTPRINT 134558 . 134822) (OPENWINDOWS 134824 . 135608) ( -\INSUREWINDOW 135610 . 135944)) (136077 139326 (OVERLAPPINGWINDOWS 136087 . 138369) (WOVERLAPP 138371 - . 138626) (ORDERFROMBOTTOMTOTOP 138628 . 139324)) (139375 144158 (\ONSCREENW 139385 . 140091) ( -\PUTONSCREENW 140093 . 140920) (\UPDATECACHEDFIELDS 140922 . 141186) (\WWCHANGESCREENSIZE 141188 . -142577) (CREATEWFROMIMAGE 142579 . 143542) (UPDATEWFROMIMAGE 143544 . 144156)) (144715 197317 ( -\MEDW.CREATEW 144725 . 149399) (\MEDW.OPENW 149401 . 151759) (\MEDW.CLOSEW 151761 . 153127) ( -\MEDW.MOVEW 153129 . 163741) (\MEDW.RELMOVEW 163743 . 164122) (\MEDW.SHRINKW 164124 . 172308) ( -\MEDW.EXPANDW 172310 . 174577) (\MEDW.SHAPEW 174579 . 179185) (\MEDW.REDISPLAYW 179187 . 181142) ( -\MEDW.BURYW 181144 . 182426) (\MEDW.TOTOPW 182428 . 183776) (\MEDW.DSPCREATE 183778 . 184579) ( -\GENERIC.DSPCREATE 184581 . 186298) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186300 . 186486) ( -\MEDW.GETWINDOWPROP 186488 . 188726) (\MEDW.PUTWINDOWPROP 188728 . 195513) (\MEDW.CURSOR 195515 . -197315)) (197318 197938 (\GENERIC.CURSOR 197328 . 197936))))) + (FILEMAP (NIL (11403 26043 (WINDOWWORLD 11413 . 15166) (WINDOWWORLDP 15168 . 15468) (CHANGEBACKGROUND +15470 . 16507) (CHANGEBACKGROUNDBORDER 16509 . 17060) (TILE 17062 . 17654) ( +\TTY.CREATING.DISPLAYSTREAM 17656 . 18203) (\CREATE.TTY.OUTCHARFN 18205 . 18505) ( +\CREATE.TTYDISPLAYSTREAM 18507 . 21546) (HASTTYWINDOWP 21548 . 21828) (TTYINFOSTREAM 21830 . 22354) ( +CREATESCREEN 22356 . 25299) (\INSURESCREEN 25301 . 25550) (\BITMAPTOSCREEN 25552 . 25913) (MAINSCREEN +25915 . 26041)) (26690 43973 (WINDOW.MOUSE.HANDLER 26700 . 39495) (\PROTECTED.APPLY 39497 . 39745) ( +DOWINDOWCOM 39747 . 41767) (DOBACKGROUNDCOM 41769 . 42927) (DEFAULT.BACKGROUND.COPYFN 42929 . 43971)) +(44054 75937 (BURYW 44064 . 44352) (CLEARW 44354 . 44744) (CLOSEW 44746 . 45520) (\CLOSEW1 45522 . +45875) (\OKTOCLOSEW 45877 . 46236) (\INTERACTIVE.CLOSEW 46238 . 47061) (OPENW 47063 . 48118) ( +DOUSERFNS 48120 . 49281) (DOUSERFNS2 49283 . 49779) (\USERFNISDON'T 49781 . 50052) (\OPENW1 50054 . +50404) (CREATEW 50406 . 51670) (CREATEW1 51672 . 53950) (\CREATEW1 53952 . 55171) (OPENDISPLAYSTREAM +55173 . 55496) (MOVEW 55498 . 55713) (PPROMPT3 55715 . 56043) (\ONSCREENCLIPPINGREGION 56045 . 56596) +(RELMOVEW 56598 . 56896) (SHAPEW 56898 . 61817) (SHAPEW1 61819 . 64521) (\SHAPEW2 64523 . 67209) ( +RESHOWBORDER 67211 . 67722) (\RESHOWBORDER1 67724 . 72650) (TRACKW 72652 . 73767) (SNAPW 73769 . 75442 +) (WINDOWREGION 75444 . 75935)) (75938 76634 (MINIMUMWINDOWSIZE 75948 . 76632)) (78281 101546 ( +ADVISEWDS 78291 . 86234) (SHOWWFRAME 86236 . 87988) (SHOWWTITLE 87990 . 92024) (\STRINGWIDTHGUESS +92026 . 92385) (RESHOWTITLE 92387 . 97028) (TOTOPW 97030 . 97269) (\INTERNALTOTOPW 97271 . 98361) ( +\TTW1 98363 . 100963) (WHICHW 100965 . 101544)) (101675 104661 (WFROMDS 101685 . 103831) (NU\TOTOPWDS +103833 . 104269) (\COERCETODS 104271 . 104659)) (105304 112104 (WINDOWP 105314 . 105460) ( +INSURE.WINDOW 105462 . 105801) (WINDOWPROP 105803 . 106235) (WINDOWADDPROP 106237 . 107971) ( +WINDOWDELPROP 107973 . 108399) (GETWINDOWPROP 108401 . 108951) (GETWINDOWUSERPROP 108953 . 109380) ( +PUTWINDOWPROP 109382 . 109847) (REMWINDOWPROP 109849 . 110904) (WINDOWADDFNPROP 110906 . 112102)) ( +112308 119872 (CWINDOWPROP 112318 . 113323) (CGETWINDOWPROP 113325 . 118543) (\GETWINDOWHEIGHT 118545 + . 119453) (\GETWINDOWWIDTH 119455 . 119870)) (119873 120532 (WINDOW.BITMAP 119883 . 120530)) (120558 +136006 (OPENWP 120568 . 120846) (TOPWP 120848 . 121131) (RESHAPEBYREPAINTFN 121133 . 131385) ( +\INBETWEENP 131387 . 131603) (DECODE/WINDOW/OR/DISPLAYSTREAM 131605 . 133645) (GROW/REGION 133647 . +134210) (CLRPROMPT 134212 . 134616) (PROMPTPRINT 134618 . 134882) (OPENWINDOWS 134884 . 135668) ( +\INSUREWINDOW 135670 . 136004)) (136137 139386 (OVERLAPPINGWINDOWS 136147 . 138429) (WOVERLAPP 138431 + . 138686) (ORDERFROMBOTTOMTOTOP 138688 . 139384)) (139435 144218 (\ONSCREENW 139445 . 140151) ( +\PUTONSCREENW 140153 . 140980) (\UPDATECACHEDFIELDS 140982 . 141246) (\WWCHANGESCREENSIZE 141248 . +142637) (CREATEWFROMIMAGE 142639 . 143602) (UPDATEWFROMIMAGE 143604 . 144216)) (144775 197377 ( +\MEDW.CREATEW 144785 . 149459) (\MEDW.OPENW 149461 . 151819) (\MEDW.CLOSEW 151821 . 153187) ( +\MEDW.MOVEW 153189 . 163801) (\MEDW.RELMOVEW 163803 . 164182) (\MEDW.SHRINKW 164184 . 172368) ( +\MEDW.EXPANDW 172370 . 174637) (\MEDW.SHAPEW 174639 . 179245) (\MEDW.REDISPLAYW 179247 . 181202) ( +\MEDW.BURYW 181204 . 182486) (\MEDW.TOTOPW 182488 . 183836) (\MEDW.DSPCREATE 183838 . 184639) ( +\GENERIC.DSPCREATE 184641 . 186358) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186360 . 186546) ( +\MEDW.GETWINDOWPROP 186548 . 188786) (\MEDW.PUTWINDOWPROP 188788 . 195573) (\MEDW.CURSOR 195575 . +197375)) (197378 197998 (\GENERIC.CURSOR 197388 . 197996))))) STOP diff --git a/sources/WINDOW.LCOM b/sources/WINDOW.LCOM index 8faf1ae67cef43e63eb1dec53016117bb6402ddf..ff1f1a974b458f96a28efd4ebffbf225147489c5 100644 GIT binary patch delta 749 zcmaKpO=}ZD7{^T$C=Cb^N-V9&!}j0?*)X#&$!3+(HM^->HoM#1Nkb&HXj(+HO-Rj2 z+TQda)U-?WQ2Z3rqX<2EDnh@2H;=v?yopatK!ws_nE!v?o_U_%eBDnS_f!4)J-H+; z_BJJ%$SM$GP~9M!0HV-pZ*(3%U0;LtCJ6AnUbQXPZfxJ)YWKRW^{u(O<5_+^e@mu0 zNDH$5H;Swn6uY*6lHIM;To?Y`%;)n0tUY*!fzP=l6CsxtD~@ZIL)&Dwg@?|~@1lG_ zmT94&gJD~{4wLRQpu6z|jPhO6Td*UE`5;!j2-5XR=vS>M2SyOu%Z^`*Bn#gJffC8= zbO%TjAVuVXR4zn7FzGNbmzH2irR-ND5XG|3e8&=mP;>(y+M>M~z>d4D|dA%4F%HFIzU67!EPVM`B&qxp$}{2Ai!dj~lMhQ#YY zl@j=Y?F~zbfYKt2P@$*s&e-&5wOTw}1AjkGrBWhH*B9|sCzr`gr;?Zu z;)8`zGgmgVu9-j4l+j6Ar|9^<9IhT&1jd-8QqawO!A%a-K=d08Q2;$RoGlHRPSUj? zK9(&z&^lGlDmn?!?Xo#muqsY6k4`WZEjhB}^XM2*%A+Hi2*N*{be;^0MjvA38$C=0 z8zgXX1~xFP3@gP-qpQ7dIs}R9H0pHp@s88iCP^f`=={J+!wc>%R)#treRnJEC^CoQ zN$vA#6lyd)G1-Phi{4Lm;~kkqpXz%tBsAKbdT|Sh65V|M;B0I+Tv_YxeccJM{+UyF z2^`+`pX22WhrP?OaC_}#LV?yasz7B1mTi_=IXOTXf$Ct{D&~<>IrP_iIur&IL#FGv zIKg80Zr!-19Oa7be<+c{pX=9SGGdRRN-&WxIQD3^hGAzRqa4?Y2Ce-dt$zHI9qzvSt6C zHsmb3RxS(;yZ9fBd2>r1+=g+l89atu(3}sN^~Kp>P6Vo{ICu@MBFG%l925>24l061 eI8YD}dAG*9HQudhzz8959zP(ONC>6EsPGGSMgD34 diff --git a/sources/WINDOWOBJ b/sources/WINDOWOBJ index 633b2560..f0b78fcb 100644 --- a/sources/WINDOWOBJ +++ b/sources/WINDOWOBJ @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jul-2024 21:54:38" {WMEDLEY}WINDOWOBJ.;27 32550 +(FILECREATED " 4-Sep-2024 20:52:28" {WMEDLEY}WINDOWOBJ.;29 32954 :EDIT-BY rmk - :CHANGES-TO (FNS IMAGEFNSCREATE) + :CHANGES-TO (FNS COPYINSERT) - :PREVIOUS-DATE "23-Apr-2024 18:08:13" {WMEDLEY}WINDOWOBJ.;26) + :PREVIOUS-DATE "27-Aug-2024 11:51:24" {WMEDLEY}WINDOWOBJ.;28) (PRETTYCOMPRINT WINDOWOBJCOMS) @@ -97,16 +97,24 @@ (COPYINSERT [LAMBDA (IMAGEOBJ) + (* ;; "Edited 4-Sep-2024 20:52 by rmk") + + (* ;; "Edited 27-Aug-2024 11:09 by rmk") + (* ;; "Edited 20-Dec-2021 23:47 by rmk: IMAGEOBJ can now also be a list of objects in the COPYINSERTFN case") (* ;; "Edited 17-Sep-90 13:19 by jds") (* ;;; "inserts IMAGEOBJ into the window that currently has the tty. If this window has a COPYINSERTFN property, that is called, otherwise BKSYSBUF is called.") - (PROG ([TTYW (\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS] + (* ;; "RMK: Take the window of the TTY process, if it has one (e.g. Tedit). Otherwise, (old behavior), get (or make) the window associated with the underlying TTY display stream") + + (PROG ([TTYW (OR (WINDOWP (PROCESSPROP (TTY.PROCESS) + 'WINDOW)) + (\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS] INSERTFN) (COND - ((SETQ INSERTFN (WINDOWPROP TTYW 'COPYINSERTFN)) + ([SETQ INSERTFN (AND TTYW (WINDOWPROP TTYW 'COPYINSERTFN] (for IMOBJ inside IMAGEOBJ do (APPLY* INSERTFN IMOBJ TTYW))) (T (* ;  "IMAGEOBJ can be a list of things too.") @@ -596,11 +604,11 @@ Either delete this image object or load its support files." IMAGEOBJ) (ADDTOVAR LAMA IMAGEOBJPROP) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4785 23416 (COPYINSERT 4795 . 6322) (IMAGEBOX 6324 . 6504) (IMAGEFNSCREATE 6506 . 7844) - (IMAGEFNSP 7846 . 8087) (IMAGEOBJCREATE 8089 . 8634) (IMAGEOBJP 8636 . 8877) (IMAGEOBJPROP 8879 . -14771) (\IMAGEUSERPROP 14773 . 15367) (HPRINT.IMAGEOBJ 15369 . 15958) (COPYIMAGEOBJ 15960 . 16703) ( -READIMAGEOBJ 16705 . 22062) (WRITEIMAGEOBJ 22064 . 23414)) (23630 32272 ( -ENCAPSULATEDOBJ.BUTTONEVENTINFN 23640 . 25423) (ENCAPSULATEDOBJ.PUTFN 25425 . 26540) ( -ENCAPSULATEDOBJ.DISPLAYFN 26542 . 28345) (ENCAPSULATEDOBJ.IMAGEBOXFN 28347 . 30523) (ENCAPSULATEDOBJP -30525 . 30833) (ENCAPSULATEDIMAGEFNS 30835 . 32270))))) + (FILEMAP (NIL (4781 23820 (COPYINSERT 4791 . 6726) (IMAGEBOX 6728 . 6908) (IMAGEFNSCREATE 6910 . 8248) + (IMAGEFNSP 8250 . 8491) (IMAGEOBJCREATE 8493 . 9038) (IMAGEOBJP 9040 . 9281) (IMAGEOBJPROP 9283 . +15175) (\IMAGEUSERPROP 15177 . 15771) (HPRINT.IMAGEOBJ 15773 . 16362) (COPYIMAGEOBJ 16364 . 17107) ( +READIMAGEOBJ 17109 . 22466) (WRITEIMAGEOBJ 22468 . 23818)) (24034 32676 ( +ENCAPSULATEDOBJ.BUTTONEVENTINFN 24044 . 25827) (ENCAPSULATEDOBJ.PUTFN 25829 . 26944) ( +ENCAPSULATEDOBJ.DISPLAYFN 26946 . 28749) (ENCAPSULATEDOBJ.IMAGEBOXFN 28751 . 30927) (ENCAPSULATEDOBJP +30929 . 31237) (ENCAPSULATEDIMAGEFNS 31239 . 32674))))) STOP diff --git a/sources/WINDOWOBJ.LCOM b/sources/WINDOWOBJ.LCOM index 9deb3610dfbd979f29f84d7d236ee7d1ef2f2295..bcccba95281ce07394bf8897ce9350514abff682 100644 GIT binary patch delta 670 zcmZuuJ#W)c6pa%QA_FL@)PaQ~OGu4GEWhWk#1l^Z+}cfI%O8yb9YRS|iV8#pB(^O4 z0KgLi5)w0_0(Bt+I}^Wx-@$bPBvgIFeed0mbI!f@$N25!^fBbiJaT;)2rY8%|< zZyvE(tB$G+Z7rtRDzjBf#=*(t!PCdnqvOdKlb6$zXSZy0!f5FC6A`C4dIH(Yx?QYS zD~cjxeE&I>Tm;LQT(53JKGW7hO1a-w*haJUY&kwVt z;SvO7ZZ(`2hs(|wvkhi*y#SD!`A^9?m|rTDq)~~^VPUF;xmuXB%~5eJ-YZk9Nju|r ztJL8a`A)4?3C=EWoZhT_4CW7C1=2hyf7{(TF8kN7eLww`-z^Jilz%ASm^C@tyU8$V zXC9bkA&SF}ND@WtIbAS=!S6ZSB5Vf~h`=;{&cRwM2Mi0_A|3dBHymU%^F@u$uumJv zVzCTBGcoYuu;(VwX6zqhnhrr|%Os-G|3(TFS^_go>{F8RMJCNu zfdu~nUyww~CRt<~^+);}9ZD5I;x0y-Gn#YGJu~V5?p-AXs#lsn2NfnU1sF9{#gMO0 z=~ypAPN3RiMyrOx3`rBr`H?(30sLG%d_;ntJBL8S&2nvNL>WcqC zpiG+w=37m~IzT0T6{snT9%LCBJW5>8_LDf|!F;6#hprdK0iO-Veu65HIDy}`L#Vyz zqbw-P;utYy6i}JhBioGPHmcA3@=oA-k>dfYLf!9lk(>wE;{sA^P(lxQTstzY7B2&p PRS@uC|I)YaHYeg=p|+8_