From 44e42940a99d269a9b71512c03b051aff1e03b22 Mon Sep 17 00:00:00 2001 From: rmkaplan <69548581+rmkaplan@users.noreply.github.com> Date: Mon, 11 Mar 2024 23:12:46 -0700 Subject: [PATCH] Tedit 4th round (#1352) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * INSPECT: Sort datatype fields alphabetically, fixed a small bug * INSPECT: Sort only DATATYPE records * VIRTUALKEYBOARD: fix loadup * Reorganizing VIRTUALKEYBOARDS as described in #1267 * KEYBOARDEDITOR: fixed one bug, still is out of step * MEDLEYDIR: Pack DSK as the default HOST on the value of (UNIX-GETENV "MEDLEYDIR") * Move KEYBOARDCONFIGS KEYBOARDEDIT to library/virtualkeyboards This collects all files relevant to VIRTUALKEYBOARDS into the same subdirectory * NEARESTCORNER must be onscreen (addresses #1294 Mouse jumps to the nearest onscreen corner of the ghost region * EQUALALL tests equivalence of bitmaps and big bitmaps * Oops, off by one * INSPECT: had wrong test in deciding whether to sort or not * Improve check for closed stream in \UFSCloseFile. Check if the (STREAM ACCESS) bits are NIL, indicating a closed stream, and if so do not attempt to close the file again * COMPAREDIRECTORIES, COMPARESOURCES, COMPARETEXT, EXAMINEDEFS Relatively minor cleanups, little or no functionality improvements * Remove calls to OPENFILE OPENFILE is a residual Interlisp function that returns a litatom instead of a stream. In almost all cases, this immediate causes an error that litatom files are no longer supported. I have found (FINDCALLERS) all the examples in lispusers/sources/library/ and replaced OPENFILE with OPENSTREAM (except for the calls from \PEEKPUP and \PEEKNS, that I didn't track down). There was a trivai call in COMPILE.FILECHECK in COMPILE, but that function is not called anywhere. So I removed it. * ADIR: remove OPENFILE calls, also another stab at \COPYSYS With respect to \COPYSYS, this replaces the draft PR #1263. This applies TRUEFILENAME at the start, but remembers whether it was in fact a pseudohost and restores that for the return value. So if you start in a pseudo world you end up there. * Next version of TEDIT core files * Update * Update * UPDATE * UPDATE * UPDATE: FORCE-END fix * FILEIO: OPENSTREAM parameters default to STREAMPROP also add LINELENGTH * Expose useful subfunctions * TEDITDORADOKEYS - compatibility with new declarations * Update tedit-exports.all * * removed from title when all changes are undone * Delete old tedit fiels * Add TEDIT.FILEDATE * REGISTER-TYPED-REGION creates a new TYPED-REGIONS entry If a window is closed whose region is of an as-yet-unknown type, a new entry will be added implicitly to TYPED-REGIONS to that that region and future regions of that type can be recycled. * COMPAREDIRECTORIES: Get AUTHOR only if selected This may provide a little speed up. But of more importance, almost all the array crashes I am seeing are underneath (GETFILEINFO xxx 'AUTHOR). The UFS implementation may be smashing array space, or maybe it is just detecting the corruption. For now, I'm eliminating this potential source of bad behavior. * Hilighting and caret flashing in split windows * A little more on window splitting caret/hilights * Rename caret functions * REGIONMANAGER: Compatibility with REGIONMANAGER PR * EXAMINEDEFS: Better interpretation of TYPE NIL = (FNS FUNCTIONS) with better formatting * Refining caret behavior, importing separate changes also in other PRs for compatibility * Mostly dealing with highlighting and caret flashing in split windows * FONTPROFILE: specvars declaration for cleanliness * Prep for UTF8, a little performance tuning * Meta EOL = non-paragraph linebreak * Back-scrolling based on linebreak characters, not paragraph breaks, also eliminate obsolete code * FIddling around with window titles (getting *'s when changed), dealing with titles not computed by Tedit * Recompile DOC-OBJECTS because \DIRTY bit has changed * COMPARETEXT: fixed to avoid EOF error if EOL gets confused * CLIPBOARD (bug fix also a separate PR) * \TEXTBOUT of EOL doesn't create a paragraph, though typing does Otherwise, every line in a plaintext or lisp sourcefile is a separate paragraph, which adds unnecessary overhead. * TEDIT-PCTREE: Move some straggling piece and btree functions to their proper home * Change \TEDIT2 to \TEDIT1 as a way of recognizing a Tedit process * Prepping for more speed up in SEEing of large source files * Miscellaneous stability/maintenance/performance changes Fixes the TEDIT.TITLEMENUFN problem, adds TEDIT.COLLECT.OBJECTS * TEDIT-FILE : fix readers for obsolete Tedit file formats * Cleanout misplaced pane/ files * Fix for most of the lispusers/ hardcopy failures They all had to do with the diacritic overbar in Env-os. * Another diacritic glitch * MODERNIZE: Fixed off by one bug in NEARESTCORNER * Update tedit-exports.all * The "HELP PURGE" problem, plus a little cleanup * hide initial caret in menus * TEDIT-LOOKS, TEDIT-PCTREE: prep for reducing FIXP's * LLSYMBOL's FILEMAP was also incomplete This update hopefully won't reveal any other problems * Introduce NOTSPLITTABLE TEXTPROPERTY If T, window-splitting cannot happen for this text stream. Hopefully removes need for Notecards advice on \TEDIT.SPLITW. * PSEUDHOSTS and .TEDIT: Apply TRUEFILENAME on PREFIX, update documentation Documentation addresses #1303 . Using TRUEFILENAME makes sure it always goes to a ground instance in e.g. (PSEUDOHOST 'MEDLEY '{MEDLEY}). * Don't allow Put of readonly file * Inverted selection (black) hilights in readonly texts More visible than a little underline when there is no blinking cursor * Remove redundant type-tests The I.S.OPRs test the I.V. type for lines and pieces, so that field accesses can safely be fast inside the loops * MULTIPLE-HARDCOPY: at least fix obvious issues with new Tedit Also avoided FILELST as a bound variable. This needs work and maybe a little support from Tedit--it shouldn't be advising and unadvising a Tedit function. * TEDIT-SELECTION: Fix hilighting glitch with READONLY texts (Shift select should have its usual highlighting) * TEDIT menus are not splittable * TEDIT-FILE fixes imageobj bug in old Tedit formats Revealed by running HCFILES * Improve conversion of unformatted to formatted Also cache HINTPC inside \CHTOPC * Fix to pageregion problem in old versions Also adds TEDIT.NCHARS * Code cleanup after testing faster scrolling * EXTERNALFORMAT: \CHECKECOLC macro confusedf ANY vs CR EOL convention * Recompile callers of \CHECKEOLC macro * EXTERNALFORMAT: \CHECKECOLC macro confusedf ANY vs CR EOL convention * Recompile callers of \CHECKEOLC macro * Mostly work on scrolling and HCFILE issues * Trying to fix PSEUDHOSTS conficts * PDFSTREAM Backing up to fix merge problems * update EXTERNALFORMAT to avoid conflicdt * Mostly diacritic display and hardcopy * Change DIRTY field to LDIRTY * Added new user function TEDIT.FINDLOOKS * WINDOWOBJ: READIMAGEOBJ doesn't ask for permission If the image object is on a hyphenated file and it can find a nonhyphenated sister, it loads that. If that doesn't provide the getfn, it tries the original file. * If ANY and no CR after LF, return EOL instead of CR * Move charset management to externalformat (addresses #1454) Removed IMCHARSET from IMAGEOPS declaration, added FORMATCHARSETFN to EXTERNALFORMAT, put XCCS charset handling in the XCCS externalformat. * XCCS, fixed a glitch * Fix EXTERNALFORMAT clash * Mostly CHARENCODING * TEDIT-PF-SEE: Use TEDIT.ATOMBOUND.READTABLE Tedit word-selection → atom selection in source files * For merging with new charset arrangement * Mostly work on hardcopy-display Also asks before it saves a plaintext file as a formatted file * Changing to hardcopy display doesn't mark "dirty" * Mostly Put and Get, reorganizing for UTF8, plus odds and ends * Straggler: TMAX-XREF.LCOM * Meta-EOL * Fix and extend page-format updates Original TEDIT.PAGEFORMAT was unsafe and less useful. Also did not update history for undoing. * Use window's screen's height/width to test offscreen * Write and read unbreakable character property * Don't suggest put-name if TEMPLATE * 2 point hilight if readonly * Mostly proper treatment of invisible pieces and forward char-delete * Forward word delete, better paragraph selection, cleanup, lisp source atom selection * fix conflicts for merge * fix incompatible merge * Updates including UTF-8 plaintext files Other continuing cleanups * Continue edit after writing out UTF-8 plaintext * TEDIT-FILE EOL stays EOL after putting to a different EOL convention for continued editing. * Update EXTERNALFORMAT from master * Get rid of needless file change * EOL processing * Fix Lafite glitches Including relaxing constraints on the order of pieces in Tedit files. * Unsplit any existing panes before main window is reused * TEDIT-FILE glitch * Better TEDIT.FORMATTEDFILEP, more TEDIT.CONCAT * Headings with concatenated Tedit files * Adjust page headers and numbers * Reshaping reestablishes the YBOT of PLINES * Tighten up on binable, better error when binning on empty textstream * TEDIT.PUT.STREAM, left click gives point selection * TEDIT.PUT.STREAM * Unhighlighting of menu buttons related to point vs. single-character selection * Better behavior when moving to foreign target also some cleanup of the file-putting code * More improvements to cursor tracking * Single-char shift-selection (lost an edit) * Try it again * Suppress EOF error * BIN instead of GETBASEBYTE, more cleanup of buttonevent and TEDIT.PUT * Mostly work on process and menu configuration * A little more careful in choosing the current selection (as opposed to prior search target) for find and substitutes Use the selection if it is greater than a single character, otherwise the prior target. meta,G is available for clearly just repeating the prior target. * Make the names of the Tedit menu process more distinctive E.g. TEDIT-Charlooks instead of TEDIT#2. TEDIT and TEDIT#n stand out as the document processes. * Logically correct undo of Move between different documents The destination document keeps the delete event in the source, if it is still the most recent source event when the move is undone, the deletion is undone in the source. Otherwise, the deletion is ignored. * Line spacing reflects offsets * TEXTPROP returns length * TEDIT-HISTORY: Redo of a move just does a new-location insert * remove unwanted cpv from PR * Removed the unecessary SPTEXTOBJ field in SELPIECES, move work on move-undo * Fix hardcopy bug * More work on the hardcopy interface * TEDIT-FILE addresses put of empty stream (issue #1577) --------- Co-authored-by: Nick Briggs Co-authored-by: Larry Masinter --- library/CLIPBOARD | 31 +- library/CLIPBOARD.LCOM | Bin 5023 -> 4808 bytes library/CLIPBOARD.TXT | 17 - library/TEXEC | 219 +- library/TEXEC.LCOM | Bin 45958 -> 44587 bytes library/UNICODE | 1677 +++++---- library/UNICODE.LCOM | Bin 23942 -> 28092 bytes library/UNICODE.TEDIT | Bin 13601 -> 17421 bytes library/lafite/LAFITECOMMANDS | 147 +- library/lafite/LAFITECOMMANDS.LCOM | Bin 59168 -> 58830 bytes library/lafite/LAFITETEDIT | 224 +- library/lafite/LAFITETEDIT.LCOM | Bin 3292 -> 1718 bytes library/tedit/TEDIT | 3854 +++++++++---------- library/tedit/TEDIT-ABBREV | 77 +- library/tedit/TEDIT-ABBREV.LCOM | Bin 3842 -> 3481 bytes library/tedit/TEDIT-CHAT | 260 +- library/tedit/TEDIT-CHAT.LCOM | Bin 8296 -> 5488 bytes library/tedit/TEDIT-COMMAND | 847 +++-- library/tedit/TEDIT-COMMAND.LCOM | Bin 16461 -> 14855 bytes library/tedit/TEDIT-DCL | 1646 --------- library/tedit/TEDIT-DCL.LCOM | 464 --- library/tedit/TEDIT-DEFAULT-USER.CM | 88 + library/tedit/TEDIT-FILE | 5292 +++++++++++---------------- library/tedit/TEDIT-FILE.LCOM | Bin 59783 -> 38957 bytes library/tedit/TEDIT-FIND | 1007 +++-- library/tedit/TEDIT-FIND.LCOM | Bin 9927 -> 7367 bytes library/tedit/TEDIT-FNKEYS | 692 ++-- library/tedit/TEDIT-FNKEYS.LCOM | Bin 14902 -> 14490 bytes library/tedit/TEDIT-HCPY | 1593 ++------ library/tedit/TEDIT-HCPY.LCOM | Bin 22906 -> 12177 bytes library/tedit/TEDIT-HISTORY | 954 +++-- library/tedit/TEDIT-HISTORY.LCOM | Bin 10994 -> 9358 bytes library/tedit/TEDIT-LOOKS | 3360 +++++++++-------- library/tedit/TEDIT-LOOKS.LCOM | Bin 46107 -> 42540 bytes library/tedit/TEDIT-MENU | 3953 ++++++++++---------- library/tedit/TEDIT-MENU.LCOM | Bin 94683 -> 92628 bytes library/tedit/TEDIT-OLDFILE | 1115 ++++++ library/tedit/TEDIT-OLDFILE.LCOM | Bin 0 -> 19160 bytes library/tedit/TEDIT-PAGE | 2222 ++++++----- library/tedit/TEDIT-PAGE.LCOM | Bin 28658 -> 24208 bytes library/tedit/TEDIT-PCTREE | 1538 +++++--- library/tedit/TEDIT-PCTREE.LCOM | Bin 9124 -> 12871 bytes library/tedit/TEDIT-SCREEN | 5212 +++++++++++++------------- library/tedit/TEDIT-SCREEN.LCOM | Bin 34695 -> 32997 bytes library/tedit/TEDIT-SELECTION | 3815 +++++++++---------- library/tedit/TEDIT-SELECTION.LCOM | Bin 35900 -> 25624 bytes library/tedit/TEDIT-STREAM | 2428 ++++++++++++ library/tedit/TEDIT-STREAM.LCOM | Bin 0 -> 29769 bytes library/tedit/TEDIT-TEXTOFD | 2624 ------------- library/tedit/TEDIT-TEXTOFD.LCOM | Bin 39845 -> 0 bytes library/tedit/TEDIT-TFBRAVO | 2467 +++++++------ library/tedit/TEDIT-TFBRAVO.LCOM | Bin 25307 -> 27095 bytes library/tedit/TEDIT-WINDOW | 4489 +++++++++++++---------- library/tedit/TEDIT-WINDOW.LCOM | Bin 56474 -> 57794 bytes library/tedit/TEDIT.LCOM | Bin 39334 -> 31740 bytes library/tedit/tedit-exports.all | 598 +++ lispusers/COMPARESOURCES | 104 +- lispusers/COMPARESOURCES.LCOM | Bin 16816 -> 17039 bytes lispusers/DOC-OBJECTS | 553 ++- lispusers/DOC-OBJECTS.LCOM | Bin 25604 -> 22909 bytes lispusers/EDITKEYS | 35 +- lispusers/EDITKEYS.LCOM | Bin 3803 -> 3680 bytes lispusers/MULTIPLE-HARDCOPY | 164 +- lispusers/MULTIPLE-HARDCOPY.LCOM | Bin 3695 -> 3673 bytes lispusers/TEDIT-PF-SEE | 36 +- lispusers/TEDIT-PF-SEE.LCOM | Bin 4001 -> 3933 bytes lispusers/TEDIT-PROCESS-KILLER.LCOM | Bin 8697 -> 8719 bytes lispusers/TEDITDORADOKEYS | 439 +-- lispusers/TEDITDORADOKEYS.LCOM | Bin 11104 -> 3405 bytes lispusers/TEDITKEY | 431 +-- lispusers/TEDITKEY.LCOM | Bin 39446 -> 39424 bytes lispusers/WHEELSCROLL | 137 +- lispusers/WHEELSCROLL.LCOM | Bin 5058 -> 4842 bytes lispusers/tedit-process-killer | 51 +- lispusers/tmax/TMAX | 69 +- lispusers/tmax/TMAX-XREF | 80 +- lispusers/tmax/TMAX-XREF.LCOM | Bin 10994 -> 10924 bytes lispusers/tmax/TMAX.LCOM | Bin 15587 -> 15247 bytes sources/SEDIT-COMMANDS.DATABASE | 1 - 79 files changed, 26500 insertions(+), 28510 deletions(-) delete mode 100644 library/CLIPBOARD.TXT delete mode 100644 library/tedit/TEDIT-DCL delete mode 100644 library/tedit/TEDIT-DCL.LCOM create mode 100644 library/tedit/TEDIT-DEFAULT-USER.CM create mode 100644 library/tedit/TEDIT-OLDFILE create mode 100644 library/tedit/TEDIT-OLDFILE.LCOM create mode 100644 library/tedit/TEDIT-STREAM create mode 100644 library/tedit/TEDIT-STREAM.LCOM delete mode 100644 library/tedit/TEDIT-TEXTOFD delete mode 100644 library/tedit/TEDIT-TEXTOFD.LCOM create mode 100644 library/tedit/tedit-exports.all delete mode 100644 sources/SEDIT-COMMANDS.DATABASE diff --git a/library/CLIPBOARD b/library/CLIPBOARD index 6923c049..2e2c381a 100644 --- a/library/CLIPBOARD +++ b/library/CLIPBOARD @@ -1,13 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Jul-2022 23:53:01"  -{DSK}kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;7 9243 +(FILECREATED "19-Oct-2023 00:20:01" {WMEDLEY}CLIPBOARD.;8 9130 - :CHANGES-TO (VARS CLIPBOARDCOMS) - (FNS CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM) + :EDIT-BY rmk - :PREVIOUS-DATE " 3-Jul-2021 13:16:26" -{DSK}kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;6) + :CHANGES-TO (FNS TEDIT.EXTRACTTOCLIPBOARD) + + :PREVIOUS-DATE " 7-Jul-2022 23:53:01" {WMEDLEY}CLIPBOARD.;7) (PRETTYCOMPRINT CLIPBOARDCOMS) @@ -146,12 +145,12 @@ THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM]) (TEDIT.EXTRACTTOCLIPBOARD - [LAMBDA NIL (* ; "Edited 19-Apr-2020 12:17 by rmk:") - (* ; "Edited 18-Apr-2018 00:02 by rmk:") - (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] - (IF TEXTSTREAM - THEN (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TEXTSTREAM)) - (TEDIT.DELETE TEXTSTREAM (TEDIT.GETSEL TEXTSTREAM]) + [LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 19-Oct-2023 00:19 by rmk") + (* ; "Edited 19-Apr-2020 12:17 by rmk:") + (* ; "Edited 18-Apr-2018 00:02 by rmk:") + (CL:WHEN TSTREAM + (PUTCLIPBOARD (TEDIT.SEL.AS.STRING TSTREAM)) + (TEDIT.DELETE TSTREAM SEL))]) ) (DEFINEQ @@ -199,8 +198,8 @@ ) (PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1317 6626 (INSTALL-CLIPBOARD 1327 . 3259) (GETCLIPBOARD 3261 . 3635) (PUTCLIPBOARD 3637 - . 4042) (PASTEFROMCLIPBOARD 4044 . 4962) (LISPINTERRUPTS.PASTE 4964 . 5385) (CLIPBOARD-COPY-STREAM -5387 . 5902) (CLIPBOARD-PASTE-STREAM 5904 . 6624)) (6627 7386 (TEDIT.COPYTOCLIPBOARD 6637 . 6918) ( -TEDIT.EXTRACTTOCLIPBOARD 6920 . 7384)) (7387 8926 (SEDIT.COPYTOCLIPBOARD 7397 . 8924))))) + (FILEMAP (NIL (1196 6505 (INSTALL-CLIPBOARD 1206 . 3138) (GETCLIPBOARD 3140 . 3514) (PUTCLIPBOARD 3516 + . 3921) (PASTEFROMCLIPBOARD 3923 . 4841) (LISPINTERRUPTS.PASTE 4843 . 5264) (CLIPBOARD-COPY-STREAM +5266 . 5781) (CLIPBOARD-PASTE-STREAM 5783 . 6503)) (6506 7273 (TEDIT.COPYTOCLIPBOARD 6516 . 6797) ( +TEDIT.EXTRACTTOCLIPBOARD 6799 . 7271)) (7274 8813 (SEDIT.COPYTOCLIPBOARD 7284 . 8811))))) STOP diff --git a/library/CLIPBOARD.LCOM b/library/CLIPBOARD.LCOM index 483b9dd86ee914753203f494ac3373fe0c1a3bc1..6076ac5d4e82858dba19200d720b36e811ce707c 100644 GIT binary patch delta 535 zcmZvY%TB^T6owmF*=RJfaC>Y*Y!_|XsYV!$p_c(mhL*I0z>?d72tq0*8e_V2<3i&D z_ztr15nP%0Mh-*)Bb&)d=Hxry|G(~kWS(k?kyC^ASVcNALDwGxW3Grm1_s8_KAD|EHvtOBBBWEUI`ImlszBxuFmIjDOximx&l z7;!zOkva=4hb1hSlc2{>6{?iNGECDn2|CR&S6O)_Cn=&_@F;OYVsSP|t0S$Bko;zV zoMGyKr*5jFYKlUBo`RABSG7y9 zcdbomacWVqU3OwYPGX*&PkwS@j$LkQN=|B}v7V`2d45rLW?s53M8qy9GpQ)CsM5~a z$1}jm-!aHV&)QrQXcUrthK5$s1_o9}ra%jlic;ZLrdAXb6{}iJF5ncKtSKm7uaF6J zgIlPNj{>r8Jv}`og_Oh+pc}c+jRl%&Y^bEkrQzo3KNkcf@(LyuLS)TM4aao zER9Tz6|9^+9R1u~gLOmv6*R&egMt;f;344b?;EVCpyB2h4E361u2n#gYnZ2hXt1se z(2XFE7{lVjP{GjH%FxWp$V^FrD#35I`2k}G&*XEwf{B`p3=9kjK+M1iA_N&3JW@7E zfZ1TeBLz%xfg}YOG>k12fC1Z4#}rVtPs0{5qak>O-v TKJ&?nETWSG1lTt5pI`<6z+b9a diff --git a/library/CLIPBOARD.TXT b/library/CLIPBOARD.TXT deleted file mode 100644 index b8959830..00000000 --- a/library/CLIPBOARD.TXT +++ /dev/null @@ -1,17 +0,0 @@ -library/CLIPBOARD - -Written by Ron Kaplan, 2020-2021 - -A small package that implements copy and paste to the system clipboard. - -It arms meta-C for copy to the clipboard from the current selection of an application that has been armed (Tedit, Sedit), and also meta-X for extraction (copy followed by delete). - -Meta-V is defined as an interrupt character that pastes the current clipboard contents into whatever process curent has input focus. - -The information in the clipboard can be provided from or provided to external (non-Medley) applications (mail, emacs, etc.) in the usual way. For example, a form cselected in SEDIT can be copied to the clipboard and pasted into an email message. - -It assumes that the external format of the clipboard is determined by (SYSTEM-EXTERNALFORMAT, and characters will be converted to and from the Medley internal character encoding. - -The name of the clipboard stream may differ from platform to platform. On the Mac, the paste stream is "pbpaste" and the copy stream is "pbcopy". Those names are used if "darwin" is a substring of (UNIX-GETENV "ostype"). Otherwise both stream-names default to "xclip". The functions CLIPBOARD-COPY-STREAM and CLIPBOARD-PASTE-STREAM perform this selection. - - diff --git a/library/TEXEC b/library/TEXEC index 93958a4c..dd671ff3 100644 --- a/library/TEXEC +++ b/library/TEXEC @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Jul-2022 23:42:20"  -|{DSK}kaplan>Local>medley3.5>working-medley>library>TEXEC.;3| 196212 +(FILECREATED "18-Jun-2023 09:48:54" |{WMEDLEY}TEXEC.;5| 185935 - :CHANGES-TO (VARS TEXECCOMS TEXEC.ICON TEXEC.ICON.MASK TEXEC.TITLED.ICON.TEMPLATE) + :EDIT-BY |rmk| - :PREVIOUS-DATE " 1-Feb-2022 09:24:13" -|{DSK}kaplan>Local>medley3.5>working-medley>library>TEXEC.;2|) + :CHANGES-TO (VARS TEXECCOMS) + + :PREVIOUS-DATE "16-Jul-2022 23:42:20" |{WMEDLEY}TEXEC.;3|) ; Copyright (c) 1985, 1900, 1986-1991 by Venue & Xerox Corporation. @@ -16,22 +16,22 @@ (RPAQQ TEXECCOMS ((COMS (* \;  "To support development and compilation") - (DECLARE\: DONTCOPY EVAL@COMPILE (FILES (LOADCOMP) - ATERM TEDIT-DCL))) + (DECLARE\: DONTCOPY EVAL@COMPILE (FILES TEDIT-EXPORTS.ALL (LOADCOMP) + ATERM))) (COMS (* |;;| "THE FILLBUFFER REPLACEMENT CODE") (FNS TEXEC.BACKSKREAD TEXEC.OPENTEXTSTREAM TEXEC.DEFAULT.MENUFN TEXEC.DO?CMD TEXEC.CREATEMENU TEXEC.GET TEXEC.INCLUDE TEXEC.FIND.FORWARD TEXEC.FIND.BACKWARD - TEDIT.FIND.BACKWARD TEDIT.BASICFIND.BACKWARD TEXEC.MENU.WHENHELDFN - TEXEC.SHRINK.ICONCREATE TEXEC.FILLBUFFER TEXEC.FILLBUFFER.TCLASS - TEXEC.CHSELPENDING TEXEC.FILLBUFFER.CHARDELETE TEXEC.FILLBUFFER.WORDDELETE - TEXEC.FILLBUFFER.LINEDELETE TEXEC.PARENCOUNT TEXEC.PARENMATCH TEXEC.FLASHCARET - TEXEC.TEXTSTREAM.TO.LINEBUF TEXEC.FIX TEXEC.NTHBUFCHARBACK TEXEC.NTHBACKCHNUM - TEXEC.EOTP TEXEC.GETKEY TEXEC.INSERTCHAR TEXEC.DELETE TEXEC.\\CHDEL1 TEXEC.?EQUAL - TEDIT.SCROLL? TEXEC.DISPLAYTEXT \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 - \\TEXEC.TEXTBOUT2 \\TEXEC.TEXTBOUT3 \\TEXEC.TEXTBOUT4 \\TEXEC.SELFN - TEXEC.PRINTARGS TEXEC.PROCENTRYFN TEXEC.PROCEXITFN)) + TEXEC.MENU.WHENHELDFN TEXEC.SHRINK.ICONCREATE TEXEC.FILLBUFFER + TEXEC.FILLBUFFER.TCLASS TEXEC.CHSELPENDING TEXEC.FILLBUFFER.CHARDELETE + TEXEC.FILLBUFFER.WORDDELETE TEXEC.FILLBUFFER.LINEDELETE TEXEC.PARENCOUNT + TEXEC.PARENMATCH TEXEC.FLASHCARET TEXEC.TEXTSTREAM.TO.LINEBUF TEXEC.FIX + TEXEC.NTHBUFCHARBACK TEXEC.NTHBACKCHNUM TEXEC.EOTP TEXEC.GETKEY TEXEC.INSERTCHAR + TEXEC.DELETE TEXEC.\\CHDEL1 TEXEC.?EQUAL TEDIT.SCROLL? TEXEC.DISPLAYTEXT + \\TEXEC.TEXTBOUT \\TEXEC.TEXTBOUT1 \\TEXEC.TEXTBOUT2 \\TEXEC.TEXTBOUT3 + \\TEXEC.TEXTBOUT4 \\TEXEC.SELFN TEXEC.PRINTARGS TEXEC.PROCENTRYFN TEXEC.PROCEXITFN + )) (COMS (* |;;| "Code to support a TEXEC lisp 'listener'") @@ -56,8 +56,8 @@ (DECLARE\: DONTCOPY EVAL@COMPILE -(FILESLOAD (LOADCOMP) - ATERM TEDIT-DCL) +(FILESLOAD TEDIT-EXPORTS.ALL (LOADCOMP) + ATERM) ) @@ -996,155 +996,6 @@ (\\SHOWSEL (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ) NIL T)))))))) -(TEDIT.FIND.BACKWARD - (LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* \; "Edited 30-May-91 19:17 by jds") - - (* I\f WILDCARDS? |is| NIL |then| TEDIT.FIND.BACKWARD |is| |the| |old| - TEDIT.FIND. |Else,| |it| |returns| \a |list| |of| - (SEL.START# SEL.END#) |which| |is| |the| |start| |and| |end| |char| |positions| - |of| |the| |selection|) - - (PROG ((TEDIT.WILDCARD.CHARACTERS '("#" "*"))) - (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) - (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (\\TEDIT.HISTORYADD TEXTOBJ (|create| TEDITHISTORYEVENT - THACTION _ '|Find| - THAUXINFO _ TARGETSTRING)) - (|replace| (TEXTOBJ \\INSERTPCVALID) |of| TEXTOBJ |with| NIL) - (* |Any| FIND |invalidates| |the| - |type-in| |cache.|) - (RETURN - (COND - (WILDCARDS? - - (* |will| |return| \a |list| |of| |start| |and| |end| |of| |selection| |or| - |nil| |if| |not| |found|) - - (PROG (TARGETLIST SEL RESULT RESULT1) - (RETURN (COND - ((OR START# (AND (|fetch| (SELECTION SET) - |of| (SETQ SEL (|fetch| (TEXTOBJ SEL) - |of| TEXTOBJ))) - (LEQ (SETQ START# (SELECTQ (|fetch| (SELECTION - POINT) - |of| SEL) - (LEFT (|fetch| - (SELECTION CH#) - |of| SEL)) - (RIGHT (|fetch| - (SELECTION CHLIM) - |of| SEL)) - NIL)) - (OR END# (SETQ END# 1))))) - (* |Backwards| |search|) - (COND - ((AND (|for| X - |in| (SETQ TARGETLIST - (\\TEDIT.PARSE.SEARCHSTRING - (|for| X |in| (UNPACK (MKATOM - TARGETSTRING - )) - |collect| (MKSTRING X)))) |collect| - X - |when| (LITATOM X)) - (SETQ RESULT1 (\\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST END# - START#))) - (* I\f |there| |are| |atoms,| |they| - |are| |tedit| |wildcard| |chars|) - (\\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 START#)) - (T (* |no| |wildcards| |but| |bounded| - |search|) - (COND - ((SETQ RESULT (TEDIT.FIND.BACKWARD TEXTOBJ (CAR - TARGETLIST - ) - START# END# NIL)) - (LIST RESULT (SUB1 (IPLUS RESULT (NCHARS (CAR TARGETLIST)) - )))))))))))) - (T (* |will| |return| |just| |the| - |number| |of| |the| |start| |char| - |or| |nil| |if| |not| |found|) - (PROG (RESULT) - (SETQ RESULT (TEDIT.BASICFIND.BACKWARD TEXTOBJ TARGETSTRING START# 1)) - (RETURN (COND - ((NULL END#) - RESULT) - ((OR (NULL RESULT)) - NIL) - (T RESULT)))))))))) - -(TEDIT.BASICFIND.BACKWARD - (LAMBDA (TEXTOBJ STRING CH# CHLIM) (* \; "Edited 30-May-91 19:17 by jds") - - (* |Search| |thru| TEXTOBJ\, |starting| |where| |the| |caret| |is,| |for| |the| - |string| STRING\, |exact| |match| |only| |for| |now.| - (|Optionally,| |start| |the| |search| |at| |character| |ch#.|)) - - (PROG ((SEL (|fetch| (TEXTOBJ SEL) |of| TEXTOBJ)) - (TEXTLEN (|fetch| (TEXTOBJ TEXTLEN) |of| TEXTOBJ)) - (TEXTLIM (OR CHLIM (ADD1 (IDIFFERENCE (|fetch| (TEXTOBJ TEXTLEN) |of| TEXTOBJ) - (NCHARS STRING))))) - (TEXTSTREAM (|fetch| (TEXTOBJ STREAMHINT) |of| TEXTOBJ)) - (FOUND NIL) - CH1 CH CH#1 (RSTRING "") - (TSTRING (CONCAT STRING)) - ANCHOR PCH# OANCHOR CH) (* |Reverse| |the| |string|) - (|while| (SETQ CH (GLC TSTRING)) |do| (SETQ RSTRING (CONCAT RSTRING (MKSTRING - CH)))) - (SETQ CH#1 (NTHCHARCODE RSTRING 1)) - (|replace| (TEXTOBJ \\INSERTPCVALID) |of| TEXTOBJ |with| NIL) - - (* |2/12/85| JDS\: I |don't| |understand| WHY |this| |is| |here,| |but| |I'll| - |assume| |it's| |right| |for| |now.|) - (* |Prohibit| |future| |insertions| - |in| |the| |current| |piece.|) - (COND - ((OR CH# (|fetch| (SELECTION SET) |of| SEL)) - (* |There| |must| |be| \a - |well-defined| |starting| |point.|) - (RETURN (PROG NIL - (SETQ CH1 (SUB1 (OR CH# (SELECTQ (|fetch| (SELECTION POINT) - |of| SEL) - (LEFT (|fetch| (SELECTION CH#) - |of| SEL)) - (RIGHT (|fetch| (SELECTION CHLIM) - |of| SEL)) - NIL)))) - (* |Find| |the| |starting| |point| - |for| |the| |search|) - (* DO THE SEARCH) - (COND - ((ILESSP CH1 2) (* |Starting| |the| |search| |past| - |the| |last| |possible| |starting| - |point.| |Just| |punt.|) - (RETURN NIL))) - RETRY - (SETQ ANCHOR CH1) - (\\SETUPGETCH ANCHOR TEXTOBJ) - (|for| |old| ANCHOR |from| CH1 |by| -1 |to| 2 - |do| (SETQ CH (\\BACKBIN TEXTSTREAM)) - (COND - ((EQ CH CH#1) - (RETURN)))) - (COND - ((ILEQ ANCHOR 2) - (RETURN NIL))) (* N\o |starting| |character| - |found| |before| |end| |of| |string|) - (SETQ OANCHOR ANCHOR) - (SETQ FOUND T) - (|for| |old| CH1 |from| (SUB1 ANCHOR) |to| 2 |by| - -1 - |as| PCH# |from| 2 |to| (NCHARS STRING) - |do| (SETQ CH (\\BACKBIN TEXTSTREAM)) - (COND - ((NEQ CH (NTHCHARCODE RSTRING PCH#)) - (SETQ FOUND NIL) - (RETURN)))) - (COND - (FOUND (RETURN ANCHOR)) - (T (GO RETRY)))))))))) - (TEXEC.MENU.WHENHELDFN (LAMBDA (ITEM MENU BUTTON) (* AJB "30-Jan-86 13:09") (PROMPTPRINT (SELECTQ (CAR ITEM) @@ -3160,21 +3011,21 @@ (RPAQ? TEXEC.BUFFERLIMIT 10000) (PUTPROPS TEXEC COPYRIGHT ("Venue & Xerox Corporation" 1985 1900 1986 1987 1988 1989 1990 1991)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3225 181985 (TEXEC.BACKSKREAD 3235 . 7859) (TEXEC.OPENTEXTSTREAM 7861 . 9919) ( -TEXEC.DEFAULT.MENUFN 9921 . 14475) (TEXEC.DO?CMD 14477 . 19795) (TEXEC.CREATEMENU 19797 . 20255) ( -TEXEC.GET 20257 . 29092) (TEXEC.INCLUDE 29094 . 42479) (TEXEC.FIND.FORWARD 42481 . 55369) ( -TEXEC.FIND.BACKWARD 55371 . 68873) (TEDIT.FIND.BACKWARD 68875 . 74352) (TEDIT.BASICFIND.BACKWARD 74354 - . 79008) (TEXEC.MENU.WHENHELDFN 79010 . 79669) (TEXEC.SHRINK.ICONCREATE 79671 . 82474) ( -TEXEC.FILLBUFFER 82476 . 98910) (TEXEC.FILLBUFFER.TCLASS 98912 . 105252) (TEXEC.CHSELPENDING 105254 . -113744) (TEXEC.FILLBUFFER.CHARDELETE 113746 . 115801) (TEXEC.FILLBUFFER.WORDDELETE 115803 . 120931) ( -TEXEC.FILLBUFFER.LINEDELETE 120933 . 123815) (TEXEC.PARENCOUNT 123817 . 125206) (TEXEC.PARENMATCH -125208 . 126748) (TEXEC.FLASHCARET 126750 . 129409) (TEXEC.TEXTSTREAM.TO.LINEBUF 129411 . 132098) ( -TEXEC.FIX 132100 . 135269) (TEXEC.NTHBUFCHARBACK 135271 . 136334) (TEXEC.NTHBACKCHNUM 136336 . 137621) - (TEXEC.EOTP 137623 . 138356) (TEXEC.GETKEY 138358 . 141274) (TEXEC.INSERTCHAR 141276 . 143577) ( -TEXEC.DELETE 143579 . 144354) (TEXEC.\\CHDEL1 144356 . 147481) (TEXEC.?EQUAL 147483 . 148532) ( -TEDIT.SCROLL? 148534 . 153497) (TEXEC.DISPLAYTEXT 153499 . 160274) (\\TEXEC.TEXTBOUT 160276 . 163284) -(\\TEXEC.TEXTBOUT1 163286 . 168920) (\\TEXEC.TEXTBOUT2 168922 . 171253) (\\TEXEC.TEXTBOUT3 171255 . -172645) (\\TEXEC.TEXTBOUT4 172647 . 174690) (\\TEXEC.SELFN 174692 . 176067) (TEXEC.PRINTARGS 176069 . -181032) (TEXEC.PROCENTRYFN 181034 . 181575) (TEXEC.PROCEXITFN 181577 . 181983)) (182045 188420 (TEXEC -182055 . 186477) (TTEXEC 186479 . 188418))))) + (FILEMAP (NIL (3083 171708 (TEXEC.BACKSKREAD 3093 . 7717) (TEXEC.OPENTEXTSTREAM 7719 . 9777) ( +TEXEC.DEFAULT.MENUFN 9779 . 14333) (TEXEC.DO?CMD 14335 . 19653) (TEXEC.CREATEMENU 19655 . 20113) ( +TEXEC.GET 20115 . 28950) (TEXEC.INCLUDE 28952 . 42337) (TEXEC.FIND.FORWARD 42339 . 55227) ( +TEXEC.FIND.BACKWARD 55229 . 68731) (TEXEC.MENU.WHENHELDFN 68733 . 69392) (TEXEC.SHRINK.ICONCREATE +69394 . 72197) (TEXEC.FILLBUFFER 72199 . 88633) (TEXEC.FILLBUFFER.TCLASS 88635 . 94975) ( +TEXEC.CHSELPENDING 94977 . 103467) (TEXEC.FILLBUFFER.CHARDELETE 103469 . 105524) ( +TEXEC.FILLBUFFER.WORDDELETE 105526 . 110654) (TEXEC.FILLBUFFER.LINEDELETE 110656 . 113538) ( +TEXEC.PARENCOUNT 113540 . 114929) (TEXEC.PARENMATCH 114931 . 116471) (TEXEC.FLASHCARET 116473 . 119132 +) (TEXEC.TEXTSTREAM.TO.LINEBUF 119134 . 121821) (TEXEC.FIX 121823 . 124992) (TEXEC.NTHBUFCHARBACK +124994 . 126057) (TEXEC.NTHBACKCHNUM 126059 . 127344) (TEXEC.EOTP 127346 . 128079) (TEXEC.GETKEY +128081 . 130997) (TEXEC.INSERTCHAR 130999 . 133300) (TEXEC.DELETE 133302 . 134077) (TEXEC.\\CHDEL1 +134079 . 137204) (TEXEC.?EQUAL 137206 . 138255) (TEDIT.SCROLL? 138257 . 143220) (TEXEC.DISPLAYTEXT +143222 . 149997) (\\TEXEC.TEXTBOUT 149999 . 153007) (\\TEXEC.TEXTBOUT1 153009 . 158643) ( +\\TEXEC.TEXTBOUT2 158645 . 160976) (\\TEXEC.TEXTBOUT3 160978 . 162368) (\\TEXEC.TEXTBOUT4 162370 . +164413) (\\TEXEC.SELFN 164415 . 165790) (TEXEC.PRINTARGS 165792 . 170755) (TEXEC.PROCENTRYFN 170757 . +171298) (TEXEC.PROCEXITFN 171300 . 171706)) (171768 178143 (TEXEC 171778 . 176200) (TTEXEC 176202 . +178141))))) STOP diff --git a/library/TEXEC.LCOM b/library/TEXEC.LCOM index 27c710068e7c20af88d9cefb64a39be986c93541..1570ee447b4d7290e03ca9f901f90bdd9d38b445 100644 GIT binary patch delta 407 zcmZpB&b0at(}bXC3tg|$JY6FLBVz>vODhu#D^n9C1r4R-{M>@foYWMB{5%CEg_`Pc zUso3&*T`C%oXn)6#G*>O5Z4G-XFY4v8chW*B|~$BDMkiX1_oBf=1K|^uj$q!N$Bb6 z0ZmFtEJ;nN!K%l^NJ*1R!_Cvj)j7!3F~rqHLCFxS^YA%G!O+6g(%4kN%GJd)MAy_Q zQlX|OH@il`%Gtxw&)qdxH^g5-gDcE2C|CjP1!sTXU`++9fFRc}Pyf(hT^FFm6a6Km zaob_MIf*INU~=;WkU&Bp-4h7oe8WG?h6cViG=;NcH;p6Y<0yH>4QvqmNkguku rrh*2@A_WaCg&J#Xp!X+F>{pq*t>2!JYx38A^~tgm%r-YnU{eMFCGK@c delta 1714 zcmb`HPi)#&9LEhwS`9S_GMYs!>3$z zRFw+tGHsbuEn|mimr6ZV>V<@HS{AfjHnu}AJv7qp)3n2=a@etZwnIv_+%_NV=imFi z-|xNO_w#;_ezSh^yY-7~ecN)j=Jj0PSi4!O6g1da2M^e)cQ_?=_tL_x!se}bdF5th zWj!u!Twkfg*9uytaGMT<;~#BomP_k5{H7&dDdjg;HgCsOeu-xTGj!Dl9x~#e|DfWh zf)oX0Bo?M)6s1ScZx(t9t57X$e?M`l&odARc%Z7SykF3&C&q|+d^Yc_DDiBTXH=f6 z-?NO>{+B%iIUS)$3Sz9l$aB2nR}pxxFj)m`#<^IOR=_-=$RfFKSWn&atj01~{)&he z6hDXeg$qggXA61r{K4rM6^fCx#|Hnsx>WNAOCea}L^Uug%3L7Hu&G5R%R!8rvUw%& zhG0>YI2N0f%RmD!bCW=UqB2=^5=g+`IbK!NtSHYxP(Ox>lJh-EW7)jx9gPwuZ|2Q-|2^8)tCHOmC!ajA|BR@SW5; zohrJoeVjU9+p`X|{!EV;_9Z8IDmBm=mqvE!guo`x=-YW`_d-ILH^&Z(rqPM+*Zb+# zu#5vNw^P=48;|Al*BXB(1WS@F4iD*Tv|Z2yGuPAdLDB7YB$#B`2*=j7)i%0NiVVW?a^K7%i`knxwkZoq1#2slK;l$A&kPR9 z2Na&kvH}*brmIJWLy%4#NlAvnupnnJ4M2v1*v_aZ4dKXf1VL0(l)cJu98h#mckKHj zL=;n^W0CONE%o{64Mw$ zR?rDNiM??rK@4J65*;hsvg5a@|3Ud_q7&HAwJ{CO56`4^&8LW*Wbj>O1)xY8WL40? zViCs!6{N9)e)W^0jQeY}2c1sAi;2keORK`ufIAn<@GA6^6QW^GVu22svsm$7ID>=f zV-BK*{@4iA6nL6%Qud{{y%J(L+#54Kz9Hj(#ptmMNz#cOm;??tH2%v7PSZM|i& g)j!?3T>p9N0v`Rf6?voYA{@7}KBStjeeRn42Se}L>i_@% diff --git a/library/UNICODE b/library/UNICODE index 96e3268a..cbce7efc 100644 --- a/library/UNICODE +++ b/library/UNICODE @@ -1,39 +1,62 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Jan-2024 14:19:50" {LIB}UNICODE.;4 72688 +(FILECREATED " 5-Feb-2024 13:49:35" {WMEDLEY}UNICODE.;57 88440 - :EDIT-BY "mth" + :EDIT-BY rmk - :CHANGES-TO (FNS MAKE-UNICODE-FORMATS MAKE-UNICODE-TRANSLATION-TABLES SHOWCHARS - READ-UNICODE-MAPPING-FILENAMES) - (VARS UNICODECOMS) + :CHANGES-TO (FNS INVERT-ALL-UNICODE-MAPPINGS UNICODE-EXTEND-TRANSLATION?) - :PREVIOUS-DATE " 8-Jan-2024 10:58:06" {LIB}UNICODE.;1) + :PREVIOUS-DATE " 4-Feb-2024 12:42:00" {WMEDLEY}UNICODE.;56) (PRETTYCOMPRINT UNICODECOMS) (RPAQQ UNICODECOMS - ((COMS - (* ;; "External formats") - + ((COMS (* ; "External formats") (FNS UTF8.OUTCHARFN UTF8.INCCODEFN UTF8.PEEKCCODEFN \UTF8.BACKCCODEFN) (FNS UTF16BE.OUTCHARFN UTF16BE.INCCODEFN UTF16BE.PEEKCCODEFN \UTF16BE.BACKCCODEFN) (INITVARS (EXTERNALEOL 'LF)) (FNS MAKE-UNICODE-FORMATS) (P (MAKE-UNICODE-FORMATS EXTERNALEOL)) (ADDVARS (*DEFAULT-EXTERNALFORMATS* (UNIX :UTF-8))) - (FNS UNICODE.UNMAPPED) - (FNS XCCS-UTF8-AFTER-OPEN) + (FNS UNICODE.UNMAPPED UNICODE-EXTEND-TRANSLATION? UTF8.BINCODE \UTF8.FETCHCODE) + (FNS UTF8.VALIDATE UTF8-SIZE-FROM-BYTE1 NUTF8-BYTE1-BYTES NUTF8-CODE-BYTES + NUTF8-STRING-BYTES) (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS UNICODE.TRANSLATE \UTF8.GETBASEBYTE)) (FNS XTOUCODE UTOXCODE)) - (COMS - (* ;; "Unicode mapping files") + + (* ;; "") - (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING WRITE-UNICODE-MAPPING - WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER WRITE-UNICODE-MAPPING-FILENAME - ) - (VARS XCCS-SET-NAMES) + (COMS (* ; "Read Unicode mapping files") + (INITVARS (UNICODEDIRECTORIES NIL)) + (VARS XCCS-CHARSETS) + (FNS READ-UNICODE-MAPPING-FILENAMES READ-UNICODE-MAPPING)) + [COMS (* ; + "Make translation tables for UTF external formats") + (FNS MAKE-UNICODE-TRANSLATION-TABLES MERGE-UNICODE-TRANSLATION-TABLES + MERGE-UNICODE-TRANSLATION-TABLES1) + (FNS INVERT-ALL-UNICODE-MAPPINGS) + (INITVARS (*XCCSTOUNICODE*) + (*UNICODETOXCCS*) + (*INVERTED-UNICODE-MAPPINGS*)) + (GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*) + [DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES 'DEFAULT] + (DECLARE%: EVAL@COMPILE DONTCOPY + + (* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter") + + (CONSTANTS (TRANSLATION-SEGMENT-SIZE 128) + (MAX-ALIST-LENGTH 10) + (N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) + (TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) + (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE] + + (* ;; "") + + (COMS (* ; "Write Unicode mapping files") + (FNS WRITE-UNICODE-MAPPING WRITE-UNICODE-INCLUDED WRITE-UNICODE-MAPPING-HEADER + WRITE-UNICODE-MAPPING-FILENAME HEXSTRING) + (FNS XCCS-UTF8-AFTER-OPEN) (* ;; "Automate dumping of a documentation prefix") @@ -41,49 +64,23 @@ :RADIX 16)) (UNDEFINEDCODE (CL:PARSE-INTEGER "FFFF" :RADIX 16] - (VARS UNICODE-MAPPING-HEADER) - (INITVARS (UNICODEDIRECTORIES NIL))) - (COMS - (* ;; "Set up translation tables for UTF8 and UTFBE external formats") - - (FNS MAKE-UNICODE-TRANSLATION-TABLES) - [INITVARS (DEFAULT-XCCS-CHARSETS '(LATIN JAPANESE-SYMBOLS1 JAPANESE-SYMBOLS2 - EXTENDED-LATIN FORMS SYMBOLS1 SYMBOLS2 - ACCENTED-LATIN1 GREEK)) - (DEFAULT-XCCS-JAPANESE-CHARSETS '(HIRAGANA KATAKANA JIS] - [DECLARE%: DONTEVAL@LOAD DOCOPY (P (MAKE-UNICODE-TRANSLATION-TABLES ( - READ-UNICODE-MAPPING - - DEFAULT-XCCS-CHARSETS - T) - '*XCCSTOUNICODE* - '*UNICODETOXCCS*] - (GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*)) - (FNS UTF-8.VALIDATE HEXSTRING UTF8HEXSTRING NUTF8CODEBYTES NUTF8STRINGBYTES XTOUSTRING - XCCSSTRING) - (FNS \UTF8.FETCHCODE) + (VARS UNICODE-MAPPING-HEADER)) + (FNS UTF8HEXSTRING XTOUSTRING XCCSSTRING) (FNS SHOWCHARS) - [DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) - EXPORTS.ALL) - - (* ;; "These control the layout of the translation tables. Since many of the upper panels are sparse, doing it per-panel (128) seems more space-efficient, and residual alists can be shorter") - - (CONSTANTS (TRANSLATION-SEGMENT-SIZE 128) - (MAX-ALIST-LENGTH 10) - (N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) - (TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) - (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE] + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (FROM LOADUPS) + EXPORTS.ALL)) (PROP (FILETYPE) UNICODE))) -(* ;; "External formats") +(* ; "External formats") (DEFINEQ (UTF8.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:02 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 31-Jan-2024 00:32 by rmk") + (* ; "Edited 8-Aug-2021 13:02 by rmk:") (* ; "Edited 17-Aug-2020 08:45 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") @@ -93,42 +90,44 @@ (IF (EQ CHARCODE (CHARCODE EOL)) THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) - (\BOUTEOL STREAM) + (\BOUTEOL STREAM) ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) - (IPLUS16 1 DATUM)) - (FOR C INSIDE (CL:IF RAW - CHARCODE - (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) - DO (IF (ILESSP C 128) - THEN (\BOUT STREAM C) - ELSEIF (ILESSP C 2048) - THEN (* ; "x800") - (\BOUT STREAM (LOGOR (LLSH 3 6) - (LRSH C 6))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 0 6))) - ELSEIF (ILESSP C 65536) - THEN (* ; "x10000") - (\BOUT STREAM (LOGOR (LLSH 7 5) - (LRSH C 12))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 6 6))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 0 6))) - ELSEIF (ILESSP C 2097152) - THEN (* ; "x200000") - (\BOUT STREAM (LOGOR (LLSH 15 4) - (LRSH C 18))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 12 6))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 6 6))) - (\BOUT STREAM (LOGOR (LLSH 2 6) - (LOADBYTE C 0 6))) - ELSE (ERROR "CHARCODE too big for UTF8" C]) + (IPLUS16 1 DATUM)) + (FOR C INSIDE (CL:IF RAW + CHARCODE + (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) + DO (IF (ILESSP C 128) + THEN (\BOUT STREAM C) + ELSEIF (ILESSP C 2048) + THEN (* ; "x800") + (\BOUT STREAM (LOGOR (LLSH 3 6) + (LRSH C 6))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 0 6))) + ELSEIF (ILESSP C 65536) + THEN (* ; "x10000") + (\BOUT STREAM (LOGOR (LLSH 7 5) + (LRSH C 12))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 6 6))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 0 6))) + ELSEIF (ILESSP C 2097152) + THEN (* ; "x200000") + (\BOUT STREAM (LOGOR (LLSH 15 4) + (LRSH C 18))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 12 6))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 6 6))) + (\BOUT STREAM (LOGOR (LLSH 2 6) + (LOADBYTE C 0 6))) + ELSE (ERROR "CHARCODE too big for UTF8" C]) (UTF8.INCCODEFN - [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:02 by rmk:") + [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 2-Feb-2024 11:44 by rmk") + (* ; "Edited 30-Jan-2024 22:56 by rmk") + (* ; "Edited 6-Aug-2021 16:02 by rmk:") (* ; "Edited 6-Aug-2020 17:13 by rmk:") (* ;; "Do not do UNICODE to XCSS translation if RAW.") @@ -142,82 +141,82 @@ (* ;; "Distinguish on header bytes (modulo peculiar EOF behavior--the caller will get whatever ended up in BYTE1") (CL:WHEN (SMALLP BYTE1) - [SETQ CODE (IF (ILESSP BYTE1 128) - THEN + [SETQ CODE (if (ILEQ BYTE1 127) + then + (* ;; + "Test first: Ascii is the common case. EOL requires its own translation") - (* ;; - "Test first: Ascii is the common case. EOL requires its own translation") - - (SELCHARQ BYTE1 - (CR (SELECTC (FETCH (STREAM EOLCONVENTION) OF STREAM) - (CR.EOLC (* ; "Also eq BYTE1") - (CHARCODE EOL)) - (CRLF.EOLC (IF (EQ (CHARCODE LF) - (\PEEKBIN STREAM T)) - THEN (\BIN STREAM) - (CL:WHEN COUNTP (SETQ COUNT 2)) - (CHARCODE EOL) - ELSE BYTE1)) - BYTE1)) - (LF (CL:IF (EQ LF.EOLC (FETCH (STREAM EOLCONVENTION) - OF STREAM)) - (CHARCODE EOL) - BYTE1)) - BYTE1) - ELSEIF (IGEQ BYTE1 (LLSH 15 4)) - THEN (* ; "4 bytes") - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) - (SETQ BYTE3 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE3)) - (ILESSP BYTE3 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) - (SETQ BYTE4 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE4)) - (ILESSP BYTE4 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) - (SETQ COUNT 4) - (LOGOR (LLSH (LOADBYTE BYTE1 0 3) - 18) - (LLSH (LOADBYTE BYTE2 0 6) - 12) - (LLSH (LOADBYTE BYTE3 0 6) - 6) - (LOADBYTE BYTE4 0 6)) - ELSEIF (IGEQ BYTE1 (LLSH 7 5)) - THEN (* ; "3 bytes") - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) - (SETQ BYTE3 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE3)) - (ILESSP BYTE3 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) - (SETQ COUNT 3) - (LOGOR (LLSH (LOADBYTE BYTE1 0 4) - 12) - (LLSH (LOADBYTE BYTE2 0 6) - 6) - (LOADBYTE BYTE3 0 6)) - ELSE (* ; "Must be 2 bytes") - (SETQ COUNT 2) - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) - (LOGOR (LLSH (LOADBYTE BYTE1 0 5) - 6) - (LOADBYTE BYTE2 0 6]) + (SELCHARQ BYTE1 + (CR (SELECTC (fetch (STREAM EOLCONVENTION) of STREAM) + (CR.EOLC (* ; "Also eq BYTE1") + (CHARCODE EOL)) + (CRLF.EOLC (if (EQ (CHARCODE LF) + (\PEEKBIN STREAM T)) + then (\BIN STREAM) + (CL:WHEN COUNTP (SETQ COUNT 2)) + (CHARCODE EOL) + else BYTE1)) + BYTE1)) + (LF (CL:IF (EQ LF.EOLC (fetch (STREAM EOLCONVENTION) + of STREAM)) + (CHARCODE EOL) + BYTE1)) + BYTE1) + elseif (ILEQ BYTE1 223) + then (* ; "2 bytes") + (SETQ COUNT 2) + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE BYTE2 0 6)) + elseif (ILEQ BYTE1 239) + then (* ; "3 bytes") + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (SETQ BYTE3 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE3)) + (ILESSP BYTE3 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (SETQ COUNT 3) + (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE BYTE2 0 6) + 6) + (LOADBYTE BYTE3 0 6)) + else (* ; "4 bytes") + (SETQ BYTE2 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE2)) + (ILESSP BYTE2 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (SETQ BYTE3 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE3)) + (ILESSP BYTE3 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (SETQ BYTE4 (\BIN STREAM)) + (CL:WHEN (OR (NOT (SMALLP BYTE4)) + (ILESSP BYTE4 128)) + (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) + (SETQ COUNT 4) + (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE BYTE2 0 6) + 12) + (LLSH (LOADBYTE BYTE3 0 6) + 6) + (LOADBYTE BYTE4 0 6]) (CL:UNLESS (OR RAW (NOT (SMALLP CODE))) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (CL:WHEN COUNTP (SETQ *BYTECOUNTER* COUNT)) CODE]) (UTF8.PEEKCCODEFN - [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 14-Jun-2021 22:53 by rmk:") + [LAMBDA (STREAM NOERROR RAW) (* ; "Edited 2-Feb-2024 11:48 by rmk") + (* ; "Edited 14-Jun-2021 22:53 by rmk:") (* ;; "Modeled this after \EUCPEEK on LLREAD. In the multi-byte (non-ASCII) case, backs the file pointer to the beginning by the proper number of \BACKFILEPTRs, and returns a count of 0. Returns NIL if NOERROR and either invalid UTF8 or end of file.") @@ -231,74 +230,72 @@ (* ;; "Distinguish on header bytex") (CL:UNLESS BYTE1 (RETURN NIL)) - [IF (ILESSP BYTE1 128) - THEN + [if (ILEQ BYTE1 127) + then + (* ;; + "Test first: Ascii is the common case. No need to back up, since we peeked.") - (* ;; - "Test first: Ascii is the common case. No need to back up, since we peeked.") - - (SETQ CODE BYTE1) - ELSEIF (IGEQ BYTE1 (LLSH 15 4)) - THEN (* ; "4 bytes") - (\BIN STREAM) - (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) - (IGEQ BYTE2 128)) - (\BACKFILEPTR STREAM) - (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) - (RETURN CODE)) - (\BIN STREAM) - (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) - (IGEQ BYTE3 128)) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) - (RETURN CODE)) - (\BIN STREAM) - (SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) (* ; - "PEEK the last, no need to back it up") - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (IF (AND BYTE4 (IGEQ BYTE4 128)) - THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3) - 18) - (LLSH (LOADBYTE BYTE2 0 6) - 12) - (LLSH (LOADBYTE BYTE3 0 6) - 6) - (LOADBYTE BYTE4 0 6))) - ELSEIF NOERROR - ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4))) - ELSEIF (IGEQ BYTE1 (LLSH 7 5)) - THEN (* ; "3 bytes") - (\BIN STREAM) - (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) - (IGEQ BYTE2 128)) - (\BACKFILEPTR STREAM) - (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) - (RETURN CODE)) - (\BIN STREAM) - (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) - (\BACKFILEPTR STREAM) - (\BACKFILEPTR STREAM) - (IF (AND BYTE3 (IGEQ BYTE3 128)) - THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4) - 12) - (LLSH (LOADBYTE BYTE2 0 6) - 6) - (LOADBYTE BYTE3 0 6))) - ELSEIF NOERROR - ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) - ELSE (* ; "Must be 2 bytes") - (\BIN STREAM) - (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) - (\BACKFILEPTR STREAM) - (IF (AND BYTE2 (IGEQ BYTE2 128)) - THEN (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5) - 6) - (LOADBYTE BYTE2 0 6))) - ELSEIF NOERROR - ELSE (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2] + (SETQ CODE BYTE1) + elseif [ILEQ BYTE1 223 (* ; "2 bytes") + (BIN STREAM) + (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (if (AND BYTE2 (IGEQ BYTE2 128)) + then (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE BYTE2 0 6))) + elseif NOERROR + else (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2] + elseif (ILEQ BYTE1 239) + then (* ; "3 bytes") + (BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE2 128)) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (RETURN CODE)) + (BIN STREAM) + (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) (* ; + "PEEK the last, no need to back it up") + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (if (AND BYTE3 (IGEQ BYTE3 128)) + then (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE BYTE2 0 6) + 6) + (LOADBYTE BYTE3 0 6))) + elseif NOERROR + else (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + else (* ; "4 bytes") + (BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE2 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE2 128)) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2))) + (RETURN CODE)) + (BIN STREAM) + (CL:UNLESS (AND (SETQ BYTE3 (\PEEKBIN STREAM NOERROR)) + (IGEQ BYTE3 128)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (OR NOERROR (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3))) + (RETURN CODE)) + (BIN STREAM) + (SETQ BYTE4 (\PEEKBIN STREAM NOERROR)) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (\BACKFILEPTR STREAM) + (if (AND BYTE4 (IGEQ BYTE4 128)) + then (SETQ CODE (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE BYTE2 0 6) + 12) + (LLSH (LOADBYTE BYTE3 0 6) + 6) + (LOADBYTE BYTE4 0 6))) + elseif NOERROR + else (ERROR "INVALID UTF8 SEQUENCE" (LIST BYTE1 BYTE2 BYTE3 BYTE4] (CL:WHEN (AND CODE (NOT RAW)) (SETQ CODE (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))) (RETURN CODE]) @@ -322,7 +319,8 @@ (DEFINEQ (UTF16BE.OUTCHARFN - [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 8-Aug-2021 13:09 by rmk:") + [LAMBDA (STREAM CHARCODE RAW) (* ; "Edited 31-Jan-2024 00:32 by rmk") + (* ; "Edited 8-Aug-2021 13:09 by rmk:") (* ; "Edited 30-Jan-2020 23:08 by rmk:") (* ;; "PRINT UTF16 sequence for CHARCODE. Do not do XCCS to UNICODE translation if RAW.") @@ -332,11 +330,10 @@ (IF (EQ CHARCODE (CHARCODE EOL)) THEN (FREPLACE (STREAM CHARPOSITION) OF STREAM WITH 0) ELSE (CHANGE (FFETCH (STREAM CHARPOSITION) OF STREAM) - (IPLUS16 1 DATUM))) + (IPLUS16 1 DATUM))) (FOR C INSIDE (CL:IF RAW - CHARCODE - (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) - DO (\WOUT STREAM C]) + CHARCODE + (UNICODE.TRANSLATE CHARCODE *XCCSTOUNICODE*)) DO (\WOUT STREAM C]) (UTF16BE.INCCODEFN [LAMBDA (STREAM COUNTP RAW) (* ; "Edited 6-Aug-2021 16:05 by rmk:") @@ -454,55 +451,275 @@ (DEFINEQ (UNICODE.UNMAPPED - [LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 11-Aug-2020 20:23 by rmk:") + [LAMBDA (CODE TRANSLATION-TABLE ALREADYTRIED) (* ; "Edited 2-Feb-2024 23:52 by rmk") + (* ; "Edited 31-Jan-2024 10:07 by rmk") + (* ; "Edited 11-Aug-2020 20:23 by rmk:") (* ;; "This is the slow fall-out when UNICODE.TRANSLATE determines that CODED has no fast mapping in TRANSLATION-TABLE.") - (* ;; "We return an existing entry in the hash array of the table. If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.") + (* ;; "") - (LET ((FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS)) - INVERSE NEXTCODE) - (IF (GETHASH CODE (CAR FORWARD)) - ELSEIF (AND (ILEQ CODE (CADDR FORWARD)) - (IGEQ CODE (CADDDR FORWARD))) - THEN (ERROR "UNMAPPED CODE IS EITHER XCCS-UNUSED OR UNICODE-PRIVATE" CODE) - ELSE (SETQ INVERSE (CL:SVREF TRANSLATION-TABLE (ADD1 N-TRANSLATION-SEGMENTS))) - (SETQ NEXTCODE (ADD (CADR INVERSE) - 1)) - (CL:WHEN (IGREATERP NEXTCODE (CADDR INVERSE)) - (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES" CODE)) - (PUTHASH CODE NEXTCODE (CAR FORWARD)) - (PUTHASH NEXTCODE CODE (CAR INVERSE)) - NEXTCODE]) + (* ;; "If we have not already dummied it up, we try to extend the current table by finding and merging the character set that has a mapping for CODE.") + + (* ;; "") + + (* ;; "When a proper mapping is not available we gin up a distinct unused code and put it in the hash array. If CODE has not previously been seen, we allocate a new code in the forward unmapped hasharray and put the inverse in the backward array.") + + (* ;; "ALREADYTRIED suppresses the recursion through the extension attempt.") + + (* ;; + "ALREADYTRIED breaks the loop of finding that CODE's character set doesn't have a mapping for CODE.") + + (LET (INVERSE NEXTCODE (FORWARD (CL:SVREF TRANSLATION-TABLE N-TRANSLATION-SEGMENTS))) + (if (GETHASH CODE (CAR FORWARD)) + elseif (AND (NOT ALREADYTRIED) + (UNICODE-EXTEND-TRANSLATION? CODE TRANSLATION-TABLE)) + elseif (AND (ILEQ CODE (CADDR FORWARD)) + (IGEQ CODE (CADDDR FORWARD))) + then (ERROR "UNMAPPED CODE IS EITHER XCCS-UNUSED OR UNICODE-PRIVATE" CODE) + else (SETQ INVERSE (CL:SVREF TRANSLATION-TABLE (ADD1 N-TRANSLATION-SEGMENTS))) + (SETQ NEXTCODE (ADD (CADR INVERSE) + 1)) + (CL:WHEN (IGREATERP NEXTCODE (CADDR INVERSE)) + (ERROR "EXHAUSTED RANGE FOR UNMAPPED CODES" CODE)) + (PUTHASH CODE NEXTCODE (CAR FORWARD)) + (PUTHASH NEXTCODE CODE (CAR INVERSE)) + NEXTCODE]) + +(UNICODE-EXTEND-TRANSLATION? + [LAMBDA (CODE TRANSLATION-TABLE) (* ; "Edited 5-Feb-2024 13:48 by rmk") + (* ; "Edited 3-Feb-2024 12:40 by rmk") + + (* ;; "There is currently no mapping for CODE in TRANSLATION-TABLE, hopefully just because the relevant character-set mapping as not be installed. We infer from TRANSLATION-TABLE whether CODE is an XCCS or UNICODE code.") + + (* ;; "The relevant mapping file, if any, can be determined directly from an XCCS code, since the mapping files are indexed by XCCS charset.") + + (* ;; "To find the file for a Unicode code by first running it through the precomputed inverted Unicode-to-XCCS inverted index, and then find the charset file for the corresponding XCCS code. Presumably that has the inverted mapping for future fast lookups.") + + (LET (XCCSCODE NEWMAPPING INVERTEDFILE) + [SETQ XCCSCODE (if (EQ TRANSLATION-TABLE *XCCSTOUNICODE*) + then CODE + elseif (SETQ INVERTEDFILE (FINDFILE 'INVERTED-UNICODE-MAPPINGS.TXT T + UNICODEDIRECTORIES)) + then + (* ;; "Note that we open/scan the inverted file for each unknown character, read the relevant character set (if any), get the XCCS code, and throw away what we just read. We will have installed all of the characters in the XCCS charset corresponding to CODE, that will catch a lot of what would otherwise be future unknowns (e.g. all Greeks are in). We may hit the same one repeatedly for Unicode JIS, since they appear to be scattered across XCCS.") + + (CL:WITH-OPEN-FILE (STREAM INVERTEDFILE :INPUT) + (FFILEPOS (CONCAT "[" (LRSH CODE 8) + " ") + STREAM NIL NIL NIL T) + (CADR (ASSOC CODE (READ STREAM] + (CL:WHEN (AND XCCSCODE (SETQ NEWMAPPING (READ-UNICODE-MAPPING XCCSCODE T T))) + + (* ;; "Whatever we find, we merge it in both directions--the tables bound to these variables are the only game in town.") + + (MERGE-UNICODE-TRANSLATION-TABLES NEWMAPPING) + + (* ;; "CODE's charset may not have a mapping for idiosyncratic CODE. ") + + (UNICODE.TRANSLATE CODE TRANSLATION-TABLE T))]) + +(UTF8.BINCODE + [LAMBDA (STREAM RAW) (* ; "Edited 4-Feb-2024 01:06 by rmk") + (* ; "Edited 1-Feb-2024 11:21 by rmk") + (* ; "Edited 28-Dec-2023 13:32 by rmk") + (* ; "Edited 6-Aug-2021 16:02 by rmk:") + (* ; "Edited 6-Aug-2020 17:13 by rmk:") + + (* ;; "Decodes a UTF8 character code by binning from STREAM ") + + (* ;; "The validity of STREAM is guaranteed by the caller (presumably TEDIT), we aren't testing here for the validity of the trailing bytes.") + + (* ;; "This doesn't do EOL conversion or translation, unlike UTF8.INCCODEFN.") + + (LET ((BYTE1 (BIN STREAM)) + CODE) + [SETQ CODE (if (ILEQ BYTE1 127) + then BYTE1 + elseif (ILEQ BYTE1 223) + then (* ; "2 bytes") + (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE (BIN STREAM) + 0 6)) + elseif (ILEQ BYTE1 239) + then (* ; "3 bytes") + (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE (BIN STREAM) + 0 6) + 6) + (LOADBYTE (BIN STREAM) + 0 6)) + else (* ; "4 bytes") + (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE (BIN STREAM) + 0 6) + 12) + (LLSH (LOADBYTE (BIN STREAM) + 0 6) + 6) + (LOADBYTE (BIN STREAM) + 0 6] + (CL:IF RAW + CODE + (UNICODE.TRANSLATE CODE *UNICODETOXCCS*))]) + +(\UTF8.FETCHCODE + [LAMBDA (CODESIZE BUFFER BYTEOFFSET) (* ; "Edited 28-Dec-2023 13:32 by rmk") + (* ; "Edited 6-Aug-2021 16:02 by rmk:") + (* ; "Edited 6-Aug-2020 17:13 by rmk:") + + (* ;; "Decodes a UTF8 byte sequence of size CODESIZE in BUFFER starting at BYTEOFFSET.") + + (* ;; "The validity of the thesize, buffer, and offset are guaranteed by the caller.") + + (LET ((BYTE1 (\GETBASEBYTE BUFFER BYTEOFFSET)) + BYTE2 BYTE3 BYTE4) + (SELECTQ CODESIZE + (2 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) + (LOGOR (LLSH (LOADBYTE BYTE1 0 5) + 6) + (LOADBYTE BYTE2 0 6))) + (3 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) + (SETQ BYTE3 (\UTF8.GETBASEBYTE BUFFER (IPLUS 2 BYTEOFFSET))) + (LOGOR (LLSH (LOADBYTE BYTE1 0 4) + 12) + (LLSH (LOADBYTE BYTE2 0 6) + 6) + (LOADBYTE BYTE3 0 6))) + (4 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) + (SETQ BYTE3 (\UTF8.GETBASEBYTE BUFFER (IPLUS 2 BYTEOFFSET))) + (SETQ BYTE4 (\UTF8.GETBASEBYTE BUFFER (IPLUS 3 BYTEOFFSET))) + (LOGOR (LLSH (LOADBYTE BYTE1 0 3) + 18) + (LLSH (LOADBYTE BYTE2 0 6) + 12) + (LLSH (LOADBYTE BYTE3 0 6) + 6) + (LOADBYTE BYTE4 0 6))) + (1 BYTE1) + (SHOULDNT]) ) (DEFINEQ -(XCCS-UTF8-AFTER-OPEN - [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 3-Jan-2024 10:27 by rmk") - (* ; "Edited 13-Aug-2020 11:54 by rmk:") +(UTF8.VALIDATE + [LAMBDA (STREAM BYTE) (* ; "Edited 2-Feb-2024 12:03 by rmk") + (* ; "Edited 28-Dec-2023 11:57 by rmk") + (* ; "Edited 6-Aug-2021 16:02 by rmk:") + (* ; "Edited 6-Aug-2020 17:13 by rmk:") - (* ;; - "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF-8. For development") + (* ;; "Returns the codesize if the bytes starting at STREAM's current position form a valid UTF-8 sequence.") - (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM))) - [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM) - 'EXTENSION] - (NOT (ASSOC 'EXTERNALFORMAT PARAMETERS))) - (STREAMPROP STREAM 'EXTERNALFORMAT :UTF-8))]) + (* ;; "If BYTE is provided, it is interpreted as the just-read header byte with the stream is positioned just after it.") + + (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error--otherwise an error will happen if the streams runs out of necessary bytes.") + + (* ;; "For valid sequences, returns the same value as UTF8-SIZE-FROM-BYTE1, but this reads/validates the rest of the bytes. On a non-NILreturn the stream is positioned before the header byte of the next putative code. The stream position is uncertain on a NIL return.") + + (* ;; "") + + (* ;; "Distinguish on the header byte BYTE. Not SMALLP presumably if ENDOFSTREAMOP did something unusual.") + + (CL:UNLESS BYTE + (SETQ BYTE (BIN STREAM))) + (CL:WHEN (SMALLP BYTE) + (if (ILEQ BYTE 127) + then 1 + elseif (ILEQ BYTE 223) + then (* ; " 2 bytes") + (CL:UNLESS (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128)) + 2) + elseif (ILEQ BYTE 239) + then (* ; "3 bytes") + (CL:UNLESS (OR (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128)) + (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128))) + 3) + else (* ; "4 bytes") + (CL:UNLESS (OR (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128)) + (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128)) + (OR [NOT (SMALLP (SETQ BYTE (BIN STREAM] + (ILESSP BYTE 128))) + 4)))]) + +(UTF8-SIZE-FROM-BYTE1 + [LAMBDA (BYTE1) (* ; "Edited 2-Feb-2024 11:50 by rmk") + + (* ;; "Returns the number of bytes of a UTF-8 code, given that BYTE1 is the first (header) byte of the sequence.") + + (if (ILEQ BYTE1 127) + then 1 + elseif (ILEQ BYTE1 223) + then 2 + elseif (ILEQ BYTE1 239) + then 3 + else 4]) + +(NUTF8-BYTE1-BYTES + [LAMBDA (BYTE1) (* ; "Edited 3-Feb-2024 15:00 by rmk") + (* ; "Edited 8-Jan-2024 10:57 by rmk") + (* ; "Edited 28-Jun-2022 00:02 by rmk") + (* ; "Edited 10-Aug-2020 12:35 by rmk:") + + (* ;; "Returns the number of bytes in a UTF8 code representation whose first byte is BYTEE1. ") + + (IF (ILEQ BYTE1 127) + THEN 1 + ELSEIF (ILEQ BYTE1 223) + THEN 2 + ELSEIF (ILEQ BYTE1 239) + THEN 3 + ELSE 4]) + +(NUTF8-CODE-BYTES + [LAMBDA (CODE) (* ; "Edited 3-Feb-2024 14:42 by rmk") + (* ; "Edited 8-Jan-2024 10:57 by rmk") + (* ; "Edited 28-Jun-2022 00:02 by rmk") + (* ; "Edited 10-Aug-2020 12:35 by rmk:") + + (* ;; "Returns the number of bytes needed to encode in UTF8 a number headed by BYTE. ") + + (IF (ILESSP CODE 128) + THEN 1 + ELSEIF (ILESSP CODE 2048) + THEN (* ; "x800") + 2 + ELSEIF (ILESSP CODE 65536) + THEN (* ; "x10000") + 3 + ELSEIF (ILESSP CODE 2097152) + THEN (* ; "x200000") + 4 + ELSE (ERROR "INVALID UTF-8 CODE"]) + +(NUTF8-STRING-BYTES + [LAMBDA (STRING RAW) (* ; "Edited 3-Feb-2024 21:32 by rmk") + (* ; "Edited 10-Aug-2020 09:06 by rmk:") + + (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ") + + (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE STRING I)) SUM (NUTF8-CODE-BYTES (CL:IF RAW + C + (XTOUCODE C))]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(PUTPROPS UNICODE.TRANSLATE MACRO [OPENLAMBDA (CODE TRANSLATION-TABLE) +(PUTPROPS UNICODE.TRANSLATE MACRO [OPENLAMBDA (CODE TRANSLATION-TABLE ALREADYTRIED) (LET [(X (CL:SVREF TRANSLATION-TABLE (LRSH CODE TRANSLATION-SHIFT ] - (COND - ((LISTP X) - (OR (CDR (FASSOC (LOGAND CODE TRANSLATION-SHIFT) - X)) - CODE)) - [(AND X (CL:SVREF X (LOGAND CODE TRANSLATION-MASK] - (T (UNICODE.UNMAPPED CODE TRANSLATION-TABLE]) + (OR [COND + ((LISTP X) + (CDR (FASSOC (LOGAND CODE TRANSLATION-MASK) + X))) + (X (CL:SVREF X (LOGAND CODE TRANSLATION-MASK] + (UNICODE.UNMAPPED CODE TRANSLATION-TABLE ALREADYTRIED]) (PUTPROPS \UTF8.GETBASEBYTE MACRO ((BASE OFFSET ERROR?) (* ;  "Fetches the OFFSET'th byte from BASE, checking for UTF-8 validity if ERROR?") @@ -527,47 +744,89 @@ -(* ;; "Unicode mapping files") +(* ;; "") + + + +(* ; "Read Unicode mapping files") + + +(RPAQ? UNICODEDIRECTORIES NIL) + +(RPAQQ XCCS-CHARSETS + ((LATIN "0") + (JAPANESE-SYMBOLS1 "41") + (JAPANESE-SYMBOLS2 "42") + (EXTENDED-LATIN "43") + (HIRAGANA "44") + (KATAKANA "45") + (GREEK "46") + (CYRILLIC "47") + (FORMS "50") + (JIS "60-166") + (ARABIC "340") + (HEBREW "341") + (IPA "342") + (HANGUL "343") + (GEORGIAN-ARMENIAN "344") + (DEVANAGRI "345") + (BENGALI "346") + (GURMUKHI "347") + (THAI-LAO "350") + (SYMBOLS2 "356") + (SYMBOLS1 "357") + (LIGATURES "360") + (ACCENTED-LATIN1 "361") + (MORE-ARABIC "365") + (GRAPHIC-VARIANTS "375") + (DEFAULT LATIN ACCENTED-LATIN1 EXTENDED-LATIN SYMBOLS1 SYMBOLS2 FORMS JAPANESE-SYMBOLS1 + JAPANESE-SYMBOLS2) + (JAPANESE HIRAGANA KATAKANA JIS))) (DEFINEQ (READ-UNICODE-MAPPING-FILENAMES - [LAMBDA (FILESPEC DIRS) (* ; "Edited 26-Jan-2024 14:02 by mth") - (* ; "Edited 5-Jan-2024 17:24 by rmk") - (* ; "Edited 5-Aug-2020 15:59 by kaplan") - (* ; "Edited 4-Aug-2020 17:31 by rmk:") - (DECLARE (USEDFREE UNICODEDIRECTORIES XCCS-SET-NAMES)) - (CL:UNLESS DIRS (SETQ DIRS UNICODEDIRECTORIES)) - (FOR F X CSI INSIDE FILESPEC JOIN - (* ;; - "Last case hopes to pick up tables that are gruped together in a subdirectory (e.g. JIS)") + [LAMBDA (FILESPEC) (* ; "Edited 3-Feb-2024 11:00 by rmk") + (* ; "Edited 30-Jan-2024 08:45 by rmk") + (* ; "Edited 26-Jan-2024 14:02 by mth") + (* ; "Edited 5-Aug-2020 15:59 by kaplan") - (OR (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION - 'TXT) - T DIRS)) - (for D inside DIRS - when (SETQ D (FILDIR (PACKFILENAME 'NAME - (CONCAT "XCCS-*=" F) - 'EXTENSION - 'TXT - 'BODY D))) - do (RETURN D)) - (AND [SETQ CSI (OR (SASSOC F XCCS-SET-NAMES) - (FIND N IN XCCS-SET-NAMES - SUCHTHAT (EQ F (CADR N] - (MKLIST (FINDFILE (PACKFILENAME 'BODY - (CONCAT 'XCCS- (CAR CSI) - '= - (CADR CSI)) - 'EXTENSION - 'TXT) - T DIRS))) - (for D inside DIRS - when (DIRECTORYNAMEP (SETQ D (CONCAT D ">" F ">"))) - join (FILDIR (CONCAT D ">*.TXT;*"]) + (* ;; "FILESPEC can be a file name, character-set name, the name of a collection of character sets, an XCCS character code, or list of those. Maps those into the names of files that contain the indicated Unicode mappings.") + (* ; "Edited 4-Aug-2020 17:31 by rmk:") + (DECLARE (USEDFREE UNICODEDIRECTORIES XCCS-CHARSETS)) + (FOR F X CSI INSIDE FILESPEC + JOIN + (* ;; "Last case hopes to pick up all the tables that are grouped together in a subdirectory (e.g. if F is JIS)") + + [OR (CL:WHEN (CHARCODEP F) (* ; + "An XCCS code can retrieve its character set") + (for D FN (FOCTAL _ (OCTALSTRING (LRSH F 8))) inside UNICODEDIRECTORIES + when [SETQ FN (FILDIR (PACKFILENAME 'DIRECTORY D 'BODY (CONCAT 'XCCS- FOCTAL + '=*) + 'EXTENSION + 'TXT] do (RETURN FN))) + (MKLIST (FINDFILE (PACKFILENAME 'BODY F 'EXTENSION 'TXT) + T UNICODEDIRECTORIES)) + (for D inside UNICODEDIRECTORIES + when [SETQ $$VAL (OR (FILDIR (PACKFILENAME 'NAME (CONCAT "XCCS-*=" F) + 'EXTENSION + 'TXT + 'BODY D)) + (FILDIR (PACKFILENAME 'NAME (CONCAT "XCCS-" F "=*") + 'EXTENSION + 'TXT + 'BODY D] do (RETURN $$VAL)) + (AND (SETQ CSI (ASSOC F XCCS-CHARSETS)) + (READ-UNICODE-MAPPING-FILENAMES (CDR CSI) + UNICODEDIRECTORIES)) + (for D inside UNICODEDIRECTORIES when (DIRECTORYNAMEP (SETQ D + (CONCAT D ">" F ">"))) + join (FILDIR (CONCAT D ">*.TXT;*"] + finally (RETURN (CL:REMOVE-DUPLICATES $$VAL :TEST (FUNCTION STREQUAL]) (READ-UNICODE-MAPPING - [LAMBDA (FILESPEC NOPRINT NOERROR) (* ; "Edited 5-Jan-2024 12:26 by rmk") + [LAMBDA (FILESPEC NOPRINT NOERROR) (* ; "Edited 3-Feb-2024 00:21 by rmk") + (* ; "Edited 5-Jan-2024 12:26 by rmk") (* ; "Edited 3-Jul-2021 13:37 by rmk:") (* ;; "Combines the char-mapping tables from FILES coded in the Uncode-CDROM format. Comments prefixed by # and") @@ -610,6 +869,338 @@ REPEATWHILE (AND (SETQ START (STRPOSL SEPBITTABLE LINE END T)) (NEQ (CHARCODE %#) (NTHCHARCODE LINE START]) +) + + + +(* ; "Make translation tables for UTF external formats") + +(DEFINEQ + +(MAKE-UNICODE-TRANSLATION-TABLES + [LAMBDA (MAPPING REINSTALL) (* ; "Edited 3-Feb-2024 00:24 by rmk") + (* ; "Edited 30-Jan-2024 09:54 by rmk") + (* ; "Edited 21-Aug-2021 13:12 by rmk:") + (* ; "Edited 17-Aug-2020 08:46 by rmk:") + (CL:UNLESS [AND (LISTP MAPPING) + (FOR PAIR IN MAPPING AS I TO 10 ALWAYS (AND (LISTP PAIR) + (CHARCODEP (CAR PAIR)) + (CHARCODEP (CADR PAIR] + (SETQ MAPPING (READ-UNICODE-MAPPING MAPPING T))) + + (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.") + + (* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") + + (* ;; "") + + (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme. But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.") + + (* ;; " ") + + (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code. An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes). The latter is used to save space for sparsely populated character sets.") + + (* ;; "") + + (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping. Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.") + + (* ;; "") + + (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).") + + (* ;; "") + + (* ;; + "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF") + + (* ;; "") + + (* ;; "If REINSTALL is T, the new mapping vectors replace the current maps in the *XCCSTOUNICODE* and *UNICODETOXCCS* global variables. Values are also installed if those variables are NIL.") + + (* ;; "") + + (LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) + :INITIAL-ELEMENT NIL)) + (RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) + :INITIAL-ELEMENT NIL))) + + (* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.") + + [FOR M LEFTC RBASE RCODES IN MAPPING EACHTIME (SETQ RCODES (CDR M)) + (SETQ RBASE (CAR RCODES)) + UNLESS (IGEQ RBASE MISSINGCODE) DO (SETQ LEFTC (CAR M)) + + (* ;; "(CDR RCODES) contains combiners on the base") + + (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK) + (CL:IF (CDR RCODES) + RCODES + RBASE)) + (CL:SVREF LTORARRAY (LRSH LEFTC + TRANSLATION-SHIFT] + (FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS) + WHEN (IGREATERP (LENGTH (CL:SVREF LTORARRAY I)) + MAX-ALIST-LENGTH) DO + (* ;; "Leave it alone if the alist is short") + + (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE + :INITIAL-ELEMENT NIL)) + (FOR P IN (CL:SVREF LTORARRAY I) + DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P) + TRANSLATION-MASK)) + (CDR P))) + (CL:SETF (CL:SVREF LTORARRAY I) + CSA)) + + (* ;; "") + + (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.") + + (FOR M LEFTC RBASE RCOMBINERS PREV IN MAPPING EACHTIME (SETQ RBASE (CADR M)) + (SETQ RCOMBINERS (CDDR M)) + UNLESS (OR (IGEQ RBASE MISSINGCODE) + RCOMBINERS) DO + (* ;; + "Have we already seen an explicit mapping from right to left?") + + (SETQ LEFTC (CAR M)) + [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK) + (CL:SVREF RTOLARRAY (LRSH RBASE + TRANSLATION-SHIFT] + (IF (NULL PREV) + THEN (CL:PUSH (CONS (LOGAND RBASE TRANSLATION-MASK) + LEFTC) + (CL:SVREF RTOLARRAY (LRSH RBASE + TRANSLATION-SHIFT))) + ELSEIF (IGREATERP (CDR PREV) + LEFTC) + THEN (RPLACD PREV LEFTC))) + (FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS) + WHEN (IGREATERP (LENGTH (CL:SVREF RTOLARRAY I)) + MAX-ALIST-LENGTH) DO + (* ;; "Long list, make an array") + + (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE + :INITIAL-ELEMENT NIL)) + (FOR P IN (CL:SVREF RTOLARRAY I) + DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P) + TRANSLATION-MASK)) + (CDR P))) + (CL:SETF (CL:SVREF RTOLARRAY I) + CSA)) + + (* ;; "") + + (* ;; "Allocate the hash arrays for future out-of-map codes. We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.") + + (CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS) + (LIST (HASHARRAY 10) + (CHARCODE.DECODE "5,0") + (CHARCODE.DECODE "40,0") + (CHARCODE.DECODE "5,0"))) + (CL:SETF (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS) + (LIST (HASHARRAY 10) + (CHARCODE.DECODE "U+E000") + (CHARCODE.DECODE "U+F8FF") + (CHARCODE.DECODE "U+E000"))) + + (* ;; "Now put in the inverse unmapped hash arrays") + + (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS)) + (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS)) + (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS)) + (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)) + + (* ;; "") + + (CL:WHEN [OR REINSTALL (NULL (GETATOMVAL '*XCCSTOUNICODE*] + (SETQ *XCCSTOUNICODE* LTORARRAY) + (SETQ *UNICODETOXCCS* RTOLARRAY)) + (LIST LTORARRAY RTOLARRAY]) + +(MERGE-UNICODE-TRANSLATION-TABLES + [LAMBDA (ADDITION TARGET) (* ; "Edited 3-Feb-2024 12:46 by rmk") + (* ; "Edited 31-Jan-2024 10:06 by rmk") + + (* ;; "ADDITION is a pair containing an LTOR array and an inverse RTOL array. TARGET is either NIL or an array pair.. If NIL, the current values of *XCCSTOUNICODE* and *UNICODETOXCCS* are used.") + + (* ;; "The ADDTION mappings are merged destructively into the TARGET mappings. This assumes that there are as yet no uncoded elements in the ADDITION hash arrays.") + + (LET (TLTORARRAY TRTOLARRAY) + (CL:UNLESS (AND (LISTP ADDITION) + (CL:ARRAYP (CAR ADDITION)) + (CL:ARRAYP (CADR ADDITION))) + (SETQ ADDITION (MAKE-UNICODE-TRANSLATION-TABLES ADDITION))) + (if (NULL TARGET) + then (SETQ TLTORARRAY *XCCSTOUNICODE*) + (SETQ TRTOLARRAY *UNICODETOXCCS*) + elseif (LISTP TARGET) + then (SETQ TLTORARRAY (CAR TARGET)) + (SETQ TRTOLARRAY (CADR TARGET)) + else (\ILLEGAL.ARG TARGET)) + (MERGE-UNICODE-TRANSLATION-TABLES1 (CAR ADDITION) + TLTORARRAY) + (MERGE-UNICODE-TRANSLATION-TABLES1 (CADR ADDITION) + TRTOLARRAY) + (LIST TLTORARRAY TRTOLARRAY]) + +(MERGE-UNICODE-TRANSLATION-TABLES1 + [LAMBDA (ADDARRAY TARGETARRAY) (* ; "Edited 2-Feb-2024 13:18 by rmk") + (* ; "Edited 31-Jan-2024 00:22 by rmk") + (for I TELT AELT (A _ ADDARRAY) from 0 TO (SUB1 N-TRANSLATION-SEGMENTS) + when (SETQ AELT (CL:SVREF A I)) + do + (SETQ TELT (CL:SVREF TARGETARRAY I)) + (CL:WHEN (EQ I 97)) + (CL:SETF + (CL:SVREF TARGETARRAY I) + (if TELT + then + (* ;; "Have to resolve, union giving priority to AELT. Have to deal with ALIST vs array cases on both sides.") + + (if (LISTP TELT) + then (if (LISTP AELT) + then + (* ;; "2 alists") + + (SETQ TELT (APPEND AELT (for TE in TELT + unless (ASSOC (CAR TE) + AELT) collect TE))) + + (* ;; "Make an array if alist is too big") + + (if (IGREATERP (LENGTH TELT) + MAX-ALIST-LENGTH) + then (for TE (TARRAY _ (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE + :INITIAL-ELEMENT NIL)) + in TELT do (CL:SETF (CL:SVREF TARRAY (CAR TE)) + (CDR TE)) finally (RETURN TARRAY)) + else TELT) + else + (* ;; + "Old Alist with new array. Copy the TELT's into empty array positions") + + (for TE TINDEX in TELT eachtime (SETQ TINDEX (CAR TE)) + unless (CL:SVREF AELT TINDEX) + do (CL:SETF (CL:SVREF AELT TINDEX) + (CDR TE))) + AELT) + elseif (LISTP AELT) + then + (* ;; "Old array with new Alist") + + (for AE in AELT do (CL:SETF (CL:SVREF TELT (CAR AE)) + (CDR AE))) + TELT + else + (* ;; "2 arrays. Smash AE value into TELT") + + (for J AE from 0 to (SUB1 TRANSLATION-SEGMENT-SIZE) + when (SETQ AE (CL:SVREF AELT J)) do (CL:SETF (CL:SVREF TELT J) + AE)) + TELT) + else AELT]) +) +(DEFINEQ + +(INVERT-ALL-UNICODE-MAPPINGS + [LAMBDA (MAKEFILE) (* ; "Edited 5-Feb-2024 13:14 by rmk") + (* ; "Edited 3-Feb-2024 09:16 by rmk") + + (* ;; "Reads all the XCCS-to-UNICODE mapping files that we know about, and iproduces a 2-level index that maps each UNICODE code back to the one or more XCCS corresponding XCCS codes.") + + (* ;; "The first index level groups all the unicode codes that have the same high-ordere byte. The index is sorted by the high-order bytes, the pairs within each group are sorted by their unicode. If a given unicode maps to multiple XCCS codes, the pair with the lowest XCCS code comes first.") + + (* ;; "GIven a UCODE, the lookup for the lowest XCCS is") + + (* ;; " (CADR (ASSOC UCODE (CADR (ASSOC (LRSH UCODE 8) INDEX)))).") + + (* ;; "If IMAKEFILE is given, the resulting is written to that file.") + + (LET (INDEX) + [for M in (READ-UNICODE-MAPPING (for N in XCCS-CHARSETS collect (CAR N)) + T) + do (push [CDR (OR (ASSOC (LRSH (CADR M) + 8) + INDEX) + (CAR (push INDEX (CONS (LRSH (CADR M) + 8] + (LIST (CADR M) + (CAR M] + + (* ;; "Sort within groups to get the lowest XCCS code first. But also push the sublists down an extra CONS, so that a subsequent READ will get them all.") + + [for I in INDEX do (change (CDR I) + (CONS (SORT DATUM (FUNCTION (LAMBDA (M1 M2) + (OR (ILESSP (CAR M1) + (CAR M2)) + (AND (EQ (CAR M1) + (CAR M2)) + (ILESSP (CADR M1) + (CADR M2] + (SETQ INDEX (SORT INDEX T)) (* ; "Sort groups") + (if MAKEFILE + then (CL:WITH-OPEN-FILE (STREAM (PACKFILENAME 'DIRECTORY (CAR (MKLIST UNICODEDIRECTORIES + )) + 'BODY + 'INVERTED-UNICODE-MAPPINGS.TXT) + :DIRECTION :OUTPUT :IF-EXISTS :NEW-VERSION) + + (* ;; "We can FFILEPOS for %"[nnn %" then READ. Or just READFILE") + + (for I in INDEX do (PRINTOUT STREAM "[" (CAR I) + " " + (CADR I) + "]" T)) + (FULLNAME STREAM)) + else INDEX]) +) + +(RPAQ? *XCCSTOUNICODE* ) + +(RPAQ? *UNICODETOXCCS* ) + +(RPAQ? *INVERTED-UNICODE-MAPPINGS* ) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*) +) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(MAKE-UNICODE-TRANSLATION-TABLES 'DEFAULT) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ TRANSLATION-SEGMENT-SIZE 128) + +(RPAQQ MAX-ALIST-LENGTH 10) + +(RPAQ N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) + +(RPAQ TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) + +(RPAQ TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE)) + + +(CONSTANTS (TRANSLATION-SEGMENT-SIZE 128) + (MAX-ALIST-LENGTH 10) + (N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) + (TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) + (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE))) +) +) + + + +(* ;; "") + + + + +(* ; "Write Unicode mapping files") + +(DEFINEQ (WRITE-UNICODE-MAPPING [LAMBDA (MAPPING INCLUDECHARSETS FILE EMPTYOK) (* ; "Edited 4-Jan-2024 22:44 by rmk") @@ -800,34 +1391,45 @@ (CAR UNICODEDIRECTORIES) 'EXTENSION 'TXT]) -) -(RPAQQ XCCS-SET-NAMES - (("0" LATIN) - ("41" JAPANESE-SYMBOLS1) - ("42" JAPANESE-SYMBOLS2) - ("43" EXTENDED-LATIN) - ("44" HIRAGANA) - ("45" KATAKANA) - ("46" GREEK) - ("47" CYRILLIC) - ("50" FORMS) - ("60-166" JIS) - ("340" ARABIC) - ("341" HEBREW) - ("342" IPA) - ("343" HANGUL) - ("344" GEORGIAN-ARMENIAN) - ("345" DEVANAGRI) - ("346" BENGALI) - ("347" GURMUKHI) - ("350" THAI-LAO) - ("356" SYMBOLS2) - ("357" SYMBOLS1) - ("360" LIGATURES) - ("361" ACCENTED-LATIN1) - ("365" MORE-ARABIC) - ("375" GRAPHIC-VARIANTS))) +(HEXSTRING + [LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:") + (* ; "Edited 20-Dec-93 17:51 by rmk:") + + (* ;; + "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.") + + (CL:UNLESS (FIXP N) + (SETQ N (CHARCODE.DECODE N))) + (LET [CHAR (STR (ALLOCSTRING [IMAX (OR WIDTH 0) + (FOR I (LEFT _ N) FROM 0 UNTIL (EQ LEFT 0) + DO (SETQ LEFT (LRSH LEFT 4)) + FINALLY (RETURN (MAX I 1] + (CHARCODE 0] + (FOR I FROM -1 BY -1 UNTIL (EQ N 0) + DO (SETQ CHAR (LOGAND N 15)) + [RPLCHARCODE STR I (IF (ILESSP CHAR 10) + THEN (+ CHAR (CHARCODE 0)) + ELSE (+ (- CHAR 10) + (CHARCODE A] + (SETQ N (LRSH N 4))) + STR]) +) +(DEFINEQ + +(XCCS-UTF8-AFTER-OPEN + [LAMBDA (STREAM ACCESS PARAMETERS) (* ; "Edited 3-Jan-2024 10:27 by rmk") + (* ; "Edited 13-Aug-2020 11:54 by rmk:") + + (* ;; + "If added to STREAM-AFTER-OPEN-FNS, causes mapping files to be opened as UTF-8. For development") + + (CL:WHEN (AND (STRPOS "XCCS-" (U-CASE (FULLNAME STREAM))) + [EQ 'TXT (U-CASE (FILENAMEFIELD (FULLNAME STREAM) + 'EXTENSION] + (NOT (ASSOC 'EXTERNALFORMAT PARAMETERS))) + (STREAMPROP STREAM 'EXTERNALFORMAT :UTF-8))]) +) @@ -873,245 +1475,8 @@ "positions, since there are repetitions in the Unicode standard." "" "For more details, see the associated README.TXT file." "" "Any comments or problems, contact ")) - -(RPAQ? UNICODEDIRECTORIES NIL) - - - -(* ;; "Set up translation tables for UTF8 and UTFBE external formats") - (DEFINEQ -(MAKE-UNICODE-TRANSLATION-TABLES - [LAMBDA (MAPPING LTORVAR RTOLVAR) (* ; "Edited 21-Aug-2021 13:12 by rmk:") - (* ; "Edited 17-Aug-2020 08:46 by rmk:") - - (* ;; "MAPPING is the list of numeric code correspondence pairs constructed by applying READ-UNICODE-MAPPING to a Unicode mapping file.") - - (* ;; "This produces two recoding arrays, one maps left-side codes into right-side codes (e.g. XCCS or ISO8859-1 to Unicode), for printing, the other maps right-side (Unicode) codes to corresponding right-side codes (e.g. XCCS).") - - (* ;; "") - - (* ;; "We assume that the left-to-right mapping into Unicode is functional, so that each left code maps to a unique right (Unicode) code, because Unicode is presumably the most refined coding scheme. But several Unicode codes may map to the same left code, for logically different codes that happen to have the same glyphs. In that case the heuristic is to map each %"from%" code to the lowest of the possible %"to%" codes. This means that round-trip reading/writing or writing/reading from one or both starting points may not always be lossless.") - - (* ;; " ") - - (* ;; " Each recoding array has 256 elements, one for each possible high-order byte of a character code. An array entry is either NIL, a 256-array of codes indexed by low-order bytes, or an alist of (lower-order-bytes . codes). The latter is used to save space for sparsely populated character sets.") - - (* ;; "") - - (* ;; "The element 256 of each array contains a hash table for characters that might be encountered in XCCS memory or Unicode files for which there is no mapping. Element 257 contains the corresponding inverse unmapped hash-array, so that UNICODE.TRANSLATE can update them consistently.") - - (* ;; "") - - (* ;; "UNICODE.TRANSLATE assigns an unmapped Unicode character to a %"not used%" XCCS code position (from 5,0 to 40,FF, leaving other low not-used sets for other internal uses (TEDIT?).") - - (* ;; "") - - (* ;; - "An unmapped XCCS character is assigned a code in the %"private use%" code blocks 0xE000-F8FF") - - (* ;; "") - - (* ;; "For the convenience of not having to deal with the multiple values, if LTORVAR or RTOLVAR are given, they are set to the constructed arrays before return.") - - (* ;; "") - - (LET ((LTORARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) - :INITIAL-ELEMENT NIL)) - (RTOLARRAY (CL:MAKE-ARRAY (IPLUS 2 N-TRANSLATION-SEGMENTS) - :INITIAL-ELEMENT NIL))) - - (* ;; "The left-to-right direction (into Unicode). We start by distributing the mappings into alists in arrays indexed by the higher-order (charaset set byte). The second loop converts long alists into arrays.") - - [FOR M LEFTC RBASE RCODES IN MAPPING EACHTIME (SETQ RCODES (CDR M)) - (SETQ RBASE (CAR RCODES)) - UNLESS (IGEQ RBASE MISSINGCODE) DO (SETQ LEFTC (CAR M)) - - (* ;; "(CDR RCODES) contains combiners on the base") - - (CL:PUSH (CONS (LOGAND LEFTC TRANSLATION-MASK) - (CL:IF (CDR RCODES) - RCODES - RBASE)) - (CL:SVREF LTORARRAY (LRSH LEFTC - TRANSLATION-SHIFT] - (FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS) - WHEN (IGREATERP (LENGTH (CL:SVREF LTORARRAY I)) - MAX-ALIST-LENGTH) DO - (* ;; "Leave it alone if the alist is short") - - (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE - :INITIAL-ELEMENT NIL)) - (FOR P IN (CL:SVREF LTORARRAY I) - DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P) - TRANSLATION-MASK)) - (CDR P))) - (CL:SETF (CL:SVREF LTORARRAY I) - CSA)) - - (* ;; "") - - (* ;; "Now the right-to-left direction (from Unicode). Here we have to detect and compensate for ambiguity.") - - (FOR M LEFTC RBASE RCOMBINERS PREV IN MAPPING EACHTIME (SETQ RBASE (CADR M)) - (SETQ RCOMBINERS (CDDR M)) - UNLESS (OR (IGEQ RBASE MISSINGCODE) - RCOMBINERS) DO - (* ;; - "Have we already seen an explicit mapping from right to left?") - - (SETQ LEFTC (CAR M)) - [SETQ PREV (ASSOC (LOGAND RBASE TRANSLATION-MASK) - (CL:SVREF RTOLARRAY (LRSH RBASE - TRANSLATION-SHIFT] - (IF (NULL PREV) - THEN (CL:PUSH (CONS (LOGAND RBASE TRANSLATION-MASK) - LEFTC) - (CL:SVREF RTOLARRAY (LRSH RBASE - TRANSLATION-SHIFT))) - ELSEIF (IGREATERP (CDR PREV) - LEFTC) - THEN (RPLACD PREV LEFTC))) - (FOR I CSA FROM 0 TO (SUB1 N-TRANSLATION-SEGMENTS) - WHEN (IGREATERP (LENGTH (CL:SVREF RTOLARRAY I)) - MAX-ALIST-LENGTH) DO - (* ;; "Long list, make an array") - - (SETQ CSA (CL:MAKE-ARRAY TRANSLATION-SEGMENT-SIZE - :INITIAL-ELEMENT NIL)) - (FOR P IN (CL:SVREF RTOLARRAY I) - DO (CL:SETF (CL:SVREF CSA (LOGAND (CAR P) - TRANSLATION-MASK)) - (CDR P))) - (CL:SETF (CL:SVREF RTOLARRAY I) - CSA)) - - (* ;; "") - - (* ;; "Allocate the hash arrays for future out-of-map codes. We we have to keep track of the next available and last possible codes, as well as the first available, for error checking.") - - (CL:SETF (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS) - (LIST (HASHARRAY 10) - (CHARCODE.DECODE "5,0") - (CHARCODE.DECODE "40,0") - (CHARCODE.DECODE "5,0"))) - (CL:SETF (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS) - (LIST (HASHARRAY 10) - (CHARCODE.DECODE "U+E000") - (CHARCODE.DECODE "U+F8FF") - (CHARCODE.DECODE "U+E000"))) - - (* ;; "Now put in the inverse unmapped hash arrays") - - (CL:SETF (CL:SVREF LTORARRAY (ADD1 N-TRANSLATION-SEGMENTS)) - (CL:SVREF RTOLARRAY N-TRANSLATION-SEGMENTS)) - (CL:SETF (CL:SVREF RTOLARRAY (ADD1 N-TRANSLATION-SEGMENTS)) - (CL:SVREF LTORARRAY N-TRANSLATION-SEGMENTS)) - - (* ;; "") - - (CL:WHEN LTORVAR (SETATOMVAL LTORVAR LTORARRAY)) - (CL:WHEN RTOLVAR (SETATOMVAL RTOLVAR RTOLARRAY)) - (LIST LTORARRAY RTOLARRAY]) -) - -(RPAQ? DEFAULT-XCCS-CHARSETS '(LATIN JAPANESE-SYMBOLS1 JAPANESE-SYMBOLS2 EXTENDED-LATIN FORMS - SYMBOLS1 SYMBOLS2 ACCENTED-LATIN1 GREEK)) - -(RPAQ? DEFAULT-XCCS-JAPANESE-CHARSETS '(HIRAGANA KATAKANA JIS)) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(MAKE-UNICODE-TRANSLATION-TABLES (READ-UNICODE-MAPPING DEFAULT-XCCS-CHARSETS T) - '*XCCSTOUNICODE* - '*UNICODETOXCCS*) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS *XCCSTOUNICODE* *UNICODETOXCCS*) -) -(DEFINEQ - -(UTF-8.VALIDATE - [LAMBDA (STREAM BYTE1) (* ; "Edited 28-Dec-2023 11:57 by rmk") - (* ; "Edited 6-Aug-2021 16:02 by rmk:") - (* ; "Edited 6-Aug-2020 17:13 by rmk:") - - (* ;; "Returns the codesize if the bytes starting at STREAM's current position form a valid UTF-8 sequence.") - - (* ;; "If BYTE1 is provided, it is interpreted as the just-read header byte with the stream is positioned just after it.") - - (* ;; "Test for smallp because the stream's End-of-file operation may suppress the error--otherwise an error will happen if the streams runs out of necessary bytes.") - - (* ;; "For valid sequences, returns the same value as NUTF8CODEBYTES, but this reads/validates the rest of the bytes. On a non-NILreturn the stream is positioned before the header byte of the next putative code. The stream position is uncertain on a NIL return.") - - (* ;; "") - - (CL:UNLESS BYTE1 - (SETQ BYTE1 (\BIN STREAM))) - (PROG (BYTE2 BYTE3 BYTE4) - - (* ;; "Distinguish on the header byte BYTE1.") - - (CL:WHEN (SMALLP BYTE1) - (IF (ILESSP BYTE1 128) - THEN (RETURN 1) - ELSEIF (IGEQ BYTE1 (LLSH 15 4)) - THEN (* ; "4 bytes") - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (RETURN)) - (SETQ BYTE3 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE3)) - (ILESSP BYTE3 128)) - (RETURN)) - (SETQ BYTE4 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE4)) - (ILESSP BYTE4 128)) - (RETURN)) - (RETURN 4) - ELSEIF (IGEQ BYTE1 (LLSH 7 5)) - THEN (* ; "3 bytes") - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (RETURN)) - (SETQ BYTE3 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE3)) - (ILESSP BYTE3 128)) - (RETURN)) - (RETURN 3) - ELSE (* ; " 2 bytes") - (SETQ BYTE2 (\BIN STREAM)) - (CL:WHEN (OR (NOT (SMALLP BYTE2)) - (ILESSP BYTE2 128)) - (RETURN NIL)) - (RETURN 2)))]) - -(HEXSTRING - [LAMBDA (N WIDTH) (* ; "Edited 23-Jul-2020 08:28 by rmk:") - (* ; "Edited 20-Dec-93 17:51 by rmk:") - - (* ;; - "Converts positive numbers to Hex strings, padding on the right with 0 up to WIDTH if given.") - - (CL:UNLESS (FIXP N) - (SETQ N (CHARCODE.DECODE N))) - (LET [CHAR (STR (ALLOCSTRING [IMAX (OR WIDTH 0) - (FOR I (LEFT _ N) FROM 0 UNTIL (EQ LEFT 0) - DO (SETQ LEFT (LRSH LEFT 4)) - FINALLY (RETURN (MAX I 1] - (CHARCODE 0] - (FOR I FROM -1 BY -1 UNTIL (EQ N 0) - DO (SETQ CHAR (LOGAND N 15)) - [RPLCHARCODE STR I (IF (ILESSP CHAR 10) - THEN (+ CHAR (CHARCODE 0)) - ELSE (+ (- CHAR 10) - (CHARCODE A] - (SETQ N (LRSH N 4))) - STR]) - (UTF8HEXSTRING [LAMBDA (CHARCODE) (* ; "Edited 10-Aug-2020 08:33 by rmk:") @@ -1151,85 +1516,55 @@ (LOADBYTE CHARCODE 0 6))) ELSE (ERROR "CHARCODE too big for UTF8" CHARCODE]) -(NUTF8CODEBYTES - [LAMBDA (BYTE) (* ; "Edited 8-Jan-2024 10:57 by rmk") - (* ; "Edited 28-Jun-2022 00:02 by rmk") - (* ; "Edited 10-Aug-2020 12:35 by rmk:") - - (* ;; "Returns the number of bytes needed to encode in UTF8 a number headed by BYTE. ") - - (IF (ILESSP BYTE 128) - THEN 1 - ELSEIF (ILESSP BYTE 2048) - THEN (* ; "x800") - 2 - ELSEIF (ILESSP BYTE 65536) - THEN (* ; "x10000") - 3 - ELSEIF (ILESSP BYTE 2097152) - THEN (* ; "x200000") - 4 - ELSE (ERROR "INVALID UTF-8 HEADER BYTE"]) - -(NUTF8STRINGBYTES - [LAMBDA (STRING RAWFLG) (* ; "Edited 10-Aug-2020 09:06 by rmk:") - - (* ;; "Returns the number of bytes it would take to represent STRING in UTF8, assuming it is an XCCS string unless RAWFLG. ") - - (FOR I C FROM 1 WHILE (SETQ C (NTHCHARCODE STRING I)) - SUM (NUTF8CODEBYTES (CL:IF RAWFLG - C - (XTOUCODE C))]) - (XTOUSTRING - [LAMBDA (XCCSSTRING RAWFLG) (* ; "Edited 10-Aug-2020 21:42 by rmk:") + [LAMBDA (XCCSSTRING RAWFLG) (* ; "Edited 3-Feb-2024 14:55 by rmk") + (* ; "Edited 10-Aug-2020 21:42 by rmk:") (* ;; "Produces a string that contains the UTF8 bytes that represent the characters in XCCSSTRING. Applies the XCCSTOUNICODE translation unless RAWFLG. ") (* ;; "The resulting string will not be readable inside Medley.") - (LET [(USTR (ALLOCSTRING (NUTF8STRINGBYTES XCCSSTRING RAWFLG] - (FOR I CHARCODE (SINDEX _ 0) FROM 1 WHILE (SETQ CHARCODE (NTHCHARCODE XCCSSTRING - I)) + (LET [(USTR (ALLOCSTRING (NUTF8-STRING-BYTES XCCSSTRING RAWFLG] + (FOR I CHARCODE (SINDEX _ 0) FROM 1 WHILE (SETQ CHARCODE (NTHCHARCODE XCCSSTRING I)) DO (CL:UNLESS RAWFLG - (SETQ CHARCODE (XTOUCODE CHARCODE))) - (IF (ILESSP CHARCODE 128) - THEN (RPLCHARCODE USTR (ADD SINDEX 1) - CHARCODE) - ELSEIF (ILESSP CHARCODE 2048) - THEN (* ; "x800") - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 3 6) - (LRSH CHARCODE 6))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 0 6))) - ELSEIF (ILESSP CHARCODE 65536) - THEN (* ; "x10000") - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 7 5) - (LRSH CHARCODE 12))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 6 6))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 0 6))) - ELSEIF (ILESSP CHARCODE 2097152) - THEN (* ; "x200000") - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 15 4) - (LRSH CHARCODE 18))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 12 6))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 6 6))) - (RPLCHARCODE USTR (ADD SINDEX 1) - (LOGOR (LLSH 2 6) - (LOADBYTE CHARCODE 0 6))) - ELSE (SHOULDNT))) + (SETQ CHARCODE (XTOUCODE CHARCODE))) + (IF (ILESSP CHARCODE 128) + THEN (RPLCHARCODE USTR (ADD SINDEX 1) + CHARCODE) + ELSEIF (ILESSP CHARCODE 2048) + THEN (* ; "x800") + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 3 6) + (LRSH CHARCODE 6))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 0 6))) + ELSEIF (ILESSP CHARCODE 65536) + THEN (* ; "x10000") + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 7 5) + (LRSH CHARCODE 12))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 6 6))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 0 6))) + ELSEIF (ILESSP CHARCODE 2097152) + THEN (* ; "x200000") + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 15 4) + (LRSH CHARCODE 18))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 12 6))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 6 6))) + (RPLCHARCODE USTR (ADD SINDEX 1) + (LOGOR (LLSH 2 6) + (LOADBYTE CHARCODE 0 6))) + ELSE (SHOULDNT))) USTR]) (XCCSSTRING @@ -1245,44 +1580,6 @@ ) (DEFINEQ -(\UTF8.FETCHCODE - [LAMBDA (CODESIZE BUFFER BYTEOFFSET) (* ; "Edited 28-Dec-2023 13:32 by rmk") - (* ; "Edited 6-Aug-2021 16:02 by rmk:") - (* ; "Edited 6-Aug-2020 17:13 by rmk:") - - (* ;; "Decodes a UTF8 byte sequence of size CODESIZE in BUFFER starting at BYTEOFFSET.") - - (* ;; "The validity of the thesize, buffer, and offset are guaranteed by the caller.") - - (LET ((BYTE1 (\GETBASEBYTE BUFFER BYTEOFFSET)) - BYTE2 BYTE3 BYTE4) - (SELECTQ CODESIZE - (2 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) - (LOGOR (LLSH (LOADBYTE BYTE1 0 5) - 6) - (LOADBYTE BYTE2 0 6))) - (3 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) - (SETQ BYTE3 (\UTF8.GETBASEBYTE BUFFER (IPLUS 2 BYTEOFFSET))) - (LOGOR (LLSH (LOADBYTE BYTE1 0 4) - 12) - (LLSH (LOADBYTE BYTE2 0 6) - 6) - (LOADBYTE BYTE3 0 6))) - (4 (SETQ BYTE2 (\UTF8.GETBASEBYTE BUFFER (IPLUS 1 BYTEOFFSET))) - (SETQ BYTE3 (\UTF8.GETBASEBYTE BUFFER (IPLUS 2 BYTEOFFSET))) - (SETQ BYTE4 (\UTF8.GETBASEBYTE BUFFER (IPLUS 3 BYTEOFFSET))) - (LOGOR (LLSH (LOADBYTE BYTE1 0 3) - 18) - (LLSH (LOADBYTE BYTE2 0 6) - 12) - (LLSH (LOADBYTE BYTE3 0 6) - 6) - (LOADBYTE BYTE4 0 6))) - (1 BYTE1) - (SHOULDNT]) -) -(DEFINEQ - (SHOWCHARS [LAMBDA (FROMCHAR TOCHAR FONT) (* ; "Edited 26-Jan-2024 14:18 by mth") (* ; "Edited 1-Aug-2020 09:27 by rmk:") @@ -1317,40 +1614,24 @@ (FILESLOAD (FROM LOADUPS) EXPORTS.ALL) - -(DECLARE%: EVAL@COMPILE - -(RPAQQ TRANSLATION-SEGMENT-SIZE 128) - -(RPAQQ MAX-ALIST-LENGTH 10) - -(RPAQ N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) - -(RPAQ TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) - -(RPAQ TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE)) - - -(CONSTANTS (TRANSLATION-SEGMENT-SIZE 128) - (MAX-ALIST-LENGTH 10) - (N-TRANSLATION-SEGMENTS (IQUOTIENT 65536 TRANSLATION-SEGMENT-SIZE)) - (TRANSLATION-SHIFT (INTEGERLENGTH (SUB1 TRANSLATION-SEGMENT-SIZE))) - (TRANSLATION-MASK (SUB1 TRANSLATION-SEGMENT-SIZE))) -) ) (PUTPROPS UNICODE FILETYPE :TCOMPL) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4111 18202 (UTF8.OUTCHARFN 4121 . 6952) (UTF8.INCCODEFN 6954 . 12444) (UTF8.PEEKCCODEFN - 12446 . 17220) (\UTF8.BACKCCODEFN 17222 . 18200)) (18203 21984 (UTF16BE.OUTCHARFN 18213 . 19037) ( -UTF16BE.INCCODEFN 19039 . 19938) (UTF16BE.PEEKCCODEFN 19940 . 21011) (\UTF16BE.BACKCCODEFN 21013 . -21982)) (22014 24295 (MAKE-UNICODE-FORMATS 22024 . 24293)) (24392 25698 (UNICODE.UNMAPPED 24402 . -25696)) (25699 26375 (XCCS-UTF8-AFTER-OPEN 25709 . 26373)) (27831 28180 (XTOUCODE 27841 . 28009) ( -UTOXCODE 28011 . 28178)) (28220 45174 (READ-UNICODE-MAPPING-FILENAMES 28230 . 30936) ( -READ-UNICODE-MAPPING 30938 . 33914) (WRITE-UNICODE-MAPPING 33916 . 37666) (WRITE-UNICODE-INCLUDED -37668 . 42390) (WRITE-UNICODE-MAPPING-HEADER 42392 . 43640) (WRITE-UNICODE-MAPPING-FILENAME 43642 . -45172)) (48488 56912 (MAKE-UNICODE-TRANSLATION-TABLES 48498 . 56910)) (57417 68615 (UTF-8.VALIDATE -57427 . 60429) (HEXSTRING 60431 . 61592) (UTF8HEXSTRING 61594 . 63799) (NUTF8CODEBYTES 63801 . 64754) -(NUTF8STRINGBYTES 64756 . 65237) (XTOUSTRING 65239 . 68250) (XCCSSTRING 68252 . 68613)) (68616 70420 ( -\UTF8.FETCHCODE 68626 . 70418)) (70421 71931 (SHOWCHARS 70431 . 71929))))) + (FILEMAP (NIL (3915 18061 (UTF8.OUTCHARFN 3925 . 6723) (UTF8.INCCODEFN 6725 . 12337) (UTF8.PEEKCCODEFN + 12339 . 17079) (\UTF8.BACKCCODEFN 17081 . 18059)) (18062 21929 (UTF16BE.OUTCHARFN 18072 . 18982) ( +UTF16BE.INCCODEFN 18984 . 19883) (UTF16BE.PEEKCCODEFN 19885 . 20956) (\UTF16BE.BACKCCODEFN 20958 . +21927)) (21959 24240 (MAKE-UNICODE-FORMATS 21969 . 24238)) (24337 33379 (UNICODE.UNMAPPED 24347 . +26421) (UNICODE-EXTEND-TRANSLATION? 26423 . 29002) (UTF8.BINCODE 29004 . 31583) (\UTF8.FETCHCODE 31585 + . 33377)) (33380 38901 (UTF8.VALIDATE 33390 . 35987) (UTF8-SIZE-FROM-BYTE1 35989 . 36421) ( +NUTF8-BYTE1-BYTES 36423 . 37160) (NUTF8-CODE-BYTES 37162 . 38219) (NUTF8-STRING-BYTES 38221 . 38899)) +(40332 40681 (XTOUCODE 40342 . 40510) (UTOXCODE 40512 . 40679)) (41624 47670 ( +READ-UNICODE-MAPPING-FILENAMES 41634 . 44581) (READ-UNICODE-MAPPING 44583 . 47668)) (47737 61373 ( +MAKE-UNICODE-TRANSLATION-TABLES 47747 . 56819) (MERGE-UNICODE-TRANSLATION-TABLES 56821 . 58261) ( +MERGE-UNICODE-TRANSLATION-TABLES1 58263 . 61371)) (61374 64671 (INVERT-ALL-UNICODE-MAPPINGS 61384 . +64669)) (65639 78070 (WRITE-UNICODE-MAPPING 65649 . 69399) (WRITE-UNICODE-INCLUDED 69401 . 74123) ( +WRITE-UNICODE-MAPPING-HEADER 74125 . 75373) (WRITE-UNICODE-MAPPING-FILENAME 75375 . 76905) (HEXSTRING +76907 . 78068)) (78071 78747 (XCCS-UTF8-AFTER-OPEN 78081 . 78745)) (81272 86774 (UTF8HEXSTRING 81282 + . 83487) (XTOUSTRING 83489 . 86409) (XCCSSTRING 86411 . 86772)) (86775 88285 (SHOWCHARS 86785 . 88283 +))))) STOP diff --git a/library/UNICODE.LCOM b/library/UNICODE.LCOM index c644aa690f9ede51eeadb8c4f92049766b61d1bb..dd8578961b181b8cbe784e98d18675db98ecab36 100644 GIT binary patch delta 10599 zcmbta4QyN2b>@4N<%G3mQIcg@mhCHARwTt#`1nscvH2uEiI05brAf-N61B8rI+1MJ zG2CqH&oZX%R_s5EUxTK_hN13?bz9r%CvyJQvH`ju3}_KxLD#Os+O#$>3>#`M1GWK+ zz3<%jp8l+QK<6NO=l;BV&pqed^PO`ZKmDfk7eA1GZ@R%E{)ux>`h$UBm?@!TIFSrR zd~C>f_L+;9=j-Qc?3qi<$38xt*V2YI^W3BL`6sWOx$@CtQw4pTr?t_ek=QWv_|`8I zNF*b1vCNfotIM4G$mJ^^KAdFsdw%UyMJuHJjY>%^lnu3_^TKha7fx!WieEJhzcVkd z7K?gevdrc$VVj95!(i+88XX<=vD%qu!RQt|gaf`|&(MT!XyYYKt!U|ulW^XKec<~Z zkj3NSaDXMXv|jO#&9EyMFRkeHwKFpHEl6F$( zQ)Pb|OoGSoI-LZQ;b1Zl@G;N*c#IBvrYaM0^9ws4Ye-4A%jH(s)6}j0*!p+fE4eZ?_sdPS-ng0RmOuU33{lrt+Eg)b z?gKQt!|Rpx+S1o*?rU$%eM)*mmtU_xpS}ILRMvx0v)%ozMx1G-5-+h}BE)9L_*8`j zV+n_f1|2FKaVTYVG~o0p@wh#zL=}e$#~do?^d$n0RgF#+$X>KGXG++br*Q)&5D&AF zQ{&_13b!>e!ov4<1>>w-fuZCX*0w0T%R+&m*{|;36%58$Fp!8Tkswo|3GDr?7OSM|PaeMhp6VIKumX00Y zQGHPg;{VaQ=ho7m)mayAeTL@rV5AHGx7UAods(T=ubG9`eS7r!!J9u4|FZStHy2$$ z(Ca_Fy*!Pvvb^vscqB}zHQl)J^|9qg^V_7Qn9y2&O}niH(rz9)Es%B#L_xcGG0)cS z*VU_;vu*iy*H9QjvIVv(S{4dNZRLg_WLwP;uuTOM?7T%PiGD|ZOG+g>b)Bl!ps$xmU0p}1K z!(`ga2hDa*Z`Y#hAJwaiuJ1lWuV?h^+@k9(O#IdD{`&K|+shA`rzd=k*@a$px!akN zo9o3tv0u|zdUOLaI>WTc`r!bnY4526a3) z(SWxrR&ev66067Qh|$%dDXSf8%3#6B>Xi*`o)^Nr4KFIuRW0I1II36T=pJjV+d+xp zrrYXfN`Qvfjlw)Ow%1LLI|mcKV%Tv;3VMUg_lXjyE+^=NCG+aHGwi$B&x+Hf1pAI7bD{ zTW%6s+kE59YRjI(xD=Zl*s6~rUuStM^DAv1FFm~tF3Fp6!y~~1lv3<*JaTpUi4=P` z#crG$TeiGHX3Yd!3^KtC49_4F#1#-Gn6XXJ{N-KynWGSBW;25jDX!k@yN0B&`Qu%m z`rt3N&^-&ttM_c_WQy6184Hf|rDK_Q^&5|mEhoh$*)?X|IbtRY7IMT)j;QM^omq#O zZ?*S(BDUEl6!WL;i558chw3Afe-9>?oIZ2Y&~!FviY@%!{(*I-bR4YePa{MK}?W1Qb36$ zhM6nka=Rqq3X4Ax4-r3{n5)(1cZztVSv(=alWtiO&$+WL&4E^l93JjQ{-mLoD-2Gb zB!m!xO$g`3%K%_(To@0j6^D66LF9zkiTR#@p6|zd+rWM~k}&-P!MXcPW65;fGgM>| zc8V3TtT+>>kb^}<9MlT>v^24WF@+VhX**;^Gr;K1l7P%(dk?liG*R;#(eB3Ywn{D; z7sLvxZe2|+q@E^|nLjDy^LTA3AlgFn^Io|{w1j}fpPXnLVls)V<5caHW3~C3=$NT3 z1;s2iwPvpt$fRJU02u`+L*(@pPfDE^FG1iyO2=H*z#hn(*GiM-k7oDFu#UG5?{2Ud zbZ#Wa4PMq5P{YwuB;>rlmBFZiKtKVwGhWmRKpQrp7lhQ{JfdNiRL6L!!rBP`j8;xnSls;mww^|O6yb(2Q(L7$p;E;%T~gE7Ohr?e4*iwX zX*>f?l)+qoh}$Tq82m$qB88>d8sdaMUyZ|341w6f1jP*dGxc3J-=*kGbc!&I$Oa}H z&eXTxd>4aaXp2e5Z{E0ZV@6$$oF+r~KRr#`22TU!;nLfZTU8z;t3(29&0YybY z=f*xv1>F6H)+aS6jTjZ)lX4LuFp>*NXro}B1D~?G(wbsV%G;z@m`dXL!UYkqcG;aD zs6VgXzE+pp=h{^gQNP{)9`!H(tKGUOTK`mcx2IS`EcTA*`L;d&SEALlTd#@MV!fr^ zMP5sIE-U--m-WXr|3r!Bk)@GB1@{IUvK2fGkF*b5ODUUGQYCQ*)~;c9TC%Zj%>v27 zT1xya|2zxcvmP1Z`sK*ls1M8qkv;u_Iz2>99}6j~=|(WXqLD}lS)Roc;2ue_-~4a& zfZ02ywfe=P=Gn3SR!bn}SN0v2BIf13p5)6-y6aXlXWja?)M-e;wHjN(NVc$@aM&E| zI|OV6Xy*HT|Nqs#Wv}+)+Xqe0{`SU10WLDe()bH^z{e}90W!?S%Q~JRaYuvjnIs_c zujQgPPCyfMxJ~ONZM?#Pn`P?98}PP%Li@5-DGxL0^&K*l?NwVcE1kOVnc|P-@fuG0 znvq}Av%+I8?auy05Ys(g-vfo(^4X4+Y4J*S?d=^TyZPxJu}aPT#oCK=y(Guk zSb2_jb*vo9PWN`te%_F$do1woaE9HVTy*^drl7mza=pHI_q_W{g=$-K?$ZSckAnOS zu@P@u+b=IjvD;dwg`R@fYWoUSy*smbw`9I>V7EDTfF0~!H@*@QuL=0gS|Dtm>F(^| z>nBya#3F5rcei1YfPClQ&9@HpHSWAaKnx^?`z(wHSr{oYQ~|+*3<(5Q;k6NRIl7oB zsCfomR1d<;Is-!chL}jD5Skc_A$6iU zn3zZzm^BgpSqww0Yr_g+$j3$ic?rwRL4~b-6(n}6;%BkAcsYh>aCPZu%$`|@31B-h zg{y{pl*9=TKMmoiappTVLYR4U1fB=6r0*D>@tE~QsOWo)1_BA@6SvIAg3*xq82cu& zrsccrh?}w}|3I0VpB%U*neWCPYD7fT1pC1a4^aRG=msg`!w_`LA`11QWB@WCCImpD zT0nCZBIEdjM@-D42C5JAN{q;eAYlYl&7ode9yUf~gcTbwQb7{~&?a?@^~F}OBeGM` zOT3^KL0cjF#XOXwK#HxfAxNqOFa;GRg@4rdxKt3-t03Go2iC>IhHU@*=+VjHbgMjJer##97l zAmhx?CK{D-qGK#ikBGevvPD`4>cV2_coH7s_z%hVbNebUe)5`(qSY)!a*ansrag>vLatQ+Jaa zlK6bbpQPr6>wMDHGyAlA(DK_?&Su8yqu zA^T&at9{j3YZf2q<&X1O;`tH&AtE8u-<0{l?U(onAK2UEOs=xU_gC_KR2(7D1Z5u~ z!~@l*n*6jlLJfpmeUd-LYt|9+-u@^bt=5~Eb)L`hI*u@kBaAM-Uvmw`=%N|PyqeSe zmMzCnumb)}RxX; zf_uG1AA#%Uc?fVQ>9?3ufFU&FDO$r>3RUTQUPB^&Zy!AD+EP(K^@fAPD{t%wDI)U& zQpDgTkbLPCT{Zlgq2;wg1+H6UWE(rFOuQ+}fWJ)KQ^pFx18y#Dq3CzdCgI5GdpZfa zf^eh0sfRV>hQK6vRx~E!6BB3omEA z*TmnM7u=s!rPowhn)x;L!NWArOi3Bx{qU|Xh>T92!!;BSTKV|f`Mw7g29Otgqt&G_ zoNHD$3~f?1M!_8b$9zlb&svd-up0Px*p-pA8j#)=Is#U0QU~VQ^1(h0JF5b;0SA?s zKxx83kOKSwDgjOl%3&dkF1-Paafe`&Z^I&$8A4{sN^=K8J9h41AW zUUe7mcCQ3@4Ym$6Pv`2-3+S;DJMWl4!~pkoEL@YS2PC6=xeMOAugQB? zI(Xk)Z?%`eqg$?aFD&rB!D?@F;XUE5ebtdBACTb7`G8yHR9cmBiR;p^4t(r%pJ$HUchlSiv#JjK%utR05a4lgXD z>Oob&4Xz7Ggzd87lV|B$U?ClZ0aMLmvr7?neV?zkR>{h#At)>#gl@BWg~|wfA$d6^ zsnYwmSG@GR^@<0V6_@z^+Z*Z<_gUXOHaINl=EcGN4Xb>QB$g_QWSSE&HiT!<0QUNj zgd%EbVFFTgjs?!cF1G?%=sUZ} zMSu;cn-@zu!zWlg3JOK%76E5&5p>1H5M37{oRVw=X~PGRH6WY7e~36mY4%=`Jm_~m z^P7J^vR{q{s5aZUci!qWr#36%XnX{tD{RYT;gQy_Dp?d=@(;Y9=B*bnj+p}}Mv!BQgz6ojm)abC{)P*5Z z&$hfQ{Up=9vV)#;y_w!q(hSJF1n;fOy?aRk-_I=Up}F`JD~szYlsQO4|B|s5JC#~G zErxbaci9yNNwmeE9Z27M8aubq?MHF=0nsV+DgM~C1Kuu52136XAV(0{B<_k;wpHkM z*y^UwcJ~prD7wOt2Cd4iLg^54^FETKFcJE8Ri@%CzUPT&DB?s53aS8hWmk#ATmI~y zchD{&Ky#EOQ9<|PXCNXcrVsx~eF6n#d0zlc(jmaZtxR*-L5>uYII z3oaloTD2EZ45rjdw;+n3XWf8aIK$Ny*fncm~l zaw^p+E&ujdPCnwdYjRY1L|H(TC4obM)f%3HG|MjHnUePF%U_zfBb$Gu$GxKBN*^-E zDVCckc+7v(PngHEyCsiV$)?S>I=alSX4}wuGn;H|uGBfju&s*j9{K>bR{fq8tqH9% zo}rzFtskz4&eei1weG2-t}BE-Y?m(WLL{wY_iU(43MrWVxraL)ew|NG8uOUd+-P`& z9X-l?J}`kCw#z7Gc`7KY5wdpwR7y^nah{wFFnnk!taniOcOok$-J+Z4V}cT z-CXOV-{9Cq9+`Pwe7mayZhHOF`7;;H7mHno*i+A3VI&uJ?jz5hyK?DFoq8^wc~)#8 ze#wK{1#58vLW>ZQ53xWK?qe>PLea6{aAB;Xi zZyV|D9!pDRd$^|yJCoGNvep*(XTE<=Im4%g3&xDKV|mQc+#XXe_L~ovUY3tD^K^bs z!!uMWswYlt)H)j)qF;^`m=C}6VnbQAs1~%c<}c6W$GB0(_rS2S)c|lP9HaqJAxpzy zSj%{P;ShCa^pZNM7F0|NQ#+?NDr(N^h)~C53AYuaQEH6Oln{06<7mgIJ;6(`XJ5qP zNe3AX_~F@T4Bw&0^l=aKh3Kbg*hw2JY17mcjOs<~8M1hzpO;M;)C5lr?5Xk6q^=f_ zoFeH0K|_MQG>o92P6DIRBlsIbVv6tIVjr>ZGy1q6 zwhZp!&3&Pm7_hCCSxVTvq=%H`Lr~;sX_c{6mW9O4M`j0hfJ?^;nE7Xgy(cZZIle_o oL-vIJO&4-?{(WvGzyJS4`^}sA?muy_|0(x-lUJm0ATzrVkOV1+#9&;E#Y3_W z`F&Sz-MoFRe02`pT0lPZnxQAZFk$K`oK{Cp1&5GNlA7xTF)qk)IpjmXcGX_zLRaQz z7hbyh%JDc^JFuU;9N16x&F4^KAc#4p76L^~ zgbUr|!>)EJzfR>u>CKpLb0b48oB5rudt8W+Ob zg%QaBpXOvT%kLk*k@%qPqrd&IExD*H$1XYGr~JhF-S=`1ZO-}ix>9a`qV@2readpr zlBSd^Pwua}6-Mi#3p%}CUY}c8B_HrVUJ#L*&*MCjqG2?X#1lm%MI;*vg=|QU+K_0^ ziZL4}M#aXg7z)}@P_QA<#zke~X+dPo-Q62RC#O=WLJ>ENa}u0{q*#dDZaLx>kR-$+ zVn{+_SR!929 zKmBUG?5=W?WVUtSvvIx3h2c*syPmEb*r2-c^i4`L05iSt*Ij<9uPs&`UnKw18YAVl z^zN$T%jJjqT5Sq2g|^4bBW3~zvrPxInbZMUaDYi2 zkOc>rS<3-gMr%3XePvO*(vkHz{J~%h*|{=dW|dqHB2}k2nmu!vfO~EN93?Te$?L2$71Xg z5#iJ46v0nFYVU1zfqy6j7&$^QW*j{mQo+OMwZKv~IjrUB8`NtghdC)PzqV%QoL{RO;MXkpwb$@0WsQpESA)^A z4X8h((oTN{#i;Gihzwbwq{eAM$`$iqU`V@$yO1nwo0VcTDL0Wz(bxug1v1rkx)cKZ z7Q!H;uD!1qrun&P8!JsWBOrXXQqc6>STEV~i$as`1*U)q!L(&1tt0lrNU))IXqz5E ziOlZVFSz|dP+>=W$~$6q$nA%)jj~vigH|wxX~-Sq=%Ba7jYN_BU{606CLgu;@k8#K zu-D6(pLaqmDo`R86W3o)*tN6%e=MG4$t|81?V2bGc3q2vclaEVCn9dIao{kre5jX5 z9j{DWZ-t8HO*o;TK_Qt)pmXps%l!ESdXzwqr;;_RxM}!ZaP7Ki|M_q*4OLhEMUb@-n{wgmA1O}$U;1xPSz5Pi{2E7&rpGM z5GVrz4eFkyjLrn=(Jg@-@bf75+HbC3X`6@Kj76GmA|HAcJ|@*Xo$s`fpC26P8bXe1 z5G=g1z&q}H2l<4?5oh0}=LHevCW@L;&`?a;03pk*V-wQM0w65LR7N-CHgyB^jf6?P z?*uQ$$j|!XwZ$_Djx70(PDD6|gJS|Fn!3<~`)l_@h*AX|zA~DE{}LKSIucP@ zhu%j=0-~j^kW*8Dhu(o6L4kr=446t*El`|ns{||5R1xQO75XIZrM*0OUTrO-8H5Bb}X|`R`qDt~!6K>iC2CnU#2R6N6*0!EhoX19UOdd2Vd%_vyIq^lW`HQr)vaz+^lI~2NjiMy--~r z=f0OQdG6`&n+$XQT6KLg%U9QRf{*VfKRtesUoS157^ti(4!<0NvTmlZnUatk3{yjc z2>}!lMJh!kOEUEXv+6W8I5ELItHzz$pZ^pDtl5pxfEZ2CAeaiztcH)6mj~QE>{|PYD{GsiJBY zbZkN+7(z@S5js#hEkb{yPF=R=MM*#}K<$Uvqk#oQCTeX5x>0h_tGO90rL0(EBZrai z^vMyRId#$pRuN$cUtmYSk|+@D|2`iL*1SW*PWX}+hYNK0=I~n_`Nn8p?UU1Qd&v*N zs1i>{U4F=d2vP(QY!6_Vflw|G)CYW%m9HF4hz$gVJ27+A>TMHk7VZwj`>FJUX z1)~fMQjl?y>Gq&Sg;IbY5Rg%j3IGQvfZz-O87qnI4=X4Em4#8khq02VNI(IT(7pr6 zScT}GFh#MH6}X3jbbE<$f=~c3SfOa@R|LUELCRHPtiU7yiVRED0bfx9s*cFmfk^;l z>}V(<5f;Gph(ckMhYJ%lu_}}i7>7_ksT5QS29cqT7E=_IQMN+A5b*_t0s@qr9AZ0y zlsUxY2hnqgZJ36VlS9qDnp?q6Fe9RT5gSTAuS~;8Kn9c}YotSAqjPYjW95y`Ft`)Q zXy2}zV?&6)FTfc~z9AeN({-VdvG`I`~+?+OP*sC0t3#6VX!_Tyvt#DlIb-Rte4_+g5#9Ka*^BpwF5=H+?;f8!s$T%XR4 zFs>g5v4AC*gjL+Z#_WJ*%^t#W9L7;PtE_e>S9fVT^uZpT6|wsACt3se8F!w)$i2U? z{%Lk?MHuJ4t3gF;bjFpRKwUH7oHF^l=ACRm_TY~D{a)@cex8C4x-$H^>Zi*Z?!M28 zT-mj@k}cn1m2jR_=~7Rf&MptmabD4fdrIj#KFz_7r6d4+DS^{C`Jjt;u0GVfgU4}q zDN_e34Ugi?gRTnhzVUaZ?&_x{uGG(SrNedH&+{cz2Wj!)wUtSXY6aZSl?LkgFl?&h z!}gKeQ}V3_z?h%eK$T332oLmQ1DjM2Kh9AQZ1g)k9$5P-_ThoPI_~95z13g-LdTW= zNiTgvuVIjQs*dwaud@K~CAf;=vzA`Eckr{I*F~z=3_gc1KIm$w^~-l0{xGCZ%7|x` zaW!BCVi+z7hH8!#HB<>gJHB;Rh6_StR)*6S4%#BlomC8Ww`h(eD3kO_g}u?FRr-OH zd`J62M!*McHkhFt*z)zP^z{nL(ibixXhmORt?1hc1kDe0>`E(luUx*PtlhogDL+-#YJmirYUQrp+eI(dcjrCq7IE)C z*;V%wc9*#KF}o@MYq`Z!eh4d$uod_Ifi9?hWYPbS(f@hb3F~3Id+)KyTABAapoMkO zKmU-6Eam>I_BZ)1?w|?!MQN;1i3^CSM>{+ilFHykm!>LdHP40*2M>J)w1J|yi55-( zM9VfU(zHd)E0d$f7&+=wTj;K2!8h1uHP5x57P9=wO&i!vwHOtek3&%Q!=aEIhPHR+ z?3ZdEA0FT~J;dGe`)m6rKjg`y>6n+gCOSgzr76m4)FjWHJJaKu0kjxSsw4Dv+?W|6 zi|5j$-nF0n{9Fh5#ku&f{em}QztF(b-l$oyS`NB#Kp8En`2fzTCVAuHvHq-*%H!tC z-$*g9m<5Br_mP7$BSZ8h5cyA{Q>P&67Oq{nHFp)=oV|Vf+QLidbMTP*iVqmLfP?** z2rr@ZP4rurt{<^q6}R@$fMwgc$ms0(y;;3b0LxQFUF6a10rD5K>0S0~B=KB6z#~8T z!i=v6mTi*7X?plYGng*gO3QYD8j^g*+8L>zJn z(O4clHZ%lsZef*Ca*C-I)W8m&nx0q26jMR2aiyq?Qz)aKEWj3Qj})Bk>hU;AW8eaL znlP}EhEWRVrV%u8e%jG-esX)b$K1kkgHaLovGm*ifVqL+`rKx*b`kf*=S)~j;|5H+ zxlCy4lojc8BHA3ew&fceZpsOA>hdA7aK493UEa&N$iwr4yAJi`90+7TP6n$vJlD03{gtT))ViWM(?_&M*hA$a9=tH*Q*%)5;$CZj@e};f3 zZOfIEZN!IC(|O%6^c0;8flMqO=pZZv#4u31GCF-g_sKz+Rq{&GqJ_H+uu_wGb<&yz zN%fp!!5|!coS!hPVFjcbQ*nMwS4=oN;h+G(ngaP;Y4E?PjOBF;1w4~*szT|u#vtU_ zL_Rw)u2~2wC0y@yh+xbpLa?G?G-ew)1WPts@gh8)0v|&kQ;HLLdZz_-!XW>)Ah+-! zQWodwA-|z(1aM<{C8z1B0OT7;U!;NT^5=8PnKNYH__bz*G`WlQ4zI5E3#U^&6GDW^e%lY50?QI2mGHoM8J&C7g_+ zV8SJ&hb5J15G85VnC8p`<1{wYBz_)|G9+E$1`!7#I8UC33AvSEJIWkQPRiyuiOWnD!mzu5hP&rba%H`7SoU? z&9mUixwQ;)!c>daFm>+_>xyC{o+lYEIS0|O)`jrKX=sI3-vTD%I2eVadqs0k$X@+w z?x2q;_DwIMSKL}RjiBZ%_!N!+G>2i;G1|KQuzoqO?TWZve7b4QquHt0`ZPK@1p-Du zjm!trX&59hAP|-S;Lark=%(1%qs#)#JG^?;;Ge*Lb{?A;j$C89SrSaraRB@+fe_A) zt)n*0U_L{rnMph|i}eJC7!rU)Y^5PEIgZaW5t4=&gYf`Uz&c$ZG<8};iJ1hm=y{0f z0x2k2Em{{l$MHAK`5bqOak zMAAX#NT=a2I*x3f3Xm$3;4EY^lL!k;Izu)&qx$hQoG`pfox^&&*YDPA2j=>599L&A zX6AaceR$M2*E_8}bG=kj2^*d6L9OosvRp0~OS`Rm+`rg)Z?D;{@AjLWwz+4C+|%8a z{B{BP@q98AQ(6fQyPZQ54`x9$k&FstOiqAkRqZfp5=F4(mDzdO>Ctf(QP(BB(S&`<>Yx3&r^V4 zJQp-3;cTA3A#^$DVR!fS+bmPD|b zLxd!^kzumSg6_s%y-_=A^(%S%^lngEEBIQgOId|HgyZ1Ci{RiT6&SM?Tx2R3oJGU= zI7qPid4x=BObfZ4p`fKbd=U=kvoI}|4v%_|&E>*fFJa45bxXO3dMXkzUdi0EEQO3j6{RhK+KpT44r_bU_3jG=O`FyjKN_rmjHm(CSiz*2lg04F8V2n{|q_YCBig1 zgB8KuwKFbL!j4E3%=Q$>=`kTcAStjy$6q${Av`eTui#Ew>m4Lxr9rZZ&8C_RN`7SN0!pzf2lNJ6@5D<_PH&I-vv`YkH}B!b|Joa}Ol z05nW0E?W$O6n+47rgNv6@fpfR5JZ_7n`bJu1~PYrFsn4$y{f4lGbb!yCvkw(uW6S+ z`LWdtYHDa}=u}e#qU}gCEgc$aDJV-GP7Nc8tfxtI zhFS`oo(01s*3?t&cWdoltJbg6{Aa<`vlABNrF?DQRAdI?i6^s@KaCPX>8tc>4_o!} z)sGLz>XYKi6f=5|?@z&cN^OaD_(9+ek02db=#qOy7unEasO0kNFdj2@*_xm_F4+jd z%3}yz&aMxz8OK9}pTGtPoexG)g3U2v5SwYTSv;+b!{_1H9Mtz(^=ByU#xFu2OBn%p z0>_JK3mOPGE7^9S({0v!I3HNcWyY?4{E=&eU?o;P{%3n0$-VGN>49^=13AGwFiXEb zZ1x_MZBw*}5x`-XL<7ndvcE;A2iVSsHc4tfY>xo2w>vJbdiG2X2*gl)Ea77PV-Ii0 zFiutlF8E|UuxM;)d@=eE{TGcsn#=KkW==2CS$I|%%%iasMb~*db{YtbdP2jpwg-bH z`mW-mcbXv(ooCUh4x=d=b_9A_bvC2BT4Uh9Gh|Ob$b{2(<~en@e&u6Qg%FeZ*(dk?53K#9+JD;Llse;DtWCS))_tUbX4_6P zcq;F`f9HPh*}=n3tGB~p8$SLx1(QmC@!(%cKKAkeR}PZs;A|M!THZyqBDPpU1HM;r z0IVF;4iB5{N2bwi)q98aUDNIycAM=!{$KBQJ6)ufhN}*r6z%neU+Pd0*!lpw2*XXW zGVEdEA<)5!glv1UiLJupgRJdSj36QlQ6Rj`9mvYYHs_EK`5Z|PwX!vmJ5gn^} z?Ae+zrKeXxDNm7TQ4(1S;Dt#7P2=Hko**cZ;hj~Tdwoxi<_Z0lwBN^9 zEhlU*Ftb`9s-}r^p6tyt6Ewm2(%M3-r4k0{i0{J}Q+gPPqo;hX;CaENjC_8PJP4;} z>mf5S&T1$$mL_!Kv5T5`aAXLwAW8bTaUWlqH>~PQ>5P|oKJ!%;;RaD{h%Qae&j#q* zsW!mP8^lH0aVI`xTj9I=xYq5}`{?gXF*mTT+De?IPSM z5r*>D(qa*9Q$3#Hn-2q^U;DlF`g(O$F7vqAtv#x>Yi7UJukG^-U<@INe+duR&YH@) z6ku76CfBRT`cOhA7g5ry`>W|S{TR~S0^ds)%C?cxjt=Xjx-MdIk#^+#Etj?0MlTBP zL2bY83+_sX-ZNT*yY(jS$7-!sE;Z^bZ1D=lXp^%6yDo*Z@CJ)wZ@V%CCL-YkCl)D~ zGN{r^B!IQ;CT$V3$H=TWyg?3l=#9A=Pq~t0M>mH9{ycZD{h|98PDrqycDL`MiV8;Zu4*wNveSa|^ z*%F6y4rl!&r8LB|30y|l0*m6DKOx~n*M0O-_`5bzRV1y@iAO>&w%qyiU zgA#JbhVTW7iapR`C+s4J7c?TTu}v}k{ot0cFqW6pBu3UOl>()8V%XR?5NI+0@du;YG zfd(e?NL9jVQ9FoTt12W$QY)6MBo&l`6>vt zzhdc0x7lB$FD=IU|7Lr)b%dj;Ho{U`bDr@|iE-%(nFQ|2(MB9arOVu?eU8rt$PFNC zptuOCrYiZrr>NS9act|{P}aq zUl7q5!is36Lh!Dbg-L)uT^4htox?j4d@vH6@Sf-dXDKumtGckYKbyuW->eXo7(SI@ zI@#L9$2LFSbJr;KV0dbVDQtPcF2@t2Dy*WowZUmeZX^OU7rcz-8E^DsJgMi44!LE# zscOJm{yGOilQWiDkzFefH*~Exnj{A$D82rsHt}2j+qS)0$lrn3HbH!u^Ps4GYjbC- zvSamS7qVjf96S*1+MWY7ahgU0WM-IUK5!?UoI(p1i!SG<5zJ{}o8sBhnAe{4Die>C zH(sqeFS8sNrc2xl$~hMdq)-oWSQtd(Xm(L8HX_t`9!FqG!4LLlks{Y7>r}$c8YJb( z*gxNKUVW`827*NIrBH3 z>OodLN^69P+E{@{PWEOUm!r{?kM+=1$$^%|My%^@=va8b^=|bc%+2Qv_Th@byB4{O z#>+82y24Xb2^II2lH4%iFpVcT5DK}5IMRLvKvTY!>L!~3Jcs65S;%WUf6UYq8Lx?j z5gR9x<0=3|yAiBIg5YBvsh^n_l;#s$VB;FA_M{2}jw8I;K{n8gsx{gQhNX*CVhZ&A zlTf_Y!aF317__2%aYD|Ly!R4ILNI40;+`1^=7m^+JfI^>dGAc#p23AY`Y&tak7}*v z9-jrd-4CDj^A$a7*OdC$ zuEM@#ga^yi<)XsRvUo`CsjsQQE*)r}oJVjW&0u$m9bhSLlnXab$)IkeAR?(E#4^VH z>j_?gav`kZBW-&o=%c~3Zo3;qF*0f&N8kg|%sJ*|ZfO(y720A;K6_%9ttIFavsNNo zI4F@Il=V8uhJpvPjW~PhmA8U010pPI0@HEk*BoQhm1wz?GtFo{yTlgak(g%!o8Y?N zv9UiSz)kj^|2JS}Ng|B&X%gaFViR$yi7XSF#nMw8zA2%s61^`KMfXb<$hXg+PA*Q> zBc9Sp)3u7_OG%1oYv^ewYvprx;^K_SF0+_Tr#WD}%srg*B}rO@44=|{2_BCyraJ3q zsdX9$xHBs~u0M6cwat^}UjOmsTA!kAcT%!JX>Z~vJK{Aj%qUx{1^&BIYBhU(Qz{+S z9@Xtl#$oLckMo;9s+$&SIZpkJPOI5zwi_K&!qfhT&0TX1PkFAD5qz~So^d_m-nY$G z*_3XXTjuuGwz>2DZTu?9PNmwdwK|>so+qGo41mJgGMyJ?`_7a`WiG^jdgb0yi&@j#{-YE>&?`+T+V( zI&y?ZPTf|sjk{;;r78F89lV;xUmY9_{nSzWA@a&TAH2(Cqju12Ju?RYT(@n+I9s<2 zUNGz9^|bn)C0B3Z$000b2|~_hujwe1h8xx$zvb#Ix&d!c`e>=OkkKR%?%4RJ2{%y1K{%v#n)-6lEjGe!^ z%dMclb^8BBr{CEYr{BK&Tc`j3iS)HjFPA0Nf2~j~Y{@tGab=_MPWJb@?>ija_;ulT z_`fT!7v9;}`1QuRg_$wk^XC6x&mVoIJ#QA?`iipMDZE)Y&hB}wa18xkrIOeU+kPM7 zy?*7&tL?T`_`LA>#$B<>>$IDEd&!4x`1+US@F9soB>A`GnKzi)UHvG$k*ODU^_tJu z;oGb-pz-KoC zqC|`R_wB;hZK2Ibu|~Gn3hN~PR-v%i?`UG>TZLl3iMJZMor79iy@7H5drkPz@B;Iz z{BngKZsxVZM&XUe-J@2$iYEw-HfIDdy679S^nYU!d6QZ}qyc{pT*_Y;y_CN$Vg&y# zNvqV<{?_t9PA{%_T~}~F)!z799g!(+_<@d4R*rs$1N^c=?g3|10*dBWh@AX2xO9nl zhD&~)T|z1UIXgf~f?qEEo8_5ra)2}9M-_!cKI04r-ryH5;i!zrmsgBqT_j0b z2fBmMK= zkn=wBR=s@FySnL5_=TMQUPn}hn>xc;uL(K+xej<`IVwvOhlStM5pVeGI^v~bzLs5n zjZ9HpF&r5m>Kd=zzK(dTNKA5vWEAd_?fekg`QhWj)A>t`%0kb}$D5bX)1gtQq!j;Q1}IKY`) z2IXeI=RdfFWdDF)xYi4y0qQL`eQpIM|l zh}wSSpL9f7iPyQwaE63^CekIMH)mE%qiPqv$IYbTN8Z*Ej|VB-T*E)%^k=%pk9eiL zz^f|wOr!F7=ZcXi=#P}JAMw#C#fxjkx<<*o%Yn6OHgu`i&WFGE;SY5U$&s!1n8(j? zb_relJ_puv{79F21%9C;o}3t#mh)@8trRvJ-kvf=Rvubjm(>wZ*+;jxxl&%xQS*rp z`QexR06)apUgRe_qMJOTybhAEb7Z_BDZZHNS4zg~AXD5W1o_L0LslH{OE^H9@8VCs z}pATZ+-gr7Cr6U5U z6eMw-Gde)AZgLjoMqK8XUcULS zxt5!}m>!i%PWm;H@-vr{^Ub$6qIi%D_$Ly1GRi=_^CcNbH$_q&fh**EE%q~)%li(6 zA~_!^ev?Y~r(E(St@#gJD~dW-cv)nSAD7GG;bv{eXQcN|KL6!E77BlrZv5+Kzxr?X C-N#Y@ delta 3832 zcmZuz-)~!Y6~AtiuJMx6Hp!L*(S6&cZBpuVVI`Dp%IZ2!XJ$LdcG^ZElxzDsxx=~F zy7wk)iZ*M&Bs6I%>-PZ(2?1}s@uP3kB>n)H5D)MGJg_GaAi)C?ZjCmW`?Xp#-jG`*I))lO#Y2ZJMz-tYhI zvEu}8x{WBb{~5fR^6gi~o+~7w>3C5qj5gV4)9rNpU_B=1xDokvuW9N#=1wkG%_L!F zIq(}{6G51jN!)tdi)Yd$dbZx+ti3Tb(H|Q(^6cHAi|LLVC4OV8?MC)TLub3mPRDP! z?e>mohYdHO(0;&4i+(+Fqn&vZ`*Gq$rs+psBMGCO^vulsZqE5TUKHM&A4t1FlbyER z$VYm!TrT967V-;)N~nk=ODfFKBp% zL`XK=#B|(bW5$>o>D1%y<50{-7{p1m)j;W_N+r(3Wjm+8Z{It6 z!k!zROQr47sZkpaulE~@Q?Dzw#+@7cePyw<(F;RPZT)MqlHPw~Ujiq9BRt}#t z*<3DPt_f|{+^ppDuTQ7zTZ#GqMKs*N)Jaz_fy6FtREuYw&@OGy$)|>D{It3YUr`ET3gz~rUzCRw*n5imac73w-3f&wZ9oJ zc1@wT3}FZP+_q^&;pP>(MxFyvPZuBb;p*CdOx+zPYoUA-M%n;An@aZf zV)3TUUYf9PO|Kor`47_{_0hl6_FvOukA8aTcgF`toMR=5Q7PL8FTVBkGtTi^zEUcb zvqd|4^&6>_{ov{(egARq`{C!m-c339IYPgVa|Or!0H5~*eZqJOhoi*4D+rqiajpx3 zut1*yfWx71^G;V_;vSPTcz8epr;dZvaDXxZ3n=g4AQUw6v;6>k(f~mHDh@&=%Xw!A z2ux)h#DpmK1$f$iJU3x~IQQvPpZ)mNiPI;Izftz>@&wJ^FOnTUSrDRKz6`b9B4m zsyPvP1OQM?aYhhs|3Fghp?5cEV`hYWsN{EHfw!voYe7V4h;Xolf*`tjQ-btTvbsmu z=?%wzk{wAMv0uAB+T}Ws4Il1DrzqLpc`_1H@x{VH11jhUJM+|lJlR(2oad- z&a2P?o$$aH9jSCQEr}z2eNkUCx5T8c2h~#Dby~_%F{Sp@u*6{#O4Yh_jh;YgqRwS; zlR$fJA|+yR$4a>_h*o%85OGo|wPYSLRM9Xc6^e(0JReFNt(i^u;)vjAJ;()1k79py zef$g`2}Y;-{s9k8^rytjqeW0yP(Tmq!~Tj~5QIZ;t8$n*`*E9}dX%@M{$As^cMdy{T&1YiClj>wuLc+4aS7 pP>m@NzbWoQ)?BP7JUG`R$a?2{z2oo4m)70?(#ye2rIzo1_&>ff5a$2@ diff --git a/library/lafite/LAFITECOMMANDS b/library/lafite/LAFITECOMMANDS index 62ed44c9..f0c6774a 100644 --- a/library/lafite/LAFITECOMMANDS +++ b/library/lafite/LAFITECOMMANDS @@ -1,18 +1,13 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 7-Feb-2022 12:04:09"  -{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;2 164626 +(FILECREATED "14-Jan-2024 16:35:53" {WMEDLEY}lafite>LAFITECOMMANDS.;3 164474 - :CHANGES-TO (FILES LAFITEDECLS) - (FNS \LAFITE.HARDCOPY.PROC \LAFITE.HARDCOPY.HEADERS) + :EDIT-BY rmk - :PREVIOUS-DATE "30-Sep-2021 22:58:57" -{DSK}kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;1) + :CHANGES-TO (FNS MESSAGEDISPLAYER) + :PREVIOUS-DATE " 7-Feb-2022 12:04:09" {WMEDLEY}lafite>LAFITECOMMANDS.;2) -(* ; " -Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. -") (PRETTYCOMPRINT LAFITECOMMANDSCOMS) @@ -235,7 +230,8 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. LAST#]) (MESSAGEDISPLAYER - [LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG) (* ; "Edited 24-Jun-99 15:34 by rmk:") + [LAMBDA (MAILFOLDER TEXTFILE TITLE NEWWINDOWFLG) (* ; "Edited 14-Jan-2024 16:33 by rmk") + (* ; "Edited 24-Jun-99 15:34 by rmk:") (* ; "Edited 24-Jun-99 15:32 by rmk:") (* ; "Edited 24-Jun-99 15:32 by rmk:") (* ; "Edited 6-Aug-93 18:48 by bvm") @@ -251,25 +247,23 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (* ;; "WINDOWPROPS for when we finally give TEdit a window: READONLY in order to avoid TEdit's odd temptation to display an ugly caret at the start and prevent mouse actions from yielding %"NewEditProcess%" menu; PROMPTWINDOW to inhibit attaching a prompt window. Due to a TEdit bug, you can't give the PROMPTWINDOW prop when opening without a window or it will try to make the symbol DON'T be the promptwindow later on.") (if (AND \LAPARSE.DONT.DISPLAY.HEADERS (NEQ EOF 0) - (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTFILE \LAPARSE.DONT.DISPLAY.HEADERS - 0))) - then (* ; - "We will filter some headers out, so put * in title to show this") - (SETQ TITLE (CONCAT "*" TITLE))) + (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTFILE \LAPARSE.DONT.DISPLAY.HEADERS 0))) + then (* ; + "We will filter some headers out, so put * in title to show this") + (SETQ TITLE (CONCAT "*" TITLE))) [COND ((AND (NOT NEWWINDOWFLG) (SETQ DISPLAYWINDOW (CAR CURRENTWINDOWS))) (MAPC (WINDOWPROP DISPLAYWINDOW 'EXTRAWINDOWS NIL) (FUNCTION CLOSEW)) (* ; - "Get rid of extra windows produced by attachments") + "Get rid of extra windows produced by attachments") (CLEARW DISPLAYWINDOW) (WINDOWPROP DISPLAYWINDOW 'TITLE TITLE)) (T (SETQ DISPLAYWINDOW (CREATEW (COND [(AND (NOT NEWWINDOWFLG) (PROGN (* ; - "This says where we'd like the primary window to be.") - (fetch (MAILFOLDER - FOLDERDISPLAYREGION) + "This says where we'd like the primary window to be.") + (fetch (MAILFOLDER FOLDERDISPLAYREGION) of MAILFOLDER] (LAFITE.DISPLAY.SIZE (* ; "Global default") @@ -283,23 +277,23 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. [(NOT CURRENTWINDOWS) (replace (MAILFOLDER FOLDERDISPLAYWINDOWS) of MAILFOLDER with (if NEWWINDOWFLG - then (* ; - "not primary, even though no window previously open") - (LIST NIL DISPLAYWINDOW) - else (LIST DISPLAYWINDOW] + then (* ; + "not primary, even though no window previously open") + (LIST NIL DISPLAYWINDOW) + else (LIST DISPLAYWINDOW] [NEWWINDOWFLG (RPLACD CURRENTWINDOWS (CONS DISPLAYWINDOW (CDR CURRENTWINDOWS] (T (* ; - "DIsplaying the primary window for the first time when there are already secondary windows.") + "DIsplaying the primary window for the first time when there are already secondary windows.") (RPLACA CURRENTWINDOWS DISPLAYWINDOW] (* ; "Now let TEDIT display it") [COND ((EQ EOF 0) (LAB.PROMPTPRINT MAILFOLDER "Message is empty")) (T [LET (WINDOW) (if (NOT FILTERED) - then (* ; - "Go ahead and display it right off. ") - (SETQ PROPS (NCONC PROPS WINDOWPROPS)) - (SETQ WINDOW DISPLAYWINDOW)) + then (* ; + "Go ahead and display it right off. ") + (SETQ PROPS (NCONC PROPS WINDOWPROPS)) + (SETQ WINDOW DISPLAYWINDOW)) (SETQ TEXTSTREAM (OR (CAR (NLSETQ (OPENTEXTSTREAM TEXTFILE WINDOW NIL NIL PROPS)) ) (PROGN (LAB.PROMPTPRINT MAILFOLDER T @@ -309,34 +303,36 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (LIST* 'CLEARGET T PROPS] (if FILTERED then (if (NOT (= EOF (GETEOFPTR TEXTSTREAM))) - then (* ; - "rats, there may have been nschars in the header, so parse it now more carefully") - (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTSTREAM - \LAPARSE.DONT.DISPLAY.HEADERS 0))) - (\LAFITE.HIDE.HEADERS TEXTSTREAM FILTERED) + then (* ; + "rats, there may have been nschars in the header, so parse it now more carefully") + (SETQ FILTERED (LAFITE.NEW.PARSE.HEADER TEXTSTREAM + \LAPARSE.DONT.DISPLAY.HEADERS 0))) + (\LAFITE.HIDE.HEADERS TEXTSTREAM FILTERED) (* ; - "Now we can display it without a major glitch") - (OPENTEXTSTREAM TEXTSTREAM DISPLAYWINDOW NIL NIL WINDOWPROPS) - (TEXTPROP TEXTSTREAM 'FILTERED FILTERED) + "Now we can display it without a major glitch") + (OPENTEXTSTREAM TEXTSTREAM DISPLAYWINDOW NIL NIL WINDOWPROPS) + (TEXTPROP TEXTSTREAM 'FILTERED FILTERED) (* ; - "Remember what's invisible, so we can easily undo it") - ) + "Remember what's invisible, so we can easily undo it") + ) (COND (LAFITEENDOFMESSAGESTR (* ; - "Add %"End of message%" token. Have to take away READONLY for a moment here...") + "Add %"End of message%" token. Have to take away READONLY for a moment here...") (TEXTPROP TEXTSTREAM 'READONLY NIL) [SETFILEPTR TEXTSTREAM (SUB1 (SETQ EOF (GETEOFPTR TEXTSTREAM] (COND ((NEQ (BIN TEXTSTREAM) - (CHARCODE CR)) (* ; - "Message doesn't end in CR, so add one before inserting end of message str") + (CHARCODE EOL)) (* ; + "Message doesn't end in EOL, so add one before inserting end of message str") (TEDIT.INSERT TEXTSTREAM LAFITEEOL (ADD1 (add EOF 1)) NIL T))) (TEDIT.INSERT TEXTSTREAM LAFITEENDOFMESSAGESTR (ADD1 EOF) LAFITEENDOFMESSAGEFONT T) (TEXTPROP TEXTSTREAM 'READONLY T) (TEDIT.SETSEL TEXTSTREAM 1 0) - (\CARET.DOWN) (* ; "Patch around TEdit bug") + (TEXTPROP TEXTSTREAM 'DIRTY NIL) + (AND NIL (\CARET.DOWN)) (* ; + "Patch around TEdit bug--probably fixed now") ] DISPLAYWINDOW]) @@ -2549,39 +2545,38 @@ Copyright (c) 1988-1989, 1992-1993, 1999, 2021 by Xerox Corporation. (ADDTOVAR LAMA LAFITE.HARDCOPY.MESSAGES) ) -(PUTPROPS LAFITECOMMANDS COPYRIGHT ("Xerox Corporation" 1988 1989 1992 1993 1999 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7934 27602 (\LAFITE.DISPLAY 7944 . 9649) (\LAFITE.DO.DISPLAY 9651 . 13816) ( -SELECTMESSAGETODISPLAY 13818 . 16186) (MESSAGEDISPLAYER 16188 . 23604) (LA.COPY.MESSAGE.TEXT 23606 . -24360) (\LAFITE.CLOSE.DISPLAYWINDOWS 24362 . 25956) (\LAFITE.CLOSE.DISPLAYER 25958 . 27600)) (27603 -36195 (\LAFITE.UNHIDE.HEADERS 27613 . 28703) (\LAFITE.HIDE.HEADERS 28705 . 29358) ( -\LAFITE.REHIDE.HEADERS 29360 . 30396) (LAFITE.EAT.UNDESIRABLE.FIELD 30398 . 31157) (LAFITE.EAT.GVGV -31159 . 32320) (\LAFITE.HARDCOPY.FROM.DISPLAY 32322 . 35841) (LAFITE.HARDCOPY.TAB.WIDTH 35843 . 36193) -) (36196 44499 (\LAFITE.SET.LOOKS.FROM.MENU 36206 . 36383) (\LAFITE.SET.DEFAULT.LOOKS 36385 . 36576) ( -\LAFITE.SET.FIXED.LOOKS 36578 . 36770) (LAFITE.SET.LOOKS 36772 . 41229) (LAFITE.SET.TAB.LOOKS 41231 . -41942) (LAFITE.SET.PARA.SEPARATION 41944 . 42152) (LAFITE.SET.LOWER.CASE 42154 . 43005) ( -LAFITE.SUBSTITUTE.VP.EOL 43007 . 44497)) (46416 54744 (LAFITE.DELETE.MESSAGES 46426 . 47476) ( -\LAFITE.DELETE 47478 . 48665) (DISPLAYAFTERDELETE 48667 . 53393) (\LAFITE.SELECT.NEXT 53395 . 54033) ( -\LAFITE.UNDELETE 54035 . 54742)) (54766 69261 (LAFITE.MOVE.MESSAGES 54776 . 55423) (\COERCE.TO.MSGLST -55425 . 56183) (\LAFITE.MOVETO 56185 . 60129) (\LAFITE.COPYTO 60131 . 60547) (\LAFITE.MOVETO.PROC -60549 . 61819) (\LAFITE.MOVE.MESSAGES.INTERNAL 61821 . 69259)) (69287 77839 (\LAFITE.ENABLE.MOVE.MENU -69297 . 70339) (\LAFITE.ADD.TO.MOVE.MENU 70341 . 71357) (\LAFITE.UPDATE.MOVE.MENU 71359 . 75999) ( -\LAFITE.RESTORE.MOVE.MENU 76001 . 76677) (\LAFITE.HANDLE.AUTO.MOVE 76679 . 77837)) (78695 96179 ( -\LAFITE.UPDATE 78705 . 84338) (\LAFITE.EXPUNGE.PROC 84340 . 85145) (\LAFITE.UPDATE.PROC 85147 . 86230) - (\LAFITE.HARDCOPYONLY.PROC 86232 . 86674) (LAB.CHOOSE.UPDATE.MENU 86676 . 87457) ( -LAB.CREATE.UPDATE.MENU 87459 . 89358) (LAB.UPDATE.NEEDED? 89360 . 90930) (\LAFITE.START.UPDATE 90932 - . 91964) (LAB.START.COMMAND 91966 . 92816) (\LAFITE.FINISH.UPDATE 92818 . 95071) ( -\LAFITE.CLOSE.OTHER.FOLDERS 95073 . 96177)) (96180 130974 (LAB.FLUSHWINDOW 96190 . 97869) ( -LAB.APPENDMESSAGES 97871 . 101033) (\LAFITE.COMPACT.FOLDER 101035 . 105199) (\LAFITE.COMPACT.FOLDER1 -105201 . 121240) (\LAFITE.COMPACT.FOLDER2 121242 . 125956) (\LAFITE.COMPACT.EXTRA 125958 . 128273) ( -\LAFITE.INVALIDATE.TOC 128275 . 128968) (\LAFITE.RENAMEFILE 128970 . 129440) (SMART-RENAMEFILEP 129442 - . 130002) (LA.OPENTEMPFILE 130004 . 130972)) (130975 144317 (\LAFITE.UPDATE.FOLDER 130985 . 132962) ( -\LAFITE.UPDATE.CONTENTS 132964 . 133681) (\LAFITE.UPDATE.CONTENTS1 133683 . 138537) (WRITETOCENTRY -138539 . 141657) (WRITETOCMARKBYTES 141659 . 141901) (WRITEFOLDERMARKBYTES 141903 . 144315)) (144343 -163318 (LAFITE.HARDCOPY.MESSAGES 144353 . 144813) (\LAFITE.HARDCOPY 144815 . 145150) ( -\LAFITE.HARDCOPY.PROC 145152 . 148630) (\LAFITE.HARDCOPY.HEADERS 148632 . 153961) ( -\LAFITE.MARK.HARDCOPIED 153963 . 155673) (\LAFITE.TRANSMIT.HARDCOPY 155675 . 157265) ( -\LAFITE.HARDCOPY.BODIES 157267 . 158509) (\LAFITE.APPEND.MESSAGE.BODY 158511 . 160619) ( -\LAFITE.DO.PENDING.HARDCOPY 160621 . 161696) (\LAFITE.CANCEL.HARDCOPY 161698 . 162414) ( -\LAFITE.CLEAR.HARDCOPY.STATE 162416 . 163316))))) + (FILEMAP (NIL (7734 27538 (\LAFITE.DISPLAY 7744 . 9449) (\LAFITE.DO.DISPLAY 9451 . 13616) ( +SELECTMESSAGETODISPLAY 13618 . 15986) (MESSAGEDISPLAYER 15988 . 23540) (LA.COPY.MESSAGE.TEXT 23542 . +24296) (\LAFITE.CLOSE.DISPLAYWINDOWS 24298 . 25892) (\LAFITE.CLOSE.DISPLAYER 25894 . 27536)) (27539 +36131 (\LAFITE.UNHIDE.HEADERS 27549 . 28639) (\LAFITE.HIDE.HEADERS 28641 . 29294) ( +\LAFITE.REHIDE.HEADERS 29296 . 30332) (LAFITE.EAT.UNDESIRABLE.FIELD 30334 . 31093) (LAFITE.EAT.GVGV +31095 . 32256) (\LAFITE.HARDCOPY.FROM.DISPLAY 32258 . 35777) (LAFITE.HARDCOPY.TAB.WIDTH 35779 . 36129) +) (36132 44435 (\LAFITE.SET.LOOKS.FROM.MENU 36142 . 36319) (\LAFITE.SET.DEFAULT.LOOKS 36321 . 36512) ( +\LAFITE.SET.FIXED.LOOKS 36514 . 36706) (LAFITE.SET.LOOKS 36708 . 41165) (LAFITE.SET.TAB.LOOKS 41167 . +41878) (LAFITE.SET.PARA.SEPARATION 41880 . 42088) (LAFITE.SET.LOWER.CASE 42090 . 42941) ( +LAFITE.SUBSTITUTE.VP.EOL 42943 . 44433)) (46352 54680 (LAFITE.DELETE.MESSAGES 46362 . 47412) ( +\LAFITE.DELETE 47414 . 48601) (DISPLAYAFTERDELETE 48603 . 53329) (\LAFITE.SELECT.NEXT 53331 . 53969) ( +\LAFITE.UNDELETE 53971 . 54678)) (54702 69197 (LAFITE.MOVE.MESSAGES 54712 . 55359) (\COERCE.TO.MSGLST +55361 . 56119) (\LAFITE.MOVETO 56121 . 60065) (\LAFITE.COPYTO 60067 . 60483) (\LAFITE.MOVETO.PROC +60485 . 61755) (\LAFITE.MOVE.MESSAGES.INTERNAL 61757 . 69195)) (69223 77775 (\LAFITE.ENABLE.MOVE.MENU +69233 . 70275) (\LAFITE.ADD.TO.MOVE.MENU 70277 . 71293) (\LAFITE.UPDATE.MOVE.MENU 71295 . 75935) ( +\LAFITE.RESTORE.MOVE.MENU 75937 . 76613) (\LAFITE.HANDLE.AUTO.MOVE 76615 . 77773)) (78631 96115 ( +\LAFITE.UPDATE 78641 . 84274) (\LAFITE.EXPUNGE.PROC 84276 . 85081) (\LAFITE.UPDATE.PROC 85083 . 86166) + (\LAFITE.HARDCOPYONLY.PROC 86168 . 86610) (LAB.CHOOSE.UPDATE.MENU 86612 . 87393) ( +LAB.CREATE.UPDATE.MENU 87395 . 89294) (LAB.UPDATE.NEEDED? 89296 . 90866) (\LAFITE.START.UPDATE 90868 + . 91900) (LAB.START.COMMAND 91902 . 92752) (\LAFITE.FINISH.UPDATE 92754 . 95007) ( +\LAFITE.CLOSE.OTHER.FOLDERS 95009 . 96113)) (96116 130910 (LAB.FLUSHWINDOW 96126 . 97805) ( +LAB.APPENDMESSAGES 97807 . 100969) (\LAFITE.COMPACT.FOLDER 100971 . 105135) (\LAFITE.COMPACT.FOLDER1 +105137 . 121176) (\LAFITE.COMPACT.FOLDER2 121178 . 125892) (\LAFITE.COMPACT.EXTRA 125894 . 128209) ( +\LAFITE.INVALIDATE.TOC 128211 . 128904) (\LAFITE.RENAMEFILE 128906 . 129376) (SMART-RENAMEFILEP 129378 + . 129938) (LA.OPENTEMPFILE 129940 . 130908)) (130911 144253 (\LAFITE.UPDATE.FOLDER 130921 . 132898) ( +\LAFITE.UPDATE.CONTENTS 132900 . 133617) (\LAFITE.UPDATE.CONTENTS1 133619 . 138473) (WRITETOCENTRY +138475 . 141593) (WRITETOCMARKBYTES 141595 . 141837) (WRITEFOLDERMARKBYTES 141839 . 144251)) (144279 +163254 (LAFITE.HARDCOPY.MESSAGES 144289 . 144749) (\LAFITE.HARDCOPY 144751 . 145086) ( +\LAFITE.HARDCOPY.PROC 145088 . 148566) (\LAFITE.HARDCOPY.HEADERS 148568 . 153897) ( +\LAFITE.MARK.HARDCOPIED 153899 . 155609) (\LAFITE.TRANSMIT.HARDCOPY 155611 . 157201) ( +\LAFITE.HARDCOPY.BODIES 157203 . 158445) (\LAFITE.APPEND.MESSAGE.BODY 158447 . 160555) ( +\LAFITE.DO.PENDING.HARDCOPY 160557 . 161632) (\LAFITE.CANCEL.HARDCOPY 161634 . 162350) ( +\LAFITE.CLEAR.HARDCOPY.STATE 162352 . 163252))))) STOP diff --git a/library/lafite/LAFITECOMMANDS.LCOM b/library/lafite/LAFITECOMMANDS.LCOM index a5b32a9fdf545bde665245c8de2afccc45509313..df32df71062c0ef69d9049083f2e47d04f82970a 100644 GIT binary patch delta 912 zcmZuv-%ry}6s8OjI!Cr?2u|aUMU!o$vp;S(*7#sqZ%4^pTiXIIF_Fm@mXI-0wTzIp@2l=hc2>|4Zcgq97uE zuD-!bf`mXUsIsCeG6xxMd2{_<>u$3Fn;XEv@xot#7O}A6!?>Ho^h0+(eo zhDma`>|)KwIvg=^=>CY?S(&~Ip&|m68u0m<8f>kv0jrj0HLHR>-nSuRSl%&{Sx_Ap zFPQec$Lq9Ru+F4L`{rB!*uQ^EJ>r9m_t{Eq%?P9)+dtsQfY9iZRG>aDT8M0{i^1d9`?)@J9DN+lvuJ2@JH z-f{o{ delta 1206 zcmb7E&2Q936pvZb1}84-5U9E;^mU<<4f0}p$GdB*-D14sV3@VHwl@JO5?P1^OFnkB z$$_Y@Q}gbz>ie($~C`|z82 z{A=#J$GLCkW2h=_a!t`yT?b9KRAi}U5v1bv-fF+Qk}N@Q4T`{j*@!NE^=W%O8LZcr zJN=c;TAlQ+cUJ1F$mrA7~EOj<$J^brfD@B=?T#sNU#CD7uH1%uydUGFB zuQmc&1y%G4Sk498pT&_92O#k*TLi>*J(>?YB$7dL{b;X|59VaBS|OhEf_9`dXi>EC zvZ_Q$pAB0BIuD~}8Py`Z^=vt9=RfY`geXWl0?QA=rcGo)l7&>^?R58Uk<-#U{LC3m zh10Dta4>Etjve9XG_=5k$g?b;L^%FJnX^e7Q?Qoq^2KB2SKM9DQ2ONV@o^arG=x;1 zJawS)ZW>JfxuuKw3IBWVB0omIpPEJe)`R|Vh zgXwAR!O3$Ymq`W=?I3@1DYJLILO~d3;KC9Aetd~!vCn=WiwwJ!xj!U6KbGE`5yAzDmjLpAUD9pISMP|RhG2+UcZ|z$7^p7cbD`Uu@WeN?+@+ie{ zf`v5mBbF@d_Os0~$*3AYyeMw9V=yW@EI4+E<5DA-_rWkKKsUjQOLVdkCSa6n6u2A* z=P%N;_T1?C5e{jzYEs~H=KdT(Rr+Ue%+{(Ehk&XY%;FdaZl)P%p9`tgz4Oj*Lc*O8 zB%@*i4UBO}SKmP8Jv$gWNnGHDap+Twr!GFTy_DiO*&PN6b- zL5K909JKv1b{-x6hU0|P69-iOES}+noqxo?o-RmqICSY+dw0VLnoZkpMBoIiE1@@g vA*Qd(kaplan>local>medley3.5>working-medley>library>lafite>LAFITETEDIT.;5 12306 +(FILECREATED "18-Jan-2024 10:34:16" {WMEDLEY}lafite>LAFITETEDIT.;33 6622 - :CHANGES-TO (VARS LAFITETEDITCOMS) + :EDIT-BY rmk - :PREVIOUS-DATE "30-Sep-2021 23:07:55" -{DSK}kaplan>local>medley3.5>working-medley>library>lafite>LAFITETEDIT.;4) + :CHANGES-TO (FILES LAFITEDECLS) + (FNS LA.ADJUST.FORMATTING) + :PREVIOUS-DATE "14-Jan-2024 12:56:19" {WMEDLEY}lafite>LAFITETEDIT.;32) -(* ; " -Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation. -") (PRETTYCOMPRINT LAFITETEDITCOMS) -(RPAQQ LAFITETEDITCOMS - ( - (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT") +(RPAQQ LAFITETEDITCOMS ( + (* ;; "Lafite's more explicit dependencies on %"internals%" of TEDIT") - (FNS LA.ADJUST.FORMATTING LA.SKIP.LOOKS.LIST LA.DETACH.TEDIT LA.TEDIT.INCLUDE - LA.WINDOW.FROM.TEXTSTREAM TEDIT.ASSURE.NO.BACKING.FILE) - (DECLARE%: EVAL@COMPILE DONTCOPY - - (* ;; "Need TEDIT internal declarations for LA.ADJUST.FORMATTING. Can't just do (FILES (SOURCE) TEDITDCL), because there is a compiled version that is already loaded that isn't enough.") - - (P (CL:UNLESS (GET 'TEDIT-DCL 'FILE) - (FILESLOAD TEDIT-DCL))) - (FILES (SOURCE) - LAFITEDECLS) - (GLOBALVARS *TEDIT-FILE-READTABLE*) - (LOCALVARS . T)))) + (FNS LA.ADJUST.FORMATTING LA.DETACH.TEDIT TEDIT.ASSURE.NO.BACKING.FILE + LA.WINDOW.FROM.TEXTSTREAM) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) + LAFITEDECLS) + (GLOBALVARS *TEDIT-FILE-READTABLE*) + (LOCALVARS . T)))) @@ -39,154 +29,82 @@ Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation. (DEFINEQ (LA.ADJUST.FORMATTING - [LAMBDA (FORMATSTREAM OUTSTREAM BYTE-LENGTHS) (* ; "Edited 3-Jun-88 18:24 by bvm") + [LAMBDA (FORMATSTREAM OUTSTREAM BYTE-LENGTHS) (* ; "Edited 18-Jan-2024 10:33 by rmk") + (* ; "Edited 13-Jan-2024 21:53 by rmk") + (* ; "Edited 3-Jun-88 18:24 by bvm") (* ;; "Adjusts the formatting info FORMATSTREAM to account for the prepending of one or more %"paragraphs%" of default looking text, whose lengths are given by BYTE-LENGTHS (or a single number if just one piece). It then writes the resulting formatting to OUTSTREAM.") - (PROG ((END (GETEOFPTR FORMATSTREAM)) - NPIECES PIECEINFOCH# TYPECODE PCLEN PREFIXEND LOOKSINDEX) - (COND - ((<= END 8) (* ; "This can't be formatting.") - (RETURN NIL))) - (SETFILEPTR FORMATSTREAM (- END 8)) - (SETQ PIECEINFOCH# (\DWIN FORMATSTREAM)) (* ; "Where the piece table starts relative to the whole file. Since in our case TEXT is only the formatting, it will start at zero.") - (SETQ NPIECES (\SMALLPIN FORMATSTREAM)) (* ; "Total number of pieces") - (if (NEQ (\SMALLPIN FORMATSTREAM) - 31418) - then (* ; - "Not the version of TEdit formatting we understand. Throw it out.") - (RETURN NIL)) - (SETFILEPTR FORMATSTREAM 0) - [do (SETQ PCLEN (\DWIN FORMATSTREAM)) - (SETQ TYPECODE (\SMALLPIN FORMATSTREAM)) (* ; "What kind of piece is it?") - (SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file, whose format is an s-expression") - (SKREAD FORMATSTREAM NIL *TEDIT-FILE-READTABLE*)) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document. This is a sequence of charlooks, ") - (LA.SKIP.LOOKS.LIST FORMATSTREAM)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document. Similar to CHARLOOKS.") - (LA.SKIP.LOOKS.LIST FORMATSTREAM)) - (\PieceDescriptorPARA (* ; - "Start a new paragraph with different looks. We will want to insert our new piece before this.") - (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM) - 6))) - (* ; - "Representation is just a paralooks index") - (\SMALLPIN FORMATSTREAM)) - (\PieceDescriptorLOOKS (* ; "Character looks for a new piece. The piece is PCLEN bytes long, which means half that many chars if fat.") - (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR FORMATSTREAM) - 6))) - (* ; - "Peek ahead to see what the charlooks of the first piece are") - (\BIN FORMATSTREAM) (* ; "FLAG byte. 1=NEW; 2 = FAT") - (SETQ LOOKSINDEX (\SMALLPIN FORMATSTREAM)) - (* ; "Charlooks index") - (RETURN)) - (PROGN (* ; - "Either imageobj or unknown type piece--I hope we're finished") - (RETURN] + (* ;; "The original code assumed that there were pieces at the beginning of the file that represented the pageframes and charlooks and paralooks vectors, and that that the information for new pieces had to come just after the last of those. That required parsing the initial pieces, with too much knowledge of Tedit internals. The reading function\TEDIT.GET.PIECES3 has been revised to relax that ordering constraint, so it is now possible just to slap the new information on the front and place an updated trailer at the end.") - (* ;; "At this point we have read enough format info to know what to do. Everything up to PREFIXEND is the preamble, which we can copy intact. Then we insert our own first piece, consisting of the prepended text in a single piece.") + (PROG ((TRAILER (\TEDIT.GET.TRAILER FORMATSTREAM)) + PIECESTART PCCOUNT TRAILERSIZE) + (CL:UNLESS (EQ 3 (pop TRAILER)) + (RETURN NIL)) + (SETQ PIECESTART (pop TRAILER)) + (SETQ TRAILERSIZE (pop TRAILER)) + (SETQ PCCOUNT (CADR TRAILER)) (* ; "Skip version") - [COPYBYTES FORMATSTREAM OUTSTREAM 0 (OR PREFIXEND (SETQ PREFIXEND (- (GETFILEPTR - FORMATSTREAM) - 6] - (for PIECELEN inside BYTE-LENGTHS do + (* ;; "Write the new-piece information at the beginning of OUTSTREAM.") - (* ;; "This code is generalized to allow multiple inserted pieces, but unfortunately if the textstream already has any paragraph formatting, we can't make the pieces be different paragraphs without making them also have non-default paralooks.") + (* ;; "This code allows for multiple inserted pieces, but unfortunately if the textstream already has any paragraph formatting, we can't make the pieces be different paragraphs without making them also have non-default paralooks.") - (\DWOUT OUTSTREAM PIECELEN) - (\SMALLPOUT OUTSTREAM \PieceDescriptorLOOKS - ) - (BOUT OUTSTREAM 0) - (* ; "Flag byte") - (\SMALLPOUT OUTSTREAM (OR LOOKSINDEX 1)) - (* ; "Char looks index--make it look like the first piece, or arbitrarily choose the first looks if the text started with an imageobj or some other ugliness") - (add PIECEINFOCH# PIECELEN) - (add NPIECES 1)) - (COPYBYTES FORMATSTREAM OUTSTREAM PREFIXEND (- END 8)) - (* ; "Copy rest of piece info") - (\DWOUT OUTSTREAM PIECEINFOCH#) (* ; - "New offset of start of formatting") - (\SMALLPOUT OUTSTREAM NPIECES) (* ; "More pieces now") - (\SMALLPOUT OUTSTREAM 31418) (* ; "Finally, the password") + (* ;; "The original code used the looks index of the first real piece, 1 if none was encountered. That was arbitrary, here we arbitrarily assign whatever charlooks got the first index. (Tedit could arrange for that also to be the index of the first piece, if it mattered).") + + (add PIECESTART (for PIECELEN inside BYTE-LENGTHS sum (\TEDIT.PUT.CHARLOOKS1 OUTSTREAM + PIECELEN 1) + (add PCCOUNT 1) + PIECELEN)) + + (* ;; "We are looking just at the format part so presume that its piece descriptions start at its 0. Copy rest of piece info, not including the old trailer.") + + (COPYBYTES FORMATSTREAM OUTSTREAM 0 (IDIFFERENCE (GETEOFPTR FORMATSTREAM) + TRAILERSIZE)) + + (* ;; "The piece-pointer for the new trailer is adjusted above to account for the new pieces in the corresponding CHARSTREAM.") + + (\TEDIT.PUT.TRAILER OUTSTREAM PIECESTART PCCOUNT 3) (RETURN OUTSTREAM]) -(LA.SKIP.LOOKS.LIST - [LAMBDA (FORMATSTREAM) (* ; "Edited 3-Jun-88 16:52 by bvm") - - (* ;; "Advance FORMATSTREAM past a sequence of CHAR/PARALOOKS. Each elements starts with a word giving its byte length, so we can skip over it") - - (for I from 1 to (\SMALLPIN FORMATSTREAM) do (SETFILEPTR FORMATSTREAM - (+ (GETFILEPTR FORMATSTREAM) - (\SMALLPIN FORMATSTREAM]) - (LA.DETACH.TEDIT - [LAMBDA (TEXTSTREAM) (* ; "Edited 3-Jun-88 17:27 by bvm") + [LAMBDA (TEXTSTREAM) (* ; "Edited 14-Jan-2024 12:56 by rmk") + (* ; "Edited 3-Jun-88 17:27 by bvm") (* ;; "Removes the TEXTSTREAM from the window, if any, it is being edited in.") - (* ;; "Yecch, TEdit ought to have a proper interface for this.") - - (replace (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM) with NIL]) - -(LA.TEDIT.INCLUDE - [LAMBDA (TEXTSTREAM FILE CH#) (* ; "Edited 3-Jun-88 17:49 by bvm") - - (* ;; "Do an Include of FILE into TEXTSTREAM at (i.e., in front of) character CH#. Returns the length of the insertion.") - - (* ;; "This code assumes that TEDIT.INCLUDE makes selection be the insertion") - - (TEDIT.SETSEL TEXTSTREAM CH# 0 'RIGHT) - (TEDIT.INCLUDE TEXTSTREAM FILE) - (fetch (SELECTION DCH) of (TEDIT.GETSEL TEXTSTREAM]) - -(LA.WINDOW.FROM.TEXTSTREAM - [LAMBDA (TEXTSTREAM) (* ; "Edited 23-Sep-87 15:36 by bvm:") - (for W in (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM)) - when (WINDOWPROP W 'TITLE) do (* ; - "Hairy loop because the window could be split") - (RETURN W]) + (TEXTPROP TEXTSTREAM '\WINDOW NIL]) (TEDIT.ASSURE.NO.BACKING.FILE - [LAMBDA (TEXTSTREAM) (* ; "Edited 20-May-92 11:25 by rmk:") + [LAMBDA (TEXTSTREAM) (* ; "Edited 13-Jan-2024 18:08 by rmk") + (* ; "Edited 18-Jun-2023 09:31 by rmk") + (* ; "Edited 29-Oct-2022 22:34 by rmk") + (* ; "Edited 20-May-92 11:25 by rmk:") + + (* ;; "This puts the contents of TEXTSTREAM to a nodircore file (if it isn't already on nodircore), and then sets it up for continuing in the current editing session. Essentially eliminates the file-system backing store.") + (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (OFILE (FETCH (TEXTOBJ TXTFILE) OF TEXTOBJ))) - (IF (AND (TYPE? STREAM OFILE) - (NEQ (FETCH (STREAM DEVICE) OF OFILE) - 'NODIRCORE)) - THEN (LET* [(NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) - (CH#S (REVERSE (CDR (TEDIT.PUT.PCTB TEXTOBJ NEWFILE] + (OFILE (GETTOBJ TEXTOBJ TXTFILE)) + NEWFILE) + (CL:WHEN [AND (TYPE? STREAM OFILE) + (NEQ 'NODIRCORE (FETCH (FDEV DEVICENAME) OF (FETCH (STREAM DEVICE) + OF (TRUEFILENAME OFILE] + (SETQ NEWFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) - (* ;; "TEDIT.PUT.PCTB has the effect of copying the whole document to NEWFILE. There are still multiple pieces, because each looks-run is a piece. Value gives the byte pointers within the resulting file where each real piece of text starts. Run thru the pieces in the PCTB, pointing them to the new file and their new locations. We do the cleanup copied from TEDIT.PUT; don't call TEDIT.PUT itself because we want it to think that we are still editing the original source.") + (* ;; "\TEDIT.PUT.PCTB will save the current text and looks in NEWFILE, leaving it open. It returns the sequence of new looks for continued editing, where all the file pieces point to their position in NEWFILE. But the file PCONTENTS do not yet point to the new stream. ") - [TEDIT.MAPPIECES TEXTOBJ (FUNCTION (LAMBDA (CH# PC) - (COND - ((FETCH POBJ OF PC)) - (T (REPLACE PFPOS - OF PC - WITH (POP CH#S)) - (CLOSEF? (FETCH PFILE - OF PC)) - (* ; - "If this is a piece on an open file, close it, since we're never going to read from it again.") - (REPLACE PFILE - OF PC WITH NEWFILE - ) - (REPLACE PSTR - OF PC WITH NIL] - (CLOSEF? OFILE) - (REPLACE (TEXTOBJ TXTFILE) OF TEXTOBJ WITH NIL]) + (CLOSEF? OFILE) + (\TEDIT.INSERT.NEWPIECES NEWFILE TEXTOBJ (\TEDIT.PUT.PCTB TEXTOBJ NEWFILE NIL T)) + (FSETTOBJ TEXTOBJ TXTFILE NIL) + (PUTTEXTPROP TEXTOBJ 'CACHE NEWFILE) + TEXTSTREAM)]) + +(LA.WINDOW.FROM.TEXTSTREAM + [LAMBDA (TEXTSTREAM) (* ; "Edited 18-Jun-2023 09:09 by rmk") + (* ; "Edited 23-Sep-87 15:36 by bvm:") + (\TEDIT.MAINW TEXTSTREAM]) ) (DECLARE%: EVAL@COMPILE DONTCOPY -(CL:UNLESS (GET 'TEDIT-DCL 'FILE) - (FILESLOAD TEDIT-DCL)) - - (FILESLOAD (SOURCE) LAFITEDECLS) @@ -200,9 +118,7 @@ Copyright (c) 1988, 1990, 1992, 2021 by Xerox Corporation. (LOCALVARS . T) ) ) -(PUTPROPS LAFITETEDIT COPYRIGHT ("Xerox Corporation" 1988 1990 1992 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1337 11935 (LA.ADJUST.FORMATTING 1347 . 7483) (LA.SKIP.LOOKS.LIST 7485 . 8059) ( -LA.DETACH.TEDIT 8061 . 8426) (LA.TEDIT.INCLUDE 8428 . 8917) (LA.WINDOW.FROM.TEXTSTREAM 8919 . 9365) ( -TEDIT.ASSURE.NO.BACKING.FILE 9367 . 11933))))) + (FILEMAP (NIL (1018 6392 (LA.ADJUST.FORMATTING 1028 . 4074) (LA.DETACH.TEDIT 4076 . 4442) ( +TEDIT.ASSURE.NO.BACKING.FILE 4444 . 6110) (LA.WINDOW.FROM.TEXTSTREAM 6112 . 6390))))) STOP diff --git a/library/lafite/LAFITETEDIT.LCOM b/library/lafite/LAFITETEDIT.LCOM index ef5ac6d358668705f9f087f313bd1fe5c11e2086..8f738ad38cb3b955aa1194ec5603e62c4383590d 100644 GIT binary patch literal 1718 zcma)7-EQMV6iypy0fSI?#r5i7slu){R_y$=be=}^$4SW>~FG|}O{pv0G?&8~^tB&A?iO-(bD1rOCE^+C6HD&5h%;#8eFUc0rr zYd3W;^uv?m)9EZ5!^s?UcroZvpV8sVPiNC7i_zlihqKYs>3Q~$ksy*3Ek)AWtJO@< zbi4V+qEmC7hFi0Bc(TY=CJ!g0`Lpb7(*;H>;&=P0v;r=AM9L`cz!W_Oea7IbCCjpO z7>~{|q8nW_bn{loZi@t(O~(OO0jso!usA*f&GkYOcW7FX9C8*@1fcNy)MKfMvRFy} z3&{jG5%eJ9{j}mE??`+74N11+Hkz)ztAlpS=p0kK$ql&vj%F}09B2dXdas1fUAr8vh3h}h%CEnjY~guk@MTdmNncvXs$iV&r#5WYuU<$&uv7&!>)`QZs4%6_*oF=k91jvHpmC{=B5SE` zYH`FgBd5rxl6aw&`&zM61xY_&@}UU$5TjdbJyStW@=!NQhHd9ciQoy=6}lNjvCjv% zH?<;ilBRt@t(aSFY(uPDOZC-Tot&1HlY-@s*TXx?+g}fcf2#GzL6lz{c%ci{g|DX~lGq zMASoGcUD}goFtxXt893Tr!@Esn%lq=8ZV2eh7^iE&LgZa(xaFL<$<@m$d6sEf`_D2 zXkr<18LEuEh`ApLj|=(|>btNyLEVACrw34Lz|uB$-EwEwub9o#StP*<1n*%^FLU@- z&fi74mYgFOD||f?#hA%ul^EEWQVu=dO9al*Wk=^ZMp=r8L_!`tx-JL9*n+)1&{;kR zKRJWrlSKyESEsY-;q)BF*=aT(XY<2pcBW?NraqmYXN&o0cDAX*$y0=eqeWj1jhovU zd;DJo{J({V$~V)4E;Kcuh@d!e=>cIa1y&WS&ts`N>vEbIDenu9n%Bl!hw(OH2SlW> ZmB�gjRo=E#-o7Z>eK}H1Wv^{s#y$sZ#&| literal 3292 zcmb_fO>Eo96_(`eVxtCuY#8V*cwicY3L-)zCEHR8RTM>8v}q1QQc2tfO%#iXWHXW> zDQ$ib^xA6<3+w_d7JDhso4dO%u)!8O6fKbRX0gq&D0gN6f*>zt)*gfzC95c)s6}DRsfPN#b>!zrb(bEn_zKPrXIyPaWBvb37%8>rIs zr7QU~Bxf|sOU1leR1^X3^n;1&;Nfn6aG?m@-ms05p@XK>8kPmqMoW?;K&v@KQ%{t+ zETsQ0m*2OGAS-Hi35t4MvsVo-;}Z~**EH9IsZi)-!%IWaagA#xX?U3`CItjFoAH8O zniHAkB)eS9=ihq{a_OX{Nm_NS;rUXHxEq@9oAxRct1C&-0#Sj=rf*~{!(R349>_o% zzUO1vY(N$`Ki{U)5dVEL7Mm-dj^S_q+39-t(d*CKsWQI5!-H6ipZvTG|185lTHW6q z{^#TF;o+;DSDVL4-N(-lzWQ5vd+Ni{ajsvq!nuRbM&!BkkyWV}EYv*4fc7$=Nr0Y;rbIG+HAIFQ1z`FTeiN;q92H7FOV91(OKs z%2Kpi$^$3mmm^ZHFj>iPvwEFy4P6h{fW^D|lx< z5jX3vpJAW0SmPXLdC3a^Q@FYJeN4=+OdG7`rlOQi+NL$OtZMk0UYD5llWxv}Z`>I7 zFE(s!9!odQOZh`u#_h$0b_!K6Hd0xmG2q|u4fC0!w`uEEqiReWxh#l zSO(Wzt@}}WFz;1zU8=cc10xZ6KC$_znPPl494{8; z*C{tSYV3ji;Pt-ZUa!=>ubM-f;Ci9+)Y%gA>P8a0JX;_J>Y(sOHryd~M z;O%R;I36JyavzY5h9n^6Q=E~qefJTm;>--Q?7n9xjQ<~Q1pVGa(0l#e9*?wu Wkd9ZfTqtDe1OIK{c#ERw#q~dzJ!>!k diff --git a/library/tedit/TEDIT b/library/tedit/TEDIT index e776f084..1f4de309 100644 --- a/library/tedit/TEDIT +++ b/library/tedit/TEDIT @@ -1,84 +1,179 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 17:10:16"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT.;47 143546 +(FILECREATED " 7-Mar-2024 08:14:51" {WMEDLEY}tedit>TEDIT.;504 120660 - :CHANGES-TO (VARS TEDITCOMS) + :EDIT-BY rmk - :PREVIOUS-DATE "14-Jul-2022 16:30:30" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT.;45) + :CHANGES-TO (FNS TEXTOBJ TEXTSTREAM TEDIT.MOVE) + :PREVIOUS-DATE " 4-Mar-2024 22:50:24" {WMEDLEY}tedit>TEDIT.;499) -(* ; " -Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. -") (PRETTYCOMPRINT TEDITCOMS) (RPAQQ TEDITCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FILES TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) + [(COMS (* ; "Loadup stuff") + (VARS TEDITFILES) + (FNS MAKE-TEDIT-EXPORTS.ALL UPDATE-TEDIT EDIT-TEDIT) + (DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE + + (* ;; "This gets EXPORTS.ALL loaded when TEDIT-EXPORTS.ALL is loaded") + + (EXPORT (FILES (FROM LOADUPS) + EXPORTS.ALL))) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP) + UNICODE))) + (DECLARE%: EVAL@COMPILE DONTCOPY + + (* ;; "Assertions go to comments if not being checked, so we see value-warnings") + + (EXPORT (COMS (MACROS TEDIT-ASSERT) + (GLOBALVARS CHECK-TEDIT-ASSERTIONS) + (INITVARS (CHECK-TEDIT-ASSERTIONS T))) + (MACROS OBJECT.ALLOWS))) + (FILES TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) + (FNS \CREATE.TEDIT.RESTART.MENU) (VARS (TEDIT.TERMSA.FONTS NIL) (TEDIT.TENTATIVE NIL) (TEDIT.DEFAULT.PROPS NIL) (TEDIT.STARTUP.MONITORLOCK (CREATE.MONITORLOCK 'TEDIT.STARTUP)) - (TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU)) - (* ; - "Original was (CREATE MENU ITEMS _ '(NewEditProcess)).") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - ) + (TEDIT.RESTART.MENU (\CREATE.TEDIT.RESTART.MENU))) (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) - (FNS \TEDIT2 COERCETEXTOBJ TEDIT TEDITSTRING TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY - TEDIT.DELETE TEDIT.DO.BLUEPENDINGDELETE TEDIT.INSERT TEDIT.KILL TEDIT.MAPLINES - TEDIT.MAPPIECES TEDIT.MOVE TEDIT.QUIT TEDIT.STRINGWIDTH TEDIT.\INSERT TEXTOBJ TEXTSTREAM - \TEDIT.INCLUDE \TEDIT.INSERT.PIECES \TEDIT.MOVE.PIECEMAPFN \TEDIT.OBJECT.SHOWSEL - \TEDIT.RESTARTFN \TEDIT.CHARDELETE \TEDIT.COPY.PIECEMAPFN \TEDIT.DELETE - \TEDIT.DIFFUSE.PARALOOKS \TEDIT.FOREIGN.COPY? \TEDIT.QUIT \TEDIT.WORDDELETE \TEDIT1) - (P (MOVD? 'NILL 'OBJECTOUTOFTEDIT)) - (* ; - "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.") - (COMS (FNS \CREATE.TEDIT.RESTART.MENU)) - (* ; - "Added by yabu.fx, for SUNLOADUP without DWIM.") - (COMS (* ; "Debugging functions") - (FNS PLCHAIN PRINTLINE SEEFILE)) + + (* ;; "Unslashed functions. Public?") + + (FNS TEDIT COERCETEXTOBJ TEDIT.CONCAT \TEDIT.CONCAT.PAGEFRAMES \TEDIT.GET.PAGE.HEADINGS + \TEDIT.CONCAT.INSTALL.HEADINGS TEDITSTRING TEDIT-SEE TEDIT.CHARWIDTH TEDIT.COPY + TEDIT.DELETE TEDIT.INSERT TEDIT.KILL TEDIT.QUIT TEDIT.DO.BLUEPENDINGDELETE TEDIT.MOVE + TEDIT.STRINGWIDTH TEXTOBJ TEDITMENUP TEXTSTREAM) + (FNS \TEDIT.MOVE.MSG \TEDIT.READONLY) + (FNS TEDIT.NCHARS TEDIT.RPLCHARCODE TEDIT.NTHCHARCODE \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 \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.FIND.OBJECT.SUBTREE - TEDIT.PUT.OBJECT TEDIT.GET.OBJECT TEDIT.OBJECT.CHANGED)) - (FILES TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ + (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) (COMS (* ; "TEDIT Support information") (E (SETQ TEDITSYSTEMDATE (DATE))) - (VARS TEDITSYSTEMDATE (TEDITSUPPORT "TEditSupport.PA")) - (FNS MAKETEDITFORM) - (P (ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM - "Report a problem with TEdit")) - (SETQ LAFITEFORMSMENU NIL))) + (VARS TEDITSYSTEMDATE)) (COMS (* ;  "LISTFILES Interface, so the system can decide if a file is a TEdit file.") - (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1) + (ADDVARS (PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) (EXTENSION (TEDIT]) -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) -(CONSTANTS (\SCRATCHLEN 64)) +(* ; "Loadup stuff") + + +(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)) +(DEFINEQ + +(MAKE-TEDIT-EXPORTS.ALL + [LAMBDA NIL (* ; "Edited 29-Aug-2023 21:59 by rmk") + (* ; "Edited 11-Sep-2022 23:43 by rmk") + (LET (VAL) + [CNDIR (PROG1 (DIRECTORYNAME T) + (CNDIR (MEDLEYDIR "library>tedit")) + (SETQ VAL (GATHEREXPORTS TEDITFILES (MEDLEYDIR "library/tedit" + "tedit-exports.all" T))))] + VAL]) + +(UPDATE-TEDIT + [LAMBDA (FILES) (* ; "Edited 26-Oct-2022 21:10 by rmk") + + (* ;; "updates sysout with new versions of loaded files. Keeps the extension") + + (FOR FILE DIRFILE LOADEDFILE INSIDE (OR FILES TEDITFILES) + WHEN [AND (SETQ LOADEDFILE (FOR F IN LOADEDFILELST WHEN (EQ FILE (FILENAMEFIELD F 'NAME)) + DO (RETURN F))) + (SETQ DIRFILE (INFILEP (PACKFILENAME 'VERSION NIL 'BODY LOADEDFILE] + UNLESS (EQ LOADEDFILE DIRFILE) COLLECT (LOAD DIRFILE T]) + +(EDIT-TEDIT + [LAMBDA NIL (* ; "Edited 3-Jul-2023 13:44 by rmk") + (* ; "Edited 17-Jun-2023 10:00 by rmk") + (* ; "Edited 25-Apr-2023 17:39 by rmk") + (* ; "Edited 26-Oct-2022 21:12 by rmk") + (* ; "Edited 14-Sep-2022 08:37 by rmk") + (BKSYSBUF " ") + (RESETLST + (RESETSAVE LOADDBFLG 'YES) + (FOR F IN TEDITFILES DO (LOADFROM F) + (LOADCOMP F))) + (%. ANALYZE ON IN TEDITFILES]) ) +(DECLARE%: DONTEVAL@LOAD DONTCOPY DONTEVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED") +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) +(* "END EXPORTED DEFINITIONS") + +) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD TEDIT-EXPORTS.ALL) +) +(DECLARE%: EVAL@COMPILE DONTCOPY (FILESLOAD (LOADCOMP) - TEDIT-DCL) + UNICODE) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(PUTPROPS TEDIT-ASSERT MACRO [ARGS (COND + [CHECK-TEDIT-ASSERTIONS + `(CL:UNLESS ,(CAR ARGS) + [HELP "TEDIT-ASSERT FAILURE" ,(KWOTE (CAR ARGS])] + (T ` (* (TEDIT-ASSERT (\,@ ARGS)))]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS CHECK-TEDIT-ASSERTIONS) ) -(FILESLOAD TEDIT-PCTREE TEDIT-TEXTOFD TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) +(RPAQ? CHECK-TEDIT-ASSERTIONS T) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) + (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) + (\TEDIT.APPLY.OBJFN (PCONTENTS PC) + OPERATION FROMTOBJ TOTOBJ)))) +) + +(* "END EXPORTED DEFINITIONS") + +) + +(FILESLOAD TEDIT-PCTREE TEDIT-STREAM TEDIT-COMMAND TEDIT-SCREEN TEDIT-ABBREV TEDIT-LOOKS) +(DEFINEQ + +(\CREATE.TEDIT.RESTART.MENU + [LAMBDA NIL (* ; "Edited 28-Aug-2022 22:45 by rmk") + + (* ;; "Separate dinky function to compile for SUNLOADUP without DWIM.") + + (CREATE MENU + ITEMS _ '(NewEditProcess]) +) (RPAQQ TEDIT.TERMSA.FONTS NIL) @@ -93,172 +188,22 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (GLOBALVARS TEDIT.TENTATIVE TEDIT.DEFAULT.PROPS) ) + + + +(* ;; "Unslashed functions. Public?") + (DEFINEQ -(\TEDIT2 - [LAMBDA (TEXT WINDOW UNSPAWNED) (* ; "Edited 12-Jun-90 17:51 by mitani") - - (* ;; "Does the actual editing work, once TEDIT has OPENTEXTSTREAMed the thing to be edited.") - - (\TEDIT.COMMAND.LOOP (fetch (TEXTSTREAM TEXTOBJ) of TEXT)) - (* ; "Run the editing engine") - (CLOSEW WINDOW) (* ; "Close the edit window") - (\TEXTCLOSEF TEXT) (* ; "Close the underlying files") - (replace (STREAM ACCESSBITS) of TEXT with BothBits) - (* ; - "But leave the stream itself accessible") - (AND (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - (APPLY* (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - WINDOW TEXT)) (* ; - "Apply any post-window-close (and post-QUIT) function") - (COND - (UNSPAWNED (* ; - "We're not a distinct process: Send back the edited text in some suitable form") - (COND - ((NEQ (fetch (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT)) - T) - (PROG1 (fetch (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT)) - (replace (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT) with - NIL))) - ((STRINGP (fetch (TEXTOBJ TXTFILE) of (fetch (TEXTSTREAM TEXTOBJ - ) of TEXT))) - (COERCETEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'STRINGP)) - (T TEXT]) - -(COERCETEXTOBJ - [LAMBDA (STREAM TYPE OUTPUTSTREAM) (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 13:58 by rmk:") - (* ; "Edited 11-Jun-99 13:58 by rmk:") - (* ; "Edited 18-Apr-93 23:42 by jds") - - (* ;; "Coerce the contents of the TEXOTBJ to be of the given type. This is for making a string from a textobj, e.g.") - - (PROG ((TEXTOBJ (COND - ((type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (T STREAM))) - OFILE FMTFILE) - (OR (type? TEXTOBJ TEXTOBJ) - (\ILLEGAL.ARG TEXTOBJ)) (* ; - "If we haven't got a TEXTOBJ, something is wrong.") - (RETURN (SELECTQ TYPE - ((STRINGP STRING) - (AND (ILEQ (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - 65535) - (PROG ((STR (ALLOCSTRING (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ))) - PC - (CH# 1) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (DELTA 0) - PFILE) - (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) - [WHILE PC - do (COND - ((ATOM PC)(* ; - "It's the lastpiece atom -- do nothing.") - (SETQ PC NIL)) - ((fetch CLINVISIBLE of (fetch - (PIECE PLOOKS) - of PC)) - - (* ;; "If the characters are invisible, do nothing. HOWEVER, we have to shrink the final string to account for the characters we ignored.") - - (add DELTA (fetch (PIECE PLEN) - of PC))) - ((fetch (PIECE PSTR) of PC) - [OR (ZEROP (fetch (PIECE PLEN) of PC)) - (RPLSTRING STR CH# (SUBSTRING - (fetch (PIECE PSTR) - of PC) - 1 - (fetch (PIECE PLEN) - of PC] - (add CH# (fetch (PIECE PLEN) of - PC))) - ((SETQ PFILE (fetch (PIECE PFILE) of - PC)) - [COND - ((NOT (OPENP PFILE)) - (SETQ PFILE (\TEDIT.REOPEN.STREAM STREAM - PFILE] - (SETFILEPTR PFILE (fetch (PIECE PFPOS) - of PC)) - (for C from CH# as I from 1 - to (fetch (PIECE PLEN) of PC) - do (RPLCHARCODE STR C (BIN PFILE))) - (add CH# (fetch (PIECE PLEN) of - PC))) - ((fetch (PIECE POBJ) of PC) - (* ; "DO NOTHING FOR OBJECTS") - (add CH# (fetch (PIECE PLEN) of - PC)) - (add DELTA (fetch (PIECE PLEN) - of PC))) - (T (ERROR "CANNOT GET TEXT FROM A 'PIECE.'" PC))) - (AND PC (SETQ PC (FETCH (PIECE NEXTPIECE) - OF PC] - [COND - ((ZEROP DELTA) (* ; - "No change in the length; do nothing.") - ) - (T (* ; - "The string got shortened to account for invisible chars. Chop it off") - (SETQ STR (SUBSTRING STR 1 (IDIFFERENCE - (fetch (TEXTOBJ - TEXTLEN) - of TEXTOBJ) - DELTA] - (RETURN STR)))) - (STREAM (COND - ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - [OPENFILE (fetch (STREAM FULLNAME) of (fetch - (TEXTOBJ TXTFILE - ) - of TEXTOBJ)) - 'INPUT NIL '((TYPE TEXT] - (replace (STREAM ACCESSBITS) of (fetch (TEXTOBJ - TXTFILE) - of TEXTOBJ) - with ReadBit))) - (\SETUPGETCH 1 TEXTOBJ) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (FILE [SETQ OFILE (OR (AND OUTPUTSTREAM (OPENP OUTPUTSTREAM 'OUTPUT)) - (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW] - (TEDIT.PUT.PCTB TEXTOBJ OFILE) - (OR OUTPUTSTREAM (CLOSEF OFILE)) - OFILE) - (SPLIT - (* ;; "I.e., Return 2 files, one with plain text, one with formatting info, such that concatenating them will do the right thing.") - - (SETQ OFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW)) - (SETQ FMTFILE (CAR (TEDIT.PUT.PCTB TEXTOBJ (\GETSTREAM OFILE - 'BOTH) - NIL T))) - (CLOSEF OFILE) - (CONS OFILE FMTFILE)) - NIL]) - (TEDIT [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) + (* ;; "Edited 20-Oct-2023 11:02 by rmk") + + (* ;; "Edited 17-Oct-2023 08:53 by rmk") + (* ;; "Edited 22-Jun-2022 20:01 by rmk: Call to OPENSTREAM passes FORMAT from PROPS") - (* ;; "Edited 22-Jun-2022 19:58 by rmk") - - (* ;; "Edited 4-Jun-2022 15:42 by rmk") - (* ;; "Edited 31-Jan-2022 17:19 by rmk: String TEXT is a file name") (* ;; "Edited 24-Dec-2021 19:21 by rmk") @@ -269,139 +214,288 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (* ;; "User entry to the text editor. Takes an optional window to be used for editing") + (SETQ PROPS (APPEND PROPS TEDIT.DEFAULT.PROPS)) + (* ;; "DONTSPAWN => Don't try to create a new process for this edit.") - (PROG (PROC TEDITCREATEDWINDOW) - [COND - ((AND TEXT (OR (LITATOM TEXT) - (STRINGP TEXT) - (CL:PATHNAMEP TEXT))) (* ; + (LET (TSTREAM PROC) (* ;  "Make sure the file exists before trying to open the window.") - (SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD `((TYPE TEXT) - (FORMAT ,(LISTGET PROPS 'FORMAT] - (CL:WHEN (AND WINDOW (OR (LITATOM WINDOW) - (REGIONP WINDOW))) - - (* ;; "Pass specified and typed regions to TEDIT.CREATEW") - - (PUSH PROPS 'REGION-TYPE WINDOW) - (SETQ WINDOW NIL)) - (RESETLST - [RESETSAVE NIL `(AND ,WINDOW (WINDOWPROP ,WINDOW 'TEXTOBJ NIL] - (WITH.MONITOR TEDIT.STARTUP.MONITORLOCK - (COND - ((NOT WINDOW) - (SETQ TEDITCREATEDWINDOW T) - (SETQ WINDOW (COND - [(OR (LISTGET PROPS 'REGION-TYPE) - (NOT TEDIT.DEFAULT.WINDOW) - (\TEDIT.ACTIVE.WINDOWP TEDIT.DEFAULT.WINDOW)) - (TEDIT.CREATEW (COND - (TEXT (CONCAT - "Please specify an editing window for " - (FULLNAME TEXT))) - (T - "Please specify a region for the editing window." - )) - TEXT - (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS] - (T (\TEDIT.CREATEW.FROM.REGION (WINDOWPROP TEDIT.DEFAULT.WINDOW - 'REGION) - TEXT - (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS))) - (* ; "Replace the old title") - TEDIT.DEFAULT.WINDOW))) - - (* ;; - "Mark the newly-created window reserved until the OPENTEXTSTREAM has done its work.") - - (* ;; - "mark that we created the window so that we know we can update the title, etc.") - - (WINDOWPROP WINDOW 'TEXTOBJ T))))) - [SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL (APPEND PROPS '(BEING-EDITED T] - (* ; "Connect the editor to the window") - (replace (TEXTOBJ TXTEDITING) of (TEXTOBJ TEXT) with T) - (* ; "For the moment, mark the document as actively in edit. (so caret flashes when the window is first brought up.)") - [COND - (TEDITCREATEDWINDOW (TEXTPROP TEXT 'TEDITCREATEDWINDOW 'T] - (COND - (DONTSPAWN (* ; + (push PROPS 'BEING-EDITED T) (* ; + "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)) + (CL:UNLESS (WINDOWP WINDOW) + (SETQ WINDOW (CAR (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + \WINDOW)))) + (COND + (DONTSPAWN (* ;  "Either no processes running, or specifically not to spawn one.") - (RETURN (\TEDIT2 TEXT WINDOW T))) - (T (* ; "Spawn a process to do the edit.") - [SETQ PROC (ADD.PROCESS (LIST '\TEDIT2 (KWOTE TEXT) - WINDOW NIL) - 'NAME - 'TEdit - 'RESTARTABLE - 'HARDRESET - 'RESTARTFORM - (LIST '\TEDIT.RESTARTFN (KWOTE TEXT) - WINDOW - (KWOTE PROPS] - (PROCESSPROP PROC 'WINDOW WINDOW) - (COND - ((NOT (LISTGET (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS)) - 'LEAVETTY)) (* ; + (\TEDIT1 TSTREAM WINDOW T)) + (T (* ; "Spawn a process to do the edit.") + [SETQ PROC (ADD.PROCESS (LIST (FUNCTION \TEDIT1) + (KWOTE TSTREAM) + WINDOW NIL) + 'NAME + 'TEdit + 'RESTARTABLE + 'HARDRESET + 'RESTARTFORM + (LIST (FUNCTION \TEDIT.RESTARTFN) + (KWOTE TSTREAM) + WINDOW + (KWOTE PROPS] + (PROCESSPROP PROC 'WINDOW WINDOW) + (CL:UNLESS (LISTGET PROPS 'LEAVETTY) (* ;  "Unless he asked us to leave the tty where it is, TEdit should get it.") - (TTY.PROCESS PROC))) - (RETURN PROC]) + (TTY.PROCESS PROC)) + PROC]) + +(COERCETEXTOBJ + [LAMBDA (TSTREAM TYPE OUTPUTSTREAM) (* ; "Edited 13-Jan-2024 20:01 by rmk") + (* ; "Edited 26-Dec-2023 12:29 by rmk") + (* ; "Edited 18-Dec-2023 23:13 by rmk") + (* ; "Edited 21-Nov-2023 00:08 by rmk") + (* ; "Edited 15-Sep-2023 00:08 by rmk") + (* ; "Edited 15-Aug-2023 20:20 by rmk") + (* ; "Edited 8-May-2023 13:25 by rmk") + (* ; "Edited 4-May-2023 12:13 by rmk") + (* ; "Edited 11-Jun-99 15:10 by rmk:") + (* ; "Edited 18-Apr-93 23:42 by jds") + + (* ;; "Coerce the contents of the TEXOTBJ to be of the given type. This is for making a string from a textobj, e.g.") + + (* ;; "RMK: moved the string case up from the piece level to the stream-BIN level") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (SETQ TSTREAM (TEXTSTREAM TEXTOBJ)) + (SELECTQ TYPE + ((STRINGP STRING) + (\TEXTSETFILEPTR TSTREAM 0) (* ; + "This gets underneath the OPENP test of the generic SETFILEPTR") + + (* ;; "Allocstring presumably errors if greater than max stringsize.") + + [for CH# CH (NOBJECTS _ 0) + (STR _ (ALLOCSTRING (TEXTLEN TEXTOBJ))) from 1 to (TEXTLEN TEXTOBJ) + do (SETQ CH (BIN TSTREAM)) + (if (IMAGEOBJP CH) + then (add NOBJECTS 1) (* ; "Skip image objects") + (add CH# -1) + else (RPLCHARCODE STR CH# CH)) + finally (RETURN (OR (SUBSTRING STR 1 (IDIFFERENCE CH# (ADD1 NOBJECTS))) + (CONCAT ""]) + (STREAM + (* ;; "It seems that all this does is to ensure that the TXTFILE is open and TSTREAM is set to the beginning") + + (CL:WHEN (STREAMP (FGETTOBJ TEXTOBJ TXTFILE)) + (CL:UNLESS (\GETSTREAM (FGETTOBJ TEXTOBJ TXTFILE))) + (OPENSTREAM (FGETTOBJ TEXTOBJ TXTFILE) + 'INPUT)) + (SETFILEPTR TSTREAM 0) + TSTREAM) + (FILE (* ; "Throw away looks if no formatting") + [SETQ OUTPUTSTREAM (OR (AND OUTPUTSTREAM (OPENP OUTPUTSTREAM 'OUTPUT)) + (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW] + (\TEDIT.PUT.PCTB TEXTOBJ OUTPUTSTREAM (NOT (\TEDIT.FORMATTEDSTREAMP TEXTOBJ))) + OUTPUTSTREAM) + (SPLIT + (* ;; "Return 2 NODIRCORE files, one with the plain text character, one with formatting info, such that concatenating them will produce a proper Tedit-format file. If TSTREAM is actually a file stream and not a text stream, we could do the split by COPYBYTES. But if a text stream, there could be other kinds of pieces.") + + (LET [(CHARSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) + (FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((LINELENGTH T] + (\TEDIT.PUT.PCTB TEXTOBJ CHARSTREAM FORMATSTREAM NIL T) + (SETFILEPTR CHARSTREAM 0) + (SETFILEPTR FORMATSTREAM 0) + (CONS CHARSTREAM FORMATSTREAM))) + (SEXPR (TEDIT.SEL.AS.SEXPR TSTREAM)) + NIL]) + +(TEDIT.CONCAT + [LAMBDA (TSTREAMS SEPARATOR) (* ; "Edited 18-Jan-2024 00:03 by rmk") + + (* ;; "Produces a textstream that contains the concatenation of all of the TSTREAMS, separated by SEPARATOR. Any stream that is not already a text stream is first converted to a plaintext stream. SEPARATOR if provided as a string or character is inserted between the files.") + + (CL:WHEN SEPARATOR + (CL:UNLESS (CHARCODEP SEPARATOR) + (SETQ SEPARATOR (OR (CHARCODE.DECODE SEPARATOR T) + (MKSTRING SEPARATOR))))) + (LET* ((CSTREAM (OPENTEXTSTREAM)) + (CTEXTOBJ (TEXTOBJ CSTREAM)) + [TSTEXTOBJECTS (for TS inside TSTREAMS collect (OR (TEXTOBJ TS T) + (TEXTOBJ (OPENTEXTSTREAM TS] + FIRSTTOBJ INITIALFILEPIECES) + (CL:WHEN TSTEXTOBJECTS + (SETQ FIRSTTOBJ (CAR TSTEXTOBJECTS)) + + (* ;; "Take overall parameters from the first stream. ") + + (FSETTOBJ CTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FIRSTTOBJ DEFAULTCHARLOOKS)) + (FSETTOBJ CTEXTOBJ FMTSPEC (FGETTOBJ FIRSTTOBJ FMTSPEC)) + (FSETTOBJ CTEXTOBJ TXTRTBL (FGETTOBJ FIRSTTOBJ TXTRTBL)) + (FSETTOBJ CTEXTOBJ TXTWTBL (FGETTOBJ FIRSTTOBJ TXTWTBL)) + (FSETTOBJ CTEXTOBJ TXTSTYLESHEET (FGETTOBJ FIRSTTOBJ TXTSTYLESHEET)) + (for TSOBJ PREVPC (LASTTOBJ _ (CAR (LAST TSTEXTOBJECTS))) + (FIRSTPC _ (create PIECE)) in TSTEXTOBJECTS first + (* ;; + "LASTTOBJ to suppress final separator") + + (SETQ PREVPC FIRSTPC) + (* ; "Dummy") + do (CL:WHEN (FGETTOBJ TSOBJ FORMATTEDP) + (FSETTOBJ CTEXTOBJ FORMATTEDP T)) + (for PC NEWPIECE inpieces (\FIRSTPIECE TSOBJ) + do (SETQ NEWPIECE (\TEDIT.COPYPIECE PC TSOBJ CTEXTOBJ NIL 'COPY)) + (FSETPC PREVPC NEXTPIECE NEWPIECE) + (FSETPC NEWPIECE PREVPIECE PREVPC) + (SETQ PREVPC NEWPIECE)) + + (* ;; "Information for pageframe adjustments") + + (push INITIALFILEPIECES (\FIRSTPIECE TSOBJ)) + (CL:WHEN SEPARATOR + (CL:UNLESS (EQ TSOBJ LASTTOBJ) + (SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE PREVPC SEPARATOR)))) + finally (\INSERTPIECES (NEXTPIECE FIRSTPC) + NIL CTEXTOBJ) + (\TEDIT.CONCAT.PAGEFRAMES CTEXTOBJ TSTEXTOBJECTS (DREVERSE INITIALFILEPIECES)) + (\TEDIT.UNIQUIFY.ALL CTEXTOBJ))) + CSTREAM]) + +(\TEDIT.CONCAT.PAGEFRAMES + [LAMBDA (CTEXTOBJ TSTEXTOBJECTS INITIALFILEPIECES) (* ; "Edited 18-Jan-2024 22:16 by rmk") + + (* ;; "The individual files may have their own heading paragraphs specified in their pieces and in their pageframes. Since the heading types are global for the file, we have to make sure the any conflicting heading-type names are made distinct within the combined toplevel pageframe, and that any new names are propagated into the FMTSPEC's of the pieces within each file.") + + (* ;; + "Scan all the first/left/right heading frames, grouping all of the heading types by their regions.") + + (LET (FIRSTREGIONS LEFTREGIONS RIGHTREGIONS FIRSTNEW LEFTNEW RIGHTNEW) + + (* ;; "Index first, even, odd types by region. Keep the lists separate for the final step of building the concat pageframes.") + + (* ;; "If the same region is appears in both left and right headings, presumably the type-names will be different--and we maintain that difference as we canonicalize. ") + + (for TSOBJ FRAMES in TSTEXTOBJECTS do (SETQ FRAMES (GETTOBJ TSOBJ TXTPAGEFRAMES)) + (SETQ FIRSTREGIONS (\TEDIT.GET.PAGE.HEADINGS + (CAR FRAMES) + FIRSTREGIONS)) + (SETQ LEFTREGIONS (\TEDIT.GET.PAGE.HEADINGS + (CADR FRAMES) + LEFTREGIONS)) + (SETQ RIGHTREGIONS (\TEDIT.GET.PAGE.HEADINGS + (CADDR FRAMES) + RIGHTREGIONS))) + + (* ;; "Invert these to map all encountered types with a given region into a canonical type with that region. ") + + [for R in FIRSTREGIONS as I from 1 + do (for TYPE in (CDR R) do (push FIRSTNEW (LIST TYPE (PACK* 'HeadingF I) + (CAR R] + [for R in LEFTREGIONS as I from 1 + do (for TYPE in (CDR R) do (push LEFTNEW (LIST TYPE (PACK* 'HeadingL I) + (CAR R] + [for R in RIGHTREGIONS as I from 1 + do (for TYPE in (CDR R) do (push RIGHTNEW (LIST TYPE (PACK* 'HeadingR I) + (CAR R] + + (* ;; "Replace the type in each heading piece to its canonical type. Presumably the input typenames were sorted by first/left/right, so a given name only appears in one of the list. So we can append.") + + [for PC PPARALOOKS (ALLNEW _ (APPEND FIRSTNEW LEFTNEW RIGHTNEW)) inpieces (\FIRSTPIECE + CTEXTOBJ) + eachtime (SETQ PPARALOOKS (PPARALOOKS PC)) when (EQ 'PAGEHEADING (fetch (FMTSPEC + FMTPARATYPE + ) + of PPARALOOKS)) + do (FSETPC PC PPARALOOKS (create FMTSPEC using PPARALOOKS FMTPARASUBTYPE _ + (CADR (ASSOC (fetch (FMTSPEC + FMTPARASUBTYPE) + of PPARALOOKS) + ALLNEW] + + (* ;; "Finally, build the pageframes for the new types and their regions. We take the page frame of the first TSOBJ as the base pattern") + + [SETQ CPAGEFRAME (\TEDIT.PARSE.PAGEFRAMES (\TEDIT.UNPARSE.PAGEFRAMES (FGETTOBJ (CAR + TSTEXTOBJECTS + ) + TXTPAGEFRAMES] + (\TEDIT.CONCAT.INSTALL.HEADINGS (CAR CPAGEFRAME) + FIRSTNEW) + (\TEDIT.CONCAT.INSTALL.HEADINGS (CADR CPAGEFRAME) + LEFTNEW) + (\TEDIT.CONCAT.INSTALL.HEADINGS (CADDR CPAGEFRAME) + RIGHTNEW) + (FSETTOBJ CTEXTOBJ TXTPAGEFRAMES CPAGEFRAME]) + +(\TEDIT.GET.PAGE.HEADINGS + [LAMBDA (PAGEREGION HEADLIST) (* ; "Edited 18-Jan-2024 21:36 by rmk") + + (* ;; "Produces an ALIST that maps each different heading region to a list of heading types that have that region. All of those heading types can be reduced to a single type.") + + (CL:WHEN (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION)) + [for PH in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) + when [AND (EQ 'HEADING (fetch (PAGEREGION REGIONFILLMETHOD) of PH)) + (EQ 'HEADINGTYPE (CAR (fetch (PAGEREGION REGIONLOCALINFO) of PH] + do (pushnew [CDR (OR (SASSOC (fetch (PAGEREGION REGIONSPEC) of PH) + HEADLIST) + (CAR (PUSH HEADLIST (CONS (fetch (PAGEREGION REGIONSPEC) of PH] + (CADR (fetch (PAGEREGION REGIONLOCALINFO) of PH] + HEADLIST)]) + +(\TEDIT.CONCAT.INSTALL.HEADINGS + [LAMBDA (PAGEREGION NEWTYPES) (* ; "Edited 18-Jan-2024 22:02 by rmk") + + (* ;; + "Smash headings representing NEWTYPES into PAGEREGION, removing any headings previously there.") + + (CL:WHEN (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEREGION)) + + (* ;; "Replace all the old headings with the new ones, keeping all other subboxes") + + (* ;; "NEWTYPES is the list that maps old types to new types. We first reduce it to just a new-type region list.") + + [change (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) + (NCONC (for SPF in DATUM unless (EQ 'HEADING (fetch (PAGEREGION REGIONFILLMETHOD) + of SPF)) collect SPF) + (for R in (for NT in NEWTYPES unless (ASSOC (CADR NT) + $$VAL) collect (CDR NT)) + collect (create PAGEREGION + REGIONFILLMETHOD _ 'HEADING + REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR R)) + REGIONSPEC _ (CADR R])]) (TEDITSTRING [LAMBDA (TEXT WINDOW DONTSPAWN PROPS) +(* ;;; "Edited 16-Dec-2023 12:06 by rmk") + +(* ;;; "Edited 9-May-2023 21:55 by rmk") + (* ;;; "Edited 23-May-2022 15:52 by rmk") (* ;;; "Edited 19-May-2022 22:46 by rmk: An interface function to replace calls to TEDIT when the text argument may be the string to be edited rather than the name of a file. This enables the transition that gets TEDIT aligned with the convention that strings, as well as litatoms, are file names") - (TEDIT (IF (STRINGP TEXT) - THEN (OPENSTRINGSTREAM TEXT) - ELSE TEXT) + (SETQ TEXT (MKSTRING TEXT)) + (TEDIT (LET ((TSTR (OPENTEXTSTREAM))) + (TEDIT.INSERT TSTR TEXT 1 NIL T) + (TEDIT.SETSEL TSTR 1 0 'LEFT) + TSTR) WINDOW DONTSPAWN PROPS]) (TEDIT-SEE - [LAMBDA (FILE WINDOW FORMAT TITLE) (* ; "Edited 5-May-2022 15:18 by rmk") - (* ; "Edited 30-Dec-2021 18:03 by rmk") - (* ; "Edited 16-Dec-2021 12:33 by rmk") - (* ; "Edited 13-Oct-2021 10:00 by rmk:") - (* ; "Edited 27-Feb-2021 20:07 by rmk:") - (* ; "Edited 1-Feb-88 19:00 by bvm:") + [LAMBDA (FILE WINDOW FORMAT TITLE) - (* ;; "See FILE in a scrollable READONLY TEDIT window. If FILE is a LISP source file, copy first to a temporary NODIRCORE image file that interpretes the fontchange characters rather than showing black boxes.") + (* ;; + "Edited 13-Sep-2023 09:04 by rmk: Old code replaced to take advantage of new standard interfaces.") - (* ;; "FORMAT for text files defaults to :UTF-8 if present, otherwise *DEFAULT-EXTERNALFORMAT*") + (* ;; "Edited 14-Jul-2023 00:02 by rmk") - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (LET ((SEESTREAM STREAM) - TSTREAM) + (* ;; "Edited 13-Sep-2022 09:21 by rmk: Changed the default format here to the current Medley default. This shouldn't be special.") - (* ;; "No need to fiddle with a TEDIT file") + (* ;; "Edited 27-Feb-2021 20:07 by rmk:") - (IF (\TEDIT.FORMATTEDP1 STREAM) - ELSEIF (LISPSOURCEFILEP STREAM) - THEN - (* ;; "Lisp source file") + (* ;; "Edited 1-Feb-88 19:00 by bvm:") - (SETQ SEESTREAM (OPENTEXTSTREAM)) - (APPLY* (FUNCTION SEE) - STREAM SEESTREAM) - ELSE - (* ;; "Not a Lisp source file and not a Tedit file. If it is not random access, we copy it so we can scroll around.") - - (* ;; "Maybe there is a conventional way of finding out the external format of a plain-text stream (an EMACS header?), here we nudge towards :UTF-8 (if it exists).") - - (SETFILEINFO STREAM 'FORMAT (OR FORMAT (FIND-FORMAT :UTF-8) - :DEFAULT)) - (CL:UNLESS (RANDACCESSP STREAM) - (SETQ SEESTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) - (COPYCHARS STREAM SEESTREAM))) - [SETQ TSTREAM (TEXTSTREAM (TEDIT SEESTREAM WINDOW NIL - `(READONLY T LEAVETTY T FONT ,DEFAULTFONT] - [WINDOWPROP (WFROMDS TSTREAM) - 'TITLE - (OR TITLE (CONCAT "SEE window for " (FULLNAME STREAM] - TSTREAM]) + (TEXTSTREAM (TEDIT FILE WINDOW NIL `(READONLY T LEAVETTY T FONT ,DEFAULTFONT]) (TEDIT.CHARWIDTH [LAMBDA (CH FONT TERMSA) (* jds "22-OCT-83 19:32") @@ -443,502 +537,242 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (CHARWIDTH CH FONT]) (TEDIT.COPY - [LAMBDA (FROM TO) (* ; "Edited 4-Jun-92 11:11 by jds") - (SETQ TEDIT.COPY.PENDING NIL) (* ; - "First, Turn off the global flag that got us here.") - (COND - ((NOT (AND FROM (fetch (SELECTION SET) of FROM))) - (* ; - "There MUST be a source selected first.") - (TEDIT.PROMPTPRINT (fetch (SELECTION \TEXTOBJ) of TO) - "Copy source selection hasn't been set yet." T)) - ((ZEROP (fetch (SELECTION DCH) of FROM)) (* ; - "The source is empty. Just turn off the selection hilite and ignore the request.") - (\SHOWSEL FROM NIL NIL)) - ((fetch (TEXTOBJ TXTREADONLY) of (fetch (SELECTION \TEXTOBJ) of TO)) - (* ; "The target is read-only. Don't do anything except turn off the selection highlighting and ignore the request.") - (\SHOWSEL FROM NIL NIL)) - (T (\SHOWSEL FROM NIL NIL) (* ; - "Before all else, make sure the copy source selection is turned off") - (replace (SELECTION SET) of FROM with NIL) - (COND - ((AND TO (fetch (SELECTION SET) of TO)) (* ; - "Can only do copy if there's a target selection") - (PROG ((TOOBJ (fetch (SELECTION \TEXTOBJ) of TO)) - (FROMOBJ (fetch (SELECTION \TEXTOBJ) of FROM)) - (CROSSCOPY (NEQ (fetch (SELECTION \TEXTOBJ) of FROM) - (fetch (SELECTION \TEXTOBJ) of TO))) - TOLEN LEN INSPC INSPC# PC NPC PCCH NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST - OBJ COPYFN UNDOCHAIN) - (SETQ PCLST (TEDIT.SELECTED.PIECES FROMOBJ FROM CROSSCOPY (FUNCTION - \TEDIT.COPY.PIECEMAPFN - ) - FROMOBJ TOOBJ)) (* ; - "Get the list of pieces to be copied") - (SETQ REPLACING (TEDIT.DO.BLUEPENDINGDELETE TO TOOBJ)) - (* ; "Do any blue-pending-delete") - (SETQ TOLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ)) - (\SHOWSEL TO NIL NIL) (* ; - "NOW turn off the target selection.") - [COND - ((EQ (fetch (SELECTION POINT) of TO) - 'LEFT) - (SETQ INSERTCH# (fetch (SELECTION CH#) of TO))) - (T (SETQ INSERTCH# (IMIN (fetch (SELECTION CHLIM) of TO) - (ADD1 TOLEN] (* ; - "Figure out where to do the insertion.") - (COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of FROMOBJ) - (NOT (fetch (TEXTOBJ FORMATTEDP) of TOOBJ))) - (* ; - "The source is formatted and the target isn't. Give the guy a choice.") - (* ; - "For now, convert the target file to formatted.") - (\TEDIT.CONVERT.TO.FORMATTED TOOBJ))) - (SETQ UNDOCHAIN (\TEDIT.INSERT.PIECES TOOBJ INSERTCH# PCLST - (SETQ LEN (IDIFFERENCE (fetch (SELECTION CHLIM) - of FROM) - (fetch (SELECTION CH#) of FROM))) - NIL NIL CROSSCOPY NIL T)) - (bind OBJ AFTERCOPYFN for PC in PCLST - when [AND (SETQ OBJ (fetch (PIECE POBJ) of PC)) - (SETQ AFTERCOPYFN (IMAGEOBJPROP OBJ 'AFTERCOPYFN] - do (APPLY* AFTERCOPYFN OBJ)) - (SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TOOBJ)) - (\TEDIT.HISTORYADD TOOBJ - (create TEDITHISTORYEVENT - THACTION _ (COND - (REPLACING 'Replace) - (T 'Copy)) - THLEN _ LEN - THCH# _ INSERTCH# - THFIRSTPIECE _ UNDOCHAIN - THOLDINFO _ (AND REPLACING EVENT))) - (* ; - "Make a history-list entry for the COPY.") - (replace (TEXTOBJ \DIRTY) of TOOBJ with T) - (* ; "Mark the document changed") - (replace (TEXTOBJ TEXTLEN) of TOOBJ with (IPLUS LEN TOLEN)) - (* ; "Set the new length") - (\FIXILINES TOOBJ TO INSERTCH# LEN TOLEN)(* ; "Fix LINES and SELs") - [COND - ((EQ (fetch (TEXTOBJ FORMATTEDP) of TOOBJ) - (fetch (TEXTOBJ FORMATTEDP) of FROMOBJ)) - (* ; - "Either both of the files are formatted or neither is. This case is OK") - ) - ((fetch (TEXTOBJ FORMATTEDP) of TOOBJ) - (* ; - "The source wasn't formatted, but the target is. Go convert the copied text.") - (\TEDIT.CONVERT.TO.FORMATTED TOOBJ INSERTCH# (IPLUS INSERTCH# LEN] - (TEDIT.UPDATE.SCREEN TOOBJ) (* ; "Refresh the display") - (replace (SELECTION CH#) of TO with INSERTCH#) - (* ; "Correct the target selection") - (replace (SELECTION CHLIM) of TO with (IPLUS INSERTCH# LEN)) - (replace (SELECTION DCH) of TO with LEN) - (replace (SELECTION DX) of TO with 0) - (replace (SELECTION POINT) of TO with 'RIGHT) - (* ; - "(replace CARETLOOKS of TOOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TOOBJ TO))") - (* ; - "Make any later type-in look like what we just copied.") - (replace (TEXTOBJ \INSERTPCVALID) of TOOBJ with NIL) - (* ; - "And make sure that the pieces copied never have their strings smashed by back spacing.") - (replace (TEXTOBJ \INSERTPCVALID) of FROMOBJ with NIL) - (\FIXSEL TO TOOBJ) - (\SHOWSEL TO NIL T))) - (T (* ; - "There is no target selection -- complain") - (TEDIT.PROMPTPRINT (fetch (SELECTION \TEXTOBJ) of FROM) - "Please select a destination for the copy first." T]) + [LAMBDA (FROM TO) (* ; "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.") + + (* ;; "This results in a single history event.") + + (CL:UNLESS (\TEDIT.MOVE.MSG FROM TO T) + (PROG ((TOBJ (GETSEL TO SELTEXTOBJ)) + (FOBJ (GETSEL FROM SELTEXTOBJ)) + FROMPIECES) + (\SHOWSEL FROM NIL) (* ; "Turn off any current highlighting") + (\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 (\SELPIECES.COPY (\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) + + (* ;; "") + + (\SHOWSEL TO NIL) (* ; + "Take down anything that might thave appeared") + (\FIXSEL TO TOBJ) + (\SHOWSEL TO T)))]) (TEDIT.DELETE - [LAMBDA (STREAM SEL LEN LEAVECARETLOOKS) (* ; "Edited 12-Jun-90 17:49 by mitani") + [LAMBDA (STREAM SEL LEN LEAVECARETLOOKS) (* ; "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 CHARACTERS SPECIFIED FROM THE MAIN TEXT.") + (* ;; "Delete the specified characters from STREAM.") - (* ;; "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.") + (* ;; "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.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM))) - [COND - ((FIXP SEL) - (TEDIT.SETSEL STREAM SEL LEN NIL NIL LEAVECARETLOOKS) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ] - (OR SEL (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (\TEDIT.DELETE SEL TEXTOBJ]) - -(TEDIT.DO.BLUEPENDINGDELETE - [LAMBDA (SEL TEXTOBJ) (* ; "Edited 29-May-91 18:21 by jds") - (* Check for blue-pending-delete, - and do it if it's there.) - (* Return T if the deletion was - made. For people who need to know) - (COND - ((fetch (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ) - (* If he's in a Blue-pending-delete - state, delete the selection.) - (PROG1 (fetch (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ) - (COND - ((NOT (ZEROP (fetch (SELECTION DCH) of SEL))) - (* There really IS something to - delete.) - (\SHOWSEL SEL NIL NIL) (* Turn off the selection) - (\DELETECH (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CHLIM) of SEL) - (fetch (SELECTION DCH) of SEL) - TEXTOBJ) (* Delete the characters.) - (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) - SEL - (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CHLIM) of SEL) - TEXTOBJ) (* Fix up any line descriptors to - reflect the deletion.) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* Make it a normal selection again.) - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) - of SEL)) - - (* Fix up the selection, so that it is 0 wide, where the old text used to be.) - - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'LEFT) - (\FIXSEL SEL TEXTOBJ) (* Make its line descriptors &c - reflect the new reality) - (\SHOWSEL SEL NIL T) (* And turn it back on.) - ) - (T (* Don't do it, since it's - zero-width. However, DO turn off the - blue-pendingness of it.) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL))))]) + (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]) (TEDIT.INSERT - [LAMBDA (STREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "Edited 29-May-91 18:21 by jds") - (* ; - "Insert TEXT (character, litatom or string) at the appropriate spot in the text.") - (SETQ STREAM (TEXTSTREAM STREAM)) - [COND - ((FIXP CH#ORSEL) (* ; - "He gave us a ch# to insert before") - (TEDIT.SETSEL STREAM CH#ORSEL 1 'LEFT] - [COND - ((LITATOM TEXT) - (SETQ TEXT (MKSTRING TEXT] - [OR (type? SELECTION CH#ORSEL) - (SETQ CH#ORSEL (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] - (COND - ((AND (STRINGP TEXT) - (ZEROP (NCHARS TEXT))) (* ; - "Can't insert an empty string sensibly. It confuses the screen update code.") - NIL) - [(AND CH#ORSEL (fetch (SELECTION SET) of CH#ORSEL)) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - CH# LINE XPOINT OTEXTLEN DS LINES CHARS BLANKSEEN CRSEEN) - (TEDIT.DO.BLUEPENDINGDELETE CH#ORSEL TEXTOBJ) - (* ; - "If the selected text was for pending delete, delete it before doing the insert.") - (COND - (LOOKS (* ; - "If looks for this insertion were specified, set them up.") - (TEDIT.CARETLOOKS STREAM LOOKS))) - (SETQ OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "The PRE-INSERT text length, for starting the screen update process") - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) + [LAMBDA (TSTREAM TEXT CH#ORSEL LOOKS DONTSCROLL) (* ; "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") - (* ;; "If this text is in a window, move it so the insertion point is on-screen, then turn off the selection highlight") + (* ;; "Insert TEXT (litatom or string) at the appropriate spot in the text.. No-op if given something else--should it error? ") - (COND - ((NOT DONTSCROLL) (* ; - "If DONTSCROLL is T, then don't bother scrolling the window to show the change.") - (TEDIT.NORMALIZECARET TEXTOBJ CH#ORSEL))) - (\SHOWSEL CH#ORSEL NIL NIL))) - (SETQ CH# (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of CH#ORSEL) - (LEFT (fetch (SELECTION CH#) of CH#ORSEL)) - (RIGHT (IMIN (fetch (SELECTION CHLIM) of CH#ORSEL) - (ADD1 (fetch (TEXTOBJ TEXTLEN) of - TEXTOBJ - )))) - NIL))) - (SETQ XPOINT (SELECTQ (fetch (SELECTION POINT) of CH#ORSEL) - (LEFT (fetch (SELECTION X0) of CH#ORSEL)) - (RIGHT (fetch (SELECTION XLIM) of CH#ORSEL)) - NIL)) - [COND - [(type? STRINGP TEXT) (* ; - "It's a string: Count the characters and Insert them one by one into the text stream") - (SETQ CHARS (NCHARS TEXT)) - (for ACHAR instring TEXT as NCH# from CH# by 1 - do (SELCHARQ ACHAR - ((CR %#^M 1,CR) - (SETQ CRSEEN T) - (\INSERTCR ACHAR NCH# TEXTOBJ)) - (SPACE (SETQ BLANKSEEN T) - (\INSERTCH ACHAR NCH# TEXTOBJ)) - (\INSERTCH ACHAR NCH# TEXTOBJ] - (T (* ; - "It's a singe character. Just insert it.") - (SETQ CHARS 1) - (SELCHARQ TEXT - ((CR %#^M 1,CR) - (SETQ CRSEEN T) - (\INSERTCR TEXT CH# TEXTOBJ)) - (SPACE (SETQ BLANKSEEN T) - (\INSERTCH TEXT CH# TEXTOBJ)) - (\INSERTCH TEXT CH# TEXTOBJ] - (\FIXILINES TEXTOBJ CH#ORSEL CH# CHARS OTEXTLEN) - (* ; - "Fix up the line descriptors and the Selection.") - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of (TEXTOBJ STREAM))) - (* ; "Update the edit window.") - (TEDIT.INSERT.UPDATESCREEN TEXT CH# CHARS XPOINT TEXTOBJ CH#ORSEL OTEXTLEN - BLANKSEEN CRSEEN DONTSCROLL] - ((NOT (fetch (TEXTOBJ TXTREADONLY) of (TEXTOBJ STREAM))) - (TEDIT.PROMPTPRINT (TEXTOBJ STREAM) - "Please select a place for the insertion." T]) + (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) + (* ; "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)))]) (TEDIT.KILL - [LAMBDA (STREAM) (* ; "Edited 12-Jun-90 17:49 by mitani") - (* Force the edit session supported - by STREAM to terminate, and to - return VALUE) - (COND - ((type? STREAM STREAM) (* If he gave us a textofd, get the - textobj) - (SETQ STREAM (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - [(WINDOWP STREAM) (* Take a window, and do the obvious - with it.) - (SETQ STREAM (WINDOWPROP STREAM 'TEXTOBJ] - ((type? TEXTOBJ STREAM) (* A Textobj is just fine) - ) - (T (* Anything else is ungood, - double-plus) - (\ILLEGAL.ARG STREAM))) - (replace (TEXTOBJ EDITFINISHEDFLG) of STREAM with T) - (PROG (TEDW TEDPROC) - (AND (SETQ TEDW (CAR (fetch (TEXTOBJ \WINDOW) of STREAM))) - [PROCESSP (SETQ TEDPROC (WINDOWPROP TEDW 'PROCESS] - (NEQ TEDPROC (THIS.PROCESS)) - (DEL.PROCESS TEDPROC) - (TEDIT.DEACTIVATE.WINDOW TEDW]) + [LAMBDA (TSTREAM) (* ; "Edited 20-Sep-2023 17:55 by rmk") + (* ; "Edited 12-Jun-90 17:49 by mitani") -(TEDIT.MAPLINES - [LAMBDA (TEXTOBJ FN) (* ; "Edited 29-May-91 18:19 by jds") + (* ;; "Force the edit session supported by TSTREAM to terminate") - (* Go thru the visible lines in a textobj and call a mapping fn on them) - - (* FN has 2 args%: the LINEDESCRIPTOR, and a VISIBLEFLG to say if the line is - visible on the screen.) - - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of (fetch (TEXTOBJ LINES) - of TEXTOBJ))) - (BOT _ (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - [TOP _ (fetch (REGION HEIGHT) of (DSPCLIPPINGREGION (\TEDIT.PRIMARYW TEXTOBJ] - while LINE do (COND - ((EQ (APPLY* FN LINE (AND (ILESSP (fetch (LINEDESCRIPTOR YBOT) - of LINE) - TOP) - (IGEQ (fetch (LINEDESCRIPTOR YBOT) - of LINE) - BOT))) - 'STOP) - (RETURN))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE]) - -(TEDIT.MAPPIECES - [LAMBDA (TEXTOBJ FN FNARG) (* ; "Edited 22-Apr-93 16:02 by jds") - - (* ;; "Go thru all the pieces in a document, applying a function to them serially") - - (* ;; "FN is a function of 3 args (PIECE CH#-of-1st-char-in-piece PIECE# in table FNARG)") - - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (CH# 1) - PCNODE PC) - (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) - (OR (ATOM PC) - (RETURN (for I from 1 while PC - do [COND - ((EQ (APPLY* FN CH# PC I FNARG) - 'STOP) - (RETURN (LIST CH# PC I] - (add CH# (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) - -(TEDIT.MOVE - [LAMBDA (FROM TO) (* ; "Edited 29-May-91 18:21 by jds") - - (* ;; - "Move the text described by the selection FROM to the place described by the selection TO") - - (SETQ TEDIT.MOVE.PENDING NIL) (* ; - "First, Turn off the global flag that got us here.") - (COND - ((NOT (AND FROM (fetch (SELECTION SET) of FROM))) - (* ; - "There MUST be a source selected first.") - (TEDIT.PROMPTPRINT (fetch (SELECTION \TEXTOBJ) of TO) - "Move source selection hasn't been set yet." T)) - ((ZEROP (fetch (SELECTION DCH) of FROM)) (* ; - "The source selection is empty. Just turn it off.") - (\SHOWSEL FROM NIL NIL)) - ((fetch (TEXTOBJ TXTREADONLY) of (fetch (SELECTION \TEXTOBJ) of TO)) - (* ; - "The target is read-only. Skip it..") - (\SHOWSEL FROM NIL NIL)) - (T (\SHOWSEL FROM NIL NIL) (* ; - "Before all else, make sure the copy source selection is turned off") - (COND - ((AND TO (fetch (SELECTION SET) of TO)) (* ; - "Can only do copy if there's a target selection") - (PROG ((TOOBJ (fetch (SELECTION \TEXTOBJ) of TO)) - (FROMOBJ (fetch (SELECTION \TEXTOBJ) of FROM)) - (TOLEN (fetch (TEXTOBJ TEXTLEN) of (fetch (SELECTION \TEXTOBJ) - of TO))) - (TOPCTB (fetch (TEXTOBJ PCTB) of (fetch (SELECTION \TEXTOBJ) - of TO))) - (FROMPCTB (fetch (TEXTOBJ PCTB) of (fetch (SELECTION \TEXTOBJ) - of FROM))) - (CROSSCOPY (NEQ (fetch (SELECTION \TEXTOBJ) of FROM) - (fetch (SELECTION \TEXTOBJ) of TO))) - LEN INSPC INSPC# PC NPC PCCH NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST OBJ - COPYFN UNDOCHAIN) (* ; "Find the insertion point") - (SETQ PCLST (TEDIT.SELECTED.PIECES FROMOBJ FROM CROSSCOPY (FUNCTION - \TEDIT.MOVE.PIECEMAPFN - ) - FROMOBJ TOOBJ)) (* ; - "Grab the pieces that reflect the source selection") - (SETQ REPLACING (TEDIT.DO.BLUEPENDINGDELETE TO TOOBJ)) - (* ; "Do any blue-pending-delete") - (SETQ TOPCTB (fetch (TEXTOBJ PCTB) of TOOBJ)) - (* ; - "Get the new PCTB and text length") - (SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TOOBJ)) - (SETQ LEN (IDIFFERENCE (fetch (SELECTION CHLIM) of FROM) - (fetch (SELECTION CH#) of FROM))) - (\DELETECH (fetch (SELECTION CH#) of FROM) - (fetch (SELECTION CHLIM) of FROM) - (fetch (SELECTION DCH) of FROM) - FROMOBJ) (* ; - "Now delete the text from its old place") - (\FIXDLINES (fetch (TEXTOBJ LINES) of FROMOBJ) - FROM - (fetch (SELECTION CH#) of FROM) - (fetch (SELECTION CHLIM) of FROM) - FROMOBJ) - (SETQ TOLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ)) - (\SHOWSEL TO NIL NIL) (* ; - "NOW turn off the target selection.") - (replace (SELECTION SET) of FROM with NIL) - [COND - ((EQ (fetch (SELECTION POINT) of TO) - 'LEFT) - (SETQ INSERTCH# (fetch (SELECTION CH#) of TO))) - (T (SETQ INSERTCH# (fetch (SELECTION CHLIM) of TO] - (* ; - "Figure out where to do the insertion.") - (\TEDIT.INSERT.PIECES TOOBJ INSERTCH# PCLST LEN NIL NIL CROSSCOPY) - (* ; - "Get the pieces that actually got inserted, so we can UNDO the move") - - (* ;; "Keep the target from sharing a piece with type-in by accident:") - - (replace (TEXTOBJ \INSERTPCVALID) of TOOBJ with NIL) - - (* ;; "Keep \DELETECH from playing clever games with the piece if it's new type-in: Don't let it be reclaimed by the deletion:") - - (replace (TEXTOBJ \INSERTPCVALID) of FROMOBJ with NIL) - (replace (TEXTOBJ \INSERTPC) of FROMOBJ with NIL) - (\TEDIT.HISTORYADD TOOBJ - (create TEDITHISTORYEVENT - THTEXTOBJ _ TOOBJ - THACTION _ (COND - (REPLACING 'ReplaceMove) - (T 'Move)) - THLEN _ LEN - THCH# _ INSERTCH# - THFIRSTPIECE _ PCLST - THAUXINFO _ FROMOBJ - THOLDINFO _ (fetch (SELECTION CH#) of FROM))) - (* ; - "Make a history-list entry for the COPY.") - (replace (TEXTOBJ \DIRTY) of TOOBJ with T) - (* ; "Mark the document changed") - (replace (TEXTOBJ TEXTLEN) of TOOBJ with (IPLUS LEN TOLEN)) - (* ; "Set the new length") - (\FIXILINES TOOBJ TO INSERTCH# LEN TOLEN)(* ; "Fix LINES and SELs") - (COND - ((EQ (fetch (TEXTOBJ FORMATTEDP) of TOOBJ) - (fetch (TEXTOBJ FORMATTEDP) of FROMOBJ)) - (* ; - "Either both of the files are formatted or neither is. This case is OK") - ) - ((fetch (TEXTOBJ FORMATTEDP) of TOOBJ) - (* ; - "The source wasn't formatted, but the target is. Go convert the copied text.") - (\TEDIT.CONVERT.TO.FORMATTED TOOBJ INSERTCH# (IPLUS INSERTCH# LEN))) - (T (* ; - "The source is formatted and the target isn't. Give the guy a choice.") - (* ; - "For now, convert the target file to formatted.") - (\TEDIT.CONVERT.TO.FORMATTED TOOBJ))) - (TEDIT.UPDATE.SCREEN FROMOBJ) - (TEDIT.UPDATE.SCREEN TOOBJ) (* ; "Refresh the display") - (replace (SELECTION CH#) of TO with INSERTCH#) - (* ; "Correct the target selection") - (replace (SELECTION CHLIM) of TO with (IPLUS INSERTCH# LEN)) - (replace (SELECTION DCH) of TO with LEN) - (replace (SELECTION DX) of TO with 0) - (replace (SELECTION POINT) of TO with 'RIGHT) - (COND - ((NEQ TO FROM) - (\FIXSEL FROM FROMOBJ) - (\FIXSEL (fetch (TEXTOBJ SEL) of FROMOBJ) - FROMOBJ))) - (\FIXSEL TO TOOBJ) - (\SHOWSEL TO NIL T))) - (T (* ; - "There is no target selection -- complain") - (TEDIT.PROMPTPRINT (fetch (SELECTION \TEXTOBJ) of FROM) - "Please select a destination for the MOVE first." T]) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + TEDW TEDPROC) + (FSETTOBJ TEXTOBJ EDITFINISHEDFLG T) + (CL:WHEN (AND (SETQ TEDW (CAR (FGETTOBJ TEXTOBJ \WINDOW))) + [PROCESSP (SETQ TEDPROC (WINDOWPROP TEDW 'PROCESS] + (NEQ TEDPROC (THIS.PROCESS))) + (DEL.PROCESS TEDPROC) + (TEDIT.DEACTIVATE.WINDOW TEDW))]) (TEDIT.QUIT - [LAMBDA (STREAM VALUE) (* ; "Edited 12-Jun-90 17:49 by mitani") + [LAMBDA (STREAM VALUE) (* ; "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 STREAM to terminate, and to return VALUE") - (COND - ((type? STREAM STREAM) (* ; - "If he gave us a textofd, get the textobj") - (SETQ STREAM (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - ((type? TEXTOBJ STREAM) (* ; "A Textobj is just fine") - ) - (T (* ; - "Anything else is ungood, double-plus") - (\ILLEGAL.ARG STREAM))) - (replace (TEXTOBJ EDITFINISHEDFLG) of STREAM with (OR VALUE T)) - (* ; - "tell the command loop to stop next time through") - (PROG (MAINW) - (COND - ([AND (fetch (TEXTOBJ \WINDOW) of STREAM) - (NEQ (SETQ MAINW (\TEDIT.PRIMARYW STREAM)) - (PROCESSPROP (TTY.PROCESS) - 'WINDOW] + (LET (MAINW (TEXTOBJ (TEXTOBJ STREAM))) + (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] - (* ;; "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 main window of the stream, and it is not the window of the tty process, so give it the tty") - (TTY.PROCESS (WINDOWPROP MAINW 'PROCESS)) - (AND (NEQ (TTY.PROCESS) - (THIS.PROCESS)) - (until [OR (NOT (WINDOWPROP MAINW 'PROCESS)) - (PROCESS.FINISHEDP (WINDOWPROP MAINW 'PROCESS] do - (* ; - "Wait until the Edit process has had a chance to go away before continuing here.") - (DISMISS]) + (TTY.PROCESS (WINDOWPROP MAINW 'PROCESS)) + (AND (NEQ (TTY.PROCESS) + (THIS.PROCESS)) + (until [OR (NOT (WINDOWPROP MAINW 'PROCESS)) + (PROCESS.FINISHEDP (WINDOWPROP MAINW 'PROCESS] do + (* ; + "Wait until the Edit process has had a chance to go away before continuing here.") + (DISMISS))))]) + +(TEDIT.DO.BLUEPENDINGDELETE + [LAMBDA (SEL TEXTOBJ) (* ; "Edited 24-Dec-2023 00:01 by rmk") + (* ; "Edited 8-Jul-2023 22:48 by rmk") + (* ; "Edited 4-May-2023 00:05 by rmk") + (* ; "Edited 22-Apr-2023 18:31 by rmk") + (* ; "Edited 29-May-91 18:21 by jds") + + (* ;; "Check for blue-pending-delete, and do it if it's there.") + + (* ;; "Return T if the deletion was made. For people who need to know") + + (CL:WHEN (GETTOBJ TEXTOBJ BLUEPENDINGDELETE) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "Make it a normal selection again.") + (\TEDIT.DELETE TEXTOBJ SEL T))]) + +(TEDIT.MOVE + [LAMBDA (FROM TO) (* ; "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") + + (* ;; "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 (\TEDIT.MOVE.MSG FROM TO NIL) + (PROG ((TOBJ (GETSEL TO SELTEXTOBJ)) + (FOBJ (GETSEL FROM SELTEXTOBJ)) + FROMPIECES) + (\SHOWSEL FROM NIL) (* ; "Turn off any current highlighting") + (\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 (\SELPIECES.COPY (\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) + (\FIXSEL TO TOBJ) + (\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))))]) (TEDIT.STRINGWIDTH [LAMBDA (STR FONT TERMSA) (* jds "19-AUG-83 14:40") @@ -955,998 +789,1117 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (TAB 36) (CHARWIDTH CH FONT]) -(TEDIT.\INSERT - [LAMBDA (CH SEL STREAM) (* ; "Edited 29-May-91 18:22 by jds") - (* Insert the character CH at the - appropriate spot in the text.) - (DECLARE (LOCALVARS . T)) - (PROG [(TEXTOBJ (COND - ((type? STREAM STREAM) (* If we got a STREAM, change it - into a textobj) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (T STREAM] - (COND - ((NOT (AND SEL (fetch (SELECTION SET) of SEL))) - (TEDIT.PROMPTPRINT TEXTOBJ "Please select a place for the insertion." T) - (RETURN))) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - - (* There is a window; make sure the insert point is on-screen, and turn off any - highlighted selection) - - (TEDIT.NORMALIZECARET TEXTOBJ SEL) - (\SHOWSEL SEL NIL NIL))) - (PROG ((CH# (TEDIT.GETPOINT STREAM SEL)) - (XPOINT (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION X0) of SEL)) - (RIGHT (fetch (SELECTION XLIM) of SEL)) - NIL)) - (OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (SELCHARQ CH - ((CR %#^M 1,CR) (* This was a CR. Go do the para - breaking as needed) - (\INSERTCR CH CH# TEXTOBJ)) - (\INSERTCH CH CH# TEXTOBJ)) - (\FIXILINES TEXTOBJ SEL CH# 1 OTEXTLEN) - (TEDIT.INSERT.UPDATESCREEN CH CH# 1 XPOINT TEXTOBJ SEL OTEXTLEN NIL NIL NIL T]) - (TEXTOBJ - [LAMBDA (STREAM) (* jds "11-Jul-85 12:06") - (* Convert from a text stream to the - associated textobj) - (COND - ((type? TEXTOBJ STREAM) (* It's already a TEXTOBJ) - STREAM) - ((AND (type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM) - (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (* It's a TEXTSTREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - ((AND (PROCESSP STREAM) - (PROCESS.WINDOW STREAM)) (* It's an edit PROCESS) - (WINDOWPROP (PROCESS.WINDOW STREAM) - 'TEXTOBJ)) - [(AND (WINDOWP STREAM) - (WINDOWPROP STREAM 'TEXTOBJ] - [(AND (DISPLAYSTREAMP STREAM) - (WINDOWPROP STREAM 'TEXTOBJ] - ((\ILLEGAL.ARG STREAM]) + [LAMBDA (STREAM NOERROR) (* ; "Edited 7-Mar-2024 08:14 by rmk") + (* ; "Edited 16-Jun-2023 08:21 by rmk") + (* ; "Edited 6-Jun-2023 15:23 by rmk") + (* ; "Edited 10-Apr-2023 09:32 by rmk") + (* ; "Edited 5-Apr-2023 15:12 by rmk") + (* ; "Edited 24-Mar-2023 18:01 by rmk") + (* jds "11-Jul-85 12:06") + + (* ;; "Convert from any designator of a textobj to that textobj") + + (LET (TOBJ) + (if (type? TEXTOBJ STREAM) + then STREAM + else (SETQ TOBJ (if [AND (type? STREAM STREAM) + (type? TEXTOBJ (SETQ TOBJ (fetch (TEXTSTREAM TEXTOBJ) + of STREAM] + then + (* ;; + "Text stream - test TEXTOBJ to distinguish displaystream case below.") + + TOBJ + else (WINDOWP STREAM) + then (WINDOWPROP STREAM 'TEXTOBJ) + elseif (AND (PROCESSP STREAM) + (PROCESS.WINDOW STREAM)) + then (* ; "It's an edit PROCESS") + (WINDOWPROP (PROCESS.WINDOW STREAM) + 'TEXTOBJ) + elseif (DISPLAYSTREAMP STREAM) + then (WINDOWPROP TOBJ 'TEXTOBJ) + elseif (type? SELECTION STREAM) + then (GETSEL STREAM SELTEXTOBJ))) + (if (type? TEXTOBJ TOBJ) + then TOBJ + elseif (NOT NOERROR) + then (ERROR STREAM "is not a Tedit document"]) + +(TEDITMENUP + [LAMBDA (WINDOW TITLE) (* ; "Edited 7-Dec-2023 21:06 by rmk") + (* ; "Edited 20-Sep-2023 22:36 by rmk") + (* ; "Edited 10-Apr-2023 10:14 by rmk") + (CL:WHEN (AND (WINDOWP WINDOW) + (WINDOWPROP WINDOW 'TEDITMENU) + (WINDOWPROP WINDOW 'TEXTOBJ) + (CL:IF TITLE + (STRING.EQUAL TITLE (WINDOWPROP WINDOW 'TITLE)) + T)) + (WINDOWPROP WINDOW 'TITLE))]) (TEXTSTREAM - [LAMBDA (STREAM) (* ; "Edited 12-Jun-90 17:50 by mitani") - (* Force a textobj or stream to be a - stream) - (COND - ((AND (type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM) - (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (* It's a stream, and is really a - TEXT stream. Just return it.) - STREAM) - ((type? TEXTOBJ STREAM) (* It's a TEXTOBJ, so grab the - stream hint field and return that.) - (fetch (TEXTOBJ STREAMHINT) of STREAM)) - ((AND (PROCESSP STREAM) - (PROCESS.WINDOW STREAM)) (* It's an edit process, so grab the - text stream from the edit window.) - (WINDOWPROP (PROCESS.WINDOW STREAM) - 'TEXTSTREAM)) - [(AND (WINDOWP STREAM) - (WINDOWPROP STREAM 'TEXTSTREAM] - [(AND (DISPLAYSTREAMP STREAM) - (WINDOWPROP STREAM 'TEXTSTREAM] - ((\ILLEGAL.ARG STREAM) (* Not a reasonable coercion to the - text stream. Punt.) - ]) + [LAMBDA (STREAM NOERROR) (* ; "Edited 7-Mar-2024 08:11 by rmk") + (* ; "Edited 21-Aug-2022 08:14 by rmk") + (* ; "Edited 12-Jun-90 17:50 by mitani") + (* ; + "Force a textobj or stream to be a stream") + (LET ((TOBJ (TEXTOBJ STREAM NOERROR))) + (CL:WHEN TOBJ (GETTOBJ TOBJ STREAMHINT]) +) +(DEFINEQ -(\TEDIT.INCLUDE - [LAMBDA (TEXTOBJ FILE START END) (* ; "Edited 29-May-91 18:22 by jds") +(\TEDIT.MOVE.MSG + [LAMBDA (FROM TO COPYFLG) (* ; "Edited 1-Feb-2024 23:33 by rmk") + (* ; "Edited 22-May-2023 09:35 by rmk") + (* ; "Edited 20-May-2023 18:53 by rmk") + (* ; "Edited 15-May-2023 22:11 by rmk") + (* ; "Edited 4-Jun-92 11:11 by jds") - (* A NATIVE text includer%: Includes part of a file, without checking to see if - it's a bravo file, a TEdit file or whatever.) - (* (PROG ((LEN (IDIFFERENCE - (OR END (GETEOFPTR FILE)) - (OR START 0))) (SEL - (fetch (TEXTOBJ SEL) of TEXTOBJ)) - NPC) (SETQ NPC (create PIECE PFILE _ - (\GETOFD FILE (QUOTE INPUT)) PFPOS _ - (OR START 0) PLEN _ LEN PLOOKS _ - (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ - SEL) PPARALOOKS _ NIL)) - (* Create a PIECE to describe the - text) (\TEDIT.INSERT.PIECES TEXTOBJ - (fetch (SELECTION CH#) of SEL) NPC - LEN) (* Insert it in the document) - (add (fetch (TEXTOBJ TEXTLEN) of - TEXTOBJ) LEN) (* And update the - document's length) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ - (fetch (SELECTION CH#) of SEL) - (IPLUS (fetch (SELECTION CH#) of SEL) - LEN)) (* Mark the screen dirty, so updating it will find something to do) (replace - (SELECTION CHLIM) of SEL with - (IPLUS (fetch (SELECTION CH#) of SEL) - LEN)) (replace (SELECTION DCH) of SEL with LEN) (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL - with (QUOTE RIGHT)) - (replace (SELECTION SELKIND) of SEL - with (QUOTE CHAR)) - (replace (SELECTION SELOBJ) of SEL - with NIL) (COND ((fetch - (TEXTOBJ \WINDOW) of TEXTOBJ) - (\SHOWSEL SEL NIL NIL) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (* Update the screen) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ - with T) (\SETUPGETCH - (fetch (SELECTION CH#) of SEL) - TEXTOBJ))) - (HELP]) + (* ;; "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.") -(\TEDIT.INSERT.PIECES - [LAMBDA (TEXTOBJ CH# FIRSTPIECE %#CHARS INSPC INSPC# CROSSCOPY DONTDIRTY COPYING) - (* ; "Edited 11-Jun-99 14:03 by rmk:") - (* ; - "Edited 24-Apr-95 12:04 by sybalsky:mv:envos") + (LET ((FOBJ (AND FROM (GETSEL FROM SET) + (GETSEL FROM SELTEXTOBJ))) + (TOBJ (AND TO (GETSEL TO SET) + (GETSEL TO SELTEXTOBJ))) + (TYPE (CL:IF COPYFLG + "copy" + "move"))) + (if (AND FOBJ TOBJ) + then (if (EQ FOBJ TOBJ) + then (\TEDIT.READONLY TOBJ) + elseif (\TEDIT.READONLY TOBJ "Destination") + else (AND (NOT COPYFLG) + (\TEDIT.READONLY FOBJ "Source"))) + else (if FOBJ + then (TEDIT.PROMPTPRINT TOBJ (CONCAT "Please select a destination for the " TYPE) + T T) + else (TEDIT.PROMPTPRINT FOBJ (CONCAT "Please select a source for the " TYPE) + T T)) + T]) - (* ;; "Inserts a series of pieces into TEXTOBJ in front of character CH#.") +(\TEDIT.READONLY + [LAMBDA (TEXTOBJ TYPE) (* ; "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)]) +) +(DEFINEQ - (* ;; "If FIRSTPIECE is a PIECE, this will follow the next-piece pointer chain; if FIRSTPIECE is a list, it is a list of pieces to insert.") +(TEDIT.NCHARS + [LAMBDA (TSTREAM) (* ; "Edited 1-Feb-2024 09:11 by rmk") + (* ; "Edited 7-Nov-2023 09:42 by rmk") + (CL:IF (type? SELECTION TSTREAM) + (FGETSEL TSTREAM DCH) + (FGETTOBJ (TEXTOBJ TSTREAM) + TEXTLEN))]) - (* ;; "If CROSSCOPY is non-NIL, the pieces' contents will be copied, to preserve text in case the original is deleted.") +(TEDIT.RPLCHARCODE + [LAMBDA (TSTREAM N NEWCHARCODE NEWCHARLOOKS) (* ; "Edited 29-Dec-2023 11:50 by rmk") + (* ; "Edited 7-Dec-2023 16:01 by rmk") + (* ; "Edited 1-Dec-2023 21:52 by rmk") + (* ; "Edited 9-Nov-2023 15:53 by rmk") + (* ; "Edited 4-Nov-2023 15:23 by rmk") - (* ;; "INSPC and INSPC# are accelerators for where in the PCTB the new pieces should go.") + (* ;; "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.") - (* ;; "DONTDIRTY is T if this is a change not visible to the user--one that shouldn't %"dirty%" the document. This is used tor NS-character encoding recognition durint line formatting.") + (* ;; "NOTE: this may introduce new pieces, so must be used carefully with other piece-based or BIN-based iterations.") - (* ;; "COPYING is T if these pieces are being inserted by a COPY operation. This lets us call the AFTERCOPYFN on image objects.") + (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)) - (* ;; "It is the CALLER'S RESPONSIBILITY to make sure the pieces to be inserted are 'safe' --that they are, if necessary, copies of the originals, and can safely be modified.") - (* ; - "NB THAT THIS DOES NOT UPDATE TEXTLEN") - (COND - ((OR DONTDIRTY (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) + (* ;; "Chop off the suffix. Unless N was last in PC, the piece containing is new.") - (* ;; "Only do this if you're allowed to change the document, or it's a TEdit-intertnal fixup change, as for NS char recognition.") + (\ALIGNEDPIECE (ADD1 N) + TEXTOBJ) + (SETQ PC (\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]) - (LET ((TOLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (TOPCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (CURCH# CH#) - LEN PC PREVPC NPC UNDOCHAIN PSTR SRCPFILE START-OF-PIECE) - (* ; - "Get a handle on the piece we're to insert within or in front of") +(TEDIT.NTHCHARCODE + [LAMBDA (TSTREAM N) (* ; "Edited 1-Feb-2024 09:50 by rmk") + (* ; "Edited 8-Nov-2023 08:41 by rmk") + (* ; "Edited 4-Nov-2023 15:23 by rmk") - (* THIS USED TO WORK, BUT WITH NEW PCTREE CODE, IT CAUSES AN EMPTY PIECE AT - START OF DOC THAT'S NOT FORWARD-CONNECTED. - COND ((ZEROP (fetch (BTREENODE TOTLEN) of TOPCTB)) - (* ; "PCTB is empty.") (\INSERT.FIRST.PIECE TEXTOBJ))) + (* ;; "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.") - (SETQ INSPC (\CHTOPC CH# TOPCTB T)) (* ; "And the piece, itself. (Used to be (OR INSPC (\CH...)), but we MUST set START-OF-PIECE, so must make the call to \CHTOPC.") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Force later insertions to make new pieces.") - [COND - ((IGREATERP CH# TOLEN) (* ; - "We're inserting at end of file; leave the piece to insert before as LASTPIECE") - ) - ((IEQP CH# START-OF-PIECE) (* ; - "The insertion is IN FRONT of this piece; just continue on") - ) - (T (SETQ INSPC (\SPLITPIECE INSPC (- CH# START-OF-PIECE) - TEXTOBJ] (* ; - "Nope, we're inserting INSIDE this piece. Split it in two.") + (LET (TEXTOBJ START-OF-PIECE) + (DECLARE (SPECVARS START-OF-PIECE)) + [if (type? SELECTION TSTREAM) + then (SETQ TEXTOBJ (TEXTOBJ (FGETSEL TSTREAM SELTEXTOBJ))) + (CL:UNLESS (EQ N 0) + [add N (CL:IF (ILESSP N 0) + (FGETSEL TSTREAM CHLIM) + (SUB1 (FGETSEL TSTREAM CH#)))] + (CL:WHEN (OR (ILESSP N (FGETSEL TSTREAM CH#)) + (IGEQ N (FGETSEL TSTREAM CHLIM))) + + (* ;; "Out of the selection: force NIL") + + (SETQ N 0))) + else (SETQ TEXTOBJ (TEXTOBJ TSTREAM)) + (CL:WHEN (ILESSP N 0) + (SETQ N (IPLUS (FGETTOBJ TEXTOBJ TEXTLEN) + N 1)))] + (CL:WHEN (AND (IGEQ N 1) + (ILEQ N (FGETTOBJ TEXTOBJ TEXTLEN))) + (\TEDIT.PIECE.NTHCHARCODE TEXTOBJ (\CHTOPC N TEXTOBJ T) + (IDIFFERENCE (ADD1 N) + START-OF-PIECE)))]) + +(\TEDIT.PIECE.NTHCHARCODE + [LAMBDA (TEXTOBJ PC OFFSET) (* ; "Edited 1-Feb-2024 09:55 by rmk") + (* ; "Edited 6-Jan-2024 16:36 by rmk") + (* ; "Edited 29-Dec-2023 11:55 by rmk") + (* ; "Edited 8-Dec-2023 22:54 by rmk") + (* ; "Edited 7-Dec-2023 15:57 by rmk") + (* ; "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. ") + + (CL:WHEN (AND (IGEQ OFFSET 1) + (ILEQ OFFSET (PLEN PC))) + [LET ((PCONTENTS (PCONTENTS PC))) + (SELECTC (PTYPE PC) + (STRING.PTYPES (NTHCHARCODE PCONTENTS OFFSET)) + (THINFILE.PTYPE + (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) + (SUB1 OFFSET))) + (BIN PCONTENTS)) + (FATFILE1.PTYPE + (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) + (SUB1 OFFSET))) + (LOGOR (LLSH (PCHARSET PC) + 8) + (BIN PCONTENTS))) + (FATFILE2.PTYPE + (\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) + (UNFOLD (SUB1 OFFSET) + 2))) + (\WIN PCONTENTS)) + (UTF8.PTYPE [\SETFILEPTR PCONTENTS (IPLUS (PFPOS PC) + (ITIMES (SUB1 OFFSET) + (PBYTESPERCHAR PC] + (UTF8.INCCODEFN PCONTENTS)) + (OBJECT.PTYPE PCONTENTS) + (SUBSTREAM.PTYPE (* ; "A substream stored as an object") + (HELP '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])]) +) + + + +(* ;; "Slashed functions. Private?") + +(DEFINEQ + +(\TEDIT1 + [LAMBDA (TSTREAM WINDOW UNSPAWNED) (* ; "Edited 22-Sep-2023 20:23 by rmk") + (* ; "Edited 13-Sep-2023 22:37 by rmk") + (* ; "Edited 12-Jun-90 17:51 by mitani") + + (* ;; "Does the actual editing work, once TEDIT has OPENTEXTSTREAMed the thing to be edited.") + + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))) + (\TEDIT.COMMAND.LOOP TEXTOBJ) (* ; "Run the editing engine") + (CLOSEW WINDOW) (* ; "Close the edit window") + (\TEXTCLOSEF TSTREAM) (* ; "Close the underlying files") + (replace (STREAM ACCESSBITS) of TSTREAM with BothBits) + (* ; + "But leave the stream itself accessible") + (CL:WHEN (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) (* ; + "Apply any post-window-close (and post-QUIT) function") + (APPLY* (GETTEXTPROP TEXTOBJ 'AFTERQUITFN) + WINDOW TSTREAM)) + (CL:WHEN UNSPAWNED (* ; + "We're not a distinct process: Send back the edited text in some suitable form") (COND - ((NEQ INSPC 'LASTPIECE) (* ; - "Not the last piece, so back up using the pointer.") - (SETQ PREVPC (fetch (PIECE PREVPIECE) of INSPC))) - ((NOT (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "If we are at the end, AND there is text before us, find it thru the pctb.") - (SETQ PREVPC (\CHTOPC (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - TOPCTB))) - (T (* ; - "Otherwise, there is no piece before where we're inserting.") - (SETQ PREVPC NIL))) (* ; "For pushing para looks in") - (bind [PC _ (create PIECE using (COND - ((LISTP FIRSTPIECE) - (pop FIRSTPIECE)) - (T FIRSTPIECE] - (LEN _ 0) - (PCCOUNT _ 0) first (SETQ UNDOCHAIN PC) - while (AND PC (OR (NOT %#CHARS) - (ILESSP LEN %#CHARS))) - do (* ; - "Now insert the copied pieces into the new place") - (COND - ((AND CROSSCOPY (SETQ SRCPFILE (fetch (PIECE PFILE) of PC))) + ((NEQ T (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)) + (PROG1 (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) + (FSETTOBJ TEXTOBJ EDITFINISHEDFLG NIL))) + ((STRINGP (FGETTOBJ TEXTOBJ TXTFILE)) + (COERCETEXTOBJ TEXTOBJ 'STRINGP)) + (T TSTREAM)))]) - (* ;; "If this is a cross-document copy, and the text comes from a file, we must REALLY make a copy of the text, lest the source file be deleted.") +(\TEDIT.INSERT + [LAMBDA (INSERT SEL TEXTOBJ DONTSCROLL) (* ; "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") - (* ;; -"(replace PSTR of PC with (SETQ PSTR (ALLOCSTRING (fetch PLEN of PC) NIL NIL (fetch PFATP of PC))))") + (* ;; "The selection runs from CH# to CHLIM-1. The insertion is before the selection if POINT=LEFT or after the selection (POINT=RIGHT). This translates to before CH# or before CHLIM respectively. ") - (replace (PIECE PFILE) of PC with (OPENSTREAM '{NODIRCORE} - 'BOTH - 'NEW)) - (* ; "Create the holding file") - [COND - ((NOT (OPENP SRCPFILE)) (* ; - "The source file was CLOSED -- reopen it, for our us") - (replace (PIECE PFILE) of PC - with (SETQ SRCPFILE (OPENSTREAM SRCPFILE 'INPUT 'OLD - '((TYPE TEXT] - (SETFILEPTR SRCPFILE (fetch (PIECE PFPOS) of PC)) - [COPYCHARS SRCPFILE (fetch (PIECE PFILE) of PC) - (fetch (PIECE PFPOS) of PC) - (IPLUS (fetch (PIECE PFPOS) of PC) - (COND - ((fetch (PIECE PFATP) of PC) - (LLSH (fetch (PIECE PLEN) of PC) - 1)) - (T (fetch (PIECE PLEN) of PC] - (replace (PIECE PFPOS) of PC with 0))) - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) - of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE - PPARALOOKS - ) - of PC) - TEXTOBJ)) - (* ; - "Assure that the new document knows about this piece's looks") - [COND - ((NULL FIRSTPIECE) - (SETQ NPC NIL)) - [(LISTP FIRSTPIECE) (* ; - "If the piece list really IS a list, grab the next piece from the front") - (SETQ NPC (create PIECE using (pop FIRSTPIECE] - (T (* ; - "Otherwise, follow the NEXTPIECE chain among pieces") - (SETQ NPC (create PIECE using (fetch (PIECE NEXTPIECE) - of PC] - (\INSERTPIECE PC INSPC TEXTOBJ NIL) (* ; - "Insert the piece into the new document") - [COND - (COPYING + (* ;; "Inserts INSERT at the location picked out by the selection, and then implements all the consequences for line and screen updates. Assumes that the caller got the selection and the text set up properly.") - (* ;; "For objects, call the optional AFTERCOPYFN.") + (* ;; "") - (LET (OBJ AFTERFN) - (AND (SETQ OBJ (ffetch (PIECE POBJ) of PC)) - (SETQ AFTERFN (IMAGEOBJPROP OBJ 'AFTERCOPYFN)) - (APPLY* AFTERFN OBJ PC CURCH#] - (add CURCH# (fetch (PIECE PLEN) of PC)) - (add LEN (fetch (PIECE PLEN) of PC)) - (SETQ PC NPC)) - (\TEDIT.DIFFUSE.PARALOOKS PREVPC INSPC) - UNDOCHAIN]) + (* ;; "Text can be a string or a single charcode (only on the call from \TEDIT.COMMAND.LOOP). ") -(\TEDIT.MOVE.PIECEMAPFN - [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* ; "Edited 12-Jun-90 17:50 by mitani") - (* Called by TEDIT.MOVE via - TEDIT.SELECTED.PIECES, to do the - move-operation processing on the - candidate pieces.) - (PROG (OBJ MOVEFN) - (SETQ PC (create PIECE using PC PNEW _ T)) (* No matter what, we need a fresh - copy.) - [COND - [(fetch (PIECE POBJ) of PC) (* This piece describes an object) - (* Call its WHENMOVEDFN.) - (SETQ OBJ (fetch (PIECE POBJ) of PC)) - (COND - ((SETQ MOVEFN (IMAGEOBJPROP OBJ 'WHENMOVEDFN)) - (* If there's an eventfn for moving, - use it.) - (APPLY* MOVEFN OBJ (CAR (fetch (TEXTOBJ \WINDOW) of TOOBJ)) - (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOOBJ] - ((fetch (PIECE PSTR) of PC) + (* ;; + "TEDIT.INSERT passes DONTSCROLL and asserts NOTINCREMENTAL, other calls do incremental scrolling.") - (* If the piece is a string, make our own copy of the string header, even tho - we share characters.) + (* ;; "SELECTION-SET test may be unnecessary here, TEDIT.INSERT already checks, not sure about the 2 other calls.") - (replace (PIECE PSTR) of PC with (SUBSTRING (fetch (PIECE PSTR) - of PC) - 1 - (fetch (PIECE PLEN) - of PC] - (RETURN PC]) + (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) (* ; "Make it a normal selection again.") + (\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)) + (\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.") + + (* ;; "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.") + + [\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.") + + (if [thereis CH instring INSERT + suchthat (FMEMB CH (CHARCODE (EOL CR LF] + then [for CH instring INSERT as NCH# from CHNO + do (\INSERTCH CH NCH# TEXTOBJ (FMEMB CH + (CHARCODE (EOL CR LF] + else (\INSERTCH INSERT CHNO TEXTOBJ)) + (SETQ NCHARSADDED (NCHARS INSERT))) + (FSETTOBJ TEXTOBJ \DIRTY T) + + (* ;; "") + + (* ;; "The model (piece table) is now correct: NCHARSADDED new characters have been been added in front of CHNO. ") + + (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION CHNO NCHARSADDED (AND NIL DONTSCROLL)) + + (* ;; " 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.") + + (\TEDIT.UPDATE.SEL SEL (SUB1 (IPLUS CHNO NCHARSADDED)) + 0 + 'RIGHT) + (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) + (CL:UNLESS DONTSCROLL (TEDIT.NORMALIZECARET TEXTOBJ SEL)) + (\SHOWSEL SEL T) + (for PANE in PANES do (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE])]) + +(\TEDIT.REPLACE.SELPIECES + [LAMBDA (SELPIECES TEXTOBJ SEL DONTDISPLAY) (* ; "Edited 17-Feb-2024 16:34 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).") + + (LET ((POINT (GETSEL SEL POINT)) + DELEVENT) (* ; "Keep the SEL point in case ") + (\SHOWSEL SEL NIL) + (CL:WHEN (\TEDIT.DELETE TEXTOBJ SEL T) + (SETQ DELEVENT (\TEDIT.LASTEVENT TEXTOBJ)) + (\TEDIT.INSERT.SELPIECES SELPIECES TEXTOBJ SEL DONTDISPLAY) + + (* ;; "SELPIECES is now in the TEXTOBJ; we don't want the insert event") + + (\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) + + (* ;; "Make sure SEL is off to guarantee turning on") + + (\SHOWSEL SEL NIL)) + (\SHOWSEL SEL T]) + +(\TEDIT.INSERT.SELPIECES + [LAMBDA (SELPIECES TEXTOBJ TARGETSEL DONTDISPLAY) (* ; "Edited 15-Feb-2024 23:58 by rmk") + (* ; "Edited 13-Feb-2024 09:01 by rmk") + (* ; "Edited 11-Feb-2024 11:42 by rmk") + (* ; "Edited 29-Aug-2023 10:35 by rmk") + (* ; "Edited 12-Aug-2023 11:57 by rmk") + (* ; "Edited 17-Jun-2023 17:08 by rmk") + (* ; "Edited 2-Jun-2023 12:02 by rmk") + (* ; "Edited 31-May-2023 09:56 by rmk") + (* ; "Edited 21-May-2023 23:57 by rmk") + + (* ;; + "Insert SELPIECES into TEXTOBJ at TARGETSEL's caret. TARGETSEL can be a character position.") + + (* ;; + "\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)) + (SPLEN (fetch (SELPIECES SPLEN) of SELPIECES)) + (SPFIRST (fetch (SELPIECES SPFIRST) of SELPIECES)) + NEXTPC) + (SETQ NEXTPC (\ALIGNEDPIECE INSCH# TEXTOBJ)) + (\INSERTPIECES SPFIRST NEXTPC TEXTOBJ) + (\TEDIT.DIFFUSE.PARALOOKS (PREVPIECE SPFIRST) + NEXTPC) + (\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION INSCH# SPLEN DONTDISPLAY) + + (* ;; "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 ON SELWINDOW) (* ; "Edited 12-Jun-90 17:50 by mitani") + [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 selected object. Let it know.") + (* ;; "We are hilighting (or dehilighting) a selection containing only a single image object if it appears in PANE ") - (LET ((X (fetch (SELECTION X0) of SEL)) - (Y (fetch (SELECTION Y0) of SEL)) - (FIRSTLINE (CAR (fetch (SELECTION L1) of SEL))) - (OBJ (fetch (SELECTION SELOBJ) of SEL)) - (WIDTH (fetch (SELECTION DX) of SEL)) - (XOFFSET (DSPXOFFSET NIL SELWINDOW)) - (YOFFSET (DSPYOFFSET NIL SELWINDOW)) - (IMAGEFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of SEL) - 'WHENOPERATEDONFN)) - (WWIDTH (WINDOWPROP SELWINDOW 'WIDTH)) - (WHEIGHT (WINDOWPROP SELWINDOW 'HEIGHT)) - IMAGEBOX) - (COND - ((INSIDE? (CREATEREGION 0 0 WWIDTH WHEIGHT) - X Y) (* ; - "Only do this if teh selection is on-screen.") - (SETQ IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (APPLY* (IMAGEOBJPROP OBJ 'IMAGEBOXFN) - OBJ SELWINDOW))) - [COND - (FIRSTLINE + (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)) - (* ;; "There's really a line this selection is being displayed on, so we need to use the YBASE of the line- the object's descent, rather than the YBOT, which is what Y0 is.") + (* ;; "The selection is in the pane and has an image function") - (SETQ Y (- (fetch (LINEDESCRIPTOR YBASE) of FIRSTLINE) - (fetch (IMAGEBOX YDESC) of IMAGEBOX] - (RESETLST - [RESETSAVE (DSPXOFFSET (IDIFFERENCE (IPLUS X XOFFSET) - (fetch XKERN of IMAGEBOX)) - SELWINDOW) - (LIST (FUNCTION DSPXOFFSET) - XOFFSET - (WINDOWPROP SELWINDOW 'DSP] - (RESETSAVE (DSPYOFFSET (IPLUS Y YOFFSET) - SELWINDOW) - (LIST (FUNCTION DSPYOFFSET) - YOFFSET SELWINDOW)) - (RESETSAVE (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ (IMIN WIDTH (IDIFFERENCE - (fetch (TEXTOBJ - WRIGHT) - of TEXTOBJ) - X)) - HEIGHT _ (fetch YSIZE of IMAGEBOX)) - SELWINDOW) - (LIST (FUNCTION DSPCLIPPINGREGION) - (DSPCLIPPINGREGION NIL SELWINDOW) - SELWINDOW)) - [AND IMAGEFN (ERSETQ (APPLY* IMAGEFN OBJ SELWINDOW (COND - (ON 'HIGHLIGHTED) - (T 'UNHIGHLIGHTED)) - SEL - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])]) + (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.RESTARTFN - [LAMBDA (TEXT WINDOW PROPS) (* ; "Edited 12-Jun-90 17:51 by mitani") - (* Restarts a TEdit session.) - (replace (TEXTOBJ \WINDOW) of (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - with NIL) (* Unattach the window, so we do a - redisplay.) - (PROG [(ODIRTY (fetch (TEXTOBJ \DIRTY) of (fetch (TEXTSTREAM TEXTOBJ) - of TEXT] - (SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL PROPS)) - (replace (TEXTOBJ \DIRTY) of (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - with ODIRTY)) (* Now reconnect the world together - again) + [LAMBDA (TEXT WINDOW PROPS) (* ; "Edited 22-Sep-2023 20:31 by rmk") + (* ; "Edited 21-Aug-2022 08:13 by rmk") + (* ; "Edited 12-Jun-90 17:51 by mitani") + (* ; "Restarts a TEdit session.") + (replace (TEXTOBJ \WINDOW) of (fetch (TEXTSTREAM TEXTOBJ) of TEXT) with NIL) + (* ; + "Unattach the window, so we do a redisplay.") + (LET [(ODIRTY (fetch (TEXTOBJ \DIRTY) of (fetch (TEXTSTREAM TEXTOBJ) of TEXT] + (SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL PROPS)) + (SETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT) + \DIRTY ODIRTY)) (* ; + "Now reconnect the world together again") (\TEDIT.COMMAND.LOOP (fetch (TEXTSTREAM TEXTOBJ) of TEXT)) - (* Run the editing engine) - (CLOSEW WINDOW) (* Close the edit window) - (\TEXTCLOSEF TEXT) (* Close the underlying files) - (replace (STREAM ACCESSBITS) of TEXT with BothBits) - (* But leave the stream itself - accessible) - (AND (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - (APPLY* (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - WINDOW TEXT)) (* Apply any post-window-close - (and post-QUIT) function) - ]) + (* ; "Run the editing engine") + (CLOSEW WINDOW) (* ; "Close the edit window") + (\TEXTCLOSEF TEXT) (* ; "Close the underlying files") + (replace (STREAM ACCESSBITS) of TEXT with BothBits) (* ; + "But leave the stream itself accessible") + (* ; + "Apply any post-window-close (and post-QUIT) function") + (CL:WHEN (GETTEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) + 'AFTERQUITFN) + (APPLY* (GETTEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) + 'AFTERQUITFN) + WINDOW TEXT))]) (\TEDIT.CHARDELETE - [LAMBDA (TEXTOBJ SCRATCHSTRING SEL) (* ; "Edited 19-Apr-93 10:50 by jds") + [LAMBDA (TEXTOBJ SEL) (* ; "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") - (* ;; "Do character-backspace deletion for TEDIT") + (* ;; "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.") (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - TLEN INSCH# INSPC INSPC# TLOOKS START-OF-PIECE) - (COND - [NIL [NOT (ZEROP (SETQ TLEN (fetch (STRINGP OFFST) of SCRATCHSTRING] - (* ; - "If we didn't really insert the text yet, just remove from the text to be inserted") - (replace (STRINGP OFFST) of SCRATCHSTRING with (SUB1 TLEN)) - (replace (STRINGP LENGTH) of SCRATCHSTRING - with (ADD1 (fetch (STRINGP LENGTH) of SCRATCHSTRING] - (T (* ; - "Delete the character just before the current insertpoint.") - (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (SETQ INSCH# (SUB1 (fetch (SELECTION CH#) of SEL)))) - (RIGHT (SETQ INSCH# (SUB1 (fetch (SELECTION CHLIM) of SEL)))) - NIL) - (COND - ((ILEQ INSCH# 0) (* ; - "Can't backspace past start of document") - (RETURN))) + (PROG [FIRSTPIECE (CH# (SUB1 (TEDIT.GETPOINT TEXTOBJ SEL] + (CL:WHEN (ILEQ CH# 0) (* ; + "Can't backspace past start of document") + (RETURN)) - (* ;; "(SETQ INSPC (\EDITELT PCTB (ADD1 (SETQ INSPC# (\CHTOPCNO INSCH# PCTB)))))") + (* ;; "Back up to the first visible character--that's the target, unless it is protected") - (SETQ INSPC (\CHTOPC INSCH# PCTB T)) - (SETQ TLOOKS (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) of INSPC) - INSPC TEXTOBJ)) - [while (AND INSPC (fetch CLINVISIBLE of TLOOKS)) - do (* ; - "Back over any invisible text, which we're no allowed to delete.") - (SETQ INSPC (fetch (PIECE PREVPIECE) of INSPC)) - (SETQ INSCH# (SUB1 START-OF-PIECE)) - (add START-OF-PIECE (IMINUS (fetch (PIECE PLEN) of INSPC))) - (COND - (INSPC (SETQ TLOOKS (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS) - of INSPC) - INSPC TEXTOBJ] - (COND - ((ILEQ INSCH# 0) (* ; - "We backed up to the start of the document. Can't go no further.") - (RETURN)) - ((NOT (fetch CLPROTECTED of TLOOKS)) - (* ; - "Can only backspace if the char to go isn't protected.") - (replace (SELECTION CHLIM) of SEL - with (ADD1 (replace (SELECTION CH#) of SEL with INSCH#))) - (* ; - "Set up the selection to point to the character which is to be deleted.") - (replace (SELECTION DCH) of SEL with 1) - (\SHOWSEL SEL NIL NIL) (* ; - "Turn off the underlining, if any, so there's no garbage.") - (\FIXSEL SEL TEXTOBJ) (* ; - "Fix the selection up so it points to the right line and all") - (\TEDIT.DELETE SEL TEXTOBJ T) (* ; "And delete it.") - ]) + (for PC START-OF-PIECE backpieces (SETQ FIRSTPIECE (\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.COPY.PIECEMAPFN - [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* ; "Edited 12-Jun-90 17:50 by mitani") - (* Called by TEDIT.COPY via - TEDIT.SELECTED.PIECES, to do the - copy-operation processing on the - candidate pieces.) - (PROG (OBJ NEWOBJ COPYFN) - (SETQ PC (create PIECE using PC PNEW _ T)) (* No matter what, we need a fresh - copy.) - [COND - ((fetch (PIECE POBJ) of PC) (* This piece describes an object) - (SETQ OBJ (fetch (PIECE POBJ) of PC)) - [COND - [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) - (SETQ NEWOBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOOBJ))) - (COND - ((EQ NEWOBJ 'DON'T) (* He said not to copy this piece -- - abort the whole copy.) - (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) - (RETFROM 'TEDIT.COPY)) - (NEWOBJ (replace (PIECE POBJ) of PC with NEWOBJ)) - (T (replace (PIECE POBJ) of PC with (COPYALL OBJ] - (OBJ (* No copy fn; just strike off a - copy of our own) - (replace (PIECE POBJ) of PC with (COPYALL OBJ] - (COND - ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (* If there's an eventfn for - copying, use it.) - (APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TOOBJ)) - 'DSP) - (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOOBJ] - [COND - ((fetch CLPROTECTED of (fetch (PIECE PLOOKS) of PC)) - (* The source text was protected; - unprotect the copy.) - (replace (PIECE PLOOKS) of PC - with (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS - using (fetch (PIECE PLOOKS) - of PC) - CLPROTECTED _ NIL CLSELHERE _ NIL) - TOOBJ] - (RETURN PC]) + (\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 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 (\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]) + +(\TEDIT.COPYPIECE + [LAMBDA (PC FROMOBJ TOOBJ UNPROTECT OPERATION PROMPTTEXTOBJ) + (* ; "Edited 15-Oct-2023 20:14 by rmk") + (* ; "Edited 30-Jul-2023 22:44 by rmk") + (* ; "Edited 21-Jun-2023 00:15 by rmk") + (* ; "Edited 19-May-2023 21:39 by rmk") + (* ; "Edited 7-May-2023 11:46 by rmk") + (* ; "Edited 12-Jun-90 17:50 by mitani") + + (* ;; "TEXTOBJ's prompt gets the message that a copy is not allowed, the FROMOBJ and TOOBJ provide the streams for the object's copy function. The copy is disconnected from PC's original connections.") + + (* ;; "If UNPROTECT, the copies of protected pieces are unprotected") + + (* ;; "OPERATION keys which imageobject function to apply, if any") + + (PROG (NEWPC SRCPFILE (CROSSCOPY (NEQ FROMOBJ TOOBJ))) (* ; + "No matter what, we need a fresh copy.") + (SETQ NEWPC + (create PIECE using PC PNEW _ T PREVPIECE _ NIL NEXTPIECE _ NIL PTREENODE _ NIL)) + (SELECTC (PTYPE PC) + (FILE.PTYPES (CL:WHEN CROSSCOPY + + (* ;; "If this is a cross-document copy, and the text comes from a file, we must REALLY make a copy of the text, lest the source file be deleted. We want to preserve the external format, so that we can just copy the bytes.") + + (SETQ SRCPFILE (PCONTENTS PC)) + (CL:UNLESS (\GETSTREAM SRCPFILE 'INPUT T) + (* ; + "The source file was CLOSED -- reopen it, for our use") + [SETQ SRCPFILE (OPENSTREAM SRCPFILE 'INPUT 'OLD + '((TYPE TEXT]) + [FSETPC PC PCONTENTS (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW + `((:EXTERNAL-FORMAT ,(STREAMPROP SRCPFILE + + :EXTERNAL-FORMAT + ] + [COPYBYTES SRCPFILE (PCONTENTS PC) + (PFPOS PC) + (IPLUS (PFPOS PC) + (ITIMES (PLEN PC) + (PBYTESPERCHAR PC] + (FSETPC PC PFPOS 0))) + (STRING.PTYPES (* ; + "In case this is in the current insertion string") + (change (PCONTENTS NEWPC) + (CONCAT DATUM))) + (OBJECT.PTYPE (* ; + "No copy if object doesn't allow it. Caller must be prepared for NIL?") + (FSETPC NEWPC PCONTENTS (OR (\TEDIT.APPLY.OBJFN (PCONTENTS NEWPC) + OPERATION FROMOBJ TOOBJ PROMPTTEXTOBJ) + (RETURN NIL)))) + NIL) + + (* ;; "If moving from one text to another, we have to register the looks.") + + (if (AND UNPROTECT (ffetch CLPROTECTED of (PLOOKS NEWPC))) + then (FSETPC NEWPC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS + using (PLOOKS PC) + CLPROTECTED _ NIL + CLSELHERE _ NIL) + TOOBJ)) + elseif CROSSCOPY + then (FSETPC NEWPC PLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (PLOOKS PC) + TOOBJ)) + (FSETPC NEWPC PPARALOOKS (\TEDIT.UNIQUIFY.PARALOOKS (PPARALOOKS PC) + TOOBJ))) + (RETURN NEWPC]) + +(\TEDIT.APPLY.OBJFN + [LAMBDA (OBJ OPERATION FROMTOBJ TOTOBJ PROMPTTEXTOBJ) (* ; "Edited 15-Jul-2023 10:43 by rmk") + (* ; "Edited 9-Jul-2023 16:24 by rmk") + (* ; "Edited 6-Jun-2023 13:35 by rmk") + (* ; "Edited 30-May-2023 08:15 by rmk") + (* ; "Edited 19-May-2023 21:37 by rmk") + (* ; "Edited 7-May-2023 11:46 by rmk") + + (* ;; "As part of an OPERATION on an image object piece, we execute the appropriate object functions. If any of them returns DONT, we print a message in the prompt window of PROMPTTEXTOBJ or FROMTOBJ, and return NIL. Otherwise, we return an object, either OBJ or a copy.") + + (CL:UNLESS TOTOBJ (SETQ TOTOBJ FROMTOBJ)) + (PROG [NEWOBJ (OBJFN (IMAGEOBJPROP OBJ (SELECTQ OPERATION + (COPY 'COPYFN) + (MOVE 'WHENMOVEDFN) + (INSERT 'WHENINSERTEDFN) + (DELETE (* ; + "This may want to apply to the first pane?") + 'WHENDELETEDFN) + NIL] + (SETQ NEWOBJ (if OBJFN + then (APPLY* OBJFN OBJ (fetch (TEXTOBJ STREAMHINT) of FROMTOBJ) + (CL:UNLESS (EQ OPERATION 'DELETE) + (fetch (TEXTOBJ STREAMHINT) of TOTOBJ))) + elseif (EQ OPERATION 'COPY) + then (COPYALL OBJ) + else OBJ)) + (CL:WHEN (MEMB NEWOBJ '(DON'T DONT)) + (TEDIT.PROMPTPRINT (OR PROMPTTEXTOBJ FROMTOBJ) + (CONCAT (L-CASE OPERATION T) + " of this object not allowed.") + T) + (RETURN)) + + (* ;; "The WHENCOPIEDFN wants the display stream, not just the text stream. ") + + (CL:WHEN [AND (EQ OPERATION 'COPY) + (SETQ OBJFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) + (MEMB (APPLY* OBJFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) + of TOTOBJ)) + 'DSP) + (fetch (TEXTOBJ STREAMHINT) of FROMTOBJ) + (fetch (TEXTOBJ STREAMHINT) of TOTOBJ)) + '(DON'T DONT] + (RETURN NIL)) + (RETURN (OR (IMAGEOBJP NEWOBJ) + OBJ]) (\TEDIT.DELETE - [LAMBDA (SEL STREAM SELOFF) (* ; "Edited 29-May-91 18:22 by jds") - (* ; - "DELETE THE CHARACTERS SPECIFIED FROM THE MAIN TEXT.") - (* ; - "SELOFF => The selection is already turned off.") - (LET* - ((TEXTOBJ (TEXTOBJ STREAM)) - (CH# (fetch (SELECTION CH#) of SEL)) - (CHLIM (fetch (SELECTION CHLIM) of SEL)) - (LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (HEIGHTCHANGED NIL) - (NLINE1 NIL) - (CRFLAG NIL) - (LINES\DELETED NIL) - OLINE1 OLINEN LEN NEXTLINE NL OLINE DX OCHLIM OXLIM OLHEIGHT OLASCENT OLDESCENT DY PREVLINE - TEXTLEN OCR\END SAVEWIDTH IMAGECACHE) - [SETQ LEN (COND - ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Past end of text, so don't delete any") - 0) - ((IGEQ CH# CHLIM) (* ; - "Start is past end, so don't delete any.") - 0) - ((ZEROP (fetch (SELECTION DCH) of SEL)) - (* ; - "Just a caret--no text really selected--so don't delete any") - 0) - ((ZEROP CHLIM) (* ; - "CHLIM is before start of text, so don't delete any") - 0) - (T (* ; "The normal case.") - (IDIFFERENCE CHLIM CH#] (* ; "# of characters to be deleted") - (COND - ((OR (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (NOT (fetch (SELECTION SET) of SEL)) - (ZEROP LEN)) (* ; "If the selection isn't set, OR the document is read-only, OR the selection contains no characters, don't do anything.") - ) - (T (AND WINDOW (TEDIT.NORMALIZECARET TEXTOBJ SEL)) (* ; - "If the text appears in a window, move the deletion point on-screen") - (SETQ OLINE1 (fetch (SELECTION L1) of SEL)) - (SETQ OLINEN (fetch (SELECTION LN) of SEL)) - (\TEDIT.SHOWSELS TEXTOBJ NIL NIL) (* ; - "Turn off the selection's highlighting") - (AND LINES (\FIXDLINES LINES SEL CH# CHLIM TEXTOBJ)) - (* ; - "Update the line descriptors to account for the deletion") - (\DELETECH CH# CHLIM LEN TEXTOBJ) (* ; - "Do the actual deletion of characters") - (replace THPOINT of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with (fetch (SELECTION POINT) of SEL)) - (* ; - "Remember which side of the selection we were on, in case it gets undone.") - (replace (SELECTION CH#) of SEL with (IMAX 1 CH#)) - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of - SEL)) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION DCH) of SEL with 0) - (COND - (WINDOW (* ; - "If there's no window to update, don't bother") - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; "The new text length") - (for OLINE1 inside (fetch (SELECTION L1) of SEL) as OLINEN - inside (fetch (SELECTION LN) of SEL) as TOPLINE - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as THISW inside - WINDOW - do (SETQ LINES\DELETED - (\TEDIT.CLOSEUPLINES - TEXTOBJ - (OR (AND OLINE1 (COND - ((fetch (LINEDESCRIPTOR DELETED) of OLINE1) - (fetch (LINEDESCRIPTOR PREVLINE) of OLINE1)) - (T OLINE1))) - (COND - ([AND (fetch (LINEDESCRIPTOR NEXTLINE) of TOPLINE) - (OR (IGEQ (fetch (LINEDESCRIPTOR CHAR1) - of (fetch (LINEDESCRIPTOR NEXTLINE) - of TOPLINE)) - (fetch (SELECTION CHLIM) of SEL)) - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) - of (fetch (LINEDESCRIPTOR NEXTLINE) - of TOPLINE)) - (fetch (SELECTION CH#) of SEL] - (* ; - "The first line on the screen is already past where we're to delete. DON'T delete any lines") - NIL) - (T TOPLINE))) - (AND OLINEN (COND - ((fetch (LINEDESCRIPTOR DELETED) of OLINEN) - (fetch (LINEDESCRIPTOR NEXTLINE) of OLINEN)) - (T OLINEN))) - NIL THISW))) (* ; - "Remove any lines which were completely deleted.") + [LAMBDA (TEXTOBJ TARGETSEL DONTDISPLAY) (* ; "Edited 21-Feb-2024 20:40 by rmk") + (* ; "Edited 20-Feb-2024 20:09 by rmk") + (* ; "Edited 19-Feb-2024 11:48 by rmk") + (* ; "Edited 16-Feb-2024 08:46 by rmk") + (* ; "Edited 12-Nov-2023 12:14 by rmk") + (* ; "Edited 29-Oct-2023 00:19 by rmk") + (* ; "Edited 6-Jun-2023 12:48 by rmk") + (* ; "Edited 29-May-91 18:22 by jds") - (* ;; "This line must needs be reformatted the hard way--it isn't a left ragged line or one of the lines is off-screen.") + (* ;; "Delete the DCH characters selected by TARGETSEL. Unlike insert, the initial position of the caret doesn't matter.") - (replace (SELECTION DX) of SEL with 0) - (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T) (* ; - "Correct the text that's displayed already") - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* ; - "Then fix up the selection as needed.") - (\TEDIT.SHOWSELS TEXTOBJ NIL T]) + (* ;; "On return, the pieces, lines, and selection are complete and correct, and the display is correct unless DONTDISPLAY.") + + (* ;; "") + + (* ;; "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#))) + (\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) + (* ; + "Delete the selected characters (if objects allow)") + + (* ;; + "Pieces are gone, make lines, SEL, and TARGTSEL consistent with current text.") + + (\TEDIT.UPDATE.LINES TEXTOBJ 'DELETION TARGETSEL NIL DONTDISPLAY) + (FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TARGETSEL)) + + (* ;; "Adjust SEL and TARGETSEL to reflect the deleted characters.") + + (\TEDIT.SEL.DELETEDCHARS SEL TARGETSEL) + + (* ;; "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) + (\FIXSEL SEL TEXTOBJ) + (CL:UNLESS DONTDISPLAY (\SHOWSEL SEL T)) + T))))]) (\TEDIT.DIFFUSE.PARALOOKS - [LAMBDA (PRIORPC SUCCEEDINGPC) (* ; "Edited 12-Jun-90 17:48 by mitani") + [LAMBDA (PRIORPC SUCCEEDINGPC) (* ; "Edited 16-Feb-2024 00:07 by rmk") + (* ; "Edited 1-Jul-2023 19:24 by rmk") + (* ; "Edited 11-Apr-2023 00:08 by rmk") + (* ; "Edited 22-Oct-2022 22:22 by rmk") + (* ; "Edited 5-Sep-2022 14:32 by rmk") + (* ; "Edited 23-Aug-2022 08:40 by rmk") + (* ; "Edited 12-Jun-90 17:48 by mitani") - (* Given a discontinuity in paragraph looks, caused by an insertion or by a - deletion%: Diffuse the existing paragraph looks across the discontinuity, so - that all the pieces in a single paragraph have consistent looks. - Give preference to diffusion toward the END of the document. - This means that if you delete a CR between paragraphs, the second para is - absorbed into the first.) + (* ;; "Given a discontinuity in paragraph looks, caused by an insertion or by a deletion: Diffuse the existing paragraph looks across the discontinuity, so that all the pieces in a single paragraph have consistent paragraph looks. Give preference to diffusion toward the END of the document. This means that if you delete an EOL between paragraphs, the second para is absorbed into the first.") - (* PRIORPC and SUCCEEDINGPC are the PIECEs that bound the area of potential - discontinuity%: the change will occur at one boundary or the other....) + (* ;; "PRIORPC and SUCCEEDINGPC are the pieces that bound the area of potential discontinuity: the change will occur at one boundary or the other.") - [COND - ((AND PRIORPC (NOT (fetch (PIECE PPARALAST) of PRIORPC))) - (* The discontinuity is inside a - paragraph. Must copy para looks - forward into the text.) - (bind (PPLOOKS _ (fetch (PIECE PPARALOOKS) of PRIORPC)) - (PC _ (fetch (PIECE NEXTPIECE) of PRIORPC)) while PC - do (* Copy para looks info in from the - left, up the the first para break.) - (replace (PIECE PPARALOOKS) of PC with PPLOOKS) - (COND - ((fetch (PIECE PPARALAST) of PC) (* If this piece ends a paragraph, - we're done.) - (RETURN))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] - (COND - ((AND SUCCEEDINGPC (NEQ SUCCEEDINGPC 'LASTPIECE)) - - (* Only copy para looks in from the right if there is text to the right.) - - (bind (PPLOOKS _ (fetch (PIECE PPARALOOKS) of SUCCEEDINGPC)) - (PC _ (fetch (PIECE PREVPIECE) of SUCCEEDINGPC)) while (NEQ PC PRIORPC) - do (* Copy para looks in from the - right, up to the first para break) - (COND - ((fetch (PIECE PPARALAST) of PC) (* If this piece ends a paragraph, - we're done.) - (RETURN))) - (replace (PIECE PPARALOOKS) of PC with PPLOOKS) - (SETQ PC (fetch (PIECE PREVPIECE) of PC]) - -(\TEDIT.FOREIGN.COPY? - [LAMBDA (SEL) (* ; "Edited 21-Jan-93 11:46 by jds") - - (* ;; "IF the current process's window isn't a TEdit window, do a 'Copy' by BKSYSBUFing the selected text. Then turn off all the various indicators.") - - (PROG (PROCW (SOURCE.TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - CH STREAM DEST.TEDIT? DEST.TEXTOBJ) - [SETQ DEST.TEDIT? (AND (SETQ PROCW (PROCESSPROP (TTY.PROCESS) - 'WINDOW)) - (SETQ DEST.TEXTOBJ (WINDOWPROP PROCW 'TEXTOBJ)) - (NOT (TEXTPROP DEST.TEXTOBJ 'COPYBYBKSYSBUF] - (* ; "Treat the destination specially if (1) the recipient process has a window, and (2) it's a TEdit window, and (3) the TEdit isn't declining special treatment by having COPYBYBKSYSBUF set in its props.") - (COND - ((ZEROP (fetch (SELECTION DCH) of SEL)) (* ; - "Nothing to copy (0 characters in selection); don't bother.") - (SETQ TEDIT.COPY.PENDING NIL)) - ((IGREATERP (fetch (SELECTION CH#) of SEL) - (FETCH (TEXTOBJ TEXTLEN) OF SOURCE.TEXTOBJ)) - (* ; - "Trying to copy from beyond the end of the document; don't bother") - (SETQ TEDIT.COPY.PENDING NIL)) - ((OR (NOT DEST.TEDIT?) - (AND PROCW DEST.TEXTOBJ (NEQ SOURCE.TEXTOBJ DEST.TEXTOBJ) - (fetch (TEXTOBJ EDITOPACTIVE) of DEST.TEXTOBJ))) - (* ; - "OK -- receiver isn't TEdit. Do it the hard way.") - [COND - [(AND (WINDOWPROP [OR PROCW (WFROMDS (PROCESS.TTY (TTY.PROCESS] - 'COPYINSERTFN) - (PROGN (* ; - "This is the exit for looked-string objects") - (OBJECTOUTOFTEDIT SOURCE.TEXTOBJ SEL] - (T (* ; - "Old tedit method, run if OBJECTOUTOFTEDIT is NILL (ie., not installed yet)") - - (* ;; "Still used because COPYINSERT does (PRIN2 BKSYSBUF) if there's no insertfn, which cretes undesired string quotes.") - - (\SETUPGETCH (fetch (SELECTION CH#) of SEL) - SOURCE.TEXTOBJ) (* ; - "Go to the first character to be copied") - (SETQ STREAM (fetch (TEXTOBJ STREAMHINT) of SOURCE.TEXTOBJ)) - (for I from 1 to (fetch (SELECTION DCH) of SEL) - do - - (* ;; "Run thru the selected text, copying only those items that really ARE characters--IMAGEOBJs don't get copied by this route.") - - (COND - ((FIXP (SETQ CH (\BIN STREAM))) - (BKSYSBUF (CHARACTER CH))) - (T (COPYINSERT CH] - (\SHOWSEL SEL NIL NIL) (* ; - "Then reset the copy-pending flags.") - (SETQ TEDIT.COPY.PENDING NIL]) + (CL:WHEN (AND PRIORPC (NOT (PPARALAST PRIORPC))) (* ; + "The discontinuity is inside a paragraph. Must copy para looks forward into the text.") + (for PC (PPLOOKS _ (PPARALOOKS PRIORPC)) inpieces (NEXTPIECE PRIORPC) + until (PPARALAST PC) do (* ; + "Copy para looks info in from the left, up to the first para break.") + (FSETPC PC PPARALOOKS PPLOOKS))) + (CL:WHEN SUCCEEDINGPC (* ; + "Copy para looks back from the right, up to the first para break") + (for PC (PPLOOKS _ (PPARALOOKS SUCCEEDINGPC)) backpieces (PREVPIECE SUCCEEDINGPC) + until (OR (EQ PC PRIORPC) + (PPARALAST PC)) do (FSETPC PC PPARALOOKS PPLOOKS)))]) (\TEDIT.QUIT - [LAMBDA (W NOFORCE) (* ; "Edited 12-Jun-90 17:50 by mitani") - (* Called by the default - TEDIT.DEFAULT.MENUFN to perform the - QUIT command.) - (PROG* ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) - (QUITFNS (TEXTPROP TEXTOBJ 'QUITFN)) + [LAMBDA (W NOFORCE) (* ; "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 (\DTEST (WINDOWPROP W 'TEXTOBJ) + 'TEXTOBJ)) + (QUITFNS (GETTEXTPROP TEXTOBJ 'QUITFN)) QUITFLG RESP) - [for QUITFN inside QUITFNS while (AND (NEQ QUITFLG 'DON'T) - (NEQ QUITFLG T)) - do (COND - ((EQ QUITFN T) - (SETQ QUITFLG T)) - (T (AND QUITFN (NEQ QUITFN T) - (SETQ QUITFLG (APPLY* QUITFN W (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ) - TEXTOBJ - (fetch (TEXTOBJ EDITPROPS) of - TEXTOBJ - ] + [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.) + (* ;; "The user supplied a QUITFN, and it returned 'DON'T' , so just ignore all this Fooferaw and keep editing.") (RETURN)) - [(AND (fetch (TEXTOBJ \DIRTY) of TEXTOBJ) - (NOT (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) + [(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.) - - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ - with (MOUSECONFIRM "Not saved yet; LEFT to Quit anyway." T (fetch - (TEXTOBJ - PROMPTWINDOW - ) - of TEXTOBJ] - (T (* Go ahead and quit the next time - we see the main command loop.) - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T))) - [AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (NOT NOFORCE) - (NEQ (\TEDIT.PRIMARYW TEXTOBJ) - (PROCESSPROP (TTY.PROCESS) - 'WINDOW)) - (TTY.PROCESS (WINDOWPROP (\TEDIT.PRIMARYW TEXTOBJ) - 'PROCESS] - (RETURN (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ]) + (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) (* ; "Edited 29-May-91 18:22 by jds") + [LAMBDA (TEXTOBJ SEL) (* ; "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") - (* ;; "Delete the word to the left of the caret.") + (* ;; "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.") - (* ;; "Back word.") + (\DTEST TEXTOBJ 'TEXTOBJ) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (PROG ((LASTNO (SUB1 (TEDIT.GETPOINT SEL))) + FIRSTNO) - (* ;; "THIS FUNCTION IS FRAUGHT WITH FENCEPOST PROBLEM POTENTIAL, AND THE WHILE vs FOR LOGIC IS CONVOLUTED. CAUTION, CAUTION.") + (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") - (LET* ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (STREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) - TEDIT.WORDBOUND.READTABLE))) - (INSCH# (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (SUB1 (fetch (SELECTION CH#) of SEL))) - (RIGHT (SUB1 (fetch (SELECTION CHLIM) of SEL))) - NIL)) - CH CHNO) + (CL:WHEN (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]) - (* ;; "INSCH# is the final (i.e., highest-numbered) character to be deleted.") +(\TEDIT.WORDDELETE.FORWARD + [LAMBDA (TEXTOBJ SEL) (* ; "Edited 25-Dec-2023 00:20 by rmk") + (* ; "Edited 23-May-2023 16:37 by rmk") + (* ; "Edited 22-May-2023 10:52 by rmk") + (* ; "Edited 29-May-91 18:22 by jds") - (COND - ((IGREATERP INSCH# 0) (* ; - "Don't try to back up past start of file.") - (\SETUPGETCH INSCH# TEXTOBJ) - (SETQ CH (\BIN STREAM)) - (for old CHNO from INSCH# to 1 by -1 - while [AND (SELECTC (COND - ((FIXP CH) - (\SYNCODE READSA CH)) - (T (* ; "It's an object!") - TEXT.TTC)) - (TEXT.TTC NIL) - T) - (NOT (fetch CLPROTECTED of (fetch (PIECE PLOOKS) - of (fetch (TEXTSTREAM - PIECE) - of STREAM] - do + (* ;; "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.") - (* ;; "Skip over any initial separator characters") + (\DTEST TEXTOBJ 'TEXTOBJ) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (PROG ((FIRSTNO (TEDIT.GETPOINT SEL)) + LASTNO) - (SETQ CH (\GETCHB TEXTOBJ))) + (* ;; "LASTNO is the final (i.e., highest-numbered) character to be deleted.") - (* ;; "At this point, CH is the first non-separator character, and CHNO is the character number of the character BEFORE that one.") - - (for old CHNO from CHNO to 1 by -1 - while [AND (SELECTC (COND - ((FIXP CH) - (\SYNCODE READSA CH)) - (T (* ; "It's an object!") - TEXT.TTC)) - (TEXT.TTC T) - NIL) - (NOT (fetch CLPROTECTED of (fetch (PIECE PLOOKS) - of (fetch (TEXTSTREAM - PIECE) - of STREAM] - do - - (* ;; "Skip over the next group of non-separators (= a 'word')") - - (SETQ CH (\GETCHB TEXTOBJ))) - - (* ;; "At this point, CH is the first separator character you encountered, and CHNO is the character number of the character BEFORE the separator, or 0 if you hit the front of the document.") - - (\SHOWSEL SEL NIL NIL) - - (* ;; "First character to delete:") - - [replace (SELECTION CH#) of SEL with (COND - ((ILESSP CHNO 1) - (* ; - "Front of document, so start deleting at char # 1") - 1) - (T - (* ; -"Otherwise, we need to start 1 later than the separator we hit, which is 2 higher than CHNO is now.") - (IPLUS 2 CHNO] - (replace (SELECTION CHLIM) of SEL with (ADD1 INSCH#)) - (replace (SELECTION DCH) of SEL with (IDIFFERENCE INSCH# CHNO)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T) - (\TEDIT.DELETE SEL TEXTOBJ]) - -(\TEDIT1 - [LAMBDA (TEXT WINDOW UNSPAWNED PROPS) (* ; "Edited 12-Jun-90 17:50 by mitani") - - (* Does the actual editing work, and re-coercion or process kill when done. - Called by TEDIT directly, or ADD.PROCESSed by it.) - - (SETQ TEXT (OPENTEXTSTREAM TEXT WINDOW NIL NIL PROPS)) (* Open the text for editing) - (\TEDIT.COMMAND.LOOP (fetch (TEXTSTREAM TEXTOBJ) of TEXT)) - (* Run the editing engine) - (CLOSEW WINDOW) - (replace (TEXTOBJ \WINDOW) of (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - with NIL) - (AND (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - (APPLY* (TEXTPROP (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'AFTERQUITFN) - WINDOW TEXT)) (* Apply any post-window-close - (and post-QUIT) function) - (COND - (UNSPAWNED (* We're not a distinct process%: - Send back the edited text in some - suitable form) - (COND - ((NEQ (fetch (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT)) - T) - (PROG1 (fetch (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT)) - (replace (TEXTOBJ EDITFINISHEDFLG) of (fetch (TEXTSTREAM - TEXTOBJ) - of TEXT) with - NIL))) - ((STRINGP (fetch (TEXTOBJ TXTFILE) of (fetch (TEXTSTREAM TEXTOBJ - ) of TEXT))) - (COERCETEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - 'STRINGP)) - (T TEXT]) + (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]) ) - -(MOVD? 'NILL 'OBJECTOUTOFTEDIT) - - - -(* ; "HOOK for looked-string copy, etc. Used in \TEDIT.FOREIGN.COPY?.") - (DEFINEQ -(\CREATE.TEDIT.RESTART.MENU - [LAMBDA NIL - (CREATE MENU - ITEMS _ '(NewEditProcess]) +(\TEDIT.PARAPIECES + [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 3-Mar-2024 13:01 by rmk") + (* ; "Edited 11-Dec-2023 23:03 by rmk") + + (* ;; "Produces SELPIECES that starts at the first piece of the paragraph containing FIRSTCHAR and runs to the last piece of the paragraph containing LASTCHAR. Since paragraphs are split anyway, this does not require further splitting.") + + (LET (FIRSTCHAR FIRST LAST START-OF-PIECE) + (DECLARE (SPECVARS START-OF-PIECE)) + (if (type? SELECTION SEL/FIRSTCHAR) + then (SETQ 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)))] + elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR) + then (SETQ FIRSTCHAR (GETTH SEL/FIRSTCHAR THCH#)) + [SETQ LASTCHAR (SUB1 (IPLUS FIRSTCHAR (GETTH SEL/FIRSTCHAR THLEN] + else (SETQ FIRSTCHAR SEL/FIRSTCHAR) + (CL:UNLESS LASTCHAR (SETQ LASTCHAR FIRSTCHAR))) + (SETQ FIRST (\TEDIT.PARA.FIRST TEXTOBJ FIRSTCHAR)) + (SETQ LAST (\TEDIT.PARA.LAST TEXTOBJ LASTCHAR)) + (create SELPIECES + SPFIRST _ (CDR FIRST) + SPLAST _ (CDR LAST) + SPLEN _ (ADD1 (IDIFFERENCE (CAR LAST) + (CAR FIRST))) + SPFIRSTCHAR _ (CAR FIRST) + SPLASTCHAR _ (CAR LAST]) + +(\TEDIT.PARA.FIRST + [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 19-Jan-2024 10:10 by rmk") + (* ; "Edited 26-Dec-2023 09:14 by rmk") + (* ; "Edited 24-Dec-2023 22:14 by rmk") + (* ; "Edited 11-Dec-2023 21:52 by rmk") + + (* ;; "Returns (FIRSTCHARNO . FIRSTPIECE) of the paragraph containing CHNO. FIRSTCHARNO is the firstcharacter of FIRSTPIECE, because paragraphs start on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the end of the paragraph.") + + (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then (CONS 0) + else (LET (CHPIECE START-OF-PIECE START) + (DECLARE (SPECVARS START-OF-PIECE)) + (if (type? SELPIECES CHNO) + then (SETQ CHPIECE (fetch (SELPIECES SPFIRST) of CHNO)) + (SETQ START (fetch (SELPIECES SPFIRSTCHAR) of CHNO)) + elseif (type? PIECE CHNO) + then (SETQ START (\PCTOCH CHNO TEXTOBJ)) + (SETQ CHPIECE CHNO) + else [SETQ CHNO (CL:IF (type? SELECTION CHNO) + (FGETSEL CHNO CH#) + (IMAX 0 (IMIN CHNO (TEXTLEN TEXTOBJ))))] + (SETQ CHPIECE (\CHTOPC CHNO TEXTOBJ T)) + (SETQ START START-OF-PIECE)) + + (* ;; + "Start one before CHPIECE, its PARALAST doesn't matter. Assume CHPIECE is visible") + + (for PC (PLENTOT _ 0) backpieces (AND CHPIECE (PREVPIECE CHPIECE)) + when (VISIBLEPIECEP PC) until (PPARALAST PC) + until (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC))) + do (add PLENTOT (PLEN PC)) finally + + (* ;; + "We overshot on PC, its NEXT is the winner. If no PC, we hit the text beginning") + + (RETURN (CONS (IDIFFERENCE START PLENTOT) + (CL:IF PC + (NEXTPIECE PC) + (\FIRSTPIECE TEXTOBJ))]) + +(\TEDIT.PARA.LAST + [LAMBDA (TEXTOBJ CHNO PROTECTEDNOTOK) (* ; "Edited 19-Jan-2024 10:37 by rmk") + (* ; "Edited 26-Dec-2023 09:14 by rmk") + (* ; "Edited 24-Dec-2023 22:16 by rmk") + (* ; "Edited 11-Dec-2023 23:02 by rmk") + + (* ;; "Returns (LASTCHARNO .LASTPIECE) of the paragraph containing CHNO. If CHNO is SELPIECES or SELECTION, CHNO is taken as its last character. LASTCHARNO is the number of the last character of the paragraph (presumably on EOL). It is also the character of LASTPIECE, because pargraphs end on piece boundaries. When PROTECTEDNOTOK, the scan will terminated on a protected piece, even if that isn't the beginning of the paragraph.") + + (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then (* ; "Empty document") + (CONS 0) + else (LET (CHPIECE START-OF-PIECE END FORMATTED) + (DECLARE (SPECVARS START-OF-PIECE)) + (if (type? SELPIECES CHNO) + then (SETQ CHPIECE (fetch (SELPIECES SPLAST) of CHNO)) + [SETQ END (SUB1 (IDIFFERENCE (fetch (SELPIECES SPLASTCHAR) of CHNO) + (PLEN CHPIECE] + elseif (type? PIECE CHNO) + then (SETQ CHPIECE CHNO) + (SETQ END (\PCTOCH CHNO TEXTOBJ)) + else (SETQ CHPIECE (\CHTOPC (CL:IF (type? SELECTION CHNO) + (SUB1 (FGETSEL CHNO CHLIM)) + CHNO) + TEXTOBJ T)) + (SETQ END START-OF-PIECE)) (* ; "Find the paragraph's last char") + + (* ;; "END is now the first character of the piece containing CHNO") + + (for PC (PLENTOT _ 0) inpieces CHPIECE when (VISIBLEPIECEP PC) + do (add PLENTOT (PLEN PC)) repeatuntil (PPARALAST PC) + repeatuntil (AND PROTECTEDNOTOK (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC))) + finally (RETURN (CONS (IMIN (IPLUS END PLENTOT -1) + (FGETTOBJ TEXTOBJ TEXTLEN)) + PC]) ) - - - -(* ; "Added by yabu.fx, for SUNLOADUP without DWIM.") - - - - -(* ; "Debugging functions") - (DEFINEQ -(PLCHAIN - [LAMBDA (LN) (* ; "Edited 29-May-91 18:20 by jds") - (PRINTLINE LN) - (COND - ((fetch (LINEDESCRIPTOR NEXTLINE) of LN) - (PLCHAIN (fetch (LINEDESCRIPTOR NEXTLINE) of LN]) +(\TEDIT.WORD.FIRST + [LAMBDA (TEXTOBJ CHNO WORDBOUNDTABLE) (* ; "Edited 25-Dec-2023 18:53 by rmk") + (* ; "Edited 23-May-2023 16:37 by rmk") + (* ; "Edited 22-May-2023 10:52 by rmk") + (* ; "Edited 29-May-91 18:22 by jds") -(PRINTLINE - [LAMBDA (LN) (* ; "Edited 29-May-91 18:20 by jds") - (* Print out a line descriptor in a - reasonable form.) - (printout T "-----" T LN " Bot: " (fetch (LINEDESCRIPTOR YBOT) of LN) - " Base: " - (fetch (LINEDESCRIPTOR YBASE) of LN) - " Height: " - (fetch (LINEDESCRIPTOR LHEIGHT) of LN) - " Ascent: " - (fetch (LINEDESCRIPTOR ASCENT) of LN) - " Descent: " - (fetch (LINEDESCRIPTOR DESCENT) of LN) - T "Char1: " (fetch (LINEDESCRIPTOR CHAR1) of LN) - " Lim: " - (fetch (LINEDESCRIPTOR CHARLIM) of LN) - " Top: " - (fetch (LINEDESCRIPTOR CHARTOP) of LN)) - (COND - ((fetch (LINEDESCRIPTOR DIRTY) of LN) - (PRIN1 " DIRTY"))) - (COND - ((fetch (LINEDESCRIPTOR CR\END) of LN) - (PRIN1 " CR-at-end"))) - (COND - ((fetch (LINEDESCRIPTOR DELETED) of LN) - (PRIN1 " DELETED"))) - (COND - ((fetch (LINEDESCRIPTOR LHASPROT) of LN) - (PRIN1 " [Protected text]"))) - (COND - ((fetch (LINEDESCRIPTOR LHASTABS) of LN) - (PRIN1 " Has Tabs"))) - (PRIN1 ". -") - (printout T "RMar: " (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LN) - " XLim: " - (fetch (LINEDESCRIPTOR LXLIM) of LN) - " Left: " - (fetch (LINEDESCRIPTOR SPACELEFT) of LN) - T "Prev: " (fetch (LINEDESCRIPTOR PREVLINE) of LN) - T "Next: " (fetch (LINEDESCRIPTOR NEXTLINE) of LN) - T) - (COND - ((AND (IGEQ (fetch (LINEDESCRIPTOR CHAR1) of LN) - 1) - (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LN) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* The line is real -- - print it.) - (\SETUPGETCH (fetch (LINEDESCRIPTOR CHAR1) of LN) - TEXTOBJ) - (PRIN1 "|") - [bind CH for CHNO from (fetch (LINEDESCRIPTOR CHAR1) of LN) - to (IMIN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - (fetch (LINEDESCRIPTOR CHARLIM) of LN)) - do (SETQ CH (\GETCH TEXTOBJ)) - (COND - ((SMALLP CH) - (PRIN1 (CHARACTER CH))) - (T (PRINT CH] - (PRIN1 "| -"]) + (* ;; "Returns the number of the first character of the word containing CHNO or of the word preceding CHNO if CHNO does not map to a text character. Unlike the paragraph case, we don't get much help from the pieces, because words are not piece-aligned. Caller can do the piece manipulation given the result. ") -(SEEFILE - [LAMBDA (FILE ST ND) (* jds " 4-NOV-83 20:21") - (PROG (CH) - [SETQ FILE (OR (OPENP FILE) - (OPENSTREAM FILE 'INPUT] - (SETFILEPTR FILE (OR ST 0)) - (for I from (OR ST 0) to (OR ND (SUB1 (GETEOFPTR FILE))) - do (printout T I 5 (SETQ CH (BIN FILE)) - 9 - (COND - [(ILEQ CH (CHARCODE ^Z)) - (CONCAT "^" (CHARACTER (IPLUS CH (CHARCODE @] - (T (CHARACTER CH))) - T]) + (* ;; "We don't need to worry about invisibles here,\BACKBIN skips them.") + + (* ;; "Image objects are treated as text characters.") + + (* ;; "Punctuation is tricky: It stops whitespace and text, and its immediate predecessor doesn't matter.") + + (\DTEST 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))) + (\TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; "Fileptrs are one back") + (SETQ CH (BIN TSTREAM)) (* ; "The char at CHNO") + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; "Started on a punct, return") + + (RETURN CHNO)) + + (* ;; "Skip over any preceding whitespace characters. 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))) + + (* ;; "") + + (* ;; "CH is either TEXT, PUNCT, or image object.") + + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; "Punct before whitespace, look no further, punct is our guy.") + + (RETURN (ADD1 CHNO))) + + (* ;; "") + + (* ;; "We've reached the first unprotected non-separator character, and CHNO is the number of the character BEFORE that one. Continue backwards through the text characters until reaching the first preceding non-text.") + + (for old CHNO from CHNO to 1 by -1 until [OR (CL:IF (CHARCODEP CH) + (NEQ TEXT.TTC (\SYNCODE READSA CH)) + T) + (fetch CLPROTECTED + of (PLOOKS (fetch (TEXTSTREAM PIECE) + of TSTREAM] + do (SETQ CH (\BACKBIN TSTREAM))) + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; + "We ended on a punct before some text, CHNO is one before the punct, get back to text") + + (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.") + + (RETURN (IPLUS CHNO (CL:IF (EQ CHNO 0) + 1 + 2)]) + +(\TEDIT.WORD.LAST + [LAMBDA (TEXTOBJ CHNO WORDBOUNDTABLE) (* ; "Edited 25-Dec-2023 18:38 by rmk") + (* ; "Edited 23-May-2023 16:37 by rmk") + (* ; "Edited 22-May-2023 10:52 by rmk") + (* ; "Edited 29-May-91 18:22 by jds") + + (* ;; "Returns the number of the last character of the word containing CHNO or of the word following CHNO if CHNO does not map to a text character. Unlike the paragraph case, we don't get much help from the pieces, because words are not piece-aligned. Caller can do the piece manipulation given the result. ") + + (* ;; "We don't need to worry about invisibles here,\BIN skips them.") + + (* ;; "Image objects are treated as text characters.") + + (* ;; + "Punctuation is tricky: It stops whitespace and text, and its immediate successor doesn't matter.") + + (\DTEST 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)) + (\TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; "Fileptrs are one back") + (SETQ CH (BIN TSTREAM)) (* ; "The char at CHNO") + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; "Started on a punct, return") + + (RETURN CHNO)) + + (* ;; "Skip over any following separator characters. Objects are consider to be text characters--don't skip over them. We don't know when the stream's piece might have changed, so test at each iteration.") + + (for old CHNO from CHNO to (SUB1 TEXTLEN) while (AND (CHARCODEP CH) + (EQ WHITESPACE.TTC (\SYNCODE READSA CH + ))) + until (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM))) + do (SETQ CH (BIN TSTREAM))) + + (* ;; "CH is either TEXT, PUNCT, or image object.") + + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; "Punct after whitespace, look no further, punct is our guy.") + + (RETURN CHNO)) + + (* ;; "We reached the last unprotected non-separator character, and CHNO is the number of the character AFTER that one. Continue forwards through the text characters until reaching the first following separator.") + + (for old CHNO from CHNO to (SUB1 TEXTLEN) + until [OR (CL:IF (CHARCODEP CH) + (NEQ TEXT.TTC (\SYNCODE READSA CH)) + T) + (fetch CLPROTECTED of (PLOOKS (fetch (TEXTSTREAM PIECE) of TSTREAM] + do (SETQ CH (BIN TSTREAM))) + (CL:WHEN (AND (CHARCODEP CH) + (EQ PUNCT.TTC (\SYNCODE READSA CH))) + + (* ;; + "We ended on a punct after some text, CHNO is one after the punct, get back to text") + + (RETURN (SUB1 CHNO))) + + (* ;; "We've now reached the first separator character after the word, and CHNO is the character number of the character after it, or TEXTLEN if we ran off the end..") + + (RETURN (CL:IF (IGEQ CHNO TEXTLEN) + TEXTLEN + (SUB1 CHNO))]) ) @@ -1956,358 +1909,193 @@ Copyright (c) 1983-1993, 1995, 1999, 2018, 2021 by Venue & Xerox Corporation. (DEFINEQ (TEDIT.INSERT.OBJECT - [LAMBDA (OBJECT STREAM CH#) (* ; "Edited 21-Apr-93 00:52 by jds") + [LAMBDA (OBJECT TSTREAM CH#) (* ; "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.") - (LET* ((TEXTOBJ (TEXTOBJ STREAM)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - SUBSTREAM START-OF-PIECE) - (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) (* ; - "Do the pending delete, if there is one.") - (COND - ((NULL CH#) (* ; - "Omitted CH# means put it at the current spot.") - (SETQ CH# SEL))) - [COND - ((type? SELECTION CH#) + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + SEL OBJPC OBJSELPIECES SUBSTREAM) - (* ;; "If the CH# passed in was a selection (or we set it because he defaulted CH#), then compute the REAL CH#.") + (* ;; + "We construct and copy a trivial SELPIECES so that we can share the basic insertion code.") - (SETQ CH# (SELECTQ (fetch (SELECTION POINT) of CH#) - (LEFT (fetch (SELECTION CH#) of CH#)) - (RIGHT (fetch (SELECTION CHLIM) of CH#)) - (SHOULDNT] - (PROG ((PCTB (ffetch (TEXTOBJ PCTB) of TEXTOBJ)) - TEXTLEN PC PCNO CHNO NEWPC PREVPC INSERTFN) - (COND - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - - (* ;; - "If no changes are allowed to this TEdit, bail out without doing anything.") - - (RETURN))) - (\SHOWSEL SEL NIL NIL) (* ; "Turn off the selection for now") - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ CH# (IMIN CH# (ADD1 TEXTLEN))) (* ; - "CH# we're to insert these characters in front of") - (freplace (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ with -1) - [SETQ PC (COND - ((ILEQ CH# TEXTLEN) - (\CHTOPC CH# PCTB T)) - (T 'LASTPIECE] (* ; - "Piece we're to insert in front of or inside") - (SETQ NEWPC (create PIECE - PSTR _ NIL - PFILE _ NIL - POBJ _ OBJECT - PLEN _ 1)) (* ; "The new piece we're inserting") - [COND - ((SETQ SUBSTREAM (IMAGEOBJPROP OBJECT 'SUBSTREAM)) + (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.") - (replace (PIECE PLEN) of NEWPC with (fetch (TEXTOBJ TEXTLEN) - of (fetch ( - TEXTSTREAM - TEXTOBJ) - of SUBSTREAM] - (COND - ((OR (IGREATERP CH# TEXTLEN) - (IEQP CH# START-OF-PIECE)) (* ; - "We're inserting on a piece boundary; do it, then remember the prior piece.") - (\INSERTPIECE NEWPC PC TEXTOBJ)) - (T (* ; - "Not on a piece boundary; split the piece we're inside of, then insert.") - (\INSERTPIECE NEWPC (\SPLITPIECE PC (IDIFFERENCE CH# START-OF-PIECE) - TEXTOBJ) - TEXTOBJ))) - (COND - ((SETQ INSERTFN (IMAGEOBJPROP OBJECT 'WHENINSERTEDFN)) - (* ; - "If there is a WHENINSERTEDFN, apply it.") - (APPLY* INSERTFN OBJECT (AND (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ - )) - (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ)) - 'DSP)) - NIL STREAM))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ PREVPC (fetch (PIECE PREVPIECE) of NEWPC)) - (* ; "Fill in the para looks") - [COND - [PREVPC (COND - [(AND (fetch (PIECE PPARALAST) of PREVPC) - (fetch (PIECE NEXTPIECE) of NEWPC)) - (replace (PIECE PPARALOOKS) of NEWPC - with (fetch (PIECE PPARALOOKS) of (fetch - (PIECE NEXTPIECE) - of NEWPC] - (T (replace (PIECE PPARALOOKS) of NEWPC - with (fetch (PIECE PPARALOOKS) of PREVPC] - (T (COND - ((SETQ PREVPC (fetch (PIECE NEXTPIECE) of NEWPC)) - (replace (PIECE PPARALOOKS) of NEWPC with (fetch - (PIECE PPARALOOKS) - of PREVPC))) - (T (replace (PIECE PPARALOOKS) of NEWPC with (fetch - (TEXTOBJ - FMTSPEC) - of TEXTOBJ] - (replace (PIECE PLOOKS) of NEWPC with (fetch (TEXTOBJ CARETLOOKS) - of TEXTOBJ)) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Insert - THCH# _ CH# - THLEN _ 1 - THFIRSTPIECE _ NEWPC)) - (SETQ TEXTLEN (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ - with (IPLUS (fetch (PIECE PLEN) of NEWPC) - TEXTLEN))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Since adding an IMAGEOBJ creates a new piece, the old insertion cache piece is no longer valid.") - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (replace (THISLINE DESC) of (fetch (TEXTOBJ THISLINE) of TEXTOBJ) - with NIL) - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\FIXILINES TEXTOBJ SEL CH# (fetch (PIECE PLEN) of NEWPC) - (SUB1 TEXTLEN)) - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION DX) of SEL with 0) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T)) - (T [replace (SELECTION CHLIM) of SEL - with (replace (SELECTION CH#) of SEL - with (IPLUS CH# (fetch (PIECE PLEN) of NEWPC] - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (THISLINE DESC) of (fetch (TEXTOBJ THISLINE) - of TEXTOBJ) with NIL))) - (\COPYSEL SEL TEDIT.SELECTION]) + "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 + (\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)) + (\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) + (\SHOWSEL SEL T)))]) (TEDIT.EDIT.OBJECT - [LAMBDA (STREAM OBJ) (* ; "Edited 29-May-91 18:23 by jds") - (PROG ([TEXTOBJ (COND - ((type? TEXTOBJ STREAM) - STREAM) - ((type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - ((SHOULDNT] - SEL LL CH# SELOBJ EDITFN) - [COND - [(AND OBJ (IMAGEOBJP OBJ)) - (SETQ CH# (TEDIT.FIND.OBJECT TEXTOBJ OBJ)) - (COND - (CH# (SETQ SEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION CH#) of SEL with CH#) - (replace (SELECTION CHLIM) of SEL with (ADD1 CH#)) - (SETQ SELOBJ OBJ) - (replace (SELECTION DCH) of SEL with 1) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (\FIXSEL SEL TEXTOBJ)) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Can't find specified object." T] - (T (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ OBJ (fetch (SELECTION SELOBJ) of SEL] - (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 (fetch (SELECTION L1) of SEL) - do (replace (LINEDESCRIPTOR DIRTY) of LINE with T)) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T) - (TEDIT.UPDATE.SCREEN TEXTOBJ] - (T (* No object selected.) - (TEDIT.PROMPTPRINT TEXTOBJ "Please select an editable object first." T]) + [LAMBDA (STREAM OBJ) (* ; "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) + (\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 3-May-93 12:52 by jds") - (* ; - "Find OBJ, if it's in TEXTOBJ, and return CH#. Else return nil") - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (LET ((PC (\GETBASEPTR (\FIRSTNODE (fetch PCTB of TEXTOBJ)) - 0)) - (CH 1)) - (while PC do (COND - ((AND (NOT (ATOM PC)) - (EQ (fetch (PIECE POBJ) of PC) - OBJ)) - (RETURN CH)) - (T (add CH (ffetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) - -(TEDIT.FIND.OBJECT.SUBTREE - [LAMBDA (PCTB OBJ) (* ; "Edited 12-Jun-90 17:52 by mitani") - (COND - ((NULL PCTB) - NIL) - ((ATOM (fetch (PCTNODE PCE) of PCTB)) - (OR (TEDIT.FIND.OBJECT.SUBTREE (fetch (PCTNODE LO) of PCTB) - OBJ) - (TEDIT.FIND.OBJECT.SUBTREE (fetch (PCTNODE HI) of PCTB) - OBJ))) - ((EQ (fetch (PIECE POBJ) of (fetch (PCTNODE PCE) of PCTB)) - OBJ) - (fetch (PCTNODE CHNUM) of PCTB)) - (T (OR (TEDIT.FIND.OBJECT.SUBTREE (fetch (PCTNODE LO) of PCTB) - OBJ) - (TEDIT.FIND.OBJECT.SUBTREE (fetch (PCTNODE HI) of PCTB) - OBJ]) - -(TEDIT.PUT.OBJECT - [LAMBDA (PIECE OFILE FONTFILE CURCH#) (* ; "Edited 12-Jun-90 17:49 by mitani") - (* Given a piece which describes an - object, put the object out there.) - (PROG ((OBJECT (fetch (PIECE POBJ) of PIECE)) - (FONTCH# (GETFILEPTR FONTFILE)) - TOFILE LEN) - (\DWOUT FONTFILE 0) (* Placeholder for length of the - object's description) - (\SMALLPOUT FONTFILE \PieceDescriptorOBJECT) (* Mark this as setting the piece's - looks) - (\ATMOUT FONTFILE (IMAGEOBJPROP OBJECT 'GETFN)) (* The FN to apply to reconstruct - the object) - (APPLY* (IMAGEOBJPROP OBJECT 'PUTFN) - OBJECT OFILE) - (SETFILEPTR FONTFILE FONTCH#) - - (* Now go back and fill in the length of the text description of the object.) - - [\DWOUT FONTFILE (SETQ LEN (ADD1 (IDIFFERENCE (GETEOFPTR OFILE) - CURCH#] - (SETFILEPTR FONTFILE -1) (* Make sure we're at the end of the - font file) - (AND (RANDACCESSP OFILE) - (SETFILEPTR OFILE -1)) (* And the text part of the file) - (RETURN LEN]) - -(TEDIT.GET.OBJECT - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 17:50 by mitani") - (* ; "Get an object from the file") - (* ; - "CURCH# = fileptr within the text section of the file where the object's text starts.") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - FILEPTRSAVE NAMELEN GETFN OBJ NBYTES) - - (* ;; "rrb 10-AUG-87 --- calculate the length of the image object's data. This assumes that the file is currently pointed at the end of the data which is where the GETFN is written {I think}") - - (SETQ NBYTES (DIFFERENCE (GETFILEPTR FILE) - CURCH#)) - (SETQ GETFN (\ATMIN FILE)) (* ; - "The GETFN for this kind of IMAGEOBJ") - (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ; - "Save our file location thru the building of the object") - (SETFILEPTR FILE CURCH#) - (SETQ OBJ (READIMAGEOBJ FILE GETFN NIL NBYTES)) - (COND - ((IMAGEOBJPROP OBJ 'UNKNOWNGETFN) (* ; - "If the object has an unknown getfn property, then it's an encapsulated object. Warn the user") - (TEDIT.PROMPTPRINT STREAM "WARNING: Document contains unknown image objects." T))) - (SETFILEPTR FILE FILEPTRSAVE) - (replace (PIECE POBJ) of PIECE with OBJ) - (replace (PIECE PFILE) of PIECE with NIL) - (replace (PIECE PSTR) of PIECE with NIL) - [replace (PIECE PLOOKS) of PIECE with (COND - ((fetch (PIECE PREVPIECE) - of PIECE) - (fetch (PIECE PLOOKS) - of (fetch (PIECE PREVPIECE - ) - of PIECE))) - (T (OR (fetch (TEXTOBJ - DEFAULTCHARLOOKS - ) - of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS - (CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ] - (RETURN (fetch (PIECE POBJ) of PIECE]) + [LAMBDA (TEXTOBJ OBJ) (* ; "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 (\FIRSTPIECE (TEXTOBJ TEXTOBJ)) + when (EQ OBJ (PCONTENTS PC)) do (RETURN CH#]) (TEDIT.OBJECT.CHANGED - [LAMBDA (STREAM OBJECT) (* ; "Edited 12-Jun-90 17:51 by mitani") + [LAMBDA (TSTREAM OBJECT) (* ; "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 (\FIRSTPIECE TEXTOBJ) suchthat (EQ OBJECT (PCONTENTS PC] + (* ; + "Find the piece containing this object") + (CL:UNLESS OBJPIECE (HELP "Changed OBJECT not found!?")) + (SETQ CHANGEDCH# (\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.") + (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + NIL) + (TEDIT.UPDATE.SCREEN TEXTOBJ) + (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + TEXTOBJ) + (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + T]) - (* Notify TEdit that an object has changed, and the display may need to be - updated.) +(TEDIT.MAP.OBJECTS + [LAMBDA (TEXTOBJ FN FNARG COLLECT?) (* ; "Edited 4-Mar-2024 16:12 by rmk") + (* ; "Edited 6-Nov-2022 12:15 by rmk") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (LINES (fetch (TEXTOBJ LINES) of (TEXTOBJ STREAM))) - PCINFO CHANGED CHANGEDCH#) - (SETQ PCINFO (TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO OBJ) - (AND (EQ OBJ (fetch (PIECE POBJ) - of PC)) - 'STOP] - OBJECT)) (* Find the piece containing this - object) - (OR PCINFO (HELP "Changed OBJECT not found!?")) - (SETQ CHANGEDCH# (CAR PCINFO)) (* 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.) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL T]) + (* ;; "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 (\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 TEDIT-FIND TEDIT-HISTORY TEDIT-FILE TEDIT-WINDOW TEDIT-SELECTION IMAGEOBJ TEDIT-TFBRAVO - TEDIT-HCPY TEDIT-PAGE TEDIT-MENU TEDIT-FNKEYS) +(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 Support information") -(RPAQQ TEDITSYSTEMDATE "14-Jul-2022 17:10:16") - -(RPAQ TEDITSUPPORT "TEditSupport.PA") -(DEFINEQ - -(MAKETEDITFORM - [LAMBDA NIL (* jds "12-Mar-85 04:00") - (* Builds a trouble-report form for - TEdit.) - (MAKEXXXSUPPORTFORM "TEdit" TEDITSUPPORT TEDITSYSTEMDATE]) -) - -(ADDTOVAR LAFITESPECIALFORMS ("TEdit Report" 'MAKETEDITFORM "Report a problem with TEdit")) - -(SETQ LAFITEFORMSMENU NIL) +(RPAQQ TEDITSYSTEMDATE " 7-Mar-2024 08:14:51") (* ; "LISTFILES Interface, so the system can decide if a file is a TEdit file.") -(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.FORMATTEDP1) +(ADDTOVAR PRINTFILETYPES (TEDIT (TEST \TEDIT.GET.TRAILER) (EXTENSION (TEDIT)))) -(PUTPROPS TEDIT COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1989 1990 1991 -1992 1993 1995 1999 2018 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4418 118701 (\TEDIT2 4428 . 7179) (COERCETEXTOBJ 7181 . 15957) (TEDIT 15959 . 21225) ( -TEDITSTRING 21227 . 21786) (TEDIT-SEE 21788 . 24377) (TEDIT.CHARWIDTH 24379 . 26403) (TEDIT.COPY 26405 - . 34841) (TEDIT.DELETE 34843 . 35533) (TEDIT.DO.BLUEPENDINGDELETE 35535 . 38602) (TEDIT.INSERT 38604 - . 44134) (TEDIT.KILL 44136 . 45693) (TEDIT.MAPLINES 45695 . 47094) (TEDIT.MAPPIECES 47096 . 48052) ( -TEDIT.MOVE 48054 . 57838) (TEDIT.QUIT 57840 . 59840) (TEDIT.STRINGWIDTH 59842 . 60513) (TEDIT.\INSERT -60515 . 62540) (TEXTOBJ 62542 . 63667) (TEXTSTREAM 63669 . 65284) (\TEDIT.INCLUDE 65286 . 69186) ( -\TEDIT.INSERT.PIECES 69188 . 79103) (\TEDIT.MOVE.PIECEMAPFN 79105 . 81184) (\TEDIT.OBJECT.SHOWSEL -81186 . 84815) (\TEDIT.RESTARTFN 84817 . 86812) (\TEDIT.CHARDELETE 86814 . 90776) ( -\TEDIT.COPY.PIECEMAPFN 90778 . 94003) (\TEDIT.DELETE 94005 . 101523) (\TEDIT.DIFFUSE.PARALOOKS 101525 - . 104289) (\TEDIT.FOREIGN.COPY? 104291 . 108018) (\TEDIT.QUIT 108020 . 111166) (\TEDIT.WORDDELETE -111168 . 116001) (\TEDIT1 116003 . 118699)) (118815 118931 (\CREATE.TEDIT.RESTART.MENU 118825 . 118929 -)) (119030 122719 (PLCHAIN 119040 . 119314) (PRINTLINE 119316 . 122080) (SEEFILE 122082 . 122717)) ( -122760 142403 (TEDIT.INSERT.OBJECT 122770 . 131847) (TEDIT.EDIT.OBJECT 131849 . 134105) ( -TEDIT.FIND.OBJECT 134107 . 135000) (TEDIT.FIND.OBJECT.SUBTREE 135002 . 135808) (TEDIT.PUT.OBJECT -135810 . 137469) (TEDIT.GET.OBJECT 137471 . 140670) (TEDIT.OBJECT.CHANGED 140672 . 142401)) (142696 -143059 (MAKETEDITFORM 142706 . 143057))))) + (FILEMAP (NIL (4341 6283 (MAKE-TEDIT-EXPORTS.ALL 4351 . 4897) (UPDATE-TEDIT 4899 . 5512) (EDIT-TEDIT +5514 . 6281)) (7615 7908 (\CREATE.TEDIT.RESTART.MENU 7625 . 7906)) (8283 46720 (TEDIT 8293 . 10898) ( +COERCETEXTOBJ 10900 . 14999) (TEDIT.CONCAT 15001 . 18053) (\TEDIT.CONCAT.PAGEFRAMES 18055 . 22954) ( +\TEDIT.GET.PAGE.HEADINGS 22956 . 23985) (\TEDIT.CONCAT.INSTALL.HEADINGS 23987 . 25318) (TEDITSTRING +25320 . 26058) (TEDIT-SEE 26060 . 26619) (TEDIT.CHARWIDTH 26621 . 28645) (TEDIT.COPY 28647 . 30808) ( +TEDIT.DELETE 30810 . 31783) (TEDIT.INSERT 31785 . 33855) (TEDIT.KILL 33857 . 34559) (TEDIT.QUIT 34561 + . 36129) (TEDIT.DO.BLUEPENDINGDELETE 36131 . 37063) (TEDIT.MOVE 37065 . 42430) (TEDIT.STRINGWIDTH +42432 . 43103) (TEXTOBJ 43105 . 45459) (TEDITMENUP 45461 . 46099) (TEXTSTREAM 46101 . 46718)) (46721 +48876 (\TEDIT.MOVE.MSG 46731 . 48384) (\TEDIT.READONLY 48386 . 48874)) (48877 56995 (TEDIT.NCHARS +48887 . 49260) (TEDIT.RPLCHARCODE 49262 . 52615) (TEDIT.NTHCHARCODE 52617 . 54279) ( +\TEDIT.PIECE.NTHCHARCODE 54281 . 56993)) (57041 96253 (\TEDIT1 57051 . 58910) (\TEDIT.INSERT 58912 . +64660) (\TEDIT.REPLACE.SELPIECES 64662 . 66334) (\TEDIT.INSERT.SELPIECES 66336 . 68637) ( +\TEDIT.OBJECT.SHOWSEL 68639 . 72399) (\TEDIT.RESTARTFN 72401 . 74539) (\TEDIT.CHARDELETE 74541 . 76539 +) (\TEDIT.CHARDELETE.FORWARD 76541 . 78053) (\TEDIT.COPYPIECE 78055 . 82793) (\TEDIT.APPLY.OBJFN 82795 + . 85868) (\TEDIT.DELETE 85870 . 89000) (\TEDIT.DIFFUSE.PARALOOKS 89002 . 91273) (\TEDIT.QUIT 91275 . +93710) (\TEDIT.WORDDELETE 93712 . 94985) (\TEDIT.WORDDELETE.FORWARD 94987 . 96251)) (96254 103226 ( +\TEDIT.PARAPIECES 96264 . 97985) (\TEDIT.PARA.FIRST 97987 . 100626) (\TEDIT.PARA.LAST 100628 . 103224) +) (103227 111315 (\TEDIT.WORD.FIRST 103237 . 107381) (\TEDIT.WORD.LAST 107383 . 111313)) (111356 +120002 (TEDIT.INSERT.OBJECT 111366 . 114639) (TEDIT.EDIT.OBJECT 114641 . 116680) (TEDIT.FIND.OBJECT +116682 . 117089) (TEDIT.OBJECT.CHANGED 117091 . 119058) (TEDIT.MAP.OBJECTS 119060 . 120000))))) STOP diff --git a/library/tedit/TEDIT-ABBREV b/library/tedit/TEDIT-ABBREV index 39a46395..9b959f9a 100644 --- a/library/tedit/TEDIT-ABBREV +++ b/library/tedit/TEDIT-ABBREV @@ -1,20 +1,16 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:53:34"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;1 9767 +(FILECREATED "12-Jun-2023 10:34:12" {WMEDLEY}tedit>TEDIT-ABBREV.;6 9257 - :PREVIOUS-DATE "14-Jul-2022 11:08:10" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-ABBREV.;3) + :EDIT-BY rmk + + :PREVIOUS-DATE "17-May-2023 13:40:00" {WMEDLEY}tedit>TEDIT-ABBREV.;5) (PRETTYCOMPRINT TEDIT-ABBREVCOMS) (RPAQQ TEDIT-ABBREVCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) + [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV) (GLOBALVARS TEDIT.ABBREVS) (INITVARS (TEDIT.ABBREVS '(("b" . "357,146") ("n" . "357,44") @@ -62,57 +58,38 @@ (" " . "357,41") ("DATE" . \TEDIT.EXPAND.DATE) (">>DATE<<" . \TEDIT.EXPAND.DATE]) - -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) (DEFINEQ (\TEDIT.ABBREV.EXPAND - [LAMBDA (STREAM) (* ; "Edited 30-May-91 19:27 by jds") + [LAMBDA (TSTREAM) (* ; "Edited 17-May-2023 13:31 by rmk") + (* ; "Edited 8-Sep-2022 23:53 by rmk") + (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* ; "Edited 30-May-91 19:27 by jds") (* ; "Expand an abbvreviation") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - SEL CH# (CH NIL) - OLDLOOKS EXPANSION) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + SEL CH# CH OLDLOOKS EXPANSION) (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ CH# (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (SUB1 (fetch (SELECTION CH#) of SEL))) - (RIGHT (SUB1 (fetch (SELECTION CHLIM) of SEL))) - 0)) + (SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL))) [COND - ((ZEROP (fetch (SELECTION DCH) of SEL)) (* ; + ((ZEROP (GETSEL SEL DCH)) (* ;  "Point Selection, so use the character to the left") - (COND - ((ZEROP CH#) (* ; + (CL:WHEN (ZEROP CH#) (* ;  "If we're off the front of the document, don't bother trying.") - (RETURN))) - (\SETUPGETCH CH# TEXTOBJ) - [SETQ CH (MKSTRING (CHARACTER (\BIN STREAM] - (TEDIT.SETSEL STREAM CH# 1 'RIGHT)) + (RETURN)) + (\TEXTSETFILEPTR TSTREAM (SUB1 CH#) + CH#) + [SETQ CH (MKSTRING (CHARACTER (BIN TSTREAM] + (TEDIT.SETSEL TSTREAM CH# 1 'RIGHT)) (T (* ;  "We have a selection that isn't just a caret. Use it.") - (SETQ CH (TEDIT.SEL.AS.STRING STREAM] - (SETQ EXPANSION (\TEDIT.TRY.ABBREV CH STREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.") - (COND - (EXPANSION (* ; + (SETQ CH (TEDIT.SEL.AS.STRING TSTREAM] + (SETQ EXPANSION (\TEDIT.TRY.ABBREV CH TSTREAM)) (* ; "Find the abbreviation's expansion --first try it as-is, then try the upper-case version to be safe.") + (CL:WHEN EXPANSION (* ;  "It exists, so insert it where the abbrev used to be") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; "Force it to abandon caching") - (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ)) - (TEDIT.DELETE TEXTOBJ SEL) (* ; + (SETQ OLDLOOKS (TEDIT.GET.LOOKS TEXTOBJ)) + (TEDIT.DELETE TEXTOBJ SEL) (* ;  "First, delete the thing being expanded.") - (TEDIT.INSERT STREAM EXPANSION SEL OLDLOOKS]) + (TEDIT.INSERT TSTREAM EXPANSION SEL OLDLOOKS))]) (\TEDIT.EXPAND.DATE [LAMBDA (STREAM CH) (* ; "Edited 23-Feb-88 10:41 by jds") @@ -224,6 +201,6 @@ ("DATE" . \TEDIT.EXPAND.DATE) (">>DATE<<" . \TEDIT.EXPAND.DATE))) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3281 8423 (\TEDIT.ABBREV.EXPAND 3291 . 5638) (\TEDIT.EXPAND.DATE 5640 . 6273) ( -\TEDIT.TRY.ABBREV 6275 . 8421))))) + (FILEMAP (NIL (2866 7913 (\TEDIT.ABBREV.EXPAND 2876 . 5128) (\TEDIT.EXPAND.DATE 5130 . 5763) ( +\TEDIT.TRY.ABBREV 5765 . 7911))))) STOP diff --git a/library/tedit/TEDIT-ABBREV.LCOM b/library/tedit/TEDIT-ABBREV.LCOM index fe482f187f4daaa724be186d0974a6a518646240..4c61db59715ca68dda26402c6db4f2bdcb12a637 100644 GIT binary patch delta 837 zcmZvZ&1(}u7{(LRG|8k5mR?HL@-hcaz^t>MNta5qNhay0n{3>jex#;_(iB?zB~n2V zDTqf8%0R)J;8{?sc=YVSgW#q3A9$($2hJw3R&h@=@BE%;o_Y4s#PbVJ7YO9C<@L3! zLKGDgV(NKQH!!5}+TPCX&F%FL?Ck=E2Mcvtc4+J2)U($Y4~z^Td{!tMCQ(hIVb~9J z+gCcUDP)y7$APn)BuN-LtNX(CfBHPmpmfD{Xvw1%qh-LdlC9m{?WL26scNRI;N;(N zr~#9To&%GXZI&&z;Lgq#AhYSwdE1@yvt?l=oO0Rv>ixcxYHGwJ0#W)xnwGa=f)+qhPpoykz%ALo2s_98EQ%k@uvK2##)koGo;j z<<7fhJ`x!pv%2%QpKF5DYl6%aYFo#(B(Fx`;AQXd>&E#|TGlmaSC**fHbK^MAd0Y= zw~jc___To>gMh6FUNJMi&Lgf)bm|gUS4<)g^#19AFL{Y7TMttYJ#p!w*Qyf#K&3t7bfeo&n@{h@=e_s&JiqUc zpL}!m{+Ej+5iQ+rM&q$~9LPjEDW?-j0V2X`duzMVtk4O z|9ZQ#GoFT4dv_gMKm%va&g(i{ER`flfLe7IIsIEt5*I`+GOOuSwW#9IJP4%t4{>th ze~5vp)I6^kxt=DZ!vYJ9?WB*Fmc2M7(2)^G3d_I3RxW+K zr(THLJiWWI)N{fs8)ruaqd)LuIy>l=-aIL1IoJ5AcKn6cek1t&itmKo>>C*!KF1tB zEp41VD%JV}56}Gv>sLxej(y(;-5-3Bc#Ocg3dyF9P4SOTreLm&8Z@JTP8`&tVkxRa zEg-1`EF)~bQlO4n#B)S{c8OYM1rK5Jf*tGi)C`+i4iNcWAWwCQ|AgQ%JG6_-ldzSf zn`YStf>f40E{?S*d0T}k7wH0#oTS*2$4ulSWNHE|tx&}F#MN-aF>@tAiU_2tqnQRw zkPA*y?!goBUX*t+vJ5(%bs)~}1t7>rM4lZ6e(UEAP3PHq@LNBB^d^|{`*}7V61;pl zG}Fa1wmo9eysC>3$x~HVEQ*hWE+~3dHRmdbfxKxrs##fth-wE`V;18dPLbd<^ diff --git a/library/tedit/TEDIT-CHAT b/library/tedit/TEDIT-CHAT index d5bcc263..2a1637fa 100644 --- a/library/tedit/TEDIT-CHAT +++ b/library/tedit/TEDIT-CHAT @@ -1,199 +1,42 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:43"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-CHAT.;1 21593 +(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}TEDIT>TEDIT-CHAT.;14 12223 - :PREVIOUS-DATE "14-Jul-2022 10:40:06" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-CHAT.;1) + :EDIT-BY rmk + + :CHANGES-TO (VARS TEDIT-CHATCOMS) + (FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN) + + :PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}tedit>TEDIT-CHAT.;9) (PRETTYCOMPRINT TEDIT-CHATCOMS) (RPAQQ TEDIT-CHATCOMS - ((COMS (* ; "character routines") - (FNS TEDITCHAT.CHARFN \TEXTSTREAMBOUT)) - (COMS (FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN)) - (COMS (* ; "TEDIT update routines") + ((FNS TEDITSTREAM.INIT TEDITCHAT.MENUFN TEDITCHAT.CHARFN) + (COMS (* ; "WHO CALLS TEDIT.DISPLAYTEXT ?") (FNS TEDIT.DISPLAYTEXT)) (GLOBALVARS TEDITCHAT.MENU CHAT.DRIVERTYPES CHAT.DISPLAYTYPES) (VARS TEDITCHAT.MENUITEMS (TEDITCHAT.MENU)) (ADDVARS (CHAT.DRIVERTYPES (TEDIT TEDITCHAT.CHARFN NILL))) (DECLARE%: EVAL@COMPILE DONTCOPY (FILES (SOURCE) CHATDECLS)))) - - - -(* ; "character routines") - -(DEFINEQ - -(TEDITCHAT.CHARFN - [LAMBDA (CH CHAT.STATE) (* ; "Edited 12-Jun-90 18:00 by mitani") - (LET* [(TEXTSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE)) - (SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ TEXTSTREAM] - (\CARET.DOWN (fetch (TEXTOBJ DS) of (TEXTOBJ TEXTSTREAM))) - (SELCHARQ CH - (BS (\TEDIT.CHARDELETE TEXTSTREAM "" SEL) - [MOVETO (fetch X0 of SEL) - (fetch Y0 of SEL) - (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM]) - (LF NIL) - (BOUT TEXTSTREAM CH]) - -(\TEXTSTREAMBOUT - [LAMBDA (STREAM BYTE) (* ; "Edited 28-Mar-94 15:29 by jds") - - (* ;; "Do BOUT to a text stream, which is an insertion at the caret.") - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - CH# WINDOW TEXTLEN PS PC PSTR OFFST SEL) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (COND - ((NOT (CAR (fetch L1 of SEL))) - (RETURN))) (* ; - "Return if caret out of bounds, ie, user scrolls past end of text") - (SETQ CH# (fetch CH# of SEL)) - (AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#)) - (COND - ((IEQP BYTE 13) - (\INSERTCR BYTE CH# TEXTOBJ)) - (T (\INSERTCH BYTE CH# TEXTOBJ))) - (AND WINDOW - (PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES - NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE CURLINE - FONT (L1 (CAR (fetch L1 of SEL))) - (LN (CAR (fetch LN of SEL))) - (LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) - TEXTOBJ))) - (add (fetch CH# of SEL) - 1) (* ; - "These must be here, since SELs are valid even without a window.") - (replace CHLIM of SEL with (fetch CH# of SEL)) - (replace POINT of SEL with 'LEFT) - (replace DCH of SEL with 0) - (replace SELKIND of SEL with 'CHAR) - (SETQ CURLINE L1) - (add (fetch CHARLIM of CURLINE) - 1) - (add (fetch CHARTOP of CURLINE) - 1) - (SETQ FONT (fetch CLFONT of LOOKS)) - (DSPFONT FONT (CAR WINDOW)) - [COND - [(OR (IGREATERP (PLUS (fetch X0 of SEL) - (CHARWIDTH BYTE FONT)) - (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - 8)) - (IEQP BYTE (CHARCODE CR))) (* ; - "gone off the edge of the line reformat and add new line") - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ (CAR WINDOW)) - (SETQ L1 (CAR (fetch L1 of SEL))) - (SETQ LN (CAR (fetch LN of SEL))) - (COND - ([OR (NULL (SELECTQ (fetch POINT of SEL) - (LEFT L1) - (RIGHT LN) - NIL)) - (ILEQ (SELECTQ (fetch POINT of SEL) - (LEFT (fetch YBOT of L1)) - (RIGHT (fetch YBOT of LN)) - 0) - (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL (CAR WINDOW] - (* ; - "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") - (while (ILESSP (fetch Y0 of SEL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - do (* ; - "The caret just went off-screen. Move it up some.") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) - (SCROLLW (CAR WINDOW) - 0 - (LLSH (COND - [(SELECTQ (fetch POINT of SEL) - (LEFT L1) - (RIGHT LN) - NIL) - (fetch LHEIGHT - of (SELECTQ (fetch POINT of SEL) - (LEFT L1) - (RIGHT LN) - (SHOULDNT] - (T 12)) - 1] - (T (TEDIT.DISPLAYTEXT TEXTOBJ BYTE (CHARWIDTH BYTE FONT) - CURLINE - (fetch X0 of SEL) - (CAR WINDOW) - SEL) (* ; - "Print out the character on the screen") - (add (fetch X0 of SEL) - (CHARWIDTH BYTE FONT)) - - (* ;; "And move the selection's notion of our X position to the right to account for that character's width.") - - (replace XLIM of SEL with (fetch X0 of SEL] - -(* ;;; "Fix up the TEXTSTREAM so that the FILEPTR looks like it ought to after the BOUT, even though we've been updating the screen (which usually moves the fileptr....)") - - [SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC) - of TEXTOBJ] - (* ; - "This piece resides in a STRING. Because it's newly 'typed' material.") - (replace (TEXTSTREAM PIECE) of STREAM with PC) - (* ; - "Remember the current piece for others.") - (* ; "And which number piece this is.") - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) - of PS) - (LRSH (SETQ OFFST - (ffetch (STRINGP OFFST) - of PS)) - 1))) - (* ; - "Pointer to the actual characters in the string (allowing for substrings.)") - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH - ) of STREAM - with (LOGAND 1 OFFST)) - (fetch (TEXTOBJ \INSERTLEN) - of TEXTOBJ))) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (* ; - "Page # within the 'file' where this piece starts") - (freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) of STREAM)) - (freplace (STREAM EPAGE) of STREAM with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (* ; - "We're, perforce, at the end of the piece.") - (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) - (* ; "We're not on a file....") - ]) -) (DEFINEQ (TEDITSTREAM.INIT - [LAMBDA (WINDOW MENUFN) (* ; "Edited 12-Jun-90 18:01 by mitani") + [LAMBDA (WINDOW MENUFN) (* ; "Edited 23-Dec-2023 09:06 by rmk") + (* ; "Edited 4-Nov-2022 17:21 by rmk") + (* ; "Edited 12-Jun-90 18:01 by mitani") - (* ;; "Initialize and return TEDIT TEXTSTREAM") + (* ;; "Initialize and return TEDIT TEXTSTREAM on WINDOW.") - (PROG* ((TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL)) - (TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ; + (LET [(TEXTSTREAM (OPENTEXTSTREAM NIL WINDOW NIL NIL '(COPYBYBKSYSBUF T] + (* ;  "force shift select typein to be put in keyboard buffer") - (TEXTPROP TEXTSTREAM 'COPYBYBKSYSBUF T) - (replace (STREAM STRMBOUTFN) of TEXTSTREAM with '\TEXTSTREAMBOUT) - (replace SET of (fetch (TEXTOBJ SEL) of TEXTOBJ) with T) - [replace L1 of (fetch (TEXTOBJ SEL) of TEXTOBJ) with (LIST (fetch DESC - of (fetch (TEXTOBJ THISLINE) - of TEXTOBJ] (* ;  "hookup middle button menu instead of TEDIT menu") - (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN) - (RETURN TEXTSTREAM]) + (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN MENUFN) + TEXTSTREAM]) (TEDITCHAT.MENUFN [LAMBDA (WINDOW) (* || "20-Oct-86 15:03") @@ -226,22 +69,40 @@ (NIL) (APPLY* COMMAND STATE WINDOW)) (replace (CHAT.STATE HELD) of STATE with NIL]) + +(TEDITCHAT.CHARFN + [LAMBDA (CH CHAT.STATE) (* ; "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]) ) -(* ; "TEDIT update routines") +(* ; "WHO CALLS TEDIT.DISPLAYTEXT ?") (DEFINEQ (TEDIT.DISPLAYTEXT - [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 12-Jun-90 18:01 by mitani") + [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 23-Dec-2023 09:15 by rmk") + (* ; "Edited 6-Apr-2023 21:39 by rmk") + (* ; "Edited 4-Nov-2022 17:18 by rmk") + (* ; "Edited 25-Sep-2022 13:34 by rmk") + (* ; "Edited 6-Aug-2022 13:28 by rmk") + (* ; "Edited 12-Jun-90 18:01 by mitani") (* This function does the actual  displaying of typed-in text on the  edit window.) + (HELP 'TEDIT.DISPLAYTEXT 'NOTUSED?) (PROG ((LOOKS (\TEDIT.APPLY.STYLES (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) - TEXTOBJ)) + (\TEDIT.CARETPIECE TEXTOBJ) + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) (TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) DY FONT) (MOVETO XPOINT (IPLUS (fetch YBASE of LINE) @@ -254,8 +115,6 @@  Use it.) (RESETLST (RESETSAVE \PRIMTERMSA TERMSA) - (replace (TEXTSTREAM REALFILE) of (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - with DS) [COND [(STRINGP CH) (for CHAR instring CH @@ -282,11 +141,11 @@ 'TEXTURE 'REPLACE WHITESHADE) (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) - (IMAX 6 (CHARWIDTH CH FONT)) - (fetch LHEIGHT of LINE) - 'TEXTURE - 'REPLACE WHITESHADE)) + (EOL (BITBLT NIL 0 0 DS XPOINT (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CH FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) (\DSPPRINTCHAR (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) CH])] (T (* No special handling; @@ -302,12 +161,12 @@ 'TEXTURE 'REPLACE WHITESHADE) (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) - (fetch YBOT of LINE) - (IMAX 6 (CHARWIDTH CHAR FONT)) - (fetch LHEIGHT of LINE) - 'TEXTURE - 'REPLACE WHITESHADE)) + (EOL (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CHAR FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) (BLTCHAR CHAR DS] (T (SELCHARQ CH (TAB (* Put down white) @@ -318,13 +177,13 @@ 'TEXTURE 'REPLACE WHITESHADE) (RELMOVETO 36 0 DS)) - (CR (* Blank out the CR's width.) - (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) - (fetch YBOT of LINE) - (IMAX 6 (CHARWIDTH CH FONT)) - (fetch LHEIGHT of LINE) - 'TEXTURE - 'REPLACE WHITESHADE)) + (EOL (* Blank out the CR's width.) + (BITBLT NIL 0 0 DS (DSPXPOSITION NIL DS) + (fetch YBOT of LINE) + (IMAX 6 (CHARWIDTH CH FONT)) + (fetch LHEIGHT of LINE) + 'TEXTURE + 'REPLACE WHITESHADE)) (BLTCHAR CH DS]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -353,7 +212,6 @@ CHATDECLS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1070 11167 (TEDITCHAT.CHARFN 1080 . 1769) (\TEXTSTREAMBOUT 1771 . 11165)) (11168 14251 -(TEDITSTREAM.INIT 11178 . 12411) (TEDITCHAT.MENUFN 12413 . 14249)) (14290 20705 (TEDIT.DISPLAYTEXT -14300 . 20703))))) + (FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN + 3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333))))) STOP diff --git a/library/tedit/TEDIT-CHAT.LCOM b/library/tedit/TEDIT-CHAT.LCOM index 3d3045aa60a978750f42e3b1c74bc2aa3ac3e38e..ac40324226dcff04bb3775473b4d31a0120828db 100644 GIT binary patch delta 2262 zcmaJ@&2Jk;6t_$Ha!W}AP17i@9+6UstKavB zl$Be%+hwXz2AXM6Zc(xXrKRnoN00Xpc6Z?D5SHNUepj?yG5F?_gZ&4`_m7`^Dn-kY z=~`}fY+1QY_zD!3C_VE>bc+*9M}H5FcgGI5_wFA)-2HOd0`w8TSezfCec1NYrz0yZ zCkkA9AjPJH{X_KF?zt{Zx~)_yOR#hQD+KqdaQf0pq11L<(F}!+K2hnFIgWE0{%=x1 zD8<@X3S7A{fa6D>L%~AG-kONY(udN99Y!hmq!LZP8?8X8?Tv(yL>%3U<2mvbDI&nS zBa;fIWxyg@K`1sHzZaETm;jc)TDBh_r#+&?;+mxylRbI*>%t9lrI6HbGMd$@6-x1+ zmp>eSkk92V?A7;nj&k_-&g*Kun$OiAs*Qa~t(}=%iJB1fWZ&^xem@BP00;*^5T0sA z>KIFl#Yj6P9qEd$@Oo_z#ZZG%(+>uXLE~ODh#I{%$dwVOXTM!}|25TSSxJ+G1X=(Z zy4sX}V;vkIkSIh_-Wvgk20%_;>J#2M`2NTj$Jn`>W zzb!_NWvzxH60+@w-Dnls6T0zdvp4e3<0rE>FU~D&&&9vY{+*wXe|Ybw;e3j_(x1)X zaAv?(D++?p@l@AC;8cUgy@n$jE~2a@RS5e|OLlBvvl)P)!}78nhW4PWWT4l^-+sG| zg#cEKm#^I#(ppwC;DliqoZhAYuBGx`sP+V0#}h3PHA5$mehAFa&WYHWH5++V){LIF zCS&Vi=8>Yuj7$`}o&lj)L?u_QC}-1ADXC72h+&MaiIGx5S(B=MPF0`bQ?mGQ?w{2g z@8)xFCc~91N%!k18F)RV?uZ)CzPSExeu$}K`x8Fs6d9ZGftzX!vNm#T3UX&N@FPb$ zz6V@aNHcLw!8K6cknYf;(E+mvu*y?V$P9(uJu%%Ov zg{^4_6qD@w!(?7KGCI|=gTNhBA~|qH1jwxH9#DfHI0D&<_gqJ~ftq?!8#iA^K4;X? zwR1e-IIL5&<~XCF7>-7O>0@(_VW)L5(v*l{oig4soVYAF)6Yd>NRugRigTSdO#M@y?-K6JgTs0CRxW0cc0^OXpKz=Eg>bhopyv6$~lbYc9vKNWgT~Ox} z9lEGg;*S>Z#LpL(@1$o)?Cd?j_fkEZP+EoC_~iFHJ~VCD9lfA0{U*2@=ZlN+&Em)T WLcCtA#7~M0cRv@&vpa5>VDLvw~psop}-id>7* zSQI3x3%4m+8-atqq)39+3Gxs)fP)t3!|t|5fix+BJb4W`$wMACKpu($dDjAcD+>2J z_ue6gl-7Mn`M|mN&N=6vd+xd4IpgwtuYwbefWdam+arysPTxw0%{=XN)R3(+u*jlY_-m;vAyHbQ<+4QJklWTf% zEt&qE=00lQyUdo;+_c=X_^X$yY^|7`PSlvfT+?PXmSmo}<+&bqyuvIDb6VFUH7&d? zl$TkgHxY?U7*i4a9$lM_M#|4pQ}h>RqtS4Gp1)gf`B%>$YW;GTD6QY)|AJw{63-DS zb5Twb^QX_hwI3_5PZL8dl28}{%r-@xeC&OIhmf5t5UYWXSMm{Emt0`98qEVey%_a?&?3>ir7OT-yoie-$-HEfOjSu zv|>^DPM6OsLc;8SU7!8xqNEClrw)G=pX!ef#;1d!x9Ir9<3aZzel2KbL8_|4Nbmkwfj}v?!1X8v8aY6V!XI_r{ z^})W>b|U)Z+Ycf?54a;z)x`fi`Qd}ezlz>|{6>ExdJxcDrh*C;Rxcy?rkMKM&ivP} zlHr8{*WUH7{fBUh`|p>HmNb-;4@69CVDq1QhB$(y4_*z-8lSlEE`GHixX7PAiu^=4 zZzX=czixjz5j!~lkD=;I8gN5+E@_f!<`(LXZ8upe2XHPs4Z8?D)dAZ@ zw^p#NTFt87teZCpzO}T*ZUf3Fx@jrGeiGlPQQTdH9Ku%(*f*R&OX?(tW3-Y=1rf!l z)$Hw6*W0!Mm$?kPZB<>f?iI=`n;UfMEQ9I992KL!xysQMtEqe2hzwcaxD2gXb=bs& zax{b7AZTWX0VadM77Ww!MRZQ*^g%RAXTdm#S?LUjhCM7I)YHS!EsYp5e3#0lcswYY zu#8pnoH}Azk^#37Z&K+Tv&|AUc(NelV@l5i1X@}Wj0y$d(>@aBrjkSa)pKfSYCR2R zgrd;YdMc2tL+A0A8iq(4ooqT-tB#m1)YX$%3lV78tRaDxg((N*S|+>{4dFG=R6{r# z(y7=N@(>ZL)C?>!s;ino^covN8gO96V8oL99B$4WDZS_tcR~fO@_Bi$%VIB zfgcW8luUTjmGlT7wk%kug87H-uqhSt(1E2Cgyn!P9e#oIYDk4O1Vl(Vg61&KLaY|f zi^H%ia#7J=wW^jEbwmxjYdR(ko`QfrN;1RT2D= zuYUImg8KgYe(M^6>mXqrWU8~XlN$o0OK*O>Cz>3?JNpX@@zM(d2l+_+5Bf4+6+!Uu z7xBpGh>-TI)s?oU|H&q(S6TGc@d ztD=ysqU0ELF9ktlY(x`>h@}za!i5tY#qpe4lS&nC@VZ%Ws#U}R%GGb0(rX(Ci{!c3 zST)7L%|qCv`cXxAFP*g8f8Iv5kzt#rStB{9iLzS!dKzrfqg>!M0%&M)lEH)V>x%1>Q07LPaQI4zRz|8CCB?oO3kJa7Go zkG}iKgm$HIas?T46=Fn_{|5OZ|%pLb6mOHxb!d5ZKzs|G%JkrHs_>j2zdTf z`N@Z6C^z?X?P3G%nsZz|0ESKpFtXuV9gYG2tRvsbvixS=^71z2R^ilKLzYoDZFw)F zA^#Z=s)#0|a#Wn4;cH|OBweKVgaSi3xNIB}Dxm^`4&F+&QOTQiI4?pGAc%?zWcxLS zgl(kIKt>$&Wi688IW;N;#8`@ZIEA%a2JR3!mWd7yq8^G`I-s#`qAxRRbDvfDy<~ z7d;%k!k|NUK6G!rh2({9fFuG@g2->j2($=?_%)A6)h)0fJp~%#2F%4n4?xZWJFOOD z6wZX_i3?ATox#$8Z&Vb?S(n+wm!6MCo{=|1x_n+)=MW)#ug~VcR4fQ|nUFQ~)W?$t zk4;WxJ$$A4((IS7a-889$N%_ML4Ro~`oe?gM}|bi=<~+x8#B(_7$VZ;$mrOk$PO-M z=7EdOTmX!8pE5!vv2o`*D4iDxAOFd@{(-aL%mX67PS2n1#5oZC5uv2HZ*m-vONsbP zvUNF5iq+k(5*QhmusiWhF77A(l>OvG8({QQao=#_VrnRQ_;_dj!RPJ^4k_(lZi31q|VGjsQbqG0;9hF&*Cn#!yVZ2#Y$3+W|KWIp9WtJ;tqJ zqVXY^A>h^!4+Cxu@nM{lt|7)se$+?-H)Y5Hw~AbKoD?owzzH^zopB0+Ci;x+aawz#*y zd$PONYoD-_?pd#M)IMEYW{DCq+hJZzCk2`GSkbr)IxYwwHREGn4F)@G5 z&W`C@-{o_M9SqFViJP{QH|$$RJ**rFr(gtstXsEmw}_oRl18BHC5*iAWQoxC zH4;af8pR@~Ph1e45SkB{C(To}Y@C*mvE8?JJ4YmLv3SzCbH{Jvvv#Rb72g24@whwiYf+N!_I6L8&Mu$ebnm2d z++*Flfp|G9muDRvpY<+EGd4|JdZF|tX@>82@0~(Pkg~g2Dg@uf2X!vMIi_6*ODH<@ zfzw-cY7|aj_+ppAK)vo>*Jmh~_d0hwd#o$?p6Uqkaplan>local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;1 48554 +(FILECREATED "26-Feb-2024 11:22:29" {WMEDLEY}tedit>TEDIT-COMMAND.;62 45850 - :PREVIOUS-DATE "14-Jul-2022 11:08:09" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-COMMAND.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.COMMAND.LOOP) + + :PREVIOUS-DATE "22-Feb-2024 23:15:00" {WMEDLEY}tedit>TEDIT-COMMAND.;61) (PRETTYCOMPRINT TEDIT-COMMANDCOMS) (RPAQQ TEDIT-COMMANDCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS \TEDIT.INSERT.TTY.BUFFER \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE - \PNC \TEDIT.COMMAND.LOOP \TEDIT.COMMAND.RESET.SETUP) + [[DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) + (CONSTANTS (MSPACE 153) + (NSPACE 152) + (THINSPACE 159) + (FIGSPACE 154)) + (EXPORT (CONSTANTS (NONE.TTC 0) + (CHARDELETE.TTC 1) + (WORDDELETE.TTC 2) + (DELETE.TTC 3) + (FUNCTIONCALL.TTC 4) + (REDO.TTC 5) + (UNDO.TTC 6) + (CMD.TTC 7) + (NEXT.TTC 8) + (EXPAND.TTC 9) + (CHARDELETE.FORWARD.TTC 10) + (WORDDELETE.FORWARD.TTC 11) + (PUNCT.TTC 20) + (TEXT.TTC 21) + (WHITESPACE.TTC 22)) + (MACROS \TEDIT.MOUSESTATE \TEDIT.CHECK) + (RECORDS TEDITTERMCODE) + + (* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character (RMK: THESE DON'T SEEM TO BE USED)") + + (CONSTANTS (NOTBEFORE.LB 1) + (* ; + "Must not break before this character (e.g. Japanese right-paren)") + (NOTAFTER.LB 2) + (* ; + "Must not break after this character (e.g. Japanese open-quote)") + (BEFORE.LB 4) + (* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)") + (AFTER.LB 8) + (* ; + "OK to break after this char, if it's OK to break before the next one (true of most white space)") + (DISAPPEAR-IF-NOT-SPLIT.LB 16) + (* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)") + (NEWCHAR-IF-SPLIT.LB 32) + (* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.") + ] + (FNS \TEDIT.INTERRUPT.SETUP \TEDIT.MARKACTIVE \TEDIT.MARKINACTIVE \TEDIT.COMMAND.LOOP + \TEDIT.COMMAND.RESET.SETUP) [INITVARS (TEDIT.INTERRUPTS '((2 BREAK) (5 ERROR) (7 HELP) (20 CONTROL-T] - (VARS (TEDIT.COPY.PENDING NIL) - (TEDIT.COPYLOOKS.PENDING NIL) - (TEDIT.MOVE.PENDING NIL) - (TEDIT.DEL.PENDING NIL) - (TEDIT.BLUEPENDINGDELETE NIL)) - (GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING TEDIT.DEL.PENDING - TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS) + (VARS (|| NIL)) + (GLOBALVARS || TEDIT.INTERRUPTS) (COMS (* ; "Read-table Utilities") (FNS \TEDIT.READTABLE \TEDIT.WORDBOUND.READTABLE TEDIT.GETSYNTAX TEDIT.SETSYNTAX - TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET) + TEDIT.GETFUNCTION TEDIT.SETFUNCTION TEDIT.WORDGET TEDIT.WORDSET + TEDIT.ATOMBOUND.READTABLE) [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.READTABLE (\TEDIT.READTABLE)) (TEDIT.WORDBOUND.READTABLE ( \TEDIT.WORDBOUND.READTABLE ] - (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)))) - -(FILESLOAD TEDIT-DCL) + (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE)) + (COMS (* ; "Wheelscroll") + (FILES (SYSLOAD FROM LISPUSERS) + WHEELSCROLL) + (FNS \TEDIT.WHEELSCROLL) + (GLOBALVARS WHEELSCROLLCHARCODES) + (VARS (WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL]) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -46,45 +85,158 @@ (CONSTANTS (\SCRATCHLEN 64)) ) +(DECLARE%: EVAL@COMPILE + +(RPAQQ MSPACE 153) + +(RPAQQ NSPACE 152) + +(RPAQQ THINSPACE 159) + +(RPAQQ FIGSPACE 154) + + +(CONSTANTS (MSPACE 153) + (NSPACE 152) + (THINSPACE 159) + (FIGSPACE 154)) +) + +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(RPAQQ NONE.TTC 0) + +(RPAQQ CHARDELETE.TTC 1) + +(RPAQQ WORDDELETE.TTC 2) + +(RPAQQ DELETE.TTC 3) + +(RPAQQ FUNCTIONCALL.TTC 4) + +(RPAQQ REDO.TTC 5) + +(RPAQQ UNDO.TTC 6) + +(RPAQQ CMD.TTC 7) + +(RPAQQ NEXT.TTC 8) + +(RPAQQ EXPAND.TTC 9) + +(RPAQQ CHARDELETE.FORWARD.TTC 10) + +(RPAQQ WORDDELETE.FORWARD.TTC 11) + +(RPAQQ PUNCT.TTC 20) + +(RPAQQ TEXT.TTC 21) + +(RPAQQ WHITESPACE.TTC 22) + + +(CONSTANTS (NONE.TTC 0) + (CHARDELETE.TTC 1) + (WORDDELETE.TTC 2) + (DELETE.TTC 3) + (FUNCTIONCALL.TTC 4) + (REDO.TTC 5) + (UNDO.TTC 6) + (CMD.TTC 7) + (NEXT.TTC 8) + (EXPAND.TTC 9) + (CHARDELETE.FORWARD.TTC 10) + (WORDDELETE.FORWARD.TTC 11) + (PUNCT.TTC 20) + (TEXT.TTC 21) + (WHITESPACE.TTC 22)) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON + + (* Test to see if only the specified mouse button is down. + DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last + time it WAS called.) + + (SELECTQ (CAR BUTTON) + (LEFT '(IEQP LASTMOUSEBUTTONS 4)) + (MIDDLE '(IEQP LASTMOUSEBUTTONS 1)) + (RIGHT '(IEQP LASTMOUSEBUTTONS 2)) + (SHOULDNT)))) + +(PUTPROPS \TEDIT.CHECK MACRO [ARGS (COND + [(AND (BOUNDP 'CHECK) + CHECK) + (CONS 'PROGN + (for I in ARGS as J on ARGS + when (NOT (STRINGP I)) + collect (LIST 'OR I (LIST 'HELP + "TEdit consistency-check failure [RETURN to continue]: " + (COND + ((STRINGP (CADR J))) + (T (KWOTE I] + (T (CONS COMMENTFLG ARGS]) +) +(DECLARE%: EVAL@COMPILE + +(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) + (TTDECODE (LOGAND DATUM 31)))) +) +(DECLARE%: EVAL@COMPILE + +(RPAQQ NOTBEFORE.LB 1) + +(RPAQQ NOTAFTER.LB 2) + +(RPAQQ BEFORE.LB 4) + +(RPAQQ AFTER.LB 8) + +(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16) + +(RPAQQ NEWCHAR-IF-SPLIT.LB 32) + + +(CONSTANTS (NOTBEFORE.LB 1) + (NOTAFTER.LB 2) + (BEFORE.LB 4) + (AFTER.LB 8) + (DISAPPEAR-IF-NOT-SPLIT.LB 16) + (NEWCHAR-IF-SPLIT.LB 32)) +) + +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) ) (DEFINEQ -(\TEDIT.INSERT.TTY.BUFFER - [LAMBDA (SCRATCH PASS TEXTOBJ SEL) (* ; "Edited 23-Feb-88 11:11 by jds") - - (* ;; "OBSOLETE 2/9/86 ?? JDS") - - (* ;; "(PROG ((TLEN (fetch (STRINGP OFFST) of SCRATCH))) (COND ((NOT (ZEROP TLEN)) (* If there are typed-ahead characters cached, insert them in the text object and clear the cache.) (replace (STRINGP OFFST) of SCRATCH with 0) (replace (STRINGP LENGTH) of SCRATCH with \SCRATCHLEN) (replace (STRINGP LENGTH) of PASS with TLEN) (TEDIT.\INSERT PASS SEL TEXTOBJ BLANKSEEN CRSEEN))))") - - (HELP]) - (\TEDIT.INTERRUPT.SETUP - [LAMBDA (PROC FORCEOFF) (* jds "12-Sep-84 15:36") - (* Disarm any inconvenient interrupts, - and save re-arming info on the window.) - [PROG [(TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW) - (WINDOWPROP (PROCESSPROP PROC 'WINDOW) - 'TEXTOBJ) - (TEXTOBJ (PROCESSPROP PROC 'WINDOW] - (UNINTERRUPTABLY - [COND - ((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) - (* There are disarmed interrupts; - re-arm them.) - (RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) - (PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL)) - ([AND (NOT FORCEOFF) - (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS] - (* There aren't any interrupts - disarmed; go do it.) - (PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS - (OR (AND TEXTOBJ (TEXTPROP TEXTOBJ - 'INTERRUPTS)) - TEDIT.INTERRUPTS) - T])] + [LAMBDA (PROC FORCEOFF) (* ; "Edited 22-Sep-2023 20:45 by rmk") + (* jds "12-Sep-84 15:36") + + (* ;; "Disarm any inconvenient interrupts, and save re-arming info on the window.") + + [LET [(TEXTOBJ (AND (PROCESSPROP PROC 'WINDOW) + (WINDOWPROP (PROCESSPROP PROC 'WINDOW) + 'TEXTOBJ) + (TEXTOBJ (PROCESSPROP PROC 'WINDOW] + (UNINTERRUPTABLY + [COND + ((AND FORCEOFF (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) + (* ; + "There are disarmed interrupts; re-arm them.") + (RESET.INTERRUPTS (PROCESSPROP PROC 'TEDIT.INTERRUPTS)) + (PROCESSPROP PROC 'TEDIT.INTERRUPTS NIL)) + ([AND (NOT FORCEOFF) + (NOT (PROCESSPROP PROC 'TEDIT.INTERRUPTS] + (* ; + "There aren't any interrupts disarmed; go do it.") + (PROCESSPROP PROC 'TEDIT.INTERRUPTS (RESET.INTERRUPTS + (OR (AND TEXTOBJ (GETTEXTPROP TEXTOBJ + 'INTERRUPTS)) + TEDIT.INTERRUPTS) + T])] PROC]) (\TEDIT.MARKACTIVE @@ -97,295 +249,187 @@ (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) TEXTOBJ]) -(\PNC - [LAMBDA (CH STR) (* jds " 7-JUN-82 14:03") - (PROG ((LEN (fetch (STRINGP LENGTH) of STR)) - (OFFST (fetch (STRINGP OFFST) of STR))) - (COND - ((ZEROP LEN) - (ERROR "NO ROOM LEFT IN STRING TO PUT CHARACTER")) - (T (UNINTERRUPTABLY - (\PUTBASEBYTE (fetch (STRINGP BASE) of STR) - OFFST CH) - (replace (STRINGP OFFST) of STR with (ADD1 OFFST)) - (replace (STRINGP LENGTH) of STR with (SUB1 LEN)))]) - (\TEDIT.COMMAND.LOOP - [LAMBDA (STREAM RTBL) (* ; "Edited 30-May-91 19:33 by jds") + [LAMBDA (STREAM RTBL) (* ; "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 (COND - ((type? STREAM STREAM) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (T STREAM))) - (ISCRSTRING (ALLOCSTRING \SCRATCHLEN " ")) - SEL WINDOW LINES IPASSSTRING TTYWINDOW) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (SETQ IPASSSTRING (SUBSTRING ISCRSTRING 1)) (* ; "Used inside \INSERT\TTY\BUFFER") - (SETQ RTBL (OR RTBL (fetch (TEXTOBJ TXTRTBL) of TEXTOBJ) + (PROG ((TEXTOBJ (CL:IF (type? STREAM STREAM) + (fetch (TEXTSTREAM TEXTOBJ) of STREAM) + STREAM)) + SEL PANES) + (\DTEST 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 WW inside WINDOW do (WINDOWPROP WW 'PROCESS (THIS.PROCESS))) - (* ; "And the window to this process") - (while (NOT (TTY.PROCESSP)) do (* ; + (for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS))) + (* ; "Add the pane to this process") + (until (TTY.PROCESSP) do (* ;  "Wait until we really have the TTY before proceeding.") - (DISMISS 250)) + (DISMISS 250)) (RESETLST - (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ WINDOW) + (RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ PANES) T)) - (PROG (CH FN TCH (DIRTY NIL) - (BLANKSEEN NIL) - INSCH# - (CRSEEN NIL) - TLEN CHNO (READSA (fetch READSA of %#CURRENTRDTBL#)) - (TERMSA (OR (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ) - \PRIMTERMSA)) - (TEDITSA (fetch READSA of RTBL)) - (TEDITFNHASH (fetch READMACRODEFS of RTBL)) - (LOOPFN (TEXTPROP TEXTOBJ 'LOOPFN)) - (CHARFN (TEXTPROP TEXTOBJ 'CHARFN)) - COMMANDFN) - (while (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - do - [ERSETQ - (while (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - do - (PROGN - (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action") - (while (OR TEDIT.SELPENDING (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ)) - do (* ; - "Don't do anything while he's selecting or one of the lock-out ops is active.") - [COND - ((EQ TEDIT.SELPENDING TEXTOBJ) + (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)) (* ; - "(OR (EQ TEDIT.SELPENDING TEXTOBJ) (fetch TCUP of (fetch CARET of TEXTOBJ)))") - (* ; - "If this TEdit is the one being selected in, or the caret is explicitly visible, flash it") - (TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ] - (BLOCK)) - [COND - ((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - (T (COND - ((fetch (TEXTOBJ TXTNEEDSUPDATE) of 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.") - (\SHOWSEL SEL NIL NIL) - (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (TEDIT.FLASHCARET (fetch (TEXTOBJ CARET) of TEXTOBJ)) - (* ; + (\SHOWSEL SEL NIL) + (TEDIT.UPDATE.SCREEN TEXTOBJ) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T)) + (\TEDIT.FLASHCARET TEXTOBJ) (* ;  "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) + (FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;  "Before starting to work, note that we're doing something.") - (AND LOOPFN (ERSETQ (APPLY* LOOPFN STREAM))) - (* ; - "If the guy wants control during the loop, give it to him.") - (* ; "Process any pending selections") - [COND - (TEDIT.COPY.PENDING (* ; - "Have to copy the shifted SEL to caret.") - (SETQ TEDIT.COPY.PENDING NIL) - (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ - SHIFTEDSEL - ) - of TEXTOBJ)) - (ERSETQ (TEDIT.COPY (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ) - (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION - with NIL) - (replace (SELECTION L1) of TEDIT.SHIFTEDSELECTION - with NIL) - (replace (SELECTION LN) of TEDIT.SHIFTEDSELECTION - with NIL) - (\COPYSEL TEDIT.SHIFTEDSELECTION (fetch (TEXTOBJ - SHIFTEDSEL - ) - of TEXTOBJ))) - (TEDIT.COPYLOOKS.PENDING(* ; - "Have to copy the shifted SEL to caret.") - (SETQ TEDIT.COPYLOOKS.PENDING NIL) - (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ)) - [ERSETQ (COND - ((EQ 'PARA (fetch (SELECTION SELKIND) - of (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ))) - (* ; - "copy the paragraph looks, since the source selection type was paragraph") - (TEDIT.COPY.PARALOOKS TEXTOBJ (fetch (TEXTOBJ - SHIFTEDSEL) - of TEXTOBJ) - (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (T (* ; "copy the character looks") - (TEDIT.COPY.LOOKS TEXTOBJ (fetch (TEXTOBJ - SHIFTEDSEL - ) - of TEXTOBJ) - (fetch (TEXTOBJ SEL) of TEXTOBJ] - (\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - NIL NIL) - (replace (SELECTION SET) of TEDIT.COPYLOOKSSELECTION - with NIL) - (replace (SELECTION L1) of TEDIT.COPYLOOKSSELECTION - with NIL) - (replace (SELECTION LN) of TEDIT.COPYLOOKSSELECTION - with NIL) - (\COPYSEL TEDIT.COPYLOOKSSELECTION (fetch (TEXTOBJ SHIFTEDSEL) - of TEXTOBJ))) - (TEDIT.MOVE.PENDING (* ; - "Have to move the ctrl-shift SEL to caret.") - (SETQ TEDIT.MOVE.PENDING NIL) - (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL) - of TEXTOBJ)) - (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) - (ERSETQ (TEDIT.MOVE (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (replace (SELECTION SET) of TEDIT.MOVESELECTION - with NIL) - (replace (SELECTION L1) of TEDIT.MOVESELECTION - with NIL) - (replace (SELECTION LN) of TEDIT.MOVESELECTION - with NIL) - (\COPYSEL TEDIT.MOVESELECTION (fetch (TEXTOBJ MOVESEL) - of TEXTOBJ))) - (TEDIT.DEL.PENDING (* ; "Delete the current selection.") - (SETQ TEDIT.DEL.PENDING NIL) - (* ; - "Above all, reset the demand flag first") - (ERSETQ (COND - ((fetch (SELECTION SET) of - TEDIT.DELETESELECTION - ) - (* ; - "Only try the deletion if he really set the selection.") - (\SHOWSEL (fetch (TEXTOBJ DELETESEL) - of TEXTOBJ) - NIL NIL) - (* ; "Turn off the selection highlights") - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (replace (SELECTION SET) - of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - with NIL) - (\COPYSEL TEDIT.DELETESELECTION - (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (\TEDIT.SET.SEL.LOOKS (fetch (TEXTOBJ SEL) - of TEXTOBJ) - 'NORMAL) - (* ; "Grab the selection we're to use") - (\TEDIT.DELETE (fetch (TEXTOBJ SEL) - of TEXTOBJ) - (fetch (SELECTION \TEXTOBJ) - of (fetch (TEXTOBJ SEL) - of TEXTOBJ)) - NIL) - (replace (SELECTION L1) of - TEDIT.DELETESELECTION - with NIL) - (replace (SELECTION LN) of - TEDIT.DELETESELECTION - with NIL] - (UNINTERRUPTABLY - (replace (STRINGP OFFST) of ISCRSTRING with 0) - (replace (STRINGP LENGTH) of ISCRSTRING with \SCRATCHLEN)) - (while (\SYSBUFP) - do (* ; "Handle user type-in") - (SETQ CH (\GETKEY)) - (COND - (CHARFN (* ; + (CL:WHEN LOOPFN + (ERSETQ (APPLY* LOOPFN (FGETTOBJ TEXTOBJ STREAMHINT)))) + + (* ;; "") + + (* ;; + "Process any pending selections from \TEDIT.BUTTONEVENTFN, here instead of in MOUSE process") + + (SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL)) + (NORMAL (CL:WHEN (FGETSEL SOURCESEL SET) + (SETQ SEL (\COPYSEL SOURCESEL SEL)) + (* ; "SOURCESEL is new SEL selection") + (FSETTOBJ TEXTOBJ CARETLOOKS ( + \TEDIT.GET.INSERT.CHARLOOKS + TEXTOBJ SEL)) + (\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 (* ;  "Give the OEM user control for each character typed.") - (SETQ TCH (APPLY* CHARFN STREAM CH)) - (OR (EQ TCH T) - (SETQ CH TCH)) - (* ; + (SETQ TCH (APPLY* CHARFN (FGETTOBJ TEXTOBJ STREAMHINT) + CH)) + + (* ;;  "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.") - )) - (SELECTC (AND CH (\SYNCODE TEDITSA CH)) - (CHARDELETE.TTC (* ; + + (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 ISCRSTRING SEL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (WORDDELETE.TTC - (\TEDIT.WORDDELETE TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (DELETE.TTC (* ; + (\TEDIT.CHARDELETE TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (CHARDELETE.FORWARD.TTC + (\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (WORDDELETE.TTC + (\TEDIT.WORDDELETE TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (WORDDELETE.FORWARD.TTC + (\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (DELETE.TTC (* ;  "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE SEL TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (UNDO.TTC (* ; + (\TEDIT.DELETE TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (UNDO.TTC (* ;  "He hit the CANCEL key, so go UNDO something") - (TEDIT.UNDO TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (REDO.TTC (* ; + (TEDIT.UNDO TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (REDO.TTC (* ;  "He hit the REDO key, so go REDO something") - (TEDIT.REDO TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) - (FUNCTIONCALL.TTC - (* ; + (TEDIT.REDO TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (FUNCTIONCALL.TTC (* ;  "This is a special character -- it calls a function") - (COND - ([SETQ FN (CAR (FETCH MACROFN + (CL:WHEN [SETQ FN (CAR (FETCH MACROFN OF (GETHASH CH TEDITFNHASH] (* ;  "There IS a command function to be called.") - (APPLY* FN (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ) - TEXTOBJ SEL) + (APPLY* FN (FGETTOBJ TEXTOBJ STREAMHINT) + TEXTOBJ SEL) (* ; "do it") - (\SHOWSEL SEL NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; - "After a user function, no more blue-pending-delete") - (\SHOWSEL SEL NIL T) - (* ; "And forget any pending deletion.") - ))) - (NEXT.TTC (* ; + "After a user function (that is not wheelscroll) no more blue-pending-delete") + (CL:UNLESS (MEMB CH WHEELSCROLLCHARCODES) + (* ; + "The wheelscroll FN handled the selection. should preserve the highlighting") + (\SHOWSEL SEL NIL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (\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 (fetch (TEXTOBJ - STREAMHINT - ) - of TEXTOBJ))) - (SELECTC (AND TERMSA CH (fetch TERMCLASS - of (\SYNCODE TERMSA CH))) - (CHARDELETE.TC - (* ; + (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 ISCRSTRING - SEL) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (WORDDELETE.TC - (* ; "Back-WORD handler") - (\TEDIT.WORDDELETE TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (LINEDELETE.TC - (* ; + (\TEDIT.CHARDELETE TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (WORDDELETE.TC (* ; "Back-WORD handler") + (\TEDIT.WORDDELETE TEXTOBJ) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (LINEDELETE.TC (* ;  "DEL Key handler: Delete the selected characters") - (\TEDIT.DELETE SEL TEXTOBJ) - (TEDIT.RESET.EXTEND.PENDING.DELETE - SEL)) - (COND - (CH (* ; - "Any other key was hit: Just insert the character.") - (TEDIT.DO.BLUEPENDINGDELETE SEL TEXTOBJ) - (* ; - "Handle blue pending delete, if there is one.") - (TEDIT.\INSERT CH SEL TEXTOBJ BLANKSEEN CRSEEN - ] - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL] - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL))))]) + (\TEDIT.DELETE TEXTOBJ SEL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL)) + (CL:WHEN CH (* ; + "Any other key: insert the character.") + (\TEDIT.INSERT CH SEL TEXTOBJ))]) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))]) (\TEDIT.COMMAND.RESET.SETUP - [LAMBDA (TEXT&WIND STARTING) (* ; "Edited 12-Jun-90 18:04 by mitani") + [LAMBDA (TEXT&WIND STARTING) (* ; "Edited 22-Feb-2024 23:14 by rmk") + (* ; "Edited 5-Oct-2023 22:41 by rmk") + (* ; "Edited 22-Sep-2023 20:41 by rmk") + (* ; "Edited 16-Sep-2023 22:30 by rmk") + (* ; "Edited 5-Nov-2022 10:41 by rmk") + (* ; "Edited 12-Jun-90 18:04 by mitani") (* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing") @@ -399,8 +443,7 @@ [COND (STARTING (* ;  "We're going INTO the command loop. Set up all the stuff") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T) - (* ; + (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 @@ -416,11 +459,10 @@ (SETQ OTTYENTRYFN (PROCESSPROP (THIS.PROCESS) 'TTYENTRYFN '\TEDIT.PROCENTRYFN)) - [COND - ((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW) - 'DON'T) (* ; + (CL:UNLESS (EQ (GETTEXTPROP TEXTOBJ 'TTYWINDOW) + 'DON'T) (* ;  "He can suppress the ability to copy-select things into this window if he wants....") - (SETQ TTYWINDOW (OR (TEXTPROP TEXTOBJ 'TTYWINDOW) + (SETQ TTYWINDOW (OR (GETTEXTPROP TEXTOBJ 'TTYWINDOW) (CREATEW DEFAULTTTYREGION "TTY Window for TEdit" NIL T))) (SETQ OTTYWINDOW (TTYDISPLAYSTREAM TTYWINDOW)) (PROCESSPROP (THIS.PROCESS) @@ -431,14 +473,12 @@ (* ;  "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS") (WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN)) - (WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR WINDOW] - (replace (TEXTOBJ TXTEDITING) of TEXTOBJ with T) - (* ; + (WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR WINDOW))) + (FSETTOBJ TEXTOBJ TXTEDITING T) (* ;  "Tell TEdit that this document is actively being edited.") - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) (* ;  "Mark us un-busy so life can go on.") - ) + (FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)) (T (* ;  "Coming OUT OF the command loop -- reset everything") (PROCESSPROP (THIS.PROCESS) @@ -450,36 +490,28 @@ (\TEDIT.INTERRUPT.SETUP (THIS.PROCESS) T) (* ;  "Re-arm the interrupts we turned off coming in.") - (COND - ((AND (TXTFILE TEXTOBJ) - (NOT (WINDOWPROP (CAR WINDOW) - 'TEDIT-CLOSING-FILE T)))(* ; + (CL:WHEN [AND (TXTFILE TEXTOBJ) + (NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR WINDOW] + (* ;  "Remember to close the file we were editing (Only if the window function isn't closing it.)") - (CLOSEF? (TXTFILE TEXTOBJ)) - (WINDOWPROP (CAR WINDOW) - 'TEDIT-CLOSING-FILE NIL) (* ; - "And let anyone else who wants to try closing the file do so.") - )) + (CLOSEF? (TXTFILE TEXTOBJ)) (* ; + "Let anyone else who wants to close the file.") + (replace (TEXTWINDOW CLOSINGFILE) of (CAR WINDOW) with NIL)) (PROCESSPROP (THIS.PROCESS) 'TTYEXITFN OTTYEXITFN) (PROCESSPROP (THIS.PROCESS) 'TTYENTRYFN OTTYENTRYFN) - (replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with NIL) - (* ; + (FSETTOBJ TEXTOBJ TXTHISTORY NIL) (* ;  "To prevent circularities arising from the need to remember textobjs in the history list.") - (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with NIL) - (* ; - "To prevent a circularity thru the window back to the textobj.") - (replace (TEXTOBJ TXTEDITING) of TEXTOBJ with NIL) - (* ; + (FSETTOBJ TEXTOBJ SELPANE NIL) + (FSETTOBJ TEXTOBJ TXTEDITING NIL) (* ;  "Tell TEdit that this document is NO LONGER actively being edited.") - (COND - ((NEQ (TEXTPROP TEXTOBJ 'TTYWINDOW) - 'DON'T) (* ; + (CL:UNLESS (EQ (GETTEXTPROP TEXTOBJ 'TTYWINDOW) + 'DON'T) (* ;  "He can suppress the ability to copy-select things into this window if he wants....") (TTYDISPLAYSTREAM OTTYWINDOW) (PROCESSPROP (THIS.PROCESS) - 'TEDITTTYWINDOW NIL] + 'TEDITTTYWINDOW NIL))] (RETURN (LIST TEXTOBJ WINDOW OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW]) ) @@ -488,19 +520,10 @@ (7 HELP) (20 CONTROL-T))) -(RPAQQ TEDIT.COPY.PENDING NIL) - -(RPAQQ TEDIT.COPYLOOKS.PENDING NIL) - -(RPAQQ TEDIT.MOVE.PENDING NIL) - -(RPAQQ TEDIT.DEL.PENDING NIL) - -(RPAQQ TEDIT.BLUEPENDINGDELETE NIL) +(RPAQQ || NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS TEDIT.COPY.PENDING TEDIT.COPYLOOKS.PENDING TEDIT.MOVE.PENDING TEDIT.DEL.PENDING - TEDIT.BLUEPENDINGDELETE TEDIT.INTERRUPTS) +(GLOBALVARS || TEDIT.INTERRUPTS) ) @@ -510,29 +533,32 @@ (DEFINEQ (\TEDIT.READTABLE - [LAMBDA NIL (* ; "Edited 20-Apr-2018 07:59 by rmk:") + [LAMBDA NIL (* ; "Edited 24-Dec-2023 09:54 by rmk") + (* ; "Edited 20-Apr-2018 07:59 by rmk:") (* jds "12-Sep-86 13:48") - (* Create a TEdit read-table, to control which characters have what functions and - call which commands.) + (* ;; "Create a TEdit read-table, to control which characters have what functions and call which commands.") - (PROG [(RTBL (create READTABLEP - READMACRODEFS _ (HASHARRAY 50] - (for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL - in (LIST CHARDELETE.TTC CHARDELETE.TTC WORDDELETE.TTC DELETE.TTC UNDO.TTC NEXT.TTC - CMD.TTC REDO.TTC) do (* Set up the default syntax classes - for command characters) - (\SETSYNCODE (fetch READSA of RTBL) - CH CL)) - (for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND) - do (* Set up the default function-calling - characters (^X to expand abbrevs for - now)) - (TEDIT.SETFUNCTION CH FN RTBL)) - (TEDIT.SETFUNCTION (CHARCODE ^O) - (FUNCTION GET.OBJ.FROM.USER) - RTBL) (* And for image object capture) - (RETURN RTBL]) + (LET [(RTBL (create READTABLEP + READMACRODEFS _ (HASHARRAY 50] + + (* ;; "CHARDELETE.FORWARD replaces WORDDELETE on ^W") + + (for CH in (CHARCODE (BS ^A ^W DEL %#A %#B %#C ESC)) as CL + in (CONSTANT (LIST CHARDELETE.TTC CHARDELETE.TTC CHARDELETE.FORWARD.TTC DELETE.TTC + UNDO.TTC NEXT.TTC CMD.TTC REDO.TTC)) + do (* ; + "Set up the default syntax classes for command characters") + (\SETSYNCODE (fetch READSA of RTBL) + CH CL)) + (for CH in (CHARCODE (^X)) as FN in '(\TEDIT.ABBREV.EXPAND) + do (* ; + "Set up the default function-calling characters (^X to expand abbrevs for now)") + (TEDIT.SETFUNCTION CH FN RTBL)) + (TEDIT.SETFUNCTION (CHARCODE ^O) + (FUNCTION GET.OBJ.FROM.USER) + RTBL) (* ; "And for image object capture") + RTBL]) (\TEDIT.WORDBOUND.READTABLE [LAMBDA NIL (* ; "Edited 22-May-92 15:10 by jds") @@ -576,7 +602,8 @@ (RETURN RTBL]) (TEDIT.GETSYNTAX - [LAMBDA (CH TABLE) (* ; "Edited 31-Mar-87 10:01 by jds") + [LAMBDA (CH TABLE) (* ; "Edited 24-Dec-2023 09:47 by rmk") + (* ; "Edited 31-Mar-87 10:01 by jds") (* ;  "Find TEdit's interpretation of a given character") (SELECTC (\SYNCODE [fetch READSA of (COND @@ -602,8 +629,12 @@ (T CH))) (WORDDELETE.TTC 'WORDDELETE) + (WORDDELETE.FORWARD.TTC + 'WORDDELETE.FORWARD) (CHARDELETE.TTC 'CHARDELETE) + (CHARDELETE.FORWARD.TTC + 'CHARDELETE.FORWARD) (DELETE.TTC 'DELETE) (UNDO.TTC 'UNDO) (REDO.TTC 'REDO) @@ -615,7 +646,8 @@ NIL]) (TEDIT.SETSYNTAX - [LAMBDA (CHAR CLASS TABLE) (* ; "Edited 31-Mar-87 10:00 by jds") + [LAMBDA (CHAR CLASS TABLE) (* ; "Edited 24-Dec-2023 09:17 by rmk") + (* ; "Edited 31-Mar-87 10:00 by jds") (* ;  "SETS TEDIT-STYLE SYNTAX BITS IN A TERMTABLE") (PROG1 (TEDIT.GETSYNTAX (SETQ CHAR (COND @@ -641,7 +673,11 @@ CHAR (SELECTQ CLASS (CHARDELETE CHARDELETE.TTC) + (CHARDELETE.FORWARD + CHARDELETE.FORWARD.TTC) (WORDDELETE WORDDELETE.TTC) + (WORDDELETE.FORWARD + WORDDELETE.FORWARD.TTC) ((DELETE LINEDELETE) DELETE.TTC) (UNDO UNDO.TTC) @@ -739,6 +775,24 @@ (WHITESPACE WHITESPACE.TTC) (TEXT TEXT.TTC) TEXT.TTC]) + +(TEDIT.ATOMBOUND.READTABLE + [LAMBDA (READTABLE) (* ; "Edited 25-Dec-2023 13:10 by rmk") + (* ; "Edited 5-Dec-2023 23:47 by rmk") + + (* ;; "A wordbound table that approximates the unquoted OTHER characters of Lisp atoms as defined by READTABLE or the current readtable. This is specified as the BOUNDTABLE for Lisp source code edits. Not perfect, but not bad.") + + (* ;; "Could cache this for common readtables (interlisp, commonlisp)") + + (LET ((TABLE (\TEDIT.WORDBOUND.READTABLE))) (* ; + "\TEDIT.WORDBOUND.READTABLE creates a new one each time.") + (for CODE IN (GETSYNTAX 'OTHER (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE + 'TEXT TABLE)) + (for CODE IN (GETSYNTAX 'BREAK (OR READTABLE *READTABLE*)) do (TEDIT.WORDSET CODE + 'PUNCTUATION TABLE)) + (TEDIT.WORDSET (CHARCODE %:) + 'TEXT TABLE) + TABLE]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY @@ -750,11 +804,40 @@ (GLOBALVARS TEDIT.READTABLE TEDIT.WORDBOUND.READTABLE) ) + + + +(* ; "Wheelscroll") + + +(FILESLOAD (SYSLOAD FROM LISPUSERS) + WHEELSCROLL) +(DEFINEQ + +(\TEDIT.WHEELSCROLL + [LAMBDA NIL (* ; "Edited 2-Oct-2023 23:23 by rmk") + + (* ;; "TEDIT disables interrupts, so it has to deal with wheelscroll behaviors when the caret is in the Tedit window. Each of the individual actions is conditioned on WHEELSCROLLENABLED (which may or may not have been loaded).") + + (* ;; "This localizes the behavior inside Tedit, where we also suppress Tedit from thinking that somehow these characters change the selection highlighting.") + + (for I in WHEELSCROLLINTERRUPTS collect (TEDIT.SETFUNCTION (CAR I) + `[LAMBDA NIL + (AND WHEELSCROLLENABLED ,(CADR I] + TEDIT.READTABLE) + (CAR I]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS WHEELSCROLLCHARCODES) +) + +(RPAQ WHEELSCROLLCHARCODES (\TEDIT.WHEELSCROLL)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2178 34353 (\TEDIT.INSERT.TTY.BUFFER 2188 . 2770) (\TEDIT.INTERRUPT.SETUP 2772 . 4437) -(\TEDIT.MARKACTIVE 4439 . 4651) (\TEDIT.MARKINACTIVE 4653 . 4869) (\PNC 4871 . 5504) ( -\TEDIT.COMMAND.LOOP 5506 . 27793) (\TEDIT.COMMAND.RESET.SETUP 27795 . 34351)) (34915 48289 ( -\TEDIT.READTABLE 34925 . 36534) (\TEDIT.WORDBOUND.READTABLE 36536 . 39129) (TEDIT.GETSYNTAX 39131 . -41327) (TEDIT.SETSYNTAX 41329 . 43522) (TEDIT.GETFUNCTION 43524 . 44884) (TEDIT.SETFUNCTION 44886 . -47325) (TEDIT.WORDGET 47327 . 47588) (TEDIT.WORDSET 47590 . 48287))))) + (FILEMAP (NIL (7792 28983 (\TEDIT.INTERRUPT.SETUP 7802 . 9442) (\TEDIT.MARKACTIVE 9444 . 9656) ( +\TEDIT.MARKINACTIVE 9658 . 9874) (\TEDIT.COMMAND.LOOP 9876 . 22486) (\TEDIT.COMMAND.RESET.SETUP 22488 + . 28981)) (29267 44464 (\TEDIT.READTABLE 29277 . 30934) (\TEDIT.WORDBOUND.READTABLE 30936 . 33529) ( +TEDIT.GETSYNTAX 33531 . 35970) (TEDIT.SETSYNTAX 35972 . 38450) (TEDIT.GETFUNCTION 38452 . 39812) ( +TEDIT.SETFUNCTION 39814 . 42253) (TEDIT.WORDGET 42255 . 42516) (TEDIT.WORDSET 42518 . 43215) ( +TEDIT.ATOMBOUND.READTABLE 43217 . 44462)) (44792 45701 (\TEDIT.WHEELSCROLL 44802 . 45699))))) STOP diff --git a/library/tedit/TEDIT-COMMAND.LCOM b/library/tedit/TEDIT-COMMAND.LCOM index 89729111882a943d4bb973beab6274d5cb6b02c1..207a1dfffe699d5fef7abf17b3a62b6ed879e9a9 100644 GIT binary patch literal 14855 zcmcIrZERcDc_t~xc9={SCDnB`*F9DehY~_U_wqv@2@+kAS0*izmmx1jD+`*)A`{BG zm0U?_+BE~xqD6t_pW6YA+aXvQpy-cclxzXrnvPfpEO37;*w8=2Fbu;m?8k;eMgMJu zyyrb1_g+#=>;{_>llPqSp0D@wIq$iQX3fQX$&4-L3uY`|TC~`OvXNObE}LvTU$V_g zAzv+zvkMi|$lAt2p{IJmsG3Zhnh1xZG(rYswwYz)dOEh)ycW}^^d!@?IbEOAXUAD| zd~NFsH`bkIgKcfHarV`E(aaXil|OpMS--Zuy8V@Bcbkp%-DfdG-i~FgV$mpN<4>pc z2^JpLb#F*LF{h>Gl2haC+IG_&v-#y4+dEIpu@`y&xawc9tTJ22e2cY0f%%7t$K&Iy zv5HCikDnZ$c%Xef@IF{FHItfRb9{dbD{T7<8!SAR$r+`~W;JG8EV@{#_FMl1n=4n$ z<-Ap^#eKPd{i@8`Tp4oo4;>aF*3NVq zS*V9LqbgJK0c&;@u4q)2jEtRMHifQ{{>YwCp+_O8;QUFF*ZSzQ5Lqc-2uD*cMbAL_ z(gO|Ey3bI4Utvs5O=m0-WUH^C;!VofuPl~&Cv)#=BUgi1|p?04LB zidD@5c1ijoG-8oWvrGad?8xEU*JYnu=pq{1_2X4pHSz?=xaHkFC+51fjDFmAwm;`Rj*7SybNKW}Ut?vHeq#p*jX&XM-bh7&&AAML5$yZ6W3Q6iNpPT2Ya~07at0)oqu=l z=vUbPa?Kg2pFabB48BZ^;_Wy0j{ZR@h8SB(Z13nN4d?XX+fp(1j(+4ke0U4v@P+Ih z-Kr1YNz?}$`*Fd*VLt;^!DHYs80eh(_x@ZtD)!ywQJQ!%(#`R`BUT^8mVUoJSX<@_ zv3E4M46oYR`|ZC4qSLbpg8!hS z*-dvXB4d?T;(!86Ri>wtk`KJHY*Y-{pilc6nC{}Xq6OTf0fD+|qyekRonj?Ggk*qm zTCf;OBO{~XNlmqc#};|MB2dzcc{JLK5D+j!HJ34fc-U;xn{@^jxR}36V@@lpsFmq# z60hPIXqFftu)9W}?1h4rSz^G8$H&z%R^7?s3Buz%_>Vk>pZeVD(x%jGdfeUfQ1vUnGS2i7EHiVU=BTzV#FvZ0+~);ZfnqXAVx(qxErBAs<3@0S0-f^*=|x^e8$_-8s=3dg)w;hy3~^u-u?E zCcs>$eu2Vf`=4+Y#deg7>T8P(Mh261&!N*j$I|KE?!qDSb3C0A;pBX{xJyT8G$mJ9 z40!-ZI4#7*O{~mtWOb815O~sGf*%mhL7hFiCw7l|s+lHG2NHSSuG*BwAT>KCam>vq z?Q}Jlui7BN$r}IR+|EVM4<+zAz4-{PB3#dGth)$pnDIt|)c@>sFc6ym8veWM_vhU`{%}6kK zIueI}cqBGnwCxp_oT5$d5Yqrcy>%%6&r%#&XSmOiTXf~rxCUmjatFREEV%IBGm*7 zesGG^IXEA}|NNi$ke{Joou3Im&xij@Z={mY_mWRE9Z~Qm{-_GM?oMvw!#UQ;!G-Px ze(DXan)AZ13%QGJ%aeAFuV#NzQgFw8`@EM{kZYA!y<5&&KHRhzQ*EP+6Tk%fx#1tg|`OJ%DLry$+E zn_iT;VtuA}3cV-ssV9-U^jjVh@V!n=pTb7EXf)uvo|>M`YS`>C4w3H^R}gjh&Z#bL zX<(_Jdm2qjIWUCCTV-7J1@0PVnPueUAFYOU0 z;5|_y977HxL2$j-nG%vE8sTFSaHz*g)R8boB8DH~cRG-*#A@Bu`fQ&ebdSmWWFmK? z!<8SKPDkRpXyiF&wd#o8axPpuFV3)b3H8q^11wG8gYtF zjUMy(;ii{c8gRUi1PUkkuF(P56_VzygbP&iA9E9@RSB!@9e&155Ac3MCUgjL1=KGd zLSc`Ml$=$G^5pS(pjy!4SvHPwS$%!8vGqE8WosK8z#SQGrX&|#kfs6^1Wtz`L?S30 zfp>a>KasaMI0o>rL{5CNw4Uht*ijx{)NFg)U%;jZ-xZ@)4Wd}*{}4O^q4+_8p2FAae* z^wMCb{T)Po0A_(x0f`rDC2`8rQtG_gRZE9Zsxa*8N{KTN?4x{;QK=X!5C&Zx!Gpwc z0T!pkf1Ivs=uGTN0Q{R~Z=4u#PoVZn*?jB`0N6}nZVn9|rD!1$BbyM_lM{4Yj!Kbs zWt}DniAQH}tU{7U!vq>KG8(4UkYdoMCm29tR6{can}9fHfEQ8|u6j`NWx+zi2Z=ZZ zzT_1j;)7HaXrEM+BrHrSN|Lk(Iswe6$i#^pb>wR#8A2B)OW=Sm)DC!3jz)H<$S{R$ zhJFgIB*&?m-ARzdlg+r#Qq4&D$lhRpYKAe(-hhy*+1&}H#8fkOBIbsdQoWJ~(4ckR8bd`eGU6OL{~8GmSj--6y6+W6&5Lwol=>-HF>9_Otz?~%09)(m>^Z`orMJx2GAe(Ux)M?F4gJ;Qs< zSh8}G1=zEP|BzVc~R&dTn1}3aB?^d$PRt4Sox9Bz!8aVjSdE5D}^Nw?i z1H`sYBTTv@*fep>y2?jbwys()U&?KaQ(JhgCs{Nn1{OTe^w?r z-h3yop2S_zsq0_Q<$pd*_e6if#~GpvGxfOPKH=6)RpOG!eLU$sKIA=~@E%WjkEhim zF1GH7lnHcIqH})zf=n+?JOHp|ghxF&!{qIYjtIl=UFZanDQ1B!Qv_vn;5dE@LV=Or zY-nDlS3_7Omo5^&ZvLM{pV!%z4!SQ6jjAz(DYkh7ctjgs8yd2+j`f zGYrnBR4^H#5^f#fKB`2T1o2KD^>jB60?Sa%ZkhyaQK|)F^Q#sCI2FqH8W5&boXb;^ zmPb5#dnbdeewAk$XsO62JTedn3_O4?T?;I5ommjty5MT7sCY+KxZ0|+Xi8fRdD;A( z&c~Y8XjtEs^L`olCR-J zTV843bWXn|N4)7g{O0w@K!|MPJsinD_!d5d6NO5Wx9IU)Kt#P3EhMFs6~a`?3P>W9 z6%K(bDHIMmtKpm}loi)OLRm3S0k7c6s|hWYRJRlw=JV9gr(y{1e@V1* zSYSn0=aBpNZvGS|#L-VF+O(^ExR;a~nR2y{!6Fr<#A;mSI4lwt;8RfeJ{Nd%*h$K# z)KJ(U^@b1pL9mYxyx89deoOhlYay<(erIYR|?lio0!@AiT7$9>@Z z&xil<`r)1PvQy~J@Vt8DN*@Z6ufq8O+v2{;=eMwF4M^R`WlBN#iy!AcC@U^Sfg6~v z5)O{8JNf@`Al>r0p9_&`cD(;ra@~iN;E&0L^!kO1{r$qXlwY`ZqM=;F{R0_fd(%1b zQAR6WPw3CZgFLt5#43`(2H=z;;Z{zvoaX5%AxoTsU@$oBA$TL3(G6r~aDnAUC9NAt zXzHZ};OL_lRXh}YPo4We9y|!@0TOzdFbk2T_Ft`^tuzwLZzy!GU9?j|E#We1%^R`*V zOV-G{QYI8xiJExj?US&>u&rVbvlMIG6Sao`eEtac3Obu~**^&n+z15&!P7XdlC$J{ zoj(|;aL3pF6dgi>d0v|nF%l=0|9UVgXU^9z2PV01oGNL$uMnsTq#U7365GI!inyy< zMJ`vhs(d1~_V5CV!($!Z)5Pa0+A<@*(kfbtz?zVxNT?H6zId`U?du%It_KC8onx;##f{zCV1omFF)}n{AQwSRb6eg;xJcMPOB3w>8L32 z{kTp<)ZwtnqD2F5!&H?u6!BXDQ{1wve0$E!EP<|KX2^*$aXh7WC4@hWPO_(;#xEfj z)^~U42NS!krq5aLwpMr9+Scao_Ljq(_01;z_F{Eoee>0)*y?73y-w||)f+dOn>#2p zH`%HnTi*fY)&?r@qmSJdifgUa?bWs2<~GA(ic52h!SL`y5|O2^nr4yVw-5^^!w#|& z<6*4Xr&lG*UNFHgGhSHW!o{-Lc=5HJUADQkD^|s>HIXWB_D&aV#$S!IE2}qFH=8?6 zw!QvpYd3adb-TGafrL5)Y1zgi7(yeHj`SOO^%Yup&pvtv-U1V1UwmzAw~29C)LSl; zD$GX>k6TM@ckAO;`xLvez4fK_27aBgzWd}3^LJ2-Xo6-PcLKyw7Tw)`t;x1tVPDwd zyx5Gr-df*n#&&M3u3;g>Mt66lskFQ9b*N#bjGkiauN7c zEhY-%BGV|BO`{UaFUG*+816OkYADH%j7coS?pBSR*4ArIWAjN!6q0IgHk#YS30e?a z-=TWaPiGZd<-6y~g$mNl=;qdDOsOYpedPwJV{3JXi%oE%WY)D zh9_k9+6^*@N$z(AJ?~7oagx@=)gfQ)UXoC8tV2fvuPWs69c~S2E)%dsC>C#Ef@t} zi^|@KKtLf#8eXNj+KBD0UUQnPw!7}E@2)p@$ehByA4$0YM!CH{AV5yz;R!LVmpc(< zw5uQ>T_Z8vtrA2uJP75GR3b1c+WKHItkw&e6eW4sELcXCg|n6jnSP#o+fjExZVhqI zTSE`d0aK*F`|Mvx!pC_rj61S#Gd;u7oSs0!Flf_0yrcHdU*iC!aJLMM|3I1 zU%8@-F<>DdBq3t&mu=k*zJ-N-Eo5L6moSjjqJE9;otdwZtDb~0&&kbw5@qhvWrd2Q xDvP2V+~Z^)sdZ8Ik&d?mDAO_ii{Bp#{yq?+<#axFxQz5>@?M=qlA3;C^}iU4Vub(z literal 16461 zcmcgzTWlQHdEN^}$xKY|lC;baigHX_3dxv@o!MRPl5u4YmrHZW<<5F{$q`*PjwGt# zWg?}r0yk+2C`O93%|iht1su1jQ8#hhhoW3ce2MKYngUH7pf!Tzp?N5ZJOs!~0UCKI z&=yp`|3Bx<%w8BNZc@SKo;lb5{O9|xXJ%}^uuv=)CKrmO!ep_$V2iUAE5B?#TM(ng za=lP36>F7Iakg5p=Ihp6sjYg>suhHh9PjHJqZ#t(RxiwpQ6oLM^jUY(Oq!-Jre-qP znT#sKzh7e0M; z)4lq+R3dZXrRz6#x37I_Qr28>w=dtgbmMauZeHEozIg#_73-6Edu7Ec&nG@^jElb3 zrBgG;^h`24DlXr+>aBhCw?A{^#d9;_+Vz`Tm|ARumW9<)Nd&1*Bod=y^AgtSI;UZd zj^Ag`nVEF@SFlHs&Sf%bF;l4)){6FOZE_wgZ>Q0iN#%U%qE;x0qA*3haItRBEun0PidCzjkQB9i)vD(g z$3^I5C=}{Bg+HNKXe=!j3#H2V!{uV>;j!_Dy+we+>T0E)s1@p~6}dzO(`_(5sfBS_ z!NkGU7VK)iU@t82ij}IJ$8z6_ghG+oPtkgP^ylt);2}^w5U75LI>y7Hcr0w~KNV=$ zKNEQ1UQJoCwfAxB&aVX;?V@8IEgMhYBoHj+v1~T57hDqzU_fO_JE2pPA>$20GbyHpX zr41qXAxxTCqSMIf%8V+2eh+~wR(09R*NbZfjcJPJBQy|+I=@tX)bNb$(MPhmzV!J+O!sTfAsc-+q1$bZuu z7GWPC*{H16$+|2QF9Q6j_6mUg+&M_Yq*bk2>yxzULS1B20=mMk3JA}}!t(_Z9O%k( z=VULoR%X(B)}zD*(5)9!`bSLV#Aw+TRoh+xCl~5~tpF#BqB7e*z zsUiiDw=3(QJ_Xw3Rs?pX*MTBZ#RuD9_E)^Y)s79y{SEWB4);f@n{69s@z@*gULRx# z@a{7t0az^8L|Q9CVp5_4h;lu6kuyDZv1XLIFXM9#VyBr1*6N}Oqk&n3ktM5MfFiWZ z@cDH612Gxh|DREG_WmeZvDXT}EEGW>{Sr4Q4|N{guEXSOo*yIcZ+P-vV;p^ND715U zyAk>W#evbSO{s4+N7|l8dDPCkL!o9(cVW?M>L&(jYn5)2$UVI!SC9m34fQv5Dc0QD z^cBz;EArs(03@h(SwqeZcB^olONkAFFnN;jBsOY`wnJqgQsMNk(ZLzq3|Xp5Y$RVL2^f<$%#|Kg(-8;Jmm8t~P<<{yT>oA7zuoBhm@I$q zA|(0FnA5K%c5Q203YycuCgl-rs!9zvrCTPS;E*<*iT&YtEb>Wm*_@$~c)Vwsy9^9+ z)$5JWt*ytXvFV&va|k(i_fgJiUtg#)3A|T~b^T3GGqA&?dp9@`>0hXq+YQxjD#eeZ3L> zDHpDQj?w+oPST0F5oh#~{wq&zAAZw$@=ENBPVDX^YVW0Lm3v#BF>EYk}xbsD;w^790xAS;tdFPR!m2LT+#J$kiNeJS5`tnnr7c4lyAspT z`r366)9k_CZ~1BRPPFHdo634?=F(*S?>9ULA4K<>w?z&{ML&|W)1B2hL!aR)@+~3@ zr{w;FvPk!|9#1y=ApFfvdF%}wP8Ru}2Us)Z@ts0pbu?MH!un*U(&&MQ<-)p{0xvdd z>osHwD~Qk05RCArl1OF*D>AuUw+KIjGth8QX-UKERT5}~kzbs5o7~$sC7V{Po z1j0lr!tV>e=Dzc%g@Gx(G2|rQcT5U?8HIwxfWYDg(CBT>Na6t*88}*ES_}Vbg)-0y zxP;^_<$}CG7RIrPb!0Ns!IQ^s1Y*l+kV)8)DcouJ{DG%HJ~Ef{J?t!?;`f@G4vxuW zGC{{K=pZ8zq(Kd&YW)VJ=uNlOvdgCeWcaeaADT%9yn5u~bAh%rz!`8WTUJj8g6lN$ zsglv;<9ei|z5GUNbs#`VK^ge8q`>UJQ#Kf#qyphdDs?Ire`#ATB*tGhVu3ePuI0p13|}~ zhmj)usz5Ek1D;78d>}JI(2=!3h8J*pLE_I1?_^|GwpI#E&BSV%GSHKNM;+M|irb(K ziO#kN50c&Y2iuUwPX(Gmrtj13haQ6S3C2+yzp${e;)PMYo!QOmbL zwBvlKV3k)ZlJQ)gefaaWcp4u82k#{jDY>hZ$2;Q88bpJxmd0BY+ zpa(wngsxSEh;yF(M_H||ce>TZ-*`mNl)Q639*c2k;FyTc2JBIuV_;DAAm?uH2VPoS z%b>jSY_)x2nq*YM6v{vsJ1vIv*WiMz;<^nNHNMCiCbA|zzFJh6fr-31l@bOJru`Fx zJ|c=x$=5NG5_pN;?J@8}*I4Q0tdg}v%|M#A^i zqqxhRe#1J5tGYRLuXs7K9FL!}`wucQ;Qv#`8vi-mUvh@ykAHxn=+962_h>XzF1o+;=0#>X@FZN zSqe0PPn4Gf!uT|#DnuRpij_4m1OW>Wc$~8$fTh~%oH`J=D^>|^lYAr~XW=MSSIcE& zfD#N{q5w&9uS|)X_O$_*4Z6biI*}{dF$>IoM)jyhF?&X{0_6@F z3M`>Tsa+myPd3uR2Ga@`;oXsSNy$g3-gSO9`Pu93UAndl24u8ar-U8tgcx(4#z1pt z1>Q`tR!eoPQY}1-JBM)*J~~NK5}u9VKmK3-QGX-h_~~8?39Tb30+jt?kTP70Vdl%* zTqD8iH*ybdf2&*Nn_aH$dC1|N&v$7$K%mZoyR}WX!=X>`a^Lo6E=#c~^BgL7E+2eC zn#WYAeKh4Bci){6st7~T2>rlcM0YGo)25c;c4^<5lJxzLsU9+sc;}3)mMrQrm`NR*;rX@@E0SzGL*;^W9t`{!04<-k?+y02RgW$l>})DgCx;xT2j?z_(UBL}agDE#V-)qpun8m?+@aJ2tWV6|2Z0 zgYDqv!DBpyIx@+JU7D~ftrhTe+stS{ze^Kh!oQX{#{@~hO-c!TaJ5JO5GV-ipxKy$ z&i2m9$oS428F_h@2F1F5A4Gk6XLRwVDCC9Jc~Opmjz&GgyX;sOhZh_u4^aYLooF{l zfHFtzm;-Y)B)hD`8A=8i8DxQ!9dh1~lZxrsU(ia=yxwX9w&;OkaOLbcRF>Ncpts@K-b%u;wy zl>Oy5dvH8-I>$QmC+a1S>g$!l6JLN^pD)eKpuz7c zTjTUyqV(#Vjg&6(?D}0= zg_1Ny?~D>`Q=x<+BZU%(JOcu^%(@%oR)UEV%&HqyBX?s>z_TI!t-C=b>TXy@5OoqnhE7>t^U&H5yyh&5&s|8cIhudpn_2nr_BU9dFI0jl`^;I;RTuD$noJn}(E&1tGS9CY7x z|2`h+x6jxks0hag-6QwM@kq=T_F1Yhr7$+aU(w=Ma);v4LHkLTzft>1`#j{2f0g|0 z{&1sl?~?9bb{~yLPummReaxP)pF(&3mEFs`Km0`F-ZQ$p9i#pqvXk6DVJB@9{rOk+ zw`03Md?D7j_hE0u5REuvPw|MfJ!R)Gf`8SBA&eMm9Q}_sVwgsJ#D1Db%-B!c7chc< z)ret?7;YT>n>XSNjTp7(c*LwdXU}5<|EdvZFyc((=q+!Apb_WnMINzWFWO5O!M|#R zzzESe`jgFYJbd08R&r0rqvLjkhn4M$UBxi|mBR)j(Svv0ue-0fueqX~ zJiZT|O@0YpHNqtevOIS;+bxWGTxxEot z@tUfTFBQBqcgs>47G*AHH&e5Rug>nW4Sb}3Z)lbyny-5`x9FYBBH*(BVU?q~^;%Jv zK;$lfO{S^d|#{cBA(y0@hIy1jeP1R754 z8M@)*-uXa7&z^cS^|pKJD{98u?nAeB;?W49_nU~wzx!qUk!lVKj)IRi-NLtBJP&f(oN zYEb0vz^pDZSR-M|DIy)BwMIaLVAFJq;Bger8G@(aCZKlMX z5zoxHLtl}`;O-UzBDez<_oap)dD^W zE#NbnS(=v;zDQx!DXS*NaGbcRDA#Mq0@UQ^i*&8tHU!=Fv%2nmCjm5_l*3g3Z<<4LK7Jg2rzh4wM&!rar!651+wS(w?W-@2qE7%Ho+i`>*hL>m za0MJIMYQk6N;-nxhpZu`uJdfNMr%j^34K74FAser11uDTZb*cbhu~@ZMC%NhS3@V^ z&)uH>8q+B6vP%i7j#KnzR$Mq{r2I6y#w7FllO*R-Cp@Eu`segMLEoZc_?t8jUj)L= r=2onA_Gy7#XLAsOovod4^!unC`^@WdP?Fr^+3KY~yRy6wi}n3452ST9 diff --git a/library/tedit/TEDIT-DCL b/library/tedit/TEDIT-DCL deleted file mode 100644 index 9ca82785..00000000 --- a/library/tedit/TEDIT-DCL +++ /dev/null @@ -1,1646 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "14-Jul-2022 17:03:38"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 - - :CHANGES-TO (VARS TEDITFILES) - - :PREVIOUS-DATE "14-Jul-2022 16:29:57" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2) - - -(PRETTYCOMPRINT TEDIT-DCLCOMS) - -(RPAQQ TEDIT-DCLCOMS - [ - -(* ;;; "This file is the collected record declarations and compile-time necessities for TEDIT.") - - - (* ;; "FROM TEDIT") - - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))) - - (* ;; "FROM TEDITSELECTION") - - (RECORDS SELECTION) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (COPYSELSHADE 30583) - (COPYLOOKSSELSHADE 30583) - (EDITMOVESHADE -1) - (EDITGRAY 32800))) - (VARS TEDITFILES) - - (* ;; "FROM TEDITSCREEN") - - (RECORDS THISLINE LINEDESCRIPTOR LINECACHE) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (LMInvisibleRun 401) - (LMLooksChange 400))) - - (* ;; "FROM TEXTOFD") - - (RECORDS EDITMARK) - (RECORDS PIECE TEXTOBJ TEXTIMAGEDATA TEXTSTREAM) - (OPTIMIZERS TEXTPROP) - (COMS - (* ;; "Private data structures and constants FROM TEXTOFD") - - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\PCTBFreePieces 0) - (\PCTBLastPieceOffset 1) - (\FirstPieceOffset 2) - (\SecondPieceOffset 4) - (\EltsPerPiece 2)) - (MACROS \EDITELT \GETCH \GETCHB \EDITSETA \WORDSETA) - (GLOBALVARS \TEXTIMAGEOPS \TEXTOFD \TEXTFDEV))) - - -(* ;;; "FROM TEDITPAGE") - - (RECORDS PAGEFORMATTINGSTATE PAGEREGION) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITPAPERSIZE) - (FUNCTIONS \NEW-COLUMN-START \FIRST-COLUMN-START)) - - (* ;; "FROM TEDITFIND") - - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\AlphaNumericFlag 256) - (\AlphaFlag 512) - (\OneCharPattern 1024) - (\AnyStringPattern 1025) - (\OneAlphaPattern 1026) - (\AnyAlphaPattern 1027) - (\OneNonAlphaPattern 1028) - (\AnyNonAlphaPattern 1029) - (\LeftBracketPattern 1030) - (\RightBracketPattern 1031) - (\SpecialPattern 1024))) - - (* ;; " FROM TEDITLOOKS") - - (RECORDS CHARLOOKS FMTSPEC PENDINGTAB) - (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \SMALLPIN \SMALLPOUT ONOFF)) - - (* ;; "FROM TEDITMENU") - - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MBUTTON)) - (INITRECORDS MBUTTON) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS NWAYBUTTON)) - (INITRECORDS NWAYBUTTON) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MARGINBAR)) - (INITRECORDS MARGINBAR) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TAB)) - (RECORDS MB.3STATE MB.BUTTON MB.INSERT MB.MARGINBAR MB.NWAY MB.TEXT MB.TOGGLE) - (FUNCTIONS WITHOUT-UPDATES) - - (* ;; "FROM TEDITHISTORY") - - (RECORDS TEDITHISTORYEVENT) - - (* ;; "FROM TEDITFILE") - - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0) - (\PieceDescriptorOBJECT 1) - (\PieceDescriptorPARA 2) - (\PieceDescriptorPAGEFRAME 3) - (\PieceDescriptorCHARLOOKSLIST 4) - (\PieceDescriptorPARALOOKSLIST 5) - (\PieceDescriptorSAFEOBJECT 6))) - - (* ;; "FROM TEDITCOMMAND") - - (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \INSERT\TTY\BUFFER \TEDIT.MOUSESTATE \TEDIT.CHECK)) - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITTERMCODE)) - (DECLARE%: EVAL@COMPILE DONTCOPY (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) - (PUNCT.TTC 20) - (TEXT.TTC 21) - (WHITESPACE.TTC 22))) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (MSPACE 153) - (NSPACE 152) - (THINSPACE 159) - (FIGSPACE 154))) - - (* ;; "FROM TEDITWINDOW") - - (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITCARET)) - (INITRECORDS TEDITCARET) - - (* ;; "FROM PCTREE added by Nakamura") - - (RECORDS PCTNODE) - - (* ;; "FROM TEDITHCPY and TEDITSCREEN") - - (DECLARE%: EVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) - - -(* ;;; "THE END") - - (COMS - (* ;; "Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character ") - - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) - (* ; - "Must not break before this character (e.g. Japanese right-paren)") - (NOTAFTER.LB 2) - (* ; - "Must not break after this character (e.g. Japanese open-quote)") - (BEFORE.LB 4) - (* ; "OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)") - (AFTER.LB 8) - (* ; - "OK to break after this char, if it's OK to break before the next one (true of most white space)") - (DISAPPEAR-IF-NOT-SPLIT.LB 16) - (* ; "This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)") - (NEWCHAR-IF-SPLIT.LB 32) - (* ; "Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found.") - ]) - - - -(* ;;; "This file is the collected record declarations and compile-time necessities for TEDIT.") - - - - -(* ;; "FROM TEDIT") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) -) - - - -(* ;; "FROM TEDITSELECTION") - -(DECLARE%: EVAL@COMPILE - -(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.") - - Y0 (* ; - "Y value of topmost line of selection") - X0 (* ; "X value of left edge of selection") - 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") - CHLIM (* ; - "CH# of the last character in the selection") - DCH (* ; - "# of characters selected (can be zero, for point selection.)") - 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") - 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") - (\TEXTOBJ FULLXPOINTER) (* ; - "TEXTOBJ 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) (* ; - "T if there should be a caret for this selection") - SELOBJ (* ; - "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.") - ) - SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T Y0 _ 0 X0 _ 0 POINT _ 'LEFT L1 _ - (LIST NIL) - LN _ (LIST NIL)) -) - -(/DECLAREDATATYPE 'SELECTION - '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG - FULLXPOINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER) - '((SELECTION 0 POINTER) - (SELECTION 2 POINTER) - (SELECTION 4 POINTER) - (SELECTION 6 POINTER) - (SELECTION 8 POINTER) - (SELECTION 10 POINTER) - (SELECTION 12 POINTER) - (SELECTION 14 POINTER) - (SELECTION 16 POINTER) - (SELECTION 18 POINTER) - (SELECTION 20 POINTER) - (SELECTION 20 (FLAGBITS . 0)) - (SELECTION 22 FULLXPOINTER) - (SELECTION 24 POINTER) - (SELECTION 26 POINTER) - (SELECTION 28 POINTER) - (SELECTION 28 (FLAGBITS . 0)) - (SELECTION 30 POINTER) - (SELECTION 30 (FLAGBITS . 0)) - (SELECTION 32 POINTER)) - '34) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ COPYSELSHADE 30583) - -(RPAQQ COPYLOOKSSELSHADE 30583) - -(RPAQQ EDITMOVESHADE -1) - -(RPAQQ EDITGRAY 32800) - - -(CONSTANTS (COPYSELSHADE 30583) - (COPYLOOKSSELSHADE 30583) - (EDITMOVESHADE -1) - (EDITGRAY 32800)) -) -) - -(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE - TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU - TEDIT-PAGE TEDIT-SCREEN TEDIT-SELECTION TEDIT-WINDOW)) - - - -(* ;; "FROM TEDITSCREEN") - -(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") - LEN (* ; "Length of the line in characters") - CHARS - - (* ;; "Array of character codes (or objects) on the line (charcode of 400 => dummy entry for looks change--go get next entry in LOOKS)") - - WIDTHS (* ; - "Array of each character's width in points") - LOOKS (* ; - "Array of any looks changes within the line. LOOKS (0) = starting character looks for the line") - TLSPACEFACTOR (* ; - "The SPACEFACTOR to be used in printing this line") - TLFIRSTSPACE (* ; "The first space to which SPACEFACTOR is to apply. This is used so that spaces to the left of a TAB have their default width.") - ) - LEN _ 0 CHARS _ (ARRAY 512 'POINTER 0 0) - WIDTHS _ (ARRAY 512 'POINTER 0 0) - LOOKS _ (ARRAY 512 'POINTER NIL 0) - TLFIRSTSPACE _ 0) - -(DATATYPE LINEDESCRIPTOR - ( - (* ;; - "Description of a single line of formatted text, either on the display or for a printed page.") - - YBOT (* ; - "Y value for the bottom of the line (below the descent)") - YBASE (* ; - "Yvalue for the base line the characters sit on") - LEFTMARGIN (* ; "Left margin, in screen points") - RIGHTMARGIN (* ; "Right margin, in screen points") - LXLIM (* ; "X value of right edge of rightmost character on the line (may exceed right margin, if char is a space.)") - SPACELEFT (* ; - "Space left on the line, ignoring trailing blanks & CRs.") - LHEIGHT (* ; - "Total height of hte line, Ascent+Descent.") - ASCENT (* ; "Ascent of the line above YBASE") - DESCENT (* ; "How far line descends below YBASE") - LTRUEDESCENT (* ; - "The TRUE DESCENT for this line, unadjusted for line leading.") - LTRUEASCENT (* ; - "The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") - CHAR1 (* ; - "CH# of the first character on the line.") - CHARLIM (* ; - "CH# of the last character on the line") - CHARTOP (* ; - "CH# of the character which forced the line break (may exceed CHARLIM)") - NEXTLINE (* ; "Next line chain pointer") - (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") - LMARK (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)") - LTEXTOBJ (* ; "A cached TEXTOBJ that this line took its text from. Used in hardcopy to disambiguate when chno's should be updated...") - CACHE (* ; "A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit.") - LDOBJ (* ; - "The object which lies behind this line of text, for updating, etc.") - LFMTSPEC (* ; - "The format spec for this line's paragraph (eventually)") - (DIRTY FLAG) (* ; - "T if this line has changed since it was last formatted.") - (CR\END FLAG) (* ; "T if this line ends with a CR.") - (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.") - (LHASTABS FLAG) (* ; "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") - ) - CHARLIM _ 1000000 NEXTLINE _ NIL PREVLINE _ NIL DIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ - 0 DELETED _ NIL) - -(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.") - )) -) - -(/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER POINTER POINTER) - '((THISLINE 0 FULLXPOINTER) - (THISLINE 2 POINTER) - (THISLINE 4 POINTER) - (THISLINE 6 POINTER) - (THISLINE 8 POINTER) - (THISLINE 10 POINTER) - (THISLINE 12 POINTER)) - '14) - -(/DECLAREDATATYPE 'LINEDESCRIPTOR - '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER - FLAG FLAG FLAG FLAG FLAG FLAG FLAG) - '((LINEDESCRIPTOR 0 POINTER) - (LINEDESCRIPTOR 2 POINTER) - (LINEDESCRIPTOR 4 POINTER) - (LINEDESCRIPTOR 6 POINTER) - (LINEDESCRIPTOR 8 POINTER) - (LINEDESCRIPTOR 10 POINTER) - (LINEDESCRIPTOR 12 POINTER) - (LINEDESCRIPTOR 14 POINTER) - (LINEDESCRIPTOR 16 POINTER) - (LINEDESCRIPTOR 18 POINTER) - (LINEDESCRIPTOR 20 POINTER) - (LINEDESCRIPTOR 22 POINTER) - (LINEDESCRIPTOR 24 POINTER) - (LINEDESCRIPTOR 26 POINTER) - (LINEDESCRIPTOR 28 POINTER) - (LINEDESCRIPTOR 30 FULLXPOINTER) - (LINEDESCRIPTOR 32 POINTER) - (LINEDESCRIPTOR 34 POINTER) - (LINEDESCRIPTOR 36 POINTER) - (LINEDESCRIPTOR 38 POINTER) - (LINEDESCRIPTOR 40 POINTER) - (LINEDESCRIPTOR 40 (FLAGBITS . 0)) - (LINEDESCRIPTOR 40 (FLAGBITS . 16)) - (LINEDESCRIPTOR 40 (FLAGBITS . 32)) - (LINEDESCRIPTOR 40 (FLAGBITS . 48)) - (LINEDESCRIPTOR 38 (FLAGBITS . 0)) - (LINEDESCRIPTOR 38 (FLAGBITS . 16)) - (LINEDESCRIPTOR 38 (FLAGBITS . 32))) - '42) - -(/DECLAREDATATYPE 'LINECACHE '(POINTER FULLXPOINTER) - '((LINECACHE 0 POINTER) - (LINECACHE 2 FULLXPOINTER)) - '4) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ LMInvisibleRun 401) - -(RPAQQ LMLooksChange 400) - - -(CONSTANTS (LMInvisibleRun 401) - (LMLooksChange 400)) -) -) - - - -(* ;; "FROM TEXTOFD") - -(DECLARE%: EVAL@COMPILE - -(RECORD EDITMARK ( - (* ;; "Used for fast access to a given place in the text--a %"Marker%". It consists of the piece, and the offset within the piece, and the piece number within the piece table. That's everything that's needed to set a text stream up quickly to start reading from a given place.") - - PC PCOFF . PCNO)) -) -(DECLARE%: EVAL@COMPILE - -(DATATYPE PIECE - ( (* ; - "The piece describes either a string or part of a file. , or a generalized OBJECT.") - PSTR (* ; - "The string where this piece's text resides, or NIL") - PFILE (* ; - "The file which contains this piece's text, or NIL") - PFPOS (* ; - "The FILEPTR of the start of the piece in the file") - PLEN (* ; - "Length of the piece, in characters.") - NEXTPIECE (* ; "-> Next piece in this textobj.") - (PREVPIECE FULLXPOINTER) (* ; - "-> Prior piece in this text object.") - PLOOKS (* ; - "Formatting info and formatting events in this piece") - POBJ (* ; "The OBJECT this piece describes") - (PPARALAST FLAG) (* ; - "This piece contains a paragraph break") - PPARALOOKS (* ; "Paragraph looks for this piece") - (PNEW FLAG) (* ; - "This text is new here; used by the tentative edit system, and anyone else interested.") - (PFATP FLAG) (* ; "T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT") - (PTREENODE XPOINTER) (* ; - "Points to the PCTB tree-node that contains this piece.") - (PEXTERNALFORMAT POINTER (* ; - "The external format of a piece on a file") - )) - PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ - NIL) - -(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") - \INSERTPC (* ; "Piece to hold type-in") - \INSERTPCNO (* ; "Piece # of the input piece") - \INSERTNEXTCH (* ; - "CH# of next char which is typed into that piece.") - \INSERTLEFT (* ; "Space left in the type-in piece") - \INSERTLEN (* ; - "# of characters already in the piece.") - \INSERTSTRING (* ; - "The string which the piece describes.") - \INSERTFIRSTCH (* ; "CH# of first char in the piece.") - (\INSERTPCVALID FLAG) (* ; "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.") - \WINDOW (* ; - "The window where this textobj is displayed") - MOUSEREGION (* ; - "Section of the window the mouse is in.") - LINES (* ; - "-> to top of chain of line descriptors for displayed text") - DS (* ; - "Display stream where this textobj is displayed") - SEL (* ; - "The current selection within the text") - SCRATCHSEL (* ; - "Scratch space for the selection code") - MOVESEL (* ; "Source for the next MOVE of text") - SHIFTEDSEL (* ; "Source for the next COPY") - 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 (* ; - "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) (* ; - "T if this TEXTOBJ is a tedit-style menu") - FMTSPEC (* ; - "Default Formatting Spec to be used when formatting paragraphs") - (FORMATTEDP FLAG) (* ; - "Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") - (TXTREADONLY FLAG) (* ; - "This is only available for shift selection.") - (TXTEDITING FLAG) (* ; "T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing.") - (TXTNONSCHARS FLAG) (* ; "T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation.") - TXTTERMSA (* ; - "Special instructions for displaying characters on the screen") - EDITOPACTIVE (* ; - "T if there is an editing operation in progress. Used to interlock the TEdit menu") - DEFAULTCHARLOOKS (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.") - TXTRTBL (* ; - "The READTABLE to be used by the command loop for command dispatch") - TXTWTBL (* ; - "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.") - (SELWINDOW FULLXPOINTER) (* ; "The window in which the last 'real' selection got made for this edit; used to control caret placement") - PROMPTWINDOW (* ; - "A window to be used for unscheduled interactions; normally a small window above the edit window") - DISPLAYCACHE (* ; - "The bitmap to be used when building the image of a line for display") - DISPLAYCACHEDS (* ; - "The DISPLAYSTREAM that is used to build line images") - DISPLAYHCPYDS (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode") - TXTPAGEFRAMES (* ; - "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) (* ; "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 (* ; - "Document properties that are stored with the document (not used yet)") - TXTSTYLESHEET (* ; - "Style sheet local to this document. Not currently saved as part of the file.") - ) - [ACCESSFNS TEXTOBJ ((\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) - (PROGN (IF (NEQ (FETCH (TEXTOBJ \XDIRTY) OF DATUM) - NEWVALUE) - THEN (* ; - "update the title to reflect the change") - (\TEDIT.WINDOW.TITLE DATUM - (\TEDIT.ORIGINAL.WINDOW.TITLE - (ffetch (TEXTOBJ TXTFILE) of DATUM) - NEWVALUE))) - (freplace \XDIRTY OF DATUM WITH NEWVALUE] - SEL _ (create SELECTION) - SCRATCHSEL _ (create SELECTION) - MOVESEL _ (create SELECTION - HOWHEIGHT _ 32767 - HASCARET _ NIL) - SHIFTEDSEL _ (create SELECTION - HASCARET _ NIL) - DELETESEL _ (create SELECTION - HOWHEIGHT _ 32767 - HASCARET _ NIL) - \INSERTNEXTCH _ -1 \INSERTPC _ NIL \INSERTLEFT _ 0 \INSERTLEN _ 0 \INSERTSTRING _ NIL - \INSERTFIRSTCH _ 1000000 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) - -(DATATYPE TEXTIMAGEDATA ( - (* ;; "Fills the IMAGEDATA field of text streams.") - - TICURPARALOOKS (* ; "The current paragraph looks") - TICURIMAGESTREAM (* ; - "The image stream for this hardcopy transduction") - TILOOKSUPDATEFN (* ; - "The function to call to update looks for this stream") - TIPCOFFSET (* ; - "The offset into the current piece, as of the last page cross.") - )) - -(ACCESSFNS TEXTSTREAM ( - (* ;; - "Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") - - (REALFILE (fetch F1 of DATUM) - (REPLACE F1 OF DATUM WITH NEWVALUE)) - (* ; - "The real, underlying file behind the current piece") - (CHARSLEFT (fetch F2 of DATUM) - (REPLACE F2 OF DATUM WITH NEWVALUE)) - - (* ;; "The # of characters that will be left in the current piece the next time its file crosses a page boundary") - - (TEXTOBJ (fetch F3 of DATUM) - (REPLACE F3 OF DATUM WITH NEWVALUE)) - (* ; - "The TEXTOBJ that is editing this text") - (PIECE (fetch F5 of DATUM) - (REPLACE F5 OF DATUM WITH NEWVALUE)) - (* ; - "The PIECE we're currently fetching chars from/putting chars into") - (PCNO (fetch FW8 of DATUM) - (REPLACE FW8 OF DATUM WITH NEWVALUE)) - (* ; - "The position of that piece in the piece table") - (PCSTARTPG (fetch FW6 of DATUM) - (REPLACE FW6 OF DATUM WITH NEWVALUE)) - (* ; - "The underlying file page# that this piece starts on") - (PCSTARTCH (fetch FW7 of DATUM) - (REPLACE FW7 OF DATUM WITH NEWVALUE)) - (* ; - "The char within page of the underlying file that this piece starts on -- for backbin & co") - (PCOFFSET (fetch TIPCOFFSET of (fetch IMAGEDATA of DATUM)) - (REPLACE TIPCOFFSET OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) - (* ; - "The offset into the current piece, as of the last page cross.") - (CURRENTLOOKS (fetch F10 of DATUM) - (replace F10 of DATUM with NEWVALUE)) - (* ; - "The CHARLOOKS that are currently applicable to characters being taken from the stream.") - (CURRENTPARALOOKS (fetch TICURPARALOOKS of (fetch IMAGEDATA of DATUM)) - (REPLACE TICURPARALOOKS OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) - (* ; - "The FMTSPEC that is currently applicable to characters being taken from the stream.") - (CURRENTIMAGESTREAM (fetch TICURIMAGESTREAM of (fetch IMAGEDATA of DATUM)) - (REPLACE TICURIMAGESTREAM OF (fetch IMAGEDATA of DATUM) with NEWVALUE) - (* ; - "The image stream that this text is being put onto; used for scaling decisions") - ) - (LOOKSUPDATEFN (fetch TILOOKSUPDATEFN of (fetch IMAGEDATA of DATUM)) - (REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA of DATUM) with NEWVALUE)) - (* ; - "Function to be called each time character looks change.") - (FATSTREAMP (fetch F4 of DATUM) - (REPLACE F4 OF DATUM WITH NEWVALUE)) - (* ; - "T if the current piece is 16 bit characters.") - ) - (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ (create TEXTIMAGEDATA)))) -) - -(/DECLAREDATATYPE 'PIECE - '(POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG - XPOINTER POINTER) - '((PIECE 0 POINTER) - (PIECE 2 POINTER) - (PIECE 4 POINTER) - (PIECE 6 POINTER) - (PIECE 8 POINTER) - (PIECE 10 FULLXPOINTER) - (PIECE 12 POINTER) - (PIECE 14 POINTER) - (PIECE 14 (FLAGBITS . 0)) - (PIECE 16 POINTER) - (PIECE 16 (FLAGBITS . 0)) - (PIECE 16 (FLAGBITS . 16)) - (PIECE 18 XPOINTER) - (PIECE 20 POINTER)) - '22) - -(/DECLAREDATATYPE 'TEXTOBJ - '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER 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) - '((TEXTOBJ 0 POINTER) - (TEXTOBJ 2 POINTER) - (TEXTOBJ 4 POINTER) - (TEXTOBJ 6 POINTER) - (TEXTOBJ 8 POINTER) - (TEXTOBJ 10 POINTER) - (TEXTOBJ 12 POINTER) - (TEXTOBJ 14 POINTER) - (TEXTOBJ 16 POINTER) - (TEXTOBJ 16 (FLAGBITS . 0)) - (TEXTOBJ 18 POINTER) - (TEXTOBJ 20 POINTER) - (TEXTOBJ 22 POINTER) - (TEXTOBJ 24 POINTER) - (TEXTOBJ 26 POINTER) - (TEXTOBJ 28 POINTER) - (TEXTOBJ 30 POINTER) - (TEXTOBJ 32 POINTER) - (TEXTOBJ 34 POINTER) - (TEXTOBJ 36 POINTER) - (TEXTOBJ 38 POINTER) - (TEXTOBJ 40 POINTER) - (TEXTOBJ 42 POINTER) - (TEXTOBJ 44 POINTER) - (TEXTOBJ 44 (FLAGBITS . 0)) - (TEXTOBJ 46 FULLXPOINTER) - (TEXTOBJ 48 POINTER) - (TEXTOBJ 50 POINTER) - (TEXTOBJ 52 POINTER) - (TEXTOBJ 54 POINTER) - (TEXTOBJ 56 POINTER) - (TEXTOBJ 56 (FLAGBITS . 0)) - (TEXTOBJ 58 POINTER) - (TEXTOBJ 58 (FLAGBITS . 0)) - (TEXTOBJ 58 (FLAGBITS . 16)) - (TEXTOBJ 58 (FLAGBITS . 32)) - (TEXTOBJ 58 (FLAGBITS . 48)) - (TEXTOBJ 60 POINTER) - (TEXTOBJ 62 POINTER) - (TEXTOBJ 64 POINTER) - (TEXTOBJ 66 POINTER) - (TEXTOBJ 68 POINTER) - (TEXTOBJ 70 POINTER) - (TEXTOBJ 70 (FLAGBITS . 0)) - (TEXTOBJ 72 POINTER) - (TEXTOBJ 74 FULLXPOINTER) - (TEXTOBJ 76 POINTER) - (TEXTOBJ 78 POINTER) - (TEXTOBJ 80 POINTER) - (TEXTOBJ 82 POINTER) - (TEXTOBJ 84 POINTER) - (TEXTOBJ 86 POINTER) - (TEXTOBJ 88 POINTER) - (TEXTOBJ 88 (FLAGBITS . 0)) - (TEXTOBJ 88 (FLAGBITS . 16)) - (TEXTOBJ 90 POINTER) - (TEXTOBJ 92 POINTER) - (TEXTOBJ 94 POINTER)) - '96) - -(/DECLAREDATATYPE 'TEXTIMAGEDATA '(POINTER POINTER POINTER POINTER) - '((TEXTIMAGEDATA 0 POINTER) - (TEXTIMAGEDATA 2 POINTER) - (TEXTIMAGEDATA 4 POINTER) - (TEXTIMAGEDATA 6 POINTER)) - '8) - -(DEFOPTIMIZER TEXTPROP (TEXTOBJ PROP &OPTIONAL (VAL NIL WRITING)) - - (* ;; "compiles calls to TEXTPROP") - - [COND - ((NOT (LISTP PROP)) (* ; "property is not quoted.") - 'IGNOREMACRO) - ((NOT (EQ (CAR PROP) - 'QUOTE)) (* ; "property is not quoted.") - 'IGNOREMACRO) - [(NOT WRITING) (* ; "fetching a TEXTPROP property.") - (SELECTQ (CADR PROP) - ((READONLY READ-ONLY) - `(fetch (TEXTOBJ TXTREADONLY) of (TEXTOBJ ,TEXTOBJ))) - ((BEING-EDITED ACTIVE) - `(fetch (TEXTOBJ TXTEDITING) of (TEXTOBJ ,TEXTOBJ))) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - `(fetch (TEXTOBJ TXTNONSCHARS) of (TEXTOBJ ,TEXTOBJ))) - `(LISTGET (fetch (TEXTOBJ EDITPROPS) of (TEXTOBJ ,TEXTOBJ)) - ,PROP] - (T (* ; "storing a window property") - (SELECTQ (CADR PROP) - ((READONLY READ-ONLY) - `(REPLACE (TEXTOBJ TXTREADONLY) OF (TEXTOBJ ,TEXTOBJ) - WITH ,VAL)) - ((BEING-EDITED ACTIVE) - `(REPLACE (TEXTOBJ TXTEDITING) OF (TEXTOBJ ,TEXTOBJ) - WITH ,VAL)) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - `(REPLACE (TEXTOBJ TXTNONSCHARS) OF (TEXTOBJ ,TEXTOBJ) - WITH ,VAL)) - `(LET* (($$TEXTOBJ$$ (TEXTOBJ ,TEXTOBJ)) - ($$PROPLST$$ (FETCH EDITPROPS OF $$TEXTOBJ$$))) - (COND - ($$PROPLST$$ (LISTPUT $$PROPLST$$ ,PROP ,VAL)) - (T (REPLACE EDITPROPS OF $$TEXTOBJ$$ - WITH (LIST ,PROP ,VAL]) - - - -(* ;; "Private data structures and constants FROM TEXTOFD") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \PCTBFreePieces 0) - -(RPAQQ \PCTBLastPieceOffset 1) - -(RPAQQ \FirstPieceOffset 2) - -(RPAQQ \SecondPieceOffset 4) - -(RPAQQ \EltsPerPiece 2) - - -(CONSTANTS (\PCTBFreePieces 0) - (\PCTBLastPieceOffset 1) - (\FirstPieceOffset 2) - (\SecondPieceOffset 4) - (\EltsPerPiece 2)) -) - -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \EDITELT DMACRO (OPENLAMBDA (ARR NO) - - (* This is equivalent to ELT, but bypasses the checking, since we "know" that ARR - is an array. Hence, much faster.) - - (GETBASEPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) - NO) - 0))) - -(PUTPROPS \GETCH MACRO ((TEXTOBJ) (* jds "23-FEB-82 08:56") - (* Get the next available character - from the text being edited.) - (\BIN (fetch STREAMHINT of TEXTOBJ)))) - -(PUTPROPS \GETCHB MACRO ((TEXTOBJ) (* Get the next prior character in the - text being edited.) - (\BACKBIN (fetch STREAMHINT of TEXTOBJ)))) - -(PUTPROPS \EDITSETA DMACRO (OPENLAMBDA (ARR N VAL) - - (* Equivalent to SETA (for pointer-type arrays)%, but bypasses the bounds and - type checking. Hence MUCH faster.) - - (\RPLPTR (\ADDBASE2 (fetch (ARRAYP BASE) of ARR) - N) - 0 VAL))) - -(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))) -) - -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS \TEXTIMAGEOPS \TEXTOFD \TEXTFDEV) -) -) - - - -(* ;;; "FROM TEDITPAGE") - -(DECLARE%: EVAL@COMPILE - -(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.") - - MINPAGE# (* ; - "The page # of the first page to be printed, or NIL") - MAXPAGE# (* ; - "The page # of the last page to be printed, or NIL") - STATE (* ; "One of FORMATTING or SEARCHING.") - REQUIREDREGIONTYPE (* ; "If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page.") - MAINSTREAM (* ; - "The principal textobj/stream source") - CHNO (* ; "Our position in that stream") - PRESSREGION (* ; "The press code's REGION info.") - PAGEHEADINGS (* ; - "The list of current values to be printed, indexed by heading type") - PAGE#GENERATOR (* ; "List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below") - PAGE#TEXT (* ; "If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c") - PAGEISRECTO (* ; - "T if this is a recto page, NIL if it's a VERSO page.") - PAGEFOOTNOTELINES (* ; - "A list of extant footnote lines that should appear at the next opportunity") - PAGEFLOATINGTOPLINES (* ; - "A list of lines that should float to the top of the next available place") - PAGECOUNT (* ; - "The number of pages we've formatted so far.") - PAGELINECACHE (* ; "A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time") - NEWPAGELAYOUT (* ; "If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again.") - ) - PAGECOUNT _ 0) - -(DATATYPE PAGEREGION ( - (* ;; - "Describe a part of a page for page formatting. Can be made into compound descriptions.") - - REGIONFILLMETHOD (* ; - "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") - REGIONSPEC (* ; - "The page-relative region this occupies") - REGIONLOCALINFO (* ; "A PLIST for local information") - (REGIONPARENT FULLXPOINTER) (* ; - "The parent node for this box, for sub-boxes") - REGIONSUBBOXES (* ; "The sub-regions of this region") - REGIONTYPE (* ; "A user-settable region type") - )) -) - -(/DECLAREDATATYPE 'PAGEREGION '(POINTER POINTER POINTER FULLXPOINTER POINTER POINTER) - '((PAGEREGION 0 POINTER) - (PAGEREGION 2 POINTER) - (PAGEREGION 4 POINTER) - (PAGEREGION 6 FULLXPOINTER) - (PAGEREGION 8 POINTER) - (PAGEREGION 10 POINTER)) - '12) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD TEDITPAPERSIZE ( - (* ;; - "Describe the size of a sheet of paper (in points), given a paper size-name.") - - TPSNAME (* ; "The name, as a litatom") - TPSWIDTH (* ; "Paper width, in points") - TPSHEIGHT (* ; "Paper Height, in points") - TPSLANDSCAPE? (* ; - "T if we have to rotate things to print them on this paper.") - )) -) - - -(DEFMACRO \NEW-COLUMN-START (LINE FMTSPEC) - `(AND (FFETCH (LINEDESCRIPTOR 1STLN) OF ,LINE) - (EQ (FFETCH (FMTSPEC FMTCOLUMN) OF ,FMTSPEC) - 'NEXT))) - -(DEFMACRO \FIRST-COLUMN-START (LINE FMTSPEC) - `(AND (FFETCH (LINEDESCRIPTOR 1STLN) OF ,LINE) - (EQ (FFETCH (FMTSPEC FMTCOLUMN) OF ,FMTSPEC) - 'FIRST))) -) - - - -(* ;; "FROM TEDITFIND") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \AlphaNumericFlag 256) - -(RPAQQ \AlphaFlag 512) - -(RPAQQ \OneCharPattern 1024) - -(RPAQQ \AnyStringPattern 1025) - -(RPAQQ \OneAlphaPattern 1026) - -(RPAQQ \AnyAlphaPattern 1027) - -(RPAQQ \OneNonAlphaPattern 1028) - -(RPAQQ \AnyNonAlphaPattern 1029) - -(RPAQQ \LeftBracketPattern 1030) - -(RPAQQ \RightBracketPattern 1031) - -(RPAQQ \SpecialPattern 1024) - - -(CONSTANTS (\AlphaNumericFlag 256) - (\AlphaFlag 512) - (\OneCharPattern 1024) - (\AnyStringPattern 1025) - (\OneAlphaPattern 1026) - (\AnyAlphaPattern 1027) - (\OneNonAlphaPattern 1028) - (\AnyNonAlphaPattern 1029) - (\LeftBracketPattern 1030) - (\RightBracketPattern 1031) - (\SpecialPattern 1024)) -) -) - - - -(* ;; " FROM TEDITLOOKS") - -(DECLARE%: EVAL@COMPILE - -(DATATYPE CHARLOOKS ( - (* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") - - 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) (* ; - "T if the characters are to be underscored, else NIL") - (CLOLINE FLAG) (* ; - "T if the characters are to be overscored, else NIL") - (CLSTRIKE FLAG) (* ; - "T if the characters are to be struck thru, else nil.") - CLOFFSET (* ; - "A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") - (CLSMALLCAP 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 this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)") - - CLSTYLE (* ; - "The style to be used in marking these characters; overridden by the other fields") - CLUSERINFO (* ; - "Any information that an outsider wants to include") - CLLEADER (* ; - "For creating dotted and other kinds of leader") - CLRULES - - (* ;; "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) - -(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 (* ; "Right margin for the paragraph") - LEADBEFORE (* ; - "Leading above the paragraph's first line, in points") - LEADAFTER (* ; - "Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") - LINELEAD (* ; - "Leading between lines, in points. Actually, this space is added BELOW each line in the para.") - 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 (* ; - "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 (* ; - "A special horizontal location on the printed page for this para.") - FMTSPECIALY (* ; - "A special vertical location on the page for this para") - (FMTHEADINGKEEP FLAG) (* ; - "This para should be kept with the top line or so of the next para..") - FMTPARATYPE (* ; - "What kind of para this is: TEXT, PAGEHEADING, whatever") - FMTPARASUBTYPE (* ; - "Sub type of the type, e.g., what KIND of page heading this is.") - FMTNEWPAGEBEFORE (* ; "Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box.") - FMTNEWPAGEAFTER (* ; "Similarly") - FMTKEEP (* ; - "For information about how this paragraph is to be kept with other paragraphs.") - FMTCOLUMN (* ; - "For setting up side-by-side paragraphs easily ala BravoX") - FMTVERTRULES (* ; - "For Keeping track of vertical rules in force") - (FMTMARK FLAG) (* ; "Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file") - (* ; "Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file.") - (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.") - ) - TABSPEC _ (CONS NIL NIL)) - -(DATATYPE PENDINGTAB ( - (* ;; "The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting.") - - PTNEWTX - - (* ;; "An updated TX, being passed back to the line formatter. This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab, which changed the width of a prior tab.") - - PTOLDTAB (* ; "The pending tab") - PTTYPE (* ; "Its tab type") - PTTABX (* ; "Its nominal X position") - (PTWBASE FULLXPOINTER) (* ; - "The WBASE for its width, for updating when we've figured out how wide the tab really is") - PTOLDTX (* ; - "The TX as of when the tab was encountered.") - )) -) - -(/DECLAREDATATYPE 'CHARLOOKS - '(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG - POINTER POINTER POINTER POINTER FLAG) - '((CHARLOOKS 0 POINTER) - (CHARLOOKS 2 POINTER) - (CHARLOOKS 4 POINTER) - (CHARLOOKS 4 (FLAGBITS . 0)) - (CHARLOOKS 4 (FLAGBITS . 16)) - (CHARLOOKS 4 (FLAGBITS . 32)) - (CHARLOOKS 4 (FLAGBITS . 48)) - (CHARLOOKS 2 (FLAGBITS . 0)) - (CHARLOOKS 6 POINTER) - (CHARLOOKS 6 (FLAGBITS . 0)) - (CHARLOOKS 6 (FLAGBITS . 16)) - (CHARLOOKS 6 (FLAGBITS . 32)) - (CHARLOOKS 6 (FLAGBITS . 48)) - (CHARLOOKS 2 (FLAGBITS . 16)) - (CHARLOOKS 2 (FLAGBITS . 32)) - (CHARLOOKS 8 POINTER) - (CHARLOOKS 10 POINTER) - (CHARLOOKS 12 POINTER) - (CHARLOOKS 14 POINTER) - (CHARLOOKS 14 (FLAGBITS . 0))) - '16) - -(/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) - '((FMTSPEC 0 POINTER) - (FMTSPEC 2 POINTER) - (FMTSPEC 4 POINTER) - (FMTSPEC 6 POINTER) - (FMTSPEC 8 POINTER) - (FMTSPEC 10 POINTER) - (FMTSPEC 12 POINTER) - (FMTSPEC 14 POINTER) - (FMTSPEC 16 POINTER) - (FMTSPEC 18 POINTER) - (FMTSPEC 20 POINTER) - (FMTSPEC 22 POINTER) - (FMTSPEC 24 POINTER) - (FMTSPEC 26 POINTER) - (FMTSPEC 26 (FLAGBITS . 0)) - (FMTSPEC 28 POINTER) - (FMTSPEC 30 POINTER) - (FMTSPEC 32 POINTER) - (FMTSPEC 34 POINTER) - (FMTSPEC 36 POINTER) - (FMTSPEC 38 POINTER) - (FMTSPEC 40 POINTER) - (FMTSPEC 40 (FLAGBITS . 0)) - (FMTSPEC 40 (FLAGBITS . 16)) - (FMTSPEC 42 POINTER)) - '44) - -(/DECLAREDATATYPE 'PENDINGTAB '(POINTER POINTER POINTER POINTER FULLXPOINTER POINTER) - '((PENDINGTAB 0 POINTER) - (PENDINGTAB 2 POINTER) - (PENDINGTAB 4 POINTER) - (PENDINGTAB 6 POINTER) - (PENDINGTAB 8 FULLXPOINTER) - (PENDINGTAB 10 POINTER)) - '12) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) - (SIGNED (create WORD - HIBYTE _ (\BIN STREAM) - LOBYTE _ (\BIN STREAM)) - BITSPERWORD))) - -(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) - (\BOUT STREAM (LOGAND 255 (LRSH W 8))) - (\BOUT STREAM (LOGAND W 255)))) - -(PUTPROPS ONOFF MACRO [OPENLAMBDA (VAL) - (COND - (VAL 'ON) - (T 'OFF]) -) -) - - - -(* ;; "FROM TEDITMENU") - -(DECLARE%: EVAL@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]) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD NWAYBUTTON NIL [TYPE? (AND (IMAGEOBJP DATUM) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.NB.DISPLAYFN]) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) - [TYPE? (AND (IMAGEOBJP DATUM) - (EQ (IMAGEOBJPROP DATUM 'DISPLAYFN) - 'MB.MARGINBAR.DISPLAYFN]) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RECORD TAB (TABX . TABKIND)) -) -) -(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)) - -(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)) -) - -(DEFMACRO WITHOUT-UPDATES (TEXTOBJ SCRATCHSEL &BODY BODY) - - (* ;; "For TEdit windows, run BODY without updating the edit window for TEXTOBJ. 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 you'll be modifying.") - - (* ;; "SCRATCHSEL should be the scratch selection (often used in this work)") - - `[LET [(OLD-UNWIND-FLAG (FETCH (TEXTOBJ TXTDON'TUPDATE) OF ,TEXTOBJ] - (CL:UNWIND-PROTECT - (PROGN (replace (TEXTOBJ TXTDON'TUPDATE) of ,TEXTOBJ with T) - ,@BODY) - (\SHOWSEL ,SCRATCHSEL NIL NIL) - (replace SET of ,SCRATCHSEL with NIL) - (\TEDIT.MARK.LINES.DIRTY ,TEXTOBJ 1 (fetch (TEXTOBJ TEXTLEN) of ,TEXTOBJ)) - (replace (TEXTOBJ TXTDON'TUPDATE) of ,TEXTOBJ with OLD-UNWIND-FLAG) - (TEDIT.UPDATE.SCREEN ,TEXTOBJ))]) - - - -(* ;; "FROM TEDITHISTORY") - -(DECLARE%: EVAL@COMPILE - -(RECORD TEDITHISTORYEVENT ( - (* ;; "Describes one event on the TEdit edit history list.") - - THACTION (* ; - "A LITATOM, 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") - THAUXINFO (* ; - "Auxiliary info about the event, primarily for redo") - THTEXTOBJ - - (* ;; "Place to remember a second textobj, for those like MOVE who need to remember both a source and a destination.") - - ) - THPOINT _ 'LEFT) -) - - - -(* ;; "FROM TEDITFILE") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \PieceDescriptorLOOKS 0) - -(RPAQQ \PieceDescriptorOBJECT 1) - -(RPAQQ \PieceDescriptorPARA 2) - -(RPAQQ \PieceDescriptorPAGEFRAME 3) - -(RPAQQ \PieceDescriptorCHARLOOKSLIST 4) - -(RPAQQ \PieceDescriptorPARALOOKSLIST 5) - -(RPAQQ \PieceDescriptorSAFEOBJECT 6) - - -(CONSTANTS (\PieceDescriptorLOOKS 0) - (\PieceDescriptorOBJECT 1) - (\PieceDescriptorPARA 2) - (\PieceDescriptorPAGEFRAME 3) - (\PieceDescriptorCHARLOOKSLIST 4) - (\PieceDescriptorPARALOOKSLIST 5) - (\PieceDescriptorSAFEOBJECT 6)) -) -) - - - -(* ;; "FROM TEDITCOMMAND") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(PUTPROPS \INSERT\TTY\BUFFER MACRO (NIL (\TEDIT.INSERT.TTY.BUFFER ISCRSTRING IPASSSTRING TEXTOBJ SEL) - )) - -(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 '(IEQP LASTMOUSEBUTTONS 4)) - (MIDDLE '(IEQP LASTMOUSEBUTTONS 1)) - (RIGHT '(IEQP LASTMOUSEBUTTONS 2)) - (SHOULDNT)))) - -(PUTPROPS \TEDIT.CHECK MACRO [ARGS (COND - [(AND (BOUNDP 'CHECK) - CHECK) - (CONS 'PROGN - (for I in ARGS as J on ARGS - when (NOT (STRINGP I)) - collect (LIST 'OR I (LIST 'HELP - "TEdit consistency-check failure [RETURN to continue]: " - (COND - ((STRINGP (CADR J))) - (T (KWOTE I] - (T (CONS COMMENTFLG ARGS]) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) - (TTDECODE (LOGAND DATUM 31)))) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ NONE.TTC 0) - -(RPAQQ CHARDELETE.TTC 1) - -(RPAQQ WORDDELETE.TTC 2) - -(RPAQQ DELETE.TTC 3) - -(RPAQQ FUNCTIONCALL.TTC 4) - -(RPAQQ REDO.TTC 5) - -(RPAQQ UNDO.TTC 6) - -(RPAQQ CMD.TTC 7) - -(RPAQQ NEXT.TTC 8) - -(RPAQQ EXPAND.TTC 9) - -(RPAQQ PUNCT.TTC 20) - -(RPAQQ TEXT.TTC 21) - -(RPAQQ WHITESPACE.TTC 22) - - -(CONSTANTS (NONE.TTC 0) - (CHARDELETE.TTC 1) - (WORDDELETE.TTC 2) - (DELETE.TTC 3) - (FUNCTIONCALL.TTC 4) - (REDO.TTC 5) - (UNDO.TTC 6) - (CMD.TTC 7) - (NEXT.TTC 8) - (EXPAND.TTC 9) - (PUNCT.TTC 20) - (TEXT.TTC 21) - (WHITESPACE.TTC 22)) -) -) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ MSPACE 153) - -(RPAQQ NSPACE 152) - -(RPAQQ THINSPACE 159) - -(RPAQQ FIGSPACE 154) - - -(CONSTANTS (MSPACE 153) - (NSPACE 152) - (THINSPACE 159) - (FIGSPACE 154)) -) -) - - - -(* ;; "FROM TEDITWINDOW") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(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 NOT VISIBLE. Used to track the current state of the - caret) - - TCCARETDS (* The display stream that the caret - appears in) - TCCURSORBM (* The CURSOR representing the caret) - TCCARETRATE (* %# of MSEC between caret up/down - transitions) - TCFORCEUP - - (* T => The caret is not allowed to become visible. - Used to keep the caret up during screen updates) - - TCCARETX (* X position in the window that the - caret appears at) - 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)) -) - -(/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER) - '((TEDITCARET 0 POINTER) - (TEDITCARET 2 POINTER) - (TEDITCARET 4 POINTER) - (TEDITCARET 6 POINTER) - (TEDITCARET 8 POINTER) - (TEDITCARET 10 POINTER) - (TEDITCARET 12 POINTER) - (TEDITCARET 14 POINTER) - (TEDITCARET 16 POINTER) - (TEDITCARET 18 POINTER) - (TEDITCARET 20 POINTER)) - '22) -) - -(/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER - POINTER POINTER POINTER) - '((TEDITCARET 0 POINTER) - (TEDITCARET 2 POINTER) - (TEDITCARET 4 POINTER) - (TEDITCARET 6 POINTER) - (TEDITCARET 8 POINTER) - (TEDITCARET 10 POINTER) - (TEDITCARET 12 POINTER) - (TEDITCARET 14 POINTER) - (TEDITCARET 16 POINTER) - (TEDITCARET 18 POINTER) - (TEDITCARET 20 POINTER)) - '22) - - - -(* ;; "FROM PCTREE added by Nakamura") - -(DECLARE%: EVAL@COMPILE - -(DATATYPE PCTNODE (CHNUM (* ; "Character #of piece in this node.") - PCE (* ; "PIECE ") - LO (* ; - "Subtree these nodes' ch#are less than this node.") - HI (* ; - " Subtree these nodes' ch#are more than this node.") - BF (* ; "Balance factor.") - (* ; - "1: Right(HI) Subtree is higher than left(lo) subtree.") - (* ; - "0: Right subtree and left subtree are same height") - (* ; - "-1: Right(HI) Subtree is shorter than left(lo) subtree.") - RANK (* ; "(# of nodes in left subtree) +1") - ) - CHNUM _ 0 BF _ 0 RANK _ 1) -) - -(/DECLAREDATATYPE 'PCTNODE '(POINTER POINTER POINTER POINTER POINTER POINTER) - '((PCTNODE 0 POINTER) - (PCTNODE 2 POINTER) - (PCTNODE 4 POINTER) - (PCTNODE 6 POINTER) - (PCTNODE 8 POINTER) - (PCTNODE 10 POINTER)) - '12) - - - -(* ;; "FROM TEDITHCPY and TEDITSCREEN") - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) -) -) - - - -(* ;;; "THE END") - - - - -(* ;; -"Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character " -) - -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ NOTBEFORE.LB 1) - -(RPAQQ NOTAFTER.LB 2) - -(RPAQQ BEFORE.LB 4) - -(RPAQQ AFTER.LB 8) - -(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16) - -(RPAQQ NEWCHAR-IF-SPLIT.LB 32) - - -(CONSTANTS (NOTBEFORE.LB 1) - (NOTAFTER.LB 2) - (BEFORE.LB 4) - (AFTER.LB 8) - (DISAPPEAR-IF-NOT-SPLIT.LB 16) - (NEWCHAR-IF-SPLIT.LB 32)) -) -) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (56384 56572 (\NEW-COLUMN-START 56384 . 56572)) (56574 56765 (\FIRST-COLUMN-START 56574 - . 56765)) (72979 74080 (WITHOUT-UPDATES 72979 . 74080))))) -STOP diff --git a/library/tedit/TEDIT-DCL.LCOM b/library/tedit/TEDIT-DCL.LCOM deleted file mode 100644 index 7a269347..00000000 --- a/library/tedit/TEDIT-DCL.LCOM +++ /dev/null @@ -1,464 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "14-Jul-2022 17:04:17" ("compiled on " -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3) "14-Jul-2022 13:19:07" -tcompl'd in "FULL 14-Jul-2022 ..." dated "14-Jul-2022 13:19:12") -(FILECREATED "14-Jul-2022 17:03:38" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;3 84851 :CHANGES-TO (VARS -TEDITFILES) :PREVIOUS-DATE "14-Jul-2022 16:29:57" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-DCL.;2) -(PRETTYCOMPRINT TEDIT-DCLCOMS) -(RPAQQ TEDIT-DCLCOMS ((* ;;; -"This file is the collected record declarations and compile-time necessities for TEDIT.") (* ;; -"FROM TEDIT") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64))) (* ;; -"FROM TEDITSELECTION") (RECORDS SELECTION) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (COPYSELSHADE -30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))) (VARS TEDITFILES) (* ;; -"FROM TEDITSCREEN") (RECORDS THISLINE LINEDESCRIPTOR LINECACHE) (DECLARE%: EVAL@COMPILE DONTCOPY ( -CONSTANTS (LMInvisibleRun 401) (LMLooksChange 400))) (* ;; "FROM TEXTOFD") (RECORDS EDITMARK) (RECORDS - PIECE TEXTOBJ TEXTIMAGEDATA TEXTSTREAM) (OPTIMIZERS TEXTPROP) (COMS (* ;; -"Private data structures and constants FROM TEXTOFD") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS ( -\PCTBFreePieces 0) (\PCTBLastPieceOffset 1) (\FirstPieceOffset 2) (\SecondPieceOffset 4) ( -\EltsPerPiece 2)) (MACROS \EDITELT \GETCH \GETCHB \EDITSETA \WORDSETA) (GLOBALVARS \TEXTIMAGEOPS -\TEXTOFD \TEXTFDEV))) (* ;;; "FROM TEDITPAGE") (RECORDS PAGEFORMATTINGSTATE PAGEREGION) (DECLARE%: -EVAL@COMPILE DONTCOPY (RECORDS TEDITPAPERSIZE) (FUNCTIONS \NEW-COLUMN-START \FIRST-COLUMN-START)) (* -;; "FROM TEDITFIND") (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\AlphaNumericFlag 256) (\AlphaFlag -512) (\OneCharPattern 1024) (\AnyStringPattern 1025) (\OneAlphaPattern 1026) (\AnyAlphaPattern 1027) ( -\OneNonAlphaPattern 1028) (\AnyNonAlphaPattern 1029) (\LeftBracketPattern 1030) (\RightBracketPattern -1031) (\SpecialPattern 1024))) (* ;; " FROM TEDITLOOKS") (RECORDS CHARLOOKS FMTSPEC PENDINGTAB) ( -DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \SMALLPIN \SMALLPOUT ONOFF)) (* ;; "FROM TEDITMENU") ( -DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS MBUTTON)) (INITRECORDS MBUTTON) (DECLARE%: EVAL@COMPILE -DONTCOPY (RECORDS NWAYBUTTON)) (INITRECORDS NWAYBUTTON) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS -MARGINBAR)) (INITRECORDS MARGINBAR) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TAB)) (RECORDS MB.3STATE - MB.BUTTON MB.INSERT MB.MARGINBAR MB.NWAY MB.TEXT MB.TOGGLE) (FUNCTIONS WITHOUT-UPDATES) (* ;; -"FROM TEDITHISTORY") (RECORDS TEDITHISTORYEVENT) (* ;; "FROM TEDITFILE") (DECLARE%: EVAL@COMPILE -DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0) (\PieceDescriptorOBJECT 1) (\PieceDescriptorPARA 2) ( -\PieceDescriptorPAGEFRAME 3) (\PieceDescriptorCHARLOOKSLIST 4) (\PieceDescriptorPARALOOKSLIST 5) ( -\PieceDescriptorSAFEOBJECT 6))) (* ;; "FROM TEDITCOMMAND") (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS -\INSERT\TTY\BUFFER \TEDIT.MOUSESTATE \TEDIT.CHECK)) (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS -TEDITTERMCODE)) (DECLARE%: EVAL@COMPILE DONTCOPY (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) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))) (DECLARE%: EVAL@COMPILE DONTCOPY -(CONSTANTS (MSPACE 153) (NSPACE 152) (THINSPACE 159) (FIGSPACE 154))) (* ;; "FROM TEDITWINDOW") ( -DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITCARET)) (INITRECORDS TEDITCARET) (* ;; -"FROM PCTREE added by Nakamura") (RECORDS PCTNODE) (* ;; "FROM TEDITHCPY and TEDITSCREEN") (DECLARE%: -EVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)) (* ;;; "THE END") ( -COMS (* ;; -"Bits in the CHARTABLE that control line breaking, and what happens when a line is broken on this character " -) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (NOTBEFORE.LB 1) (* ; -"Must not break before this character (e.g. Japanese right-paren)") (NOTAFTER.LB 2) (* ; -"Must not break after this character (e.g. Japanese open-quote)") (BEFORE.LB 4) (* ; -"OK to break before this character, provided it's OK to break after the prior char (true of most non-white-space)" -) (AFTER.LB 8) (* ; -"OK to break after this char, if it's OK to break before the next one (true of most white space)") ( -DISAPPEAR-IF-NOT-SPLIT.LB 16) (* ; -"This character shouldn't be rendered if it isn't the last char on the line (non-breaking hyphen has this)" -) (NEWCHAR-IF-SPLIT.LB 32) (* ; -"Look this char up in *TEDIT-SPLITCHAR-HASH* if this IS the last character on a line, and render it as the char we found." -)))))) -(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." -) Y0 (* ; "Y value of topmost line of selection") X0 (* ; "X value of left edge of selection") 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") CHLIM (* ; -"CH# of the last character in the selection") DCH (* ; -"# of characters selected (can be zero, for point selection.)") 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") 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") (\TEXTOBJ FULLXPOINTER) (* ; -"TEXTOBJ 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) (* ; -"T if there should be a caret for this selection") SELOBJ (* ; -"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.")) SET _ NIL HOW _ -BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T Y0 _ 0 X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST -NIL)) -(/DECLAREDATATYPE (QUOTE SELECTION) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER -POINTER POINTER POINTER POINTER FLAG FULLXPOINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER)) -(QUOTE ((SELECTION 0 POINTER) (SELECTION 2 POINTER) (SELECTION 4 POINTER) (SELECTION 6 POINTER) ( -SELECTION 8 POINTER) (SELECTION 10 POINTER) (SELECTION 12 POINTER) (SELECTION 14 POINTER) (SELECTION -16 POINTER) (SELECTION 18 POINTER) (SELECTION 20 POINTER) (SELECTION 20 (FLAGBITS . 0)) (SELECTION 22 -FULLXPOINTER) (SELECTION 24 POINTER) (SELECTION 26 POINTER) (SELECTION 28 POINTER) (SELECTION 28 ( -FLAGBITS . 0)) (SELECTION 30 POINTER) (SELECTION 30 (FLAGBITS . 0)) (SELECTION 32 POINTER))) (QUOTE 34 -)) -(RPAQQ TEDITFILES (TEDIT-PCTREE TEDIT-TEXTOFD TEDIT TEDIT-ABBREV TEDIT-COMMAND TEDIT-DCL TEDIT-FILE -TEDIT-FIND TEDIT-FNKEYS TEDIT-HCPY TEDIT-HISTORY TEDIT-LOOKS TEDIT-MENU TEDIT-PAGE TEDIT-SCREEN -TEDIT-SELECTION TEDIT-WINDOW)) -(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") LEN (* ; -"Length of the line in characters") CHARS (* ;; -"Array of character codes (or objects) on the line (charcode of 400 => dummy entry for looks change--go get next entry in LOOKS)" -) WIDTHS (* ; "Array of each character's width in points") LOOKS (* ; -"Array of any looks changes within the line. LOOKS (0) = starting character looks for the line") -TLSPACEFACTOR (* ; "The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ; -"The first space to which SPACEFACTOR is to apply. This is used so that spaces to the left of a TAB have their default width." -)) LEN _ 0 CHARS _ (ARRAY 512 (QUOTE POINTER) 0 0) WIDTHS _ (ARRAY 512 (QUOTE POINTER) 0 0) LOOKS _ ( -ARRAY 512 (QUOTE POINTER) NIL 0) TLFIRSTSPACE _ 0) -(DATATYPE LINEDESCRIPTOR ((* ;; -"Description of a single line of formatted text, either on the display or for a printed page.") YBOT ( -* ; "Y value for the bottom of the line (below the descent)") YBASE (* ; -"Yvalue for the base line the characters sit on") LEFTMARGIN (* ; "Left margin, in screen points") -RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ; -"X value of right edge of rightmost character on the line (may exceed right margin, if char is a space.)" -) SPACELEFT (* ; "Space left on the line, ignoring trailing blanks & CRs.") LHEIGHT (* ; -"Total height of hte line, Ascent+Descent.") ASCENT (* ; "Ascent of the line above YBASE") DESCENT (* -; "How far line descends below YBASE") LTRUEDESCENT (* ; -"The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ; -"The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") CHAR1 (* ; -"CH# of the first character on the line.") CHARLIM (* ; "CH# of the last character on the line") -CHARTOP (* ; "CH# of the character which forced the line break (may exceed CHARLIM)") NEXTLINE (* ; -"Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ; -"One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)" -) LTEXTOBJ (* ; -"A cached TEXTOBJ that this line took its text from. Used in hardcopy to disambiguate when chno's should be updated..." -) CACHE (* ; -"A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit." -) LDOBJ (* ; "The object which lies behind this line of text, for updating, etc.") LFMTSPEC (* ; -"The format spec for this line's paragraph (eventually)") (DIRTY FLAG) (* ; -"T if this line has changed since it was last formatted.") (CR\END FLAG) (* ; -"T if this line ends with a CR.") (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.") (LHASTABS FLAG) (* ; -"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")) CHARLIM _ 1000000 NEXTLINE _ NIL PREVLINE _ NIL DIRTY _ NIL -YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL) -(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."))) -(/DECLAREDATATYPE (QUOTE THISLINE) (QUOTE (FULLXPOINTER POINTER POINTER POINTER POINTER POINTER -POINTER)) (QUOTE ((THISLINE 0 FULLXPOINTER) (THISLINE 2 POINTER) (THISLINE 4 POINTER) (THISLINE 6 -POINTER) (THISLINE 8 POINTER) (THISLINE 10 POINTER) (THISLINE 12 POINTER))) (QUOTE 14)) -(/DECLAREDATATYPE (QUOTE LINEDESCRIPTOR) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER -POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER -POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG)) (QUOTE ((LINEDESCRIPTOR 0 POINTER) ( -LINEDESCRIPTOR 2 POINTER) (LINEDESCRIPTOR 4 POINTER) (LINEDESCRIPTOR 6 POINTER) (LINEDESCRIPTOR 8 -POINTER) (LINEDESCRIPTOR 10 POINTER) (LINEDESCRIPTOR 12 POINTER) (LINEDESCRIPTOR 14 POINTER) ( -LINEDESCRIPTOR 16 POINTER) (LINEDESCRIPTOR 18 POINTER) (LINEDESCRIPTOR 20 POINTER) (LINEDESCRIPTOR 22 -POINTER) (LINEDESCRIPTOR 24 POINTER) (LINEDESCRIPTOR 26 POINTER) (LINEDESCRIPTOR 28 POINTER) ( -LINEDESCRIPTOR 30 FULLXPOINTER) (LINEDESCRIPTOR 32 POINTER) (LINEDESCRIPTOR 34 POINTER) ( -LINEDESCRIPTOR 36 POINTER) (LINEDESCRIPTOR 38 POINTER) (LINEDESCRIPTOR 40 POINTER) (LINEDESCRIPTOR 40 -(FLAGBITS . 0)) (LINEDESCRIPTOR 40 (FLAGBITS . 16)) (LINEDESCRIPTOR 40 (FLAGBITS . 32)) ( -LINEDESCRIPTOR 40 (FLAGBITS . 48)) (LINEDESCRIPTOR 38 (FLAGBITS . 0)) (LINEDESCRIPTOR 38 (FLAGBITS . -16)) (LINEDESCRIPTOR 38 (FLAGBITS . 32)))) (QUOTE 42)) -(/DECLAREDATATYPE (QUOTE LINECACHE) (QUOTE (POINTER FULLXPOINTER)) (QUOTE ((LINECACHE 0 POINTER) ( -LINECACHE 2 FULLXPOINTER))) (QUOTE 4)) -(RECORD EDITMARK ((* ;; -"Used for fast access to a given place in the text--a %"Marker%". It consists of the piece, and the offset within the piece, and the piece number within the piece table. That's everything that's needed to set a text stream up quickly to start reading from a given place." -) PC PCOFF . PCNO)) -(DATATYPE PIECE ((* ; -"The piece describes either a string or part of a file. , or a generalized OBJECT.") PSTR (* ; -"The string where this piece's text resides, or NIL") PFILE (* ; -"The file which contains this piece's text, or NIL") PFPOS (* ; -"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.") -NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; -"-> Prior piece in this text object.") PLOOKS (* ; -"Formatting info and formatting events in this piece") POBJ (* ; "The OBJECT this piece describes") ( -PPARALAST FLAG) (* ; "This piece contains a paragraph break") PPARALOOKS (* ; -"Paragraph looks for this piece") (PNEW FLAG) (* ; -"This text is new here; used by the tentative edit system, and anyone else interested.") (PFATP FLAG) - (* ; -"T if the characters in this piece are FAT -- i.e., are 16 bits each. This is trumped for a piece on a file that has its own PEXTERNALFORMAT" -) (PTREENODE XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PEXTERNALFORMAT - POINTER (* ; "The external format of a piece on a file"))) PSTR _ NIL PFILE _ NIL PFPOS _ 0 PLEN _ 0 -PPARALOOKS _ TEDIT.DEFAULT.FMTSPEC PTREENODE _ NIL) -(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") \INSERTPC (* ; -"Piece to hold type-in") \INSERTPCNO (* ; "Piece # of the input piece") \INSERTNEXTCH (* ; -"CH# of next char which is typed into that piece.") \INSERTLEFT (* ; "Space left in the type-in piece" -) \INSERTLEN (* ; "# of characters already in the piece.") \INSERTSTRING (* ; -"The string which the piece describes.") \INSERTFIRSTCH (* ; "CH# of first char in the piece.") ( -\INSERTPCVALID FLAG) (* ; -"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." -) \WINDOW (* ; "The window where this textobj is displayed") MOUSEREGION (* ; -"Section of the window the mouse is in.") LINES (* ; -"-> to top of chain of line descriptors for displayed text") DS (* ; -"Display stream where this textobj is displayed") SEL (* ; "The current selection within the text") -SCRATCHSEL (* ; "Scratch space for the selection code") MOVESEL (* ; -"Source for the next MOVE of text") SHIFTEDSEL (* ; "Source for the next COPY") 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 (* ; -"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) (* ; -"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ; -"Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ; -"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") -(TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ; -"T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing." -) (TXTNONSCHARS FLAG) (* ; -"T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation." -) TXTTERMSA (* ; "Special instructions for displaying characters on the screen") EDITOPACTIVE (* ; -"T if there is an editing operation in progress. Used to interlock the TEdit menu") DEFAULTCHARLOOKS -(* ; -"The default character looks -- if any -- to be applied to characters coming into the file from outside." -) TXTRTBL (* ; "The READTABLE to be used by the command loop for command dispatch") TXTWTBL (* ; -"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.") (SELWINDOW FULLXPOINTER) (* ; -"The window in which the last 'real' selection got made for this edit; used to control caret placement" -) PROMPTWINDOW (* ; -"A window to be used for unscheduled interactions; normally a small window above the edit window") -DISPLAYCACHE (* ; "The bitmap to be used when building the image of a line for display") -DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPLAYHCPYDS (* ; -"The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode" -) TXTPAGEFRAMES (* ; "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) (* ; -"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 (* ; -"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; -"Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ ( -(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (PROGN (IF (NEQ (FETCH (TEXTOBJ \XDIRTY) OF DATUM) -NEWVALUE) THEN (* ; "update the title to reflect the change") (\TEDIT.WINDOW.TITLE DATUM ( -\TEDIT.ORIGINAL.WINDOW.TITLE (ffetch (TEXTOBJ TXTFILE) of DATUM) NEWVALUE))) (freplace \XDIRTY OF -DATUM WITH NEWVALUE))))) SEL _ (create SELECTION) SCRATCHSEL _ (create SELECTION) MOVESEL _ (create -SELECTION HOWHEIGHT _ 32767 HASCARET _ NIL) SHIFTEDSEL _ (create SELECTION HASCARET _ NIL) DELETESEL _ - (create SELECTION HOWHEIGHT _ 32767 HASCARET _ NIL) \INSERTNEXTCH _ -1 \INSERTPC _ NIL \INSERTLEFT _ -0 \INSERTLEN _ 0 \INSERTSTRING _ NIL \INSERTFIRSTCH _ 1000000 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) -(DATATYPE TEXTIMAGEDATA ((* ;; "Fills the IMAGEDATA field of text streams.") TICURPARALOOKS (* ; -"The current paragraph looks") TICURIMAGESTREAM (* ; "The image stream for this hardcopy transduction" -) TILOOKSUPDATEFN (* ; "The function to call to update looks for this stream") TIPCOFFSET (* ; -"The offset into the current piece, as of the last page cross."))) -(ACCESSFNS TEXTSTREAM ((* ;; -"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (REALFILE - (fetch F1 of DATUM) (REPLACE F1 OF DATUM WITH NEWVALUE)) (* ; -"The real, underlying file behind the current piece") (CHARSLEFT (fetch F2 of DATUM) (REPLACE F2 OF -DATUM WITH NEWVALUE)) (* ;; -"The # of characters that will be left in the current piece the next time its file crosses a page boundary" -) (TEXTOBJ (fetch F3 of DATUM) (REPLACE F3 OF DATUM WITH NEWVALUE)) (* ; -"The TEXTOBJ that is editing this text") (PIECE (fetch F5 of DATUM) (REPLACE F5 OF DATUM WITH NEWVALUE -)) (* ; "The PIECE we're currently fetching chars from/putting chars into") (PCNO (fetch FW8 of DATUM) - (REPLACE FW8 OF DATUM WITH NEWVALUE)) (* ; "The position of that piece in the piece table") ( -PCSTARTPG (fetch FW6 of DATUM) (REPLACE FW6 OF DATUM WITH NEWVALUE)) (* ; -"The underlying file page# that this piece starts on") (PCSTARTCH (fetch FW7 of DATUM) (REPLACE FW7 OF - DATUM WITH NEWVALUE)) (* ; -"The char within page of the underlying file that this piece starts on -- for backbin & co") (PCOFFSET - (fetch TIPCOFFSET of (fetch IMAGEDATA of DATUM)) (REPLACE TIPCOFFSET OF (fetch IMAGEDATA of DATUM) -with NEWVALUE)) (* ; "The offset into the current piece, as of the last page cross.") (CURRENTLOOKS ( -fetch F10 of DATUM) (replace F10 of DATUM with NEWVALUE)) (* ; -"The CHARLOOKS that are currently applicable to characters being taken from the stream.") ( -CURRENTPARALOOKS (fetch TICURPARALOOKS of (fetch IMAGEDATA of DATUM)) (REPLACE TICURPARALOOKS OF ( -fetch IMAGEDATA of DATUM) with NEWVALUE)) (* ; -"The FMTSPEC that is currently applicable to characters being taken from the stream.") ( -CURRENTIMAGESTREAM (fetch TICURIMAGESTREAM of (fetch IMAGEDATA of DATUM)) (REPLACE TICURIMAGESTREAM OF - (fetch IMAGEDATA of DATUM) with NEWVALUE) (* ; -"The image stream that this text is being put onto; used for scaling decisions")) (LOOKSUPDATEFN ( -fetch TILOOKSUPDATEFN of (fetch IMAGEDATA of DATUM)) (REPLACE TILOOKSUPDATEFN OF (fetch IMAGEDATA of -DATUM) with NEWVALUE)) (* ; "Function to be called each time character looks change.") (FATSTREAMP ( -fetch F4 of DATUM) (REPLACE F4 OF DATUM WITH NEWVALUE)) (* ; -"T if the current piece is 16 bit characters.")) (CREATE (create STREAM using \TEXTOFD IMAGEDATA _ ( -create TEXTIMAGEDATA)))) -(/DECLAREDATATYPE (QUOTE PIECE) (QUOTE (POINTER POINTER POINTER POINTER POINTER FULLXPOINTER POINTER -POINTER FLAG POINTER FLAG FLAG XPOINTER POINTER)) (QUOTE ((PIECE 0 POINTER) (PIECE 2 POINTER) (PIECE 4 - POINTER) (PIECE 6 POINTER) (PIECE 8 POINTER) (PIECE 10 FULLXPOINTER) (PIECE 12 POINTER) (PIECE 14 -POINTER) (PIECE 14 (FLAGBITS . 0)) (PIECE 16 POINTER) (PIECE 16 (FLAGBITS . 0)) (PIECE 16 (FLAGBITS . -16)) (PIECE 18 XPOINTER) (PIECE 20 POINTER))) (QUOTE 22)) -(/DECLAREDATATYPE (QUOTE TEXTOBJ) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER -POINTER POINTER FLAG POINTER 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)) (QUOTE ((TEXTOBJ -0 POINTER) (TEXTOBJ 2 POINTER) (TEXTOBJ 4 POINTER) (TEXTOBJ 6 POINTER) (TEXTOBJ 8 POINTER) (TEXTOBJ 10 - POINTER) (TEXTOBJ 12 POINTER) (TEXTOBJ 14 POINTER) (TEXTOBJ 16 POINTER) (TEXTOBJ 16 (FLAGBITS . 0)) ( -TEXTOBJ 18 POINTER) (TEXTOBJ 20 POINTER) (TEXTOBJ 22 POINTER) (TEXTOBJ 24 POINTER) (TEXTOBJ 26 POINTER -) (TEXTOBJ 28 POINTER) (TEXTOBJ 30 POINTER) (TEXTOBJ 32 POINTER) (TEXTOBJ 34 POINTER) (TEXTOBJ 36 -POINTER) (TEXTOBJ 38 POINTER) (TEXTOBJ 40 POINTER) (TEXTOBJ 42 POINTER) (TEXTOBJ 44 POINTER) (TEXTOBJ -44 (FLAGBITS . 0)) (TEXTOBJ 46 FULLXPOINTER) (TEXTOBJ 48 POINTER) (TEXTOBJ 50 POINTER) (TEXTOBJ 52 -POINTER) (TEXTOBJ 54 POINTER) (TEXTOBJ 56 POINTER) (TEXTOBJ 56 (FLAGBITS . 0)) (TEXTOBJ 58 POINTER) ( -TEXTOBJ 58 (FLAGBITS . 0)) (TEXTOBJ 58 (FLAGBITS . 16)) (TEXTOBJ 58 (FLAGBITS . 32)) (TEXTOBJ 58 ( -FLAGBITS . 48)) (TEXTOBJ 60 POINTER) (TEXTOBJ 62 POINTER) (TEXTOBJ 64 POINTER) (TEXTOBJ 66 POINTER) ( -TEXTOBJ 68 POINTER) (TEXTOBJ 70 POINTER) (TEXTOBJ 70 (FLAGBITS . 0)) (TEXTOBJ 72 POINTER) (TEXTOBJ 74 -FULLXPOINTER) (TEXTOBJ 76 POINTER) (TEXTOBJ 78 POINTER) (TEXTOBJ 80 POINTER) (TEXTOBJ 82 POINTER) ( -TEXTOBJ 84 POINTER) (TEXTOBJ 86 POINTER) (TEXTOBJ 88 POINTER) (TEXTOBJ 88 (FLAGBITS . 0)) (TEXTOBJ 88 -(FLAGBITS . 16)) (TEXTOBJ 90 POINTER) (TEXTOBJ 92 POINTER) (TEXTOBJ 94 POINTER))) (QUOTE 96)) -(/DECLAREDATATYPE (QUOTE TEXTIMAGEDATA) (QUOTE (POINTER POINTER POINTER POINTER)) (QUOTE (( -TEXTIMAGEDATA 0 POINTER) (TEXTIMAGEDATA 2 POINTER) (TEXTIMAGEDATA 4 POINTER) (TEXTIMAGEDATA 6 POINTER) -)) (QUOTE 8)) -(DEFOPTIMIZER TEXTPROP (TEXTOBJ PROP &OPTIONAL (VAL NIL WRITING)) (* ;; "compiles calls to TEXTPROP") -(COND ((NOT (LISTP PROP)) (* ; "property is not quoted.") (QUOTE IGNOREMACRO)) ((NOT (EQ (CAR PROP) ( -QUOTE QUOTE))) (* ; "property is not quoted.") (QUOTE IGNOREMACRO)) ((NOT WRITING) (* ; -"fetching a TEXTPROP property.") (SELECTQ (CADR PROP) ((READONLY READ-ONLY) (BQUOTE (fetch (TEXTOBJ -TXTREADONLY) of (TEXTOBJ (\, TEXTOBJ))))) ((BEING-EDITED ACTIVE) (BQUOTE (fetch (TEXTOBJ TXTEDITING) -of (TEXTOBJ (\, TEXTOBJ))))) ((NO-NS-CHARS NONSCHARS NO-NSCHARS) (BQUOTE (fetch (TEXTOBJ TXTNONSCHARS) - of (TEXTOBJ (\, TEXTOBJ))))) (BQUOTE (LISTGET (fetch (TEXTOBJ EDITPROPS) of (TEXTOBJ (\, TEXTOBJ))) ( -\, PROP))))) (T (* ; "storing a window property") (SELECTQ (CADR PROP) ((READONLY READ-ONLY) (BQUOTE ( -REPLACE (TEXTOBJ TXTREADONLY) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL)))) ((BEING-EDITED ACTIVE) ( -BQUOTE (REPLACE (TEXTOBJ TXTEDITING) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL)))) ((NO-NS-CHARS -NONSCHARS NO-NSCHARS) (BQUOTE (REPLACE (TEXTOBJ TXTNONSCHARS) OF (TEXTOBJ (\, TEXTOBJ)) WITH (\, VAL)) -)) (BQUOTE (LET* (($$TEXTOBJ$$ (TEXTOBJ (\, TEXTOBJ))) ($$PROPLST$$ (FETCH EDITPROPS OF $$TEXTOBJ$$))) - (COND ($$PROPLST$$ (LISTPUT $$PROPLST$$ (\, PROP) (\, VAL))) (T (REPLACE EDITPROPS OF $$TEXTOBJ$$ -WITH (LIST (\, PROP) (\, VAL))))))))))) -(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." -) MINPAGE# (* ; "The page # of the first page to be printed, or NIL") MAXPAGE# (* ; -"The page # of the last page to be printed, or NIL") STATE (* ; "One of FORMATTING or SEARCHING.") -REQUIREDREGIONTYPE (* ; -"If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page." -) MAINSTREAM (* ; "The principal textobj/stream source") CHNO (* ; "Our position in that stream") -PRESSREGION (* ; "The press code's REGION info.") PAGEHEADINGS (* ; -"The list of current values to be printed, indexed by heading type") PAGE#GENERATOR (* ; -"List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below" -) PAGE#TEXT (* ; -"If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c" -) PAGEISRECTO (* ; "T if this is a recto page, NIL if it's a VERSO page.") PAGEFOOTNOTELINES (* ; -"A list of extant footnote lines that should appear at the next opportunity") PAGEFLOATINGTOPLINES (* -; "A list of lines that should float to the top of the next available place") PAGECOUNT (* ; -"The number of pages we've formatted so far.") PAGELINECACHE (* ; -"A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time" -) NEWPAGELAYOUT (* ; -"If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again." -)) PAGECOUNT _ 0) -(DATATYPE PAGEREGION ((* ;; -"Describe a part of a page for page formatting. Can be made into compound descriptions.") -REGIONFILLMETHOD (* ; "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") REGIONSPEC (* - ; "The page-relative region this occupies") REGIONLOCALINFO (* ; "A PLIST for local information") ( -REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") REGIONSUBBOXES (* ; -"The sub-regions of this region") REGIONTYPE (* ; "A user-settable region type"))) -(/DECLAREDATATYPE (QUOTE PAGEREGION) (QUOTE (POINTER POINTER POINTER FULLXPOINTER POINTER POINTER)) ( -QUOTE ((PAGEREGION 0 POINTER) (PAGEREGION 2 POINTER) (PAGEREGION 4 POINTER) (PAGEREGION 6 FULLXPOINTER -) (PAGEREGION 8 POINTER) (PAGEREGION 10 POINTER))) (QUOTE 12)) -(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") -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) (* ; -"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ; -"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ; -"T if the characters are to be struck thru, else nil.") CLOFFSET (* ; -"A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") (CLSMALLCAP 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 this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)" -) CLSTYLE (* ; "The style to be used in marking these characters; overridden by the other fields") -CLUSERINFO (* ; "Any information that an outsider wants to include") CLLEADER (* ; -"For creating dotted and other kinds of leader") CLRULES (* ;; -"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) -(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 (* ; -"Right margin for the paragraph") LEADBEFORE (* ; -"Leading above the paragraph's first line, in points") LEADAFTER (* ; -"Leading below the paragraph's bottom line, in points. NOT IMPLEMENTED.") LINELEAD (* ; -"Leading between lines, in points. Actually, this space is added BELOW each line in the para.") -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 (* ; -"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 (* ; -"A special horizontal location on the printed page for this para.") FMTSPECIALY (* ; -"A special vertical location on the page for this para") (FMTHEADINGKEEP FLAG) (* ; -"This para should be kept with the top line or so of the next para..") FMTPARATYPE (* ; -"What kind of para this is: TEXT, PAGEHEADING, whatever") FMTPARASUBTYPE (* ; -"Sub type of the type, e.g., what KIND of page heading this is.") FMTNEWPAGEBEFORE (* ; -"Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box." -) FMTNEWPAGEAFTER (* ; "Similarly") FMTKEEP (* ; -"For information about how this paragraph is to be kept with other paragraphs.") FMTCOLUMN (* ; -"For setting up side-by-side paragraphs easily ala BravoX") FMTVERTRULES (* ; -"For Keeping track of vertical rules in force") (FMTMARK FLAG) (* ; -"Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file" -) (* ; -"Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file." -) (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." -)) TABSPEC _ (CONS NIL NIL)) -(DATATYPE PENDINGTAB ((* ;; -"The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting." -) PTNEWTX (* ;; -"An updated TX, being passed back to the line formatter. This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab, which changed the width of a prior tab." -) PTOLDTAB (* ; "The pending tab") PTTYPE (* ; "Its tab type") PTTABX (* ; "Its nominal X position") ( -PTWBASE FULLXPOINTER) (* ; -"The WBASE for its width, for updating when we've figured out how wide the tab really is") PTOLDTX (* -; "The TX as of when the tab was encountered."))) -(/DECLAREDATATYPE (QUOTE CHARLOOKS) (QUOTE (POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER -FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER POINTER POINTER FLAG)) (QUOTE ((CHARLOOKS 0 POINTER) ( -CHARLOOKS 2 POINTER) (CHARLOOKS 4 POINTER) (CHARLOOKS 4 (FLAGBITS . 0)) (CHARLOOKS 4 (FLAGBITS . 16)) -(CHARLOOKS 4 (FLAGBITS . 32)) (CHARLOOKS 4 (FLAGBITS . 48)) (CHARLOOKS 2 (FLAGBITS . 0)) (CHARLOOKS 6 -POINTER) (CHARLOOKS 6 (FLAGBITS . 0)) (CHARLOOKS 6 (FLAGBITS . 16)) (CHARLOOKS 6 (FLAGBITS . 32)) ( -CHARLOOKS 6 (FLAGBITS . 48)) (CHARLOOKS 2 (FLAGBITS . 16)) (CHARLOOKS 2 (FLAGBITS . 32)) (CHARLOOKS 8 -POINTER) (CHARLOOKS 10 POINTER) (CHARLOOKS 12 POINTER) (CHARLOOKS 14 POINTER) (CHARLOOKS 14 (FLAGBITS - . 0)))) (QUOTE 16)) -(/DECLAREDATATYPE (QUOTE FMTSPEC) (QUOTE (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)) (QUOTE ((FMTSPEC 0 POINTER) (FMTSPEC 2 POINTER) (FMTSPEC 4 POINTER -) (FMTSPEC 6 POINTER) (FMTSPEC 8 POINTER) (FMTSPEC 10 POINTER) (FMTSPEC 12 POINTER) (FMTSPEC 14 -POINTER) (FMTSPEC 16 POINTER) (FMTSPEC 18 POINTER) (FMTSPEC 20 POINTER) (FMTSPEC 22 POINTER) (FMTSPEC -24 POINTER) (FMTSPEC 26 POINTER) (FMTSPEC 26 (FLAGBITS . 0)) (FMTSPEC 28 POINTER) (FMTSPEC 30 POINTER) - (FMTSPEC 32 POINTER) (FMTSPEC 34 POINTER) (FMTSPEC 36 POINTER) (FMTSPEC 38 POINTER) (FMTSPEC 40 -POINTER) (FMTSPEC 40 (FLAGBITS . 0)) (FMTSPEC 40 (FLAGBITS . 16)) (FMTSPEC 42 POINTER))) (QUOTE 44)) -(/DECLAREDATATYPE (QUOTE PENDINGTAB) (QUOTE (POINTER POINTER POINTER POINTER FULLXPOINTER POINTER)) ( -QUOTE ((PENDINGTAB 0 POINTER) (PENDINGTAB 2 POINTER) (PENDINGTAB 4 POINTER) (PENDINGTAB 6 POINTER) ( -PENDINGTAB 8 FULLXPOINTER) (PENDINGTAB 10 POINTER))) (QUOTE 12)) -(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))) -(DEFMACRO WITHOUT-UPDATES (TEXTOBJ SCRATCHSEL &BODY BODY) (* ;; -"For TEdit windows, run BODY without updating the edit window for TEXTOBJ. 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 you'll be modifying.") (* ;; -"SCRATCHSEL should be the scratch selection (often used in this work)") (BQUOTE (LET ((OLD-UNWIND-FLAG - (FETCH (TEXTOBJ TXTDON'TUPDATE) OF (\, TEXTOBJ)))) (CL:UNWIND-PROTECT (PROGN (replace (TEXTOBJ -TXTDON'TUPDATE) of (\, TEXTOBJ) with T) (\,@ BODY)) (\SHOWSEL (\, SCRATCHSEL) NIL NIL) (replace SET of - (\, SCRATCHSEL) with NIL) (\TEDIT.MARK.LINES.DIRTY (\, TEXTOBJ) 1 (fetch (TEXTOBJ TEXTLEN) of (\, -TEXTOBJ))) (replace (TEXTOBJ TXTDON'TUPDATE) of (\, TEXTOBJ) with OLD-UNWIND-FLAG) ( -TEDIT.UPDATE.SCREEN (\, TEXTOBJ)))))) -(RECORD TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (* ; -"A LITATOM, 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") THAUXINFO (* ; -"Auxiliary info about the event, primarily for redo") THTEXTOBJ (* ;; -"Place to remember a second textobj, for those like MOVE who need to remember both a source and a destination." -)) THPOINT _ (QUOTE LEFT)) -(/DECLAREDATATYPE (QUOTE TEDITCARET) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER -POINTER POINTER POINTER POINTER)) (QUOTE ((TEDITCARET 0 POINTER) (TEDITCARET 2 POINTER) (TEDITCARET 4 -POINTER) (TEDITCARET 6 POINTER) (TEDITCARET 8 POINTER) (TEDITCARET 10 POINTER) (TEDITCARET 12 POINTER) - (TEDITCARET 14 POINTER) (TEDITCARET 16 POINTER) (TEDITCARET 18 POINTER) (TEDITCARET 20 POINTER))) ( -QUOTE 22)) -(DATATYPE PCTNODE (CHNUM (* ; "Character #of piece in this node.") PCE (* ; "PIECE ") LO (* ; -"Subtree these nodes' ch#are less than this node.") HI (* ; -" Subtree these nodes' ch#are more than this node.") BF (* ; "Balance factor.") (* ; -"1: Right(HI) Subtree is higher than left(lo) subtree.") (* ; -"0: Right subtree and left subtree are same height") (* ; -"-1: Right(HI) Subtree is shorter than left(lo) subtree.") RANK (* ; "(# of nodes in left subtree) +1" -)) CHNUM _ 0 BF _ 0 RANK _ 1) -(/DECLAREDATATYPE (QUOTE PCTNODE) (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER)) (QUOTE (( -PCTNODE 0 POINTER) (PCTNODE 2 POINTER) (PCTNODE 4 POINTER) (PCTNODE 6 POINTER) (PCTNODE 8 POINTER) ( -PCTNODE 10 POINTER))) (QUOTE 12)) -NIL diff --git a/library/tedit/TEDIT-DEFAULT-USER.CM b/library/tedit/TEDIT-DEFAULT-USER.CM new file mode 100644 index 00000000..09c48b1e --- /dev/null +++ b/library/tedit/TEDIT-DEFAULT-USER.CM @@ -0,0 +1,88 @@ +[CHAT] +CONNECT: MAXC2 +TYPESCRIPT: Chat.TypeScript 25000 +FONT: Gacha10.al +BORDER: BLACK +BELL: FLASH + +[EXECUTIVE] +eventBooted: settime +eventRFC: FTP // eventRFC +eventInstall: // eventInstall +eventAboutToDie: // eventAboutToDie +eventUnknown: // eventUnknown +(635) +[BRAVO] +B.INIT:"{6,2,0,4}g'@1.bcpl@@G[@1.bcpl]{6,2,0,0}wny1114,y1114,y1114,{6,4,0,4}g'@1.bt@@G[@1.bt]{6,2,0,0}@@E" + +C.INIT:"{6,1,0,0}g'line.cm@@G[line.cm]@@E" + +F.INIT:"{6,1,0,0}g'form.@1@@G[form.@1]@@E" + +H.INIT:"{6,2,0,6}g'@1@@G[@1]{6,2,0,0}hc'@2@@@@'@3 +*q +@@E" + +M.INIT:"{6,1,0,0}g'form.memo@@G[form.memo]@@E" + +N.INIT:"{6,1,0,0}g'@1@@G[@1]@@E" + +P.INIT:"{6,2,0,4}g'@1@@G[@1]{6,2,0,0}wny1114,y1114,y1114,{6,4,0,4}g'qspell.tx@@G[qspell.tx]{6,2,0,0}@@E" + +B.QUIT:"{6,1,0,0}q +BCPL/F @4;BRAVO/B @4 +" + +C.QUIT:"*P'line.cm@@P[line.cm]*q +@@line.cm@@ +" + +p.QUIT:"{6,1,0,0}q +PROOFREADER @4;BRAVO/P @4 +" + +FONT:0 HELVETICA 10 HELVETICA 12 HELVETICA 10 +FONT:1 HELVETICA 8 HELVETICA 10 HELVETICA 8 +FONT:2 LOGO 24 LOGO 24 +FONT:3 MATH 10 MATH 10 +FONT:4 HIPPO 10 HIPPO 10 +FONT:5 TIMESROMAN 12 TIMESROMAN 14 TIMESROMAN 12 +FONT:6 HELVETICA 10 HELVETICA 12 HELVETICA 10 +FONT:7 HELVETICA 8 HELVETICA 10 HELVETICA 8 +FONT:8 GACHA 10 GACHA 12 GACHA 10 +FONT:9 HELVETICA 18 HELVETICA 18 +FONT:D HYTYPE 12 GACHA 12 + + +TABS: Standard tab width = 635 +MARGINS: paragraph margin = 2999,Left margin = 2999, right margin = 18591 +UPDOWN: Delta left = 1270, Delta right = 0, Delta paragraph = 0 +LEAD: Line leading = 1, Paragraph leading = 6 +SCREEN: Screen top = 25, System window end = 90, Screen bottom = 780 +OFFSET: Standard offset = 4 + +[DDS] +FONT: timesroman10.al +SMALLFONT: gacha10.al +CONTEXT: not (*.al or *.run or sys* or *.scratch* or dds* or swat* or bravo.* or DEFAULT.ED or DiskDescriptor or *.Boot or *.b or FONTS.WIDTHS or MANUAL1.DRAW or com.cm or rem.cm) +FULLINIT: No +SELSPEC: * +SORT BY: name^,extension^ +SHOW: (times),written,length + +[HARDCOPY] +HOST: Maxc +PRESS: Clover +PREFERREDFORMAT: Press +EXTENSION: .bravo +FONT: Gacha 10 MRR +COLOR-PRESS: Viola + + +[SIL] +0: XHELVETICA10B +1: XHELVETICA8 +2: HELVETICA12 +3: GATES32 + +\1610v8V diff --git a/library/tedit/TEDIT-FILE b/library/tedit/TEDIT-FILE index 32288690..bb19121e 100644 --- a/library/tedit/TEDIT-FILE +++ b/library/tedit/TEDIT-FILE @@ -1,454 +1,769 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Jul-2022 15:06:59"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-FILE.;29 225044 +(FILECREATED "11-Mar-2024 00:38:51" {WMEDLEY}tedit>TEDIT-FILE.;502 152349 - :CHANGES-TO (FNS \TEDIT.CONVERT.FOREIGN.FORMAT) + :EDIT-BY rmk - :PREVIOUS-DATE "20-Jul-2022 11:23:04" -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-FILE.;28) + :CHANGES-TO (FNS TEDIT.PUT.STREAM \TEDIT.PUT.PCTB \TEDIT.PUT.TRAILER \TEDIT.PUT.CHARLOOKS + \TEDIT.PUT.CHARLOOKS1) + + :PREVIOUS-DATE " 4-Mar-2024 22:50:23" {WMEDLEY}tedit>TEDIT-FILE.;501) (PRETTYCOMPRINT TEDIT-FILECOMS) (RPAQQ TEDIT-FILECOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) + ((DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\PieceDescriptorLOOKS 0) + (\PieceDescriptorOBJECT 1) + (\PieceDescriptorPARA 2) + (\PieceDescriptorPAGEFRAME 3) + (\PieceDescriptorCHARLOOKSLIST 4) + (\PieceDescriptorPARALOOKSLIST 5) + (\PieceDescriptorSAFEOBJECT 6) + (\PieceDescriptorMETAINFO 7)) + (EXPORT (MACROS \SMALLPIN \SMALLPOUT))) (COMS - (* ;; "GETting a file") + (* ;; "Public entries ") - (FNS TEDIT.BUILD.PCTB \TEDIT.CONVERT.FOREIGN.FORMAT TEDIT.FORMATTEDFILEP TEDIT.GET - TEDIT.PARSE.PAGEFRAMES1 \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.FORMATTEDP1 - \TEDIT.SET.WINDOW TEDIT.GET.PASSWORD) - (FNS \TEDIT.READ.FORMATTED.FILE \TEDIT.READ.UNFORMATTED.FILE \TEDIT.CACHEFILE - \TEDIT.UNIQUIFY.ALL)) + (FNS TEDIT.GET TEDIT.FORMATTEDFILEP TEDIT.FILEDATE \TEDIT.GET.IDATE3 TEDIT.INCLUDE + TEDIT.RAW.INCLUDE TEDIT.PUT TEDIT.PUT.STREAM) + + (* ;; "Getting (pageframe functions on TEDIT-PAGE)") + + (FNS \TEDIT.GET.FOREIGN.FILE \TEDIT.GET.UNFORMATTED.FILE \TEDIT.GET.FORMATTED.FILE + \TEDIT.FORMATTEDSTREAMP \ARBIN \ATMIN \DWIN \STRINGIN \TEDIT.GET.TRAILER + \TEDIT.CACHEFILE) + [COMS + (* ;; + "Until CL:COMPILE-FILE and any others are updated, They should use the public TEDIT.FORMATTEDFILEP") + + (P (MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1] + (FNS \TEDIT.GET.PIECES3 \TEDIT.MAKE.STRINGPIECE) + (FNS \TEDIT.GET.UNFORMATTED.FILE.XCCS \TEDIT.INTERPRET.XCCS.SHIFTS) + (* ; "XCCS") + (FNS \TEDIT.GET.UNFORMATTED.FILE.UTF8) + (* ; "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.OBJECT)) (COMS - (* ;; "INCLUDEing a file") + (* ;; "Putting (pageframe functions on TEDIT-PAGE)") - (FNS TEDIT.INCLUDE TEDIT.RAW.INCLUDE)) - (COMS - (* ;; "PUTting a file:") - - (FNS TEDIT.PUT TEDIT.PUT.PCTB \TEDIT.PUTRESET TEDIT.PUT.PIECE.DESCRIPTOR \ARBOUT - \ATMOUT \DWOUT \STRINGOUT \TEDIT-OPEN-FONT-FILE)) - (FNS \TEDIT.GET.CHARLOOKS.LIST \TEDIT.GET.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS.LIST - \TEDIT.PUT.SINGLE.CHARLOOKS) - (FNS \TEDIT.GET.PARALOOKS.LIST \TEDIT.GET.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS.LIST - \TEDIT.PUT.SINGLE.PARALOOKS) + (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.CHARLOOKS.LIST \TEDIT.PUT.SINGLE.CHARLOOKS \TEDIT.PUT.CHARLOOKS + \TEDIT.PUT.CHARLOOKS1) + (FNS \TEDIT.PUT.PARALOOKS.LIST \TEDIT.PUT.SINGLE.PARALOOKS \TEDIT.PUT.PARALOOKS) + (FNS TEDIT.PUT.OBJECT)) (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) - (INITVARS (TEDIT.INPUT.FORMATS NIL) - (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) + (FNS TEDITFROMLISPSOURCE) + (ADDVARS (TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE))) + (INITVARS (*TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) (* ;  "For consistent reading and writing of info on TEdit files.") - ) - (COMS - (* ;; - "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") - - (FNS TEDIT.BUILD.PCTB2 \TEDIT.GET.CHARLOOKS.LIST2 \TEDIT.GET.SINGLE.CHARLOOKS2 - \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.PUT.SINGLE.CHARLOOKS2 - \TEDIT.GET.PARALOOKS.LIST2 \TEDIT.GET.SINGLE.PARALOOKS2 TEDIT.PUT.PCTB2 - \TEDIT.PUT.CHARLOOKS.LIST2 \TEDIT.PUT.PARALOOKS.LIST2)) - (COMS - (* ;; "For converting incoming old-format files (1/27/85 cutover)") - - (FNS TEDIT.BUILD.PCTB1 TEDIT.GET.PAGEFRAMES1 \TEDIT.GET.CHARLOOKS1 - \TEDIT.GET.PARALOOKS1 TEDIT.GET.OBJECT1)) - (COMS - (* ;; "VERSION 0 Compatibility reading functions") - - (FNS TEDIT.BUILD.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0)))) - -(FILESLOAD TEDIT-DCL) + ))) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(RPAQQ \PieceDescriptorLOOKS 0) + +(RPAQQ \PieceDescriptorOBJECT 1) + +(RPAQQ \PieceDescriptorPARA 2) + +(RPAQQ \PieceDescriptorPAGEFRAME 3) + +(RPAQQ \PieceDescriptorCHARLOOKSLIST 4) + +(RPAQQ \PieceDescriptorPARALOOKSLIST 5) + +(RPAQQ \PieceDescriptorSAFEOBJECT 6) + +(RPAQQ \PieceDescriptorMETAINFO 7) -(CONSTANTS (\SCRATCHLEN 64)) +(CONSTANTS (\PieceDescriptorLOOKS 0) + (\PieceDescriptorOBJECT 1) + (\PieceDescriptorPARA 2) + (\PieceDescriptorPAGEFRAME 3) + (\PieceDescriptorCHARLOOKSLIST 4) + (\PieceDescriptorPARALOOKSLIST 5) + (\PieceDescriptorSAFEOBJECT 6) + (\PieceDescriptorMETAINFO 7)) ) +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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)))) +) + +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) ) -(* ;; "GETting a file") +(* ;; "Public entries ") (DEFINEQ -(TEDIT.BUILD.PCTB - [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS UNFORMATTED?) - (* ; "Edited 19-Jul-2022 10:12 by rmk") - (* ; "Edited 29-Apr-2021 22:52 by rmk:") - (* ; "Edited 11-Jun-99 14:37 by rmk:") - (* ; "Edited 19-Apr-93 13:46 by jds") - (* ; - "START = 1st char of file to read from, if specified") - - (* ;; "Set the default paragraph formatting for filling in piece PPARALOOKS fields") - - (CL:UNLESS DEFAULTPARALOOKS - [SETQ DEFAULTPARALOOKS (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - (T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC]) - (CL:UNLESS DEFAULTLOOKS (* ; - "Set the default CHARLOOKS, for filling in pieces' PLOOKS fields") - (SETQ DEFAULTLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (CL:WHEN TEXTOBJ (* ; "If there's a TEXTOBJ behind this, set its TXTFILE field to point to the right place, and assume no page formatting") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT) - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with NIL)) - (CL:UNLESS START (SETQ START 0)) (* ; - "END = use this as eofptr of file. For use in reading files within files.") - (LET (PCTB PCCOUNT CACHE (*READTABLE* *TEDIT-FILE-READTABLE*) - (*PRINT-BASE* 10)) - (SETQ TEXT (\CREATEPIECEORSTREAM TEXT DEFAULTLOOKS DEFAULTPARALOOKS START END)) - (* ; - "Grab the file, or a single piece (if the text is a string, or such simple cases)") - (* ; - "Start by assuming no page formatting") - (CL:WHEN (STREAMP TEXT) (* ; - "OK, it wasn't a string, so check for cases where we have to cache the file locally.") - (CL:WHEN TEXTOBJ (* ; - "Didn't we just do this? Did the STREAM text change?") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with TEXT)) - (CL:WHEN (OR (AND TEXTOBJ (TEXTPROP TEXTOBJ 'CACHE)) - (NOT (RANDACCESSP TEXT))) (* ; - "If the file device isn't random access, cache the file locally.") - (* ; - "Also do this if he asks for a local cache.") - (SETQ TEXT (\TEDIT.CACHEFILE TEXT TEXTOBJ START END)) - - (* ;; - "Since we only copied the relevant part of the file into the cache, the whole file is now relevant.") - - (SETQ START 0) - (SETQ END (GETEOFPTR TEXT))) - - (* ;; - "Check to see if this is a formatted file, and find out how many pieces we should allocate for it.") - - (SETQ PCCOUNT (\TEDIT.FORMATTEDP1 TEXT END))) - [SETQ PCTB - (COND - ((type? PIECE TEXT) - - (* ;; "If this isn't a stream, build a piece table containing one piece.") - - [COND - ((EQ (fetch (PIECE PLEN) of TEXT) - 0) - (SETQ TEXT NIL)) - (T (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) of TEXT) - TEXTOBJ)) - (* ; - "And note the CHARLOOKS and PARALOOKS of this text--as well as filling them in.") - (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) of TEXT) - TEXTOBJ] - (\MAKEPCTB TEXT)) - (UNFORMATTED? - - (* ;; "If the user wants an uninterpreted stream onto even a formatted file , build a piece table with the one piece in it.") - - (SETQ TEXT - (create PIECE - PFILE _ TEXT - PFPOS _ START - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - START) - PREVPIECE _ NIL - PLOOKS _ DEFAULTLOOKS - PPARALAST _ NIL - PPARALOOKS _ DEFAULTPARALOOKS - PEXTERNALFORMAT _ (GETSTREAMPROP TEXT :EXTERNAL-FORMAT))) - (replace (PIECE PLOOKS) of TEXT with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) of TEXT) - TEXTOBJ)) - (* ; - "And note the CHARLOOKS and PARALOOKS for later saving. Keep those caches consistent.") - (replace (PIECE PPARALOOKS) of TEXT with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) of TEXT) - TEXTOBJ)) - (\MAKEPCTB TEXT)) - ((NOT PCCOUNT) (* ; "This is an unformatted file") - (\TEDIT.READ.UNFORMATTED.FILE TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS)) - ((LISTP PCCOUNT) (* ; - "This is an obsolete version of the TEdit file format.") - (SELECTQ (CAR PCCOUNT) - (0 (* ; "VERSION 0") - (TEDIT.BUILD.PCTB0 TEXT TEXTOBJ (CDR PCCOUNT) - START END DEFAULTLOOKS DEFAULTPARALOOKS)) - (1 (* ; - "Version 1; obsoleted at INTERMEZZO release 2/85") - (TEDIT.BUILD.PCTB1 TEXT TEXTOBJ (CDR PCCOUNT) - START END DEFAULTLOOKS DEFAULTPARALOOKS)) - (2 (* ; "Version 2; obsoleted 5/22/85") - (TEDIT.BUILD.PCTB2 TEXT TEXTOBJ (CDR PCCOUNT) - START END DEFAULTLOOKS DEFAULTPARALOOKS)) - (SHOULDNT "File format version incompatible with this version of TEdit."))) - (T (* ; - "This is a current TEdit-format file") - (\TEDIT.READ.FORMATTED.FILE TEXT TEXTOBJ START END PCCOUNT DEFAULTLOOKS - DEFAULTPARALOOKS] - (\TEDIT.UNIQUIFY.ALL TEXTOBJ DEFAULTLOOKS) (* ; - "Make sure the default paralooks are merged.") - (CL:WHEN TEXT - [bind (CHARLOOKSLIST _ (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) - (PARALOOKSLIST _ (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - for (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) by (fetch (PIECE NEXTPIECE) of PC) while PC - until (EQ PC 'LASTPIECE) do (* ; - "Look at every piece, and assure that its CHARLOOKS and PARALOOKS are in the cache.") - (CL:UNLESS (FMEMB (fetch (PIECE PLOOKS) of PC) - CHARLOOKSLIST) - (* ; - "This piece's CHARLOOKS are not known in the cache already. ") - (replace (PIECE PLOOKS) of PC - with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (PIECE PLOOKS) of PC) - TEXTOBJ))) - (CL:UNLESS (FMEMB (fetch (PIECE PPARALOOKS) of PC) - PARALOOKSLIST) - (* ; - "This piece's PARALOOKS are not known in the cache already. ") - (replace (PIECE PPARALOOKS) of PC - with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) of PC) - TEXTOBJ)))]) - PCTB]) - -(\TEDIT.CONVERT.FOREIGN.FORMAT - [LAMBDA (CONVERSIONFN FILE PREDICATERESULT TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 20-Jul-2022 15:06 by rmk") - (* ; "Edited 19-Jul-2022 10:09 by rmk") - (* ; "Edited 12-Jun-90 18:16 by mitani") - - (* ;; - "Perform the conversion from a foreign file format into TEdit-internal form as an open TextStream.") - - (LET (TSTREAM TTEXTOBJ SEL WORKINGSTREAM) (* ; "See if there are Bravo headers") - (SETQ WORKINGSTREAM (OPENTEXTSTREAM)) - (RESETLST - (RESETSAVE (\TEDIT.SET.WINDOW (CONS (TEXTOBJ WORKINGSTREAM) - NIL))) - (SETQ TSTREAM (APPLY* CONVERSIONFN FILE PREDICATERESULT WORKINGSTREAM))) - (COND - (TEXTOBJ (* ; - "If we're filling in an existing TEXTOBJ, there are fields that need to be copied.") - [OR (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (fetch (TEXTOBJ TXTPAGEFRAMES - ) - of (TEXTOBJ TSTREAM] - (* ; - "Such as the page formatting, which the converter may well set.") - )) - (fetch (TEXTOBJ PCTB) of (TEXTOBJ TSTREAM]) - -(TEDIT.FORMATTEDFILEP - [LAMBDA (STREAM) (* ; "Edited 19-Apr-93 11:57 by jds") - (* ; - "Test to see if this stream's text would need a TEdit-format file (T) or is just plain text (NIL)") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (FONTFILE 0) - OLDPARALOOKS PC OLDLOOKS PREVPC TENTATIVE) - (SETQ OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - (SETQ TENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (* ; "If edits are to be shown") - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) (* ; "First piece in the document") - (COND - ((ATOM PC) (* ; "Empty document") - (RETURN NIL))) - (SETQ OLDLOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) - (while PC do [COND - ((fetch (PIECE POBJ) of PC) (* ; - "OBJECTS require the special format") - (SETQ FONTFILE 4)) - ([AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; "We just hit a paragraph break.") - (SETQ FONTFILE (IMAX FONTFILE 3))) - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (AND TENTATIVE (OR (AND PREVPC (NEQ (fetch (PIECE PNEW) of PREVPC) - (fetch (PIECE PNEW) of PC))) - (AND (NOT PREVPC) - (fetch (PIECE PNEW) of PC)) - (AND PREVPC (NEQ (fetch (PIECE PFATP) of PREVPC) - (fetch (PIECE PFATP) of PC] - (* ; "Change in font, size, etc.") - (SETQ FONTFILE (IMAX FONTFILE 2))) - ((fetch (PIECE PFATP) of PC) (* ; "NS Chars in the piece.") - (SETQ FONTFILE (IMAX FONTFILE 1] - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (RETURN (SELECTQ FONTFILE - (0 NIL) - (1 'NSCHARS) - (2 'CHARLOOKS) - (3 'PARALOOKS) - (4 'IMAGEOBJ) - NIL]) - (TEDIT.GET - [LAMBDA (TEXTOBJ FILE UNFORMATTED?) (* ; "Edited 19-May-2001 11:43 by rmk:") + [LAMBDA (TSTREAM FILE UNFORMATTED? PROPS) (* ; "Edited 21-Jan-2024 23:13 by rmk") + (* ; "Edited 22-Sep-2023 20:16 by rmk") + (* ; "Edited 18-Sep-2023 16:41 by rmk") + (* ; "Edited 9-Sep-2023 17:24 by rmk") + (* ; "Edited 19-May-2001 11:43 by rmk:") (* ; "Edited 19-Apr-93 13:12 by jds") - (* ;; "Get a new file (overwriting the one being edited.)") + (* ;; "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)") - (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) - OFILE OCURSOR LINES USER.CMFILE RESP TITLE FILENAME MENUSTREAM (GETFN (TEXTPROP - TEXTOBJ - 'GETFN)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (TEDIT.GET.FINISHEDFORMS NIL)) - (COND - ([AND (fetch (TEXTOBJ \DIRTY) of TEXTOBJ) - (PROGN (AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) - (FRESHLINE (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (NOT (MOUSECONFIRM "Not saved yet; LEFT go Get anyway." T - (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] + (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] (* ;; "Only do the GET if he knows he'll zorch himself.") - (RETURN))) - [SETQ OFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to GET: " - (OR (TEXTPROP TEXTOBJ 'LASTGETFILENAME) - (\TEXTSTREAM.FILENAME TEXTOBJ] - (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE) - (COND - [(AND OFILE (OR (OPENP OFILE) - (INFILEP OFILE))) (* ; - "Only if there's a file to load and the file exists.") - (COND - ((AND GETFN (EQ (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME OFILE) - 'BEFORE) - 'DON'T)) (* ; + (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] (* ;  "He doesn't want this document put. Bail out.") - (RETURN))) - (TEXTPROP TEXTOBJ 'LASTGETFILENAME NIL) - (RESETLST - (RESETSAVE (TTYDISPLAYSTREAM (OR (AND (NEQ (fetch (TEXTOBJ PROMPTWINDOW) - of TEXTOBJ) - 'DON'T) - (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) - PROMPTWINDOW))) - (RESETSAVE (CURSOR WAITINGCURSOR)) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (\TEXTCLOSEF (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (* ; "CLOSE the old files") - [OR (AND (STREAMP FILE) - (OPENP FILE)) - (SETQ OFILE (OPENSTREAM OFILE 'INPUT NIL '((TYPE TEXT] - (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (* ; "Remove the previous hardcopyfile") - (WINDOWPROP WINDOW 'HARDCOPYFILE NIL)) + (RETURN)) - (* ;; "Open the new one.") + (* ;; "") - (SETQ PCTB (replace (TEXTOBJ PCTB) of TEXTOBJ with (TEDIT.BUILD.PCTB - OFILE TEXTOBJ NIL NIL - (fetch (TEXTOBJ - DEFAULTCHARLOOKS) - of TEXTOBJ) - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ) - UNFORMATTED?))) - (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) + (SETQ FSTREAM (\TEDIT.OPENTEXTFILE FILE)) + (CL:UNLESS (\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) + 'DON'T) + (GETTOBJ TEXTOBJ PROMPTWINDOW)) + PROMPTWINDOW))) + + (* ;; "New file is good, clean out the old stuff") + + (\SHOWSEL (TEXTSEL TEXTOBJ) + NIL) + (\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") + + (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) + (\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]) + +(TEDIT.FORMATTEDFILEP + [LAMBDA (FILE) (* ; "Edited 18-Jan-2024 10:29 by rmk") + (* ; "Edited 13-Jan-2024 11:57 by rmk") + (* ; "Edited 12-Jul-2023 23:35 by rmk") + + (* ;; "If FILE is a Tedit formatted stream or the name of a Tedit formatted file, returns a pair consistening of its version number and piececount. Piececount is probably useless.") + + (RESETLST + (LET ((STREAM (STREAMP FILE))) + [if STREAM + then [RESETSAVE (GETFILEPTR FILE) + `(PROGN (SETFILEPTR ,FILE OLDVALUE] + else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + (\TEDIT.GET.TRAILER STREAM)))]) + +(TEDIT.FILEDATE + [LAMBDA (FILE INTEGER) (* ; "Edited 18-Jan-2024 10:26 by rmk") + (* ; "Edited 13-Jan-2024 10:20 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 6-Dec-2023 20:11 by rmk") + (* ; "Edited 28-Sep-2023 22:47 by rmk") + + (* ;; "If FILE is a Tedit-format file, returns its save date if it is stamped in the file, otherwise its file-system creation date as an integer or string. NIL if not a Tedit file.") + + (* ;; "FILE must be random access. If not, then presumably we first have to fetch the last 5+4+8 bytes to someplace else.") + + (CL:WHEN FILE + (RESETLST + (LET ((STREAM (\GETSTREAM FILE 'INPUT T)) + IDATE) + [if STREAM + then [RESETSAVE (GETFILEPTR STREAM) + `(PROGN (SETFILEPTR ,STREAM OLDVALUE] + else (RESETSAVE (SETQ STREAM (OPENSTREAM FILE 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE] + [SETQ IDATE (CAR (LAST (\TEDIT.GET.TRAILER STREAM] + (CL:UNLESS IDATE + (SETQ IDATE (GETFILEINFO STREAM 'ICREATIONDATE))) + (CL:IF INTEGER + IDATE + (GDATE IDATE)))))]) + +(\TEDIT.GET.IDATE3 + [LAMBDA (STREAM END) (* ; "Edited 6-Dec-2023 16:55 by rmk") + + (* ;; "Returns the integer IDATE for slightly updated version 3 files, otherwise NIL. 4 for the bytes of the IDATE, 8 for the header. Leaves resets to starting position (assumes an error wouldn't matter).") + + (CL:WHEN (IGREATERP END (IPLUS (CONSTANT (NCHARS "DATE:")) + 4 8)) + (LET ((FILEPTR (GETFILEPTR STREAM))) + (SETFILEPTR STREAM (IDIFFERENCE END (IPLUS (CONSTANT (NCHARS "DATE:")) + 4 8))) + + (* ;; + "DATE: is the marker for this extension to version 3 (could be removed if version is update). ") + + (PROG1 (CL:WHEN (AND (EQ (CHARCODE D) + (BIN STREAM)) + (EQ (CHARCODE A) + (BIN STREAM)) + (EQ (CHARCODE T) + (BIN STREAM)) + (EQ (CHARCODE E) + (BIN STREAM)) + (EQ (CHARCODE %:) + (BIN STREAM))) + (\DWIN STREAM)) + (SETFILEPTR STREAM FILEPTR))))]) + +(TEDIT.INCLUDE + [LAMBDA (TSTREAM FILE START END SAFE PLAINTEXT) (* ; "Edited 16-Feb-2024 23:54 by rmk") + (* ; "Edited 13-Jan-2024 09:39 by rmk") + (* ; "Edited 12-Nov-2023 12:29 by rmk") + (* ; "Edited 23-Jul-2023 15:30 by rmk") + (* ; "Edited 16-Jul-2023 10:18 by rmk") + (* ; "Edited 21-Jun-2023 17:46 by rmk") + (* ; "Edited 19-May-2001 11:43 by rmk:") (* ; - "Do any necessary cleanup for outside packages") - (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL) - (for FIRSTLINE inside LINES do (replace (LINEDESCRIPTOR NEXTLINE) of FIRSTLINE - with NIL)) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) + "Edited 1-Jun-93 11:31 by sybalsky:mv:envos") - (* ;; "The old cached piece is no longer valid--keep people from stepping on it, to prevent lost type-in and smashing other docuemnts to which it has been moved...") + (* ;; "Obtain a file name, and include that file's contents at the place where the caret is.") - (* ;; "(replace TEXTLEN of TEXTOBJ with (SUB1 (\EDITELT PCTB (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)))))") + (* ;; "This is a documented entry, but SAFE wasn't described there and I (RMK) added PLAINTEXT to collapse with TEDIT.INCLUDE.RAW.") - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN) of PCTB)) - (replace (SELECTION CH#) of SEL with (replace (SELECTION CHLIM) of SEL with 1)) - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION SET) of SEL with T) - (replace (SELECTION SET) of (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) with NIL) - (replace (SELECTION SET) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) with NIL) - (replace (SELECTION SET) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) with NIL) - (replace (SELECTION SET) of TEDIT.SELECTION with NIL) - (replace (SELECTION SET) of TEDIT.SHIFTEDSELECTION with NIL) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ - SEL)) - (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINE inside LINES - do (* ; - "Fill the edit window (s) with the new text") - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL WINDOW)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T) - (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) - (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) - (COND - ((AND MENUSTREAM (type? 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))) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ)) + (* ;; + "Returns the length of the input, if the insertion happened, NIL if there was no place to put it.") + + (* ;; "") + + (* ;; "This assumes that START and END are file positions (defaulting to 0 and length), not character numbers.") + + (* ;; "") + + (* ;; "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)) + TSEL FSEL WASOPEN FTSTREAM NDCSTREAM (FROMFILE FILE)) + (SETQ TSEL (TEXTSEL TEXTOBJ)) + (CL:UNLESS (GETSEL TSEL SET) + (TEDIT.PROMPTPRINT TEXTOBJ "Please select a destination for the included text" T) + (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: "))) + (CL:UNLESS FROMFILE + (TEDIT.PROMPTPRINT TEXTOBJ "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") + T T) + (RETURN)) + + (* ;; "") + + (* ;; "Now we have the FROMFILE, which may be a stream.") + + (CL:UNLESS START (SETQ START 0)) + (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) + (RETURN)) + + (* ;; "") + + (* ;; "If the caller says SAFE, he's guranteeing that the file will be there at least as long as we need it. Otherwise, we take ownership of the information by copying it to a NODIRCORE. ") + + (CL:UNLESS SAFE + [if (\GETSTREAM FROMFILE 'INPUT T) + then (SETQ WASOPEN T) + else (* ; + "Wasn't open -- need to open it for input...") + (SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT NIL '((TYPE TEXT] + + (* ;; "Create our holding file and copy the file-section into it.") + + (SETQ NDCSTREAM (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW)) + + (* ;; "Have to explicitly fill in 0 and EOFPTR, because if the file was open already, NILs would only copy from current fileptr to EOF.") + + (* ;; + "Use COPYBYTES for formatted files, otherwise allow natural EOL conversion to take place") + + (if (\TEDIT.GET.TRAILER FROMFILE) + then (COPYBYTES FROMFILE NDCSTREAM START END) + else (COPYCHARS FROMFILE NDCSTREAM START END)) + (CL:UNLESS WASOPEN (CLOSEF FROMFILE)) (* ; + "If the file didn't come to us open, close it.") + (CLOSEF NDCSTREAM) + (SETQ START 0) (* ; + "But we now want everything we copied") + (SETQ END (GETFILEINFO NDCSTREAM 'LENGTH)) + (SETQ FROMFILE NDCSTREAM)) + + (* ;; "") + + (* ;; "FROMFILE is now a safe file or stream, possibly already open. If it wasn't open before, we want to make sure it gets closed if/when this event gets undone.") + + (CL:UNLESS (\GETSTREAM FROMFILE 'INPUT T) + (SETQ FROMFILE (OPENSTREAM FROMFILE 'INPUT)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Get))) - (AND GETFN (APPLY* GETFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - 'AFTER] - (OFILE (TEDIT.PROMPTPRINT TEXTOBJ "[File not found.]") - (TEXTPROP TEXTOBJ 'LASTGETFILENAME OFILE)(* ; - "Remember the file name he tried for, so we offer it next time.") - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "[Get aborted.]" T]) + THACTION _ :Closefile + THOLDINFO _ FROMFILE))) + [SETQ FTSTREAM (OPENTEXTSTREAM FROMFILE NIL NIL NIL + `(FONT ,(\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ TSEL) + PARALOOKS + ,(GETTOBJ TEXTOBJ FMTSPEC) + PLAINTEXT + ,PLAINTEXT] -(TEDIT.PARSE.PAGEFRAMES1 - [LAMBDA (PAGELIST PARENT) (* ; "Edited 2-Jan-87 12:21 by jds") - (* Take an external pageframe and - internalize it.) - (PROG (FRAMETYPE PAGEFRAME) - (COND - ((type? PAGEREGION PAGELIST) - (RETURN PAGELIST)) - ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) - [SETQ PAGEFRAME (create PAGEREGION - REGIONFILLMETHOD _ FRAMETYPE - REGIONTYPE _ (pop PAGELIST) - REGIONLOCALINFO _ (pop PAGELIST) - REGIONSPEC _ (for VAL - in (OR (pop PAGELIST) - (LIST 0 0 0 0)) - collect (\TEDIT.SCALE VAL - (CONSTANT (FQUOTIENT 1 35.27778] - (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) - collect (TEDIT.PARSE.PAGEFRAMES1 ALIST - PAGEFRAME))) - (RETURN PAGEFRAME)) - (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC - NIL]) + (* ;; "") + + (* ;; "FTSTREAM is now a text stream for the source.") + + (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.") + + (\TEXTSETFILEPTR (FGETTOBJ TEXTOBJ STREAMHINT) + (SUB1 (FGETSEL TSEL CHLIM))) + (RETURN (FGETSEL FSEL DCH))))]) + +(TEDIT.RAW.INCLUDE + [LAMBDA (TSTREAM INFILE START END SAFE) (* ; "Edited 1-May-2023 08:46 by rmk") + (* ; + "Edited 27-May-93 16:36 by sybalsky:mv:envos") + + (* ;; "Inserts the INFILE characters betwen START and END into TSTREAM, treating INFILE as a plain text file. This is a documented entry, motivated by now-silly speed considerations. But it really amounts to just calling TEDIT.INCLUDE with a (new) PLAINTEXT flag and let the OPENTEXTSTREAM plaintext reader do its thing. I (RMK) added the SAFE argument here, consistent with the (undocumented) SAFE argument of TEDIT.INCLUDE.") + + (TEDIT.INCLUDE TSTREAM INFILE START END SAFE T]) + +(TEDIT.PUT + [LAMBDA (TSTREAM FILE FORCENEW UNFORMATTED? FORMAT) (* ; "Edited 7-Feb-2024 13:31 by rmk") + (* ; "Edited 4-Feb-2024 00:10 by rmk") + (* ; "Edited 22-Dec-2023 10:41 by rmk") + (* ; "Edited 19-Dec-2023 10:18 by rmk") + (* ; "Edited 21-Jun-99 19:02 by rmk:") + (* ; "Edited 19-Apr-93 13:04 by jds") + + (* ;; "If the guy was editing a file, make a new updated version; else, ask for a file name") + + (* ;; "If FILE is specd, it's used; else the user must give us one") + + (* ;; "Returns the destination stream open for input.") + + (CL:UNLESS (\TEDIT.READONLY TSTREAM) + (RESETLST + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) + CHARSTREAM NEWPIECES PUTFN OLDEXTFORMAT NEWEXTFORMAT) + (CL:WHEN (AND (SETQ PUTFN (GETTEXTPROP TEXTOBJ 'PUTFN)) + (EQ (APPLY* PUTFN TSTREAM (FULLNAME FILE) + 'BEFORE) + 'DON'T)) + + (* ;; "PUTFN BEFORE says it can't be saved, even though asked. Let him know") + + (TEDIT.PROMPTPRINT "This document cannot be saved" T T) + (RETURN NIL)) + (CL:UNLESS (OR (IGREATERP (TEXTLEN TEXTOBJ) + 0) + (TEDIT.GETINPUT TEXTOBJ "Document is empty. Save anyway? " "Yes")) + (RETURN NIL)) + (if (AND (STREAMP FILE) + (\GETSTREAM FILE 'OUTPUT T)) + then (SETQ CHARSTREAM FILE) + else (CL:UNLESS UNFORMATTED? + (if (\TEDIT.FORMATTEDSTREAMP TEXTOBJ) + then [SETQ UNFORMATTED? + (AND (GETTEXTPROP TEXTOBJ 'CLEARGET) + (EQ 'N (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ + "Convert plaintext to formatted file? " + "No") + 1] + else (SETQ UNFORMATTED? T))) + (SELECTQ FILE + (NIL (CL:UNLESS FORCENEW (* ; "Forcenew for templates?") + (CL:WHEN [AND (TEXTPROP TEXTOBJ 'TEMPLATE) + (EQ 'N (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ + "Overwrite template? " + "No") + 1] + (SETQ FORCENEW 'DETEMPLATE))) + [SETQ FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "PUT to: " + (CL:UNLESS FORCENEW + (\TEXTSTREAM.FILENAME + TEXTOBJ UNFORMATTED? + ]) + (T (SETQ FILE (\TEXTSTREAM.FILENAME TEXTOBJ UNFORMATTED?))) + NIL) + (CL:UNLESS FILE (* ; "No file to put to.") + (TEDIT.PROMPTPRINT TEXTOBJ "No output file--aborted" T T) + (RETURN))) + + (* ;; "") + + (* ;; "Ready to save. IF the external format changes, we don't want to update the current textstream. Unlesss we figure out what the new proper piecetypes should be (FATFILE2, UTF8...).") + + [SETQ OLDEXTFORMAT (AND (STREAMP (FGETTOBJ TEXTOBJ TXTFILE)) + (STREAMPROP (FGETTOBJ TEXTOBJ TXTFILE) + 'FORMAT] + (SETQ NEWEXTFORMAT (OR FORMAT (GETTEXTPROP TEXTOBJ 'OUTPUT-FORMAT) + OLDEXTFORMAT :DEFAULT)) + [RESETSAVE [SETQ CHARSTREAM (OPENSTREAM FILE 'OUTPUT 'NEW + `([TYPE ,(CL:IF UNFORMATTED? + 'TEXT + 'BINARY)] + (LINELENGTH T) + (FORMAT ,NEWEXTFORMAT] + '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] + [RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS) + 'DON'T] + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting to file " (FULLNAME CHARSTREAM) + "...") + T) + + (* ;; "") + + (* ;; "CHARSTREAM is open, we're ready to go.") + + (* ;; "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)) + + (* ;; "The file is written, nothing can be lost. CHARSTREAM isn't closed yet") + + (* ;; "") + + (* ;; + "TEDIT.PUT.FINISHEDFORMS is not documented. Are we supposed to supply some defined specvars?") + + (for FORM in (GETTEXTPROP TEXTOBJ 'TEDIT.PUT.FINISHEDFORMS) + do (EVAL FORM)) + (CL:WHEN PUTFN + (APPLY* PUTFN TSTREAM (FULLNAME CHARSTREAM) + 'AFTER)) + + (* ;; "") + + (* ;; "") + + (TEDIT.PROMPTPRINT TEXTOBJ "done") + + (* ;; "") + + (CL:WHEN (EQ FORCENEW 'DETEMPLATE) + (TEXTPROP TEXTOBJ 'TEMPLATE NIL)) + (RETURN CHARSTREAM))))]) + +(TEDIT.PUT.STREAM + [LAMBDA (TSTREAM DESTSTREAM UNFORMATTED? EXTERNALFORMAT CONTINUE) + (* ; "Edited 7-Feb-2024 12:41 by rmk") + (* ; "Edited 4-Feb-2024 00:19 by rmk") + (* ; "") + + (* ;; " If UNFORMATTED?, the FORMATSTREAM portion of the Tedit stream is discarded, so only the plaintext character portion appears in DESTSTREAM. ") + + (* ;; "Saves the contents of TSTREAM on DESTSTREAM, starting at DESTSTREAM's current file position. If DESTSTREAM is not a stream open for output, an attempt will be made to open it. Either way, if EXTERNALFORMAT is provided, the stream will be written with that format. Otherwise, the current format of the stream (or the current default format, if a file) will be used. ") + + (* ;; "If not CONTINUE and DESTSTREAM is opened here, it will be closed and its filename will be returned. Otherwise, the DESTSTREAM will be left in its original mode and positioned after the last byte written.") + (* ; "") + (RESETLST + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + NEWPIECES ENDPTR OPENEDHERE) + (CL:UNLESS (\GETSTREAM DESTSTREAM 'OUTPUT T) + [RESETSAVE [SETQ DESTSTREAM (OPENSTREAM DESTSTREAM 'OUTPUT NIL '(LINELENGTH T] + '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] + (SETQ OPENEDHERE T)) + (CL:WHEN EXTERNALFORMAT + (STREAMPROP DESTSTREAM 'FORMAT EXTERNALFORMAT)) + (SETQ NEWPIECES (\TEDIT.PUT.PCTB TEXTOBJ DESTSTREAM UNFORMATTED? CONTINUE)) + (if CONTINUE + then (SETQ ENDPTR (GETFILEPTR DESTSTREAM)) + (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") + (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)) + elseif OPENEDHERE + then (OR (CLOSEF? DESTSTREAM) + (FULLNMAE DESTSTREAM)) + else DESTSTREAM)))]) +) + + + +(* ;; "Getting (pageframe functions on TEDIT-PAGE)") + +(DEFINEQ + +(\TEDIT.GET.FOREIGN.FILE + [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 22-Oct-2023 20:40 by rmk") + (* ; "Edited 18-Sep-2023 16:40 by rmk") + (* ; "Edited 10-Aug-2023 17:26 by rmk") + (* ; "Edited 6-Sep-2022 12:18 by rmk") + (* ; "Edited 26-Aug-2022 08:43 by rmk") + (* ; "Edited 25-Jul-2022 21:21 by rmk") + + (* ;; "If TEXT is recognized as a file in a user format, convert it into a new text stream. It could be that the foreign file is coming from a TEDIT.GET on an existing stream. There may be a window attached to TSTREAM, and that's where the edit will eventually take place. Its dimensions are available, e.g. for width and height, but it may not yet have been initialized for TEDIT (because the source text is being installed here). ") + + (* ;; "") + + (* ;; "The foreign function returns a textstream FSTREAM. If FSTREAM=TSTREAM then we assume that the foreign function filled in everything completely. If it is a different stream, then we assume that its pieces are safe and its looks are good, we copy that information back into TSTREAM.") + + (* ;; "") + + (* ;; "Either way, the foreign function guarantees that file pieces, if any, are safe wrt buffer boundaries.") + + (LET (USERFILEFORMAT USERTEMP FSTREAM FTEXTOBJ (TTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + ) + + (* ;; "Do the predicate and the converter agree that they can handle this?") + + (CL:WHEN (AND (SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS + when (SETQ USERTEMP (APPLY* (CAR FILETYPE) + TEXT TSTREAM PROPS)) + do (RETURN FILETYPE))) + (SETQ FSTREAM (APPLY* (CADR USERFILEFORMAT) + TEXT TSTREAM PROPS USERTEMP START END)) + (TEXTSTREAMP FSTREAM)) (* ; "Return NIL if we couldn't convert") + (CL:UNLESS (EQ TSTREAM FSTREAM) + (SETQ FTEXTOBJ (TEXTOBJ FSTREAM)) + (\INSERTPIECES (\FIRSTPIECE FTEXTOBJ) + NIL TTEXTOBJ) + (FSETTOBJ TTEXTOBJ LASTPIECE (FGETTOBJ FTEXTOBJ LASTPIECE)) + (* ; "Last piece have different looks") + (FSETTOBJ TTEXTOBJ TXTPAGEFRAMES (FGETTOBJ FTEXTOBJ TXTPAGEFRAMES)) + (FSETTOBJ TTEXTOBJ FMTSPEC (FGETTOBJ FTEXTOBJ FMTSPEC)) + (FSETTOBJ TTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ FTEXTOBJ DEFAULTCHARLOOKS))) + TSTREAM)]) + +(\TEDIT.GET.UNFORMATTED.FILE + [LAMBDA (STREAM TSTREAM START END PROPS) (* ; "Edited 5-Feb-2024 09:26 by rmk") + (* ; "Edited 21-Jan-2024 09:42 by rmk") + (* ; "Edited 29-Dec-2023 11:52 by rmk") + (* ; "Edited 27-Dec-2023 13:33 by rmk") + (* ; "Edited 22-Oct-2023 22:59 by rmk") + (* ; "Edited 12-Sep-2023 16:45 by rmk") + (* ; "Edited 3-Aug-2023 22:04 by rmk") + (* ; "Edited 3-May-2023 17:38 by rmk") + (* ; "Edited 26-Apr-2023 14:09 by rmk") + (RESETLST + [RESETSAVE NIL `(STREAMPROP ,STREAM ENDOFSTREAMOP ,(STREAMPROP STREAM 'ENDOFSTREAMOP + (FUNCTION NILL] + (\SETFILEPTR STREAM START) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (FORMAT (STREAMPROP STREAM 'FORMAT)) + DEFAULTCHARLOOKS DEFAULTPARALOOKS PIECES) + (PUTTEXTPROP TEXTOBJ 'CLEARGET T) + (SETQ DEFAULTCHARLOOKS (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (SETQ DEFAULTPARALOOKS (GETTOBJ TEXTOBJ FMTSPEC)) + (CL:WHEN (AND (EQ FORMAT :STRING) + (\IOMODEP STREAM 'OUTPUT T)) + (SETQ STREAM (COPYFILE STREAM '{NODIRCORE}))) + [SETQ PIECES + (SELECTQ FORMAT + (:XCCS (\TEDIT.GET.UNFORMATTED.FILE.XCCS STREAM START END DEFAULTCHARLOOKS + DEFAULTPARALOOKS)) + (:UTF-8 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 STREAM START END DEFAULTCHARLOOKS + DEFAULTPARALOOKS)) + (:STRING (CL:WHEN (\IOMODEP STREAM 'OUTPUT T) + + (* ;; + "Protect against somebody smashing the string. (Should also protect other files, but...)") + + (SETQ STREAM (COPYFILE STREAM '{NODIRCORE}))) + + (* ;; "String format is known to be fat. Eventually it should be sufficient to know the byesperchar of the piece to figure out the PFILEPOS byte pointers, and just use the generic \OUTCHAR to get the characters.") + + (create PIECE + PCONTENTS _ STREAM + PFPOS _ START + PLEN _ (FOLDLO (IDIFFERENCE END START) + 2) + PLOOKS _ DEFAULTCHARLOOKS + PPARALAST _ NIL + PPARALOOKS _ DEFAULTPARALOOKS + PTYPE _ FATFILE2.PTYPE + PBYTESPERCHAR _ 2)) + (create PIECE + PCONTENTS _ STREAM + PFPOS _ START + PLEN _ (IDIFFERENCE END START) + PLOOKS _ DEFAULTCHARLOOKS + PPARALAST _ NIL + PPARALOOKS _ DEFAULTPARALOOKS + PTYPE _ THINFILE.PTYPE + PBYTESPERCHAR _ 1 + PBINABLE _ (fetch (STREAM BINABLE) of STREAM] + (\INSERTPIECES PIECES NIL TEXTOBJ)))]) + +(\TEDIT.GET.FORMATTED.FILE + [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 5-Feb-2024 09:25 by rmk") + (* ; "Edited 21-Jan-2024 10:25 by rmk") + (* ; "Edited 18-Jan-2024 10:25 by rmk") + (* ; "Edited 27-Oct-2023 13:48 by rmk") + (* ; "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") + + (* ;; + "If TSTREAM is a formatted file, it is included in TEXTOBJ and TEXTOBJ is returned, otherwise NIL") + + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (TRAILER (\TEDIT.GET.TRAILER TEXT END)) + PCCOUNT IDATE PC) + (CL:WHEN TRAILER + (SETTOBJ TEXTOBJ TXTPAGEFRAMES NIL) + (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)) + (\INSERTPIECES (\TEDIT.GET.PIECES3 TEXT TEXTOBJ PCCOUNT START END) + NIL TEXTOBJ)) + (2 (* ; "Version 2; obsoleted 5/22/85") + (\TEDIT.GET.PCTB2 TEXT TEXTOBJ PCCOUNT START END)) + (1 (* ; + "Version 1; obsoleted at INTERMEZZO release 2/85") + (\TEDIT.GET.PCTB1 TEXT TEXTOBJ PCCOUNT START END)) + (0 (* ; "VERSION 0") + (TEDIT.GET.PCTB0 TEXT TEXTOBJ (CADR PCCOUNT) + PCCOUNT START END)) + (SHOULDNT "File format version incompatible with this version of TEdit.")) + (CL:WHEN (SETQ PC (PREVPIECE (\LASTPIECE TEXTOBJ))) + (FSETPC PC PPARALAST T)) + (\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ NIL) + TEXTOBJ)]) + +(\TEDIT.FORMATTEDSTREAMP + [LAMBDA (TSTREAM) (* ; "Edited 22-Sep-2023 20:17 by rmk") + (* ; "Edited 15-Sep-2023 00:09 by rmk") + (* ; "Edited 15-Aug-2023 17:35 by rmk") + (* ; "Edited 16-Sep-2022 21:00 by rmk") + (* ; "Edited 1-Sep-2022 08:54 by rmk") + (* ; "Edited 19-Apr-93 11:57 by jds") + + (* ;; + "Test to see if this stream's text would need a TEdit-format file (T) or is just plain text (NIL)") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (for PC (FORMATLEVEL _ 0) + (DEFAULTCLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (DEFAULTPLOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) + (TENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) inpieces (\FIRSTPIECE TEXTOBJ) + do [COND + ((EQ OBJECT.PTYPE (PTYPE PC)) (* ; + "OBJECTS require the special format") + (SETQ FORMATLEVEL 4) + (GO $$OUT)) + ([OR (AND (PPARALAST PC) + (NEXTPIECE PC)) + (NOT (EQFMTSPEC DEFAULTPLOOKS (PPARALOOKS PC] + (* ; + "A paragraph break not at the end, or a new plook") + (SETQ FORMATLEVEL (IMAX FORMATLEVEL 3))) + ((OR (NOT (EQCLOOKS DEFAULTCLOOKS (PLOOKS PC))) + (AND TENTATIVE (PNEW PC))) (* ; "Change in font, size, etc.") + (SETQ FORMATLEVEL (IMAX FORMATLEVEL 2))) + ((MEMB (PTYPE PC) + (CONSTANT (LIST FATFILE2.PTYPE FATSTRING.PTYPE))) + (* ; "16-bit chars in the piece") + (SETQ FORMATLEVEL (IMAX FORMATLEVEL 1] + finally + + (* ;; + "1 originally meant NSCHARS. But that's not a %"look%", just an external format issue.") + + (RETURN (SELECTQ FORMATLEVEL + (0 NIL) + (2 'CHARLOOKS) + (3 'PARALOOKS) + (4 'IMAGEOBJ) + NIL]) (\ARBIN - [LAMBDA (STREAM) (* jds "13-Nov-86 20:21") + [LAMBDA (STREAM) (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* jds "13-Nov-86 20:21") (* ;  "Read an arbitrary object from a file, parse it, and return it.") - (PROG ((LEN (\SMALLPIN STREAM)) + (PROG ((LEN (\WIN STREAM)) USERSTR) (COND ((NOT (ZEROP LEN)) @@ -458,275 +773,81 @@ (CLOSEF? USERSTR]) (\ATMIN - [LAMBDA (STREAM) (* jds " 3-Apr-84 10:41") - (PROG ((LEN (\SMALLPIN STREAM))) + [LAMBDA (STREAM) (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* jds " 3-Apr-84 10:41") + (PROG ((LEN (\WIN STREAM))) (RETURN (COND ((ZEROP LEN) NIL) - (T (PACK (for I from 1 to LEN collect (CHARACTER (\BIN STREAM]) + (T (PACK (for I from 1 to LEN collect (CHARACTER (BIN STREAM]) (\DWIN - [LAMBDA (FILE) (* jds " 3-JAN-83 16:08") - (IPLUS (LLSH (\BIN FILE) + [LAMBDA (FILE) (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* jds " 3-JAN-83 16:08") + (IPLUS (LLSH (BIN FILE) 24) - (LLSH (\BIN FILE) + (LLSH (BIN FILE) 16) - (LLSH (\BIN FILE) + (LLSH (BIN FILE) 8) - (\BIN FILE]) + (BIN FILE]) (\STRINGIN - [LAMBDA (STREAM SETLEN) (* ; "Edited 20-Apr-88 19:54 by jds") + [LAMBDA (STREAM SETLEN) (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 20-Apr-88 19:54 by jds") (* Read a string in length-contents form%: One word for the length, and one byte  per character contained. However, the length may be specified by the caller  instead of being read from the file.) - (PROG ((LEN (OR SETLEN (\SMALLPIN STREAM))) + (PROG ((LEN (OR SETLEN (\WIN STREAM))) STR) (SETQ STR (ALLOCSTRING LEN)) [OR (ZEROP LEN) (for I from 1 to LEN do (RPLCHARCODE STR I (READCCODE STREAM] (RETURN STR]) -(\TEDIT.FORMATTEDP1 - [LAMBDA (FILE LEN) (* ; "Edited 12-Feb-88 11:43 by jds") - (* ; - "Checks for a version-1 formatted file") +(\TEDIT.GET.TRAILER + [LAMBDA (STREAM LEN) (* ; "Edited 18-Jan-2024 10:22 by rmk") + (* ; "Edited 16-Jan-2024 22:39 by rmk") + (* ; "Edited 15-Jan-2024 17:38 by rmk") + (* ; "Edited 13-Jan-2024 21:49 by rmk") - (* ;; "Returns NIL if it isn't a formatted file, or the # of pieces needed if it is; leaves file at start of text or of piece descriptions, resp.") + (* ;; "For an open formatted stream, returns a list (VERSION PCCOUNT DESCPTR IDATE) where DESCPTR is the byte position of the first piece. Returns NIL if it is not a formatted stream. Either way, the file is left at position 0 FWIW ") - (SETQ LEN (OR LEN (GETEOFPTR FILE))) - (PROG (DESCPTR NPIECES PASSWORD) - (COND - ((ILEQ LEN 8) (* ; "Too short to be formatted.") - (RETURN NIL)) - (T (SETFILEPTR FILE (IDIFFERENCE LEN 8)) (* ; + (* ;; "If STREAM is the format-stream split of a complete Tedit file, then PIECESTART is the position in that larger file that this section was taken from, and 0 in STREAM corresponds to PIECESTART in that file. TRAILERSIZE") + + (SETQ LEN (OR LEN (GETEOFPTR STREAM))) + (CL:WHEN (IGREATERP LEN 8) + (LET (PIECESTART TRAILERSIZE PCCOUNT VERSION IDATE) + (SETFILEPTR STREAM (IDIFFERENCE LEN 8)) (* ;  "Move to start of FILEPTR to descriptions") - (SETQ DESCPTR (\DWIN FILE)) (* ; + (SETQ PIECESTART (\DWIN STREAM)) (* ;  "Read the file pos of the descriptions") - (SETQ NPIECES (\SMALLPIN FILE)) - (SETQ PASSWORD (\SMALLPIN FILE)) - (COND - ((IEQP PASSWORD 31418) (* ; - "Version 3 TEdit format; instituted on 5/22/85") - (SETFILEPTR FILE DESCPTR) - (RETURN NPIECES)) - ((IEQP PASSWORD 31417) - - (* ;; "Version 2 format. Obsoleted 5/22/85 to permit revision of looks in the future without loss of compatibility") - - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 2 NPIECES))) - ((IEQP PASSWORD 31416) (* ; "VERSION 1 TEDIT FORMAT") - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 1 NPIECES))) - ((IEQP PASSWORD 31415) (* ; "VERSION 0 TEDIT FORMAT") - (SETFILEPTR FILE DESCPTR) - (RETURN (CONS 0 NPIECES))) - (T (* ; "NOT A FORMATTED FILE") - (SETFILEPTR FILE 0) - (RETURN NIL]) - -(\TEDIT.SET.WINDOW - [LAMBDA (TOWIND) (* ; "Edited 12-Jun-90 18:16 by mitani") - (* USED IN RESETSAVES TO NULL OUT A - TEXTSTREAM'S WINDOW BRIEFLY.) - (PROG1 (CONS (CAR TOWIND) - (fetch (TEXTOBJ \WINDOW) of (CAR TOWIND))) - (replace (TEXTOBJ \WINDOW) of (CAR TOWIND) with (CDR TOWIND)))]) - -(TEDIT.GET.PASSWORD - [LAMBDA (FILE LEN) (* ; "Edited 20-Jun-2022 12:04 by rmk") - - (* ;; "Returns the TEDIT password of FILE, if it is a TEDIT formatted file") - - (LET (DESCPTR NPIECES PASSWORD) - (CL:WITH-OPEN-FILE (STREAM FILE :DIRECTION :INPUT) - (CL:UNLESS LEN - (SETQ LEN (GETEOFPTR STREAM))) - (CL:WHEN (IGREATERP LEN 8) - (SETFILEPTR STREAM (IDIFFERENCE LEN 8)) (* ; - "Move to start of FILEPTR to descriptions") - (SETQ DESCPTR (\DWIN STREAM)) (* ; - "Read the file pos of the descriptions") - (SETQ NPIECES (\SMALLPIN STREAM)) - [CAR (MEMB (\SMALLPIN STREAM) - '(31415 31416 31417 31418 31419])]) -) -(DEFINEQ - -(\TEDIT.READ.FORMATTED.FILE - [LAMBDA (TEXT TEXTOBJ CURFILECH# END PCCOUNT DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 20-Jul-2022 11:10 by rmk") - (* ; "Edited 19-Jul-2022 10:30 by rmk") - (* ; - "This IS a TEdit-format file, so read in all the parts.") - (LET (PARAHASH LOOKSHASH (PCTB (\MAKEPCTB NIL PCCOUNT))) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETFILEPTR TEXT (\DWIN TEXT)) (* ; "Pieceinfo char #") - (bind PC TYPECODE PCLEN (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from 1 - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - [SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (CL:WHEN TEXTOBJ - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (TEDIT.GET.PAGEFRAMES - TEXT))) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add PCN -1)) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document.") - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.CHARLOOKS.LIST - TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for J from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) - do (SETA LOOKSHASH J LOOKS)) - (add PCN -1) - (add I -1)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.PARALOOKS.LIST - TEXT TEXTOBJ)) - (* ; - "Read the list of looks used in this document.") - [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for J from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - do (SETA PARAHASH J LOOKS)) - (add PCN -1) - (add I -1)) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (CL:WHEN OLDPC - (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) - (* ; - "Get the new set of looks, for use by later pieces.") - (CL:WHEN TEXTOBJ - (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) - (* ; - "Mark the document as containing paragraph formatting info") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add PCN -1)) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") - (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) - (* ; - "Read the character looks for this guy.") - (CL:WHEN OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC)) - (* ; - "And note the passing of characters.") - (add CURFILECH# PCLEN)) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (CL:WHEN OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC)) - (TEDIT.GET.OBJECT (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS TEXT))) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS) - of OLDPC)) - DEFAULTLOOKS] - (* ; - "OBJECTs are officially one character long.") - (replace (PIECE PLEN) of PC with 1)) - (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) - (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) - (\SMALLPIN TEXT] - (CL:WHEN PC (* ; - "If we created a piece, save it in the table.") - (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (SETQ OLDPC PC))) - PCTB]) - -(\TEDIT.READ.UNFORMATTED.FILE - [LAMBDA (TEXT TEXTOBJ START END DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 19-Jul-2022 10:33 by rmk") - (* ; "Edited 13-Jul-2022 23:49 by rmk") - (LET (USERFILEFORMAT USERTEMP PCTB) - [COND - [(SETQ USERFILEFORMAT (for FILETYPE in TEDIT.INPUT.FORMATS - when (SETQ USERTEMP (APPLY* (CAR FILETYPE) - TEXT)) do (RETURN FILETYPE))) - (* ; - "The input file is in a user-sensible format, which he is willing to convert for TEdit's use.") - (* ; "See if there are Bravo headers") - (SETQ PCTB (\TEDIT.CONVERT.FOREIGN.FORMAT (CADR USERFILEFORMAT) - TEXT USERTEMP TEXTOBJ DEFAULTLOOKS DEFAULTPARALOOKS)) - (* ; - "Convert the foreign format file, and grab its PCTB") - (bind (PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while PC until (EQ PC 'LASTPIECE) - do (* ; - "Run thru the converted pieces, noting their CHARLOOKS and PARALOOKS for the get/put caches.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (PIECE PLOOKS - ) - of PC) - TEXTOBJ)) - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS - (fetch (PIECE PPARALOOKS) of PC) - TEXTOBJ)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC] - (T - (* ;; "Nope--it's straight unformatted text. Create a single piece to describe its contents ; Insert LASTPIECE here") - - (SETQ PCTB (\MAKEPCTB (create PIECE - PFILE _ TEXT - PFPOS _ START - PLEN _ (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - START) - PREVPIECE _ NIL - PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ) - PPARALAST _ NIL - PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS DEFAULTPARALOOKS - TEXTOBJ) - PEXTERNALFORMAT _ (GETSTREAMPROP TEXT :EXTERNAL-FORMAT] - PCTB]) + (SETQ PCCOUNT (\WIN STREAM)) + (SETQ VERSION (IDIFFERENCE (\SMALLPIN STREAM) + 31415)) + (PROG1 (SELECTQ VERSION + (3 (* ; "Current version") + (SETQ IDATE (\TEDIT.GET.IDATE3 STREAM LEN)) + (SETQ TRAILERSIZE (IPLUS 8 (CL:IF IDATE + (IPLUS (CONSTANT (NCHARS "DATE:")) + 4) + 0))) + (LIST PIECESTART TRAILERSIZE VERSION PCCOUNT IDATE)) + ((2 1 0) + (LIST PIECESTART 8 VERSION PCCOUNT)) + NIL) + (SETFILEPTR STREAM 0))))]) (\TEDIT.CACHEFILE - [LAMBDA (TEXT TEXTOBJ START END) (* ; "Edited 14-Jul-2022 08:44 by rmk") + [LAMBDA (TEXT TEXTOBJ START END) (* ; "Edited 22-Sep-2023 20:15 by rmk") + (* ; "Edited 31-Aug-2023 15:35 by rmk") + (* ; "Edited 14-Jul-2022 08:44 by rmk") + + (* ;; "If TEXT is not a random-access file, we copy it into local storage (NODIRCORE)") + (LET (CACHE) (* ;; "Sets the external format and its EOL.") @@ -749,971 +870,508 @@ (* ;;  "REMEMBER THAT THIS TEXT WAS CACHED, SO THAT LATER PUTS DON'T INVALIDATE THE CACHE.") - (TEXTPROP TEXTOBJ 'CACHE T)) + (PUTTEXTPROP TEXTOBJ 'CACHE T)) CACHE]) - -(\TEDIT.UNIQUIFY.ALL - [LAMBDA (TEXTOBJ DEFAULTLOOKS) (* ; "Edited 13-Jul-2022 22:56 by rmk") - (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEXTOBJ)) (* ; - "And make sure that the default and caret looks are reflected in that list.") - (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - (AND DEFAULTLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS DEFAULTLOOKS TEXTOBJ)) - (* ; - "And the default looks we used in this function...") - (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ) - TEXTOBJ]) ) -(* ;; "INCLUDEing a file") +(* ;; +"Until CL:COMPILE-FILE and any others are updated, They should use the public TEDIT.FORMATTEDFILEP") + +(MOVD? '\TEDIT.GET.TRAILER '\TEDIT.FORMATTEDP1) (DEFINEQ -(TEDIT.INCLUDE - [LAMBDA (STREAM FILE START END SAFE) (* ; "Edited 19-May-2001 11:43 by rmk:") +(\TEDIT.GET.PIECES3 + [LAMBDA (TEXT TEXTOBJ PCCOUNT CURFILEBYTE# END) (* ; "Edited 14-Jan-2024 00:22 by rmk") + (* ; "Edited 11-Jan-2024 12:37 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 8-Dec-2023 22:49 by rmk") + (* ; "Edited 7-Nov-2023 13:10 by rmk") + (* ; "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.") + + (\DTEST 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)) + (* ; "Throw away at the end") + (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)) + [SELECTC (\WIN TEXT) + (\PieceDescriptorLOOKS (* ; + "New character looks. Build a piece to describe those characters.") + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILEBYTE# + PLEN _ BYTELEN + PBYTELEN _ BYTELEN + PPARALOOKS _ OLDPARALOOKS + PTYPE _ THINFILE.PTYPE + PCHARSET _ 0 + PBYTESPERCHAR _ 1 + PREVPIECE _ PREVPC)) + (\TEDIT.GET.CHARLOOKS.INDEX PC TEXT) (* ; + "Get its looks and character-pointers") + (add CURFILEBYTE# BYTELEN)) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (CL:WHEN PREVPC (FSETPC PREVPC PPARALAST T)) (* ; - "Edited 1-Jun-93 11:31 by sybalsky:mv:envos") + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS.INDEX TEXT)) + (* ; + "Get the new set of looks, for use by later pieces.") + (* ; + "Mark the document as containing paragraph formatting ") + (SETTOBJ TEXTOBJ FORMATTEDP T)) + (\PieceDescriptorOBJECT + (* ;; + "BYTELEN is the number of bytes on the file, PLEN is always 1 character") - (* ;; "Obtain a file name, and include that file's contents at the place where the caret is.") + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILEBYTE# + PBYTELEN _ BYTELEN + PLEN _ 1 + PPARALOOKS _ OLDPARALOOKS + PTYPE _ OBJECT.PTYPE + PREVPIECE _ PREVPC)) + (TEDIT.GET.OBJECT (GETTOBJ TEXTOBJ STREAMHINT) + PC TEXT CURFILEBYTE#) + (add CURFILEBYTE# BYTELEN) + (FSETPC PC PLOOKS (if (ZEROP (BIN TEXT)) + then + (* ;; "No new looks; steal them from the prior piece. RMK: Goofy part of this format--we now always put out 0.") - (* ;; "Returns T if the insertion happened, NIL if there was no place to put it.") + (OR (AND PREVPC (PLOOKS PREVPC)) + DEFAULTCHARLOOKS) + else + (* ;; + "There are new character looks for this object. Read them in.") - (SETQ STREAM (TEXTOBJ STREAM)) - (PROG ((SEL (fetch (TEXTOBJ SEL) of STREAM)) - PCTB TEXTLEN NFILE NNFILE INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN PCCOUNT NSTREAM - START-OF-PIECE) - (DECLARE (SPECVARS START-OF-PIECE)) - (COND - ((fetch (TEXTOBJ TXTREADONLY) of STREAM) (* ; "This is read-only.") - ) - ((fetch (SELECTION SET) of SEL) (* ; - "There is a place to do the include.") - [SETQ NFILE (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT STREAM - "Name of the file to load: "] - (COND - ((NOT NFILE) (* ; - "If no file was given, don't bother INCLUDEing.") - (TEDIT.PROMPTPRINT STREAM "[Include aborted.]" T) + (\TEDIT.GET.SINGLE.CHARLOOKS TEXT)))) + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES (READ TEXT)))) + (\PieceDescriptorCHARLOOKSLIST (* ; + "Read the list of CHARLOOKSs used in this document.") + (add PCNO -1) (* ; + "Lists don't count, in this format.") + (FSETTOBJ TEXTOBJ TXTCHARLOOKSLIST (\TEDIT.GET.CHARLOOKS.LIST TEXT)) + [SETQ CHARLOOKSMAP (ARRAY (LENGTH (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST] + (* ; + "Build an array of the looks, so the reader can index them.") + (for J from 1 as CHARLOOKS in (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + do (SETA CHARLOOKSMAP J CHARLOOKS))) + (\PieceDescriptorPARALOOKSLIST (* ; + "Read the list of PARALOOKSs used in this document.") + (add PCNO -1) (* ; "Lists don't count in this format") + (FSETTOBJ TEXTOBJ TXTPARALOOKSLIST (\TEDIT.GET.PARALOOKS.LIST TEXT TEXTOBJ)) + [SETQ PARALOOKSMAP (ARRAY (LENGTH (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST] + (* ; + "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))) + (PROGN (TEDIT.PROMPTPRINT TEXTOBJ "WARNING: Unknown-type piece skipped." T) + (SETFILEPTR TEXT (IPLUS (GETFILEPTR TEXT) + (\WIN TEXT] + (CL:WHEN PC (* ; + "Chain them together without putting them in the tree") + (FSETPC PREVPC NEXTPIECE PC) + (SETQ PREVPC PC)) finally (SETQ PC (NEXTPIECE FIRSTPC)) + (* ; "Throw out the dummy FIRSTPC") + (FSETPC PC PREVPIECE NIL) + + (* ;; "We defer filling in the actual looks to avoid requiring the mapping arrays to come before the content pieces. This makes it easier to prepend additional pieces without parsing the whole sequence, as Lafite wants to do.") + + [for P inpieces PC + do (CL:WHEN (SMALLP (PLOOKS P)) + (change (PLOOKS P) + (ELT CHARLOOKSMAP DATUM))) + (CL:WHEN (SMALLP (PPARALOOKS P)) + (change (PPARALOOKS P) + (CL:UNLESS (EQ DATUM 0) + (* ; " For the last piece?") + (ELT PARALOOKSMAP DATUM))))] + (CL:WHEN (EQ :XCCS (STREAMPROP TEXT 'FORMAT)) + (\TEDIT.INTERPRET.XCCS.SHIFTS PC TEXT)) + (RETURN PC]) + +(\TEDIT.MAKE.STRINGPIECE + [LAMBDA (PC STRING) (* ; "Edited 23-Jan-2024 14:32 by rmk") + (* ; "Edited 16-Jan-2024 11:15 by rmk") + (* ; "Edited 12-Jan-2024 16:34 by rmk") + + (* ;; "Makes a string piece modeled on PC containing STRING, and links it in the piece-chain after PC. STRING can be a single charcode.") + + (SETQ STRING (CL:IF (CHARCODEP STRING) + (ALLOCSTRING 1 STRING) + (CONCAT STRING))) + (LET (SPIECE) + (SETQ SPIECE (if (fetch (STRINGP FATSTRINGP) of STRING) + then (create PIECE using PC PTYPE _ FATSTRING.PTYPE PCONTENTS _ STRING PLEN + _ (NCHARS STRING) + PBYTESPERCHAR _ 2 PBINABLE _ NIL PBYTELEN _ + (UNFOLD (NCHARS STRING) + 2) + PREVPIECE _ PC PUTF8BYTESPERCHAR _ 2 PFPOS _ 0) + else (create PIECE using PC PTYPE _ THINSTRING.PTYPE PCONTENTS _ STRING PLEN + _ (NCHARS STRING) + PBYTESPERCHAR _ 1 PBINABLE _ T PBYTELEN _ + (NCHARS STRING) + PREVPIECE _ PC PUTF8BYTESPERCHAR _ 1 PFPOS _ 0))) + (CL:WHEN (NEXTPIECE PC) + (FSETPC (NEXTPIECE PC) + PREVPIECE SPIECE)) + (FSETPC PC NEXTPIECE SPIECE) + SPIECE]) +) +(DEFINEQ + +(\TEDIT.GET.UNFORMATTED.FILE.XCCS + [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 21-Jan-2024 09:40 by rmk") + (* ; "Edited 12-Jan-2024 13:13 by rmk") + (* ; "Edited 10-Jan-2024 11:19 by rmk") + (* ; "Edited 8-Jan-2024 13:15 by rmk") + + (* ;; "We build a chain of pieces for the NS stringlets, some of which are divided at CR/LF. ") + + (* ;; "We assume that caller has positioned the stream at the intended start byte and has set the ENDOFSTREAMOP to return NIL on EOF. ") + + (* ;; "CRBEFORE and the LF test are used to ensure that potential EOL's are normalized to EOL and appear at the end of their pieces, whether or not they we decide to make them PPARALAST on input. LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.") + + (bind (NEXTFILEPOS _ START) + (CHARSET _ 0) + (FIRSTPC _ (create PIECE + PLOOKS _ DEFAULTCHARLOOKS + PPARALOOKS _ DEFAULTPARALOOKS)) + (CODESIZE _ 1) + (SBINABLE _ (fetch (STREAM BINABLE) of STRM)) + EOLC PC BYTE CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE SHIFTNEXT first (SETQ PREVPC FIRSTPC + ) + (* ; "FIRSTPC is a throwaway") + do (SETQ FILEPOS NEXTFILEPOS) (* ; "Start of next file piece") + + (* ;; "In thin or fat mode, we have to look at the first byte of the next character, to see if it is a shift. If not a shift, we have to decode the byte configuration to make sure we can detect CR or LF.") + + (do (CL:WHEN (IGEQ NEXTFILEPOS END) + (RETURN)) + (SETQ BYTE (\PEEKBIN STRM T)) + (CL:WHEN (SETQ SHIFTNEXT (EQ NSCHARSETSHIFT BYTE)) + (SETQ CHAR NIL) (* ; + "Suppress CR/LF checking on real shift") (RETURN)) - ((STREAMP NFILE)) - ((NOT (INFILEP NFILE)) (* ; - "Can't find the file. Put out a message.") - (TEDIT.PROMPTPRINT STREAM "[File not found.]") - (RETURN))) - (COND - ((NOT SAFE) + (BIN STRM) (* ; "Not a shift, read the peeked byte") + (SETQ CHAR (if (EQ CODESIZE 2) + then (* ; + "Return T if this takes us over the end") + (LOGOR (LLSH BYTE 8) + (CL:IF (AND (ILEQ NEXTFILEPOS END) + (SETQ BYTE (BIN STRM))) + BYTE + (RETURN))) + else (LOGOR (LLSH CHARSET 8) + BYTE))) + (add NEXTFILEPOS CODESIZE) + (CL:WHEN (MEMB CHAR (CHARCODE (CR LF))) + (RETURN))) - (* ;; "If the caller sets SAFE, we don't need to do any of this copying, because he's guaranteeing that the files'll be there until we don't need 'em any more.") + (* ;; "NEXTFILEPOS and file are positioned at beginning of the next piece, possibly after CR and LF have been read.") - [SETQ NFILE (COND - ((OPENP NFILE) - (SETQ WASOPEN T) - NFILE) - (T (* ; - "Wasn't open -- need to open it for input...") - (OPENSTREAM NFILE 'INPUT NIL '((TYPE TEXT] + (SETQ RUNLEN (IDIFFERENCE NEXTFILEPOS FILEPOS)) + (CL:WHEN (EQ CHAR (CHARCODE LF)) (* ; "We never produce raw LF's") + (add RUNLEN (IMINUS CODESIZE))) + (CL:WHEN (IGREATERP RUNLEN 0) + (SETQ PTYPE (if (EQ CODESIZE 2) + then FATFILE2.PTYPE + elseif (EQ CHARSET 0) + then THINFILE.PTYPE + else FATFILE1.PTYPE)) + (SETQ PC + (create PIECE + PTYPE _ PTYPE + PCONTENTS _ STRM + PFPOS _ FILEPOS + PLEN _ (IQUOTIENT RUNLEN CODESIZE) + PLOOKS _ DEFAULTCHARLOOKS + PPARALOOKS _ DEFAULTPARALOOKS + PCHARSET _ CHARSET + PBYTESPERCHAR _ CODESIZE + PBYTELEN _ RUNLEN + PREVPIECE _ PREVPC + PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE) + SBINABLE))) + (SETQ PREVPC (FSETPC PREVPC NEXTPIECE PC))) + (CL:WHEN (EQ CHAR (CHARCODE LF)) + [if CRBEFORE + then (SETQ EOLC CRLF.EOLC) + else + (* ;; "Linefeed not preceded by CR, replace by string piece") - (* ;; "Create the holding file") + (SETQ EOLC LF.EOLC) + (SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE PREVPC (CHARCODE EOL]) + (CL:WHEN SHIFTNEXT (* ; + "Interpret and bump NEXTFILEPOS for the shifting bytes. ") + (BIN STRM) (* ; "Read the original peeked byte") + (SETQ CHARSET (BIN STRM)) + (if (EQ CHARSET \NORUNCODE) + then (CL:UNLESS (MEMB (BIN STRM) + '(0 NIL)) + (ERROR "EXPECTED PLANE 0 XCCS CHARACTER IS ILL-FORMED")) + (SETQ CHARSET 0) + (SETQ CODESIZE 2) + else (SETQ CODESIZE 1)) + (add NEXTFILEPOS (ADD1 CODESIZE)) + (SETQ SHIFTNEXT NIL)) + (CL:WHEN (IGEQ NEXTFILEPOS END) + (CL:WHEN EOLC (* ; + "Record the last one we encountered") + (replace (STREAM EOLCONVENTION) of STRM with EOLC)) + (RETURN (NEXTPIECE FIRSTPC))) + (CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR))) + (SETQ EOLC CR.EOLC]) - (SETQ NNFILE (OPENSTREAM '{NODIRCORE} 'OUTPUT 'NEW)) +(\TEDIT.INTERPRET.XCCS.SHIFTS + [LAMBDA (PIECES PFILE) (* ; "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") - (* ;; "And copy the file-section into it.") + (* ;; "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. ") - (* ;; "Have to explicitly fill in 0 and EOFPTR, because if the file was open already, NILs would only copy from current fileptr to EOF.") + (for PC BYTE EOLC inpieces PIECES when (EQ PFILE (PCONTENTS PC)) + do (\SETFILEPTR PFILE (PFPOS PC)) + (SETQ BYTE (BIN PFILE)) + [if (EQ NSCHARSETSHIFT BYTE) + then (SELECTC (SETQ BYTE (BIN PFILE)) + (0 (* ; "Runlength of charset 0") + (add (PBYTELEN PC) + -2) (* ; + "The shift characters really disappear") + (FSETPC PC PLEN (PBYTELEN PC)) + (FSETPC PC PTYPE THINFILE.PTYPE) + (FSETPC PC PBINABLE T) + (FSETPC PC PCHARSET 0) + (add (PFPOS PC) + 2)) + (\NORUNCODE (* ; "Going for 3 byte characters") + (CL:UNLESS (EQ 0 (BIN PFILE)) + (SHOULDNT "XCCS CHARACTER NOT IN PLANE 0")) + (FSETPC PC PTYPE FATFILE2.PTYPE) + (FSETPC PC PBYTESPERCHAR 2) + (add (PFPOS PC) + 3) + (add (PBYTELEN PC) + -3) + (FSETPC PC PLEN (FOLDLO (PBYTELEN PC) + 2))) + (PROGN + (* ;; "A run in a non-zero charset. Convert it to FATFILE1. Could also read into a FATSTRING instead, get rid of on-file FATFILE1. A string piece could hold adjacent substrings in different charsets") - (* ;; - "Use COPYBYTES for formatted files, otherwise allow natural EOL conversion to take place") + (add (PBYTELEN PC) + -2) + (add (PFPOS PC) + 2) + (FSETPC PC PLEN (PBYTELEN PC)) + (FSETPC PC PBINABLE NIL) + (FSETPC PC PTYPE FATFILE1.PTYPE) + (FSETPC PC PBYTESPERCHAR 1) + (FSETPC PC PCHARSET BYTE))) + elseif (EQ 2 (PBYTESPERCHAR PC)) + then (FSETPC PC PTYPE FATFILE2.PTYPE) (* ; "This is the continuation of an XCCS 2-byte run that was broken up presumably for looks or paragraphs") + (FSETPC PC PCHARSET \NORUNCODE) + (FSETPC PC PLEN (FOLDLO (PBYTELEN PC) + 2)) + else (FSETPC PC PCHARSET 0) (* ; "A charset 0 1-byte run") + (FSETPC PC PBINABLE T) + (FSETPC PC PBYTESPERCHAR 1) + [\SETFILEPTR PFILE (IPLUS (PFPOS PC) + (SUB1 (PLEN PC] + (if (EQ (CHARCODE LF) + (SETQ BYTE (BIN PFILE))) + then + (* ;; "First EOL approximation: Convert trailing LF's to string-piece EOL's. This doesn't get LF's at the end of FATFILE2 or anywhere other than the end.") - [IF (\TEDIT.FORMATTEDP1 NFILE) - THEN [COPYBYTES NFILE NNFILE (OR START 0) - (OR END (GETFILEINFO NFILE 'LENGTH] - ELSE (COPYCHARS NFILE NNFILE (OR START 0) - (OR END (GETFILEINFO NFILE 'LENGTH] - (OR WASOPEN (CLOSEF NFILE)) (* ; - "If the file didn't come to us open, close it.") - (CLOSEF NNFILE) - (SETQ NFILE NNFILE) - (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") - )) - (TEDIT.DO.BLUEPENDINGDELETE SEL STREAM) (* ; "Delete any text, if need be") - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of STREAM)) - (* ; - "We need the POST-deletion text length for later, so this must come after the b-p-d.") - (\SHOWSEL SEL NIL NIL) (* ; - "Turn off SELs before we go any further") - [SETQ NFILE (TEXTOBJ (SETQ NSTREAM (OPENTEXTSTREAM (OPENSTREAM NFILE 'INPUT) - NIL NIL NIL (LIST 'FONT ( - \TEDIT.GET.INSERT.CHARLOOKS - STREAM SEL) - 'PARALOOKS - (fetch (TEXTOBJ FMTSPEC) - of STREAM] - - (* ;; "Get a textobj to describe the include source file (need NSTREAM so that if we have to convert it to formatted, we won't have lost the textstream--and thus smash the free list.)") - - (COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of NFILE) - (NOT (fetch (TEXTOBJ FORMATTEDP) of STREAM))) - (* ; - "If the includED text is formatted but this file isn't, let's format it!") - (\TEDIT.CONVERT.TO.FORMATTED STREAM)) - ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) - (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) - - (* ;; "The TARGET document is formatted, but the INCLUDEd text isn't. Better format it before completing the include.") - - (\TEDIT.CONVERT.TO.FORMATTED NFILE))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) (* ; - "HERE, because the conversion to formatted will lengthen the pctb") - [SETQ INSERTCH# (COND - ((EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (fetch (SELECTION CH#) of SEL)) - (T (fetch (SELECTION CHLIM) of SEL] - (* ; - "Find the place to make the insertion.") - (SETQ INSPC (\CHTOPC INSERTCH# PCTB T)) (* ; - "The piece to make the insertion in") - [COND - ((NEQ INSPC 'LASTPIECE) - (COND - ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") - (SETQ INSPC (\SPLITPIECE INSPC INSERTCH# STREAM INSPC#)) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of STREAM)) - (* ; "Refresh the PCTB in case it grew.") - ] - (SETQ PCLST (fetch (TEXTOBJ PCTB) of NFILE)) (* ; - "A temporary pctb, holding the pieces which describe the INCLUDEd text") - (SETQ LEN (fetch (BTREENODE TOTLEN) of PCLST)) - (\TEDIT.INSERT.PIECES STREAM INSERTCH# (SETQ PCLST (\GETBASEPTR (\FIRSTNODE PCLST) - 0)) - LEN INSPC INSPC# NIL) - [COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of STREAM) - (NOT (fetch (TEXTOBJ FORMATTEDP) of NFILE))) - (* ; - "If the includED text is formatted but this file isn't, let's format it!") - (\TEDIT.CONVERT.TO.FORMATTED STREAM INSERTCH# (IPLUS INSERTCH# LEN] - (\TEDIT.HISTORYADD STREAM (create TEDITHISTORYEVENT - THACTION _ 'Include - THCH# _ INSERTCH# - THLEN _ LEN - THFIRSTPIECE _ PCLST)) - (* ; - "Remember that we did this, so it can be undone.") - (replace (TEXTOBJ TEXTLEN) of STREAM with (IPLUS TEXTLEN LEN)) - (* ; - "Inserting the pieces didn't fix up things like the length of the document, so do it now.") - (AND (fetch (TEXTOBJ \WINDOW) of STREAM) - (\FIXILINES STREAM SEL INSERTCH# LEN TEXTLEN)) - (* ; "Mark any changed lines dirty.") - (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION CH#) of SEL - with INSERTCH#) - LEN)) - (* ; - "Now fix up the selection to be the included text, point_left, character selection grain.") - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'RIGHT) (* ; - "So that several things INCLUDED in sequence fall in sequence.") - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SELOBJ) of SEL with NIL) - (COND - ((fetch (TEXTOBJ \WINDOW) of STREAM) (* ; - "We're displaying; update the display and the selection's line references") - (TEDIT.UPDATE.SCREEN STREAM) - (\FIXSEL SEL STREAM) - (\SHOWSEL SEL NIL T))) - (replace (TEXTOBJ \DIRTY) of STREAM with T) (* ; "Mark the document changed") - (\SETUPGETCH (IPLUS -1 INSERTCH# LEN) - STREAM) (* ; - "Set the fileptr to the end of the insertion.") - T) - (T (TEDIT.PROMPTPRINT STREAM "Please choose the place for the INCLUDE first." T]) - -(TEDIT.RAW.INCLUDE - [LAMBDA (STREAM INFILE START END) (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 11-Jun-99 14:49 by rmk:") - (* ; "Edited 11-Jun-99 14:41 by rmk:") - (* ; - "Edited 27-May-93 16:36 by sybalsky:mv:envos") - - (* ;; "takes a text stream and an OPEN stream to include. Note: Start and End are inclusive ptrs, unlike in copybytes and friends") - - (* ;; - "no interpretation (alternate file type e.g. Bravo) takes place. Simply include the characters") - - (* ;; "Default character and paragraph looks are applied") - - (LET* ((TEXTOBJ (TEXTOBJ STREAM)) - (START START) - (END END) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - [HOLDING.FILE (OR (fetch (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ) - (replace (TEXTOBJ TXTRAWINCLUDESTREAM) of TEXTOBJ - with (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - PCTB TEXTLEN INSERTCH# INSPC LEN INSPC# PCLST NPC WASOPEN HOLDSTART HOLDLEN START-OF-PIECE - ) - (COND - ((NOT (fetch (SELECTION SET) of SEL)) - (SHOULDNT "\TEDIT.RAW.INCLUDE called with no selection set")) - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (* ; "Not allowed to change it.") - NIL) - (T (* ; - "There is a place to do the include.") - (\SHOWSEL SEL NIL NIL) (* ; - "Turn any pre-existing selection off") - (COND - (END - (* ;; "This is the copy-part-of-a-file case, with file liable to be volatile. Copy it to core for protection") - - [SETQ INFILE (COND - ((OPENP INFILE) - (SETQ WASOPEN T) - INFILE) - (T (OPENSTREAM INFILE 'INPUT NIL '((TYPE TEXT] - (* ; - "And copy the file-section into it.") - (SETFILEPTR HOLDING.FILE (SETQ HOLDSTART (GETEOFPTR HOLDING.FILE))) - (* ; - "Move to the end of the pre-existing part of the file.") - (COPYBYTES INFILE HOLDING.FILE START END) - (* ; - "must be copychars to respect eol conventions") - (SETQ HOLDLEN (IDIFFERENCE (OR END (GETEOFPTR INFILE)) - START)) - (COND - ((NOT WASOPEN) (* ; - "Close the input file if it wasn't open when we got here.") - (CLOSEF INFILE))) - (SETQ INFILE HOLDING.FILE) - (SETQ START (SETQ END NIL)) (* ; "Then pretend nothing happened.") - )) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ INSERTCH# (TEDIT.GETPOINT NIL SEL)) (* ; - "Find the place to make the insertion.") - (SETQ INSPC (OR (\CHTOPC INSERTCH# PCTB T) - (LASTPIECE PCTB))) (* ; - "The piece to make the insertion in") - [COND - ((NEQ INSPC 'LASTPIECE) - (COND - ((IGREATERP INSERTCH# START-OF-PIECE) (* ; "Must split the piece.") - (SETQ INSPC (\SPLITPIECE INSPC (- INSERTCH# START-OF-PIECE) - TEXTOBJ INSPC#)) - (add INSPC# 1) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (* ; "Refresh the PCTB in case it grew.") - ] - (SETQ PCLST (create PIECE - PFILE _ INFILE - PFPOS _ (OR HOLDSTART START 0) - PLEN _ - [OR HOLDLEN (IDIFFERENCE - [COND - (END END) - (T (* ; "get the eof pointer") - (COND - ((OPENP INFILE) - (GETEOFPTR INFILE)) - (T [OPENSTREAM INFILE 'INPUT NIL - '((TYPE TEXT] - (PROG1 (GETEOFPTR INFILE) - (CLOSEF INFILE] - (COND - (START START) - (T 0] - PREVPIECE _ NIL - NEXTPIECE _ NIL - PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ) - PPARALAST _ NIL - PPARALOOKS _ (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC))) - (SETQ LEN (fetch (PIECE PLEN) of PCLST)) - (\TEDIT.INSERT.PIECES TEXTOBJ INSERTCH# PCLST LEN INSPC INSPC# NIL) - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS TEXTLEN LEN)) - (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\FIXILINES TEXTOBJ SEL INSERTCH# LEN TEXTLEN)) - (replace (SELECTION CHLIM) of SEL with (IPLUS (replace (SELECTION CH#) of SEL - with INSERTCH#) - LEN)) - (* ; - "Now fix up the selection to be the included text, point_left, character selection grain.") - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'RIGHT) - (* ; - "So that several things INCLUDED in sequence fall in sequence.") - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SELOBJ) of SEL with NIL) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document changed") - (\SETUPGETCH (create EDITMARK - PC _ INSPC - PCOFF _ 0 - PCNO _ NIL) - TEXTOBJ) (* ; - "Set the fileptr to the end of the insertion.") - T]) + [if (EQ (PLEN PC) + 1) + then (FSETPC PC PTYPE THINSTRING.PTYPE) + (* ; "Convert to EOL string") + (FSETPC PC PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL))) + else (add (PLEN PC) + -1) (* ; + "Shorten PC, add EOL string piece unless preceded by CR") + (add (PBYTELEN PC) + -1) + (if (EQ (CHARCODE CR) + (\BACKBIN PFILE)) + then (SETQ EOLC CRLF.EOLC) + else (SETQ EOLC LF.EOLC) + (SETQ PC (PROG1 (\TEDIT.MAKE.STRINGPIECE PC (CHARCODE EOL)) + (FSETPC PC PPARALAST NIL] + else (CL:WHEN (EQ BYTE (CHARCODE CR)) + (SETQ EOLC CR.EOLC)) + (FSETPC PC PTYPE THINFILE.PTYPE) + (FSETPC PC PLEN (PBYTELEN PC] finally (CL:WHEN EOLC + (replace (STREAM EOLCONVENTION) + of PFILE with EOLC))) + PIECES]) ) -(* ;; "PUTting a file:") +(* ; "XCCS") (DEFINEQ -(TEDIT.PUT - [LAMBDA (STREAM FILE FORCENEW UNFORMATTED? OLDFORMAT?) (* ; "Edited 21-Jun-99 19:02 by rmk:") - (* ; "Edited 21-Jun-99 18:58 by rmk:") - (* ; "Edited 11-Jun-99 15:05 by rmk:") - (* ; "Edited 19-Apr-93 13:04 by jds") +(\TEDIT.GET.UNFORMATTED.FILE.UTF8 + [LAMBDA (STRM START END DEFAULTCHARLOOKS DEFAULTPARALOOKS) (* ; "Edited 4-Feb-2024 10:12 by rmk") + (* ; "Edited 2-Feb-2024 11:24 by rmk") + (* ; "Edited 21-Jan-2024 09:41 by rmk") + (* ; "Edited 12-Jan-2024 13:17 by rmk") + (* ; "Edited 10-Jan-2024 10:32 by rmk") + (* ; "Edited 8-Jan-2024 12:08 by rmk") - (* ;; "If the guy was editing a file, make a new updated version; else, ask for a file name") + (* ;; "Break a UTF-8 file into pieces all of whose characters are of the same length. This is roughly the same logic of \TEDIT.GET.UNFORMATTED.FILE.XCCS.") - (* ;; "If FILE is specd, it's used; else the user must give us one") + (* ;; "We assume that caller has positioned the stream at the intended start byte and has set the ENDOFSTREAMOP to return NIL on EOF. ") - (* ;; "Returns an open stream on the file you PUT to.") + (* ;; "CRBEFORE and the LF test are used to ensure that potential CR/LF's are normalized to EOL and appear at the end of their pieces, whether or not we decide to make them PPARALAST on input. LF's after CR are discarded, LF's by themselves are converted to singleton EOLstring pieces.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (TEDIT.PUT.FINISHEDFORMS NIL) - (TEDIT.GET.FINISHEDFORMS NIL) - (OUTPUT.FILE.WRITTEN NIL) - OCURSOR OFILE FONTFILEUSED PROPS WINDOW PUTFN CACHE MENUSTREAM FILENAME TITLE CH#S PC) - [COND - (FILE (* ; "We were given a file to use.") - (SETQ OFILE FILE)) - [FORCENEW (* ; - "He insists on a new file. (without giving us one NIL)") - (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: "] - (T (* ; "Get a file to put the text into") - (SETQ OFILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT TEXTOBJ "File to PUT to: " - (\TEXTSTREAM.FILENAME TEXTOBJ] - (SETQ PUTFN (TEXTPROP TEXTOBJ 'PUTFN)) - (SETQ CACHE (TEXTPROP TEXTOBJ 'CACHE)) - (COND - ((NOT OFILE) (* ; - "There's no file to put to; don't bother.") - (RETURN)) - ((AND PUTFN (EQ (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (FULLNAME OFILE) - 'BEFORE) - 'DON'T)) (* ; - "He doesn't want this document put. Bail out.") - (RETURN))) - (RESETLST - [RESETSAVE [SETQ OFILE (OPENSTREAM OFILE 'OUTPUT 'NEW - (COND - [UNFORMATTED? (* ; - "If the user forced no formatting, respect his wish.") - '((TYPE TEXT] - [(TEDIT.FORMATTEDFILEP TEXTOBJ) - (* ; - "If this file has objects, para looks, or font changes, then we need a binary file.") - '((TYPE BINARY] - [(AND NIL (EQL (U-CASE (FILENAMEFIELD OFILE - 'EXTENSION)) - 'TEDIT)) - (* ; "If file extension is TEDIT, then we presume that it really is a tedit file, thus making it a binary file. BUT: rmk we really prefer TYPE TEXT even for a file with extension tedit.") - '((TYPE BINARY] - (T (* ; - "Otherwise, we can get by with a text file") - '((TYPE TEXT] - '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] - [RESETSAVE (\TEDIT.PUTRESET (CONS (THIS.PROCESS) - 'DON'T] - (replace DESC of (fetch (TEXTOBJ THISLINE) of TEXTOBJ) with NIL) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "PUTting file " (fetch (STREAM FULLNAME) - of OFILE) - "...") - T) - [COND - ((IGREATERP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - 0) - (SETQ FONTFILEUSED (COND - (OLDFORMAT? (TEDIT.PUT.PCTB2 TEXTOBJ OFILE UNFORMATTED?)) - (T (TEDIT.PUT.PCTB TEXTOBJ OFILE UNFORMATTED?] - (CLOSEF OFILE) (* ; - "Close the file, to free it up. And re-open it for INPUT only") - [COND - ((NOT CACHE) (* ; - "CSLI if caching do not need to reopen the output file anyway") + (bind (NEXTFILEPOS _ START) + (FIRSTPC _ (create PIECE + PLOOKS _ DEFAULTCHARLOOKS + PPARALOOKS _ DEFAULTPARALOOKS)) + (NEXTCODESIZE _ 1) + (SBINABLE _ (fetch (STREAM BINABLE) of STRM)) + EOLC CHAR PREVPC PTYPE RUNLEN FILEPOS CRBEFORE CODESIZE PREVCRLF first (SETQ CODESIZE + NEXTCODESIZE) + (* ; "Assume Ascii to start") + (SETQ PREVPC FIRSTPC + ) + (* ; "FIRSTPC is a throwaway") + do (SETQ FILEPOS NEXTFILEPOS) (* ; "Start of next file piece") + (do + (* ;; "We stop extending if the next character wouold be out of range, go below to wrap up the final piece. ") - (* ;; "Declare as type text, even if it hasn't been specified as a binary file--could simply be an unformatted stream.") + (CL:WHEN (IGEQ NEXTFILEPOS END) + (RETURN)) + (SETQ CHAR (\PEEKBIN STRM)) (* ; + "Keep CHAR for CR/LF checking, error if EOF") + (* ; "Error if invalid header") + (SETQ NEXTCODESIZE (UTF8-SIZE-FROM-BYTE1 CHAR)) + (CL:UNLESS (EQ CODESIZE NEXTCODESIZE) (* ; "Header byte hasn't been read") - (SETQ OFILE (OPENSTREAM (fetch (STREAM FULLFILENAME) of OFILE) - 'INPUT NIL '((TYPE TEXT](* ; - "changed TEMPORary for ns filing with caching. may not work in general") - (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) (* ; "Close the old text file") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with OFILE) - (* ; - "And remember the new one for next time.") - (* ; - "We can safely QUIT now without losing anything.") - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL)) - (SETQ CH#S (REVERSE (CDR FONTFILEUSED))) (* ; - "The true filepos's of the pieces in the output file.") - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE) - (EQ CR.EOLC (fetch (STREAM EOLCONVENTION) of OFILE))) + (* ;; "Don't want LF processing if we split because of size change. If next is a CR/LF still in size 1, we pick it up below") - (* ;; "If we've cached this file, DON'T go thru and fill in the real file's location, because the EOL convention may well be wrong.") + (SETQ CHAR NIL) + (RETURN)) + (SETQ NEXTCODESIZE (UTF8.VALIDATE STRM)) (* ; "\Read/validate the trailing bytes") + (add NEXTFILEPOS NEXTCODESIZE) + (CL:WHEN (MEMB CHAR (CHARCODE (CR LF))) - (* ;; "(SETQ PC (ELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") + (* ;; "Force a split now, after reading the CR/LF. But make sure a size change doesn't force an empty split in front of the next character.") - (UNINTERRUPTABLY - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) - (while (AND PC CH#S) do - (* ;; - "Run thru the pieces in the PCTB, pointing them to the new file and their new locations.") + (SETQ NEXTCODESIZE (NUTF8-BYTE1-BYTES (OR (\PEEKBIN STRM) + 0))) + (RETURN))) - (COND - ((fetch (PIECE POBJ) of PC)) - (T (replace (PIECE PFPOS) of PC with (pop CH#S)) - (CLOSEF? (fetch (PIECE PFILE) of PC)) - (* ; - "If this is a piece on an open file, close it, since we're never going to read from it again.") - (replace (PIECE PFILE) of PC with OFILE) - (replace (PIECE PSTR) of PC with NIL))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))))] - (TEDIT.PROMPTPRINT TEXTOBJ "done.") (* ; "Tell him we're finished.") - (SETQ TITLE (TEXTSTREAM.TITLE TEXTOBJ)) (* ; "find and set the title") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE TITLE NIL)) - (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) - (COND - ((AND MENUSTREAM (type? 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))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; "Make sure any new insertions happen for real, and not as appends. Since all the pieces now point to the file rather than the strings.") - (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL) + (* ;; "") - (* ;; "make sure that TEDIT doesn't try to just add to the \INSERTPC since it will now have a pfile property") + (* ;; "NEXTFILEPOS and file are positioned at beginning of next piece, possibly after CR and LF have been read.") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Put - THCH# _ 0 - THLEN _ 0 - THFIRSTPIECE _ NIL)) - (* ; "Remember we did this.") - (AND PUTFN (APPLY* PUTFN (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - 'AFTER)) (* ; - "CSLI changed to not presume ofile is the txtfile anymore") - (RETURN OFILE]) + (SETQ RUNLEN (IDIFFERENCE NEXTFILEPOS FILEPOS)) + (CL:WHEN (EQ CHAR (CHARCODE LF)) (* ; "We never produce raw LF's") + (add RUNLEN -1)) + (CL:WHEN (IGREATERP RUNLEN 0) + (SETQ PTYPE (CL:IF (EQ CODESIZE 1) + THINFILE.PTYPE + UTF8.PTYPE)) + (SETQ PREVPC + (FSETPC PREVPC NEXTPIECE + (create PIECE + PTYPE _ PTYPE + PCONTENTS _ STRM + PFPOS _ FILEPOS + PLEN _ (IQUOTIENT RUNLEN CODESIZE) + PLOOKS _ DEFAULTCHARLOOKS + PPARALOOKS _ DEFAULTPARALOOKS + PBYTESPERCHAR _ CODESIZE + PBYTELEN _ RUNLEN + PREVPIECE _ PREVPC + PBINABLE _ (AND (EQ PTYPE THINFILE.PTYPE) + SBINABLE) + PUTF8BYTESPERCHAR _ CODESIZE)))) + (CL:WHEN (EQ CHAR (CHARCODE LF)) + [if CRBEFORE + then (SETQ EOLC CRLF.EOLC) + else + (* ;; "Linefeed not preceded by CR, replace by string piece") -(TEDIT.PUT.PCTB - [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 30-Apr-2021 14:46 by rmk:") - (* ; "Edited 19-May-99 21:58 by rmk:") - (* ; - "Edited 27-May-93 16:00 by sybalsky:mv:envos") - - (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") - - (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - (*READTABLE* *TEDIT-FILE-READTABLE*) - (*PRINT-BASE* 10) - OLDCH# CURCH# PREVPC FONTFILE (PCCOUNT 0) - TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) - (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (PARALOOKSSEEN NIL) - (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) - (CACHE (TEXTPROP TEXTOBJ 'CACHE)) - CH#S PREVFATP PARAHASH LOOKSHASH PREVPREVPC) - (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - - (* ;; "(SETQ PC (\EDITELT (fetch PCTB of TEXTOBJ) (ADD1 \FirstPieceOffset)))") - - (SETQ PC (\GETBASEPTR (\FIRSTNODE (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - 0)) (* ; "First piece in the document") - (SETQ OLDLOOKS (OR (AND (type? PIECE PC) - (fetch (PIECE PLOOKS) of PC)) - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") - - (* ;; "RMK: CHANGED DEFAULT FROM CR TO LF") - - (COND - ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) - LF.EOLC) (* ; - "This file is on a non-LF host; make a note to cache it") - (SETQ TRUEFILE OFILE) (* ; - "Remember where the file should wind up.") - [SETQ OFILE (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "And open a temp file to write it to.") - (replace (STREAM LINELENGTH) of OFILE with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - )) - [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] - (COND - ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) (* ; - "There is layout info for this file. Save it") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) - (add PCCOUNT 1))) - (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; - "Run thru the lists of char & para looks and remove any that aren't in use") - (COND - ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - 1) - (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - TEDIT.DEFAULT.FMTSPEC] - - (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") - - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST FONTFILE (fetch (TEXTOBJ TXTPARALOOKSLIST) - of TEXTOBJ))) - (SETQ PARALOOKSSEEN T))) - [COND - ((OR PARALOOKSSEEN FORMATTINGLEVEL) - - (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") - - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - [while PC - do (COND - ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; - "The last piece ended a paragraph, so send out new para looks") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((NEQ CURCH# OLDCH#) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) - (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) - (SETQ PARALOOKSSEEN T) (* ; - "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") - (add PCCOUNT 1))) - (COND - [(fetch (PIECE POBJ) of PC) (* ; - "It's an object -- go use its PUTFN") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((AND (NEQ CURCH# OLDCH#) - PREVPC) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) (* ; - "If the prior thing was text, send along its descriptor.") - (* ; "Send out the object") - (IF UNFORMATTED? - THEN (CL:WHEN (AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - - (* ;; "Last piece was FAT, but object doesn't know that. Start it out thin. The stream must also be thin after the PRIN1 of the object's preprint string. Setting PREVPC to NIL means that no comparisons will be done (which asserts THIN among other things), but that's OK because we aren't doing formatting anyway.") - - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2) - (SETQ PREVPC NIL)) - (LET [(FN (IMAGEOBJPROP (fetch (PIECE POBJ) of PC) - 'PREPRINTFN] - (PRIN1 (IF FN - THEN (PROG1 (APPLY* FN (fetch (PIECE POBJ) of PC)) - - (* ;; "Insure thin") - - (CHARSET OFILE 0)) - ELSE "[UNPRINTABLE OBJECT]") - OFILE) - (add CURCH# 1 (IDIFFERENCE (GETEOFPTR OFILE) - CURCH#))) - ELSE (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#))) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) - (COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; - "The OBJECT has different ooks from before") - (\BOUT FONTFILE 1) - (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch (PIECE PLOOKS) of PC)) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (T (* ; - "No differences. Don't write any charlooks, and mark that fact") - (\BOUT FONTFILE 0) (* ; - "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") - ] - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) (* ; "It's not an object.") - - (* ;; "For 0-length pieces, don't even acknowledge their existence!!") - - (* ;; "So only do this processing if there's text in the piece.") - - [COND - ([OR [NEQ (fetch (PIECE PFATP) of PC) - (SETQ PREVFATP (AND PREVPC (fetch (PIECE PFATP) of PREVPC] - (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; "We have a piece with new looks.") - (* ; - "The PREVFATP clause needs to come first, so that PREVFATP gets set for later use.") - (SETQ FONTFILE (\TEDIT-OPEN-FONT-FILE FONTFILE)) - (* ; - "Open a font-info file if one is needed.") - (COND - ((NOT (IEQP OLDCH# CURCH#)) (* ; - "If there were looks past, and if the run was not empty, save a piece for its looks") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1))) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) - (SETQ OLDCH# CURCH#) - (COND - [PREVFATP (COND - ((fetch (PIECE PFATP) of PC)) - (T (* ; "Switching from FAT to thin") - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2] - ((fetch (PIECE PFATP) of PC) (* ; "Switching from thin to fat") - (BOUT OFILE 255) - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 3] (* ; - "Now dump out the non-object contents of the piece.") - [COND - [(SETQ PFILE (fetch (PIECE PFILE) of PC)) - (* ; "It's on a file. Copy it.") - [OR (OPENP PFILE) - (replace (PIECE PFILE) of PC with (SETQ PFILE (\TEDIT.REOPEN.STREAM - TEXTOBJ PFILE] - (* ; "Make sure the file is open.") - (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) - (IPLUS (fetch (PIECE PFPOS) of PC) - (COND - ((fetch (PIECE PFATP) of PC) - (* ; - "For fat file pieces, copy twice as many bytes as characters.") - (UNFOLD (fetch (PIECE PLEN) of PC) - 2)) - (T (fetch (PIECE PLEN) of PC] - ((SETQ PSTR (fetch (PIECE PSTR) of PC)) - (* ; "It's in a string. Just print it.") - - (* ;; - "RMK: BOUT ptimizations would miss external formats and EOL conventions") - - (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring PSTR - do (\OUTCHAR OFILE CH)) (* (COND ((fetch (PIECE PFATP) of PC) - (* ; - "The string is fat: Copy twice as many bytes as chars.") - (for I from 1 to (fetch - (PIECE PLEN) of PC) as CH instring - PSTR do (\BOUT OFILE - (\CHARSET CH)) (\BOUT OFILE - (\CHAR8CODE CH)))) (T - (* ; - "The string is thin. Just copy it to the file.") - (for I from 1 to (fetch - (PIECE PLEN) of PC) as CH instring - PSTR do (\BOUT OFILE CH))))) - ] - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE)) (* ; - "CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") - (push CH#S (SUB1 CURCH#] - [COND - ((fetch (PIECE PFATP) of PC) - (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) - 2))) - (T (add CURCH# (fetch (PIECE PLEN) of PC] - (* ; - "Keep running track of where in the file we are.") - )) - (COND - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) - - (* ;; "Only remember this piece if it's not zero-length!") - - (SETQ PREVPREVPC PREVPC) - (SETQ PREVPC PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (* ; - "Put out a piece describing the last characters in the file.") - (COND - ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; - "Only if there WERE characters, and only if there's a need for font information") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVPREVPC) (* ; - "Put out a description of the characters") - (add PCCOUNT 1))) - (COND - ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) - (* ; - "The last piece contained the end of a paragraph. Make sure it gets noted.") - (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) - - (* ;; "Write out a dummy paragraph-looks piece, so that we protect the PPARALAST of the final piece in the document.") - - (\DWOUT FONTFILE 0) - (\SMALLPOUT FONTFILE \PieceDescriptorPARA) - (\SMALLPOUT FONTFILE 1) - - (* ;; "This adds a total of 2 pieces to the file:") - - (add PCCOUNT 2] - (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) - (* ; "Do any user-specific cleanup") - (COND - (TRUEFILE (* ; - "This file needs to be converted to the right convention") - (COND - ((AND FONTFILE (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) (* ; - "Formatted file: Copy without converting.") - (COPYBYTES OFILE TRUEFILE 0 -1)) - (T (* ; - "Go ahead and convert the EOLCONVENTION, this is a plain-text file") - (COPYCHARS OFILE TRUEFILE 0 -1))) - (SETQ OFILE TRUEFILE))) - [COND - ((AND (OPENP OFILE) - FONTFILE) (* ; "We need to write format info.") - (\DWOUT FONTFILE (GETFILEPTR OFILE)) (* ; - "So remember the end of the plain-text part of the file") - (\SMALLPOUT FONTFILE PCCOUNT) (* ; - "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") - (\SMALLPOUT FONTFILE 31418) (* ; - "Now the password for NEW format files: 31416") - (COND - ((AND (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) - - (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") - - (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) - (* ; - "Copy the font information to the file trailer") - ) - (T)) - (CLOSEF FONTFILE) - (COND - ((NOT SEPARATEFORMAT) (* ; - "Unless we want the formatting info separately, delete the file") - (* ; - "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") - ] - (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ) - TEXTOBJ)) - (* ; - "Re-add the default and caret looks's to the lists, since they may not have been really saved.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ) - TEXTOBJ)) - (RETURN (CONS (COND - (UNFORMATTED? NIL) - (T FONTFILE)) - CH#S]) - -(\TEDIT.PUTRESET - [LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38") - (CONS (CAR PROC&VALUE) - (PROCESSPROP (CAR PROC&VALUE) - 'BEFOREEXIT - (CDR PROC&VALUE]) - -(TEDIT.PUT.PIECE.DESCRIPTOR - [LAMBDA (FILE CH1 CHLIM LOOKS) (* ; "Edited 30-May-91 20:25 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (* (PROG ((FONT (fetch - (CHARLOOKS CLFONT) of LOOKS)) STR) - (SETQ STR (CONCAT "(FONTCREATE " - (KWOTE (FONTPROP FONT - (QUOTE FAMILY))) " " - (FONTPROP FONT (QUOTE SIZE)) " " - (KWOTE (FONTPROP FONT - (QUOTE FACE))) " )")) - (\DWOUT FILE (IDIFFERENCE CHLIM CH1)) - (* The length of this run of looks) - (\SMALLPOUT FILE (NCHARS STR)) - (* The length of the description which - follows) (PRIN1 STR FILE) - (* Print the form which can EVAL to - re-create the font information) - (\BOUT FILE (LOGOR (COND - ((fetch (CHARLOOKS CLPROTECTED) of - LOOKS) 8) (T 0)) (COND - ((fetch (CHARLOOKS CLINVISIBLE) of - LOOKS) NIL 4) (T 0)) - (COND ((fetch (CHARLOOKS CLSELHERE) of - LOOKS) 2) (T 0)) (COND - ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) - 1) (T 0)))))) - (HELP]) - -(\ARBOUT - [LAMBDA (STREAM ITEM) (* ; "Edited 20-Apr-88 19:55 by jds") - (* ; - "Write an arbitrary MKSTRING-able thing in length-contents form.") - (LET ((SIZE (AND ITEM (NCHARS ITEM T *TEDIT-FILE-READTABLE*))) - (FPTR) - (END-FPTR)) - (\SMALLPOUT STREAM (OR SIZE 0)) - (SETQ FPTR (GETFILEPTR STREAM)) - (OR (NOT ITEM) - (ZEROP SIZE) - (PRIN2 ITEM STREAM *TEDIT-FILE-READTABLE*)) - - (* ;; "Because of NS chars, you gotta back up and really count bytes.") - (* (SETQ END-FPTR (GETFILEPTR STREAM)) - (SETFILEPTR STREAM FPTR) - (\SMALLPOUT STREAM (- - END-FPTR FPTR)) (SETFILEPTR STREAM - END-FPTR)) - NIL]) - -(\ATMOUT - [LAMBDA (STREAM ATOM) (* jds "30-Jan-85 14:46") - (* Write an atom's characters in - length-contents form.) - (\SMALLPOUT STREAM (COND - (ATOM (NCHARS ATOM)) - (T 0))) - (OR (NOT ATOM) - (ZEROP (NCHARS ATOM)) - (for CH inatom ATOM do (\BOUT STREAM CH]) - -(\DWOUT - [LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30") - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 24))) - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 16))) - (\BOUT FILE (LOGAND 255 (LRSH NUMBER 8))) - (\BOUT FILE (LOGAND 255 NUMBER]) - -(\STRINGOUT - [LAMBDA (STREAM STRING LEN) (* jds " 1-May-84 11:58") - - (* Write a string on a file in length-contents form; - one word for the length, and one byte per character contained.) - - (SETQ LEN (OR LEN (NCHARS STRING))) - (\SMALLPOUT STREAM LEN) - (OR (ZEROP LEN) - (for CH instring STRING as I from 1 to LEN do (\BOUT STREAM CH]) - -(\TEDIT-OPEN-FONT-FILE - [LAMBDA (EXISTING-FONTFILE-IF-ANY) (* ; "Edited 23-Sep-87 12:31 by jds") - - (* ;; " Open a font-information file for TEDIT PUT operation, if one doesn't exist already. Also set its linelength to effective infinity, so that we don't get spurious CRs in the middle of formatting info.") - - (* ;; "The calling form must be (SETQ FOO (\TEDIT-OPEN-FONT-FILE FOO)), to preserve information.") - - (COND - ((NOT EXISTING-FONTFILE-IF-ANY) (* ; - "Create the font-info file if it doesn't exist yet") - (SETQ EXISTING-FONTFILE-IF-ANY (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW)) - (replace (STREAM LINELENGTH) of EXISTING-FONTFILE-IF-ANY with MAX.SMALLP) - (* ; - "Prevent spurious carriage-returns in the piece descriptions.") - )) - EXISTING-FONTFILE-IF-ANY]) + (SETQ EOLC LF.EOLC) + (SETQ PREVPC (\TEDIT.MAKE.STRINGPIECE PREVPC (CHARCODE EOL]) + (CL:WHEN (IGEQ NEXTFILEPOS END) + (CL:WHEN EOLC (* ; + "Record the last EOLC we encountered") + (replace (STREAM EOLCONVENTION) of STRM with EOLC)) + (RETURN (NEXTPIECE FIRSTPC))) + (SETQ CODESIZE NEXTCODESIZE) + (CL:WHEN (SETQ CRBEFORE (EQ CHAR (CHARCODE CR))) + (SETQ EOLC CR.EOLC]) ) + + + +(* ; "UTF-8") + (DEFINEQ (\TEDIT.GET.CHARLOOKS.LIST - [LAMBDA (FILE) (* jds "28-Jan-85 17:50") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE]) + [LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:44 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* jds "28-Jan-85 17:50") + (* ; + "Read the list of CHARLOOKSs from the file.") + (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS FILE]) (\TEDIT.GET.SINGLE.CHARLOOKS - [LAMBDA (FILE) (* ; "Edited 20-Feb-2022 12:42 by larry") + [LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:46 by rmk") + (* ; "Edited 21-Dec-2023 23:54 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 25-Nov-2023 23:21 by rmk") + (* ; "Edited 24-Aug-2023 15:05 by rmk") + (* ; "Edited 20-Feb-2022 12:42 by larry") (* ; "Edited 30-May-91 20:25 by jds") - (* Read a set of CHARLOOKS from FILE) + + (* ;; "Read one CHARLOOKS from FILE. This gets and then sets the file pointer, based on the stored length. But that won't work if the file is not random access. Maybe that's not necessary?") + (PROG* ((LOOKS (create CHARLOOKS)) (FILEPOS (GETFILEPTR FILE)) - (LOOKSLEN (\SMALLPIN FILE)) + (LOOKSLEN (\WIN FILE)) FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) + (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)) - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] + (SETQ PROPS (\WIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLUNBREAKABLE (NOT (ZEROP (LOGAND 4096 PROPS] + [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] @@ -1727,164 +1385,111 @@ [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] (SETQ CLSIZE SIZE) (SETQ CLOFFSET SUPER)) - [replace (CHARLOOKS CLFONT) of LOOKS with (COND - ((LISTP NAME) - (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (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)) - NIL NIL T NIL] + [SETQ FONT (COND + ((LISTP NAME) (* ; + "This was a font class. Restore it.") + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (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.") + + (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T] + (FONTPROP NAME 'FAMILY)) + else NAME)) + (replace (CHARLOOKS CLFONT) of LOOKS with FONT) (SETFILEPTR FILE (IPLUS FILEPOS LOOKSLEN)) (RETURN LOOKS]) -(\TEDIT.PUT.CHARLOOKS.LIST - [LAMBDA (FILE LOOKSLIST) (* jds " 5-Mar-85 15:58") - (* Write the list of CHARLOOKSs into - the font file.) +(\TEDIT.GET.CHARLOOKS + [LAMBDA (PC FILE LOOKSARRAY) (* ; "Edited 13-Jan-2024 00:01 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 3-Sep-2023 23:31 by rmk") + (* ; "Edited 28-Aug-2023 22:19 by rmk") + (* ; "Edited 26-Aug-2023 23:22 by rmk") + (* ; "Edited 30-May-91 21:43 by jds") - (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' - position in the list we wrote on the file. - Those position numbers are then written in the individual looks descriptions, and - are used to reconstruct the piece looks when the file is read back in.) + (* ;; "Set the PLOOKS for the current piece, PC, according to what the file says") - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) (* No characters are described by this - pseudo-piece entry.) - (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of - CHARLOOKSs) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in - the list) - (for I from 1 as LOOKS in LOOKSLIST do (* Write each charlooks, in the order - they appear in the list.) - (\TEDIT.PUT.SINGLE.CHARLOOKS FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - (* And save it in the hash table so - people can find its index.)) - (RETURN LOOKSHASH]) + (* ;; "We also ") -(\TEDIT.PUT.SINGLE.CHARLOOKS - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") - (* Put out a single CHARLOOKS - description.) - (PROG ((FILEPOS (GETFILEPTR FILE)) - (FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) - STR LEN) - (\SMALLPOUT FILE 0) (* Reserve space for the length of - this looks) - [COND - ((type? FONTCLASS FONT) (* For font classes, we need to save a - list of device-FD sets) - (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) - (T (* For FONTDESCRIPTORs, do it the easy - way) - (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) - (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) - 0)) (* Size of the type, in points) - (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) (* Super/subscripting distance) - (COND - ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) - (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] - (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (COND - ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) - (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - [\SMALLPOUT FILE (LOGOR (COND - ((fetch (CHARLOOKS CLLEADER) of LOOKS) - (* Dotted-leader; relevant only to - TABs) - 2048) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS) - (* Inverse-video) - 1024) - (T 0)) - (COND - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 512) - (T 0)) - (COND - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 256) - (T 0)) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - 128) - (T 0)) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - 64) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) - 32) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) - 16) - (T 0)) - (COND - ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) - 8) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) - NIL 4) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSELHERE) of LOOKS) - 2) - (T 0)) - (COND - ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) - 1) - (T 0] + (LET ((FLAGS (BIN FILE))) + (FSETPC PC PLOOKS (ELT LOOKSARRAY (\WIN FILE))) + (CL:UNLESS (ZEROP (LOGAND FLAGS 1)) + (FSETPC PC PNEW T)) + (CL:UNLESS (ZEROP (LOGAND FLAGS 2)) (* ; + "XCSS FAT. It may be a continuation of a previous fat piece") + (FSETPC PC PLEN (IQUOTIENT (FGETPC PC PLEN) + 2)) + (FSETPC PC PTYPE FATFILE2.PTYPE) + (FSETPC PC PBYTESPERCHAR 2))]) - (* * Now go fill in the length field at the front of the LOOKS. - (ALL looks info should be written out BEFORE this comment.)) +(\TEDIT.GET.PARALOOKS.INDEX + [LAMBDA (STREAM PARAHASH) (* ; "Edited 13-Jan-2024 13:06 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 18-Dec-88 17:47 by jds") - (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) - FILEPOS)) (* The length of this set of looks) - (SETFILEPTR FILE FILEPOS) (* Go write the length field) - (\SMALLPOUT FILE LEN) - (SETFILEPTR FILE -1) (* And back to the end of the file) - ]) + (* ;; "Reads the index of a paragraph format. .") + + (* ;; "Index 0 indicates an end-of-file dummy, used to preserve the paralooks of EOF para break.") + + (\WIN STREAM]) + +(\TEDIT.GET.CHARLOOKS.INDEX + [LAMBDA (PC FORMATSTREAM) (* ; "Edited 14-Jan-2024 00:11 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 3-Sep-2023 23:31 by rmk") + (* ; "Edited 28-Aug-2023 22:19 by rmk") + (* ; "Edited 26-Aug-2023 23:22 by rmk") + (* ; "Edited 30-May-91 21:43 by jds") + + (* ;; "Set the type, length, and and charlooks-index for the current piece, PC") + + (LET ((FLAGS (BIN FORMATSTREAM))) + (FSETPC PC PLOOKS (\WIN FORMATSTREAM)) + (CL:UNLESS (ZEROP (LOGAND FLAGS 1)) + (FSETPC PC PNEW T)) + (CL:UNLESS (ZEROP (LOGAND FLAGS 2)) (* ; + "XCSS FAT. It may be a continuation of a previous fat piece") + (FSETPC PC PLEN (IQUOTIENT (FGETPC PC PLEN) + 2)) + (FSETPC PC PTYPE FATFILE2.PTYPE) + (FSETPC PC PBYTESPERCHAR 2))]) ) (DEFINEQ (\TEDIT.GET.PARALOOKS.LIST - [LAMBDA (FILE TEXTOBJ) (* jds "13-Jun-85 11:14") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ]) + [LAMBDA (FILE TEXTOBJ) (* ; "Edited 16-Jan-2024 22:47 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* jds "13-Jun-85 11:14") + (* ; + "Read the list of CHARLOOKSs from the file.") + (for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS FILE TEXTOBJ]) (\TEDIT.GET.SINGLE.PARALOOKS - [LAMBDA (FILE TEXTOBJ) (* ; + [LAMBDA (FILE TEXTOBJ) (* ; "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") + (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* ;  "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 (\SMALLPIN FILE)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC TABTYPE QUAD) + (LOOKSLEN (\WIN FILE)) + TABFLG DEFTAB TABCOUNT TABS TABSPEC TABTYPE QUAD) (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) (* ;  "Left margin for the first line of the paragraph") @@ -1898,25 +1503,23 @@ (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 NIL NIL))) - (* ; "Will be tab specs") - (SETQ TABFLG (\BIN FILE)) - (replace (FMTSPEC QUAD) of LOOKS with (SELECTC (SETQ QUAD (\BIN 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))) - (COND - ((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read") - (SETQ DEFAULTTAB (\SMALLPIN FILE)) - (SETQ TABCOUNT (\BIN FILE)) + (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)) + (BIN FILE)) (0 'LEFT) (1 'RIGHT) (2 'CENTERED) @@ -1926,11 +1529,10 @@ (6 'DOTTEDCENTERED) (7 'DOTTEDDECIMAL) (SHOULDNT] - (OR (ZEROP DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* ; + (CL:UNLESS (ZEROP DEFTAB) + (RPLACA TABSPEC DEFTAB)) + (RPLACD TABSPEC TABS)) + (CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;  "There are other paragraph parameters to be read.") (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE)) (* ; @@ -1945,1432 +1547,914 @@ (replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)) (replace (FMTSPEC FMTHEADINGKEEP) of LOOKS with (\ARBIN FILE)) (replace (FMTSPEC FMTKEEP) of LOOKS with (\ARBIN FILE)) - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTBASETOBASE) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTREVISED) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCOLUMN) of LOOKS with (\ARBIN FILE] - (COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) - (replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE] - [COND - ((ILESSP (GETFILEPTR FILE) - (IPLUS FILEPOS LOOKSLEN)) (* ; + (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)) (* ;  "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] + (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#]) +) +(DEFINEQ + +(TEDIT.GET.OBJECT + [LAMBDA (TSTREAM PIECE FILE CURFILEBYTE# BYTELEN) (* ; "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") + (* ; "Edited 12-Oct-2022 14:10 by rmk") + (* ; "Edited 12-Jun-90 17:50 by mitani") + + (* ;; "Get an object from FILE") + + (* ;; "TSTREAM =TEXTOBJ are used for the error message and (possibly for default charlooks)") + + (* ;; "CURFILEBYTE# = fileptr within the text section of the file where the object's text starts. On entry the file is positioned just before the object's GETFN in the looks section of the file. On exit, the fileptr points just after the GETFN in the looks section, after having been detoured to the text section for the getfn to read the object's data.") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + FILEPTRSAVE GETFN OBJ) + + (* ;; "rrb 10-AUG-87 --- calculate the length of the image object's data. This assumes that the file is currently pointed at the end of the data which is where the GETFN is written {I think}.") + + (* ;; "RMK: Originally, BYTELEN was calculated here as (DIFFERENCE (GETFILEPTR FILE) CURFILEBYTE#). But this is garbage: (GETFILEPTR FILE) is in the looks section, CURFILEBYTE# is in the text section. The caller knows the true value, now passes it in. ") + + (SETQ GETFN (\ATMIN FILE)) (* ; + "The GETFN for this kind of IMAGEOBJ") + (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ; + "Save our file location thru the building of the object") + (SETFILEPTR FILE CURFILEBYTE#) + (SETQ OBJ (READIMAGEOBJ FILE GETFN NIL BYTELEN)) + (CL:WHEN (IMAGEOBJPROP OBJ 'UNKNOWNGETFN) (* ; + "If the object has an unknown getfn property, then it's an encapsulated object. Warn the user") + (TEDIT.PROMPTPRINT TSTREAM (CONCAT (CL:IF (GETD (IMAGEOBJPROP OBJ 'UNKNOWNGETFN)) + "Cannot read image object with GETFN " + "Image object with unknown GETFN ") + (IMAGEOBJPROP OBJ 'UNKNOWNGETFN)) + T)) + (SETFILEPTR FILE FILEPTRSAVE) + (SETPC PIECE PCONTENTS OBJ) + [FSETPC PIECE PLOOKS (COND + ((PREVPIECE PIECE) + (PLOOKS (PREVPIECE PIECE))) + (T (OR (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) + TEXTOBJ] + (FSETPC PIECE PTYPE (CL:IF (IMAGEOBJPROP OBJ 'SUBSTREAM) + SUBSTREAM.PTYPE + OBJECT.PTYPE)) + OBJ]) +) + + + +(* ;; "Putting (pageframe functions on TEDIT-PAGE)") + +(DEFINEQ + +(\TEDIT.PUT.PCTB + [LAMBDA (TEXTOBJ CHARSTREAM FORMATSTREAM CONTINUE KEEPSEPARATE) + (* ; "Edited 11-Mar-2024 00:33 by rmk") + (* ; "Edited 25-Jan-2024 00:00 by rmk") + (* ; "Edited 23-Jan-2024 13:43 by rmk") + (* ; "Edited 13-Jan-2024 19:57 by rmk") + (* ; "Edited 27-Sep-2023 23:50 by rmk") + (* ; "Edited 7-Sep-2023 23:43 by rmk") + (* ; "Edited 30-Apr-2021 14:46 by rmk:") + (* ; "Edited 19-May-99 21:58 by rmk:") + (* ; + "Edited 27-May-93 16:00 by sybalsky:mv:envos") + + (* ;; "Put a representation of a piece table as plaintext on CHARSTREAM, preserving font changes and paragraph looks in a binary FORMATSTREAM. If FORMATSTREAM is not a stream, a stream is created here. FORMATSTREAM=T if an unformatted stream is desired. In that case, the format stream, whether created here or passed in, is not appended to the end of CHARSTREAM") + + (* ;; "") + + (* ;; "The characters and objects in the pieces are put out in the plaintext CHARSTREAM. At the end of each sequence, when the byte positions are known, the hashed look-identifiers are put out to connect the looks back to the character sequences.") + + (* ;; "") + + (* ;; "If a sequence of pieces have equivalent piece properties (same character representation (fat, thin, utf-8 size) and looks) then the the characters of those pieces are concatenated and a single looks record is posted for the whole sequence. For example, a sequence of THINFILE THINSTRING THINFILE pieces may be collapsed if they have the same font, new, etc. (but objects always have individual pieces). Concatenation also stops at paralast sequences. ") + + (* ;; "") + + (* ;; "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")) + (CL:WHEN (EQ :UTF-8 (STREAMPROP CHARSTREAM 'FORMAT)) + (\TEDIT.PUT.UTF8.SPLITPIECES TEXTOBJ)) + (for PC PREVPC PFILE NEXTNEW RUNLEN PLEN (CURBYTE# _ 0) + (OLDBYTE# _ 0) + [UNFORMATTED? _ (PROG1 (EQ FORMATSTREAM T) + (CL:UNLESS (STREAMP FORMATSTREAM) + [SETQ FORMATSTREAM (OPENSTREAM '{NODIRCORE} 'BOTH 'NEW + `((LINELENGTH ,MAX.SMALLP]))] + (NEWPIECES _ (CL:WHEN CONTINUE (create PIECE))) + (PCCOUNT _ 0) + (EDITSTENTATIVE _ (GETTEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) + (LOOKSHASH _ (HASHARRAY 50)) + (PARAHASH _ (HASHARRAY 50)) + (*READTABLE* _ *TEDIT-FILE-READTABLE*) + (*PRINT-BASE* _ 10) + (EXTFORMAT _ (GETSTREAMPROP CHARSTREAM 'FORMAT)) + (EOLC _ (fetch (STREAM EOLCONVENTION) of CHARSTREAM)) + (NSHIFTBYTES _ 0) inpieces (\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) + + (* ;; "All the layout and looks information goes into the LOOKSTREAM, CHARSTREAM is essentally plaintext. Unless UNFORMATTED?, APPENDEDSTREAM is appended to the end of CHARSTREAM.") + + (* ;; "It seems that PCCOUNT isn't incremented for the PARA and CHARLOOKS lists, just for the page frame and the actual document pieces.") + + (CL:WHEN (FGETTOBJ TEXTOBJ TXTPAGEFRAMES) + (\TEDIT.PUT.PAGEFRAMES FORMATSTREAM (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) + (add PCCOUNT 1)) + (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ) + (\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; + "We can now use EQ tests on looks, and the lists may have been shortened.") + (\TEDIT.PUT.PARALOOKS.LIST FORMATSTREAM PARAHASH (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)) + (\TEDIT.PUT.CHARLOOKS.LIST FORMATSTREAM LOOKSHASH (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST)) + + (* ;; "The hash-tables map char and parlooks to unique id numbers") + + (* ;; "") + + (* ;; " We're ready to put the pieces on the output file. ") + + (SETQ CURBYTE# (\GETFILEPTR CHARSTREAM)) + (SETQ OLDBYTE# CURBYTE#) + (SETQ NSHIFTBYTES (CL:WHEN (\FIRSTPIECE TEXTOBJ)(* ; + "Set up for first piece, possibly hiding shifts.") + (CHARSET CHARSTREAM (CL:IF (THINPIECEP (\FIRSTPIECE TEXTOBJ)) + 0 + T)) + (IDIFFERENCE (\GETFILEPTR CHARSTREAM) + CURBYTE#))) + + (* ;; "ZEROP should never happen, but...") + unless (ZEROP (SETQ PLEN (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. ") + + (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") + (\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.") + + [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) + + (* ;; "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.") + + (BOUT FORMATSTREAM 0) + + (* ;; "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#) + (* ; + "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)) + + (* ;; "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))) + + (* ;; "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.") + + (RETURN (AND NEWPIECES (NEXTPIECE NEWPIECES]) + +(\TEDIT.PUT.TRAILER + [LAMBDA (FORMATSTREAM PIECESTART PCCOUNT VERSION) (* ; "Edited 13-Jan-2024 10:13 by rmk") + + (* ;; "Finalize FORMATSTREAM. We sneak in the date here--at the end of the looks, after the last look but before the final pointers, so that it doesn't interfere with anything. TEDIT.FILEDATE pulls it out if it's there.") + + (PRIN1 "DATE:" FORMATSTREAM) + (\DWOUT FORMATSTREAM (IDATE)) + (\DWOUT FORMATSTREAM PIECESTART) (* ; "Position of the first piece") + (\WOUT FORMATSTREAM PCCOUNT) (* ; + "Number of pieces followed by the password") + (\WOUT FORMATSTREAM (IPLUS 31415 VERSION]) + +(\TEDIT.PUT.PCTB.MERGEABLE + [LAMBDA (PREVPC PC EDITSTENTATIVE EXTFORMAT TEXTOBJ) (* ; "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") + + (* ;; "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.") + + (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] + + (* ;; "PC cannot merge with PREVPC if PREVPC ends in EOL (even if not PPARALAST). (We assume here that EOL's of interest appear only in last-of-piece position.) For some input piece types we can make the decision without bothering to look at their last character. If the destination EXTFORMAT is :UTF-8, the splitter has presumably arranged it so that EOL's only appear in thin string and file pieces.") + + [AND (SELECTQ EXTFORMAT + (:XCCS + (* ;; "All thin strings and files are mergeable, all fat pieces are mergeable, since they all go to FAT2. ") + + (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])]) + +(\TEDIT.PUT.UTF8.SPLITPIECES + [LAMBDA (TEXTOBJ) (* ; "Edited 3-Feb-2024 14:52 by rmk") + (* ; "Edited 11-Jan-2024 23:29 by rmk") + (* ; "Edited 5-Jan-2024 11:37 by rmk") + (* ; "Edited 30-Dec-2023 11:27 by rmk") + + (* ;; "We are putting to a UTF-8 format file. This function splits pieces if necessary to ensure that all the characters in a piece map to Unicode characters with the same-length UTF8 encoding. That length is stored in PUTF8BYTESPERCHAR.") + + (for PC inpieces (\FIRSTPIECE TEXTOBJ) + do (SELECTC (PTYPE PC) + (UTF8.PTYPE (FSETPC PC PUTF8BYTESPERCHAR (PBYTESPERCHAR PC))) + (STRING.PTYPES (for CH BPC instring (PCONTENTS PC) as I from 1 + do + + (* ;; "If BPC changes, split off and mark the prefix piece with the previous value, go back to the main loop to continue on the residual suffix piece.") + + (if (EQ I 1) + then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH + *XCCSTOUNICODE*))) + (FSETPC PC PUTF8BYTESPERCHAR BPC) + (* ; + "The first character defines the piece") + elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH + *XCCSTOUNICODE*))) + else (\SPLITPIECE PC (SUB1 I) + TEXTOBJ) + (SETQ PC (PREVPIECE PC)) + (* ; + "Prefix piece always exists since I>1") + (FSETPC PC PUTF8BYTESPERCHAR BPC) + (* ; + "Mark it, iteration continues on its next.") + (RETURN)))) + (THINFILE.PTYPE + (CL:UNLESS (EQ :UTF-8 (GETSTREAMPROP (PCONTENTS PC) + 'FORMAT)) (* ; "Could be above Ascii") + (for I BPC (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC) + first (\SETFILEPTR PFILE (PFPOS PC)) + do (if (EQ I 1) + then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE) + *XCCSTOUNICODE*))) + (FSETPC PC PUTF8BYTESPERCHAR BPC) + elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE (BIN PFILE) + *XCCSTOUNICODE*))) + else (\SPLITPIECE PC (SUB1 I) + TEXTOBJ) + (SETQ PC (PREVPIECE PC)) + (FSETPC PC PUTF8BYTESPERCHAR BPC) + (RETURN))))) + ((LIST FATFILE2.PTYPE FATFILE1.PTYPE) (* ; "XCCS pieces") + (for I BPC CH (PFILE _ (PCONTENTS PC)) from 1 to (PLEN PC) + first (\SETFILEPTR PFILE (PFPOS PC)) + do (SETQ CH (LOGOR (LLSH (CL:IF (EQ FATFILE2.PTYPE (PTYPE PC)) + (BIN PFILE) + (PCHARSET PC)) + 8) + (BIN PFILE))) + (if (EQ I 1) + then (SETQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*)) + ) + (FSETPC PC PUTF8BYTESPERCHAR BPC) + elseif (EQ BPC (NUTF8-CODE-BYTES (UNICODE.TRANSLATE CH *XCCSTOUNICODE*))) + else (\SPLITPIECE PC (SUB1 I) + TEXTOBJ) + (SETQ PC (PREVPIECE PC)) + (FSETPC PC PUTF8BYTESPERCHAR BPC) + (RETURN)))) + NIL]) + +(\TEDIT.PUT.PCTB.NEXTNEW + [LAMBDA (NEXTNEW PREVPC OLDBYTE# RUNLEN EXTFORMAT TEXTOBJ EOLC NSHIFTBYTES) + (* ; "Edited 24-Jan-2024 23:29 by rmk") + (* ; "Edited 23-Jan-2024 15:24 by rmk") + (* ; "Edited 21-Jan-2024 10:34 by rmk") + (* ; "Edited 12-Jan-2024 16:24 by rmk") + (* ; "Edited 5-Jan-2024 17:46 by rmk") + (* ; "Edited 30-Dec-2023 21:56 by rmk") + + (* ;; "This updates the piece chain 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.") + + (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 + ))) + (SELECTQ EXTFORMAT + (:UTF-8 (FSETPC NEXTNEW PTYPE (CL:IF (EQ 1 (FGETPC PREVPC PUTF8BYTESPERCHAR)) + THINFILE.PTYPE + UTF8.PTYPE)) + (FSETPC NEXTNEW PBYTESPERCHAR (FGETPC PREVPC PUTF8BYTESPERCHAR))) + (:XCCS (* ; + "String pieces can be merged with corresponding file pieces") + (FSETPC NEXTNEW PTYPE (SELECTC (PTYPE PREVPC) + (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))) + (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] + (if (EQ 1 (PLEN NEXTNEW)) + then (FSETPC NEXTNEW PTYPE THINSTRING.PTYPE) + (FSETPC NEXTNEW PCONTENTS (ALLOCSTRING 1 (CHARCODE EOL))) + else (add (FGETPC NEXTNEW PLEN) + -1) (* ; "We know it's thin, maybe paralast") + (add (FGETPC NEXTNEW PBYTELEN) + -1) + (SETQ NEXTNEW (\TEDIT.MAKE.STRINGPIECE NEXTNEW (CHARCODE EOL))) + (FSETPC (PREVPIECE NEXTNEW) + PPARALAST NIL)))) + NEXTNEW]) + +(\TEDIT.INSERT.NEWPIECES + [LAMBDA (STREAM TEXTOBJ NEWPIECES) (* ; "Edited 5-Feb-2024 09:24 by rmk") + (* ; "Edited 3-Feb-2024 23:59 by rmk") + (* ; "Edited 21-Jan-2024 09:21 by rmk") + (* ; "Edited 12-Jan-2024 21:06 by rmk") + (* ; "Edited 18-Dec-2023 17:00 by rmk") + (* ; "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.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + + (* ;; "The \SETFILEPTR translates TSTREAM's buffer parameters to the new file. ") + + (LET ((TSTREAM (GETTOBJ TEXTOBJ STREAMHINT)) + FILEPTR) + (SETQ FILEPTR (\TEXTGETFILEPTR TSTREAM)) (* ; "Restore the editing parameters") + (for PC (SBINABLE _ (fetch (STREAM BINABLE) of STREAM)) inpieces NEWPIECES + when (MEMB (PTYPE PC) + FILE.PTYPES) do (FSETPC PC PCONTENTS STREAM) + (CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC)) + (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)") + + (\MAKEPCTB TEXTOBJ) + (\INSERTPIECES NEWPIECES NIL TEXTOBJ) (* ; + "Build the tree, then fix the stream") + + (* ;; "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.") + + (\TEXTSETFILEPTR TSTREAM (IMAX 0 (IMIN FILEPTR (FGETTOBJ TEXTOBJ TEXTLEN]) + +(\TEDIT.PUTRESET + [LAMBDA (PROC&VALUE) (* jds "15-May-85 16:38") + (CONS (CAR PROC&VALUE) + (PROCESSPROP (CAR PROC&VALUE) + 'BEFOREEXIT + (CDR PROC&VALUE]) + +(\ARBOUT + [LAMBDA (STREAM ITEM) (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* ; "Edited 7-Sep-2023 09:06 by rmk") + (* ; "Edited 20-Apr-88 19:55 by jds") + + (* ;; "Write an arbitrary MKSTRING-able thing in length-contents form. SIZE is in characters, not bytes, which is OK because \STRINGIN uses READCCODE.") + + (LET [(SIZE (AND ITEM (NCHARS ITEM T *TEDIT-FILE-READTABLE*] + (\WOUT STREAM (OR SIZE 0)) + (OR (NOT ITEM) + (ZEROP SIZE) + (PRIN2 ITEM STREAM *TEDIT-FILE-READTABLE*)) + NIL]) + +(\ATMOUT + [LAMBDA (STREAM ATOM) (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* jds "30-Jan-85 14:46") + (* Write an atom's characters in + length-contents form.) + (\WOUT STREAM (COND + (ATOM (NCHARS ATOM)) + (T 0))) + (OR (NOT ATOM) + (ZEROP (NCHARS ATOM)) + (for CH inatom ATOM do (\BOUT STREAM CH]) + +(\DWOUT + [LAMBDA (FILE NUMBER) (* jds " 3-JAN-83 15:30") + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 24))) + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 16))) + (\BOUT FILE (LOGAND 255 (LRSH NUMBER 8))) + (\BOUT FILE (LOGAND 255 NUMBER]) + +(\STRINGOUT + [LAMBDA (STREAM STRING LEN) (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* jds " 1-May-84 11:58") + + (* Write a string on a file in length-contents form; + one word for the length, and one byte per character contained.) + + (SETQ LEN (OR LEN (NCHARS STRING))) + (\WOUT STREAM LEN) + (OR (ZEROP LEN) + (for CH instring STRING as I from 1 to LEN do (\BOUT STREAM CH]) +) +(DEFINEQ + +(\TEDIT.PUT.CHARLOOKS.LIST + [LAMBDA (LOOKSFILE LOOKSHASH LOOKSLIST LOOKSHASH) (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* ; "Edited 25-Aug-2023 11:39 by rmk") + (* ; "Edited 15-Aug-2023 23:08 by rmk") + (* jds " 5-Mar-85 15:58") + (* ; + "Write the list of CHARLOOKSs into the font file.") + + (* ;; "Returns a hasharray that will map from a given CHARLOOKS to its index in the list. Those position numbers are then written in the individual piece descriptions, and are used to reconstruct the piece looks when the file is read back in. These descriptions are written in a 0-character pseudo-piece") + + (\DWOUT LOOKSFILE 0) (* ; + "No characters, marked as containing the list of CHARLOOKSs") + (\WOUT LOOKSFILE \PieceDescriptorCHARLOOKSLIST) + (\WOUT LOOKSFILE (FLENGTH LOOKSLIST)) (* ; "Number of charlooks to follow") + (for I from 1 as LOOKS in LOOKSLIST do + (* ;; + "Write each charlooks, in the order they appear in the list.") + + (\TEDIT.PUT.SINGLE.CHARLOOKS LOOKSFILE LOOKS) + (PUTHASH LOOKS I LOOKSHASH]) + +(\TEDIT.PUT.SINGLE.CHARLOOKS + [LAMBDA (FORMATSTREAM LOOKS) (* ; "Edited 16-Jan-2024 23:07 by rmk") + (* ; "Edited 21-Dec-2023 23:54 by rmk") + (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* ; "Edited 26-Aug-2023 11:29 by rmk") + (* ; "Edited 15-Aug-2023 23:17 by rmk") + (* ; "Edited 30-May-91 20:26 by jds") + + (* ;; "Put out a single CHARLOOKS description.") + + (LET ((FILEPOS (GETFILEPTR FORMATSTREAM)) + (FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) + LEN) + (\WOUT FORMATSTREAM 0) (* ; + "Reserve space for the length of this looks") + [COND + ((type? FONTCLASS FONT) (* ; + "For font classes, we need to save a list of device-FD sets") + (\ARBOUT FORMATSTREAM (FONTCLASSUNPARSE FONT))) + (T (* ; + "For FONTDESCRIPTORs, do it the easy way") + (\ATMOUT FORMATSTREAM (FONTPROP FONT 'FAMILY] (* ; "The font family") + (\WOUT FORMATSTREAM (OR (FONTPROP FONT 'SIZE) + 0)) (* ; "Size of the type, in points") + (\SMALLPOUT FORMATSTREAM (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0)) (* ; "Super/subscripting distance") + (COND + ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) + (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] + (\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLSTYLE) of LOOKS))) + (T (\WOUT FORMATSTREAM 0))) + (COND + ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) + (\ARBOUT FORMATSTREAM (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) + (T (\WOUT FORMATSTREAM 0))) + (\WOUT FORMATSTREAM (LOGOR (CL:IF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS) + 4096 + 0) + (CL:IF (fetch (CHARLOOKS CLLEADER) of LOOKS) + 2048 + 0) + (CL:IF (fetch (CHARLOOKS CLINVERTED) of LOOKS) + 1024 + 0) + (CL:IF (fetch (CHARLOOKS CLBOLD) of LOOKS) + 512 + 0) + (CL:IF (fetch (CHARLOOKS CLITAL) of LOOKS) + 256 + 0) + (CL:IF (fetch (CHARLOOKS CLULINE) of LOOKS) + 128 + 0) + (CL:IF (fetch (CHARLOOKS CLOLINE) of LOOKS) + 64 + 0) + (CL:IF (fetch (CHARLOOKS CLSTRIKE) of LOOKS) + 32 + 0) + (CL:IF (fetch (CHARLOOKS CLSMALLCAP) of LOOKS) + 16 + 0) + (CL:IF (fetch (CHARLOOKS CLPROTECTED) of LOOKS) + 8 + 0) + (CL:IF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS) + 4 + 0) + (CL:IF (fetch (CHARLOOKS CLSELHERE) of LOOKS) + 2 + 0) + (CL:IF (fetch (CHARLOOKS CLCANCOPY) of LOOKS) + 1 + 0))) + + (* ;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)") + + (SETQ LEN (IDIFFERENCE (GETFILEPTR FORMATSTREAM) + FILEPOS)) (* ; "The length of this set of looks") + (SETFILEPTR FORMATSTREAM FILEPOS) (* ; "Go write the length field") + (\WOUT FORMATSTREAM LEN) (* ; "And back to the end of the file") + (SETFILEPTR FORMATSTREAM -1]) + +(\TEDIT.PUT.CHARLOOKS + [LAMBDA (FORMATSTREAM BYTELEN PREVPC EDITSTENTATIVE LOOKSHARRAY) + (* ; "Edited 13-Jan-2024 16:35 by rmk") + (* ; "Edited 30-Dec-2023 16:25 by rmk") + (* ; "Edited 23-Aug-2023 22:27 by rmk") + (* ; "Edited 24-Jul-2023 17:21 by rmk") + (* ; "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") + + (\DTEST PREVPC 'PIECE) + (\TEDIT.PUT.CHARLOOKS1 FORMATSTREAM BYTELEN (GETHASH (PLOOKS PREVPC) + LOOKSHARRAY) + (AND EDITSTENTATIVE PREVPC (PNEW PREVPC)) + (EQ FATFILE2.PTYPE (PTYPE PREVPC]) + +(\TEDIT.PUT.CHARLOOKS1 + [LAMBDA (FORMATSTREAM BYTELEN CHARLOOKSINDEX NEW FAT) (* ; "Edited 13-Jan-2024 16:36 by rmk") + + (* ;; "Put out the actual bytes to represent a piece with the indicated properties. This is split out as a separate helper function to hide Tedit innards from Lafite when it makes its dummy piece entries (LA.ADJUST.FORMATTING).") + + (\DWOUT FORMATSTREAM BYTELEN) (* ; "The length of this piece run") + (\WOUT FORMATSTREAM \PieceDescriptorLOOKS) (* ; + "Mark this as setting the piece's looks") + + (* ;; "Flag for newness and fatness") + + (\BOUT FORMATSTREAM (LOGOR (CL:IF NEW + 1 + 0) + (CL:IF FAT + 2 + 0))) (* ; "The index into the list of fonts") + (\WOUT FORMATSTREAM CHARLOOKSINDEX]) +) +(DEFINEQ + (\TEDIT.PUT.PARALOOKS.LIST - [LAMBDA (FILE LOOKSLIST) (* ; "Edited 1-Sep-87 20:34 by jds") - (* ; - "Write the list of FMTSPECs into the font file.") - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) - (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) - (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS FILE LOOKS) - (* ; "Write out the description") - (PUTHASH LOOKS I LOOKSHASH) - (* ; - "And save it in the hash table so people can find its index.") - ) - (RETURN LOOKSHASH]) + [LAMBDA (LOOKSFILE PARAHASH PARALOOKS) (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* ; "Edited 25-Aug-2023 11:39 by rmk") + (* ; "Edited 15-Aug-2023 23:25 by rmk") + (* ; "Edited 1-Sep-87 20:34 by jds") + + (* ;; "Write out the looks in a no-characters pseudo-piece, producing a hashtable of their arbitrary indexes for future reference.") + + (\DWOUT LOOKSFILE 0) + (\WOUT LOOKSFILE \PieceDescriptorPARALOOKSLIST) + (\WOUT LOOKSFILE (FLENGTH PARALOOKS)) + (for I from 1 as PL in PARALOOKS do (\TEDIT.PUT.SINGLE.PARALOOKS LOOKSFILE PL) + (PUTHASH PL I PARAHASH]) (\TEDIT.PUT.SINGLE.PARALOOKS - [LAMBDA (FILE LOOKS) (* ; + [LAMBDA (FONTFILE LOOKS) (* ; "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") + (* ;  "Edited 2-Jul-93 21:30 by sybalskY:MV:ENVOS") (* ;; "Put a description of LOOKS into FILE.") - (PROG ((FILEPOS (GETFILEPTR FILE)) - DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) - (\SMALLPOUT FILE 0) (* ; - "Reserve space for the length of this looks") - (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) + (LET ((FILEPOS (GETFILEPTR FONTFILE)) + DEFTAB TABSPECS LEN) + (\SMALLPOUT FONTFILE 0) (* ; + "Reserve space to store the look length") + (\SMALLPOUT FONTFILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) (* ;  "Left margin for the first line of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) + (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) (* ;  "Left margin for the rest of the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) + (\SMALLPOUT FONTFILE (fetch (FMTSPEC RIGHTMAR) of LOOKS)) (* ; "Right margin for the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) + (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEADBEFORE) of LOOKS)) (* ; "Leading before the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) + (\SMALLPOUT FONTFILE (fetch (FMTSPEC LEADAFTER) of LOOKS)) (* ; "Lead after the paragraph") - (\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS)) + (\SMALLPOUT FONTFILE (fetch (FMTSPEC LINELEAD) of LOOKS)) (* ; "inter-line leading") - (SETQ DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (COND - ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) - (OR DEFAULTTAB TABSPECS)) (* ; - "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) - (LEFT 1) - (RIGHT 2) - ((CENTER CENTERED) - 3) - ((JUST JUSTIFIED) - 4) - (SHOULDNT))) - [COND - ((OR TABSPECS DEFAULTTAB) (* ; "There are tab specs to save.") - (COND - (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) - (T (\SMALLPOUT FILE 0))) - (COND - ((IGREATERP (LENGTH TABSPECS) - 255) - (SHOULDNT "Paragraph has more than 255 TABs set--can't be saved."))) - (\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) - (DOTTEDLEFT 4) - (DOTTEDRIGHT 5) - (DOTTEDCENTERED - 6) - (DOTTEDDECIMAL 7) - (SHOULDNT))) - (* ; "Tab type")] - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS) - 0)) - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) - 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 (fetch (FMTSPEC FMTHEADINGKEEP) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTKEEP) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTBASETOBASE) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTREVISED) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCOLUMN) of LOOKS)) - (\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS)) + (SETQ DEFTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) + (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) + + (* ;; "Indicate whether there are tab specs or a default tab setting to save") + + (\BOUT FONTFILE (CL:IF (OR DEFTAB TABSPECS) + 3 + 2)) + (\BOUT FONTFILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS) + (LEFT 1) + (RIGHT 2) + ((CENTER CENTERED) + 3) + ((JUST JUSTIFIED) + 4) + (SHOULDNT))) + (CL:WHEN (OR TABSPECS DEFTAB) (* ; "There are tab specs to save.") + (\SMALLPOUT FONTFILE (OR DEFTAB 0)) + (CL:WHEN (IGREATERP (LENGTH TABSPECS) + 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)) + (* ; "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) + 0)) + (\SMALLPOUT FONTFILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + 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)) (* ;;; "Now go fill in the length field at the front of the LOOKS. (ALL looks info should be written out BEFORE this comment.)") - (SETQ LEN (IDIFFERENCE (GETFILEPTR FILE) - FILEPOS)) (* ; "The length of this set of looks") - (SETFILEPTR FILE FILEPOS) (* ; "Go write the length field") - (\SMALLPOUT FILE LEN) - (SETFILEPTR FILE -1) (* ; "And back to the end of the file") - ]) + (SETQ LEN (IDIFFERENCE (GETFILEPTR FONTFILE) + FILEPOS)) (* ; "The length of this set of looks") + (SETFILEPTR FONTFILE FILEPOS) (* ; "Write the length field") + (\SMALLPOUT FONTFILE LEN) (* ; "And back to the end of the file") + (SETFILEPTR FONTFILE -1]) + +(\TEDIT.PUT.PARALOOKS + [LAMBDA (LOOKSFILE PC PARAHASH) (* ; "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") + + (* ;; + "Put the identifier of PC's paralooks into LOOKSFILE. This applies to characters CH1 thru CHLIM-1") + + (\DWOUT LOOKSFILE 0) (* ; + "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]) +) +(DEFINEQ + +(TEDIT.PUT.OBJECT + [LAMBDA (PIECE CHARSTREAM FORMATSTREAM CURFILEBYTE#) (* ; "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") + (* ; "Edited 17-Jul-2023 16:39 by rmk") + (* ; "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.") + + (LET ((OBJECT (PCONTENTS PIECE)) + (ORIGFILEPTR (GETFILEPTR FORMATSTREAM)) + BYTELEN) + (\DWOUT FORMATSTREAM 0) (* ; + "Placeholder for byte-length of the object's description") + (\WOUT FORMATSTREAM \PieceDescriptorOBJECT) (* ; + "Mark this as setting the piece's looks") + (\ATMOUT FORMATSTREAM (IMAGEOBJPROP OBJECT 'GETFN)) (* ; + "The FN to apply to reconstruct the object") + (APPLY* (IMAGEOBJPROP OBJECT 'PUTFN) + OBJECT CHARSTREAM) + (SETQ BYTELEN (IDIFFERENCE (GETEOFPTR CHARSTREAM) + CURFILEBYTE#)) + (SETFILEPTR FORMATSTREAM ORIGFILEPTR) (* ; + "Now go back and fill in the length of the text description of the object.") + (\DWOUT FORMATSTREAM BYTELEN) + (SETFILEPTR FORMATSTREAM -1) (* ; + "Move back to the end of the looks file") + (CL:WHEN (RANDACCESSP CHARSTREAM) (* ; "And the end of CHARSTREAM") + (SETFILEPTR CHARSTREAM -1)) + BYTELEN]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.INPUT.FORMATS *TEDIT-FILE-READTABLE*) ) +(DEFINEQ -(RPAQ? TEDIT.INPUT.FORMATS NIL) +(TEDITFROMLISPSOURCE + [LAMBDA (SOURCEFILE TSTREAM PROPS USERTEMP START END) (* ; "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") + (* ; "Edited 22-Sep-2023 09:07 by rmk") + + (* ;; "This is called because OPENTEXTSTREAM recognized that SOURCESTREAM is a LISPSOURCEP foreign-format file. TSTREAM may have a partially instantiated attached window with region and prompt, etc., but may not yet have the properties of a text or process.") + + (* ;; + "TSTREAM and its window are available to provide default looks and region for the empty stream") + + (* ;; "USERTEMP is the reader environment returned by LISPSOURCEFILEP") + + (CL:UNLESS TSTREAM + (SETQ TSTREAM (OPENTEXTSTREAM))) + + (* ;; "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") + + (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))) + TSTREAM]) +) + +(ADDTOVAR TEDIT.INPUT.FORMATS (LISPSOURCEFILEP TEDITFROMLISPSOURCE)) (RPAQ? *TEDIT-FILE-READTABLE* (COPYREADTABLE \ORIGREADTABLE)) - - - -(* ;; "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") - -(DEFINEQ - -(TEDIT.BUILD.PCTB2 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 20-Jul-2022 11:22 by rmk") - (* ; "Edited 19-Jul-2022 08:45 by rmk") - (* ; "Edited 4-May-93 16:27 by jds") - - (* ;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (* ;; "START = 1st char of file to read from, if specified") - - (* ;; "END = use this as eofptr of file. For use in reading files within files.") - - (LET (PIECEINFOCH# (CURFILECH# (OR START 0)) - LOOKSHASH PARAHASH (PCTB (\MAKEPCTB NIL PCCOUNT))) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind PC TYPECODE PCLEN (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from - \FirstPieceOffset - by \EltsPerPiece - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - (SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with ( - TEDIT.GET.PAGEFRAMES - TEXT))) - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add PCN (IMINUS \EltsPerPiece))) - (\PieceDescriptorCHARLOOKSLIST (* ; - "This is the list of CHARLOOKSs used in this document.") - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.CHARLOOKS.LIST2 - TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ LOOKSHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) - do (SETA LOOKSHASH I LOOKS)) - (add PCN (IMINUS \EltsPerPiece)) (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARALOOKSLIST (* ; - "This is the list of PARALOOKSs used in this document.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with ( - \TEDIT.GET.PARALOOKS.LIST2 - TEXT)) - (* ; - "Read the list of looks used in this document.") - [SETQ PARAHASH (ARRAY (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ] - (* ; - "Build an array of the looks, so the reader can index them.") - (for I from 1 as LOOKS in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - do (SETA PARAHASH I LOOKS)) - (add PCN (IMINUS \EltsPerPiece)) (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add I -1)) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS TEXT PARAHASH)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) - (* ; - "Mark the document as containing paragraph formatting info") - (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - (add PCN (IMINUS \EltsPerPiece))) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") - (\TEDIT.GET.CHARLOOKS PC TEXT LOOKSHASH OLDPC) - (* ; - "Read the character looks for this guy.") - (COND - [OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC) - (COND - ((AND (fetch (PIECE PFATP) of PC) - (NOT (fetch (PIECE PFATP) of OLDPC))) - (* ; - "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") - (add (fetch (PIECE PFPOS) of PC) - 3) - (add CURFILECH# -3)) - ((AND (fetch (PIECE PFATP) of OLDPC) - (NOT (fetch (PIECE PFATP) of PC))) - (* ; - "Switching from fat to not-fat. Add 3 bytes for the 255-0") - (add (fetch (PIECE PFPOS) of PC) - 2] - ((fetch (PIECE PFATP) of PC) (* ; - "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") - (add (fetch (PIECE PFPOS) of PC) - 3) - (add CURFILECH# -3))) (* ; - "And note the passing of characters.") - (add CURFILECH# PCLEN)) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (COND - (OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC))) - (TEDIT.GET.OBJECT (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (replace (PIECE PLOOKS) of PC with (\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT))) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS) - of OLDPC)) - DEFAULTLOOKS] - (* ; - "OBJECTs are officially one character long.") - (replace (PIECE PLEN) of PC with 1)) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (CL:WHEN PC (* ; - "If we created a piece, save it in the table.") - (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (SETQ OLDPC PC))) - PCTB]) - -(\TEDIT.GET.CHARLOOKS.LIST2 - [LAMBDA (FILE) (* jds "22-May-85 14:28") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE]) - -(\TEDIT.GET.SINGLE.CHARLOOKS2 - [LAMBDA (FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Read a set of CHARLOOKS from FILE) - (PROG* ((LOOKS (create CHARLOOKS)) - FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] - [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] - [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - [replace (CHARLOOKS CLFONT) of LOOKS with (COND - ((LISTP NAME) - (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (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] - (RETURN LOOKS]) - -(\TEDIT.PUT.SINGLE.PARALOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:33 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (PROG (DEFAULTTAB TABSPECS OUTPUTFORMAT LEN) - (\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS)) - (* Left margin for the first line of - the paragraph) - (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) - (* 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 DEFAULTTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS))) - (COND - ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) - (OR DEFAULTTAB TABSPECS)) - - (* 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) - (LEFT 1) - (RIGHT 2) - ((CENTER CENTERED) - 3) - ((JUST JUSTIFIED) - 4) - (SHOULDNT))) - [COND - ((OR TABSPECS DEFAULTTAB) (* There are tab specs to save.) - (COND - (DEFAULTTAB (\SMALLPOUT FILE DEFAULTTAB)) - (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) - 0)) - (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) - 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]) - -(\TEDIT.PUT.SINGLE.CHARLOOKS2 - [LAMBDA (FILE LOOKS) (* ; "Edited 30-May-91 20:26 by jds") - (* Put out a single CHARLOOKS - description.) - (PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) - STR LEN) - [COND - ((type? FONTCLASS FONT) (* For font classes, we need to save a - list of device-FD sets) - (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) - (T (* For FONTDESCRIPTORs, do it the easy - way) - (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* The font family) - (\SMALLPOUT FILE (OR (FONTPROP FONT 'SIZE) - 0)) (* Size of the type, in points) - (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) (* Super/subscripting distance) - (COND - ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) - (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] - (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (COND - ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) - (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) - (T (\SMALLPOUT FILE 0))) - (\SMALLPOUT FILE (LOGOR (COND - ((fetch (CHARLOOKS CLLEADER) of LOOKS) - (* Dotted-leader; relevant only to - TABs) - 2048) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS) - (* Inverse-video) - 1024) - (T 0)) - (COND - ((fetch (CHARLOOKS CLBOLD) of LOOKS) - 512) - (T 0)) - (COND - ((fetch (CHARLOOKS CLITAL) of LOOKS) - 256) - (T 0)) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - 128) - (T 0)) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - 64) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) - 32) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) - 16) - (T 0)) - (COND - ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) - 8) - (T 0)) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) - NIL 4) - (T 0)) - (COND - ((fetch (CHARLOOKS CLSELHERE) of LOOKS) - 2) - (T 0)) - (COND - ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) - 1) - (T 0]) - -(\TEDIT.GET.PARALOOKS.LIST2 - [LAMBDA (FILE) (* jds "22-May-85 14:28") - (* Read the list of CHARLOOKSs from - the file.) - (for I from 1 to (\SMALLPIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE]) - -(\TEDIT.GET.SINGLE.PARALOOKS2 - [LAMBDA (FILE) (* ; "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 DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\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 NIL 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 DEFAULTTAB (\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 DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph - parameters to be read.) - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\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]) - -(TEDIT.PUT.PCTB2 - [LAMBDA (TEXTOBJ OFILE UNFORMATTED? SEPARATEFORMAT) (* ; "Edited 11-Jun-99 15:03 by rmk:") - (* ; "Edited 11-Jun-99 15:03 by rmk:") - (* ; "Edited 11-Jun-99 14:31 by rmk:") - (* ; "Edited 11-Jun-99 14:29 by rmk:") - (* ; "Edited 30-May-91 20:24 by jds") - - (* ;; "Put a representation of the piece table onto OFILE, preserving font changes and paragraph looks. UNFORMATTED? means write no font or formatting info.") - - (PROG (OCURSOR CH PC PFILE PSTR POBJ OFILELEN OLDLOOKS (OLDPARALOOKS (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - OLDCH# CURCH# PREVPC (FONTFILE NIL) - (PCCOUNT 0) - TRUEFILE CHARLOOKSLST PARALOOKSLST (TEDIT.PUT.FINISHEDFORMS NIL) - (EDITSTENTATIVE (TEXTPROP TEXTOBJ 'TEDIT.TENTATIVE)) - (PARALOOKSSEEN NIL) - (FORMATTINGLEVEL (TEDIT.FORMATTEDFILEP TEXTOBJ)) - (CACHE (TEXTPROP TEXTOBJ 'CACHE)) - CH#S PREVFATP PREVPREVPC LOOKSHASH PARAHASH) - (SETQ PC (\EDITELT (fetch (TEXTOBJ PCTB) of TEXTOBJ) - (ADD1 \FirstPieceOffset))) (* ; "First piece in the document") - (SETQ OLDLOOKS (OR (AND (type? PIECE PC) - (fetch (PIECE PLOOKS) of PC)) - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - TEDIT.DEFAULT.CHARLOOKS)) (* ; "Starting looks") - (COND - ((NEQ (fetch (STREAM EOLCONVENTION) of OFILE) - CR.EOLC) (* ; - "This file is on a non-CR host; make a note to cache it") - (SETQ TRUEFILE OFILE) (* ; - "Remember where the file should wind up.") - [SETQ OFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "And open a temp file to write it to.") - )) - [SETQ CURCH# (SETQ OLDCH# (ADD1 (GETFILEPTR OFILE] - (COND - ((fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) (* ; - "There is layout info for this file. Save it") - [SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (TEDIT.PUT.PAGEFRAMES FONTFILE (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ)) - (add PCCOUNT 1))) - (\TEDIT.FLUSH.UNUSED.LOOKS TEXTOBJ PC) (* ; - "Run thru the lists of char & para looks and remove any that aren't in use") - (COND - ([AND (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - (OR (IGREATERP (FLENGTH (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - 1) - (NOT (EQFMTSPEC (CAR (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ)) - TEDIT.DEFAULT.FMTSPEC] - - (* ;; "There are paragraph looks in this document that don't match the default -- save the list of them for later retrieval.") - - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (* ; - "Create the font-info file if it doesn't exist yet") - (SETQ PARAHASH (\TEDIT.PUT.PARALOOKS.LIST2 FONTFILE (fetch (TEXTOBJ TXTPARALOOKSLIST) - of TEXTOBJ))) - (SETQ PARALOOKSSEEN T))) - [COND - ((OR PARALOOKSSEEN FORMATTINGLEVEL) - - (* ;; "There are character looks in this document that don't match the default (or paragraph formatting, which forces looks to be saved) -- save the list for later retrieval.") - - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW '((TYPE TEXT] - (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST2 FONTFILE (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - [while PC do (COND - ([AND (NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (OR PARALOOKSSEEN (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) - of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; - "The last piece ended a paragraph, so send out new para looks") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW - '((TYPE TEXT] - (* ; - "Create the formatting-info file, if it didn't exist before.") - (COND - ((NEQ CURCH# OLDCH#) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) - (\TEDIT.PUT.PARALOOKS FONTFILE PC PARAHASH) - (SETQ PARALOOKSSEEN T) (* ; - "Remember that we've seen a foreign paralooks, and must henceforth note para boundaries") - (add PCCOUNT 1))) - (COND - [(fetch (PIECE POBJ) of PC) (* ; - "It's an object -- go use its PUTFN") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH 'NEW - '((TYPE TEXT] - (* ; - "Create the font-info file, if need be.") - (COND - ((AND (NEQ CURCH# OLDCH#) - PREVPC) (* ; - "There were prior characters that hadn't been described in a piece yet. Describe them") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) (* ; - "And now we've described all the characters up to the current one.") - )) (* ; - "If the prior thing was text, send along its descriptor.") - (add CURCH# (TEDIT.PUT.OBJECT PC OFILE FONTFILE CURCH#)) - (* ; "Send out the object") - (add PCCOUNT 1) - (SETQ OLDCH# CURCH#) - (COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; - "The OBJECT has different ooks from before") - (\BOUT FONTFILE 1) - (\TEDIT.PUT.SINGLE.CHARLOOKS FONTFILE (fetch (PIECE PLOOKS) - of PC)) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (T (* ; - "No differences. Don't write any charlooks, and mark that fact") - (\BOUT FONTFILE 0) (* ; - "MAKE BLOODY SURE THAT THE NEXT RUN OF CHARACTERS GETS ITS OWN LOOKS") - ] - (T (* ; "It's not an object.") - [COND - ([OR (NOT (EQCLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC))) - (NEQ (fetch (PIECE PFATP) of PC) - (AND PREVPC (fetch (PIECE PFATP) of PREVPC))) - [AND EDITSTENTATIVE (NEQ (fetch (PIECE PNEW) of PC) - (AND PREVPC (fetch (PIECE PNEW) - of PREVPC] - (AND (OR (NOT PREVPC) - (fetch (PIECE PPARALAST) of PREVPC)) - (NOT (EQFMTSPEC (fetch (PIECE PPARALOOKS) of PC) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (* ; "We have a piece with new looks.") - [OR FONTFILE (SETQ FONTFILE (OPENFILE '{NODIRCORE} 'BOTH - 'NEW - '((TYPE TEXT] - (COND - ((NOT (IEQP OLDCH# CURCH#)) - (* ; - "If there were looks past, and if the run was not empty, save a piece for its looks") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST - FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC - EDITSTENTATIVE LOOKSHASH PREVFATP) - (add PCCOUNT 1))) - (SETQ OLDLOOKS (fetch (PIECE PLOOKS) of PC)) - (SETQ OLDCH# CURCH#) - (COND - [PREVFATP (COND - ((fetch (PIECE PFATP) of PC)) - (T (* ; "Switching from FAT to thin") - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 2] - ((fetch (PIECE PFATP) of PC) - (* ; "Switching from thin to fat") - (BOUT OFILE 255) - (BOUT OFILE 255) - (BOUT OFILE 0) - (add CURCH# 3))) - (SETQ PREVFATP (fetch (PIECE PFATP) of PC] - (* ; - "Now dump out the non-object contents of the piece.") - [COND - [(SETQ PFILE (fetch (PIECE PFILE) of PC)) - (* ; "It's on a file. Copy it.") - [OR (OPENP PFILE) - (replace (PIECE PFILE) of PC - with (SETQ PFILE (OPENSTREAM (fetch (STREAM FULLNAME) - of PFILE) - 'INPUT NIL '((TYPE TEXT] - (* ; "Make sure the file is open.") - (COPYBYTES PFILE OFILE (fetch (PIECE PFPOS) of PC) - (IPLUS (fetch (PIECE PFPOS) of PC) - (COND - ((fetch (PIECE PFATP) of PC) - (* ; - "For fat file pieces, copy twice as many bytes as characters.") - (UNFOLD (fetch (PIECE PLEN) of PC) - 2)) - (T (fetch (PIECE PLEN) of PC] - ((SETQ PSTR (fetch (PIECE PSTR) of PC)) - (* ; "It's in a string. Just print it.") - (COND - [(fetch (PIECE PFATP) of PC) - (* ; - "The string is fat: Copy twice as many bytes as chars.") - (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring - PSTR - do (\BOUT OFILE (\CHARSET CH)) - (\BOUT OFILE (\CHAR8CODE CH] - (T (* ; - "The string is thin. Just copy it to the file.") - (for I from 1 to (fetch (PIECE PLEN) of PC) as CH instring - PSTR - do (\BOUT OFILE CH] - [COND - ((AND (NOT CACHE) - (RANDACCESSP OFILE)) (* ; - "CSLI leave the pieces and the pctb alone and just write the file if its cached or not randomaccess") - (push CH#S (SUB1 CURCH#] - [COND - ((fetch (PIECE PFATP) of PC) - (add CURCH# (UNFOLD (fetch (PIECE PLEN) of PC) - 2))) - (T (add CURCH# (fetch (PIECE PLEN) of PC] - (* ; - "Keep running track of where in the file we are.") - )) - (SETQ PREVPREVPC PREVPC) - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (* ; - "Put out a piece describing the last characters in the file.") - (COND - ((AND FONTFILE (NEQ OLDCH# CURCH#)) (* ; - "Only if there WERE characters, and only if there's a need for font information") - [OR LOOKSHASH (SETQ LOOKSHASH (\TEDIT.PUT.CHARLOOKS.LIST FONTFILE - (fetch (TEXTOBJ TXTCHARLOOKSLIST) - of TEXTOBJ] - (\TEDIT.PUT.CHARLOOKS FONTFILE OLDCH# CURCH# OLDLOOKS PREVPC EDITSTENTATIVE - LOOKSHASH PREVPREVPC) (* ; - "Put out a description of the characters") - (add PCCOUNT 1))) - (COND - ((AND PARALOOKSSEEN (fetch (PIECE PPARALAST) of PREVPC)) - (* ; - "The last piece contained the end of a paragraph. Make sure it gets noted.") - (\TEDIT.PUT.PARALOOKS FONTFILE PREVPC PARAHASH) - (add PCCOUNT 1] - (for FORM in TEDIT.PUT.FINISHEDFORMS do (EVAL FORM)) - (* ; "Do any user-specific cleanup") - (COND - (TRUEFILE (* ; - "This file needs to be converted to the right convention") - (COND - ((AND FONTFILE (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) (* ; - "Formatted file: Copy without converting.") - (COPYBYTES OFILE TRUEFILE 0 -1)) - (T (* ; - "Go ahead and convert the EOLCONVENTION, this is a plain-text file") - (COPYCHARS OFILE TRUEFILE 0 -1))) - (SETQ OFILE TRUEFILE))) - [COND - ((AND (OPENP OFILE) - FONTFILE) (* ; "We need to write format info.") - (\DWOUT FONTFILE (GETEOFPTR OFILE)) (* ; - "So remember the end of the plain-text part of the file") - (\SMALLPOUT FONTFILE PCCOUNT) (* ; - "# OF PIECES WE'' NEED TO RECONSTRUCT THIS FILE") - (\SMALLPOUT FONTFILE 31417) (* ; - "Now the password for NEW format files: 31416") - (COND - ((AND (NOT UNFORMATTED?) - (NOT SEPARATEFORMAT)) - - (* ;; "Only write fmtg info at the end if we want it there--not if we want plain text or want it kept separate.") - - (COPYBYTES FONTFILE OFILE 0 (GETEOFPTR FONTFILE)) - (* ; - "Copy the font information to the file trailer") - ) - (T)) - (CLOSEF FONTFILE) - (COND - ((NOT SEPARATEFORMAT) (* ; - "Unless we want the formatting info separately, delete the file") - (* ; - "(since FONTFILE is a stream, we should not need to delete it at all) (DELFILE FONTFILE)") - ] - (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ) - TEXTOBJ)) - (* ; - "Re-add the default and caret looks's to the lists, since they may not have been really saved.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ) - TEXTOBJ)) - (RETURN (CONS (COND - (UNFORMATTED? NIL) - (T FONTFILE)) - CH#S]) - -(\TEDIT.PUT.CHARLOOKS.LIST2 - [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:12") - (* Write the list of CHARLOOKSs into - the font file.) - - (* Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' - position in the list we wrote on the file. - Those position numbers are then written in the individual looks descriptions, and - are used to reconstruct the piece looks when the file is read back in.) - - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) (* No characters are described by this - pseudo-piece entry.) - (\SMALLPOUT FILE \PieceDescriptorCHARLOOKSLIST) (* Mark it as containing the list of - CHARLOOKSs) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) (* How many CHARLOOKSs there are in - the list) - (for I from 1 as LOOKS in LOOKSLIST do (* Write each charlooks, in the order - they appear in the list.) - (\TEDIT.PUT.SINGLE.CHARLOOKS2 FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - (* And save it in the hash table so - people can find its index.)) - (RETURN LOOKSHASH]) - -(\TEDIT.PUT.PARALOOKS.LIST2 - [LAMBDA (FILE LOOKSLIST) (* jds "22-May-85 15:09") - (* Write the list of FMTSPECs into the - font file.) - (PROG ((LOOKSHASH (HASHARRAY 50))) - (\DWOUT FILE 0) - (\SMALLPOUT FILE \PieceDescriptorPARALOOKSLIST) - (\SMALLPOUT FILE (FLENGTH LOOKSLIST)) - (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS2 FILE LOOKS) - (* Write out the description) - (PUTHASH LOOKS I LOOKSHASH) - (* And save it in the hash table so - people can find its index.)) - (RETURN LOOKSHASH]) -) - - - -(* ;; "For converting incoming old-format files (1/27/85 cutover)") - -(DEFINEQ - -(TEDIT.BUILD.PCTB1 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 20-Jul-2022 11:22 by rmk") - (* ; "Edited 19-Jul-2022 08:33 by rmk") - (* ; "Edited 22-May-92 18:00 by jds") - -(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (* ;; "START = 1st char of file to read from, if specified") - - (* ;; "END = use this as eofptr of file. For use in reading files within files.") - - (LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0)) - (PCTB (\MAKEPCTB NIL PCCOUNT))) - (replace (TEXTOBJ PCTB) of TEXTOBJ with PCTB) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind PC TYPECODE PCLEN (OLDPC _ NIL) - (OLDPARALOOKS _ DEFAULTPARALOOKS) for I from 1 to PCCOUNT as PCN from - \FirstPieceOffset - by \EltsPerPiece - do (SETQ PC NIL) (* ; - "This loop may not really read a piece, so we have to distinguish that case.") - (SETQ PCLEN (\DWIN TEXT)) - (SETQ TYPECODE (\SMALLPIN TEXT)) (* ; "What kind of piece is it?") - (SELECTC TYPECODE - (\PieceDescriptorPAGEFRAME (* ; - "This is page layout info for the file") - (AND TEXTOBJ (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with ( - TEDIT.GET.PAGEFRAMES1 - TEXT))) - (add PCN (IMINUS \EltsPerPiece)) (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorPARA (* ; - "Reading a new set of paragraph looks.") - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (* ; - "Mark the end of the preceding paragraph.") - (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS1 TEXT)) - (* ; - "Get the new set of looks, for use by later pieces.") - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T)) - (* ; - "Mark the document as containing paragraph formatting info") - (add PCN (IMINUS \EltsPerPiece)) (* ; - "This didn't create a piece -- don't count it in the PCTB placement.") - ) - (\PieceDescriptorLOOKS (* ; - "New character looks. Build a piece to describe those characters.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) (* ; "Build the new piece") - (CL:WHEN OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC)) - (\TEDIT.GET.CHARLOOKS1 PC TEXT) (* ; - "Read the character looks for this guy.") - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - (* ; - "And note the passing of characters.") - ) - (\PieceDescriptorOBJECT (* ; - "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") - (SETQ PC - (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ PCLEN - PREVPIECE _ OLDPC - PPARALOOKS _ OLDPARALOOKS)) - (CL:WHEN OLDPC (* ; - "If there's a prior piece, hook this one on the chain.") - (replace (PIECE NEXTPIECE) of OLDPC with PC)) - (TEDIT.GET.OBJECT1 (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - [COND - ((NOT (ZEROP (\BIN TEXT))) (* ; - "There are new character looks for this object. Read them in.") - (\DWIN TEXT) - (\WIN TEXT) (* ; - "Skip over the piece-type code we know has to be here.") - (\TEDIT.GET.CHARLOOKS1 PC TEXT)) - (T (* ; - "No new looks; steal them from the prior piece.") - (replace (PIECE PLOOKS) of PC with (OR (AND OLDPC (fetch (PIECE PLOOKS) - of OLDPC)) - DEFAULTLOOKS] - - (* ;; "OBJECTs are officially one character long.") - - (replace (PIECE PLEN) of PC with 1)) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (CL:WHEN PC - (\INSERTPIECE PC 'LASTPIECE TEXTOBJ) - (SETQ OLDPC PC))) - PCTB]) - -(TEDIT.GET.PAGEFRAMES1 - [LAMBDA (FILE) (* jds " 1-Feb-85 14:55") - (* Read a bunch of page frames from - the file, and return it.) - (TEDIT.PARSE.PAGEFRAMES1 (READ FILE]) - -(\TEDIT.GET.CHARLOOKS1 - [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Read a description of PC's - CHARLOOKS from FILE.) - (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) - (replace (PIECE PLOOKS) of PC with LOOKS) - (SETQ NAME (\ARBIN FILE)) (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) - (OR (ZEROP SUB) - (SETQ SUPER (IMINUS SUB))) - - (* If this is an old file, it'll have a subscript value not zero. - Let those past and do the right thing.) - - (COND - ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. - Mark it so.) - (replace (PIECE PNEW) of PC with T))) - [COND - ((NOT (ZEROP (\BIN FILE))) (* There is style or user information - to be read) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) - 0)) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE] - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - (replace (CHARLOOKS CLFONT) of LOOKS with (COND - ((LISTP NAME) - (* This was a font class. - Restore it.) - (FONTCLASS (pop NAME) - NAME)) - ((AND NAME (NOT (ZEROP SIZE))) - (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]) - -(\TEDIT.GET.PARALOOKS1 - [LAMBDA (FILE) (* ; "Edited 30-May-91 20:34 by jds") - (* Read a paragraph format spec from - the FILE, and return it for later use.) - (PROG ((LOOKS (create FMTSPEC)) - TABFLG DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\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 NIL 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 DEFAULTTAB (\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 DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS))) - [COND - ((NOT (ZEROP (LOGAND TABFLG 2))) (* There are other paragraph - parameters to be read.) - (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\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]) - -(TEDIT.GET.OBJECT1 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") - (* Get an object from the file) - - (* CURCH# = fileptr within the text section of the file where the object's text - starts.) - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - FILEPTRSAVE NAMELEN GETFN OBJ) - (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ) - (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the - building of the object) - (SETFILEPTR FILE CURCH#) - (SETQ OBJ (READIMAGEOBJ FILE GETFN)) - (SETFILEPTR FILE FILEPTRSAVE) - (replace (PIECE POBJ) of PIECE with OBJ) - (replace (PIECE PFILE) of PIECE with NIL) - (replace (PIECE PSTR) of PIECE with NIL) - [replace (PIECE PLOOKS) of PIECE with (COND - ((fetch (PIECE PREVPIECE) of PIECE) - (fetch (PIECE PLOOKS) of (fetch (PIECE PREVPIECE) - of PIECE))) - (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS ( - CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ] - (RETURN (fetch (PIECE POBJ) of PIECE]) -) - - - -(* ;; "VERSION 0 Compatibility reading functions") - -(DEFINEQ - -(TEDIT.BUILD.PCTB0 - [LAMBDA (TEXT TEXTOBJ PCCOUNT START END DEFAULTLOOKS DEFAULTPARALOOKS) - (* ; "Edited 20-Jul-2022 11:21 by rmk") - (* ; "Edited 19-Jul-2022 08:41 by rmk") - (* ; "Edited 22-May-92 18:01 by jds") - -(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") - - (LET (PCTB OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP - (CURFILECH# (OR START 0))) - (SETQ PCTB (\MAKEPCTB NIL PCCOUNT)) - (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) - 8)) - (SETQ PIECEINFOCH# (\DWIN TEXT)) - (SETFILEPTR TEXT PIECEINFOCH#) - (bind PC TYPECODE PCLEN (OLDPC _ NIL) for I from 1 to PCCOUNT as PCN from \FirstPieceOffset - by \EltsPerPiece do (SETQ PC (create PIECE - PFILE _ TEXT - PFPOS _ CURFILECH# - PLEN _ (SETQ PCLEN (\DWIN TEXT)) - PREVPIECE _ OLDPC - PPARALOOKS _ DEFAULTPARALOOKS)) - [COND - (OLDPC (replace (PIECE NEXTPIECE) of OLDPC with PC) - (replace (PIECE PPARALOOKS) of PC - with (fetch (PIECE PPARALOOKS) of OLDPC] - (SETQ TYPECODE (\SMALLPIN TEXT)) - (SELECTC TYPECODE - (\PieceDescriptorLOOKS - (TEDIT.GET.CHARLOOKS0 PC TEXT) - (add CURFILECH# (fetch (PIECE PLEN) of PC))) - (\PieceDescriptorOBJECT - (TEDIT.GET.OBJECT0 (AND TEXTOBJ (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ)) - PC TEXT CURFILECH#) - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - (replace (PIECE PLEN) of PC with 1) - (* ; - "Only object--can't be followed by either ot the others.") - ) - (\PieceDescriptorPARA - (AND OLDPC (replace (PIECE PPARALAST) of OLDPC with T)) - (TEDIT.GET.PARALOOKS0 PC TEXT) - (replace (PIECE PLEN) of PC with (\DWIN TEXT)) - (* ; - "Set this piece's length from the character looks.") - (\SMALLPIN TEXT) (* ; - "Skip the piece-type code, since we know what's next") - (TEDIT.GET.CHARLOOKS0 PC TEXT) - (* ; "This document is 'formatted' .") - (add CURFILECH# (fetch (PIECE PLEN) of PC)) - (AND TEXTOBJ (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ - with T))) - (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) - (SETQ OLDPC PC) - (\INSERTPIECE PC 'LASTPIECE TEXTOBJ)) - PCTB]) - -(TEDIT.GET.CHARLOOKS0 - [LAMBDA (PC FILE) (* ; "Edited 30-May-91 20:26 by jds") - (* Put a description of LOOKS into - FILE. LOOKS apply to characters CH1 - thru CHLIM-1) - (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) - (replace (PIECE PLOOKS) of PC with LOOKS) - (SETQ NAMELEN (\SMALLPIN FILE)) (* The length of the description which - follows) - [SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (\BIN FILE] - (* The font name) - (SETQ SIZE (\SMALLPIN FILE)) (* Size of the type, in points) - (SETQ SUPER (\SMALLPIN FILE)) (* Superscripting distance) - (SETQ SUB (\SMALLPIN FILE)) (* former Subscripting distance) - (OR (ZEROP SUB) - (SETQ SUPER (IMINUS SUB))) - - (* If this is an old file, it'll have a subscript value not zero. - Let those past and do the right thing.) - - (COND - ((NOT (ZEROP (\BIN FILE))) (* This text is NEW. - Mark it so.) - (replace (PIECE PNEW) of PC with T))) - [COND - ((NOT (ZEROP (\BIN FILE))) (* There is style or user information - to be read) - (SETQ STYLESTR (\STRINGIN FILE)) - (SETQ USERSTR (\STRINGIN FILE)) - (COND - ((NOT (ZEROP (NCHARS STYLESTR))) (* There IS style info) - (replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR))) - (T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0))) - (COND - ((NOT (ZEROP (NCHARS USERSTR))) (* There IS user info) - (replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR] - (SETQ PROPS (\SMALLPIN FILE)) - (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] - [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] - [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] - [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] - [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] - [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] - [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] - [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] - [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] - [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] - (SETQ CLSIZE SIZE) - (SETQ CLOFFSET SUPER)) - (replace (CHARLOOKS CLFONT) of LOOKS with (AND NAME (NOT (ZEROP SIZE)) - (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]) - -(TEDIT.GET.OBJECT0 - [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 12-Jun-90 18:17 by mitani") - (* Get an object from the file) - - (* CURCH# = fileptr within the text section of the file where the object's text - starts.) - - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - FILEPTRSAVE NAMELEN GETFN OBJ) - (SETQ GETFN (\ATMIN FILE)) (* The GETFN for this kind of IMAGEOBJ) - (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* Save our file location thru the - building of the object) - (SETFILEPTR FILE CURCH#) - (SETQ OBJ (READIMAGEOBJ FILE GETFN)) - (SETFILEPTR FILE FILEPTRSAVE) - (replace (PIECE POBJ) of PIECE with OBJ) - (replace (PIECE PFILE) of PIECE with NIL) - (replace (PIECE PSTR) of PIECE with NIL) - [replace (PIECE PLOOKS) of PIECE with (COND - ((fetch (PIECE PREVPIECE) of PIECE) - (fetch (PIECE PLOOKS) of (fetch (PIECE PREVPIECE) - of PIECE))) - (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS ( - CHARLOOKS.FROM.FONT - DEFAULTFONT) - TEXTOBJ] - (RETURN (fetch (PIECE POBJ) of PIECE]) - -(TEDIT.GET.PARALOOKS0 - [LAMBDA (PC FILE) (* ; "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 DEFAULTTAB TABCOUNT TABS TABSPEC) - (replace (PIECE PPARALOOKS) of PC with LOOKS) - (replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE)) - (* Left margin for the first line of - the paragraph) - (replace (FMTSPEC LEFTMAR) of LOOKS with (\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 NIL 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 DEFAULTTAB (\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 DEFAULTTAB) - (RPLACA TABSPEC DEFAULTTAB)) - (RPLACD TABSPEC TABS]) -) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3169 33941 (TEDIT.BUILD.PCTB 3179 . 13168) (\TEDIT.CONVERT.FOREIGN.FORMAT 13170 . 14962 -) (TEDIT.FORMATTEDFILEP 14964 . 18176) (TEDIT.GET 18178 . 26660) (TEDIT.PARSE.PAGEFRAMES1 26662 . -28368) (\ARBIN 28370 . 28986) (\ATMIN 28988 . 29313) (\DWIN 29315 . 29589) (\STRINGIN 29591 . 30195) ( -\TEDIT.FORMATTEDP1 30197 . 32454) (\TEDIT.SET.WINDOW 32456 . 32967) (TEDIT.GET.PASSWORD 32969 . 33939) -) (33942 48973 (\TEDIT.READ.FORMATTED.FILE 33952 . 43494) (\TEDIT.READ.UNFORMATTED.FILE 43496 . 46781) - (\TEDIT.CACHEFILE 46783 . 47991) (\TEDIT.UNIQUIFY.ALL 47993 . 48971)) (49009 68567 (TEDIT.INCLUDE -49019 . 59791) (TEDIT.RAW.INCLUDE 59793 . 68565)) (68601 110449 (TEDIT.PUT 68611 . 78572) ( -TEDIT.PUT.PCTB 78574 . 104130) (\TEDIT.PUTRESET 104132 . 104374) (TEDIT.PUT.PIECE.DESCRIPTOR 104376 . -107020) (\ARBOUT 107022 . 108173) (\ATMOUT 108175 . 108686) (\DWOUT 108688 . 108967) (\STRINGOUT -108969 . 109405) (\TEDIT-OPEN-FONT-FILE 109407 . 110447)) (110450 121878 (\TEDIT.GET.CHARLOOKS.LIST -110460 . 110861) (\TEDIT.GET.SINGLE.CHARLOOKS 110863 . 114662) (\TEDIT.PUT.CHARLOOKS.LIST 114664 . -116601) (\TEDIT.PUT.SINGLE.CHARLOOKS 116603 . 121876)) (121879 136155 (\TEDIT.GET.PARALOOKS.LIST -121889 . 122298) (\TEDIT.GET.SINGLE.PARALOOKS 122300 . 128937) (\TEDIT.PUT.PARALOOKS.LIST 128939 . -129946) (\TEDIT.PUT.SINGLE.PARALOOKS 129948 . 136153)) (136463 192394 (TEDIT.BUILD.PCTB2 136473 . -147906) (\TEDIT.GET.CHARLOOKS.LIST2 147908 . 148311) (\TEDIT.GET.SINGLE.CHARLOOKS2 148313 . 151790) ( -\TEDIT.PUT.SINGLE.PARALOOKS2 151792 . 156291) (\TEDIT.PUT.SINGLE.CHARLOOKS2 156293 . 160809) ( -\TEDIT.GET.PARALOOKS.LIST2 160811 . 161214) (\TEDIT.GET.SINGLE.PARALOOKS2 161216 . 165839) ( -TEDIT.PUT.PCTB2 165841 . 189455) (\TEDIT.PUT.CHARLOOKS.LIST2 189457 . 191396) ( -\TEDIT.PUT.PARALOOKS.LIST2 191398 . 192392)) (192471 210789 (TEDIT.BUILD.PCTB1 192481 . 199615) ( -TEDIT.GET.PAGEFRAMES1 199617 . 199973) (\TEDIT.GET.CHARLOOKS1 199975 . 204137) (\TEDIT.GET.PARALOOKS1 -204139 . 208755) (TEDIT.GET.OBJECT1 208757 . 210787)) (210849 225021 (TEDIT.BUILD.PCTB0 210859 . -215024) (TEDIT.GET.CHARLOOKS0 215026 . 219454) (TEDIT.GET.OBJECT0 219456 . 221486) ( -TEDIT.GET.PARALOOKS0 221488 . 225019))))) + (FILEMAP (NIL (4977 31356 (TEDIT.GET 4987 . 9663) (TEDIT.FORMATTEDFILEP 9665 . 10588) (TEDIT.FILEDATE +10590 . 12174) (\TEDIT.GET.IDATE3 12176 . 13571) (TEDIT.INCLUDE 13573 . 20426) (TEDIT.RAW.INCLUDE +20428 . 21236) (TEDIT.PUT 21238 . 28064) (TEDIT.PUT.STREAM 28066 . 31354)) (31418 49820 ( +\TEDIT.GET.FOREIGN.FILE 31428 . 34492) (\TEDIT.GET.UNFORMATTED.FILE 34494 . 38253) ( +\TEDIT.GET.FORMATTED.FILE 38255 . 40921) (\TEDIT.FORMATTEDSTREAMP 40923 . 43610) (\ARBIN 43612 . 44332 +) (\ATMIN 44334 . 44871) (\DWIN 44873 . 45252) (\STRINGIN 45254 . 45962) (\TEDIT.GET.TRAILER 45964 . +48289) (\TEDIT.CACHEFILE 48291 . 49818)) (49986 61364 (\TEDIT.GET.PIECES3 49996 . 59523) ( +\TEDIT.MAKE.STRINGPIECE 59525 . 61362)) (61365 73308 (\TEDIT.GET.UNFORMATTED.FILE.XCCS 61375 . 67491) +(\TEDIT.INTERPRET.XCCS.SHIFTS 67493 . 73306)) (73330 79151 (\TEDIT.GET.UNFORMATTED.FILE.UTF8 73340 . +79149)) (79174 87310 (\TEDIT.GET.CHARLOOKS.LIST 79184 . 79798) (\TEDIT.GET.SINGLE.CHARLOOKS 79800 . +84122) (\TEDIT.GET.CHARLOOKS 84124 . 85454) (\TEDIT.GET.PARALOOKS.INDEX 85456 . 86000) ( +\TEDIT.GET.CHARLOOKS.INDEX 86002 . 87308)) (87311 95549 (\TEDIT.GET.PARALOOKS.LIST 87321 . 87943) ( +\TEDIT.GET.SINGLE.PARALOOKS 87945 . 94957) (\TEDIT.GET.PARALOOKS 94959 . 95547)) (95550 98948 ( +TEDIT.GET.OBJECT 95560 . 98946)) (99010 130965 (\TEDIT.PUT.PCTB 99020 . 112763) (\TEDIT.PUT.TRAILER +112765 . 113532) (\TEDIT.PUT.PCTB.MERGEABLE 113534 . 117052) (\TEDIT.PUT.UTF8.SPLITPIECES 117054 . +122008) (\TEDIT.PUT.PCTB.NEXTNEW 122010 . 125785) (\TEDIT.INSERT.NEWPIECES 125787 . 128563) ( +\TEDIT.PUTRESET 128565 . 128807) (\ARBOUT 128809 . 129533) (\ATMOUT 129535 . 130140) (\DWOUT 130142 . +130421) (\STRINGOUT 130423 . 130963)) (130966 140095 (\TEDIT.PUT.CHARLOOKS.LIST 130976 . 132648) ( +\TEDIT.PUT.SINGLE.CHARLOOKS 132650 . 137894) (\TEDIT.PUT.CHARLOOKS 137896 . 139040) ( +\TEDIT.PUT.CHARLOOKS1 139042 . 140093)) (140096 148134 (\TEDIT.PUT.PARALOOKS.LIST 140106 . 141008) ( +\TEDIT.PUT.SINGLE.PARALOOKS 141010 . 147059) (\TEDIT.PUT.PARALOOKS 147061 . 148132)) (148135 150408 ( +TEDIT.PUT.OBJECT 148145 . 150406)) (150503 152185 (TEDITFROMLISPSOURCE 150513 . 152183))))) STOP diff --git a/library/tedit/TEDIT-FILE.LCOM b/library/tedit/TEDIT-FILE.LCOM index 744b2a37983a93d6e2ecd7e0c03296c6073ed267..b8b07c9cf24f486020ac3de56ad937a3f7587a36 100644 GIT binary patch literal 38957 zcmcJ2dvIIVc_#=`G{ZnDi5E#RX^aO!0VIG+5uhl_QW=S0!UrUI zB|3@w*xG3xP1>ewJGPTF$xiGfZIiASB*iqgWur~IGo{+8cW3m6G)Z^rBx>63b_S~3 z?aXc)@9+D*bM8F=D9349&4@VnoO93neBbYToOAm|lVj;z^6*$XlRTWxjoH?|$yj0{ zb~I`ArgMelR3@FD?6vkyC1az7SUgh~9gpRcR$$;@dwU<1kU+LVa@6V#1P*7l}_4UqQIQQUEX`yIcIB)e@zc7U&T`y1-59e^+E6c+hI^4Gg#i27@D^p^-qS*E)M~!6|X!Ll0iObnl3Dir?;^oG$cF zCJJ$D2{nyPXEJD}TSR|~d${-Do9fY%A zBvP^5(PaK`!M6Iwa(T;bdA@*=%r^AJ=v!ebh5?^4v!J-CjBQWkt#%`$6B{^ajZ97@ zkEiYF{NYi|6J{Xn4hcpzGB6UvsJ^*Q1rD}Ldyggyv4MesfHg8Y+}@XqWs_DuJu-4= zIyaNfjUJwyvJ1&X;gFTK1|%VoNyc*1lZVIbscim`HHP>?@ zXcg30j9DQI3sUC`TPS!kk1P=>bt;)p7Mvmnt#~q>J9?M~91C*H8j{h~D|E~nMrlsb zN33bA{i$rMfZX>}GX|_NNj+$JzTwpS7TYO$k`v|cymyid;Dq^|$2R}NOxJI5%u=DJXTGg6<3F}oEbQ7rFV6dl zQt6)g)+r9<{d@8pnELbnsbwzY*!uoFS5P^|<;--vmEKiPQ}S^9a@!PV@)@;vRLURm z^aTSU3-d@5X3tFLlT$Rf7Pha9niV(_w6LQjozntCN9tn+BYHJXPtyA8FQf|~7=g$j z#h)n9{9w&a7N)E~;D}{UCV4*9Bn%Hx3n(9#KNQx5@p`ZZhoz82#?B|ltihmlDxb1v z^2v-9I${+Hv!ftXnb@qFwD!K>z;Nx92ZjfEovHc)L#lInNd&@@PU|ob8nSf0pc@<* zuxRm4p`q4ruy%<>!dyDN9pc5AomAsx1tU&UV8|M^b3av}1*R7>UTkc>vAbkrO24LL)DGnjdA>Jk)M~ippAQ^h?wlQRE(?T?I{@+eKS3s z@7&3+@az1ijW_E4)~4O#>pf9b?|pUEMt#_$VGI=*8B^FGHV{!+UJycQtzZCqCVLzM zSHRZArl9%i$J7XUradfCmmRqN6@RB8=#Mi2?+eEm*NvlPNe5ZWzqK;E7pg&?L-20G#;zg;nc) z7alraJbd`f*$WqeOnQmP^`a2#eHSmB8$q7Xpw*j0zDs950O0cQ!s@%MOmeJXz5jxB zbYayxbN=BEo_V+*&_#yCVQAEW$v4HLY1gXhzCF8EJC>L;GkSybVy})jc|A?Xc>Q)Z zc~a|l^Lpn$$9P8&f9#PA<=q@3Jd1bA38YQ+%(qlzhho_eIV%W5(XU|-cnU2-)z;83 z4>olZ%msje7ttg}Hxf`Y76h?0_|G5_q@y_+|8T_W;|Hrxn9Kc^of$nI%SH2c?Zz8 z*k%o&&%^caBFpA?m!AWT~jNB=0zDDc>{Ss@4)O$)?%j*9}VleBrUQPiQ>GGyuqOlzVf8 z!3Z^$Wg_r;+QZh+kfvtlTEsRr)?zqpu0`-@mxN-JL4(uGdee4}Yl;l%1qztqE>O@^ zS(6b-riF^N{00j(6xwc~s>%G)Wnyp%SusxT~xVtZ%OJt@;le#m2W1|U0wMYz@E&~CJ_!I^P&5ex__zJ0!0!c5#rYNZqmmRd4{`3xy zr&W5raZG+=ol~s}we*}6QRS*1xa7NLQrv(rT?(KP?7+<-bh~MChOOj(^ zTxKD))jz(~z9P$eVrwTBY#5NHUN{SfHK@wk$CFk#1X)Y=rjqMuiG>05G}s9p8LpS+ zLW2%i)J|+1Ti)6$0NfNNETl%B7xG5M)?w9Hz=a)S<+| zAfT!fgpg)W&Qe`@D~P_(Q+&3N#1r76K{zy+2!fd!)son2JO+kqS`io|^yWfN1*3uK z%(f9I-X>Qd;(%=^OwbD=Rn`&kazQMX1B?aFO5rX9ssYjHzEpvV1(pIGZ&Rs*HbFpC z?@66!=Q6V(rC~^?j3UE^NE!kmbLm6~gv^<1G-fh36%$2M2;)9xLyQPPIN?%408Ar^ z(uGS4?}MVx3IzwOUuY? zlbpdXCTP0Asd(cTa`tF?Dgn&>OVCVcgcpFyK%;YDZYcq47poQeC-7TLzwQRH(*T%! zUmrDuV}bQZQ_-7Sc>kHzr4KAv=N~$EcHyFR;eFQp;+czQ=2sUkUb0p%K%qEadZ@Ty z;Pe1St_H!YES5&{?H1M$pu5FmvP~JM0rnvUTy+jyy0Go9VCNFF%6*%kpIQsn`yH zSqJFXj%X~N7+u=MB!_TQKrK5}dL2*0w7p3%If%ssp^i8mrX4Iw;431+gvrea7FAj2 z5Tv}5>0|;MoERT(e9@oQvcB7?ABQw59j?_)j6r#_4NS#kqgjb0Elem1(Ran5@c@9! zTEv5vw{SEsO<5zAO1giXGvoM zE(*+(JIfDQJP|i#K0k}lOjpl*7bh{R=1>n;!8tiuN);gBPKx5O=^5Xm;=8j(Pk+7G z)Y;T3sA0FadGqfl*55YMEoE>eya-e$xqCByj<5cflp>u?W4lFIk)!ma5zymCnjZms zb#z4$hz3c>vsMIn8@z%@IoJz!nWH4a7VTH7I1IAbSYQ}rR;h`?&{sHRhe=1IvQJ~v z0p?oapeT1$fuSRsPnkR|BnsX}g->YE;n6kRE)*faL44O?ccHLS3QJ9{(kK)dw5AUy z$T$_k2F(>xL=?bn8j1))?d*(45W<*xEf@h=QLmBGsIKNIzcdOI zDN>s^5GIgK_8p#tfTLeVR?^_1durs4fd16u0;luf7i!!MZ64U2Gd1A6=44YJSSJSF z7h#x@1&4g7VFipbLbS?*T z3u)m%hLH?7)UYg2oD2@YW5|l9bFrye0EC*_Ls+6<)IfSpgMyH+5e4S$=-$OJ0SSh< zKXY(WV-i6oWtu_?0chSvVBU;PXOI!?m3THgk+u^mJk=bM`_)Tft=B`UR_j4znuaEi zFhc~GtG9UJ`~r9}YV2h@Vt6P5wme+`8-70l1ZMKcfR)#mfpJwqk-|YMG<<|%z=ela zAAAV}vU7Ey0u5$Q#pcmB+I(s7;z zbRqSngG#8wY&j(9)o2j0@&@ip4Bb?qh4mDY1Y2XmBTECOSJ?D+(rkm)tq*F99ZI&n z`wev&iy*=wX`P{#u!0bIwEErIoErN$^ud7M*bvl1qYSJut%t+7D3bgp!IQ`^$7GKuwcmbT#;Xi^uCENO7)v<^6M*L1qDGknOJ9INs&|8w0S?avZL}g zWaA(NMnzI<&8r~aT5la7se3Y+oB(kJ$piav^h|hk#Q3yGL7V<$zfx+e9*bG{>+_j}Ep3 zR3gmMN$7*APV9K11=R+_BmkERgyX%S%t3j_M8^Ea zm=c3x^R&E4)`KC|@;6|iKrUBFM7&5v5)2p35pgARzSKP5-s*_uB-77gIV-8zO@}o6 zEQU9L1(wGhmecebZ99|~&x|<0s2?WPJVhi3_AC}51a|k#chC4{x?3DMcEd2To*_)$V_ z+DqK%Dr9}>%JxMorZnRtP4i5bzXgs(GhH{n`%*EBg;*T-@2nJ;U+F;Ngx^;wmb|Zc zn(4>iQJ%idyDt}W+r7HXZ?5VPl^Iz~H)MKgE^8LSHCw^If`1xIibv5!ac z8IeQ62nvHp1+We=2Aw;M-k}L2(gkog^W6Yxuth-{fD+1immRo-fiKf8yghZ)*Tuy*wRKH-R zln06{bus&vt6#*s-X?mTNyH}@+B1t(7W%FBQ=4y1iN9pZw?dSu{P$2VyPFzAk;{|T zqCb{Tq|?Msu%F4nknHoq4g=7A!8LF?Gm7yGz%@h|AR!KN2p+&Hc63%cG61(Z2VU#Q zAo=*!k|#*|#xfA57lH=Gj8*1nQsuZct2rb(;mTjyQ3bIeN|2bx$YcT~KIC-^g8U`Y z=|h(fr)lW-&m!%EORI~}@I$WF$*>j_l5m}S-i_NLx=&|`=*UjYV~SRoDD z9xXb}uQgwGnYE75oH_&34H=i+9vI*f!08V#uT6r4U{7C8ZADXCBZdyN)4xOcYMjnq z?Er&#HoMjKyA#(swTGA$joC(VqTgO>(!`rojhpZE*VViXntCzVdH>uUEl%Xft+Q&&p~DA_K~&& zyiE&uP^6Ix16p1!xq(Y5x=WT~1QCG-f{UCQJDCLbMh7749^!7vNdqc@j}siSw48=a z)VD&`?Hhb$w(k`YE8Q#jm@QYomMZRO{tVNS$6z&C=?v}|PrtSSuMLiSDYLl?n*LKS zj;~xhS^n$nfh*;Inh@m!IyVSUW}JDT9?^uv66_y{uISb)4-N6<;BlvQPY?woyxSvf zc@<;)>Z{lB2mi18JoJ)&(HRppX`uAz7&J&V)5acZ4KtW*A%~UCHg^)aOS3eW_ffZ> z=I0Fyz4kUwjK8+got}_QD00Wd%C!f|f6Io0VQXqKLw!sDQdw#y!D;XS+@<;p#9_rU z8Jql0Fq4ikuaTPRH3++_Vq78XcycOFwpIfD+c2?w`Xo`E0VOavz9tRb{v@~+cbj{6 z)>|yK-Maj6=VS}qblQ}I4kw+EfjKEZ#q+=X`mHC=zyA7-l^f@O{`YS@P-HIl&Pp`K zi~35bE%PLM|2(pM{rOaSVm!0hQ+^w$!tYG1RKGm2T)n(ARcf0UXIUUB-u2|!6M(9~ zK!1Qx#&{@_PjrF(eSj&=yhI+7_863L^@Ev+B~t7atA`Ta3KVraVbze5h~8lNt-znD zrPJr(E$seb(#VfdcXP7^OH5rS;?E@3cSlq4&F1CAX3M$PS$Fm^?aCzUC$`y=GUW^5 z#=w*&NQN3*NCVMJ*VO`MDfa;!+0gQcw0s zvbrBm_%<8`YS1vzOSoT{rhUyCnYFX1>iCNR47fxYn{wD1r@e^=nX+m`VqtZrM9h*- z%*H6jC_^Ghk3j-DF>tKX0#e`gUd4n*QM>Sx+yk zJqq@muBfu2B%3Cv2o@}JkPwR*E}KQl#N(UQ+s>{%llyz@)}X zHfqgvgYx#+-8-5$cS)W8ook+dU}CghwL6})JGORi{@q0RZ<+M?D>2E%8TywrAx!12fuM+*oE3vKPoQ40);kB*fE1g|FdvEh*>uw(ZZ|>M#jy264sMuZhe*1tbaX(7j zU$J|=bG_yNDd!hNvrvi3ijWDsE_0BDiYn`Gt7K`~SFX*j{jhZrGiUbzgYDaG&>f~g z)u*yDcUb{ub3I!-cQmc0^K+hzgU>|f7D9DE#YdXOF~_EG^ezuy)35-v5G;b4rH9Bi^#vy)xZ;3P)<`&R6IC+3E#9v@NO~m61y7hH_g_atQE6~V zU@~~<6QRcW38h`M27y9V930(L2s~GXK*&WoGKc|HI*s5k^-B~WLEyW36%5#jP7Ywb z)Fq=n85AWV^=knDi=jTNE{B*;1P%keGqEW$iH}&*=U2{O_~7}&s}Dc8U_H3BFb@mp z%F=@mE))%!ja(hb+=n-$I|?bn5F^h-#w8tOAH7e2_g`a-#5?@y71{J3m4iuVy+BH_ zt6tx7^{W!|D|q@i9GcftOn7B0f)Fvui-8DBw&&rI3VKL7KoE6O+DZIhz5sP0sAUv1 z7^&q%O)1TFrMw7*B1&Ph4XuGLyuhe-){I5(Y*)4?AwZ*|@&Wa3=t z#Hkhn!z8efMy-C1>tm435xQxI)N9X~+-PJ+)P@L84$F~PI9T?S@-V=YoQ#;X*@Z1& z!Jk4v0yfd4vW8&sYZw8GADW6%;G_UZfB<$2fr*Hfv@?P#^5kGa2ewJZr(P-OO*Ls` zqMYU6vqO-aTE^QEtsrQj6$5(TBXS#TLRbSzK_t=w72k2J+QL*8{^Cz|63SRsygoq+ z=g~&suo7jWu5`wo|IIf(*HuY@+Q(D3*3(fj*Uoj6Ua!vWeR6TmS1E_1R%HUL|3BLu zucqR+z5=e?vH6xtd2jkvyW{)Fk(#*nP21-x2-d%mviIDW>#o?oQhW6?cK7ncjcaq= zk0Nku{pYEu$4lOiL2>Zd@*^u?zN*ExpI0`66nhU)irqc&Z7|)Uy^j{S+o3e$lnKTu z-L%NWBrGq zofag|{Ge{f;AE~!9IV?+L?%NZ$i2xE(5QgQlDly(iB-t@ZCc(Uho`X?GZ_{IlA|~R zhi3F)sirdrv1tY^$Yr1eq!kfLy*;Z}#1sovc1J*O8zQ8rawq+wFu^k@pQn$;BOEr0?3Y4M02X_KHhUbyoTvd6}P-tAaE3bMTHcn7KH(2 zYcjW#yx06KYfYzVhV7UIJ%%x}DY3`k2dk>?y=J^u8|OXuFS_FIt~I@-CckbJ?=sa; zsoQ8MHE~6nOZCx$Ui17>YO8|~_8zA(uX8WZz3;Aho>hI4{t>m0VW3i5tt&SaM5IB& zep_FxP;7O*J5^#{ky=p;-R~*?TuobB0g7ql%(i+d&Z{^P*72uH-jn5@T6rO*3PCfV zDn3!}M%rV`FQ`#hQvfjP8~?1p`EhKAsKC!}#)_#ePZdt02g={UIS4W}$r5T<`e9NH z$Dtu2wOa@_7(+V(|3WB#4cr)j{?64t10lI-So2|kOyTEY`0uH`5hAk_W1SGx3MvHc zpbqJ{ATW}|(dk|Z1>hQ{LQplTkn?T;m8dxEb{*1j@ST&WVO<7ri^RYIf&;WoNgvu< zw<~itjtD`Bl|AdKp10+KY?)JA5R8tvSYj$O2A%`RZg3_Nt6i1|3`f|TIU@8{njxYa ziXYMuP9;_g>qdc)hh>KYTe|#@Jj72F%$f`y`0v8^CVa&Aemu7K$9Il{Kc!zzf%p^S zyI;h{(@f`Iu)D{r&n~`HJ}9v-q{gp(GwZU1^;aYw>Kw_Rvb%184`#9Zp0<71Ky$uF zZ6BE3s@=VUUGiw@tq|LCn$L9@e2xsow$JYV_FND6R!=RXv%8tc`H08mh{bgfi<aVtN# z)juv@S^HrXUMScjx7(it)pE4R4igv(@L%9Y>=wCxuvbYz`zqvpHC!>e-yb10!`wynmoDt7lWRPl(5{aY1A{y+Oc)4DIqy1L7-9 zHz^mj4L@Ril`!7xe1&kJOI(JQ}bEB_xR)svl%!A@)Pu6>{EjTNX^r6%7GD@o&>-~klYGc&kLE1&igAYi^Dv0I}G+c zU#UR>^28D|Cr%-erA1|h>yNYh;qu8g7w&r`4Wt9ZNryw7uUcDed{=^f2aiIwC_Ii&g~bC($eMk+kH?nz1Qx8Wy$X2YBr{zEbEiOyV`<5*?60NfPM0- ztmi75=_<<1^%c&g&aOPN2-!eQhV@4t{9AvAZ6N)*{l(9_`uj)i{e&%L?kvdcQG2hw zPoNe_%|q}MbK!tSGzec#PJ%%lW=}G0 zix~{3M;wzFJHPArFqAP)n5^C^KZyoT7*O8{la!(I1lg61jfAilLbA~DIH{q-g60ST>!(V1Tx{JstvWaaa~QYs7jgjQ^P4C z70ag>0SMke2iiauyuyTP&B`LL)QpbO%_=bAj*)iZP$0%pAs#0oR|ZGM=HGBw4B9~+ z?J_KHJRYnWuR%h!#w(gxjL3bY_>>VbP?56m*1)14XjlXa;SQIAJkC69*QokDdffq5 z!gGPGZ~^PsG&~^yW8e`Ji#vKcgxODoFWW*GIiP38nOWu1HAt#8JR_b98_OI;5W0UC z0D%ZQ_(!d8EQ;+0qxm=Cf#7|w2mkIa?O*Ka^fslS#O~zR(lA# ziKirZx7|(Vwx=ZJQ?Rg!bI(U;_jvriEFb|;!{ck7|3kpxa|$@%`L7zs0EWuB4y>#$ zSljl#hCI(S=0O%e6hOKur&n}K^0pruawlPwS|x2fLMbgy$|2b7oYo_y)ouM9HLdSq zqui$7reWzNGa#G()?Qz*_aB(+t(0%sRu_c5+;a85x>)ba&@;kd24n19kf#8efQTMn zYl;yl`kVqqcn;{1B_E-hg|Me`+oT?y#IVTUUHiDV_HkeBV^{5?zxL6peeA7yWcjkk zQxoS0zUNjs2tH}3Q**!2FiE+RGUQ%bL>9{-;1!($Yl>0Y5I~Af zfm^Z;l8I221ig$3k{wP5$>&8fkd0NjY7LTGw0La|lEG0j&^bxX2P0(hQ#_GOqKhRzZ zH+~Qb0Vf_dU?+@|N=_I(a>9g{RU0DcoeqaF=A$;e0!K%a3Ag~_#uSt$F*uY6gEVyB zVH7G+aPCOqG*WMkRD5;;2>&uatARS zk~;_|Q#nOt^dJbJqFYU1&k4hr=7a&%oG_NQ4r58^pfTnQ_f)(K_J*N*ajl}cg%9F# z4L&NXTv^{`J$&II3paB-Q&hj=sbAIl3$PDPi(<_j6G~k zZ&_TVsr-M)me%02qkyZ{%Mwb{=acAqG-Z$@VFe&)v&A{DiW8J^rg$giXErYG-SP3o zQFiQlKn|lYd4gGK!j&ocwI`X5eT4rSX`EeAw|JVLM2|k<_r!`@?N8zV*3R-Ckw~|q zn;mkzQO4E3GiH?acxlI@>|g`cD0_5kw^)`=12`|N@Y!@OeQY{CHtXugU;;M8jDAwm z;UE(^cY}Z!M3#;r$~2)&=YmU6MP=`$yVsO2E>}wA7DI{?+M_U_!imvLgydH948fC} zR&^ZCWSdn(`Q=h9v{#eF8ed>gF{sKE0vE@0@k|I{2P#cGE+EKFNH1#6x` zFU)6>p|Aye)922-9~Z}*U8XBx*hl;!aXL_o634c2f;=H7urDs0DOyVnZ%BpiUZVqj ze1W!J=(rYOfL!fiPln+fL0AoNe4m4G(SRkyN?>Ws%(9%IWor24$$l#RF17Uz@(G|`$RH1naBN{Q>2PvvVgVC$Er!RmBu?_o3hx;NjRnt z=pZQ2L2F0%J+L{9uKR@qn3lwtyWKfdeM%4$jxfiUs*-4kep!?P?Tkj(2_W3)R^bbA z{9&R~$*f$vqMEFJ;&w-L>x8(i#dFcE;}TR}d+l7*R<5(jA6v2eI=W6gFYjH>D}Otj z3IKTjGKmb2SIT>erMFf;udv-!|HoIV9|0PFVhPRw;(SnPDEMtC_)tez>IOTdZMDwr zCv@H1Y3~PXd2cFxgJq5HKtb1&wf#{!F#}2BDv|)%<94sTH=C1a?%%}vUAATKO(Ve{ zwY%*-yI67|w7=JA?dL1yyLoumzp&T-@%l)qUeMQCujm9$_~>4L?55oGdS4 zCSQx%`#5cG-=mPQdbDv}H)kDgiTmNr{&u_HzVEdSf6U%z$wILE;i1@H{$IP-nm$2u z_uC{-!5aVTnZPC1wXzs|HuD&kdGu>|XP{Mxx*PPuH~n zE^7a)_^*uOsuO>O?0-z2sXs%x(RcqHuXZ-yZNJ+dd2QqEG5bAu30}>pex-lY z$^8{IDc&^*b)Yy9k&e{uxQpk>Z*MYroF5%0LRQyG=Kz$Pi+jOryIhof#0I z4FpMuMwI0QLd~bz>%p*`j8hvxeln8)J~b1->l5EzNXz+4cpz(Axzvc&qEBOLJGnSm zx~?lEmyW>>fSriNp%F42IgWhk;V}82cf|YQ8@oXR(BG#^SDM5s2UD(0YJw9zW4$< z*Joa3G8l=3B6QUyoi^pG3RO4HU%<6d7cYEZsfdfBScEWfX{}hG=_5-9gjn^VuljQ* zJeaOis97Nd*euQ_wlGi-Z{#Qg9%f7Gv{p3!Jz;6lcM39LTN(l0XxPy?tEu66NaT`9n2YB8~N83hf2cV98 zI0g&E({-YJz71juKM=&%KISx5u0X<`v$aA68-d6pk(xoyP4Gi(!!YfL0;t9CpE?ev z4j}oDY5D!T=+@5I)=nTl9OHg9y5);)`Q+hRl<^rS{7HQMt|*_PU985`ujG0zp)abK zs8B5iEM_?PG-3^ONsTbFC~z6$Eakfhf%=zzQ>2W`lk_GfRWBz~fGwN%r&g+;MdTfH zH^gQjA^FtJ%{;w`?inRh+sX|_^e&EEtg@|*?&xDS5~P_`q@JAT`qg!P#3uO)CCY_e zLU+jO`xCGmR1jJLJ}f}ni0=AR4mzN`@F^XzLayI)=L0*fh zSW=V}wocGbh<|iGGQJ{KvS6-d%GEMCXf==GbXF4`c4Sz$);wr{-KL*`Go@#x^X$%S zJ=XPCYNG&k;qmMT)Xh3bx2raf2D-2m`0cJ+SXh5%?}6)u?PsWq-*1th7+|U#4YoVJ zEC0UH*|f{u&E?}i!zG?S#dw=z_BnjZ*8=H699W40Ct(D>sLT=f%j~v5nKLE2I zrCxiv{7Ku#In9DQ?7eQmd%57fZ%}Y`qnygE+=z+{nA&PTA=N-i_`g`IkPrTnhKyGm zuQFM8Fn)ZS+)|O$xx35mb)0-{3;x|?_W26Bowa+d7r2Gvy63aS=Fe2d(a&_Z_hV0| zDfEraj&Y;IJZ-Srr0o6NUkmu%Dt{f`BfZuY&X>`JJwSzJP{afkHbEg2mZ>kSx^X3C zTeY2}ve8EvzP#11LXvm}j=$_^OFg;=$GnUlNr(PCh3$*nPoN#Yk|K!%f$!5XFbiER zaHaME-86TG51>`f4ATS6@ByQZYKH53{A>39pR~;C#^$yiuk0@GWr%-*C=#g4Gi(3+ z9r9=Hpb<}PwG}tM%RVt66D~TzCmgi1AQ1}XD>wu&002fYfLb`gISC#5ATX!66&g7Q z0g4)OMhF5MkT^nKDn^|Vc$hSl6oHpTLrGx}wT7HwV917?A-amfs51m$R}1w*fYW9x zf-vPYlpTcWqoHiNTCFiB&`d*4`pk`%6^PsELpCIdpf!$=0d}mjv5bMn>SrZlV8mSD z3aUH|FCoEVWUe|y{>KHF&v}jxSwkSJ^>KqZ2GkG-fK(qB0WGeNBfC^X91uf&TnMsH zLmW_{;wm9nt`t@b;@Db!P6D^}apb_=5J$Hq)bTOIJv8H28&L`VjwGm1&rDO#B?z@vD5 zIx43SqH+o$YMeqCkpnaGcT1f@sEJdj5TeR^`K)KFoz5Nbr@82Jbb>`1P7ly2O7p+~ z%V@X5EhJ&2k{RFyI?~48c|pQ3j$=N3&p@^XAr&3caS%=A2qX}V#ys`+P7&ha%Vw|+ z_?W$3vEhXFv77;)o4}1dT zyjc`JO6}7R!j1^w=RXF2QSQyD}fE5NC|9}*yX#)=6V-wu20Eiemy4C zgWn~yD|j+VT|wx4zy`z}lspr-O{62?0O+drX91s&GcFtk45wbk z3U*yDAHjn0Mq`_2mkn7H$D(w%cE=#9%*nzNtMcY9^zgF!v|!g}VkOoY-;w^qwk^*C zS3P%JN&lhuYBP>_EmmJjWo~WUll}Ze3K07f3>C|G_|^;2aiL_XmFp+Ue?bF7mO<5d zoDG-W^L0~dkN`APB&dPP2wXtJ<@&UVh^v?cG>~!*mX;5RD%f}f9`5V+zV|)dyJ)N? z>_+Pl+6EpjHPW>wJVAgtstq8AwQa!a!O>=8=*i&}M1rpPA@V>bK$-~2hoDx;Nuz$Yn8UAI@dJ_2PI6riti;Oj&m2`b)T6=!NnPo;GrQlr@V9)JVq! zNYL!oA|#M*osSU`6j1tEAtZnTy*EHXRPl)8dh|MQXI-%vQ!`z2&;))Xe5yjvfqGW% zr^@G${V{1?TvI4b4L_;Ha~k&(wWy17^nE!|HJVY;%HL)O#c>x!bGmu6WzpC4q8`YJ zarOO78qKtKw)`qCK!roZbb(toOCt6R zZ;tIot)Xm18)dD6LxXSf$raf~bWqJ1C|HP3poDmbYll~)Y zMb8(aa;k)vR(W^S_=1$IHZulf_sRnqMRp-RYO)(uwX`C`%cpbB)~;l8P9Bw|ZT&tS zqSGK7`^@7Y&*_5Nxb9EYwb-$Yeo^OZ-#(v8zUm#oy>B={^T@KQbLSK1+nlGXtvFTj zEKbMhWIkr`EDpoC5wJNvd%nqt09Ada^oW}QH9S*_I?rCb@Jz{ao?H3Z=RWiMZSFI_ z-{L&eEeg-zl(lN`RWI_>X_D_7|8Qn+&S!V2X~5~ZE@zNs&Qmu|s>_w4nny+*9vMCN zIu9DCY6QZbA=X6*gz$>S7sPc4{M^g}HMn6m36oh$_5g{c91243twVZ;&`qo4t;dQ` z5*1ZQrw8Z;5|vJOkZRf!a2PXbpXDvm#7l@SbmfA`9S{41O#tlID2x|^pc4(Ot1AF6 zq38r1I+@PFO2S|6&~0)$ZuArEJdEA$m|NgGXP#3C*PLOX?@hQl>AbD+RCDrzzA|E@ z!H8x&0oEB$=(GDo7mXNC&_f$f;0DGMIJNNv&9nQ&ALDh-XwZj4j5N~;id6qb8YEvn za7P|{a;OE8rZb?(?B*31v<-96pi;S^D+>{8tm}2uu##x$P)^bd_tvtngB1Hg%XY*W zdE<*wTRTNiOI+R+FJ5j}O6WMyHxyFh2tlXEvPet-T>zjZo$qZsqdrDY z;_eu}^+CNL^9msiXGG=f1<`ERC$FIk@1`zjYlP6~ie`2Raz`G;y%8VTHLK9RWGZhaUw;IhmLl(UW56jZC{)_d|E9v_tiRA?d$2 z({@|>Z_l*dvNh9&4TjHKkhiQ{PN)uPu)~;p9^>}RJjaG<=;pt2m&3?AZ{6AX$lL2U zqUM91mri9}uA9la3_&qIT<>1_IlIHnlY@@Co_)7y&f=uhG8a`=D-`{6e!JT(4C?%D z=N;XqHn>;K?Xi1|Y6=`8qV@n?gf@q3(2Tp};c%R_ETOZkxdu%rAA=lxRar<5t8bcY;N;kNC@_rV~|ygsj| zZ4dSLP-U*qK4dfzPi_;{c=u4w{>t2acE6DmPYpS{YvyTh&69X%>DuKMeEsCF$tiwW zI<41CyV?VswOBQyw)WRN$pydq0BMAcB?#mG=qCXMhWT7Ao)>CoCDJap*fJa2zl;k zUkv)9n?#2R-SJEOEiV;fN=af90W0?{*vyqU6{h}4W~i$q6oMv4g`lBv-s0OEIBU=$ z_CYd|NF4dIa43KVs*qDqfOJBV>R@5IWJTg=TshGh0#d|rjKgnT)rd|q0W&bfFz}N; z#!z$Cgd9-R*^Xh1f)hsdP8fo`4%3kvCkzPagwX{j3{|cZrq8wM^DD3+J7LV24i7@L z?1YW;D-l?yYR{MOcii~IiF5KJGFW@QBm%v#alRyiRi@9EL;4?0Yra&yAi zV@}vOaf4$Cb?DT~GzRgjnuPg~+>MBx%G}nk^PX)^Bh5;!NEP zh~+94w}*@l_@xUs^mb5z2GHo@=i0L>xGYzlJ|Xo5T_~%4?MPd%@)A~VJeXp-3K3)` z6fHQPbsd7nEzgHo8MNh5dY|5Abj@Ijg#u= zNqn5M#+9rr+Q6q{>X8oJ(M?4LEvHLg@V$W1Sc1Muh%SRn8ObEyifWY3p1FR9Fa?4G zDA!Qf9`%tA7G+sx6}k+WwI+$=X(l{GuZ3WN-l!T3rb6NiOgHc;$iQgQI`dZYK?8a zh2hj$FXJN7O>mHv@#3GYhcqJVYS$cgKdt{?uxe-iLA>)K*=&(TDb9 z?sA2^)pu%=ZUG%#xHNxp>A}?t7lptK9JKn{>yxxwFw*Lihz?o7Z4;D3DBPH~Dbf*u zS-BhDwg5%+I7eig9QoK7ebRt#i5=Xojw~+4s{{x?SANNX=&bCIKO&vY2gxP20a3S9i3_GSr{JmM8PW*zIba0(dzg<?yi-+k>-hB4QJMDPR8h`F^tIE_-aCDMb*Y3K-bd7m=BkK&SLk|}5P153hR$+1BVe8W3g@;N->mhupoIYm$pvsMBhmGM?E< zEDrnl=>1mTv1z+@-t?DK>XMv7CIeVIYLt!sF-OXWoPn>m%QwDJKm2lgt15EadnHi@ z7KGK#x8v!VHrmioBKZ-jmwFLCJiN_I&h`{*jk$0dOcF+2&THnXar7YST9EDXOHzB| zc(^Y!88F^$xEjMqbKX(~s{KUkTL?zuM*p!lld6vK865eYIi`rZb*=Ll&i=;R4St^xEtw8eYJE?l(cLEe`xt%4<4 zbcU7y1JObHC^LoeB_=wpE)1Z!B%gP_1bG7g+J7SQ)=r~Qu+figNB7MQh9H;wZ|61v M=KDs&!0zz>A6eybp#T5? literal 59783 zcmeIb3vgWLbtc$oKoAU*P&e2{U<87$VVVXR5=KAKfW2}zfQHaSqb~?F1X85bA_>YM z0g)P#isMXX#&$e;&U)kcAzOZAEG3?a>Q#VCef@?nDPb_Bgc+E zx_&G%l1O;*^!P|-JUuq(4Go^Z^6(=U*DtJiS1x;lUgtlYTAcky?^(Kb;p(-!*Umn& ze)jU+r7P#puHXIeg_ZRSA4m?T?|%Q4t7{i8zwelo+`WGB+|{#JKX5ljDOTh!&wcpa ziLt|V<0i&OM#mG`!A|eo)eC0i3qSM7)obq<_s(z^!;^mb-oipSUgto zy`kyyV&@yL@vt{Ozfich=r1iEo5E|W+r9XBA~`;i`hLHq?BPz?_=%-rX=-?WvNGX~ zPh~rY=Dm2_o6j%gOTIt5h+|jrP&DFUQ44O-m^VL(nyhz*&*#F@yqwEsd zs5l@^kIA+$2xq+1$UT+O11DdA|M9?$$e3&xJNlNPc|t=1Dsi zr&eQ?8cO8>_1L~V_ZHh%3lv9GaYT)~*>dOf6PuwgKS*QVwUUd4Ybz76w%X)QhfHkZ zm2a%f#oB8ttAEs4TbV+CE0 zEq}IU1zU8WmdnqEx$1UW%f{5oT9eY@_3-X*)V1upLJ#ok`DfJoEV}1D?#oZ{+HzY* zj&t>mki6y__p0BM(bhNn-JkKhS9m9OKXyE#R^-R}w|~;_=A8PuVV9{(B7RR}Gy9Ho zvyN)_#^*vqnbA=Vc$Uh=6HCSEQ^WQH$|UjS%79{VZFIWL>^g2vf$V(?jy~P=SsWb%$kWQr4hi4&9!b^`dmd3qQHrdd2#7m_! zfzcc&A>*ZznC4u5w!n}kl^oH{%?j=MQzMPLW7nTVPxllmixn(uZhpZB_!{GqfP<8Z$Fp4~aw@Z^% zh)1T2&BphV0JQ_U%zNm{)rZes_kJ1#*+r0O7cUdpboTnibEtd&#p|oy_0@~lO!bwA zFy_j|>%*XX-jJNikBp4O1>DN#B^mY? z7D`O=fRvFhlgJ&tE4NPB=%7m)$8i0U2?tN<19o`-5YYz3IdJC0SR@lbkeXTY zl7LC(HF`!c8LkHha6MTwQ-`!7+hhwhxbcMP$Rd5KA2f7L6(8*|F;rm#aW5}pl?2UE6j_Qdq_eLOE3Hu;^~A0&vaP$F>Qa$n#1K5o^l zLO<8Hy7FdvPUnZYgXKf~^J(?F{S(Ur+|w%aHOyN)SJaUc|E22qx)?_H!qfs9dI^ zUZ1x|`9OX7aDBl@eSw;OkCHjWQhMxetb4H2@7lR@Bis7q-1Dm+nQM7|F8qx$_plo4 zuWf$kFI&IlcU8MH&`_3$3ViS-1yDx8W+=*n=re!e zRDNp88wFLMN-a@13}6Rj?~SGmNeKznTz=uyvNsAod2V8zgOij_gZ)w65u7TP7fHP8U?&<5H6(?@Bf{Y}n^yve=ndzUNJI2? zZyqvQV8;2SimZyc<~aB_S*m6F0i@$h&Z+%~1Huw@2gCv7CxwJWnAtyB0iwnPy)nEu zv&@V)xwNq8FL>ywQaLpRBD|D8C65ASWzi1-{Hem?9LL%uw5=}gbmj*Xi*HJoc5o$VRk#HI(!hm&%H8M^vg>GzJ zDr*VTR0e#7K@=&c?-Z8i)PU#JNH7H)=G2U2WnrlicLKyN+eS%n$8L`K5`~?T5I{_T zCM~d}Cy7&|2TFn+)#-#o+b1w-Qx57L1kTi?KYxm`ZQNmi<5{~uM0M$h;_4t10Y!vN zv5ZsW@lg>biN!yX%*4Ire6a$iQ@wIbSEWG2;E>JDs{`kO6f+}ay(z!^&I-x0bs2WB z@u*<@j5jnyJUBNzeAuCPG%tV+5AcFGG7Yo`PHfsTTSVEUyn_enBPcCa4j!a}Bns4I zq+oA40974?rgMImScT1>M*cbULU|Vr4B4WPLr+!1x zPwbl!T%S-}N9prA!I-DUq{&5H#@OX)lE^=q-#IqJl}#9IhNX}nUvDkm(Z#9V zFRVtSNA6(bslA4Oz#V>dMTTEK7=2rmALnuTk7dt`wEmk{^!V!cD7UiHfSiApbE`6g z-zhz@c~k8equJVCQ+lgACA}k?-}zg2J-eZy6aWjc@$~(sAY0QXA_YoX;J$pJtnl$t z5I*VFNdOd5>@l89LO@r?phG@sg#<}J8R-s3RJafl`03FSkk09T6M&nhUlQ^`naX^9 z0^gsYnFN4yjZEn#{iG&o=<|4 z%!2`0@RAVc>e(d$V@(=VRKuG9>}lwU<@PdC!U6e&8|vF80I~%dCm_|HD1cQefL5Sa zDjmcD@9Q6mLxgSWA#pZooU(?teA=Y1tUZK~(d(zMZ#s!%Ws(-q0ecJd18i5-cn6>_ zQr_Tc7Rg?|avfsXM=!4o-#-X#^a#p{Za91H%2g<$sW1*yEaKbiSE#pf54v?6)4?(x zy>|Aep|1YGh3oGYbp1Xwp~o+O;QePm0Ku)|vLQ=YEI>_jPholi652&2tp)tY=fWkV zszf&7<>|;Hne~YFLJ??B^%%o&ZqA5}fHpcN5|`L)YDUjOBKTjUp-?zF-zHkbkL4n{ zmRuOB#*_S=??U491ap{ot;~SUQI%g`IS!UdWu9G`g#s{|>rnZf!x{!aYPPf2}Nw$g()>zgX z86HVwlc@|o>cjibu zTS8djmuFUPYyC7&{$s0=nYC!*w&TUux9`k(T=tF9&VC%TGtVAhd+EN7znDAp+{Rze zc5@XLO0qPtXtX-wh4PaO4Z-0|tCf_CC7$RM*cf>q^vw_m#?BvrIECi*E$scbzV$Nx z;QyB+A$mwZh}S0jqs%Fiyhu>Fthq3-cvf?n)fRvm(KSMotd(q*@x}j`_t!D21jN{*+k?xyY}ScrVhF6712-RGavvR$ins88{b? zj)e2;9j|?H725jsj#v0>DuaWsHEzT+jYapZT>jawzjA5!Gc|SGi;>Ge`wR*`r}7XO z7yBZ|(d=tfs+-l;P z3zpT%LC}1L&lDIQr#NfXy!9K7R$8sa`%UMt;uCj`li0^6u_f0cglu=8O69__?wTCP zAyDNS)tMB3g@%>_sFU}1OQPMqWwcn5R%^)XhRoB;kI;6J8c-hwQUj_(f+ehkZVR=X z*y$8q-}x}kz|%AHC(IF0G3P!ckWG{pO)nWn#^{5Q*g#|~>#D&YLUhC)wG7FDD; zb+(7M1NR_|eY z$7%aOa*{C|CDT#@UIH3FMTyNrQ%-y{2^%0tV6ciDsSr>Knb;)NVyQtT;V2`9g!Da= zU!0*X@Y)vgDx-7|WD(cI0M1y&$=t{yPFvf##&BT$33^S=yq#gO1_%sHKz~C6ai}L0 zx_woQm!cj%x^0GJwSs%9y|qRNUG0Ga zad*puo!maZ`{A1}Rl7ICzsjIXo+1tMUqDT_bwP$#rT5m9>D0aU;C)>etwp;det+xE zTMno$A>yX4yEelkEmf~}+#m2gIiLQ(+Dp{|5QgDu|Hg|xW^>!_*85cFIc4Q`QV(|0 z4)%;1>?8&|;14z%tmR*~R1ejP{z3nc8tfnjJ6Q7v!_~o!7om{cO8b2~@5m{7HsWqV z%P;UIti3oMs%`wGO2c4o<4-V27^*!Y#)OWo-HP8!26lcQS=jjz*wvkmMq;xKMs%}v zHgwfk?zrE_qWT)9^X3V^_oZ`fn=QBTpnfdYQQP=G*GNPBzblg8nD;dfc_tcpOQ~VV zQp1om(sX|1Q#{6vVLz6ekQq#9QGPonfdg|th?>K5plRlK@3-$%^>Pk24my+EQdNH6 z<64ZfZ>O~YTSHX=WzNQM-Vxo@)VXaumoE#k0S4oM--WjZ{YW={x@((%dzj%}UcJ&7 z*ouum10^*Ev9!q2MddmQF}j04M#XSU(+ebJZWJ{*8UTXliy#+E1xGZWfk0i;WEn`u zExLxp6fnk;7T6QHS6UU7V@W%f)oOP>z>Mt=UA`> zo*QN!lf)?ea2!$tc{mPvx_&qgGq7f}k%!|f7P9bMbGFc-C=86pogD-sP;?TB&<*7U zxddjW?BN{aI{^Ptpm!1ps22j3T~Z{{S1Cv+R0Mnog5b3# z=o0IvrYuxo5<^>bljylpn41R%8)4p+nhC=ItYa`0;Wmq{6i(9xw_?8y+4AB2As8|J zS_cEEXtdMsZe@+;H&?q)a^j=);LEX2CUFCRCs`*?3DhThWo@NgkRmcp4p=J#EUfrl zWUw5GM&9g48UUXkse^nB#O^yD3Af~md2N4uAD7+;MO*gyy`S}al@;*TU9|%n{{c$Q zmS=Novv+iz`h*|byqWg9!$6WZ-yx7sG}f+7u$1_!!m$EYB^}jXvH~VKsropZSivU1 z2G`eGXcC7o&9R3eb&hJhhqnen1#1=?hcybmSs_VT9Y{(%0cK6+0&rAcX{Q2+Xg+_O zdJ;Lxmq@Z-mBQdE1u>&akw#LCZD1X1fkb?yi47?vl6Bv-Hqm05Q<0U6F1cx~aW#=y zuk@+Y`M^SteIr~7ZEtr4a0wp+v)mSqgcuvyKaAZt>sZyZour`nlM_!&ZXL+YOzgB? zn%rr7_$H&>U(j5xpw;{i2sb{I(P+3RIC}cNogPVY?-xZGvhj-K7#nW<6&MwW*|o?W zC{cqo92ljq#jzuu;KZp4>~2W9WHR6qNDi+!6^LU4X9T-Tk~P^SQVpw=mCJ&#HUN;U zn48!FHC~_s5KoomG+ClH?a5T zgyrs8iR}PQqu;0_E_W@&tZu`+3;r(T>n@fjOG}U~X_S%zUkaC;WB&9p`5M9KBw-sT zG6Q4?=V(VEa8b+oMLHtH4~;-zpt&e$Qkjne{WU-Nb|j$<;Z_+)7*T|hG^K!xh}|J= zXPLD>NMbm~a)h>MZHi;VxU2*v0;dF2g_-833rIA>M%)1lL6ju6HG4-Wbenuk=Rzy; zdi$c^>XH}#!Z_>}Nm1AO7E#c>5Q9b2uWyF`-~3K@&WbDe6Fj{Wks>k1QR>F+o>{K_ ziqm{GG6li>N2TIZ7ppzB*^L8A&&QqexBjdJ7M$Ww_c?iJ>(1GdK!*MD9G_2qY~v^Q ztg87vUy|o*qVKGgo?SiH4*Gp2cznZOpHZe~HK+U46+w6k2JxiS2Qtq30h8teujXK+cadkTroBcs zdJo^6dl{3FU_J#}32lmEIgtU8payU($kOCcBTs88 zsN!3Z6P!2<9V4J$NfBE$IaBcg*pko}z0sga z#}bK@J70~q*c#SETEx|J) zfmte)PpWsF1m8;-pU@GEpTPoRTmql$+MK|~T6%zN#N67r^;>gQ4sqNK%hIk?PMMcwDtt0o}jZ2Fz7tkQVdphwFpo)keWNYV%0N{Qi@%u)jL#SmDbuVB2yUkpCg$W|uHfWwx}BV3xt`(e z5QZ|1_sT|aX>4)v^7-{gS1!PZ&mw!*pe=wdD*yWNnbjv*=W~$t0+Kac9H4WOe8{==`XQOOB^7?p%g*2WL0-K>vj>&euJ)2qmY_6OZEfv z>le;myWpK)y>bOV*H^)qub%~D4ks_pX=>@Ai&w9~hYOZtsh~+3sGv+!GX%(T22bl3 zdDd7W?Dt^gI9NXW@C6U9VKm@FtQC3lcf0gOa~L9%x80Vi3znF_rolo%p?586(k11j;!X;l_pt0MLJEJ3G5pFF_} zRjhr-;VS;$dc&bML6*^faQj5GrDHPM@+QHrH~KUwa^KD&2jwyr=0BEfyDxTM?RfN? ziU(tY@o}zYGElkYFkuOOX;G0`e)rZx;zbT}@K7zkaUjp#uG)Ujg&`gl@qKkjP;}mp z`4PXHDILf?cRHjCKk`cTNX zEXJ$-O2n~!)bI0;zP9xah^_sj|9-~zcu-ho_#VWqp6(dkX?b@Z)Q&&2b356qUlJn| z|H#fbra2<>dQ5&c-qx_xn$+m&QwOg&f**L4chr_gct6ED!j%EB@Mt-~J0yZ2@>2ha zTk%q_4k`|yy*e<1g$_dh(C>SS9+VyPd;I|ra%%g!zc5oo!vVinQF6k0%U{0_q#V_P zmQy7Iv3-&PB_|0*$hnzb$$*U0qipqwIY_N2>#Y?v6(=p&_>!r(nK~+NhN(Dqd+_@& zfl8MSE)r)-f?AhM!$+_1W{^w+2vp_G$u#mYHq=H2AWf5L8TRX=&uu9{rlldnb;z_d zQEl>B1_`bdaI*Gg_6RkpR?V1Y=qL^A?07?`fJYQblZ2Q9s9#B-lfWwuHIl?sol5Y} zLW~d|a%s8*+F5j&fZ?5{@I)X?i$y>4J`|PkJTmlDJTQ11LS=`3f*{=yloJ-SQ;AzE z9&-AQ10`!R3A?6gJoJvF`02xH&RLjC<79v;H3rQ9N18Ouxh*ct;9M|`LlFj?VhGt4 zjl&vuO%`N;3Y=B}yZLn1?SZHl+cIc}Z>Gsqw#XP#z}@v;)=*1p1fFb^?(@9e#B_@Q*#;pE5f#`YmOO!caR~~L5&9`s6$vrJ9%h^*A|eSg zHDIC+3IR3=uDr?vQ9G!Pw~Nye!-t~$u*>-6E8evW>le;nCy(-L7p@O_IDUa%G*y80 z{Jrf#^r~PRZv61@{>b5+ZRv@$XK(Rj(7>EbL`39A{^6i0ga;tMJ6J#}r&_2RU<1># zKXiMjg;CrIi%J(i#U&dtF(3IP=RRT);rTGY*h1fVv1ed#&ksAU=2SZ`!kjGsto~7G zUdEBqj-A#MoM$Fpu%3D#eCf5V-lb2^pIGF&U(|{7`)Vf`T&e>a831c zl$%QCMC_;}7)*b4zRnwN-a5kpDmw!G02HQR2yY056FB<<>D~+LRyZ_+nNoyM9Pm~F z!8qI0GRL$8TNfh39J5JPgiuqE;5PDL1bo0UBLskFSv;IIJ`WyzubeRfEu;g(0uuK~ zhK8=;aKa(H30mqy7suzIK1+N%dKu2QMzI@IF}a<9y=PNw=qGd+;1O#oC|`M{TB=KB!pc9W?7eA1+0c2z+3Gzu*Trd=(oDB|g?eJk1RJ&jPeta)Ohyvnzs0@KOXIbTtexvw~U?jX$fP0Jck!$%ZsP_hvAK0AV z3+QN$e?WX}{l^PB-3c&2WIL3rB!$K9LIBJ5GJuNgkc&cz3&95e$Tj-6$Y;+6GfU!# zlC}QB;2mISN?iuQ01C9DFMGEbPZywI=HZw%7+zi|A_N0Tl<5^KG>ac7V%y2>#OnwMK~JLX^W?Q0@0)5JG=QdfECJ<@>)c3Y(QR*rTXXLfjal(Sfas z-@i5QixcdPuI+J^^!r=bDyIh7q^^}Abasw70eOyMLFq;v8(&eI!aF2uuJ(cOUgZL} zvp_-&dqTq(;P^GX5D&?rewcQJaqf)hwwF`;C)WqYMV8bf_f215LA@@-(JcPpZ zWPxx6e6vVZRtjDRfD|5uR-MS?ED*uq%9YC(AnF30U_55f79uKkngRXWq}ah+fp~>@ zX+$LewgX>Ik`*PENR9=VH2X7x(&z9kI)n?}CW{G`nI)vtj?pE!6KXu2uaGqh@U_BZ zIQmBOx=7jrRBBw(3}0ZMOnVV}0nHj7Q;ETFS{IhszYN_0#cBeVa)j|z%o&_;;5E@{ z;)DSCs5B!Y5qaVXpgcOUN=ycwDmmDq95cbYr4-%>69!_HiV_fgv|*sV4C2ICDtu#_ z_Z49nLHm^Ofs!08l?t+Aq((urIm>UyeLPb{3Iv z%Calx!aOG)MhUjoUak&QJvC-!>rVfmpyY$Ph*2N8e>|J>yE&t3PHs);6hDHHJ273* zvV1Q$-M*{7zmr^EP1P<|hd<;GKQXuUll4vH(Q1aoh~$|23IE{M7@6O~9m&sZ$9z3E z+wdS&Lq0ZG@-u#Rzfc%7XMcFh_Xl~^5|bzo)7n8lrBL%han7juHnAR-6+1<1QZl<9 zMu$f?Z_CJ=ZLf}#0zUM(KYm*){_rj!|119B=L2K@j6b~Hr(a)0?a{bw&>6FOh%fzt z-R;p^Sz^LnqDRKa2mNlnD(o!3FFj({6PqpnyndK>`-5A5x1lCr)%)}Q;7-c)&!>!+ z6K(PQ+*ZNVtogY+y7Fq1Hxlw5C>qoDzsaxPlx@}3zK8vV_;$5ASljq5KD1&&$8uc} z!1~@RXmVg9hP~>hS1GbzdW_#TZ$-ZzUPY98MCD(QFi`&B%4h9FR(E%|{LyY*A`FLgqXQujiS_y^T_p?4xDMJ9sttg_Yq&G1wDfNh4K)D`X3_pnLF$Nl%v ziF%JZQQ@Cg4fa?;H33t1oPOOs@9Wm$Ev)KY{@`!8M-`{{1>H?>U8vb`&JaE~I6B?h z_ZT>=dX6lvr-Pf=dZ)X(tzy%Iu`%p6+CFF-H91DDbRP6F!qwPLTxXyY!0G*Koo!$9 zd!ma&{`ATVVLFuOdBZmz;GgXt)hy@7ct@)-Vjg07{d8M>f?v;wO6X8njZ1Dc%%=3rzzL`l0UuP#v{F4Jzm%3!!Lw?aeZpHI*(=m*(Lw@Yum&A z{9}IEFa7Z!gg!#Qzh9lH`BVPH>)V*463+WmP>D>{Hva8_^7aAwhCTx|$t(UyUv)(9 z5zqT8^hwG2Z2$9LaWd{^wpZ`QHoeuq8^-ni-8}i<_6Mt3^i&=EkbWL9V>kci9*W6y z*k9mA6qM;T|IpSU|KM*-{O;uM0BS5TZ-WPmZt(E6|rngUoe7?!-_9c=%9j7-3fm6zrw z5KADQ0Zke(Wr?S;N4lxRrcaLsY(CP~B4wdKa~?L_2UsYzh!pf3x)*+swHjU_XXFC(t9yw5B92Yd(c#I~5IH(9(&g65Pv^6$t zU_1_H*M<}%hScoo2pA%DE=B@k!$!9c7$w`bU}5Y4WAwgs$ighFMGOl(tUN-pSh&^t zWHAyMQ^mb3I4s_VESMfikns(ffjcPvdGk~-HZ^9qO$mzR+uu`cfiN0pWo zh5wT8*3lLQr=7y?HJx_S8pk)8wj*(AR*To$d{N2ZaAy0IUk;Rz&7VtPHg+=-8Tf60 zD`Za}a?F(DGhJF*oEct1G(-gK7A8^z>clq5vW>G&!hEmw`%cmv7s4UV6MZe}bEX;E zh?LgyJP8!h+f_a;^DI7A@AY~*m zFe@@cPy{a3fK-$!>G}~tiC}e&@dUnb-3UT^l_aA&okVmMoiy?wC_ro}K!a*90x^(I z;(O9byF(*rt7Sg%5j)<9+1fDxZFz3Y^e|@DG-kGHj07CK!C5l@<`j8ysT3e8#2;)C z3K&5mv&92TrczUVK?}V?Q5!^$OZ?NS7 zMVE=O4KO0=J>@)s4TlcxkSL>cJPkxKV16_gW*(nNGtwl9vW@T(#D>8795|?OvRFYj zAPc0k133?@cqQ1M8Vf;%*lU~gF_Vb3G{?%A$r!JmJCTN@}^Vyr|+UbA8$o4mrsdq<9G5o+Y7~}pzj(;KEWaW6|Tce zcYv{>CvX515duF5#{Sqtpwd0w`(72i@f5-(uq%@@y!w2_uUq|x!JCA0`JIcGqT!aA zqFwGxQ7`vEesy=}0ipGy9NlGSKbHKoirv<|GjS;&ow%*|%??Diej#-GbH#6lUugBn z==}cL%-YK*ORsGY%zbWl1{~EdGvBiD$=R9T|9b8?GXop{iGz3$e&shw#=)|F4>-{f z2&NDkYSmB?_Vz3YVW5r{9uV5sIY}cpNm%W-zirk@8NE=XZBnP`$Z3iMU|fc_lLZMw zv$k`Lx*?cm!fl!v>=+G%A$uAv5X@{gXX2ena3J!Vegf{X!*Or?w6RPDV^o%Ah z?Xm#x=O;{nnVp}W$gf2gZ!ZeRt@vN!ioX#ox)FMQ4xzSr<6nL*P^Wp}uG-w%%lG4* zz0L3XWO)uR?Zf4{-+%V_%f_K5pedShXA_>QtH6Va;tT=rvUp|HH zK7`ZIlG}MZ12+4IL4dl>MnuOr1E5tc$%JnVr%(ZNz<P2;1$V2sYk)n-!~VpeJE|++Rd%*yAZAp;1EkPv43?dJyjq zR~%h}4QBM4`(#@XII=N>K=g~fQVSVqV=YAcO$vvU!K*w7WB`j)Q4mWBg;#3`?^Qjj z+W1E=cZ6O&g)en~kwB%y@mk$Aem-c>7JBu*OS@k=4(uV95q)v(gO^@x*CxDZ5e~h2 z8ZBngLj0zVF~wpXh$Y7?V2F*{bfGoSFQ)gEfoLv6&0nfnRbeOY_8+DlD(sY$QxCTxZ}Wc;lB zA)Ft1vye}>ey)Xsf(UB5`1JcAQrq2r&_9H5X1;`F-(G;KL)nPG&_)7I?K;>7srHu` zkZcS|k6f>c+*ZHEtv)C*KR-w|6FHa>_e-pc8GOd0AmSa1(NQ2p`cUNBA82bWX3T)G z;wqRz!h?w%PBo!{Z&Rm9PGiz!Xr>u&d}%tJB$F=)OoI_fi)o~PvJG$T#{7mrY;$nOA;{C z){%3(lMA#Y&lg)4hxE_Mfmw2L0IyCCOq0!VtV5F}jQsYW6WUN9e-jypLPxNDP?3~G zMX$gwYvPG=5im`GEght_N_6CUfejD)Q^6j$6W}cw7@UHPA5K zx6QVa%X`Z=a&tm#%#~(Dtyo%n>ABhP>5Xq8SQzlnQiW#(3R~ejT2Vc|^T7280YO9s z6Dp7=Ye9>pE)4CBlPgqY1~Ic2@h%aDr5~gr`bQz^%YrV{rQ|=69G{Na&l<{=VZs+5+JT`oSCz`U79nyol^s~ zqYb=dAMm?uvoh}Y)53h!tYhn_P7$o%9&myEQ@XPbp2A1#Ca$A4b$&s&>ulamSMU2c z@aG3F$$&4kW4tGUFHHeK-6w$_Z2=(flb2hZ0`MPCtbfop7@>U5!mC1jWQrlW*AoEq zWw09r8zdA*NIyLj{oS%Z1yhWSMJO`AfqgJS34n9u;3+_kZ1ikP!hlW=B6=r>nK(Hz zl(wKA@)?^;K>F|Gz{5K^EYrz>>34D#zhSzTsauou4a~ zPEnjcvxQ`7WZJs;fY_5d*>!+Dv63nW>W`7^q>&8Ptje7#Y+I05`3uXd7}!mtE7)x& zQ4e;Twb8r^_z2wFNAV=Ez7tCbjf)gyf%yp)2nkkP`3b&5mJF&WjTR6D;&xDV`K<}y zhceW0hts8dkPL7pE@PtN0y0F`k~+IPt-pj&wBZNAqlE54#CVdgtQ2EiwQl+J8@Da` z@%_hHRoqw=3+-7G-m|7{&zkl699*q}mPN;O4K>XiCs6Va#n##tnEr=T*CKuDZ!# z?{&0!qOlE{#1N2APv!nKJ(ESaRbpPcVv1%Za~z|ZHdAv1F$c};QPXZ`e|uo|eH=V+ z2S!r}VLeE85gfg6^X3Kr;32ZKdCm988?$_A_p6q*`c1#P3`6E_Kl0Yv+&cJ}KC(+` z$@_h@eDQ8UKCX8b5sU-Tqhr0bJ*)b36_a4Go?x~=m>mdayMx(SFpDUSaw?_g!9ez7 z#IyE=0%fs-D$e9=>E*wD?F)gYaeFa$)1>Oi-c{hx_j*dlwB!!Adh=}IBdW{G?hMkNbDty@E~Kve??kXu6-Pijb4;?#_i3RcyC zi*Rc|*6SK*oOBX$6rCg~nmn2zeVs~z71Bw%{#OEbXGo;1l0+j&TfQGyF>Z7bjz-!k zpkU)z$hu6;-N8iJRDg@K(*@edf^5(?@?|lINt08*x~zK?tfEPSG%#tX%uJdDJ*s^M z${3RdS#Q!%A(=FkIwlS0MU%#gbUF=JNt4FvbUKASpYrL#@~OfkRO%(f)z&3&1ffe$ zr`QKo8i^+)F?fu%!`mM^^j!d3Be zQkUAk+xx(kM-h z=E|BW!Nu&15N^R&51Kn z%SkDBRXa{9p_V_@6YV9QeyCPGe3>c>f%j*>MUOFB_0uo{=CZiLTqMhT1 z5@eSrDNqcOB7bd_G7?HhXhOTfPnbm*`#9K+NEKPaNw0cNRt)64LJ(_YniwQ}#&ANU z#E>LJ9=n837IJ5Y@X3PI)PxV2E}G}EkmU<0lhvfmD5M&i@EFA|nl$!Nr!x?ho3ul- zWUxL{4no$Xq46+j$U98hAvh@(g)S#sR+EMufk|VNbUFn}O{d9o&k}2N-4^BGr3T@R zrrIcin`HP-X+`cq^uPpM(jnT&woms=Hc2M!%p?JYfG(%owM^PsHHA^te)wDz16eVyoaw`r6^WsFC!ch3o@=zG>K!!&Y!*f&gJ0l8Ur=0K5mx>(<-#L;GQu(c4 z)C@TdhT|?f<@fbFx7BZ1EZ(= zlp)N-+VpxjI&}xh2XJ3QF+$fga0^g8jna;4AK%w7P|JTohLEdJgX4(y->e&`yOAQAYDLKp)P{>BB8`tC_dH2!TumTAO_(>6s~%>tpRhvZ4D3U z+ZuS*v1XSwJg3H@%NpL|A8I;Qx&^_lO8$_4L=->%5XKsU7elyuNG@wg_yeC+PUdSb z;wpw*iFX@xX8v&*fNyKi8`1J@Oc3(=&6ai@yNWMPn1K>_#qWpycf}vzyBcDMDt>=7 z(lgf(KYXq(e0a4tH|q~5zlDLFcd01f?DPTg)F)M52mfwcZ+(eW&JX|XOD8vehKVLz z646m}AKN~r*2JA`-StLYq}`_5hum(qdK(@L^Voj>OD8u&|FQ7`iRSz80AgyD8}^~x zun&-Z?cC#BAkmwfk!_h#^SIIe5-y1%BZBRpA}fMVD=PxrAR&R!<>cxcBxqYUHuV|? z9@o(X^bHd73~rG4WtR2uS;Ia;7$^5a_&wzD)>GU3|Gvh=l)fLL7k*J2{|WRHsWc=E zl^APgDQc0%kGI3~Vbb(??GIpuuqS z1Mq;p`2l!J(Ig2X5t=;5>~?}fckSDoXFjZ-oF(%yP5u?gLibyIAvP!44d2t#qN0ni_RSJ42l>+&p zQb3F<1%xjtx@@X$DoKz}dZtO}e57H5g^tQ@8KOqrg0yft4bLB&cGgQ*c$hZ8u_kT8 zDX;}FXsN;C!;f6KcJ1Oh1eE0aCFH7!^H&f`^x|dDB71w?1m0bpahf3neu&m-i8oOB zm~(3&XTv2KcxX&IS7?c6~&P*3Ynj;?iC zgsjV&+dx?Zvj`cOkq+W1Qb0VW6cB7nWo^tN(5k;$?Wacl)Tp1=DUFPAR|IBe)d6ZV zKy3z`Hpb#A0!yTwHcx|Lv}1{Y!)FU%@JyIgxVajZLG0b1Zu3K z)Z{2NIqEdgL(Lgmv$8QYn_X#ryam=QOt);TJbi8s*zt^WyVCsZoMS@v{V*{jv$6~r zSk?t2-~(btu_KpO3J~{1CT3zs=Gbb=`;xqRGOfl zNfTDm%ca`@z!a2 z6k~m^-5B7zQ;7-L9L2J9asfqrI-rP8yWvAT@@ccrk-)*p1q=p=FtByZW?It%Xnt&6 zBCxgu`NNu)6d%UP!H31k1#HS-vtg?sQL&j@u^Ow_(;I+{_aX9UYXk*Z5v-+*&>9%e z3aue;C`{*vjsZrD)0n&z}yIs*o-lFAtq3>qR6n-O9Cf!RLt`Dms)RrUPL(a)kVuNYB_w=4LR(28pz5gH|iD@Y&P5%fjbFwJL7gv)#a<`;b|yZpp&u zBeg16J*Opd4K06g!spcpNqu{A{?QgNv{la^bf$uwor-_dmHHkwQrk6Gf*Upx+}1h? z?&F)^`EwZd8iS}&XzdK!K?JLa^D+cgS+K{@SqnR14P*qLfORHK@yK)=7P2ZqDGOOu z+7Ys*&G5{o@Hnoctrk2INvq_H099HzN?K@sgd**#6v$PT0 zi6a@S8HpnyBF=cEnpY}gSig$O7zjr9Mz;f+G|rMqV@q_J98OKzkwnrJPP!Z$q?2TM zr`C@nppw|ofbO^6;MO7oIy6j43xSS}C5pNkoNxK}pn}2*>V={od((`va}}pLA(3!V z7IX8Q<3G3}+LnNd-qTx8Lvys*OQWfpxHhgNt{8Bg9)4`&+Qi27jqoTLt#Z6X{v=c8 zt0uBVeWpgyk$@Oo!!ZXYfb*A@tT0hVIU90`E>f&

z6 z)+|BlV2YKc4BNblB`Oob%H$Nsp6-=)2qi!Yo1^g0PA)*CC9!U&j^p2H?}cQ5V5Cpn zwoC*J|4EDB)IoCM}%G6f^!Qqrb?Nhv^rIQaemJl@Q}ZzNN&jkMMS)}x?C$&Qq5LzTfOgfn6= z%DNP7Flug|Ao`UoH1I11qt-4|FERX&?=V7xfGueBAG~Q#lfM71Y(Bfl=JT|kt84M; znpWQVh8CZ*V3lDv5Apaj+z-ReJ`O7jV+_ z6yd|PaV*;?XoM+;1%Xbd97=`)zi1MWu7R-h6_%#dxS)1~r~>h1$ucs}Gp#A|iXy=< zVQw8Dsaz$lLyl3f2t6xTp$jTr7h`L567~l=+0Grv zGyyuTBUN^JIt$S>g)r4&Oi8-!gjS`V-oA*wKq4AwsY9z81KK8`xJlNILB&^WktC@Q zSsP@dLaPGCI-yksr4UM>))ZVqhgJnzG@(^t2xmg8!Y3QI8);p$y2L<{osid42vUxs zDikQB!m4w~?Mc;4_#8h_PNVxpe*tNXqynoFX|OOC46KUi67_*qNn5QELY>0;?-Mr_ zm{ycBIy9=;I>b!{x(`;W1B1A!4;*shrhab$Q~$36(O*;dHr@!WhY=1hQxoH^ke~Tu z{D*LQT{>uLm(&DhfI3ZP!e8@lY#Ozl5)*e*x zQxiZLJLi25K~`a(NI@MF2(qeU!rDe2RnwhA$Nhvqq9Tye+WaF>0ZUMI4zl`Hie##z zk#d8f&D%a9FQUDgWxTrOX9+81HCB4UANUQo4CENae-=(OQH#Wx-Jyu1I~6MB@o zoj-!`k#ekQo7C5(3Us#GyV?3d-xFWZ&DKY8Xmk~~+`4Y211hW8loxMd%I|7CGOy`z zf|JH!`j6lBo#AjxNYn52ed(nUjm9r%7$HriQ0ya`gf#7kDekb_=nX@f_QNKF0;W2h zuI?hruU;+8n|Ja$gR5h4M*mm0FJ8z>VwtLuL>BO8tnu z*^ZqyKf>RcbNyR2LV-{tX2dq#w@&b~zpP6s5USdvb`=P9v*jHe33aNb=V2qEPE!!m zyLIT7>O@@=9sPx3odO~w-sx-G@AhXN^QZkOj)aQe->>Fs{(JoK*SFu6_jBKt(}|Rk zkoxZdE&ZO_#`6a@L!UL13+{{)n+6e7zc2F~-gBOa*s88Q)>Hep2TC?#Yd<2k9_@qm zvzjY!@K*>(D5#2vtv17FWq{(lc2(6K86DNG&A+*m#8li1QH$MrZ=btW1)hXj$sN;MAk71AAuWkCEP5eQfU>D zH4Dl*5QH^r%#IE1S# zBvwtg3=BgtHiN^YA%N0NWtcQYt*{HD(1$j-5hC$`&rv%5h!NY#++7i|mk`p6xP5$@$JUHx;sq zQMH}Ch)i&HhDY-1qOh7i;Cciede6?&_`=K%r6Jz43rdp#yXMeIOJh5+!=@+{i>6!lEl5Xtr=Ulg)Gsur5Kua1qmp(v>981L=VzS)1auD zC!zy3pEp))WPERWk7HW+0_jC?q-WS=nL1{w#4-yOV`?Db01H$61cj(lMpuwuAo{em z@IuBh=AuBG);bF>$YyYYYzC%UCX>ba6&o=Ge6dMMM$K?Z8)cO4V^q)4wKh6wY~$i|o4G2b_otI~!U=4Z zDvd)@ZWc{91##>&y3a-eZIVnn5NR_GAZZ_fj9+y$VmEBW?#BoKhHikKbP`{nPMTdB zgK$X-$AAG;$~gsNIJT-308dg`V>p;KPjet=36hFcsCLGRaTLH;PoDxb({kyGab7J2 zJ8~CGuD#Mh#yL-El+t5qY#l$A2L5y(OGCY($Dpgir3<>`UQ*-=qf+>wRLZd+Okyqi zd3wV%7~SX1gC)_SJ6IBXX&S>Yh#PZo@5+pqz)Nu(Q?w}EIDsBb8fU|#$!rAH^CYdI zTj!}m606C1z%g_?q;Mm;F&VaUV}LMe3~g+nF(9Wt+V@gzW0@ zjfgM^-RdzROB2vwqqO1+)U{@AfDeEckO2lFt|B%CaCxwZ{9}S8X)HNdk_1?2cg>+(3=h`xFtm*iZ&sja#YMMF@axQi*v1I~*S(lEy-c z3u;_^h(H^;H(62W7ru1NQ`h66twJb2I-jBN-O)Oqp@nu4qu#pD5WKGaF7X-a(LO_c z&3uM>_w*Txkw%{d5!O8oD4I zE;j63(+%gEGttN$r3R;xQoU124`e<&eSVMP-e>$C#gUT-%YWgt-$Q;Pf5zS{fA}DU zl(}og@#?7`7+yV*Tkz`Pf#)1=mLBWPV&(vE7R1clP9U<&V-hrT`;hpss6B@Zmdt$P zkTcicQLFI#A6J`uL;JKy*Y!RvJ@9FXK%^4E{W#>)602=~r+NY%l@+M zd|JpFNo(71Z!ZicWK`o|FggPCra)utR{TQYU9&4v4k!#M?QZLtBfak_TItufFM zHB2qgWd&jlpy_hldVwi@f80yxnsMu1LZ(-W05ZY-Q;+~Cvd7TC#NVhghg_%IGwVG$ zP%RA;uq0C{=uGRH;bH_ph1Lh4XT?$;J=Y+X5<6QUub{<|lFe?!O~bVD*)A zz+Z8?;IC^Ywol?pp3ZyU$_GOx-QQUBKw}XUTTuBUoc5)ZhQHN5+r9BSZH7 zN8pe__Ho1$vL%&r$RJ6llG$W}MpgvFRZZGyMbT+>IYl@!Y4F@SO>t>Wn#75!pCmw% zPLu1QNjtcJyb6@b2gmgl^ANgCLboPyut|fr(rFU=aBFZwqmZX*_Y81d2E2H5eU%F9 z>-r&NAjNduGXUb9XTWDWIhaw~9C1%hE?}3J4tRj1AvLxwDI%tm3&xKG2C#J$DZt5r z%eFbXi^R!67~$lAT5Jxt-ncn3N^valG`|kkSm7u_H>L%VyuoO`f?bupg{7^3Y|VE0 zpWJ-ylZfK~%GxV2CxYRRt=WET&E}ZJ_2!3fkLlKZMqhBvxa}kpVINr9}ST=-fJ>Q^Lyb+vpX_ z0~bzrE%8WlyC|qxY0*X0yVd>})u+J&V6VtPPg#=>Pa}}!FfGLc{&s!y5o{22zP?3} z!Y4bmKug$ts}oVSoIMv; zZ5gdtXvBzxK)p1GfS@SSA|UW&S_A~X%Mk&QY=}fan52Y}A^&v}{NM_`1zi3#kIX1% zXvxMi5e%<77Gw~}Q??=@$cxorP~X_G*!)mNLxUe?oSBv~Pxeqkt$lIm5D7_YdLgO#OcCENJIcAiM#vV~2xgK{=v&6#e90q-F9j-{#Un`oXWPVx zRz?unsZmHX0xMg$)aj9gH{4+ZY*6DM^nnEf5ZeGK=x`q344iNtNw{%ac}o&1C9VG; zR~Px(iL;PY0wxVAWz=+}*HvX8<@M7EGE`w1LS;Q1(LNlq57we>ZW8 zvquW^U>+Q`>PIT^XuWTsQR4Ayy&`@fiARH|!soCkP!!lAC2VX9|t5SkBEeXq|7q+7{X6U3Nb1WEXWB` z@w-Z3BK5x@If|p9E)Al9729{Y5i7o`o{&q0Zbb~!Jf4LUhJylQG!JOu1foD-j6sSH zQ6JEvO-F}7z*GdrI7n^k16s5N17kD|Xi*m!qj^9JXFdpw(KMh%yE7jI#%LPRqAoDT zFwJ?GqFxO1YvKSK!N3@}HRCCNgqn;vP4rNKz!>s=W}iNfNEkc&5eehz4!N;vb@yri z`x*=*79z<@7Qo7pyo|zbNlPwBDXY^N0-RbRL%xGLP40$T9s|f`(l9$PX-688f)ZDk zlN+#3Cjr+?8t8y1HGqFR0YU(BD@ir}iEKcL9nmwzq#OJKQ_?Cke|j!)qj99G5cWwxUR`Re3ioi79D)a7rE+T0pX2+mg^fB!Y(I(?!8I(*=TDrdD~8Dw zwOCZeQ0V`kR9Lp73Ne66HL8P^nn(Hib_!o;=?QIptBqpk zah?QafpHvOE|#bKWjhKK&5Mi6{=$@6gPt;KoJuyua|?_( zEMF=eHrv=K`&cYbmX@Xpdu^qvRZai^QvvQ3=(OErJg=isV81ylBpW5wo*g42Wxl_d4=>G;PK6qZFovNw#5&ul zX)u4+?}6;3n?FW1^^Y|UX(SOcr0$kxqaHRb^h~K^Qy7@3Go)#NA@3>q6Zz7;uv_rd zjRz2%bIQ!4G^BaYd=LUv_2-9V&tyWx=Z9V1^=YFL(|xcbZmd1frRuxwyV>(A>nq1( z-{qBgL-BVdMrqT}%S$+{w^b%)cQvjLsw~l(J2l&E13v@%;fni|N~B@p0Q!qXzYJZ* zohp-RE2?^Q3X@w3zQf46V16JKuU{|`Bak0$^C diff --git a/library/tedit/TEDIT-FIND b/library/tedit/TEDIT-FIND index 7bb2e407..8eafce01 100644 --- a/library/tedit/TEDIT-FIND +++ b/library/tedit/TEDIT-FIND @@ -1,612 +1,489 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:46"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FIND.;1 37798 +(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}tedit>TEDIT-FIND.;93 29098 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FIND.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT.SUBSTITUTE) + + :PREVIOUS-DATE " 3-Mar-2024 20:44:51" {WMEDLEY}tedit>TEDIT-FIND.;92) (PRETTYCOMPRINT TEDIT-FINDCOMS) -(RPAQQ TEDIT-FINDCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE] - (COMS (* Read-table Utilities) - (FNS \TEDIT.SEARCH.CODETABLE) - (GLOBALVARS TEDIT.SEARCH.CODETABLE)) - (FNS \TEDIT.BASICFIND TEDIT.FIND TEDIT.NEW.FIND TEDIT.NEXT \TEDIT.FIND.WC \TEDIT.FIND.WC1 - \TEDIT.PACK.TARGETLIST \TEDIT.PARSE.SEARCHSTRING \TEDIT.SUBST.FN1 \TEDIT.SUBST.FN2 - TEDIT.SUBSTITUTE))) +(RPAQQ TEDIT-FINDCOMS ( + (* ;; "User entries") -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE + (FNS TEDIT.FIND TEDIT.FIND.BACKWARD TEDIT.SUBSTITUTE TEDIT.NEXT) + + (* ;; "Implementation") -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(RPAQ TEDIT.SEARCH.CODETABLE (\TEDIT.SEARCH.CODETABLE)) -) + (FNS \TEDIT.WCFIND \TEDIT.BASICFIND \TEDIT.WCFIND.BACKWARD + \TEDIT.BASICFIND.BACKWARD \TEDIT.PARSE.SEARCHSTRING))) -(* Read-table Utilities) +(* ;; "User entries") (DEFINEQ -(\TEDIT.SEARCH.CODETABLE - [LAMBDA NIL (* jds "23-OCT-83 00:58") - (* Build the 16-bit-item "syntax class" - table for searching) - (PROG ((CODETBL (ARRAY 256 'SMALLP 0 0))) - (for I from 0 to 255 do (SETA CODETBL I I)) (* Default is that a char maps to - itself, and is punctuation.) - (for CH - in (CHARCODE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h i j k - l m n o p q r s t u v w x y z)) - do (SETA CODETBL CH (IPLUS \AlphaNumericFlag \AlphaFlag CH))) - (for CH in (CHARCODE (0 1 2 3 4 5 6 7 8 9)) do (SETA CODETBL CH (IPLUS \AlphaNumericFlag CH - ))) - (for CH in (CHARCODE (%# * @ ! & ~ { })) as CODE - in (LIST \OneCharPattern \AnyStringPattern \OneAlphaPattern \OneNonAlphaPattern - \AnyAlphaPattern \AnyNonAlphaPattern \LeftBracketPattern \RightBracketPattern) - do (SETA CODETBL CH CODE)) - (RETURN CODETBL]) -) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.SEARCH.CODETABLE) -) -(DEFINEQ - -(\TEDIT.BASICFIND - [LAMBDA (TEXTOBJ STRING CH# CHLIM) (* ; "Edited 30-May-91 20:56 by jds") - - (* ;; "Search thru TEXTOBJ, starting where the caret is, for the string STRING, exact match only for now. (Optionally, start the search at character ch#.)") - - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - [TEXTLIM (OR CHLIM (ADD1 (IDIFFERENCE (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - (NCHARS STRING] - (TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (FOUND NIL) - (CH#1 (NTHCHARCODE STRING 1)) - CH1 ANCHOR PCH# OANCHOR CH) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "2/12/85 JDS: I don't understand WHY this is here, but I'll assume it's right for now.") - (* ; - "Prohibit future insertions in the current piece.") - (COND - ((OR CH# (fetch (SELECTION SET) of SEL)) (* ; - "There must be a well-defined starting point.") - (RETURN (PROG NIL - (SETQ CH1 (OR CH# (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (fetch (SELECTION CHLIM) of SEL)) - NIL))) (* ; - "Find the starting point for the search") - (* ; "DO THE SEARCH") - (COND - ((IGREATERP CH1 TEXTLIM) (* ; - "Starting the search past the last possible starting point. Just punt.") - (RETURN NIL))) - (SETQ ANCHOR (SUB1 CH1)) - RETRY - (\SETUPGETCH (ADD1 ANCHOR) - TEXTOBJ) - [for old ANCHOR from (ADD1 ANCHOR) to TEXTLIM - do (SETQ CH (\BIN TEXTSTREAM)) - (COND - ((EQ CH CH#1) - (RETURN] - (COND - ((IGREATERP ANCHOR TEXTLIM) - (RETURN NIL))) (* ; - "No starting character found before end of string") - (SETQ OANCHOR ANCHOR) - (SETQ FOUND T) - [for old CH1 from (ADD1 ANCHOR) to TEXTLIM as PCH# from 2 - to (NCHARS STRING) do (SETQ CH (\BIN TEXTSTREAM)) - (COND - ((NEQ CH (NTHCHARCODE STRING PCH#)) - (SETQ FOUND NIL) - (RETURN] - (COND - (FOUND (RETURN ANCHOR)) - (T (GO RETRY]) - (TEDIT.FIND - [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 6-May-2018 17:34 by rmk:") + [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS?) (* ; "Edited 19-Jun-2023 22:27 by rmk") + (* ; "Edited 6-May-2018 17:34 by rmk:") (* ; "Edited 30-May-91 20:56 by jds") - (* ;; "If WILDCARDS? is NIL then TEDIT.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") + (* ;; "If WILDCARDS? is NIL then TEDIT.FIND returns just the start of a basic string-match.") - (LET* - [(TEXTOBJ (TEXTOBJ TEXTOBJ)) - (TEDIT.WILDCARD.CHARACTERS '("#" "*")) - (REAL-END# (OR END# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) - (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) + (* ;; "Otherwise it returns a list of (MATCHSTART MATCHEND) which is the start and end char positions of the match,") - (* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit by adding the find event (given that the history is not a list, just a single event (TEDITHISTORY)") + (* ;; "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?") - (AND NIL (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Find - THAUXINFO _ TARGETSTRING))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) (* ; - "Any FIND invalidates the type-in cache.") - (COND - [WILDCARDS? (* ; - "will return a list of start and end of selection or nil if not found") - (PROG (TARGETLIST SEL RESULT RESULT1) - (RETURN (COND - ((OR START# (AND (fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL) - of TEXTOBJ))) - (LEQ (SETQ START# (SELECTQ (fetch (SELECTION POINT) - of SEL) - (LEFT (fetch (SELECTION CH#) - of SEL)) - (RIGHT (fetch (SELECTION CHLIM) - of SEL)) - NIL)) - REAL-END#))) (* ; "START# better be >= to END#") - (COND - ((AND (for X in [SETQ TARGETLIST - (\TEDIT.PARSE.SEARCHSTRING - (for X in (CHCON TARGETSTRING) - collect (MKSTRING (CHARACTER X] collect X - when (LITATOM X)) - (SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST START# - REAL-END#))) - (* ; - "If there are atoms, they are tedit wildcard chars") - (\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 REAL-END#)) - (T (* ; "no wildcards but bounded search") - (COND - ((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST) - START# REAL-END# NIL)) - (LIST RESULT (SUB1 (IPLUS RESULT (NCHARS (CAR TARGETLIST] - (T (* ; - "will return just the number of the start char or nil if not found") - (LET ((RESULT (\TEDIT.BASICFIND TEXTOBJ TARGETSTRING START# REAL-END#))) - (COND - ((NULL REAL-END#) - RESULT) - ((OR (NULL RESULT) - (GREATERP (IPLUS RESULT (SUB1 (NCHARS TARGETSTRING))) - REAL-END#)) - NIL) - (T RESULT]) + (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))) -(TEDIT.NEW.FIND - [LAMBDA (TEXTOBJ TARGETSTRING START# END# WILDCARDS?) (* ; "Edited 23-Feb-88 11:13 by jds") + (* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING") - (* ;; "If WILDCARDS? is NIL then TEDIT.NEW.FIND is the old TEDIT.FIND. Else, it returns a list of (SEL.START# SEL.END#) which is the start and end char positions of the selection") + (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)))))]) - (* ;; "(PROG ((TEXTSTREAM (fetch STREAMHINT of TEXTOBJ)) PATTERN FIRSTPAT PATTERNSTACK POSNSTACK FIRSTCHAR1 FIRSTCHAR2 FIRSTPATNORMAL PATTERNLEN FOUND PATTERNPOS TEXTPOS) (AND TARGETSTRING (NOT (STRINGP TARGETSTRING)) (SETQ TARGETSTRING (MKSTRING TARGETSTRING))) (SETQ PATTERN (\TEDIT.NEW.PARSE.SEARCHSTRING TARGETSTRING)) (OR PATTERN (RETURN)) (SETQ PATTERNLEN (FLENGTH PATTERN)) (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT THACTION _ (QUOTE Find) THAUXINFO _ TARGETSTRING)) (COND ((ZEROP (LOGAND \SpecialPattern (SETQ FIRSTPAT (CAR PATTERN)))) (* The pattern starts with an easy first character) (SETQ FIRSTPATNORMAL T) (SETQ FIRSTCHAR1 (LOGAND \CHARMASK FIRSTPAT)) (COND ((ZEROP (LOGAND \AlphaFlag FIRSTPAT)) (* Not alphabetic) (SETQ FIRSTCHAR2 FIRSTCHAR1)) (T (* Is alphabetic) (SETQ FIRSTCHAR2 (LOGAND FIRSTCHAR1 223)))))) (bind (CH# _ START#) while (ILEQ CH# END#) first (\SETUPGETCH START# TEXTOBJ) do (COND (FIRSTPATNORMAL (* The pattern starts with an easy first character) (COND ((AND (NEQ (SETQ CH (\BIN TEXTSTREAM)) FIRSTCHAR1) (NEW CH FIRSTCHAR2)) (GO $$ITERATE))) (SETQ PATTERNPOS 1) (SETQ CH (\BIN TEXTSTREAM))) (T (SETQ PATTERNPOS 0))) (SETQ TEXTPOS (\TEXTMARK TEXTOBJ)) (COND ((IGEQ PATTERNPOS PATTERNLEN) (SETQ FOUND T) (RETURN)))))") +(TEDIT.FIND.BACKWARD + [LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS? AGAIN) (* ; "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") - (HELP]) + (* ;; "The search is confined to the characters between START and END. It runs backwards from END looking for the nearest match, and returns the character positions of that match.") -(TEDIT.NEXT - [LAMBDA (STREAM) (* ; "Edited 30-May-91 20:57 by jds") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - TARGET SEL OPTION FIELDSEL) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T)) - (* find the first >>delimited<< field) - (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (SELECTION CH#) of SEL))) - (* find the first menu-type insertion - field, usually delimited with {}) - [SETQ OPTION (COND - [(AND TARGET FIELDSEL) (* take the first one) - (COND - ((IGREATERP (CAR TARGET) - (fetch (SELECTION CH#) of FIELDSEL)) - (* use the {} selection) - 'FIELD) - (T 'TARGET] - (TARGET 'TARGET) - (FIELDSEL 'FIELD) - (T 'NEITHER] - (SELECTQ OPTION - (TARGET (* Found another fill-in) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION CH#) of SEL with (CAR TARGET)) - (* Set up SELECTION to be the found - text) - (replace (SELECTION CHLIM) of SEL with (ADD1 (CADR TARGET))) - (replace (SELECTION DCH) of SEL with (IDIFFERENCE (ADD1 (CADR TARGET)) - (CAR TARGET))) - (replace (SELECTION POINT) of SEL with 'RIGHT) - (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* Always selected normally) - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) - (* And never pending a deletion.) - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T) (* And get it into the window) - ) - (FIELD (* Replace the selection for this - textobj with the scratch sel returned - from MBUTTON.FIND.NEXT.FIELD) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION CH#) of SEL with (fetch (SELECTION CH#) of FIELDSEL)) - (* Set up SELECTION to be the found - text) - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CHLIM) of FIELDSEL)) - (replace (SELECTION DCH) of SEL with (fetch (SELECTION DCH) of FIELDSEL)) - (replace (SELECTION POINT) of SEL with 'LEFT) - (\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T) (* And get it into the window) - ) - (NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T) - (SETQ SEL NIL)) - (SHOULDNT "No legal value found in selectq in TEDIT.NEXT")) - (COND - (SEL + (* ;; "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.") - (* There really IS a selection made here, so set up the charlooks for it - properly.) + (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 - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ - SEL]) + (* ;; "Assume that we aren't interested in another match at the current position.") -(\TEDIT.FIND.WC - [LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 9-Dec-88 09:56 by jds") - (* ; - "\TEDIT.FIND.WC returns the end char # of the TARGETLIST which may contain wildcards") - (PROG (RESULT RESULT1) - (RETURN (COND - ((SETQ RESULT (\TEDIT.FIND.WC1 TEXTOBJ TARGETLIST START# END#)) - - (* ;; "SUB1 because NEWFIND.WC2 takes that arg as the Lastchar of the selection so far and so will start on the next char after this") - (* ; "DONE!") - (LIST START# (IMAX START# RESULT))) - (T (AND (SETQ RESULT1 (\TEDIT.SUBST.FN1 TEXTOBJ TARGETLIST (ADD1 START#) - END#)) - (\TEDIT.FIND.WC TEXTOBJ TARGETLIST RESULT1 END#]) - -(\TEDIT.FIND.WC1 - [LAMBDA (TEXTOBJ TARGETLIST TRIALEND# END#) (* ; "Edited 9-Dec-88 09:52 by jds") - (* ; - "TRIALEND# is where the next char string should go") - (* ; - "\TEDIT.FIND.WC1 should return the lastchar# of selection") - (PROG (RESULT RESULT1) - (RETURN (COND - ((NULL TARGETLIST) (* ; "DONE!") - (SUB1 TRIALEND#)) - [(STRINGP (CAR TARGETLIST)) - (COND - ((SETQ RESULT (TEDIT.FIND TEXTOBJ (CAR TARGETLIST) - TRIALEND# END# NIL)) - (* ; "NOT null") - (\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST) - (IPLUS RESULT (NCHARS (CAR TARGETLIST))) - END#] - ((LITATOM (CAR TARGETLIST)) - (COND - [(MEMBER (CAR TARGETLIST) - '(%#)) (* ; "fixed width wildcard") - (COND - ((OR (NULL (CDR TARGETLIST)) - (EQUAL (CAR (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST - (CDR TARGETLIST))) - (ADD1 TRIALEND#) - END# T)) - (ADD1 TRIALEND#))) (* ; - "If the next start after a fixed char is the char after it, OK. else return nil") - (\TEDIT.FIND.WC1 TEXTOBJ (CDR TARGETLIST) - (ADD1 TRIALEND#) - END#] - (T (* ; "variable width wildcard") - (COND - ((CDR TARGETLIST) - (SETQ RESULT1 (TEDIT.FIND TEXTOBJ (CONCATLIST (\TEDIT.PACK.TARGETLIST - (CDR TARGETLIST))) - TRIALEND# END# T)) - (AND RESULT1 (CADR RESULT1))) - (T (* ; "last element of search") - (SUB1 TRIALEND#]) - -(\TEDIT.PACK.TARGETLIST - [LAMBDA (TARGETLIST) (* ; "Edited 24-Sep-87 09:54 by jds") - (COND - ((NULL TARGETLIST) - NIL) - [(MEMBER (CAR TARGETLIST) - '("#" "*")) - (CONS (CONCAT (CAR TARGETLIST) - (CAR TARGETLIST)) - (\TEDIT.PACK.TARGETLIST (CDR TARGETLIST] - [(STRINGP (CAR TARGETLIST)) - (CONS (CAR TARGETLIST) - (\TEDIT.PACK.TARGETLIST (CDR TARGETLIST] - (T (* ; "wildcard") - (CONS (MKSTRING (CAR TARGETLIST)) - (\TEDIT.PACK.TARGETLIST (CDR TARGETLIST]) - -(\TEDIT.PARSE.SEARCHSTRING - [LAMBDA (LST RESULT) (* jds "31-Jan-84 13:26") - (PROG [(TEDIT.WILDCARD.CHARACTERS '("#" "*"] - (RETURN (COND - [(NULL LST) - (COND - (RESULT (LIST RESULT] - [(MEMBER (CAR LST) - TEDIT.WILDCARD.CHARACTERS) - (COND - [(NULL RESULT) - (CONS (MKATOM (CAR LST)) - (\TEDIT.PARSE.SEARCHSTRING (CDR LST] - (T (APPEND (LIST RESULT (MKATOM (CAR LST))) - (\TEDIT.PARSE.SEARCHSTRING (CDR LST] - [(AND (EQUAL (CAR LST) - "'") - (LISTP (CDR LST)) - (MEMBER (CADR LST) - TEDIT.WILDCARD.CHARACTERS))(* quoting something a wildcard char) - (\TEDIT.PARSE.SEARCHSTRING (CDDR LST) - (COND - ((NULL RESULT) - (MKSTRING (CADR LST))) - (T (CONCAT RESULT (MKSTRING (CADR LST] - (T (\TEDIT.PARSE.SEARCHSTRING (CDR LST) - (COND - ((NULL RESULT) - (CAR LST)) - (T (CONCAT RESULT (CAR LST]) - -(\TEDIT.SUBST.FN1 - [LAMBDA (TEXTOBJ TARGETLIST START# END#) (* ; "Edited 3-Sep-87 11:38 by jds") - (* ; - "returns the char location that would match the beginning element of a targetlist") - (PROG (RESULT) - (SETQ RESULT (\TEDIT.SUBST.FN2 TEXTOBJ TARGETLIST START# END#)) - (RETURN (AND RESULT (IGEQ RESULT START#) - RESULT]) - -(\TEDIT.SUBST.FN2 - [LAMBDA (TEXTOBJ TARGETLIST TRIALSTART# END#) (* ; "Edited 9-Dec-88 09:54 by jds") - - (* ;; - "will return the start char of a wildcarded selection. returns NIL if selection is beyond bounds") - - (* ;; "TARGETLIST is (what)?") - - (LET (SUB-FIND-RESULT) - (COND - ((NULL TARGETLIST) - TRIALSTART#) - ((IGREATERP TRIALSTART# END#) - NIL) - [(LITATOM (CAR TARGETLIST)) - (COND - ((EQ (CAR TARGETLIST) - '%#) (* ; "fixed width wildcard") - (AND (SETQ SUB-FIND-RESULT (\TEDIT.SUBST.FN1 TEXTOBJ (CDR TARGETLIST) - (ADD1 TRIALSTART#) - END#)) - (SUB1 SUB-FIND-RESULT))) - (T (* ; - "variable width wildcard, so forget them") - (\TEDIT.SUBST.FN2 TEXTOBJ (CDR TARGETLIST) - TRIALSTART# END#] - (T (* ; "it's a string") - (TEDIT.FIND TEXTOBJ (CAR TARGETLIST) - TRIALSTART# END# NIL]) + (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)))))]) (TEDIT.SUBSTITUTE - [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 30-Mar-94 16:04 by jds") + [LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "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 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") (* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.") - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (REPLACEDFLG 0) - (YESLIST '("Y" "y" "yes" "YES" "T" "Yes")) - SEARCHSTRING REPLACESTRING ABORTFLG OUTOFRANGEFLG BEGINCHAR# ENDCHAR# STARTCHAR# RANGE - CONFIRMFLG SEL PC# SELCH# SELCHLIM SELPOINT CRSEEN REPLACE-LEN) - (COND - ([NULL (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:" - (TEXTPROP TEXTOBJ - 'TEDIT.LAST.SUBSTITUTE.STRING) - (CHARCODE (EOL LF ESC] + (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))) - [SETQ REPLACESTRING (OR REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" - (TEXTPROP TEXTOBJ - 'TEDIT.LAST.REPLACEMENT.STRING) - (CHARCODE (EOL LF ESC] - [COND - ((STRINGP REPLACESTRING) - (SETQ REPLACE-LEN (NCHARS REPLACESTRING))) - ((LISTP REPLACESTRING) (* ; - "It's a list of pieces, meaning insert these pieces as the replacement.") - (SETQ REPLACE-LEN (for PC in REPLACESTRING sum (fetch (PIECE PLEN) of PC] - (SETQ CRSEEN (AND REPLACESTRING (STRINGP REPLACESTRING) - (STRPOS (CHARACTER (CHARCODE CR)) - REPLACESTRING))) - [COND - (PATTERN (* ; - "If a pattern is specd in the call, use the caller's confirm flag.") - (SETQ CONFIRMFLG CONFIRM?)) - (T (* ; "Otherwise, ask for one.") - (SETQ CONFIRMFLG (MEMBER (TEDIT.GETINPUT TEXTOBJ "Ask before each replace?" "No" - (CHARCODE (EOL SPACE ESCAPE LF TAB))) - YESLIST] - (TEDIT.PROMPTPRINT TEXTOBJ "Substituting..." T) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) (* ; - "STARTCHAR# and ENDCHAR# are the bound of the search") - (\SHOWSEL SEL NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "Turn off any blue pending delete") - (SETQ BEGINCHAR# (SETQ STARTCHAR# (fetch (SELECTION CH#) of SEL))) - [SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (fetch (SELECTION DCH) of SEL] - (while (AND (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T)) - (NOT ABORTFLG)) - do [PROG (PENDING.SEL CHOICE) - (COND - [CONFIRMFLG (SETQ PENDING.SEL (TEDIT.SETSEL TEXTSTREAM (CAR RANGE) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE))) - 'RIGHT T)) - (\SHOWSEL PENDING.SEL NIL NIL) - (TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL) - (\SHOWSEL PENDING.SEL NIL T) - [SETQ CHOICE (TEDIT.GETINPUT TEXTOBJ "OK to replace? ['q' quits]" - "Yes" (CHARCODE (EOL SPACE ESCAPE LF TAB] - (COND - ((MEMBER CHOICE '("Q" "q")) - (SETQ ABORTFLG T) - (GO L1)) - ((NOT (MEMBER CHOICE YESLIST)) - (* ; "turn off selection") - (TEDIT.SHOWSEL TEXTSTREAM NIL PENDING.SEL) - (GO L1)) - (T (* ; "OK to replace") - (TEDIT.DELETE TEXTSTREAM PENDING.SEL) - (* ; "make the replacement") + (TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]") + (RETURN)) + (CL:UNLESS 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 (\SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)) + elseif (LISTP REPLACEMENT) + then (HELP "LISTP REPLACEMENT")) -(* ;;;; "This is just wrong in this clause: (COND ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING %"%"))) (* ; %"If the replacestring is nothing, why bother to add nothing%") (TEDIT.INSERT TEXTSTREAM REPLACESTRING (CAR RANGE)) (SETQ ENDCHAR# (IPLUS ENDCHAR# (IDIFFERENCE (NCHARS REPLACESTRING) (IDIFFERENCE (CADR RANGE) (SUB1 (CAR RANGE)))))) (add REPLACEDFLG 1)))") + (* ;; "Could be NIL or empty string, meaning just delete all occurrences.") - [AND REPLACESTRING - (OR (IEQP REPLACE-LEN 0) - (COND - ((LISTP REPLACESTRING) - (* ; "INSERT A RUN OF PIECES") - (\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE) - (for PC in REPLACESTRING - collect (\TEDIT.COPY.PIECEMAPFN PC - TEXTOBJ TEXTOBJ TEXTOBJ)) - REPLACE-LEN NIL NIL T NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - REPLACE-LEN)) - (T (TEDIT.INSERT TEXTSTREAM REPLACESTRING - (CAR RANGE] - [SETQ ENDCHAR# (IPLUS ENDCHAR# - (IDIFFERENCE (OR (AND REPLACESTRING - REPLACE-LEN) - 0) - (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE] - (add REPLACEDFLG 1] - (T (* ; - "No confirmation required. Do the substitutions without showing intermediate work") - [replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (fetch (PIECE PLOOKS) of (\CHTOPC (CAR RANGE) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - (SETQ PC# (\DELETECH (CAR RANGE) - (ADD1 (CADR RANGE)) - (ADD1 (IDIFFERENCE (CADR RANGE) - (CAR RANGE))) - TEXTOBJ)) - (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) - SEL - (CAR RANGE) - (ADD1 (CADR RANGE)) - TEXTOBJ) - [SETQ ENDCHAR# (IDIFFERENCE ENDCHAR# (IDIFFERENCE (CADR RANGE) - (SUB1 (CAR RANGE] + (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.") + + (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)) + (\SHOWSEL SEL NIL) + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) (* ; "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.") + + (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.") + + [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)) + (\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 (\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 + (* ;; + "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") + + (bind FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0) + (SAVESEL _ (\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 (\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 + + (* ;; + "At least one replacement, update the lines that have changed.") + + (\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.") + + (\SHOWSEL SEL NIL) + (\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#) + (IPLUS (GETSEL SAVESEL DCH) + TOTALDIFF) + 'RIGHT) + (\TEDIT.HISTORYADD TEXTOBJ (DREVERSE $$VAL)))] + + (* ;; "Save the search & replacement strings to offer for next time:") + + (\SHOWSEL SEL T) + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING) + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\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 16-Feb-2024 23:48 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)) + 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#))) (* ; - "Take the length of what we're removing off the end-location, so we don't search too far.") - (COND - ((AND REPLACESTRING (NOT (EQUAL REPLACESTRING ""))) + "find the first menu-type insertion field, usually delimited with {}") + [SETQ OPTION (COND + [(AND TARGET FIELDSEL) (* ; "take the first one") + (COND + ((IGREATERP (CAR TARGET) + (GETSEL FIELDSEL CH#)) (* ; "use the {} selection") + 'FIELD) + (T 'TARGET] + (TARGET 'TARGET) + (FIELDSEL 'FIELD) + (T 'NEITHER] + (SELECTQ OPTION + (TARGET (* ; "Found another fill-in") + (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) (* ; - "If the replacestring is nothing, why bother to add nothing") - (\FIXILINES TEXTOBJ SEL (CAR RANGE) - REPLACE-LEN - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (COND - [CRSEEN (for ACHAR instring REPLACESTRING as NCH# - from (CAR RANGE) by 1 - do (SELCHARQ ACHAR - (CR (\INSERTCR ACHAR NCH# TEXTOBJ)) - (\INSERTCH ACHAR NCH# TEXTOBJ] - ((LISTP REPLACESTRING) (* ; "INSERT A RUN OF PIECES") - (\TEDIT.INSERT.PIECES TEXTOBJ (CAR RANGE) - (for PC in REPLACESTRING - collect (\TEDIT.COPY.PIECEMAPFN PC TEXTOBJ TEXTOBJ - TEXTOBJ)) - REPLACE-LEN NIL NIL T NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - REPLACE-LEN)) - (T (\INSERTCH REPLACESTRING (CAR RANGE) - TEXTOBJ))) - (SETQ ENDCHAR# (IPLUS ENDCHAR# REPLACE-LEN)) + "Original comment: %"never pending a deletion%", but it is!") + (\SHOWSEL SEL NIL) (* ; + "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") + (TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window") + (\SHOWSEL SEL T)) + (FIELD (* ; + "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD") + (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T) + (\SHOWSEL SEL NIL) (* ; + "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") + (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")) + (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)))]) +) + + + +(* ;; "Implementation") + +(DEFINEQ + +(\TEDIT.WCFIND + [LAMBDA (TSTREAM TARGETLIST START END HITSTART ANCHORED) (* ; "Edited 19-Jun-2023 23:50 by rmk") + + (* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITSTART is the first character of such a match") + + (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)) + + (* ;; "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])]) + +(\TEDIT.BASICFIND + [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "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. ") + + (* ;; "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 + (IDIFFERENCE END NCHARS))] + eachtime (\TEXTSETFILEPTR TSTREAM ANCHOR) + + (* ;; "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]) + +(\TEDIT.WCFIND.BACKWARD + [LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "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") + + (LET (RESULT) + (COND + ((NULL TARGETLIST) (* ; "Final match") + (LIST (ADD1 (\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)) + + (* ;; "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]) + +(\TEDIT.BASICFIND.BACKWARD + [LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 12-Jul-2023 08:14 by rmk") + (* ; "Edited 23-Apr-2023 12:42 by rmk") + + (* ;; "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. ") + + (* ;; "A better interface would return a selection for the string-match, but we repeat the pair interface that is documented for forward search.") + + (* ;; + "Note that caller must decrement END in subsequent calls to avoid looping on the same match.") + + (* ;; "") + + (* ;; "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)) + (\TEXTSETFILEPTR TSTREAM (SUB1 END)) + (CL:WHEN [AND (EQ CHARN (\TEXTPEEKBIN TSTREAM)) + (OR (EQ NCHARS1 0) + (for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I) + (\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 (\TEXTSETFILEPTR TSTREAM ANCHOR) (* ; - "Now add the length of the replacement string into the ending position, so we go far enough.") - )) - (add REPLACEDFLG 1))) - [SETQ STARTCHAR# (COND - (REPLACESTRING (IPLUS (CAR RANGE) - REPLACE-LEN)) - (T (CAR RANGE] - (RETURN) - L1 + "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 (\TEXTBACKFILEPTR + TSTREAM))) + when [OR (EQ NCHARS1 0) + (for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I) + (\TEXTBACKFILEPTR TSTREAM] + do (ADD ANCHOR 1) + (RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1) + ANCHOR]) - (* ;; - "12/12/88 Should only look at REPLACESTRING when there has been a replacement.") +(\TEDIT.PARSE.SEARCHSTRING + [LAMBDA (TARGETSTRING) (* ; "Edited 19-Jun-2023 16:42 by rmk") + (* jds "31-Jan-84 13:26") - (SETQ STARTCHAR# (ADD1 (CAR RANGE] (* ; "start looking where you left off") - ) + (* ;; + "Quote Is an escape if it comes before a wild card. ''# would match ' in front of literal .") - (* ;; "Save the search & replacement strings to offer for next time:") - - (TEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING) - (TEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING REPLACESTRING) - - (* ;; "Print the message that says how many substitutions got made:") - - (COND - ((ZEROP REPLACEDFLG) - (TEDIT.PROMPTPRINT TEXTOBJ "No replacements made." T)) - ((EQUAL REPLACEDFLG 1) - (TEDIT.PROMPTPRINT TEXTOBJ "1 Replacement made." T)) - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING REPLACEDFLG) - " Replacements made.") - T))) - - (* ;; "Update the current selection:") - - (COND - ((AND (NOT CONFIRMFLG) - (NOT (ZEROP REPLACEDFLG))) (* ; - "There WERE replacements, and they were not confirmed.") - (replace (SELECTION CHLIM) of SEL with (ADD1 ENDCHAR#)) - (* ; - "account for the changes in selection length due to replacements") - (replace (SELECTION CH#) of SEL with BEGINCHAR#) - (* ; "And remember where it started") - (replace (SELECTION DCH) of SEL with (IDIFFERENCE (fetch (SELECTION CHLIM) of SEL) - (fetch (SELECTION CH#) of SEL))) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CHLIM) of SEL)) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (RETURN REPLACEDFLG]) + (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)]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1329 2662 (\TEDIT.SEARCH.CODETABLE 1339 . 2660)) (2737 37775 (\TEDIT.BASICFIND 2747 . -6376) (TEDIT.FIND 6378 . 10740) (TEDIT.NEW.FIND 10742 . 12344) (TEDIT.NEXT 12346 . 16787) ( -\TEDIT.FIND.WC 16789 . 17770) (\TEDIT.FIND.WC1 17772 . 20589) (\TEDIT.PACK.TARGETLIST 20591 . 21284) ( -\TEDIT.PARSE.SEARCHSTRING 21286 . 22831) (\TEDIT.SUBST.FN1 22833 . 23319) (\TEDIT.SUBST.FN2 23321 . -24705) (TEDIT.SUBSTITUTE 24707 . 37773))))) + (FILEMAP (NIL (782 18465 (TEDIT.FIND 792 . 2432) (TEDIT.FIND.BACKWARD 2434 . 4247) (TEDIT.SUBSTITUTE +4249 . 14573) (TEDIT.NEXT 14575 . 18463)) (18498 29075 (\TEDIT.WCFIND 18508 . 20509) (\TEDIT.BASICFIND + 20511 . 21874) (\TEDIT.WCFIND.BACKWARD 21876 . 23820) (\TEDIT.BASICFIND.BACKWARD 23822 . 27052) ( +\TEDIT.PARSE.SEARCHSTRING 27054 . 29073))))) STOP diff --git a/library/tedit/TEDIT-FIND.LCOM b/library/tedit/TEDIT-FIND.LCOM index 78906c0dedf02d13ca9ece361b39c4d2d130c11f..5371e31f047fcb42dedef0988713d7e65da1bb05 100644 GIT binary patch literal 7367 zcmbtZUuawB6_?~BZQa(jmDUX=WFJbJ$fg#$SO49AzPh^3z4Dc=B3(Ce(o9&98Yyz( z)^^5987rlfvF)W@nn5XS9TY|xRF)%3yR>>J4Ei(%d5E9(GS+o3bI8MuXrK#mkO zC1WdTbJuWMDQQFsPYw?U=?*H$Y%N0qBs!g2TAh}|a+JvOOe{PTO$JCXaAD>0D~;t^ zm8@I=(d(ykTE^5CfAZ{dqq4fR`r7mBwQ6Jid2C_W5GkJtJ(G$|lHuL^NzzPA3XsZb zt+!$A$FHoeJvBqv+E8gBU9t^(!PZCvoaPoxlelFHg+c*RT>`s%ZypOw{?8N1k?(r~ zBB#QsB$;8yN-vVt%S|#oqv}fjq*j`?EfSo|m-a|LNoEQ~?M1^{C{1UeRwyju(kfIM zWm*{iUTTylhq-E~TFFc%IUF=dl$e0nM#rP@yOrceE7_G@3|KsVhP7PI@*JDW!{?Sr#l zhZIJXRv)3uM(KcPdq?Y|o?t>IFL60xT87Gmjfb7F(|jNnaRv%Xv807cno?ACA!8&a zGzqZ_7HpVEagv)CvviWnKb$wr;h96cl9o03rpvy6zSFaj(-su|t$^q?q_43Xws$M8H zm}wvCDfPQGE6I|hwVrDGCziq~XO=73JtdP23{iusNh;xx-9z=b7k+m=)yol*hn*Ko z-|G@wua+5TfndFE*coGPj-Vscj;ZBoTOxBtv1DTaJt;v-%8Ob_GifJIY|B& zRksXPqf=2*fQiGDVKaksR$iC~NF-9!3Z|lJ)0~qOCYoiIG{!bX__`!ftvm$C z&6y{$Z-Nx*TShC+pAJ3qQFLSUMLC@)QPNh?=1U^j$z`=T5n0qq@V4wcBrk->X?eSZ zje746#u#y!(>E(S;!;ZVB~nmq_-$&nd=ZYODY;29R6XSJ?Biy*nc&}-R_HSv+k8~% z9MV}^zeq=h>BqzL{b%>2Isrs!fV^AK| ztwRmgWK*owV5BulKaGd`A|PaODR)oDJ`+`4_<8vWgd=kqc0m_DD+H6Gnh zr7VxMi@G)9wMKmS_iiLbvVr@H-p%1?JKKRwseOaSJSyMw~`UBU>B4Sxw)p57{lx;ZO!>kEtEvrM`|(Rz8p z%bV7O?{U3b4tA~Moe?WopC}(MAM0-H)UDw0@^LiE*0J^iH#lp`xrAYBYKseE`T2!W z83W?7oW>&-;dj7Eb?X?@E?56S%g=9w?>*1;%8r<>b1m~B1E$v==T_-9uU5Rd-F|}I z-@xz>*pR_kxo5eRaC!bz-WSGp+JEK^NsNoqOP+`JlTsKg2V)9ERk3|<}4Ndimv4nl2{C}qSpXFfw`{BySLxm&~bHGF1D&`c^II961X_$!8ZG}!F&?#4G3CIXCM#9bjlV9%Lei0$b z4&eq71wu~b$!MkqG$%9lh%IH<1K-kZFmj}44KfaG@-xU%gyghbS}PJc>?j8jmmfhw zgcimmQQ$OpR-@J<0T$`F8pO8&1 z;W;c0aWL8AN8thkV~CT&0%@LM<;_LF??fDdoI>W1sg&%HDBx24pV-$V(&?Asi zq-dPfZIS@K!BuH2*rOMA_2LQ1-HXe_$d|Mtg#{!o(W~V`#+kN-zzIN(-hQ!|1f^5^ zjyMdX5kP?+K@=#05k$ihStOBUiku>m2(Si|PKI*(#PWbVGEC2rK!Q3!CmvWT>gqtA z?^af1fMAcVpl~=SnFJauSJueorD`nzFBL=5fp6F$`vwA|^UgG&RRDk^KoWSs?uCgI z2uXeg9}&FYz+!EUwlHYTll2v{T6<-A=|b%Va_+>dC&;T;8|!Q51H%A#bek&|S$2lp zkp%K9U_dtm*B8))X9y^3O;V}7ys}y&wWSMnDgs_|VC`yUZN0I6bsc?JPM}&_uF-ZR zOac^E72H4x%%J2zk;_5W)>pxHCIFvB0_T*<$|^F$^AH&{rP|Uexb#S1Qo+C?)bSeq zrw0oFxZ%^LE%YayoFWgq;i*Ic3B;VCnHgLjz+8k_1!i3o_3N)`%VGTJAq?ZbxG6r*>pvoP2?!oQw0-eZkln*94M z);m`fD5b57sNVeZoTr-=;W%q}4Ico9;oV~7JOpQ1Ti_oSA-h=~g>uH6G00x3$HUyOl=NY!V|z*g)fznG4*>A0te?oqmOH~1XRMEorL8*hX%LIg955Z zQjc>gCN`mAh!r3R0=LtmsUJNB{7IiN0%*U3JWp_-ZcPSyfhQr$wTny3FiH8xA0e=m>Bhnm-g(e;!8JgtC`MFy74G``<*3i^Qel!F`qAM+}(U~ zR>`VaF?pt=W}COpw!W>8Dq@ch=oV^*L)+0=#hX?&-Z^t)9CJE#0bsCC_X-+MP=d`3 zDnsgnwO-W$7^L?+gwB9<2iM`r4GiEO0c@sFNh41kMW?6q{;opr322ul-U@TH6c})| zql;vp-2j@1*Kh$ymXRcj3I)9s*A3nOQUvZEyq4D=L@|sPw-lc4;Y!914rSiSzNzZS z82>oS{Ze;6OYdNR&b<4HF-x|uEJT*uN6sOhcjf9||fADzWracD5l*KW6GvZ#DcH?w2DhpbV{e|PhUV)?n9vseyW z|GDMIMV9^D)?XX`U#rw4eWL^oxT0VtjRYuL3T4|mPfi@S|c~}=H1OF96rA? zKW@BD=i%FKJV$wkD9?wj$E|V3b9^_?amsU?@ofLrY~Fe)yJhkxCez%B1{PW!l65 zANV~gx8jY{go4&HVK?{$NU#;dgv9{=xPAse>HjOdG#3~>JJfl~>^yFqA9{Dg^IpBP zZ+4X3A^&7eW1{s>@44#oiS720Zr0~zppB{iTGn^g`^LOEaWm^{eY$*fyG_i_$h=tf zS-tfwYdZbbH}loysqOY(x`v2Un_ruqQRDZn6`#6SEVlk$=V9^VTxaObjh%}Pl%8_F zjhzzSH*$5JE>o|GGIcD~uZ&R4LLU%H#DGH*P{jZ#uuH!#?xutV&;*^J*x_D)+^|RQ zF2K+NHR#|5q(lsUKtj4Tg&qO;3&M{_Wuz2A{1#-}iz>=VteC`{3;T@>LnX`?3(Bce z9K-a6NiaA?o_U4@7S?L3q;>^q4oy(pzc(=i$UPN9iM`)I_*g$rB;xlY3L~)t-`BYO v%5v>8HeOmshUV-H6Qyapi0z`+57YzGeb?r|s2*W|O03vxxRcNf{T=7O`7s`p literal 9927 zcmb_iZERcDc_t~@S(G>-CB^ZK%sXXdn=&kp_wrjcR9=#ozE`^BVMr>m9jAm8GLb|^ zN+fw%ux`VGwB4`*MO&`t^||iGvrFB%7uv0E`;~Y!Irs9$W@mN% z`5DnN*IixST-tnPZoA!D-JZi*b_08_6r-QjrVlI|pVhLnu{4%h-fX)Iw}0cs&8^e3 zWPM|M1@n?sY^1d4IK;coZ00nvC7aYi%}`nT=_mYVGy*%XhO^pB}r)*&VH$My+5)3$$noiI^>B#v)Y`Ck2aC ziB4?%A0xa!?@SZlU;mQN=Ueytp2v@Gt@R-L3Hg29kJmzhz`T9?^@$DE)Qed2tp`|X zFyFa(rT6oeKja^=7BF%>;M-f+<9!o>k=>sQ`bUNYp3Z+?AN8$|`qxJT>!YLVqa*91 zN7hG=u8-cga#H@|qeJ2Q$|JiYU-bXb8QC4Rg8t@11FJ$G5*sK7e&7V&?ft7SqNR0G z$3Y?GF;Pfs;x`eO9SLI8YR2X1W05qemkr0Mq6m44lSn*C5;{pGNIXvB8KUVa{KfH? zoF*BKL=qX2$dY7?BsG%MNit5736e~bWQruy(`-~El_aSYNu^0DLsD6ijuC7Cn@Yz? zIziG&l1`Cynxr!%oh6wVn>M49Oq^sAB$FhW6v?DXCPOk=l8upUnm~rKS$-TXrr{SF z8pD=i3H&AThb_j^_``N%pwnXb1Dyss4RjjlG|*|F(?F+zP6M3|IvsSnK0SR*iVDnw zU0~`-q>Nx-wO~CC0m%w!$q;H(3Kp%QDXsca#BEE0OhaFSl;|Sn5n}c@Ytl)>yws>S zU~|f-YP{;$tjuo8fgCcCWGyy`*|IjMFu<-{L@~w((EL0^^uK~W-)QbA6TbIO7Ir6O zF<{)!nr?OWWJA>GjIox`YY&K)wVwukgSFQF%6@+Lg2g9zf6}+Me?5`kJum9-O}4n? z?|*wB8;*WeG~5`I4P(!=><_-S671aiVFhdPB?dN%&EtdS#BUX^t=K z|7oRjv-h7B47vUf&ER15U9n3>-wlLDAEuA}fS#f!ZeM@2Oi$kaD>lfWr}(7%-&=Wi z!s-8UC0Op<1Xbr|^HlF&d=VXjS!q}W3#tvhCK^Nq*J9M_kYkNpg$68EFPaT#ION$& zsV5{MWS+?Y7;hFDHmyJ^G*YuKS`Ek%Qx(;oO%TT{HJD@$8zI)i3Y39eEv|-XfGR@Z zR57VaSakZBFiQu->=F}+7-2stQZws|PJ;iIol$LH{!l z!6P{?Z=ufwxQ%+Ju&X2_@HfVr;+p?l{458gGz}%N`1X$PzeBmB`RfZ(u1;PZO61pf zd>=VN!iNGW8-@ZY8^)GL=Wk=gPeQT##d^JIW^KplB;O(bZyY9*26ykL53QVRj=xGD zIs<8hdETSrknu1*KC=5O^u%~SZ!P5Kx$XaaKV>acL>YGXR4bm_?@!WG&Bq4x zk z`H#%MRSuS0Z-|X|ZtczA?(eSzeUUg!u$1aJ0+YLpR2;TX_UlZ|hz8SNunJHcsGCa@hm3M_ z#ROLhKhrbT?&=eqiPAIJV^2FQI9D{`xs>|BCk$!eI9#0?3Nt*^a4`a-9|=DmCgF2o zSa!jbiusga47cl_TKIkU;ZBdRFu{jwN)XFrKD1&xL-nq}ASf>aXJDI7QK>Jja(ly6 zS2RIsxkew*P?#9*ET)P7Pas8pscgom(v~Y0SG$$gs*tkF*1S-dquh92wfkpV{l{#- z(wYyx$?bUWl=ykn{zG2)iX(ns;Q6J4dK_J^Rk%9ohp$g<@{o! zK`UIlqD<&ff~=D`3wK<5Z)VKv@3IsFwl*^4&Og~ zoZ-lLNg3}$j_?=q2*&QweCJkB`2YU-oZ-(GWMFXV#>lHXzAxsCfMv+|V0mvabq|plWA0J={w?_Ow#tZ2L{3w5TLpK8Wm1Y;D-UzQp}~gI;$b9g@Z2`BGS}gjwHhv;t~}?$xqE9XYW8{o}Ph_>3fVr z0$4W7dFVb2i5tk=F%_J@2q@&Gu^cjT`tf1Pc5pA!!Q&)ukc@okB0RM}*ZOYI%gD)` zKj-H>%?VaQs>B`q5qb_ZxpiLzw&WfM0t4Mx2;92|6(S}TCBfL-g9t&A;2{zk$tA^t ztT(=Khu;;wNo`bjs-k`Fkz_`|@=GD>Jim164e;s>zt1P)d4L|d-TRGJpRAk=`i0N# zpEq{LC7WEH$U5{=HgT?kn_O%^?5A_Bz(`*Ys5#E&0s&+9fm}ea`zxxzhY8`|`S^Eo zpgEHBe@R}FYJVP*3RzU#L13(k2q#_kGd#epWD&;-L1TAkRGBFU%;91FUEBk@QC=__ zv`m;I71Di3hzyG($>3te8tR(hBf@9H$g@1rsGMjRfV-FEUc)CPVu#q6U&d{XhJwDK znQYy-KW}}ovVSAMblR0dwWfa1{J9;<{=uOv<~d3^bJ(u9@w+QWJY;Jnxi#ahd@x^N zc!98I{nJLvF9W?vX2*t>{A)0if#twN?|rY4#5r(p9t)E|I3ucR^DycWI9OPQVF=Fq z?8YKcN6BX7Q&Uq2xT=u!sVRip@iZD_Fv1)3EHPM?gFZ|Lo5Yf8xI92UcEMz2T?GOx z*kTPx(+l_ou2eItj!`gY;2Ky1@+F9sDD!}$N?DMH9-h(&s0TG3wuqIGyHpE2k9Tte zZiGvAtz2?0va#?;Mg?#;gQWN^u>RCL~WxO*vrAE* zS2>+U&-2p^=y{oc9lq^mlplf9eq;5S-XkgHtN_j3;Bm754U-=I^wBWuH>Gj0ufT`>fNa;%S^Mlkrn$;1FX zY)ofQjs${gamfObBZnNPCtNB^;Gnn z@l$H|YKkyWu&xZli!47V~zFMM!4LG!QE9G&~eANyWozdvfuwz|jmzeO_^XWo}pVL&rL zSu=y)-%a#Zp%ncq195XxhuvIpKufr}B5uxll@`x5OXB9NUwm`Fhck<{86T(EMeTg_ zw`kn?pLc||hy16hL^Mhv{~7A+uF5)>=mo?ZlckA?dlCPdm)McS_S*jU?beZz{&~*h z{*+M0UY1Yka9;F&CgvBF@7kRYUzb!9md%F^H9`Ue^!W8J*e!_q%ST3D7c|#9QfX;`X)}uwc*0{`GMi?G&#e~0P&n3u1d2-+d zEYR!;zgU>%!i5?VN#-xAivZNMB(OcV0wCqxUU`9s)D<8sxUsVwqL zB*Op|;5Y207+470DjowAA%8wjcqzEY54c!n-0;0n8 zB2I})G$ktctm6>wlsdQ|ru5314tz-NTu0D#VCNbh9T7}aDPDjumlvrXrdtqcm1nXy zK@r@rm`cgE%Lt&(N)YjmdG}@j)E(FW2fT#nx??%^4Gr-CG zZ!dC6ZxwpvscLw66?<|F!284KH!6cT99i*|Q+Q&tAqkYuGs&SO47zfa6vr7>@ZReg ze8>)Bcv>Ek<26}TvUunnmWKdgI^i-C&&oqUE(KxWnod$2&J>JK0Vh5G|3&Eqc zYL5eJ5ZIlLSLPxAbRY|!nrCksz&NoM-y}1m_u?N+j9Ldd$|v#ymnTUXREH<&G`=vY zweeBOv+Wn!>)Tu8g{4*-fE!+{0l6XO9`+5pz#fM1Z4Ud~acP+EF!E2NfRXSMcn^6A zh#gR9zz0Y(Ag*8`vWe_8+7cvuxxEGS53p~TE-=JTPWd_V^x2orl9#TnZf`xq&_6(m z^=r#p+pF8xw(&s<|MWzMQ8_T_F(gJDNyHf3O4!)ykmdGs3{`9|J-gygkMqI6vccGk zj&BH{5Mg;#vbDX5C1%3}dJulvSl-yghaT7kK0p|bz)EaS?WIjj>yF^3zKm19!v5IV z!bo87KQK;yRzOG*e45f|TrL2B=kPnfFP`|Ksg7@EYE|QjC&V?n%_PD<9jeRbVga9w zM2cp?0XC2Cbj&9WC&y;Q=S8GQD-C9@NdyoDlC?^sP9j&~d=0!zvn(-{n4TUZa>9s1 zjUpR5?V04E=)TaYDxS}z!&C6G zI*Gz@RsTTkaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FNKEYS.;1 29919 +(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}tedit>TEDIT-FNKEYS.;68 32048 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-FNKEYS.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL) + + :PREVIOUS-DATE " 3-Mar-2024 20:44:44" {WMEDLEY}tedit>TEDIT-FNKEYS.;67) (PRETTYCOMPRINT TEDIT-FNKEYSCOMS) (RPAQQ TEDIT-FNKEYSCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (COMS + [(COMS (* ;; "Functions that actually implement the commands for the function keys:") (FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV - \TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL \TEDIT.FIND - \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.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)) (COMS (* ;; "Auxiliary functions used in the above main functions:") @@ -33,12 +32,12 @@ \TEDIT.UNDERLINE.CARET.ON \TEDIT.STRIKEOUT.CARET.OFF \TEDIT.STRIKEOUT.CARET.ON)) (COMS (* ;  "little selection utilities etc., for building hacks") - (FNS \SEL.LIMIT \SEL.LINEDESC \TK.DESCRIBEFONT \PARAS.IN.SEL)) + (FNS \TK.DESCRIBEFONT)) [VARS (TEDIT.FNKEY.VERBOSE T) (\TEDIT.KEYS '(("Function,^D" UNDO) ("Function,$" UNDO) - ("Function,^C" FN \TEDIT.FIND) - ("Function,#" FN \TEDIT.FIND) + ("Function,^C" FN \TEDIT.KEY.FIND) + ("Function,#" FN \TEDIT.KEY.FIND) ("Function,Bs" REDO) ("Function,(" REDO) ("Function,^R" NEXT) @@ -68,40 +67,30 @@ ("Function,M" FN \TEDIT.DEFAULTSSEL) ("Function,m" FN \TEDIT.SETDEFAULT.FROM.SEL) ("Function,^A" FN \TEDIT.SHOWCARETLOOKS) - ("Meta,U" UNDO) - ("Meta,u" UNDO) - ("Meta,z" UNDO) - ("Meta,Z" UNDO) - ("Meta,F" FN \TEDIT.FIND) - ("Meta,f" FN \TEDIT.FIND) ("Meta,a" FN \TEDIT.SELECT.ALL) ("Meta,A" FN \TEDIT.SELECT.ALL) - ("Meta,g" FN \TEDIT.FINDAGAIN] - [P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) + ("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,p" FN \TEDIT.PRINT.MENU) + ("Meta,P" FN \TEDIT.PRINT.MENU) + ("Meta,r" REDO) + ("Meta,R" REDO) + ("Meta,s" FN \TEDIT.KEY.SUBSTITUTE) + ("Meta,S" FN \TEDIT.KEY.SUBSTITUTE) + ("Meta,U" FN \TEDIT.UNDO.UNDO) + ("Meta,u" UNDO) + ("Meta,z" UNDO) + ("Meta,Z" \TEDIT.UNDO.UNDO] + (P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) - (CADR ENTRY] - (* ; "Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%".") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - )) - -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) + (CADR ENTRY]) @@ -128,112 +117,152 @@ SEL]) (\TEDIT.CENTER.SEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (TEXTSTREAM TEXTOBJ SEL REVERSE) (* ; "Edited 11-Dec-2023 11:02 by rmk") + (* ; "Edited 28-Jul-2023 16:14 by rmk") + (* ; "Edited 11-Apr-2023 13:22 by rmk") + (* ; "Edited 10-Apr-2023 10:08 by rmk") + (* ; "Edited 30-May-91 21:05 by jds") - (* ;; "makes the current paragraph centered") + (* ;; "Changes the QUAD of the selected paragraphs in TEXTSTREAM, when the CENTER key is typed. Rotates through the sequences (LEFT/RIGHT/CENTER) from the QUAD of the first paragraph to find the NEWQUAD that it will apply to all the paragraphs in SEL. If REVERSE, cycles the quads in the opposite direction.") - (PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS PARASEL (SAVECH# (fetch (SELECTION CH#) of SEL)) - (SAVEDCH (fetch (SELECTION DCH) of SEL))) - (for PARA in (\PARAS.IN.SEL SEL TEXTOBJ) - do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT] - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (push NEWQUADS NEWQUAD)) - (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) - (COND - (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) - T]) + (CL:UNLESS (TEDITMENUP TEXTOBJ) + (LET [(NEWQUAD (LIST 'QUAD (OR [CADR (MEMB (LISTGET (TEDIT.GET.PARALOOKS TEXTSTREAM SEL) + 'QUAD) + (CL:IF REVERSE + '(LEFT CENTERED JUSTIFIED LEFT) + '(LEFT JUSTIFIED CENTERED RIGHT))] + 'LEFT] + (TEDIT.PARALOOKS TEXTSTREAM NEWQUAD SEL) + (CL:WHEN TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM NEWQUAD T))))]) (\TEDIT.CENTER.SEL.REV - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") - - (* ;; "acts like center.sel but cycles in the opposite direction") - - (PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS PARASEL (SAVECH# (fetch (SELECTION CH#) of SEL)) - (SAVEDCH (fetch (SELECTION DCH) of SEL))) - (for PARA in (\PARAS.IN.SEL SEL TEXTOBJ) - do (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - [SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT] - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (push NEWQUADS NEWQUAD)) - (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) - (COND - (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) - T]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 11-Dec-2023 11:02 by rmk") + (* ; "Edited 30-May-91 21:05 by jds") + (\TEDIT.CENTER.SEL TEXTSTREAM TEXTOBJ SEL T]) (\TEDIT.DEFAULTS.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 11:24") - (PROGN (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS)) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 26-Feb-2024 08:45 by rmk") + (* ; "Edited 11-Nov-2023 16:00 by rmk") + (* jds "21-Sep-85 11:24") + (TEDIT.CARETLOOKS TEXTSTREAM (create CHARLOOKS using (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS))) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) (\TEDIT.DEFAULTSSEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:12 by jds") - (* acts on the selection) - (TEDIT.LOOKS TEXTSTREAM (create CHARLOOKS using TEDIT.DEFAULT.CHARLOOKS) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 11-Nov-2023 15:55 by rmk") + (* ; "Edited 20-Oct-87 11:12 by jds") + (* ; "acts on the selection") + (TEDIT.LOOKS TEXTSTREAM (create CHARLOOKS using (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) SEL]) (\TEDIT.SETDEFAULT.FROM.SEL - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds " 8-Nov-85 15:22") - (* Set the defaults from the current - selection.) - (PROG ((LOOKS (TEDIT.GET.LOOKS TEXTSTREAM SEL))) - (SETQ TEDIT.DEFAULT.CHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Nov-2023 16:40 by rmk") + (* ; "Edited 11-Nov-2023 16:03 by rmk") + (* jds " 8-Nov-85 15:22") + (* ; + "Set the defaults from the current selection.") + (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST (TEDIT.GET.LOOKS TEXTSTREAM SEL) + NIL TEXTOBJ]) -(\TEDIT.FIND - [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 6-May-2018 17:14 by rmk:") +(\TEDIT.KEY.FIND + [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "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) - (PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - SEL CH W) (* Case sensitive search, with * and - %# wildcards) - [SETQ W (CAR (MKLIST (fetch (TEXTOBJ \WINDOW) of TEXTOBJ] - (CL:WHEN AGAIN - (SETQ TARGET (WINDOWPROP W 'TEDIT.LAST.FIND.STRING))) - (CL:UNLESS TARGET - [SETQ TARGET (TEDIT.GETINPUT TEXTOBJ "Text to find: " (WINDOWPROP W - 'TEDIT.LAST.FIND.STRING) - (CHARCODE (EOL LF ESC]) - [COND - (TARGET (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (\SHOWSEL SEL NIL NIL) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET) - NIL NIL T)) - (COND - (CH (* We found the target text.) - (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (replace (SELECTION CH#) of SEL with (CAR CH)) - (* Set up SELECTION to be the found - text) - (replace (SELECTION CHLIM) of SEL with (ADD1 (CADR CH))) - [replace (SELECTION DCH) of SEL with (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] - (replace (SELECTION POINT) of SEL with 'RIGHT) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (* And never pending a deletion.) - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T) - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING TARGET) - (* And get it into the window) - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") - (\SHOWSEL SEL NIL T] - (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with -1]) + + (* ;; "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.") + + (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))) + (\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) (* ; + "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)) + (\FIXSEL SEL TEXTOBJ) + (TEDIT.NORMALIZECARET TEXTOBJ)) + (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found") + T))) + (\SHOWSEL SEL T))]) + +(\TEDIT.GET.TARGET.STRING + [LAMBDA (TEXTOBJ PROP) (* ; "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.") + + (* ;; "Current heuristic: use selection if longer than 1 character, otherwise last search string. Note that meta-G goes directly to the last search.") + + (if (GETTEXTPROP TEXTOBJ PROP) + then (if (IGREATERP (GETSEL (GETTOBJ TEXTOBJ SEL) + DCH) + 1) + then (TEDIT.SEL.AS.STRING TEXTOBJ) + else (GETTEXTPROP TEXTOBJ PROP)) + else (TEDIT.SEL.AS.STRING TEXTOBJ]) + +(\TEDIT.KEY.FIND.BACKWARD + [LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 20-Jun-2023 13:57 by rmk") + (* ; "Edited 18-Jun-2023 17:59 by rmk") + (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL AGAIN T]) + +(\TEDIT.FINDAGAIN.BACKWARD + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Jun-2023 13:57 by rmk") + (* ; "Edited 18-Jun-2023 18:03 by rmk") + (* ; "Edited 6-May-2018 17:12 by rmk:") + (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL T T]) (\TEDIT.FINDAGAIN - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 17:12 by rmk:") - (\TEDIT.FIND TEXTSTREAM TEXTOBJ SEL T]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Jun-2023 13:57 by rmk") + (* ; "Edited 6-May-2018 17:12 by rmk:") + (\TEDIT.KEY.FIND TEXTSTREAM TEXTOBJ SEL T]) (\TEDIT.ITALIC.SEL.OFF [LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* ; "Edited 20-Oct-87 10:43 by jds") @@ -255,46 +284,41 @@ SEL]) (\TEDIT.LCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") + [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-Mar-2024 12:28 by rmk") + (* ; "Edited 28-May-2023 00:34 by rmk") + (* ; "Edited 24-May-2023 22:46 by rmk") - (* ;; "LOWER-CASEs the selection") + (* ;; "uppercasifies the selection. This changes the :Replace THACTION to :LowerCase for REDO. That could be stored in another field, in which case undo wouldn't need to know. Or maybe the transformation function should be stored.") - (PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL)) - (POS (fetch (SELECTION CH#) of SEL)) - (LEN (fetch (SELECTION DCH) of SEL)) - (POINT (fetch (SELECTION POINT) of SEL))) - (TEDIT.DELETE STREAM SEL) - (TEDIT.INSERT STREAM (L-CASE STR)) - (TEDIT.SETSEL STREAM POS LEN POINT) - (TEDIT.NORMALIZECARET TEXTOBJ) - (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with 'LowerCase]) + (\TEDIT.REPLACE.SELPIECES (\SELPIECES.CHARTRANSFORM (\SELPIECES.COPY (\SELPIECES SEL)) + (FUNCTION L-CASECODE) + NIL TEXTOBJ) + TEXTOBJ SEL) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THACTION :LowerCase]) (\TEDIT.SHOWCARETLOOKS - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:09 by jds") - - (* * comment) - - (PROG ((LOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) - (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch (CHARLOOKS CLFONT) - of LOOKS)) - (COND - ((AND (fetch (CHARLOOKS CLOFFSET) of LOOKS) - (NEQ (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0)) - (CONCAT " offset " (fetch (CHARLOOKS CLOFFSET) - of LOOKS))) - (T "")) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) - " overlined") - (T "")) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) - " underlined") - (T ""))) - T) - (RETURN]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:07 by rmk") + (* ; "Edited 30-May-91 21:09 by jds") + (LET ((LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS))) + (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\TK.DESCRIBEFONT (fetch (CHARLOOKS CLFONT) + of LOOKS)) + (COND + ((AND (fetch (CHARLOOKS CLOFFSET) of LOOKS) + (NEQ (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0)) + (CONCAT " offset " (fetch (CHARLOOKS CLOFFSET) + of LOOKS))) + (T "")) + (COND + ((fetch (CHARLOOKS CLOLINE) of LOOKS) + " overlined") + (T "")) + (COND + ((fetch (CHARLOOKS CLULINE) of LOOKS) + " underlined") + (T ""))) + T]) (\TEDIT.SMALLERSEL [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* jds "21-Sep-85 08:58") @@ -315,18 +339,18 @@ SEL]) (\TEDIT.UCASE.SEL - [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 30-May-91 21:05 by jds") - (* ; "uppercasifies the selection") - (PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL)) - (POS (fetch (SELECTION CH#) of SEL)) - (LEN (fetch (SELECTION DCH) of SEL)) - (POINT (fetch (SELECTION POINT) of SEL))) - (TEDIT.DELETE STREAM SEL) - (TEDIT.INSERT STREAM (U-CASE STR)) - (TEDIT.SETSEL STREAM POS LEN POINT) - (TEDIT.NORMALIZECARET TEXTOBJ) - (replace (TEDITHISTORYEVENT THACTION) of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with 'UpperCase]) + [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-Mar-2024 12:56 by rmk") + (* ; "Edited 28-May-2023 00:33 by rmk") + (* ; "Edited 24-May-2023 22:45 by rmk") + + (* ;; "uppercasifies the selection. This changes the :Replace THACTION to :UpperCase for REDO. That could be stored in another field, in which case undo wouldn't need to know.") + + (\TEDIT.REPLACE.SELPIECES (\SELPIECES.CHARTRANSFORM (\SELPIECES.COPY (\SELPIECES SEL)) + (FUNCTION U-CASECODE) + NIL TEXTOBJ) + TEXTOBJ SEL) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THACTION :UpperCase]) (\TEDIT.UNDERLINE.SEL.OFF [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 20-Oct-87 11:26 by jds") @@ -352,6 +376,13 @@ [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:") (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ)) 'LEFT]) + +(\TEDIT.KEY.SUBSTITUTE + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 8-May-2023 09:35 by rmk") + + (* ;; "Stub for function-key") + + (TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T]) ) @@ -361,103 +392,114 @@ (DEFINEQ (\TEDIT.BOLD.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT MEDIUM) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:08 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT MEDIUM) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.BOLD.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT BOLD) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:09 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(WEIGHT BOLD) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.ITALIC.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE REGULAR) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:09 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE REGULAR) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.ITALIC.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE ITALIC) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SLOPE ITALIC) + (GETTOBJ TEXTOBJ CARETLOOKS TEXTOBJ) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.LARGER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT 2) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT 2) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.SMALLER.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT -2) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:15 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(SIZEINCREMENT -2) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.SUBSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT -2) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:16 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT -2) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.SUPERSCRIPT.CARET - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT 2) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:16 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(OFFSETINCREMENT 2) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.UNDERLINE.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE OFF) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:17 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE OFF) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.UNDERLINE.CARET.ON - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE ON) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:17 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(UNDERLINE ON) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.STRIKEOUT.CARET.OFF - [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") - (PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT OFF) - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ))) - (COND - (LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) - (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL]) + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Dec-2023 21:18 by rmk") + (* ; "Edited 12-Jun-90 18:32 by mitani") + (LET ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT OFF) + (GETTOBJ TEXTOBJ CARETLOOKS) + TEXTOBJ))) + (CL:WHEN LOOKS + (TEDIT.CARETLOOKS TEXTSTREAM LOOKS) + (\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))]) (\TEDIT.STRIKEOUT.CARET.ON [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani") @@ -475,29 +517,6 @@ (DEFINEQ -(\SEL.LIMIT - [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") - - (* returns the character that delimits this selection. - The first char if the point is left else the last) - - (COND - ((EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (fetch (SELECTION CH#) of SEL)) - (T (SUB1 (fetch (SELECTION CHLIM) of SEL]) - -(\SEL.LINEDESC - [LAMBDA (SEL) (* ; "Edited 30-May-91 21:06 by jds") - (* returns the first line descriptor - if the point is left, otherwise the - last) - (COND - [(EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (CAR (MKLIST (fetch (SELECTION L1) of SEL] - (T (CAR (MKLIST (fetch (SELECTION LN) of SEL]) - (\TK.DESCRIBEFONT [LAMBDA (FONT) (* gbn "15-Dec-84 17:54") @@ -517,37 +536,6 @@ 'REGULAR) (CONCAT " " (L-CASE (FONTPROP FONT 'SLOPE] (T ""]) - -(\PARAS.IN.SEL - [LAMBDA (SEL TEXTOBJ) (* ; "Edited 30-May-91 21:06 by jds") - - (* returns a list which contains one character number for each paragraph included - in the selection) - - (PROG ((PARAS) - PARAENDED PCS (POS (fetch (SELECTION CH#) of SEL))) - (COND - ((ZEROP (fetch (SELECTION DCH) of SEL)) - - (* there are not really any pieces in this selection, however, effect the change - to the para containing this selection by starting the selection one character - earlier. This is not the right soln, but TEdit has no looks on the empty last - para as yet.) - - (replace (SELECTION CH#) of SEL with (IDIFFERENCE (fetch (SELECTION CH#) of SEL) - 1)) - (replace (SELECTION DCH) of SEL with 1) - (\FIXSEL SEL TEXTOBJ))) - (SETQ PCS (TEDIT.SELECTED.PIECES TEXTOBJ SEL)) (* to include the first char) - (SETQ PARAENDED T) - (for PC in PCS do (COND - (PARAENDED (* the last piece ended a paragraph, - so include this character in the list) - (SETQ PARAENDED NIL) - (push PARAS POS))) - (SETQ PARAENDED (fetch (PIECE PPARALAST) of PC)) - (add POS (fetch (PIECE PLEN) of PC))) - (RETURN (DREVERSE PARAS]) ) (RPAQQ TEDIT.FNKEY.VERBOSE T) @@ -555,8 +543,8 @@ (RPAQQ \TEDIT.KEYS (("Function,^D" UNDO) ("Function,$" UNDO) - ("Function,^C" FN \TEDIT.FIND) - ("Function,#" FN \TEDIT.FIND) + ("Function,^C" FN \TEDIT.KEY.FIND) + ("Function,#" FN \TEDIT.KEY.FIND) ("Function,Bs" REDO) ("Function,(" REDO) ("Function,^R" NEXT) @@ -586,15 +574,24 @@ ("Function,M" FN \TEDIT.DEFAULTSSEL) ("Function,m" FN \TEDIT.SETDEFAULT.FROM.SEL) ("Function,^A" FN \TEDIT.SHOWCARETLOOKS) - ("Meta,U" UNDO) - ("Meta,u" UNDO) - ("Meta,z" UNDO) - ("Meta,Z" UNDO) - ("Meta,F" FN \TEDIT.FIND) - ("Meta,f" FN \TEDIT.FIND) ("Meta,a" FN \TEDIT.SELECT.ALL) ("Meta,A" FN \TEDIT.SELECT.ALL) - ("Meta,g" FN \TEDIT.FINDAGAIN))) + ("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,p" FN \TEDIT.PRINT.MENU) + ("Meta,P" FN \TEDIT.PRINT.MENU) + ("Meta,r" REDO) + ("Meta,R" REDO) + ("Meta,s" FN \TEDIT.KEY.SUBSTITUTE) + ("Meta,S" FN \TEDIT.KEY.SUBSTITUTE) + ("Meta,U" FN \TEDIT.UNDO.UNDO) + ("Meta,u" UNDO) + ("Meta,z" UNDO) + ("Meta,Z" \TEDIT.UNDO.UNDO))) [MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY) (SELECTQ (CADR ENTRY) @@ -602,33 +599,22 @@ (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY] - - - -(* ; -"Original was %"(FOR ENTRY IN \TEDIT.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))%"." -) - - - - -(* ; "Changed by yabu.fx, for SUNLOADUP without DWIM.") - (DECLARE%: DONTCOPY - (FILEMAP (NIL (5737 18485 (\TEDIT.BOLD.SEL.OFF 5747 . 6085) (\TEDIT.BOLD.SEL.ON 6087 . 6415) ( -\TEDIT.CENTER.SEL 6417 . 7458) (\TEDIT.CENTER.SEL.REV 7460 . 8526) (\TEDIT.DEFAULTS.CARET 8528 . 8806) - (\TEDIT.DEFAULTSSEL 8808 . 9131) (\TEDIT.SETDEFAULT.FROM.SEL 9133 . 9565) (\TEDIT.FIND 9567 . 12789) -(\TEDIT.FINDAGAIN 12791 . 12969) (\TEDIT.ITALIC.SEL.OFF 12971 . 13223) (\TEDIT.ITALIC.SEL.ON 13225 . -13418) (\TEDIT.LARGERSEL 13420 . 13708) (\TEDIT.LCASE.SEL 13710 . 14416) (\TEDIT.SHOWCARETLOOKS 14418 - . 15994) (\TEDIT.SMALLERSEL 15996 . 16287) (\TEDIT.SUBSCRIPTSEL 16289 . 16492) (\TEDIT.SUPERSCRIPTSEL - 16494 . 16698) (\TEDIT.UCASE.SEL 16700 . 17462) (\TEDIT.UNDERLINE.SEL.OFF 17464 . 17662) ( -\TEDIT.UNDERLINE.SEL.ON 17664 . 17860) (\TEDIT.STRIKEOUT.SEL.ON 17862 . 18058) ( -\TEDIT.STRIKEOUT.SEL.OFF 18060 . 18258) (\TEDIT.SELECT.ALL 18260 . 18483)) (18557 24045 ( -\TEDIT.BOLD.CARET.OFF 18567 . 19019) (\TEDIT.BOLD.CARET.ON 19021 . 19470) (\TEDIT.ITALIC.CARET.OFF -19472 . 19926) (\TEDIT.ITALIC.CARET.ON 19928 . 20380) (\TEDIT.LARGER.CARET 20382 . 20834) ( -\TEDIT.SMALLER.CARET 20836 . 21290) (\TEDIT.SUBSCRIPT.CARET 21292 . 21750) (\TEDIT.SUPERSCRIPT.CARET -21752 . 22211) (\TEDIT.UNDERLINE.CARET.OFF 22213 . 22670) (\TEDIT.UNDERLINE.CARET.ON 22672 . 23127) ( -\TEDIT.STRIKEOUT.CARET.OFF 23129 . 23586) (\TEDIT.STRIKEOUT.CARET.ON 23588 . 24043)) (24114 27576 ( -\SEL.LIMIT 24124 . 24568) (\SEL.LINEDESC 24570 . 25174) (\TK.DESCRIBEFONT 25176 . 25866) ( -\PARAS.IN.SEL 25868 . 27574))))) + (FILEMAP (NIL (5593 22336 (\TEDIT.BOLD.SEL.OFF 5603 . 5941) (\TEDIT.BOLD.SEL.ON 5943 . 6271) ( +\TEDIT.CENTER.SEL 6273 . 7789) (\TEDIT.CENTER.SEL.REV 7791 . 8087) (\TEDIT.DEFAULTS.CARET 8089 . 8582) + (\TEDIT.DEFAULTSSEL 8584 . 9031) (\TEDIT.SETDEFAULT.FROM.SEL 9033 . 9710) (\TEDIT.KEY.FIND 9712 . +14442) (\TEDIT.GET.TARGET.STRING 14444 . 15308) (\TEDIT.KEY.FIND.BACKWARD 15310 . 15615) ( +\TEDIT.FINDAGAIN.BACKWARD 15617 . 16028) (\TEDIT.FINDAGAIN 16030 . 16321) (\TEDIT.ITALIC.SEL.OFF 16323 + . 16575) (\TEDIT.ITALIC.SEL.ON 16577 . 16770) (\TEDIT.LARGERSEL 16772 . 17060) (\TEDIT.LCASE.SEL +17062 . 17950) (\TEDIT.SHOWCARETLOOKS 17952 . 19552) (\TEDIT.SMALLERSEL 19554 . 19845) ( +\TEDIT.SUBSCRIPTSEL 19847 . 20050) (\TEDIT.SUPERSCRIPTSEL 20052 . 20256) (\TEDIT.UCASE.SEL 20258 . +21090) (\TEDIT.UNDERLINE.SEL.OFF 21092 . 21290) (\TEDIT.UNDERLINE.SEL.ON 21292 . 21488) ( +\TEDIT.STRIKEOUT.SEL.ON 21490 . 21686) (\TEDIT.STRIKEOUT.SEL.OFF 21688 . 21886) (\TEDIT.SELECT.ALL +21888 . 22111) (\TEDIT.KEY.SUBSTITUTE 22113 . 22334)) (22408 28817 (\TEDIT.BOLD.CARET.OFF 22418 . +22953) (\TEDIT.BOLD.CARET.ON 22955 . 23487) (\TEDIT.ITALIC.CARET.OFF 23489 . 24026) ( +\TEDIT.ITALIC.CARET.ON 24028 . 24571) (\TEDIT.LARGER.CARET 24573 . 25108) (\TEDIT.SMALLER.CARET 25110 + . 25647) (\TEDIT.SUBSCRIPT.CARET 25649 . 26190) (\TEDIT.SUPERSCRIPT.CARET 26192 . 26734) ( +\TEDIT.UNDERLINE.CARET.OFF 26736 . 27276) (\TEDIT.UNDERLINE.CARET.ON 27278 . 27816) ( +\TEDIT.STRIKEOUT.CARET.OFF 27818 . 28358) (\TEDIT.STRIKEOUT.CARET.ON 28360 . 28815)) (28886 29588 ( +\TK.DESCRIBEFONT 28896 . 29586))))) STOP diff --git a/library/tedit/TEDIT-FNKEYS.LCOM b/library/tedit/TEDIT-FNKEYS.LCOM index 8d4d2dbaaea6951a2c804e6d6fe547fa82e9967a..47db44b9ebaf38d38730ae2d3627ebf08fac81d1 100644 GIT binary patch literal 14490 zcmeHO-ESMm5hrCQLD{6R8@EUeG}tgrL!}Zy9!Y(r2y`Tm;#uU8CXcZd1a2vbju?Fz zBGn{q0u)8i$G)ZLL!S!tJ&m1bKRbUx`d=jfK+)gMejZ85V&oQxU?ZUJc4v2HXJ_U& zJ9|l$y^0@r^A*45&HF*6!Cr2)oSyC*$Oq)u8?{pP~bEK7{en9Z&fvPrgi)YDV;KD>7{cx{Ef zOT*K(5@buay_#z1=!QO+S30#Cv&BrO)5!$e?m~ny`8l^ja`v%{baH236w5i8{1RKC zwH7zn(f%$=tdy#5u;#Vr!v;%Lg0_vga(_L-Be1mt=`E zDtmD@Ar)9`)XH3c=|-i(R?16>l+SVu0=7zxvd4VpFs@ynWm)Lm4jaWAc+SvsJA@(B zXIbp0u~_W#s$2Xa{>D}h`LB4s5=&*5L5qz}*BXuWHd|C{CB7xM<%OK{Y$EV$i4@D` zSn8JNuT?_^qwzcS*$ILMO3pKicIh0V1rsFWq8qtN9(N!zK~i56+6lZ{H#=?_n#wV3 zo7aN>JYJKmLQ3Y!BCkkeV6oBmpy5_L9=q)RfNS=?{~rIdT1@ai^!$41GgA7e^h@nC z@h_jFzMbpWuf}7mRk0yAA0$?*ecGohJJ_AYMY%i8R-@hwn=M2Gwy>ZY-Igo1EuX`F z)Qe2-<{I{`sk;keK-~*EP54j2VKuK3GK2+EL)M|c=wZ1fmZH8Jop$I~e1s99Ks>bg zzR$vAB#G`Yw0!6!)u*B5DXfAkfLlfXd9Fj~VM&>#*-g3e+Wrti-A*lRr^#riVD@^P zm_5r`JzB+P{FXmeX`6mbzsf!#NNzz%(ylgc5i79+&XU{|yUk&N2*wU{n_XZZU%tdW zmqvseP4Cr@8Q)8CTTqOxg?qO2`7`(uJ8dD_;hm_%JKt5twiim3rzBsk2= zGf=uqI+vcZTf6?J|x0_Q9o{YcD;lZj0b}Ess%xs7fq8|JjKm^ofpp zAmI94?tI)ia(TXUJR;ixGMCG`MoYR^6@n?|33UD>MVMfD-OmQYBh0bFvq*3)D$)VXZhAFdjB8w?MwZdesf-W-4zc%F z2n{onZ12T0F*b>(r#NReZeMzI$(p zs$eEl0dZg{u$15}SQ*xkV~ywi(X*YY4!6ka0o!>ooF z!C9uM%dB1XD`B~DE8v;AQ($dCl+V*fWa}ZzBd-r#^k`o0BnlVvJN*6)(?z@rrtS|C{?iAv07B6ja4I zPc(gXIfJB#Xrj$5+D!W)PkxAB(5$eYC^Ro9Xf7m*sqrLt?4+yyggu*XSkRAR` zw=RGT)gnM5JG^^$&>J!oZloQxk%!fuuw)63i2C3=zo7&w)2tA#9_pH!ky*)nkbS8$LPEh8R z+JGXYU9USsMlltlX-3>w45aC1f&Tw9K-GL$BQV@~>b>qYI^uwYT>exW;c;9;)KrVt zd`{zTYNbzF_ZE9w_lO5L!lV({rdan&6c*l>@H?~nHAM(j^U|j?gab^EKmc#0+8i$m zPRylwcnbZngY)ItwJ&l^6b%$(b#yedjV900;;`T~CCI+PL6%@qE5J}dlMQxeUN{hY_>x`DjM>F?}u%V}) zI4;tbo_4;mi{amI!;Kz`91C|uHhEE3I&UvkWuF&ku_M_oi!N8EyBBxC*7oYWO03po zkl%05)yq05TfIoZ*jntw+*qzv<)`28ojoZR)+d2;?d;rX8RCmFLwu-GM1EV2I<+b> zL@#HbOpa(RSL|)H>Y`Ha45Jzhi~R-ZeO#0VsVqb_BuaU$M(dHX|8MU9e3XR7S%szV zFvOIpkw>cwCdXVCq1+_OX{hrolKgaUu$(i`i@NrNa*`y*Z4F;5(dHfV41Mc%U8&<0 zLDkAra8#H?>VlgUSsCWVB+<5zW%4_d{G$BSgyj}ho3lV=QWO*`Zr!hKU^;x7f}0v% zpyD+rQIJaVODX>1;0}ftpi=lqCk!`A_?Cjcq@WU;{KN^3ya3Z`x;Jl%+MCtEQYqfg zQg5&~-^6!NmE(i0VgK-8z=k{BA?t1pkGp$&AF=-ay}jOk?_h}b9>Ygb``v@>0p0QN zhP!eY+wFZcSV_)CzAmCe6%Kk7_f@UTGzQAH%_k7!E%cp*^nsBNB1T$y0ZTE#0dwps zUy`e92E}UprfG!GT&JknC)~8iF}g?1Zr=wWL`pKdRck@l?-Pp56vpMak%OXYHPuJe zqS7j^6WykB4_i~F0w(Enyw^7_lRLEBI*6zujZ)J{hgm-OtI~p;n{SGBIENWUjMF{- zu)o*GhkV-J2JCo%59;v69k;^nCJMD|zl&F8kduwkfRz%`KKSb;jU6AQn9+7k9=ZQe z6GscPaspj#mFb^u)_W7}Fq<(h`BNH?INa;8L2s`|0f8M4 zq5EOKH(=fEXFuwHIJ$c!-S96>T~z z-h#+l!scWu)Bx=@kzSS3B5^B1hQ&g+N`9MeWIk-D*#sSYB6Hyi#*pY37!}^LX^g!i zvZPVMwHMGkg>po;3X!Ts82_3u>s@=+5z3KS*CMm(2!Kf=a=vHJ*pA$bMChs!Ivx6> z>e;c0G_XYGS+_|};kQe4N+~CbUyDv>E|nro_o7rf>Ir37##y%s74DC!Y~LoD0QnKt zccLy9g;Gvg?+v?i5f=kLiBq~?OrnD6cz@J{RFKgrgq|m2KZ;EEMr=Xn6uLWVQM!Me zOJL#=t?ppt{hqBrN+8qxi(1VHU+5={D^4Id(y>vf4^dIYPhyC8YR2+(>FL(*jb9!MTxCs=AQ zsab*mQe|HTZ%1%oDkPQij{&Krqw^rC5nceP68XUy6$ z@~q*SOqHQe%2HZ>Vt!{hp-<{M(~2{N(oB9j#nP#j&GkEjVZX;VH&}`# ze^zxDe*VLq?f%yGrM2#zVRz%waC4dx}h-p4O(>Osj2Pv6>xsq6&q_Mbu^{ zr)DO#C*r=*zq_A~^-OY^w4R-9+SROU+Sz8U#%8Kh$+X3CtWr1Hm1fms7SkD8@vAY< zyy`V)=kYvA&#nhMX=GU9#Y7@;qHN553%`l-CjTp*&nD8CrC?+?n+q;0F_mw{Xqz7A zoH^}S_USa!axA@QT61-eHDDB-MkaGw{eT2@q@0Ho?f4Uj=IkRGS6L`m#pL^ot5As5 z!W>&h+h8qLqzB&8Vg=@yiFdT2dv(AK;TF|y@TrsPaI;fNMT&cfu zh}B>CRXX4=f@JqXHW9g`S_&&d+J>K~Hf#v}v7p(Q}QS{$8GU1j%k(_|f@e$N&77a@``z;@J<+mK)#X zLk)>wc(yNJFaKdEO<&`1bE=|{cIzPnSE^^Uora#tRgg&sC@vnjgIZPS#pGj zb!*t;(ysjhvfN*jZDXH*CxLxl{xRQkE!w#BNBThQKRqv2~5^J$9w4%SGRGP*d z5fA9F{Q`UY#PNWcx70FUc^l-wNy`cGE$f5H^Isk<7S zkm|lCeJA{Q=!57S6}g*|g9W<5LcB1>7h;ywe{L*MCpWlqj9ef*koXXO$Th?D%W@Y6 z;1G@6ZHZ+S_!#IJ!CqCmlRR4_7$K|>+UEG-8Et${@DT!cju~@?HQS9M700zPlSE!V88G_oc~ZksUR zEaEZKsb*XFV>xrMLEA(WsZUNzednBjvOW*UNIT zvc5n_NP=z}ZwhMpD9VZtiUKGAZag&r;RRjXqKlZE}*O+g3 z6S7BHxLR_%Wov$ctkNKb7y@7Fq>Y!jS4B)NHe<{s7Ug33xj{kZ2Ex^`e2Li;e4=6e z@4H5+Rc_#j{)IPzex`u=n|J$LmF{+*A&-!NsjCh}hekqwLO?6>169GXh>A8U*QHp; z$A=U!ly}CUQC}N*#0_O1G!vvI|K;R^@5`s#4?lQ;tXUFByYDKbPfkqUe)tC>M9C~l zrqwu1o>pl(6$3s#&-^C}DHni1Zl!I_nzg3mK`YbKR7enWFBO#+c;g^a;;R(CAayodiBcW`-h?`povjJH|BwrZF z2Ygu53AuB0STLI%UV}nB^o4N`_#DJNEY3b{-7D->-3zG8!ZjW?k;kIHM2_XQ4_?RC zJ|!O`Lr)a=1fC1rhAY8-r$QPBdYJ+Q!6;RxgMd(GyGMf3iyTS`_avSgly>rL{KNBQ zKmC)D7>_xCMSfx)L-L#yUagG;VcC9JJf9y=i{!)*jvZLr_NVIG*%5<=|JRvDYvu7M z|Jhj7gY%PTYgrGzdCJNX z2eFTsZy4o$*>`X-u}8&}&z56Wrn_$p>(5rkkze-JeN@yM#O%-3>MGNv)#Vw9Z8a=U z2Io|pLInOQBJi=YD5Z^4^!@NX|Mlcq{~@{d+1Ui$x6n~R3`$z@`W8jz(W7s~=7O_h z@={Nnd2TQB2j_jJXXLq&l;Uha5VGKGK#?Uy=#!QiJae$kBIg9simN0H`hD0*@E z>A(cltl*g!&_vx0CmVj}VliyTaZ=D1*-G%N6=ZLuBa+IK6Ah^(mDZ=HWObeKBNU>c z$m(CjK{-|2#bLRUq~TDCM@U$bn$fWAB@Bmi4l2Fz!=e=apVF!1R-hNy7HBXZ_1cAu z{&6r?LBScN=n5}9>vU@dXIi*ULFH(EQ-cc9yf7WVhy z{?UH!_=6wVw1y8}7Y(xK+GjXP6fbKyG%SmoFuO*X7W=KiwT1WJ;J0F)oBz$~M|JDM zUmLWuJ~@-P{c!c+M|JV~@yUN)<+on`C5|s?k@MkQmXbWi66S58 zfC12A}hLhG?;yMwNe>QN~6q7l)IZu+0Gwf_C>nH1;gxH7ws zTzlJl7tWFWl-pf?T_B{;ogSYmFFyEDV~mQ`Vv-4pAM&z5aPz?LPA9L*vpDSY3F>hd zP<$V%6YvPnr~Gc=xsOkXRW~FxEQL#o%m5-&h!%eRu3~ElZLR(a7DGpFN$(|>E6Kk09)_kHR!Ofm4uO# zTtc-n64ED4I@`S1n=PLyW zv@e6Ih_bOmhl9~**k{}QVV`y?+ZjRkqd|Y0^+zk&i?k_@($ zB9w{77RzyTPe#Cli*N;ZXINU)6eG7CnTJ+idVZ;xr7w4yxEhg82hQZ;^=gVi9ZmEM ziLc_a?H=OwN{ZD2MbWvr`pqi`w$5&+0Io4MX|UNtyxvaXTIf|SdMHp)4~gdXN{X3R zTLup9)jrp~eaQxwD=8gC=(Zx?c2(iSKHRlM`pv5SLg(qAQ|O>C-q^nv>dLCT5p}9= zjgJ;i9g~IDrRA#qV&h>U!{rIQP-H9|42E3-XBZXURQrV6fjmxBvi<=*W3tt#tDHo* z{q`C4raEe@XKd8D$f)WmU}V;})Dabb0p^i@^+>+}1ET6#RXYU$6B%bg?Q#IWHR>mo z@<{RR=y2gtXN2i6+AFBvh)F8O*-$%5ypF44UG20FR7Y4}r!5wkXcSX<&qjaLz1Ru; z488Bf-hUcZ7N=PmpeAu3p9U`{Fho)d8!~bLH z7E3n_1nm(QTkAODx^&t$8nab{rEv$Py@c+9|78HQQEjuNBx6VV&KrsjzXr%K*##fq z3-QJohv!F2j%QruBg$rfblEq9C=(wbgake{w+6Qc8{Hwh+udfbrP8&g{}rE&{PK(_gj8->yMy$GM zHL@v8RQw|rWN!Fp1R|{GL3$*f&&Cl_wni3F@xPA($iv~IvhhA2KpupT%HU55kkW=j z?87oB<3~19*y$($8A6)CN9p)N7>&92BLSqpe0%UwnZuI+WGKAAM=AW*07)RKX!&b^ fkaplan>local>medley3.5>working-medley>library>tedit>TEDIT-HCPY.;1 102257 +(FILECREATED " 6-Mar-2024 23:58:11" {WMEDLEY}tedit>TEDIT-HCPY.;145 33076 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-HCPY.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT.HARDCOPY) + + :PREVIOUS-DATE "19-Jan-2024 23:19:53" {WMEDLEY}tedit>TEDIT-HCPY.;144) (PRETTYCOMPRINT TEDIT-HCPYCOMS) (RPAQQ TEDIT-HCPYCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (COMS + ((COMS (* ;; "Generic interface functions and common code") - (FNS TEDIT.HARDCOPY TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE - \TEDIT.HARDCOPY.FORMATLINE \DOFORMATTING.HARDCOPY \TEDIT.HARDCOPY.MODIFYLOOKS - \TEDIT.HCPYLOOKS.UPDATE \TEDIT.HCPYFMTSPEC \TEDIT.INTEGER.IMAGEBOX)) + (FNS TEDIT.HARDCOPY \TEDIT.PRINT.MENU TEDIT.HCPYFILE \TEDIT.HARDCOPY.DISPLAYLINE + \HARDCOPY.FORMATLINE.HEADINGS \TEDIT.HARDCOPY.MODIFYLOOKS \TEDIT.HCPYFMTSPEC + \TEDIT.INTEGER.IMAGEBOX \TEDIT.DISPLAY.DIACRITIC)) (COMS - (* ;; "Functions for scaling distances and regions as needed during hardcopy.") + (* ;; "Functions for scaling regions as needed during hardcopy.") - (FNS \TEDIT.SCALE \TEDIT.SCALEREGION)) + (FNS \TEDIT.SCALEREGION)) (COMS (* ;; "PRESS-specific code") @@ -33,7 +31,7 @@ [COMS (* ;; "Support for the window-menu's HARDCOPY button, LISTFILES, etc.") - (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY) + (FNS TEDIT.HARDCOPYFN \TEDIT.HARDCOPYFILEFN \TEDIT.HARDCOPY \TEDIT.PRESS.HARDCOPY) [P (LET [(IPVALUES (ASSOC 'CONVERSION (ASSOC 'INTERPRESS PRINTFILETYPES] (COND (IPVALUES (* ;  "Only install INTERPRESS printing if INTERPRESS is loaded.") @@ -60,21 +58,6 @@ (FNS TEDIT-BOOK)))) -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) - (* ;; "Generic interface functions and common code") @@ -83,15 +66,14 @@ (TEDIT.HARDCOPY [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS) + (* ; "Edited 6-Mar-2024 23:33 by rmk") (* ; "Edited 5-Jan-88 16:09 by jds") - (* ;; "Send the text to the printer.") + (* ;; "Send the text to a printer, unless DONTSEND. If DONTSEND and we can't find a server, we'll get the DEFAULTPRINTERTYPE.") + (CL:UNLESS SERVER (SETQ SERVER DEFAULTPRINTINGHOST)) (COND - [(OR SERVER DEFAULTPRINTINGHOST) - - (* ;; "We can only hardcopy if there is a server specified, or the system will give us a reasonable default one.") - + [(OR SERVER DONTSEND) (for IMAGETYPE in (PRINTERPROP (PRINTERTYPE SERVER) 'CANPRINT) do (RETURN (TEDIT.FORMAT.HARDCOPY STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS @@ -101,1057 +83,216 @@ (T (TEDIT.PROMPTPRINT (TEXTOBJ STREAM) "Can't HARDCOPY: No print server specified." T]) -(TEDIT.HCPYFILE - [LAMBDA (STREAM FILE BREAKPAGETITLE) (* ; "Edited 12-Jun-90 18:36 by mitani") +(\TEDIT.PRINT.MENU + [LAMBDA (TSTREAM) (* ; "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] + (SELECTQ [MENU (create MENU + ITEMS _ '(("Print to a file" 'FILE + "Puts image on a file; prompts for filename and format" + ) + ("Send to a printer" 'PRINTER + "Sends image to a printer of your choosing"] + (FILE (HARDCOPYIMAGEW.TOFILE W)) + (PRINTER (HARDCOPYIMAGEW.TOPRINTER W)) + NIL]) - (* Create a hardcopy-format FILE from the text on STREAM, with the file type - depending on what the default printer is.) +(TEDIT.HCPYFILE + [LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 4-Oct-2022 09:23 by rmk") + (* ; "Edited 1-Oct-2022 22:12 by rmk") + (* ; "Edited 12-Jun-90 18:36 by mitani") + + (* ;; "Create a hardcopy-format FILE from the text on TSTREAM, with the file type depending on what the default printer is.") (LET ([IMAGETYPE (CAR (PRINTERPROP (PRINTERTYPE) 'CANPRINT] - TEXTOBJ FILENM TXTFILE) - (COND - ([SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME (TEDIT.GETINPUT - (SETQ TEXTOBJ (TEXTOBJ STREAM)) - (CONCAT IMAGETYPE " file name: ") - (COND - ((type? STREAM (SETQ TXTFILE - (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ))) - (* There was a file, so supply default) - (PACKFILENAME 'VERSION NIL 'EXTENSION - (SELECTQ IMAGETYPE - (PRESS 'PRESS) - (INTERPRESS 'IP) - NIL) - 'BODY - (fetch (STREAM FULLFILENAME) - of TXTFILE] - (TEDIT.FORMAT.HARDCOPY STREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE]) + (TEXTOBJ (TEXTOBJ TSTREAM)) + FILENM TXTFILE) + (CL:WHEN [SETQ FILENM (OR FILE (\TEDIT.MAKEFILENAME + (TEDIT.GETINPUT TEXTOBJ (CONCAT IMAGETYPE " file name: ") + (COND + ((type? STREAM (SETQ TXTFILE (fetch (TEXTOBJ + TXTFILE) + of TEXTOBJ))) + (* ; + "There was a file, so supply default") + (PACKFILENAME 'VERSION NIL 'EXTENSION + (OR (CAR (PRINTFILETYPE IMAGETYPE + 'EXTENSION)) + 'HCPY) + 'BODY + (fetch (STREAM FULLFILENAME) of TXTFILE] + (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE]) (\TEDIT.HARDCOPY.DISPLAYLINE - [LAMBDA (TEXTOBJ LINE THISLINE REGION PRSTREAM) (* ; "Edited 29-Mar-94 13:44 by jds") + [LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 24-Dec-2023 22:07 by rmk") + (* ; "Edited 2-Dec-2023 11:17 by rmk") + (* ; "Edited 28-Oct-2023 23:52 by rmk") + (* ; "Edited 6-May-2023 20:03 by rmk") + (* ; "Edited 7-Mar-2023 23:10 by rmk") + (* ; "Edited 29-Mar-94 13:44 by jds") - (* ;; "Display LINE on the HARDCOPY file under way.") + (* ;; "Display LINE on the HARDCOPY file under way. Original FORM-terminated lines end with EOL.") (* ;; "If possible, use the information cached in THISLINE") - (PROG ((CH 0) - (CHLIST (fetch CHARS of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) - (WLIST (fetch (THISLINE WIDTHS) of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) - (LOOKS (fetch LOOKS of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (LEFTMARGIN (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) - (STREAMSCALE (DSPSCALE NIL PRSTREAM)) - (LINELEN (fetch LEN of (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - THISLINE))) - OLOOKS LOOKSTARTX FONT OFONT CURRENTY FIRST-SCALED-CHAR KERN) - (COND - ((ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - TEXTLEN) (* ; - "Only display the line if it appears before the end of the text!") - (COND - ((fetch (LINEDESCRIPTOR CACHE) of LINE) (* ; - "This line was cached. Don';t need to re-compute the breaks &c") - ) - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; "Format the line to our specs") - (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) - (fetch (LINEDESCRIPTOR CHAR1) of LINE) - THISLINE LINE NIL PRSTREAM))) (* ; - "Use the characters cached in THISLINE.") - (SETQ OLOOKS (\EDITELT LOOKS 0)) - (COND - ((ZEROP (SETQ FIRST-SCALED-CHAR (fetch (THISLINE TLFIRSTSPACE) of THISLINE))) - (* ; - "For expanding spaces to justify a line") - (DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE) - PRSTREAM) - (SETQ FIRST-SCALED-CHAR -1))) - (MOVETO LEFTMARGIN [SETQ CURRENTY (COND - [(AND (fetch (CHARLOOKS CLOFFSET) of OLOOKS) - (NEQ 0 (fetch (CHARLOOKS CLOFFSET) - of OLOOKS))) - (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) - (FIXR (FTIMES STREAMSCALE - (fetch (CHARLOOKS CLOFFSET) - of OLOOKS] - (T (fetch (LINEDESCRIPTOR YBASE) of LINE] - PRSTREAM) - (DSPFONT (SETQ OFONT (fetch (CHARLOOKS CLFONT) of OLOOKS)) - PRSTREAM) - [COND - ((SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) of OLOOKS) - 'KERN)) - (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN] - (STREAMPROP PRSTREAM 'KERN KERN) - (SETQ LOOKSTARTX LEFTMARGIN) - (while (EQ (CHARCODE SPACE) - (\EDITELT CHLIST LINELEN)) do (* ; - "Trim any trailing blanks off the line, to avoid the INTERPRESS CORRECT bug that they cause.") - (add LINELEN -1)) - (bind (LOOKNO _ 1) - (TX _ LEFTMARGIN) - DX for I from 0 to LINELEN - do (SETQ CH (\EDITELT CHLIST I)) - (SETQ DX (\EDITELT WLIST I)) - [COND - ((EQ I FIRST-SCALED-CHAR) (* ; "Time to turn on space scaling.") - (DSPSPACEFACTOR (fetch (THISLINE TLSPACEFACTOR) of THISLINE) - PRSTREAM) - (LET ((X (DSPXPOSITION NIL PRSTREAM)) - (Y (DSPYPOSITION NIL PRSTREAM))) - (MOVETO 0 0 PRSTREAM) - (MOVETO X Y PRSTREAM] - [SELECTC CH - (LMInvisibleRun - (* ;; - "An INVISIBLE run -- skip it, and skip over the char count:") + (\DTEST TEXTOBJ 'TEXTOBJ) + (\DTEST LINE 'LINEDESCRIPTOR) - (add LOOKNO 1)) - (LMLooksChange + (* ;; "Only display the line if it appears before the end of the text!") - (* ;; "Change in character looks. Do any cleanup (like underlining) for the prior characters, and set up the new looks, like font:") + (CL:UNLESS (IGREATERP (FGETLD LINE LCHAR1 LINE) + (FGETTOBJ TEXTOBJ TEXTLEN)) + [LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE))) + (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) + (\FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + LINE REGION PRSTREAM FORMATTINGSTATE)) - (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX - (fetch (LINEDESCRIPTOR YBASE) of LINE) - OLOOKS PRSTREAM) - (DSPFONT (fetch (CHARLOOKS CLFONT) of (SETQ OLOOKS - (\EDITELT LOOKS LOOKNO) - )) - PRSTREAM) - (add LOOKNO 1) - (DSPYPOSITION [SETQ CURRENTY - (COND - [(AND (fetch (CHARLOOKS CLOFFSET) - of OLOOKS) - (NEQ 0 (fetch (CHARLOOKS CLOFFSET) - of OLOOKS))) - (IPLUS (fetch (LINEDESCRIPTOR YBASE) - of LINE) - (FIXR (FTIMES STREAMSCALE - (fetch (CHARLOOKS - CLOFFSET) - of OLOOKS] - (T (fetch (LINEDESCRIPTOR YBASE) - of LINE] - PRSTREAM) - [COND - ((SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) - of OLOOKS) - 'KERN)) - (SETQ KERN (FIXR (FTIMES STREAMSCALE KERN] - (STREAMPROP PRSTREAM 'KERN KERN) - (SETQ LOOKSTARTX TX)) - ((CHARCODE SPACE) - (* ;; - "Space: Just print it, because we set up the space adjustment to do justification.") + (* ;; "Use the characters cached in THISLINE.") - (* ; - "(DSPXPOSITION (IPLUS TX DX) PRSTREAM)") - (\OUTCHAR PRSTREAM CH)) - ((CHARCODE (TAB %#^I)) - (* ;; - "TAB: use the width from the cache to decide the right formatting:") - - [COND - ((OR (IEQP CH (CHARCODE %#^I)) - (fetch (CHARLOOKS CLLEADER) of OLOOKS) - (EQ (fetch (CHARLOOKS CLUSERINFO) of OLOOKS) - 'DOTTEDLEADER)) - - (* ;; "Dotted leaders are meta-TAB, or have the DOTTEDLEADER looks.") + (for CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE + + TLSPACEFACTOR + ) + of THISLINE)) + (FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE)) + (SCALE _ (DSPSCALE NIL PRSTREAM)) + (TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM) + (DSPXPOSITION TX PRSTREAM) + do + (* ;; + "Display the line character by character. CHAR and CHARW are bound to CHARSLOT values") + (SELCHARQ CHAR + (SPACE (CL:WHEN (EQ CHARSLOT FIRST-SCALEDSPACE-SLOT) + (* ; "Time to turn on space scaling.") + (DSPSPACEFACTOR SPACEFACTOR PRSTREAM) + (SETQ SCALESPACES T)) + (\OUTCHAR PRSTREAM (CHARCODE SPACE)) + (add TX (CL:IF SCALESPACES + (HCSCALE SPACEFACTOR CHARW) + CHARW))) + ((TAB Meta,TAB) (* ; + "Dotted leaders are meta-TAB, or are DOTTEDLEADER.") + (CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB)) + (fetch CLLEADER of CLOOKS) + (EQ (fetch CLUSERINFO of CLOOKS) + 'DOTTEDLEADER)) (LET* [(DOTWIDTH (CHARWIDTH (CHARCODE %.) (FONTCOPY (fetch (CHARLOOKS CLFONT) - of OLOOKS) + of CLOOKS) 'DEVICE PRSTREAM))) (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER TX DOTWIDTH] (DSPXPOSITION (IDIFFERENCE TTX DOTWIDTH) PRSTREAM) (* ;  "Move over to the next even multiple of a dot's width.") - (while (ILEQ TTX (IPLUS TX DX)) - do (* ; - "Print enough dots to fill the TAB's gap.") - (\OUTCHAR PRSTREAM (CHARCODE %.)) - (add TTX DOTWIDTH] - (DSPXPOSITION (IPLUS TX DX) - PRSTREAM)) - ((CHARCODE CR) - (* ;; - "Do nothing for carriage return, since it ends the line.") - + (while (ILEQ TTX (IPLUS TX CHARW)) + do (\OUTCHAR PRSTREAM (CHARCODE %.)) + (add TTX DOTWIDTH)))) + (add TX CHARW) + (DSPXPOSITION TX PRSTREAM)) + ((EOL LF CR) NIL) (NIL - (* ;; "Do nothing if it's NIL, which signals a character we deleted during line formatting (e.g., an unused discretionary hyphen)") + (* ;; + "LOOKS. Line-start looks are guaranteed to come before any character/object") - NIL) - (COND - [(SMALLP CH) (* ; "CH is a char code, just print it") - (COND - ((AND (IGEQ CH 192) - (ILEQ CH 207)) (* ; "This is an NS accent character. Readjust our position with MOVETO, so that the accent overprints the next character.") - (MOVETO (+ TX (RSH (- (\EDITELT WLIST (ADD1 I)) - DX) - 1)) - CURRENTY PRSTREAM) - (\OUTCHAR PRSTREAM CH) - (MOVETO TX CURRENTY PRSTREAM) - (SETQ DX 0)) - (T (\OUTCHAR PRSTREAM CH] - (T (* ; "CH is an object.") + (if (type? CHARLOOKS CHARW) + then (CL:WHEN CLOOKS - (* ;; "Add SETXY command to PRSTREAM,to avoid the XP-9's BUG") + (* ;; + "Underline/overline/strike the just-finished looks run") + (* ; "DISPLAY ALSO PASES LINE DESCENT") + (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX + (FGETLD LINE YBASE) + CLOOKS PRSTREAM)) + (SETQ CLOOKS CHARW) + (DSPFONT (fetch CLFONT of CLOOKS) + PRSTREAM) + [SETQ CURY (COND + [(AND (fetch (CHARLOOKS CLOFFSET) of CLOOKS) + (NEQ 0 (fetch (CHARLOOKS CLOFFSET) + of CLOOKS))) + (IPLUS (FGETLD LINE YBASE) + (HCSCALE SCALE (fetch (CHARLOOKS CLOFFSET + ) + of CLOOKS] + (T (FGETLD LINE YBASE] + (DSPYPOSITION CURY PRSTREAM) + (CL:WHEN (SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) + of CLOOKS) + 'KERN)) + (SETQ KERN (HCSCALE SCALE KERN))) - (DSPXPOSITION (IPLUS TX 1) - PRSTREAM) - (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) - CH PRSTREAM (IMAGESTREAMTYPE PRSTREAM) - TEXTOBJ) - (MOVETO (IPLUS TX DX) - CURRENTY PRSTREAM] - (add TX DX) finally + (* ;; "LOOKSTARTX: Starting X position for this CLOOKS.") - (* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:") + (SETQ LOOKSTARTX TX) + elseif (SMALLP CHARW) + else (HELP "UNRECOGNIZED CHARW" CHARW))) + (PROGN (if (IMAGEOBJP CHAR) + then + (* ;; "Go to the base line, left edge of the image region.") - (\TEDIT.HARDCOPY.MODIFYLOOKS LINE LOOKSTARTX TX - (fetch (LINEDESCRIPTOR YBASE) of LINE) - OLOOKS PRSTREAM) - (COND - ((fetch (FMTSPEC FMTREVISED) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) + (SETQ CURY (DSPYPOSITION NIL PRSTREAM)) + (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) + CHAR PRSTREAM (IMAGESTREAMTYPE PRSTREAM) + (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) + (DSPFONT (fetch CLFONT of CLOOKS) + PRSTREAM) (* ; "Restore the font") + (DSPYPOSITION CURY PRSTREAM) + (* ; + "Restore the Y position, assume X is OK") + elseif (DIACRITICP CHAR) + then + (* ;; "Special placement for diacritics") + + (SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE + PRSTREAM)) + else (\OUTCHAR PRSTREAM CHAR)) + (add TX CHARW))) finally + + (* ;; "Do any last-minute underlining or similar looks fix-ups, and print a revision mark, if one is needed:") + + (CL:WHEN CLOOKS + (\TEDIT.HARDCOPY.MODIFYLOOKS LINE + LOOKSTARTX TX (FGETLD LINE YBASE) + CLOOKS PRSTREAM)) + (CL:WHEN (fetch (FMTSPEC FMTREVISED) + of (FGETLD LINE LFMTSPEC)) (* ;  "This paragraph has been revised, so mark it.") - (\TEDIT.MARK.REVISION TEXTOBJ (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE) - PRSTREAM LINE]) + (\TEDIT.MARK.REVISION TEXTOBJ + (FGETLD LINE LFMTSPEC) + PRSTREAM LINE))])]) -(\TEDIT.HARDCOPY.FORMATLINE - [LAMBDA (TEXTOBJ WIDTH CH#1 THISLINE LINE IMAGESTREAM DOINGHEADING? PAGEINFO) - (* ; "Edited 28-Jun-2021 12:34 by rmk:") +(\HARDCOPY.FORMATLINE.HEADINGS + [LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 19-Jan-2024 23:19 by rmk") + (* ; "Edited 3-Oct-2022 13:05 by rmk") -(* ;;; "Given a starting place, format the next line of text. Return T if a control-L was seen on the line.") + (* ;; "Return setup LINE to skip a sequence of heading pieces STATE") - (DECLARE (SPECVARS LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST - WLIST DEVICE NEWASCENT NEWDESCENT IMAGESTREAM)) - (PROG ((TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (CH#B CH#1) - (CHNO CH#1) - (LOOKNO 0) - (GATHERBLANK T) - (TLEN 0) - (INVISIBLERUNS 0) - (DESCENT 0) - (ASCENT 0) - (PREVSP 0) - (%#BLANKS 0) - (DEVICE IMAGESTREAM) - (KERN NIL) - TX DX TXB CH FORCEEND T1SPACE TXB1 DXB LOOK#B FONT FONTWIDTHS TERMSA CLOOKS TEXTSTREAM - CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO CTRL\L\SEEN - 1STLN FMTSPEC NEWASCENT NEWDESCENT PREVHYPH PREVDHYPH ORIGCHLIST ORIGWLIST) + (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) + (PAGEHEADING + (* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.") - (* ;; "Variables:") - - (* ;; "(TLEN = Current character count on the line)") - - (* ;; "(CHNO = Current character # in the Text)") - - (* ;; "(DX = width of current char/object)") - - (* ;; "(TX = current right margin) ") - - (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") - - (* ;; "(CH#B = The CHNO of most recent space/tab)") - - (* ;; "(TXB = right margin of most recent space/tab)") - - (* ;; "(DXB = width of most recent space/tab)") - - (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") - - (* ;; "(T1SPACE = a space/CR/TAB has been seen)") - - (* ;; "(#BLANKS = # of spaces/tabs seen) ") - - (* ;; "(LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") - - (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") - - (* ;; "(ASCENTB = Ascent at most recent potential line break point) (DESCENTB = Descent at most recent potential line break point)") - - [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch CHARS of THISLINE] - (* ; - "Place to put character codes/objects") - [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) of THISLINE] - (* ; "Place to put width of each item") - (SETQ LOOKS (fetch LOOKS of THISLINE)) - (SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) - (replace LOOKSUPDATEFN of TEXTSTREAM with (FUNCTION \TEDIT.HCPYLOOKS.UPDATE)) - (* ; - "This gets called every time we cross a piece boundary, to check for changes in looks.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN) - (* ; - "Force each new line to find its true CHARLIM.") - (freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1) - (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL)(* ; "Assume we won't see a CR.") - (replace (LINEDESCRIPTOR LHASTABS) of LINE with NIL) - (* ; "And has no TABs.") - (replace (LINEDESCRIPTOR LSTLN) of LINE with NIL) (* ; - "And assume it isn't the last line in a paragraph until we find otherwise.") - (replace (THISLINE TLFIRSTSPACE) of THISLINE with 0) - (* ; - "Start out assuming that all spaces on the line will be scaled.") - (COND - [(COND - ((AND (ILEQ CH#1 TEXTLEN) - (NOT (ZEROP TEXTLEN))) (* ; - "Only continue if there's really text we can format.") - (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") - (* ; "And starting character looks") - (SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)) - [COND - ((fetch (CHARLOOKS CLINVISIBLE) of CLOOKS) - (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) of PC))) - (\RPLPTR CHLIST 0 401) - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) - PC TEXTOBJ))) - [while (AND PC (fetch (CHARLOOKS CLINVISIBLE) of CLOOKS)) - do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch (PIECE PLEN) - of PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ] - (add CHNO (\EDITELT LOOKS LOOKNO)) - (COND - (PC (* ; - "Move us to the right place in the stream") - (\SETUPGETCH (create EDITMARK - PC _ PC - PCOFF _ 0 - PCNO _ NIL) - TEXTOBJ)) - (T (* ; - "We've walked off the end of the document. Just note that we're not at any piece now.") - (replace (TEXTSTREAM PIECE) of TEXTSTREAM with NIL] - (ILEQ CHNO TEXTLEN))) - (\TEDIT.HCPYLOOKS.UPDATE TEXTSTREAM (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) - CLOOKS) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") - (SETQ FONT (fetch (CHARLOOKS CLFONT) of CLOOKS)) - [SETQ FONT (COND - ((AND (type? FONTCLASS FONT) - (FONTCLASSCOMPONENT FONT DEVICE))) - (T (FONTCOPY FONT 'DEVICE DEVICE](* ; - "Keep the font around for char widths.") - (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (\TEDIT.APPLY.PARASTYLES (OR (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) of TEXTSTREAM) - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - PC TEXTOBJ) - IMAGESTREAM)) (* ; "Paragraph formatting info") - (COND - ((AND (NEQ FMTSPEC *TEDIT-CACHED-FMTSPEC*) - (fetch (FMTSPEC FMTCHARSTYLES) of FMTSPEC)) - - (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") - - (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) - (SETQ *TEDIT-CACHED-FMTSPEC* FMTSPEC))) - [SETQ 1STLN (OR (IEQP CH#1 1) - (AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) of - TEXTSTREAM - )) - (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM))) - (IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM) - (fetch (STREAM COFFSET) of TEXTSTREAM)) - (IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM) - (fetch (STREAM CPAGE) of TEXTSTREAM] - (* ; - "Are we on the first line of a paragraph?") - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - (COND - ((AND 1STLN (NOT DOINGHEADING?)) (* ; - "This is a new paragraph. Check for special paragraph types, and handle them accordingly.") - (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) - (PAGEHEADING (* ; "This paragraph is the content for a page heading. Handle it, then don't bother formatting further.") - (TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO - IMAGESTREAM) - - (* ;; "This will capture the text, and set LINE:CHARLIM to the LAST char# in the page heading. That lets formatting continue apace.") - - (RETURN NIL)) - (EVEN (* ; "This paragraph may or may not belong here. If this is an odd page, we don't want to format this paragraph.") - (COND - ((ODDP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) - (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO - IMAGESTREAM) - (RETURN NIL)))) - (ODD (* ; "This paragraph may or may not belong here. If this is an even page, we don't want to format this paragraph.") - (COND - ((EVENP (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) - (TEDIT.SKIP.SPECIALCOND TEXTOBJ TEXTSTREAM LINE FMTSPEC CHNO - IMAGESTREAM) - (RETURN NIL)))) - NIL))) - [SETQ TX (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (COND - (1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC)) - (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] - (* ; "Set the left margin accordingly") - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) - (T WIDTH] (* ; - "RIGHTMAR = 0 => follow the window's width.") - (SETQ TXB1 WIDTH) - (for old TLEN from TLEN to 511 as old CHNO from CHNO while (ILEQ CHNO TEXTLEN) - when (SETQ CH (\BIN TEXTSTREAM)) - do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") - - (* ;; "The character loop") - - (* ;; "Get the next character for the line.") - - [SETQ DX (COND - ((SMALLP CH) (* ; "CH is really a character") - (\FGETCHARWIDTH FONT CH)) - (T (* ; "CH is an object") - (SETQ BOX (\TEDIT.INTEGER.IMAGEBOX (APPLY* (IMAGEOBJPROP CH - 'IMAGEBOXFN) - CH IMAGESTREAM TX WIDTH))) - (* ; "Get its size") - [SETQ ASCENT (IMAX ASCENT (IDIFFERENCE (fetch YSIZE of BOX) - (fetch YDESC of BOX] - (SETQ DESCENT (IMAX DESCENT (fetch YDESC of BOX))) - (IMAGEOBJPROP CH 'BOUNDBOX BOX) - (fetch XSIZE of BOX] - (AND KERN (SETQ DX (IPLUS DX KERN))) (* ; "Get CH's X width.") - [SELCHARQ CH - (SPACE (* ; - "CH is a . Remember it, in case we need to break the line.") - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) (* ; - "put the location # of the previous space/tab in the character array instead of the space itself") - (COND - (NEWASCENT - - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") - - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 PREVSP) - (\RPLPTR WLIST 0 DX) - (SETQ PREVSP (ADD1 TLEN)) - (SETQ PREVHYPH NIL) - (SETQ PREVDHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (SETQ T1SPACE T) - (add TX DX) - (SETQ TXB TX) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS) - (add %#BLANKS 1)) - ((CR LF) (* ; - "Ch is a . Force an end to the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) - (COND - ((AND NEWASCENT (ZEROP ASCENT) - (ZEROP DESCENT)) (* ; "The ascent has changed; catch it") - (SETQ ASCENT NEWASCENT) - (SETQ DESCENT NEWDESCENT))) - (SETQ FORCEEND T) - (\RPLPTR CHLIST 0 (CHARCODE CR)) - (\RPLPTR WLIST 0 (SETQ DX 0)) - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ T1SPACE T) - (freplace (LINEDESCRIPTOR CR\END) of LINE with T) - (SETQ TX (IPLUS TX DX)) - (replace (LINEDESCRIPTOR LSTLN) of LINE - with (fetch (PIECE PPARALAST) of (fetch PIECE of TEXTSTREAM))) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (RETURN)) - (^L (* ; - "Ch is a

Force an end to the line. Immediately--just like a CR.") - (SETQ CTRL\L\SEEN T) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) - (SETQ FORCEEND T) - (\RPLPTR CHLIST 0 (CHARCODE CR)) - (\RPLPTR WLIST 0 (SETQ DX (IMAX DX 6))) - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ T1SPACE T) - (freplace (LINEDESCRIPTOR CR\END) of LINE with T) - (SETQ TX (IPLUS TX DX)) - (replace (LINEDESCRIPTOR LSTLN) of LINE with T) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (RETURN)) - (TAB - (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") - - (\RPLPTR CHLIST 0 CH) (* ; "TABs are 0 wide to start with.") - (replace (THISLINE TLFIRSTSPACE) of THISLINE with TLEN) - (COND - (NEWASCENT - - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") - - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC TABSPEC) - of FMTSPEC) - THISLINE CHLIST WLIST TX - (FIXR (FTIMES 36.0 (DSPSCALE NIL IMAGESTREAM))) - 0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM - )) - 1) - NIL)) (* ; - "Figure out which tab stop to use, and what we need to do to get there.") - [COND - ((FIXP TABPENDING) (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX of TABPENDING] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (SETQ DX (\GETBASEPTR WLIST 0)) - (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) - PREVSP) (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) (* ; - "So we can allocate extra space among the right number of blanks to justify things after the tab.") - (SETQ PREVSP 0) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (SETQ T1SPACE T) - (SETQ TX (IPLUS TX DX)) - (SETQ TXB TX) (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - (PROGN (COND - ((AND (EQ CH (CHARCODE "0,377")) - (NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ))) - - (* ;; - "Character-set change character. This suggests undetected NS characters.") - - (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM) - (* ; - "Leaves us ready to BIN again at the same place.") - - (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") - - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add CHNO -1) - (add TLEN -1) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Because moving to NS characters changes the TEXTLEN for the shorter.") - ) - (T - (* ;; "This character isn't special. Just space over for it.") - - (SETQ GATHERBLANK T) - (COND - ((IGREATERP (SETQ TX (IPLUS TX DX)) - WIDTH) (* ; - "We're past the right margin; stop formatting at the last blank.") - (SETQ FORCEEND T) - (COND - (PREVDHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH) - 1) - (CHARCODE "-")) - (\RPLPTR ORIGWLIST (LLSH (SUB1 PREVDHYPH) - 1) - (\FGETCHARWIDTH FONT (CHARCODE "-"))) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (PREVHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (T1SPACE (* ; - "There's a breaking point on this line. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - ((IGREATERP TLEN 0) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX CH#1 (SUB1 CHNO))) - (SETQ TX (IDIFFERENCE TX DX)) - (* ; - "No spaces on this line; break it before this character.") - - (* ;; "Check line break character.") - - (while (OR (MEMBER (\GETBASEPTR CHLIST -2) - TEDIT.DONT.LAST.CHARS) - (MEMBER CH TEDIT.DONT.BREAK.CHARS)) - do - (* ;; - "This character ch doesn't appear at first of lines. or") - - (* ;; - "Previous character doesn't appear at the end of lines.") - - (* ;; "So,move previous character to next line.") - - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add TLEN -1) - (add CHNO -1) - (SETQ CH (\GETBASEPTR CHLIST 0))) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX (SUB1 CHNO) - CH#1))) - (T (* ; - "Can't split BEFORE the first thing on the line!") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX))) - (RETURN)) - (T (* ; "Not past the rightmargin yet...") - (COND - ((AND NEWASCENT (SMALLP CH)) - - (* ;; "The ascent/descent changed. Update the real values, now that we have a character to actually take effect on it") - - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX)(* ; "Check for decimal tabs") - (SELCHARQ CH - (%. (COND - ((AND TABPENDING (NOT (FIXP TABPENDING)) - (EQ (fetch PTTYPE of TABPENDING) - 'DECIMAL)) - (add (fetch (PENDINGTAB PTTABX) of TABPENDING) - DX) - (* ; - "Adjust the pending tab so that the LEFT side of the decimal point goes at the tab stop.") - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC - TABSPEC) - of FMTSPEC) - THISLINE CHLIST WLIST TX - (FIXR (FTIMES 36.0 (DSPSCALE NIL - IMAGESTREAM)) - ) - 0 TABPENDING - (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM)) - 1) - T)) - (* ; - "Figure out which tab stop to use, and what we need to do to get there.") - [COND - ((FIXP TABPENDING) - (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING - (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX of TABPENDING - ] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (* ; "SETQ DX (\GETBASE WLIST 0)") - (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) - PREVSP) - (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) - (* ; - "So we can allocate extra space among the right number of blanks to justify things after the tab.") - (SETQ PREVSP 0) - (SETQ T1SPACE T) - (SETQ TXB TX) - (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)))) - ((- "357,045") (* ; "Hyphen, M-dash") - (SETQ PREVHYPH (ADD1 TLEN)) - (SETQ PREVDHYPH NIL) - (SETQ TXB1 (SETQ TXB TX)) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,042" (* ; "non-breaking hyphen") - (\RPLPTR CHLIST 0 (CHARCODE "-"))) - ("357,043" (* ; "Discretionary hyphen") - (* ; "And isn't actually displayed.") - (SETQ PREVDHYPH (ADD1 TLEN)) - (SETQ PREVHYPH NIL) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (\RPLPTR WLIST 0 0) - (* ; - "Unless we use it, the prevhyph is 0 wide.") - (\RPLPTR CHLIST 0 NIL) - (SETQ TX (IDIFFERENCE TX DX)) - (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE - "-"))) - (SETQ TXB1 (SETQ TXB (IPLUS TX DX))) - (SETQ DXB DX) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,041" (* ; "non-breaking space.") - (\RPLPTR CHLIST 0 (CHARCODE SPACE))) - (COND - ((AND (SMALLP CH) - (IGEQ CH 192) - (ILEQ CH 207)) - (* ; "This is an NS accent character. Space it 0.0 -- SO back TX down by the width of the accent, so it doesn't add to the line width.") - (SETQ TX (- TX DX] - (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; - "Move the pointers forward for the next character.") - (SETQ WLIST (\ADDBASE WLIST 2))) - -(* ;;; "Done processing characters; the line is now filled.") - - (COND - ((AND (IEQP TLEN 255) - (ILESSP CHNO TEXTLEN)) (* ; - "This line is too long for us to format??") - (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T))) - (COND - (TABPENDING (* ; - "There is a TAB outstanding. Go handle it.") - (add (fetch (PENDINGTAB PTTABX) of TABPENDING) - DX) (* ; - "Modify the pending tab so that the LEFT side of the CR is at the tab stop.") - (SETQ TABPENDING (\TEDIT.FORMATTABS TEXTOBJ (fetch (FMTSPEC TABSPEC) - of FMTSPEC) - THISLINE CHLIST WLIST TX - (FIXR (FTIMES 36.0 (DSPSCALE NIL IMAGESTREAM))) - 0 TABPENDING (LRSH (FIXR (DSPSCALE NIL IMAGESTREAM)) - 1) - T)) - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL) - (\TEDIT.PURGE.SPACES (fetch CHARS of THISLINE) - PREVSP) - (SETQ PREVSP 0] - (T (* ; - "No text to go in this line; set Ascent/Descent to the default font from the window.") - (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) - (\EDITSETA LOOKS 0 CLOOKS) - [SETQ 1STLN (AND (fetch (STREAM F5) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (STREAM F5) of TEXTSTREAM)) - (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch (STREAM F5) of TEXTSTREAM)) - ) - (IEQP (fetch (STREAM FW6) of TEXTSTREAM) - (fetch (STREAM CPAGE) of TEXTSTREAM)) - (IEQP (fetch (STREAM FW7) of TEXTSTREAM) - (fetch (STREAM COFFSET) of TEXTSTREAM] - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - [SETQ TX (SETQ TXB (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (COND - (1STLN (fetch (FMTSPEC 1STLEFTMAR) of FMTSPEC)) - (T (fetch (FMTSPEC LEFTMAR) of FMTSPEC] - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch (FMTSPEC RIGHTMAR) of FMTSPEC))) - (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) - (T WIDTH] - (SETQ TXB1 WIDTH))) - [COND - ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT DESCENT))) - (replace (LINEDESCRIPTOR LHEIGHT) of LINE - with (FONTPROP (OR (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ - DEFAULTCHARLOOKS) - of TEXTOBJ))) - DEFAULTFONT) - 'HEIGHT] (* ; - "Line's height (or 12 for an empty line)") - (replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT) - (replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT) - (freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO) - (COND - (FORCEEND NIL) - (T (SETQ CHNO (SUB1 CHNO)) - (SETQ TLEN (SUB1 TLEN)) - (SETQ TXB1 TX))) (* ; - "If we ran off the end of the text, then keep true space left on the line.") - (freplace (LINEDESCRIPTOR LXLIM) of LINE with TX) - (freplace DESC of THISLINE with LINE) - [freplace (THISLINE LEN) of THISLINE - with (IMIN 254 (COND - ((ILESSP TEXTLEN CH#1) - -1) - (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - TEXTLEN) - (IPLUS INVISIBLERUNS (fetch (LINEDESCRIPTOR - CHAR1) - of LINE] - (freplace (LINEDESCRIPTOR SPACELEFT) of LINE with (IDIFFERENCE WIDTH TXB1)) - (\DOFORMATTING.HARDCOPY TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) - (replace (LINEDESCRIPTOR LFMTSPEC) of LINE with FMTSPEC) - (replace LOOKSUPDATEFN of TEXTSTREAM with NIL) - (RETURN CTRL\L\SEEN]) - -(\DOFORMATTING.HARDCOPY - [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) - (* ; "Edited 29-Mar-94 16:30 by jds") - (* ; - "Do the formatting work for justified, centered, etc. lines") - (PROG ((QUAD (fetch QUAD of FMTSPEC)) - (SPACELEFT (fetch (LINEDESCRIPTOR SPACELEFT) of LINE)) - (EXISTINGSPACE 0) - (CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (SPACEOFLOW 0) - EXTRASP OPREVSP LINELEAD) (* ; - "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR DESCENT) - of LINE)) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR ASCENT) - of LINE)) - (* ; - "Save the true ascent value for display purposes") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1) - (* ; - "Start by assuming that we want a space factor of 1.0") - [COND - ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) (* ; - "If line leading was specified, set it") - (COND - (T (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LINELEAD of FMTSPEC)) (* ; - "And adjust the line's descent accordingly") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LINELEAD of FMTSPEC] - [COND - ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADBEFORE of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR ASCENT) of LINE) - (fetch LEADBEFORE of FMTSPEC] - [COND - ((AND (fetch (LINEDESCRIPTOR LSTLN) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LEADAFTER of FMTSPEC] - (SELECTQ QUAD - (LEFT (* ; - "Do nothing for left-justified lines except replace the character codes")) - (RIGHT (* ; "Just move the right margin over") - (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (IPLUS (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE) - (fetch (LINEDESCRIPTOR - SPACELEFT) - of LINE))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR RIGHTMARGIN) - of LINE)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (CENTERED (* ; - "Split the difference for centering") - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (LRSH SPACELEFT 1)) - (add (fetch (LINEDESCRIPTOR LXLIM) of LINE) - (LRSH SPACELEFT 1)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (JUSTIFIED (* ; - "For justified lines, stretch each space so line reaches the right margin") - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN))) - (COND - ((OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "This is the last line in the paragraph; don't stretch it out.") - (SETQ EXTRASP 0)) - ((IEQP PREVSP (ADD1 (fetch (THISLINE LEN) of THISLINE))) - (* ; - "Only if the last character on the line is a space should we remove trailing spaces from the list") - (bind (OPREVSP _ (SUB1 PREVSP)) while (AND (IGREATERP PREVSP 0) - (ILEQ OPREVSP PREVSP)) - do - - (* ;; "Back up over all trailing white space on the line. So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.") - - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (add %#BLANKS -1)) - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR - RIGHTMARGIN) - of LINE)) - (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) - (* ; - "Now apportion the extra space evenly among blanks.") - ) - (T - (* ;; - "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") - - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR - RIGHTMARGIN) - of LINE)) - (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) - (* ; - "Now apportion the extra space evenly among blanks.") - )) - (bind (SP _ PREVSP) while (IGREATERP SP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 SP)) - (SETQ SP (\EDITELT CHLIST OPREVSP)) - (add EXISTINGSPACE (\EDITELT WLIST OPREVSP))) - [while (IGREATERP PREVSP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (\EDITSETA WLIST OPREVSP (FIXR (FTIMES (\EDITELT WLIST OPREVSP) - (FPLUS 1.0 (FQUOTIENT - SPACELEFT - - EXISTINGSPACE - ] - (COND - ((AND (NOT (ZEROP EXISTINGSPACE)) - (NOT (ZEROP EXTRASP))) (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).") - (replace (THISLINE TLSPACEFACTOR) of THISLINE - with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR SPACELEFT - ) of LINE)) - EXISTINGSPACE)) (* ; - "And set the space factor for display") - ) - (T (* ; "Pathological cases ") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1))) - (RETURN)) - NIL) - (\TEDIT.PURGE.SPACES CHLIST PREVSP) (* ; - "Change all the spaces--chained for justification--back into regular spaces, for the display code.") - ]) + (TEDIT.HARDCOPY.PAGEHEADING TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM + FORMATTINGSTATE) + T) + (EVEN (* ; "Skip an odd page.") + (CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#)) + (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) + T)) + NIL]) (\TEDIT.HARDCOPY.MODIFYLOOKS - [LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 30-May-91 21:17 by jds") + [LAMBDA (LINE STARTX CURX CURY LOOKS PRSTREAM) (* ; "Edited 27-May-2023 12:16 by rmk") + (* ; "Edited 30-May-91 21:17 by jds") (* ;; "Do underlining, overlining, etc. for hardcopy files") @@ -1161,26 +302,26 @@ YOFFSET) (COND ((fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.") - (DRAWLINE STARTX (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE) - (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE)) + (DRAWLINE STARTX (IDIFFERENCE (GETLD LINE YBASE) + (GETLD LINE LTRUEDESCENT LINE)) CURX - (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE) - (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE)) + (IDIFFERENCE (GETLD LINE YBASE) + (GETLD LINE LTRUEDESCENT LINE)) RULEWIDTH 'PAINT PRSTREAM) (* ; "A 1/2-pt underline") )) (COND ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line") - (DRAWLINE STARTX (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) - (fetch (LINEDESCRIPTOR LTRUEASCENT) of LINE)) + (DRAWLINE STARTX (IPLUS (GETLD LINE YBASE) + (GETLD LINE LTRUEASCENT LINE)) CURX - (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) - (fetch (LINEDESCRIPTOR LTRUEASCENT) of LINE)) + (IPLUS (GETLD LINE YBASE LINE) + (GETLD LINE LTRUEASCENT LINE)) RULEWIDTH 'PAINT PRSTREAM))) (COND ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struch-thru") - (DRAWLINE STARTX (SETQ YOFFSET (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) + (DRAWLINE STARTX (SETQ YOFFSET (IPLUS (GETLD LINE YBASE LINE) (IQUOTIENT [FIXR (FTIMES STREAMSCALE (FONTPROP (fetch (CHARLOOKS CLFONT) @@ -1190,203 +331,53 @@ CURX YOFFSET RULEWIDTH 'PAINT PRSTREAM] (MOVETO CURX CURY PRSTREAM]) -(\TEDIT.HCPYLOOKS.UPDATE - [LAMBDA (STREAM PC NLOOKS) (* ; - "Edited 3-Jul-93 20:12 by sybalskY:MV:ENVOS") - - (* ;; "At a piece boundary, update the line formatting fields ASCENT, DESCENT, and FONTWIDTHS") - - (* ;; "Also, KERN, if USERPROPS has a KERN entry.") - - (DECLARE (USEDFREE LOOKS ASCENT DESCENT FONTWIDTHS FONT INVISIBLERUNS CHNO TLEN LOOKNO CHLIST - WLIST DEVICE NEWASCENT NEWDESCENT KERN IMAGESTREAM)) - (COND - (PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - TLOOKS TEMP NEWPC OFFSET PARALOOKS PREVPC NEWKERN) - [COND - ([OR (NOT (fetch (PIECE PREVPIECE) of PC)) - (NEQ (fetch (PIECE PPARALOOKS) of PC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) of PC] - (* ; - "The paragraph looks have changed between the last piece and this one. Take account of the change") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of PC) - PC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)) - (T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM] - (SETQ TLOOKS (OR NLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) - PC TEXTOBJ))) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of TLOOKS) - (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO (fetch (PIECE PLEN) of PC)) - (\RPLPTR CHLIST 0 LMInvisibleRun) - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (COND - ((NEQ (fetch (PIECE PPARALOOKS) of PC) - (fetch (PIECE PPARALOOKS) of PREVPC)) - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of PC) - PC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) - (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) - PC TEXTOBJ))) - [while (AND PC (OR (ZEROP (fetch (PIECE PLEN) of PC)) - (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) - do (\EDITSETA LOOKS LOOKNO (IPLUS (fetch (PIECE PLEN) of PC) - (\EDITELT LOOKS LOOKNO))) - (SETQ PREVPC PC) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (COND - ((AND PC (NEQ (fetch (PIECE PPARALOOKS) of PC) - (fetch (PIECE PPARALOOKS) of PREVPC))) - (* ; - "If there IS new text, and the paragraph looks have changed, update the streams notion of them.") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of PC) - PC TEXTOBJ)) - (* ; - "And take care of style sheets on the way.") - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) - (SETQ TLOOKS (AND PC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ] - (add CHNO (\EDITELT LOOKS LOOKNO)) - (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) - (SETQ NEWPC PC))) - (COND - ([AND PC (OR NLOOKS (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) - of STREAM] - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS) - (SETQ FONT (fetch (CHARLOOKS CLFONT) of TLOOKS)) - [SETQ FONT (COND - ((AND (type? FONTCLASS FONT) - (FONTCLASSCOMPONENT FONT DEVICE))) - (T (FONTCOPY FONT 'DEVICE DEVICE] - (SETQ OFFSET (OR [AND (fetch (CHARLOOKS CLOFFSET) of TLOOKS) - (FIXR (FTIMES (DSPSCALE NIL DEVICE) - (fetch (CHARLOOKS CLOFFSET) of TLOOKS] - 0)) - (SETQ NEWASCENT (IMAX ASCENT (IPLUS (fetch \SFAscent of FONT) - OFFSET))) - (SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (fetch \SFDescent of FONT) - OFFSET))) - (SETQ NEWKERN (LISTGET (fetch (CHARLOOKS CLUSERINFO) of TLOOKS) - 'KERN)) - (COND - [NEWKERN (SETQ KERN (FIXR (FTIMES (DSPSCALE NIL DEVICE) - NEWKERN] - (T (SETQ KERN NIL))) - (COND - ((NOT NLOOKS) - - (* ;; "If we're calling this to initialize values, don't go and update the running cache. However, since NLOOKS is NIL, we're not initializing, so go to it!") - - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO TLOOKS) (* ; - "Save the new looks for selection/display") - (\RPLPTR CHLIST 0 LMLooksChange) (* ; - "Put a marker in the character list to denote a looks change") - (\RPLPTR WLIST 0 0) (* ; "Font changes have no width") - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) (* ; - "Account for the dummy marker/looks in TLEN") - )) - (SETQ NEWPC PC)) - ((NOT (OR PC NLOOKS)) (* ; - "We have run off the end of the document. Bail out so that \TEDIT.HARDCOPY.FORMATLINE doesn't die") - (RETFROM '\BIN NIL))) - (OR NEWPC (SETQ NEWPC PC)) - [COND - ((AND (fetch (PIECE POBJ) of NEWPC) - (NEQ (fetch (PIECE PLEN) of NEWPC) - 1)) (* ; - "If this piece is for an object, check for a length mismatch") - (COND - ((IMAGEOBJPROP (fetch (PIECE POBJ) of NEWPC) - 'SUBSTREAM)) - (T - (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from. Build an invisible run to fill the space.") - - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO (SUB1 (fetch (PIECE PLEN) of PC))) - (\RPLPTR CHLIST 0 LMInvisibleRun) (* ; - "Note the existence of an invisible run of characters here.") - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (add CHNO (\EDITELT LOOKS LOOKNO)) - (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) - (* ; - "Keep track of how much invisible text we cross over") - ] - (RETURN NEWPC]) - (\TEDIT.HCPYFMTSPEC - [LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 30-May-91 21:18 by jds") + [LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 7-Mar-2023 21:03 by rmk") + (* ; "Edited 6-Mar-2023 15:14 by rmk") + (* ; "Edited 20-Oct-2022 22:35 by rmk") + (* ; "Edited 29-Sep-2022 23:32 by rmk") + (* ; "Edited 30-May-91 21:18 by jds") - (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.)") + (* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ") - (PROG ((SCALEFACTOR (DSPSCALE NIL IMAGESTREAM))) - (RETURN (create FMTSPEC using SPEC 1STLEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC 1STLEFTMAR) + (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 _ (\FORMATLINE.SCALETABS SPEC SCALE) + FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX) + of SPEC) + (HCSCALE SCALE + (SCALEPAGEUNITS + (fetch (FMTSPEC FMTSPECIALX) of SPEC) - SCALEFACTOR)) - LEFTMAR _ (FIXR (FTIMES (fetch (FMTSPEC LEFTMAR) of SPEC) - SCALEFACTOR)) - RIGHTMAR _ (FIXR (FTIMES (fetch (FMTSPEC RIGHTMAR) - of SPEC) - SCALEFACTOR)) - LEADBEFORE _ (FIXR (FTIMES (fetch (FMTSPEC LEADBEFORE) - of SPEC) - SCALEFACTOR)) - LEADAFTER _ (FIXR (FTIMES (fetch (FMTSPEC LEADAFTER) + 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) - SCALEFACTOR)) - LINELEAD _ (FIXR (FTIMES (fetch (FMTSPEC LINELEAD) - of SPEC) - SCALEFACTOR)) - FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE) - of SPEC) - (FIXR (FTIMES (fetch (FMTSPEC + (HCSCALE SCALE (fetch (FMTSPEC + FMTBASETOBASE ) - of SPEC) - SCALEFACTOR))) - QUAD _ (fetch (FMTSPEC QUAD) of SPEC) - TABSPEC _ - [CONS (AND (CAR (fetch (FMTSPEC TABSPEC) of SPEC)) - (FIXR (FTIMES (CAR (fetch (FMTSPEC TABSPEC) - of SPEC)) - SCALEFACTOR))) - (for TAB in (CDR (fetch (FMTSPEC TABSPEC) of SPEC)) - collect (CONS (FIXR (FTIMES SCALEFACTOR (CAR TAB))) - (CDR TAB] - FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX) of SPEC) - (FIXR (FTIMES (SCALEPAGEUNITS - (fetch (FMTSPEC FMTSPECIALX - ) - of SPEC) - 1.0 NIL) - SCALEFACTOR))) - FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY) of SPEC) - (FIXR (FTIMES (SCALEPAGEUNITS - (fetch (FMTSPEC FMTSPECIALY - ) - of SPEC) - 1.0 NIL) - SCALEFACTOR]) + of SPEC] + FMTSPEC]) (\TEDIT.INTEGER.IMAGEBOX [LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52") @@ -1397,35 +388,42 @@ (replace YSIZE of OLDBOX with (FIXR (fetch YSIZE of OLDBOX))) (replace XSIZE of OLDBOX with (FIXR (fetch XSIZE of OLDBOX))) OLDBOX]) + +(\TEDIT.DISPLAY.DIACRITIC + [LAMBDA (CHARSLOT THISLINE IMAGESTREAM) (* ; "Edited 2-Dec-2023 16:44 by rmk") + (* ; "Edited 28-Oct-2023 23:51 by rmk") + + (* ;; "Called when CHARSLOT contains a diacritic. This moves to a position so that the diacritic will be centered over the next character, prints the diacritic, and then moves the stream back to its starting position. ") + + (* ;; "Returns the %"width%" of what was displayed, so the affected character can be positioned wrt the diacritic. 0 unless the diacritic is wider than the character (shift lt 0). TBD") + + (DSPXPOSITION (PROG1 (DSPXPOSITION (IPLUS (DSPXPOSITION NIL IMAGESTREAM) + (\TEDIT.DIACRITIC.SHIFT CHARSLOT THISLINE IMAGESTREAM)) + IMAGESTREAM) + (\OUTCHAR IMAGESTREAM (CHAR CHARSLOT))) + IMAGESTREAM) + 0]) ) -(* ;; "Functions for scaling distances and regions as needed during hardcopy.") +(* ;; "Functions for scaling regions as needed during hardcopy.") (DEFINEQ -(\TEDIT.SCALE - [LAMBDA (VALUE SCALEFACTOR) (* ; "Edited 2-Jan-87 12:11 by jds") - -(* ;;; "Scale VALUE by SCALEFACTOR, and round it to the nearest integer. Used for scaling distances, etc. during hardcopy.") - - (FIXR (FTIMES VALUE SCALEFACTOR]) - (\TEDIT.SCALEREGION - [LAMBDA (REGION SCALEFACTOR) (* ; "Edited 2-Jan-87 12:13 by jds") + [LAMBDA (SCALEFACTOR REGION) (* ; "Edited 8-Mar-2023 18:20 by rmk") + (* ; "Edited 2-Jan-87 12:13 by jds") -(* ;;; "Scale the region REGION by SCALEFACTOR, rounding all the dimensions to integers. Used to scale page-boundary regions during hardcopy.") + (* ;; "Scale the region REGION by SCALEFACTOR, rounding all the dimensions to integers. Used to scale page-boundary regions during hardcopy.") + + (* ;; "SCALEREGION in Interpress uses FIX instead of FIXR. ") (create REGION - LEFT _ (\TEDIT.SCALE (fetch (REGION LEFT) of REGION) - SCALEFACTOR) - BOTTOM _ (\TEDIT.SCALE (fetch (REGION BOTTOM) of REGION) - SCALEFACTOR) - WIDTH _ (\TEDIT.SCALE (fetch (REGION WIDTH) of REGION) - SCALEFACTOR) - HEIGHT _ (\TEDIT.SCALE (fetch (REGION HEIGHT) of REGION) - SCALEFACTOR]) + LEFT _ (HCSCALE SCALEFACTOR (fetch (REGION LEFT) of REGION)) + BOTTOM _ (HCSCALE SCALEFACTOR (fetch (REGION BOTTOM) of REGION)) + WIDTH _ (HCSCALE SCALEFACTOR (fetch (REGION WIDTH) of REGION)) + HEIGHT _ (HCSCALE SCALEFACTOR (fetch (REGION HEIGHT) of REGION]) ) @@ -1447,38 +445,57 @@ (DEFINEQ (TEDIT.HARDCOPYFN - [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 21-Sep-2021 15:33 by rmk:") + [LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 25-Sep-2023 16:29 by rmk") + (* ; "Edited 4-Jul-2023 11:16 by rmk") + (* ; "Edited 21-Sep-2021 15:33 by rmk:") (* ;;  "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.") - (PROG ((TEXTOBJ (TEXTOBJ WINDOW)) - (TEXTSTREAM (TEXTSTREAM WINDOW))) + (LET ((TEXTOBJ (TEXTOBJ WINDOW)) + (TEXTSTREAM (TEXTSTREAM WINDOW)) + WASDIRTY) - (* ;; "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!") + (* ;; "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!") - (RESETLST - [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) - '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with 'Hardcopy) - (* ; "Build the hardcopy") - (TEDIT.FORMAT.HARDCOPY TEXTOBJ IMAGESTREAM))]) + (CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG) + (SETQ WINDOW (\TEDIT.MAINW WINDOW)) + (SETQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ))) + (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.HARDCOPYFILEFN + [LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk") + (LET [(STRM (OR (GETTOBJ (TEXTOBJ W) + TXTFILE) + (AND (GETTOBJ (TEXTOBJ W) + MENUFLG) + (GETTOBJ (TEXTOBJ (\TEDIT.MAINW W)) + TXTFILE] + (CL:WHEN STRM + (PACKFILENAME 'VERSION NIL 'EXTENSION (OR EXT 'IMAGEFILE) + 'BODY + (FULLNAME STRM)))]) (\TEDIT.HARDCOPY - [LAMBDA (FILE PFILE) (* ; "Edited 12-Jun-90 18:35 by mitani") + [LAMBDA (FILE PFILE) (* ; "Edited 4-Oct-2022 10:40 by rmk") + (* ; "Edited 1-Oct-2022 22:08 by rmk") + (* ; "Edited 12-Jun-90 18:35 by mitani") (* ;; "Send the document FILE to the printer (or to a print file, as determined by PFILE).") - (CL:WITH-OPEN-STREAM [TEXT-STREAM (OPENTEXTSTREAM (COND - ((STRINGP FILE) - (MKATOM FILE)) - (T FILE] + (CL:WITH-OPEN-STREAM (TEXT-STREAM (OPENTEXTSTREAM FILE)) (RESETLST [RESETSAVE (\TEDIT.MARKACTIVE (TEXTOBJ TEXT-STREAM)) '(AND (\TEDIT.MARKINACTIVE OLDVALUE] [RESETSAVE NIL `(AND (CLOSEF? ',PFILE] (replace (TEXTOBJ EDITOPACTIVE) of (TEXTOBJ TEXT-STREAM) with 'Hardcopy) - (TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'INTERPRESS) + (TEDIT.FORMAT.HARDCOPY TEXT-STREAM PFILE T NIL NIL NIL 'POSTSCRIPT) PFILE)]) (\TEDIT.PRESS.HARDCOPY @@ -1544,11 +561,11 @@ (CLOSEF DOC]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3705 96172 (TEDIT.HARDCOPY 3715 . 4731) (TEDIT.HCPYFILE 4733 . 6660) ( -\TEDIT.HARDCOPY.DISPLAYLINE 6662 . 20176) (\TEDIT.HARDCOPY.FORMATLINE 20178 . 65510) ( -\DOFORMATTING.HARDCOPY 65512 . 78584) (\TEDIT.HARDCOPY.MODIFYLOOKS 78586 . 80933) ( -\TEDIT.HCPYLOOKS.UPDATE 80935 . 90952) (\TEDIT.HCPYFMTSPEC 90954 . 95497) (\TEDIT.INTEGER.IMAGEBOX -95499 . 96170)) (96261 97345 (\TEDIT.SCALE 96271 . 96565) (\TEDIT.SCALEREGION 96567 . 97343)) (97588 -100153 (TEDIT.HARDCOPYFN 97598 . 98509) (\TEDIT.HARDCOPY 98511 . 99424) (\TEDIT.PRESS.HARDCOPY 99426 - . 100151)) (101433 102234 (TEDIT-BOOK 101443 . 102232))))) + (FILEMAP (NIL (3328 26268 (TEDIT.HARDCOPY 3338 . 4471) (\TEDIT.PRINT.MENU 4473 . 5327) (TEDIT.HCPYFILE + 5329 . 7269) (\TEDIT.HARDCOPY.DISPLAYLINE 7271 . 17047) (\HARDCOPY.FORMATLINE.HEADINGS 17049 . 18340) + (\TEDIT.HARDCOPY.MODIFYLOOKS 18342 . 20576) (\TEDIT.HCPYFMTSPEC 20578 . 24597) ( +\TEDIT.INTEGER.IMAGEBOX 24599 . 25270) (\TEDIT.DISPLAY.DIACRITIC 25272 . 26266)) (26343 27173 ( +\TEDIT.SCALEREGION 26353 . 27171)) (27416 30972 (TEDIT.HARDCOPYFN 27426 . 28758) ( +\TEDIT.HARDCOPYFILEFN 28760 . 29321) (\TEDIT.HARDCOPY 29323 . 30243) (\TEDIT.PRESS.HARDCOPY 30245 . +30970)) (32252 33053 (TEDIT-BOOK 32262 . 33051))))) STOP diff --git a/library/tedit/TEDIT-HCPY.LCOM b/library/tedit/TEDIT-HCPY.LCOM index 913f3b2ef389e75c0a76ba3629db890ba15a914c..419e96145314f0cf330bc9fc293d97cd99b2c2a6 100644 GIT binary patch literal 12177 zcmbtaU2I#|eJ3eLaX813WY#k@Pd()_M{*^Cm)}x`R9EDscrA*TCa)x`3C7SO9nzL1 zLz3GC?XV)i&|!UQift$c^r0_%C^lG%4K(dGZWxA5dFdWHz(MykV8E~^WqTgB-~WHk zxxA$0#7zT7JokK`|HtqDan5wXD%urmu4tF7IlEGH#8lPHub9i0h}sp`s+H|}H7cfR zmRWGkrSeeql3BNe5uXW%r)h>fy17*71!q2yd)J%AYFbjoTc)BVKVXuPQ?q<~zwn&R=4QzL+uI*q; zwn&M(Ra>`eC?>@c*t=4t-nI)#uth=?oQhkwDg}HPf;k;|g;mg_9t5V^Q&FFLhV)9p)0CMm31&8dlWPUM|R z-gHGOC+T3-m@dh<{>0o>k?=mL6_S!ji@aHpD`o{W%3LeU4cL|Cl2dolN6aTgG~e8L z?LcVRTo9tND<151cMimUd+%%QJ+c3wz16+bZMPtw=_FKyTibj1OnKww2xg~f?QT81 z-`+XcCyiQ>`1uB+>rfF{;XHx&oLf$^7y>^3``qw!#g_5+(rz7 zM&btX%4JTsu{dQ7!G}m|MuL_gr5=~fN~ud_G~KCp$to9$6_Lz}e7Pp&K_m?E&2uBv zN?iM`ZvwV_Q;I}ROixFv%#4Fwkn#?23XpYk&4KdKR%S%B`VfTf-fzCsmgJ^BuY*TG zH8kAW-Q!U^&HHW9+-Xt8{pLY*2EbQujOz* zR#1i1`gsip5FJfEET9<1P~d$jB$&@A>=W~GvE&psMJ_GKkcn(U0Enzg9l$Cw8UIII z0ARTuDle5&q&#^S*oFcZf{|njs6cWjNX!5seU;a^5-Y%Fm(9&G47*l-kj#c0Bp@H| zEh-RnyBl`FEzuXO07*$kz$n!=s0c_ykxDQDd9!TQK`pCJ6-iNcoRzw3)_5u-Ay%wf zg<1@eU#o3WDGtq}PAFsln5kZNTzmkJX?c)|=0qtCA+6QjIsPv2B6F%Q7N#|eX5Ixl zli<1~yUwQ~!z7sxb}nNp&{48bRZK;u2OkMhvzCe2WSP{UzQ&7@?|d;3cwv#H&6IzS zFE1X4K6(Fe?1=wj44!Db+Ht`Qc&UyFF)$iXTil5qXRY zA6(MKFzf5d(VN>bT_rIg&sr;Odhjx~H~Z9?rJsNM`004?*PWO%`>{TC4E5saCm%%e z+c9+YXh8;U}Q!N1&o88iw0g)_Asros=1I9&C;CnN72261vGIyU}4 zPUI+JI+M;t^El*0@`_)MXsB}p^aj-T=+U}9#OU3V4{QvpcojeS@W#l|?09_g#-lIV zHzZ9P@t%_aN#h`C>OCiZt&t#-{=1W!__prz^gT?|xIDC!q}ywaD;RyTF?ksH*O8;t zc>Fh=E0S+h73YfPTc+pa&@F>S7T$9**BUv=w}pv6@_IF{^d9}#5ibPaKMZ__vDcB3 z@#q`O{Ub}sX5%v0*@xYqI#c-;_gFlRZJ%3tV@FZZ*2daGX-9O z0YCfXN6th^a=IbDop+`@VI-D8T({5tOJm~je`n9;gn2wI1?u|ai%_cRym^64M28%> zc(M=PwUroozl@5x?7VL9Aa2zu*u_l=F}Wn#oi&#MD+fcaOn`zxz@eG1*{+=zSvZNn zn9ZtF$2YJco13SKBD`3U&7`Geln}x;Ae&Zo@E{rRv#I#d3`yldQxBkgO2GL5z|GGC z*lyJT^<++|08AWMJ3UXn3tG~;OBxi=yGg-tsB@fo=#;@nx#b-tIS=w_DkQThn#tFi zN=j^J#7`!3fX|A{5mG`gpMV+Q4H@vpys3;VZ^{qF253AmyJ0XH{e58X&_$v=%-UNL ztqF%=#d0~Uzv|Yj7I>0_)xZ%YFSBV-Nt!P>a2a^kY+EuoZNF0*4EKG(mifNO2zk?` z=A|8zlczE;OI}+ti7i6L@|H-F2j6dig@bW~i%~|@3+FT$mxfW!k{FoNh{L35vjp?+ zl_~Vl^;p*{Ct=xjJ@!fzDOhy~XqBv-XZFd~XN|0gu2pJQ-dV2LUqxU|o7^Cak6(^& zV|}{DO4uz~LuvDE7}?V%azMmk8dI3E;;`-13?b90>?Qmj&z|~hXJ8d7`(j=y@>S*d z|3HRlMd_w>$5i$Ai@|&UarfjX($Nt?MAkgMKn9hyzYFb$lu4hizG7EnBpJ3@MmSa= z&s?^6XQmKT9TsGQbUB5BNW!ODw<_eG_}a<8kb;JuUU1~i~s<9dSEy6kqMMP7B*Eu=sa2|!5A++fK| zz+ab0lmU+ES_&Y&53rki0De830r)EX>enGIR4@bqNB}CTCb2Vtxd;J$s%OlTGH4(& zfWJe!X&@H$bx0#%;JFN>3x>PGObl1S1s|@$c806sexSpSB{4)dW|bml~~y1Bydn#&c(c=dxDvV00}dwR6t=@FNMv9mxsXy~oj~GA z$~WwcDkzQ+;;mI|w~oL~8*%WOx#eqvTKNodjGK|wt&5ymRJ#HYU%7T%RAf>&0dwNl zB#5S#i$pHjFT>P%^`xUpm=cH*b=jb#jjA^g3VUT3WUoxVi0b283T}P zJgPw^dRWeLDPhFoFb?zd>&ZJMpO&p!j58uj&Mj>^}= z3X1sWeJpy#maYRQk&A`2yHshNh2gRe8;ie2{Eq|@FiD1>cBBlaybspGJ9hfWWl@UG;VBi3uMKdVXV$lrsOa7uRa|)6utwbIsgeeVY zk$>fnx1~WZqF6EGaaaM~6=#X+_QJyTwaSKFDa^sycdfj89R?elq=r14!OB{7j(n>6 zbx{OgbW*5@%)^FRFW5*IqXBsf8c?&~M0mXi9j_wDM(a2mICVYrLLkWSQ)BVMvE0e6 z^EEcxkvD1|&BEArPPRtZ*O;|+U32om)mojadbRp@?|tj;cqmx1e>NNF*%O2%&}J1v z$hBfJZ;wo}B!zSj`rgwt}>az0T?Fq$oA_T3fph-X&d1iD^)0xgw^0o$ZS3 zPI|L$me(v_ic-0%@aL6DNkala8=1DLo<*-JC`va^w;<`#5%cIvju;VM=>w;QREnQ6 zJ%hS}oHtV$T*>q&1kFpMK}Z^tTmBuN2$ep{kyrBtS#jH!==|~e_?KQ_cJK)Pa~`r9 z=)F1`Btipf!E!#86d(Z{d~00!F(v%9I(DjATJ4X>0~b2l|Yf$M-%q+_h0KZ(x|7z#)RaY1r-PDwMNN|iPb zM*MDIM8U$%zSIF5s*_t%G?~);r-o|vuO&OkA(th6U5Dh-c3_G|M6=mm3~?mf}l1jO&y|9I;Fh848zQ6v0yGaHM-C|r6L;L)qFBx?^}t0hGm#UPumM@9C4UD1YK>MLE5DMaJYl7 z*FCj(E^&Ld@Q_mtTq=5mAay6!`+WrnQ{L13YG0C|-?hoDbF#*-*wvduiY;~jCfOw< z{gkR9T0L9SIlUsU$Z_f8f$iCvj^KhRB9K7TJ^@}gXe9^b$UXRFGt%*K@75nlZYhFdo=nPFwg#zU*F?Y%qAt+u%HaA)hFySuZ`SO0jHbRRD= zwsu=>y8l1@zDJz#P(z-Tu8Wz+L)bKMt^4T-U_G}slQDmuQ%~zl^{A>-(XgsN6`IcA zNMS!Yir(Sr5ybvha~sbT#9sRyNsxW9({8u$+N$*s4=mmh9TiT*G;P#EzG#t_pcTTJ z;;dbB>VeFbN7;2mzhYWaPQScCGDL-#(=vIXz7kn@oyL4TjhpU7I)mGA+z%j7!4hEs zrcx>l9Np@)@t6aTI>hbWgM;1sv%qWqJlK7Jrx$WxYFpuG{o#WLyL$)x`s1L}7GLk~ zw06HfhetUNU)%Q{wTRmfG1bm2IT`#uqdqIz2U{Ki6zlt;(l852BH+7g=IQ5c>U$7+ zu*IsF#xn*8tzG4C3^X$9bpVEX&;ssN)T;yZ9%v#dKqvycHzUD>mZnrn9i-yZlcUz3 z7Ycz_bk5H9yP)0vL34Xs^rw&yn26`yJO1kKzS!PvLL`_1L=<|I(VtYhicA$OSzN0i z7{~+>6eYX;DDCET*UY(UyO4{ zkZ0gT-U0AVM^naZDiIa@i`Rwp%dZT%kdhTy^=lYuSz#nqS0jm6p48Py;B{uS)ZJ^& zrl?AmsFy6!Kw0worO_`eD~-6<(@6P>-Y6sG4Kvai%(c=yP%Ft24U#1qBTE<(mPJ}h zmgGv@E>}`TZBrr6Yl8T^sw}f?>Iy}>-LWzb*Ql0%a z-Uc?e`PmQ53%&JgdoTYqgz~P~RUk15vk{XvEcQ8ZG5qNe@@$3btN-&Lh(!1ymFiD1 zpjW=?GnMO^2oly1qBTpKM%F2P(g8gm0L5n?mdAYBIe{y{Qmya5B6>Uz)UkLm^ Dy{}xn literal 22906 zcmb_^eQ;dYb>A)k!qA$60CLSBC`w;L6b-NhvhVFTY}0uA0qz2ez02JNL0YudAQtoj zSOOdnw5-O>C~l`sX3}x&W-Q6dOkzztty(3<2QiIh%bT{-iKstnPD8g~(?3$DX+6mw z2Gf~L|7gtq&i#1%_AMw~x?m6e4_eN6bscb$yHkHk#$Flh;&Q2Dr zqAX1-rem1h3Ir*GX{+PHacb>T*RVeMRfeQ}|F z?)p--zVuRXJbdoO^^Mi#wJ(mznsfE#s~Za&FP+<5sxEJy!(7?&SSDGxJpL(T)HQ8z z!iY}++{jyX{tA0HoP)dfs)7)-+)9(@eG z;fWAU{I^OU_-vZtD4Qr0(-*URt~8bcvzf1z*~Ua5HW4s>uF2PyUTo*DIqDPa9?w|C zRFW4ivx!v9H&S2*%g#bx%9jgimStg9C_->}p`7LU5-LKhlrCOO7f}qd1O#NJK)thN z$WoS>EXDKXQaYc)gTY9MPzbP689is&6m>{XS#!Cv0GrL9&+t-tlzFancs<>zz3$>p zI`xzX|9z4E_~=i6zct-PQZPb?N>!^wrUPi`{J`w7PK>+HtH^4ccD?)lQv2D^D< zX>s}5@=_I|8wz1}iPohJJO=IYa)cm@Ro549U0+(;yh)pJfkCF#`eHkYbx`XYWaUd` zQBlBZP$56dXxTL*3Ro|v2$=25+_th z>Uihu^Z$W{MFI?) zPZYyJ4KNh8u>fWcNehzTT!V&YYYW$xAZ3sWMYI;Z@f1#koOL;eV?(O|6Y$EHAQa$H zikIiJsd9#%g6uN=m`t=8EG2%yVfqE%a-7fPIhAAB_4o;~nRGEvr644&SSpW|l2$IA z8cSk&sy112u2@Xx%LEwvhEG9#P%*$%NkT1^t)iGE#yHJVLZ2ujoUv>uYu*a*cn-5% zda68Y70+j>IVAWay9NcC1i)nTI1a^hESXWo0E$4KmQN`yQgp@idE!1PxN;_263ik6 zrwSxwLW_*DuF{~#b7aMmGJ0ySGa*Y|Z8hC(H9eEEZ-;8>s-?tkY3tb0|7xGAJdu0w zjqT1K>n^*e)qEc7V0Umb+0o(E9TQe9B{xPx?I6z`Po=M+1{|#nt{m(p`QVYxy~r%@ zlc;p>oVSZ;o>0I#@^=t|BW$An%>IL2f2uyNXh8G5in;ZZqVtizEUtyOKf+*0cutp|T6>>jW@8ay4UV?CD-v&ZY_bMZhD+tA@?Z0{P5yGI> zY(%1Y=JxSPU6Zno(g|6E0b>|}VDrc-&Ww}YC{6++5Q*y+Td&XZRCemJRF*I`<7}2+ zOqV%SYXI7rOgyRIgas3i;}D`cSVH3XipRn%RVrL6@KTmcKNiP%bcN5Ah31aq7*gQk zu!@@XAw$>4fKm&9SSZr$7{kHY(i)A!Mgs2gtck{9Vc;YXc4-vmlRZNu4g*velLE~M z47jQ6r6P-j0|fB0jc+7K#tmA+(FnDO<0K4A%6cimnhCpo>u)gHG6?hzt8r zSP)x+l>qBDS%$F~1VRo(gE)!>IziY08XYqh({q>+F^3a^8H%whQ=dzdNom545yK65 z3~maf!77fTs6b4df@F6Fz%8mzrAx_Twm^6p0hpgtv*l7Dox}r})7BvzbJxY=u-m1b zFa=S-f>_0(bs1+ci3!9onPyQe1+AczxG1a^m<}+oa&R@_E=0j1M>A+^K1E;x2}2*0*;HaKnPh@xuIbEhq&b}l8Fq|?;pOfPJE_^hh&x$q zKo)Go4TzV*)_}F>0%MqPgS1&=z<6`F2in*hhZ~_sK%iU$z+ZQbZ6dL-!-fjAk%WC> z1I8M=z(DfsR=4Cr;M=WR$KFu>56I`m?0IeaK_k$kZU12b$stc=E*Hq=1%mXbpA42y z&(m&#$x5vOdbac<`~tnR3M?37MyZ@5^D`J_$#OAwC3mHi7UpU&!U{=YDF@+TC#g#a zE&-X*kU#`x3hrENKrRL%BFxvIr8?1XQq4$iiBNK9$BfM4JXYE9QgRy+j3an=U2bypZu< zHiROhhbTrBlOQ`qPo(7O7Y>FT1+6EX2l7g(!IZlOC8AL%7L)_*xn~nOD=+MR^1ag+ zO9gbt7Sz0l;65XlRh$fLIFJYtnl`K@cZpmIh|wZBU#; zgw(QdH&UEp7f@~Z`7D~@$u*Bu;Xjb%qTtvk+;^)d}?n&%~ogWAE%wKukV{+frX5|trtYCo&;=?3quoCDbkOKuWv5(79M zXGIL=Tl_3PAsD&W$InV<>x4x4Y(sNTuIC-ko=>gygr+Mk4dVR#R}OYR#`AI}|Esmd zmm564_?1Rt6&}OhvIaDC`vtow`}%I@+%=-%yB<1$FYJK#HwAzWN$GxAXke?j?=dkcu+x9B)kW5Q3J|Y3Z2N`gF@sWBymXtA7qh zXV~3Eu;<`a-Tq@e*=riS=ht+pqw)oRSA%~6Ua;z=nA26c3edmEuO8`qg`x(sdrzal&(_2W!r@`{hkt(eUC-7v&K&+rwZU1M4_a_us?YQa94aX|j6Buh z#s3}N`;}{rD!=yNjRwDlPyz21wUrtwYgAc-udN_*?GvZGaM$_3D}0C#>{F4EH@WlW zM(&$@5Cqk}KmA=^*kQb{$_oUfARt$HksgYGSgRDU2l+9v1^JNJgZuFKYn5{4Vq>{- zs=){O(7nnaJUc!F|7wPO_dYG?`O0L2`{8lF(Lptuum$JKsU{;o$dq z?~%@(f6gUecV3rt5`9}=gGe%vbFot1?%1mzJ=mFBu1rhhTCm|m)p|GBQty5;v{oH( zKTl*oMP&aE;wA%GQlHNHkAek{TYyO|jJ-*Wj`2Yey{*ZOF2gb_JfWTi**~s5Efq$h z8f344Rkcc@@f)vm9g#wf%~yy(47z7Xp>(HqrQ#PW4c6Ez4YogWrMEl(SN-9^ z&cx(<6Hxa%<}~)I(tMHYKa)C}eq)VkgofUp#h-U{nC;Sb=bOvlR|{)Bcw^i92ZH+- zcP^x|Bqx{n#nt!T~p-Sw_$KMDE}KY_r1ngseBZH+VE27G{L~Zl`p2^?4|dj4iRsn*l@;v671}i`ge?U0KH)%g-|>8b;s%1J zzsFhgVdpu~F3vK^7r_$293H`vu*MbyarJ&R@!;EygnwYmFZYa;AP55OkK?oThtRV- z$1~FpetXh!(bC|FH?}*gYR&c1cVo9goqY(AT2>+@g-KZ*4q-Xg*zWji2=i&qpaCDR zQ)m|`8fbfr)AsmdfwcE`cp}JPP`skC?viRAV)2ju*6DeoEz(Xd?G35_9=#zvKdO%% zyb0>oe)`=bs7~&mQc2 zUck6W`d6r0=QwF2@kosrt0nNTEkYYZs8AaP=;^JIwV!_C;1$e>h1vQ$Vi8Z&|B$l> z5L(3W{v{3hkr3)u1B{Ha>D7DN|Mx&!BJ%XgyUiS}r$4;G(PCLN4UQH&4AQY~B{$5q;_4i@d5Axx+pb6fdUA_N~IJ#4O(BG3x{U=Wn2Khg` z{&4H>&d33G2CA6{UvFgc>hZ+>{r$>jqy96#`QRIT^H=LX^LL~ye)_)OHwj}a$^D3m z=j3gKnlkSn(I%WUGi&}XK8?61LMdT(C55XY?fx|HW`hCv>voVVjwp})5REotqI3nS zLSAMB(Yz}%vw=b`C!(VE{tH^rhrN;ZKHA~|B5oPXu+;||s)opM#QWQ7siQ|MWR zLhdrg6s=PEaxPtBVMIU42NwbDFl1Id+q zmFEh$l|~397z?z{rRE`VarVQqYl0CT3z~>fQMf^{4S+3#m%s)U3ksSP*=Y?I2aRZ3 z>@{eF+d_yz+(ERB4S*wVcmYI=iFijyIvBu~Y=$urA#dKQ2LlLr>j()R+7LA3hJNsG~)>Jx*^2u8wiH@eONQkq)nw5X~q!AvCFvk zC}h)!kee~e8_`8a53pTVWBu%bSUX*gB6~%}Z_Q|w1Xm`lm?3C6J0fa^z$_IyL=X`n zJYu#cFo+wOmPR1i@=RAK*aWjy4kIZJDua*$5?w$v=b_lL4HrATrK^F28RyUd4W-Pk zamo!E7db=YLiIu`LH{}0up!E-$%tZIHJL^PF=l&uBhos95spFa>MM;ff~(E0AwY4h zpb;d(#WEN{NV4Lw5yYK@yDRS85SN|Hr=*TSNL6bbx(7k9RZklaGzE_mZdlua_ z22E?15$<<)g^=)6ip2t9mcEGCBOPQ;^%Hf-cr+xlARN0X3Pq?$ibAAy5rpU>P*ueU zlRxP z;$Fb11;RjBU$tQI)!-0`rC7QUdh2$ay0S6|&N~zdZj;owAhx~g9Smxsu#yhtiFz%%FT6l zZGGeV!X|Rh3_9g#46a%ZH_3DwA>@rh^blr8xSqH|7lLSrIvPZV6Anun0Ltkal~3jP zJRU>#B}Nd7p^|h=WJDozha%zB7u~RERHCdOJO$W=IZQ%i6knlSwq2W@vcQF+57cO$^^VEh&3%1hK}QkI9ES13LKhHxJ%gLC%V#;=k7V(n@+dR`)5g zawWZbzu)^*8o{2=@MGx*yHQlY``4*k{McRmyW_d)b5)Ti-AEzKb+xCl_3w`Zy|;kf zUe}giO!a!Lk1)PPb<1t6&!+z52kCyVkNc}D4|a>k)AaLFV_ICK{A3#UF4F=Eu2ue9 zUR3^Z9+i1r`5z?_(~4N%{`6lW1xnKRTeUt=(Az{;|nOLZ>Sy|=d?{>q`f zo%9L-f?fxwu|ByR?{z~IF{(u2iF39aN3?N+&IsBcF!`%rY7gYBN;w;u>6MmjLH=Ld$ zjQKc5*xH`5bCkM|=e}+gVm&qFhg_^=94bATfZ?3wezM6MJWrk z)q{vMvm?lKP_QHLWNkoUGGdiQ8-{h`f)H*`NC|_o=5XLSJ%{69DvOsD$Og8XLYUD7 zEd&DHRqdG-A(%GqUhr_}-alQ$EJ5I8&k}@*@9G@Hn!BrDJ+@V~_ksuD?geWADGC_` zDiEg-N1PdT81`_NTq8{I++Bqbgg)F5r)XtHzNT)nZ_^tw_5-w)+n4 zk_W@n78yvKT}E=W3lW=A>~my^2bm!ZE>}##nYm^s_h05yQxwxe0tZ7}p@2LEdN5dV zE|=Ds+}anA;VEexDchFJBbg3Dwh^+kFT;#N-ojk*lE_<7nb?%LKu9C;|F4kv->vR} z+V6;*7exKXJ7uu%y)H5~LY6)Y)$g(UiME=oFd)(@aaj+?RZshH|Gs;;fB(?o9k^27 zjo7niRM65R1EM|hgs6A^$^P?+nN|SD6Unr=UBcNw!4#DtXu=ar6)mLOAm_tuhPn{D z)3pW!(0+gl5~m6!@-%~oDsbiq?1@xCoy|uMNWr4zGy%&MLor%B9|L}!OQa0w)uuB; zX@nA%(Jr|ZO>~cj?7FMkl_qiv9diI9IYm1%IQU%9+I1KrX0ASnX4(|c#z2ZtU_2Ub zCVjc1W@=MJDM?GchyXVa$wMOL3a&2#bUO73X<&Ne1gXF1LVnpSIVCvtbVmwi$lwd@ zi@e?|h=C-rLG;c-at1qwPkcEKt@7P0H zs{iGx0Hv~Zyw?2C>b*teUYwlQb9O(%Ses`uO=o_X(sbsLW4(B)G0$*Ow8$Fs!}L4c zuwIau_FU~yD69O7CqcboRbRCc{jRkanje`zDZzN=hwkDZvV9gu8uMoksXo)Np5NM# zy}K)vZ!kpp2CwiwVGqA0Uq}#i@4o3Iw++_*BN*VItqQYuVf*37E!Zxis{4R z1{k-R&&Z0bf4I@I9#|mzO^U_SG8Jh4^!!;dZm)0tw9vovXT{nsp4NT4cLr;!lX|hD zTdK{y&Xw=ahvrWUy5H@|QQk(CAEQg^V~b{EKA@YP%H4GypF;`y!P*6$_$ji9S0lMZISZGBHUR=v0o{uip; zy-N9Gujm#rLh;k{tB1%bJhsE#iYJoP4ChYVTTqBe}!ShJRb;`Z$X%v3ul=eV6f)H!`YWr_w7S+_kDsP~p@4}BGZXjDtR z<2uBE5^QNxV~{u8Qr#Rv4i6NW@*d*2fzeJ%Gtd>oDJ+9{F$$f}C6q}+?-t1VC|n*@ zg5Rb}bgPuWYhn?&b=o_D-6<2&0o^`x7+q<(&fPF9Uw2i@NgD?ECWJ6jfpzc`8sFwK z3&Ut=cB7~@oifdP8oC@(`-w&i7lfk~O-%D{)v(QT8KwIHlnyNtUIyXLRB9N>`_PqIbrg{R-LObe9I_6t5&iTb$Ik z3wp7)Xv^>%U8ccr3?e_xJK53ELH~P&O*DWa{@D+ccCo7Ku*gt4lHWQBLp_U^j4u^O zefez8vBRa4tLDc&0lk52Z)vfqe+W~V-!1PMR z0Ah5(QPM@Ea}N#*3D!rT#2ZVXjzsy~JUQjFeXS%OZFE~h1ygw|5P;JtFcz=5m$DNR zXXf(r*?ejYIV0tCvV2CmFVv949Zi0&Fh)5qC3=&f>GZ%qVPY^|QirLbJK!yq=KBwz ze8kh~@rsRI5GxDvE(|Vq6ol#$hLrzYp(qrlBw8XYlWdy#JrGt!J>KP>!JBp2i}XPS zm?)Wrjq2k1jhD#xQ4Sf&V~CAd$lw@pjLPQaIFdZM*rWEh5mb5yE^`HI=(qh-is}DT2GiZ(M6l(F^Jt2DmkT#0%LIjFNx* zJG^uKpO6WNqFVgvfjD^@r@Flqn#OrgxCwOSLejfKS7t8?-x3@;Tm;}WJMeYh2a;B7 z1qg;V&q>89AxQMc{CT9QjjJS9gx8p2Bz#j=pbsv9J1^L>bfL)$2vlKkQNCL&qa>WZV80tq8F6X&}65kFw(n8svX?I4J|1? zd;vmy!NF)sDZ-r^3{1cabJ%h8Y8UM3QhMsMiw-xvhFY3JOdajvO7rN^Lj<_-ALVGCW6NT;poJ0NUUjNIG%#a2TYZlYSxfw(fo+ zi4->UBTgJ*3^b+Y6=?*w+JL+zZRH>j8Yx|agT=wcE?MK;`-Kaxy)V_n1*|XJWW5_j z%GqJcKxkDN{Cm7IKq86M16U9Hw8DZk)x{H^R%#7f8LY+ZgYRk0QsTbivST}gsi98$ zJZcrjtDg7U+TbFrTGt^$FUi{CXlu|`Qa+ea!j5;%A*4{q`B(yBR?Qi*;2}e#(o&qF zvxtNs%rU0EPlXePKG-8ZmWD>e;r7&|$0hC$rq5SV49bdFvU)+Y}3wrjWJGY4X`(-z0qZN%jw z<;_7KAee+&k8eHRT2RW4tqI1uqlP9Z+ghN=?Uiv{b#1y?m25ucAMsp?cRH_Aqk zT9~tnX?&|K4J&MtAkyN{f{3ix5v1P2?84W>V7--+MGJYZ6cCSuV6HI*a3seqB;?K( zMjfyLoRDE7XV|Ac#fHx>tu1XVFXB^hn@bzl78aM-wOeb8o6GBKH`&5kmEqfQ*YSz0 z#r5jaFosUyvu65JS^86GN@Y@VFX8A?p)H?Ga<@tQfo?9?qcWu2L!9?`y3Ku+;i%Uh znf{WK+tnIv<%e&0$|fIaTo`1TJCK>vgA@Dn247zMXi@S-pG{*?$X=1VJm2Pv1go z0+m<_`Z49yTprFD&-*mJntsBFaI(o2jQD^Qi!r0jCv?!E#I`^cLeWC5XqKPQQMe;ZRzF`6A6}yjirTE+E!V_ zr&{&{bYe@M^hgryOme9Ek>QYWHe?Pn@f(!CVf^~2A{>$xQS}RxTvixC)zt{%Tawh( zF!4pp;mq>J!r2g2$rAOFB^oG8cE2!vhEi7Ibqn2Ygd9bCltCZNRDHt{6lWGT)l9NP zgJg-u$P$M5WRa$lB{`F5mourNJxb0bYcZ1$Hlo(dN$Z#m}iA q9;+X;2KkT*;&J*xDG+?+$krfYCZ~cpgqeq{385Swt0hFd`Tqm7nREC6 diff --git a/library/tedit/TEDIT-HISTORY b/library/tedit/TEDIT-HISTORY index bd304cf4..16172ba5 100644 --- a/library/tedit/TEDIT-HISTORY +++ b/library/tedit/TEDIT-HISTORY @@ -1,19 +1,24 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:48"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-HISTORY.;1 36011 +(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}tedit>TEDIT-HISTORY.;147 32593 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-HISTORY.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.HISTORYEVENT.DEFPRINT \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS + TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.DELETION \TEDIT.UNDO.REPLACE + \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE) + + :PREVIOUS-DATE " 4-Mar-2024 21:33:56" {WMEDLEY}tedit>TEDIT-HISTORY.;146) (PRETTYCOMPRINT TEDIT-HISTORYCOMS) (RPAQQ TEDIT-HISTORYCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) + ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT) + (MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH) + )) + (FNS \TEDIT.HISTORYEVENT.DEFPRINT) + (INITRECORDS TEDITHISTORYEVENT) (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST) (INITVARS (TEDIT.HISTORY.TYPELST NIL) (TEDIT.HISTORYLST NIL)) @@ -24,24 +29,107 @@ (COMS (* ;; "Specialized UNDO & REDO functions.") - (FNS TEDIT.UNDO TEDIT.UNDO.INSERTION TEDIT.UNDO.DELETION TEDIT.REDO - TEDIT.REDO.INSERTION TEDIT.UNDO.MOVE TEDIT.UNDO.REPLACE TEDIT.REDO.REPLACE - TEDIT.REDO.MOVE)))) - -(FILESLOAD TEDIT-DCL) + (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)))) (DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT + ))) + THPOINT _ 'LEFT) +) + +(/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER) + '((TEDITHISTORYEVENT 0 POINTER) + (TEDITHISTORYEVENT 2 POINTER) + (TEDITHISTORYEVENT 4 POINTER) + (TEDITHISTORYEVENT 6 POINTER) + (TEDITHISTORYEVENT 8 POINTER) + (TEDITHISTORYEVENT 10 POINTER) + (TEDITHISTORYEVENT 12 POINTER) + (TEDITHISTORYEVENT 14 POINTER)) + '16) + +(DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT)) (DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) + (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) +(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) + (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ)))) -(CONSTANTS (\SCRATCHLEN 64)) +(PUTPROPS GETTH MACRO ((EVENT FIELD) + (fetch (TEDITHISTORYEVENT FIELD) of EVENT))) + +(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) + (replace (TEDITHISTORYEVENT FIELD) of EVENT with NEWVALUE))) ) +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) ) +(DEFINEQ + +(\TEDIT.HISTORYEVENT.DEFPRINT + [LAMBDA (EVENT STREAM) (* ; "Edited 24-May-2023 23:36 by rmk") + (* ; "Edited 22-May-2023 14:42 by rmk") + (* ; "Edited 21-May-2023 09:15 by rmk") + (LET (INFO LOC) + (SETQ INFO (CONCAT (fetch (TEDITHISTORYEVENT THACTION) of EVENT) + " " + (fetch (TEDITHISTORYEVENT THCH#) of EVENT) + "-" + (fetch (TEDITHISTORYEVENT THLEN) of EVENT) + "-" + (NTHCHAR (fetch (TEDITHISTORYEVENT THPOINT) of EVENT) + 1))) + (SETQ LOC (LOC EVENT)) + (CONS (CONCAT "{TH" ":" INFO " " (CAR LOC) + "/" + (CDR LOC) + "}"]) +) + +(/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER) + '((TEDITHISTORYEVENT 0 POINTER) + (TEDITHISTORYEVENT 2 POINTER) + (TEDITHISTORYEVENT 4 POINTER) + (TEDITHISTORYEVENT 6 POINTER) + (TEDITHISTORYEVENT 8 POINTER) + (TEDITHISTORYEVENT 10 POINTER) + (TEDITHISTORYEVENT 12 POINTER) + (TEDITHISTORYEVENT 14 POINTER)) + '16) + +(DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT)) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST) @@ -58,53 +146,85 @@ (DEFINEQ (\TEDIT.HISTORYADD - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Sep-87 10:36 by jds") + [LAMBDA (TEXTOBJ EVENT) (* ; "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") + (* ; "Edited 14-Jun-2023 16:04 by rmk") + (* ; "Edited 12-Jun-2023 10:26 by rmk") + (* ; "Edited 3-Jun-2023 20:41 by rmk") + (* ; "Edited 28-May-2023 00:07 by rmk") + (* ; "Edited 3-Sep-87 10:36 by jds") - (* ;; "Add a new event to the history list. For now, this just re-sets the whole list to be the one event...") + (* ;; "Add a new event to the history list, unless the list is currently DON'T (as in middle of foreign get).") - (* ;; "This function also takes care of cumulating cumulative events, like successive deletions.") + (* ;; "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.") - (LET* ((OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - (ETYPE (fetch (TEDITHISTORYEVENT THACTION) of EVENT)) - (OETYPE (fetch (TEDITHISTORYEVENT THACTION) of OLDEVENT)) - (REALEVENT EVENT)) - [COND - ((AND OLDEVENT (EQ OETYPE ETYPE) - (EQ ETYPE 'Delete)) (* ; - "Repeated successive deletions. See if we can combine them.") - (LET* [(OSTART (fetch (TEDITHISTORYEVENT THCH#) of OLDEVENT)) - (NSTART (fetch (TEDITHISTORYEVENT THCH#) of EVENT)) - (OLDEND (+ OSTART (fetch (TEDITHISTORYEVENT THLEN) of OLDEVENT))) - (NEWEND (+ NSTART (fetch (TEDITHISTORYEVENT THLEN) of EVENT] - (COND - ((IEQP OLDEND NSTART) (* ; - "The old deletion was just in front of the current one; cumulate them.") - (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT T))) - ((IEQP NEWEND OSTART) (* ; - "The new deletion was just in front of the old one; cumulate them.") - (SETQ REALEVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT T] - (replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with REALEVENT]) + (CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY)) + (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)) + + (* ;; "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))) + + (* ;; + "Repeated successive deletions, we can combine them if they are adjacent.") + + (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))) + + (* ;; "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] + + (* ;; "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") + + (push (GETTOBJ TEXTOBJ TXTHISTORY) + EVENT))) + EVENT]) (\TEDIT.CUMULATE.EVENTS - [LAMBDA (EVENT1 EVENT2 PIECES-TO-SAVE?) (* ; "Edited 3-Sep-87 10:42 by jds") + [LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 3-Mar-2024 12:15 by rmk") + (* ; "Edited 3-Jun-2023 17:09 by rmk") + (* ; "Edited 27-May-2023 00:54 by rmk") + (* ; "Edited 25-May-2023 23:58 by rmk") + (* ; "Edited 21-May-2023 13:14 by rmk") + (* ; "Edited 17-May-2023 14:55 by rmk") + (* ; "Edited 3-Sep-87 10:42 by jds") - (* ;; "Accumulate history events that should really be combined into a single event.") + (* ;; "Accumulate history events that should be combined into a undoable single even.") (* ;; "For now, this assumes they're events of the same type. Actually, this should be able to cumulate a delete/insert pair into a replacement, etc.") - (LET* [(OLDLEN (fetch (TEDITHISTORYEVENT THLEN) of EVENT1)) - (NEWPC1 (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT2)) - (REALEVENT (create TEDITHISTORYEVENT using EVENT1 THLEN _ (+ OLDLEN (fetch ( - TEDITHISTORYEVENT - THLEN) - of EVENT2] - (bind (PC _ (fetch (TEDITHISTORYEVENT THFIRSTPIECE) of EVENT1)) - (CHCOUNT _ 0) while (< (SETQ CHCOUNT (+ CHCOUNT (fetch (PIECE PLEN) of PC))) - OLDLEN) do (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally (replace (PIECE NEXTPIECE) of PC with NEWPC1) - (replace (PIECE PREVPIECE) of NEWPC1 with PC) - (RETURN)) - REALEVENT]) + (SETTH EVENT1 THDELETEDPIECES (\SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES) + (GETTH EVENT2 THDELETEDPIECES) + TEXTOBJ)) + (SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES))) + EVENT1]) ) @@ -114,464 +234,332 @@ (DEFINEQ (TEDIT.UNDO - [LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:41 by mitani") + [LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 20:02 by rmk") + (* ; "Edited 22-Nov-2023 18:17 by rmk") + (* ; "Edited 27-Sep-2023 00:14 by rmk") + (* ; "Edited 23-Jun-2023 00:19 by rmk") + (* ; "Edited 12-Jun-90 18:41 by mitani") - (* ;; "Undo the last thing this guy did.") + (* ;; "Undo the last thing this guy did. This could be a sequence of subevents for a single user-level action that has more than one component: e.g. move or replace is (Insert Delete). Undoing each (sub)event must restore the status quo ante (pieces, lines, looks, SEL). ") - (COND - ((NOT (FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ)) + (* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY) (* ;; "Only undo things if the document is allowed to change.") - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - EVENT CH# LEN FIRSTPIECE) - (COND - ((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - (* ; - "There really is something to UNDO. Decide what, & fix it.") - (SETQ LEN (fetch THLEN of EVENT)) (* ; - "Length of the text that was inserted/deleted/changed") - (SETQ CH# (fetch THCH# of EVENT)) (* ; "Starting CH# of the change") - (SETQ FIRSTPIECE (fetch THFIRSTPIECE of EVENT)) - (* ; - "First piece affected by the change") - (RESETLST - (RESETSAVE (CURSOR WAITINGCURSOR)) - (\SHOWSEL SEL NIL NIL) - [SELECTQ (fetch THACTION of EVENT) - ((Insert Copy Include) (* ; "It was an insertion") - (TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Delete (* ; "It was a deletion") - (TEDIT.UNDO.DELETION TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Looks (* ; "It was a character-looks change") - (TEDIT.UNDO.LOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (ParaLooks (* ; "It was a PARA looks change") - (TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Move (TEDIT.UNDO.MOVE TEXTOBJ EVENT LEN CH# FIRSTPIECE) - (* ; "He moved some text") - ) - ((Replace LowerCase UpperCase) + (TEDIT.PROMPTPRINT TEXTOBJ "" T) + (PROG ((SEL (TEXTSEL TEXTOBJ)) + (EVENT (\TEDIT.POPEVENT TEXTOBJ)) + PREVEVENTS UNDOEVENT) + (CL:UNLESS EVENT + (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T) + (RETURN)) - (* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.") + (* ;; "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. ") - (TEDIT.UNDO.REPLACE TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (Get (* ; "He did a GET -- not undoable.") - (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a GET." T)) - (Put (* ; "He did a PUT -- not undoable.") - (TEDIT.PROMPTPRINT TEXTOBJ "You can't UNDO a Put." T)) - (COND - ((AND (SETQ UNDOFN (ASSOC (fetch THACTION of EVENT) - TEDIT.HISTORY.TYPELST)) - (SETQ UNDOFN (CADDR UNDOFN))) - (* ; - "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") - (APPLY* UNDOFN TEXTOBJ EVENT LEN CH# FIRSTPIECE)) - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " - (fetch THACTION of EVENT)) - T] - (\SHOWSEL SEL NIL T))) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to UNDO." T]) + (* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.") -(TEDIT.UNDO.INSERTION - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 01:33 by jds") + (SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY)) + (\SHOWSEL SEL NIL) + (\TEDIT.UNDO1 TEXTOBJ EVENT) - (* ;; "UNDO a prior Insert, Copy, or Include.") + (* ;; + "Gather into a single (list) event all the events that were created as part of the undo. .") - (PROG (OBJ DELETEFN) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Keep TEdit from reusing the current cache piece in the future -- it is probably invalid") - (\DELETECH CH# (IPLUS CH# LEN) - LEN TEXTOBJ) - (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) - (fetch (TEXTOBJ SEL) of TEXTOBJ) - CH# - (IPLUS CH# LEN) - TEXTOBJ) (* ; - "Fix the line descriptors & selection") - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of TEXTOBJ) with 'LEFT) - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Delete) (* ; - "Make the UNDO be UNDOable, by changing the event to a deletion.") - ]) + [SETQ UNDOEVENT (for ETAIL on (FGETTOBJ TEXTOBJ TXTHISTORY) + until (EQ ETAIL PREVEVENTS) collect (CAR ETAIL) + finally (RETURN (CL:IF (CDR $$VAL) + $$VAL + (CAR $$VAL))] + (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)) -(TEDIT.UNDO.DELETION - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 21-Apr-93 12:01 by jds") + (* ;; "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.") - (* ;; "UNDO a prior Deletion of text.") + (push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ) + (LIST (CAR PREVEVENTS) + UNDOEVENT EVENT)) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T)))]) - (PROG ((NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - NEWPIECE INSPC OBJECT INSERTFN START-OF-PIECE) - (SETQ INSPC (\CHTOPC CH# PCTB T)) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Keep future people from stepping on the current cache piece, which is probably no longer valid.") - (COND - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) (* ; "Don't change read-only documents.") - (RETURN))) - [COND - ((IGREATERP CH# START-OF-PIECE) - (SETQ INSPC (\SPLITPIECE INSPC (- CH# START-OF-PIECE) - TEXTOBJ INSPC#] - (SETQ NEWPIECE (create PIECE using FIRSTPIECE)) - (replace THFIRSTPIECE of EVENT with NEWPIECE) - (bind (TL _ 0) while (ILESSP TL LEN) do (\INSERTPIECE NEWPIECE INSPC TEXTOBJ) - (* ; "Insert the piece back in") - [COND - ([AND (SETQ OBJECT (fetch (PIECE POBJ) - of NEWPIECE)) - (SETQ INSERTFN (IMAGEOBJPROP OBJECT - 'WHENINSERTEDFN] - (* ; - "If this is an imageobject, and it has an insertfn, call it.") - (APPLY* INSERTFN OBJECT (\TEDIT.PRIMARYW - TEXTOBJ) - NIL - (TEXTSTREAM TEXTOBJ] - (SETQ TL (IPLUS TL (fetch (PIECE PLEN) of - FIRSTPIECE - ))) - (* ; - "Keep track of how much we've re-inserted") - (SETQ FIRSTPIECE NPC) - (* ; "Move to the next piece to insert") - (AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) - of NPC))) - (SETQ NEWPIECE (create PIECE using FIRSTPIECE))) - (* ; - "Done here because \INSERTPIECE creams the NEXTPIECE field.") - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - LEN)) - (* ; - "Reset the text length and EOF ptr of the text stream.") - (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ; - "Fix the line descriptors & selection") - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION CH#) of SEL with CH#) (* ; - "Make the selection point at the re-inserted text") - (replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN)) - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT)) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Insert) (* ; - "Make the UNDO be UNDOable, by changing the event to a insertion.") - ]) +(\TEDIT.UNDO1 + [LAMBDA (TEXTOBJ EVENT) (* ; "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.") + + (\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 did a GET or PUT-- not undoable.") + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION)) + T)) + (LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION) + TEDIT.HISTORY.TYPELST] + (COND + (UNDOFN + + (* ;; "TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)") + + (APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN) + (GETTH EVENT THCH#) + (GETTH EVENT THFIRSTPIECE))) + (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT + THACTION)) + T]) (TEDIT.REDO - [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:27 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 4-Mar-2024 21:33 by rmk") + (* ; "Edited 2-Mar-2024 09:41 by rmk") + (* ; "Edited 21-Dec-2023 11:57 by rmk") + (* ; "Edited 27-May-2023 11:19 by rmk") + (* ; "Edited 30-May-91 21:27 by jds") (* ;; "REDO the last thing this guy did.") - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - EVENT CH) - (COND - ((FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ) + (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)) - (* ;; "The document is read-only; don't make any changes.") + (* ;; "There really is something to redo and something to do it to.") - NIL) - ((SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - (* ; - "There really is something to REDO Decide what, & do it.") - (RESETLST - (RESETSAVE (CURSOR WAITINGCURSOR)) - (\SHOWSEL SEL NIL NIL) - (SELECTQ (fetch THACTION of EVENT) - ((Insert Copy Include) (* ; "It was an insertion") - (TEDIT.REDO.INSERTION TEXTOBJ EVENT - (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (fetch (SELECTION CHLIM) of SEL)) - NIL)))) - (Delete (* ; "It was a deletion") - (\TEDIT.DELETE SEL TEXTOBJ)) - (Replace (* ; + (\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 (* ;  "It was a replacement (a del/insert combo)") - (TEDIT.REDO.REPLACE TEXTOBJ EVENT)) - (LowerCase (* ; "He lower-cased something") - (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) - (UpperCase (* ; "He upper-cased something") - (\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL)) - (Looks (* ; "It was a looks change") - (TEDIT.REDO.LOOKS TEXTOBJ EVENT (IMAX 1 - (SELECTQ (fetch (SELECTION POINT) - of SEL) - (LEFT (fetch (SELECTION CH#) - of SEL)) - (RIGHT (fetch (SELECTION - CHLIM) - of SEL)) - NIL)))) - (ParaLooks (* ; "It was a Paragraph looks change") - (TEDIT.REDO.PARALOOKS TEXTOBJ EVENT - (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (fetch (SELECTION CHLIM) of SEL)) - NIL)))) - (Find (* ; "EXACT-MATCH SEARCH COMMAND") - (RESETLST - (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (\SHOWSEL SEL NIL NIL) - (SETQ CH (TEDIT.FIND TEXTOBJ (fetch THAUXINFO of EVENT))) - (COND - (CH (TEDIT.PROMPTPRINT TEXTOBJ "done.") - (replace (SELECTION CH#) of SEL with CH) - [replace (SELECTION CHLIM) of SEL - with (IPLUS CH (NCHARS (fetch THAUXINFO of EVENT] - (replace (SELECTION DCH) of SEL - with (NCHARS (fetch THAUXINFO of EVENT))) - (replace (SELECTION POINT) of SEL with 'RIGHT) - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T)) - (T (TEDIT.PROMPTPRINT TEXTOBJ "[Not found]")))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; "Drop the cached piece. WHY??") - ) - ((Move ReplaceMove) (* ; "He moved some text") - (TEDIT.REDO.MOVE TEXTOBJ EVENT (fetch THLEN of EVENT) - (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (fetch (SELECTION CHLIM) of SEL)) - NIL)) - (fetch THFIRSTPIECE of EVENT))) - (Get (* ; "He did a GET -- not undoable.") - (TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a GET." T)) - (Put (* ; "He did a PUT -- not undoable.") - (TEDIT.PROMPTPRINT TEXTOBJ "You can't REDO a PUT." T)) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "REDO of the action " (fetch THACTION - of EVENT) - " isn't implemented.") - T)) - (\SHOWSEL SEL NIL T))) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Nothing to REDO." T]) + (\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") + (* (* ;; "RESTLST ?") + (AND NIL (RESETSAVE (CURSOR + WAITINGCURSOR))) (TEDIT.PROMPTPRINT + TEXTOBJ "Searching..." T) + (SETQ SEL (fetch (TEXTOBJ SEL) of + TEXTOBJ)) (\SHOWSEL SEL NIL) + (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)) (\FIXSEL SEL TEXTOBJ) + (TEDIT.NORMALIZECARET TEXTOBJ) + (\SHOWSEL SEL T)) (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)) + (\SHOWSEL SEL T)))]) -(TEDIT.REDO.INSERTION - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 21-Apr-93 01:06 by jds") - (* ; - "REDO a prior Insert/Copy/Include of text.") - (PROG (INSPC INSPC# NPC (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (LEN (fetch THLEN of EVENT)) - (FIRSTPIECE (create PIECE using (fetch THFIRSTPIECE of EVENT) - PNEW _ T)) - (OTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - OBJ COPYFN ORIGFIRSTPC) - (SETQ ORIGFIRSTPC FIRSTPIECE) - (replace THFIRSTPIECE of EVENT with FIRSTPIECE) (* ; - "So we can UNDO this, and remove the right set of pieces.") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Force any further insertions to make new pieces.") - (SETQ NPC (fetch (PIECE NEXTPIECE) of FIRSTPIECE)) - (SETQ INSPC (\CHTOPC CH# PCTB T)) - [SETQ INSPC (COND - ((IEQP CH# START-OF-PIECE) (* ; - "We're inserting just before an existing piece") - INSPC) - (T (* ; - "We must split this piece, and insert before the second part.") - (\SPLITPIECE INSPC (- CH# START-OF-PIECE) - TEXTOBJ] - (bind (TL _ 0) while (ILESSP TL LEN) - do - (* ;; "Loop thru the pieces of the prior insertion, inserting copies of enough of them to cover the length of the insertion.") +(\TEDIT.UNDO.UNDO + [LAMBDA (TEXTOBJ) (* ; "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") - [COND - ((SETQ OBJ (fetch (PIECE POBJ) of FIRSTPIECE)) - (* ; "This piece describes an object") - [COND - [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) - (SETQ OBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - (COND - ((EQ OBJ 'DON'T) - (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) - (RETFROM 'TEDIT.COPY)) - (T (replace (PIECE POBJ) of FIRSTPIECE with OBJ] - (OBJ (replace (PIECE POBJ) of FIRSTPIECE with (COPY OBJ] - (COND - ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (* ; - "If there's an eventfn for copying, use it.") - (APPLY* COPYFN OBJ (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - 'DSP) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ] - (\INSERTPIECE FIRSTPIECE INSPC TEXTOBJ) (* ; "Insert the piece back in") - (SETQ TL (IPLUS TL (fetch (PIECE PLEN) of FIRSTPIECE))) - (* ; - "Keep track of how much we've re-inserted") - (SETQ FIRSTPIECE (create PIECE using NPC PNEW _ T)) - (* ; "Move to the next piece to insert") - (AND NPC (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) - (* ; - "Done here because \INSERTPIECE creams the NEXTPIECE field.") - ) - (\TEDIT.DIFFUSE.PARALOOKS (fetch (PIECE PREVPIECE) of ORIGFIRSTPC) - INSPC) (* ; - "propagate paragraph formatting into the new insertion") - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - LEN)) - (* ; - "Reset the text length and EOF ptr of the text stream.") - (\FIXILINES TEXTOBJ SEL CH# LEN OTEXTLEN) (* ; - "Fix the line descriptors & selection") - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; - "Fix up the display for all this foofaraw") - (replace (SELECTION CH#) of SEL with CH#) (* ; - "Make the selection point at the re-inserted text") - (replace (SELECTION CHLIM) of SEL with (IPLUS CH# LEN)) - (replace (SELECTION DCH) of SEL with LEN) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (\FIXSEL SEL TEXTOBJ) (* ; "Really fix the selection") - (replace THACTION of EVENT with 'Insert) (* ; - "Make the UNDO be UNDOable, by changing the event to a insertion.") - ]) + (* ;; + "This undoes a preceding undo, by pushing the undoing event on the history list, and undoing that.") -(TEDIT.UNDO.MOVE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") - (* ; "UNDO a MOVE command") - (PROG ((TOOBJ (fetch THAUXINFO of EVENT)) - (FROMOBJ (fetch THTEXTOBJ of EVENT)) - (SOURCECH# (fetch THOLDINFO of EVENT)) - (CH# (fetch THCH# of EVENT)) - TOSEL TOTEXTLEN) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ) - NIL NIL) (* ; - "Turn off the selections in the old source and target documents") - (\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ) - NIL NIL) - (\DELETECH CH# (IPLUS CH# LEN) - LEN FROMOBJ) (* ; - "Delete the characters we moved, from the place we moved them to") - (\FIXDLINES (fetch (TEXTOBJ LINES) of FROMOBJ) - (fetch (TEXTOBJ SEL) of FROMOBJ) - CH# - (IPLUS CH# LEN) - FROMOBJ) - (replace (SELECTION CH#) of (fetch (TEXTOBJ SEL) of FROMOBJ) - with (replace (SELECTION CHLIM) of (fetch (TEXTOBJ SEL) of FROMOBJ) with CH#)) + (* ;; "The state is recorded as the event that would be undone next") + + (* ;; "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.") + + (push (FGETTOBJ TEXTOBJ TXTHISTORY) + (CADR LASTUNDONE)) + (TEDIT.UNDO TEXTOBJ) + + (* ;; "This 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) (* ; + "If something else has happened, there are no undos to undo.") + (TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T]) +) +(DEFINEQ + +(\TEDIT.UNDO.INSERTION + [LAMBDA (TEXTOBJ EVENT) (* ; "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") + (* ; "Edited 21-Apr-93 01:33 by jds") + + (* ;; "UNDO a prior Insert, Copy, or Include. ") + + (\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + EVENT]) + +(\TEDIT.UNDO.DELETION + [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 23:31 by rmk") + (* ; "Edited 27-May-2023 23:39 by rmk") + (* ; "Edited 21-Apr-93 12:01 by jds") + + (* ;; "UNDO a prior deletion ") + + (\TEDIT.INSERT.SELPIECES (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES) + 'INSERT TEXTOBJ) + TEXTOBJ + (GETTH EVENT THCH#]) + +(\TEDIT.UNDO.MOVE + [LAMBDA (TEXTOBJ EVENT) (* ; "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.") + + (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 (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES) + 'INSERT TEXTOBJ) + TEXTOBJ + (GETTH EVENT THCH#))) + (if FOBJ + then (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ)) (* ; - "Make this document's selection be a point sel at the place the text used to be.") - (replace (SELECTION DCH) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 0) - (replace (SELECTION POINT) of (fetch (TEXTOBJ SEL) of FROMOBJ) with 'LEFT) - (* ; - "Mark lines for update, and fix the selection") - (SETQ TOTEXTLEN (fetch (TEXTOBJ TEXTLEN) of TOOBJ))(* ; - "The pre-insertion len of the place the text is returning to, for the line udpater below") - (\TEDIT.INSERT.PIECES TOOBJ SOURCECH# (fetch THFIRSTPIECE of EVENT) - LEN) + "Delete is last event in other document") + (TEDIT.UNDO FOBJ)) + else (\TEDIT.UNDO1 TEXTOBJ DELEVENT)) - (* ;; "Put the pieces we moved back where they came from (no need to copy them, since we did that on the original move.)") + (* ;; "Put the point back after the original target. Caller wil fix it.") - (\FIXILINES TOOBJ (fetch (TEXTOBJ SEL) of TOOBJ) - SOURCECH# LEN TOTEXTLEN) (* ; - "Mark lines that need updating, and fix up the selection") - (add (fetch (TEXTOBJ TEXTLEN) of TOOBJ) - LEN) (* ; - "Update the text length of the erstwhile move source") - (TEDIT.UPDATE.SCREEN FROMOBJ) (* ; - "Update the erstwhile text location's image.") - (COND - ((NEQ FROMOBJ TOOBJ) (* ; - "If they aren't the same document, we need to update the other document image as well.") - (TEDIT.UPDATE.SCREEN TOOBJ))) - (\FIXSEL (fetch (TEXTOBJ SEL) of TOOBJ) - TOOBJ) (* ; - "Fix up the selections so their images will be OK") - (\FIXSEL (fetch (TEXTOBJ SEL) of FROMOBJ) - FROMOBJ) - (\COPYSEL (fetch (TEXTOBJ SEL) of FROMOBJ) - TEDIT.SELECTION) (* ; - "It's handy to think of this as the last selection made, also.") - (replace THACTION of EVENT with 'Move) - (replace THTEXTOBJ of EVENT with TOOBJ) - (replace THAUXINFO of EVENT with FROMOBJ) - (replace THOLDINFO of EVENT with CH#) - (replace THCH# of EVENT with SOURCECH#) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TOOBJ) - NIL T) - (\SHOWSEL (fetch (TEXTOBJ SEL) of FROMOBJ) - NIL T]) + (\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T]) -(TEDIT.UNDO.REPLACE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:27 by jds") - (PROG ((OLDEVENT (fetch THOLDINFO of EVENT)) - (CH# (fetch THCH# of EVENT)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (\SHOWSEL SEL NIL NIL) - (TEDIT.UNDO.INSERTION TEXTOBJ EVENT LEN CH# FIRSTPIECE) - (\SHOWSEL SEL NIL NIL) - (TEDIT.UNDO.DELETION TEXTOBJ OLDEVENT (fetch THLEN of OLDEVENT) - CH# - (fetch THFIRSTPIECE of OLDEVENT)) - (replace THOLDINFO of OLDEVENT with EVENT) - (replace THACTION of OLDEVENT with 'Replace) - (replace THOLDINFO of EVENT with NIL) - (\TEDIT.HISTORYADD TEXTOBJ OLDEVENT) - (replace (SELECTION CH#) of SEL with CH#) - (replace (SELECTION CHLIM) of SEL with (IPLUS CH# (fetch THLEN of OLDEVENT))) - (replace (SELECTION DCH) of SEL with (fetch THLEN of OLDEVENT)) - (replace (SELECTION POINT) of SEL with (fetch THPOINT of EVENT)) - (replace THPOINT of OLDEVENT with (fetch THPOINT of EVENT)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T]) +(\TEDIT.UNDO.REPLACE + [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 30-May-2023 23:10 by rmk") + (* ; "Edited 27-May-2023 16:49 by rmk") + (* ; "Edited 24-May-2023 22:43 by rmk") -(TEDIT.REDO.REPLACE - [LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-91 21:28 by jds") - (PROG ((OLDEVENT (fetch THOLDINFO of EVENT)) - (CH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (\SHOWSEL SEL NIL NIL) - (\DELETECH (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CHLIM) of SEL) - (IDIFFERENCE (fetch (SELECTION CHLIM) of SEL) - (fetch (SELECTION CH#) of SEL)) - TEXTOBJ) - (\FIXDLINES (fetch (TEXTOBJ LINES) of TEXTOBJ) - SEL - (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CHLIM) of SEL) - TEXTOBJ) - (replace (SELECTION POINT) of SEL with 'LEFT) - (TEDIT.REDO.INSERTION TEXTOBJ EVENT CH#) - (replace THOLDINFO of EVENT with (SETQ OLDEVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ))) - (replace THACTION of OLDEVENT with 'Replace) - (replace THACTION of EVENT with 'Replace) - (replace THCH# of EVENT with CH#) - (\TEDIT.HISTORYADD TEXTOBJ EVENT]) + (* ;; "This undoes the replacement, but tracks for REDO whether the action was replace, lowercase, or uppercase.") -(TEDIT.REDO.MOVE - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:28 by jds") - (PROG ((FROMOBJ TEXTOBJ) - (SOURCECH# (fetch THOLDINFO of EVENT)) - (OLDCH# (fetch THCH# of EVENT)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (MOVESEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) - OLDCHLIM) - (replace (SELECTION CH#) of MOVESEL with OLDCH#) - (replace (SELECTION CHLIM) of MOVESEL with (IPLUS OLDCH# LEN)) - (replace (SELECTION DCH) of MOVESEL with LEN) - (replace (SELECTION SET) of MOVESEL with T) - (\FIXSEL MOVESEL TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS MOVESEL 'MOVE) - (TEDIT.MOVE MOVESEL SEL]) + (\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY (GETTH EVENT THDELETEDPIECES) + NIL TEXTOBJ) + TEXTOBJ + (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + EVENT)) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THACTION ACTION]) +) +(DEFINEQ + +(\TEDIT.REDO.INSERTION + [LAMBDA (TEXTOBJ EVENT SEL) (* ; "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 (\SELPIECES.COPY (\SELPIECES EVENT NIL TEXTOBJ) + 'INSERT TEXTOBJ) + TEXTOBJ SEL]) + +(\TEDIT.REDO.REPLACE + [LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 2-Oct-2023 11:43 by rmk") + (* ; "Edited 31-May-2023 10:25 by rmk") + (* ; "Edited 27-May-2023 11:16 by rmk") + (* ; "Edited 16-May-2023 22:05 by rmk") + (* ; "Edited 30-May-91 21:28 by jds") + + (* ;; "We get the replacement from where EVENT just installed it in the text (assume that it is still there unchanged), and then we use it to replace what is now at the current selection. EVENT's deleted pieces are not relevant.") + + (\TEDIT.REPLACE.SELPIECES (\SELPIECES.COPY (\SELPIECES EVENT NIL TEXTOBJ) + NIL TEXTOBJ) + TEXTOBJ + (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ) + EVENT)) + (SETTH (\TEDIT.LASTEVENT TEXTOBJ) + THACTION ACTION]) + +(\TEDIT.REDO.MOVE + [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "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) + (\FIXSEL SCR2 TEXTOBJ) + (\TEDIT.SET.SEL.LOOKS SCR2 'MOVE) + (TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1548 4840 (\TEDIT.HISTORYADD 1558 . 3393) (\TEDIT.CUMULATE.EVENTS 3395 . 4838)) (4893 -35988 (TEDIT.UNDO 4903 . 8883) (TEDIT.UNDO.INSERTION 8885 . 10419) (TEDIT.UNDO.DELETION 10421 . 15423) - (TEDIT.REDO 15425 . 22036) (TEDIT.REDO.INSERTION 22038 . 28108) (TEDIT.UNDO.MOVE 28110 . 32451) ( -TEDIT.UNDO.REPLACE 32453 . 33807) (TEDIT.REDO.REPLACE 33809 . 35165) (TEDIT.REDO.MOVE 35167 . 35986))) -)) + (FILEMAP (NIL (5054 6075 (\TEDIT.HISTORYEVENT.DEFPRINT 5064 . 6073)) (6841 12292 (\TEDIT.HISTORYADD +6851 . 10927) (\TEDIT.CUMULATE.EVENTS 10929 . 12290)) (12345 25970 (TEDIT.UNDO 12355 . 15592) ( +\TEDIT.UNDO1 15594 . 18659) (TEDIT.REDO 18661 . 23730) (\TEDIT.UNDO.UNDO 23732 . 25968)) (25971 29764 +(\TEDIT.UNDO.INSERTION 25981 . 26738) (\TEDIT.UNDO.DELETION 26740 . 27312) (\TEDIT.UNDO.MOVE 27314 . +28974) (\TEDIT.UNDO.REPLACE 28976 . 29762)) (29765 32570 (\TEDIT.REDO.INSERTION 29775 . 30604) ( +\TEDIT.REDO.REPLACE 30606 . 31726) (\TEDIT.REDO.MOVE 31728 . 32568))))) STOP diff --git a/library/tedit/TEDIT-HISTORY.LCOM b/library/tedit/TEDIT-HISTORY.LCOM index 5bdc5152a27560c56a204230091a10c785a48fcd..7c8ab1fdd765b38675349f99a2ed284c7f97c5b9 100644 GIT binary patch literal 9358 zcmc&)-ESjT6}O#qX-%6tyJ;&$ReN^|tpgj^Gh;i67qy<)DAs@RzA10dlC1k(1U;;l$LAi*CH9*}tCcfZCn_GGv1 z3wiL&oH_U0d(S=RcRnV`l3BK^=5pDtn9Fvx?2zYbMsd@)U=qcyx@Ns%H);xbu5KD7 z*I2Jikk^fdN!0XGJf5TyiePii5>ZHId8^r9*3w#rXj(p-&SzDHB$eIX?St-KyG45Y zV0!!VmRYKpJMVmLuY0}U?7#KOpxx>YUV#YPUAF9o>(qBr=he*05{XaBR8=PPdcW-n zZGZEifB5A*xyl5jgaGrBS#?v`XRVGMO}sQpB@!3>#qF)_3f7-uBN~KD*{+rxIf&k? zf?hX+bj(mOUE8VpnNxMMRxygEHwPW%5yiZWw&h$hNf%lvZ&xbBufJ3(rI1z=s+rO& z)j?KSdZ_X>{j(^W=vsD7CwX=X>pP@>`xc4kiUb$m^0m5o$#%9I%O#xlgi_VKuIID4&!Df|l3aPXF7l<-c(O)RQgMo; zM$&}2nGHh2g}-bO8#HEeOC+)%i$r4cBw9EX!QcHzk6y&XDgVQ){~>lOPWhhr0{y*G zc#K|l7z6vU*smSsml(S|@hD~LEG8mJHJv3zr&=^zl3Qh~%&C%)&628X;q2?Mvdjv% zeg8g*o(Ump!b<|2tJ91SO4inh@{U5*G@`t$kku>>L?J66=5fgoP?b?#MqSH<$GOQRJ_d81GR=g6Gt|GxAPcXFn0lr~Y>H zczDjR3SXqFxE}K+`yHRvj`DBDYNv|?lvSn_q!!C54S{pkp zqU-7Lz3RJ9>mFT$0ZD#s)kn{+fsTL@uthB!W}#Y!%9!E}H*tiv5MG#OzSQ1p586aa zhgdwQbp4ZasH-_p`EJ#f?D#(Cqld0e)#+ZR8MYRyL@mKb7Dq&PjV%x-+(AJIt^?pv?f9fmK34Su&yMK2QFJ7A)-ThDW z^wq-Vg0(q3yEzkO&^tW08J)uE;WLGg&P8q>e^B64jtVzFJ{J)h@VFo;Mv16%ZBF5PjtdSb-wMiFs^qeWUg zEdEkle>5ua@RK-+@WTm)-~K~zPQI9Y9)6Wus+c*>uflrWh4^T}oe=$-iN*cAV6=ph zF%OVy96m2)vW)BAlYvLc^(!H5_$>Dc!4zS}#$75QQ-jDiXxx7~7K>7^8Y#)?K#T}5XfP#_4Qc@HV#R5gFF?N*5K$|X<~~hcc*4n8ZL6v(1ait7UwkV zhD9_Dv5onhrisG{__Y=q2~bv(d~vUL*nS@(gtaQ*0j`wEM;8A((Ki`AY9i z`Iv)h|M&QNRio0VSg)*)GC zlheBumE^a2Z?p+)MJ5$GR?29QmoN4X-Xbc>PkaBc-5;<_U?Pvf@ggNeg+MKY?Dqzw zd;4IoeY?F+i{#gPeH0KH@(*RFcZcjY_g@+?^de0H=;DXRs&@fga0m;5QI-j`M4Jwb zf1dRMqZb#WA5O-?=)5vxPsBc+Wq-7Qfb`Q~RJ3?_vIVvXoR~zPpNtB&#c<~+dS3AS zcvP?$ejG)U5?-DHUjU|#qK}Jr5YZAMBL5Ac{Y%Pt1~T|+9=-p#9PyX1w+Z>ygSRsy zvAfpe6vU1q-xK5BJBoZqia0l32cW=pwpLm20zw3x0p8V&9e5o#u zpM0{rXD42=e1$2EBkaf;2lq?{xFdsmMy6^35X`^}1PEqi79V6tdnK|CR}#oH?&Rq3 zYi?;5OtEBfRh5@A7NHdJzUgSw5Gt!AyI=nNbD=3MD@LWx%75?jglI zA1I=Om_d+J>g`sK<#U}jY3>fXtPQIpe)yoW4;~7YFj%x?#turfpQQRMhxSBZkBZA|5XC+JZ$4+VJ%9P6>wNoU=xI!W3Y!F|T~W zeW2zUXQdBZ!wYl`B4M9n^$zdr6=X8cs|lp)UIgL0qx19r0+KtRv3x?ep|*p?gl4fw z!1(ABQl{VzSpMuKK$wALKxOnsS&y13hJH6WshEqrJ2T!}JSsL6j}`7O&dY^-NTwjQ+<2cZ>@Nx?F z-OFdl=yQae6b1y5pw{>wYjo@l~wThHZwF?Rvvy zIEY8IBCHp1)!<|&_Lw3U&|`W;*yeLI?h8{s#ZQmdVz)kCh>ULCJnkG@yz|Gu|FH02 z0l{RPz}GMyZrS?q9YGjy!*r=(i|m{>CS-Ro1dXs+B!seEfng$<3+*}hV>t$*aqGG} zMKlZ9r)#zt`CS~;23YDfqh00Q5S2IU-Z3}3qKt(3OyJhl#NJ=N?*M7##HSJ*d|93N(P;3 zl_bAH&YvfW)jb^a`fn}o;Yw~dyXY?LH}}ymdHv2l%bgDujEGO~ly<#@ekQ(AOis}_ zXzzBLd);rLZ^1&-i-dJ1yctq-3Oa+o%`b73#WubZHp)k5xw9DRCy&9t_=P6%;#xv4THzYxVuz&{Q0N5KxRsYL*I#&4(16>v3vJv})0z_+Wuw;`hO#q&Y35mFxb zdc3mn_Ty@f9)b5?F%M9EdArI}262pjm3jYGLxoW&dQ~81nAe4J(9S9Ky*Pg2{{tO- B*d;tB(tud1=15{w=202!I>dNQ7OFQWn_*t;?U$!vRfyPA~KO| zS#o8$Y1&<&F9mveC|VRKq4}B=mKfpnsi|z0G z&N(xOlG1dO>Onm7o$Gw}-*;xF?k;;xcW&A9-8rwh9Ej&zmD+0Mx+}6?Gj!X&*J)+N z^KG|M4=Yvw1i4!2xWdZMrqeUDLJh-0w=S|)VQ%Ho?wp;sZDGwX7E6nTg{+v#ZtdTH zu(R9miTyp173trpcUHgstB)S`4<25-xA|aqbMM;j{?_L1wfp_vZvQPOSG@M-{=vPS zy*K70<=XDfYX_SLZ(Td=_jV4iVJ|P7Yj~Y7Xy3}cWX+27@Yc?vRbI@Ovf{OaezbT0 zw;mik{Q9EU+dtgK(qac^S?>D2Fi)M!<+7r;iG9vo)3UR(pYhH`e&_%9cNETi-m=7E ztL?6PLANtk2g^^M(OS$eEat5*#NxgFn`d&_o=x9o#^)5{EA_fqtS_WzTB0PH?uOf} zi*WD&{*dlPlTP+t&OXyaf*WeKzkyR@%Lic7E zR99w2V&_64ky;u};O}W;;>JiN`CcRW!^-=OV{gTKc3k(~psr`fFEvuBRPsj^`v1Wi z9+DqTBu9NbQ{zib|EG7K{b{4}`@z^6T8}G@ov+Zu_b*?Ti?3!HtK*58g|bjDU+b=Q zeXu^qr|QgJnkg^na|y>5_5N=EurG?5h5@se&Yr8eR}i&EE$A{o9MP&VTTCWd#NJlT zLI<sp>$b31ckFxRQ9yWa#&G0R3XFZl-JNc_P_B5`gBuRJl4Bu=D~?=2;l zQppCh0UaqkMgP@-~aXYFUm(Rb7A0d$LhbP zSH{(t3rGK!XnOvo8Oy=j(D8+3=XJ}{t#VP4n0Zp^y3Kk}$>;Mh0n)ivOGk5W2PSD!(~*)O@$n?6&5XgZ5hIs#w+>LCez8LE9F@&Sl|13NPZfAeOy$ zCzOX z>s2e+lZyEd>i2Kd?_UjWw6NVPt>mjjzp|BnS4dhbnI?*~p8?)jw#K1HTj}F}=hxdE={`4h z^q+|tyHpUjJB?ri%oFx}0rG%L&q0W5t+3Tb2oiR2LDYg~tr7~WTvh`}7P+?D@++h{ z^CU-_$K3OipC*ZYUUT7W)1c+fwnZ9eP^t5g#H{+s$~ zzAV~(M8hrg6iQ-k|2NUFVG5fEoBsa(y@v?7&{l4h%8{p;7vA31?xS8`6u`0l2X6@+ z$J;}6JrrfJQSm~rd0n0r${igV47Nm;I7bmt?A(8_+rQu6qsaIA{sF?Y4HM1Y+J7Xr zHut`9$Yvlm>1_}pZE*8+-*q?4WoIwNywe`81fLJ1K?p$1q8PyjY8p}thDJHZP2wPi z3|V0d#z{s>;ew2mV}%MJd9pt?dKDaCs0;B@@P1ntl8L1B=Kr!de)risUsrKsdZKb( zhmc$EjxVvMORe1|wSC_s-}giMkKnN}KJmhr*b3OT`5%H%A~E>dX!7#Whl!ao&H|6b zuO+>bfVgk3t>eW)v7mK?SS~$TL93*p_fV%&@zgptX*I__s8G~2gA55h+f=E|;XaFN zSQxojkyY5X1gpFY@5Yg(x&lTHao$sIk)n-^I%kLDd#OZXWI`x5-~DhrF}T}%w*9Qu ztA1Qvx=3tNoW7!&PhCsW-z_mSbq5CxW^^W_X-n)|DomZ)MnEpli`&cIO_Ke*t*y01 zIZ>{IbQH=`lq2ds^4yL918>Whtu?@6G9(qL7h--wM83Nm3K9T(L5+=mKJG7&yO2_F zBHlyWbXr28K34u*~PIGRRQ=BxS>bKn7J^!R8oRBswPqNT84c zaKI#MK&-nNYLg%)kV&*^VU-2h#FWn?NSF>nFmL%HLRvkYOpMfJaKE4=p~X0@o>LRy zg_RjMCnQcEkf>Z+-gE4+R!GpZUGl$OnE=Avv=QprqaCEju6l(ssS z6RE3{hhj=CflJImcsUu2>>}wDhn*oswhPc*=(?vg86qO-cS59yYltjZT24dUT&uKi zZ6IDE0bB!^gCfDTKsOLBni8b}n2{|=eN!12mWX=G7Ghk>_f!H@K**~#!k|@y)i_pJ z2Nnm3SQCj=1>u|gUSuxzf@MA-lp1{q*v1pWsWvCuCReB(TuE#++@?IDTZd6tB}aVg z{5d`@h1M6ph2XDpM8wLnP9U9m)hd@xj>mAl0mkd5;aBZADTK82fYXU++g0wHe0cGT zWTScy%16N#SRaKq{5T5oP%?TlQX-(eml!!a)eNV%F0_m&){?d{y_M?e{If&B4B?DT zW9xkHxGyL0^9>%~&Wx&t9?b3;dN0XC)XYUmRQ~!#ix+C~j2k)yG`4{2widL*Ho_i6 zoHvrI$frvk^M1{(RoX5xLFLtnU6uoZ z=)qNdE>5qrmyv<=Xi+Wwc+iz-@k~CPz4za2ugAQ*+`DDp#$GQ%4sI(4$Mqv=nkSxJcmEoS(j?BDR3@YuCc4ge5 zkS5ToipYKqg;EOf9Dz?0iyEx*^a$4?l~-eB%8HP!kuDFEk&%$j|Ls!nG@gwpr1juib4TX#-s&+S#CIG0`4jyMxK0%xkZ49oxL88 z$z>9iQ9FPza(f54OuP@}6ui9+Tpp7tqlh7}jWvxvNJcJYJLVR)4Gc)Byp8ITF+2~l zMAAt64Iqxg8$cWhLIlK}yaoyu(xiAPyt>?Y0cbYLehARhwt(_65sDij^zzSx(2IDd ztk`)-@Y}%WhzLa-D@(c{_For=+kLUQb-2UD^&(2|1~TU{K!q7#Yh>sq$Jfp3Wk_O^&=CC(}Ke> z`wS=!N5Ux15&`r|mLRDT3=63Rty_!?%Y+O;TM&fs6l`qOs33wOkV1;6x|2;xa5x0! z%`%F@iZbyebWe4asD8}RUt2cPQ*eO_`4MCVIQ)-GNz{~8f~kHJR8N)#W&~XZWDO3c zy?ay{8-poD23DLJ@M(f^<2WA#hsWD6NX~ znTztOgqQM8A=d(><*Lw9n2(_5Fmf%R$|(b9cL=!_EQIVBxjOKL9*8#@mpV1SMY<61!4!w48# znW)!7BvP#A`3=NGgcZG#ZMZWVC`$Pn zJ6g{|G3*rdMsgwVZh&rN3z$bXcvIyQ&BLEs#KhR@G~_#N)CjVCV2*4%55@j#cl%q1 zT%_LI-9@>)7dz9q@E^sjaLE0I0eBDpC~tSDfZPeX?V790$fQHkse)BE7&8=@~M7Yr2?wQ)iTv{MUS8^Pg=Pqv0oT^ zSk0sdtJ?0LPV<1fuzBf0SlH`tT}m+vusWD^=xF
    V`cWq3vD5Mz z&;Gi>t$}_i>HhU@o^J&ChaO;>R#)tFK(Pc>HgcV$Yir~rXpQaw^h*rD1$gzKT1 z(F57UZPF>y1gGsP;?C50Lj~(&p@9>^*Fwq-7(A*W)eY#@fO~ zTtuHoYDU>BU93fVjGBuv1o^hn14kE4#zmFUW86|uamMID%}mdMSaj2P9nLI2kqjlVmG8x7M`Re+tIIG0*cwz^cQdUa`m5vf6t z*`u!xQc2mx?Nnu|!FHz9dV6X~+J-D4d%C_%Gm}w?nI49!%#9R^%~PttykaOnl|!}u zKw>iPg6jgZR%&T{w!wEAtm=rg@jV5iShNP$t)d|Y;*865kO^J48nPXNc^0LO5i+v! zCT>GCju6&aGUk-|=aKQ**HUjoh~O9tL(5NkpHcm2h*OHE|bYVMJ#CE16N%pc^FF#0`>c-1{(-7~H#y3sYZa;6CdG ztAoE9YX#C$8DjYTAp)f%!|6E6Tq>x6ZAi>`FnoK=SonwdVMr9iRg~C2$Nro}F@w+0 z!thoNwKx7)gHNTu$OE;5ujJaT%8eWHyk?J>;co^zs;6GV*E2J9x8|e3kFWFG^@_hl z>*BjY%2z|q1!qv!0|ae`9Wiqo7rd1a0>>q9dcH7=>GTmIdiV2X+UULR2i1zd zP8S7|dndor7^32{4b1VHUdS_M(nGyD{bdKfV#2VYKKkH;$eFE=|{oQ9`X0zUcG*@-PW5Bgg>o4Y%| zjgL3@i;iCgK0e4qqMS8^YGe>B7q%k7>Khy~6wg3PC diff --git a/library/tedit/TEDIT-LOOKS b/library/tedit/TEDIT-LOOKS index 85af13d9..4d27f754 100644 --- a/library/tedit/TEDIT-LOOKS +++ b/library/tedit/TEDIT-LOOKS @@ -1,29 +1,27 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:49"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-LOOKS.;1 161854 +(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}tedit>TEDIT-LOOKS.;219 152365 - :PREVIOUS-DATE "14-Jul-2022 11:12:19" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-LOOKS.;3) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.CHANGE.LOOKS TEDIT.PARALOOKS \TEDIT.UNDO.LOOKS \TEDIT.UNDO.PARALOOKS) + + :PREVIOUS-DATE "24-Feb-2024 12:34:14" {WMEDLEY}tedit>TEDIT-LOOKS.;218) (PRETTYCOMPRINT TEDIT-LOOKSCOMS) (RPAQQ TEDIT-LOOKSCOMS - [ - (* ;; "Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.)") + ( + (* ;; "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.") - (FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) + (DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS CHARLOOKS FMTSPEC) + (MACROS \WORDSETA) + (MACROS ONOFF))) + (INITRECORDS CHARLOOKS FMTSPEC PENDINGTAB) + (FNS \TEDIT.CHARLOOKS.DEFPRINT \TEDIT.FMTSPEC.DEFPRINT) [DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (TEDIT.TERMSA.FONTS NIL) - (TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT - DEFAULTFONT)) (TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC)) - (* ; "Original was (create FMTSPEC QUAD _ 'LEFT 1STLEFTMAR _ 0 LEFTMAR _ 0 RIGHTMAR _ 0 LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 TABSPEC _ (CONS NIL NIL)).") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") (TEDIT.TERMSA.FONTS NIL) (TEDIT.KNOWN.FONTS '((Classic 'CLASSIC) (Modern 'MODERN) @@ -32,44 +30,39 @@ (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)) - (* ; "Original was (create MENU ITEMS _ '(Bold Italic Bold%% Italic Regular) CENTERFLG _ T TITLE _ %"Face:%").") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - (TEDIT.SIZE.MENU (\CREATE.TEDIT.SIZE.MENU)) - (* ; "Original was (create MENU ITEMS _ '(6 7 8 9 10 11 12 14 18 24 30 36) CENTERFLG _ T MENUROWS _ 4 TITLE _ %"Type Size:%").") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - ) + (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.CHARLOOKS TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) + TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) (ADDVARS (FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT) (TEDIT.ICON.FONT MENUFONT))) (COMS (* ; "Character looks functions") - (FNS CHARLOOKS.FROM.FONT EQCLOOKS SAMECLOOKS \TEDIT.UNIQUIFY.CHARLOOKS TEDIT.CARETLOOKS - TEDIT.COPY.LOOKS \TEDIT.GET.CHARLOOKS \TEDIT.UNPARSE.CHARLOOKS.LIST - TEDIT.MODIFYLOOKS TEDIT.NEW.FONT \TEDIT.PUT.CHARLOOKS \TEDIT.CARETLOOKS.VERIFY - \TEDIT.GET.INSERT.CHARLOOKS \TEDIT.GET.TERMSA.WIDTHS \TEDIT.LOOKS.UPDATE - \TEDIT.PARSE.CHARLOOKS.LIST \TEDIT.FLUSH.UNUSED.LOOKS) + (FNS CHARLOOKS.FROM.FONT EQCLOOKS 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) + (COMS (FNS \TEDIT.TRANSLATE.ASCIICHARS \TEDIT.CONVERT.TO.FORMATTED) + (MACROS \TEDIT.TRANSLATE.ASCII.CHARLOOKS)) + (FNS \TEDIT.UNIQUIFY.CHARLOOKS \TEDIT.UNIQUIFY.PARALOOKS \TEDIT.UNIQUIFY.ALL + \TEDIT.FLUSH.UNUSED.LOOKS) (* ;; "For making font substitutions") - (FNS TEDIT.SUBLOOKS) + (FNS TEDIT.SUBLOOKS TEDIT.FINDLOOKS) (FNS \TEDIT.CHANGE.LOOKS TEDIT.LOOKS \TEDIT.LOOKS \TEDIT.FONTCOPY TEDIT.GET.LOOKS)) (COMS (* ; "Paragraph looks functions") - (FNS \TEDIT.GET.PARALOOKS EQFMTSPEC \TEDIT.UNIQUIFY.PARALOOKS TEDIT.GET.PARALOOKS - \TEDIT.UNPARSE.PARALOOKS.LIST \TEDIT.PARSE.PARALOOKS.LIST TEDIT.PARALOOKS - TEDIT.COPY.PARALOOKS \TEDIT.PUT.PARALOOKS \TEDIT.CONVERT.TO.FORMATTED - \TEDIT.PARABOUNDS \TEDIT.FORMATTABS) + (FNS EQFMTSPEC TEDIT.GET.PARALOOKS \TEDIT.PARSE.PARALOOKS.LIST TEDIT.PARALOOKS + TEDIT.COPY.PARALOOKS \TEDIT.PARABOUNDS) (* ;; "For making paragraph-looks substitutions.") (FNS TEDIT.SUBPARALOOKS SAMEPARALOOKS)) (COMS (* ; "UNDO & History List stuff") - (FNS TEDIT.REDO.LOOKS TEDIT.REDO.PARALOOKS TEDIT.UNDO.LOOKS TEDIT.UNDO.PARALOOKS)) + (FNS \TEDIT.UNDO.LOOKS \TEDIT.UNDO.PARALOOKS)) (COMS (* ; "Revision-mark support") (FNS \TEDIT.MARK.REVISION)) (COMS (* ; @@ -87,37 +80,336 @@ (* ;; "*TEDIT-STYLESHEET-SAVE-LIST* is a list of points inside TEDIT.STYLES, so we can %"push%" new style sheets on the front, and %"pop%" them off sensibly. This is the push-stack, in effect. Used by TEDIT.ADD.STYLESHEET, TEDIT.PUSH.STYLESHEET, and TEDIT.POP.STYLESHEET") + (INITVARS (TEDIT.STYLES)) + + (* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented") + + (GLOBALVARS TEDIT.STYLES) (INITVARS (*TEDIT-PARASTYLE-CACHE*) (*TEDIT-CURRENTPARA-CACHE*) - (*TEDIT-STYLESHEET-SAVE-LIST*]) + (*TEDIT-STYLESHEET-SAVE-LIST*)) + (GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* + *TEDIT-STYLESHEET-SAVE-LIST*)))) (* ;; -"Support for Character looks (font, italic/bold, sub/superscripting, etc) and paragraph looks (margins, centered/justified, tabs, etc.)" +"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." ) - -(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(DATATYPE CHARLOOKS ( + (* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") + CLFONT (* ; + "The font descriptor for these characters") + CLNAME -(CONSTANTS (\SCRATCHLEN 64)) + (* ;; "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) (* ; + "T if the characters are to be underscored, else NIL") + (CLOLINE FLAG) (* ; + "T if the characters are to be overscored, else NIL") + (CLSTRIKE FLAG) (* ; + "T if the characters are to be struck thru, else nil.") + CLOFFSET (* ; + "A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") + (CLSMALLCAP 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 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 (* ; + "Any information that an outsider wants to include") + CLLEADER (* ; + "For creating dotted and other kinds of leader") + CLRULES + + (* ;; "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 '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 (* ; "Right margin for the paragraph") + LEADBEFORE (* ; + "Leading above the paragraph's first line, in points") + 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") + 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 (* ; + "A special horizontal location on the printed page for this para.") + FMTSPECIALY (* ; + "A special vertical location on the page for this para") + (FMTHEADINGKEEP FLAG) (* ; + "This para should be kept with the top line or so of the next para..") + FMTPARATYPE (* ; + "What kind of para this is: TEXT, PAGEHEADING, whatever") + FMTPARASUBTYPE (* ; + "Sub type of the type, e.g., what KIND of page heading this is.") + FMTNEWPAGEBEFORE (* ; "Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box.") + FMTNEWPAGEAFTER (* ; "Similarly") + FMTKEEP (* ; + "For information about how this paragraph is to be kept with other paragraphs.") + FMTCOLUMN (* ; + "For setting up side-by-side paragraphs easily ala BravoX") + FMTVERTRULES (* ; + "For Keeping track of vertical rules in force") + (FMTMARK FLAG) (* ; "Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file") + (* ; "Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file.") + (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 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) + LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL)) ) +(/DECLAREDATATYPE 'CHARLOOKS + '(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG + POINTER POINTER POINTER POINTER FLAG) + '((CHARLOOKS 0 POINTER) + (CHARLOOKS 2 POINTER) + (CHARLOOKS 4 POINTER) + (CHARLOOKS 4 (FLAGBITS . 0)) + (CHARLOOKS 4 (FLAGBITS . 16)) + (CHARLOOKS 4 (FLAGBITS . 32)) + (CHARLOOKS 4 (FLAGBITS . 48)) + (CHARLOOKS 2 (FLAGBITS . 0)) + (CHARLOOKS 6 POINTER) + (CHARLOOKS 6 (FLAGBITS . 0)) + (CHARLOOKS 6 (FLAGBITS . 16)) + (CHARLOOKS 6 (FLAGBITS . 32)) + (CHARLOOKS 6 (FLAGBITS . 48)) + (CHARLOOKS 2 (FLAGBITS . 16)) + (CHARLOOKS 2 (FLAGBITS . 32)) + (CHARLOOKS 2 (FLAGBITS . 48)) + (CHARLOOKS 8 POINTER) + (CHARLOOKS 10 POINTER) + (CHARLOOKS 12 POINTER) + (CHARLOOKS 14 POINTER) + (CHARLOOKS 14 (FLAGBITS . 0))) + '16) -(FILESLOAD (LOADCOMP) - TEDIT-DCL) +(DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)) + +(/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) + '((FMTSPEC 0 POINTER) + (FMTSPEC 2 POINTER) + (FMTSPEC 4 POINTER) + (FMTSPEC 6 POINTER) + (FMTSPEC 8 POINTER) + (FMTSPEC 10 POINTER) + (FMTSPEC 12 POINTER) + (FMTSPEC 14 POINTER) + (FMTSPEC 16 POINTER) + (FMTSPEC 18 POINTER) + (FMTSPEC 20 POINTER) + (FMTSPEC 22 POINTER) + (FMTSPEC 24 POINTER) + (FMTSPEC 26 POINTER) + (FMTSPEC 26 (FLAGBITS . 0)) + (FMTSPEC 28 POINTER) + (FMTSPEC 30 POINTER) + (FMTSPEC 32 POINTER) + (FMTSPEC 34 POINTER) + (FMTSPEC 36 POINTER) + (FMTSPEC 38 POINTER) + (FMTSPEC 40 POINTER) + (FMTSPEC 40 (FLAGBITS . 0)) + (FMTSPEC 40 (FLAGBITS . 16)) + (FMTSPEC 42 POINTER) + (FMTSPEC 44 POINTER)) + '46) + +(DEFPRINT 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT)) +(DECLARE%: EVAL@COMPILE + +(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))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS ONOFF MACRO [OPENLAMBDA (VAL) + (COND + (VAL 'ON) + (T 'OFF]) +) + +(* "END EXPORTED DEFINITIONS") + +) + +(/DECLAREDATATYPE 'CHARLOOKS + '(POINTER POINTER POINTER FLAG FLAG FLAG FLAG FLAG POINTER FLAG FLAG FLAG FLAG FLAG FLAG FLAG + POINTER POINTER POINTER POINTER FLAG) + '((CHARLOOKS 0 POINTER) + (CHARLOOKS 2 POINTER) + (CHARLOOKS 4 POINTER) + (CHARLOOKS 4 (FLAGBITS . 0)) + (CHARLOOKS 4 (FLAGBITS . 16)) + (CHARLOOKS 4 (FLAGBITS . 32)) + (CHARLOOKS 4 (FLAGBITS . 48)) + (CHARLOOKS 2 (FLAGBITS . 0)) + (CHARLOOKS 6 POINTER) + (CHARLOOKS 6 (FLAGBITS . 0)) + (CHARLOOKS 6 (FLAGBITS . 16)) + (CHARLOOKS 6 (FLAGBITS . 32)) + (CHARLOOKS 6 (FLAGBITS . 48)) + (CHARLOOKS 2 (FLAGBITS . 16)) + (CHARLOOKS 2 (FLAGBITS . 32)) + (CHARLOOKS 2 (FLAGBITS . 48)) + (CHARLOOKS 8 POINTER) + (CHARLOOKS 10 POINTER) + (CHARLOOKS 12 POINTER) + (CHARLOOKS 14 POINTER) + (CHARLOOKS 14 (FLAGBITS . 0))) + '16) + +(DEFPRINT 'CHARLOOKS (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT)) + +(/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) + '((FMTSPEC 0 POINTER) + (FMTSPEC 2 POINTER) + (FMTSPEC 4 POINTER) + (FMTSPEC 6 POINTER) + (FMTSPEC 8 POINTER) + (FMTSPEC 10 POINTER) + (FMTSPEC 12 POINTER) + (FMTSPEC 14 POINTER) + (FMTSPEC 16 POINTER) + (FMTSPEC 18 POINTER) + (FMTSPEC 20 POINTER) + (FMTSPEC 22 POINTER) + (FMTSPEC 24 POINTER) + (FMTSPEC 26 POINTER) + (FMTSPEC 26 (FLAGBITS . 0)) + (FMTSPEC 28 POINTER) + (FMTSPEC 30 POINTER) + (FMTSPEC 32 POINTER) + (FMTSPEC 34 POINTER) + (FMTSPEC 36 POINTER) + (FMTSPEC 38 POINTER) + (FMTSPEC 40 POINTER) + (FMTSPEC 40 (FLAGBITS . 0)) + (FMTSPEC 40 (FLAGBITS . 16)) + (FMTSPEC 42 POINTER) + (FMTSPEC 44 POINTER)) + '46) + +(DEFPRINT 'FMTSPEC (FUNCTION \TEDIT.FMTSPEC.DEFPRINT)) + +(/DECLAREDATATYPE 'PENDINGTAB '(POINTER POINTER POINTER POINTER FULLXPOINTER POINTER) + '((PENDINGTAB 0 POINTER) + (PENDINGTAB 2 POINTER) + (PENDINGTAB 4 POINTER) + (PENDINGTAB 6 POINTER) + (PENDINGTAB 8 FULLXPOINTER) + (PENDINGTAB 10 POINTER)) + '12) +(DEFINEQ + +(\TEDIT.CHARLOOKS.DEFPRINT + [LAMBDA (LOOKS STREAM CPL NOLOC) (* ; "Edited 26-Aug-2023 11:10 by rmk") + + (* ;; "CPL seems to be a hidden argument passed on calls from \PRINT-USING-DEFPRINT, usually with value 0. So NOLOC is one beyond that") + + (LET ((LOC (LOC LOOKS)) + (FACE (CONCAT (CL:IF (fetch (CHARLOOKS CLBOLD) of LOOKS) + "B" + "M") + (CL:IF (fetch (CHARLOOKS CLITAL) of LOOKS) + "I" + "R"))) + INFO) + (SETQ INFO (CONCAT (L-CASE (fetch (CHARLOOKS CLNAME) of LOOKS) + T) + (fetch (CHARLOOKS CLSIZE) of LOOKS) + (CL:IF (STREQUAL FACE "MR") + "" + FACE))) + (CONS (CL:IF NOLOC + INFO + (CONCAT "{CL" (CAR LOC) + "/" + (CDR LOC) + ":" INFO "}"))]) + +(\TEDIT.FMTSPEC.DEFPRINT + [LAMBDA (FMTSPEC STREAM) (* ; "Edited 26-Aug-2023 11:11 by rmk") + (LET ((LOC (LOC FMTSPEC))) + (CONS (CONCAT "{FMT" (CAR LOC) + "/" + (CDR LOC) + ":" + (SUBSTRING (fetch (FMTSPEC QUAD) of FMTSPEC) + 1 2) + "-" + (fetch (FMTSPEC LEFTMAR) of FMTSPEC) + "-" + (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) + "}"]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (RPAQQ TEDIT.TERMSA.FONTS NIL) -(RPAQ TEDIT.DEFAULT.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)) - (RPAQ TEDIT.DEFAULT.FMTSPEC (\CREATE.TEDIT.DEFAULT.FMTSPEC)) (RPAQQ TEDIT.TERMSA.FONTS NIL) @@ -132,6 +424,8 @@ (Times% Roman 'TIMESROMAN))) ) +(RPAQ? TEDIT.DEFAULT.FOLIO ) + (RPAQQ TEDIT.CHARLOOKS.FEATURES (SUPERSCRIPT INVISIBLE SELECTPOINT PROTECTED SIZE FAMILY OVERLINE STRIKEOUT UNDERLINE EXPANSION SLOPE WEIGHT)) @@ -141,8 +435,7 @@ (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.CHARLOOKS - TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) + TEDIT.FACE.MENU TEDIT.SIZE.MENU TEDIT.DEFAULT.FONT TEDIT.DEFAULT.FMTSPEC TEDIT.TERMSA.FONTS) ) (ADDTOVAR FONTVARS (TEDIT.PROMPT.FONT DEFAULTFONT) @@ -155,70 +448,75 @@ (DEFINEQ (CHARLOOKS.FROM.FONT - [LAMBDA (FONT) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (FONT) (* ; "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.") - (PROG ((LOOKS (create CHARLOOKS - CLFONT _ FONT))) - (OR (FONTP FONT) - (\ILLEGAL.ARG FONT)) (* It HAS to be a font, first off.) - (SELECTQ (CAR (FONTPROP FONT 'FACE)) - (BOLD (replace (CHARLOOKS CLBOLD) of LOOKS with T) - (replace (CHARLOOKS CLITAL) of LOOKS with NIL)) - (replace (CHARLOOKS CLBOLD) of LOOKS with NIL))(* Set the boldness bit, if it's a - bold font.) - (SELECTQ (CADR (FONTPROP FONT 'FACE)) - (ITALIC (replace (CHARLOOKS CLITAL) of LOOKS with T)) - (replace (CHARLOOKS CLITAL) of LOOKS with NIL))(* Set the italic bit, if it's italic) - (with CHARLOOKS LOOKS (SETQ CLSIZE (FONTPROP FONT 'SIZE)) - (* Grab the size from the font) - (SETQ CLOFFSET 0) (* And let it be neither super- - nor subscripted.) - ) - (RETURN LOOKS]) + (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]) (EQCLOOKS - [LAMBDA (CLOOK1 CLOOK2) (* ; + [LAMBDA (CLOOK1 CLOOK2) (* ; "Edited 1-Dec-2023 19:27 by rmk") + (* ; "Edited 9-Nov-2023 00:46 by rmk") + (* ; "Edited 24-Jul-2023 17:18 by rmk") + (* ;  "Edited 1-Jun-93 11:49 by sybalsky:mv:envos") (* ;; "Given two sets of CHARLOOKS, are they effectively the same?") - (OR (EQ CLOOK1 CLOOK2) - (AND [OR (EQ (fetch (CHARLOOKS CLFONT) of CLOOK1) - (fetch (CHARLOOKS CLFONT) of CLOOK2)) - (AND (type? FONTCLASS (ffetch (CHARLOOKS CLFONT) of CLOOK1)) - (type? FONTCLASS (ffetch (CHARLOOKS CLFONT) of CLOOK2)) - (EQ (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) of CLOOK1)) - (ffetch FONTCLASSNAME of (ffetch (CHARLOOKS CLFONT) of CLOOK2] - (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 CLUSERINFO) of CLOOK1) - (ffetch (CHARLOOKS CLUSERINFO) of CLOOK2]) + (LET ((FONT1 (fetch (CHARLOOKS CLFONT) of CLOOK1)) + (FONT2 (fetch (CHARLOOKS CLFONT) of CLOOK2))) + (OR (EQ CLOOK1 CLOOK2) + (AND [OR (EQ FONT1 FONT2) + (AND (type? FONTCLASS FONT1) + (type? FONTCLASS FONT2) + (EQUAL (fetch (FONTCLASS DISPLAYFD) of FONT1) + (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]) (SAMECLOOKS - [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (CLOOK1 CLOOK2 FEATURES) (* ; "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") @@ -257,6 +555,8 @@ (fetch (CHARLOOKS CLSTRIKE) of CLOOK2))) (UNDERLINE (EQ (fetch (CHARLOOKS CLULINE) of CLOOK1) (fetch (CHARLOOKS CLULINE) of CLOOK2))) + (UNBREAKABLE (fetch (CHARLOOKS CLUNBREAKABLE) of CLOOK1) + (fetch (CHARLOOKS CLUNBREAKABLE) of CLOOK2)) (FACE (EQUAL (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK1) 'FACE) (FONTPROP (fetch (CHARLOOKS CLFONT) of CLOOK2) @@ -265,122 +565,57 @@ " is an unknown feature of character looks. Detected in SAMECLOOKS" ]) -(\TEDIT.UNIQUIFY.CHARLOOKS - [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:40 by jds") - - (* Assure that there is only ONE of a given CHARLOOKS in the document--so that - all instances of that set of looks share structure.) - - (COND - ((for LOOK in (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) thereis (EQCLOOKS NEWLOOKS LOOK))) - (T (push (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ) - NEWLOOKS) - NEWLOOKS]) - (TEDIT.CARETLOOKS - [LAMBDA (STREAM LOOKS) (* ; "Edited 30-May-91 21:40 by jds") + [LAMBDA (STREAM LOOKS) (* ; "Edited 15-Oct-2023 17:12 by rmk") + (* ; "Edited 28-May-2023 14:15 by rmk") + (* ; "Edited 6-Apr-2023 21:42 by rmk") + (* ; "Edited 8-Sep-2022 11:25 by rmk") + (* ; "Edited 30-May-91 21:40 by jds") (* ;; "Set the 'Caret looks' for a TEdit document, i.e., the looks that will be applied to newly-typed characters from here on.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - CHARLOOKS) - (SETQ CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (\TEDIT.PARSE.CHARLOOKS.LIST - LOOKS - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - TEXTOBJ)) - TEXTOBJ)) (* ; + (LET ((TEXTOBJ (TEXTOBJ STREAM))) (* ;  "Parse up the looks he gave us, to make sure they're a valid CHARLOOKS") - (COND - ((NEQ CHARLOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) - (* ; - "Only change the caret looks if they really changed") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; "Changing the caret's looks means we can't type into the same piece any more. Force the next insert to create a new one.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with CHARLOOKS]) + (change (FGETTOBJ TEXTOBJ CARETLOOKS) + (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ (\TEDIT.PARSE.CHARLOOKS.LIST LOOKS DATUM TEXTOBJ]) (TEDIT.COPY.LOOKS - [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:43 by jds") + [LAMBDA (STREAM SOURCE DEST) (* ; "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") (PROG ((TEXTOBJ (TEXTOBJ STREAM)) LOOKS LEN) (* ;  "get the character looks of the first character of SOURCE") - [SETQ LOOKS (fetch (PIECE PLOOKS) of (CL:TYPECASE SOURCE - ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ - PCTB) - of TEXTOBJ))) - (SELECTION - (\SHOWSEL SOURCE NIL NIL) - (* ; - "Turn off the source selection, so it doesn't hang around after the copy.") - (\CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (TEXTOBJ PCTB) - of (fetch (SELECTION \TEXTOBJ) - of SOURCE)))) - (T (\ILLEGAL.ARG SOURCE)))] + [SETQ LOOKS (PLOOKS (if (FIXP SOURCE) + then (\CHTOPC SOURCE TEXTOBJ) + elseif (type? SELECTION SOURCE) + then (\CHTOPC (fetch (SELECTION CH#) of SOURCE) + (fetch (SELECTION SELTEXTOBJ) of SOURCE)) + else (\ILLEGAL.ARG SOURCE] (COND - [(type? SELECTION DEST) (* ; + ((type? SELECTION DEST) (* ;  "make sure that the destination selection is in this document") - (COND - ((NEQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of DEST)) - (\LISPERROR "Destination selection is not in stream " STREAM] + (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]) -(\TEDIT.GET.CHARLOOKS - [LAMBDA (PC FILE LOOKSARRAY PREVPC) (* ; "Edited 30-May-91 21:43 by jds") - -(* ;;; "Set the PLOOKS for the current piece, PC, according to what the file says") - -(* ;;; "The PLEN field of this piece is the number of FILE BYTES taken to describe the piece. This may need to be adjusted for fat pieces, and at fat/thin boundaries. PREVPC is the previous piece, if any, so we can detect such boundaries.") - - (PROG ((FLAGS (\BIN FILE))) - (COND - ((NOT (ZEROP (LOGAND FLAGS 1))) (* ; "This text is NEW. Mark it so.") - (replace (PIECE PNEW) of PC with T))) - (COND - ((NOT (ZEROP (LOGAND FLAGS 2))) (* ; - "This text is FAT--16 bit characters.") - (replace (PIECE PFATP) of PC with T))) - (replace (PIECE PLOOKS) of PC with (ELT LOOKSARRAY (\SMALLPIN FILE))) - (* ; - "Look the looks up in the array we built according to specs earlier") - (COND - [(fetch (PIECE PFATP) of PC) (* ; - "For a fat piece, convert bytes to characters") - (COND - ((AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - (replace (PIECE PLEN) of PC with (FOLDHI (FETCH (PIECE PLEN) OF PC) - 2))) - (T (* ; - "The prior piece wasn't fat and this one is. Take account of the 255-255-0 in the length") - (replace (PIECE PLEN) of PC with (FOLDHI (IDIFFERENCE (fetch (PIECE PLEN) - of PC) - 3) - 2)) - (add (fetch (PIECE PFPOS) of PC) - 3] - ((AND PREVPC (fetch (PIECE PFATP) of PREVPC)) - - (* ;; "The prior piece was fat and this one isn't. Take account of the 255-0 on the front of this piece's chars.") - - (replace (PIECE PLEN) of PC with (IDIFFERENCE (fetch (PIECE PLEN) of PC) - 2)) - (add (fetch (PIECE PFPOS) of PC) - 2]) - (\TEDIT.UNPARSE.CHARLOOKS.LIST - [LAMBDA (LOOKS) (* ; "Edited 30-May-91 21:45 by jds") - (* Convert a CHARLOOKS into an - equivalent PList-form for external - consumption) - (PROG ((NEWLOOKS NIL) - OFFSET) + [LAMBDA (LOOKS) (* ; "Edited 24-Jul-2023 17:28 by rmk") + (* ; "Edited 11-Feb-2023 14:51 by rmk") + (* ; "Edited 30-May-91 21:45 by jds") + + (* ;; "Convert a CHARLOOKS into an equivalent PList-form for external consumption") + + (LET (NEWLOOKS OFFSET) + (SETQ NEWLOOKS (for PROP in (LIST (fetch (CHARLOOKS CLSTYLE) of LOOKS) (fetch (CHARLOOKS CLUSERINFO) of LOOKS) (ONOFF (fetch (CHARLOOKS CLINVERTED) of LOOKS)) @@ -393,6 +628,7 @@ (ONOFF (fetch (CHARLOOKS CLULINE) of LOOKS)) (ONOFF (fetch (CHARLOOKS CLSTRIKE) of LOOKS)) (ONOFF (fetch (CHARLOOKS CLOLINE) of LOOKS)) + (ONOFF (fetch (CHARLOOKS CLUNBREAKABLE) of LOOKS)) (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) 'FAMILY) (FONTPROP (fetch (CHARLOOKS CLFONT) of LOOKS) @@ -400,58 +636,53 @@ (ONOFF (fetch (CHARLOOKS CLPROTECTED) of LOOKS)) (ONOFF (fetch (CHARLOOKS CLSELHERE) of LOOKS)) (ONOFF (fetch (CHARLOOKS CLINVISIBLE) of LOOKS))) as PROPNAME - in '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE FAMILY - SIZE PROTECTED SELECTPOINT INVISIBLE) do (push NEWLOOKS PROP) - (push NEWLOOKS PROPNAME)) - (push NEWLOOKS (IABS (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0))) - [push NEWLOOKS (COND - ((IGREATERP (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0) - 'SUPERSCRIPT) - ((ILESSP (fetch (CHARLOOKS CLOFFSET) of LOOKS) - 0) - 'SUBSCRIPT) - (T 'SUPERSCRIPT] - (RETURN NEWLOOKS]) + in '(STYLE USERINFO INVERTED WEIGHT SLOPE EXPANSION UNDERLINE STRIKEOUT OVERLINE + UNBREAKABLE FAMILY SIZE PROTECTED SELECTPOINT INVISIBLE) + join (LIST PROPNAME PROP))) + (SETQ OFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS)) + (push NEWLOOKS (COND + ((IGREATERP OFFSET 0) + 'SUPERSCRIPT) + ((ILESSP OFFSET 0) + 'SUBSCRIPT) + (T 'SUPERSCRIPT)) + (IABS (OR OFFSET 0))) + NEWLOOKS]) (TEDIT.MODIFYLOOKS - [LAMBDA (LINE STARTX DS LOOKS LINEBASEY) (* ; "Edited 30-May-91 21:45 by jds") + [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") + (* ; "Edited 30-May-91 21:45 by jds") - (* Modify the screen to allow for underlining, etc. - Also, restore the vertical offset to the baseline.) + (* ;; "Modify the screen to allow for underlining, etc. Also, restore the vertical offset to the baseline.") - (PROG ((CURX (DSPXPOSITION NIL DS)) - (CURY (DSPYPOSITION NIL DS)) - (FONT (fetch (CHARLOOKS CLFONT) of LOOKS))) - (COND - ((fetch (CHARLOOKS CLULINE) of LOOKS) (* It's underlined.) - (MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY) - (fetch (LINEDESCRIPTOR LTRUEDESCENT) of LINE))) - DS) - (RELDRAWTO (IDIFFERENCE CURX STARTX) - 0 1 'PAINT DS))) - (COND - ((fetch (CHARLOOKS CLOLINE) of LOOKS) (* Over-line) - (MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT] - DS) - (RELDRAWTO (IDIFFERENCE CURX STARTX) - 0 1 'PAINT DS))) - (COND - ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* Struck-thru) - (MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT) - 3)) - DS) - (RELDRAWTO (IDIFFERENCE CURX STARTX) - 0 1 'PAINT DS))) - (COND - ((fetch (CHARLOOKS CLINVERTED) of LOOKS) (* Inverse video) - (BITBLT NIL NIL NIL DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT)) - (IDIFFERENCE CURX STARTX) - (FONTPROP FONT 'HEIGHT) - 'TEXTURE - 'INVERT BLACKSHADE))) - (MOVETO CURX LINEBASEY DS]) + (LET ((CURX (DSPXPOSITION NIL DS)) + (CURY (DSPYPOSITION NIL DS)) + (FONT (fetch (CHARLOOKS CLFONT) of LOOKS))) + (CL:WHEN (fetch (CHARLOOKS CLULINE) of LOOKS) (* ; "It's underlined.") + (MOVETO STARTX (ADD1 (IDIFFERENCE (IPLUS CURY) + (GETLD LINE LTRUEDESCENT))) + DS) + (RELDRAWTO (IDIFFERENCE CURX STARTX) + 0 1 'PAINT DS)) + (CL:WHEN (fetch (CHARLOOKS CLOLINE) of LOOKS) (* ; "Over-line") + (MOVETO STARTX [IPLUS CURY (SUB1 (FONTPROP FONT 'ASCENT] + DS) + (RELDRAWTO (IDIFFERENCE CURX STARTX) + 0 1 'PAINT DS)) + (CL:WHEN (fetch (CHARLOOKS CLSTRIKE) of LOOKS) (* ; "Struck-thru") + (MOVETO STARTX (IPLUS CURY (IQUOTIENT (FONTPROP FONT 'ASCENT) + 3)) + DS) + (RELDRAWTO (IDIFFERENCE CURX STARTX) + 0 1 'PAINT DS)) + (CL:WHEN (fetch (CHARLOOKS CLINVERTED) of LOOKS) (* ; "Inverse video") + (BLTSHADE BLACKSHADE DS STARTX (IDIFFERENCE CURY (FONTPROP FONT 'DESCENT)) + (IDIFFERENCE CURX STARTX) + (FONTPROP FONT 'HEIGHT) + 'INVERT)) + (MOVETO CURX LINEBASEY DS]) (TEDIT.NEW.FONT [LAMBDA (TEXTOBJ) (* jds " 8-Feb-85 11:27") @@ -460,99 +691,49 @@ NAME] (RETURN (U-CASE NAME]) -(\TEDIT.PUT.CHARLOOKS - [LAMBDA (FILE CH1 CHLIM LOOKS OLDPC EDITSTENTATIVE LOOKSHARRAY PREVFATP) - (* ; "Edited 30-May-91 21:45 by jds") - - (* ;; "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") - - (PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) - STR) - (\DWOUT FILE (IDIFFERENCE CHLIM CH1)) (* ; "The length of this run of looks") - (\SMALLPOUT FILE \PieceDescriptorLOOKS) (* ; - "Mark this as setting the piece's looks") - [\BOUT FILE (LOGOR (COND - ((AND EDITSTENTATIVE OLDPC (fetch (PIECE PNEW) of OLDPC)) - (* ; - "If this is a tentative edit, save the newness flag") - 1) - (T (* ; "Otherwise, don't bother") - 0)) - (COND - ((AND OLDPC (fetch (PIECE PFATP) of OLDPC)) - (* ; - "If this piece contains fat characters, remember that fact.") - 2) - (T (* ; "Otherwise, don't bother") - 0] - (\SMALLPOUT FILE (GETHASH LOOKS LOOKSHARRAY)) (* ; "The index into the list of fonts") - ]) - (\TEDIT.CARETLOOKS.VERIFY - [LAMBDA (TEXTOBJ NEWLOOKS) (* ; "Edited 30-May-91 21:41 by jds") - (* Check with the user's CARETLOOKSFN - to see if he wants to make changes) - (PROG ((CARETFN (TEXTPROP TEXTOBJ 'CARETLOOKSFN)) - LOOKS) - (SETQ LOOKS (AND CARETFN (APPLY* CARETFN NEWLOOKS TEXTOBJ))) - (RETURN (COND - ((EQ LOOKS 'DON'T) (* He said not to change the looks.) - (OR (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ))) - (LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS LOOKS TEXTOBJ)) - (T (* He didn't give us any guidance, so - return the looks unmodified.) - NEWLOOKS]) + [LAMBDA (TEXTOBJ NEWLOOKS) (* ; "Edited 15-Oct-2023 20:13 by rmk") + (* ; "Edited 30-May-91 21:41 by jds") + + (* ;; "Check with the user's CARETLOOKSFN to see if he wants to make changes") + + (LET ((CARETFN (GETTEXTPROP TEXTOBJ 'CARETLOOKSFN)) + LOOKS) + (SETQ LOOKS (AND CARETFN (APPLY* CARETFN NEWLOOKS TEXTOBJ))) + (if (EQ LOOKS 'DON'T) + then (* ; "He said not to change the looks.") + (OR (FGETTOBJ TEXTOBJ CARETLOOKS) + (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + else (\TEDIT.UNIQUIFY.CHARLOOKS (OR LOOKS NEWLOOKS) + TEXTOBJ]) + +(\TEDIT.CARETPIECE + [LAMBDA (TEXTOBJ) (* ; "Edited 6-Apr-2023 21:32 by rmk") + (\CHTOPC (TEDIT.GETPOINT TEXTOBJ) + TEXTOBJ]) (\TEDIT.GET.INSERT.CHARLOOKS - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 21:45 by jds") + [LAMBDA (TEXTOBJ SEL) (* ; "Edited 16-Feb-2024 22:48 by rmk") + (* ; "Edited 15-Dec-2023 08:40 by rmk") + (* ; "Edited 3-Aug-2023 22:39 by rmk") + (* ; "Edited 9-Oct-2022 13:57 by rmk") + (* ; "Edited 22-Aug-2022 13:21 by rmk") + (* ; "Edited 30-May-91 21:45 by jds") - (* Given a default source of charlooks, set us up some good ones. - IN particular, reset CLPROTECTED if need be.) + (* ;; "Return the looks at SEL, or defaults. Reset CLPROTECTED if need be.") - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - [CH# (IMAX 1 (IMIN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (SELECTION CH#) of SEL)) - (RIGHT (SUB1 (fetch (SELECTION CHLIM) of SEL))) - (SHOULDNT] - PCNO PIECE LOOKS) - (SETQ PIECE (\CHTOPC CH# PCTB)) - [COND - [(NULL PIECE) (* No piece to take looks from; - use the default) - (SETQ LOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) - TEXTOBJ] - ((ATOM PIECE) (* Trying to take from the - pseudo-piece at the end.) - (COND - [(ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* No characters to steal from. - Use the defaults) - (SETQ LOOKS (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) - TEXTOBJ] - (T (* Otherwise, steal the looks of the - last character) - (SETQ PIECE (fetch (PCTNODE PCE) of (FINDNODE-INDEX - PCTB - (SUB1 (INDEX (fetch (PCTNODE CHNUM) - of (\LASTNODE PCTB)) - PCTB] - [COND - (LOOKS) - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PIECE)) - (* His looks are protected; - we have to copy to a new CHARLOOKS.) - (SETQ LOOKS (\TEDIT.UNIQUIFY.CHARLOOKS (create CHARLOOKS - using (fetch (PIECE PLOOKS) of PIECE) - CLPROTECTED _ NIL CLSELHERE _ NIL) - TEXTOBJ))) - (T (* No protection, just reuse his looks) - (SETQ LOOKS (fetch (PIECE PLOOKS) of PIECE] - (RETURN (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS) - TEXTOBJ]) + (LET ((PC (\CHTOPC (IMAX 1 (IMIN (FGETTOBJ TEXTOBJ TEXTLEN) + (TEDIT.GETPOINT TEXTOBJ SEL))) + TEXTOBJ)) + LOOKS) + (SETQ LOOKS (if PC + then (PLOOKS PC) + elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + else (CHARLOOKS.FROM.FONT DEFAULTFONT))) + (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of LOOKS) (* ; + "Unprotect by copying to a new CHARLOOKS.") + (SETQ LOOKS (create CHARLOOKS using LOOKS CLPROTECTED _ NIL CLSELHERE _ NIL))) + (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ LOOKS]) (\TEDIT.GET.TERMSA.WIDTHS [LAMBDA (TERMSA FONT) (* jds "22-OCT-83 21:36") @@ -564,308 +745,426 @@ (for I from 0 to 255 do (\WORDSETA NWIDTHS I (TEDIT.CHARWIDTH I FONT TERMSA))) (RETURN NWIDTHS]) -(\TEDIT.LOOKS.UPDATE - [LAMBDA (STREAM PC) (* ; "Edited 30-May-91 21:47 by jds") - -(* ;;; "Called under \FORMATLINE, on which it depends. At a piece boundary, update the line formatting fields such as ASCENT, DESCENT, etc. Also, skip over invisible characters") - - (DECLARE (USEDFREE LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT - INVISIBLERUNS NEWASCENT NEWDESCENT)) - (COND - (PC (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (ORIGPC PC) - TLOOKS TEMP NEWPC PARALOOKS PREVPC) - [COND - ([OR (NOT (fetch (PIECE PREVPIECE) of ORIGPC)) - (NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) of ORIGPC] - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) of ORIGPC) - ORIGPC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS)) - (T (SETQ PARALOOKS (fetch (TEXTSTREAM CURRENTPARALOOKS) of STREAM] - (SETQ TLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of ORIGPC) - ORIGPC TEXTOBJ)) - (COND - ((fetch (CHARLOOKS CLINVISIBLE) of TLOOKS) - (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO (fetch (PIECE PLEN) of ORIGPC)) - (\RPLPTR CHLIST 0 LMInvisibleRun) (* ; - "Note the existence of an invisible run of characters here.") - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (SETQ PREVPC ORIGPC) - (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC)) - (COND - ((AND ORIGPC (NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) - (fetch (PIECE PPARALOOKS) of PREVPC))) - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of ORIGPC) - ORIGPC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) - (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of ORIGPC) - ORIGPC TEXTOBJ))) - [while (AND ORIGPC (OR (ZEROP (fetch (PIECE PLEN) of ORIGPC)) - (fetch (CHARLOOKS CLINVISIBLE) of TLOOKS))) - do (* ; - "Skip over this run of invisible characters --and any trailing run of empty pieces") - (\EDITSETA LOOKS LOOKNO (IPLUS (fetch (PIECE PLEN) of ORIGPC) - (\EDITELT LOOKS LOOKNO))) - (* ; - "Note the invisible run length for the line displayer") - (SETQ PREVPC ORIGPC) - (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC)) - (COND - ((NOT ORIGPC) (* ; - "We ran off the end of the document. Don't try to update paragraph looks.") - ) - ((NEQ (fetch (PIECE PPARALOOKS) of ORIGPC) - (fetch (PIECE PPARALOOKS) of PREVPC)) - (* ; - "Paragraph looks changed in the course of the invisible section.") - (SETQ PARALOOKS (\TEDIT.APPLY.PARASTYLES (fetch (PIECE PPARALOOKS) - of ORIGPC) - ORIGPC TEXTOBJ)) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS))) - (SETQ TLOOKS (AND ORIGPC (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of ORIGPC) - ORIGPC TEXTOBJ] - (while (AND ORIGPC (ZEROP (fetch (PIECE PLEN) of ORIGPC))) - do (* ; - "Skip over any trailing pieces that are zero long") - (SETQ PREVPC ORIGPC) - (SETQ ORIGPC (fetch (PIECE NEXTPIECE) of ORIGPC))) - (add CHNO (\EDITELT LOOKS LOOKNO)) - (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) - (* ; - "Keep track of how much invisible text we cross over") - (SETQ NEWPC ORIGPC))) - (COND - ([AND ORIGPC (NOT (EQCLOOKS TLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of STREAM] - - (* ;; "Only update looks if there's really a new piece to update them from, and the looks have really changed") - - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with TLOOKS) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with PARALOOKS) - [COND - [(type? FONTCLASS (fetch (CHARLOOKS CLFONT) of TLOOKS)) - (* ; - "For FONTCLASSes, we have to get the real font") - (SETQ FONT (FONTCOPY (fetch (CHARLOOKS CLFONT) of TLOOKS) - 'DEVICE - 'DISPLAY] - (T (* ; - "It's a font already, so no work is needed") - (SETQ FONT (fetch (CHARLOOKS CLFONT) of TLOOKS] - [SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT 'ASCENT) - (OR (ffetch (CHARLOOKS CLOFFSET) - of TLOOKS) - 0] - [SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT 'DESCENT) - (OR (ffetch (CHARLOOKS CLOFFSET) - of TLOOKS) - 0] - [COND - ((fetch (FMTSPEC FMTHARDCOPY) of PARALOOKS) - (* ; - "If it's a hardcopy-format line, grab the hardcopy widths.") - (SETQ FONT (FONTCOPY (fetch (CHARLOOKS CLFONT) of TLOOKS) - 'DEVICE DEVICE] - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO TLOOKS) (* ; - "Save the new looks for selection/display") - (\RPLPTR CHLIST 0 LMLooksChange) (* ; - "Put a marker in the character list to denote a looks change") - (\RPLPTR WLIST 0 0) (* ; "Font changes have no width") - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) (* ; - "Account for the dummy marker/looks in TLEN") - (COND - ((ffetch (CHARLOOKS CLPROTECTED) of TLOOKS) - (* ; - "If this line contains protected text, mark the linedescriptor accordingly") - (freplace (LINEDESCRIPTOR LHASPROT) of LINE with T))) - (SETQ NEWPC ORIGPC)) - [(AND ORIGPC (fetch (PIECE PREVPIECE) of ORIGPC) - (fetch (PIECE POBJ) of (fetch (PIECE PREVPIECE) of ORIGPC))) - - (* ;; "After passing over an image object, always update the ascent and descent. This avoids losing that info if an image object is first on the line; we used to forget the starting font's data, which left following characters at the mercy of the imageobj.") - - [SETQ NEWASCENT (IMAX ASCENT (IPLUS (FONTPROP FONT 'ASCENT) - (OR (ffetch (CHARLOOKS CLOFFSET) - of TLOOKS) - 0] - (SETQ NEWDESCENT (IMAX DESCENT (IDIFFERENCE (FONTPROP FONT 'DESCENT) - (OR (ffetch (CHARLOOKS CLOFFSET) - of TLOOKS) - 0] - ((NOT ORIGPC) - - (* ;; "No more pieces in this document (we ran off the end skipping invisible text!) Return a NIL from the BIN, so that \FORMATLINE will not die.") - - (RETFROM '\BIN NIL))) - (RETURN NEWPC]) - (\TEDIT.PARSE.CHARLOOKS.LIST - [LAMBDA (NLOOKS OLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:46 by jds") + [LAMBDA (NLOOKS DEFAULTCLOOKS TEXTOBJ) (* ; "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") - (* ;; "Takes a CHARLOOKS, a FONTDESCRIPTOR, or an ALST-format looks spec and parses it into a new CHARLOOKS. If OLOOKS is given, it will be used as the base for modifications; otherwise, TEDIT.DEFAULT.CHARLOOKS will be.") + (* ;; "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.") - (PROG ((FAMILY NIL) - (FONT NIL) - (FACE NIL) - (SIZE NIL) - (SIZEINC NIL) - (PROT NIL) - (SELHERE NIL) - (ULINE NIL) - (OLINE NIL) - (STRIKE NIL) - (SUPER NIL) - (OFFSETINC NIL) - (WEIGHT NIL) - (SLOPE NIL) - (EXPANSION NIL) - (SUB NIL) - (INVISIBLE NIL) - STYLE STYLESET UISET USERINFO NEWLOOKS NEWFONT NEWPCLOOKS INVERSEVIDEO) - (* ; + (* ;; "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 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:") - (COND - ((type? CHARLOOKS NLOOKS) (* ; - "We've already got a made-up set of looks; we'll just use it.") - (RETURN NLOOKS)) - ((FONTP NLOOKS) (* ; - "It was a font spec. Make the looks be that font, otherwise unmodified.") - (RETURN (CHARLOOKS.FROM.FONT NLOOKS))) - (T (* ; + (* ;  "We got an AList -- prepare looks changes in that form") - (SETQ FONT (LISTGET NLOOKS 'FONT)) - (SETQ FAMILY (LISTGET NLOOKS 'FAMILY)) + + (* ;; "First get the new font") + + [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 SIZE (LISTGET NLOOKS 'SIZE)) + (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 NEWLOOKS 'INVERTED)) + (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 WEIGHT (LISTGET NLOOKS 'WEIGHT)) - (SETQ SLOPE (LISTGET NLOOKS 'SLOPE)) - (SETQ EXPANSION (LISTGET NLOOKS 'EXPANSION)) (SETQ OFFSETINC (LISTGET NLOOKS 'OFFSETINCREMENT)) - (SETQ SIZEINC (LISTGET NLOOKS 'SIZEINCREMENT)) + (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 NIL) (* ; "Tell later code to use NEWLOOKS.") - (SETQ NEWLOOKS NIL) - [COND - (FAMILY (SETQ NEWLOOKS (CONS 'FAMILY (CONS FAMILY NEWLOOKS] - [COND - (FONT (SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR] - [COND - [(OR WEIGHT SLOPE EXPANSION) (* ; - "Setting one of these inhibits the FACE parameter") - [AND WEIGHT (SETQ NEWLOOKS (CONS 'WEIGHT (CONS WEIGHT NEWLOOKS] - [AND SLOPE (SETQ NEWLOOKS (CONS 'SLOPE (CONS SLOPE NEWLOOKS] - (AND EXPANSION (SETQ NEWLOOKS (CONS 'EXPANSION (CONS EXPANSION NEWLOOKS] - (FACE (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS] - [COND - (SIZE (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS] - [SETQ NEWPCLOOKS - (COND - [OLOOKS (create CHARLOOKS using OLOOKS CLFONT _ - (SETQ NEWFONT (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) - of OLOOKS) - NEWLOOKS TEXTOBJ] - (T (create CHARLOOKS - using TEDIT.DEFAULT.CHARLOOKS CLFONT _ - (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of TEDIT.DEFAULT.CHARLOOKS) - (COND - (SIZEINC (* ; - "There's a size change requested. Fix up the size of the font.") - (LISTPUT NEWLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT - ) - of - TEDIT.DEFAULT.CHARLOOKS - ) - 'SIZE) - SIZEINC)) - NEWLOOKS) - (T NEWLOOKS)) - TEXTOBJ] (* ; "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 PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS with (EQ SELHERE + [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 ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE 'ON] - [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS - with (EQ INVISIBLE 'ON] - [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS + [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 NEWPCLOOKS with SUPER)) - (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS SUB))) - (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) - (AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of NEWPCLOOKS) - 0) - OFFSETINC))) - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) - (RETURN NEWPCLOOKS]) + (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]) +) +(DEFINEQ + +(\TEDIT.TRANSLATE.ASCIICHARS + [LAMBDA (TEXTOBJ NOASCIIFONTS) (* ; "Edited 1-Dec-2023 22:28 by rmk") + (* ; "Edited 27-Nov-2023 16:13 by rmk") + (* ; "Edited 26-Nov-2023 11:19 by rmk") + (* ; "Edited 14-Nov-2023 19:21 by rmk") + (* ; "Edited 9-Nov-2023 23:56 by rmk") + + (* ;; "Converts characters in Alto/Ascii font pieces to their XCCS character and font (more or less) equivalents. The affected characters are put in their own string pieces with their new CHARLOOKS. Asciifont pieces are completely replaced if NOASCIIFONTS, otherwise untranslated characters remain in their Asciifonts.") + + (* ;; "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.") + + (DECLARE (GLOBALVARS ASCIITONSTRANSLATIONS \ASCIITOSTAR)) + (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) + (CL:WHEN (thereis CL in (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + unless (EQ 'CLASSIC (fetch (CHARLOOKS CLNAME) of CL)) + suchthat + + (* ;; "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 (\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.") + + (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)) + + (* ;; " 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") + + (CL:UNLESS MAPARRAY (SETQ MAPARRAY \ASCIITOSTAR)) + (SETQ TARRAYLAST (SUB1 (ARRAYSIZE MAPARRAY))) + + (* ;; "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 + (* ;; + "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.") + + (* ;; "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.") + + (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 (\PCTOCH PC TEXTOBJ))) + (TEDIT.RPLCHARCODE TEXTOBJ (IPLUS START OFFSET -1) + NEWCODE + (FSETPC PC PLOOKS (\TEDIT.TRANSLATE.ASCII.CHARLOOKS TEXTOBJ CLOOKS + NEWFONTNAME))) + + (* ;; + "Move START up to the new START of PC, set OFFSET back to its beginning.") + + (add START OFFSET) + (SETQ OFFSET 0))) 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 + + (* ;; + "Something happened, get rid of any lingering old looks") + + (\TEDIT.UNIQUIFY.ALL TEXTOBJ))))]) + +(\TEDIT.CONVERT.TO.FORMATTED + [LAMBDA (TEXTOBJ START END) (* ; "Edited 6-Jan-2024 15:10 by rmk") + (* ; "Edited 11-Dec-2023 10:02 by rmk") + (* ; "Edited 9-Nov-2023 15:37 by rmk") + (* ; "Edited 5-Nov-2023 11:22 by rmk") + (* ; "Edited 24-Sep-2023 23:30 by rmk") + (* ; "Edited 22-May-2023 22:50 by rmk") + (* ; "Edited 20-May-2023 16:44 by rmk") + (* ; "Edited 8-May-2023 08:44 by rmk") + (* ; "Edited 29-Apr-93 19:47 by jds") + + (* ;; "Turn an unformatted TEdit file into a formatted TEdit file, essentially simulating ANY.EOLC by ensuring that end-of-line indicators (CR, CRLF, LF) are canonicalized as EOL's and then interpreted as paragraph ends. Pieces are split so that EOLs are always at piece-end. If it wasn't formatted before, it presumably didn't have any looks to worry about, just the defaults.") + + (* ;; "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.") + + (\DTEST 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") + + (\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.RPLCHARCODE TEXTOBJ CHNO (CHARCODE EOL)) + (FSETPC (\CHTOPC CHNO TEXTOBJ) + PPARALAST T) + (\TEXTSETFILEPTR TSTREAM CHNO)) + (CR + (* ;; + "Post-CR characters go to a separate piece, the CR piece is then paragraph-final") + + (FSETPC (PREVPIECE (\ALIGNEDPIECE (ADD1 CHNO) + TEXTOBJ)) + PPARALAST T) + (CL:WHEN (EQ (CHARCODE LF) + (\TEXTPEEKBIN TSTREAM T)) + (* ; "DO WE EVER WANT TO SEE LF'S ??") + + (* ;; + "Linefeed following CR. Chop it off from whatever follows, and then delete it.") + + (add END -1) (* ; "One less char to do") + (\DELETEPIECES (\SELPIECES (ADD1 CHNO) + (ADD1 CHNO)) + TEXTOBJ))) + NIL) repeatuntil (IGEQ CHNO END))) (* ; + "Test END explicitly, because it may get reduced") + (FSETTOBJ TEXTOBJ FORMATTEDP T) + (\TEDIT.MARK.LINES.DIRTY TEXTOBJ START END))]) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \TEDIT.TRANSLATE.ASCII.CHARLOOKS MACRO + [OPENLAMBDA (TEXTOBJ CLOOKS NEWFONTNAME) + + (* ;; "Macro because CLOOKSLIST is set. The alist avoids creating and then uniquifying each time we want to make the same translation.") + + (CDR (OR (ASSOC CLOOKS CLOOKSLIST) + (CAR (PUSH CLOOKSLIST (CONS CLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS + (create CHARLOOKS + using CLOOKS CLFONT _ + (\TEDIT.FONTCOPY + (fetch (CHARLOOKS CLFONT) + of CLOOKS) + (LIST 'FAMILY NEWFONTNAME) + TEXTOBJ) + CLNAME _ NEWFONTNAME) + TEXTOBJ]) +) +(DEFINEQ + +(\TEDIT.UNIQUIFY.CHARLOOKS + [LAMBDA (NEWLOOK TEXTOBJ) (* ; "Edited 15-Oct-2023 17:17 by rmk") + (* ; "Edited 18-Aug-2023 21:47 by rmk") + (* ; "Edited 15-Aug-2023 20:57 by rmk") + (* ; "Edited 3-Aug-2023 17:52 by rmk") + (* ; "Edited 30-May-91 21:40 by jds") + + (* ;; "Assure that there is only ONE of a given CHARLOOKS in the document--so that all instances of that set of looks share structure. When we get a hit, we move it to the front, hopefully more frequent looks will come earlier in the list.") + + (CL:WHEN NEWLOOK + (for LOOKTAIL LOOK PREVTAIL on (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + do (SETQ LOOK (CAR LOOKTAIL)) + (CL:WHEN (EQCLOOKS NEWLOOK LOOK) + (CL:WHEN PREVTAIL (* ; "Not already in first position") + (RPLACD PREVTAIL (CDR LOOKTAIL)) + (push (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + LOOK)) + (RETURN LOOK)) + (SETQ PREVTAIL LOOKTAIL) finally (push (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + NEWLOOK) + (RETURN NEWLOOK)))]) + +(\TEDIT.UNIQUIFY.PARALOOKS + [LAMBDA (NEWLOOK TEXTOBJ) (* ; "Edited 18-Aug-2023 21:48 by rmk") + (* ; "Edited 30-May-91 21:41 by jds") + + (* ;; "Assure that there is only ONE of a given PARALOOKS in the document--so that all instances of that set of looks share structure. When we get a hit, we move it to the front, hopefully more frequent looks will come earlier in the list.") + + (for LOOKTAIL LOOK PREVTAIL on (GETTOBJ TEXTOBJ TXTPARALOOKSLIST) + do (SETQ LOOK (CAR LOOKTAIL)) + (CL:WHEN (EQFMTSPEC NEWLOOK LOOK) + (CL:WHEN PREVTAIL (* ; "Not already in first position") + (RPLACD PREVTAIL (CDR LOOKTAIL)) + (push (GETTOBJ TEXTOBJ TXTPARALOOKSLIST) + LOOK)) + (RETURN LOOK)) + (SETQ PREVTAIL LOOKTAIL) finally (push (GETTOBJ TEXTOBJ TXTPARALOOKSLIST) + NEWLOOK) + (RETURN NEWLOOK]) + +(\TEDIT.UNIQUIFY.ALL + [LAMBDA (TEXTOBJ) (* ; "Edited 14-Nov-2023 16:20 by rmk") + (* ; "Edited 25-Aug-2023 08:57 by rmk") + (* ; "Edited 15-Aug-2023 22:04 by rmk") + (* ; "Edited 3-Aug-2023 18:44 by rmk") + (* ; "Edited 1-Aug-2023 11:43 by rmk") + (* ; "Edited 13-Jul-2022 22:56 by rmk") + (SETTOBJ TEXTOBJ TXTCHARLOOKSLIST NIL) + (SETTOBJ TEXTOBJ TXTPARALOOKSLIST NIL) + (for PC inpieces (\FIRSTPIECE TEXTOBJ) do + (* ;; + "Assure that the CHARLOOKS and PARALOOKS of every piece are in the cache.") + + (change (PLOOKS PC) + (\TEDIT.UNIQUIFY.CHARLOOKS DATUM TEXTOBJ)) + (change (PPARALOOKS PC) + (\TEDIT.UNIQUIFY.PARALOOKS DATUM TEXTOBJ))) + (CL:WHEN (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + (change (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + (\TEDIT.UNIQUIFY.CHARLOOKS DATUM TEXTOBJ))) + (change (GETTOBJ TEXTOBJ CARETLOOKS) + (\TEDIT.UNIQUIFY.CHARLOOKS DATUM TEXTOBJ)) + (change (GETTOBJ TEXTOBJ FMTSPEC) + (\TEDIT.UNIQUIFY.PARALOOKS DATUM TEXTOBJ]) (\TEDIT.FLUSH.UNUSED.LOOKS - [LAMBDA (TEXTOBJ FIRSTPC) (* ; "Edited 30-May-91 21:47 by jds") + [LAMBDA (TEXTOBJ) (* ; "Edited 25-Aug-2023 08:03 by rmk") + (* ; "Edited 15-Aug-2023 22:11 by rmk") + (* ; "Edited 30-May-91 21:47 by jds") (* ;; "Run thru the CHARLOOKS and PARALOOKS lists for this document, and flush any looks that aren't being used in the document itself.") - (PROG ((CHARLOOKS (fetch (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ)) - (PARALOOKS (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ))) - (for LOOKS in CHARLOOKS do (* ; - "Reset the in-use mark in all CHARLOOKSs") - (replace (CHARLOOKS CLMARK) of LOOKS with NIL)) - (for LOOKS in PARALOOKS do (* ; - "Reset the in-use mark in all FMTSPECs") - (replace (FMTSPEC FMTMARK) of LOOKS with NIL)) - (while FIRSTPC do (* ; - "Now run thru the pieces in the document, marking the looks that are really in use.") - (replace (CHARLOOKS CLMARK) of (fetch (PIECE PLOOKS) of FIRSTPC) - with T) - (replace (FMTSPEC FMTMARK) of (fetch (PIECE PPARALOOKS) of FIRSTPC) - with T) - (SETQ FIRSTPC (fetch (PIECE NEXTPIECE) of FIRSTPC))) - (replace (TEXTOBJ TXTCHARLOOKSLIST) of TEXTOBJ with (for LOOKS in CHARLOOKS - when (fetch (CHARLOOKS CLMARK) - of LOOKS) collect LOOKS)) - (* ; - "Keep only those CHARLOOKSs that ARE being used.") - (replace (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ with (for LOOKS in PARALOOKS - when (fetch (FMTSPEC FMTMARK) - of LOOKS) collect LOOKS)) - (* ; - "And only those PARALOOKSs that ARE being used.") - ]) + (LET ((CHARLOOKS (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST)) + (PARALOOKS (GETTOBJ TEXTOBJ TXTPARALOOKSLIST))) + + (* ;; "Reset the in-use mark in all looks") + + (for LOOKS in CHARLOOKS do (replace (CHARLOOKS CLMARK) of LOOKS with NIL)) + (for LOOKS in PARALOOKS do (replace (FMTSPEC FMTMARK) of LOOKS with NIL)) + + (* ;; "Run thru the pieces in the document, marking the looks that are really in use.") + + (for PC inpieces (\FIRSTPIECE TEXTOBJ) do (replace (CHARLOOKS CLMARK) of (PLOOKS PC) + with T) + (replace (FMTSPEC FMTMARK) of (PPARALOOKS PC) + with T)) + + (* ;; "Keep only those char and para looks that ARE being used.") + + (SETTOBJ TEXTOBJ TXTCHARLOOKSLIST (for LOOKS in CHARLOOKS when (fetch (CHARLOOKS CLMARK) + of LOOKS) + collect (replace (CHARLOOKS CLMARK) of LOOKS + with NIL) + LOOKS)) + (SETTOBJ TEXTOBJ TXTPARALOOKSLIST (for LOOKS in PARALOOKS when (fetch (FMTSPEC FMTMARK) + of LOOKS) + collect (replace (FMTSPEC FMTMARK) of LOOKS + with NIL) + LOOKS]) ) @@ -875,445 +1174,392 @@ (DEFINEQ (TEDIT.SUBLOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 14:53 by jds") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 13-Nov-2023 00:26 by rmk") + (* ; "Edited 18-Apr-2023 23:53 by rmk") + (* ; "Edited 22-Aug-2022 13:06 by rmk") + (* ; "Edited 26-Apr-93 14:53 by jds") (* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.") - (LET* ((OLDLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST)) - (NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKSLIST)) - (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (FIRSTPC (\CHTOPC 1 PCTB)) - (FEATURELIST (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) - CHANGEMADE) - (\SHOWSEL SEL NIL 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 - ((SAMECLOOKS OLDLOOKS (fetch (PIECE PLOOKS) of PC) - FEATURELIST) - (replace (TEXTOBJ \DIRTY) of (TEXTOBJ TEXTSTREAM) with T) - (freplace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS - (\TEDIT.PARSE.CHARLOOKS.LIST - NEWLOOKSLIST - (fetch (PIECE PLOOKS) 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") - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (COND - (CHANGEMADE 'Done) - (T 'NoChangesMade]) + (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 + )) + (NEWLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKSLIST NIL TEXTOBJ)) + (FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) + (CH# _ 1) inpieces (\FIRSTPIECE TEXTOBJ) as CH# from 1 by (PLEN PC) + when (SAMECLOOKS OLDLOOKS (PLOOKS PC) + FEATURELIST) do (CL:UNLESS CHANGEMADE + (SETQ CHANGEMADE T) + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (\SHOWSEL SEL NIL) + (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") + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T)) + (RETURN (CL:IF CHANGEMADE + 'Done + 'NoChangesMade)])]) + +(TEDIT.FINDLOOKS + [LAMBDA (TEXTSTREAM OLDLOOKSLIST CH#) (* ; "Edited 3-Dec-2023 00:09 by rmk") + (* ; "Edited 13-Nov-2023 00:26 by rmk") + (* ; "Edited 18-Apr-2023 23:53 by rmk") + (* ; "Edited 22-Aug-2022 13:06 by rmk") + (* ; "Edited 26-Apr-93 14:53 by jds") + +(* ;;; "Finds and selects the next substring of the text whose looks are a superset of OLDLOOKSLIST.") + + (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))) (* ; "Turn off the selection, first.") + (if (AND (FIXP CH#) + (IGEQ CH# 1) + (ILEQ CH# (FGETTOBJ TEXTOBJ TEXTLEN))) + elseif (type? SELECTION CH#) + then (SETQ CH# (TEDIT.GETPOINT TEXTOBJ CH#)) + elseif (NULL CH#) + then (SETQ CH# (TEDIT.GETPOINT TEXTOBJ (FGETTOBJ TEXTOBJ SEL))) + else (\ILLEGAL.ARG CH#)) + (CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + (for PC PCLAST FOUNDCH# (OLDLOOKS _ (\TEDIT.PARSE.CHARLOOKS.LIST OLDLOOKSLIST NIL + TEXTOBJ)) + (FEATURELIST _ (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) + inpieces (\CHTOPC CH# TEXTOBJ) when (SAMECLOOKS OLDLOOKS (PLOOKS PC) + FEATURELIST) + do [SETQ PCLAST (find PC1 inpieces (NEXTPIECE PC) + suchthat (NOT (SAMECLOOKS OLDLOOKS (PLOOKS PC1) + FEATURELIST] + (SETQ PCLAST (CL:IF PCLAST + (PREVPIECE PCLAST) + PC)) + (SETQ FOUNDCH# (\PCTOCH PC TEXTOBJ)) + (TEDIT.SETSEL TEXTOBJ FOUNDCH# (IDIFFERENCE (IPLUS (\PCTOCH PCLAST) + (PLEN PCLAST)) + FOUNDCH#) + 'RIGHT) + (TEDIT.NORMALIZECARET TEXTOBJ) + (RETURN (FGETTOBJ TEXTOBJ SEL))))]) ) (DEFINEQ (\TEDIT.CHANGE.LOOKS - [LAMBDA (STREAM NEWLOOKS CH# LEN) (* ; "Edited 19-Apr-93 14:08 by jds") + [LAMBDA (TSTREAM NEWLOOKS SEL) (* ; "Edited 24-Feb-2024 12:33 by rmk") + (* ; "Edited 22-Feb-2024 23:01 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..") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - PCTB PC1 PCNO1 PCNON PCN \INPC FAMILY FONT FACE SIZE PROT SELHERE ULINE OLINE STRIKE - INVERSEVIDEO (SUPER NIL) - (WEIGHT NIL) - (SLOPE NIL) - (SIZEINC NIL) - (OFFSETINC NIL) - (EXPANSION NIL) - (NEWLOOKS NEWLOOKS) - (NLOOKSAVE NEWLOOKS) - (SUB NIL) - (INVISIBLE NIL) - FOOLOOKS NEWFONT DY CHLIM (OLDLOOKSLIST NIL) - STYLE STYLESET UISET USERINFO START-OF-PIECE) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ \INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ))(* ; + (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) + (* ;  "Construct the set of new looks to apply:") - (COND - ((OR (IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (ZEROP LEN)) (* ; - "There won't be any text changed by this. Just punt out.") - (TEDIT.CARETLOOKS STREAM NEWLOOKS) (* ; "After setting the caret looks.") - (RETURN))) - [COND - ((type? CHARLOOKS NEWLOOKS) (* ; - "We've already got a made-up set of looks; we'll just use it.") - ) - ((FONTP NEWLOOKS) (* ; - "If it's a font descriptor, extract what we need from that.") - (SETQ FONT NEWLOOKS) - (SETQ NEWLOOKS NIL)) - (T (* ; - "We got an AList -- prepare looks changes in that form") - (SETQ FONT (LISTGET NEWLOOKS 'FONT)) - (SETQ FAMILY (LISTGET NEWLOOKS 'FAMILY)) - (SETQ FACE (LISTGET NEWLOOKS 'FACE)) - (SETQ SIZE (LISTGET NEWLOOKS 'SIZE)) - (SETQ PROT (LISTGET NEWLOOKS 'PROTECTED)) - (SETQ SELHERE (LISTGET NEWLOOKS 'SELECTPOINT)) - (SETQ ULINE (LISTGET NEWLOOKS 'UNDERLINE)) - (SETQ OLINE (LISTGET NEWLOOKS 'OVERLINE)) - (SETQ INVERSEVIDEO (LISTGET NEWLOOKS 'INVERTED)) - (SETQ STRIKE (LISTGET NEWLOOKS 'STRIKEOUT)) - (SETQ INVISIBLE (LISTGET NEWLOOKS 'INVISIBLE)) - (SETQ SUPER (LISTGET NEWLOOKS 'SUPERSCRIPT)) - (SETQ SUB (LISTGET NEWLOOKS 'SUBSCRIPT)) - (SETQ WEIGHT (LISTGET NEWLOOKS 'WEIGHT)) - (SETQ SLOPE (LISTGET NEWLOOKS 'SLOPE)) - (SETQ EXPANSION (LISTGET NEWLOOKS 'EXPANSION)) - (SETQ SIZEINC (LISTGET NEWLOOKS 'SIZEINCREMENT)) - (SETQ OFFSETINC (LISTGET NEWLOOKS 'OFFSETINCREMENT)) - (SETQ STYLE (LISTGET NEWLOOKS 'STYLE)) - (SETQ STYLESET (FMEMB 'STYLE NEWLOOKS)) - (SETQ USERINFO (LISTGET NEWLOOKS 'USERINFO)) - (SETQ UISET (FMEMB 'USERINFO NEWLOOKS)) - (SETQ NEWLOOKS NIL) (* ; "Tell later code to use FOOLOOKS") - (SETQ FOOLOOKS NIL) - [COND - (FAMILY (SETQ FOOLOOKS (CONS 'FAMILY (CONS FAMILY FOOLOOKS] - [COND - (FONT (COND - ((type? FONTCLASS FONT) (* ; - "Needn't do anything. It's a font class.") - ) - ([SETQ FONT (CAR (NLSETQ (\DTEST FONT 'FONTDESCRIPTOR] - (* ; - "Try converting it to a font--it might be a list or some such.") - ) - (T (* ; - "Nothing doing--it isn't any of the reasonable forms, so punt.") - (TEDIT.PROMPTPRINT (CONCAT FONT " isn't a valid font descriptor.") - T) - (RETURN] - [COND - [(OR WEIGHT SLOPE EXPANSION) (* ; + (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 (* ;  "Setting one of these inhibits the FACE parameter") - [AND WEIGHT (SETQ FOOLOOKS (CONS 'WEIGHT (CONS WEIGHT FOOLOOKS] - [AND SLOPE (SETQ FOOLOOKS (CONS 'SLOPE (CONS SLOPE FOOLOOKS] - (AND EXPANSION (SETQ FOOLOOKS (CONS 'EXPANSION (CONS EXPANSION FOOLOOKS] - (FACE (SETQ FOOLOOKS (CONS 'FACE (CONS FACE FOOLOOKS] - (COND - [SIZE (SETQ FOOLOOKS (CONS 'SIZE (CONS SIZE FOOLOOKS] - (SIZEINC (SETQ FOOLOOKS (CONS 'SIZE (CONS 'BOGUSSIZE FOOLOOKS] - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document changed.") - (SETQ CHLIM (IMIN (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (IPLUS CH# LEN))) (* ; "last ch to change") - (SETQ PC1 (\CHTOPC CH# PCTB T)) (* ; "Piece the first ch is in") - (COND - ((IGREATERP CH# START-OF-PIECE) (* ; - "If CH# is not first ch in piece, split it.") - (SETQ PC1 (\SPLITPIECE PC1 (- CH# START-OF-PIECE) - TEXTOBJ PCNO1)) (* ; - "Take 2nd half of the split, which starts with CH#.") - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (* ; - "NB: \SplitPiece may make a new PCTB, so copy it here.") - )) - (SETQ PCN (\CHTOPC CHLIM PCTB T)) - (COND - ((IEQP CHLIM START-OF-PIECE) (* ; - "CHLIM+1 is the start of a new piece. just use prevpiece as pcn") - (SETQ PCN (\CHTOPC (SUB1 CHLIM) - PCTB T))) - (T (* ; - "If the last char isn't the last char in the piece, then split it and take the first half.") - (\SPLITPIECE PCN (- CHLIM START-OF-PIECE) - TEXTOBJ PCNON))) - [COND - (NEWLOOKS - - (* ;; "For the case of a completely specified looks, do the following outside the loop: Make sure that this isn't a duplicate set of looks for this document.") - - (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS NEWLOOKS TEXTOBJ] - [bind (PC _ PC1) - NEWPCLOOKS while (AND PC (NEQ PC PCN)) - do - (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE PLOOKS) of PC))) + (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 (\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 (* ; + [COND + (NEWLOOKS (* ;  "We got a CHARLOOKS in. Just use it") - (replace (PIECE PLOOKS) of PC with NEWLOOKS)) - (T (* ; + (FSETPC PC PLOOKS NEWLOOKS)) + (T (* ;  "Otherwise, we have to override selectively") - [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS (create CHARLOOKS - using (fetch (PIECE PLOOKS) - of PC] + (SETQ NEWPCLOOKS (create CHARLOOKS using OLDPCLOOKS)) + (FSETPC PC PLOOKS NEWPCLOOKS) - (* ;; "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.") - [replace (CHARLOOKS CLFONT) of NEWPCLOOKS - with (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) of PC)) - (COND - (SIZEINC (* ; - "There's a size change requested. Fix up the size of the font.") - (LISTPUT FOOLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT) - of (fetch (PIECE PLOOKS) - of PC)) - 'SIZE) - SIZEINC)) - FOOLOOKS) - (T FOOLOOKS)) - TEXTOBJ] (* ; "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 PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS - with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS - with (EQ SELHERE 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE - 'ON] - [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS - with (EQ INVISIBLE 'ON] - (AND SUPER (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with SUPER)) - (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS SUB))) - (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) - (AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS (OR (fetch (CHARLOOKS CLOFFSET) of NEWPCLOOKS) - 0) - OFFSETINC))) - [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS - with (EQ INVERSEVIDEO 'ON] - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ)) + (SETQ NEWFONT + (OR FONT (\TEDIT.FONTCOPY + (fetch (CHARLOOKS CLFONT) of OLDPCLOOKS) + (PROGN (CL:WHEN SIZEINCREMENT (* ; - "Assure that each set of looks appears only once in the world.") - )) - [COND - ((EQ PC \INPC) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (fetch (PIECE PLOOKS) of PC] - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - finally - (OR PC (RETURN)) - (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE PLOOKS) of PC))) - (COND - (NEWLOOKS (* ; - "We got a CHARLOOKS in. Just use it") - (replace (PIECE PLOOKS) of PC with NEWLOOKS)) - (T (* ; - "Otherwise, we have to override selectively") - [replace (PIECE PLOOKS) of PC with (SETQ NEWPCLOOKS (create CHARLOOKS - using (fetch (PIECE PLOOKS) - of PC] + "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)) - (* ;; "If a size increment is specified, then add to the newspecs arg for fontcopy, the entry with the incremented size from the current font.") + (* ;; "Assure that each set of looks appears only once in the world.") - [replace (CHARLOOKS CLFONT) of NEWPCLOOKS - with - (SETQ NEWFONT - (OR FONT (\TEDIT.FONTCOPY - (fetch (CHARLOOKS CLFONT) of (fetch (PIECE PLOOKS) of PC)) - (COND - (SIZEINC (PROGN (LISTPUT FOOLOOKS 'SIZE - (IPLUS (FONTPROP (fetch (CHARLOOKS CLFONT) - of (fetch (PIECE PLOOKS) - of PC)) - 'SIZE) - SIZEINC)) - FOOLOOKS)) - (T FOOLOOKS)) - TEXTOBJ] (* ; "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 PROT (replace (CHARLOOKS CLPROTECTED) of NEWPCLOOKS with (EQ PROT 'ON] - [AND SELHERE (replace (CHARLOOKS CLSELHERE) of NEWPCLOOKS with (EQ SELHERE - 'ON] - [AND ULINE (replace (CHARLOOKS CLULINE) of NEWPCLOOKS with (EQ ULINE 'ON] - [AND OLINE (replace (CHARLOOKS CLOLINE) of NEWPCLOOKS with (EQ OLINE 'ON] - [AND STRIKE (replace (CHARLOOKS CLSTRIKE) of NEWPCLOOKS with (EQ STRIKE 'ON] - (AND SUPER (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with SUPER)) - (AND SUB (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS with (IMINUS SUB))) - [AND INVISIBLE (replace (CHARLOOKS CLINVISIBLE) of NEWPCLOOKS - with (EQ INVISIBLE 'ON] - [AND INVERSEVIDEO (replace (CHARLOOKS CLINVERTED) of NEWPCLOOKS - with (EQ INVERSEVIDEO 'ON] - [AND OFFSETINC (replace (CHARLOOKS CLOFFSET) of NEWPCLOOKS - with (IPLUS OFFSETINC (OR (fetch (CHARLOOKS CLOFFSET) of - NEWPCLOOKS - ) - 0] - (AND STYLESET (replace (CHARLOOKS CLSTYLE) of NEWPCLOOKS with STYLE)) - (AND UISET (replace (CHARLOOKS CLUSERINFO) of NEWPCLOOKS with USERINFO)) - (replace (CHARLOOKS CLSIZE) of NEWPCLOOKS with (FONTPROP NEWFONT 'SIZE)) - (replace (PIECE PLOOKS) of PC with (\TEDIT.UNIQUIFY.CHARLOOKS NEWPCLOOKS TEXTOBJ] - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CHLIM) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (TEDIT.RESET.EXTEND.PENDING.DELETE (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL T))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (RETURN (LIST OLDLOOKSLIST NLOOKSAVE PC1]) + (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) + (\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)) + (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") + (\FIXSEL (FGETTOBJ TEXTOBJ SEL) + TEXTOBJ) + (\SHOWSEL (FGETTOBJ TEXTOBJ SEL) + T))]) (TEDIT.LOOKS - [LAMBDA (STREAM NEWLOOKS SELORCH# LEN) (* ; "Edited 30-May-91 21:41 by jds") + [LAMBDA (TSTREAM NEWLOOKS SELORCH# LEN) (* ; "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") + (* ;; "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.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - TSEL CHANGERESULT) - [SETQ TSEL (COND - ((type? SELECTION SELORCH#) - SELORCH#) - (SELORCH# (TEDIT.SETSEL TEXTOBJ SELORCH# LEN 'LEFT)) - (T (fetch (TEXTOBJ SEL) of TEXTOBJ] - (COND - ((NOT (fetch (SELECTION SET) of TSEL)) (* ; - "No selection to change the looks of. Can't do anything!") - (RETURN))) - (COND - ((SETQ CHANGERESULT (\TEDIT.CHANGE.LOOKS STREAM NEWLOOKS (fetch (SELECTION CH#) - of TSEL) - (fetch (SELECTION DCH) of TSEL))) - (* ; "Go actually change the looks") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Looks - THLEN _ (fetch (SELECTION DCH) of TSEL) - THCH# _ (fetch (SELECTION CH#) of TSEL) - THFIRSTPIECE _ (CADDR CHANGERESULT) - THOLDINFO _ (CAR CHANGERESULT) - THAUXINFO _ (CADR CHANGERESULT))) - (* ; "Save this action for undo/redo") - ]) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + SEL) + (CL:UNLESS (\TEDIT.READONLY TEXTOBJ) + + (* ;; "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.CARETLOOKS TSTREAM NEWLOOKS))))]) (\TEDIT.LOOKS - [LAMBDA (TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") + [LAMBDA (TEXTOBJ) (* ; "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)) - (FONT NIL) - (FACE NIL) - (SIZE NIL) - NEWLOOKS + (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] - (COND - ((IGREATERP (fetch (SELECTION CH#) of SEL) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; "Nothing to change, really") - ) - [(fetch (SELECTION SET) of SEL) (* ; "He's got something selected.") - (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") + 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") (* ;  "Construct the set of new looks to apply:") - (COND - (FONT (SETQ NEWLOOKS (LIST 'FAMILY FONT))) - (T (SETQ NEWLOOKS NIL))) (* ; "The font") - [COND - (FACE (SETQ NEWLOOKS (CONS 'FACE (CONS FACE NEWLOOKS] - (* ; "The face") - [COND - (SIZE (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS] - (* ; "The size") - (COND - (NEWLOOKS (* ; - "If there's something to do, do it.") - (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL] - (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" 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) (* jds "26-Dec-84 16:06") - (* Cloak FONTCOPY in protection for - the user from an unavailable font.) + [LAMBDA (FONT NEWSPECS TEXTOBJ) (* ; "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.) + ((NULL NEWSPECS) (* ; "No changes specified. Punt it.") FONT) [(CAR (NLSETQ (FONTCOPY FONT NEWSPECS] - (T (PROG [(OLDFAMILY (FONTPROP FONT 'FAMILY)) - (OLDSIZE (FONTPROP FONT 'SIZE] - (TEDIT.PROMPTPRINT TEXTOBJ [CONCAT "Can't find font " (OR (LISTGET NEWSPECS - 'FAMILY) - OLDFAMILY) - " " - (OR (LISTGET NEWSPECS 'SIZE) - OLDSIZE) - " " - (OR (LISTGET NEWSPECS 'FACE) - (FONTPROP FONT 'FACE] - T)) - FONT]) + (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]) (TEDIT.GET.LOOKS - [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 30-May-91 21:44 by jds") - (* Return a PLIST of character looks) - (PROG ((TEXTOBJ (TEXTOBJ TEXTOBJ)) - LOOKS FONT NLOOKS) - [COND - ((type? CHARLOOKS CH#ORCHARLOOKS) (* He handed us a CHARLOOKS. - Unparse it for him.) - (SETQ LOOKS CH#ORCHARLOOKS)) - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* There's no text in the document. - Use the extant caret looks.) - (SETQ LOOKS (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) - [(FIXP CH#ORCHARLOOKS) (* He gave us a CH# to geth the looks - of. Grab it.) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - CH#ORCHARLOOKS) - (fetch (TEXTOBJ PCTB) of TEXTOBJ] - [(type? SELECTION CH#ORCHARLOOKS) (* Get the looks of the selected text) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - (fetch (SELECTION CH#) of - CH#ORCHARLOOKS - )) - (fetch (TEXTOBJ PCTB) of TEXTOBJ] - ((NULL CH#ORCHARLOOKS) (* Get the looks of the selected text) - (SETQ LOOKS (fetch (PIECE PLOOKS) of (\CHTOPC (IMIN (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ) - (fetch (SELECTION CH#) - of (fetch (TEXTOBJ SEL) - of TEXTOBJ))) - (fetch (TEXTOBJ PCTB) of TEXTOBJ] + [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 14-Dec-2023 21:00 by rmk") + (* ; "Edited 21-Jun-2023 11:10 by rmk") + (* ; "Edited 22-Aug-2022 13:14 by rmk") + (* ; "Edited 30-May-91 21:44 by jds") - (* * Now break the looks apart into a PROPLIST) + (* ;; "Returns as a property list the looks denoted by CH#ORCHARLOOKS.") - (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS)) - (RETURN NLOOKS]) + (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) + (\TEDIT.UNPARSE.CHARLOOKS.LIST (if (type? CHARLOOKS CH#ORCHARLOOKS) + then (* ; "Unparse the given looks.") + CH#ORCHARLOOKS + elseif (ZEROP (TEXTLEN TEXTOBJ)) + then (* ; + "Empty document, use extant caret looks.") + (FGETTOBJ TEXTOBJ CARETLOOKS) + else (PLOOKS (\CHTOPC (OR (FIXP CH#ORCHARLOOKS) + (GETSEL (if (type? SELECTION + CH#ORCHARLOOKS) + then CH#ORCHARLOOKS + elseif (NULL CH#ORCHARLOOKS) + then (TEXTSEL TEXTOBJ) + else (\ILLEGAL.ARG + CH#ORCHARLOOKS)) + CH#)) + TEXTOBJ]) ) @@ -1322,19 +1568,6 @@ (DEFINEQ -(\TEDIT.GET.PARALOOKS - [LAMBDA (FILE PARAHASH) (* ; "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# (\SMALLPIN FILE))) - (COND - ((ZEROP LOOKS#) - NIL) - (T (ELT PARAHASH LOOKS#]) - (EQFMTSPEC [LAMBDA (PARALOOK1 PARALOOK2) (* ;  "Edited 2-Jul-93 21:32 by sybalskY:MV:ENVOS") @@ -1389,41 +1622,31 @@ (EQUALALL (ffetch (FMTSPEC TABSPEC) of PARALOOK1) (ffetch (FMTSPEC TABSPEC) of PARALOOK2]) -(\TEDIT.UNIQUIFY.PARALOOKS - [LAMBDA (NEWLOOKS TEXTOBJ) (* ; "Edited 30-May-91 21:41 by jds") - - (* Assure that there is only ONE of a given PARALOOKS in the document--so that - all instances of that set of looks share structure.) - - (COND - ((for LOOK in (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) thereis (EQFMTSPEC NEWLOOKS LOOK)) - ) - (T (push (fetch (TEXTOBJ TXTPARALOOKSLIST) of TEXTOBJ) - NEWLOOKS) - NEWLOOKS]) - (TEDIT.GET.PARALOOKS - [LAMBDA (TEXTSTREAM SELORCH#) (* ; "Edited 30-May-91 21:44 by jds") - (* ; - "Return a proplist of paragraph formatting information about the characters specified.") - (LET* [(TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (SEL (OR SELORCH# (fetch (TEXTOBJ SEL) of TEXTOBJ] - (\TEDIT.UNPARSE.PARALOOKS.LIST (fetch (PIECE PPARALOOKS) - of (\CHTOPC (CL:TYPECASE SEL - (SELECTION (fetch (SELECTION CH#) - of SEL)) - ((OR FIXP SMALLP) - (IMAX 1 (IMIN SEL (fetch (TEXTOBJ - TEXTLEN) - of TEXTOBJ)))) - (T (\ILLEGAL.ARG SEL))) - (fetch (TEXTOBJ PCTB) of TEXTOBJ]) + [LAMBDA (TSTREAM SELORCH#) (* ; "Edited 11-Dec-2023 10:12 by rmk") + (* ; "Edited 22-Jun-2023 00:02 by rmk") + (* ; "Edited 11-Feb-2023 14:55 by rmk") + (* ; "Edited 30-May-91 21:44 by jds") -(\TEDIT.UNPARSE.PARALOOKS.LIST - [LAMBDA (FMTSPEC) (* ; "Edited 30-May-91 21:48 by jds") - (* ; - "Convert a FMTSPEC into an equivalent PList-form for external consumption") - (PROG ((NEWLOOKS NIL)) + (* ;; "Return a proplist of paragraph formatting information about the characters specified.") + + (LET* [(TEXTOBJ (TEXTOBJ TSTREAM)) + (PC (if (type? PIECE SELORCH#) + then + (* ;; "An internal call, if we already have the piece.") + + SELORCH# + else (\CHTOPC (OR (FIXP SELORCH#) + (GETSEL (if (type? SELECTION SELORCH#) + then SELORCH# + elseif (NULL SELORCH#) + then (TEXTSEL TEXTOBJ) + else (\ILLEGAL.ARG SELORCH#)) + CH#)) + TEXTOBJ))) + (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) @@ -1440,44 +1663,35 @@ (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC) - (fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC) - (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC) - (fetch (FMTSPEC FMTHEADINGKEEP) 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) - (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) + (ONOFF (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC)) (fetch (FMTSPEC FMTREVISED) of FMTSPEC) (fetch (FMTSPEC FMTCOLUMN) of FMTSPEC)) 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) - as METHOD - in '(VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE VALUE - VALUE VALUE VALUE VALUE ONOFF VALUE VALUE VALUE VALUE) - do (SELECTQ METHOD - (VALUE (* ; - "Give him the value straight from the looks") - (push NEWLOOKS PROP)) - (ONOFF (* ; "Translate T/NIL into ON/OFF") - (push NEWLOOKS (ONOFF PROP))) - (SHOULDNT)) - (push NEWLOOKS PROPNAME)) - (RETURN NEWLOOKS]) + join (LIST PROPNAME PROP]) (\TEDIT.PARSE.PARALOOKS.LIST - [LAMBDA (NEWLOOKS OLDLOOKS) (* ; + [LAMBDA (NEWLOOKS OLDLOOKS) (* ; "Edited 17-Oct-2023 12:08 by rmk") + (* ; "Edited 9-May-2023 13:20 by rmk") + (* ; "Edited 5-Sep-2022 15:39 by rmk") + (* ;  "Edited 3-Jul-93 21:49 by sybalskY:MV:ENVOS") (* ;  "Apply a given format spec to the paragraphs which are included in this guy.") - (PROG (D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC QUADD - NLOOKSAVE PC1 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) - (COND - ((type? FMTSPEC NEWLOOKS) (* ; + (if (type? FMTSPEC NEWLOOKS) + then (* ;  "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") - (RETURN NEWLOOKS)) - (T (* ; "create an FMTSPEC from the Alist") + NEWLOOKS + else (LET (1STLEFT LEFT RIGHT LEADB LEADA LLEAD TABSPECC 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") (SETQ 1STLEFT (LISTGET NEWLOOKS '1STLEFTMARGIN)) (SETQ LEFT (LISTGET NEWLOOKS 'LEFTMARGIN)) (SETQ RIGHT (LISTGET NEWLOOKS 'RIGHTMARGIN)) @@ -1528,7 +1742,7 @@ (PROGN (* ;  "We got an illegal QUAD value. Use LEFT.") (TEDIT.PROMPTPRINT (AND (BOUNDP 'TEXTOBJ) - TEXTOBJ) + (EVALV 'TEXTOBJ)) (CONCAT "Illegal paragraph quad " QUADD ", replaced with LEFT.") T) (SETQ QUADD 'LEFT] @@ -1570,507 +1784,234 @@ CONS pair of default width and LIST of TAB record instances") (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)) - (RETURN NEWLOOKS]) + NEWLOOKS]) (TEDIT.PARALOOKS - [LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* ; "Edited 21-Apr-93 18:44 by jds") + [LAMBDA (TEXTOBJ NEWLOOKS SEL LEN) (* ; "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") - (* ;; "Apply a given format spec to the paragraphs which are included in this guy.") + (* ;; "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.") - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (PROG ([SEL (COND - ((type? SELECTION SEL) - SEL) - ((FIXP SEL) - (TEDIT.SETSEL TEXTOBJ SEL LEN 'RIGHT)) - (T (fetch (TEXTOBJ SEL) of TEXTOBJ] - CH# CHLIM REPLACEALLFIELDS D PC PCNO NPC NCHLIM PCTB LASTLOOKS 1STLEFT LEFT RIGHT LEADB - LEADA BLEAD BLEADSET LLEAD TABSPECC QUADD NLOOKSAVE PC1 OLDLOOKSLIST TYPE SUBTYPE TYPESET - SUBTYPESET SPECIALX SPECIALY NEWBEFORESET NEWBEFORE NEWAFTERSET NEWAFTER KEEP KEEPSET - HEADINGKEEP BASETOBASE BASESET HCPYMODE HCPYSET USERINFO USERSET REVISED REVISEDSET STYLE - STYLESET CHARSTYLES CHARSTYLESSET COLUMN COLUMNSET STYLE STYLESET START-OF-PIECE OLDSTART) - (SETQ CH# (fetch (SELECTION CH#) of SEL)) (* ; "First affected character") - (SETQ CHLIM (IMIN (IMAX CH# (SUB1 (fetch (SELECTION CHLIM) of SEL))) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; "Last affected character.") - (COND - ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Can't change the para looks of something beyond end of text.") - (RETURN)) - ((NOT (fetch (SELECTION SET) of SEL)) (* ; - "Can't do anything if there is no selection set in the main document") - (RETURN))) - (COND - ((NOT (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ)) - (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (* ; - "Because it may grow during the conversion to formatted.") - (SETQ PC (\CHTOPC CH# PCTB T)) - (SETQ OLDSTART START-OF-PIECE) - (SETQ PC1 PC) - (SETQ NLOOKSAVE NEWLOOKS) - [COND - ((type? FMTSPEC NEWLOOKS) (* ; - "if we were given an FMTSPEC really replace the FMTSPEC of all pieces affected") - (SETQ D (create FMTSPEC copying NEWLOOKS)) (* ; - "Create the universal replacement looks") - (SETQ REPLACEALLFIELDS T) (* ; - "And set the replace-everything flag.") - ) - (T (* ; "create an FMTSPEC from the Alist") - (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)) - (* ; "Keep for headings") - (SETQ KEEP (LISTGET NEWLOOKS 'KEEP)) (* ; + (CL:UNLESS (type? SELECTION SEL) + (SETQ SEL (CL:IF (FIXP SEL) + (TEDIT.SETSEL TEXTOBJ SEL LEN 'RIGHT) + (FGETTOBJ TEXTOBJ SEL)))) + (CL:WHEN (AND (FGETSEL SEL SET) + (NOT (\TEDIT.READONLY TEXTOBJ))) + (LET (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) + [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 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] - (* ;; "change from the users list to the real tabspec --- CONS pair of default width and LIST of TAB record instances") + (* ;; "The new format specification has been decoded into the different variables. ") - (COND - (TABSPECC (SETQ TABSPECC (CONS [OR (COND - ((AND (CAR TABSPECC) - (ZEROP (CAR TABSPECC))) - 1) - (T (CAR TABSPECC))) - (CAR (fetch (FMTSPEC TABSPEC) - of (fetch (PIECE PPARALOOKS) - of PC] - (for SPEC in (CDR TABSPECC) - collect (create TAB - TABKIND _ (CDR SPEC) - TABX _ (CAR SPEC] - [COND - (REPLACEALLFIELDS + (* ;; "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.") - (* ;; "Given that we're replacing the FMTSPEC wholesale, let's uniquify it within this document OUTSIDE the loop.") + (SETQ PARAPIECES (\TEDIT.PARAPIECES SEL NIL TEXTOBJ)) - (SETQ D (\TEDIT.UNIQUIFY.PARALOOKS D TEXTOBJ] - (bind (NPC _ PC) while NPC do (SETQ OLDLOOKSLIST (NCONC1 OLDLOOKSLIST (fetch (PIECE - PPARALOOKS - ) - of NPC))) - [COND - (REPLACEALLFIELDS + (* ;; "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") - (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") + (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) - (replace (PIECE PPARALOOKS) of NPC with D)) - (T (* ; - "Only replacing part of the looks; create a new one, and smash it.") - (COND - [(NEQ (fetch (PIECE PPARALOOKS) of NPC) - LASTLOOKS) - (* ; - "only build a new FMTSPEC when they are different") - (SETQ LASTLOOKS (ffetch (PIECE PPARALOOKS) - of NPC)) - (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) - (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) - of NEWLOOKS with 1STLEFT)) - (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS - with LEFT)) - (AND RIGHT (freplace (FMTSPEC RIGHTMAR) - of NEWLOOKS with RIGHT)) - (AND LEADB (freplace (FMTSPEC LEADBEFORE) - of NEWLOOKS with LEADB)) - (AND LEADA (freplace (FMTSPEC LEADAFTER) - of NEWLOOKS with LEADA)) - (AND BLEADSET (freplace (FMTSPEC FMTBASETOBASE) - of NEWLOOKS with BLEAD)) - (AND LLEAD (freplace (FMTSPEC LINELEAD) - of NEWLOOKS with LLEAD)) - (AND TABSPECC (freplace (FMTSPEC TABSPEC) - of NEWLOOKS with TABSPECC)) - (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS - with QUADD)) - (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) - of NEWLOOKS with TYPE)) - (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) - of NEWLOOKS with SUBTYPE)) - (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) - of NEWLOOKS with SPECIALX)) - (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) - of NEWLOOKS with SPECIALY)) - (AND NEWBEFORESET (freplace (FMTSPEC - FMTNEWPAGEBEFORE - ) of NEWLOOKS - with NEWBEFORE)) - (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER - ) of NEWLOOKS - with NEWAFTER)) - [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) - of NEWLOOKS - with (EQ HEADINGKEEP - 'ON] - (AND KEEPSET (freplace (FMTSPEC FMTKEEP) - of NEWLOOKS with KEEP)) - (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) - of NEWLOOKS with BASETOBASE)) - (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) - of NEWLOOKS with HCPYMODE)) - (AND USERSET (freplace (FMTSPEC FMTUSERINFO) - of NEWLOOKS with USERINFO)) - (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) - of NEWLOOKS with REVISED)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) - of NEWLOOKS with STYLE)) - (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES - ) of NEWLOOKS - with CHARSTYLES)) - (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) - of NEWLOOKS with COLUMN)) - (AND STYLESET (replace (FMTSPEC FMTSTYLE) - of NEWLOOKS with STYLE)) - (freplace (PIECE PPARALOOKS) of NPC - with (SETQ NEWLOOKS (\TEDIT.UNIQUIFY.PARALOOKS - NEWLOOKS TEXTOBJ] - (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") - (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS - ] - [SETQ CHLIM (IMAX CHLIM (SETQ NCHLIM - (SETQ START-OF-PIECE - (IPLUS START-OF-PIECE - (fetch (PIECE PLEN) - of NPC] - (COND - ((fetch (PIECE PPARALAST) of NPC) - (* ; - "We've found the end of a paragraph. Stop to see if we've run off the end yet.") - (COND - ((IGEQ NCHLIM (SUB1 (fetch (SELECTION CHLIM) - of SEL))) - (RETURN))) (* ; "Make a new set of looks.") - )) - (SETQ NPC (fetch (PIECE NEXTPIECE) of NPC))) - (SETQ LASTLOOKS NIL) - [bind (NPC _ (fetch (PIECE PREVPIECE) of PC)) - while (AND NPC (NOT (fetch (PIECE PPARALAST) of NPC))) - do (SETQ OLDLOOKSLIST (CONS (fetch (PIECE PPARALOOKS) of NPC) - OLDLOOKSLIST)) - [COND - (REPLACEALLFIELDS + (* ;; "We need to instantiate new looks for this piece.") - (* ;; "We're replacing the whole paragraph format. Just smash the new one it; it has been uniquified (and recorded in the master list) already.") + (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 - (replace (PIECE PPARALOOKS) of NPC with D)) - (T (* ; - "Only replacing part of the looks; create a new one, and smash it.") - (COND - [(NEQ (fetch (PIECE PPARALOOKS) of NPC) - LASTLOOKS) (* ; - "only build a new FMTSPEC when they are different") - (SETQ LASTLOOKS (fetch (PIECE PPARALOOKS) of NPC)) - (SETQ NEWLOOKS (create FMTSPEC using LASTLOOKS)) - (AND 1STLEFT (freplace (FMTSPEC 1STLEFTMAR) of NEWLOOKS with 1STLEFT)) - (AND LEFT (freplace (FMTSPEC LEFTMAR) of NEWLOOKS with LEFT)) - (AND RIGHT (freplace (FMTSPEC RIGHTMAR) of NEWLOOKS with RIGHT)) - (AND LEADB (freplace (FMTSPEC LEADBEFORE) of NEWLOOKS with LEADB)) - (AND LEADA (freplace (FMTSPEC LEADAFTER) of NEWLOOKS with LEADA)) - (AND LLEAD (freplace (FMTSPEC LINELEAD) of NEWLOOKS with LLEAD)) - (AND TABSPECC (freplace (FMTSPEC TABSPEC) of NEWLOOKS with TABSPECC)) - (AND QUADD (freplace (FMTSPEC QUAD) of NEWLOOKS with QUADD)) - (AND TYPESET (freplace (FMTSPEC FMTPARATYPE) of NEWLOOKS with TYPE)) - (AND SUBTYPESET (freplace (FMTSPEC FMTPARASUBTYPE) of NEWLOOKS with SUBTYPE - )) - (AND SPECIALX (freplace (FMTSPEC FMTSPECIALX) of NEWLOOKS with SPECIALX)) - (AND SPECIALY (freplace (FMTSPEC FMTSPECIALY) of NEWLOOKS with SPECIALY)) - (AND NEWBEFORESET (freplace (FMTSPEC FMTNEWPAGEBEFORE) of NEWLOOKS - with NEWBEFORE)) - (AND NEWAFTERSET (freplace (FMTSPEC FMTNEWPAGEAFTER) of NEWLOOKS - with NEWAFTER)) - [AND HEADINGKEEP (freplace (FMTSPEC FMTHEADINGKEEP) of NEWLOOKS - with (EQ HEADINGKEEP 'ON] - (AND KEEPSET (freplace (FMTSPEC FMTKEEP) of NEWLOOKS with KEEP)) - (AND BASESET (freplace (FMTSPEC FMTBASETOBASE) of NEWLOOKS with BASETOBASE) - ) - (AND HCPYSET (freplace (FMTSPEC FMTHARDCOPY) of NEWLOOKS with HCPYMODE)) - (AND USERSET (freplace (FMTSPEC FMTUSERINFO) of NEWLOOKS with USERINFO)) - (AND REVISEDSET (freplace (FMTSPEC FMTREVISED) of NEWLOOKS with REVISED)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) - (AND CHARSTYLESSET (freplace (FMTSPEC FMTCHARSTYLES) of NEWLOOKS - with CHARSTYLES)) - (AND COLUMNSET (freplace (FMTSPEC FMTCOLUMN) of NEWLOOKS with COLUMN)) - (AND STYLESET (freplace (FMTSPEC FMTSTYLE) of NEWLOOKS with STYLE)) - (freplace (PIECE PPARALOOKS) of NPC with (SETQ NEWLOOKS ( - \TEDIT.UNIQUIFY.PARALOOKS - NEWLOOKS TEXTOBJ] - (T (* ; "Re-use the last set of looks; they're still what we want (this paragraph looks like the last one.)") - (freplace (PIECE PPARALOOKS) of NPC with NEWLOOKS] - (SETQ PC1 NPC) - (SETQ OLDSTART (IDIFFERENCE OLDSTART (fetch (PIECE PLEN) of PC1))) - (SETQ NPC (fetch (PIECE PREVPIECE) of NPC)) finally (SETQ CH# (IMIN CH# - (IMAX 1 OLDSTART] - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) (* ; + (* ;; "change from the users list to the real tabspec --- CONS pair of default width and LIST of TAB record instances") + + [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))) + (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))) + + (* ;; "Pieces have been updated. Now update any visible lines.") + + (CL:WHEN (FGETTOBJ TEXTOBJ \WINDOW) + (\SHOWSEL SEL NIL) (* ;  "Turn off the sel before updating the screen") - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 CHLIM)) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) (* ; "Mark the document as changed.") - (\TEDIT.HISTORYADD TEXTOBJ - (create TEDITHISTORYEVENT - THACTION _ 'ParaLooks - THLEN _ (IDIFFERENCE CHLIM CH#) - THCH# _ CH# - THFIRSTPIECE _ PC1 - THOLDINFO _ OLDLOOKSLIST - THAUXINFO _ NLOOKSAVE)) (* ; "Save this action for undo/redo") - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T]) + (\TEDIT.MARK.LINES.DIRTY TEXTOBJ PARAPIECES) + (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)) (* ; "Save this action for undo/redo") + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; + "Update the screen image, showing the original selection") + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T))))]) (TEDIT.COPY.PARALOOKS - [LAMBDA (STREAM SOURCE DEST) (* ; "Edited 30-May-91 21:44 by jds") + [LAMBDA (TSTREAM SOURCE DEST) (* ; "Edited 9-Feb-2024 11:39 by rmk") + (* ; "Edited 18-Apr-2023 23:53 by rmk") + (* ; "Edited 22-Oct-2022 15:29 by rmk") + (* ; "Edited 22-Aug-2022 13:15 by rmk") + (* ; "Edited 30-May-91 21:44 by jds") (* ;; "Copy the PARAGRAPH LOOKS from one place to another") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) + (PROG ((TEXTOBJ (TEXTOBJ TSTREAM)) LOOKS LEN) (* ;  "get the paragraph looks of the first character of SOURCE") - [SETQ LOOKS (fetch (PIECE PPARALOOKS) - of (CL:TYPECASE SOURCE - ((SMALLP FIXP) (\CHTOPC SOURCE (fetch (TEXTOBJ PCTB) of TEXTOBJ))) - (SELECTION - (\SHOWSEL SOURCE NIL NIL) (* ; - "Turn off the looks-source selection") - (\CHTOPC (fetch (SELECTION CH#) of SOURCE) - (fetch (TEXTOBJ PCTB) of (fetch (SELECTION \TEXTOBJ) - of SOURCE)))) - (T (\ILLEGAL.ARG SOURCE)))] + [SETQ LOOKS (PPARALOOKS (if (FIXP SOURCE) + then (\CHTOPC SOURCE TEXTOBJ) + elseif (type? SELECTION SOURCE) + then (\CHTOPC (fetch (SELECTION CH#) of SOURCE) + (fetch (SELECTION SELTEXTOBJ) of SOURCE)) + else (\ILLEGAL.ARG SOURCE] (COND - [(type? SELECTION DEST) (* ; + ((type? SELECTION DEST) (* ;  "make sure that the destination selection is in this document") - (COND - ((NEQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of DEST)) - (\LISPERROR "Destination selection is not in stream " STREAM] + (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]) -(\TEDIT.PUT.PARALOOKS - [LAMBDA (FILE PC PARAHASH) (* ; "Edited 30-May-91 21:44 by jds") - - (* ;; "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") - - (* ;; "NB: ANY CHANGE TO THE FORMAT THIS PUTS OUT NEEDS TO BE MIRRORED IN TEDIT.PUT.PCTB WHERE IT PUTS OUT THE DUMMY FINAL PARAGRAPH PIECE.") - - (PROG ((LOOKS (fetch (PIECE PPARALOOKS) of PC)) - DEFAULTTAB TABSPECS OUTPUTFORMAT) - (\DWOUT FILE 0) (* ; - "Place holder for number of characters in the piece -- really taken from the charlooks.") - (\SMALLPOUT FILE \PieceDescriptorPARA) (* ; - "Identify this as a paragraph looks piece") - (\SMALLPOUT FILE (GETHASH LOOKS PARAHASH]) - -(\TEDIT.CONVERT.TO.FORMATTED - [LAMBDA (TEXTOBJ START END) (* ; "Edited 29-Apr-93 19:47 by jds") - (* ; - "Turn an unformatted TEdit file into a formatted TEdit file.") - (PROG ((NEXTCR (\TEDIT.BASICFIND TEXTOBJ (MKSTRING (CHARACTER (CHARCODE CR))) - (OR START 1))) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - [CRSTRING (MKSTRING (CHARACTER (CHARCODE CR] - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - PCNO PC START-OF-PIECE) - [while (AND NEXTCR (ILEQ NEXTCR (OR END TEXTLEN))) - do (* ; - "Look at each CR in the range given (or whole file) and insert paragraph breaks accordingly.") - (SETQ PC (\CHTOPC NEXTCR (fetch (TEXTOBJ PCTB) of TEXTOBJ) - T)) - [COND - ((IEQP (ADD1 NEXTCR) - START-OF-PIECE) (* ; "This para ends on a piece bound.") - ) - (T (* ; - "The CR is in mid-piece. Split just after it.") - (\SPLITPIECE PC (- (ADD1 NEXTCR) - START-OF-PIECE) - TEXTOBJ PCNO) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ] - (replace (PIECE PPARALAST) of PC with T) - (SETQ NEXTCR (\TEDIT.BASICFIND TEXTOBJ CRSTRING (ADD1 NEXTCR] - (replace (TEXTOBJ FORMATTEDP) of TEXTOBJ with T) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ (OR START 1) - (OR END TEXTLEN]) - (\TEDIT.PARABOUNDS - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 21-Apr-93 18:22 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "Edited 26-Mar-2023 12:54 by rmk") + (* ; "Edited 20-Feb-2023 13:55 by rmk") + (* ; "Edited 25-Oct-2022 14:50 by rmk") + (* ; "Edited 22-Aug-2022 13:17 by rmk") + (* ; "Edited 21-Apr-93 18:22 by jds") - (* ;; "returns the first and last chars of the paragraph bracketed by CH#") + (* ;; "Returns the first and last character number of the paragraph that brackets CH#") - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PCNO NPC PC OPC BEGIN END PIECE START-OF-PIECE OLDSTART) - [COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* ; - "An empty document has no paragraphs.") - (RETURN (CONS 1 1] - (SETQ PC (\CHTOPC CH# PCTB T)) - [COND - ((ATOM PC) (* ; - "OOPS, we found the end-of-doc piece. Back up to the last real piece in the document.") - (SETQ PC (\CHTOPC (FETCH (TEXTOBJ TEXTLEN) OF TEXTOBJ) - PCTB T] - (SETQ PIECE PC) - (SETQ OPC PIECE) - (SETQ OLDSTART (IPLUS START-OF-PIECE (fetch (PIECE PLEN) of PC))) - (repeatwhile (AND PIECE (NOT (fetch (PIECE PPARALAST) of OPC))) - do (* ; - "Find the piece that ends the paragraph") - (SETQ OPC PIECE) - (add START-OF-PIECE (fetch (PIECE PLEN) of PIECE)) - (SETQ PIECE (fetch (PIECE NEXTPIECE) of PIECE))) - [SETQ END (COND - (PIECE (* ; - "This is the piece that ends the para. Get the CH# of its final character") - (SUB1 START-OF-PIECE)) - (T (* ; - "If PIECE winds up NIL, we walked off the end of the document, so use the textlen.") - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (bind (PIECE _ PC) repeatwhile (AND PIECE (NOT (fetch (PIECE PPARALAST) of PIECE))) - do (* ; - "Now find the piece that ends the previous paragraph") - (add OLDSTART (IMINUS (fetch (PIECE PLEN) of PIECE))) - (SETQ PIECE (fetch (PIECE PREVPIECE) of PIECE))) - (SETQ BEGIN OLDSTART) (* ; - "Actually, NPC is pointing at the piece that starts THIS para.") - (RETURN (CONS BEGIN END]) - -(\TEDIT.FORMATTABS - [LAMBDA (TEXTOBJ TABSPEC THISLINE CHBASE WBASE CURTX DFLTTABX MARGINXOFFSET PRIORTAB GRAIN - CLEANINGUP) (* ; "Edited 13-Nov-90 01:09 by jds") - (* ; "Do the formatting work for a tab.") - - (* ;; "PRIORTAB is the outstanding tab, if any, that has to be resolved. This will be a centered or flush right tab. its format is a PENDINGTAB") - - (* ;; "If CLEANINGUP is non-NIL, then we're at the end of the line, and only need to resolve the outstanding tab.") - - (* ;; "GRAIN is the granularity of the tab spacing; anything within GRAIN will slop over to the next tab. This is to finesse rounding problems when going among various devices.") - - (PROG (NEXTTAB NEXTTABTYPE NEXTTABX DEFAULTTAB TABWIDTH) - [COND - (PRIORTAB - - (* ;; "If there is a prior tab to resolve, do that first--it affects the perceived current X value, which affects later tabs") - - (SELECTQ (fetch PTTYPE of PRIORTAB) - ((CENTERED DOTTEDCENTERED) (* ; "Centered around the tab X") - [SETQ TABWIDTH (IMAX 3 (IDIFFERENCE (IDIFFERENCE - (fetch PTTABX of PRIORTAB) - (LRSH (IDIFFERENCE CURTX - (fetch PTOLDTX - of PRIORTAB)) - 1)) - (fetch PTOLDTX of PRIORTAB] - (\RPLPTR (fetch PTWBASE of PRIORTAB) - 0 TABWIDTH) - (add CURTX TABWIDTH)) - ((RIGHT DOTTEDRIGHT DECIMAL DOTTEDDECIMAL) - (* ; "Snug up against the tab X") - [SETQ TABWIDTH (IMAX 3 (IDIFFERENCE (IDIFFERENCE (fetch PTTABX - of PRIORTAB) - (IDIFFERENCE CURTX - (fetch PTOLDTX - of PRIORTAB))) - (fetch PTOLDTX of PRIORTAB] - (\RPLPTR (fetch PTWBASE of PRIORTAB) - 0 TABWIDTH) (* ; "Now we can fill in the real width") - (add CURTX TABWIDTH)) - (SHOULDNT] - (SETQ DEFAULTTAB (OR (CAR TABSPEC) - DFLTTABX)) (* ; - "Default Tab width, if there aren't any real tabs to use") - (SETQ NEXTTAB (for TAB in (CDR TABSPEC) when (IGREATERP (fetch TABX of TAB) - (IDIFFERENCE CURTX MARGINXOFFSET)) - do (RETURN TAB))) (* ; "The next tab on this line, if any") - (SETQ NEXTTABTYPE (OR (AND NEXTTAB (fetch TABKIND of NEXTTAB)) - 'LEFT)) (* ; - "The type of the next tab (LEFT, if we use the default spacing)") - (SETQ NEXTTABX (IPLUS [COND - (NEXTTAB (* ; - "There is a real tab to go to; use its location.") - (fetch TABX of NEXTTAB)) - (T (* ; - "No real tab; use the next multiple of the default spacing.") - (ITIMES DEFAULTTAB (IPLUS 1 (IQUOTIENT (IPLUS GRAIN - (IDIFFERENCE - CURTX - MARGINXOFFSET)) - DEFAULTTAB] - MARGINXOFFSET)) (* ; "The next tab's X value") - (COND - (CLEANINGUP (* ; - "We're cleaning up at end of line, so this shouldn't have any effect.") - (RETURN CURTX)) - (T (SELECTQ NEXTTABTYPE - ((DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL) - (* ; - "This is a dotted-leader tab. Change it to Meta-TAB, so the line displayer knows.") - (\RPLPTR CHBASE 0 (CHARCODE %#^I))) - NIL) - (SELECTQ NEXTTABTYPE - ((LEFT DOTTEDLEFT) (* ; "Flush LEFT TAB.") - (SETQ TABWIDTH (IMAX 1 (IDIFFERENCE NEXTTABX CURTX))) - (\RPLPTR WBASE 0 TABWIDTH) - (RETURN CURTX)) - ((CENTERED DOTTEDCENTERED) (* ; "Centered around the tab X") - (\RPLPTR WBASE 0 0) (* ; "For now, the TAB is 0 wide") - (RETURN (create PENDINGTAB - PTNEWTX _ CURTX - PTOLDTAB _ NEXTTAB - PTTYPE _ NEXTTABTYPE - PTTABX _ NEXTTABX - PTWBASE _ WBASE - PTOLDTX _ CURTX))) - ((RIGHT DOTTEDRIGHT DECIMAL DOTTEDDECIMAL) - (* ; "Snug up against the tab X") - (\RPLPTR WBASE 0 0) (* ; "For now, the TAB is 0 wide") - (RETURN (create PENDINGTAB - PTNEWTX _ CURTX - PTOLDTAB _ NEXTTAB - PTTYPE _ NEXTTABTYPE - PTTABX _ NEXTTABX - PTWBASE _ WBASE - PTOLDTX _ CURTX))) - (SHOULDNT]) + (if (ZEROP (TEXTLEN TEXTOBJ)) + then (* ; "Empty document") + (CONS 0 0) + else (LET (CHPIECE START-OF-PIECE START END) + (DECLARE (SPECVARS START-OF-PIECE)) + (SETQ CHPIECE (\CHTOPC (IMIN CH# (TEXTLEN TEXTOBJ)) + TEXTOBJ T)) + (SETQ START START-OF-PIECE) (* ; "Find the paragraph's first char") + [for PC backpieces (PREVPIECE CHPIECE) until (PPARALAST PC) + do (add START (IMINUS (PLEN PC] + (SETQ END (SUB1 START-OF-PIECE)) (* ; "Find the paragraph's last char") + (for PC inpieces CHPIECE do (add END (PLEN PC)) repeatuntil (PPARALAST PC)) + (CONS START END]) ) @@ -2080,7 +2021,9 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (TEDIT.SUBPARALOOKS - [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 26-Apr-93 15:13 by jds") + [LAMBDA (TEXTSTREAM OLDLOOKSLIST NEWLOOKSLIST) (* ; "Edited 18-Apr-2023 23:54 by rmk") + (* ; "Edited 22-Aug-2022 13:13 by rmk") + (* ; "Edited 26-Apr-93 15:13 by jds") (* ;;; "User entry to substitute one set of looks for another. Goes through the whole textstream and whenever the looks match the characteristics of OLDLOOKSLIST which are specified, the characteristics listed in NEWLOOKSLIST are substituted.") @@ -2088,11 +2031,10 @@ CONS pair of default width and LIST of TAB record instances") (NEWLOOKS (\TEDIT.PARSE.PARALOOKS.LIST NEWLOOKSLIST)) (TEXTOBJ (TEXTOBJ TEXTSTREAM)) (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (FIRSTPC (\CHTOPC 1 PCTB)) + (FIRSTPC (\CHTOPC 1 TEXTOBJ)) (FEATURELIST (for A on OLDLOOKSLIST by (CDDR A) collect (CAR A))) CHANGEMADE) - (\SHOWSEL SEL NIL NIL) (* ; "Turn off the selection, first.") + (\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 @@ -2112,7 +2054,7 @@ CONS pair of default width and LIST of TAB record instances") ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (TEDIT.UPDATE.SCREEN TEXTOBJ) (* ; "Update the screen image") (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) + (\SHOWSEL SEL T))) (COND (CHANGEMADE 'Done) (T 'NoChangesMade]) @@ -2163,86 +2105,64 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ -(TEDIT.REDO.LOOKS - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") - (* Set looks on the current selection - from the TEDIT.CHARLOOKS.WINDOW) - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (NEWLOOKS (fetch THAUXINFO of EVENT))) - (COND - ((fetch (SELECTION SET) of SEL) (* He's got something selected.) - (TEDIT.LOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.) - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T]) +(\TEDIT.UNDO.LOOKS + [LAMBDA (TEXTOBJ EVENT) (* ; "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") -(TEDIT.REDO.PARALOOKS - [LAMBDA (TEXTOBJ EVENT CH#) (* ; "Edited 30-May-91 21:42 by jds") - (* Re-set the looks on selected - paragraphs) - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (NEWLOOKS (fetch THAUXINFO of EVENT))) - (COND - ((fetch (SELECTION SET) of SEL) (* He's got something selected.) - (TEDIT.PARALOOKS TEXTOBJ NEWLOOKS SEL) (* Go perform a similar action again.) - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "Please select some text to modify first" T]) + (* ;; "The loop is controlled by the looks, since the pieces are still chained through the text.") -(TEDIT.UNDO.LOOKS - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") - (* Set looks on the current selection - from the TEDIT.CHARLOOKS.WINDOW) - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - CHLIM - (OLDLOOKSLIST (fetch THOLDINFO of EVENT)) - (NEWLOOKSLIST NIL) - (\INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ))) - (bind (PC _ (fetch THFIRSTPIECE of EVENT)) for OLDLOOKS in OLDLOOKSLIST - do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch (PIECE PLOOKS) of PC))) - (* Remember this for the undo.) - (replace (PIECE PLOOKS) of PC with OLDLOOKS) (* Give this piece its old looks) - [COND - ((EQ PC \INPC) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (fetch (PIECE PLOOKS) of PC] - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we - UNDO the UNDO.) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT) - (fetch THLEN of EVENT) - -1)) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (SETQ TEDIT.PENDINGDEL NIL) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T]) + (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) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T)) + (\TEDIT.HISTORYADD TEXTOBJ EVENT]) -(TEDIT.UNDO.PARALOOKS - [LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 30-May-91 21:44 by jds") - (* Set looks on the current selection - from the TEDIT.CHARLOOKS.WINDOW) - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - CHLIM - (OLDLOOKSLIST (fetch THOLDINFO of EVENT)) - (NEWLOOKSLIST NIL)) - (bind (PC _ (fetch THFIRSTPIECE of EVENT)) for OLDLOOKS in OLDLOOKSLIST - do (SETQ NEWLOOKSLIST (NCONC1 NEWLOOKSLIST (fetch (PIECE PPARALOOKS) of PC))) - (* Remember this for the undo.) - (replace (PIECE PPARALOOKS) of PC with OLDLOOKS) - (* Give this piece its old looks) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (replace THOLDINFO of EVENT with NEWLOOKSLIST) (* Remember the other looks in case we - UNDO the UNDO.) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (IPLUS (fetch THCH# of EVENT) - (fetch THLEN of EVENT) - -1)) - (TEDIT.UPDATE.SCREEN TEXTOBJ) - (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) - (SETQ TEDIT.PENDINGDEL NIL) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T]) +(\TEDIT.UNDO.PARALOOKS + [LAMBDA (TEXTOBJ EVENT) (* ; "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) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T)) + (\TEDIT.HISTORYADD TEXTOBJ EVENT]) ) @@ -2252,13 +2172,14 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (\TEDIT.MARK.REVISION - [LAMBDA (TEXTOBJ FMTSPEC IMAGESTREAM LINE) (* ; "Edited 30-May-91 21:38 by jds") + [LAMBDA (TEXTOBJ FMTSPEC IMAGESTREAM LINE) (* ; "Edited 27-May-2023 12:12 by rmk") + (* ; "Edited 30-May-91 21:38 by jds") (LET ((SCALE (DSPSCALE NIL IMAGESTREAM))) - (BLTSHADE BLACKSHADE IMAGESTREAM (+ (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (FIXR (CL:* 12 SCALE))) - (fetch (LINEDESCRIPTOR YBOT) of LINE) + (BLTSHADE BLACKSHADE IMAGESTREAM (IPLUS (GETLD LINE RIGHTMARGIN LINE) + (FIXR (ITIMES 12 SCALE))) + (GETLD LINE YBOT) (FIXR SCALE) - (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) + (GETLD LINE LHEIGHT) 'PAINT]) ) @@ -2269,7 +2190,7 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (\CREATE.TEDIT.DEFAULT.FMTSPEC - [LAMBDA NIL + [LAMBDA NIL (* ; "Edited 24-Aug-2023 23:31 by rmk") (create FMTSPEC QUAD _ 'LEFT 1STLEFTMAR _ 0 @@ -2278,7 +2199,9 @@ CONS pair of default width and LIST of TAB record instances") LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _ 0 - TABSPEC _ (CONS NIL NIL]) + FMTSPECIALX _ 0 + FMTSPECIALY _ 0 + TABSPEC _ (CONS DEFAULTTAB NIL]) (\CREATE.TEDIT.FACE.MENU [LAMBDA NIL @@ -2303,89 +2226,93 @@ CONS pair of default width and LIST of TAB record instances") (DEFINEQ (\TEDIT.APPLY.STYLES - [LAMBDA (LOOKS PC TEXTOBJ) (* ; + [LAMBDA (LOOKS PC TSTREAM) (* ; "Edited 12-Nov-2023 16:08 by rmk") + (* ; "Edited 18-Mar-2023 21:45 by rmk") + (* ; "Edited 25-Sep-2022 13:28 by rmk") + (* ; "Edited 11-Sep-2022 14:45 by rmk") + (* ;  "Edited 4-Jul-93 01:02 by sybalskY:MV:ENVOS") (* ;; "Given a set of looks, return the looks with the proper styles expanded out.") - (\TEDIT.CHECK (type? CHARLOOKS LOOKS)) (* ; "Incoming thing has to be a LOOKS.") + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) (OR (CDR (ASSOC LOOKS *TEDIT-CURRENTPARA-CACHE*)) (CDR (ASSOC LOOKS *TEDIT-PARASTYLE-CACHE*)) - (LET ((STYLE (fetch (CHARLOOKS CLSTYLE) of LOOKS)) - (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ) - TEDIT.STYLES)) - (NOSTYLE) - CHARSTYLES CHARSTYLE IN-PARA FMTSPEC) - (SETQ STYLE (COND - ((NULL STYLE) (* ; + (LET* ((TEXTOBJ (TEXTOBJ TSTREAM)) + (STYLE (fetch (CHARLOOKS CLSTYLE) of LOOKS)) + (STYLE-SHEET (OR (FGETTOBJ TEXTOBJ TXTSTYLESHEET) + TEDIT.STYLES)) + NOSTYLE CHARSTYLES CHARSTYLE IN-PARA FMTSPEC) + (SETQ STYLE (COND + ((NULL STYLE) (* ;  "STYLE of NIL means don't bother. Just use the looks we got.") - (SETQ NOSTYLE T) - LOOKS) - ((AND [SETQ CHARSTYLES (AND (fetch (TEXTSTREAM CURRENTPARALOOKS) - of (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ)) - (fetch (FMTSPEC FMTCHARSTYLES) - of (fetch (TEXTSTREAM CURRENTPARALOOKS) - of (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ] - (SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES))) + (SETQ NOSTYLE T) + LOOKS) + ((AND [SETQ CHARSTYLES (AND (fetch (TEXTSTREAM CURRENTPARALOOKS) + of TSTREAM) + (fetch (FMTSPEC FMTCHARSTYLES) + of (fetch (TEXTSTREAM CURRENTPARALOOKS) + of TSTREAM] + (SETQ CHARSTYLE (FASSOC STYLE CHARSTYLES))) (* ;  "If the paragraph we're in has character styles, and this is one of them, use it.") - (SETQ IN-PARA T) - CHARSTYLE) - ((CDR (SASSOC STYLE STYLE-SHEET))) - ((AND (LITATOM STYLE) - (DEFINEDP STYLE)) (* ; + (SETQ IN-PARA T) + CHARSTYLE) + ((CDR (SASSOC STYLE STYLE-SHEET))) + ((AND (LITATOM STYLE) + (DEFINEDP STYLE)) (* ;  "Call the guy's function to find the new looks") - (APPLY* STYLE LOOKS PC TEXTOBJ)) - (T (* ; + (APPLY* STYLE LOOKS PC TEXTOBJ)) + (T (* ;  "If all else fails, return the original set of looks") - (SETQ NOSTYLE T) - LOOKS))) - (SETQ STYLE (COND - ((LISTP STYLE) - (\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL)) - LOOKS)) - (T STYLE))) + (SETQ NOSTYLE T) + LOOKS))) + (SETQ STYLE (COND + ((LISTP STYLE) + (\TEDIT.PARSE.CHARLOOKS.LIST (APPEND STYLE '(STYLE NIL)) + LOOKS TEXTOBJ)) + (T STYLE))) - (* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.") + (* ;; "Cache the looks->styled-looks mapping, either in the cache for this kind of paragraph (which gets wiped when we hit a new para type), or in the global cache.") - [OR NOSTYLE (CL:IF IN-PARA - (push *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE)) - (push *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))] - STYLE]) + [OR NOSTYLE (CL:IF IN-PARA + (push *TEDIT-CURRENTPARA-CACHE* (CONS LOOKS STYLE)) + (push *TEDIT-PARASTYLE-CACHE* (CONS LOOKS STYLE)))] + STYLE]) (\TEDIT.APPLY.PARASTYLES - [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; + [LAMBDA (PARALOOKS PC TEXTOBJ) (* ; "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") (* ;; "Given a set of looks, return the looks with the proper styles expanded out.") (\TEDIT.CHECK (type? FMTSPEC PARALOOKS)) (* ; "Incoming thing has to be a LOOKS.") (OR (CDR (ASSOC PARALOOKS *TEDIT-PARASTYLE-CACHE*)) - (LET* [(NOSTYLE) - (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ) - TEDIT.STYLES)) - (STYLE (COND - ((NULL (fetch (FMTSPEC FMTSTYLE) of PARALOOKS)) - (SETQ NOSTYLE T) - PARALOOKS) - ((CDR (SASSOC (fetch (FMTSPEC FMTSTYLE) of PARALOOKS) - STYLE-SHEET))) - ((AND (LITATOM (fetch (FMTSPEC FMTSTYLE) of PARALOOKS)) - (DEFINEDP (fetch (FMTSPEC FMTSTYLE) of PARALOOKS))) + (LET* [NOSTYLE (STYLE-SHEET (OR (fetch (TEXTOBJ TXTSTYLESHEET) of TEXTOBJ) + TEDIT.STYLES)) + (STYLE (COND + ((NULL (fetch (FMTSPEC FMTSTYLE) of PARALOOKS)) + (SETQ NOSTYLE T) + PARALOOKS) + ((CDR (SASSOC (fetch (FMTSPEC FMTSTYLE) of PARALOOKS) + STYLE-SHEET))) + ((AND (LITATOM (fetch (FMTSPEC FMTSTYLE) of PARALOOKS)) + (DEFINEDP (fetch (FMTSPEC FMTSTYLE) of PARALOOKS))) (* ;  "Call the guy's function to find the new looks") - (APPLY* (fetch (FMTSPEC FMTSTYLE) of PARALOOKS) - PARALOOKS PC TEXTOBJ)) - (T (SETQ NOSTYLE T) - PARALOOKS] + (APPLY* (fetch (FMTSPEC FMTSTYLE) of PARALOOKS) + PARALOOKS PC TEXTOBJ)) + (T (SETQ NOSTYLE T) + PARALOOKS] (SETQ STYLE (COND ((LISTP STYLE) (\TEDIT.PARSE.PARALOOKS.LIST (APPEND STYLE '(STYLE NIL)) PARALOOKS)) (T STYLE))) - (OR NOSTYLE (push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE))) + (CL:UNLESS NOSTYLE + (push *TEDIT-PARASTYLE-CACHE* (CONS PARALOOKS STYLE))) STYLE]) (TEDIT.STYLESHEET @@ -2462,31 +2389,46 @@ CONS pair of default width and LIST of TAB record instances") ) +(RPAQ? TEDIT.STYLES ) + + + +(* ;; "RMK 2023: Maybe this should be one of the later ones? Only partly implemented") + +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.STYLES) +) + (RPAQ? *TEDIT-PARASTYLE-CACHE* ) (RPAQ? *TEDIT-CURRENTPARA-CACHE* ) (RPAQ? *TEDIT-STYLESHEET-SAVE-LIST* ) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *TEDIT-PARASTYLE-CACHE* *TEDIT-CURRENTPARA-CACHE* *TEDIT-STYLESHEET-SAVE-LIST*) +) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8377 56776 (CHARLOOKS.FROM.FONT 8387 . 9892) (EQCLOOKS 9894 . 12309) (SAMECLOOKS 12311 - . 16155) (\TEDIT.UNIQUIFY.CHARLOOKS 16157 . 16712) (TEDIT.CARETLOOKS 16714 . 18316) (TEDIT.COPY.LOOKS - 18318 . 20588) (\TEDIT.GET.CHARLOOKS 20590 . 23319) (\TEDIT.UNPARSE.CHARLOOKS.LIST 23321 . 26046) ( -TEDIT.MODIFYLOOKS 26048 . 27868) (TEDIT.NEW.FONT 27870 . 28290) (\TEDIT.PUT.CHARLOOKS 28292 . 30027) ( -\TEDIT.CARETLOOKS.VERIFY 30029 . 31104) (\TEDIT.GET.INSERT.CHARLOOKS 31106 . 34560) ( -\TEDIT.GET.TERMSA.WIDTHS 34562 . 34978) (\TEDIT.LOOKS.UPDATE 34980 . 46131) ( -\TEDIT.PARSE.CHARLOOKS.LIST 46133 . 54180) (\TEDIT.FLUSH.UNUSED.LOOKS 54182 . 56774)) (56824 59209 ( -TEDIT.SUBLOOKS 56834 . 59207)) (59210 86410 (\TEDIT.CHANGE.LOOKS 59220 . 77134) (TEDIT.LOOKS 77136 . -78970) (\TEDIT.LOOKS 78972 . 82154) (\TEDIT.FONTCOPY 82156 . 83522) (TEDIT.GET.LOOKS 83524 . 86408)) ( -86453 139794 (\TEDIT.GET.PARALOOKS 86463 . 86947) (EQFMTSPEC 86949 . 90450) (\TEDIT.UNIQUIFY.PARALOOKS - 90452 . 91017) (TEDIT.GET.PARALOOKS 91019 . 92339) (\TEDIT.UNPARSE.PARALOOKS.LIST 92341 . 95532) ( -\TEDIT.PARSE.PARALOOKS.LIST 95534 . 103137) (TEDIT.PARALOOKS 103139 . 125355) (TEDIT.COPY.PARALOOKS -125357 . 127186) (\TEDIT.PUT.PARALOOKS 127188 . 128086) (\TEDIT.CONVERT.TO.FORMATTED 128088 . 130018) -(\TEDIT.PARABOUNDS 130020 . 132703) (\TEDIT.FORMATTABS 132705 . 139792)) (139854 145740 ( -TEDIT.SUBPARALOOKS 139864 . 142341) (SAMEPARALOOKS 142343 . 145738)) (145783 151119 (TEDIT.REDO.LOOKS -145793 . 146574) (TEDIT.REDO.PARALOOKS 146576 . 147334) (TEDIT.UNDO.LOOKS 147336 . 149393) ( -TEDIT.UNDO.PARALOOKS 149395 . 151117)) (151158 151696 (\TEDIT.MARK.REVISION 151168 . 151694)) (151758 -152427 (\CREATE.TEDIT.DEFAULT.FMTSPEC 151768 . 152049) (\CREATE.TEDIT.FACE.MENU 152051 . 152223) ( -\CREATE.TEDIT.SIZE.MENU 152225 . 152425)) (152464 160866 (\TEDIT.APPLY.STYLES 152474 . 155842) ( -\TEDIT.APPLY.PARASTYLES 155844 . 157740) (TEDIT.STYLESHEET 157742 . 158809) (TEDIT.POP.STYLESHEET -158811 . 159479) (TEDIT.PUSH.STYLESHEET 159481 . 160221) (TEDIT.ADD.STYLESHEET 160223 . 160864))))) + (FILEMAP (NIL (21037 22798 (\TEDIT.CHARLOOKS.DEFPRINT 21047 . 22178) (\TEDIT.FMTSPEC.DEFPRINT 22180 . +22796)) (23908 50243 (CHARLOOKS.FROM.FONT 23918 . 25286) (EQCLOOKS 25288 . 28339) (SAMECLOOKS 28341 . +32493) (TEDIT.CARETLOOKS 32495 . 33537) (TEDIT.COPY.LOOKS 33539 . 35524) ( +\TEDIT.UNPARSE.CHARLOOKS.LIST 35526 . 38129) (TEDIT.MODIFYLOOKS 38131 . 40124) (TEDIT.NEW.FONT 40126 + . 40546) (\TEDIT.CARETLOOKS.VERIFY 40548 . 41385) (\TEDIT.CARETPIECE 41387 . 41577) ( +\TEDIT.GET.INSERT.CHARLOOKS 41579 . 43091) (\TEDIT.GET.TERMSA.WIDTHS 43093 . 43509) ( +\TEDIT.PARSE.CHARLOOKS.LIST 43511 . 50241)) (50244 64418 (\TEDIT.TRANSLATE.ASCIICHARS 50254 . 60265) ( +\TEDIT.CONVERT.TO.FORMATTED 60267 . 64416)) (65608 72323 (\TEDIT.UNIQUIFY.CHARLOOKS 65618 . 67162) ( +\TEDIT.UNIQUIFY.PARALOOKS 67164 . 68315) (\TEDIT.UNIQUIFY.ALL 68317 . 70019) ( +\TEDIT.FLUSH.UNUSED.LOOKS 70021 . 72321)) (72371 77760 (TEDIT.SUBLOOKS 72381 . 75285) (TEDIT.FINDLOOKS + 75287 . 77758)) (77761 98634 (\TEDIT.CHANGE.LOOKS 77771 . 90595) (TEDIT.LOOKS 90597 . 92444) ( +\TEDIT.LOOKS 92446 . 95344) (\TEDIT.FONTCOPY 95346 . 96544) (TEDIT.GET.LOOKS 96546 . 98632)) (98677 +130558 (EQFMTSPEC 98687 . 102188) (TEDIT.GET.PARALOOKS 102190 . 105819) (\TEDIT.PARSE.PARALOOKS.LIST +105821 . 113739) (TEDIT.PARALOOKS 113741 . 127047) (TEDIT.COPY.PARALOOKS 127049 . 129007) ( +\TEDIT.PARABOUNDS 129009 . 130556)) (130618 136661 (TEDIT.SUBPARALOOKS 130628 . 133262) (SAMEPARALOOKS + 133264 . 136659)) (136704 140615 (\TEDIT.UNDO.LOOKS 136714 . 138876) (\TEDIT.UNDO.PARALOOKS 138878 . +140613)) (140654 141232 (\TEDIT.MARK.REVISION 140664 . 141230)) (141294 142119 ( +\CREATE.TEDIT.DEFAULT.FMTSPEC 141304 . 141741) (\CREATE.TEDIT.FACE.MENU 141743 . 141915) ( +\CREATE.TEDIT.SIZE.MENU 141917 . 142117)) (142156 151061 (\TEDIT.APPLY.STYLES 142166 . 145731) ( +\TEDIT.APPLY.PARASTYLES 145733 . 147935) (TEDIT.STYLESHEET 147937 . 149004) (TEDIT.POP.STYLESHEET +149006 . 149674) (TEDIT.PUSH.STYLESHEET 149676 . 150416) (TEDIT.ADD.STYLESHEET 150418 . 151059))))) STOP diff --git a/library/tedit/TEDIT-LOOKS.LCOM b/library/tedit/TEDIT-LOOKS.LCOM index 43129dcaddf9ec914ee129f578a60733646c911c..1329d460f2bfc9759cb7aa1b3a53bfcaf60f5156 100644 GIT binary patch literal 42540 zcmdUYdvILWdEa6IQ8Y}!0EEyK#L(9;Nr4CfVIO!9R+L=;3+@7oy$~K0A<=?BE-1VR zFaRh;c{H}_Op-RK$BN}djy5Cb!EmxS%Oy+Y_6K&q9$xM29Iz5=LNFGd2WxQDTx%&Ecs$mGlrZdA{o0seypWo<= zcgK@nJU-CVJ&^2e^V-|4t>3u0w7O9A*4I$zryd{A4CgbmKl8}y($$UmjprZTS|~1U zJ&G!F)17(WADim>WIT4^oL662V=Ok%6KnIXZYCwhCl0UnmYS#RUUidR1%9h~Z%_PzFz!qnfg-&MPf0Uwx{%v{R(GgF7k4_ z;dOg?f5^*u39sNwDDDkSBqC5>3rf$u38iI6-4|IewLsUgF@Vb04M`o)~(uxczZX$=1jt%8yb0 zd*8iOXtA|1(jH5q-F{&xJ&mQ(V}cjr+=<6#(s{2h;pIDrXf5^hn*1K>JqW4qf@cTK z0~G|3MAC`GVnGCNd9g&V*Y-1Qcy@bj19-+0UfaWX#*qF~L-{uELciD6=Joe^ZR3+| zUQf(x!z0;)b>HU2kvEP<+-n;IH7k*fj89KZWQMvbr_M}NXj-%|CT6B45{b&hG}T0^ zjF=8}EFuGPGQXhqk}l3|BJYP0b8~EOLd5o*BE|K2MwB^(1XDkuX6T zsJOXj>Zf__fx0{BVk9sYh=TZb&Vw_BkJZv!WGnI ziR8L3c+`f8Nq@rYj|br%jEG53Vn|Fl5%aF(^7+igbiOM+dC|kZ&3PE1Sa;H!$~}?s z`Y(97>2y9f$1mcM;qe2+$j{}<;`WVBVc)RFm}$X$w!Hdcx9I(X?-?DYf|a`z1kOcYGT>k z{_WxHAJSOfp#(1%gj=%mLexCJPemd>$nt)Xh&mg87eJLN&W_swGw$s@;^zvUZ=_O+`sdaNYZ-cxqs&wd`jz-=l-2()Q4S* zKf}-cJLy#UNV}MkEY8<_wSs-Rw=7i92< z^69CmnF5#|HlY3&ehbkg~rM?ba7M-e>tp z?t^}!=8r$vCu+X(!9TIApE$0)IHG+$vcFSPu+@EB2gOjYa7H0z6g;Dqcv6WWW+|l< zy%Tx2N_9fVS{+CBcOw6`qB`cS4ey(^7C5V$Fz02c(gkC==Qv= z?E&p;Nk&3Re_J-r{oVHWGu_|+oWt;WTlm^yV>Wtu=LcViwD-pPz0BmKKk4-nbqi1L z?Up6Ldu@-q*~WWhF>y{j;cUHe?5TF|jrI3B5g>pdM;8=VK-j_NfNk5byQk9*tb01v zSKWf@n@#JWC+9Dv=_%t`FJLGF^eF;ic>HVw;6G_mGM}Q$%tLJ;7#TI z2?$%jjlsJyG(gjVW1MsVMNJ2=%UqsF7p8K4!Ha?CJEhQZCok>}CgDUU5A(_x;DXz7 z&^jlECbqX%5*ZT+7H~U-sa1#ojO8?i5CxS6)q1_%Kw;j}rZ>Ol-CA2&TYqlNyS^~L zb!%h6TfgpITb$pRzqYlo;jON(uWWXC-tfZK0uqWI#I=C40IsPhn4Zi`hfqg1B*M$n z{@^Hc8Ob8BAz}rPTL*&;UjM{tc*n`66+9%fj6fN%&9)?SV5Ny3D}ULKb%9KCBeNb> zi~?w8u_T$Q3#985^LRjY90J1q zwWAOhnz}`dRAzNlpY_TD2@!sS+2UvU??ImS{!mAn=k8kkIWXA-`VZt_T=_z zmtR>Pedl(^=ypfVTtjKxZz!N5Zs&LN(eI2!U)_FnIrq-)zvA-Sf3iIKcD9wo_(Wg7 zccnl~KMuiIkgjm{m;(S}E*fyb0N8=UnG+ZKSY8$0kN~N>ydnYN-R=@z9A!Z|c*Z=C zcASJ>vxPuXO-g2OKW73AIGNb|`AvxR^k#^!#-S15?K_UG-g$>$h6r&ns0e}#;yhFt z!4*^%3+?)`-V2fmk&rU6`#WzY@dmvKBte;RSEWIU3C;x9rOa-(F~BbY6AED%Kp0_g zVF+`D(w+_b-mFy#1c9kVJ6%T=2?j?SFXB zcW86G-M;qjyMy+<550{>>1XS?X`-1cWrwBFSlMx)=5b6DG^ueg>%si=R5m>ftOecM zWF|j6nSLBuF~DOj6$5s0GN5eHjJ{qcy{F$KgRq9DCT1u6soXTPDvDkbX(FF&kyB=icUp=| z`@fTD-21TX;@GkIKYr_@RP@eKQRQGdu{F$yHWhoW*|7n2H4&&<;n;Y34Au|eC*suD z#08pM%uMGB6EoB348}mx#tQ!91@6xjX*?dAfn4DMNgT+fZ38OQ!u$<}s@K=owgx;0 zI1C*?hgJ_J3zXE}Txg_#r5W==Kp_~pKE|g!7(509Qtx~yom!1%KhiK;RDH$ErBpe& z_mNaN)woxiPH{;L5cWo^_Rl>wgH0s>GBget0s0a#H}nUp!C}Af5CPSo^&%pvJhA*^G2`}LSdbr$xjoxW1Cy9tBFKY>d7IW`>zLaZ*YIY_2 z&eyV^UTKz=HZ|3b?tK#Dw|8`!N%6@d?_i8vZnr*-o<+vEmg4doM?5Ha--tGrUQJ0_ zWBJ(jpFqt9@G4yl#?QzG*kKA{HH(vq+Ab?cy$rp987f1L!BDkB<~*org?b{W%AF`0 zOBnUWr_x=I=Z2@VQ;zjTaH%HKNYZfWP|_P1xp8zpx>h65Zn?;~zUkx9)pwU)`Sxh; zuRfn`%#Ie*DP{&uwfBrE^N{Ci9S>Cgtv?z6=|maAUBidFjc?G>L|g;yE}0ZGs5_2#lxmc_LLyGgSpGr5UKUnT=1uzBQcj(QP0Q zEHmydB5@NTTLG9k}7X$r4>|uscm_X#7PzjKc8xp75_zfG&b!w zG<~mCRB;cHr>z{9Jojb2)j)$&DYCfC_^!}v2_Jls?PMCnHeeR@x;+uZ! z*NeN|{)w+}<^Bn+$8XhyR+DgY_W>z#^5;k8o1>bQzI|e__$%d9@mv0RCS7j!)o6*! zkEuu;;TY$?B`@aonoXX6UO>iNmp1ZK`h3bXy1@h*O`zKZnoYnnfff@uWdg@dpv?qM zb9+)J=gyjx4wKT(`<3i^MZb#-Qu&s;lHV0{fkXRq@lw%`e}3iD%Vc<}lAlC=Qt~6E ztC8{DkIKF{F7I;=w!^~iM+GDnoOEoEe#7nw$?zMToI0=MH`<&=H>bPgH`|%SZgYGjo|=s;74T@RA30&9@ZP$ z(j>E0;}LNvrtKRLbNB_?xvCY$uEY7*F#FIhTLfl3=LN5iY|&QE>_*r(|B+wn3G?N%b74nj3Q57DW?8Z)O7()U~K8QfC zC4ysu^s_8NCh!TDDI`cxW_=KL;K|H*h7`|00A$2AN&#XMfdZM70#+#W5)eTG88dz?@u~P@;G$2!T7{MrlKFfkUGi0gPa_LE|`rAG0aLJ z0>=W?GmPmvgfZw#oFc?IMVk#~W{Pwx6M~k5>JNs6M18V91C8^OtSV|{HdGDnSs$Saql5d z*A6%BE92gYp0Ak|02h_L^Y%w`8fQLo{H5I9A1!T{VI153UbF_vvuMq0@>O@!HedqR{`sew33QOj? z_HUQ{?%y7jO6R&uDZktAca)>7Hv*x>@vFgkrAjekxTQBSLAaeb7(R&|UPC(w8Jprk|9T zBmAo0i{bO*G7_iIyi?RXzZV1O$GNh3TyQUJ|04)_5>85%i(T041O%u53&KGNf$`+3L@n;Z3%a+?6^DGvk99 z=-#00a{CN-RPV~j6B%->ig$zYq0yu#JhWZ0o`i=9^oMkNCnY$4hItuO`;dNN zWBY*4f{E{gEujju>4S!-`qvl+>eu?9Qwyr^-$cW7_=UPUH{Mzp(91ph0@$}?a7imGJx`uO;(~zRz#c^dA$agx! zOJWKpWtj7Tg-w(;Bi4FmGGl`|7@{DmT!FXaMX0`I6~zFExd>D-q&A+Io`lK<6lRRn z@ZLDMNs>XU@~uG3dprjh^vAoVbJH+0(cULp3uwb#{Z_A4WoNURP;%IwPUrF&@ zm|h4Waw^eEpvPedOL@@hJyu7E@J@FcU@%sjovqzFF8Ygaz*1VD$Jj<(w`^mx z0JPsQ-;ko)f%K7YVY%1Ha$m$uF#uU?x!lyKj>g;loOGH0st?OCSyzB{>fFMaVTwT!^n-c42)u>#;^@5!>lsFG02;h zxxt=GJMiJT!OE&qF>wP~pf)q87o_MgU(g`gu+2opU_rKFAOaf(BC%oU1A=fcvyf*^ zG6+Jp5@@|8fGtG=So<1)+ZtO^z~Ib#Rf%IHKQoo>nkhi-FdX&?>bJf?sEbv`Fy)!$ z!v-eHQNx7v*MP7}NM)s?@@1Ti$o^8XhUa;icJpZM-e2Z|ly*sJYE)06?bBTJNfrBe ziytcsEM9p7rN=;7|4}I`+mt>Er;P{4n+@USB;`lPo1bX8Jla?@CvU#qK=$C1zQnj4 zej|j%!rpy;!(!`G5I?VM|GwXF_OM}WRS0OWsXjt|5M zLCNt4a0VASki|8iqL{m*0kfGI1QD3mfs=yrfTflYOo6atT*B57rUD^ksEb4gpt}QL zK6o1K{H)5u38-Nr4*s3B;)p^n?aQ9IjOz!MX>dR)E(?e%M3;sweni?2`N% z@fK536Qr~N7q~Vx+!uJ7!Bkm}&Mre7iu|A4J+&{3_dR0&GrcIDb%XkB>aI(Fu2}QR z*xtRPi>+5aGkW&bD5&p$<(pTEO+ClN;=5P3eUm9}t_3=Qmhv&bff2~=w152ek1RpA zkS({)omdp4k`16uR-p}!R{+}hEray3G(f!IXmj)%i%355rhpm*kM4D3%gwtF%EwFo z2`P(!RtGik53}?tq>5Jgja&tE4Lk2XEm@3LzzMEQW&Ou##zd~jU6wG79@#`^Cg}84 z*Az5_@bV)M9NoYU03341Iec>?_Z-cwY8oRV*8C76q0>XQiFBwW@UEnj0?vA&lQVbw z0;Hb1Wz$foROOO+9LmJP`q1M1+A|BA?h)w<8JQUMgK3+A^%3+83BU=Cj>P4N#6 zs!u1>Fy*7g+dta8cgb%6G5QUXG1m+-Z}uDcQ+{Ll$XkB%+f1gS?@>y}DzX&K>#V?Q z;`X=vmc8Fw+WuC#e*1U)2CR=d)q#k2UHO=l+x_#V#(KYD=iPq*qz(w^P!iF;6OF;^ zOQx|vvQQqnUpAb>^UN5Bfxu~@#7L@F4ML0*CngN-zd_{?kMBl!P=Fi4BL?7}fr3Ur znqkcC1kfu|Ld0sBIXUbo6NhemlAXRuZEoCCU4#o>5S&vr*cK*`{4i*feYT+K4aiWp zX~?D6ft?b{>G2hD#vry&CITzqAPRdh35%WnNT;+8X+4420Cxe^}I2PCycQG z$!L*d96=5sKq-phm>yVlA3bqYWLmp%xozwxP2&bi#&C+fb_wowT7g z8#-k}o(-KByLtNLT$fFY+qCXdPOR@aza4%6?Irl#_^rR~pZpCNai<)!z2y2Q)sBBs zi=)&dJT!jW_IVz_+kY@B&sXF`F7tok(Tj~^^06^}JO4#~H~-82sXL;emAd3(i%^Xm ziW>%b+nno_UDEGunmpsHI1~XiIV;d)uw)XWbE76)@&`%t8+kd)D)5hq*B125>P>%a zt{;l$e%K;3;mF(o5(dZ)-OKfsBXf@+bq-dwiW}WEwl)(@bT9ho< zQMix$U*CyNQ@Z(voGaUj&XteNWlR2upIsDgG&fR8zvK_5cWVAdRQAd~hS3jy7+`61 zZ@^daGUA`wJ>$2_D4H~m@z?!RZz-T^7r-^wK`N@~34fUT<#%8dY&dvNT5KH?OyTMU zBBk+NQ{e%}1e0;lGvNXA-GiRp2st%1Z{$lfv^2x)^9pyC(1l zhE^P7Cv_k=3DngJ5e(iYY!L^Gk+%c4J#ZOVy-i_bp9#dd7{PGjjqK>r54;dWpa-;( zK4^}$7D{8=NFV%#iMzw~6uuYg!$D?-UT7+;5g;bENhw<3dJ239*HVHI)oqI4EdUkynHbRmV*h^~%Lpu>E04!};2MdCf~ zEV^i#jfQLpvF^~Zjaawqe}gJvqd+?@0Nn;v zT)=cvVyNB==q)9}CgGGsZIp;<4ifvt*QP&oG@>8E9!mCyhM^yFlX|=KV`>Ca^@mgq z{eV#H`$Fa-^~$I;7r9BU6nGb7V*26Csk7kYK{ zp$DEcoZCak3N4oH36&*7V?Z1|z^VgzIv9vMEqdsaOr}crnM-iAk?RQH4g`v^btW-} zP7GQaA*>{ps*?_6Kj>eafw>JHDM@oIGC>|cl#;-49JvYs8bhLg*KHod#H*c*L2%%? z;Nal|#$M)xPMGT8lk}_BsyHak`WKN597Hfug3aUD4m1QJ!TJb+YqEe)69a4=!=FKPm7?qSK@S;3r!dK&_tP#gYx+H`ZPVoYR#O)HHjE@Z9v9ihblTqy7thPH}5?=zq(ZP$R*z^ zE^J=gSh~5jzR_h*iH7xP)C>p;E|Q0{Ig~Jp=>16}|5u0gktKNO>vc5bV#D0+_TwV& zzc{%4LxW#Q4Gu9cWGVXvu)EnJ^TgL%NNssuoo$Zc?Ai$pA0ef|H&bc3fu>O%*c;_& zrQvlBw+i${7?wcF#J(b1w-KZ577sHceEo5Mhr2J6|CNzk!>25vArEq}`SDUESMm2f}@!eknH+IYlmbn6{>`ZA_b})UwoY=GZ*RT3{445O-ONFvyS04itAQ*q$>b# zuHj)XA8D$o9jh6O;y?JFkYh|Mw9E=ikHF>$t7gr^66euJ^!{Zo%mBw$$1w%#d~Btq zxx`Wa4$mh4Nx^x9|Kk_FUCaST6_)^=6raPPgv+&@EG-w;e)ioW3b(etQXB=a%kw** z;%X(VK>b%mSlaHYh@aB<7bX9fxaR#k_ww^8r=Gcn@jG&WW*py}Yb=NmRPY-q27Qpq zR1K2w8Ncz)hf{u|AoNB#r?bSkok=c%g;)gwK$R$|GU0LTtMG1|f#RT716ci>LKYT- zWynL2VGy{eha+rL{-ik{MHkPAhpbH@;Da+ExF;u$Zug&pJ?v?OrE zl#6gk2We8FDrN2&#{!`8=&)Im)ExO}3_F^7&{HF_I9-N=KBS%<%1;WCf=$_|xv)m$ z5EYr3{jEhDd8gx&(i8Vg5^xG}I;v8c8|%>2_6Xi&79<>Fod{;cC@S0qk9`xDL`|$N z%x^B}d1!BQ9VeQ$7Jg#O+gkT-tQVKAKTnrQ;jGgLopB0|MjJev?(PPRFzQ#Zo`Hc5 zT!A%|?ZjdHnaM&YU7*w<>zVR~XU4~8JK_C+qgyD|;o-n5vr7c{dj032P=QUS6PqXQshjMCUjRuCQ`Btia@1^T$4EYXkrHEG2PSbSlNsg%Xk3tBX}G=2 zL(IUdW=MKRyBf8GyIEP)2zKSWH44M<3w6;*ZTf4eM%aFN;ZL_N@jf-v+EiOBh87i2 z@6=|SYxbTTy_0DQn0hLPJf?F9jV0!16gpI$TnpkH@x+?hk|gxGNn zMH_@Men2E^8=5C5aeZk`aRipY1+RT5KOi?4bUD>2&Dhhsbo9z$fi&$v5CkLiHi$4w zi!21Urd^GQO7O+>cHs~oo-e@paXUsgINbgOYrRnR{`B65m2w`RDWP}g7*8tGnsME23g_Puh&q@e0K2O-Kz2~)PohM`!(ij=T zwOj^fVsszaNQB&0^zyGqwWE#d*3rl=Pc;vv%3iwcNu)JZZcCTjBywM>+?*~qOC*vi zpGcQaa3u0qsd8(&+$xd(ntHvJU7^zYl;k&3<FD@STq{@$cU`o+`Jb%Prr(gYGw^%MF|j z3P^yfWauhFax|es0-49K!@;eQpOC%y3Esg^2-5t7^vF-3dpt3N;C#l2jWiAN%nEtY z8Zc96{qL*amJ!rMyDHn}0xBZH02vt!jtrwsulePp*1a9RZg$-~d~j(f{0lD)(LFUa zMR8FCG_(Iy3k|%&yP=#TFE{ElqR*&4>-2dnxREc%aiG{N_K}9JIlZ{e9s2QLYHmS zjl)l)`du1-3gUuLXJ8)L*wkGP`)Oz=aS=!YXwXnnf|!K5UL-`Y#g#g&At5!O$%+Fd z24T5VA`a07G6S7!u~~3EBGnP0I?5t3T`P}+t~m>mIc1Tvsma1tWy5qD-?)M}4Tw1n zpnI8Y893$IFfk*Nu_^c{j!Z+jcoFWAPLS=Jn#`*kLL?t#@uAEl zzax#4Kc)%Od0*VWL|2~TTHz_xTM#!8t7D+wAYhbB=P!F2nDq$Zl2(GBfXEZLt#~j4 zDDnf!GpE1~%IZp@Bm}KaZZ2 z2Ho*cBAGpfWTX*;pGM|!j%h(QQ0ufHpCP9&f+5lgCetm?G+Axs zsB!udDGT~=4FjpMNo_zhgh3>uH|~BVB0~r_pdgS&h%`6pVLEY*VPI=KS|r*E(kCco z1Aql?OpL~ijsnM~e&HPP6^2$g+f1jK_kXzQ(`N)PKXh52v-&iLlg(k}E1Lc(-kEVY z*Ph!IG>#N|j9H8_ND0m}o44$-Uwb0h9`cp*t$6FSerisPZ%FAdDd$Z+<}~u0J$)>P zU{N@33MWnBUX#*qQU*+lSX}Yeqb5b3NEtLK!{)6KbJiE0UccvrzwU(LjK{^vH|!tz z4aKkTL|%}De}NX4z0#wll3z7#lOKh0rW|Izen+f*-s6mUQ zQQCAr@zc00)M%qrZ`EasgUQ%1ByeWrNgyIt11Hfa11^$ilntZPLomYNS_+sTak+^^ zaAO}7fcP8J9Xbh?F$oI`&N9I7s>d6hnVQax@(p6VdxH+ zBCU!RQ9cgRHf))!Wy+z+%1)4s#C&>U;$5f*D>L-AAtVTktP2c5rY?pAT5`}O#w(0G zE$tFIP2%Hi=e>=Eo2&EJZ~^FZOIwTlHh!TY3E_v5XiTsx<#DMVK}jMf7M374(kzk-iG2f)Md+c z+q9%j>$Pe9Hf_MBJz~=ywP`7vHfYlV56G;|9ksc6n^v%C!!`|maXc^&!C%gd&}eCJ zQ4aoJE;gm({uKd@k-d9%YW|GFb5E5_YILq>!X^JHD)PN@qkjUY7D_U!FZoZw?d~i7 zQ%HUq;JD@=QgH5R#gb369&heyY4j!k>L`HZ7@lJQk$F7nil1>j#{nJ-coxW)tnrKf zRa|udxYkUeW^yQN*?ZDIPO;+z8c$KEl>nnhp_2p_+bGmV(CsvZP7`c9OQCiGj~x^` zPrxz0`wtL|^H}Wf-dNdQDc0-)#sk&nJMVmP(PU zqD9A``%n2-X~do?`bBtCMqVr3pJI$3ICQESv2Jb}ewx#m5KTBTcL@oXFf*DEnY)aH z%QQtNcpT=QK>P_zk4Qh5Q=V&RukTC`E=pLGmg(BBq-$izzmSebcON|T6tB3f$}Tb} z-53;CyGFS0J+Q!Pba1{eT zw5~|8Zt$-ldI7?Y6N5}KFab0pK28_Vs=N3&T>t_$(525&gVF^~kVbj{XAdHNM{MXJ zMr|9`1GF5(k^sxW>Ibr}PZ zJwyT+H5W6{aTaiPg3f}E$Xzj@oTHkW>W!bRyS=c(Qo6BI`2 z7$QS==$8m#j_MhU!60zb$ObxBqi%)R_kr)Vw^pFY-|=Gm#=rf=_Q8&TA^HFFa(n6m zt4LfE9Z5X6%AOvu_Tlac2qRdNdT*A5+=E4A-ImQkE#0h8RV4sC6+Xjuy6P8F{K|5% zwXtd99$YgK{cdp_SF?_%L@75r`eak%k=*u2nGrw5hl0O6wp=J5dHc;*3+4K~|Avc2 z-@ek+cyDg|hXrLdl=3*0cI3_P;L0aDL;Mn-QTy}z$MSTkJ25r2M_~;Fw=ZDpk=C1& z+77{D`319V99+nh{Rs>T#1bAPYR`@`w&R-i9H zp%%cdX27oFFZj)8fwkxW?qB%Fo1qz9gwxo#U=XcDPbvOJ=#=71g_Wl0ef|kRqhHMW zC**UD=9KPbX~+}7x!h4bNINR$a!(A}cLeS*F5)0iSKe>MwOUfAIiKtII z7CAb1V&~oG@7Lxw?>>;{+DhZn_tLn2+iw(8svPtn3po@~7JHD7uE9caD9wb;hoR72 zZzI9pdN`DbJLksn3!0`RXzrkKiu}p6rZA8Kv@p~}N+CL484xY`-5B5lCT{x$d!Stn zf%Xp8K>bA3CRq3WYPnc8^m97lGrZ*N%qMs0zDv_e^172H7YAz45MYsn=uD`FpxM$8 z{L9SS>}kaAZoE*#-8E~}8{ze%D^YI2H-mD}zvSP+fw$`KjD1uuy?_IW&|UNQcWQo9 zg&n=u6y6(>7kzsfKeP1<2Y#a}_z62M@Jz+)b^3Z8=jQC|_S=D@%TA44@Valb_4r*l zT@U>7G5fOleXMYS$p5JLcD=q{Pp?P**uHMR-Jk^;z7I=|zHEMl%+ov%ufAwsJ#L1q zO|#qfw>R}oy&@JKIMV79`0Vy2`|1hvYOChAQhu+#d`b)^#z}{3FrGSx{gT(;#If&V zeTdH%oq`cN0VpR4@x{QFq~py(%4iqyB|&D(%NvPewG%E&2*IZv=>zXNi@Qgj5}rmI!?gYnSP4O7I3~FhwjmZg>lF8f=)x( zcd#k(x-rlYLYv8>yU>C#6k-*s-xv_8&39}SBvA@-b?hoQ-xCxDA`aotK(GNMHdSIf ztiYkcSYV<}F?fAADrRTW9V-b*J|uI1EMPSvSHMGmkt$FwANGq>W}BG`9A#mHGCw}7 z8x)*Xg6lREY=KnxAOi3d{d54Z1>q?^#!`W({)iBju913Ss!$v@P2H<$IGDfvNnRkY z(Jv=%KTIw=g<@|1E2UJ?7gw;BWT}7y`>YxIZhr3u{KT&SR~_A3luE{+h%mQ8*tHHY{lP>C`^q@0y;3EOnWgrV>Cw`uk;C9f z70{$&TXw!Xln%e-+^(g+S_Lv}t98im0Vcy&K!&ydxaQT-G2l45Mf3?NvRIAC^zAx2 zyb+?UoI_iB=Ugc#D9+NBehwGaehyRxBd&JYr7F5I!crABUrSXmPH6E8s=_gbYE%Wm zSj$%u710QG9z`$M&y_|Df(%VNcCv#L%$~GxN)MI9j(V^p_B17hYJ|dsCZ_}5gDSWW ztX!efH@ZzJy7{!55V<~;A`~krQg@#CSu5;jglX- z0kKpFjbHuzHYxOj(DM)I9oA z%2z_I3eK3=_GFy)uzL$NfKMSwtl21)s~<Y5nk7g9;ZN25N%%1Q>%I1=N}74V(?r6BGH_F4cAF!U}K{ zXt8@d#V?Z}TaHU0R#>U)3m+u8C{>gM#y;*(cC^%MX`Zug=d z{O`WgWJ0_jms_s9oXa2o)EAas8{a;Y6Mv}a-h;VfBDMcjIjiz(sdRR=HusT+7nWX4 z;b)C%cYjFdS1ljR3TDS{w-vsc%E|BXwDRvkm3}!KryuEz;SPS?nlY{rrfC>i$s(Sf zbanj|ObgUom^M&0$elI}Xmv<8i&MKkJX8XqleW&wM(Icgi~79|-XeI~WFm&rL)lCR zF3O1?nn%}q>3cZ%HVNMtnspo?;y3A+z7EfIoQ>cGrMoZx=m6gs%RV@?XK`crx2tTQ z$t~cp=7K*Q`b}EZbb+J(HXe4WN}8tT>j#yt)iD;ds|0BY6mA1byiAsQU8X~pR2k0^ zNb_Yti`ozo{t|vJQ>n_3-nW$;n|B9ID96+i-P3z1%gsb$yPq)G%yf2JO!O7pD!W=c zN<{bjDLOe?toN8NqytXr;um=I>0aVH_b>9&6;o)c<*8I7$5Z?lM`Zblaklqt zq9MU(1)uJmf`@P?d4+Vya&=Y!aM2;XB35O(j^%zxDSXlxE++g59W~ouh5=^@p-5Mr zreF>KjdJTtx<6`Hn9ZX}?%)xh2*oia+L-EH1VFuee)rw;4;>M=uXNXF@Oc4(?rff> zj!LIxf$}nundAQ3*&{ryn=C#6mBU>dA8b;=*WLLA8HNT6JU0}7Kb?aY`Ca?w-KB2< zRfhWo3)|iMRng85*6wy(_Ka&RhH&!=-@C$H?&NI}X;T>2$%*u1kI7I3>0Wz#hxf@( zdi8Bnw{G5C-@sAE^$ic#D{eTyr|q@V6$$6PB|h!^@KqdTKJRVby87_ut(yxQa&N-Y z+B4_9g{^Dn@Dtrd$G48vA71;7`Hg3m);7<3*A~|BJKYP#hnH{R7nZLtEugBc`K!pm z%U$QXyqV2~P4C+JjhjoW@ZP(IpIP2o@UGul<6mIjq~Bh?HjhKd!;k02&F?YKKRds) zI)8O_!JFU0FM!V%Z{75^mToL`wbh^V+J`f^(Qz_!W&k>pbUsBRgsZyg7YyZ=op#)K z;ZII`?UR`ye-d6>0YB6&5tWRmhbD3Dz?H|TL}nU4eP@#D{Q`~%ojZq=Tp@>R*$=72 z(@Tb+Z$r@$+|#d&!G4a!2$?){`b58PGw@>28|nb}DDUHN!?4fiSlTZE#(3>Q@cO%c zbVzo}Bd+YV*GrC~cI&v?9){Qz+0?f~Ym^N4=y`j+{2FF^`_StA<|fX^J$}zMH^jNqppMNm-sJj?pvLLkcxDPG(5Y7bhtZ-Lbw|_= z41QYAr_Z>V!9-enf_A*!y_hh#AEh1&DO@9{_X^ruP57L$9!<7)q6GJ-1XrU3SGCAB zEpkN*+HU7L5CJP@*k?aOibgYjmmjfiOqY1}S^ zx_;eMsEu>%GH#0PS!KPG3(qcXVxBvJdR73G7+6)*8PcLwR*)_hfqkw%?>#?%^;XyQ zpE%E`Y-$FF9n-@z6MUv&{ni$PAX{%pNmjWPR_M@z-8Ibk?Is&;QQOqk^Q#M;n~Mtz z7@=@~3<-pkS2|3RM&l$paxCRG>vAls? z3GpI(V__4+^W5UXnum*du=;^jxkec`)Jk`jOK~ps+yZ?HiIsTyy!Xt~v#5qzhlVWz z)-KLJi((r~&k`J_25QxUaTUYs7*x?2p?M^UE?xJYTX<+=!CPBLkJh|-{)G9$X0;ET z$B0qys7ppg&@Kb@@pDX<+&*e5Bm}D8o8MT#m;uQ1XcZT(E#aDW(_`)k2J!mpt<6Ov z5m^#3Ixh6su6gh3`mMF%{KnG4CaN7@-`rY#9zw(7(&j^}tKQWG?itO2bc)0aY_)68 zR2!Or^jwh<-2)ZS@&|?7Twhw-B0*!5nyq^ZsZ6IJ^sH0=t^qWjX}gK`pK0^f7M_!- z@OYXxy>*%X>l-XHQM*uf{U(ZH2yfsE*KvaqD!;n=Ji0TDZkXYv8ap?)=C7?_B-gx! z>(>{qZJCk8ZcuFjoHt7-yjX~w479ivP}8&o7> ztdE-rDxY*+lvnMKDOg`Evm(uuJ?u%vX*{fWX4*%`lziOQnwcblIY33Q?n-hf6<0x2 zO>L+82Xl}$yS#2@Ah!M_7<7;s>#e_Ab|QYa++=?^Hy)}w{M~wTP_5F|-n+bmSHf)# ze=eLWO|1_`ES!D!w#H!k36Hk>;mT2nd-ZO1Wz{fgR_Q2APF0huPb}-ls__47@|AV3~0846{t1tvW5Z`%zLaLZMf<0fv4%&fsFThkr&x} z6*Bn;zQS);t0EY}_IATp-Ptl}?o^qyWWDJH=D{Soq;Aq&sxWCGny`u0K2r~Z(2hCZ zfmX9hVzn>9S?pj*=&pmrdh>l4LxWVCSnW%&n7HeJ7rcF;S}UMDH?!jO0*0A`AB2Ig zN@BHEz+Q5&WIe3I2UC%FXoD;AWJfT)fgfI#+MG2SkWjMfD%6Uo*A;6}bKchq4CyW3 z=OP@L$>*U}WtL()fp%EUU{GnmdywxWyPbEE-5GL{-8rgv(qYzeniBqkvk-!jjDh)t zbmc~?K@zoSQ6*b(SEZm;p*yR{exG%#n!d|bi~YT7Q;E%o)Tw{(+EnOgU3IFA*^gBY z8mm#m!yT}PK#N*kefj~kr}ZC1eHxnIKvJ%lS({zZ(xjhS%<6jpWnggTrakZi?TRsve;sBwD9m zng^ArJTN|gZDSqC|Jpo+U?}qGegqb&Ni0|(A!Qn}04~FY3^o7k`ce@#95UUI{)YCyK0r@Li0=GQhMUOQxkE?N)`OCpIm?VS7?@Q;>9PlNxKkL<8f^ zVP<8rtd_0)I;>ZVE|?q2Q|396lH_ePjt9)_fui6)N1ocjaO+f@!#gzo_*B(w0$}(T bUQ{YinZ!dR9sAPZ5>-VF)x|3EZ>#@*svrPk literal 46107 zcmeHwdvILWdEf2=f@p+-7Z5^IYnr}>DGH=X82i8ipj2irfCYDf#a?K4L4Y(P2*iTI zO8^6adN@w&xXHMw9Vb@(h@Gg3oW`}?Gyy=OW66?tnsz3EI$K&Im29byFORl4M@w0EpyKuwb|v?@<*XC$Jki+LPA&AKSS35)w8c}WhpsK2 zPIM*`PCR|4tNTofGW?)mdJ0+MLE89w-n0$V1mwXI56vE=*lroLV}& zxI8_zc=qv`>f+4P$&RkGPcE-4%q=~3T2js~&Rt%aT6y~H+DvtB?JS;^ubeJ;-f+3& z!T5OR_C)!TD!3%etN%g+vFNmRx_jIM4Goz*K`Mft)K0Scpb{d1j9X}IK;LX3Mr!UPs zxz7kEPc-)D+>(s2QXVM~Ko-IH50uL!t1aA^dxHHPafZ zRp(n9YR%zL=53VrMfs^^9-~+z{Rwk$XY+8bfuakq)JJO)oPVW0^b;l+wJSwbt7L&Ar}p`$5UzU@@UB$b$YFED(R;ur6WNid)F{JH2sd(CyDUJ)Ks5y4Q+y z^;nTquhZuh2ApJ%R7*J@s;@JTsazP%zV}1u;fZ^)5BJOb@O0%JJf7kSo-Yn!0fpa* zQIBNYovpf$Y=rO4@GNYHT=lzi{r#Ek(0`(-xq$+qzjW=`pCNC%5lP#PJDmMrGcPwd z^EKpmH##!g4eoZs&W-y~T;<8{&W)DL_5pYMz|M`gW$3*cccP(U zzHm=F#+(Sezu=b34(8a81gALV&l68U*&WH+lQ4=&7{vG|oI&u-u~N2-$iDLu8Hc16=_A7b{yTick9_Bk z7*dZoq~4-Iy=%kHM!3T?_Z~GUn$DPfRRjg^QjIv$h$cHJrD$&>^oRR2Cse1J_C~0^t0(PbOC_)5boGGvykfswak{{9h^(0-c6EVHbtC~^=SPy= zR-{vLMB<`xv}%gQyX*+DD&1PV(`v29YOKo&C;h%)9d)Jg7~+s!C}TLC(?vX-lTqAC zPM|U;$8GkT>a`1{dOMx5;sBwYV%AA@+iW|P4%F*PIOR$yKb-Z(Do!eCEpaE6uvvNv z&-2c!CX?7y{5~anl6I^+>0p>E*?xjf$-q{UOxX`lCX-G%3z$_I^#IPCWZWKrB!=IA zMxr<6Cy%L}U=jx#W`HiLvJp-z7{ zXghJwC5EycW5xW#WBI`g9sZ~*bQNcG#rs1gJ5llahIr#HX2*F~2iW>2*dii|9iEq+ zA~xHy_5G5R(K)f!^O>Ek>UK0t!0Q3<=tlwT=wO!) z@s=jt?srSsiiIv{WAopDprNi!`bw|+m9Q9q`Aobi8__m$OeV<`lIqvU; zs?OTEen^A7Xh^}id~0eJa1LAY?Z*@RKxO*9?!Y?5s1u}9d82Nrob_j+17Z-EqJ9m$ zI_Orv6A-x$V!h}f$WjIEf$~N#bOZ(pWLh|L=GZYpYNyY;g|VzN3P4cE7V)dcDma1( zXCRB-&`_4Wu@X38U@SjX52&EV@;wo^Ib1jFGyk90Lo0j1dU}}A+-AEwTjjB?=?zu= z9^#E>TZ;d<%bQ1wq#eA_CzbEZ^-0R1onPTcWq7WBbm3wxm+u=oNOMT@LW^1mMus3x zkeUQc*?zz<0sy-Q)7YP@c%%K;j+{&7oHq{cM@UyECotR?x6#1N5JM0y$&944+luw} zIHUP2My$I>&yLfLVPvLC#nYO@QUp7SpX09v%%>9v18f_ZSzVi3np&HKG`l*ph?Pwt zu!E)LHCo}TYb!HTkAp+Rdz|+2h+8O(I)nL%(GzC9pUYN!BJ%~Q!Ge2^upn&=+4FdR z!iYR(ZmHy6;Hf8hn9}DPz*M&m$uG9RUNN(ZJFU;>;Kb*g-?lXCwuCEA^Sa^lj z$ztTsFH-gpvWIqML#pC=>~ozzcAeL%OaJWkTc2Kf{q>s*H+e!^4=PL&1+KpC^>4jT z;_`R9VX^M!!fSs55igKjzgV|E&h5U;^?oyu+rTx}d;6=KX{*qQV4=mx&ArV=UTv)> zvg++}vIVTpq;qNTVwS)MV7Llmt`cAeGU*AdeHFrvr9z!LEsi}}(&C^F9ZKj>mnoMr zx!9dmIgo=2#Z5WLbdm-NlR&yt1$0N4H5gvCFVivn-y0k(XDi?eosQ=EJpW7=5Z(Uy z-H@M~J0r3Jc`UaNsHtg`Ulxddi2>%1@n4l4;t0?2n@?dGY;R*MVeOMlKzMKR_M3P# z3y*uNGHl-`nPf{lc{UdK*WA`nsN1Uh@$gH-bzASyB5uQ0-TVvlL$|KKV`%*y;jfS6 zVqY!d|3c)&;mFt4zd1j2GZ&jsW79By>-xR(I&$mN)_CS(pvQ!bY2!AijRTz+=nGI{ z!USm*BnC+&39nd)ED4xV9_v&1ESa|PND{k`zttw=w$>m4s0FHV66qcX>?{$$%L(8u z&IIbA%m9>4Bv6BDVkJ>#Kv|K{7%LtCS#f$H0aEb*(27HrpvK~0u4pU{z~%RtR4<&F z>f}tU3@Z~1o-={EsAi`P{Ak%5+}C64M7qK98H0A)qk#piU~QlS>iP2cz|#Y8K5pSj z+5o!2(JL3gg2&3h4x~5*+Rl~;!mFo97yK^z0){U@7y&^I9HUfU7?9mZz`g&M)xt=)31GLIE{h32XFv zyPF^4=6>VA!p%3VLc;R(6MmJ&x<7csI;8ix-Z@*X_L+KbyNOPz$2M};_z!ludsLqX zr1P}1Bmjs;+>!Zi%8}7?j`moi+yL+8dwlGj~$B_lCtS%LYtYBqeZ&B5;g8g(T z@KiFWYM?xNVbm+dXF^Ye1u5b&fFKKP5Z*P{v64szw-!@3 zb}N_U#<)^o*+m1(Kc2uw#YF*_h%s3u1F|btwv@v_5z$!XlJ?rerf53Cd!A4*_OV?m z|1$ghJBB?zR4#Z5A2z;QnxnCKBLr>KWLp^c=t~UmP8) z;AJodk~UoQ#*6$uWd}0!!())?!F%`S68`{vEKWVnV&awMrL{AT<4b{PcP}agO0AT5 zLDPg_jJg>d4!V_5MAEXJA>s=@1aE|Cq+H1sD{du!p2ie=L1BQgq`mn2bA|i}a!Fu| z;};tgUKWf08pMbLX1T}fGJUR~z|1@kXifcQvd;``ot+=pIywJmf*|?_`S)uVhyQf( z^*@)wL&G{a8?|8GHx?u7|3$@VeZR1<{?$-BHj+zyq+bDWk^p!&Mm*=1a}KsGNdv`7 z07EPRP}!w{aa6Yo?oZdB)AX>efudL;r8i&NI$$6eX{%x!!33%aeZXNp`!Q3li-5NVCfut#5%?8E{Q zhP01@gO-+L?n6@v>{5nJclZWA0**$s0%yBJ3s4aj#R?3=FT^Mqmj{a80NIuYvJ*%G zkC6~I!AmfpR45nXw9&lm)2}$>=l%NCi*6|e0jUvl-dJG()P-FWMl@Oc2}@6tfRMJ= zIEKAc6E)1${&S$f)ah~Td7y3SDL||VL;I~sJdR1xVW@C@y#aQ{5-U>yApBHp>xJwf zG_1Dr0cgN9p+mcuC`|GrWw&EIKTye)wZ?#qcq|vHWMb!Pm!J)cYJj5?K}D9rB5}=E zSuF#F!Q$)lFFZe#|JEmS(cDng%`gmVuDfek=sP68i}g%|h1b40@|&T1hZbJFxc-e$ zJ9Oihz&Hq1l465&Gm7-E6LDt%HXPoRh);D%5X_@nhXB=CF=D?bGpdfUQMPU?W(?U} zR3XfR+>)z#bBd&4Y-_}bD%p`y=0r*vNg6Z{qtDqvB_wZzS_26y9F#`XA~+ht05jxM zKtZBBR{kLj0YU|Vk9d3`Awfw>$~uyjP?YOKYB6ZNG*+Z`K;P&l!6WR*6vt4QaGLV` zXgBHibh#cx&gY@ALLJZy1M|8MMw_7OB^ztqnqnY_-R8}Md6}}t%_Axl)hUt@-MRi= zlOwv-msI^uE-}&?`l&#|cIXFd`R#*wDSWZYrPz}8%trW$acAMxX{R>cHtwiq8=C9h z?#1M3A@9gH>A$0`p?k-VErmY`4}kIG^Yr&5>Yc2OA6txkbNUz(>Gyao|Ap^2Z{XeF z2<--+^_rMd|FXyo{OZ?->^I)i*lV{L1ON5Ny8ilmHeP=?|Amd$FX^G1Bx&XQz35$a zNFDT|{9FVd^ee9a7HWiBhtwRk@tVX;sI7FUwN0Z6GoLl-xH8ml#&nc-RQ|&Y{-Zj5 zy1h1@7;oo+_>BWY+oTzJZL+0S^;&Lyq2{$rr)uMAo&Pq;zd6~8{8q|uo$jp3&h>IT zz0ZBRU4GPf4?m2ap-Cq&K|@3wAeEnfBT^X>rO^19g;&};^U?g~q^9)EvJOehO`CoD zyw4%@_Yn2>(Ejgp82N`O|L}C@$Mav|&d&-51TyP^UCbg)*T3vesv&;1d{zK z;I2JzD7n;^FFHNg!HIcUvRV(=-0mcUpSvxkxz>DkW6xx+K8p8`YZjI6v2{^t?Dc~q z6=?VSA!CVV!g^*JFm%^5y8>3yF0?iP<3Irl?=A@3iVt={j5S~Yh5^x>i7&=(i?D3T z`4PCYVJ~rEBQ_kr3-YO$pCC~{>CcuZCuMZNWcC#ZkphrbA?yI^t&-2KCm9w?Oq`0b22g#dHRc zb0`vtgyu333`)HIXJgY1yn2=I4yN!-(JKLSkQ@{wz&Gl=?l+X9C!sKafDN6^>6}{} zC}c~gv9<>C#dBrqJ=8$led!#Tb2v5aoP=_(Kbsw3)q@lTSlsm*)Bs!WVUx$^KaeFc z3!s95j>bKJ8;H{jP-dJWCJWvSS}O?%)a#7p#d3gUE-ZxY2!J`F!bF+0k66$gRyXv` z6i8V*Rzxx6tXM_R_yQoznq)j8UnCrcab@i_f^Y_4X9)zMP$u+(5Hv3;#P+pZ778s! zb#Q_}0Nx0&)k{+}#jxAs1)*972twmB`-FCt&XjCp8a5N~^<)@Gl~L3%4$x`$$PYT; z0C$?k6HeV@?}~)#ns=I-f8lV3O`V_2M8&fD8TpB3n6@5xUj2Sm{l1`nzovd)QomnU zzmrYMf$;%Iirz_SWU|vFwwMr{g;Z{<2^}?|!zL6np(7>)6@%1$QMb`nO z5-s89y~AJjV!!Ae+3fTVKg&7ZVbzisQwcGhaAZ?Nd+*3chvcb4Dr;Dx!z$`-#<&MA zZ^HSliwYoy)^nWBe^lOCjwoPJ*nB_@u${{NlKuQOh9sB;(fdxG!q$HZ_+zqzTkuZ# zW#v6Tx$t3lqhj9fTp&~%**vVuj94|H2`HM3qLl&VfY-EnpKi9v%Bpv2UewQ0zI@V= zPJl8$OU(smMM5>t@v|JO!3Nao^s_qcEOevwXLT=HVR!Y8KC7bh-cd5dddEzDTkC6=1fp|*{j7(?Is2@N5SEXgah`I8JGgMrn> zz{jR~EJnbtw9^iMD)A@ku*Ow^G~e@PurOB6!QT$UI1u#6@|E3CB3gW^2$oI3wXQ>YfH+xpAApVBTV?pC|h$ThnSLv>sE z;TAaSajm?hOdw@KSx~k`^SnUqX>AFYg-C2t4qT3`|GTj0RbFm_iRH`1mkL`4M`mM} zzBUxOxc+k^$6s9kD_x*{Z-JlW0^;}17Jenskqyyb9Py+PNTAu$QXlDUl|%yVs8t#g ziKJukXy^v&(?Kvg-9&(M-c~;AG14re{_ zs)H)FkKq(N_O$z6LqRAh_L2&OzP=#VfadqSt-14{yB@2Cp?vWUZN1HFosCT%{)pFl zeDY8&0t)*J?{Ev?F0p*hmz#lEl+`dm&c z@eX=X#z&j8(kHC~JOxsj-I?3D-dY=~Zl9WCEX99nLkq8*0`iFUnKn3G>T|I5V6EUC zsp|ZOR|SI2p{L#vKXvj5T9E-bFd5r;eePb>|CY^IfrqL#Qjlkk%+4to*CPHn0+9eK zl3<*^?;sfGC1|Q?PLoVd5aN`kxuXnT2~93Z;R+dyxTRsZeipOkj)8osLJp#Lwtg6^ z9JIlA#20L?S5Fy-;OLEaRPs{%KyD zY^KUk0*-BJ8z8kG0s`gV0Uv?el76GO+&??D^w`Ym$W(O(=5uIimX{C!@7GTupry10 z;La)przI5vw3857i*%j1$&Z7@>r@=8(m|M+RM3{$!C|nvg`59_Q8d_{)(Qq1Su$z} zTLJUIaFJw<&G=3dE0rKmcj#1tiU*9`Zt)jI0UP!z9>B=i5$Loxcv>a~{I1JK8;GTh zK7rr>t0Y;UfJxE%1i)_16%})3gh{RjkmW%o7wEUg)?k49dP;OhR!|>-Jw@~pP>cA0 z1;s2(Lk-f)Yt;c(y4F=d53Aq|_5$E_LNF+f-H8E;uVZ122p#UAT==CaH3ifmT4Mo) z2zZB5SBIt$W&iJ}7Zsx=iNC7>xffx-t2XwSI>zY&^CDC_#k$D4MVB9Jv}KoA1x zVB0$VvZ;~uFxXd^7F>98pliYXM=uKY>H-5Jg$QkYwELKiicpH|I#8iOxwxAikl1}k z;yU5n{pF5Gs9xB(TW$VUbMubVeDwk4kRSSh3e-v~5&i~uM4VOD=vo>eHY zR(wPDoXvOUv31QpzY%_knfc})sY3~~(LBqe4cFKI2! zBhb>k&nxZH(u}qMGu)_O|D^9!CHwbm)H|e}b4Wku@Mq;Qhkw#LwRtaxB|-WvGySrL z1HYQv1qN~q1{Me`Xrh37VE=2ALr}8}-Fl|x4NX4OH!Qn1+<0=gHV;?v^E2dn+a`#(IFGTudQ z12dR2<)qaRhU}D=mhsY0QdykH&-6}d6;xWxtdl)ZKj~I`{DK_XG3qDv*xM8!1O^3< zDipKoLIDNsoXI+3WswT%sGoJz$|4mMDU(!#wlb+6%A__wtIeuKDyWp7m9nx(1qH>C zYVSDdh7!-J=)9L;JyV~_&yb#Jz(fa0&(r}uld3L1qG#%0J<~D&smJW6;tf?DYv6Do zT+j4Hp$?kYiK-Xf*?gBeT;xx#VAzzdvVC9@CnLG=JR_?~T zfTa9b3fe|1=9|PRku|?KQU-mEQvE_%W$AvQlj!yJz40W_q4x8QCvYl5^=Yq@9L{zb z$!NbGCxDSnuX=$&O{53si2VqZS?U?4yFJjp>fZK1gJKGI!#Zzt)7><0$|boQ19JP( zOJjg8!9<>~2v$#%?5bVjfcj0CUfwPT0Zr$T(Of+tAZT_$qpi~Smqh8Dv`jis@W?3C z^Wzx7`TZ8Y41}#NMI%VrXg}kvQ0w? z^usv8LhFKD-!z2I7}HRk`lIj3h@&IEafp_OZ5^Vsg1&i(Yz{owaddW$Mno%9qSr&s2#t}Ug3qC9ke^i6Z3(AML6$<=M&PFq?c0X0W2f6sg8-J1G%KS%X>7qlC zNO&kb6ba8(_1Ric!>_Lcc7n|++>iq>^GX-ofdRVCN+n`CjFy&8T*)v2Ytldjc6+P| znSMGNM`vgK7@Ppue;$aTKzD06WJLB)@w3$i_oVPCerWtmj)fnkr$6&wq`0KC5n!^XwBk&vCxFVoR;zsQ2)gp=Ha^B?v zKSm#Z;nF*w6&2WehdSM(<40BeGm`&tDShK^{=H~7^nv^h|772bL!aXkLxouE#o^C$ zco^YJA1>Tz%oIeC5|v|vqFf?d5ZKFJ#F~V;+g__=y@1Vp4C>`h6#x?A6u>Wo%;TUX zkwL(JamcppmGr?)5G!_az6{YMVSj<@w~W)9g0jhiqB&R+nM^iG5`UDzA1qTX4RGcT z=@9mOXy=OqZfOAO^Mq5HdF>!+xH^@G23-#Ybw?fwXbs<6KDznRwxPb2hb$`MYc4o2|3ak$JXkt z&EoPKx&}`&?Guu8#uU3WH7U2$VbJ^|G+-D0qQ%;NkdA3;hHbV5<_qSYl>qaAKSrn1 zHo7=7wK}6N=Wte+ao}=o=BYJjZP|HzxjJ{{Y3It^%IX?!=m0-&8>EAn{xMA6kKxGu z)|!$qK;#llhe8N7>~UayN2E?Wu$Fnr!h`hylQ)U<;{Hfv2l~MXDr{l%E!}NxOu{r2 z1{8PVGoZ#8@rKqULNj}eN&DH7Fk8Fcgsl*I!jvUK-kZ;u($+i(+s9rr#2Z;5LZ4`W zQ>Ob|CfXbgF?%?#wcSn7cGrn*LAxZ@SIRea@qr1b%kJb zBoMvFYULhQ;tF5M(7Zs>6B4&YVdxyRD9ji|YdIhr(IlZLj6Rkw0hmPXk$Mi9^f0+` zShEzwQ5y`T7M@cu0X3hHg*XMqUX=nkt+6Kv$C@EL**GDib*wzP$EuC)o}?cjvbO#y z0zg;hmK6HI66t-Dh=)#+1~yOlOGuozN1A%FVd*3r`H=kcUP3(TmeJt08T$RZ{cED8 z8eBGee9FDB5&Dm6V~kvawduhEtWEECt4U|`L9H)~R9&1B4PJgEiui-5{t?~+H@~4; zNnKc9=C(IGb-T*JrUBa_+8I&FA*LhU&iWbmdRkXdzcI;d!1joG#eM62SV$IRL`M-7 z1&kHGR_}og0~vs%y13_b0`ObX>>)yD#xxizeV>ykmgdK*}>Il1)MGA z3qa{MRqdg~T_6UhdnGrj>KI+BIvAp-t4meSDnJ(1K3javY50N6w&QL)5{YHD+uZFo ziQJRfZgIC;BofMOA9lA7b0qYw%y!J(j!EQyWL}Q3PmZg8CHa-i_Az(+m_&Xpvwg(f zJ|dB=%=S@t`=~^|l;PuAbX6-I+nU{xg$bL{4S454zh2CGzgf_91us(6?_K z%51l~+pXWef!A+xx0^T{Q<4Ni$v!;h7I2#uJP8trfU7{u!oR?G{0l_Kzkq1`i`|`n zK~?w#J%M!f1R_lZZ8|fGUpoD7;FpRGYAP%Q-M23^C|fx9}W7*!f# zL?!19U;_j<#{SQ@im<~6fdM|lt?qL;=sb77c!ci4hm*{S{Nn9}>m3d4h3QtjqC)Mw9 z796z#!TN1ZHsEfqx{rrngcB^?)Ro7j$GK?u5hE%Va2waUGC^>v` zJrf29Ghq;u2}5&b!epe$-GLxi-yjz%XRNw;N{YWZEk{?MKGm3Mb zeOVk9G%#!bE-LdT24Vevr+deA`CweILN5e{L_p6nMHFJaq_Sz z`fvvExH*I9pG#~vX~#^tlP2wyN$W6a{;A2dNlTb=DU;S?($1K)hfLa8ljfhFRGxh3 zX`jg*Ff|5ETF#^mnY4mQE1I-XlU6cm6_a)zURkV&AlLkVV}*al3V+-Re;6+Gn@>xX zuOKWTtyg_SqSqhZlQSSWU(!u|hU4p}`G+Op8};Lt8Dn@y_=o*gl!HB&f@i*->=<2U z5&CcL*4>Xn%n40iR6b1?8L?l6|5wxJWyANH$gM4^W6{Ru-+fuy2q`4R>b(GaC2v;7h8Wf4qZ%yy@^O{@>0!v1ZOWU;q1kuAMq|7 zpL~Q4_x!QmfI@vpV)r>q&SU=~$-qIGiJO zEZ2It<`s3U&>E|GB^?`uCf_@+W0h8%2O0dFdX<6JL!_XhTN8|bNf(?3_G+uhrl}n_ zfHQCbTXBFyrCw4|DMZj~VFt4Onsf`V^a5q+bh;?RgwX{Pwh#%Ke|35{6a*#=1ukG& zH)J`JWI-n~*qU^3P908LFfDB%qcn8lri=y6(%278x&?mHq>5LsP3{yX41Wg`#zh{` zVXLT8W0OCPjIKUuXo}-e405`#4Ki0xS*n;6`G4T39*lznaK^@Da0Efv8DN%7sx2V} zLwpHG0$>5dfq-sjXslex59X;7HqasL_V|l5IQXZmO!A^I%_pH>mklO~Vd1XOu|*$9 zz{_78I24FrQw1L~OkyJz{E#G*uYiIJIPxKQ0SFDpWH1LNhkUL42y}}EDbUeJKSIwJ zm_XNV>L6Z_K_^+8HCm(FFHIN{orM$P(2Lqpj430&I0#Duc&3d9zbc27<3mg2RFT1fZx?@9SjD(G<(G?4NVL}8)-=93@Z{XuELVs9n*4d%@{5Zzk4-H)SMiyG$5y7U&N@GIZ3<)XknGI8V-@KohkXJ?Vs>E!xHH3IJC2rkwoR0n3` z!%>X9MOVm72gnEsf#M* zuNV~y$|J!KIEJnP2pd#Org}lO0Kpp8g1ahQ3jpi`TY|tAvW0V)AX^+2(#RI8k!es4 z&fr-DfANFcg7BB79ajeRXQ3YiQv{JBk>nvcd&C9?qyXfzQ65*JsuMF3-*sX}D|noS z&t{C9#pRIkvN+P0be_!w{4A7mBi4ND?aez!n|Dq(|Ivd=xz%94UV#fNCzo&lVu`Mp zT2fUalUI>+mCi(5y_naDx8S59_1V0C{acdp@);<5)h#6Y&acp9OWtb{oc4p>{N&=u z+s|XY!~nIR$#n1>KzYnwWu3I<$~R90;@mZ9bZ2o#;reG zSpP%7*0r#=2H5(+n)e~V)(--<{?m_mA3Q$!A%U&`6tMMpZR7O?(*v)STuP33Pi;qW z9E&l&*DBZ^`2EnQUGEUV`ojnuCPW`YAVy&R2m(jQfBq-}M+w5WA>a_=J%+$Bg7L=@ zI8F$@9f5WN?Nn5b%8nfwP3)GYIq%bkA+x>w4m_BO4RF!O@b^wuM$8N$NfB>w0lkbd!4y|h!dvg za?f0OPvMRqZ_zs?YpmhsX2Is}*T55bAp%tG`~{$}1gg~fhymm8g&{7@S}3tjX1*RP9*Uo9te zSIg=19~*!Dr!bJD1IIDakhIK6k2E{Z>^DKU@ZO9BK)a4&E?4d=&E;BxV9geR=21Z+ier1}ULJg-vP zuAhSchBEOdG3(?sNp87&BviOwX){=yyt`B#@>SPC*fDgFoNmQc9>-=(5U5S1c9JWK z?*>5r=sE`zt%H_i-3!o5f<0^%d%8x_zEnwDCYCg$MwMzDw$qq4Lt;ra~Am zC0BI$f@K$KTQY7JK)fBLW9BU5c9CQ&A&eA@>?ycXYk`6!brXj5$H=gBgOMMBoNf#a zbWF*QKvuAX2|5yCM}eJLcu3*d9H6fU+A?br&sXxN$gD|pBA9@Vs01Zj(02uQrI0M8 zMGKbiB{Bgi1vyI1okVX;m?T}C1DL9``b z7WhdAt_(^<$+ql^zU&fy=}SA>a>Y6rwWz?r%xa-2_Gy)r@@gGHJEDU)B;%KXDbSC= zkfIAgE)!7(ZI}XV2$rQze8M*ZYhOGVM)n%wzo)Og{nXyCy)oQ>D?juW{f9RbsMLfnz-?5| z7Rb>rPWMU~8X()4iI4!T`6>$Oi^;)8;Y<2vzxHN6?na;S@ZVplP#}Jf(LHstJFsl3 zMC&plbd@f9+9HjmR59_;jSke3a%*B!j^*7n03cJR-HDnXzDs|ZLw~4aQM_|9Ir)^& zOP5Cc4|5bo7S%U8$l;0HoB7KdV8ar?_`s!vA53$>nb0Ok0Qx5L!42hI#!KK%o1s=E zfx$w1WM4C48HihDXgM z4oQ6ZZu%zT;yo-1@gH}qZh_4j3TB1uOqCXCPBr8bhjO~8NZ2ps7G5jj z7J}>djZo-!G6lJJK$m)6pgiBtl^H@2e%!?Rx)fM={r-08JK(0;F*liB}3^;1=RKSX=MM0E1UMB4uSg=#E1JlRyei^!oUQ4w|=fDX=D=$XuW|}St)(gX>*)>d){QA}0l6G2vpAAv5@u^gc z3N!=-SC>qve>DYQ-_}8cVQns0+h6M98t_qinRU=z++~q=U>z%_3=UTGonr^-}{0Fc7{<)^tE}m=s!ba#%veEGR zw}fu$m8JJf>UVRXc24Ph8nQanc=Jzg`r(%r>qc%pH}a#4bua3~0|lsUvV~VKHq!__do;;m;kUa!Ln*!a7@ zl*@B=uD?qMT2)q8Xg4G-pR@FS6ZyJK4sygtE12tqc)>Pf=-_*VNbshM+4s7wuu#+$j zylbyAIHkaY(04IQVZjY}Bm@q?d5JC^Phn-4Fno6;SD++)PFzCjvQc&G0?3L8{JkH7 zNkZ4~O?eQb{D^6hrN|^2lmKjk!G6$}BJF3>XM-ee8YAyoN#Zu>W8i*=a8wAGL~ezk zl|-M2w4-Rwit-tvz&Oxdl6o9)Kt9kHI%TE6b?})G_yeut9qfm|@N7kKG;r4o(UB!> zV8tV?ve+2u9hoi3-U^v#4|an+jW!MN9kspiS?YhhP%^ar9b70GeG4v>lv9TGg_6<# zk1mw->5e{KtoP167fPC9;sQT~+~F9Kb@8Wx%A^qZ!-d3KX3(Ddz%(66Y<+T+|&c@C;R zW2&0(CAO*Tww?7=Rr4KcKn|;{!+7lac~cc%Nf6`|Q~5E<*G^sv!t2vBTv8vQ`Kdhn zzp=TCf&FtZ#zrPK{w{&TLGVwKi>ApVM?9xM!YQm-t%gcjF5M|?8nzNIg&k6tO9FnI zFt&JKEeC92GJqvanA|Ijy3TUSq8;B95?5IAidJeu?9nC@nruP_YQlE1idl)BSCB-|_EOf5OrmKK(lpImaT%uKCaTj7tu`aU>|be}W=fE(kWTKRQ+@AWQCW$HKN3bCnZ zee5CD6c{<2>8DT_fA}U0(c3XU7Mnlw=h^8NWgXSV(b;Gia^Z+p zvFJNKUs4HPlzal3s>5{0qjVx;%5syfxZ}~+&(w;MM>bxchk6cXCWT}C%gZ`o_rvGd z0hpj2RhPGsn%bzc>4ON`DhqzE8h}Z#1B*i~V+cheegtpj^Pjg{9SHiOuY7BbjnU0u zuh76T4)(0_Vf~O0*q!JDL1!!o$ofjnz&-Z9eWgYnX zNaP3Ce+pED*)W7cw4rStFs^Aj@onirI)Ti;AD#Ht^8M(9WNFdoL4~YBP|hiefbL9v z7VUOqpeUA`X7eXqzo9lBaEyKz*VpsqMf903;u8GDIXORyxW7>cH=ur;&90vn(*zD= zFTMVHpZe^0!{Wi*@A5K#Rey+FTq9KMAj7|V?k2U87%%z?m2!^0?f^qCj&GLe8(;hj zrCxcIyNDG71CV^R9@`gz73-^nA|JJeS5#Dec0)Uh?=hF}(-r^T7SoBW z)d_~P^i;mkM`HN4r}SR=>d#8u5PNpf;6!laH5gpz_vaOdfAF3ZRFusk`3R;6b5EV_!WT5!`K zx_pue`ZSc@B|t@bEWT9OpUcvR7xC3Y$)#j&&(G7FJ|~xH!@s)@uyVZVP=xi|FJ;D~ zD!8fk`vZN#D<9daAIB%#VQHIIDIJm_pRnBy-FWx@=~Alo1E0$cAG-9Zxt9v-_viAw zZ%4M?nX4ugx|FRXvTog^Wd}DRr(LEV{Af4PnRzsp z7jopk9R+FXx(y9cW15aqcc2u479<=PO8J-dxX&k3QPlCH&7BcL7 zA*Q=iZbWCNBO)kfS|7K}?&0Z(>|^R87d6rJF);tN1=SEt z(E~~Lyud@v$ojRc!Fq#U-HTp@(W}fTGoa~E_2C%xs~x_Nin7d2GxA&w|h|R zuI<}*jGF3S#P1*Gw0{5owU6S#@`=Xw(y06J!!mw;y3^i% z(s}Sfr?IVk?dsL#72GwoyyD<%LMu~HdaO9C1##Nx=FL;i+#20t_x{VcqVANldhPQ2 zSFc^2S&{2F=awEj<;<*2pMYYeY8_=#4Lm-z^4Q$c>M3V>W(n=iRNp^;ZFOz#%G?Z^ zTAR9z98~T&(bjmvX&=OGL1op`fquxX?J!Xl+*0=bGZ1y%LWbTFWnfrR_m8(j?*|8k zVx{b~Un=*P=p)7Cv64=mFzvM$JQvpujEtUe8fA2-?Lgzy9zTGJqIJHU05=ho(5w&u zJT^wkE?=!zc8Hhj3$(;h@!yRxYsCJl4u zt;}Imadhm-sa2tLhqWqBW#EXA+}$AMa3r2D zZ{QdH9rx?IFty;JEX0F_bEr^p(^}j0UT-9A?0PGzUGm0hOrS{M@6ORH`ZCP-_@0=Qa|K-LQeg5DR-;4; zVMf9SJ9L_%JhjW}bRSbn8}=fU6hjDle>QTWdW2zNbnT$j(Mh|Xs?#+yl+rdwz^ zs#z!k<()O6hEJ@it6{d^8LdRMx_~=#=|F{FsnN<*lf%AZW!)TiKz-Cvr|sKo)zIEg z!D6&eHWE6)m9Q($<5LR&8FC3Yzz5L7+O@!}$lJqXgrBUYN;Qst`?p<7K^bNJ8WPi8 z0ZsAVFC}RTq|E@Kw9&y3Ij}7#XAhm|#)G%P`Ii=|#~J$Az0iX7bZh!fN>f@UUo|E} zyem)M!z9|o<|pd*gAUVr0QWml<3Ccnk*XBmnULmC0H!sE#>#eD1}-q23Gob{ z4QE??J$_Aw_ zpQ283Hf!bhVOkF+)?JrP8_QQ5XIaB!0JxR+6Y(jz2KP^|(rZ?oT{*D(=GVwdd~Fq( zC^il7hYPGx7(58V3JE#LUYS|N@H{y?v*h58ZLla9iMd4?H?&G$WtHMw>d6^;6cTrf zNT-~~=AJ+^)VozQHnrx=PCbEQD|1f}s;3UBrVYR*xTVHmA59^;N0@x>iu2^m1F&u{ zE#r-roGE^Ue!}X04>*Mpqqn11(z|fG4Ags0Fo5U&QCA@pQv1%-$_&PAOpR7`W_k`E zqSbHAFM>h5vUqKE_I6qV2XAcnf^&KK+ER6DWp0K{@FUBsYl}}qPMn=vePD6Xxje&f zMspx9MG__UgQdsz8=8HkYxV$e7KufGLar{)Ev>C$bXKX`LUd9Ma_%y{-!$<1{cTs# z|NGmVrI{yXDjc5XRcBeI|H=xB$XG)!E5N@r4~=G zu1!rZU?i8EnJZV|Y@kOH++e>2a7v}_S}a0kQX#mySRl(6^9m>3X4%lXk_EMwnEbqb zN0Y^vMv>cDbe48Vz7FUeV5iw7K1;TGA=SRU zb4q8@VWZx+ROBR;N5z&o-*S-?LaZ%w2Is^YVk2*Uw}PgTGaJ7XK{GIi{yw!!C^H#) y-tvc|3o*3Q;Q0z<`voWNJUf3Na_bod8u$I294nf!g$)2kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-MENU.;1 270108 +(FILECREATED " 1-Mar-2024 20:35:49" {WMEDLEY}tedit>TEDIT-MENU.;150 263731 - :PREVIOUS-DATE "14-Jul-2022 13:10:07" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-MENU.;3) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.APPLY.PARALOOKS) + + :PREVIOUS-DATE "27-Feb-2024 08:13:25" {WMEDLEY}tedit>TEDIT-MENU.;149) (PRETTYCOMPRINT TEDIT-MENUCOMS) (RPAQQ TEDIT-MENUCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) + [(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.PIECES - MBUTTON.NEXT.FIELD.AS.TEXT MBUTTON.NEXT.FIELD.AS.ATOM MBUTTON.SET.FIELD - MBUTTON.SET.NEXT.FIELD MBUTTON.SET.NEXT.BUTTON.STATE TEDITMENU.STREAM - \TEDITMENU.SELSCREENER) + 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] @@ -63,14 +65,14 @@ (COMS (* ;; "Text menu creation and support") - (FNS \TEXTMENU.START \TEXTMENU.DOC.CREATE TEXTMENU.CLOSEFN) + (FNS \TEDIT.MENU.START \TEDIT.MENU.BUTTONEVENTFN \TEXTMENU.DOC.CREATE) (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.SHOW.CHARLOOKS - \TEDIT.NEUTRALIZE.CHARLOOKS \TEDIT.FILL.IN.CHARLOOKS.MENU + \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 @@ -90,20 +92,87 @@ (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA]) - -(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(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)) -(CONSTANTS (\SCRATCHLEN 64)) +(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) + MBBUTTONEVENTFN _ 'MB.DEFAULTBUTTON.FN MBFONT _ (FONTCREATE 'HELVETICA 8 + 'BOLD)) + +(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%: 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)) ) +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) +) +(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))]) +) ) @@ -113,33 +182,30 @@ (DEFINEQ (MB.BUTTONEVENTINFN - [LAMBDA (OBJ STREAM SEL RELX RELY SELWINDOW TEXTSTREAM) (* ; "Edited 30-May-91 22:15 by jds") + [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. - Make sure that the button gets turned OFF when the mouse moves outside it.) + (* ;; "There was a buttn event inside a menu button. Turn the button OFF when the mouse moves outside it.") - (PROG [(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.) - - (RETURN '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.) - (RETURN T)) - (T (* He's moved outside the button. - Don't permit the selection.) - (RETURN 'DON'T]) + (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 11-Jan-89 16:58 by jds") + [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") @@ -147,32 +213,29 @@ (DISPLAY (* ;; "Going to the display. Use the cached bitmap version of the button") - [PROG (BITMAP DS (OBJBOX (IMAGEOBJPROP OBJ 'BOUNDBOX)) + [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] - [BITBLT BITMAP 0 0 STREAM X (SETQ Y (IDIFFERENCE Y (fetch YDESC of OBJBOX] - (* ; "Display the button's image") - (COND - ((EQ (IMAGEOBJPROP OBJ 'STATE) - 'ON) (* ; "If the button is ON, mark it so.") - (BITBLT NIL 0 0 STREAM X Y (fetch XSIZE of OBJBOX) + (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) - 'TEXTURE - 'INVERT BLACKSHADE]) - (PROG (BITMAP DS (FONT (IMAGEOBJPROP OBJ 'MBFONT)) - (TEXT (IMAGEOBJPROP OBJ 'MBTEXT)) - OLOOKS) (* ; - "Going to some output image stream. Use the actual text.") - (SETQ OLOOKS (DSPFONT (FONTCOPY FONT 'DEVICE STREAM) - STREAM)) (* ; + '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 TEXT STREAM) (* ; "Print the button text") - (DSPFONT OLOOKS STREAM) (* ; "And put the font back as it was.") - ]) + (PRIN1 (IMAGEOBJPROP OBJ 'MBTEXT) + STREAM))]) (MB.SETIMAGE [LAMBDA (OBJ) (* jds "23-Aug-84 13:22") @@ -198,45 +261,46 @@ (RETURN OBJ]) (MB.SELFN - [LAMBDA (OBJ SEL W FN) (* ; "Edited 30-May-91 22:15 by jds") - (* Calls a menu-button's associated - function, then turns off the - highlighting of the menu button.) - (PROG [(TSEL (create SELECTION)) - (BUTTONFN (OR FN (IMAGEOBJPROP OBJ 'MBFN] - (\COPYSEL SEL TSEL) (* Save the selection that points to - the menu button.) - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SET) of SEL with NIL) - (replace (SELECTION ONFLG) of SEL with NIL) (* Call the button's function) - (COND - ((NEQ (AND BUTTONFN (APPLY* BUTTONFN OBJ SEL W)) - 'DON'T) (* If the button fn left the selection - alone,) - (\FIXSEL TSEL (fetch (SELECTION \TEXTOBJ) of TSEL)) - (\SHOWSEL TSEL NIL NIL))) (* Turn off the button hilite) - ]) + [LAMBDA (OBJ SEL W FN) (* ; "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 (\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,") + (\FIXSEL TSEL) (* ; + "Turn off the button hilite. Perhaps the function changed something that changed the selection?") + (\SHOWSEL TSEL NIL)) + (SETSEL SEL SET NIL]) (MB.SIZEFN - [LAMBDA (OBJ STREAM CURX RIGHTMARGIN) (* jds "30-Aug-84 11:24") - (* Tell the size of a menu button) - (PROG ((FONT (IMAGEOBJPROP OBJ 'MBFONT)) - BOX) - [COND - ((DISPLAYSTREAMP STREAM) (* We're formatting for the DISPLAY) - ) - [(EQ 'INTERPRESS (IMAGESTREAMTYPE STREAM)) - (SETQ FONT (FONTCOPY FONT 'DEVICE 'INTERPRESS] - ((EQ 'PRESS (IMAGESTREAMTYPE STREAM)) - (SETQ FONT (FONTCOPY FONT 'DEVICE 'PRESS] - (SETQ BOX (create IMAGEBOX - XSIZE _ (STRINGWIDTH (IMAGEOBJPROP OBJ 'MBTEXT) - FONT) - YSIZE _ (FONTPROP FONT 'HEIGHT) - YDESC _ (FONTPROP FONT 'DESCENT) - XKERN _ 0)) - (IMAGEOBJPROP OBJ 'BOUNDBOX BOX) - (RETURN BOX]) + [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 DS OPERATION SEL) (* jds " 7-Feb-84 14:20") @@ -256,35 +320,38 @@ IMAGEOBJFNS _ (fetch (IMAGEOBJ IMAGEOBJFNS) of OBJ]) (MB.GETFN - [LAMBDA (OBJ FILE) (* ; "Edited 20-Aug-87 16:17 by jds") + [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.) - (ERROR) + (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)) - (\SMALLPOUT FILE (FONTPROP FONT 'SIZE)) + (\WOUT FILE (FONTPROP FONT 'SIZE)) (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) (MB.PUTFN - [LAMBDA (OBJ FILE) (* ; "Edited 20-Aug-87 16:17 by jds") + [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 "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)) - (\SMALLPOUT FILE (FONTPROP FONT 'SIZE)) + (\WOUT FILE (FONTPROP FONT 'SIZE)) (for ATTR in (FONTPROP FONT 'FACE) do (\ATMOUT FILE ATTR]) (MB.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 11-Jan-89 16:35 by jds") + [LAMBDA (OBJ SEL ON DS) (* ; "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") @@ -293,14 +360,11 @@ (fetch (IMAGEBOX YSIZE) of OBJBOX) 'INPUT 'REPLACE) - (COND - ((OR ON (EQ (IMAGEOBJPROP OBJ 'STATE) - 'ON)) - (BITBLT NIL 0 (fetch (IMAGEBOX YDESC) of OBJBOX) - DS 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) + (CL:WHEN (OR ON (EQ (IMAGEOBJPROP OBJ 'STATE) + 'ON)) + (BLTSHADE BLACKSHADE DS 0 0 (fetch (IMAGEBOX XSIZE) of OBJBOX) (fetch (IMAGEBOX YSIZE) of OBJBOX) - 'TEXTURE - 'INVERT BLACKSHADE]) + 'INVERT))]) (MBUTTON.CREATE [LAMBDA (MBTEXT MBFN MBFONT IMAGEFNS) (* ; "Edited 11-Jan-89 16:10 by jds") @@ -335,104 +399,85 @@ (TEDIT.OBJECT.CHANGED TEXTOBJ OBJ]) (MBUTTON.FIND.BUTTON - [LAMBDA (LABEL TEXTSTREAM CH#) (* ; "Edited 22-Apr-93 15:40 by jds") - (* "27-Sep-84 00:52" gbn) + [LAMBDA (LABEL TEXTSTREAM CH#) (* ; "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 no containing the imageobj with MBTEXT prop LABEL) + (* ;; "Returns the piece containing the imageobj with MBTEXT prop LABEL") - (PROG ((LABELATOM (MKATOM LABEL)) - OBJ STARTPCNO (PCTB (fetch (TEXTOBJ PCTB) of (TEXTOBJ TEXTSTREAM))) - START-OF-PIECE PC) - (RETURN (first (SETQ PC (\CHTOPC (OR CH# 1) - PCTB T)) while (AND PC (NOT (ATOM PC))) - do (SETQ OBJ (fetch (PIECE POBJ) of PC)) - (COND - ([AND OBJ (EQ LABELATOM (MKATOM (IMAGEOBJPROP OBJ 'MBTEXT] - (RETURN PCNO))) - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) + (for (PC _ (\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 22-Apr-93 16:39 by jds") + [LAMBDA (TEXTOBJ CH#) (* ; "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") - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - START-OF-PIECE) - (RETURN (bind PC OBJ first (SETQ PC (\CHTOPC CH# PCTB T)) - while (AND PC (NOT (ATOM PC))) do (* ; - "Loo thru the piece table, looking for pieces with objects in them") - (SETQ OBJ (fetch (PIECE POBJ) of PC)) - [COND - ((AND OBJ (OR (type? MBUTTON OBJ) - (type? MARGINBAR OBJ) - (type? NWAYBUTTON OBJ))) - (* ; - "Which are some kind of menu-buttonish object") - (RETURN (CONS OBJ START-OF-PIECE] - (add START-OF-PIECE (fetch (PIECE PLEN) - of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) + (for (PC _ (\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 (\PCTOCH PC TEXTOBJ]) (MBUTTON.FIND.NEXT.FIELD - [LAMBDA (TEXTOBJ CH# DON'TFIX) (* ; "Edited 22-Apr-93 16:53 by jds") + [LAMBDA (TEXTOBJ CH# DONTFIX) (* ; "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") - (* ;; "Starting from CH#, find the next fill-in area (usually surrounded by a {-} pair), and select any text it contains. Returns the TEXTOBJ's SCRATCHSEL with the text selected. (If no insert point is found, NIL.)") + (* ;; "Scan forward from CH# to the next type-in field. If found, sets SCRATCHSEL to the text inside the field") - (PROG ((PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - CH1 PCNO PCNO1 PC CH LEN START-OF-PIECE (DEPTH 0)) - (COND - ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; + (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))) - (SETQ PC (\CHTOPC CH# PCTB T)) - (while PC do (* ; - "Look thru the pieces for one which starts a user-fill-in area") - (COND - ((fetch (CHARLOOKS CLSELHERE) of (fetch (PIECE PLOOKS) of PC)) - (* ; "Found it, so return") - (RETURN))) - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (COND - (PC (* ; - "We found a starting point for a type-in field") - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ CH1 START-OF-PIECE) (* ; - "Remember the starting character number") - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (while PC do (COND - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) - of PC)) - (RETURN))) - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (SETQ LEN (IDIFFERENCE START-OF-PIECE CH1)) - (replace (SELECTION CH#) of SCRATCHSEL with CH1) - (replace (SELECTION CHLIM) of SCRATCHSEL with (IPLUS CH1 (IMAX 0 LEN))) - (replace (SELECTION DCH) of SCRATCHSEL with LEN) - (replace (SELECTION SELOBJ) of SCRATCHSEL with NIL) - (replace (SELECTION POINT) of SCRATCHSEL with 'LEFT) - (* ; - "So if it's used, it'll be in the correct spot.") - (replace (SELECTION SELKIND) of SCRATCHSEL with 'CHAR)) - (T (* ; - "No fill-in blank found, so return an indication.") - (RETURN NIL))) - (COND - ((NOT DON'TFIX) - (\FIXSEL SCRATCHSEL TEXTOBJ))) + (RETURN NIL)) + + (* ;; + "Find the start of the field. CLSELHERE is set for the prefix {, since the field may be empty") + + (for old PC inpieces (\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 (* jds "12-Feb-85 14:32") + [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) - 'MB.COPYFN + (FUNCTION MB.COPYFN) (FUNCTION MB.BUTTONEVENTINFN) 'NILL 'NILL @@ -440,25 +485,24 @@ 'NILL 'NILL (FUNCTION MB.WHENOPERATEDFN) - 'NIL + (FUNCTION NILL) 'TEditMenuButton]) (MBUTTON.NEXT.FIELD.AS.NUMBER - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") + [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) - (NUMBERP (MKATOM (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ]) - -(MBUTTON.NEXT.FIELD.AS.PIECES - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 30-Mar-94 16:02 by jds") - - (* ;; - "Find the next fill-in field in the menu after CH#, and return its contents as A LIST OF PIECES.") - - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH# T) - (TEDIT.SELECTED.PIECES TEXTOBJ (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - NIL - 'CL:IDENTITY]) + (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") @@ -470,72 +514,66 @@ (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ]) (MBUTTON.NEXT.FIELD.AS.ATOM - [LAMBDA (TEXTOBJ CH#) (* ; "Edited 12-Jun-90 19:00 by mitani") + [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.) + (* ;; "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 blank.) - (PROG [(STR (TEDIT.SEL.AS.STRING (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ] - (COND - ((ZEROP (NCHARS STR)) (* The field is empty.) - (RETURN NIL)) - (T (* It's non-empty. Convert the string - to an atom.) - (RETURN (MKATOM STR]) + (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 22-Apr-93 10:56 by jds") + [LAMBDA (TEXTSTREAM FIELD VALUE) (* ; "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.") - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - PCTB OBJ SAVED.SEL FIELD.SEL PCNO NEW-STRING) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ PCNO (MBUTTON.FIND.BUTTON FIELD TEXTSTREAM)) - (COND - (PCNO [SETQ FIELD.SEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (fetch (PCTNODE CHNUM) - of (FINDNODE-INDEX PCTB PCNO] + (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 (\PCTOCH PC TEXTOBJ))) (* ;  "select the field following this button.") - (COND - (FIELD.SEL (* ; + (CL:WHEN FIELD.SEL (* ;  "there are contents to set for this button") - (\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)) (* ; + (\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]) + (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 30-May-91 22:15 by jds") + [LAMBDA (TEXTOBJ CH# NEWVALUE DONTUPDATESCREEN) (* ; "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) + (* ;; "SET the text content of the next fill-in field in this document to be NEWVALUE. Perhaps SHOULDNT if it can't find one?") - (PROG ((SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ))) - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) (* Find the next menu fill-in field) - (\FIXSEL SCRATCHSEL TEXTOBJ) - - (* Fix up the SELECTION that describes its contents, so we've got the right - screen coordinates &c) - - (OR (ZEROP (fetch (SELECTION DCH) of SCRATCHSEL)) - (\TEDIT.DELETE SCRATCHSEL TEXTOBJ T)) (* If there is text in that fill-in, - delete it to make room for ours) - (COND - (NEWVALUE (* Only insert something if there IS - something to insert.) - (TEDIT.\INSERT (MKSTRING NEWVALUE) - SCRATCHSEL TEXTOBJ))) (* Then fill it with out new value.) - ]) + (LET (FIELDSEL) + (CL:WHEN (SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)) + (\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") @@ -549,46 +587,13 @@ (RETURN (ADD1 (CDR NEXTB]) (TEDITMENU.STREAM - [LAMBDA (TEXTSTREAM) (* jds "13-Aug-84 14:10") - (* returns the textstream of the - teditmenu attached to this stream if - any) - (PROG (MENUW (MAINWINDOW (\TEDIT.MAINW TEXTSTREAM))) - [SETQ MENUW (for W in (ATTACHEDWINDOWS MAINWINDOW) - thereis (AND (WINDOWPROP W 'TEDITMENU) - (EQUAL (WINDOWPROP W 'TITLE) - "TEdit Menu"] - (RETURN (COND - (MENUW (TEXTSTREAM MENUW]) + [LAMBDA (TEXTSTREAM) (* ; "Edited 10-Apr-2023 09:53 by rmk") + (* jds "13-Aug-84 14:10") -(\TEDITMENU.SELSCREENER - [LAMBDA (TEXTOBJ SEL SELECTMODE FINAL?) (* ; "Edited 30-May-91 22:15 by jds") + (* ;; "returns the textstream of the teditmenu attached to this stream if any") - (* Called to screen potential selections in the TEdit menu window; - if an edit op is in progress, no selection will be permitted.-) - - (PROG ((MAINW (WINDOWPROP (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - 'MAINWINDOW)) - MAINTEXT) - (SETQ MAINTEXT (WINDOWPROP MAINW 'TEXTOBJ)) - (COND - ((AND (EQ (fetch (SELECTION CH#) of SEL) - (fetch (SELECTION CH#) of TEDIT.SCRATCHSELECTION)) - (EQ (fetch (SELECTION DCH) of SEL) - (fetch (SELECTION DCH) of TEDIT.SCRATCHSELECTION)) - (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT)) - (\COPYSEL SEL TEDIT.SCRATCHSELECTION) - (RETURN 'DON'T)) - ((EQ (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) - T) - (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T) - (RETURN 'DON'T)) - ((fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) - " in progress; please wait.") - T) - (\COPYSEL SEL TEDIT.SCRATCHSELECTION) - (RETURN 'DON'T]) + (for W in (ATTACHEDWINDOWS (\TEDIT.MAINW TEXTSTREAM)) when (TEDITMENUP W "TEdit Menu") + do (RETURN (TEXTSTREAM W]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -637,23 +642,25 @@ (RETURN OBJ]) (MB.THREESTATE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* jds "30-Aug-84 13:53") - (* Display the innards of a menu - button) + [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.) + (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.) + ((SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE)) (* ; + "The image bitmap exists already. Use it.") ) - (T (* Need to create an image for this - object.) + (T (* ; + "Need to create an image for this object.") (SETQ BITMAP (BITMAPCREATE X Y)) (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) (SETQ DS (DSPCREATE BITMAP)) @@ -667,111 +674,110 @@ (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) - (BITBLT NIL 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'TEXTURE 'INVERT BLACKSHADE)) - (OFF (* The button is OFF. - Mark it with a diagonal line thru it.) + (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.)) + (NEUTRAL (* ; + "The button is neutral. Just display it regular.")) NIL]) (MB.THREESTATE.SHOWSELFN - [LAMBDA (OBJ SEL ON DS) (* ; "Edited 30-May-91 22:16 by jds") - (PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ DS] - (COND - (ON (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from ON to NEUTRAL) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) + [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) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from OFF to ON) + '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) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (NEUTRAL (* Switch from NEUTRAL to OFF) - (DRAWLINE 0 0 (SUB1 (fetch XSIZE of IMAGEBOX)) - (SUB1 (fetch YSIZE of IMAGEBOX)) - 1 - 'PAINT DS)) - NIL)) - ((fetch (SELECTION SET) of SEL) - (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from NEUTRAL to ON) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from ON to OFF) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE) - (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]) + 'REPLACE)) + NIL]) (MB.THREESTATE.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") - (* Handle operations on a three-state - button) + [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) + (HIGHLIGHTED (* ; "It is being hilighted") (MB.THREESTATE.SHOWSELFN OBJ SEL T DS)) - (UNHIGHLIGHTED (* And being de-hilighted) + (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) - (replace (SELECTION SET) of SEL with NIL) (* And mar the selection turned off, - so others can use it without trashing - us) - (replace (SELECTION ONFLG) of SEL with NIL) - (replace (SELECTION SET) of TEDIT.SELECTION with NIL)) + (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 30-May-91 22:16 by jds") - (* MBFN for TEdit default menu item - buttons.) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) - OFILE CH NEWSTATE) - (SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (OFF 'ON) - (ON 'NEUTRAL) - (NEUTRAL 'OFF) - 'ON)) - (if STATECHANGEFN - then (* apply the user supplied state - change fn if she supplied one) - (APPLY* STATECHANGEFN OBJ NEWSTATE (TEXTSTREAM TEXTOBJ))) - (IMAGEOBJPROP OBJ 'STATE NEWSTATE) - (replace (SELECTION ONFLG) of SEL with NIL]) + [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") @@ -901,18 +907,21 @@ NIL NIL 'INVERT 'REPLACE]) (MB.NB.WHENOPERATEDFN - [LAMBDA (OBJ DS OPERATION SEL) (* ; "Edited 30-May-91 22:16 by jds") + [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))) - (UNHIGHLIGHTED (* (MB.SHOWSELFN OBJ SEL NIL DS))) - (SELECTED (* There may be a side-effect to occur - upon selection.) - [PROG ((STATE (IMAGEOBJPROP OBJ 'STATE)) - FN) - (for BUTTON in (IMAGEOBJPROP OBJ 'BUTTONS) as SIDEFN - in (IMAGEOBJPROP OBJ 'SIDEEFFECTFNS) when (EQ STATE BUTTON) - do (COND - (SIDEFN (MB.SELFN OBJ SEL DS SIDEFN] + (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]) @@ -977,37 +986,40 @@ (RETURN BOX]) (MB.NWAYBUTTON.SELFN - [LAMBDA (OBJ W SEL MOUSEX MOUSEY) (* ; "Edited 30-May-91 22:16 by jds") - (* Selecting an NWAY button.) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (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) - (RETURN T]) + [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") @@ -1178,25 +1190,28 @@ (RETURN OBJ]) (\TEXTMENU.TOGGLE.DISPLAY - [LAMBDA (OBJ STREAM MODE) (* gbn "27-Sep-84 01:23") - (* "27-Sep-84 01:11" gbn) - (* Display the innards of a menu - toggle) + [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) - (OR OBJBOX (SETQ OBJBOX (MB.SIZEFN OBJ STREAM))) (* Make sure the size is set.) + (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.) + (* ; + "The image bitmap exists already. Use it.") ) - (T (* Need to create an image for this - object.) + (T (* ; + "Need to create an image for this object.") (SETQ BITMAP (BITMAPCREATE X Y)) (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) (SETQ DS (DSPCREATE BITMAP)) @@ -1210,76 +1225,50 @@ (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) - (BITBLT NIL 0 0 STREAM CURX (IDIFFERENCE CURY (fetch YDESC of OBJBOX)) - X Y 'TEXTURE 'INVERT BLACKSHADE)) - (OFF (* The button is OFF. - Just display it regular.)) + (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 30-May-91 22:16 by jds") - (PROG [(IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ DS] - (COND - (ON (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from ON to - (NEUTRAL (* Switch from OFF to NEUTRAL) - (BITBLT (IMAGEOBJPROP OBJ - (QUOTE BITCACHE)) 0 0 DS 0 0 - (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - (QUOTE INPUT) (QUOTE REPLACE)))) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from OFF to ON) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - NIL)) - ((fetch (SELECTION SET) of SEL) - (SELECTQ (IMAGEOBJPROP OBJ 'STATE) - (ON (* Switch from OFF to ON) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - (OFF (* Switch from ON to OFF) - (BITBLT NIL 0 0 DS 0 0 (fetch XSIZE of IMAGEBOX) - (fetch YSIZE of IMAGEBOX) - 'TEXTURE - 'INVERT BLACKSHADE)) - NIL]) + [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 30-May-91 22:16 by jds") - (* Handle operations on a three-state - button) + [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) + (HIGHLIGHTED (* ; "It is being hilighted") (\TEXTMENU.TOGGLE.SHOWSELFN OBJ SEL T DS)) - (UNHIGHLIGHTED (* And being de-hilighted) + (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) - (replace (SELECTION SET) of SEL with NIL) (* And mar the selection turned off, - so others can use it without trashing - us) - (replace (SELECTION ONFLG) of SEL with NIL) - (replace (SELECTION SET) of TEDIT.SELECTION with NIL)) + (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 30-May-91 22:16 by jds") + [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 \TEXTOBJ) of SEL)) + (PROG ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) (STATECHANGEFN (IMAGEOBJPROP OBJ 'STATECHANGEFN)) OFILE CH NEWSTATE) (SETQ NEWSTATE (SELECTQ (IMAGEOBJPROP OBJ 'STATE) @@ -1312,25 +1301,22 @@ 'ToggleButton]) (\TEXTMENU.SET.TOGGLE - [LAMBDA (TEXT VALUE TEXTSTREAM) (* ; "Edited 12-Jun-90 19:02 by mitani") + [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) +(* ;;; "finds the button with MBTEXT field TEXT in TEXTSTREAM and sets its state to VALUE") - (PROG ((PCNO (MBUTTON.FIND.BUTTON TEXT TEXTSTREAM)) - OBJ PC) - (COND - ((NOT PCNO) - (ERROR TEXT " was not found as a button."))) - [SETQ OBJ (fetch (PIECE POBJ) of (SETQ PC (fetch (PCTNODE PCE) - of (FINDNODE-INDEX (fetch (TEXTOBJ PCTB) - of (TEXTOBJ TEXTSTREAM)) - PCNO] - (IMAGEOBJPROP OBJ 'STATE VALUE) - (IMAGEOBJPROP OBJ 'BITCACHE 'JUNK) - (for WINDOW inside (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM)) - do (\TEDIT.REPAINTFN WINDOW)) - (RETURN 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 @@ -1351,7 +1337,8 @@ (DEFINEQ (DRAWMARGINSCALE - [LAMBDA (W UNIT) (* ; "Edited 12-Jun-90 18:59 by mitani") + [LAMBDA (W UNIT) (* ; "Edited 20-Nov-2023 14:49 by rmk") + (* ; "Edited 12-Jun-90 18:59 by mitani") (* ;; " Draw the margin-bar scale -- the markings across the bottom of the margin bar that show you the margin values. Draws the scale in window W, according to UNIT = 1 for points, or 12 for picas.") @@ -1373,33 +1360,32 @@ (COND ((ZEROP (IREMAINDER (IDIFFERENCE X 4) 72)) - (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) + (BLTSHADE BLACKSHADE W X 8 1 16 'REPLACE) (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH (IDIFFERENCE X 4)) 1)) 10 W) (PRIN1 (IDIFFERENCE X 4) W)) - (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE]) + (T (BLTSHADE BLACKSHADE W X 20 1 4 'REPLACE]) (12 (* ; "Picas") (for X from 4 by 12 to (fetch (REGION WIDTH) of WREG) as NOMX from 0 do (* ;; "Put a tick every half-pica, with a number every inch.") - (COND + [COND ((ZEROP (IREMAINDER NOMX 6)) - (BITBLT NIL 0 0 W X 8 1 16 'TEXTURE 'REPLACE BLACKSHADE) + (BLTSHADE BLACKSHADE W X 8 1 16 'REPLACE) (MOVETO (IDIFFERENCE X (LRSH (STRINGWIDTH NOMX) 1)) 10 W) (PRIN1 NOMX W)) - (T (BITBLT NIL 0 0 W X 20 1 4 'TEXTURE 'REPLACE BLACKSHADE))) - (BITBLT NIL 0 0 W (IPLUS X 6) - 22 1 2 'TEXTURE 'REPLACE BLACKSHADE))) + (T (BLTSHADE BLACKSHADE W X 20 1 4 'REPLACE] + (BLTSHADE BLACKSHADE W (IPLUS X 6) + 22 1 2 'REPLACE))) NIL) - (BITBLT NIL 0 0 W 4 23 (fetch (REGION WIDTH) of WREG) + (BLTSHADE BLACKSHADE W 4 23 (fetch (REGION WIDTH) of WREG) 1 - 'TEXTURE - 'REPLACE BLACKSHADE) + 'REPLACE) (MOVETO 0 0 W) (RELDRAWTO (IDIFFERENCE (fetch (REGION WIDTH) of WREG) 2) @@ -1418,9 +1404,12 @@ (DSPOPERATION OLDOP W]) (MARGINBAR - [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Given a set of margins and a unit, - show the margin bar properly) + [LAMBDA (W L1 LN R TABS UNIT UPDATE RIGHTLIM) (* ; "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") + (* ; + "Given a set of margins and a unit, show the margin bar properly") (PROG ((OLDOP (DSPOPERATION 'ERASE W)) (SCALEDL1 (MSCALE L1 UNIT)) (SCALEDLN (MSCALE LN UNIT)) @@ -1428,59 +1417,51 @@ (FLOATINGRIGHT NIL) (EXTENDEDRIGHT NIL) UNSETL1 UNSETLN) - (OR UPDATE (DRAWMARGINSCALE W UNIT)) - (DSPFONT (FONTCREATE 'GACHA 10) + (CL:UNLESS UPDATE (DRAWMARGINSCALE W UNIT)) + (DSPFONT (FONTCREATE 'TERMINAL 10) W) (SETQ L1 (MKSTRING (ABS L1))) (SETQ LN (MKSTRING (ABS LN))) (SETQ R (MKSTRING (ABS R))) [COND - [(ILESSP SCALEDR 4) (* Unset right margin. - Show specially, but at its usual - place.) + [(ILESSP SCALEDR 4) (* ; + "Unset right margin. Show specially, but at its usual place.") (SETQ FLOATINGRIGHT T) (SETQ SCALEDR (IPLUS 4 (IDIFFERENCE 4 SCALEDR] - ((ILEQ SCALEDR 4) (* Floating right margin => marked - specially) + ((ILEQ SCALEDR 4) (* ; + "Floating right margin => marked specially") (SETQ FLOATINGRIGHT T) (SETQ SCALEDR RIGHTLIM)) - ((IGREATERP SCALEDR RIGHTLIM) (* Not floating, so just limit it to - the rightmost that can be seen.) + ((IGREATERP SCALEDR RIGHTLIM) (* ; + "Not floating, so just limit it to the rightmost that can be seen.") (SETQ EXTENDEDRIGHT T) (SETQ SCALEDR (IDIFFERENCE RIGHTLIM 8] - [COND - ((ILESSP SCALEDL1 4) (* Unset right FIRST LEFT margin. - Show specially, but at its usual - place.) + (CL:WHEN (ILESSP SCALEDL1 4) (* ; + "Unset right FIRST LEFT margin. Show specially, but at its usual place.") (SETQ UNSETL1 T) - (SETQ SCALEDL1 (IPLUS 4 (IDIFFERENCE 4 SCALEDL1] - [COND - ((ILESSP SCALEDLN 4) (* Unset LEFT margin. - Show specially, but at its usual - place.) + (SETQ SCALEDL1 (IPLUS 4 (IDIFFERENCE 4 SCALEDL1)))) + (CL:WHEN (ILESSP SCALEDLN 4) (* ; + "Unset LEFT margin. Show specially, but at its usual place.") (SETQ UNSETLN T) - (SETQ SCALEDLN (IPLUS 4 (IDIFFERENCE 4 SCALEDLN] - (BITBLT NIL 0 0 W 1 26 (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL W)) - 3) + (SETQ SCALEDLN (IPLUS 4 (IDIFFERENCE 4 SCALEDLN)))) + (BLTSHADE WHITESHADE W 1 26 (IDIFFERENCE (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL W) + ) + 3) 32 - 'TEXTURE - 'REPLACE WHITESHADE) - (BITBLT NIL 0 0 W SCALEDL1 42 (IDIFFERENCE SCALEDR SCALEDL1) + 'REPLACE) + (BLTSHADE BLACKSHADE W SCALEDL1 42 (IDIFFERENCE SCALEDR SCALEDL1) 16 - 'TEXTURE - 'REPLACE BLACKSHADE) - (BITBLT NIL 0 0 W SCALEDLN 26 (IDIFFERENCE SCALEDR SCALEDLN) + 'REPLACE) + (BLTSHADE BLACKSHADE W SCALEDLN 26 (IDIFFERENCE SCALEDR SCALEDLN) 16 - 'TEXTURE - 'REPLACE BLACKSHADE) + 'REPLACE) (COND - (UNSETL1 (* 1st left margin isn't set, tho it - has a value. Mark it neutral) - (BITBLT NIL 0 0 W SCALEDL1 42 (IPLUS (STRINGWIDTH L1 W) - 2) + (UNSETL1 (* ; + "1st left margin isn't set, tho it has a value. Mark it neutral") + (BLTSHADE EDITGRAY W SCALEDL1 42 (IPLUS (STRINGWIDTH L1 W) + 2) 16 - 'TEXTURE - 'REPLACE EDITGRAY) + 'REPLACE) (DSPOPERATION 'PAINT W) (MOVETO (IPLUS SCALEDL1 2) 44 W) @@ -1490,13 +1471,12 @@ 44 W) (PRIN1 L1 W))) (COND - (UNSETLN (* left margin isn't set, tho it has a - value. Mark it neutral) - (BITBLT NIL 0 0 W SCALEDLN 26 (IPLUS (STRINGWIDTH LN W) - 2) + (UNSETLN (* ; + "left margin isn't set, tho it has a value. Mark it neutral") + (BLTSHADE EDITGRAY W SCALEDLN 26 (IPLUS (STRINGWIDTH LN W) + 2) 16 - 'TEXTURE - 'REPLACE EDITGRAY) + 'REPLACE) (DSPOPERATION 'PAINT W) (MOVETO (IPLUS SCALEDLN 2) 28 W) @@ -1506,20 +1486,18 @@ 28 W) (PRIN1 LN W))) [COND - (FLOATINGRIGHT (* Floating right margin is marked by - a light gray marker) - (BITBLT NIL 0 0 W (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W) - 2)) + (FLOATINGRIGHT (* ; + "Floating right margin is marked by a light gray marker") + (BLTSHADE EDITGRAY W (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W) + 2)) 26 (IPLUS (STRINGWIDTH R W) 2) 32 - 'TEXTURE - 'REPLACE EDITGRAY) + 'REPLACE) (DSPOPERATION 'PAINT W)) - (EXTENDEDRIGHT (* A non-visible right margin is - marked by two wavy lines indicating a - break) + (EXTENDEDRIGHT (* ; + "A non-visible right margin is marked by two wavy lines indicating a break") (BITBLT TEDIT.EXTENDEDRIGHTMARK 0 0 W SCALEDR 26 8 32 'INPUT 'REPLACE] (MOVETO (IDIFFERENCE SCALEDR (IPLUS (STRINGWIDTH R W) 2)) @@ -1527,9 +1505,8 @@ (PRIN1 R W) (DSPOPERATION OLDOP W) (COND - ((EQ TABS 'NEUTRAL) (* All tabs have been neutralized. - Just lay down a grey pattern over - them.) + ((EQ TABS 'NEUTRAL) (* ; + "All tabs have been neutralized. Just lay down a grey pattern over them.") (DSPFILL (create REGION LEFT _ 2 BOTTOM _ 1 @@ -1548,8 +1525,8 @@ 4)) WHITESHADE 'REPLACE W) - (for TAB in TABS do (* Run thru the tabs, putting them - down in place.) + (for TAB in TABS do (* ; + "Run thru the tabs, putting them down in place.") (MB.MARGINBAR.SHOWTAB W TAB UNIT 'PAINT]) (MARGINBAR.CREATE @@ -1611,186 +1588,190 @@ (RETURN OBJ]) (MB.MARGINBAR.SELFN - [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* ; "Edited 12-Jun-90 18:59 by mitani") + [LAMBDA (OBJ SELWINDOW SEL RELX RELY STREAM ORIGX ORIGY) (* ; "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.") - (PROG [(OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) - (IMAGEBOX (OR (IMAGEOBJPROP OBJ 'BOUNDBOX) - (IMAGEBOX OBJ STREAM 'DISPLAY] - (PROG ((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)) + [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) (* ; + (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") + (SETQ L1 (MINUS L1] (COND - ((EQ (fetch MARTABS of OBJDATUM) - 'NEUTRAL) (* ; + ((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) + (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) (* ; + (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) - 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))) + )) + (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) + 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] T]) (MB.MARGINBAR.SIZEFN @@ -1804,9 +1785,10 @@ (RETURN BOX]) (MB.MARGINBAR.DISPLAYFN - [LAMBDA (OBJ STREAM MODE) (* ; "Edited 12-Jun-90 18:59 by mitani") - (* Display the innards of a menu - button) + [LAMBDA (OBJ STREAM MODE) (* ; "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))) (OBJDATUM (IMAGEOBJPROP OBJ 'OBJECTDATUM)) @@ -1816,16 +1798,14 @@ (COND [[SETQ WASON (SETQ BITMAP (IMAGEOBJPROP OBJ 'BITCACHE] - (* 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] - (T (* Have to create an image for the - margin bar) + (T (* ; + "Have to create an image for the margin bar") (SETQ BITMAP (BITMAPCREATE (fetch XSIZE of IMAGEBOX) (fetch YSIZE of IMAGEBOX))) - (* Create a cache bitmap) + (* ; "Create a cache bitmap") (IMAGEOBJPROP OBJ 'BITCACHE BITMAP) (SETQ DS (DSPCREATE BITMAP)) (IMAGEOBJPROP OBJ 'DSPCACHE DS) @@ -1844,7 +1824,7 @@ (fetch (MARGINBAR MARUNIT) of OBJDATUM) (OR WASON (IMAGEOBJPROP OBJ 'NEEDSUPDATE NIL)) (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL STREAM))) - (* Update the image, if it needs it) + (* ; "Update the image, if it needs it") (BITBLT BITMAP 0 0 STREAM (IDIFFERENCE (DSPXPOSITION NIL STREAM) 4) (IDIFFERENCE (DSPYPOSITION NIL STREAM) @@ -1904,20 +1884,18 @@ NIL]) (MB.MARGINBAR.TABTRACK - [LAMBDA (STREAM OBJ TAB) (* jds " 8-Feb-84 20:38") + [LAMBDA (STREAM OBJ TAB) (* ; "Edited 20-Nov-2023 10:51 by rmk") + (* jds " 8-Feb-84 20:38") - (* Given that the mouse is down over a tab, track the tab as the mouse moves.) + (* ;; "Given that the mouse is down over a tab, track the tab as the mouse moves.") - (PROG ((UNIT (fetch MARUNIT of OBJ)) - (CLIP (DSPCLIPPINGREGION NIL STREAM)) - (OLDX (MSCALE (fetch TABX of TAB) - (fetch MARUNIT of OBJ))) - X) - (while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? CLIP (LASTMOUSEX STREAM) - (LASTMOUSEY STREAM))) do (COND - ([NOT (IEQP OLDX (SETQ X (LASTMOUSEX STREAM] - (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT + (bind X (UNIT _ (fetch MARUNIT of OBJ)) + (CLIP _ (DSPCLIPPINGREGION NIL STREAM)) + (OLDX _ (MSCALE (fetch TABX of TAB) + (fetch MARUNIT of OBJ))) while (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) + (INSIDE? CLIP (LASTMOUSEX STREAM) + (LASTMOUSEY STREAM))) + unless (IEQP OLDX (SETQ X (LASTMOUSEX STREAM))) do (MB.MARGINBAR.SHOWTAB STREAM TAB UNIT 'ERASE) (replace TABX of TAB with (MDESCALE X UNIT)) @@ -1926,43 +1904,36 @@ (SETQ OLDX X]) (\TEDIT.TABTYPE.SET - [LAMBDA (OBJ SEL W) (* ; + [LAMBDA (OBJ SEL W) (* ; "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.) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - STATE DOTTEDBUTTON) - (SETQ STATE (IMAGEOBJPROP OBJ 'STATE)) (* Find out roughly what kind of TAB - this is to be.) - [SETQ STATE (U-CASE (COND - ((LISTP STATE) - (CAR STATE)) - (T STATE] (* Make sure it's upper case, and an - atom.) - (SETQ DOTTEDBUTTON (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))) - (* Find out if this is to be a tab - with a dotted leader.) - [COND - ((EQ (IMAGEOBJPROP DOTTEDBUTTON 'STATE) - 'ON) (* Yes. Make this a DOTTEDxxx tab.) - (SETQ STATE (PACK* 'DOTTED STATE] - (TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PC PCNO FNARG) - (* Now run thru the rest of the document until we find the margin bar. - Replace the tab type of that margin bar with the new type.) + (* ;; "Change the kind of TAB that will be set in the succeeding marginbar.") - (COND - ((AND (IGREATERP CH# (CAR FNARG)) - (fetch (PIECE POBJ) of PC) - (type? MARGINBAR (fetch (PIECE POBJ) - of PC))) - (replace MARTABTYPE - of (IMAGEOBJPROP (fetch (PIECE POBJ) - of PC) - 'OBJECTDATUM) with (CDR FNARG)) - 'STOP] - (CONS CH# STATE]) + (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 _ (\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") @@ -2019,233 +1990,220 @@ (DEFINEQ -(\TEXTMENU.START - [LAMBDA (MENU MAINWINDOW TITLE HEIGHT) (* ; "Edited 26-Oct-2021 08:43 by rmk:") +(\TEDIT.MENU.START + [LAMBDA (MENUSTREAM MAINWINDOW TITLE HEIGHT TYPE) (* ; "Edited 27-Feb-2024 08:12 by rmk") + (* ; "Edited 3-Nov-2023 22:23 by rmk") + (* ; "Edited 31-Oct-2023 08:59 by rmk") + (* ; "Edited 10-Apr-2023 09:46 by rmk") + (* ; "Edited 26-Oct-2021 08:43 by rmk:") (* ;  "Edited 4-Jun-93 11:59 by sybalsky:mv:envos") - (* ;; "Create a TEdit-based menu for a given main window.") + (* ;; "Create a TEdit-based menu for a given main window. Creates a Tedit process and window for the menu, attaches it to MAINWINDOW and cause it to share the main windows prompt (so messages will come out in the right place).") (* ;; "RMK: Add MAX/MINSIZE so menus don't grow vertically when the main window is reshaped. Not sure why HEIGHT is passed in or defaults to 133, but either way, the original window height should persist") - (PROG ([WREG (COND - (MAINWINDOW (WINDOWPROP MAINWINDOW 'REGION)) - (T (GETREGION] - (CH#1 NIL) - MENUW MENUTEXT) - (COND - ((AND MAINWINDOW (WINDOWPROP MAINWINDOW 'TEDITMENU)) - (* ; - "This is a menu window. It can't have a menu, so bail out.") - (RETURN)) - ([AND MAINWINDOW (for WW in (ATTACHEDWINDOWS MAINWINDOW) - thereis (EQUAL (OR TITLE "TEdit Menu") - (WINDOWPROP WW 'TEDITMENU] - (* ; - "If this main window already has a menu, don't add another.") - (RETURN))) - (SETQ MENUW (CREATEW (SETQ WREG (COND - (MAINWINDOW (create REGION - LEFT _ (fetch (REGION LEFT) - of WREG) - BOTTOM _ (fetch (REGION TOP) - of WREG) - WIDTH _ (fetch (REGION WIDTH) - of WREG) - HEIGHT _ (OR HEIGHT 133))) - (T WREG))) - (OR TITLE "TEdit Menu"))) - (WINDOWADDPROP MENUW 'CLOSEFN 'TEXTMENU.CLOSEFN) - (WINDOWPROP MENUW 'TEDITMENU (OR TITLE "TEdit Menu")) + (* ;; "RMK: Added TYPE argument to be used in renaming the menu's process") + + (* ;; "") + + (* ;; "Pretext: menu windows can't have menu windows.") + + (* ;; "Typically this is called from a menu under the main window running in the mouse process. When we're done, we want to return to the main window's editing process, not to the process we are called in.") + + (CL:UNLESS [AND MAINWINDOW (OR (TEDITMENUP MAINWINDOW) + (for WW in (ATTACHEDWINDOWS MAINWINDOW) + thereis (STREQUAL (OR TITLE "TEdit Menu") + (WINDOWPROP WW 'TEDITMENU] + (LET ((WREG (CL:IF MAINWINDOW + (WINDOWPROP MAINWINDOW 'REGION) + (GETREGION))) + MENUW) + (SETQ MENUW (CREATEW (SETQ WREG (COND + (MAINWINDOW (create REGION + LEFT _ (fetch (REGION LEFT) + of WREG) + BOTTOM _ (fetch (REGION TOP) + of WREG) + WIDTH _ (fetch (REGION WIDTH) + of WREG) + HEIGHT _ (OR HEIGHT 133))) + (T WREG))) + (OR TITLE "TEdit Menu"))) + (WINDOWADDPROP MENUW 'CLOSEFN (FUNCTION FREEATTACHEDWINDOW)) + (WINDOWPROP MENUW 'TEDITMENU (OR TITLE "TEdit Menu")) (* ; "Mark this as a TEDIT MENU window") - (ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE) - [SETQ HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP MENUW 'REGION] - (WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT)) - (WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT)) - (SETQ MENUTEXT MENU) - (replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T) - [AND MAINWINDOW (WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW] - [TEDIT MENUTEXT MENUW NIL (LIST 'TITLEMENUFN 'DON'T 'PROMPTWINDOW (fetch (TEXTOBJ - PROMPTWINDOW - ) - of (TEXTOBJ MAINWINDOW - ] - (AND MAINWINDOW (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS]) + (ATTACHWINDOW MENUW MAINWINDOW 'TOP 'JUSTIFY 'LOCALCLOSE) + [SETQ HEIGHT (FETCH (REGION HEIGHT) OF (WINDOWPROP MENUW 'REGION] + (WINDOWPROP MENUW 'MAXSIZE (CONS 64000 HEIGHT)) + (WINDOWPROP MENUW 'MINSIZE (CONS 0 HEIGHT)) + (SETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of MENUSTREAM) + MENUFLG T) + + (* ;; "The mainwindow's PROMPTWINDOW is also the menus prompt window") + + (CL:WHEN MAINWINDOW + (WINDOWPROP MENUW 'PROMPTWINDOW (WINDOWPROP MAINWINDOW 'PROMPTWINDOW))) + [TEDIT MENUSTREAM MENUW NIL `(TITLEMENUFN DON'T PROMPTWINDOW ,(GETTOBJ (TEXTOBJ + MAINWINDOW + ) + PROMPTWINDOW] + (PROCESSPROP (WINDOWPROP MENUW 'PROCESS) + 'NAME + (PACK* "TEdit-" (CL:IF TYPE + (L-CASE TYPE T) + "Menu"))) + (CL:WHEN MAINWINDOW (* ; + "Give the tty back to the main window") + (TTY.PROCESS (WINDOWPROP MAINWINDOW 'PROCESS))) + + (* ;; "No caret now, let the buttonevent fn bring it up") + + (\TEDIT.UPCARET (CAR (GETTOBJ (fetch (TEXTWINDOW PTEXTOBJ) of MENUW) + CARET)) + -10 -10) + (TEXTPROP (fetch (TEXTWINDOW PTEXTOBJ) of MENUW) + 'NOTSPLITTABLE T) + (WINDOWPROP MENUW 'BUTTONEVENTFN (FUNCTION \TEDIT.MENU.BUTTONEVENTFN)) + MENUW))]) + +(\TEDIT.MENU.BUTTONEVENTFN + [LAMBDA (MENUW) (* ; "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) + (\TEDIT.BUTTONEVENTFN MENUW]) (\TEXTMENU.DOC.CREATE - [LAMBDA (MENUDESC MENUPROPS) (* ; "Edited 31-Jan-2022 22:48 by rmk") + [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 \TEXTMENU.START to get the menu up on screen) + (* ;; "Create the TEXTSTREAM for a menu, given a description. That stream is passed to \TEDIT.MENU.START to get the menu up on screen") - (PROG ((CH#1 NIL) - MENUW MENUTEXT) - [SETQ MENUTEXT (OPENTEXTSTREAM NIL NIL NIL NIL (OR MENUPROPS '(FONT (MODERN 10] - (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 + (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)) - (fetch (MB.BUTTON MBBUTTONEVENTFN) - of DESC) - (fetch (MB.BUTTON MBFONT) of DESC)) - MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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)) - MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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)) - MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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 MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MENU (* Real menu, except the selection - sticks) - (TEDIT.INSERT.OBJECT (MB.CREATE.FULLMENU (CADR DESC)) - MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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) - MENUTEXT CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(PROTECTED OFF) - CH# 1) - (add CH# 1)) - (MB.TEXT (* Arbitrary text, which will be - protected from the user.) - (TEDIT.INSERT MENUTEXT (fetch (MB.TEXT MBSTRING) of DESC) - CH#) - [AND (fetch (MB.TEXT MBFONT) of DESC) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - (LIST 'MBFONT (fetch (MB.TEXT MBFONT) of DESC)) - CH# - (NCHARS (fetch (MB.TEXT MBSTRING) of DESC] - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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 MENUTEXT " {}" CH#) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(PROTECTED ON) - CH# 4) - (TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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) - MENUTEXT - (IPLUS CH# 3))) - (T (* It's regular text.) - (TEDIT.INSERT MENUTEXT (MKSTRING (fetch (MB.INSERT - MBINITENTRY) - of DESC)) - (IPLUS CH# 3] - [TEDIT.LOOKS (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) - '(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))) - (replace (TEXTOBJ MENUFLG) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT) with T) - (* Remember that this is a menu) - [COND - (CH#1 (* We actually inserted some text, so - it makes sense to put up a selection) - (push (fetch (TEXTOBJ EDITPROPS) of (fetch (TEXTSTREAM TEXTOBJ) of MENUTEXT)) - (LIST 'SEL CH#1] (* And where the first selection - should be.) - (RETURN MENUTEXT]) - -(TEXTMENU.CLOSEFN - [LAMBDA (W) (* ; "Edited 12-Jun-90 18:59 by mitani") - - (* ;; "CLOSE a TEdit menu window: Detach the menu, then reshape the remaining windows to take up the remaining space") - - (PROG ((MAINW (WINDOWPROP W 'MAINWINDOW)) - TEXTOBJ HEIGHT OHEIGHT OBOTTOM WBOTTOM WINDOWS) - (FREEATTACHEDWINDOW W) (* (DETACHWINDOW W) (* ; - "So detach this window.") - (COND ((IGREATERP (FLENGTH - (ATTACHEDWINDOWS MAINW)) 1) - (SETQ OHEIGHT (fetch - (REGION HEIGHT) of (WINDOWPROP W - (QUOTE REGION)))) (SETQ OBOTTOM - (fetch (REGION BOTTOM) of - (WINDOWPROP W (QUOTE REGION)))) - (CLOSEW W) (SETQ WINDOWS - (SORT (ATTACHEDWINDOWS MAINW) - (FUNCTION (LAMBDA (WW) - (fetch (REGION BOTTOM) of - (WINDOWPROP WW (QUOTE REGION))))))) - (for WW in WINDOWS when - (IGEQ (SETQ WBOTTOM (fetch - (REGION BOTTOM) of (WINDOWPROP WW - (QUOTE REGION)))) OBOTTOM) do - (MOVEW WW (fetch (REGION LEFT) of - (WINDOWPROP WW (QUOTE REGION))) - (IDIFFERENCE WBOTTOM OHEIGHT)))))) - (COND - ((SETQ TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (* ; - "Then, if this window still has a textobj under it, kill off that edit process.") - (TEDIT.KILL TEXTOBJ) - - (* ;; "This has to be TEDIT.KILL to avoid problems with the TTY being handed from main back to menu, causing main never to finish off; menu would quit and hand TTY to top level window.") - - ]) + (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@ @@ -2266,39 +2224,49 @@ (SETQ TEDIT.EXPANDED.MENU (\TEXTMENU.DOC.CREATE TEDIT.EXPANDEDMENU.SPEC]) (\TEDIT.EXPANDED.MENU - [LAMBDA (STREAM) (* ; "Edited 20-Aug-87 16:51 by jds") - (* "27-Sep-84 01:04" gbn) - (PROG (CHARMENUTEXTSTREAM) - (\TEXTMENU.START (SETQ CHARMENUTEXTSTREAM (COPYTEXTSTREAM TEDIT.EXPANDED.MENU T)) - (\TEDIT.PRIMARYW (TEXTOBJ STREAM)) - "TEdit Menu" - (HEIGHTIFWINDOW 60 T)) - (COND - ((OR (TEXTPROP STREAM 'CLEARGET) - (TEXTPROP STREAM 'CLEARPUT)) (* initialise the button) - (\TEXTMENU.SET.TOGGLE "Unformatted" 'ON CHARMENUTEXTSTREAM]) + [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]) (MB.DEFAULTBUTTON.FN - [LAMBDA (OBJ SEL W) (* ; "Edited 30-Mar-94 15:46 by jds") + [LAMBDA (OBJ SEL W) (* ; "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 (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + (PROG* ((TEXTOBJ (\DTEST (GETSEL SEL SELTEXTOBJ) + 'TEXTOBJ)) + (MAINTEXT (\DTEST (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'TEXTOBJ) 'TEXTOBJ)) - (MAINSEL (fetch (TEXTOBJ SEL) of MAINTEXT)) - OFILE CH PROC) - (COND - ((EQ (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) + (MAINSEL (FGETTOBJ MAINTEXT SEL)) + PROC) + [COND + ((EQ (FGETTOBJ MAINTEXT EDITOPACTIVE) T) (TEDIT.PROMPTPRINT MAINTEXT "Edit operation in progress; please wait." T) (RETURN)) - ((fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) - (TEDIT.PROMPTPRINT MAINTEXT (CONCAT (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) + ((FGETTOBJ MAINTEXT EDITOPACTIVE) + (TEDIT.PROMPTPRINT MAINTEXT (CONCAT (FGETTOBJ MAINTEXT EDITOPACTIVE) " operation in progress; please wait.") T) - [AND (NEQ (fetch (TEXTOBJ EDITOPACTIVE) of MAINTEXT) - (IMAGEOBJPROP OBJ 'MBTEXT] - (RETURN))) + (CL:UNLESS (EQ (FGETTOBJ MAINTEXT EDITOPACTIVE) + (IMAGEOBJPROP OBJ 'MBTEXT)) + (RETURN] [COND ((AND (SETQ PROC (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS)) @@ -2312,33 +2280,35 @@ (PROCESS.EVAL PROC (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL ))) (T (ADD.PROCESS (LIST 'MB.DEFAULTBUTTON.ACTIONFN OBJ SEL W TEXTOBJ MAINTEXT MAINSEL] - (COND - ((fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) + (CL:WHEN (FGETTOBJ TEXTOBJ EDITFINISHEDFLG) (GIVE.TTY.PROCESS W) - (DISMISS 20))) - [COND - ((OR (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) - (EQ (WINDOWPROP W 'PROCESS) - (TTY.PROCESS))) (* ; + (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.") - (SETQ TEDIT.SELPENDING NIL) - (GIVE.TTY.PROCESS (WINDOWPROP W 'MAINWINDOW] + (GIVE.TTY.PROCESS (WINDOWPROP W 'MAINWINDOW))) (* ;; "Tell the menu button handler not to turn off this button--it's still active and will turn itself off.") (RETURN 'DON'T]) (\TEDITMENU.RECORD.UNFORMATTED - [LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* jds " 7-Feb-85 09:44") - (PROG ((FLG (COND - ((EQ NEWSTATE 'ON) - T) - (T NIL))) - (TEXTOBJ (TEXTOBJ TEXTSTREAM))) - (TEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET FLG]) + [LAMBDA (BUTTON NEWSTATE TEXTSTREAM) (* ; "Edited 22-Sep-2023 20:06 by rmk") + (* jds " 7-Feb-85 09:44") + (PUTTEXTPROP (TEXTOBJ TEXTSTREAM) + 'UNFORMATTEDPUT/GET + (EQ NEWSTATE 'ON]) (MB.DEFAULTBUTTON.ACTIONFN - [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* ; "Edited 30-Mar-94 16:04 by jds") + [LAMBDA (OBJ SEL W TEXTOBJ MAINTEXT MAINSEL) (* ; "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) @@ -2350,40 +2320,35 @@ [RESETSAVE (PROG1 OBJ (IMAGEOBJPROP OBJ 'MENUBUTTON.SELECTED T)) '(AND (IMAGEOBJPROP OLDVALUE 'MENUBUTTON.SELECTED NIL] - (replace (TEXTOBJ EDITOPACTIVE) of MAINTEXT with (OR (IMAGEOBJPROP OBJ - 'MBTEXT) - T)) - (* ; + (SETTOBJ MAINTEXT 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 - (fetch (SELECTION CH#) of SEL] + (GETSEL SEL CH#] [COND (OFILE (* ;  "Only try this if he really typed a file name") - (TEDIT.PUT MAINTEXT OFILE NIL (TEXTPROP TEXTOBJ + (TEDIT.PUT MAINTEXT OFILE NIL (GETTEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET]) (Get [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) of SEL] + (GETSEL SEL CH#] [COND (OFILE (* ;  "Only try this if he really typed a file name") - (TEDIT.GET MAINTEXT OFILE (TEXTPROP TEXTOBJ + (TEDIT.GET MAINTEXT OFILE (GETTEXTPROP TEXTOBJ 'UNFORMATTEDPUT/GET]) (Include [SETQ OFILE (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) - of SEL] + (GETSEL SEL CH#] (COND (OFILE (TEDIT.INCLUDE MAINTEXT OFILE)))) - (Find (SETQ OFILE (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (fetch (SELECTION - CH#) - of SEL))) + (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 MAINTEXT "Searching..." T) @@ -2391,44 +2356,39 @@ (COND (CH (* ; "We found the target text.") (TEDIT.PROMPTPRINT MAINTEXT "Done.") - (\SHOWSEL MAINSEL NIL NIL) - (replace (SELECTION CH#) of MAINSEL - with (CAR CH)) + (\SHOWSEL MAINSEL NIL) + (SETSEL MAINSEL CH# (CAR CH)) (* ;  "Set up SELECTION to be the found text") - (replace (SELECTION CHLIM) of MAINSEL - with (ADD1 (CADR CH))) - [replace (SELECTION DCH) of MAINSEL - with (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] - (replace (SELECTION POINT) of MAINSEL - with 'RIGHT) - (replace (TEXTOBJ CARETLOOKS) of MAINTEXT - with (\TEDIT.GET.INSERT.CHARLOOKS MAINTEXT - MAINSEL)) + (SETSEL MAINSEL CHLIM (ADD1 (CADR CH))) + [SETSEL MAINSEL DCH (ADD1 (IDIFFERENCE (CADR CH) + (CAR CH] + (SETSEL MAINSEL POINT 'RIGHT) + (FSETTOBJ MAINTEXT CARETLOOKS ( + \TEDIT.GET.INSERT.CHARLOOKS + MAINTEXT MAINSEL)) (* ;  "Set the caret looks to match those of the new selection") (TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL) (* ; "And never pending a deletion.") (\FIXSEL MAINSEL MAINTEXT) (TEDIT.NORMALIZECARET MAINTEXT MAINSEL) - (\SHOWSEL MAINSEL NIL T)) + (\SHOWSEL MAINSEL T)) (T (TEDIT.PROMPTPRINT MAINTEXT "(Not found)"]) - (Substitute [PROG* ((SAVECH# (fetch (SELECTION CH#) of SEL)) - (REPLACEMENT (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (fetch (SELECTION CH#) of SEL))) - [PATTERN (MBUTTON.NEXT.FIELD.AS.TEXT + (Substitute [PROG* ((SAVECH# (GETSEL SEL CH#)) + (REPLACEMENT (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ + (GETSEL SEL CH#))) + (PATTERN (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CHLIM) - of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + (GETSEL (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ) + CHLIM))) CONFIRM? KEEPLOOKS? LOC) - [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON + (SETQ LOC (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ - (fetch (SELECTION CHLIM) - of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + (GETSEL (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ) + CHLIM))) [SETQ CONFIRM? (EQ 'ON (IMAGEOBJPROP (CAR LOC) 'STATE] [SETQ LOC (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ @@ -2438,72 +2398,71 @@ (COND ((ZEROP (NCHARS PATTERN)) (* ; "NOTHING--HE HIT DEL.") - ) + NIL) (PATTERN (* ;  "There's something to do. Go do it.") - [COND - (KEEPLOOKS? (SETQ REPLACEMENT - (MBUTTON.NEXT.FIELD.AS.PIECES - TEXTOBJ SAVECH#] + (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 + (\SELPIECES (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ)))) (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE (fetch (TEXTOBJ - STREAMHINT - ) - of MAINTEXT) - PATTERN REPLACEMENT CONFIRM?))]) + (TEDIT.SUBSTITUTE MAINTEXT PATTERN + REPLACEMENT CONFIRM?))]) (Quit (* ; "He wants to QUIT the edit.") (COND ((\TEDIT.QUIT (\TEDIT.PRIMARYW MAINTEXT) T) (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T)))) (Page% Layout (* ; "Page layout menu") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) + (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) (\TEDIT.PRIMARYW MAINTEXT) "Page Layout Menu" - (HEIGHTIFWINDOW 135 5))) + (HEIGHTIFWINDOW 135 5) + 'PAGE)) (Para% Looks (* ; "Page layout menu") (\TEDIT.EXPANDEDPARA.MENU MAINTEXT)) (Char% Looks (* ; "Page layout menu") (\TEDIT.EXPANDEDCHARLOOKS.MENU MAINTEXT)) (All (* ; "Select the entire document.") (COND - ((NOT (ZEROP (fetch (TEXTOBJ TEXTLEN) of MAINTEXT))) - (\SHOWSEL MAINSEL NIL NIL) + ((NOT (ZEROP (TEXTLEN MAINTEXT))) + (\SHOWSEL MAINSEL NIL) (TEDIT.RESET.EXTEND.PENDING.DELETE MAINSEL) - (replace (SELECTION CH#) of MAINSEL with 1) - (replace (SELECTION CHLIM) of MAINSEL - with (ADD1 (fetch (TEXTOBJ TEXTLEN) of MAINTEXT))) - (replace (SELECTION DCH) of MAINSEL with (fetch (TEXTOBJ TEXTLEN) - of MAINTEXT)) - (replace (SELECTION POINT) of MAINSEL with 'LEFT) - (replace (SELECTION SET) of MAINSEL with T) + (SETSEL MAINSEL CH# 1) + (SETSEL MAINSEL CHLIM (ADD1 (TEXTLEN MAINTEXT))) + (SETSEL MAINSEL DCH (TEXTLEN MAINTEXT)) + (SETSEL MAINSEL POINT 'LEFT) + (SETSEL MAINSEL SET T) (\FIXSEL MAINSEL MAINTEXT) - (\SHOWSEL MAINSEL NIL T)))) + (\SHOWSEL MAINSEL T)))) (Hardcopy [SETQ PRINTHOST (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) - of SEL] + (GETSEL SEL CH#] (COND ((NOT PRINTHOST) (* ;  "If he didn't specify a particular host, defer to his defaults.") (TEDIT.PROMPTPRINT MAINTEXT "Using default print server."))) - [SETQ %#COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER + (SETQ %#COPIES (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ - (fetch (SELECTION CH#) of (fetch (TEXTOBJ - SCRATCHSEL - ) - of 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 + (SELECTQ (IMAGEOBJPROP (CAR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ - (fetch (SELECTION CHLIM) - of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + (GETSEL (fetch (TEXTOBJ SCRATCHSEL) + of TEXTOBJ) + CHLIM))) 'STATE) (One% Side 1) (Duplex 2) @@ -2513,21 +2472,21 @@ (push PRINTOPTIONS '%#SIDES] [SETQ MSG (\TEDIT.MAKEFILENAME (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ - (fetch (SELECTION CH#) - of (fetch (TEXTOBJ SCRATCHSEL) - of TEXTOBJ] + (GETSEL (fetch (TEXTOBJ + SCRATCHSEL) + of TEXTOBJ) + CH#] [COND (MSG (push PRINTOPTIONS MSG) (push PRINTOPTIONS 'MESSAGE] (TEDIT.HARDCOPY MAINTEXT NIL NIL NIL PRINTHOST PRINTOPTIONS)) (ERROR)))] - (replace (SELECTION SET) of SEL with T) (* ; + (SETSEL SEL SET T) (* ;  "Now turn the menu button highlighting off.") - (replace (SELECTION ONFLG) of SEL with T) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) (* ; + (SETSEL SEL ONFLG T) + (\SHOWSEL SEL NIL) (* ;  "And forget that anything is selected.") - ]) + (SETSEL SEL SET NIL]) ) (DEFINEQ @@ -2559,14 +2518,18 @@ TEDIT.CHARLOOKSMENU.SPEC]) (\TEDIT.EXPANDEDCHARLOOKS.MENU - [LAMBDA (STREAM) (* ; "Edited 20-Aug-87 16:49 by jds") + [LAMBDA (STREAM) (* ; "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.") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.CHARLOOKS.MENU T) + (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.CHARLOOKS.MENU T) (\TEDIT.PRIMARYW STREAM) "Character Looks Menu" - (HEIGHTIFWINDOW 68 T]) + (HEIGHTIFWINDOW 75 T) + 'CHARLOOKS]) (\TEDIT.APPLY.BOLDNESS [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:55") @@ -2576,29 +2539,31 @@ NEWLOOKS]) (\TEDIT.APPLY.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") - (* MBFN for TEdit default menu item - buttons.) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'TEXTOBJ)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - SCRATCHSEL OFILE CH NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT OFFSET) - [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 MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of MAINTEXT)) - (fetch (SELECTION DCH) of (fetch (TEXTOBJ SEL) of MAINTEXT))) - (* Make the change in looks) - (\SHOWSEL SEL NIL NIL) (* And turn off the APPLY button.) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS)) (* Leave him typing in the real - document) - ]) + [LAMBDA (OBJ SEL W) (* ; "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.") + + (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) + (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'TEXTOBJ)) + (CH# (ADD1 (FGETSEL SEL CH#))) + NEWLOOKS) + (\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 MAINTEXT NEWLOOKS) (* ; "Make the change in looks") + (* ; + "Leave him typing in the real document") + (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'PROCESS]) (\TEDIT.APPLY.OLINE [LAMBDA (BUTTON NEWLOOKS) (* jds "30-Aug-84 13:56") @@ -2607,296 +2572,333 @@ (OFF (CONS 'OVERLINE (CONS 'OFF NEWLOOKS))) NEWLOOKS]) +(\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]) + (\TEDIT.SHOW.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:17 by jds") + [LAMBDA (OBJ SEL MENUSTREAM) (* ; "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") + + (* ;; "OBJ is unused, presumably to have a standard interface with other menu functions that are updating an image object.") + + (* ;; "MENUSTREAM is the displaystream of the charlooks menu window.") (* ;; "Set the CHARLOOKS menu from the looks of the currently selected character.") - (LET* ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + (LET* ((TEXTOBJ (\DTEST (GETSEL SEL SELTEXTOBJ) + 'TEXTOBJ)) + (MAINTEXT (WINDOWPROP (WINDOWPROP MENUSTREAM 'MAINWINDOW) 'TEXTOBJ)) - (MAINCH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) of MAINTEXT))) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - (SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) + (MAINCH# (GETSEL (GETTOBJ MAINTEXT SEL) + CH#)) + (CH# (ADD1 (GETSEL SEL CH#))) PC OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET) - (COND - ((<= MAINCH# (fetch (TEXTOBJ TEXTLEN) of MAINTEXT)) + (CL:WHEN (ILEQ MAINCH# (TEXTLEN MAINTEXT)) [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] (* ; "Skip over the NEUTRAL button.") - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) - (SETQ PC (\CHTOPC MAINCH# (fetch (TEXTOBJ PCTB) of MAINTEXT))) - (* ; + (\SHOWSEL SEL NIL) + (SETSEL SEL SET NIL) + (SETQ PC (\CHTOPC MAINCH# MAINTEXT)) (* ;  "The PIECE containing the text to describe") - (SETQ NEWLOOKS (fetch (PIECE PLOOKS) of PC)) (* ; + (SETQ NEWLOOKS (PLOOKS PC)) (* ;  "Get the looks for those characters.") - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ CH# NEWLOOKS - )) (* ; + (* ;  "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 MAINTEXT) + 'PROCESS)))]) (\TEDIT.NEUTRALIZE.CHARLOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 30-May-91 22:18 by jds") + [LAMBDA (OBJ SEL W) (* ; "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") - (* Handle the NEUTRAL button on a character looks menu. - Sets all the menu settings neutral.) + (* ;; "Handle the NEUTRAL button on a character looks menu. Sets all the menu settings neutral.") - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'TEXTOBJ)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - PC SCRATCHSEL OFILE CH NEWLOOKS NEXTB BUTTON TEXT OFFSET) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) - (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU TEXTOBJ CH#) (* Fill in the menu blanks with that - info) - (TEDIT.UPDATE.SCREEN TEXTOBJ) (* And update the screen image.) - ]) + (LET [(TEXTOBJ (GETSEL SEL SELTEXTOBJ)) + (CH# (ADD1 (FGETSEL SEL CH#] + (\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]) (\TEDIT.FILL.IN.CHARLOOKS.MENU - [LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "Edited 30-May-91 22:28 by jds") + [LAMBDA (TEXTOBJ CH# NEWLOOKS) (* ; "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.") - (PROG (PC SCRATCHSEL OFILE CH NEXTB BUTTON TEXT OFFSET) - (SETQ NEWLOOKS (\TEDIT.PARSE.CHARLOOKS.LIST NEWLOOKS NIL NIL)) + (\DTEST 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.") + (* ;; "Make sure the charlooks are in the proper internal format, so this fn can be called from every reasonable place.") - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - [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)) - 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 (* ; + [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 (* ; + (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] + [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] + (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 (fetch (SELECTION CH#) of SCRATCHSEL)) - (fetch (CHARLOOKS CLSIZE) of NEWLOOKS)) (* ; "Set the value in the SIZE field") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] + (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)) + (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))) + [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) (* ; + (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))) (* ; + ) + ((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.") - (\SHOWSEL SCRATCHSEL NIL NIL) - (replace (SELECTION SET) of SCRATCHSEL with NIL) - (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]) + (\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 30-May-91 22:18 by jds") + [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, starting at CH# to neutral values.") + "Set all the fields in the CHARLOOKS menu specified by TEXTOBJ to neutral values, starting at CH#.") - (PROG ((SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - PC OFILE CH NEXTB BUTTON TEXT OFFSET) - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL [for PROP - in '(BOLD ITAL ULINE STRIKE OLINE) - 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#)) + (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) (* ; + (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 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) (* ; "Set the value in the SIZE field") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + (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)) (* ; + (SETQ BUTTON (CAR NEXTB)) (* ;  "Remember the offset value for later") - (IMAGEOBJPROP BUTTON 'STATE NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (CDR NEXTB)) - NIL) (* ; + (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 30-May-91 22:18 by jds") - (* MBFN for TEdit default menu item - buttons.) - (PROG (SCRATCHSEL CH NEWLOOKS SIZE SUPER SUB NEXTB BUTTON TEXT OFFSET) - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - [for BUTTON in '(BOLD ITALIC UNDERLINE STRIKEOUT OVERSCORE) - do (* Set the character properties which - are independent) - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SELECTQ BUTTON - (BOLD (SETQ NEWLOOKS (\TEDIT.APPLY.BOLDNESS (CAR NEXTB) + [LAMBDA (TEXTOBJ CH#) (* ; "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))) - (ITALIC (SETQ NEWLOOKS (\TEDIT.APPLY.SLOPE (CAR NEXTB) + (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))) - (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))) - NIL) - (SETQ CH# (ADD1 (CDR NEXTB] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))(* Get to the start of the text.) - (SETQ BUTTON (CAR NEXTB)) - [AND BUTTON - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (Other (* Have to get and add in a new font.) - (COND - ([SETQ TEXT (MBUTTON.NEXT.FIELD.AS.ATOM TEXTOBJ (ADD1 (CDR NEXTB] - (* He wants some font not on the list. - Add it to the list.) - (SETQ NEWLOOKS (CONS 'FAMILY (CONS (U-CASE TEXT) - NEWLOOKS))) - (COND - ([NOT (FMEMB (U-CASE TEXT) - (U-CASE (IMAGEOBJPROP BUTTON 'BUTTONS] - (* This font name isn't in the list - already; add it.) - (MB.NWAYBUTTON.ADDITEM BUTTON TEXT) - (IMAGEOBJPROP BUTTON 'STATE TEXT)) - (T [IMAGEOBJPROP BUTTON 'STATE (for NAME - in (IMAGEOBJPROP BUTTON - 'BUTTONS) - suchthat (EQ (U-CASE TEXT) - (U-CASE NAME] - (* Select the newly-specified font.) - )) - (TEDIT.DELETE TEXTOBJ SCRATCHSEL) - (* Delete the new font's name from the - fill-in field.) - (TEDIT.OBJECT.CHANGED TEXTOBJ BUTTON)) - (T (* He didn't specify a font. - Complain but keep on.) - (TEDIT.PROMPTPRINT TEXTOBJ - "'Other' font not specified; no change made." T)))) - (COND - ((STRPOS '-class (IMAGEOBJPROP BUTTON 'STATE)) - (* It's a font class. - Grab the name and evaluate it.) - (SETQ NEWLOOKS - (CONS 'FONT (CONS [EVAL (MKATOM (SUBSTRING (IMAGEOBJPROP BUTTON 'STATE) - 1 - (SUB1 (STRPOS '-class - (IMAGEOBJPROP - BUTTON - 'STATE] - NEWLOOKS))) - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#)) - (T (SETQ NEWLOOKS (CONS 'FAMILY (CONS (U-CASE (IMAGEOBJPROP BUTTON 'STATE)) - NEWLOOKS))) - (MBUTTON.FIND.NEXT.FIELD TEXTOBJ CH#) - (* Skip over the "other text" fill-in.) - ] (* Now find which text button was "on") - [SETQ SIZE (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL - ] - (* Read the contents of the SIZE menu - field) - [COND - (SIZE (* He specified one. - Set it.) - (SETQ NEWLOOKS (CONS 'SIZE (CONS SIZE NEWLOOKS] - [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 + NIL) + (SETQ CH# (ADD1 (CDR NEXTB] + (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* He called for SUPERSCRIPTing. Offset the characters by either the distance he - gave, or 2 pts.) + (* ;; "We're now at the start of the fonts.") - (SETQ NEWLOOKS (CONS 'SUPERSCRIPT (CONS (OR OFFSET 2) - NEWLOOKS)))) - (Subscript + (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") - (* He called for SUBSCRIPTING. Offset the characters by either the distance he - gave, or 2 pts if he gave no distance.) + [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 (type? FONTCLASS (SETQ FONTCLASS (GETATOMVAL UTEXT))) + then (push NEWLOOKS 'FONT FONTCLASS) + else (push NEWLOOKS 'FAMILY UTEXT)) + elseif (OR (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 ") - (SETQ NEWLOOKS (CONS 'SUBSCRIPT (CONS (OR OFFSET 2) - NEWLOOKS)))) - (Normal (* NORMAL => Turn off all super and - subscripting) - (SETQ NEWLOOKS (CONS 'SUPERSCRIPT (CONS 0 NEWLOOKS)))) - NIL) - (RETURN NEWLOOKS]) + (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 + "Can't find 'Other' font, 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") @@ -2928,402 +2930,350 @@ (SETQ TEDIT.EXPANDEDPARA.MENU (\TEXTMENU.DOC.CREATE TEDIT.PARAMENU.SPEC]) (\TEDIT.EXPANDEDPARA.MENU - [LAMBDA (STREAM) (* ; "Edited 20-Aug-87 16:51 by jds") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDEDPARA.MENU T) + [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]) + (HEIGHTIFWINDOW 141 T) + 'PARALOOKS]) (\TEDIT.APPLY.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 22-Apr-93 16:45 by jds") + [LAMBDA (OBJ SEL W) (* ; "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") (* ;; "Handler for the Paragraph Menu's APPLY button. Collects the specs from the paragraph menu and calls TEDIT.PARALOOKS to effect the change.") - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'TEXTOBJ)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - SCRATCHSEL QUAD OFILE CH NEWLOOKS SIZE SUPER SUB LINELEAD PARALEAD DEFAULTTAB BUTTON NEXTB - BUTTONDATA L1 LN R PARATYPE SPECIALX SPECIALY) - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] + (LET ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) + (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'TEXTOBJ)) + (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#] + [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] (* ; "and the NEUTRAL button.") - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (SETQ NEWLOOKS NIL) (* ; - "The list we'll be collecting the looks changes in.") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#))(* ; + (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)) - [COND - ((AND (SETQ QUAD (IMAGEOBJPROP BUTTON 'STATE)) - (NEQ QUAD 'OFF)) (* ; "A justification was specified") - (SETQ NEWLOOKS (CONS 'QUAD (CONS (U-CASE (MKATOM QUAD)) - NEWLOOKS] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] + (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) (* ; "This paragraph IS a page heading.") - (SETQ NEWLOOKS (CONS 'TYPE (CONS 'PAGEHEADING NEWLOOKS))) - (* ; "Tell him that it's a heading.") - (SETQ NEWLOOKS (CONS 'SUBTYPE (CONS [MKATOM (MBUTTON.NEXT.FIELD.AS.TEXT - TEXTOBJ - (ADD1 (CDR NEXTB] - NEWLOOKS)))(* ; "And say what kind.") - ) - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; + (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.") - (SETQ NEWLOOKS (CONS 'TYPE (CONS NIL NEWLOOKS))) - (* ; "Tell him that it's NOT a heading.") - (SETQ NEWLOOKS (CONS 'SUBTYPE (CONS NIL NEWLOOKS))) - (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB))) - (* ; "And say what kind.") - ) - (T (* ; - "No change specified. Skip over the heading-type fill-in.") - (MBUTTON.NEXT.FIELD.AS.TEXT TEXTOBJ (ADD1 (CDR NEXTB] - [COND - ((SETQ LINELEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (fetch (SELECTION CH#) - of SCRATCHSEL))) + (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") - (SETQ NEWLOOKS (CONS 'LINELEADING (CONS LINELEAD NEWLOOKS] - [COND - ([SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + (push NEWLOOKS 'LINELEADING LINELEAD)) + (CL:WHEN [SETQ PARALEAD (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] (* ; "Get any paragraph leading") - (SETQ NEWLOOKS (CONS 'PARALEADING (CONS PARALEAD NEWLOOKS] - [COND - ([SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + (push NEWLOOKS 'PARALEADING PARALEAD)) + (CL:WHEN [SETQ SPECIALX (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] (* ;  "Get any special X position for the paragraph") - (SETQ NEWLOOKS (CONS 'SPECIALX (CONS (FIXR (TIMES 12 SPECIALX)) - NEWLOOKS] - [COND - ([SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] + (push NEWLOOKS 'SPECIALX (FIXR (TIMES 12 SPECIALX)))) + (CL:WHEN [SETQ SPECIALY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (FGETSEL SCRATCHSEL CH#] (* ;  "Get special Y positioning for the paragraph") - (SETQ NEWLOOKS (CONS 'SPECIALY (CONS (FIXR (TIMES 12 SPECIALY)) - NEWLOOKS] - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL))) - (SETQ BUTTON (CAR NEXTB)) - [COND - [(EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; + (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)") - (SETQ NEWLOOKS (CONS 'NEWPAGEBEFORE (CONS T NEWLOOKS] - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; + (push NEWLOOKS 'NEWPAGEBEFORE T)) + ((EQ (IMAGEOBJPROP BUTTON 'STATE) + 'OFF) (* ;  "This paragraph IS NOT a page heading.") - (SETQ NEWLOOKS (CONS 'NEWPAGEBEFORE (CONS NIL NEWLOOKS] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - [COND - [(EQ (IMAGEOBJPROP BUTTON 'STATE) - 'ON) (* ; + (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....") - (SETQ NEWLOOKS (CONS 'NEWPAGEAFTER (CONS T NEWLOOKS] - ((EQ (IMAGEOBJPROP BUTTON 'STATE) - 'OFF) (* ; + (push NEWLOOKS 'NEWPAGEAFTER T)) + ((EQ (IMAGEOBJPROP BUTTON 'STATE) + 'OFF) (* ;  "The next paragraph DOESN'T START on a new page....") - (SETQ NEWLOOKS (CONS 'NEWPAGEAFTER (CONS NIL NEWLOOKS] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (push NEWLOOKS T) - (push NEWLOOKS 'HARDCOPY)) - (OFF (push NEWLOOKS NIL) - (push NEWLOOKS 'HARDCOPY)) - NIL) + (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) (* ;;; "THE VARIOUS KINDS OF KEEP PROPERTIES (ONLY HEADING-KEEP FOR NOW THO)") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - (SELECTQ (IMAGEOBJPROP BUTTON 'STATE) - (ON (push NEWLOOKS 'ON) - (push NEWLOOKS 'HEADINGKEEP)) - (OFF (push NEWLOOKS 'OFF) - (push NEWLOOKS 'HEADINGKEEP)) - NIL) + [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) -(* ;;; "THE DEFAULT TAB WIDTH") + (* ;; "Default tab width") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL))) - (SETQ BUTTON (CAR NEXTB)) - (SETQ DEFAULTTAB (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (CDR NEXTB))) - (while (NOT (type? MARGINBAR BUTTON)) do (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (fetch (SELECTION CH#) of SCRATCHSEL) - )) - (SETQ BUTTON (CAR NEXTB))) - (SETQ BUTTONDATA (IMAGEOBJPROP BUTTON 'OBJECTDATUM)) - [COND - ((IGEQ [SETQ L1 (FIXR (TIMES (fetch MARL1 of BUTTONDATA) - (fetch MARUNIT of BUTTONDATA] - 0) (* ; + (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.") - (SETQ NEWLOOKS (CONS '1STLEFTMARGIN (CONS L1 NEWLOOKS] - [COND - ((IGEQ [SETQ LN (FIXR (TIMES (fetch MARLN of BUTTONDATA) - (fetch MARUNIT of BUTTONDATA] - 0) (* ; + (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.") - (SETQ NEWLOOKS (CONS 'LEFTMARGIN (CONS LN NEWLOOKS] - [COND - ((IGEQ [SETQ R (FIXR (TIMES (fetch MARR of BUTTONDATA) - (fetch MARUNIT of BUTTONDATA] - 0) (* ; + (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.") - (SETQ NEWLOOKS (CONS 'RIGHTMARGIN (CONS R NEWLOOKS] - [COND - ((NEQ (fetch MARTABS of BUTTONDATA) - 'NEUTRAL) (* ; + (push NEWLOOKS 'RIGHTMARGIN R)) + (CL:UNLESS (MEMB (fetch MARTABS of BUTTONDATA) + '(NIL NEUTRAL)) (* ;  "If the tab settings are neutral, don't change anything.") - (SETQ NEWLOOKS - (CONS 'TABS - (CONS [CONS DEFAULTTAB - (SORT (for TAB in (fetch MARTABS of BUTTONDATA) - collect (CONS (FIXR (TIMES (CAR TAB) - (fetch MARUNIT of BUTTONDATA))) - (CDR TAB))) - (FUNCTION (LAMBDA (A B) - (ILEQ (CAR A) - (CAR B] - NEWLOOKS] - (TEDIT.PARALOOKS MAINTEXT NEWLOOKS (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) - of MAINTEXT)) - (fetch (SELECTION DCH) of (fetch (TEXTOBJ SEL) of MAINTEXT))) - (\SHOWSEL SEL NIL NIL) - (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'PROCESS]) + [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 MAINTEXT NEWLOOKS (GETSEL (FGETTOBJ MAINTEXT SEL) + CH#) + (GETSEL (FGETTOBJ MAINTEXT SEL) + DCH)) + (\SHOWSEL SEL NIL) + (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'PROCESS]) (\TEDIT.SHOW.PARALOOKS - [LAMBDA (OBJ SEL W) (* ; "Edited 6-Jul-92 09:42 by jds") + [LAMBDA (OBJ SEL W) (* ; "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") + (* ;; "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.") - (PROG* ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'TEXTOBJ)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - (SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (OLDUPDATEFLG (fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ)) - FMTSPEC BUTTON NEXTB ARB BUTTONDATA) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) - (COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of MAINTEXT)) (* ; - "If there is no text to take the formatting from, don't bother") - (RETURN))) - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL - [SETQ FMTSPEC (fetch (PIECE PPARALOOKS) - of (\CHTOPC [IMAX 1 (IMIN (fetch (TEXTOBJ TEXTLEN) of MAINTEXT) - (fetch (SELECTION CH#) - of (fetch (TEXTOBJ SEL) of MAINTEXT] - (fetch (TEXTOBJ PCTB) of MAINTEXT] - (* ; "Get to the start of the text.") - [SETQ CH# (ADD1 (CDR (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#] - (* ; "Skip the NEUTRAL button.") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (* ; "Grab the justification button") - (SETQ BUTTON (CAR NEXTB)) - [for ITEM in (IMAGEOBJPROP BUTTON 'BUTTONS) - do (COND - ([EQ (fetch (FMTSPEC QUAD) of FMTSPEC) - (U-CASE (COND - ((LISTP ITEM) - (CAR ITEM)) - (T ITEM] (* ; "Turn this button on.") - (IMAGEOBJPROP BUTTON 'STATE ITEM) - (RETURN] (* ; + (* ;; "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 (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'TEXTOBJ] + (\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] + [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] (* ; "Find the 'Page Heading' button") - (SETQ BUTTON (CAR NEXTB)) - (COND - ((EQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC) - 'PAGEHEADING) (* ; + (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 (fetch (SELECTION CH#) of SCRATCHSEL)) - (fetch (FMTSPEC FMTPARASUBTYPE) of FMTSPEC))) - (T (* ; - "This isn't a page heading; make sure the type field is empty.") - (IMAGEOBJPROP BUTTON 'STATE 'OFF) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL))) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (fetch (FMTSPEC LINELEAD) of FMTSPEC)) - (* ; "Update the LINE LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (fetch (FMTSPEC LEADBEFORE) of FMTSPEC)) - (* ; "Update the PARA LEADING field") - [MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - 0) - 3)) - 4))) - (COND - ((FIXP VAL) - VAL) - (T (FLOAT VAL] - [MBUTTON.SET.NEXT.FIELD - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (LET ((VAL (/ (FIXR (IQUOTIENT (OR (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) - 0) - 3)) - 4))) - (COND - ((FIXP VAL) - VAL) - (T (FLOAT VAL] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (SETQ BUTTON (CAR NEXTB)) - [COND - ((fetch (FMTSPEC FMTNEWPAGEBEFORE) of FMTSPEC) - (IMAGEOBJPROP BUTTON 'STATE 'ON) (* ; "This para starts on a new page") - ) - (T (IMAGEOBJPROP BUTTON 'STATE 'OFF] - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (ADD1 (CDR NEXTB] - (SETQ BUTTON (CAR NEXTB)) - [COND - ((fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC) - (IMAGEOBJPROP BUTTON 'STATE 'ON) (* ; "This para starts on a new page") - ) - (T (IMAGEOBJPROP BUTTON 'STATE 'OFF] + (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") + (* ;; "HARDCOPY-DISPLAY MODE") - [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (CDR NEXTB)) - (COND - ((fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) - (* ; - "This para is to be formatted for hardcopy on the display") - 'ON) - (T 'OFF] + [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (CDR NEXTB)) + (LISTGET PARALOOKS 'HARDCOPY] - (* ;; "HEADING KEEP") + (* ;; "HEADING KEEP") - [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (COND - ((fetch (FMTSPEC - FMTHEADINGKEEP - ) - of FMTSPEC) - (* ; - "This para is to be formatted for hardcopy on the display") - 'ON) - (T 'OFF] + [SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB (LISTGET PARALOOKS + 'HEADINGKEEP] - (* ;; "DEFAULT TAB WIDTH") + (* ;; "DEFAULT TAB WIDTH") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB (CAR (fetch (FMTSPEC TABSPEC) of FMTSPEC))) - (* ; - "Update the DEFAULT TAB SPACING field") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL) - )) - (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 (FQUOTIENT (fetch (FMTSPEC 1STLEFTMAR) - of FMTSPEC) - (fetch MARUNIT of BUTTONDATA))) - (replace MARLN of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC LEFTMAR) of FMTSPEC) - (fetch MARUNIT of BUTTONDATA))) - (replace MARR of BUTTONDATA with (FQUOTIENT (fetch (FMTSPEC RIGHTMAR) of FMTSPEC) - (fetch MARUNIT of BUTTONDATA))) - (replace MARTABS of BUTTONDATA - with (for TAB in (CDR (fetch (FMTSPEC TABSPEC) of FMTSPEC)) - collect (CONS (FQUOTIENT (CAR TAB) - (fetch MARUNIT of BUTTONDATA)) - (CDR TAB]) + [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 30-May-91 22:18 by jds") + [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.") - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - SCRATCHSEL FMTSPEC BUTTON NEXTB ARB BUTTONDATA) - (SETQ SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (* ; "Get to the start of the text.") - (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ CH# - 'NIL)) + (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)) + (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) (* ; "Find the 'Page Heading' button") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) (* ; "Update the LINE LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) (* ; "Update the PARA LEADING field") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - NIL) - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL)) - 'NEUTRAL)) (* ; "New page before") - (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) + (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)) + (SETQ NEXTB (MBUTTON.SET.NEXT.BUTTON.STATE TEXTOBJ NEXTB 'NEUTRAL)) (* ; "Hardcopy formatting mode") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) (* ; + (MBUTTON.SET.NEXT.FIELD TEXTOBJ NEXTB NIL) (* ;  "Update the DEFAULT TAB SPACING field") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ (fetch (SELECTION CH#) of SCRATCHSEL)) - ) - (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)) + (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) + [replace MARL1 of BUTTONDATA with (COND + ((ILESSP (fetch MARL1 of BUTTONDATA) 0) - (fetch MARR of BUTTONDATA)) - ((ZEROP (fetch MARR of BUTTONDATA)) - (IMINUS (IQUOTIENT (IDIFFERENCE - (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - 20) - 12))) - (T (IMIN -0.5 (IMINUS (fetch MARR of BUTTONDATA] - (replace MARTABS of BUTTONDATA with 'NEUTRAL]) + (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") @@ -3355,229 +3305,194 @@ (DEFINEQ (\TEDIT.SHOW.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; "Edited 4-Feb-92 16:38 by jds") + [LAMBDA (OBJ SEL W) (* ; "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.") - (PROG* ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) - 'TEXTOBJ)) - (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) - (SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (OLDUPDATEFLG (fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ)) - FOLIOINFO NEWLOOKS NEXTB BUTTON PAGEID OPAGEFRAMES FIRST REST PFONT HEADING HEADINGS - PAGEPROPS STARTINGPAGE# PAPERSIZE) + (LET* ((TEXTOBJ (GETSEL SEL SELTEXTOBJ)) + (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) + 'TEXTOBJ)) + (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.") + (* ;; "Start by turning off the selection--and leaving it off afterward.") - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION SET) of SEL with NIL) + (\SHOWSEL SEL NIL) + (SETSEL SEL SET NIL) - (* ;; "What kind of page are we looking at the specs for?") + (* ;; "What kind of page are we looking at the specs for?") - (SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON TEXTOBJ CH#)) - (SETQ BUTTON (CAR NEXTB)) - (SELECTQ (IMAGEOBJPROP (CAR NEXTB) - 'STATE) - (|First(&Default)| - (SETQ PAGEID 'FIRST)) - (Other% Left (SETQ PAGEID 'LEFT)) - (Other% Right (SETQ PAGEID 'RIGHT)) - (PROGN (TEDIT.PROMPTPRINT MAINTEXT "First specify which kind of page you want to see." - T) - (SETQ PAGEID NIL))) + (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 MAINTEXT + "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.") + (* ;; "Now mark the menu for NO SCREEN UPDATES during the button-setting process.") - (AND PAGEID (WITHOUT-UPDATES TEXTOBJ SCRATCHSEL (replace (TEXTOBJ TXTDON'TUPDATE) - of TEXTOBJ with T) + (CL:WHEN PAGEID + [TEDIT.DEFERRED-UPDATES TEXTOBJ - (* ;; "Now replace the button values, fill-in fields, etc.") + (* ;; "Now replace the button values, fill-in fields, etc.") - (SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXT) - TEDIT.PAGE.FRAMES)) - [COND - ((LISTP OPAGEFRAMES) (* ; - "No problem, this is already just a list of first-recto-verso frames") - ) - (T (* ; - "This is 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] - (COND - ((NOT OPAGEFRAMES) (* ; + (SETQ OPAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of MAINTEXT) + 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 MAINTEXT "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#)) + (TEDIT.PROMPTPRINT MAINTEXT "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] (* ; + (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)) + (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 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Page # Y location") - (SETQ PFONT (pop NEWLOOKS)) - (* ; "Skip the font info for now.") - [SETQ NEXTB (MBUTTON.FIND.NEXT.BUTTON - TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL] - (SETQ CH# (ADD1 (CDR NEXTB))) - (SETQ BUTTON (CAR NEXTB)) - (IMAGEOBJPROP BUTTON 'STATE (SELECTQ (pop FOLIOINFO) - (ARABIC 123) - (LOWERROMAN 'xiv) - (UPPERROMAN 'XIV) - 123)) + (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)) + (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 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop FOLIOINFO)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Left Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Right Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Top margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Bottom Margin") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "# of columns") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Column width") - (MBUTTON.SET.NEXT.FIELD TEXTOBJ (ADD1 (fetch (SELECTION - CH#) - of SCRATCHSEL)) - (pop NEWLOOKS)) - (* ; "Intercolumn spacing") - (SETQ HEADINGS (pop NEWLOOKS)) - (for HEADING# from 1 to 8 - do - (* ;; + (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 (fetch (SELECTION CH#) of SCRATCHSEL)) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (pop HEADING)) - (MBUTTON.SET.NEXT.FIELD TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (pop HEADING))) - (COND - (HEADINGS + (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.") + (* ;; "There were headings left over, so warn user.") - (PROMPTPRINT "WARNING: This document has more kinds of page heading than the menu has room for. Some will be lost if you APPLY this menu." - ))) - (\TEDIT.FILL.IN.CHARLOOKS.MENU TEXTOBJ - (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL)) - (OR PFONT TEDIT.DEFAULT.FOLIO.LOOKS)) - (* ; + (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") @@ -3593,12 +3508,15 @@ TEDIT.CHARLOOKSMENU.SPEC]) (\TEDIT.APPLY.PAGEFORMATTING - [LAMBDA (OBJ SEL W) (* ; + [LAMBDA (OBJ SEL W) (* ; "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") (* ;;; "Change the page formatting for this document") - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) + (PROG ((TEXTOBJ (fetch (SELECTION SELTEXTOBJ) of SEL)) (MAINTEXT (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'TEXTOBJ)) (CH# (ADD1 (fetch (SELECTION CH#) of SEL))) @@ -3686,11 +3604,10 @@ [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] - (COND - [(SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) - of SCRATCHSEL] - (T (TEDIT.PROMPTPRINT MAINTEXT "Please specify how many columns there should be." T) - (TEDIT.PROMPTFLASH MAINTEXT))) + (CL:UNLESS [SETQ COLS (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) + of SCRATCHSEL] + (TEDIT.PROMPTPRINT MAINTEXT "Please specify how many columns there should be." T) + (TEDIT.PROMPTFLASH MAINTEXT)) [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#) @@ -3707,41 +3624,35 @@ [SETQ HEADINGY (MBUTTON.NEXT.FIELD.AS.NUMBER TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL]) - collect (COND - ((AND HEADINGX HEADINGY)) - (T (TEDIT.PROMPTPRINT MAINTEXT (CONCAT - "You need to say WHERE " - HEADINGTYPE - " headings go.") - T) - (TEDIT.PROMPTFLASH MAINTEXT) - (SETQ HEADINGINVALID T))) + collect (CL:UNLESS (AND HEADINGX HEADINGY) + (TEDIT.PROMPTPRINT MAINTEXT (CONCAT "You need to say WHERE " + HEADINGTYPE + " headings go.") + T) + (TEDIT.PROMPTFLASH MAINTEXT) + (SETQ HEADINGINVALID T)) (LIST HEADINGTYPE HEADINGX HEADINGY))) - (COND - (HEADINGINVALID (* ; "Headings invalid.") - (RETURN))) + (CL:WHEN HEADINGINVALID (* ; "Headings invalid.") + (RETURN)) [SETQ PFONT (\TEDIT.PARSE.CHARLOOKS.MENU TEXTOBJ (ADD1 (fetch (SELECTION CH#) of SCRATCHSEL ] (* ;;; "Glom all the oddball options (starting page, folio format &c) together") (SETQ PAGEOPTIONS (AND STARTINGPAGE# (LIST 'STARTINGPAGE# STARTINGPAGE#))) - (push PAGEOPTIONS (LIST FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT)) - (push PAGEOPTIONS 'FOLIOINFO) - [COND + (push PAGEOPTIONS 'FOLIOINFO (LIST FOLIOFORMAT FOLIOPRETEXT FOLIOPOSTTEXT)) + (COND (LANDSCAPE? (* ;  "The pages are to be printed landscape. Remember that fact.") - (push PAGEOPTIONS T) - (push PAGEOPTIONS 'LANDSCAPE?] + (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 MAINTEXT)) - [COND - ((NOT (LISTP OPAGEFRAMES)) - (COND + (CL:UNLESS (LISTP OPAGEFRAMES) + [COND ((EQ PAGEID 'FIRST) (* ;  "Setting the first page sets them all") (SETQ PAGEOPTIONS (COPY PAGEOPTIONS)) @@ -3755,7 +3666,7 @@ (SETQ OPAGEFRAMES (LIST NPAGEFORMAT NFPAGEFORMAT NFPAGEFORMAT))) (T (* ;  "Otherwise, start from the default page layout") - (SETQ OPAGEFRAMES (COPY TEDIT.PAGE.FRAMES] + (SETQ OPAGEFRAMES (COPY TEDIT.PAGE.FRAMES]) (SELECTQ PAGEID (FIRST (RPLACA OPAGEFRAMES NPAGEFORMAT)) (LEFT (RPLACA (CDR OPAGEFRAMES) @@ -3764,8 +3675,6 @@ NPAGEFORMAT)) NIL) (TEDIT.PAGEFORMAT MAINTEXT OPAGEFRAMES) - (replace (TEXTOBJ \DIRTY) of MAINTEXT with T) (* ; - "Mark the document as having changed.") (TTY.PROCESS (WINDOWPROP (WINDOWPROP W 'MAINWINDOW) 'PROCESS]) @@ -3897,7 +3806,11 @@ (DEFINEQ (\TEDIT.MENU.INIT - [LAMBDA NIL (* ; "Edited 29-Apr-2021 22:44 by rmk:") + [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") (* ;;; "Initialize the descriptions for all TEdit menus") @@ -3999,33 +3912,36 @@ (* ;;; "The character-looks (font, etc.) menu") (SETQ TEDIT.CHARLOOKSMENU.SPEC (LIST (create MB.TEXT - MBSTRING _ "Props: " + MBSTRING _ "Props: " MBFONT _ (FONTCREATE 'HELVETICA 8)) (create MB.3STATE MBLABEL _ 'Bold) (create MB.TEXT - MBSTRING _ " ") + MBSTRING _ " ") (create MB.3STATE MBLABEL _ 'Italic) (create MB.TEXT - MBSTRING _ " ") + MBSTRING _ " ") (create MB.3STATE MBLABEL _ 'Underline) (create MB.TEXT - MBSTRING _ " ") + MBSTRING _ " ") (create MB.3STATE MBLABEL _ 'StrikeThru) (create MB.TEXT - MBSTRING _ " ") + 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 Gacha Modern Classic Terminal - Other) + MBBUTTONS _ '(TimesRoman Helvetica Modern Classic + Terminal Other) MBMAXITEMSPERLINE _ 5) (create MB.TEXT MBSTRING _ "other font:") @@ -4129,6 +4045,8 @@ Tab Type: " MBSTRING _ " Default Tab Size:" MBFONT _ (FONTCREATE 'HELVETICA 8)) (create MB.INSERT) + (create MB.TEXT + MBSTRING _ "pts") (create MB.TEXT MBSTRING _ " ") @@ -4141,13 +4059,15 @@ Tab Type: " (SETQ TEDIT.PAGEMENU.SPEC (APPEND (LIST (create MB.BUTTON MBLABEL _ 'APPLY - MBBUTTONEVENTFN _ '\TEDIT.APPLY.PAGEFORMATTING) + MBBUTTONEVENTFN _ (FUNCTION + \TEDIT.APPLY.PAGEFORMATTING)) (create MB.TEXT MBSTRING _ " " MBFONT _ (FONTCREATE 'HELVETICA 8 'BOLD)) (create MB.BUTTON MBLABEL _ 'SHOW - MBBUTTONEVENTFN _ '\TEDIT.SHOW.PAGEFORMATTING) + MBBUTTONEVENTFN _ (FUNCTION + \TEDIT.SHOW.PAGEFORMATTING)) (create MB.TEXT MBSTRING _ " ") @@ -4356,42 +4276,41 @@ Tab Type: " (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (6181 32683 (MB.BUTTONEVENTINFN 6191 . 7480) (MB.DISPLAY 7482 . 9653) (MB.SETIMAGE 9655 - . 10609) (MB.SELFN 10611 . 11984) (MB.SIZEFN 11986 . 12999) (MB.WHENOPERATEDFN 13001 . 13329) ( -MB.COPYFN 13331 . 13789) (MB.GETFN 13791 . 14399) (MB.PUTFN 14401 . 15145) (MB.SHOWSELFN 15147 . 16063 -) (MBUTTON.CREATE 16065 . 17297) (MBUTTON.CHANGENAME 17299 . 17678) (MBUTTON.FIND.BUTTON 17680 . 18681 -) (MBUTTON.FIND.NEXT.BUTTON 18683 . 20340) (MBUTTON.FIND.NEXT.FIELD 20342 . 23882) (MBUTTON.INIT 23884 - . 24670) (MBUTTON.NEXT.FIELD.AS.NUMBER 24672 . 25029) (MBUTTON.NEXT.FIELD.AS.PIECES 25031 . 25467) ( -MBUTTON.NEXT.FIELD.AS.TEXT 25469 . 25895) (MBUTTON.NEXT.FIELD.AS.ATOM 25897 . 26783) ( -MBUTTON.SET.FIELD 26785 . 28700) (MBUTTON.SET.NEXT.FIELD 28702 . 29921) (MBUTTON.SET.NEXT.BUTTON.STATE - 29923 . 30403) (TEDITMENU.STREAM 30405 . 31181) (\TEDITMENU.SELSCREENER 31183 . 32681)) (32987 43530 -(MB.CREATE.THREESTATEBUTTON 32997 . 34164) (MB.THREESTATE.DISPLAY 34166 . 36987) ( -MB.THREESTATE.SHOWSELFN 36989 . 40023) (MB.THREESTATE.WHENOPERATEDFN 40025 . 41358) ( -MB.THREESTATEBUTTON.FN 41360 . 42468) (THREESTATE.INIT 42470 . 43528)) (43631 63113 ( -MB.CREATE.NWAYBUTTON 43641 . 47710) (MB.NB.DISPLAYFN 47712 . 49980) (MB.NB.WHENOPERATEDFN 49982 . -51016) (MB.NB.SIZEFN 51018 . 54646) (MB.NWAYBUTTON.SELFN 54648 . 56570) (MB.NWAYMENU.NEWBUTTON 56572 - . 57159) (NWAYBUTTON.INIT 57161 . 58010) (MB.NB.PACKITEMS 58012 . 59991) (MB.NWAYBUTTON.ADDITEM 59993 - . 63111)) (63367 74033 (\TEXTMENU.TOGGLE.CREATE 63377 . 64867) (\TEXTMENU.TOGGLE.DISPLAY 64869 . -67368) (\TEXTMENU.TOGGLE.SHOWSELFN 67370 . 69711) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69713 . 71055) ( -\TEXTMENU.TOGGLEFN 71057 . 72145) (\TEXTMENU.TOGGLE.INIT 72147 . 72978) (\TEXTMENU.SET.TOGGLE 72980 . -74031)) (74285 111021 (DRAWMARGINSCALE 74295 . 77754) (MARGINBAR 77756 . 84997) (MARGINBAR.CREATE -84999 . 87871) (MB.MARGINBAR.SELFN 87873 . 99910) (MB.MARGINBAR.SIZEFN 99912 . 100270) ( -MB.MARGINBAR.DISPLAYFN 100272 . 102969) (MDESCALE 102971 . 103511) (MSCALE 103513 . 103843) ( -MB.MARGINBAR.SHOWTAB 103845 . 106168) (MB.MARGINBAR.TABTRACK 106170 . 107490) (\TEDIT.TABTYPE.SET -107492 . 110134) (MARGINBAR.INIT 110136 . 111019)) (112038 128824 (\TEXTMENU.START 112048 . 115700) ( -\TEXTMENU.DOC.CREATE 115702 . 126031) (TEXTMENU.CLOSEFN 126033 . 128822)) (129134 148914 ( -\TEDITMENU.CREATE 129144 . 129440) (\TEDIT.EXPANDED.MENU 129442 . 130146) (MB.DEFAULTBUTTON.FN 130148 - . 133032) (\TEDITMENU.RECORD.UNFORMATTED 133034 . 133368) (MB.DEFAULTBUTTON.ACTIONFN 133370 . 148912) -) (148915 175047 (\TEDIT.CHARLOOKSMENU.CREATE 148925 . 151139) (\TEDIT.EXPANDEDCHARLOOKS.MENU 151141 - . 151499) (\TEDIT.APPLY.BOLDNESS 151501 . 151782) (\TEDIT.APPLY.CHARLOOKS 151784 . 153647) ( -\TEDIT.APPLY.OLINE 153649 . 153926) (\TEDIT.SHOW.CHARLOOKS 153928 . 155732) ( -\TEDIT.NEUTRALIZE.CHARLOOKS 155734 . 156672) (\TEDIT.FILL.IN.CHARLOOKS.MENU 156674 . 163698) ( -\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 163700 . 166361) (\TEDIT.PARSE.CHARLOOKS.MENU 166363 . 174198) ( -\TEDIT.APPLY.SLOPE 174200 . 174479) (\TEDIT.APPLY.STRIKEOUT 174481 . 174764) (\TEDIT.APPLY.ULINE -174766 . 175045)) (175048 204283 (\TEDITPARAMENU.CREATE 175058 . 175434) (\TEDIT.EXPANDEDPARA.MENU -175436 . 175755) (\TEDIT.APPLY.PARALOOKS 175757 . 186838) (\TEDIT.SHOW.PARALOOKS 186840 . 197014) ( -\TEDIT.NEUTRALIZE.PARALOOKS.MENU 197016 . 202970) (\TEDIT.RECORD.TABLEADERS 202972 . 204281)) (204284 -242617 (\TEDIT.SHOW.PAGEFORMATTING 204294 . 221103) (\TEDITPAGEMENU.CREATE 221105 . 222144) ( -\TEDIT.APPLY.PAGEFORMATTING 222146 . 234022) (TEDIT.UNPARSE.PAGEFORMAT 234024 . 242615)) (242922 -269775 (\TEDIT.MENU.INIT 242932 . 269773))))) + (FILEMAP (NIL (10426 33961 (MB.BUTTONEVENTINFN 10436 . 11658) (MB.DISPLAY 11660 . 13617) (MB.SETIMAGE +13619 . 14573) (MB.SELFN 14575 . 16197) (MB.SIZEFN 16199 . 17177) (MB.WHENOPERATEDFN 17179 . 17507) ( +MB.COPYFN 17509 . 17967) (MB.GETFN 17969 . 18707) (MB.PUTFN 18709 . 19586) (MB.SHOWSELFN 19588 . 20514 +) (MBUTTON.CREATE 20516 . 21748) (MBUTTON.CHANGENAME 21750 . 22129) (MBUTTON.FIND.BUTTON 22131 . 23039 +) (MBUTTON.FIND.NEXT.BUTTON 23041 . 24263) (MBUTTON.FIND.NEXT.FIELD 24265 . 26678) (MBUTTON.INIT 26680 + . 27596) (MBUTTON.NEXT.FIELD.AS.NUMBER 27598 . 28530) (MBUTTON.NEXT.FIELD.AS.TEXT 28532 . 28958) ( +MBUTTON.NEXT.FIELD.AS.ATOM 28960 . 29761) (MBUTTON.SET.FIELD 29763 . 31739) (MBUTTON.SET.NEXT.FIELD +31741 . 33023) (MBUTTON.SET.NEXT.BUTTON.STATE 33025 . 33505) (TEDITMENU.STREAM 33507 . 33959)) (34265 +44801 (MB.CREATE.THREESTATEBUTTON 34275 . 35442) (MB.THREESTATE.DISPLAY 35444 . 38150) ( +MB.THREESTATE.SHOWSELFN 38152 . 41075) (MB.THREESTATE.WHENOPERATEDFN 41077 . 42418) ( +MB.THREESTATEBUTTON.FN 42420 . 43739) (THREESTATE.INIT 43741 . 44799)) (44902 64684 ( +MB.CREATE.NWAYBUTTON 44912 . 48981) (MB.NB.DISPLAYFN 48983 . 51251) (MB.NB.WHENOPERATEDFN 51253 . +52401) (MB.NB.SIZEFN 52403 . 56031) (MB.NWAYBUTTON.SELFN 56033 . 58141) (MB.NWAYMENU.NEWBUTTON 58143 + . 58730) (NWAYBUTTON.INIT 58732 . 59581) (MB.NB.PACKITEMS 59583 . 61562) (MB.NWAYBUTTON.ADDITEM 61564 + . 64682)) (64938 73856 (\TEXTMENU.TOGGLE.CREATE 64948 . 66438) (\TEXTMENU.TOGGLE.DISPLAY 66440 . +68873) (\TEXTMENU.TOGGLE.SHOWSELFN 68875 . 69475) (\TEXTMENU.TOGGLE.WHENOPERATEDFN 69477 . 70827) ( +\TEXTMENU.TOGGLEFN 70829 . 72028) (\TEXTMENU.TOGGLE.INIT 72030 . 72861) (\TEXTMENU.SET.TOGGLE 72863 . +73854)) (74108 110302 (DRAWMARGINSCALE 74118 . 77577) (MARGINBAR 77579 . 84440) (MARGINBAR.CREATE +84442 . 87314) (MB.MARGINBAR.SELFN 87316 . 99332) (MB.MARGINBAR.SIZEFN 99334 . 99692) ( +MB.MARGINBAR.DISPLAYFN 99694 . 102496) (MDESCALE 102498 . 103038) (MSCALE 103040 . 103370) ( +MB.MARGINBAR.SHOWTAB 103372 . 105695) (MB.MARGINBAR.TABTRACK 105697 . 107082) (\TEDIT.TABTYPE.SET +107084 . 109415) (MARGINBAR.INIT 109417 . 110300)) (111319 126430 (\TEDIT.MENU.START 111329 . 116449) +(\TEDIT.MENU.BUTTONEVENTFN 116451 . 116935) (\TEXTMENU.DOC.CREATE 116937 . 126428)) (126740 146446 ( +\TEDITMENU.CREATE 126750 . 127046) (\TEDIT.EXPANDED.MENU 127048 . 128129) (MB.DEFAULTBUTTON.FN 128131 + . 131352) (\TEDITMENU.RECORD.UNFORMATTED 131354 . 131687) (MB.DEFAULTBUTTON.ACTIONFN 131689 . 146444) +) (146447 174728 (\TEDIT.CHARLOOKSMENU.CREATE 146457 . 148671) (\TEDIT.EXPANDEDCHARLOOKS.MENU 148673 + . 149383) (\TEDIT.APPLY.BOLDNESS 149385 . 149666) (\TEDIT.APPLY.CHARLOOKS 149668 . 151464) ( +\TEDIT.APPLY.OLINE 151466 . 151743) (\TEDIT.APPLY.UNBREAKABLE 151745 . 152143) (\TEDIT.SHOW.CHARLOOKS +152145 . 154454) (\TEDIT.NEUTRALIZE.CHARLOOKS 154456 . 155604) (\TEDIT.FILL.IN.CHARLOOKS.MENU 155606 + . 163010) (\TEDIT.NEUTRALIZE.CHARLOOKS.MENU 163012 . 165585) (\TEDIT.PARSE.CHARLOOKS.MENU 165587 . +173879) (\TEDIT.APPLY.SLOPE 173881 . 174160) (\TEDIT.APPLY.STRIKEOUT 174162 . 174445) ( +\TEDIT.APPLY.ULINE 174447 . 174726)) (174729 200589 (\TEDITPARAMENU.CREATE 174739 . 175115) ( +\TEDIT.EXPANDEDPARA.MENU 175117 . 175679) (\TEDIT.APPLY.PARALOOKS 175681 . 186019) ( +\TEDIT.SHOW.PARALOOKS 186021 . 193628) (\TEDIT.NEUTRALIZE.PARALOOKS.MENU 193630 . 199276) ( +\TEDIT.RECORD.TABLEADERS 199278 . 200587)) (200590 235299 (\TEDIT.SHOW.PAGEFORMATTING 200600 . 213890) + (\TEDITPAGEMENU.CREATE 213892 . 214931) (\TEDIT.APPLY.PAGEFORMATTING 214933 . 226704) ( +TEDIT.UNPARSE.PAGEFORMAT 226706 . 235297)) (235604 263398 (\TEDIT.MENU.INIT 235614 . 263396))))) STOP diff --git a/library/tedit/TEDIT-MENU.LCOM b/library/tedit/TEDIT-MENU.LCOM index bc176b50834f28ad8906cbbd94432405030d4d5c..ce2ae15a1a38b9cd7680fdf972e8e18b599d3d49 100644 GIT binary patch literal 92628 zcmdqK3v^t^c_xT%fD}bbFaSan1k>~tL_;7&!ssUeT9MHJ8teudeIY#91WBn)p&{YX zBDEwH+Y={aJMm27Nivol*_IvK6Wd94a*|9FAkJ71t9N(K?lHZ)@$4SiA(J_qnPjpj ziD!4g@$Al?nX$Ov|Nm8W>)!4LDUTnMlbTKCTz6{DS;Yq@7IHbqZmGY&zsD(^!&mEmA{y&Cd`APj z!+|)_WNa`NagOu&Mi-rn&#pUrkB?P3-j}CK7BHspU2|oo#W#}d;4ab0mmJk z9Cc4QStsetr%%n#&0}S!kxV#q>0BY3A9o8##hux7ZV?YLdZ6l2D#vfcF|TlAhn=Pq zp{Az0MxJTHzrFOQJ=8S1n;tl;v&$-ak+a&?#%^x@`?c|#oBwt!6S}$iZ^koW{QTu= zTT@?b(8*2%O3}}mS$767=u2bS;xT93%|ATv#G(#?k_@#U-Aj)Vi~=%Gy1CRmz}ATj zQ@4?yb@LeFsJoCK$MDe#&(b*dKrXeYXD8;2X6L6E9RsqEyvJfBuE z&*S#h2hQKRh2l&I6UbTj-bLSEX$w|Oy^Zpv4_29ERQc&2NGYo1OhM8~f zRlj$yt#sqx=~8Gi9O4RR5b(r?HNeo$ zbWf&%_ac!&4^(JEuxReY1SW#Pf!0hVhZ9sNgvJ>f_AlRH04pTpYOAXHSbi*RHh-d! z9iPuQ(TM-`S|kzyfY2I`r{~6IvorJVtTTjVQ24h(&f)$*1+ z=b>M;%6J($w661lQezI%gkcHuVjzrXHFA9>+|<+}SY>SMUVEX#p_GkfC9(GHgH6@7 z()P-B_Uhh|)M&Xm`}S5r7Jrx#B$HX;Wv%KLI@JqULQKKgxr|$&E(|7|vlH1<^a!91 zY^Jlc-BE;54i8u;7TZE_Gd2;572*XF04bbxqS!qqGZLqn%A0x0o=*EFinqZ4Pc)_l zbSQfw1LQn=A}f zq|)a`#)J&DjY`JV<`v9jB8Gkv`9=q@v*=ks5b4N}FAZP;UBIX{tp_h)o}&q8A)f)1 zRJ+hvK>-c#ulkbUNU~J$$0Hd?k@zV zOy$bA{!$*T7k;f2Y7gy7O>@D%aP!tpTK5R{!P(UOw7URW5EXz{EZ>lG7N~gM86H#* zL$ZCicra;R1Dd8?#o38rlMQC!tdIk0BpzfPyh-O5@o7EnoE~;E>D&zFJ`w@uPk|)> zTATxVa*|1;r?X&;8BXcb;QRrh1gUzr;YF~|J=BIXG3!n{ljC#8j^*8XXJIZq{yqpE zfbf}xAIXZ=Upy-p>*%fe|9@6A!AnE}fN$mQfb2J3QXomq_NgWHt>{2tNu6WIoWP=b zXscG*B8D0J5g1iasUTR5elA0T@=>f%leLJyQ!5>;mB!Xe9@o!%^IqOwqnr0xuPQv- z1u?<*f`|#U2_qJR4mkJCC-`H-p99nS%D`~}jsFNWK4)* z*l39%@Y~oML@o_`O)Rx$wLKE3a3ix*{fY~`1FjlkB_m2my}4t&fr;Gl$Vft`6*Am5 z%K@}p#DOy*odEWQUM01Vo2PfdiC@?i0u|i4cfmuC5Pw(3w(fdAVOw63_E2bKC*Gp{ z!Imt)F4R$;M}*Vh{ER#^>dw-lVJ?|uD&Z(H5I||SW1r*T*(`QB=3ziJlYj~u;8-p- zH#g=^&p?%c;ey%I3rFNcC_wYLHKOdJY*%h!FV-o}*<#_PYpUc||zM$^zwfHV-v zo*84P8_PU|--ur+Gaz*_h6x(O=vMQ(be!Qz&_a7hI8*vZZQp8YF7MvncxUEX)9H=- zvljJbu-Seg)0Vlm=TzmpV7SobDgHiKFMBjRSSi6c&yHp0UG#3)OeJ(LjYpfu90Z0e zi(v){wulF5ugzD%c!g6VvQOGWncrGz%g9h(#7Gvm_Hd`a$79%duWSvj%xk&5`DAU@ zRBhH!RvNgkw&$%mgT86?DL!gt zTW|LXBNN!nz=ftY@U&`K0B#XpjsCnr!^DP=Vnp^6r9csZC`4)+P0eb2O-0~6y^6zF zZUSOf&Ca_gPUO|%%;<<2r;#iz>KCAgdvMK01cR;+FinMGm%Z_ z#`R7~U|*0@B$p(;y3$POqOd&LJVU#p>HOg&pAIMdb9oPjV zL}X$egJQNho7i{&Ki5|<>4QiQ82eLm{rQFI(e$ha%K_(PN;KfLuyqm)TzDiUkfdO& zU&ESW0-8ksvUc<8QRc~oC1AvKsuXM6+CP%ve6GG)Vqu!(q@gJ03U-rzV29}$2s<#} zkalLw&5xz#9mtj%n@63o+;Ji7$3WhvNleKTM9h)uMH&Hc(a@xpLwtn515+$-_?Q*o z4n;$ORrDkBN%_#@tX^`?U%2d?bIw2i>{H7Zk2M9_AI z1dusi^~JUA&Ccwu=FbQT`W?w_W1R?~Rgq|5hl$f^GKKtDR?{0Vbh7;cJPf|-n1YlU zY#PS8;0y^_GnQiPoI07-DUaZ5$RUOr+h##*Cepm-&d@S!Phf8T-d%*5c~08T?N;2t zS^azUiA+xR3h#_FrK`D;q(`P02VdK*e(zDgovVUzN4d!-O8oOAX8RraUCmo>ACY`+ zt&Phz{!jTjp<@U(vQx&PWP+wY5`~&VtpI7Wr7)YHW3xa6^1_swA~45lw?V=&xn}!f zehITfGpO~dP?$H^exxPR+y=hyt0fy&6b{zjRoOPSAJp10Qs99= zH~g*=nX03uFYp>=L?XfxK@Fn_rdkCM9W&iDy}tE>`o}CESU9E9ZaDLV_^g?#KRF6# ziYZ7T1+Cj>#)PJDR8NakBlO0c46GF3A@wFuA_``wSxrql@Iz>ksjSE<)l7K(I$^m0 z*GWv41pvHkl7U_WQu(_)0G<%$?PSmCb&aseLHKdA8~f3hkn9JZc5z9u(Coh+bPey z+E!W?Udo_L@QQPyL_H%#V!E5+Wjeh!$^B73DV5Uw5zC&u#`UC}Ind#xHr&COV`L4s zzJs^amOQX=FwpS~MZk2}mON}a%aRwtmh((`kyua~0vwABuayl!c?oJ?UoT+!@TH-b z@}({HI!jPsR|F-CHPHLMVM!xsQmHQ@N{MV~DM*|%Dkl<@^67s07T zI3*NYtrwrzI-Pf0x%3;7J7tE$Fi{`&e2Y2R(d<2tvVQZM{{ zPHl@hD++=?KAS4!;C~utp#>D}Rfi@sNaiy$c~Nnq3I-#@>Yk z?7U&@>Fgn)wph?w3FWJA3&L*e>zQa4l(ZCM%e?1n0dAXiyXR{WP*~I|f1^-H>OB<2 zewYE;hv@`(0>*zQid~@GETRK((hWz3X$O;^MPvxVKG%-G?jy?Kh-cZPo$B8%4w*@{ zx)?@L^UNlC2K*W&vc0$JDDin_WSi`$#t#h!)c9L>kBl+2lSkB7t~C8d9Y7=xo_eZz z4T6tZ?=;r>H)uq`WjEOh)^A`tYRDZ^1^}TB-|B1v^JRN0sjqMTW8IBN{Vz0ZSbh27 zJL)})JTZW;*$h#jQy)M^$?ogzDpWOIMW9~3s)W!@RoXgURltDxM3B^xu|v0sm;6mC zfzsAZS{-J!og z34;7v^B357L^}+OG5%j8y&3zq=(P5A2{;t6dZ!*K7WV?Lq{h>rUJ(c|(2?bIfEn~8 zDZr(dcFh0R=3~i zTl*$x>FP-pBTb+mJWo6SX{dxhw`kG%0t1P+w`9f;Z zFX;hQ3O5f%7K=;#EHD*|zx1rka`b2k;xOLnm%uBT+OTMGHrW%0qy{}=S+nEm^uz>| zBxDSpf%rEEr+EnMcqYs5+!)NDcs8sx0~spMhlic!rsCcC6_KBlVvA60T+Iqn4MVp6;Jyq8U z7ahDDE*`8_Hr?Ld;-PBg-;_ed&gQGT-A+gd^*ixr)QMI|9!*UFN7R(?{O5nZN%@{m zw)Z^X_Deqps_xO|t<(EN(8Ul^`>5kT=Qy)xo43xm$2+bxy$~u!tL}gjI@YF@JmN-aQdO?oA1?Nz7vbX3>Xln-p<)kD z$%}5Ud+7Twxio&aM^DL>TTh3Ik5=6wH~#(2FS*CvNAuU;C?2o6$#5}=?DaQ_LulnA zZd=H03$L|zbh?Ky(2reddfn~qu*X0{5~a0@&$jNt)&>M7!)>$Q;pwn4#;oTR z>)CC!5+c>f5{OTOJdaDAHU_6&w~xk3;1Vt#x^nB0roKTiKQ`KSk~K^kxFLTHFjoGI zpiMgocRYU$7?A=Qak4d@fa7oy`dnXGVmMGa0duIoM$mIT0hYjD1JYC=BdR}`fYQrX z7Do?642lCd{6doLS*8bU15IrQdJQ;`>6Nldavze%Wj{fIh=o(dC|9#=>{387U;cM`lnUSUut36@x%6#+DLpOAx7e$3h-6}D}f%X7h}+KAtm%CMuzunUKK^5&_YUz zAiM@7R=gO6aL*lrY;YiW9A5wJINX5EmRhHEOPiO3D{;x=aYABuW3I zJ3}g{w|=}P^bflHS}4Ej$zo`4``A8sw^gUux^;m)>6m;LTNT5r5L(r36^hVSU31&G ziuYi(qRaBRsrK00-7YB1EBA$p-BowL5T*lFx3hUGw$E+l13hxMr{-8svE%BwX=-Eq zez&)ID_NNh6%VeJ+%~t{J+LCIIx~l&*aGQQ9K_$2YAk00| zfukVBqQ)ok)ZzATZ}hlFsWWch^-1^0^?J?shBbmlJ7Gi4uiPp@=MRgLk){c?c!{8; zA_}BtO39N(qnt?aTo1A777ij9w{Q@-30pWQh^&D@d^ic3I3NB?2JvuE>lMJoz#+c( z!DUk4jN(hqws?xLI;sJTRg2>>LLN%mhZwK3qo|@Z2EbIZ)gnM>3iGiLPgq^f8tH>D zl7bK~`%CRV%%-I098f*I^*|To@f2;(z!5m$je0^o@wkL!!HRl2mp88T@D7FkUxepN zi}Lp0{E$8^uz5iXoln}jTx&a7k8okm0)jstdKFfv&V5?+*Q$WF&})-Z+h54N1YJRn zeI}~e@XML-*DL=cZxp4KC8-noc~A+A2sF>Pu0ee(D4ktS(jzUsckBRw#J6j^Tl2NmGX>>XRc*T^PMZe2?Ms<1gUG%Pw`J>V#zbo#?OkAxzK z7qmoiQwsQ(JV2IK{^L}HmQTHDnXv1n?y7WeMO%rVF^?$ZRO~2C#0>n za9Sw*>cf8DYYX&#T#sX;H`>?RCf&}Pn;*<>K0gW3XqqH~wzc-r{e-XI4(1+sy?x+5 zx2=*5L6UF}mE4Xuiig~z_)}$hYpcUO0wJr9Ff`%j$~E^$F9fy9_tz+^4}u*DVMjhj zLRTLNc7N?2=>SQ(()543ou#Rpn}4S|g-_@3Y57vujxU1Fw7IQHO!|}d(E}uNz0HkE zlV1rzQgH{?+}0a!6bDFniKBx_bRbSL6A49?|J6?`)Uy$@7g3Kd7I?uh#sMp1l> zdp26>avy6jpMQle3D+=Ebsr5EAH8zxa;TUI6?0X0@|rMK$5w!YY9M?h%IE(<5&V3aM74Z3opkeBBJNT6Mn5bGd9)PL| zlED$M`Bbi0{7ToP+q1oKFqrR?EG)g9dms!v?RJL=%d*6A<<<~+U1E*(`TZzqRr192 zybmA+e^Fb-560ZD;wSr7t&X2U4g_{+fFmdCn!Tli${2XO`O0Ac_NC!@;Y&l>@TG&Q zp;|ja6v)-E?u4QEyi%0p7-fM&3@Z5ZHeNiUL% zuRL;J!Q1PtbP8%9RRkAbu$b~8;2n*uf))wF&%g=n3kHupY1VTGQ)yzRQnQey;9ifD z@x)Mhm1$pLN2;pzy>`dQ+s`r)!G}!FSE!>*Bcc`@5nb}SC^Ai|9A@5tjygfY5pOz;FLy&)&iJ>312Z%GZX0)VQfo`o2FTyztt;6zj*nvm@ zT?Clvrfk(?mmLr)=6Lk0NW8chMZ0A1>%{#a8vG;n$U_urQj3Zw-_o2ET z_O*ha-^t!aT=8;?m)L`i5ThylU{EFeA+{AY;irw1{t zs9fPJ2u4|^A?WneLB{+_AR+jq7u2pIGQf{mkR=jM*Gh<(k=p8*`od&ps(YoIvFqu{ zwooekRJi)uNG5lE>V?sdtX==X&CNq&Tko8@dRJ!jjjvB-RMl5Axi`L^U4P@{%4^x1 zn}1<7^2*AqYl~m6{BwBl!|zn_Qh;au2*Rr#l>?-ReICV5jl=67BAuq$daKi{DAtD_ zHCCZ#i18=&vbYDZ|$|HZLz~x zuiOsh^hM^YOy!7WzH)`@Ze+juW42#q>e#P94wd~%H9-cfOy$lESQ|eI1D4wnuwZ43 z1?yKsMX_L!iRaHW_19J`%KT5-k|ncdj5mr=sIe3MAI47Py&&d&u@gzI*oov>P_#UY zoydFB7D2>Lq~7uDM3N!mjXWz=swBiVGy<08ty$9E{PWvb(x?Ksrhr-L&HscmNzm_z zNhLuJAQG4+Azo~@NhJZjw~rf01np7r;K5pwhJ=Ga-m#|GhL5om;wS$OZj}&A$fx&A*D-O=juThIrR0b6XMDZeV^0LxcC=TK$ z&kFU&$rX%+J0)?&VSAGd{xIoGHPXa0tv#?WDYnw^{D5@k31ncvj1(4w=HP{C?T?8__e`5r9`R&i| z2gMryUV)RKZ>L#`4e1mhDgxAHJl<Cuox8H&U5j)to+kV`x?Xdc= zQy|fDW!;0K6CN576D*LzDk`sCQq8i)0O3!~euNMo*c+r8(AyCT1R0QX2kz_;eWM8Q zdj4n6l~+s7CGz>B2&tDZJo8L>*?CHiT0@Mj*;M}-e(z1wslop!WQp zSK0(KZv6NBTlr^jTMNhlZ`n1OVvCY%GWZhU4a3)xn-??9Y+U}~JdlI4?1QcK@W?1*MLJfCv*_ND+NuhCb2UkkZv;r~h)@h~EP%`TbykmD z>u7Ipp4@6lwKacr^3|1Jnhd=<8Gc1hgjOqm1$TRxq%atY9|5&Bound0%?s@iG^)Y! zum{vcXA;=<$%f?>P1H)h;>9wissnkeBhi!j(GaQ z^XE$r66X|I>IYe(b2}2PW)AKgCiWA=I(M3!4-#UTBKGymc=&PY8ni2wrc0^J&!E_be%Tljr-3UIpI{KgZN|Cu!*8~>Zs*|T02 ze4*=<&=%MD^Bd*8;*ndW_N9N7*UI-$Ctj33thG1qMkhXXrRf**<=y|{3_6gRLI)nL z-vP48zP40vNJO{vVeUd zJPxUyg!_!cFHb#@2+YSSWAJxXPvA(6WeXmw<{63|^9(LmKU2JC^NcCc&vv%4l`*en z;!tT!iZeW^QEcNuI79)@=E&JBsh%M-V7o*0k$WVw54(x08*aL<3lp%+y27Mx1(y(fc}QC3NLT|TO?pnAcsP}yI%hTAG%!S_d{ zr5(RANu>wWSJVssuhgxP+Zd*yOpTdO+$eW@3Ew37ntO11<6VUg;KiwOcX^MhCo{^B zQ1vx=NIIq(RsrY6x%&3Tk#cz5S{jg{JxsUIF@Z2~c&wxv)U)YZb-Z#v*--Z2U{9Lg z=9eiP@81w^C9fga_skw;$$_?K68x;jI7!G9~YKhzaPIZH;jPsKhuJB;vLd64ZyH zP@4E^5p6Laih^X>AEM(KULp8jFF}q5x_=RL7L5j0jE_gFUY)+VqDlb;?Cs>BuhUr%$T_cfk=Xt6jGFg5<`=d zB$V>{Ie`h$2R0J`MUzk7udG%{7{V4u5GGw7hn5{d&T*wp47r-{B~5t@`X(ul8dXgc zAgkYx0%puJxLExhfnroY1Hf>r4s`!GSP_@j{6y~#qSV4)0TBQf$cxvLEySf2P=Y9k zsZojy4myMhP0cETg;nArqFLl4J4<8>bB{=XDtaxRA`n0RYlz3Y&o^(EA6qN8Fd}JB zwcwI~vGFvga682NNkz$MYSB9saYlSM>}WG*B}-&v|3wihFfq3%hR)n1-8nG{>Vp6B zCmdQSNg*=sg@(1MNm`T;dK~2z0Phn;=&%3=g$n=>%94X{)&h0}&{CTV9U(HcIuV+1 zq_j2>`@{DY!~viN_`)MTC2#v1fkpBu7qP|l%bunk_%fePkIyOA0#Hp2@>L;XBa>$c zv}QEih*o&}u`qkAYmEt_dojZV%Mu<)A_A8wSy2AyEJ$};3+%AUf~5;OTc}r{tYqd0 zJJMyw2rQwlgE)iy8a9hzk=UnzkOzU}u&_vY0*$ij5{$L?lGC&7jV5dPDA^}X!__wZxo5h9!Sy4_qH4)N~jz)>4_KU}Ok z;o;o%F}Jf9es&=&f*Qt&|NR@DpzXbyf+v5cS$m;VciC`45r_+<`;1a#MDD zxoJp7`62GY(`Th=Xk?Q+tqm=LZ%eC!KT?wzbeQD+dK}ew`}OOQtsx}UDcd7 z-QOrp-+TcAb{lxNa$DK4=M-Y~i>ig!*YY=iEB~>z{EcEOglyMsg_J#tb60(|WNr3a zkk0?Dy%sIJ7NKcO-l6u{2i+m~Z^BJu>q^tB+_{ZcvmviP#kMLAbKU$DT20K2~QgH_E=5EOy{jS_dZcqizSB-F>s^e22~!#9im#ZGNr(N)rrLaL5}6k#W>{ z5=WhjM_)>3+@lOq)r@nr7U4Dj7#(&V3e(vEKJt9!&Hu)lfpwYO6TA-T9iI_LY!*hh>zm|&$=0m59|1{do-lry4a8Ouc|5S#}0(I*N462^_!dL z)9z8X*W;UU!kapRZ>#WZ4^)FSuDtoW90l-A!A#Z7zv$xD6->cQF<-?2flSq%2z|(={0DDBFh8HV@`JzjGOknlM)0#}|EThlEB0LZ!Pi5@(^dDB zyrm%G$*OzyMfa@xB&OrZ;@PTux_Gkc&WDTh=uEgci|JT`7L&MkqBRJ;4bp7WB3TIH97;>-Vjf_zGpBYXn> z<_I`C>mE1xp6>*H(qj1GUJUyJhesf3mB6olsXZk&l;wi?Ej_{QH;)NnuH|XP?U}b=~-Tcvw#oQ zqv*ZA6XcSk-=$Lk8a5$;@}8h0H#J~M9xbY~%B_IdN^q~5C2!>W9fyD{;vVA1S+gbf z4Imkc;U`jJgmk(bavhsZYfo`$3Pw(G*m0~>OO9~j@dV0Y=zF!GI*bFpW-jz6h9F&9 zrvwJ=J+JEwqMJ1@Ch@_VOj3N;WX7Z;i5UXeWUxvi==uHLWQ_rtuX#BQxlvV@TZ4}$;lCmhN_ykRy)TyQ-e zN%(rYPgLbW7Ew>&B0@JL7y*0vVC{|GEvkHR%&GUN;4kagI~-j+6hV$=wR@G+Q1+^V zPP0lZKxweu=w&UbM}Vx6)S@~a;`TM7sFld-@R{)yVhj3Yb!;(TIb?ZX8YqkUEsbG= z`wBsPjeEoIoO`HTJdS)M3Fe`8P5~ZwA$_GB4AzLe| zKOzbWZB2=212v&kQWGG=n$DttTL`qynK(KjW|why9uNKF=`pNHP6|CMH`#?G&xD!w z)ilw=RWsgK*?orWI;zC}IIg7geVjEU_zaBAk;YcF#y=Db)|60?TrUC4WD>wH=9zYu zZdmJ^iHtC3M%Rl`Y))BY1sRAvjtwqH`JmI2GG1atr-g5$lz>-|5&;Yx4I|G!<fwWV zq!mPf2+`RM=q)G8J=*9%G*F|FKb*RL;lt#Wl44m_8Jk9N`iUqC%bd8Y+Lj$jDS<%! z5^GHUvYLRd$C2b2prOq_8X1+KUt*#fosugXx~l&CsaGmr16m=ofRBy94WP7#Bbai- zZvqhNR}%ykMnctiW9P5^CcP@kmMy^FzpC;doQ=IH1cxmY0gq0I>y$E8Sz}ZwtM|LFJtJm zY+O#r_WT0>NZh`cz3Q@3?V*+&?iIV%bVl@8k4$lG>-CMU+_fezlOQIX?OJKeUE6cE z@;{K!9`yEwDCVQ86kFY7I1st@onw#^>3HCgnoupU5c=GZtV<6lEXu;MF|zW2#+haj z#-0`r0+>xi4o{!E z_{{40+2_m47wMW2a0R$-Dli-9H{8U?Y!^83XNmv(kaAf0EjIM7a9)=G2C(jacE(^=EHgCu`Q& zR!jNg%#c^2qWauj`A+EN(XG3f`x1i|Zy5gbVs`8IRx7_tS7v-^^0cnSMQ3DDd1V=! z%4XAbBukF}d(a_1Rw6rG+fDfTsonD4`Tx)~CJ{m;y{1y?Myf7$9bEtRkh+E}wef(| zlP_?OMD;r|wc>q`pJbZE_b|s}X9TZ$(a&{w^y6Dk^RL%hYAY?D;Vfw)8hZBsDOn@t zB5p(sf${=pNG%E1qIAsFN@bPbsC9NPpZ(xs65b42n1)HXfCr1(Dy?1=u0LmJ`c;B_!G?O?lUgA%Te0~@J{ zW^^D#l6`%Fl;XfjfgBKKT*W&#lgkq0kKIp)_w;;{MW6xDFx*gAWXg+ zq)J^Wq_%yj`KzTDR=Pu+T%KUQXA@LKW@gR@`@x~wK}Ocwdv;AWZ$Xz9*55dDC9Fg3Z9H20GPMv6aqUdwCPGF){o$K=Q*|Su4po@~d4E>Q_sHjVdi^f_wYh2ry;d_s zo!>YpA`Lx*^iAnyk%?E!;LkL5uqaJ`z>7@|-d|Lec^#`NQEpKU$sXzAeow)BQLSwD zYg6Us>o4O28z=QwzJ!MiWphiFPU`M_5f z^h_5)x9lqdLRLj_*!z4f#-Y8l>&7A9*cEig>7cpC=4yo^2(SGzIT6--IR+9%OgF0` z`zIE1IYK}{*8XqDUs|~OCRg_N$(^uX15xl$Aii}^oJTQl>RL*=uf%RH zLe!CcqWz0VM9u4u7x!NYzGU=NEfU%CwWztH09ep{j9LU#b4x}T)e2@0+zj=fa5j0! z!^03NM140MNJJ8PCxzb=aA!pC6jYM$pgOl42gIU)-a}LX9)ej>wxRK&ki#Zw(JVtv z#OtO`3Ps3HHrgK(IS_M$gc>pgN{F>AFOoN<>Is+;`WW*dno}Tpodo5#LlNPan8=hf zE?uF7V`GOA)OyHQC-1L<=tT*9)NX~cFhWE$`njL)aS#e)Z?HIy-DAH&-yy#2SZugI z!93Wp0eXO}%nvbW{e$&m*mi-uy@10=FcV>G;x&21a|T|fD0F@7dfG>}npt9R4&!23 z;T35`Y;q5|)@f=d+VXz-!&ps=%gkTaa0!@i7&`?9)2DF83+E1)y&*|c`TI*Qe`{_g zJ*GJh!b|>FlwOXmv`x)YeGdk~Zy1(^nF@gc@JUa4S1*E%;C_pIvnb~inIe=Ql{_XU zik$H?OG3XdB#NJ}cJK=pivb1;CVFpwTZh{K4`9-%m%MWzx7bM-OKg@La199^2wFmE zWG5863<*S4gLgA_%pwE^i4JKE-)7~&oI{TS=5s8UPR(NLl1_!6@pT6%LC-2hr1dWX zFAePxY>}RY^G{#6`0TmMm+1y#D1!W~Ds~@28K)L<^Rfy1!5SOIDTYg|Aht5}1=w87 z4$?DqIj~kxK`>KD)rcL$ekB6{D^P`M@8=)7@XK2h?@0m6_}$i|XCo z-9p_n*9N{M^{VAgll6!CRffFnF9$!t&8Zu6e@7&9f8*S@%2&C;uUxtH!G?9N-1@s@ z0DuH5vT}c#g3uFgP#IVc5Ga2sFoIVKNIQ`|neMlR{3wVyz$PG$MuG4B@+c7{XrHFD zbFlS;4%ak9SBOFQ_3kJlj}HKccSjKg^$6ymp_-3Jf&qM>#1=5dP|R)K;55{2-cTRZ z7DIDT+cHf+@N?J=6rZpL+*4z8X9NkYU|Du3#l}&>F3Y7xeHO(i&e}80uGqm%Wxm4d zd{6lnfsc#|JpwHZ?J6d7-XoUH($#^#)OGv{R0m7d<6L-d`Qo|DtGF>9aSfikc;T6g z%a<;_*LkkIeD2aRPM5A;?(YFfbb9E1`8%rZqad^CF?V*ne<45N&Q3$JhLJ~!v(ha~ zGBl^x2@?on0SNgF50;tfOv8ms z4GauK=uedX#5HOIo0C0${0J_IAIltrx@uuIe~g^0jxbW=vhjuK>BVChDzs*(b;Kdl ztHFH}kdNg!{sc%My^zm=Vmy9~4>n`0?+7=Cn^s5K!=c%^m6E!3d!>76k6;Rz05q3M zXNCzn(YZWLZ0@a$C@CXiZ4GyOf%Uq_u!Sf@;}IdEJXTN={Xt=lvR{Ji`eb+ zCR4zT(L0S7TW=yeJN-UXCl4R2IamuCu{zoT>W$cSO%FBgY6|hd7(FtQ16Ez>p6Om{ zdK_@U5*3yhniJW>a|@%;-^_#bLn%YS3UOfz#tmP$RF;k~N)A3`iZ}$IpH%5x<5Imu(h+NOjpRWl8!1@|J@IZkEdt_}d6nF)#+IF(M%ux#}{zzgh2Ts2OxsG;6KtJNo*riZ*K}QnJ-8o3I|uzuT1ZeQ0MN#LG_F?@Yg%{TFJtZ&<$kWqq4Z^&d$PtQsE%C(itzvL5jk` z!U1XbfGR2+6n?(V{<<{;aW*svg=MTG1ojcu?&FnGIUR(05f!tDOU@rd~gzU#X>D;gv4`{qioJ zS^ks=M*5}Cs)~)$Sp1I{4qOY@2dZ07c)-BDSF614K?L5lAp*%7SPJxH>H2^`fuRkqEey1&?63pZM^g#lVG9Y7|+4P;P$8a zUP#O1e47B=<&DqPbZRP1*qb>36nGjSw*OCL5dxw=H7EL-2;EL^oBu)R$n32}KZ;&r zyA8miMfw?uZQ^e)zc4+T#!6@A!}VKarUMKyY z;Z{e4Y#4&Je2ED-lnNC8pdUJ{aWD*!VsmM56T?s!nfHgGDAVrfLvUwTJ<@_R=^vPk zizQ9(kng`< z2aa0fEiaVUm?{-ugYFsBifeci`GAM+eyD9jzy;1m0VmQV>tC%nIX0vvp)c1>c|9?J zn}EmaPQ?J4S|ChdGZ;`v7=BxrY?v6uMn;F{HHgKHs&*$3qvO+RsUUx79jpN+X#P;H zL6}sewOxw=)b3bji5ca(Ef~k(rll8&P9ms9qPxO(n5ifxQo57PkL4D|VP{3_YBWAv zLRTK{)DTuv8p0faBV-Am;2V7e>xzl2*C+))+@aA30A5WN)LmrKMdMzho&nU?Q*l_T zhom%0@q;ZnCi+e;`(2_)M`rpyJ4O5HB&3u&nGjfTqzSAxTpDl<84gE))y5Ws;6(w- za3vdACPb!(>y*b2Lkj?Rsplb>e-I4=v$*G%-|ft;mX?tON)h1%XDNKXQ)GAcn!~3I zvkg2AhTZ${0IO2ehX=?N%PNDyCUfp$Y3agq9|D3!7wtl{!%mvR=&hGO4E2JQff8i(@Cdx;DQ zRth>iD}`zCQsk(ilmjrapq?ie+EOEY)$G-bf;3O8o-aWzvzv}$8)eTgm7fQ+MKQy* zDiw%?_SYj|MouhW#>sUG1Z0#yO8-KK_pGjx!D$9dMF$^7dH=E2jh{e2%=7^dV2KrL zAtOzb8U!GT_3Bx;w0iy-r?mX^x#!E5q03r5f7!XTeDPoEDh*f&17R)%W$1Qbhk*j%PU_uG$D!3%q<^t=7)qnSc}kN* z8U-U#8(qR%Re0e9qZZ2{x&w`PaHsWL$99F4o@=4~!4~F*nd9X@MwID*=Ib6VBt0KO zBm}q`qST710r9*8$_PjS9@BdQJ2ucF%6FJdJ&)Ke=tw{nGgPCXko(UAsu)u8kV=C> zacMmVJ2BhZ6>_8TG$gbr24|Cg2ig>lzs2eois_)0HWI}|*;(kAh~78k##v)$!Pk@6*bjfAtc5`;5y zCxijQa5yY-?8Jm(Equt*hmEjjJv@g|(1IwHmyOzZJ=G>NoEBk_8oTDpBtA2!1^$#p z^~#DDNPpekT+Z_GN=YYw0`Ks*ySsTsSSaVMqV2B~4iDq3vA{xc2SZD0hQysHw3reX zSy}nv1xdzV?N1@`#3hA^BRh_8Rc7Wyrip-*1PXXc$$Sg7EZajEapNo~j$P$&r~`}b zUB66c(A1i!6P@6y`^`td%h2UW3pkB|fPAo%U|%cYK+Y?0+jOZkH4W0}wG5e8HB5Z8 z)g&Yi${|yz*BVSGNN{T~{YXd2{;IEu26wDl!~EqIt>$o$mvVrfO>3AiP&yb%_Vy4F z<7=eJH(cE(ts2tIiW#iTsB!NzcI!s~jkdX3y!k{cGgV`)#@2$^q`o0*!RBPR7X-vi zuz#wWkuq6JZ3~$g3TVCQB1RclZSFJ;7@FN4V%N?sU54wsuxw0JwE?JKW{&0-R}Rey z0wo_nSbD_E$Y<#}j!}m#qpVV+d`Z+Lyvb7C-6~%27rjkKnJH3$_+>|Q5i2qcM*{?a z0$dj4npQ~K9A6w~od|+Jj8y?92MnHK@9=V96yA&&OSc&Y;b`snXcX#xuY@`n7|3?b zwsc$OVICas^AsI8!I7bq;MI&ARfTfwbnWAr>=eIaHN7y+E7;5Oj7kROGM+Z4NN z{}jhzcOy6yyR6}8{HU9>P_f(D=Lm@~OGbV!0c$1UcQHE=#B*<9)SUY{Vt=f;n*i+}_- zLzf-_Yuq%u{_HL8!z}l0?uGS_tidXr$xY_!mW`pG-p`fPIlYikboX{U0rq~8|L5(Tup3aHn{wW#TPZ>O`F zVourFwWz&4oRxar^0WID^&TPQkG^d(do7G0J#al1qzjaMMj`1S^E;Vkw0yR7?Ve(5 zrv1TIR~*={9iW(D^8Bq+ZM3Sm5tMO1FE0OayEH85s%|%d13`k@#Z}1evoGttqVc_s zJz!&eQug~%e$->g3|BxAMd|?+afO=E2!NIFnpz$Mlc?(Xp-MJ1^MGR+*ptVgq4%T$ z=pGu9hqvOiLk>xLmqp+d+OR80aI7>^rS)PbV66eOWenmVjjqS9fie4^RDimrJM_RY z_@XW+toRH;TzA4vWPmvga0}xQ4r!S5WU-8Zqu6*G^9oRX*?>dS=wlV2jH@BX#PimJ z8;?J&H&Wpnpb^sIA+QoA`S!%SK2kQA3x{FpzDIJtUN~>?;|tOE{qf#L939!4>aTmx{gScKl{e43msi{(+rf`ho)> z>(`$OQ`F*bs+Z1|LQe?m%~-3w{cUb%^VYz$y5hNsZ(V{>^~*X#(Boc@XT8$&wGhHL z>T-TzBd(Kn_3h1f*30G(S02(ujM=Vs>ZJD}cR$yBX_~X#{gu4i87_7r;+wA9@Kt`X zDlh8FUc>wvPtd**njv-lqB>**0-#=L;W{H;J~vA>psVfUoXo+p8fHKK+}QOv(=HHN347s8b{T>`3HpQbcHMp0!b zq-zLuL$v|{+q=X>6ZlG;jhOX|&{5y_==g{_#~z3Ii*z2`vA8G~yfYpB`hwUvcurF- zrt~Dx${{}2Snl}ox$N{zE`1C<229Au(tL6=2CcC73ix(T;QS+bYvJr94-OG_75pS$cN z$TGmzj|2teA&2lX4myAqN+#JaV6jk@F*_&CP1L-V%n{`FrQK-RR&sT zl|lQWKL>NERSoNIRRd>jl>uVCGP-q9Xc`50gdvMALjr)xup`*KkS!_Znqb;9S z=Ov&~^Aa$HcnJ`6FM)1)3BwQBqD4ch&t90f6Yz-l;Vs)(((_m^k?=^oAoo*|`FtYG z1SAZZ9Y|Zh9fA|;Bb3B>8`dGaIjQh;fx1cqJfhhfc;JR9i954DeV zd)ayDkQZ3BL&$n64RM=pLAMkU=C~7R80(yU%4lXx2}G3-_W5a9>|H&DNR;o>D zc~+g3g*Xd%=hy;t5X`UF02*qFB zg&DZnk@&)q5NI)toI=RdTIjlK8vdJBQpKyq#Fg@l5wA4;3ZcZeDLLUA?tZ1A|9o{i zBr;`1Ne6C*tjfNRzZ9Fy>3_YR(z#H zD8NXD>sLqe@~e!b#ZHlU4s(-k=amp{XYWRca#v1^ZGXn?-gWg|}7do4OCa8tjhxJfC9wbrUrLINS~d5elObWheTQ^upxI5xQ;p*cx?(?#4*+DRCi*gzIo8pK^g! zE~|9H-bd1ib8bY_a1Plcqjj4j&f3=;-QNRk3N&JLaF5PW`-{n4X<;-q?@lB3F;T)< z#1BOXwtys&0AljL2q8yT29M|~BksF)2qMPCjmsYxFLSOgZqz%_sl#E7wBh*^IMPKj zmY`eZQA-hY{U3wIALi1!(w1C&gTpSVY>o{W#Ibv`5yOC$02hO9*($(@oG?S@22p>QvPhF>GiRfDM8u4rU>il_(KJ#)|=eXjv2DF~3cLlDsZOfdRD87A1W%caMVK z>)Z&WTKDn_Z0!-qno=G?_kHkz`6iR$98O)rubqZLj4uHK_S8Zi$NZTEh7e5LadwOj zoinrSW1-3CuxISt`G?^aN6vr`^LHPHkKFmoNBQrur_VjRTKyx_pa{sdki$(% zB+l@5@(iGAu1UP%l7{9_H3qY2KaFvax`0J84LRO8#3t>n$Zf_UxaOxg1`mpYWAI8E zje(AFus4nJkfLGyXo6r+%VP7;&Nb#+je=l!uc+AsLe%kQaWhjLZy{#I#AWE$>beY> zlP#9Z5Cour%Mcg}MG}m05EEvEAE<$RM^r!!SkDRXE!Ukwd`v}$wd<1^2Pz^Y0eR$J zJon7SbI+|DYwSQoFL860wuqy4k3yD7QNV5*YX_1@rltllJX^{q)t>}xdnBybYp3>Oo$$jF6PJYx3|Cl{#r*R zh-9Y~|9{|&DlR&uQ1O5z!=2r7Gp=K#w_q`UYI`Hczuq6~72W}ED|v0gaw5Sywm1KP z>x!nq)WG$vmEUj=a1o0b{ItDsKmV@CU)>Zga5CMhW~Q#mF~Q<~aY=LcQ#~|DC0g|C zQe`mT)RZ0F=;HRv_qazTGJKs%{a&U1no8W`n)#CYpcI1y}a|TsP}(U-siU~ozlq0KK|uDdQfI{7<_2qWU{(Z&>re?osB_tTinL} z+8NsH&bR|=b^)BYT@K(#*SKBVr{B7-_O0Jztjn;4Ti>`l(ne2-BLx-@x;-KHpe$qY z(3*SbrU0dTNOjxo340ZK*W6xRq1UTm)#$^`b-G5MRU<6t;rZj6vobH;?IQ=!JRQ-OKx~&MiqojEAbPu0! zS55~OX5i`2jw$4;Nlt~9Cn6-6pkoT32d#B6hzx*v*Pa4!FoMt`vYv4K`_atI_^*M zP8-%J#0McknyPfxZ4hL_WFUMQ`8n^Tetj?ag6(2qMe7{QSI4YK80z@-Kn=u!q-*8oM1 z?rcq6Y@~)|J00-`z}4B8buz)_VHab}o`Wv#asdxw47)hH?N7pD?$be-T`kPtFrXET z60SI5xNkP|z3L_zj_)^3iulP;}p!uNYi6WgBHe z0ty6kZa+aG-SBb(XCAyvoQ=UN38NuF%t7M+=oDmX0s(grgpj>3odoGfMALz|UA`)G z;WrwIliG!A#9>=eHAd4o6NbRgfC3f=F$Jm)MjWUEc&BEta8e~k9s-(&j$v?yg^t1c zubEp+4s7HIFs|5JPD4tAwul*Q3hOKnV9u!zQNrom&j_@6%+5yWlqQPkNM^dp#Z3vB)F8gs>;151eo7+6*bfA%!pm0r6#PYytPiFaZZ!^BGvdhtWx~hhql_ zl|e4x!je;v2C4HT1Ekq_4i~n6e%D=1p+YMYde25)Xe|}GnIF&``cen%*PRvvkC2O* z=B@m`LTjPJU#TF<`G=V$+1@x=5Dt!$Vp_pF%10JFw60#64!x|Oy_-3U@XWd5a}m&1>c6KV>eb+`{wH9tuyEV$Roi;>2Q9x6QZyCO2Sx0Gyj$0U|Bo>|acGbdhzL zE}Hbw$;3|1$F)ooxK8sr+hH0K(gc(Ux-j5Vk+1?-m?FgoDs*cxehq4Xyqca6_s8Lq zRU+H^hJ3R^#iW zs=963+sPG&6h6IU^@rcHG$q&(K1B&+6aPVs2%Hz{h-1J2q8IV|Pep*alz@dr@SO}3 z>#{z=gH5UG)ni;Kq7>z0S9ym%(2IT#Hh{rvyMk*^c+vTUnk`w>7CrqOzS*Ug|Ckw?@e7RH&ULjhzwUXEkyoJw z_2jmy8FpYTZ(n(it6<+r!~YOsWmiJGYaLi0KPl|(((cFSJf<3{9ehx0oKk;?4Bxl> zUk;=KjSC~Wn;l>o{x|Mh@b)D?ZEx;-e9mx@yWwbC`D3fjQcG!VHgxmTrBLMoJlufm zE~{ZPH($v75Fdul{;^g z@A=akm3Q!qjam)!IGFn+5m}#spgX{QYzW;%)rf!KpjrOf_JIqIq1EtR@(b660rt#3 zf?$di6R8NJrKD<50~Efdd4C%q$~85FpCk{K21Tr=5p9?Gu)JiQn+TL}sE4}mz*nW_ zJHAdr1+ZfUV5>M>MHF6upNF@TqfnsO3|bWR8mO2kh?2*k(Sbz|U(w}Jx_RPP%`*VQ zJo{KW!jazl&_s9%kP9zCY>we$z@K;tXj^pCeoqi6faPimFz|9U1@tKL05*^x=-v)_ z!0}LexHIHAB*^n`iBq*7`D+U@X4*s0#Msm_K4v<>y8LL_n_t*dpS_8;fK9n;nmH42 zDXmp`R7}e2jD|cGW!i8kQZ29f6A4IrJNAS$X0{y%@DgB8plPZh`E=~J9(O`UAjz*` zP9Sh}45RyRt{*%P@F@U-XF@hg0g_wzk6oIr<1-&0!M{!PiLU@VHY` z4J;mo9A|ElhG;EU(Rw*_c>`ToU~)h{%`2yTbglK85q^4j@ zQq9W(wFqW`3HQn|3mj*WE`X4V5_VCy#3?Yr@~bKX<=Z5QOc3n5D@G8Q4QwcO^K}H& z6J!gZyBnaQr)_lyT5Af+#P$z44_!Yxhjn;m&@YD zrU@4**hS=Hc!pq4qWA>4Zp|SL6^|<96loAnq_g8xLVh+U(sZtji|DEXoSI;78kA~G zO*P4FM}<{Gij2jxbI|USs}I8G@e`(zVlH8Zs8NbDf|Z+LH&4(v&q947-7kGR>@?pB z?`sOp@#eJj>Jrxa+Wb~ap$|IV=FKNmP-=-!wtaQ5&>$cd~GZ71(np z0d^R*2#`tR9TL>*3n4^xW3i54Fin6oS z^HT4eR~{J1lJajVw8EegUTUqX$=-NxwfuAS$E9CUt?L&Ki=v^DR2dorzowRKgMTZ3 zpo%{u)juvj>Pw~SfXGD4$2L5VL zGz3@kMn#t9J0Nrofj~8QYY<&-RD}4=jf$WKYE%UL+Mp;2wRWST#u8%^HsnTcK{)cW z9MIJ3x-~pTqQ=AmsiT~s|@Usm!j(? ztrVhGSSd`;*z$SAPFybWiLu$$XI3u5c`K^;MGD7oDti)P7;tg}F+6d#!*mKxAFy70 zaP?>L3l7gMm~0FtxBN7sHb78f4lvwz{trX4DhyBgRb#b`LGRXc3TA_r;{=AIvHvR z-qeNZz(lDW-AR=~m}bnORRpwYrLb$P6d30@#QI3*$LKzEy9D-K&AS>|AAkwpLka-8 zvV5+D*wL2|7!;lC$zQmLPSc`&=b=94H>Ds%LE?>#Z@7^%w<| zs_OP?6_neM)8mZ=^LMAz!PFqCfRou$hnjj`SlbkncGh2-%@ z2L|8m2yLNA%uE_^VT3MWnnBuk0df$?4^OOKymYy*cU%JLAO0|WD;3U$)z2mpRsuxO zbik)^vq&BxMT$ey!yjs?w#Bz~Q;7X^+;JQ;-ztPN zV?Cn;(zqHbETiTDegkZI#2;x=uxO16lJGvA@Y(^M1awkbUn&Tk2uw@71&+4!1um!q z{gh3^dqI}zST+y$Nk-5xJy}>E8$qSiF)x);$GlXE-8j%3 z%r3s38{H1b1hkR3*?4x$WiL&zbZ)MY9f#zFGU%(^91|I0Y)+)}IJ1xJI2e%Zi9D8# z1_W{>+ZB(16L@gpfmR;T04R7N2odjDB1ALPTX=U;H+{s%)_M^IGQ`LZX*g%o&>w~X zIbiiP(9w8|E~};daLDtts7sVAiiA^P+fIAigTW(U(6i{M)@Mogb6SNftK^Fv?!k?Bx^15-ZQgIcU6r7&D>W|!VlCN$)oX(n@?wXvgnwWF*P?I)5^%vIgV ztwA@3vr&`9Ox2xOf1@~Y<<>>D_Melh9aS;+GzUUys7e0{o_ugLMr?HBT&(0%z#J{)%Yx~f?TsbgUh zeqFgmkxeKP0d4SG9_g&IFGOtw_hi-bTEMPg3Ox#`C4kNgAwuVF+c4mlNHGq4aVFoQ{I2&ah&GbRiiW5Ua#$SP>mNdRyPsPNsJ*NHd>k53Z!qZdA$PyfI z%gg1fZV=VR(<9Yy3~N%qxB6?=si?Xw#4SgX`W39BZ1pR^W?a7y%$&seppYoa{O?OK z6a~ulIF2><2^4Y56TDU<2StLfb_|*X-H+PZFf-P|Q;eP9g0mh2$DteY_gGD86b{up zR{$8=Uz630LPO^3aTM&IZl|WlbOWBRHl3JjSes&y`)fnt)wuTUb^&}>e63mAs-~l` zr8fK!uu+XvN8DjeCirmRB}|9qhd2NQo08cEaL!9)v;k}%t-&HC2W!Ac_fIOfVe)YF z={bfm=Sqgd#wLg(M@Ulg%bP>W>v;$guBVBhn@9ca4Egn-c*{~g4#Ihzbdq%T)lxnV zVrEDunWW1{jqWw+^Ds&hqi)I)5UH&c%;{DN{kKvWftQN=G`Ml-@2oPvdlNaFoA1Q| z=@=(eelef{r3~ehYLW>}rdK)UQ{s~To3x-&fD)9VQ4>iuN@whFO9vKHnkL6`rRSt8 znN%kFp_UPItyUS(5|GS6Rd803)qko)N#@$#j6G3DGS^>$=b2t|m<_z4*h&RJuLpD1 zK28hAxUC;JnDBco$jAa`6(~#D`czPE1ofc{h56X8P zOOY9;E7>3+Ditw{e3rBbc@H{mtPd{fbJ=5uJ=~4hCZd>PY04*qeB_vD|4&x#mLZ(cgzBrG#lkThoE@mylt@7Dgf{HOV!-@kaPX) zm8Sn!${-y6U%B!pDd&IJjVWJ=jUjNYsxK|lx=td_f-1mRiLG6cV~@o?gur*ZAp{__ zqp5+e9H?eZx_Bhy9>IIppS^W`{rU~u3-2CU-QIl0J+yJZsT6V#-M|E`77taXO=j_E z$UUmwBqgf;LI{TrCQYi?kM8x;DxmTGUM+N^t4g7XahBoD&!uGin0n;THyv^FkV9#3;?g&lbc2aPK>V;z3zg_&Pl)oFAqR;@&H|-JdmP{&fC%9?z6axV-j zlw;6v=Sf0{0;vx{S|G_qVKoZ2KZdK&z+m7W=M4O#;`qEU2XVAL1BWW?{y4N}_FFh0 zXeDFtFSC;%xpoo;dpij^%SuK;9{<1g&aJnt9LeJki(RbsvhVYBpvIt`M&i-Mw&a-? z%eUBxW2a-KFTlPiw&Dn_NQNv=Z_j+q{XqNsSCNN2y4cBLvAbwY&}tvvip65FNETVe zJji^S2krE)#8$_Dxf-q&)PMTB6)Nb(Y%eCXgeHYa3Z%uPoIsgjt=CvSyVQ*ny^RMlbX8u z47qPwU7581+kZ+~U}C~XxIJ|F=?|tDPqFr8|NEjhG7Zx2vP|B5YoO6<^-G~&L z^7Re;(h@7%_5ZN&68k5Kxf)w*m}ScOd1Z5}%&-7B1y^KSH`I*p%K!a$23|na{*)IT zEVS^yij-27mTojjsILlIzDntv$Hv$%v~?}$Wmpzt2t0<;a=Az5q%UhkrMhMKUxwEr zo`=cUxnhj{28eiE*h<)un@>XGOUVktI97tMp8|ed(#}AbZdFIv5+oTpp|qE>9X)%wfj0~zp~U077JN$ zSNhUKd-=f4f;)ETS#p-V*k-Brx@0Qb*1>BQCX~+2w z$9*n=Fi$&q^q3ZxrV*+U0M4xwPw)yBZ&6@PLms+3^%0kP4DnFjN3fBwC9lc}Q(m}D zEo^n2r9ETU?n=cbwYolpLRvO}STpST?Frp0acpEKnqkv*G2z&BIA8Kya>AVD>SQB` zLk&aItJ8@}NdOKxVtJa9mv`aNzkJDsK5h?W!hv-PP7{KC+Afm85zzZn832Fr&0a90 zcqRieWUCNuHXC zgHM;-WzERaa951uw=~(c+H`f<;vhhhgA`mlCIQ)MyTJ0U4>BYSEH0VJp=BH1 zbdxRMz3i5yC86TYl~3vnhPx=;ifq&3w5`NcE~-NzI3O?NqsaTViTKLWbVsO!&_q}| zgeEc}&*k%d+piGu)SON`%ZBOdYk~p01sE(Zvs_wjkt@PzR2!z-WhD#=A&1dm?B+0B zNS82tMlj;ju26`tyb!ndj7XsnHk)~`H21RJMAYVU0_(?|$D3g>6RNYjic#V~#tPJK zwz$AQcm-;g`8Kr)E8{dnA>Iwwz(L$CtU`sMB9XASszBA|r%dZG-x>kgV&wdTZ$>K= zY0=3Z;f&57KuTZYFV>yDrfq#~_i8_YX>zARxg$-7J`5Al;=;a%)}b;Dce6*5cyl|86MlH;`vkutot%`t$>eKs^n zHshqy77CGfwwaZ)a(a)xgzlb{UAAJNS1H%_Ws7q;%c+1yyE+!yzOZ+m$R!)XAQsV0 z#S8=a&wW4nFdGhj8GINIF)#A9S!BjmJ`xeap<>Lz2$BK@ZgDKtSXDq_(D88jOICH~y2EcW-Zwf-I>$jH!T+Dd@Cz8WvVv z#C#XoU0wQWes zULnzQhw2?HJd%NRxv&h@_cal0wyn`c<^)!ca2Qzg!ClVu{^*+H%;6X>3+pPjRVBv}sj61MEv)8!EL(R;sCfYh36RVZ5+HenBjhrjHKPN9cM?WTr^+%QXX${ERFWkic4G#J zg+XZv+Dr76%asvzftQ8J%F5;mUHGkaiR+X%pm_x@y7PH~`oEHdIx*NnZT? z=Q`h9edPNm`-bW28>j9Lqv-#3H&kqw{a(!71%fLHq zMatZWpqP6X`Md(S)YUP&-s&l{Gm4ghORmJ+J1om$Zn<4q0i2t7DLYIZvu`8!mVs|G zup;nn=Abe+YtR+I^vn0hOb zF<9R?oQ{hhM>q3N7AM7eohV)6_Xw6O21=GaAj2#;pHDwiyu~6&5&h{MA#HXDnY#f6 zRqV}Rb~_TB!W`5nn(dN7V;V2&L^K#;24wgj^J4H(j$-`gKZTTxbhK>D3iXYRzH$YN zfJ!!|2?N`pNtc$W#DbP8+R(c0PC;R^v-|H+e`k(A7gw21);wj|GLdi%(_ zn1l{9jQ3tJcknto-~wLCz!tB5j*Z0q_26zugfXzysi~2sns1%+;q72t^tM5ISHoxH zExBjK)#z`yoDqV%8a*|day1{!=GalV;r}!VG+UrN~8OA5)h>hV) zk?g0O+AXwio8HS|+kl@{S?q7&hw53e=`Jr;CY4;VGWCe(sy{=>6^ZIMsR!#dA!;(r zTG*7#3qubi<$I{U@p?GCbD}iFbf<&a&Gq!|H_{tw*~Zc6{%(v#&FAS&=%0qhX;190 zOe_c0Qr^bilaM?x6Brx>nIECM(e>cIb}{_by3nd&W)fAE@ErL|PPuUtnbqTZgqud4 zPp>EB{z<9Klp$5G@EVQb2_y$|nIy-#R@zwj$bXSy?TM?Rn7im^RS$x>&`}m~I|GR& zKD}c@(EFhz`KyQfxxEJdjP0n&VRG-fpr*Z0lB$hw*sd81-Hh(%gUK~CB3arf2GL9% zls^_4!>SkLrn+Lx&rlnIAb$MSSpK*DLbK9NAmnVMqT19dy|>0D9F{TvN>j2n0y?~ z5dG4RdJ}iODonJn3)9r0-k6W(4|9aojtWs&noK;uOn4`rgN&NtsN3lEv&r@N;f9>t zR=1qn2+I1~hdGj8%s^Q^9#elgRE(stmlnKZbmC%e}oP9pP70n#hk+qo+q1NvoMj%2Z$YxeNZ*fi1|M~Fp zjhnvOUhjq0NJL$c{_bt>`|o|}R7NAX@FdJ*@yCDsb8(D|l6{pwLot1%b4Qt!Z?av~ z3#OaCD8AB4ENr{env5@B>DQE;RHg)MkH}wJg6gj=l_eLC4=>*x37%Oh7s?nu697c% zGalB?u&gbh=}5lm9lpbyuf)414|i+|%XWm#-S> z7&2a5V)%wl=#eL?N&bb=u76cHC z^qViwFAsX>Kj7*S>Kg*q74#duS4*rfZa2Q-ji@7d-SpBROGXZBE=ykpkqFq*HV75P@-5EnoK`0rXOE0+%!0y zILs<6=BOZy%+Tmuv>=hn;ptsMctt~q4TF?cB>)WPFoYFn+=g$xK+7zfjTV(Wz-h$Co`gh~|@%%phG&G9u>R0jUuT$sJ=U8Ij-l7G) zt*|FP(wzJ(TZ7j!7x{q$wVbWSM_DOLuxd);yQQRs9$QSOXBVT4Dn(X_giARaWj*lk z9{H8zUs>IwB16<0eq}eX>@s-~HnRnW=eB>6-8$=2t>Yv8kKXlu^oi7L#f%`E*sumR^l{b95Z42!ATjIQwN5H{MSGwMBZzxLC2dNr*;iad5`l$#1V> zUKvjcA{3V&5jU~4Dng9eS!OxHV+nbTJ&drm0LkAn$N&a-AwGhw#hOEW2Hr7(i@Dc$ zd}IY^^XuveFR8GS!)j|KVp;CV@$H(9cMoIc1)GT$2e>-irljSWsBT&floAicH77Ra z20`4lu3DYf44%o<2e^`_YL|YP7h9XmIU^-|L`!x>xGYp1V!nq7k;7#x9b!DQ| zJgJ%Xh5Kw|6SNX7Lm{k-0;2KI!+jmm{3U&7FhsSoD-^&>MexCZV}p~6B<_qGdAQO% zt>!pH8`p?Lc|_>g1Qh)mgOs8d$5$n{du&-E@}5WIfbfEKMg_q8ivzBCzSdhWF|*|8 z))I*9d^V*;SZjR1hniLut+ZvOhp7nLalble)f+JkQT=ykua7U^_p8zG)yfK)Wj6g7 zft6mt$KfYy>(CA(%u;ODx-!k6l_Nj!2NESbs8hkt)=QbMF1wH7HOgvx72*-U$`uxu zCd(c}sH|K%YTG)Rqfr_C&By8?N&-y**@PBck3{Zs!bDN^wkJ`Q2>T}V8Sj(D zy)m;bJ7@F&=A~(iZNt&e01lfH^e^Uc=fkiV6xXQWCd?>+utLxAvGW@#vmuI{Iqq}O z=Ete6PB1r&IhJ(a?{Bdl7yPV$gXa#bu%g z?vElNnNHn57tIuMF~}Cv!ewJV3~ix5y)m7sE%F18WZqmCfZSit26J30-w(&bYb_+6 z7ayh%^t{nRRfyX}UW0dj-2YCD7%)=rfMzX&zsZ`#_%!B8X<8;MI&5Fc-v6o3@cXv! zdLf1l;CT%E{l$;?ZhFBm=^r1W>Eh$%MX|~Lpi)`2biqEh94=9^EIwo#@od(L7fot= z0^~viDBy#(`f_dnYNCaKUr|xiwCC$zA~s5Ia*t^!47|kKl7gbPxwrwZZ7%LG*H`xC z8%&eH)m@(n^!2d&U$JkBTF=lwalQY|cRbfobe|pU@9*pPlHaRS|5o_$g8%Wa)SAW_ z0SzB!5bQl7g#9D3=|_p)arh?OyX2dHixA=-A_3@;OTR6HcA{;fe<+T z__v5d*tX=v*o7GT`^wG_E%5%qEBih?Io&@zximOyz@+V$@Nq!P2pyjE0Q3^bYw@X& z#^Eee_wZ!@=m|Ir6j}#q|IO)z{c?ih8U z@!w+pMc6euVPPA%exN+L3rw59I8G#5Bo1sR=Ka~)hBMMXu>y_my=K&$p7+j9>DgEN zr@hxFug_k+dewV%z~6&cz0-aE9ua@^>g?4yKmFyW_>=w9lin$xCmLs``)XA@ok;a- z^Jl|kmqXl@I55UuUY_?ZFE3y6`?`OWxS-_e{>y|zl;RM;x7e$ehcPbgr}E`tOkG?a PrufSG|5*)3N45U~Jy=6G>8ToeIYyqlA_e609ts7 zR7fg`$4_ArWO^Z7Ba zJC!{?`NGEWbZDV;>IYsq69tIu3Icj-fqT{*wJ zdgU>^t1y3jI$v7oc_eit_S(#e)X<6E0lem!OXq_ZpZ~$whiANA&mWl_@lSaLuiu-` zpPHYW2N+D_w$Gc(7Z(eqF@F(vS#LI9JdKMCFW5ZIdi+g!!6VYy5wGcFqN(Zb;b)uh zZx4Uk6HOz#cp*id`<$wmq^NCe^wzcidu{C2wf{Cck+^m3zl=>J@#oK0+nNq%2E4*F zKpNwmne}G?u#x*C_Z`k=yfMG@@Vu8vdju!_)E*2kKT3d3XT2xt8{^b1*rmQ)4PcU8EU%J}#ac9O>ax$mpPy0hH zPTf}Lusm3G%AQI z=Nad+J$=u#G|fpn9a_1gq!)gN87r1C-P?!RnUR@F4GnlRvxQR1OAT^fP3d4-CUVrD zISslKU-rKK$hrgN)85DwR%4_%51`0KYlpB1wsIg=*N^ER0eH*{TzP%5>TEBEbb7|0 zD+rWi0A6!5r-J)*Y#@F5X2pW}(=&MhQ)-~!8v~+`0^;O#L@h7Xm%^KM3eanz^hACZ zrRhPzyoFg(V}M-A8v>NhlRoqh5tc@CqZ4^A>s+T(0q7DT4A@#I4nEBwc|Eu!&J!}H zM`UOOPcyWFLMrh1XYOihN;s?ST(+lM3KIf|69Q6S-(&vXv$oQOe`l5xlgWfMcv2sm z5(v@jNx7a9SUtN|lxF77gt@cb6{TrGONRkSsmzcC9^$+IM1J1)QmKIujyNG$K!1E3 z6M^Z`^)t6a0*1=#yuqO;)C|Ocu0Lx~*|g6Hu`85LE*8e-Cp@geZAeoJw1?|GmY*A) zEzHdOv)&*e(@-660LvIGuaXg`B`9C)*;Kz>uRgO{;gT0aqK-ERwMWSe==8i2>Wqhb z(rwane27qQOR~S(($v)Q0pj|5me;?zzp1*s-nqZJ3<}WMRb5{DW+zGn(K|bp5#F>`JC@fvlW2{`qg(g6(2{JE@D zhI1nu%~Nl0m3MDnd*|e`bnx0<>8(1svMlhiLckd8^Ulsq_>259BH-Ea!YN)44SHuu zRCo<~<1QId6*z_(!xB<`Lx!28fT2z~0L-}qnvPE7W`*vA#aLS4P|3^mdByzrJov#! zTAG7ul7@#q5-eEZOg>yOqOmQ%#a6_hYe%4*4VO~I>A7XNhP%|BC` zH&qNSoo7C=oM=znm7A6}_a~dTZV62U$2yyvpY|8P2(irk79&N2J_1GNiJ*D`>J?Oj zG1?0O13yV0AeeM%}(M%dR#_I86n9E@mViFJL}J4(NZbAHU~LrV9=WbP4xOP zt-0v}lnt_Xm6pJ0g|LFNtGr_2Y-Zs*vS#(y$SK8g$-4gkY0W^rCi2A@PP0V_0gXG5 zY8tN@2)0=>kyU^&B!)y7yJR8RsZ~KKsR5tTl!0qylz#}dGQ#H)E}s2rt?IM3Ji4|# z5!Gq#69gH#_6}!t4V`>wWsO==?K6QMLBir z`d}(p8Qr@310-nSGmiA1 zRl4hxfb~wRU>{65v}d(g80<1DI*}`#%$IW0d27f>6S2s{01Rrq=oN{RxK_$9N>i>G zSC~u2vEdqP^qyvzBiehDIho86nM{=(haKg908hZ0*MnyuNcTWC#sFY>;o^syb}9<= z7&8SAhdAi)VbdHl_9{F6K5u3emz08QDt!?H*3w9tb)ekG=!Dqo}zLMTWY#D)x$fzXE< z$WD+QHCxCwfA_DoU%n@2Zj!fNTxqlL{`B(JSm}E6$F4U08^5EZu)gc{a>py?diT>? zGk(X^&2n3{AhlDSyX@7P-*)TTg5Oq|)#vV&Ki^2Ut!;1qMx?iD&|Bq`k+!=$wEbeV zZRN+-ZglQ3FY((t?=_bzod?X7U>FQMIwHN>R~`A)!mzMna?f-hh?23ZfDwjJn#P@& zMAEQ+sJ2LjHVsWcY$0igl}<4Tnse6+mKvI11}&JRKoQxe+TdxLF(fS{ZooQI24|Ji z7Q&O3)07%?4b~psfbbepR`z! z-}_qm+ynf<+yaX&V^>K6$PYz4&hzo{^LaSXrq5q^VdRA?SKy6)0b3LVn>5=@b z;%+Qvw^DVUA)Xr-*?CSw_x|V8|0ftyvNFgmh)?@nJai{>^;)%i-y>s*Meq`;) zcNi|eZKuJ$Co)(i57BuhKGXN`-JMpEZ30~n>sFt@HsxR)+8Hj|+Y=K48>iQ{uf3yi zSM%0Adf%qf!e5G^YX}7DOrEYn+PqY>0+}e0I?Q?Bl@ErWp(nz#`YBZ(H!x~BlQ1Sl z6u<`VAiL(C0D$OS9of}_FWJ)*x#EJl4E0S`OjjuuBI~DilR?Q$w13~->OXm{>2yws z_fyN)pPeYEc}QVF^{cbXo4)E-)#0L6>@t7vHGex-?}H->Kia6suXb%S7$5(jS8wo39eT}ON`}D(K8%rtPetvFcS~#gYcz@Ol}5G zVt51Q6y8v@8J%a>jgXfx5|SrHT*@DC3|Vo6+BBq)`Gpw<2cRMkDaWX2;quprCQU_g z0O;cF2a*`gY(iJwK*GI5n!P}pPZwkXe{Et|NpN*!`4^>RLe*wbO5in;2|jC9rJrht zSrm9;Aw+We&3e)nXiyF_YF7dtlgQ+TACGB;)*McrJKrH+2`0=ery4vAA%P| zdmgb9rOn8CM00`X0WzXR7NgT*zM9P>k)|Y03pZBfwmOkqzd_0vli=xki^G)`;B)95 zqL3`)TINP1Y{gBx)){!-#Ey&@1zv%*=L)4D#6s1m0G*4_q!I?5E!}HxZ=P)4dizSp z>E-LYmu1n~5>LwD1^G4~P~GOW!xxFLfBDkX*6*!W{{3X~OywJpFR(UPPFRu5J7Hn~ z&)1s;AfG5QV7Y{TGjwnw7{cj)9@BPnzz(zeGJ1S5U_ba|+|q*EEfR`H5vBXcecE1U zBwtjxwlacD2&O@}SuiJ9Fc?t^rCjm-vaSj%VbFv)P6E9Xio1o^5S!GY2fFynNm!YT ze9;lk6&F6dJFULQ*LE41d)M~n0aJ9Z6~nhbr-Jcok6jzHSF78box?KOicHdDo2|Wm zc-US_8(AcSb-7u&(+5B#DOgh+!>59TPyir?VM(TEV6w*qfo#&%Q5wyuQ@geSOpLYb z3DB%5B*em7qERy`SL}t{Y?%(jm9zzPRa-a^UV`ZuJVHyAVIpO%d3;`26`x=dP?m1a90~ z0((@TcGOuzJ`6eOlQ^BM#Oc6$ZjEH2+01xnX$Ms_^;)1w zOjCNVBu%ejRt>9*DhWKPRT`V2wByX0dg{#|?lFV4}s7L)qqijp*A*h0}(#B4Xmm$^B8R`x>B|UOkI(;0!$+J zahnUw^^tnVfoN4?8O?)1iJ1rx%q1B;G9f&oE-enA5G z3M>)?(L;zpI1RQ1RfVAlB-{e#B-+3W4I*SjPJ_s{M6U>_0)q!RqbCBJycy&V*K@cG^ogplGFI2 z>NLXOCZ{A;4sVe0$&Y%CoFN$Z`{u({M$XlHBybv4D<^F0BURIKvUFqproP8-#pSxZ zC3oN5B4_`&+-ryJEOhS zA~di!hE%}z0G|=o7hJ2a6OucGBO7;82jA+rK4lgab#`=qCVnL5{M@={cvLWe!L=}} zU#$b22ML@zxHGRN-e)0m(nW@P4=D!RuEVDP&4Mm0pZ}iD*Y%sgUJKx(3gB0pepA`W zH#(cvw&4x`TSRVm#nLOWRipB+Cw+ai2PLP=sLQAcGtW*}Fatk;6U> z$r=N}aFhn@h_5k&s<25)e-zQFmN$yqg1|?~PYo0%vJleVl_t8o4bSVh4H!0kkc!4nw@`5>m@4Gh@f z4GckgL*MWn1(JoY565i86i}hR?h{c3{#*YM;1XV7)2A3>(QM(oviL>Rw zl0)o3j0yRuF={{`iwUWY<|k|}TqRiXj9=uiAVJ_hlu;r|1b8qEJZO^d-T5bQmW0jJ zVX`FN5+l5$&p;dp#mUTF!PXzwH-b;68$^91&PZd}{oQbvIB$!3PE62EPiZlCI;x36 z=+NMD2-;X%%G;n(*4AaihFI*Fzz}C)AA$@Qw1%TdiW&Mbs4aMjWre39KRyl<3FCI? zK%K+JF__A5%^;n*Q8*%S9fwApp=Ii%7)!uvG zaODUCAzS_Z%gsNVPz|D^ytnG_+q%c!yV6ze`k24>P_#+OY6`D~~Q*0+hPIZzCKh$J4KTNiF zztiv0arRdIW6fJ6fWNQ|xD^gEL4 zYweu}{Ql;xC;by0SDRi;l+#te*C<76(?(zN)0|XO>h~neJs3r@e5`u)&9y|iTc+eC z|B!$1Tc7j!{eHKdlB;iiFj0QA>JR$aZ(aL>f5LyXbmR5%iK^e9Ecc^${q^!7diki| zmhjt>YwaDK{y}^wgvhV?hdSJE;3uh7^bedbD>>J$ZN#-!#3sXUbDxpva0*79>lNqP zZ*^`|>r`8aYlRupHf;h1#tYv3bKrwIEgrj{!~no?1P^?(zp)+@zDY|LPfl5VC~Ts(DGshY5T%HSpFh) zS&Tr{(+pm1w9yQ8-MJYMAZ${^hCT8keCM1$i>OBQE&<;ekjO|^8AeLFTLiJ!lHJTY zJ1EjHN~1^&7HJs5seppVaf47AOb@r#>XgR*BHUV=60~T@m57|KdfX?8rd&<4`gWljO#Jvw;y^ylu-9$q*i`1M82QV7Q(vwAqtcX1@-!| z+fJ_y1L(udYJs8JebgOh{cxn7ky;2r^Lpy`GV|BA3(x?66iwskgL` z*}>36_SW}*CVpxkol_$62&0Rd#+-`VUbYY1;q+qbO2w)6%-j8a&08&%cO=SPRe!HCru|jFvw16Xzu&skw$pOQ^>fqgW9$L{ zQ1e!QWj0Yhu(s^C`Cb106_v1M3XIvo-_V*^qMLUz_&T8f3LS4ZnWB_2y-8z6{ zV8tk00rdrY>hOEEH@p2~9E^YX#-xArM!oJ2B`twQKgocdUwv~KDnA?@ftF3u65hmp zglQ19pjNh$*}bjs?nFpb3gJ=?4NAdv}sPg^$wwg5&Xk!>iwKYgQ(y>_KR2&cdCvV4s;_X@EhU*`UzlY0sw7%xK_bblD z!51TIj}>w6sZfIBxvG971_D+WnSJt)7`KA=MkkNP774-Ai13}ak5TJ9%+UtB)2OlI zd1`S0!z0v2>o=HZwPg~<)@&9TLlAWY)EQCB#*Z;%%cy8UWg)%J2DQK`Ed#V#hX?k$ zS)B)LMERVs5uF4{!GU`Vt>gxz2r@(BF#)jZzH2Dl*t9W)24FjZ?qylBVcL>zKpqZW zi)c#t0fJi?s{`&!_zl@K`B1=%$%q1;P2k3jqoj!jS7aUpXmHq2;>b-jbII3hK!wQ- zAqpSVv{xRE?#OX~_q%mDI&!mpy=~I(ymjpd3)fzlgt|3NEu(F%ePl0rz}ulPfLFBl zz5@}og#@${|KPIU@p}27e+)lW(c!i_{G(9Z4wLGW-dA4pj~;^ZSNYZ&iw;9sq+)mU zV^ri0Q(63v{?QJwxvNe8r{B3eb?e$cs7~S4MZ8+yv~R};!Moc0R-=0TLHo#l>Tz%L z)7s^i63~A9-Zj7V=IiBNDnwZfupa}+QV*k|Rrz;*|Dkdg14Kt11;O_6etGx)ibs|A z-Tn#PHrY`=)co`Kg!9nBj_Tn5n1ja{_G1kDh0p&%d-sF>qs?1If0$$N_qXQ``D4vn zKkScpfE7a=unqBr6VMxf!ap#PxQVFZAND<1^m%nm?{}{fa z{Fsbvq_WR{tigQ#IfkT?$Z*wvG+BQ1>YG;*<%vYOSoJ4gLfVZ;(r$Gs;&Mg0Q)y?xRW#%zi4}GJ}ucCiq#P zuhHBZc}Lv!2a|WCK5j*X3=^p*k9JiiSjQswaXTYq=}3L8N1>n2N5hHxF$0$B^@GD$ zpP1KAm%i0+VAzsAmB-5t2^x+>=V1O0>CBKqh&Xz0NFUTLhY&&&4e21_qeC(XQ)WN~ z!C3+#NRM5F213S*<$?*d5yLvIwqd4%?833T4XG|MD7pkBCLJz0fN}Bjk}>i^^CKTa zjYA8JI$@s<_<&W-$Wg57A#+DdTsYUE@?koHJ-j%kT$p6vxap&|aBvOeBg&r^+Ao)6 z17gs}-;|__Fa$qwY%lC`n#(6*A$QR5J9^oE^lj6AD;0$WG10YDz6XXTvC*|uyaa7b z`;7(wvfZT`0Bm^BOFHg1xUYm@75V^_go7|o9rimUN6Dz#X*S;pI~CN5qtFppZ}fx8 zzDd6uQDE`%h+5(p{rvq&5M;kANpdRc%GEc0gb_jn4pf3PTq|((`4GzQc%66&(|pkQ#%3~X4 z1gHapgMcF9f3((sG^ncHpY{-Sqn9!`Nc0xiPce~(Rv~U%_WnumaDb^m1r;n|C=x#e zDJU%J5@`tMkUnd}FYWk%F}+@H78(=+Z;_CNB2U;@{Cbdug!l;j*T&n9GTv52Y++%L z;C0`r*=sti#z2h=%&n{WGPv7F3isx28t66ZCe$4+;4FG;f^H$Ty7y*xB^?5hb*!bu z*w5j7AaWT5UrU1uENX|Lw;^N=y~E#g#DmET78V#-9GVw8ayTWtv#O92-ey(@st*%Y zGz)I*{L|2>6YPR9oX+*@0Efbn$+y#Qf$u0Sp8Js90~7J{)T(s!|jj&8ks>iXRiBd>pXYQi*qWuo}{mkaB!f2Hzj;nuZ3bvk)@<(0M5U#|Sy zro-4&Wu+a!v%LgsG?##?LeT`DIn$mSgMS=Km*uJ!)j2ChIN_y(wJx`{JP%DY&7+_cX7xy@~<&MB-<#&j~UY%AGm7|W+%2&C#k=N?? z#cMTD$7=;XX1rFW3%ac)DtGR-+Wbzqt^AId-)bW8Tm5vRtbQvxcK*onXY0FS;a^$* zmCjn=vN5c@#yj*Efp;i;Kz;G*9nwyw;qF&V1lSNdcHJTY&Bnt;k;NZ!E`DwW!{aI)_T3|G!EIe*nATOq+)Dlfx zbL|6VE5o4U(7^)%EYOoOP;NujDucM?K%GJ)Rm`0O78@%8`8M`lJD9jjr)E34ah(~q z@Ldhe2bcU`Xt7=S0NwAx8~?u_g`Y-%o{9U78#hwSJ7S~o1=s}-QtBJEc#u-}sP%`Y z01m(s>(PuOT?$%t6fxphe)|L~aXluAD@b+_!8AwQ4V zz;eszCgy=riI&J0i4}vQ6$eXN&iM-bMTDY_zYk)CfhDnb!Zj2t;l3%!xFGnb&P~}H zRX-hrL4faeP(DLXTz8}LF~NnX=dt~ELHWN$B)WF`zn94TLyQXEIWoV}DZ0w`KNnAp z?v`YbZyJUl1>Ld{wrNm5mxv>j+;#T>iwxey!-Ba1*5Vz|1=yr`2Q|&%KinXK z+W_zIwh-^)j1ia|!Mg8uz&+RvktPih!}|8X-fd8A8s`FSWk&yTGuV}j&px|x-g`z9 zBC*WCo4s1|%QB4#z;zY2tfG=HHFo(eA;=!8B5FKma zjM-4*G_gTFppfu@g~anyMM$*#dWNOA8EX zH7|7IrNc_*1W+L=gj=(joyIhivWyV}G@wZmD4NTh0D78lY%T@e5dbaVV+7UV5jEyM zn4I`^HP*_#$$BB?n%9~%RfgUq&*t0mXg{69>+ zy7Hq_iB}P@Q55S!wesgA>cQrEnBB=gfuImFIDUQ|%pWB8MI?Ga zJ#q@)HC_DHr|!R+NKbFH+}xP>4`t)1B)ZEp?yXXny@EL_Tlai~XLkfc=j;s&C|3^^Iix(cb&|S4-=!e+`jw z_p|jz%fbS$*)H8V(4^!o=a+!J6aTK^k@LU?wrbdKS`9AY)}9W`;M^dIP-xh@+B! znrf&j*lDPXu6-yC15x+{v}l_#B?Y7oDpKL5U2a4*x;n<^b`?oM3rD%_2~SY9;AR(% z*b65^Rrq3IW(J!)fJo{v%W~i%rDq{>n=6_VwG1{yy~?1SbpvJ$IpU_j3_OfMIW#3w z04ay86O4l|3F0wF)o zB$Y+!P0OfLvumSe>elC0U)^X~p1OIX^3Excx?BIWy87zL)}K7tdh0W*Up?8nvHRvL zkkoE{cJ*s$R=9cND;q77x30IYBE%R4lQ(a?OhU1~(PhXq5xM#1h8NP8H9cj9%?cYw zrwTXg5?WSIZgfpe)~_yYE}9NZ#w%;MhhgKGA=>6aw?SoZ-4=eU zz769U(Vp(;ZIf)Z-@MH{7=2sa7R60rK~tl_t8Q*|g*Wb0Ua0q#l?SIc-?P|(`J3A4 z+Su*3H}Tbxt`F(}%?nHxsWDlu?aiYb$#rKT!7z6VhsBE(BsCDVl55b;<;2yo$^&$K z?ZzIgygV%r-;Z#+|3sQTfQVi=Wdo!ZZHo9j0Nb4&R1SuKshdIO0-ae2%m-hA{|8_vF`_zFDcF_kzPgo1{PUKN=6Zbv~lZU=9 zi%+mD2Z0fhQDp;;kYy4Dnfw26DL1pfXXx`TsWk6g_7a1rK)WDX$m@xtr&L!*$iVaT$4b8GX_PFNLd6v z6%=8rSOlhm-o&DYx#C}AtHxr)#Y}oLRN$nJqF3OR_DVcH!E%D54B-2f2jciP%V_{y zVb=A21jE>^wS8De%b5D8h>G2-kJ(CvqxL~c4(joo z9&OtUV&AoG2JmJ0vxqvH1wM^=v~APQI2pL{zdg9P%>U69dkff3f4W1Q?#?QD>8kY74C!m~KQ{je&zS;Ho=)KW!G$@t}2GE2rT z&kDb!&uX@alLMQ64eHyj3(eabkF9OA2sLWYwczBS(XqVT;W(-f&^Rq@@^rWf=1Gm( zakC$t)gs;S7(JQF93>zeOk9`fG%{4S|ZCZxL#Y_0P5BK*A*(dYX<=64=KXe9XY@A>;W_*62n zwp>Uc5t*QY@erXD>Tdff?A>C3#{mXEcnDTEA>{rc=^AR?#?g(oWqH!ZUj73?k?IGC zC>wYG8MDD8*ZjkI5kmD>zUE6;lXH4&dV6_o@>?&ieRL8rm-;Xi%|}D2%c4ll}pDg)_FUI~ZHyx9g5A@tcvcy|OmNv2lYy zWNZh1myz{p|3JgBaq2KO&mCJK@#=E%*7dup#c;a6x;%aBMHm^{AP8=>ZFugS!e;Q2 z>EUZ@rCVPteQd3CQ_{8ilCE_G`|J*L$=ckfU=jIm?pn0SS|oZgc?a8PAM^(iTMP5V z*43t0WN@3W6cXWhkj5OF_ilX>+Z^hSY4a0q-@49CAFDH$n;VgtEO%fRVh1MkNBjgSDG+b!KQv}Jjd4dKK8l%gnvvxsygBC-v=X*e}KP9 z-;+N{zk45Jg&)JN1RaXnc4TwIOW5Bqf_(`iWo%k_jQiIIlia!?yV$S3@xMABxvukf zQc%sv&c}JPvad?fI43xvm}5j}6^->UFKkQUydU<*HKrN+Ah0{*Ie!A5fTjA1e=K1@ zx7>sKpEk4B10+Kz-$%mR8@H}q$ot3qL!o?)P5T@O-fc1hzOx!{arKQq)SVcSDVVAH zrI&mhWriu3DVM6)pD|JO$CGx026phz`o}ikg~6EtDCWzje)8%YFGfnEW9TX$^Siqc z+g&@98E0BIk}|JvjO+Zo&!5-%IaT#%o43yTPssed@o;p0-gqFK5X=vTvMVgOf&0Jy zzv8b&|Hn)aWV!q5U;l2Re5UH3(x(hWJYDtAzT}_vpT=}NT|Qg&&y=62`t!;1JO-02 z&tf{3VAJJJcd`>~`NX~t>;*9~_DJW69cW_(5|y?ic?&vfIJYLi$Tam zT#Z49FHX0E+|}+*J=i+p!$+rZriCNVAOke+?0gMCHgWnGkhpk_?jOL5gR0Xw=o3d) zgiGI#kdx@J`gt&=*%`pp4wS578ZDfy*3#FHb%{RT$5_nmIHF+|C)>h5U<;u` z)OMPMHP1|D7AwMu$-=1+$Zrxf7JP3OYPa(hGz;49X%-BsuoV}oTX2gwe#o2A@n)c^ z19v%bpi`{|+0U0VI_9uwesOqMRoYBp_R+Tg&a?^VdoRNsC zgZ892jsBfrj8D{0jCU~9JhlZa07087)%BMz=H}o8mMvE{RVv|y+5tyz72Zfx3C%AJ z(xW#0CvifCl07q^YW`kF#uru?J@os@v!8bwoTO_tyA zub!7DlA&hytxk%(Ux2uP|N4_m6rpU$P&E`f6lYY*omwFh@ly!Hng;L7Wa)maBks$0Yj_ z4ID9xfu|Ok7J_m(g@STw%OP3;$)fOXDXb{vMelG*)#6_I%a0uKn%)f^Et%W67mC*B z;rP4xzvuo?0_T3e4R^nr`~9{iZuF4N9@M1MJ-u+qD5;b#X}k%Xx9rnH9yfHk0b32u zRQo;AD{cTXATW`Cxf@4(InQvt!rz9j|x(NYLy+C4_1 zCGc1T-NM9X9_D#!S6o+&BEIpQxJ~$(M)gpD@ywpSK21^_DPVTYrj1_ zqUqPv>ohW@@j3gd(ekO6E58D=LQ8){j6jYN;xGlPK*$9k)NSO7G^enU9doCmKB#RV z>tHvlBiTXljmy0-R9Y#sj&KR^;o_;h2aUiO`kfaTxk*GKL#Mb%FrH%{<9x2S7vOG) zEdtO>;Fnkh^vL5exh#l~;;LXzE0*MxM6r%0Ze5=>Sx;N9PuMHumDZh9*G-Z^StiA} zj_VKFW}&>owM>pC_elvb58`fwxdC4y_wM!}d=J!*Ih=LLNK=o)*1nCoEA!RE*&8X(Df6?eo$arW4!j7 znc1~|15rq>WVXEA{K@KaLfG7y2~8uJcv1n4Z<+(CLR&`%QIUy_vK`Qjoq&4KTCtA|6}6R$kyE=@=47ZT?T0? z#97b1wQaOWdkPm-qrWt=?zLSc|Ih5w=Pvv|O`{6tdcS7whMzPC?d=l;TmR-@Q+0i9 zdu2Pf`A%)=j8-kXQ%>>>$4|>!Wt#r-rRlBTT&-L$ zCeK!W9RdlxskNsrf&WJjXJWuu{OBbnlbD}B%~OF!^K(dw0056Yh2BMcl~WKb-JIdQ zTxTG1l935i+k-h{cqxb;p;k7b1YZWSgC224l6g1J8P!vZ(l99CG{s_`4-rqH$3>b- z)_M0?8+%4lpW^XGBD(;=Ve%ojKSLWW@Gy5uuW1hRVL2Tw`XHl}A|@A*xpe$A4=5rp z1F;N;4bhFG=4g8435*GQhU_IBmi7~m>^Th4VK8!xmInsu9;@YHRPOzeJs{bp`!Rns z=9L$w3Mv8d5yoCzKn@h<1`dG%@kt>jydhZ;5rN@oARH*-qR|Zx9*jG7al~sL0KrJM z4>zxXAmT~Ivn{$C;^N^O-<$2+Yc=9OSZfB1)q2aPp#Ug-d~kz3x8HN z?lnaFwv&>0$o6usI*D&F5Ac&V-)mPzR+>dv>}k7@x<6827JF zYGWn*(GE6R>UE14JOdIFzcRhieB;Y_&*oG1WnaL>B#WiPN+&-<2z*c$11~hSO{ATH zHe2@kQy)bv`0G!7Ttl*}-~w0w>OUfD2E>N5kUR1xb2!fyV)_6Acg#_j12Aq0E$Gp_ zFat2|*edQqwP8{N+`%DXqM%MZJ5#(9L2ZNdF#{mrfgp}UG8pGWc~alS)LoH#c%CBf z=!Xhp2Gfslh)7#Rd6}v{*rnYnhDO;ci4^7=&8YieEOOg2EZKdf&3nUuxlp1q_Bckx zMIMG>x9-DqbRofuSn+zs7m7tvGGxAqer^Vq`Ff9Mz^}k*RX-r5+ zpv}?i<{Rj-v&S66o#B2C{d0A@1J4b|6P`0*gnODZOphsa?)J$2-1T})!6IRm1v4&g zN3r9Aus=g9nLUXDENTF{nPHJkn`bYf58F$+>PCWP#>|)s=9&)nPzTK=&os_HBQIj~ zzG=+pIP?;%JWg^5>#$o(*AX5O)1E#gwC5Tjg6A0-4>W1-u?wHK7Y%Voz*Akb#;5o#fs`T!Qg&Ao&zwW=S@_&mW1 z7U&}$U4d?!QnU%uH8B}{qy>twsz~AV;UDTo?(fu|cr|xNxKHpsS$y~L%ur7sTz>uD z@m{$=kz4=_LffyMEKLoFB$!SCqSVyQm-j$jj$oskzSFK2xs?3rFVQ?ZByudz%e^G0BE43 zS&h&Ly{e8 zuir1vN(=Sq(J;b16XC}@I|X5=urn;$k>Vv38>h7>+*n$Lp2E1*CIaI=LZd-}PD5V_ zdjox7!m#lBF=_DZbK5A-bI<2yp$75XM*DgZ_fZUxfpb16wgfsd&*+QJrtXCcAG~fAzc-r9MB9leNLhMFh{GRmZr+`(UfF@Pp6!WoGdQG?eU zAa24>qwQc(#D6y9vXbQCOf3UNCe{5&!Y=5C%kIU-Br+~?Rt6T z$+KTIH;=7uf4(5gsS&a(!Qr`^se)1bACr0kAai)Geb~X<6?5d3G!p=Ot>-C;S^GKN z-@@Au%6Q;cohVF-`rg&mC2gzbl#a^EDNg*+gyF~d5{`Na9l&E`aOA`Ucij7rU0v``fOOs-1K2B*zn21 z6ZxK~y+FcY6u5&EpPA1ws?jqJ2)3!|0&NUP%wE$G-LKH)149JKd$bFBUgITo2q2;! zqKOu z3pvo37ibj-$TgTAJ$|lj#w8R8)V4Grh4DA;pAl3}ubR4Du#^nJXQ)0aVIEfbr~kNUG?Jqx9Ae|8$|5x%X! zvvlwv)^nyfH-GS;kf?(P&9LP@%E8Br>egV3fb&RNJ{96fuaq8w!B2>BUQiQTY*!VJ z+Y!hhSjZ#Q4aa$M>m7P2ZE1_>9AD8bzshAQ-$Kex_{wnR2MIeuyn>kxXguHx@~ZQN zX!$I zbbK6WbX17D)Qv4nPoF-H1%UA%t&W1ID?i}3;Ks6vaR^p?pi~4aef+rWna6CtE7_cE zS{=sx&CabXuc~EWrE5tyB$5qVeTbXO@e!D%6D2Np@vVGOzkX3EH=Wl{TEMX~rLp6H z5#}vDDlAFA6?_&3Dt^)Q9KQyN0Ow#fk8uZu4x8imf|QIGW~bjT-#bG{g!suXHnCI? zYvw5%Hr>^f5NHS`Er7*J*G$(^)8h&@Jpe$FUhwTup;XA4TNr^Ma2}!&-2+JEi6e|S z7rHlxtaQj*%oVuHR4ei7pw%5M`|aijoSi!gFb9efxQAyeJ~1d|B5ee}Oz1&25K@D= zVQS5(e11j@1Mdd}0rW+nfF0FL84Zfgl%WlPCiesmL#N{m>JVS35Hw!Qog^4Si^3v~ z=JR9XeZrDa2w_7P(so#1OlTmoAdQ#OOG+uY327Z}Xzqn*HQ8lPn#m`BD@L z`OxV;;@#EO`u3)TNH>d`mmkozc(`lnu$Fm3qM~KT)Wl{4AzQb&U!ZaEm_VzD8C%V( zosYQ%);2d>UGx?YDfI3N#igZ#%gjK~^5Mn(iw9R0_1%UvO0N$qnA>jNzjHTPc2lnx zF|65RQ8vG4$6lKMD|?YK+9$qrHL29;~9!kytvq3>)J=HqXd777wf}%O@-z&?!Hf=-d@t zBNM`n&OOfU;?cxS6y0lzr0>p7yIlJh4@jq-*+t!tvUp%|zrMy+;eEQ+ZSE+-*=YKm zYOt7aT*a5RJ+W)iGjg=T$ZL9lVtZ;&{fcs1LPjaW(7C{-phXV{^R3^I!g?(_>ARXgqld9yd!OHW{g~hJ*+ozH#eHpYu>HaNq+gkC`PmIUwyAn>S0Xqdb@M@k z5vm_@?Gk^y=*g6?cJ{8?3D`U=3#hHkBeK97KfZC7j5Y$bpD|7B!tvdG*bw9T1Swo3&jJ;lRu^CM*O7TUG-L3P7GSbALs4DOHO>nj6T z>RJ95E_7hEqD!u5zSO(?i_+6#FX+ZncTF>e3}^Wbu79$+{*QGC*IPD{OX=m!&gI2! z_MqL#W&L;R__Fn%z)@ezi#?0o8Wh?lP(TqP4fCbus=@i!Rvmz~VNA}-K>iCcb5IAE z&Q0Y>(nU}}1+BE2+eTs?#tX;*(vzE0qap%;VhLwcw2s;*BpZ$!B7s;O>H_upD=kcq za%TBjmHyyQg_=42 zgq|n>2W>+=Dk>iL!!Z&Xx1)ezLTCmMjbx{40Fr}sw?OR-d?h^elEzuPel_sYk4cKQ zhLNXnYq3+;11&B+QJrT1PZbQU5uIWa2r}2u#K!g5QwpL3>K3Yp5HkCgXkF4&%bc~z24mF z@_F3i`;FIy1|+Aulw-?4c*#I0ZG$F5TL@q5nnhqbiVUh3I5KhW((=;9=RX8uin((h z?1kj7LA1TlA>0Zeo?V9_5T>wd2*VF*BCi?(<~!}gp{Xl5giU|BjSX)Qw%pN`bC=%h z6)#>~zl{B7Fy)=QbS}7u;YWeXl4l$taZ+MeU`>W9bM9HpTk+h7F1~QZ8*~(%0WiqN zUs$~Y-;$~_5rT=gV|jSytWGo!m}LP-w<*B(x^U$Eh^4e&*blUFYDBL$=84Fx^hI(c z_5p|HUU=s6mDMXRAQNk!@JD?ti&1Deauyp1!>*ZC-njz@bnakAbna;BP+}%q%p9%J z)hUsfs^5D=T(jY`8Q|jh>V;(lVFT&{07`R%#)YMg7XXli={h!=2yBCxgb#Dm*va!( zpm)}NkU(u`la@T^LF{gs!9og6WD_hY5L>Rq0dFQ+qjQV|qL1fkRH5KO-@xV73(tDX z=RbJvg^erT^OsgHT=6cSzx4g*FZFaIUMS;r6KpKhOrO8-Lbulk8qj^XWE1lp=|<8K z81%+2UO113xJj*h?)Cd;J`Y0GVYrOE!x7SfY*%6v@(w?~0Go`sVdDd3 zWF>ZvpnvVap*1+)S*eZf2PZeecyK4}Zf75{#xPoQ9Q%i{Mo5{l3(*=8v3{s6;4PZZ zu;(?fpwL6&K&7>s9ltAStY!=C54MQVEP}E81j}dB&C4^vzo^kPqF@i?=0fo5( zW(r8bu2G9IFbKtZMEwqvY3C7Sv(}6=SYzB^k~KDrm~m(zqB(>vTWcesktkxBp`|Fa zu5eKT;|gs<;=O_cN=!FQoz&+-y#*X_noIBLc?EL{7g=)+JTE0dtPEKc~OA;b#AQfTpc3v?o24V?9 z8WADPVANp^KEs)4m-5Mi8Y~N>Gx6z~kPe#L#ee)2YTN>Av7ZgK&y1h7 z`*xu@5=@kkdW_;R0WlDWrE7pl*fRt&(=lalr%O1RS;9kk!``3{*xuk2(t!>+y@fJ9 z=C63#=?>05mJr?S*ci>ijPBigy2-`lfOdw~>q+g5MWuRfWtm{&bVkML6NwdgFQ8FP zacap?ufG~{#+(oV8relOj%cEg>|%;21SB&A5EgaZi)lONt*1Q4aYn}nETRRtoATPZ zr7PGZpfZ~6i$WlD$!le@N zr8fRJfTYJ0wiNBDOaJVO-rg(L#GIk|&dY>41=|R)Ui1Yy?%))4Zm=!nM>Vk}^nBO2rykPW#J^#H#R-GE#` zwxFURx<%`IW}R9>7}zA-b*TLc%Hzh7OLrhfSV%TEHNlZA zBbt+uh9cDL`m7>hQmXZ4{>Al=uEG60QQ#L9I=B;PRcNJvHc1@$&06H#3n(-ond2t>2HIe?qr4i!z@<5JOvL0s+0C_UWu zvO`;6yw^lg?SFOUsi(`W<+d{N$(8rw=LRIMv35NB%mY^0NN&Q#7ztEr!4}v2MntaAab={4PQgfk+*NbU#UFZ4}*^ zW~Lq}r9mtk!BUzLhym?}@D^%o!9%sElYtzC=SC;ssU8KSxP8D((2!~aLTlLvo~|hb z%<_z!M_}Iwuo>pd5Wv%5GXaFdOCC^#+QIh2))7V=rC>`C13JXu&@@KI7Iue#NQ+2F z6=N?Un1)RvnvP?Ey2H?=Kq9LvU0Z<$ThhnJVGdBd<2VHC0(pjLrw9n^e~5tnihv;c z1_8mpT$u%$EAjE$6kQlOa>t^}r{2~GS&ST`a7^e8%;!-$NZm+*y53Z&5J4Neh2gg% z7{GcRuIS&0%h%^c0eyu>hUdnTWJ2|20#9sivrDT1ASgp}2Jr~sl1JO<%92c?fW%lM zVIjP@i;4J2?vD?7C~lOok_j8wMF#d?;Ig&uNBjTRwK_NIxn z%HDX+O)^r`%No^tD?`gj&UueHj__5#;}?rcoPK>ANxFAr>H?XBB< z``Wwf70Zh&57{aq(APWdZTKR8ueAJ}hQs=MDamAQGsR-q4E#rKu(uX+ zRq@1$xx(~JF@GEpd`ZU0%Ah`ur8IPqJ$;e^nnm zKP7G`*nlShe46$E>_vcc0!|y#n65o7hbu5Jjlh@V-qD8>*2R4|gKiyk&v0lwhITwR zU7$G$q25jxR3+uL8Ti>u6Q;xrn`AI}=MFN5c>pV7AAqsVX#({syh~$NjxTMTyL=gO zc*Yip)Gdf{#|9{;8Q|PR-E!?EYY#6*wJqE#PFtvhP8}3Nrw$%Q`#NX^PBW}~*enIN zSXjr%dZ!K`t9%Uk0U^Cn0i~5uKbyKZ6i?>0(E{k%;j=IfhBuKx0}jI)2y5X@=(uzh zorc1Kxb1JJztV&wXxdnj4MkB^V9Bi+iA+U?dZWXn#{_b{Tm4}L5 zDCOZYyq!2p2sP31f3Iv44N=yL(J&O(SSkJ{akL=b< zqs}9ZxS)ziPVzHh)p^z6MeG?~H_sb&Uhn)itIn(MK%+^KFUbZY#Z;ldK~Q57ay1}G zCsv7<4L;&6XgIk-4}lI~E>_WPr1L_1zcbi{Dbe;7Xwoimj!Or0P1!|;*+~K;C1`YF*9R^eyFNY0V%K+6By`T1%op~m`3p|+@BKxO-LL7Vpm4}LCq@SkX-&)P;WmjXTM6XtzS zFDJ^a2=h*iI@*#x2JPr8!+b&pR&K++X6G{A;mNM9m(8W$DvwA*f!zJq9`IZJHYq@C zwAA`-mG{_7r+s_-z5d?jt#_|miJcvl^$8Cq2iVA*Vj4kkd8LLx29YV<#R_bE!S1)2obTOdEMNGQpqVW6ImTL zW;QTM>Ey}f&&m6yq*1I=r(No$@mXi0JBntxe@W?q-+_EfN%Ug;V_(qE2uh1`zpZau zL%TDR;I@5`4=v9M^%_P4o9Nv>u-FKb>yr$D%2sPQV%7=$tlM3-E-Gv;bNPgo$-;q4B~U-=?uijXaOVBv@xT3qID8i zNAD#hvS4#1Pk9P*!3_qN5(me&h)6`7AAJL*li0FHRYxpa}Igdi_bLZ7mi%q69LeNTsZZ!IyD)Le{g;9~?yuqu1tH1il6;8zGT8V;1=^ zjCPY@IG+@X=0=?<1A)*K0rIUDghH#$&?2o37|n040Oq!yVWZ}qv^e`$R^W!Gy;++w zW`f?fIcz9J)H^;vb%m6vC<4`6=x8bY85d;GZ1ylttg^Irm z&m~f+EfjIO6x3B6MCiIS^8@75nufkh^9{j7|6P0s6<~ftFo^Iw)CC*X+~zwJZ~qRz zA%vXxH-t5fzJVJv>V|dwjnjg#XX6MkL_T;|qqHF5BW5;<*(U4nQP`Mk<9bAL(BPg= z#DaT-jz)repn1lEd*~ul1{4POgin)K%`rndzbiSM$R%#AY&+S|12t7KDCozE>GX5SDPoKfM(&kD z4#u$=h9H?cCR>Iw%m?M1Jc!&l0vCm_*XVg<$VA8_pnw-8pg4UX$9v@JGQvFMhCsvz z@iYc5eJ}W|3@V=+<3rpMT!Ox?cUVo)0zjpW762lwTEOi*WiY6+L$IMxEyS0IT?g+8 zgE#LW%%^4SU2nlx_O15znZ32)JrL#37&&zRld!{^7Ucub0rorM|Jkki3I9MK_{XbN z+}wOz{;Dk6+SP>vZ{^x~QUKkTy2@F7>e{c#-=b7G_0`JH`1_?w#9?i`sU<7gg?4Xm zoYzz*Ox8r*=U3jV0c8GO^ITAEHJN>;0o)KW?wSTiH&x!>xYs|biTN9~JQlV*R==fu zPt6qT2YyEWtXAGt`|Y|_vCh|iH@h-=$0w_+KVep&lOwQ8tC!Bq*Nnw<@M&GEpEjLX z>^2%`_ST_11Kb!0-_u#BP zoHp2l(+1NY^Lq~AY(AJ|U-#3x3tPUe%eYM9CfYBPd!Z%||?{ph@LYp6((*7P|wY~2UPShTg9{+(|8 zK4x-gG_)){LXpR_@Lfd<;M8dRIK72jh^%8AuRB5XH%UvLk8Jy^-x5mmjt$a0Tg!Y< z-5%0-SN#SOosy2vP#SO*sKZ$3Db;tOv;~)q3?9-Ua~DVEjIpM60JWMiU^dbkF2sh7 z9lu6RM{sO3eD19Tm_R32iNVIt_EJF&+zQw%9a>#ey>OPfb$F4rqQXHEQ{e-FOa(h` zn}%F8hwytwmoDH43~ax~DW1|5B!>5Rkeu@vMlk`o3`QYlW?dYP(R{- z_$N@p`!T#=|9n4e9@3aPG+JSyRjKa71S9l``wnyCNQnbyF=Msia-*wREeEivMVr7` zj86I(^QCqHDC4HZNFMvFU@3s#iM@zJt+7iMl^kL;%n$a?Vcc&I}XXRYhrs*ROp5>Wykb6bkPDA6=3w|uVM6-v| z3c@4gM9NK>6`=XaK1ZJ(C)2DL{9_RGdCoPCe&p9Oy?}l#H&n{ZfCO7O{TszlN#tGx zu8kM0aYiM|=}a<50bL@j8vAQQWEw{l*7)>1*9M+i@G_%g;F_?cj$Ei0S}a-#J=m^7 zfP3JA-NuDGNllLY;xFvp-IQ2t6US@l-VL&I*b6HRFeZ4pfManB9q|0FPu%+A#7EaV zY%7f;RVQxSQpaMO$-Dv?f9XJQx3m{tT;qNa*`pl+ugzOC_oKyLs}5+R#SZOECG_ph zQ;VG<^~jIf@$rxy-1-gM{y?Rac-h{xO)fY8Y(k{G?O!q-n3LHmpC}|xS3Z85Uey_0 zt^1}uGK#uYyBb&R+iG6hX#PVP(?*Lh{|8)*qGrqZ8`=qWjH1 z<=zC-+F&iZ@9u$59eajY3nilto82_L5;ldUs-NK->B~ps~{CC^-t(EuC z)s?Uf{MKaGtJ7O|<2;O~f24Tms}Q{ZxYV&P!T3>-;|TK~0CR1~#RtGpqOC!$g90$8 zP|m554wyOGb{q>==!c28rpgFZN-dd-eCHN@ko1F*h?u#PH=wU3;>__i)C@hlQ&by* zZxCSi-uJ!_xiJFaGZeRCpUT|IwtWVh%2fn~ak}Q~)SZ-pHK;+AD|W`-QpYV5lcFhe z25y#^Uy0nyzO!a7c%))vo>M!8uET-UuqOz`CKevHIp&VB>}3#)!Cns_xIVZB&kU}i z7DR+DaM(s-7HnssnAOjKxq$iiBQb^Tl1h+BOAsw6ErE3hRagb70s~_eg3W9dlOnLH z50aR|Dib51Q6GTD6rkgvIix&kE{;A4$pimnbGm{8xym-rLV65Gn}u#QUi5SG2zACX z1dT9XP9q2^rV%A3+lZMG!bTY=Q9%uG!Kney4r(Yc26L6hwpr&6ee*-oARsz!9?)y9 zFkQ9}o=9V_82}gdz;x{R@DyEJ^5H22vPGmQey$NYxLZOg0#0;>5wnoTIoh%b$n4^Y zd_yQ(fnZrND=-`b+yX;wjrat~MvU8kuY!o8vtX^&1k9SyAl-Oi_lMeGliVyfky{7xI(p(U1{5C|hK;lSo<`sIIn+1U+aI5V-I)^t;&igSUmdTAi`DRKbb+3RElcl{pTf z#`;xbbt)SE8c~&)89tdYmLrBA3N$jePhJE}ARS}kUJwE5ixVs+T zA)vJ;!u8uIh`cNM=Ga}VbCsQUNi?mX$>uv2LX?%O?Q8cxJ{JhiyAZWo`F*F&Qp@t% zY~t3ZmJ^kC;^HQ>LGd+C+BC~SY=Ypz;*zN9eXwU){liTzGiKnK83bzctX;9^un1dJVL-hu&HIf6P zZm2Y@IW_Nzd?>_(9UFi+WMTNSHo^=<7fVpmAUdujN|R9oNi>b9vrrOEMI=$izS!+N&fbH6iI7R50JthW1sT>o-y)t?M z(M~R?edq?Yy7{g6ByRUm3 z%27FKCm|;Y;f@M9OrWD)wy2P^gNy^T3FH%)5v+s*mCFb?4QF3?IS`x2Ia*|P1eJ)K z62|xK*xeu!(gl6FLWgVOZXk1*BNO0{U_1r_-Yj%bAf_h*&I7D-h-MyDTif zLql?8g<*PE)r!lk@Pw7VflLf7Ic2aoCjorU9F>qr6h_t7X#;z~1e1F7s&H$XrfTjJ zTX#!e#v%S0b%mzT38bK2|>#yU)h%5614*2)nIGzkhT$0&<%6sh|uZIpHrL zThBbQxJDUg&1RR7G1OW*0-;sJSsd|>fE}D}fRG#*6yz-Fu!Luk@|cUD1ZIKY8la@< z5GjyrJ97^WH+pY;Pq36jAL21=vpg0aP^HbnB5;{_5ljkUJ(M?-^wJ)DEw{iVeN66P zjMBfRF<6Dm%3zjqZ|TGcxC(3~dU8cnk2pzB5KsJoqlE}|+oUIiXyZ0{NT`vdpsUG% z;%r0Ueld%$b@q%|FHQts5H zQy60n!=_H=xw%cM=xt*7ErX-PtD(5XYluURhXY2M!t5Lm5&-K*LPEJhDg|x>WFf2; zJdg^L#s0Ym4*b=|8Jx`b1Y?7irNt(kt4BUck8*?u*3Oa2v5=bhnKpli+d%b|NXOJ z3yA*OXldW#UhV61+C3jwptI-RMGeMzckju9ptZh4rxySu#;=i!l4Q zCYM^PX0kUQscw9@{&(3&Oz-xABZh$Yn*vL)U)5>e+?2nS-!RoC0P5rVlzCGyiuhMG ztZ+Zq`O3fJVmtAj8@t!xb}USM>)JDmor%THOC%p}U>lfSK+!uso{ zD_^*OvGeBznFPQi9UTPb9+m!O4Y<*iB-W7N2I(}0pbfa2K!(6{YLp$-poU;?X;jr% zR~v+M)Zi&5G;UOdT_+8y1{%AH2ApV}8pW`VDr$5_5by@?>PO5%qbgXI8dbq=7179< zA;Gq-ktDe5KGHfX>3|z;KWePuW*g5mbFoL>k#SV$ni28z+h}WNYcxU?33r0;dMgl?A2#iu6X?rw^T~(hfHv)@C43~htCcPPiOJ9IeMY`ydPZs zery`z>GX@XxDOvwJpVzaf-rf{na)GifIb)y5WYBq?JRu^kx_qBkJdYDD zFCj!H@EfV;%#ni9*xwWiSTwMx6vh19GlkI{@;Hb@W<@aim9(7MVy&p%Zvqm5MAZm0a=_ov8Oz~kT1al1(TCg1COB(LB5ywwkSNFi_X zxnALm_#D%GGp|JVxSTcWUAc&TPZyt)to>Imdgqr{uk>^WrW|9Fj|=sGAB{M5rot-d z!1OwPGQfPq5CdH*>L>#=hMEb~Aewf9bbzq!sUm}lOz1@uus@lHQi5{0=Lmd8M?eAW z0ita%W0oiz^v0>KL0_EJd}vJy6dfkeVlS%O&?^_!NF-%_=peR zlH(AxH=v?Ulw=xWYsi=wzq0dZ41!7UL@DETgt^)<21I|#KG63XM$5CJ)KtR24Q@Zh z@f&2IOyXiV2MqEb8DG70`O4u#V|oa~k&lRtM!BIR=5g42@LKQ(JA!Y=AqfM)5J)v& zZ1$>t$oqkn)uk0-5dnuFo&SMz;2@yjm(OGKswLn=?7F)Lr)VzwK=30#D>{c@_tgq?(vvRW3M z;BGhZg$Ja-BBg*CWHOQ$N>nO<%;v%l6Q_fY!WqMnfhOvsd}6Hd1Ws|B?U4uVp21+Y zSW0FM!d{aa9PCz(Xz@xfJogOJZk_NvFPLwWDqN^?U+y+j4L96%F@JS z1sdEUsCGQ;hem#G3p|;(hg^aZL$09&hGYS-JW7^Jh>Ti4JEWK_uCCKg8V}uaqT~kOcuZl+p?(OIS8Z>50Qm3nwS!5_Wq@3kgm* z0_!Vs0-(7OdL?TlM+*+fVXAm1--gI}8K2ty8fK7;uUaSo2SmsUgeBkIGe9^M`C- zzsK^)thuP|*_g`8!wp+#=jD-x4a{IRJF6>|eJ)EihcIt{YPEczYKPJmY=Ew~)s*b3DcM_7;$7QY=ljAvpmsjGYo0tvdsX_7Kkkn)5A&C68XR5Ot|>cK z+jCF#+DZS|r~IC4hjb+VQDGCp8jP`5XT7>wPFMY-{xNRx!&cK`)t}rN@DXxco-9vP z{qgnJ%i~wyykyq?vpV@#-}pxs6yLZaS6AQoKEHUVJXx*$wm;EP?)B53yqfsFnz0`8 zv)AZO0cZ}U6+LuMZ((y?A|@%Q_k zewV)wyJ^_EnqK_j``XAW%ZJUj#QCRTJ6|^`a<(^5`;RK9=xa63rTXo?;<2iK z*ne!9AM#_1CF%BSeyf?aPgP5m2Xw+-Ed8W?|EEjIqB!beo@XE1I+=n2q$cI9tfM>k013T*0}+Ind1oF3}4Kvwp9fGHYPYyy6cC4tfqdc&<4#L(L?RF5db*LW?z^LokiU(jSpb2>Z zmS@LSJb-DV3AsOF$nK8>iS<)s2z1-N$gzlh(I6Rog3}Tc7v5!|$U1j$@Hls3QMD(G zW|{RTcwaU!6VsnzY}bsWRK+{PZKOft418hXT^cW;(K-z{gAJQUM(aa75dl_e?y}Yb zrs6ebX>vVNh;f)@#ax?J2Pj2t2Ot~@1yEBWwgb8_#25#JsWlxS@Iv3>KtROp;Otv~ z{m%hNXL6{b_R~OMO~jYIXD=di754~tpN37~!g+WUXcIX1A#ZU4c5gK04&UyXjq~R& zpASq5D;NLY_O9hO(&M;?Yb7uTFboNfEC?H8Fp?Eg*rn$^v(AOHLr+i7uO=rrQ0AdAH2_07yoAYv=y!`l zJhS;8&YO>iv+?;E&!Y9r`b;;+D2u3(9zye($rARTcth*}0PgMLrOCmTY-;E8t$s^I z*Tea1A2H9sMi#0Zn>0AUR@I&8RKdp1V}Y z4enC0xs}TaqTvn%)Fl$a?oPySmw6n3^8(THdf4ARJP_>}E{7BZv_jf{6J4<0c=5l! z{o+4g3)X0gV14w=9H z`IFw+Qt_+zKmUvW)->!=f7_etFWOivyJ}xh=spNPCLW&~OI%H#zADS# zqZK@aFnATa5u5{u96;sflid(LdUI*;CTR54>Xf);(M8A@WhELO* zh`yPLzKKl|qQ94k{@#-p*KZD1KI_7YwY@ZGgIEbph{;B=hq(c*!^cb&d(P%h2Guu? z>hv-5<)HZzn0HX>?f2oR^(8drWgrNrJE(ZYje-{l!2HoP7SoxSXSR4#L#HB5DD~+F z776-+({%lS{Fjdgyt?QI1f721&{98mVn;X)%slVo9j@*+_CL_=gj;%St@_+PR3X&c z*h<84T&!c!v4OY$a7@h?pP;HnAEUZfr~~$W=(b_>*Kv$zOX23+1Zj6_gP3w{5F0id z#QDDoRxv%=Am&pW#5`$(polvibeGliE%uf9a-`$Owd}Y{IY1tV8q`{^bqi$v0(DLokuU=9_&DePgi{^~F8%$5|o{ z(X<^;?E-1eHT{_q_*#a@BfQel2nLsF9&A1@#9ohdpRb2ZBe9u={GrM$qP}CiT-+9x zkr9yBnw0pC3iE`FMgM=ZJbwe9wM1^a{s;@tF@KbP`PfRsB$MUm+~%gt5CP}J=Z`F5 zv-r>NGSD1i@?X%FkWl8IL?*FLNf#PK%=3bhFDZR;-I)3qO8GUS_sqWy+bZ9a!#!Y!P(Bw-wP+i;Ukl1zT_O=ZIL*J;z~%Pa|t8dsX?iQA7c6#@_CY61aYipf(;lanIN6P z+F(jIaZMIM)u16@GSdLW2I20+1S>civq79znjo!30^rpG#vgjv-Gk$D#ORCO!4WBx zLwEZJ-3NHchMePdMR8mzUOYk?Mrlk#6}B9%2V)wBlTE|1a7+WDCaon(52~A5Q%G70cmxHKvJYzL3_`$8$v=0tPz?E=?RjhjLBPVTk3#9iYRr ziQ#W>(N~3i8gD8iJsYAb;L>Q7WYgp>-=|>+*fcS6^J(BfnYTv{E& z#H8`?96@b+9ZrdDny8NWG@NGJG#m=Yau78(4MQiSQEZyD8Z;qd8V-GJnwT)U`sl~l zrr|6&mV>AejpkYnl#M#gxQZ2k+L|g3p+gax1Q>8t(Z6t2@gCf!iN_(ICQ2Zo%c=Ge zVd^l^+IUEBfY5ng$VmTvHckA2y9z34Khle2ET^^ku?DyLF|7>o88VikPHQSCL)6AJ z2&0%*y#qn!)2fsJF@SrSU~Y#O&fudChBsTQ zXga9n+vsvrzAYL{@>De)P78Mk330k_Sq1MC#}-0m!Dhrg5GrzXsZymQ)a%@eE5sHC ztY|v4&<4eZZd?sEEfo{mniei5TrNxoHkTPexTiO$@Wp^oH{YYy@=Y|wly}16aIg){ zJbH$-g&>Tajs+|^+71A3%M5^qc9f#oFftIln-Gl_wE>?7>QQ|7w15St0$0JQj+wG! zwT@Xml;?GtmajvyoAUKJ?{r?*kRBVTQ38FFoxwZ!(mBAnfq=b@rx4Z2EJU%Qc1YBq zr=j)MAdO8f8dth&9{-R~T5%2NOA730RdV~9xt#EmoqIV-Y#gBF6=eqOD2214UzsZJ z_yR$ys2>5(c$6XryQ-0wc*!rQdd@qrsnSYETga!>Eev!Nt8<(}=jx&M3ToFvbWmmr z(c?ODX?Ipq)~o2eq~oCy7`&1)I9>e!Le1#`l`-QR_XvcvH&A( zSlKm<))z3|al!>(R=7ZkPTK2Wz(ASkVw4`iSGao^_FNKN`ZL+qYiR7tQacdio0Hu}9YNn+MH#i0X z-m^w9eq>i#$;gH(vJ~= zre4R>LdQ=igq46xWjJ$yCA)#D6J!#%e=$v`0kuW&-) z0NM6U!?Qe|BCs;O(tyOt$dU*e!$HMJrLOB254#T0q|FX0(Q)An|Il`>tx#jnw52Y} z%PQkA?Kd1{>saEOTv(Q~%VaR)m4qmqFp}-G2j53&ImqPD)is^gl#^?^9Pm6>)77u0 zagn4QOsznJ2Di5XjjDJMbeLDcAg%}&N45yoE`uM9EfzbR=yEbX8v#a&2vp`H48DS- zi17I%g9s(w?rb<2A43BnMWSqxCm zbBWbajTWGs4<;QfYg>JJtqJjN^t4RnEhu*@AZ!c`APiUXiOzqt9bkx)MicTv3N#a; z-E=Zr3vdM%3M9>In&vf==21uqU_LS%F=^ ztd7iiu;OXcQ>r0`0orhC2uHAd2TH)!u@R48)ed031M0dzci2)Z%9F>f%pA6LFX-vw z(ty>?!yLBtM3&c#DChH05nKAb5NzrBB7&{yPIe9~y|1IN!97KsB|m~Ls6({0ZbneH>yLU);Zj&I;%L`s*X>|nN@J9 z0HVLy2#D|D8pSuOI>2p(azf_pZ-U6$K>|k!6UG&1|a`Q0L=Wb$I8*<~& zGY2@&l703D#F5Y50GH2WPUkWqH&z`!cO8>^4sbqZ;Inhd5VB(|&I70ZqR(AJ@A=#{ z90}wA=XoNYdWH8CN8c%F%d^!|fgccOrR9T*;qeHn=d({nqciHh!ULzn)1r(=tAcI+OHamZe;+(x1ad>{gkP<~)`Y_01`@_peW5Owl zp8-UdvAY#$G;b?00<(nx8U6jNIQ)P*Iu&gg@NZL88bQmIf_UdA`iL09;8I?Y62L4p!(2s`3d zR2MRW5l%7Cg7>6&8`Cz@Sr|*OYGbVd{Z`B}rFSKnbEqb_Fk`I1G6P2!s|D)7N*B{a zfCdcGd(MtP>u3TO;KdBsb(VTCKA0X4FGh?Y152G;Z=1iR>(zc$Nx8R0Nlhp6I$$fcd(<;n5+#ivYX%a%9C(~Al0Qy!n6Xs2LvjK+1y^LT`vFKe=; z1$}J0Ajz;y)kI#_% zU8Z7IbE$k9T4)SLfVjXa9R&+LF0WxPLmx~MOYu-F&QxAw=?(;~q(Q+Z*#M&lJ5KbD zj63azK=Qq-=}aD;UqvR)1K1=p*3>q;Gf*B*{k{xt# z1)iQBUyd(k`2Ik@02cQd9z+cr-;#1Y30cFqlL~7%LMWZn*awz782o@-#g1U*aQt{Q zeQ*wwAc)V&k47_)xwt(%J{=bK(M^|U#f`~uI>oNxaCG^2d+z4!1SFz); zGhvi|g}8EvgO6Cy@ACYD@~~9AqXW6PKblS&oD4^nHwslTmT= ziY}|biPGKoFURnHf=nDnAZ1(U6ENC%M9EJlZa`r=y2QQ>VV*}AR&2Rqe1fs`5Qb6Y zD0v za(05xO06I`Qlq=Hdv-jzIzdie6EbI=6U6QDjyFi z7Z8J9W8Ny+rZbt~i%mfch6CA?jD3Fo@e~m_$(01+y>W^?tWS{PNZL7m?hWBrW(J0# z#TF4kt#4h8fe0#r7{=n}KKzUvzPB;hSKCtA*4^fE2vG+}e{jF^)?2zt3egZ(a8wB^ z2F<;>(Sw+RtK?qiLHGMVEOz06WStO^2d;{7(Mr4T71&1L(2jNvEAJnuU#(sjKJe#Fb|E zZP+5faI0S|U^VC5_A?oRRm@WLyN3*ngezeEf}vf10K+W!vf0!awm`pNhN>ShQP&Ti z_P}Hj0o0<#yiOA!1a~_9?XJ8w;-kdE)vZF4I5DGLm>|9|3&2+E5#s?L$Th&tPn5Tp zNGJu9mXsxRXiAzUw(GtaJwvKJ%s|2%INz?|StoCb|Xw;|_eBgne`ZCC-{cIS$#>hey%=G{)xk!-&={K{%%&h>hbq0)PZ?qn>fXgYewvfSYV?fUN<{{m#ZcKDBxv z!o=hOFEJkUFl-vrpPf@luR<)SRKA8;`|k`teQrJ#HZ7D6KRH(}y#?#yM~`p-`6yve zI3QDDip8UI38p7qjsrPX(|9jl3v(%v@8*&+J(f*J&t{{9Dn(NXg^Qw=_Q3lZ`JCj> zt?pWhLF$d3vl}qqskqR6WD&;HvUQ;?HdcvTO?&!pKIpuomwaLeZ61;cSAV`sIB;WR z;BXTaX1Ev^AG6ut?7Ax4e+e{9a@dv#@5jR2s64>9$k}27;KEZ*RYm>q>m#QfDWFE_h1XYW*2Y3D@Ne&Zhy18DFx8x zdntbfD&%rlVWC6}<(@jel{p?Rq^<8q^AAkuFO&? zvO6XdXi&wlaR7*k+70!M-rxXhBoM-Prcc_%>JAg7=3`*Lb8s)tj=%|XBPZ9}Q*Pis z#Kt3o3WqcpL1eL8Ke>+cmkjFB2W_4^7&Jw5&Ra>QvEP_3TF6!{X?!E5dp>PU^twuj&Tik@*AxwmIAhj;~CB@#y{3^xPc8g#k*N9c!_hr zLy4m;N#i2HG(PZy>s5^<#glXF6o_<)D3fG>WD{6hjMJ66`00v~Dddot(pj=U>uM3R zq9e8~rcn~3LlQN(Y=H)Osi6s>RDK6L*%`O5S;?Khopt-$2fB?2`-wuo*V*p?MgGri zu>@I1LASWFH4)m~=DxX*ZcPf@nH&xPH26*W-F7C0xs`WeCA+j-T-md)EDP+5bRj6+ zy%_f4b1azr@q_DcKheMTCLYZwwpZ`2udnmBjo;pmelxt$$3OTB#}}So#5DmI5FWz% zCbIE|5}mI5Mz}M;H~z8^{Nf=3=pYw=8>qj_k{VtFz^pO?4tXF5jz9cmad7JuON=In zvA)ji_~Gzn{qCN8Z*1+XZ)^<&&H^xT-9>y9&^$sLTO9z}2IPhKB&1O|^VHqgTHkyM zoD78)L0aG6>C4Yzes64C|I6mj!Y-f_GV8y^ z1Ldj9zqtDIDt}CvE&yeiG;wi~ivz~k_Mq1p z3MTn^igtWeLLddMtPh(L^!2uN}%e6f%iOOCl8;RojhWEvN%{Rz-ve0{{X~d B*!lnf diff --git a/library/tedit/TEDIT-OLDFILE b/library/tedit/TEDIT-OLDFILE new file mode 100644 index 00000000..082050fe --- /dev/null +++ b/library/tedit/TEDIT-OLDFILE @@ -0,0 +1,1115 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED "21-Jan-2024 10:27:59" {WMEDLEY}TEDIT>TEDIT-OLDFILE.;6 72571 + + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT.GET.PCTB0 \TEDIT.GET.PCTB2 \TEDIT.GET.CHARLOOKS2 \TEDIT.GET.PCTB1 + \TEDIT.GET.CHARLOOKS1 TEDIT.GET.CHARLOOKS0) + + :PREVIOUS-DATE "16-Jan-2024 23:03:47" {WMEDLEY}TEDIT>TEDIT-OLDFILE.;4) + + +(PRETTYCOMPRINT TEDIT-OLDFILECOMS) + +(RPAQQ TEDIT-OLDFILECOMS + ( + (* ;; "Code for reading old-format TEDIT-FILES (1985)") + + (COMS + (* ;; + "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") + + (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PARALOOKS2 \TEDIT.GET.CHARLOOKS2 + \TEDIT.PARSE.PAGEFRAMES2 \TEDIT.GET.CHARLOOKS.LIST2 \TEDIT.GET.SINGLE.CHARLOOKS2 + \TEDIT.PUT.SINGLE.PARALOOKS2 \TEDIT.PUT.SINGLE.CHARLOOKS2 + \TEDIT.GET.PARALOOKS.LIST2 \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.PUT.CHARLOOKS.LIST2 + \TEDIT.PUT.PARALOOKS.LIST2)) + (COMS + (* ;; "For converting incoming old-format files (1/27/85 cutover)") + + (FNS \TEDIT.GET.PCTB1 \TEDIT.GET.PAGEFRAMES1 \TEDIT.PARSE.PAGEFRAMES1 + \TEDIT.GET.CHARLOOKS1 \TEDIT.GET.PARALOOKS1 TEDIT.GET.OBJECT1)) + (COMS + (* ;; "VERSION 0 Compatibility reading functions") + + (FNS TEDIT.GET.PCTB0 TEDIT.GET.CHARLOOKS0 TEDIT.GET.OBJECT0 TEDIT.GET.PARALOOKS0)))) + + + +(* ;; "Code for reading old-format TEDIT-FILES (1985)") + + + + +(* ;; "For converting old incoming format. Cutover 5/22/85 to permit looks changes in the future.") + +(DEFINEQ + +(\TEDIT.GET.PCTB2 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:21 by rmk") + (* ; "Edited 13-Jan-2024 12:09 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 25-Nov-2023 23:18 by rmk") + (* ; "Edited 8-Nov-2023 13:48 by rmk") + (* ; "Edited 4-Oct-2022 16:58 by rmk") + (* ; "Edited 8-Sep-2022 23:06 by rmk") + (* ; "Edited 5-Sep-2022 21:33 by rmk") + (* ; "Edited 4-May-93 16:27 by jds") + + (* ;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (* ;; "START = 1st char of file to read from, if specified") + + (* ;; "END = use this as eofptr of file. For use in reading files within files.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (LET (PIECEINFOCH# (CURFILECH# (OR START 0)) + LOOKSHASH PARAHASH) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) + (SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\WIN TEXT)) (* ; "What kind of piece is it?") + (SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.PARSE.PAGEFRAMES2 (READ TEXT)))) + (\PieceDescriptorCHARLOOKSLIST (* ; + "This is the list of CHARLOOKSs used in this document.") + (FSETTOBJ TEXTOBJ TXTCHARLOOKSLIST (\TEDIT.GET.CHARLOOKS.LIST2 TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ LOOKSHASH (ARRAY (FLENGTH (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + do (SETA LOOKSHASH I LOOKS)) + (add I -1)) + (\PieceDescriptorPARALOOKSLIST (* ; + "This is the list of PARALOOKSs used in this document.") + (FSETTOBJ TEXTOBJ TXTPARALOOKSLIST (\TEDIT.GET.PARALOOKS.LIST2 TEXT)) + (* ; + "Read the list of looks used in this document.") + [SETQ PARAHASH (ARRAY (FLENGTH (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST] + (* ; + "Build an array of the looks, so the reader can index them.") + (for I from 1 as LOOKS in (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST) + do (SETA PARAHASH I LOOKS)) + (add I -1)) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (CL:WHEN OLDPC (FSETPC OLDPC PPARALAST T)) + (* ; + "Mark the end of the preceding paragraph.") + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS2 TEXT PARAHASH)) + (* ; + "Get the new set of looks, for use by later pieces.") + (* ; + "Mark the document as containing paragraph formatting info") + (FSETTOBJ TEXTOBJ FORMATTEDP T)) + (\PieceDescriptorLOOKS + (* ;; + "New character looks. Build a piece to describe those characters, assuming THINFILE to begin") + + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILECH# + PBYTELEN _ PCLEN + PLEN _ PCLEN + PPARALOOKS _ OLDPARALOOKS + PTYPE _ THINFILE.PTYPE + PBYTESPERCHAR _ 1)) (* ; "Build the new piece") + (\TEDIT.GET.CHARLOOKS2 PC TEXT LOOKSHASH) + (CL:WHEN (EQ THINFILE.PTYPE (PTYPE PC)) + (FSETPC PC PBINABLE SBINABLE))(* ; + "Read the character looks for this guy.") + (COND + [OLDPC (* ; + "If there's a prior piece, hook this one on the chain.") + (COND + ([AND (EQ FATFILE2.PTYPE (PTYPE PC)) + (NOT (EQ FATFILE2.PTYPE (PTYPE OLDPC] + (* ; + "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") + (add (PFPOS PC) + 3) + (add CURFILECH# -3)) + ([AND (EQ FATFILE2.PTYPE (PTYPE OLDPC)) + (NOT (EQ FATFILE2.PTYPE (PTYPE PC] + (* ; + "Switching from fat to not-fat. Add 3 bytes for the 255-0") + (add (PFPOS PC) + 2] + ((EQ FATFILE2.PTYPE (PTYPE PC)) (* ; + "Switching from not-fat to fat. Add 3 bytes for the 255-255-0") + (add (PFPOS PC) + 3) + (add CURFILECH# -3))) (* ; + "And note the passing of characters.") + (add CURFILECH# PCLEN)) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILECH# + PLEN _ 1 + PPARALOOKS _ OLDPARALOOKS + PTYPE _ OBJECT.PTYPE + PBYTESPERCHAR _ PCLEN)) + (TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT) + PC TEXT CURFILECH# PCLEN) + (add CURFILECH# PCLEN) + (FSETPC PC PLOOKS (if (ZEROP (BIN TEXT)) + then + (* ;; + "No new looks; steal them from the prior piece.") + + (OR (AND OLDPC (PLOOKS OLDPC)) + DEFAULTCHARLOOKS) + else + (* ;; + "There are new character looks for this object. Read them in.") + + (\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT)))) + (SHOULDNT "Impossible piece-type code in BUILD.PCTB")) + (CL:WHEN PC (* ; + "If we created a piece, save it in the table.") + (\INSERTPIECE PC NIL TEXTOBJ) + (SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ]) + +(\TEDIT.GET.PARALOOKS2 + [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.GET.CHARLOOKS2 + [LAMBDA (PC FILE LOOKSARRAY) (* ; "Edited 13-Jan-2024 00:01 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 3-Sep-2023 23:31 by rmk") + (* ; "Edited 28-Aug-2023 22:19 by rmk") + (* ; "Edited 26-Aug-2023 23:22 by rmk") + (* ; "Edited 30-May-91 21:43 by jds") + + (* ;; "Set the PLOOKS for the current piece, PC, according to what the file says") + + (* ;; "We also ") + + (LET ((FLAGS (BIN FILE))) + (FSETPC PC PLOOKS (ELT LOOKSARRAY (\WIN FILE))) + (CL:UNLESS (ZEROP (LOGAND FLAGS 1)) + (FSETPC PC PNEW T)) + (CL:UNLESS (ZEROP (LOGAND FLAGS 2)) (* ; + "XCSS FAT. It may be a continuation of a previous fat piece") + (FSETPC PC PLEN (IQUOTIENT (FGETPC PC PLEN) + 2)) + (FSETPC PC PTYPE FATFILE2.PTYPE) + (FSETPC PC PBYTESPERCHAR 2))]) + +(\TEDIT.PARSE.PAGEFRAMES2 + [LAMBDA (PAGELIST PARENT) (* ; "Edited 13-Nov-2023 00:21 by rmk") + (* ; "Edited 7-Nov-2023 13:24 by rmk") + (* ; "Edited 4-Oct-2022 16:57 by rmk") + (* jds "31-Jul-84 15:30") + + (* ;; "Internalize an external pageframe.") + + (* ;; "Exactly like \TEDIT.PARSE.PAGEFRAMES1, except this doesn't scale the region specs. Except that if it looks like a PAGE region appears to be the result of mistakenly treating points as micas and scaling them down, we scale them back up.") + + (LET (FRAMETYPE PAGEFRAME) + (COND + ((type? PAGEREGION PAGELIST) + PAGELIST) + ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) + [SETQ PAGEFRAME (create PAGEREGION + REGIONFILLMETHOD _ FRAMETYPE + REGIONTYPE _ (pop PAGELIST) + REGIONLOCALINFO _ (pop PAGELIST) + REGIONSPEC _ (OR (pop PAGELIST) + (LIST 0 0 0 0] + (CL:WHEN (AND (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of PAGEFRAME)) + (LESSP (fetch (REGION WIDTH) of (fetch (PAGEREGION REGIONSPEC) + of PAGEFRAME)) + 18)) + (change (fetch (PAGEREGION REGIONSPEC) of PAGEFRAME) + (SELECTQ (fetch (REGION HEIGHT) of DATUM) + (22 (* ; "Letter") + (CREATEREGION 0 0 612 792)) + (29 (* ; "Legal") + (CREATEREGION 0 0 612 1008)) + (24 (* ; "A4") + (CREATEREGION 0 0 595 842)) + (fetch (PAGEREGION REGIONSPEC) of DATUM)))) + (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) + collect (\TEDIT.PARSE.PAGEFRAMES2 ALIST + PAGEFRAME))) + PAGEFRAME) + (T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES2 FRAMESPEC NIL]) + +(\TEDIT.GET.CHARLOOKS.LIST2 + [LAMBDA (FILE) (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* jds "22-May-85 14:28") + (* Read the list of CHARLOOKSs from + the file.) + (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") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 25-Nov-2023 23:22 by rmk") + (* ; "Edited 7-Nov-2023 22:00 by rmk") + (* ; "Edited 30-May-91 20:26 by jds") + (* ; "Read a set of CHARLOOKS from FILE") + (PROG* ((LOOKS (create CHARLOOKS)) + FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR) + (SETQ NAME (\ARBIN FILE)) (* ; "The font name") + (SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points") + (SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance") + (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) + 0)) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE)) + (SETQ PROPS (\WIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLLEADER (NOT (ZEROP (LOGAND 2048 PROPS] + [SETQ CLINVERTED (NOT (ZEROP (LOGAND 1024 PROPS] + [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + [SETQ FONT (COND + ((LISTP NAME) (* ; + "This was a font class. Restore it.") + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (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.") + + (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T] + (FONTPROP NAME 'FAMILY)) + else NAME)) + (replace (CHARLOOKS CLFONT) of LOOKS with FONT) + (RETURN LOOKS]) + +(\TEDIT.PUT.SINGLE.PARALOOKS2 + [LAMBDA (FILE LOOKS) (* ; "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)) + (* ; + "Left margin for the first line of the paragraph") + (\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS)) + (* ; + "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))) + (COND + ((AND (fetch (FMTSPEC TABSPEC) of LOOKS) + (OR DEFTAB TABSPECS)) (* ; + "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) + (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) + 0)) + (\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS) + 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]) + +(\TEDIT.PUT.SINGLE.CHARLOOKS2 + [LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk") + (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* ; "Edited 30-May-91 20:26 by jds") + (* ; + "Put out a single CHARLOOKS description.") + (PROG ((FONT (fetch (CHARLOOKS CLFONT) of LOOKS)) + STR LEN) + [COND + ((type? FONTCLASS FONT) (* ; + "For font classes, we need to save a list of device-FD sets") + (\ARBOUT FILE (FONTCLASSUNPARSE FONT))) + (T (* ; + "For FONTDESCRIPTORs, do it the easy way") + (\ATMOUT FILE (FONTPROP FONT 'FAMILY] (* ; "The font family") + (\WOUT FILE (OR (FONTPROP FONT 'SIZE) + 0)) (* ; "Size of the type, in points") + (\SMALLPOUT FILE (OR (fetch (CHARLOOKS CLOFFSET) of LOOKS) + 0)) (* ; "Super/subscripting distance") + (COND + ([AND (fetch (CHARLOOKS CLSTYLE) of LOOKS) + (NOT (ZEROP (fetch (CHARLOOKS CLSTYLE) of LOOKS] + (\ARBOUT FILE (fetch (CHARLOOKS CLSTYLE) of LOOKS))) + (T (\WOUT FILE 0))) + (COND + ((fetch (CHARLOOKS CLUSERINFO) of LOOKS) + (\ARBOUT FILE (fetch (CHARLOOKS CLUSERINFO) of LOOKS))) + (T (\WOUT FILE 0))) + (\WOUT FILE (LOGOR (COND + ((fetch (CHARLOOKS CLLEADER) of LOOKS) + (* ; + "Dotted-leader; relevant only to TABs") + 2048) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVERTED) of LOOKS) + (* ; "Inverse-video") + 1024) + (T 0)) + (COND + ((fetch (CHARLOOKS CLBOLD) of LOOKS) + 512) + (T 0)) + (COND + ((fetch (CHARLOOKS CLITAL) of LOOKS) + 256) + (T 0)) + (COND + ((fetch (CHARLOOKS CLULINE) of LOOKS) + 128) + (T 0)) + (COND + ((fetch (CHARLOOKS CLOLINE) of LOOKS) + 64) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSTRIKE) of LOOKS) + 32) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSMALLCAP) of LOOKS) + 16) + (T 0)) + (COND + ((fetch (CHARLOOKS CLPROTECTED) of LOOKS) + 8) + (T 0)) + (COND + ((fetch (CHARLOOKS CLINVISIBLE) of LOOKS) + NIL 4) + (T 0)) + (COND + ((fetch (CHARLOOKS CLSELHERE) of LOOKS) + 2) + (T 0)) + (COND + ((fetch (CHARLOOKS CLCANCOPY) of LOOKS) + 1) + (T 0]) + +(\TEDIT.GET.PARALOOKS.LIST2 + [LAMBDA (FILE) (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* jds "22-May-85 14:28") + (* Read the list of CHARLOOKSs from + the file.) + (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") + (* ; "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)) + (* ; + "Left margin for the first line of the paragraph") + (replace (FMTSPEC LEFTMAR) of LOOKS with (\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))) (* ; + "There are other paragraph parameters to be read.") + (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\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]) + +(\TEDIT.PUT.CHARLOOKS.LIST2 + [LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk") + (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* jds "22-May-85 15:12") + (* ; + "Write the list of CHARLOOKSs into the font file.") + + (* ;; "Returns a hasharray that will map from a given CHARLOOKS to that CHARLOOKS' position in the list we wrote on the file. Those position numbers are then written in the individual looks descriptions, and are used to reconstruct the piece looks when the file is read back in.") + + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) (* ; + "No characters are described by this pseudo-piece entry.") + (\WOUT FILE \PieceDescriptorCHARLOOKSLIST) (* ; + "Mark it as containing the list of CHARLOOKSs") + (\WOUT FILE (FLENGTH LOOKSLIST)) (* ; + "How many CHARLOOKSs there are in the list") + (for I from 1 as LOOKS in LOOKSLIST do (* ; + "Write each charlooks, in the order they appear in the list.") + (\TEDIT.PUT.SINGLE.CHARLOOKS2 FILE LOOKS) + (* ; "Write out the description") + (PUTHASH LOOKS I LOOKSHASH) + (* ; + "And save it in the hash table so people can find its index.") + ) + (RETURN LOOKSHASH]) + +(\TEDIT.PUT.PARALOOKS.LIST2 + [LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk") + (* ; "Edited 19-Dec-2023 10:14 by rmk") + (* jds "22-May-85 15:09") + (* ; + "Write the list of FMTSPECs into the font file.") + (PROG ((LOOKSHASH (HASHARRAY 50))) + (\DWOUT FILE 0) + (\WOUT FILE \PieceDescriptorPARALOOKSLIST) + (\WOUT FILE (FLENGTH LOOKSLIST)) + (for I from 1 as LOOKS in LOOKSLIST do (\TEDIT.PUT.SINGLE.PARALOOKS2 FILE LOOKS) + (* ; "Write out the description") + (PUTHASH LOOKS I LOOKSHASH) + (* ; + "And save it in the hash table so people can find its index.") + ) + (RETURN LOOKSHASH]) +) + + + +(* ;; "For converting incoming old-format files (1/27/85 cutover)") + +(DEFINEQ + +(\TEDIT.GET.PCTB1 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:23 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 8-Nov-2023 13:48 by rmk") + (* ; "Edited 7-Nov-2023 13:17 by rmk") + (* ; "Edited 6-Nov-2023 08:43 by rmk") + (* ; "Edited 27-Oct-2023 13:54 by rmk") + (* ; "Edited 3-Aug-2023 22:08 by rmk") + (* ; "Edited 26-Apr-2023 14:18 by rmk") + (* ; "Edited 5-Sep-2022 23:06 by rmk") + (* ; "Edited 22-May-92 18:00 by jds") + +(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (* ;; "START = 1st char of file to read from, if specified") + + (* ;; "END = use this as eofptr of file. For use in reading files within files.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0))) + (SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT)) + 8)) + (SETQ PIECEINFOCH# (\DWIN TEXT)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind PC TYPECODE PCLEN OLDPC (DEFAULTCHARLOOKS _ (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (OLDPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) + (SBINABLE _ (fetch (STREAM BINABLE) of TEXT)) for I from 1 to PCCOUNT + do (SETQ PC NIL) (* ; + "This loop may not really read a piece, so we have to distinguish that case.") + (SETQ PCLEN (\DWIN TEXT)) + (SETQ TYPECODE (\WIN TEXT)) (* ; "What kind of piece is it?") + (SELECTC TYPECODE + (\PieceDescriptorPAGEFRAME (* ; + "This is page layout info for the file") + (FSETTOBJ TEXTOBJ TXTPAGEFRAMES (\TEDIT.GET.PAGEFRAMES1 TEXT))) + (\PieceDescriptorPARA (* ; + "Reading a new set of paragraph looks.") + (CL:WHEN OLDPC (* ; + "Mark the end of the preceding paragraph.") + (FSETPC OLDPC PPARALAST T)) + (SETQ OLDPARALOOKS (\TEDIT.GET.PARALOOKS1 TEXT)) + (* ; + "Get the new set of looks, for use by later pieces.") + (* ; + "The document contains paragraph formatting info") + (FSETTOBJ TEXTOBJ FORMATTEDP T)) + (\PieceDescriptorLOOKS + (* ;; "New character looks. Build a piece to describe those characters. This format doesn't have fat characters.") + + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILECH# + PBYTELEN _ PCLEN + PLEN _ PCLEN + PPARALOOKS _ OLDPARALOOKS + PTYPE _ THINFILE.PTYPE + PBYTESPERCHAR _ 1)) + (\TEDIT.GET.CHARLOOKS1 PC TEXT) + (FSETPC PC PBINABLE SBINABLE) (* ; + "Read the character looks for this guy.") + (add CURFILECH# (PLEN PC)) (* ; + "And note the passing of characters.") + ) + (\PieceDescriptorOBJECT (* ; + "It describes an object. Read that, and perhaps some description of the charlooks to go with it.") + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILECH# + PLEN _ 1 + PPARALOOKS _ OLDPARALOOKS + PTYPE _ THINFILE.PTYPE + PBYTESPERCHAR _ PCLEN)) + (TEDIT.GET.OBJECT1 (FGETTOBJ TEXTOBJ STREAMHINT) + PC TEXT CURFILECH#) + (add CURFILECH# PCLEN) + [COND + ((NOT (ZEROP (BIN TEXT))) (* ; + "There are new character looks for this object. Read them in.") + (\DWIN TEXT) + (\WIN TEXT) (* ; + "Skip over the piece-type code we know has to be here.") + (\TEDIT.GET.CHARLOOKS1 PC TEXT)) + (T (* ; + "No new looks; steal them from the prior piece.") + (FSETPC PC PLOOKS (OR (AND OLDPC (PLOOKS OLDPC)) + DEFAULTCHARLOOKS]) + (SHOULDNT "Impossible piece-type code")) + (CL:WHEN PC + (\INSERTPIECE PC NIL TEXTOBJ) + (SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ]) + +(\TEDIT.GET.PAGEFRAMES1 + [LAMBDA (FILE) (* ; "Edited 7-Nov-2023 12:35 by rmk") + (* jds " 1-Feb-85 14:55") + (* ; + "Read a bunch of page frames from the file, and return it.") + (\TEDIT.PARSE.PAGEFRAMES1 (READ FILE]) + +(\TEDIT.PARSE.PAGEFRAMES1 + [LAMBDA (PAGELIST PARENT) (* ; "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") + + (* ;; "Internalize an external pageframe.") + + (* ;; "Exactly like \TEDIT.PARSE.PAGEFRAMES, except this scales the region specs from Micas to points. However, that scaling is suppress if it looks like the PAGE regions are already in points") + + (LET (FRAMETYPE PAGEFRAME RSPEC) + (COND + ((type? PAGEREGION PAGELIST) + PAGELIST) + ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) + [SETQ PAGEFRAME (create PAGEREGION + REGIONFILLMETHOD _ FRAMETYPE + REGIONTYPE _ (pop PAGELIST) + REGIONLOCALINFO _ (pop PAGELIST) + REGIONSPEC _ + (if (AND (SETQ RSPEC (OR (pop PAGELIST) + (CREATEREGION 0 0 0 0))) + (EQ FRAMETYPE 'PAGE) + (IGEQ (fetch (REGION WIDTH) of RSPEC) + 595)) + then + (* ;; + "595 is A4, US letter and legal are greater, 612. RSPEC is already in points.") + + RSPEC + else (HCUNSCALE MICASPERPT RSPEC] + (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) + collect (\TEDIT.PARSE.PAGEFRAMES1 ALIST + PAGEFRAME))) + PAGEFRAME) + (T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC NIL]) + +(\TEDIT.GET.CHARLOOKS1 + [LAMBDA (PC FILE) (* ; "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") + (* ; "Edited 27-Oct-2023 13:04 by rmk") + (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* ; "Edited 30-May-91 20:26 by jds") + + (* ;; "Read a description of PC's CHARLOOKS from FILE. The looks are here stored in PC, not in the TEXTOBJ (uniquify later?)") + + (LET (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) + (FSETPC PC PLOOKS LOOKS) + (SETQ NAME (\ARBIN FILE)) (* ; "The font name") + (SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points") + (SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance") + (SETQ SUB (\SMALLPIN FILE)) (* ; "former Subscripting distance") + (OR (ZEROP SUB) + (SETQ SUPER (IMINUS SUB))) + + (* ;; "If this is an old file, it'll have a subscript value not zero. Let those past and do the right thing.") + + (CL:UNLESS (ZEROP (BIN FILE)) (* ; "This text is NEW. Mark it so.") + (FSETPC PC PNEW T)) + (CL:UNLESS (ZEROP (BIN FILE)) (* ; + "There is style or user information to be read") + (replace (CHARLOOKS CLSTYLE) of LOOKS with (OR (\ARBIN FILE) + 0)) + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (\ARBIN FILE))) + (SETQ PROPS (\WIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + [SETQ FONT (COND + ((LISTP NAME) (* ; + "This was a font class. Restore it.") + (FONTCLASS (pop NAME) + NAME)) + ((AND NAME (NOT (ZEROP SIZE))) + (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.") + + (CL:WHEN [SETQ NAME (FONTCOPY FONT '(DEVICE DISPLAY NOERROR T] + (FONTPROP NAME 'FAMILY)) + else NAME)) + (replace (CHARLOOKS CLFONT) of LOOKS with FONT]) + +(\TEDIT.GET.PARALOOKS1 + [LAMBDA (FILE) (* ; "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") + (* ; "Edited 1-Aug-2022 12:04 by rmk") + (* ; "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)) + (* ; + "Left margin for the first line of the paragraph") + (replace (FMTSPEC LEFTMAR) of LOOKS with (\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))) + (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:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ; + "There are other paragraph parameters to be read.") + (replace (FMTSPEC FMTSPECIALX) of LOOKS with (\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]) + +(TEDIT.GET.OBJECT1 + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 27-Oct-2023 12:58 by rmk") + (* ; "Edited 6-Aug-2022 09:11 by rmk") + (* ; "Edited 12-Jun-90 18:17 by mitani") + + (* ;; "Get an object from the file") + + (* ;; "CURCH# = fileptr within the text section of the file where the object's text starts.") + + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + FILEPTRSAVE GETFN OBJ) + (SETQ GETFN (\ATMIN FILE)) (* ; + "The GETFN for this kind of IMAGEOBJ") + (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ; + "Save our file location thru the building of the object") + (SETFILEPTR FILE CURCH#) + (SETQ OBJ (READIMAGEOBJ FILE GETFN)) + (SETFILEPTR FILE FILEPTRSAVE) + (FSETPC PIECE PCONTENTS OBJ) + (FSETPC PIECE PTYPE OBJECT.PTYPE) + (FSETPC PIECE PLOOKS (if (PREVPIECE PIECE) + then (PLOOKS (PREVPIECE PIECE)) + elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + else (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT) + TEXTOBJ))) + (PCONTENTS PIECE]) +) + + + +(* ;; "VERSION 0 Compatibility reading functions") + +(DEFINEQ + +(TEDIT.GET.PCTB0 + [LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 21-Jan-2024 10:27 by rmk") + (* ; "Edited 19-Dec-2023 10:13 by rmk") + (* ; "Edited 27-Oct-2023 13:47 by rmk") + (* ; "Edited 3-Aug-2023 22:09 by rmk") + (* ; "Edited 26-Apr-2023 14:21 by rmk") + (* ; "Edited 5-Sep-2022 23:06 by rmk") + (* ; "Edited 22-May-92 18:01 by jds") + +(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE") + + (LET (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)) + (SETFILEPTR TEXT PIECEINFOCH#) + (bind PC TYPECODE PCLEN OLDPC (DEFAULTPARALOOKS _ (FGETTOBJ TEXTOBJ FMTSPEC)) for I + from 1 to PCCOUNT + do (SETQ PCLEN (\DWIN TEXT)) + (SETQ PC + (create PIECE + PCONTENTS _ TEXT + PFPOS _ CURFILECH# + PLEN _ PCLEN + PREVPIECE _ OLDPC + PPARALOOKS _ DEFAULTPARALOOKS + PTYPE _ THINFILE.PTYPE + PBYTESPERCHAR _ 1 + PBINABLE _ SBINABLE)) + [COND + (OLDPC (FSETPC OLDPC NEXTPIECE PC) + (FSETPC PC PPARALOOKS (PPARALOOKS OLDPC] + (SETQ TYPECODE (\WIN TEXT)) + (SELECTC TYPECODE + (\PieceDescriptorLOOKS + (TEDIT.GET.CHARLOOKS0 PC TEXT) + (add CURFILECH# (PLEN PC))) + (\PieceDescriptorOBJECT + (TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT)) + PC TEXT CURFILECH#) + (add CURFILECH# (PLEN PC)) (* ; + "Only object--can't be followed by either of the others.") + (FSETPC PC PLEN 1)) + (\PieceDescriptorPARA + (AND OLDPC (FSETPC OLDPC PPARALAST T)) + (TEDIT.GET.PARALOOKS0 PC TEXT) + (FSETPC PC PLEN (\DWIN TEXT)) (* ; + "Set this piece's length from the character looks.") + (\WIN TEXT) (* ; + "Skip the piece-type code, since we know what's next") + (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")) + (SETQ OLDPC PC) + (\INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ]) + +(TEDIT.GET.CHARLOOKS0 + [LAMBDA (PC FILE) (* ; "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") + (* ; + "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1") + (PROG (FONT STR NAME NAMELEN SIZE SUPER SUB PROPS STYLESTR USERSTR (LOOKS (create CHARLOOKS))) + (replace (PIECE PLOOKS) of PC with LOOKS) + (SETQ NAMELEN (\WIN FILE)) (* ; + "The length of the description which follows") + [SETQ NAME (PACK (for I from 1 to NAMELEN collect (CHARACTER (BIN FILE] + (* ; "The font name") + (SETQ SIZE (\WIN FILE)) (* ; "Size of the type, in points") + (SETQ SUPER (\SMALLPIN FILE)) (* ; "Superscripting distance") + (SETQ SUB (\SMALLPIN FILE)) (* ; "former Subscripting distance") + (OR (ZEROP SUB) + (SETQ SUPER (IMINUS SUB))) + + (* ;; "If this is an old file, it'll have a subscript value not zero. Let those past and do the right thing.") + + (COND + ((NOT (ZEROP (BIN FILE))) (* ; "This text is NEW. Mark it so.") + (replace (PIECE PNEW) of PC with T))) + [COND + ((NOT (ZEROP (BIN FILE))) (* ; + "There is style or user information to be read") + (SETQ STYLESTR (\STRINGIN FILE)) + (SETQ USERSTR (\STRINGIN FILE)) + (COND + ((NOT (ZEROP (NCHARS STYLESTR))) (* ; "There IS style info") + (replace (CHARLOOKS CLSTYLE) of LOOKS with (READ STYLESTR))) + (T (replace (CHARLOOKS CLSTYLE) of LOOKS with 0))) + (COND + ((NOT (ZEROP (NCHARS USERSTR))) (* ; "There IS user info") + (replace (CHARLOOKS CLUSERINFO) of LOOKS with (READ USERSTR] + (SETQ PROPS (\WIN FILE)) + (with CHARLOOKS LOOKS [SETQ CLBOLD (NOT (ZEROP (LOGAND 512 PROPS] + [SETQ CLITAL (NOT (ZEROP (LOGAND 256 PROPS] + [SETQ CLULINE (NOT (ZEROP (LOGAND 128 PROPS] + [SETQ CLOLINE (NOT (ZEROP (LOGAND 64 PROPS] + [SETQ CLSTRIKE (NOT (ZEROP (LOGAND 32 PROPS] + [SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS] + [SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS] + [SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS] + [SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS] + [SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS] + (SETQ CLSIZE SIZE) + (SETQ CLOFFSET SUPER)) + (replace (CHARLOOKS CLFONT) of LOOKS with (AND NAME (NOT (ZEROP SIZE)) + (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]) + +(TEDIT.GET.OBJECT0 + [LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 6-Aug-2022 15:57 by rmk") + (* ; "Edited 12-Jun-90 18:17 by mitani") + + (* ;; "Get an object from the file") + + (* ;; "CURCH# = fileptr within the text section of the file where the object's text starts.") + + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + FILEPTRSAVE NAMELEN GETFN OBJ) + (SETQ GETFN (\ATMIN FILE)) (* ; + "The GETFN for this kind of IMAGEOBJ") + (SETQ FILEPTRSAVE (GETFILEPTR FILE)) (* ; + "Save our file location thru the building of the object") + (SETFILEPTR FILE CURCH#) + (SETQ OBJ (READIMAGEOBJ FILE GETFN)) + (SETFILEPTR FILE FILEPTRSAVE) + (replace (PIECE PCONTENTS) of PIECE with OBJ) + [replace (PIECE PLOOKS) of PIECE with (COND + ((fetch (PIECE PREVPIECE) of PIECE) + (fetch (PIECE PLOOKS) of (fetch (PIECE PREVPIECE) + of PIECE))) + (T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS) + of TEXTOBJ) + (\TEDIT.UNIQUIFY.CHARLOOKS ( + CHARLOOKS.FROM.FONT + DEFAULTFONT) + TEXTOBJ] + OBJ]) + +(TEDIT.GET.PARALOOKS0 + [LAMBDA (PC FILE) (* ; "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)) + (* ; + "Left margin for the first line of the paragraph") + (replace (FMTSPEC LEFTMAR) of LOOKS with (\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]) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (1765 38438 (\TEDIT.GET.PCTB2 1775 . 11514) (\TEDIT.GET.PARALOOKS2 11516 . 12105) ( +\TEDIT.GET.CHARLOOKS2 12107 . 13438) (\TEDIT.PARSE.PAGEFRAMES2 13440 . 16179) ( +\TEDIT.GET.CHARLOOKS.LIST2 16181 . 16688) (\TEDIT.GET.SINGLE.CHARLOOKS2 16690 . 20407) ( +\TEDIT.PUT.SINGLE.PARALOOKS2 20409 . 25160) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25162 . 29636) ( +\TEDIT.GET.PARALOOKS.LIST2 29638 . 30145) (\TEDIT.GET.SINGLE.PARALOOKS2 30147 . 35156) ( +\TEDIT.PUT.CHARLOOKS.LIST2 35158 . 37237) (\TEDIT.PUT.PARALOOKS.LIST2 37239 . 38436)) (38515 58558 ( +\TEDIT.GET.PCTB1 38525 . 44772) (\TEDIT.GET.PAGEFRAMES1 44774 . 45226) (\TEDIT.PARSE.PAGEFRAMES1 45228 + . 47604) (\TEDIT.GET.CHARLOOKS1 47606 . 51978) (\TEDIT.GET.PARALOOKS1 51980 . 57012) ( +TEDIT.GET.OBJECT1 57014 . 58556)) (58618 72548 (TEDIT.GET.PCTB0 58628 . 62135) (TEDIT.GET.CHARLOOKS0 +62137 . 66723) (TEDIT.GET.OBJECT0 66725 . 68674) (TEDIT.GET.PARALOOKS0 68676 . 72546))))) +STOP diff --git a/library/tedit/TEDIT-OLDFILE.LCOM b/library/tedit/TEDIT-OLDFILE.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..07e8294893c031136992bded9c55fb5634284e2d GIT binary patch literal 19160 zcmeHPYiwM{b>0WXQVdNmsSUGXXnL|%1X8u=z4z{eq>E&iOxKx4E;6C^_0v?%E6 zN6;UM`<;2*JC|HKPU1R$EI{O$nKN@|?wvX3JCEVeRCYRF%AT0c7qTbvrD>ZD&SfTN zGbghwnlDwd^M!nQF3JYyvze(%W}>jCdLmQKG9xzJ**QcbOoFYFonlebI5Bf>?SvUK z<7gf?Q{#!TC>x5NU%zk?I-_RH9nrMLEn_^Min50;FF8Y=Up}|?iKQza8fRztFe4|km65s0%7m#` zOy)B41>2r2duoZzV4Ye=htFW%(PCQJVT!Q}SkUxBp}_Qsj*N^%S?$~g7TjtD2{StU zmR{UjeNilBCQ=3)r?+@wVv$|GxXL=mG0W1)Z23gRW<%4ZvNnHOc1(XeZ}01JU(YZb zpPSF#pSKsvC#JAPSky>*zGuwh-?Q^At~5TZe=9NT@u|_yp*d!ZG5&oS$WfN3UrDzn zA!;m!-8DB!jV7C$EM!YW;!`iqWhd>aER|wt!0$0up2(N@)}LdeykBNMqaKlBI6#?& zLd97tx+M8SEH($mT&A2ul_{nmO9q?EXD73C-X?Q*p*hAT7v}j1LNU+cEL)nwZ;O>H znfVGRn&qUuP$HUkw0H~vo43K;il+SjWpBjJ8AZ< zYG17$+}#Q{GopbrhAW$a;dTd_B9*- zfrqZ_KD+7rm*#^sr8{fsu&-Imh1;4nI}#4?pY8Y=3Wu7tl~;YiW^Fax-K>VwGxCAq zSA4;h-Dm8u-TUb3)s zV%v(UuGb>_Is|wJJ96XHrthnYZ)9nEVfXKJZU493-T3}G zb>j_9JG_0kw2JTl!_O~g)Jv=OHyi)u8%mDF*_nK)oSm=m6T*_I1S{w4g~AlJelh`J zHT^(#-o_b=8@k{s=SwG{E1XkkvZRsFBppsmcCx~((S+VhW4B_K-ahw0Ol>S&}LaMhr zIA&DNj?6(bPtRwHS?DhVD5pDw^+hVN-934>f)nL9iAun z;#i%aEIf7ZaHEiJn17MchvEVa&&3yy0eW1#w0`Bvg@@`(?9zp$^Ghc-K6z=0onNml zk)oYg$QP!#YKQ*Rbhh@!_EX<=P8s6>QXJnECJR#_R8S@KE}%Nj^N94yFC+ zz(c;~sZUUO_pwditp|y^6C&8xl#S2VX2PAS@Iq}CGE=r}zh|XZt1b8A-;1>ZMAu@C zOV}Ns7;o!hy*Dpv0)c@4*49~7dPxvPs;<@hcK^7!QdAuC%^J3{nC^u`$R9 zcStMF<%ClqWe@BKzRmOpU_PzSo)n&H!(#twC;k_q!TjRHulAU2`P{8XXF@`Gy*Rsl zTVc8X^z-@E8;gy9FC2TJ@dLc#H&-;Rq`-b{q~;Q13s7#5d;I8>D~pA!C}3ewYh_fY zSb1RrzmxbqmnBB1!2AP*N#m>p(J#=d#c5PRJMrNlPi&kp0+Rxrx{D6{-TScU2WcnY z361| z^>%2j!*{dVx3ar^yWMvvc>S>5$Hmg}Zn(?kX#-DWW%p}#1aixcaE>n$R%+J<3V^Af znEHvS-(_mknEYTGAf^Fg8qk;^9r@(#Q2px7>LBq963?KM`OuMm)zf9&J8tH>*R$GekT?8jm)g zz|HD$;yF${$6cO)`+`<)R_`X3yNTs)jYU1GNPv^Ss1mltY%Tb-e>QNM%biB;`a?x% zmor6lF7m$D=4Ok6`<1p3n%=7lupRz{i`d4HszST0(z(9ExvnmA+;?^P8-hE}#sAg^ z@*F1er=PAp!&!OZ>MZ1`WDWarq{<*QXuH#)Vad@rFHG8VivWp9QQ*D^mPompE|CE6 zLZ`_>rd(zTC_beFT7S%L0!A<%Hl|m@2&QV)CkD$@c}!ShG^Lk-z_m8OBexVEOX{VhK1v+2+~u@J z^;ua7s2t~c7A$wSWRB{im;jktTTGvs0SM`~8Gx;B3H!z^r1X}A{@%D2au|gY66kb{ z4Nbw50Tet1*H{78K*`R|&)f5?GVG|MxrNGzR04!Lr6nPi06r>QX%N&F6QbN?_Cf_+ zrtSG+MnEYrlmW0vAH>MTKphA&?vw1_gk%r&>~{BDdT&~o|2w{y&J@2}f8!=UI?Y1S zAr(Uah~r~+x64zqyZ14*RePJ&klpKY*(mK}YX=&shV4F$4W)f-9Wd~!5xZYwLunsd zC(QrqfIXhRT%_#zP3Qt89jtX}ea$7iSRh<3AdAwO2vX5(=DDC6y<4;ok20W!fPpQ{a3VTY- zQ;PD^a;WC-@%N?eyZzN@v&!tKHWifIsn~Z1h z7kdPt_UX+ZecQ(+-I)oT36_FY?wbE`2y9-R1WJ??4n9dpVos2dRkW0*ydDzKsZWq> ztrU4Z89|CRwZ0IvV)XbJdh)U3B-jN7J6=+xKtvt9h|(Pp2dov97G$8LNV{-Gi%c*< zK^HkIGgFF{D-F(II-?t7m@}_4Qfg)f1f{IApf^OTp$0b~wnZK3EZzt#F9=$+cz}E+ z#99(>ZYn#OFJ=l*rVzm})qwG#93V;O^CxrUdl|(Nr$J!s>0*VX6BGh;t)k&3acEMs zsvd&cp`mmf8p2)CaZJ;pEq5FXs(5ChT**)8F&PUAj7rRc{q0QA!g~@0X5rn7*_zOf ze6}V*1344;#$6hF$*IRHQM55O=F(7GPCcvuMdJl2GM;cqYynxT+a;PJaI}fz8sM7- z65fyq9*-jg-%8H=U&TQTC;{K|=;0iPOkYUnI56XZPu13~iQ>B4tK z!)(Dlv~t*XFuZ)WEVK9b0!Rs@e?zIB0hhvh3!Q_?i+u9sCiW-761e&(1$m ze4VZNRCCwkuqLjqh;Fa615kcxt<9|<1p1}5fK~w%`lU6$Rsl%=Z2hV;L|cr?X{Q`O zhiB`|DYx@-$Sw2!9d4QTZ*$54%;4F2z%7HH?3nMl|CACHFJ0H5l>l%N3+F$bHC1Fkq<*3I{?E06&5N+;pHcT$4&9 z#^LBu2pg8X8XxG*0h*s-L{A9aeFs6?} z=i2ROCUsP2!cDBT!SkqUV?OSn*iszc@F6$0Xa!F*UWHP zb-}=clL{KX0}cxphQ5iz!evt4ONxnQCMZOeB7#eOa!nA8N_cKF6Cy4}-U$g*3E854 zx^NOKGV-OlU;@8)yW@?hA6@S63HWohJfaP~@J)15%%OvRz)SJVhi8Nbg1Z@X*F@NN zU`yb@mbL?1+7E2$IIyKtw9pEw-Qn&uJFQr2tGiD%xg>5JuOa563U^TC>`Bq`Swzd8 z;5-5Xg+sG2)*(>f^ZbS#Iuv}`7S3mszq;Qw^J1Evh5M@8?z6+UuC456NHYYo)Psk$ z8DSCucM?I*B>JlZ2v%($u?MgwcpKq(MEI<)@dbO}7)5CQ$By*ATv*xtIwC$#7P!#= zvfW((Uw7&K%~`mktG#>$n|3d)pqH~?1z%LJh9Zcb?-*$w*wn9@_$c8%Z*jm|9P}1@ zy~VJ%h^V9H*$PKz$fE#BL^6)-Z-SSSgmtV)LUy7yfuIhFN$@5JVM&stxnPJBgYqFH zz@caz&zgiTWrGQzrQjd|G7`QLwj`kt92#O)(TOp)J^|mYQ=io80al%Q1Z@-@*I*6_ zYX$x+vhWr7BZr58Qx?#pfK$o12FOgT%;7fS4v^pr6BgVW#Pa|vs2(*FLjz)l2D0#O z6id>DWZG-t7P@3{>~oI+?uclwcuhznngkZ52S|4*56wH!i#wZL2dZxg`z25}`A(z= zjWF>Xgi~+h3O+5u=FczANR*YIaS;?^)rV$-+ikg!|D|+M0D@v6CnBJQ)f+Fu@z(f` zZwOllsF6>H6uihjX^kUY_@FQWi~$vx1dbN^olF}60)Y6ZK1!xflF|4)617(y(32cJ z@D9AWL+{+1bCzYoR+R6A01tmTKl__g`9?^yE4l}F&-=Cl(3W4C$JN{rx7nO4$OEa+(^y(+DwPsI?z zq#XayN%p90`u&tHF=$7&kBA5ayjCJx!}o6@TjTq77)ox-Zjr0e2ZwRZ?&Dbv-FtF1 zdeah(_u3(qqLH(EciJh7;&+iA@#zQ2+oR`xi1Y|;APlXtBYJsuL~lCBBY;Sa=)3V8 zzyPeHW3w=hX1UC`)-To|SKGAZBpM&Ed+o>*b_9tM!BV*EGkT&#@Al#1>W#CTKl)oI zQKA=0nGz)|Ku}Mjgaw(Z6bK``S&NH1g3y2s4Uxig1uV_=Y(gElS#Ba%!eA!(6WnTT z6oV9`+v1!n133wMT2#7%@&A&gV8Q_3lU6_|eoqy-T3TcpSWuL2l4-Cvx4>NqKi-;h zz!^bEk$-3Y189Qc22yhG$=fghnkj2zpWNNYr=$qH6FlQX1l;jaRKy*weGahaB`p7G zBJh#k9~XiDdwCkP2s{Pdod`Td+V@1@`AK--`ul`CV)q$D$Y&5(fBo5+#z$s?TlXL+ zKGTR&IGk_y|KxA2MNIr(5flHN8I9+qTG5T_^GG>Q7ZBlc5n4yK(gERe8D8&^;q|Bt zuLJT9BD_wJmpwv2cTj}a89t*)?!tqApGlTqDM3BYGV^Sh` z4wPrWFxEofaKiC`_)iuB$CFHEB}U9t3f@5jAWsz>Fhq(;JH2XOy|b}sI2rVGm%u+$ z;6iRKEhL=_cL@-6TI9f-6~A6n*Wz6pDUI zMxtfv44M#uzGhGe`g1Y_eeEt0VieDZGt7y1iyCZs@#JbqFe2RjZj|~Rk5a$mLF&b~ z9;9|+)OiSx6cSz>4_XRQV(t{;F>3O6lZQygs5L_{flz?vJfdVhX(A@z08@0FLK@1Z zBK8{o;9rjNL>W1J&w5~R<8%Fk@Kzf z@p$_Z@aMa236GaBfp6uu#SuNyO0YV$k|)$`A@=UJS(ZKup(?k{MCeB=;YGP6N)pvd zh&5>?tlKRe7?*|-{}$rX9X@04P!%pP1moxWM3Z=L(LtJ#d2DfhL0uJ4;k?0hNoTs>x zc_)p=X%X2V{|jj?q-vjS^ZVMwy_uazj}e^U2FwHE*W$z^_b*J$@L#7Vgk6%E4f`_u zZbhcH)A=O+?{qbesqH`F$=O}ViQa=6od)8ej}vK(8Km%mFj`DoiO13zMLW&n?PEIBiB2A8a3+cmN_m=x)&x19u zo9yo6^QyuBiq^QbZv#=zg`~~;GE;*GGXny zyVE%vF=hhh2^SYx?=Fk8`@lkBO}Zq>?}!Q+5`!U)-R9J4BT|Tm`^+$&c7y;6r7I07 z+wNHcAjQdYF47=dWRE)v7lPCQL(0lecH5=p{N$koq~zBff39|Y@FRo!?fT!3h!aD` zJ-^v9_1)2U&OVc0aXT*j? z!iFT^M-sE5H1umHDG&W~G7tUQm~;RLhK7-0{8&`SoA&5-*dB*3X|$Sb+Hq|5_~siQ zu*Z*8N1Kh;MK^LR*kREF+3UCnsHLxeT@EeU5Ar#*PH1-%zmW!WP)56!iH^+pmKp7B zDm@(8^T>=pN;dx9jP^Dy6CIiHEi>BpWX8A7XxHY0%=nfW?d{rpkQv`HrM+F758}`x zH0KfW`;71x&F>d@GvkrX^EEq0EHRBmJ<5|AFTTm__47!G-@XkA@z*;`HLEMl`32svlGa!O4xedDL2{DLko8)7l z`MM?C`BYCew3*R;M^z7}1pS=?V3bk1u-Ad1o8_sPUZNCyca)^Z4Uq7-0TLcJK*Ez&6i1?`J4)P}knTy-wWcBMIUF|AGz#mAaH#CoUnkz>@^IP3@MF@cRCY@H?RZ zq=erahjjRzX%o2n^d9&vu6UnO@S9us1z>Pas9Z##6<*%y6u-I}5pmWDmoIR!pm2Es z=hATFIu2CP-Y53AQ+nHRIZlka_m5D5_*^){f`Hdd63T!X~pzr0DGT^{dpc7A-RMt3``U{c6!7Q@>iY$keYE zEqlB|8I}5#VOpZqPm=n@lcxR>;o{GWa53=6pY4C{iy5Bu)rF982uWZ28Swm{Ch3dv zypZ%20cz=^@L4ZVOD~eXB6QUhNnhcElfFb2tLy)bLoB)w9T`eWV4JX6RRg4U9Jtp> zI>P;RCymI$mR3ne$kd^Xa}%L$Hw&EmQB{f(rFzPwBPblfO{!C6d?S-z(T0|`Z9vRB z^;%9k-APsTFfSB|qohb+esQV}NIx3FpE;>i7ANiE9CTYn*c0kc*`T(Jwa?FG?z?Y) z3mY0b&hEXJMJMT+`^VQWv&&28Y8Tc%!Pe`w6DVIiw;_9xiCktw#@J|LI6BORXkaFK zcSfht^ZfeSuPj~OkezX79)Bf=3SyKI#wH)$SO*77++&*eKt*h2&&Wqe}{ZX#E^j LHjID#uQL1}wV7~5 literal 0 HcmV?d00001 diff --git a/library/tedit/TEDIT-PAGE b/library/tedit/TEDIT-PAGE index e75136ea..1183fb5a 100644 --- a/library/tedit/TEDIT-PAGE +++ b/library/tedit/TEDIT-PAGE @@ -1,34 +1,38 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:51"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;1 119264 +(FILECREATED " 7-Mar-2024 09:55:14" {WMEDLEY}TEDIT>TEDIT-PAGE.;154 111276 - :PREVIOUS-DATE "14-Jul-2022 12:45:04" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-PAGE.;4) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT.FORMAT.HARDCOPY) + + :PREVIOUS-DATE " 7-Mar-2024 00:14:19" {WMEDLEY}TEDIT>TEDIT-PAGE.;152) (PRETTYCOMPRINT TEDIT-PAGECOMS) (RPAQQ TEDIT-PAGECOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (COMS - (* ;; "Page-numbering font specification/default") + ((DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS TEDITPAPERSIZE) + (EXPORT (RECORDS PAGEFORMATTINGSTATE PAGEREGION) + (MACROS GETPFS SETPFS)) + (MACROS \FIRST-COLUMN-START) + + (* ;; "Replaces CL:MULTIPLE-VALUE-SETQ, to avoid CL:VALUES") + + (MACROS TEDIT.SETQS TEDIT.VALUES)) + (INITRECORDS PAGEREGION) + [COMS + (* ;; "Page-numbering font specification/default. ") (* ;; "(Must come before calls to TEDIT.SINGLE.PAGEFORMAT below.)") (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) - [INITVARS (TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE - 10 WEIGHT - MEDIUM SLOPE - REGULAR] - - (* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") - - (INITVARS (*TEDIT-PAGE-BREAKS* NIL))) + (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 @@ -39,10 +43,9 @@ (COMS (* ;; "Creation, GET, and PUT of page frames.") - (FNS TEDIT.GET.PAGEFRAMES TEDIT.PARSE.PAGEFRAMES TEDIT.PUT.PAGEFRAMES - TEDIT.UNPARSE.PAGEFRAMES)) + (FNS \TEDIT.PARSE.PAGEFRAMES \TEDIT.PUT.PAGEFRAMES \TEDIT.UNPARSE.PAGEFRAMES)) (COMS - (* ;; "For setting up page layouts") + (* ;; "Public functions for setting up page layouts") (FNS TEDIT.SINGLE.PAGEFORMAT TEDIT.COMPOUND.PAGEFORMAT TEDIT.PAGEFORMAT)) (COMS @@ -54,7 +57,7 @@ (* ;; "Aux function to capture page headings during line formatting:") - (FNS TEDIT.HARDCOPY.PAGEHEADING) + (FNS TEDIT.HARDCOPY.PAGEHEADINGS) (* ;;  " Aux function to handle end-of-column processing (paragraph keep, widow elimination, etc):") @@ -84,25 +87,130 @@ (* ;; "Foot note support") (FNS \TEDIT.FORMAT.FOOTNOTE)))) - -(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RECORD TEDITPAPERSIZE ( + (* ;; + "Describe the size of a sheet of paper (in points), given a paper size-name.") + + TPSNAME (* ; "The name, as a litatom") + TPSWIDTH (* ; "Paper width, in points") + TPSHEIGHT (* ; "Paper Height, in points") + TPSLANDSCAPE? (* ; + "T if we have to rotate things to print them on this paper.") + )) +) + +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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.") + + MINPAGE# (* ; + "The page # of the first page to be printed, or NIL") + MAXPAGE# (* ; + "The page # of the last page to be printed, or NIL") + STATE (* ; "One of FORMATTING or SEARCHING.") + REQUIREDREGIONTYPE (* ; "If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page.") + MAINSTREAM (* ; + "The principal textobj/stream source") + CHNO (* ; "Our position in that stream") + PRESSREGION (* ; "The press code's REGION info.") + PAGEHEADINGS (* ; + "The list of current values to be printed, indexed by heading type") + PAGE#GENERATOR (* ; "List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below") + PAGE#TEXT (* ; "If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c") + PAGEISRECTO (* ; + "T if this is a recto page, NIL if it's a VERSO page.") + PAGEFOOTNOTELINES (* ; + "A list of extant footnote lines that should appear at the next opportunity") + PAGEFLOATINGTOPLINES (* ; + "A list of lines that should float to the top of the next available place") + PAGECOUNT (* ; + "The number of pages we've formatted so far.") + PAGELINECACHE (* ; "A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time") + NEWPAGELAYOUT (* ; "If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again.") + ) + PAGECOUNT _ 0) + +(DATATYPE PAGEREGION ( + (* ;; + "Describe a part of a page for page formatting. Can be made into compound descriptions.") + + REGIONFILLMETHOD (* ; + "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") + REGIONSPEC (* ; + "The page-relative region this occupies") + REGIONLOCALINFO (* ; "A PLIST for local information") + (REGIONPARENT FULLXPOINTER) (* ; + "The parent node for this box, for sub-boxes") + REGIONSUBBOXES (* ; "The sub-regions of this region") + REGIONTYPE (* ; "A user-settable region type") + )) +) + +(/DECLAREDATATYPE 'PAGEREGION '(POINTER POINTER POINTER FULLXPOINTER POINTER POINTER) + '((PAGEREGION 0 POINTER) + (PAGEREGION 2 POINTER) + (PAGEREGION 4 POINTER) + (PAGEREGION 6 FULLXPOINTER) + (PAGEREGION 8 POINTER) + (PAGEREGION 10 POINTER)) + '12) (DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(PUTPROPS GETPFS MACRO ((FS FIELD) + (fetch (PAGEFORMATTINGSTATE FIELD) of FS))) - -(CONSTANTS (\SCRATCHLEN 64)) +(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) + (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))) ) +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \FIRST-COLUMN-START MACRO [(LINE FMTSPEC) + (AND (FGETLD LINE 1STLN) + (EQ (FFETCH (FMTSPEC FMTCOLUMN) OF FMTSPEC) + 'FIRST]) ) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS TEDIT.SETQS MACRO + [ARGS `(LET (($$VALUES ,(CADR ARGS)) + ($$PRIMARY)) + (DECLARE (LOCALVARS $$VALUES)) + (PROG1 (CAR $$VALUES) + ,@[FOR V IN (CAR ARGS) collect (COND + [V `(SETQ ,V (POP $$VALUES] + (T `(SETQ $$VALUES (CDR $$VALUES])]) + +(PUTPROPS TEDIT.VALUES MACRO [ARGS `(LIST ,@ARGS]) +) +) + +(/DECLAREDATATYPE 'PAGEREGION '(POINTER POINTER POINTER FULLXPOINTER POINTER POINTER) + '((PAGEREGION 0 POINTER) + (PAGEREGION 2 POINTER) + (PAGEREGION 4 POINTER) + (PAGEREGION 6 FULLXPOINTER) + (PAGEREGION 8 POINTER) + (PAGEREGION 10 POINTER)) + '12) -(* ;; "Page-numbering font specification/default") + +(* ;; "Page-numbering font specification/default. ") @@ -114,15 +222,9 @@ (GLOBALVARS TEDIT.DEFAULT.FOLIO.LOOKS) ) -(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM - SLOPE REGULAR))) - - - -(* ;; "If non-nil, TEdit appends the start & end fileptrs for pages here.") - - -(RPAQ? *TEDIT-PAGE-BREAKS* NIL) +(RPAQ? TEDIT.DEFAULT.FOLIO.LOOKS [CHARLOOKS.FROM.FONT (FONTCOPY NIL + '(FAMILY MODERN SIZE 10 WEIGHT MEDIUM + SLOPE REGULAR]) (RPAQQ MAXPAGE# 65535) @@ -139,253 +241,314 @@ (DEFINEQ -(TEDIT.GET.PAGEFRAMES - [LAMBDA (FILE) (* jds "18-Jun-84 02:55") - (* Read a bunch of page frames from - the file, and return it.) - (TEDIT.PARSE.PAGEFRAMES (READ FILE]) +(\TEDIT.PARSE.PAGEFRAMES + [LAMBDA (PAGELIST PARENT) (* ; "Edited 13-Nov-2023 00:14 by rmk") + (* ; "Edited 4-Oct-2022 16:57 by rmk") + (* jds "31-Jul-84 15:30") -(TEDIT.PARSE.PAGEFRAMES - [LAMBDA (PAGELIST PARENT) (* jds "31-Jul-84 15:30") - (* Take an external pageframe and - internalize it.) - (PROG (FRAMETYPE PAGEFRAME) - (COND - ((type? PAGEREGION PAGELIST) - (RETURN PAGELIST)) - ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) - [SETQ PAGEFRAME (create PAGEREGION - REGIONFILLMETHOD _ FRAMETYPE - REGIONTYPE _ (pop PAGELIST) - REGIONLOCALINFO _ (pop PAGELIST) - REGIONSPEC _ (OR (pop PAGELIST) - (LIST 0 0 0 0] - (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) - collect (TEDIT.PARSE.PAGEFRAMES ALIST - PAGEFRAME))) - (RETURN PAGEFRAME)) - (T (RETURN (for FRAMESPEC in (CAR PAGELIST) collect (TEDIT.PARSE.PAGEFRAMES FRAMESPEC - NIL]) + (* ;; "Internalize an external pageframe.") -(TEDIT.PUT.PAGEFRAMES - [LAMBDA (FILE PAGEFRAMES) (* jds "13-Nov-86 20:10") - (* Put out a description of a set of - page-layout frames) - (PROG (STR) - (\DWOUT FILE 0) (* The length of this run of looks) - (\SMALLPOUT FILE \PieceDescriptorPAGEFRAME) (* Mark this as a set of page frames) - (PRIN2 (TEDIT.UNPARSE.PAGEFRAMES PAGEFRAMES) - FILE *TEDIT-FILE-READTABLE*]) + (* ;; "Exactly like TEDIT.PARSE.PAGEFRAMES1, except this doesn't scale the region specs") + + (LET (FRAMETYPE PAGEFRAME) + (COND + ((type? PAGEREGION PAGELIST) + PAGELIST) + ((NEQ 'LIST (SETQ FRAMETYPE (pop PAGELIST))) + [SETQ PAGEFRAME (create PAGEREGION + REGIONFILLMETHOD _ FRAMETYPE + REGIONTYPE _ (pop PAGELIST) + REGIONLOCALINFO _ (pop PAGELIST) + REGIONSPEC _ (OR (pop PAGELIST) + (LIST 0 0 0 0] + (replace REGIONSUBBOXES of PAGEFRAME with (for ALIST in (pop PAGELIST) + collect (\TEDIT.PARSE.PAGEFRAMES ALIST + PAGEFRAME))) + PAGEFRAME) + (T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES FRAMESPEC NIL]) + +(\TEDIT.PUT.PAGEFRAMES + [LAMBDA (LOOKSFILE PAGEFRAMES) (* ; "Edited 22-Dec-2023 09:03 by rmk") + (* ; "Edited 19-Dec-2023 10:25 by rmk") + (* ; "Edited 26-Aug-2023 08:29 by rmk") + (* jds "13-Nov-86 20:10") + + (* ;; "Put out a description of a set of page-layout frames") + + (\DWOUT LOOKSFILE 0) (* ; "The length of this run of looks") + (\WOUT LOOKSFILE \PieceDescriptorPAGEFRAME) (* ; "Mark this as a set of page frames") + (PRIN4 (\TEDIT.UNPARSE.PAGEFRAMES PAGEFRAMES) + LOOKSFILE *TEDIT-FILE-READTABLE*]) + +(\TEDIT.UNPARSE.PAGEFRAMES + [LAMBDA (PAGEFRAME) (* ; "Edited 22-Dec-2023 09:04 by rmk") + (* jds "31-Jul-84 15:00") + + (* ;; "Take an internal page frame, and create an equivalent list structure.") -(TEDIT.UNPARSE.PAGEFRAMES - [LAMBDA (PAGEFRAME) (* jds "31-Jul-84 15:00") - (* Take an internal page frame, and - create an equivalent list structure.) (COND [(LISTP PAGEFRAME) - (LIST 'LIST (for FRAME in PAGEFRAME collect (TEDIT.UNPARSE.PAGEFRAMES FRAME] + (LIST 'LIST (for FRAME in PAGEFRAME collect (\TEDIT.UNPARSE.PAGEFRAMES FRAME] (T (LIST (fetch REGIONFILLMETHOD of PAGEFRAME) (fetch REGIONTYPE of PAGEFRAME) (fetch REGIONLOCALINFO of PAGEFRAME) (fetch REGIONSPEC of PAGEFRAME) (for SUBREGION in (fetch REGIONSUBBOXES of PAGEFRAME) collect ( - TEDIT.UNPARSE.PAGEFRAMES + \TEDIT.UNPARSE.PAGEFRAMES SUBREGION]) ) -(* ;; "For setting up page layouts") +(* ;; "Public functions for setting up page layouts") (DEFINEQ (TEDIT.SINGLE.PAGEFORMAT [LAMBDA (PAGE#S? PX PY PFONT PQUAD LEFT RIGHT TOP BOTTOM COLS COLWIDTH INTERCOL HEADINGS UNITS - PAGEPROPS PAPERSIZE) (* ; "Edited 17-Dec-87 14:54 by jds") + PAGEPROPS PAPERSIZE) (* ; "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.") - (PROG* ((LANDSCAPE? (LISTGET PAGEPROPS 'LANDSCAPE?)) - (PAPERWIDTH (\TEDIT.PAPERWIDTH PAPERSIZE LANDSCAPE?)) - (PAPERHEIGHT (\TEDIT.PAPERHEIGHT PAPERSIZE LANDSCAPE?)) - [PAGEREGION (create PAGEREGION - REGIONFILLMETHOD _ 'PAGE - REGIONSPEC _ - (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ PAPERWIDTH - HEIGHT _ PAPERHEIGHT) - REGIONLOCALINFO _ (CONS 'PAPERSIZE (CONS PAPERSIZE PAGEPROPS] - PAGEWIDTH SUBREGIONS FOLIO FOLIOLEFT SCALEFACTOR HEADINGREGIONS) - (SELECTQ UNITS - ((POINTS NIL) (* ; + (LET* ((LANDSCAPE? (LISTGET PAGEPROPS 'LANDSCAPE?)) + (PAPERWIDTH (\TEDIT.PAPERWIDTH PAPERSIZE LANDSCAPE?)) + (PAPERHEIGHT (\TEDIT.PAPERHEIGHT PAPERSIZE LANDSCAPE?)) + [PAGEREGION (create PAGEREGION + REGIONFILLMETHOD _ 'PAGE + REGIONSPEC _ + (create REGION + LEFT _ 0 + BOTTOM _ 0 + WIDTH _ PAPERWIDTH + HEIGHT _ PAPERHEIGHT) + REGIONLOCALINFO _ (CONS 'PAPERSIZE (CONS PAPERSIZE PAGEPROPS] + PAGEWIDTH SUBREGIONS FOLIOLEFT SCALEFACTOR HEADINGREGIONS) + (SELECTQ UNITS + ((POINTS NIL) (* ;  "If units are in printers points, the default, do no scaling") - (SETQ SCALEFACTOR 1)) - (PICAS (* ; + (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.27pts per. Set the scale factor") - (SETQ SCALEFACTOR 72)) - (MICAS (* ; + (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 (* ; + (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.") - (SETQ PX (SCALEPAGEXUNITS PX SCALEFACTOR PAPERSIZE LANDSCAPE?)) - (SETQ PY (SCALEPAGEYUNITS PY SCALEFACTOR PAPERSIZE LANDSCAPE?)) - [AND LEFT (SETQ LEFT (FIXR (FTIMES LEFT SCALEFACTOR] - [AND RIGHT (SETQ RIGHT (FIXR (FTIMES RIGHT SCALEFACTOR] - [AND TOP (SETQ TOP (FIXR (FTIMES TOP SCALEFACTOR] - [AND BOTTOM (SETQ BOTTOM (FIXR (FTIMES BOTTOM SCALEFACTOR] - [AND COLWIDTH (SETQ COLWIDTH (FIXR (FTIMES COLWIDTH SCALEFACTOR] - [AND INTERCOL (SETQ INTERCOL (FIXR (FTIMES INTERCOL SCALEFACTOR] - [SETQ HEADINGS (for HDG in HEADINGS collect (LIST (CAR HDG) - (SCALEPAGEXUNITS (CADR HDG) - SCALEFACTOR PAPERSIZE LANDSCAPE?) - (SCALEPAGEYUNITS (CADDR HDG) - SCALEFACTOR PAPERSIZE LANDSCAPE?] - (SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT) - LEFT)) - (COND - [PAGE#S? (SELECTQ PQUAD - (LEFT (* ; + (SETQ SCALEFACTOR (CONSTANT (FQUOTIENT 72 2.54)))) + (\ILLEGAL.ARG UNITS)) (* ; "We need to do the scaling.") + (SETQ PX (SCALEPAGEXUNITS PX SCALEFACTOR PAPERSIZE LANDSCAPE?)) + (SETQ PY (SCALEPAGEYUNITS PY SCALEFACTOR PAPERSIZE LANDSCAPE?)) + (AND LEFT (SETQ LEFT (HCSCALE SCALEFACTOR LEFT))) + (AND RIGHT (SETQ RIGHT (HCSCALE SCALEFACTOR RIGHT))) + (AND TOP (SETQ TOP (HCSCALE SCALEFACTOR TOP))) + (AND BOTTOM (SETQ BOTTOM (HCSCALE SCALEFACTOR BOTTOM))) + (AND COLWIDTH (SETQ COLWIDTH (HCSCALE SCALEFACTOR COLWIDTH))) + (AND INTERCOL (SETQ INTERCOL (HCSCALE SCALEFACTOR INTERCOL))) + (SETQ PAGEWIDTH (IDIFFERENCE (IDIFFERENCE PAPERWIDTH RIGHT) + LEFT)) + (CL:WHEN PAGE#S? + (SELECTQ PQUAD + (LEFT (* ;  "If the page number is flush left, set up the region to start where he specified.") - (SETQ FOLIOLEFT PX)) - (RIGHT (* ; + (SETQ FOLIOLEFT PX)) + (RIGHT (* ;  "If it's flush right, set up the region to END there") - (SETQ FOLIOLEFT (IDIFFERENCE PX 288))) - ((CENTERED NIL) (* ; + (SETQ FOLIOLEFT (IDIFFERENCE PX 288))) + ((CENTERED NIL) (* ;  "Otherwise, center the page number around the point he specifies") - (SETQ FOLIOLEFT (IDIFFERENCE PX 144))) - (SHOULDNT)) - [SETQ SUBREGIONS - (LIST (SETQ FOLIO - (create PAGEREGION - REGIONFILLMETHOD _ 'FOLIO - REGIONSPEC _ - (create REGION - LEFT _ FOLIOLEFT - BOTTOM _ PY - WIDTH _ 288 - HEIGHT _ 36] - (replace REGIONLOCALINFO of FOLIO with (LIST 'PARALOOKS - (LIST 'QUAD (OR PQUAD 'CENTERED)) - 'CHARLOOKS - (\TEDIT.UNPARSE.CHARLOOKS.LIST - (\TEDIT.PARSE.CHARLOOKS.LIST - PFONT TEDIT.DEFAULT.FOLIO.LOOKS)) - 'FORMATINFO - (LISTGET PAGEPROPS 'FOLIOINFO] - (T (SETQ SUBREGIONS NIL))) - [COND - (HEADINGS (* ; - "There are page headings specified for this page.") - [SETQ HEADINGREGIONS (for HEADING in HEADINGS - collect + (SETQ FOLIOLEFT (IDIFFERENCE PX 144))) + (SHOULDNT)) + + (* ;; "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 ( + \TEDIT.PARSE.CHARLOOKS.LIST + PFONT + TEDIT.DEFAULT.FOLIO.LOOKS + )) + FORMATINFO + ,(LISTGET PAGEPROPS 'FOLIOINFO]) + (CL:WHEN HEADINGS + [SETQ HEADINGREGIONS (for HDG LEFT in HEADINGS + collect (* ;; "Run thru the list of headings, building a box for each. By default, a heading will have the same width right margin as the left margin that was specified.") - (create PAGEREGION - REGIONFILLMETHOD _ 'HEADING - REGIONSPEC _ - (create REGION - LEFT _ (CADR HEADING) - BOTTOM _ (CADDR HEADING) - WIDTH _ (IMAX (IDIFFERENCE - PAPERWIDTH - (CADR HEADING)) - 72) - HEIGHT _ 36) - REGIONLOCALINFO _ (LIST 'HEADINGTYPE - (CAR HEADING] - (SETQ SUBREGIONS (APPEND SUBREGIONS HEADINGREGIONS] - [COND - [(OR (NULL COLS) - (IEQP COLS 1)) (* ; + (SETQ LEFT (SCALEPAGEXUNITS (CADR HDG) + SCALEFACTOR PAPERSIZE LANDSCAPE?)) + (create PAGEREGION + REGIONFILLMETHOD _ 'HEADING + REGIONSPEC _ (create REGION + LEFT _ LEFT + BOTTOM _ (SCALEPAGEYUNITS + (CADDR HDG) + SCALEFACTOR + PAPERSIZE LANDSCAPE? + ) + WIDTH _ + (IMAX (IDIFFERENCE PAPERWIDTH + LEFT) + 72) + HEIGHT _ 36) + REGIONLOCALINFO _ (LIST 'HEADINGTYPE (CAR HDG] + (SETQ SUBREGIONS (APPEND SUBREGIONS HEADINGREGIONS))) + [COND + [(OR (NULL COLS) + (IEQP COLS 1)) (* ;  "There is a single column, so treat it as just one text region bounded by the page margins.") - (SETQ SUBREGIONS - (NCONC1 SUBREGIONS - (create PAGEREGION - REGIONFILLMETHOD _ 'TEXT - REGIONSPEC _ - (create REGION - LEFT _ LEFT - BOTTOM _ BOTTOM - WIDTH _ PAGEWIDTH - HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) - BOTTOM] - (T (* ; + (SETQ SUBREGIONS + (NCONC1 SUBREGIONS + (create PAGEREGION + REGIONFILLMETHOD _ 'TEXT + REGIONSPEC _ + (create REGION + LEFT _ LEFT + BOTTOM _ BOTTOM + WIDTH _ PAGEWIDTH + HEIGHT _ (IDIFFERENCE (IDIFFERENCE PAPERHEIGHT TOP) + BOTTOM] + (T (* ;  "There are several columns. We need to create a text box for each col.") - [COND - [(NULL COLWIDTH) (* ; + [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"] - ((NULL INTERCOL) (* ; + (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"] + ((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] - (replace REGIONSUBBOXES of PAGEREGION with SUBREGIONS) - (RETURN PAGEREGION]) + (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] + (replace REGIONSUBBOXES of PAGEREGION with SUBREGIONS) + PAGEREGION]) (TEDIT.COMPOUND.PAGEFORMAT - [LAMBDA (FIRST VERSO RECTO) (* jds "27-Jul-84 10:15") + [LAMBDA (FIRST VERSO RECTO) (* ; "Edited 20-Jan-2024 12:07 by rmk") + (* ; "Edited 16-Jan-2024 14:24 by rmk") + (* jds "27-Jul-84 10:15") + + (* ;; "This creates a 2-element SEQUENCE pageformat consisting of FIRST followed by an ALTERNATE pageformat containing VERSO and RECTO") + + (CL:UNLESS VERSO (SETQ VERSO FIRST)) + (CL:UNLESS RECTO (SETQ RECTO VERSO)) (create PAGEREGION REGIONFILLMETHOD _ 'SEQUENCE REGIONSUBBOXES _ (LIST FIRST (create PAGEREGION REGIONFILLMETHOD _ 'ALTERNATE - REGIONSUBBOXES _ (LIST (OR VERSO FIRST) - (OR RECTO VERSO FIRST)) + REGIONSUBBOXES _ (LIST VERSO RECTO) REGIONSPEC _ (LIST 0 0 0 0))) REGIONSPEC _ (LIST 0 0 0 0]) (TEDIT.PAGEFORMAT - [LAMBDA (STREAM FORMAT) (* ; "Edited 12-Jun-90 19:13 by mitani") + [LAMBDA (STREAM FORMAT PAGETYPE) (* ; "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") + (* ;; "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.") - (PROG ((TEXTOBJ (TEXTOBJ STREAM))) - (COND - ((AND (type? PAGEREGION FORMAT) - (EQ 'PAGE (fetch (PAGEREGION REGIONFILLMETHOD) of FORMAT))) - (* ; - "This is a single page format. Make it a compound for ALL the pages.") - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (LIST FORMAT FORMAT FORMAT)) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) - ([OR (type? PAGEREGION FORMAT) - (AND (LISTP FORMAT) - (type? PAGEREGION (CAR FORMAT] + (* ;; "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.") - (* ;; "It's in one of the two forms acceptable to the page formatter--either a real tree of layout info, or a list of first/left/right infos") + (* ;; "FORMAT can also be another text, in which case its formats are take as FORMAT--essentially the copy case.") - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) - ((LISTP FORMAT) (* ; - "It's likely to be a list acceptable to the parser. Try it that way.") - (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with FORMAT) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T)) - (T (\ILLEGAL.ARG FORMAT]) + (* ;; + "Note that PAGETYPE and the TEXT-format case are extensions, not in the original documentation.") + + (LET* ((TEXTOBJ (TEXTOBJ STREAM)) + (OLDFORMAT (GETTOBJ TEXTOBJ TXTPAGEFRAMES)) + SUBBOXES) + (CL:WHEN (TEXTOBJ FORMAT T) + (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 (* ; + "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)) + + (* ;; "FORMAT is now a triple of new components.") + + (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))) + + (* ;; "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.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ :PageFormat + THOLDINFO _ OLDFORMAT)) + (SETTOBJ TEXTOBJ TXTPAGEFRAMES FORMAT) + (SETTOBJ TEXTOBJ \DIRTY T) + STREAM]) ) @@ -395,24 +558,32 @@ (DEFINEQ (TEDIT.FORMAT.HARDCOPY - [LAMBDA (STREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG ENDPG) + [LAMBDA (TEXTSTREAM FILE DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS IMAGETYPE FIRSTPG# STARTPG + ENDPG) (* ; "Edited 7-Mar-2024 09:55 by rmk") + (* ; "Edited 19-Jan-2024 23:39 by rmk") + (* ; "Edited 24-Dec-2023 14:10 by rmk") + (* ; "Edited 15-Nov-2023 23:56 by rmk") + (* ; "Edited 22-Sep-2023 20:38 by rmk") + (* ; "Edited 4-Jul-2023 11:16 by rmk") + (* ; "Edited 2-Oct-2022 00:00 by rmk") (* ;  "Edited 25-May-93 13:06 by sybalsky:mv:envos") -(* ;;; "Format a document for hardcopy") + (* ;; "Format a document for hardcopy. Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.") -(* ;;; "Returns the number of pages printed (not the final page number!). Returns NIL if the before-print-fn said not to print.") - - (* ;; "You want both TEXTOBJ and TEXTSTREAM here so that it hangs onto them even if the window goes away out from under it. DON'T REMOVE THEM!!!!") + (* ;; "TEXTSTREAM is either already a textstream or somehow denotes a tedit-formatted file, otherwise an error. We don't here try to decide that a non-formatted file is a plain text file, as opposed binary or anything else.") (RESETLST - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - (TEXTSTREAM (TEXTSTREAM STREAM)) - (FORCENEXTPAGE NIL) + (SETQ TEXTSTREAM (if (TEXTSTREAM TEXTSTREAM T) + elseif (TEDIT.FORMATTEDFILEP TEXTSTREAM) + then (CL:UNLESS (\GETSTREAM TEXTSTREAM 'INPUT T) + [RESETSAVE (SETQ TEXTSTREAM (OPENSTREAM TEXTSTREAM 'INPUT)) + `(PROGN (CLOSEF? OLDVALUE]) + (OPENTEXTSTREAM TEXTSTREAM) + else (ERROR TEXTSTREAM "is not a Tedit stream"))) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXTSTREAM)) [FORMATTINGSTATE (create PAGEFORMATTINGSTATE - PAGE# _ (COND - ((NUMBERP FIRSTPG#)) - (T NIL)) + PAGE# _ (FIXP FIRSTPG#) FIRSTPAGE _ T STATE _ FIRSTPG# MINPAGE# _ STARTPG @@ -423,49 +594,41 @@ (CDR FIRSTPG#)) PAGE#TEXT _ (AND (LISTP FIRSTPG#) (CAR FIRSTPG#] - TEXTLEN THISLINE LINE REGION LINES NCHNO PRSTREAM PAGEFRAMES SCRATCHFILE WASOPEN - BEFOREFN AFTERFN) - (SETQ PAGEFRAMES (OR (fetch (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ) + PRSTREAM PAGEFRAMES SCRATCHFILE BEFOREFN AFTERFN NPAGES WASOPEN TARGETFILENAME) + (CL:WHEN (AND (SETQ BEFOREFN (GETTEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)) + (EQ 'DON'T (APPLY* BEFOREFN TEXTSTREAM TEXTOBJ))) + (* ; + "Do pre-hardcopy processing as indicated, or refuse") + (RETURN)) + (SETQ PAGEFRAMES (OR (FGETTOBJ TEXTOBJ TXTPAGEFRAMES) TEDIT.PAGE.FRAMES)) - [COND - ((LISTP PAGEFRAMES) (* ; + (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] - (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (replace PRESSREGION of FORMATTINGSTATE with TEDIT.DEFAULTPAGEREGION) + (CADDR PAGEFRAMES)))) + (SETPFS FORMATTINGSTATE PRESSREGION TEDIT.DEFAULTPAGEREGION) (* ;  "Print in the usual region on the page") - [SETQ BREAKPAGETITLE (COND - (BREAKPAGETITLE) - ((LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) - ([OR (NOT (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (type? STRINGP (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (type? STREAM (fetch (STREAM FULLNAME) - of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ))) - (type? STRINGP (fetch (STREAM FULLNAME) - of (fetch (TEXTOBJ TXTFILE) of TEXTOBJ] + (CL:UNLESS BREAKPAGETITLE + [SETQ BREAKPAGETITLE (COND + ((LISTGET PRINTOPTIONS 'DOCUMENT.NAME)) + ([OR (NOT (FGETTOBJ TEXTOBJ TXTFILE)) + (STRINGP (FGETTOBJ TEXTOBJ TXTFILE)) + (type? STREAM (fetch (STREAM FULLNAME) + of (FGETTOBJ TEXTOBJ TXTFILE))) + (STRINGP (fetch (STREAM FULLNAME) + of (FGETTOBJ TEXTOBJ TXTFILE] (* ;  "This isn't a real file, so print a generic name on the document break page.") - "TEdit Hardcopy Output") - (T (* ; + "TEdit Hardcopy Output") + (T (* ;  "It's a real file, so use the file name on the break page.") - (fetch (STREAM FULLNAME) of (fetch (TEXTOBJ TXTFILE) - of TEXTOBJ] - (SETQ BEFOREFN (TEXTPROP TEXTOBJ 'BEFOREHARDCOPYFN)) - [COND - (BEFOREFN (* ; - "Let the guy do any pre-hardcopy processing he wants to do") - (COND - ((EQ 'DON'T (APPLY* BEFOREFN TEXTSTREAM TEXTOBJ)) - (* ; - "If it says not to do the hardcopy, then don't.") - (RETURN] - [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM STREAM] + (fetch (STREAM FULLNAME) of (FGETTOBJ TEXTOBJ TXTFILE]) + [SETQ SCRATCHFILE (OR FILE (PRINTER.SCRATCH.FILE (TEXTSTREAM TEXTSTREAM] (RESETLST - (SETQ AFTERFN (TEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)) - (AND AFTERFN (RESETSAVE NIL (LIST AFTERFN TEXTSTREAM TEXTOBJ))) + (CL:WHEN (SETQ AFTERFN (GETTEXTPROP TEXTOBJ 'AFTERHARDCOPYFN)) + (RESETSAVE NIL (LIST AFTERFN TEXTSTREAM TEXTOBJ))) (* ;  "Set up to do the user's cleanup on the way out, as well.") (TEDIT.PROMPTPRINT TEXTOBJ "Formatting for print..." T) @@ -483,325 +646,282 @@ (CAR (PRINTERPROP (PRINTERTYPE SERVER) 'CANPRINT] - (LIST 'FONT (FONTCREATE 'GACHA 10) + (LIST 'FONT (FONTCREATE 'TERMINAL 10) 'BREAKPAGEFILENAME BREAKPAGETITLE))) '(AND RESETSTATE (DELFILE (CLOSEF? OLDVALUE] (* ;  "So we close and delete the file in case of trouble.") - (STREAMPROP PRSTREAM 'FORMATTINGSTATE FORMATTINGSTATE) - (* ; - "So that subsidiary people can find out the state of the formatting.") - (* ;; "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). Thiss will cause a performance hit. Sigh. JDS 9/5/89") + (* ;; "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 (fetch CHNO of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + [while (ILEQ (GETPFS FORMATTINGSTATE CHNO) + (FGETTOBJ TEXTOBJ TEXTLEN)) do - (* ;; "Must use (fetch TEXTLEN...) so that NS characters in an unformatted doc don't cause infinite loops.") - (* ;; "Format pages according to the existing layout:") - (for REGION inside PAGEFRAMES do (TEDIT.FORMATBOX TEXTOBJ PRSTREAM - (fetch CHNO of FORMATTINGSTATE) - REGION FORMATTINGSTATE IMAGETYPE)) - (COND - ((EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT) + (for PAGEREGION inside PAGEFRAMES do (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 (fetch (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of - FORMATTINGSTATE - )) + (SETQ PAGEFRAMES (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.)") - (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE - with (SUB1 (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) - ) - (replace (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE with 0) - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with - :SEARCHING-FOR-EQUIVALENT-PAGE - ) - (COND - ((LISTP PAGEFRAMES) (* ; + (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] - [COND - ((NOT WASOPEN) (* ; + (CADDR PAGEFRAMES)))))] + (SETQ TARGETFILENAME (STREAMPROP PRSTREAM 'PDFTARGETINFO)) + (CL:UNLESS WASOPEN (* ;  "Only if we created the image stream should we close it.") (SETQ PRSTREAM (CLOSEF PRSTREAM)) - (OR DONTSEND (SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS - (LIST 'DOCUMENT.NAME - BREAKPAGETITLE] - (OR FILE (DELFILE SCRATCHFILE))) - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (MKSTRING (fetch (PAGEFORMATTINGSTATE PAGECOUNT) - of FORMATTINGSTATE)) - "pg done.")) - (RETURN (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE))))]) + (CL:UNLESS DONTSEND + (SEND.FILE.TO.PRINTER PRSTREAM SERVER (APPEND PRINTOPTIONS + (LIST 'DOCUMENT.NAME + BREAKPAGETITLE))))) + (CL:UNLESS FILE (DELFILE SCRATCHFILE))) + (SETQ NPAGES (GETPFS FORMATTINGSTATE PAGECOUNT)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT NPAGES " page" (CL:IF (EQ 1 NPAGES) + "" + "s") + " printed" + (CL:IF (EQ FILE SCRATCHFILE) + (CONCAT " to " (OR TARGETFILENAME (FULLNAME + FILE))) + "")) + T) + (RETURN NPAGES)))]) (TEDIT.FORMATBOX - [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE SERVERTYPE) + [LAMBDA (TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE) + (* ; "Edited 20-Jan-2024 12:16 by rmk") + (* ; "Edited 28-Jun-2023 15:54 by rmk") + (* ; "Edited 22-Jun-2023 21:50 by rmk") + (* ; "Edited 9-May-2023 18:22 by rmk") + (* ; "Edited 15-Feb-2023 23:47 by rmk") (* ; "Edited 30-May-91 12:51 by jds") - (* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") + (* ;; "Grab text from the TEXTOBJ, starting with STARTINGCHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") - (PROG ((REGIONSPEC (fetch (PAGEREGION REGIONSPEC) of REGION)) - CHNO NCHNO LINES LAST-CHNO SUBREGIONSPEC) - (SETQ LINES NIL) - (SELECTQ (fetch REGIONFILLMETHOD of REGION) - (TEXT (* ; + (* ;; "This updates the CHNO field of the PAGEFORMATTINGSTATE") + + (LET ((REGION (fetch (PAGEREGION REGIONSPEC) of PAGEREGION)) + CHNO LINES LAST-CHNO SUBREGIONSPEC (TEXTLEN (FGETTOBJ TEXTOBJ TEXTLEN))) + (SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION) + (TEXT (* ;  "A normal text region. Fill it with text formatted the usual way.") - [COND - ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) + (CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") - (CL:MULTIPLE-VALUE-SETQ (LINES NIL LAST-CHNO) - (TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE]) - (FOLIO (* ; + (TEDIT.SETQS (LINES NIL LAST-CHNO) + (TEDIT.FORMATTEXTBOX TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION + FORMATTINGSTATE)))) + (FOLIO (* ;  "A Page Number. Fill it in according to the instructions") - [COND - ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) + (CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") - (SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE REGION]) - (HEADING (* ; + (SETQ LINES (TEDIT.FORMATFOLIO TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION)))) + (HEADING (* ;  "A Page heading. Fill it in from a text source we saved for the occasion.") - [COND - ((\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) + (CL:WHEN (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE) (* ;  "Only format if we're not looking for something else.") - (SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE REGION]) - (PAGE - (* ;; "This box is really a PAGE FRAME. Fill it in and do whatever other processing is needful for end of page.") + (SETQ LINES (TEDIT.FORMATHEADING TEXTOBJ PRSTREAM FORMATTINGSTATE + PAGEREGION)))) + (PAGE + (* ;; "This box is really a PAGE FRAME, no lines here. Fill it in and do whatever other processing is needful for end of page.") - (SETQ LINES NIL) (* ; - "This will send along its own lines to the printer.") - (\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) + (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE) (* ;  "So that if this is the box he's looking for, we'll spot it and stop searching") - (TEDIT.FORMATPAGE TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE)) - ((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT) + (TEDIT.FORMATPAGE TEXTOBJ PRSTREAM STARTINGCHNO PAGEREGION FORMATTINGSTATE)) + ((RECURSIVE SEQUENCE ALTERNATE SELECTION REPEAT) (* ;  "This box is really a list of boxes. Fill them.") - (\TEDIT.FORMAT.FOUNDBOX? REGION FORMATTINGSTATE) + (\TEDIT.FORMAT.FOUNDBOX? PAGEREGION FORMATTINGSTATE) (* ;  "So that if this is the box he's looking for, we'll spot it and stop searching") - (SELECTQ (fetch REGIONFILLMETHOD of REGION) - ((SEQUENCE RECURSIVE) (* ; + (SELECTQ (fetch REGIONFILLMETHOD of PAGEREGION) + ((SEQUENCE RECURSIVE) (* ;  "Just run thru filling in the sub-boxes in order.") - (bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) - of REGION) - while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (OR (NOT (fetch (PAGEFORMATTINGSTATE PAGE#) of - FORMATTINGSTATE - )) - (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of - FORMATTINGSTATE - )) - (ILEQ (fetch (PAGEFORMATTINGSTATE PAGE#) of - FORMATTINGSTATE - ) - (fetch (PAGEFORMATTINGSTATE MAXPAGE#) - of FORMATTINGSTATE))) - (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT)) - do [SETQ SUBREGIONSPEC (create REGION - using (fetch REGIONSPEC of SUBREGION) - LEFT _ - (IPLUS (fetch (REGION LEFT) - of (fetch REGIONSPEC - of SUBREGION)) - (fetch (REGION LEFT) - of REGIONSPEC)) - BOTTOM _ - (IPLUS (fetch (REGION BOTTOM) - of (fetch REGIONSPEC - of SUBREGION)) - (fetch (REGION BOTTOM) - of REGIONSPEC] - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch (PAGEFORMATTINGSTATE - CHNO) of FORMATTINGSTATE) - (create PAGEREGION using SUBREGION REGIONSPEC _ - SUBREGIONSPEC) - FORMATTINGSTATE))) - (ALTERNATE (* ; + (bind SUBREGIONSPEC for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) + of PAGEREGION) + while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO) + TEXTLEN) + (OR (NOT (GETPFS FORMATTINGSTATE PAGE#)) + (NOT (GETPFS FORMATTINGSTATE MAXPAGE#)) + (ILEQ (GETPFS FORMATTINGSTATE PAGE#) + (GETPFS FORMATTINGSTATE MAXPAGE#))) + (NEQ (GETPFS FORMATTINGSTATE STATE) + :NEW-PAGE-LAYOUT)) + do [SETQ SUBREGIONSPEC (create REGION + using (fetch REGIONSPEC of SUBREGION) + LEFT _ + (IPLUS (fetch (REGION LEFT) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION LEFT) + of REGION)) + BOTTOM _ + (IPLUS (fetch (REGION BOTTOM) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION BOTTOM) + of REGION] + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE CHNO) + (create PAGEREGION using SUBREGION REGIONSPEC _ SUBREGIONSPEC + ) + FORMATTINGSTATE))) + (ALTERNATE (* ;  "Run through the sub-boxes repeatedly in sequence.") - (while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of + (while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO) + TEXTLEN) + (NEQ :NEW-PAGE-LAYOUT (GETPFS FORMATTINGSTATE STATE))) + do (bind SUBREGIONSPEC for SUBREGION + in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) + while (AND (ILEQ (GETPFS FORMATTINGSTATE CHNO) + TEXTLEN) + (NEQ (GETPFS FORMATTINGSTATE STATE) + :NEW-PAGE-LAYOUT)) + do [SETQ SUBREGIONSPEC + (create REGION + using (fetch REGIONSPEC of SUBREGION) + LEFT _ (IPLUS (fetch (REGION LEFT) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION LEFT) + of REGION)) + BOTTOM _ (IPLUS (fetch (REGION BOTTOM) + of (fetch REGIONSPEC + of SUBREGION)) + (fetch (REGION BOTTOM) + of REGION] + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE - ) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NEQ (fetch (PAGEFORMATTINGSTATE STATE) of - FORMATTINGSTATE - ) - :NEW-PAGE-LAYOUT)) - do (bind SUBREGIONSPEC for SUBREGION - in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) - while (AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) - of FORMATTINGSTATE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NEQ (fetch (PAGEFORMATTINGSTATE STATE) - of FORMATTINGSTATE) - :NEW-PAGE-LAYOUT)) - do [SETQ SUBREGIONSPEC - (create REGION - using (fetch REGIONSPEC of SUBREGION) - LEFT _ (IPLUS (fetch (REGION LEFT) - of (fetch REGIONSPEC - of SUBREGION)) - (fetch (REGION LEFT) - of REGIONSPEC)) - BOTTOM _ (IPLUS (fetch (REGION BOTTOM) - of (fetch REGIONSPEC - of SUBREGION)) - (fetch (REGION BOTTOM) - of REGIONSPEC] - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch ( - PAGEFORMATTINGSTATE - CHNO) - of FORMATTINGSTATE - ) - (create PAGEREGION using SUBREGION REGIONSPEC _ - SUBREGIONSPEC) - FORMATTINGSTATE)))) - (SELECTION (* ; + CHNO) + (create PAGEREGION using SUBREGION REGIONSPEC _ + SUBREGIONSPEC) + FORMATTINGSTATE)))) + (SELECTION (* ;  "Do one or another box, depending on some criterion.")) - (SHOULDNT)) (* ; + (SHOULDNT)) (* ;  "For now, draw a box around it, too.") - ) - NIL) - (for LINE in LINES when LINE do (* ; + ) + NIL) + (for LINE in LINES when LINE do (* ;  "Run thru the lines displaying them all.") - (BLOCK) - (COND - ((OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) - of FORMATTINGSTATE)) - (IGEQ (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE) - (fetch (PAGEFORMATTINGSTATE MINPAGE#) - of FORMATTINGSTATE))) + (BLOCK) + (CL:WHEN (OR (NOT (GETPFS FORMATTINGSTATE MINPAGE#)) + (IGEQ (GETPFS FORMATTINGSTATE PAGE#) + (GETPFS FORMATTINGSTATE MINPAGE#))) (* ;  "We're beyond the min page number -- go ahead and print the line") - (\TEDIT.HARDCOPY.DISPLAYLINE (fetch (TEXTSTREAM TEXTOBJ - ) - of (fetch ( - LINEDESCRIPTOR - LTEXTOBJ) - of LINE)) - LINE - (fetch (LINEDESCRIPTOR CACHE) of LINE) - REGION PRSTREAM))) - [COND - ((EQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) - of (fetch (LINEDESCRIPTOR LTEXTOBJ) - of LINE))) + (\TEDIT.HARDCOPY.DISPLAYLINE (GETLD LINE LTEXTOBJ) + LINE + (SCALEREGION (DSPSCALE NIL PRSTREAM) + REGION) + PRSTREAM FORMATTINGSTATE)) + (CL:WHEN (EQ TEXTOBJ (GETLD LINE LTEXTOBJ)) - (* ;; + (* ;;  "This line refers back to the main text, so update the current-char pointer.") - (* ;; + (* ;;  "[NB that footnotes could cause the count to be non-monotonic; hence the IMAX.]") - (SETQ CHNO (IMAX (OR CHNO 0) - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE] - (push (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) - of FORMATTINGSTATE) - LINE) - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with NIL)) - (COND - (LAST-CHNO (* ; - "We got a definite last chno from FORMATTEXTBOX, so use it.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with LAST-CHNO)) - (CHNO (* ; + [SETQ CHNO (IMAX (OR CHNO 0) + (ADD1 (GETLD LINE LCHARLIM]) + (push (GETPFS FORMATTINGSTATE PAGELINECACHE) + LINE) + (SETLD LINE LTEXTOBJ NIL)) + (COND + (LAST-CHNO (* ; + "We got a definite last chno from FORMATTEXTBOX.") + (SETPFS FORMATTINGSTATE CHNO LAST-CHNO)) + (CHNO (* ;  "Otherwise, use the new char no if we computed one.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO]) + (SETPFS FORMATTINGSTATE CHNO CHNO]) (TEDIT.FORMATHEADING - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 31-Jan-2022 23:30 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 6-Mar-2024 13:09 by rmk") + (* ; "Edited 15-Feb-2024 22:02 by rmk") + (* ; "Edited 19-Jan-2024 23:20 by rmk") + (* ; "Edited 9-Sep-2023 22:17 by rmk") + (* ; "Edited 19-May-2023 21:15 by rmk") + (* ; "Edited 9-May-2023 20:30 by rmk") (* ; "Edited 9-Oct-90 13:24 by jds") - (* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") + (* ;; "Grab heading pieces from the FORMATTINGSTATE and use them to fill REGION on a page. Return a list of line descriptors which fill the region.") - (PROG ((CHNO 1) - [REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of PAGEREGION) - collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM) - VALUE] - (LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) - HEADINGSTREAM HEADINGTEXTOBJ PRECONDITIONS THISLINE LINE YBOT (FORCENEXTPAGE NIL) - LINES HEADING) - [COND - ((SETQ PRECONDITIONS (LISTGET LOCALINFO 'PRECONDITIONS)) - (* ; - "There are preconditions for this heading to appear. Check them.") - (COND - ((for FORM inside PRECONDITIONS thereis (NOT (EVAL FORM))) - (* ; - "One of the predicates returned NIL, so don't display this heading.") - (RETURN] - (COND - ([NOT (SETQ HEADING (LISTGET (fetch (PAGEFORMATTINGSTATE PAGEHEADINGS) of - FORMATTINGSTATE - ) - (LISTGET LOCALINFO 'HEADINGTYPE] - (* ; - "There's no text for this heading. Punt.") - (RETURN))) - [SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (SETQ HEADINGSTREAM - (OPENTEXTSTREAM - NIL NIL NIL NIL - (LIST 'PARALOOKS (fetch (PIECE - PPARALOOKS - ) - of (CAR HEADING] - (\TEDIT.INSERT.PIECES HEADINGTEXTOBJ 1 HEADING) - (for PC in HEADING do (add (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ) - (fetch (PIECE PLEN) of PC))) - (SETQ LINES (while (AND (ILESSP CHNO (fetch (TEXTOBJ TEXTLEN) of HEADINGTEXTOBJ)) - (NOT FORCENEXTPAGE)) - collect (SETQ THISLINE (create THISLINE)) - (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE HEADINGTEXTOBJ - (fetch (REGION WIDTH) of REGION) - CHNO THISLINE (SETQ LINE (create - LINEDESCRIPTOR - )) - PRSTREAM T)) - (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) - (* ; - "Mark this line as having cached print info.") - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with HEADINGSTREAM) - (* ; - "And remember the document it came from.") - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) - (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) - (* ; "Format the next possible line") - [COND - [YBOT (* ; - "We're into it; take account of this line's height") - (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (T (* ; - "Just starting out; find the line's position with respect to the top of the region to be filled.") - (SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) - (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (* ; "This line is good; use it.") - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (* ; - "Keep track of the next character...") - LINE)) - (RETURN LINES]) + (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) + (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))) + (LOCALINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) + HEADINGTEXTOBJ FORCENEXTPAGE HEADING) + (CL:WHEN [AND (for FORM inside (LISTGET LOCALINFO 'PRECONDITIONS) always (EVAL FORM)) + (SETQ HEADING (LISTGET (GETPFS FORMATTINGSTATE PAGEHEADINGS) + (LISTGET LOCALINFO 'HEADINGTYPE] + [SETQ HEADINGTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) + of (OPENTEXTSTREAM + NIL NIL NIL NIL + `(PARALOOKS ,(PPARALOOKS (fetch (SELPIECES SPFIRST) + of HEADING] + + (* ;; "Insert the heading pieces into HEADINGTEXTOBJ") + + (\INSERTPIECES (fetch (SELPIECES SPFIRST) of HEADING) + (\ALIGNEDPIECE 1 HEADINGTEXTOBJ) + HEADINGTEXTOBJ) + + (* ;; "") + + (* ;; "Why is BOTTOM said to be the %"top%" of the region to be filled?") + + (bind LINE YBOT (BOTTOM _ (fetch (REGION BOTTOM) of REGION)) + (LEN _ (TEXTLEN HEADINGTEXTOBJ)) + (CHNO _ 1) while (ILESSP CHNO LEN) until FORCENEXTPAGE + collect + + (* ;; "Format the next line from HEADINGTEXTOBJ pieces") + + (SETQ LINE (\FORMATLINE HEADINGTEXTOBJ CHNO NIL REGION PRSTREAM FORMATTINGSTATE + )) + (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM) + (GETLD LINE FORCED-END))) + [SETQ YBOT (COND + (YBOT (* ; + "Take account of this line's height") + (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") + LINE))]) (TEDIT.FORMATPAGE - [LAMBDA (TEXTOBJ PRSTREAM CH# REGION FORMATTINGSTATE) (* ; + [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:10 by rmk") + (* ; "Edited 11-Dec-2023 22:02 by rmk") + (* ; "Edited 13-Nov-2023 00:15 by rmk") + (* ; "Edited 22-Sep-2023 20:37 by rmk") + (* ; "Edited 15-Jul-2023 22:22 by rmk") + (* ; "Edited 5-Jul-2023 12:49 by rmk") + (* ; "Edited 8-Mar-2023 18:20 by rmk") + (* ; "Edited 4-Mar-2023 22:10 by rmk") + (* ; "Edited 9-Oct-2022 17:24 by rmk") + (* ;  "Edited 4-Jul-93 00:29 by sybalskY:MV:ENVOS") (* ;; "Format a whole page -- run thru the page's sub-boxes filling them in by type:") @@ -812,353 +932,289 @@ (* ;; " TEXT -- plain running text.") - [COND - ((NOT (EQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) - :SEARCHING-FOR-EQUIVALENT-PAGE)) + (CL:UNLESS (EQ :SEARCHING-FOR-EQUIVALENT-PAGE (GETPFS FORMATTINGSTATE STATE)) (* ;; "Only do real page formatting work if we're not trying to get ourselves to an equivalent page frame spec (having switched page layouts in mid-document).") - (PROG ((FORCENEXTPAGE NIL) - (CHNO CH#) - (PAGE# (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE)) - (PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of REGION)) - (PAGEREGION (\TEDIT.SCALEREGION (fetch (PAGEREGION REGIONSPEC) of REGION) - (DSPSCALE NIL PRSTREAM))) - (END-OF-PAGE-FN (TEXTPROP TEXTOBJ 'END-OF-PAGE-FN)) + [PROG ((PAGE# (GETPFS FORMATTINGSTATE PAGE#)) + (PAGEPROPS (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) + (REGION (\TEDIT.SCALEREGION (DSPSCALE NIL PRSTREAM) + (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))) + (END-OF-PAGE-FN (GETTEXTPROP TEXTOBJ 'END-OF-PAGE-FN)) (PRE-EXISTING-FONT (DSPFONT NIL PRSTREAM)) - TEXTLEN THISLINE LINE LINES NCHNO TPAGE END-OF-PAGE-MARKER STARTING-FILEPTR PC - NEWPARALOOKS) + (TEXTLEN (TEXTLEN TEXTOBJ)) + END-OF-PAGE-MARKER STARTING-FILEPTR PC NEWPARALOOKS) (* ;; "For real page independence, we need to reset the font to where it was as of the beginning of the page before calling DSPNEWPAGE. This avoids font creation in a page prolog, which might get missed otherwise.") - - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) (* ;  "Print in the usual region on the page") - (COND - ([AND (ILEQ CHNO TEXTLEN) - (EQ 'NEWPAGELAYOUT (fetch FMTPARATYPE - of (SETQ NEWPARALOOKS - (\TEDIT.APPLY.PARASTYLES - [fetch (PIECE PPARALOOKS) - of (SETQ PC (\CHTOPC CHNO (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - PC TEXTOBJ] + (CL:UNLESS (ILEQ CHNO TEXTLEN) + (RETURN)) + (SETQ PC (\ALIGNEDPIECE CHNO TEXTOBJ)) + (SETQ NEWPARALOOKS (\TEDIT.APPLY.PARASTYLES (PPARALOOKS PC) + PC TEXTOBJ)) (* ; + "RMK: Why both 'NEWPAGELAYOUT and :NEW-PAGE-LAYOUT ?") + (CL:WHEN (EQ 'NEWPAGELAYOUT (fetch (FMTSPEC FMTPARATYPE) of NEWPARALOOKS)) - (* ;; "The first paragraph on this page starts a new page layout.") + (* ;; "The first paragra ph on this page starts a new page layout.") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with :NEW-PAGE-LAYOUT) - [replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE - with (ADD1 (CDR (\TEDIT.PARABOUNDS TEXTOBJ CHNO] - [replace (PAGEFORMATTINGSTATE NEWPAGELAYOUT) of FORMATTINGSTATE - with (TEDIT.PARSE.PAGEFRAMES (LISTGET (fetch (FMTSPEC FMTUSERINFO) of - NEWPARALOOKS - ) - 'NEWPAGELAYOUT] - (RETURN))) - (COND - (PAGE# (* ; - "If we've already got a starting page number, don't set another one") - ) - ((SETQ TPAGE (LISTGET PAGEPROPS 'STARTINGPAGE#)) - (* ; - "If this page template specifies a starting page number, use it.") - (SETQ PAGE# TPAGE) - (replace (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE with TPAGE)) - (T (SETQ PAGE# 1) - (replace (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE with PAGE#))) - (COND - ((LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") - [COND - ((fetch (STREAM OTHERPROPS) of PRSTREAM) - (LISTPUT (fetch (STREAM OTHERPROPS) of PRSTREAM) - 'PRINTERMODE - 'LANDSCAPE)) - (T (NCONC (fetch (STREAM OTHERPROPS) of PRSTREAM) - (LIST 'PRINTERMODE 'LANDSCAPE](* ; - "Puts the info. into stream , IP creater may use") + (SETPFS FORMATTINGSTATE STATE :NEW-PAGE-LAYOUT) + + (* ;; "The first character of the paragraph after the one containing PC:") + + [SETPFS FORMATTINGSTATE CHNO (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ PC] + [SETPFS FORMATTINGSTATE NEWPAGELAYOUT (\TEDIT.PARSE.PAGEFRAMES + (LISTGET (fetch (FMTSPEC FMTUSERINFO) + of NEWPARALOOKS) + 'NEWPAGELAYOUT] + (RETURN)) + + (* ;; "") + + (CL:UNLESS PAGE# + + (* ;; "If this page template specifies a starting page number, use it.") + + (SETQ PAGE# (OR (LISTGET PAGEPROPS 'STARTINGPAGE#) + 1)) + (SETPFS FORMATTINGSTATE PAGE# PAGE#)) + (CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") + (STREAMPROP PRSTREAM 'PRINTERMODE 'LANDSCAPE) + (* ; "Put the info. into stream ") (DSPPUSHSTATE PRSTREAM) (DSPROTATE 90 PRSTREAM) - (DSPTRANSLATE 0 (- (ffetch (REGION HEIGHT) of PAGEREGION)) - PRSTREAM))) - [COND - (*TEDIT-PAGE-BREAKS* - - (* ;; "Only save the starting fileptr if we're making signatures, since we could be paginating to the screen as well.") - - (SETQ STARTING-FILEPTR (GETFILEPTR PRSTREAM] - (DSPCLIPPINGREGION PAGEREGION PRSTREAM) (* ; - "Set the clipping region to the whole sheet of paper.") - (DSPRIGHTMARGIN (fetch (REGION WIDTH) of PAGEREGION) + (DSPTRANSLATE 0 (IMINUS (ffetch (REGION HEIGHT) of REGION)) + PRSTREAM)) + (DSPCLIPPINGREGION REGION PRSTREAM) (* ; "Clip to the whole sheet.") + (DSPRIGHTMARGIN (fetch (REGION WIDTH) of REGION) PRSTREAM) - [while [AND (ILEQ CHNO TEXTLEN) - (EQ 'PAGEHEADING (fetch FMTPARATYPE - of (fetch (PIECE PPARALOOKS) - of (\CHTOPC CHNO (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - do (* ; - "Go thru any leading page heading paras on the page.") - (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ 1 CHNO THISLINE (SETQ LINE (create - LINEDESCRIPTOR - )) - PRSTREAM) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with CHNO) - (for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of REGION) - while (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) - TEXTLEN) do (* ; - "Now format the subregions of the page.") - (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (fetch ( - PAGEFORMATTINGSTATE - CHNO) of - FORMATTINGSTATE - ) + + (* ;; "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)) + + (* ;; "") + + (* ;; "We now fill up the next complete page. Afterwards, we either continue to the next page (DPSNEWPAGE) or finish up. TEDIT.FORMATBOX is responsible for setting up NEWPAGEBEFORFE and NEWPAGEAFTER") + + (SETPFS FORMATTINGSTATE CHNO CHNO with CHNO) + (for SUBREGION in (fetch (PAGEREGION REGIONSUBBOXES) of PAGEREGION) + while (ILEQ (GETPFS FORMATTINGSTATE CHNO) + TEXTLEN) do + (* ;; + "Now format the subregions of the page. The CHNO field may be updated by each call.") + + (TEDIT.FORMATBOX TEXTOBJ PRSTREAM (GETPFS FORMATTINGSTATE + CHNO) SUBREGION FORMATTINGSTATE)) + + (* ;; "") + (DSPFONT PRE-EXISTING-FONT PRSTREAM) - [COND - (*TEDIT-PAGE-BREAKS* (SHOW.IP PRSTREAM) - (SETQ *TEDIT-PAGE-BREAKS* (NCONC1 *TEDIT-PAGE-BREAKS* (CONS STARTING-FILEPTR - (GETFILEPTR - PRSTREAM] - (COND - ((LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") - (AND (fetch (STREAM OTHERPROPS) of PRSTREAM) - (LISTPUT (fetch (STREAM OTHERPROPS) of PRSTREAM) - 'PRINTERMODE NIL)) - (DSPTRANSLATE 0 (ffetch (REGION HEIGHT) of PAGEREGION) + (CL:WHEN (LISTGET PAGEPROPS 'LANDSCAPE?) (* ; "This is a landscape page.") + (STREAMPROP PRSTREAM 'PRINTERMODE NIL) + (DSPTRANSLATE 0 (ffetch (REGION HEIGHT) of REGION) PRSTREAM) (DSPROTATE 0 PRSTREAM) - (DSPPOPSTATE PRSTREAM))) + (DSPPOPSTATE PRSTREAM)) [COND - ([AND (ILEQ (fetch (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE) + ([AND (ILEQ (GETPFS FORMATTINGSTATE CHNO) TEXTLEN) - (OR (NOT END-OF-PAGE-FN) - (NEQ (SETQ END-OF-PAGE-MARKER (APPLY* END-OF-PAGE-FN TEXTOBJ - FORMATTINGSTATE)) - 'DON'T)) - (OR (NOT (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE)) - (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MINPAGE#) of FORMATTINGSTATE))) - (OR (NOT (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE)) - (ILESSP PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE] + [NOT (AND END-OF-PAGE-FN (EQ 'DON'T (SETQ END-OF-PAGE-MARKER + (APPLY* END-OF-PAGE-FN TEXTOBJ + FORMATTINGSTATE] + [NOT (AND (GETPFS FORMATTINGSTATE MINPAGE#) + (ILESSP PAGE# (GETPFS FORMATTINGSTATE MINPAGE#] + (NOT (AND (GETPFS FORMATTINGSTATE MAXPAGE#) + (IEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#] (* ; "There is more to print....") - (DSPNEWPAGE PRSTREAM) (* ; "Force the new page") - ) - ((AND (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE) - (IGEQ PAGE# (fetch (PAGEFORMATTINGSTATE MAXPAGE#) of FORMATTINGSTATE))) - (* ; - "We've run past the last page it wants formatted. Stop the world.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 TEXTLEN))) - ((EQ END-OF-PAGE-MARKER 'DON'T) (* ; - "The guy's e-o-page fn said stop. So stop.") - (replace (PAGEFORMATTINGSTATE CHNO) of FORMATTINGSTATE with (ADD1 TEXTLEN] - (add (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE) + (* ; "Force the new page") + (DSPNEWPAGE PRSTREAM)) + ((OR (AND (GETPFS FORMATTINGSTATE MAXPAGE#) + (IGEQ PAGE# (GETPFS FORMATTINGSTATE MAXPAGE#))) + (EQ END-OF-PAGE-MARKER 'DON'T)) (* ; + "We've run past the last page to be formatted. or were told to stop. .") + (SETPFS FORMATTINGSTATE CHNO (ADD1 TEXTLEN] + (add (GETPFS FORMATTINGSTATE PAGE#) 1) - (replace (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE with NIL) - (replace (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE - with (pop (fetch (PAGEFORMATTINGSTATE PAGE#GENERATOR) of FORMATTINGSTATE] + (SETPFS FORMATTINGSTATE FIRSTPAGE NIL) + (SETPFS FORMATTINGSTATE PAGE#TEXT (pop (GETPFS FORMATTINGSTATE PAGE#GENERATOR]) (* ;; "Some things happen regardless of whether we're searching or not: Need to count pages we pass over to find an equivalent page in the new layout:") - (add (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE) + (add (GETPFS FORMATTINGSTATE PAGECOUNT) 1]) (TEDIT.FORMATTEXTBOX - [LAMBDA (TEXTOBJ PRSTREAM CH# PAGEREGION FORMATTINGSTATE) (* ; + [LAMBDA (TEXTOBJ PRSTREAM CHNO PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:37 by rmk") + (* ; "Edited 4-Dec-2023 12:34 by rmk") + (* ; "Edited 4-Jul-2023 08:02 by rmk") + (* ; "Edited 2-Jul-2023 20:49 by rmk") + (* ; "Edited 1-Jun-2023 15:32 by rmk") + (* ; "Edited 27-May-2023 12:19 by rmk") + (* ; "Edited 30-Sep-2022 10:06 by rmk") + (* ; "Edited 24-Aug-2022 11:45 by rmk") + (* ;  "Edited 3-Jul-93 22:14 by sybalskY:MV:ENVOS") (* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") - (COND - ((NEQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) - 'SEARCHING) + (CL:UNLESS (EQ (GETPFS FORMATTINGSTATE STATE) + 'SEARCHING) (* ;; "Only format text if we're really formatting.") (LET* - ((CHNO CH#) - [REGION (for VALUE in (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION) - collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM) - VALUE] + ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) + (ffetch (PAGEREGION REGIONSPEC) of PAGEREGION))) (COLUMNBOTTOM (fetch (REGION BOTTOM) of REGION)) + (RTOP (fetch (REGION TOP) of REGION)) (FIRSTLINE T) - (BREAKAFTERLASTPARA NIL) - (STREAMSCALE (DSPSCALE NIL PRSTREAM)) - (FORCENEXTPAGE NIL) (FOOTNOTELINES (ffetch PAGEFOOTNOTELINES of FORMATTINGSTATE)) - (PAGEFOOTNOTES NIL) - COLUMN-YBASE PRIOR-COLUMN-YBOT THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT - FMTSPEC SPECIALYPOS NEWPAGETYPE FINAL-CHNO FOOTNOTE-REMNANTS KEPT-ONE-LINE) + FORCENEXTPAGE PAGEFOOTNOTES PRIOR-COLUMN-YBOT LINES ORPHAN FINAL-CHNO FOOTNOTE-REMNANTS) (* ;; "Account for lines carried over from prior columns:") - [while (AND (ILEQ COLUMNBOTTOM (fetch (REGION TOP) of REGION)) - (SETQ LINE (pop FOOTNOTELINES))) + (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") - (COND - ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) of LINE)) - (fetch (REGION TOP) of REGION)) (* ; - "If we ran out of room for footnotes, put this line back on the queue") - (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS IGNORE KEPT-ONE-LINE) + (* ;; "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) + + (* ;; "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)) - [COND - (KEPT-ONE-LINE (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (CL:WHEN KEPT-ONE-LINE + (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) (SETQ FOOTNOTELINES (APPEND FOOTNOTE-REMNANTS FOOTNOTELINES)) (RETURN)) - (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) - (add COLUMNBOTTOM (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (freplace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE with FOOTNOTELINES) + (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) + (add COLUMNBOTTOM (FGETLD LINE LHEIGHT))) + (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES FOOTNOTELINES) (* ; "Remember any remaining footnotes") [SETQ LINES - (while (AND (ILEQ CHNO (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NOT FORCENEXTPAGE)) - collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) of - FORMATTINGSTATE - )) - (create LINEDESCRIPTOR))) - (* ; - "Grab a line descriptor from the recycling list, or create a new one.") - (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - (create THISLINE))) (* ; - "And a recycled or new THISLINE cache for char widths &c") - (BLOCK) (* ; - "Allow other things to happen while we format....") - (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) - of REGION) - CHNO THISLINE LINE PRSTREAM)) + (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.") + + (SETQ LINE (pop (GETPFS FORMATTINGSTATE PAGELINECACHE))) (* ;  "Format the line, noting any form-feeds") - (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) - (* ; - "Mark this line as having cached print info.") - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ STREAMHINT) - of TEXTOBJ)) - (* ; - "And remember the document it came from.") + (SETQ LINE (\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 - ((fetch (LINEDESCRIPTOR LMARK) of LINE) + ((FGETLD LINE LMARK) - (* ;; "This line is a placeholder for a page heading, OR for a conditional line that is to be skipped (e.g., and 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 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) LINE) - ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) + ((LISTGET (fetch (FMTSPEC FMTUSERINFO) of FMTSPEC) 'FOOTNOTE) (* ;; "This paragraph is a footnote para.") - (COND - (FORCENEXTPAGE (HELP))) + (CL:WHEN FORCENEXTPAGE (* ; + "HELP in original code. SHOULDNT ?") + (SHOULDNT)) (SETQ FOOTNOTELINES (\TEDIT.FORMAT.FOOTNOTE TEXTOBJ PRSTREAM LINE REGION - PAGEREGION FORMATTINGSTATE)) - [SETQ CHNO (PLUS 1 (fetch (LINEDESCRIPTOR CHARLIM) of (CAR (FLAST - FOOTNOTELINES - ] - (* ; "Grab the lines of this footnote") + FORMATTINGSTATE)) + (SETQ CHNO (ADD1 (FGETLD (CAR (FLAST FOOTNOTELINES)) + LCHARLIM))) (* ; "Grab the lines of this footnote") [COND - [(fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE) + [(GETPFS FORMATTINGSTATE PAGEFOOTNOTELINES) (* ;;  "There are overflow footnote lines from this page already. Add to them.") - (replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of FORMATTINGSTATE - with (COPY (APPEND (fetch (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) - of FORMATTINGSTATE) - FOOTNOTELINES] + (SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES (COPY (APPEND (GETPFS + FORMATTINGSTATE + + PAGEFOOTNOTELINES + ) + FOOTNOTELINES] (T (* ;;  "No overflow footnote lines yet. Try adding more footnotes to this page/column.") - (for LINE in FOOTNOTELINES as REST on FOOTNOTELINES - do (COND - ((IGREATERP (+ COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE)) - (OR YBOT (fetch (REGION TOP) of REGION))) - (CL:MULTIPLE-VALUE-SETQ (PAGEFOOTNOTES FOOTNOTE-REMNANTS - IGNORE) + (for LTAIL LINE on FOOTNOTELINES + do (SETQ LINE (CAR LTAIL)) + (add COLUMNBOTTOM LHEIGHT) + (CL:WHEN (IGREATERP COLUMNBOTTOM (OR YBOT RTOP)) + + (* ;; "This one overflows") + + (TEDIT.SETQS (PAGEFOOTNOTES FOOTNOTE-REMNANTS) (TEDIT.HARDCOPY-COLUMN-END PAGEFOOTNOTES LINE NIL 1 NIL REGION TEXTOBJ FORMATTINGSTATE 3 (NOT FIRSTLINE) )) - [replace (PAGEFORMATTINGSTATE PAGEFOOTNOTELINES) of - FORMATTINGSTATE - with (COPY (APPEND FOOTNOTE-REMNANTS (CDR REST] - [SETQ FINAL-CHNO (IMAX CHNO (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of (CAR (FLAST REST] - [COND - (FIRSTLINE (* ; "If this overflowing footnote line happens before any real text line, go ahead and update the colbottom, because we want to stop here anyhow.") - (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] + [SETPFS FORMATTINGSTATE PAGEFOOTNOTELINES + (COPY (APPEND FOOTNOTE-REMNANTS (CDR LTAIL] + [SETQ FINAL-CHNO (IMAX CHNO (ADD1 (GETLD (CAR (FLAST LTAIL)) + LCHARLIM] (RETURN)) - (T (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE)) - (add COLUMNBOTTOM (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] + (SETQ PAGEFOOTNOTES (NCONC1 PAGEFOOTNOTES LINE] + + (* ;; "Don't accumulate footnote lines.") + NIL) - (T (* ; - "This line must not represent a special item, e.g. a page heading. If it does, ignore it.") - (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) - (fetch (REGION LEFT) of REGION))) - (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (OR (AND (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) - (fetch (FMTSPEC FMTSPECIALX) of FMTSPEC)) - (fetch (REGION LEFT) of REGION))) - (* ; "Format the next possible line") + (T + (* ;; "This line is not a page heading or a footnote, format it.") + (SETQ SPECIALYPOS NIL) (* ;; "So that only the first line of a specially-placed paragraph is guaranteed to appear in the current box.") - [COND - [(AND (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) - (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) - (fetch (LINEDESCRIPTOR 1STLN) of LINE)) + [SETQ YBOT (COND + ((AND (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC) + (NOT (ZEROP (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) + (FGETLD LINE 1STLN)) (* ;  "There is a special Y location for this paragraph. Move there") - (SETQ SPECIALYPOS (SETQ YBOT (fetch (FMTSPEC FMTSPECIALY) of FMTSPEC] - [(AND COLUMN-YBASE (\NEW-COLUMN-START LINE FMTSPEC)) + (SETQ SPECIALYPOS (ffetch (FMTSPEC FMTSPECIALY) of FMTSPEC))) + ((AND COLUMN-YBASE (FGETLD LINE 1STLN) + (EQ (ffetch (FMTSPEC FMTCOLUMN) OF FMTSPEC) + 'NEXT)) - (* ;; + (* ;;  "This is the first line of a new column; back YBOT back down to match the prior column.") - (SETQ YBOT (- COLUMN-YBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] - [YBOT (* ; - "We're into it; take account of this line's height") - (COND - [(fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - (SETQ LHEIGHT - (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC) - (COND - ((fetch (LINEDESCRIPTOR 1STLN) of LINE) - (IPLUS (OR (fetch (FMTSPEC LEADBEFORE) of FMTSPEC) - 0) - (OR (fetch (FMTSPEC LEADAFTER) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of PREVLINE)) - 0))) - (T 0] - (T (COND - [(\FIRST-COLUMN-START LINE FMTSPEC) - (SETQ YBOT (IDIFFERENCE (IMIN PRIOR-COLUMN-YBOT YBOT) - (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE] - (T (* ; + (- COLUMN-YBASE (FGETLD LINE DESCENT))) + [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 (* ;  "Just starting out; find the line's position with respect to the top of the region to be filled.") - (SETQ YBOT (IDIFFERENCE (fetch (REGION TOP) of REGION) - (IPLUS (fetch (LINEDESCRIPTOR LTRUEASCENT) - of LINE) - (fetch (LINEDESCRIPTOR DESCENT) of LINE] + (IDIFFERENCE RTOP (IPLUS (FGETLD LINE LTRUEASCENT) + (FGETLD LINE DESCENT] (COND ((AND (ILESSP YBOT COLUMNBOTTOM) (NOT SPECIALYPOS)) @@ -1166,54 +1222,43 @@ (* ;; "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 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) (SETQ ORPHAN LINE) (* ; "Remember this potential orphan") NIL) ((AND (NOT FIRSTLINE) - (fetch (LINEDESCRIPTOR 1STLN) of LINE) + (FGETLD LINE 1STLN) (SETQ NEWPAGETYPE (OR (fetch (FMTSPEC FMTNEWPAGEBEFORE) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) + of (FGETLD LINE LFMTSPEC)) 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 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) + (SETQ FINAL-CHNO (FGETLD LINE LCHAR1)) (SETQ ORPHAN NIL) - (COND - ((NEQ NEWPAGETYPE T) (* ; + (CL:UNLESS (EQ NEWPAGETYPE T) (* ;  "This isn't simply go to a new box; we need to set up the search for it.") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE - with 'SEARCHING) - (replace (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE - with NEWPAGETYPE))) + (SETPFS FORMATTINGSTATE STATE 'SEARCHING) + (SETPFS FORMATTINGSTATE REQUIREDREGIONTYPE NEWPAGETYPE)) NIL) (T (* ; "This line is good; use it.") - (COND - ((AND (fetch (FMTSPEC FMTNEWPAGEAFTER) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) + (CL:WHEN (AND (fetch (FMTSPEC FMTNEWPAGEAFTER) of FMTSPEC)) (* ;  "We're supposed to put the line after this one at the start of a new page/column (any box, later)") - (SETQ BREAKAFTERLASTPARA T))) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (COND - (PRIOR-COLUMN-YBOT (SETQ PRIOR-COLUMN-YBOT (IMIN PRIOR-COLUMN-YBOT - YBOT))) - (T (SETQ PRIOR-COLUMN-YBOT YBOT))) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - [COND - ((\FIRST-COLUMN-START LINE FMTSPEC) + (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) (* ;; "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 (fetch (LINEDESCRIPTOR YBASE) of LINE] + (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 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (SETQ CHNO (ADD1 (GETLD LINE LCHARLIM))) (* ;  "Keep track of the next character...") (SETQ PREVLINE LINE) @@ -1221,166 +1266,128 @@ (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]) + FORMATTINGSTATE FINAL-CHNO)))]) (TEDIT.FORMATFOLIO - [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE REGIONSPEC) (* ; "Edited 31-Jan-2022 23:33 by rmk") + [LAMBDA (TEXTOBJ PRSTREAM FORMATTINGSTATE PAGEREGION) (* ; "Edited 19-Jan-2024 23:28 by rmk") + (* ; "Edited 18-Jan-2024 17:04 by rmk") + (* ; "Edited 13-Nov-2023 00:24 by rmk") + (* ; "Edited 1-Jun-2023 00:12 by rmk") + (* ; "Edited 9-May-2023 21:39 by rmk") (* ; "Edited 30-May-91 12:51 by jds") (* ;; "Print a page number (called a %"folio%" in the biz) at the location and with the alignment specified in the REGIONSPEC.") - (PROG ([REGION (for VALUE in (fetch (PAGEREGION REGIONSPEC) of REGIONSPEC) - collect (FIXR (FTIMES (DSPSCALE NIL PRSTREAM) - VALUE] - (FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of REGIONSPEC)) - (FORCENEXTPAGE NIL) - (CHNO 1) - FOLIOTEXTOBJ FOLIOSTREAM THISLINE LINE YBOT PARALOOKS CHARLOOKS NOFIRSTPAGE PAGE# - FOLIOFORMAT PRETEXT POSTTEXT INFOLIST) - (SETQ PARALOOKS (LISTGET FOLIOINFO 'PARALOOKS)) - (SETQ CHARLOOKS (OR (LISTGET FOLIOINFO 'CHARLOOKS) - TEDIT.DEFAULT.FOLIO.LOOKS)) - (SETQ NOFIRSTPAGE (LISTGET FOLIOINFO 'NOFIRSTPAGE)) - (SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO)) (* ; - "A LIST OF (FORMAT PRETEXT POSTTEXT)") - (SETQ FOLIOFORMAT (CAR INFOLIST)) - (SETQ PRETEXT (CADR INFOLIST)) - (SETQ POSTTEXT (CADDR INFOLIST)) - [SETQ PAGE# (COND - ((fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE) - (MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#TEXT) of FORMATTINGSTATE))) - (T (SELECTQ FOLIOFORMAT - (LOWERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE))) - (UPPERROMAN (ROMANNUMERALS (fetch (PAGEFORMATTINGSTATE PAGE#) - of FORMATTINGSTATE) - T)) - (MKSTRING (fetch (PAGEFORMATTINGSTATE PAGE#) of FORMATTINGSTATE] - [COND - (PRETEXT (SETQ PAGE# (CONCAT PRETEXT PAGE#] - [COND - (POSTTEXT (SETQ PAGE# (CONCAT PAGE# POSTTEXT] - [SETQ FOLIOTEXTOBJ (TEXTOBJ (SETQ FOLIOSTREAM (OPENTEXTSTREAM (OPENSTRINGSTREAM PAGE#) - NIL NIL NIL (LIST 'PARALOOKS PARALOOKS - 'LOOKS CHARLOOKS] - (COND - ((OR (NOT (fetch (PAGEFORMATTINGSTATE FIRSTPAGE) of FORMATTINGSTATE)) - (NOT NOFIRSTPAGE)) (* ; + (LET ((REGION (SCALEREGION (DSPSCALE NIL PRSTREAM) + (fetch (PAGEREGION REGIONSPEC) of PAGEREGION))) + (FOLIOINFO (fetch (PAGEREGION REGIONLOCALINFO) of PAGEREGION)) + FOLIOTEXTOBJ PAGE# FOLIOFORMAT PRETEXT POSTTEXT INFOLIST) + (CL:UNLESS (AND (GETPFS FORMATTINGSTATE FIRSTPAGE) + (LISTGET FOLIOINFO 'NOFIRSTPAGE)) (* ;  "If this isn't the first page, OR we want a page # on the first page, go ahead and format it.") - (RETURN (while (AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of FOLIOTEXTOBJ)) - (NOT FORCENEXTPAGE)) - collect (SETQ THISLINE (create THISLINE)) - (SETQ FORCENEXTPAGE (\TEDIT.HARDCOPY.FORMATLINE FOLIOTEXTOBJ - (fetch (REGION WIDTH) of REGION) - CHNO THISLINE (SETQ LINE (create - LINEDESCRIPTOR - )) - PRSTREAM)) - (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with FOLIOSTREAM) - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) - (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) + (SETQ INFOLIST (LISTGET FOLIOINFO 'FORMATINFO)) (* ; + "A LIST OF (FORMAT PRETEXT POSTTEXT)") + (SETQ FOLIOFORMAT (CAR INFOLIST)) + (SETQ PRETEXT (OR (CADR INFOLIST) + "")) + (SETQ POSTTEXT (OR (CADDR INFOLIST) + "")) + [SETQ PAGE# (COND + ((GETPFS FORMATTINGSTATE PAGE#TEXT) + (MKSTRING (GETPFS FORMATTINGSTATE PAGE#TEXT))) + (T (SELECTQ FOLIOFORMAT + (LOWERROMAN (ROMANNUMERALS (GETPFS FORMATTINGSTATE PAGE#))) + (UPPERROMAN (ROMANNUMERALS (GETPFS FORMATTINGSTATE PAGE#) + T)) + (MKSTRING (GETPFS FORMATTINGSTATE PAGE#] + [SETQ FOLIOTEXTOBJ (TEXTOBJ (OPENTEXTSTREAM NIL NIL NIL NIL + `(PARALOOKS ,(LISTGET FOLIOINFO 'PARALOOKS) + LOOKS + ,(LISTGET FOLIOINFO 'CHARLOOKS] + (TEDIT.INSERT FOLIOTEXTOBJ (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 (\FORMATLINE FOLIOTEXTOBJ CHNO NIL REGION PRSTREAM FORMATTINGSTATE + )) + (SETQ FORCENEXTPAGE (EQ (CHARCODE FORM) + (GETLD LINE FORCED-END))) (* ; "Format the next possible line") - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) + (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) (* ;  "Keep track of the next character...") - [COND - [YBOT (* ; + [SETQ YBOT (COND + (YBOT (* ;  "We're into it; take account of this line's height") - (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (T (* ; + (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.") - (SETQ YBOT (SETQ YBOT (IDIFFERENCE (fetch (REGION BOTTOM) - of REGION) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE] - (COND - ((ILESSP YBOT (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) - (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - (* ; - "This line hangs off the bottom; punt it.") - NIL) - (T (* ; "This line is good; use it.") - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - LINE]) + (IDIFFERENCE BOTTOM (FGETLD LINE DESCENT] + (CL:WHEN (ILESSP YBOT (IDIFFERENCE BOTTOM (FGETLD LINE DESCENT))) + (GO $$ITERATE)) + (SETYPOS LINE YBOT) (* ; "This line is still good") + LINE))]) (\TEDIT.FORMAT.FOUNDBOX? - [LAMBDA (PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Apr-88 17:35 by jds") + [LAMBDA (PAGEREGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:34 by rmk") + (* ; "Edited 2-Jul-2023 19:07 by rmk") + (* ; "Edited 19-Apr-88 17:35 by jds") (* ;;; "Return T if we're either not looking to begin in a new box, or we are and we've found it.") (* ;;; "This is part of generalizing the 'go to a new page' code to allow going to an arbitrary new formatting box.") - (SELECTQ (fetch (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE) + (SELECTQ (GETPFS FORMATTINGSTATE STATE) (FORMATTING (* ;  "we're just munching along formatting. Keep going.") T) (SEARCHING (* ;  "We're searching for a page box of the right type. Decide if this is it or not.") - (COND - ((EQ (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE) - (fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) + (CL:WHEN (EQ (GETPFS FORMATTINGSTATE REQUIREDREGIONTYPE) + (fetch (PAGEREGION REGIONTYPE) of PAGEREGION)) (* ;  "What we're looking for matches what we've got. Turn off the search and return T") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING) - T))) + (SETPFS FORMATTINGSTATE STATE 'FORMATTING) + T)) (:SEARCHING-FOR-EQUIVALENT-PAGE (* ;; "We've switched document formats in mid-document, and need to find the corresponding page frame to continue properly.") - [COND - ((IEQP (fetch (PAGEFORMATTINGSTATE REQUIREDREGIONTYPE) of FORMATTINGSTATE) - (fetch (PAGEFORMATTINGSTATE PAGECOUNT) of FORMATTINGSTATE)) + (CL:WHEN (IEQP (GETPFS FORMATTINGSTATE REQUIREDREGIONTYPE) + (GETPFS FORMATTINGSTATE PAGECOUNT)) (* ;  "We've formatted enough pages up to now.") - (replace (PAGEFORMATTINGSTATE STATE) of FORMATTINGSTATE with 'FORMATTING]) + (SETPFS FORMATTINGSTATE STATE 'FORMATTING))) T]) (TEDIT.SKIP.SPECIALCOND - [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) + [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). Then set LINE:CHARLIM so it will move the document ahead to the next real text.") + (* ;; "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.") - (PROG ((PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (LEN 0) - (FORMATTINGSTATE (STREAMPROP IMAGESTREAM 'FORMATTINGSTATE)) - (HEADINGTYPE (fetch FMTPARASUBTYPE of PARALOOKS)) - NPC PIECES) - (SETQ NPC PC) - (SETQ PIECES (repeatuntil [OR (NOT PC) - (AND (fetch (PIECE PPARALAST) of PC) - (OR (NOT NPC) - (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) - of NPC)) - 'PAGEHEADING) - (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE - of (fetch (PIECE PPARALOOKS) - of NPC] - collect (* ; "GRAB THE PIECES FOR THIS HEADING.") - (SETQ PC NPC) - (AND PC (add LEN (fetch (PIECE PLEN) of PC)) - (SETQ NPC (fetch (PIECE NEXTPIECE) of PC))) - NIL)) - (replace (LINEDESCRIPTOR LMARK) of LINE with 'SPECIAL) - (* ; - "Mark this as text to skip, as far as the main formatter's concerned.") - (replace (LINEDESCRIPTOR 1STLN) of LINE with T) - (replace (LINEDESCRIPTOR LSTLN) of LINE with T) - (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) - (replace (LINEDESCRIPTOR ASCENT) of LINE with 0) - (replace (LINEDESCRIPTOR DESCENT) of LINE with 0) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with 0) - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with 0) - (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) - (* ; - "Set the line's CHARLIM to be the last character in the page heading.") - ]) + (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]) ) @@ -1389,49 +1396,36 @@ (DEFINEQ -(TEDIT.HARDCOPY.PAGEHEADING - [LAMBDA (TEXTOBJ TEXTSTREAM LINE PARALOOKS CHNO IMAGESTREAM) - (* ; "Edited 18-Mar-93 13:07 by jds") +(TEDIT.HARDCOPY.PAGEHEADINGS + [LAMBDA (TEXTOBJ CHNO FORMATTINGSTATE) (* ; "Edited 9-May-2023 17:46 by rmk") + (* ; "Edited 7-May-2023 23:45 by rmk") + (* ; "Edited 9-Oct-2022 17:12 by rmk") - (* ;; "Capture the text for this page heading. Then set LINE:CHARLIM so it will move the document ahead to the next real text.") + (* ;; "This runs thru all the headings starting at CHNO, copying the pieces of the different heading types into FORMATTINGSTATE, and returning the starting CHNO of the first non-heading piece. ") - (PROG ((PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (LEN 0) - (FORMATTINGSTATE (STREAMPROP IMAGESTREAM 'FORMATTINGSTATE)) - (HEADINGTYPE (fetch FMTPARASUBTYPE of PARALOOKS)) - NPC PIECES) - (SETQ NPC PC) - [SETQ PIECES (repeatuntil [OR (NOT PC) - (NOT (type? PIECE PC)) - (AND (fetch (PIECE PPARALAST) of PC) - (OR (NOT NPC) - (NEQ (fetch FMTPARATYPE of (fetch (PIECE PPARALOOKS) - of NPC)) - 'PAGEHEADING) - (NEQ HEADINGTYPE (fetch FMTPARASUBTYPE - of (fetch (PIECE PPARALOOKS) - of NPC] - collect (* ; "GRAB THE PIECES FOR THIS HEADING.") - (SETQ PC NPC) - (COND - ((type? PIECE PC) - (add LEN (fetch (PIECE PLEN) of PC)) - (SETQ NPC (fetch (PIECE NEXTPIECE) of PC)) - (\TEDIT.COPYTEXTSTREAM.PIECEMAPFN PC TEXTOBJ TEXTOBJ TEXTOBJ] - (replace (LINEDESCRIPTOR LMARK) of LINE with T) - (replace (LINEDESCRIPTOR CHARLIM) of LINE with (SUB1 (IPLUS CHNO LEN))) - (* ; - "Set the line's CHARLIM to be the last character in the page heading.") - (replace (LINEDESCRIPTOR 1STLN) of LINE with T) - (replace (LINEDESCRIPTOR LSTLN) of LINE with T) - (replace (LINEDESCRIPTOR LHEIGHT) of LINE with 0) - (replace (LINEDESCRIPTOR ASCENT) of LINE with 0) - (replace (LINEDESCRIPTOR DESCENT) of LINE with 0) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with 0) - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with 0) - (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE) - (fetch FMTPARASUBTYPE of PARALOOKS) - PIECES]) + (CL:UNLESS FORMATTINGSTATE (* ; + "If it isn't there, we would loose the headings") + (SHOULDNT "NIL FORMATTINGSTATE")) + (bind HEADINGSUBTYPE (PC _ (\CHTOPC CHNO TEXTOBJ)) while [AND PC (EQ 'PAGEHEADING + (fetch FMTPARATYPE + of (PPARALOOKS PC] + do (SETQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE of (PPARALOOKS PC))) + (for P (START _ CHNO) inpieces PC while [AND (EQ 'PAGEHEADING (fetch FMTPARATYPE + of (PPARALOOKS P))) + (EQ HEADINGSUBTYPE (fetch FMTPARASUBTYPE + of (PPARALOOKS P] + do + (* ;; "We loop at least once, because P=PC satisfies the while. We need the CHNO, not the piece for the piecerange") + + (add CHNO (PLEN P)) finally (LISTPUT (fetch PAGEHEADINGS of FORMATTINGSTATE) + HEADINGSUBTYPE + (\SELPIECES.COPY (\SELPIECES START CHNO TEXTOBJ))) + + (* ;; + "Set PC to continue looking for the next headingtype.") + + (SETQ PC P))) + CHNO]) ) @@ -1442,7 +1436,12 @@ (TEDIT.HARDCOPY-COLUMN-END [LAMBDA (ORIGINAL-LINES ORPHAN FORCENEXTPAGE CHNO FOOTNOTELINES REGION TEXTOBJ FORMATTINGSTATE - FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "Edited 11-May-93 01:21 by jds") + FINAL-CHNO DONT-KEEP-SINGLE-LINE) (* ; "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") + (* ; "Edited 3-Oct-2022 18:08 by rmk") + (* ; "Edited 11-May-93 01:21 by jds") (* ;; "Do column-end processing for TEdit hardcopy -- widow elimination, respect keep-together specifications, etc.") @@ -1452,124 +1451,108 @@ (* ;; " -- List of line descriptors removed from the end of the column.") - (* ;; " -- ?? CHNO for start of next line in sequence??") + (* ;; " -- Flag to say that it kept one line") (SETQ ORIGINAL-LINES (DREMOVE NIL ORIGINAL-LINES)) (* ; "Remove any NILs from the list of lines; they're artifacts of running into page headings in mid-page.") (LET ((LINES (COPY ORIGINAL-LINES)) LASTLINE (REMOVED-LINES (LIST ORPHAN))) - [COND - (LINES (* ; + (CL:WHEN LINES (* ;  "Only worry about widows and orphans if there are really lines to worry about") - [for LINE in LINES when (fetch (LINEDESCRIPTOR LMARK) of LINE) - do (DREMOVE LINE LINES) - (SETQ FINAL-CHNO (AND FINAL-CHNO (IMAX FINAL-CHNO (ADD1 (fetch ( - LINEDESCRIPTOR - CHARLIM) - of LINE] - (SETQ LASTLINE (CAR (FLAST LINES))) (* ; + [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 LASTLINE (CAR (FLAST LINES))) (* ;  "Find the last line in this box (column or page)") - [COND - ((AND ORPHAN (fetch (LINEDESCRIPTOR LSTLN) of ORPHAN) - (NOT (fetch (LINEDESCRIPTOR 1STLN) of ORPHAN))) + (CL:WHEN (AND ORPHAN (GETLD ORPHAN LSTLN) + (NOT (GETLD ORPHAN 1STLN))) - (* ;; "There was an overhanging line, and it was the last line of the paragraph. Remove the penultimate line.") + (* ;; "There was an overhanging line, and it was the last line of the paragraph. Remove the penultimate line.") - (SETQ LINES (DREMOVE LASTLINE LINES)) - (CL:PUSH LASTLINE REMOVED-LINES) - (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LASTLINE)) - (SETQ LASTLINE (CAR (FLAST LINES] - [COND - ((AND LASTLINE (fetch (LINEDESCRIPTOR 1STLN) of LASTLINE) - (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE)) - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LASTLINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; + (SETQ LINES (DREMOVE LASTLINE LINES)) + (PUSH REMOVED-LINES LASTLINE) + (SETQ FINAL-CHNO (GETLD LASTLINE LCHAR1)) + (SETQ LASTLINE (CAR (FLAST LINES)))) + (CL:WHEN (AND LASTLINE (GETLD LASTLINE 1STLN) + (NOT (GETLD LASTLINE LSTLN)) + (ILESSP (GETLD LASTLINE LCHARLIM) + (TEXTLEN TEXTOBJ))) (* ;  "The last line on the page is a widow. Remove it, too.") - (SETQ LINES (DREMOVE LASTLINE LINES)) - (CL:PUSH LASTLINE REMOVED-LINES) - (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of LASTLINE)) - (SETQ LASTLINE (CAR (FLAST LINES] - (COND - [(NOT LINES) + (SETQ LINES (DREMOVE LASTLINE LINES)) + (PUSH REMOVED-LINES LASTLINE) + (SETQ FINAL-CHNO (GETLD LASTLINE LCHAR1)) + (SETQ LASTLINE (CAR (FLAST LINES)))) + [COND + [(NOT LINES) - (* ;; "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.") + (* ;; "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 (fetch (LINEDESCRIPTOR CHAR1) of ORPHAN)) - (T (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of (CAR (FLAST ORIGINAL-LINES] - ([AND (NEQ FORCENEXTPAGE 'USERBREAK) - (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (OR (fetch FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LASTLINE)) - (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LASTLINE)) - (NOT (FETCH (LINEDESCRIPTOR LSTLN) OF LASTLINE] + (SETQ LINES ORIGINAL-LINES) + (SETQ FINAL-CHNO (COND + (ORPHAN (GETLD ORPHAN LCHAR1)) + (T (ADD1 (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)) + (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.") + (* ;; "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 FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LASTLINE)) - (AND (fetch (FMTSPEC FMTKEEP) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LASTLINE)) - (NOT (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE] do - - (* ;; "Run thru, removing any trailing headings. However, assure that there's at least one line on a page.") + (for LASTLINE in (REVERSE LINES) while [OR (fetch (FMTSPEC FMTHEADINGKEEP) + of (GETLD LASTLINE LFMTSPEC)) + (AND (fetch (FMTSPEC FMTKEEP) + of (GETLD LASTLINE LFMTSPEC)) + (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 FMTHEADINGKEEP of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LASTLINE))) - (fetch (LINEDESCRIPTOR LSTLN) of LASTLINE))) + ((AND LASTLINE (AND (NOT (fetch (FMTSPEC FMTHEADINGKEEP) of (GETLD LASTLINE LFMTSPEC))) + (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.") - [SETQ LINES (LDIFF LINES (SETQ LASTLINE (CDR (MEMB LASTLINE LINES] + (SETQ LASTLINE (CDR (MEMB LASTLINE LINES))) + (SETQ LINES (LDIFF LINES LASTLINE)) (SETQ REMOVED-LINES (APPEND LASTLINE REMOVED-LINES)) - (SETQ FINAL-CHNO (fetch (LINEDESCRIPTOR CHAR1) of (CAR LASTLINE] - (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "WARNING: Page full of headings on page " - (fetch (PAGEFORMATTINGSTATE PAGE#) of - FORMATTINGSTATE - ] - [COND - (FOOTNOTELINES + (SETQ FINAL-CHNO (GETLD (CAR LASTLINE) + LCHAR1))) + (T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "WARNING: Page " (GETPFS FORMATTINGSTATE PAGE#) + " is completely full of headings ") + T]) + (CL:WHEN FOOTNOTELINES - (* ;; "There are footnotes--fix up their vertical locations, so they're aligned on the botton of the column.") + (* ;; "There are footnotes--fix up their vertical locations, so they're aligned on the botton of the column.") - (bind [YBOT _ (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) - (fetch (LINEDESCRIPTOR DESCENT) of (CAR (FLAST FOOTNOTELINES] - for LINE in (REVERSE FOOTNOTELINES) - do (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( - LINEDESCRIPTOR - DESCENT) - of LINE))) - (add YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (bind (YBOT _ (IDIFFERENCE (fetch (REGION BOTTOM) of REGION) + (GETLD (CAR (FLAST FOOTNOTELINES)) + DESCENT))) for LINE in (REVERSE FOOTNOTELINES) + do (SETYPOS LINE YBOT) + (add YBOT (FGETLD LINE LHEIGHT)))) (COND ((OR LINES FOOTNOTELINES) (* ;  "There really ARE lines in this column; take care of them.") - (CL:VALUES (APPEND LINES FOOTNOTELINES) - REMOVED-LINES FINAL-CHNO NIL)) - ((AND ORPHAN (NOT ORIGINAL-LINES) + (TEDIT.VALUES (APPEND LINES FOOTNOTELINES) + REMOVED-LINES NIL)) + [(AND ORPHAN (NOT ORIGINAL-LINES) (NOT DONT-KEEP-SINGLE-LINE)) (* ;  "If there's only one line left for this box, return it anyhow.") - (CL:VALUES (CONS ORPHAN FOOTNOTELINES) + (TEDIT.VALUES (CONS ORPHAN FOOTNOTELINES) NIL - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of ORPHAN)) - T)) - ((AND (NOT DONT-KEEP-SINGLE-LINE) + (ADD1 (GETLD ORPHAN LCHARLIM] + [(AND (NOT DONT-KEEP-SINGLE-LINE) REMOVED-LINES) - (CL:VALUES (LIST (SETQ LASTLINE (CAR REMOVED-LINES))) + (SETQ LASTLINE (CAR REMOVED-LINES)) + (TEDIT.VALUES (LIST LASTLINE) (CDR REMOVED-LINES) - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LASTLINE)) - NIL)) - (ORPHAN (* ; "WAS ORPHAN.") + (AND LASTLINE (ADD1 (GETLD LASTLINE LCHARLIM] + (ORPHAN (* ;; "There's only the one line, so let's go back and try again.") - (CL:VALUES NIL (LIST ORPHAN) - FINAL-CHNO NIL]) + (TEDIT.VALUES NIL (LIST ORPHAN) + FINAL-CHNO]) ) @@ -1762,66 +1745,49 @@ (DEFINEQ (\TEDIT.FORMAT.FOOTNOTE - [LAMBDA (TEXTOBJ PRSTREAM LINE REGION PAGEREGION FORMATTINGSTATE) + [LAMBDA (TEXTOBJ PRSTREAM LINE REGION FORMATTINGSTATE) (* ; "Edited 19-Jan-2024 23:30 by rmk") + (* ; "Edited 6-May-2023 20:38 by rmk") + (* ; "Edited 7-Mar-2023 13:11 by rmk") (* ; "Edited 30-May-91 12:52 by jds") - (* ;; "Grab text from the TEXTOBJ, starting with CH#, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") + (* ;; "Grab text from the TEXTOBJ, starting with CHNO, and use it to fill REGION on a page. Return a list of line descriptors which, taken together, fill the region.") - (LET* ((CHNO (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (STREAMSCALE (DSPSCALE NIL PRSTREAM)) - THISLINE LINE YBOT LINES ORPHAN LASTLINE PREVLINE LHEIGHT FMTSPEC SPECIALYPOS NEWPAGETYPE) - (SETQ LINES (while [AND (ILEQ CHNO (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (OR (NOT PREVLINE) - (NOT (fetch (LINEDESCRIPTOR LSTLN) of PREVLINE] - collect (SETQ LINE (OR (pop (fetch (PAGEFORMATTINGSTATE PAGELINECACHE) - of FORMATTINGSTATE)) - (create LINEDESCRIPTOR))) - (* ; - "Grab a line descriptor from the recycling list, or create a new one.") - (SETQ THISLINE (OR (fetch (LINEDESCRIPTOR CACHE) of LINE) - (create THISLINE))) - (* ; - "And a recycled or new THISLINE cache for char widths &c") - (BLOCK) (* ; - "Allow other things to happen while we format....") - (\TEDIT.HARDCOPY.FORMATLINE TEXTOBJ (fetch (REGION WIDTH) of REGION) - CHNO THISLINE LINE PRSTREAM) + (BLOCK) (* ; + "Footnotes aren't so long, but why not?") + (bind PREVLINE (LEFT _ (fetch (REGION LEFT) of REGION)) + (TEXTLEN _ (TEXTLEN TEXTOBJ)) + (CHNO _ (GETLD LINE LCHAR1)) while (ILEQ CHNO TEXTLEN) until (AND PREVLINE (GETLD PREVLINE + LSTLN)) + collect + + (* ;; "Grab a line descriptor from the formatting list, or create a new one.") + + (SETQ LINE (\FORMATLINE TEXTOBJ CHNO (GETPFS FORMATTINGSTATE PAGELINECACHE) + REGION PRSTREAM FORMATTINGSTATE)) (* ;  "Format the line, noting any form-feeds") - (replace (LINEDESCRIPTOR CACHE) of LINE with THISLINE) - (* ; - "Mark this line as having cached print info.") - (replace (LINEDESCRIPTOR LTEXTOBJ) of LINE with (fetch (TEXTOBJ - STREAMHINT - ) - of TEXTOBJ)) - (* ; + (SETLD LINE LTEXTOBJ TEXTOBJ) (* ;  "And remember the document it came from.") - (SETQ FMTSPEC (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) - (add (fetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE) - (fetch (REGION LEFT) of REGION)) - (* ; "Format the next possible line") - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (* ; + (add (FGETLD LINE LEFTMARGIN) + LEFT) + (add (FGETLD LINE RIGHTMARGIN) + LEFT) (* ; "Format the next possible line") + (SETQ CHNO (ADD1 (FGETLD LINE LCHARLIM))) (* ;  "Keep track of the next character...") - (SETQ PREVLINE LINE) - LINE)) - (SETQ LINES (DREMOVE NIL LINES)) (* ; + (SETQ PREVLINE LINE) + LINE finally (* ;  "Remove any NILs from the line list; they're artifacts of running across page headings in-stream") - LINES]) + (RETURN (DREMOVE NIL $$VAL]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (5090 8513 (TEDIT.GET.PAGEFRAMES 5100 . 5454) (TEDIT.PARSE.PAGEFRAMES 5456 . 6879) ( -TEDIT.PUT.PAGEFRAMES 6881 . 7511) (TEDIT.UNPARSE.PAGEFRAMES 7513 . 8511)) (8559 21110 ( -TEDIT.SINGLE.PAGEFORMAT 8569 . 18906) (TEDIT.COMPOUND.PAGEFORMAT 18908 . 19538) (TEDIT.PAGEFORMAT -19540 . 21108)) (21197 94262 (TEDIT.FORMAT.HARDCOPY 21207 . 31947) (TEDIT.FORMATBOX 31949 . 46666) ( -TEDIT.FORMATHEADING 46668 . 52835) (TEDIT.FORMATPAGE 52837 . 63761) (TEDIT.FORMATTEXTBOX 63763 . 82761 -) (TEDIT.FORMATFOLIO 82763 . 89282) (\TEDIT.FORMAT.FOUNDBOX? 89284 . 91343) (TEDIT.SKIP.SPECIALCOND -91345 . 94260)) (94342 97315 (TEDIT.HARDCOPY.PAGEHEADING 94352 . 97313)) (97424 106093 ( -TEDIT.HARDCOPY-COLUMN-END 97434 . 106091)) (106138 111079 (SCALEPAGEUNITS 106148 . 107289) ( -SCALEPAGEXUNITS 107291 . 108061) (SCALEPAGEYUNITS 108063 . 108834) (\TEDIT.PAPERHEIGHT 108836 . 109771 -) (\TEDIT.PAPERWIDTH 109773 . 111077)) (111495 115063 (ROMANNUMERALS 111505 . 115061)) (115099 119241 -(\TEDIT.FORMAT.FOOTNOTE 115109 . 119239))))) + (FILEMAP (NIL (11921 15254 (\TEDIT.PARSE.PAGEFRAMES 11931 . 13431) (\TEDIT.PUT.PAGEFRAMES 13433 . +14257) (\TEDIT.UNPARSE.PAGEFRAMES 14259 . 15252)) (15317 31779 (TEDIT.SINGLE.PAGEFORMAT 15327 . 25545) + (TEDIT.COMPOUND.PAGEFORMAT 25547 . 26526) (TEDIT.PAGEFORMAT 26528 . 31777)) (31866 90148 ( +TEDIT.FORMAT.HARDCOPY 31876 . 42886) (TEDIT.FORMATBOX 42888 . 55048) (TEDIT.FORMATHEADING 55050 . +58664) (TEDIT.FORMATPAGE 58666 . 66869) (TEDIT.FORMATTEXTBOX 66871 . 81654) (TEDIT.FORMATFOLIO 81656 + . 86040) (\TEDIT.FORMAT.FOUNDBOX? 86042 . 88081) (TEDIT.SKIP.SPECIALCOND 88083 . 90146)) (90228 92509 + (TEDIT.HARDCOPY.PAGEHEADINGS 90238 . 92507)) (92618 99801 (TEDIT.HARDCOPY-COLUMN-END 92628 . 99799)) +(99846 104787 (SCALEPAGEUNITS 99856 . 100997) (SCALEPAGEXUNITS 100999 . 101769) (SCALEPAGEYUNITS +101771 . 102542) (\TEDIT.PAPERHEIGHT 102544 . 103479) (\TEDIT.PAPERWIDTH 103481 . 104785)) (105203 +108771 (ROMANNUMERALS 105213 . 108769)) (108807 111253 (\TEDIT.FORMAT.FOOTNOTE 108817 . 111251))))) STOP diff --git a/library/tedit/TEDIT-PAGE.LCOM b/library/tedit/TEDIT-PAGE.LCOM index f16811514ecca730efb5e03ade13b02fe8ea27e0..68bd0a7114359e33561b4835422c42f9bb2515ef 100644 GIT binary patch literal 24208 zcmd6P3vgrCc^)oEtyc6d1#l6XhH2^uD^uLfk|G{_+L3YbAOI4;g#b|4UD1L`f)csp zlIvZrWjRS}$MRzuXB^9;Sa#&vSvQ#^^`v|(r&`H2rfFw7bUjIvDl@yDc9KkI+D#HEMO2r z9|(>_&WMiY2FE8u;mOc&KrCEcvRhpG_?4^I-aje0iJ>X0m@~^mX|tG!TZIc^1^rFU zX0yUMvZ0}&fT+!HVmwFo5DA=lNAr4z^AN#cFf=wQCTWs`u?ynr@7TTl#(uKb-MLkg?>Rxcw&p%J;gWb)K(DRX6+UKgPtT$@Yz7Cyuvo_;v*NMG% zU8>b;%YOWQrlbRrsJb_LT-Dw3*Nmzs(?QVh=J$^0mi^VvPv!c*=Wg5k&sJxb z?|8=Jjh=`aTaTh(&oURRcGWH4-a}Rw3U~jK)zx41)lvS>tZt8MAUHBE?zdpU;Mo20 zfIbr=yb#4?Dr4nEI3#|dy^R)70%+Y%|AN3N;nf{?lttafCe4-)ZIN7Ud)sKmvz9ee zqH~BPKa07$qnCJU>QRrbwQ<^fh*l>05&C@>{a}XS2~j9!@(~fTXF8idgdCxen2TAn zWf2Ukmr*g7r~rcDh9lxEBbB5kHpw{aoXQc6DvXPW(riqvQ$d6!V%eC)$cTA;>H(L_ zh}PP6&ea)tywSGk*1K!QGd!o)GkXuFm;Dz%mF~ZV&HIaK?55wt=&|pL%4dgqwyUSx zJM31k$G6^FGrUH7mK*D8Y3)C8Yd||fh~c2#^dn}3{Z!a;I1`I8KI+(KG1i13qhrpz z5$uYMEMi2SJ+($bY&ab+!V`IxOPPEss}3{MKYf@(BO;znPSNqj(Bf8>UP3~Hf+C$r z(a|0iY0!DJBD*LNY($jeCQ6#|vQ;ENL`+%PjHN0A5$tW_@*y5^C6g$psdUqjktVuO zNEXw{Oe#&|p$Q_b%VSPvK7k$!$qx}hp|wGFDRYtOON1LQ6sHUapDFWeNDrM; zLBY(6W{P6NG-cUC1|1?ng~mn9DwnMsUdKe)D&RRPiae~07?F#U5$N%$Su=smuqaGf zOxrNU3jknh=kbt~?sVxxXGGh)ABQQ`%b5AN_fyAHeQ7>%UgM$0YsW|E%so=$QlNO3 zYF3x!V}f?8mH|QIj8tE$*Y77X*k1QO52ZaS?Ww1Hl=i8#ub%3rbhk=(*R8IpJIOoMp6HEj*FQ<9vAp~Bi@ypF^$)H-tI#NLDa zL?%DuT$#6q=f^<3Z`^`pF70)21Ajf$vzJbFeKpm!dgsysM*Jt1pBrfOo=kbH9?O^N zyp!_W;RdRm^_ta*Q7rqpA2hRVOn9H_wgPQ?-PU7WRZ+M6me847-!!Uc-3C@k?MC(7 zp(&oT&bpmNfH&vv)Yj5>Z(!He)W2KH>8V?14GiUbwLDO$I#9Rz_fA;@m{5Q9vAPv- zR|DJkUa$uGtNrz@|B>?T4y3wwdaRyQH_h{hcT!#dRqnlStDjMZQ^2I|-FKsuFV#h5 zR_~}%-E}0A-nREx!`9IM+|3y*{aq}%fQjx#$R2SJ<5$E|!k1oAm5rZVS?Vhqf+l(uHG2^`X~;JAd2f;%$-BRYCP zl8cdXlq8}?u=5Hw3f5*83dwvTBu2tuZ>s$W*jfuQhs0K7UOU8GI})1EB_zXa$q$cU z2zp?laW$~e7$htjcSuhl6oE9w5D;nk0@B4V!HL7O2#$kew#*`kM&~lwY%*nLhsxcDHb+1mqmPIO}wyD!`u9NOs_`8uR!iPNosGG?{VcbSqPaE&_uAOc~XMzCr(2qNj^23%*Uae zjvlqN4xxzqWn1Dpg#$wia>?6b$VPzAl6e&G)EUefxRz!+Bw*I5a&`Ooc zkbrY%gz+CBvbIH;dU_vqr==8HzP0>@xx&Q%8&V!u@CElLO(my)-Sm3fXWI6LSGr!_ zcKv&kwI{Hje`CtBF2y%@o~WBrBU*58yLOE^E_m|?Syha=+rf?Htv6=e&une092L#*Kfn`c_<){hdaB#xNcEr)B=GFJ>2HHg@oGeObyr3+{9a8wYZB z)MbC*O1wLAzf4~_{rz*UO9#sbD+k|B%Z;n2SO4&wD++ZW0Bq2 zh$Bjw$;q>`c|yfOC`)C~@v}_D97ALhMdhFwn)%tnAT?Y%3)+X7fW{N?LIQd?bA>Xr z!cv)t?iA@nL^P$nXsUsM$QqS>7n7xA*=}$QTmy$;3MyA7hnh?+r=W?MQ=sHidE|gs zm*PdU98asFK+;mO2&ALTkbq&poS|OjxdJRKDrU)oyha7&8ry>=wGqY)D0O96T}o5} z2LtjD28EIE8UZ#Y5>V($5cxo*f5+`{8M90(_}njc?f5EPmEKvRLd!M3|7ri?iTW&) zkQKI?R66(CerenFdkm`hDxSUWN_Rt@;8u)94>!p_YaI;Z_eu}7>*t0R+wsoLb5lhw zRdUNeV|L$tcjx({V`QS@-#t_0o)+8dmB4OqvC>`XYqZM^aMSflCs@ZHReW69!@oDS z?^%^j{hC-=^rI9S+WK_a>owAQzj&%tqrMGp5c|XRhhjr~Jc49;N=(T^!?Jg9 zc%*R*?PG+B7-BAyH?x9N8?umqZ^X^K9O8&P||n9Frg_(Y-;Ao5fL((IaU((LbO`gF+Hb29+wmac>So=PAr zRx0NzLwgUb-@8`{EZ0_-;blPOK-T1ubkdLw=;ns zp6~7xc&qxPtbTm2-SV-ZzuQA#X(HJtuw+87@I1drc|DCPJ&ObN%42(-YB{*wxyo7Z zqYrbJoaP^CWP9wGampT@8l+L}Ok17Yy4AUQAp3cV)BIC;EPJriBlElV9;!UX?eVh6 zQYWDhxm=M~9ElgHGa8120mNOU>^{`-PbTQV5`Aej!1N#H`quTJGcCor z5bO~8b*ur!P&5?!N(&!=5eQP!<8b+mjw-6vAm#!_990$DlF1j~8p6@$7b5f#tWzK$ z$c7dWn;ZCvfHnjq#a^l*3DOg|M$Zrz#2O`=%7`9vU%8i zh^Xxm41nD(ivE*3K~g&MCujml4h5UKl2@T2^^#}7N!wsS0Qr}KF1Z+5^Fg4uoMB~I^7h3TIJE4yac-;L@4fYjNZALP{nt3mY zW7?ApUkXADNdIv9ilko|+its$Py*PieSjrd0G?5^R340{^A_@HqIu?~APo`}c#m$Q?&xjX_*0d?`?!AT(=R`xUVc|SZ)_Xeb|WqGX_RsO^Sa7A?tS#6)!nvt z?9{gLBK+p{gk}htySqP1)QoSC+F*RuAh>aN_lKOXw20jwSc(g|;Tf^tjkIywPQW_o zMzRyN=|}y#iO<4&f>qG{vDL=v;q|V;E8woH)vjCJ?rQh;y${<{bp5__n9zk}QjH4f zf7UX)2TpDM+t$hbx2Bo=nLXgD=j~_Wp*i43{r;cKEF@ zfH(AlWP1#cQSAfhbFv&VjISnWBa9#4-92sfN!$%seaj}VnsiH=dfB3OiG!W@P4Bf` z(&?Vn+X#$+gYxbT`0U=$9jc9RyQ@B{&+-}mp1P{B>FV(6LSPQZ7h73RjBEzGN0wIXE%1Ec!!W5arQSL)vdd;Me9IB?XAxJQKP$SJ_B33|?0^_?+4IzNys>v0{QaC zMh=4@^0byZTyZoEI-Nwg7g<-Z*lbU1Nbt&#ID%m|fMNuqg)^y)ZEB}S$Vl0$l}5&z z?0*pmAcxC9v}jlX!!QvZTr-RGG);IOm6?{&6ksMcMa2my}Fh zQq!J`I%{>BJDg@i7I@h7zI)YM>a;vWH@971m;s;p+%!VV(q>GWv8sOAhJWqE!JAg^ z-h$O>`S(4DZa`3gQc67t59mdFh}C-=91hu%7+Zd@UaNbr-+~FT+Kn)^tygPpH@>(0 zY2$l2_jmKGZN0pGuV;DtUa!^DU+sp?>;+Umv30}pk?aSRBnf*844}}I0rg$0zc0cXRz_S^#hHF{C(VVFz?NvMb*qiphRb}2y2Y#hl$=YbJcABJXubV7hA zHT=b7+$m5zB;4_2?O-DtDPrX!fTN@f3|dptv8oXLHa48t$QA!nGYmtbPQ~n$o)Y> zpPi%5Rg{kfW4y{Hk@)G3SS@$=G*_C1y-%15HwC9z!wMjh;ASuEgY8d7A` z@^D3C^>zbjA5XWX+US-?nX!D^_+t9^)VbYjTYWu|?y0NfPRQhf{3A`_%Gfe8={62_Czb1T zwn=EEow#?|Au?M%TGmq{a#J%uzWbHD?Cv#cmi}_Q4K-u+E!vIc<}J~MP_F7T49izD z+&%T4Qw}&c!qrLgi@@^WlxA26gTVvR9Um}oj4&(`NEU$R>}Lw&h?5oFk|~(jkt!F> zd@0Mmf3S2(CFo=z6o6~9{W-*eD%RFSC55a+p=HuB+p@4&_&Rz&c z@TN{fuoX4NL~I|a!fYumhfMAS$C!c*8SYRdEirW^tr2+{A}v=SSXjZ}WXN8?sEYt! z$bu46Q%!^zf+_mu`NGKJa09^TqFZs2Wl(aIX9x)32&86d)}b&N`4&b+WeCez32X?6 zsv{aR-0Y1Ffo9veA_V!(SvLeWVdp}Oo*a?O`V!5WWdIoO#QFsMNb*F01ka7O7j66UOO9zNp1VltOE zDMkqmz{W~09c_03N4AOuTvVXEh7pF?YB2*RlRaxGMoNyQ8|DVd)zvH?Qec1bdqr2q>b(1HtIM#u+yGPqyXh9%Xm#}v*Zdcc#H{|i zziIg(Ccb11bXEP!mW~&#S-qAoW_72d39IiUGdxem3hbYF3ytsmoP|iz<<({6o@Ax} zA|hmN?+i5qnp0SIo-Mb~Q~!e1<$W|@MXRy4y$4S% zZ@a@rHGye|-nw8-!e4^bT)=83zeP=pkr1nj^F;|rQ5uX-0!Zx(Zy?4PtBUV`*Piyv_fB`pMM0+WoX|=UEID? zoy4+E-rezAqr2TJ5+S-Ve`^Se&GNSE4a>7z(EX=SNA)PM3**%f?nu8^quw&?)HA!03Bx_M}DVM^{p>k=lZK>0hyq%gi(ko zb5j?SB$80*v5q1hK~&Wg^Y{_?-#ON61figIFu@4evy_jt$f9W~n3{+{6yiD@XQl%X z$cQD|B(q1W=|_@Q7=@rhXNlHwTID~iNzpz3{MHJ~U3t6Y}rtDKxP8)x? z=-;jJXU+T5j6Vwx#-KeZwG8U%lj^nFSu^I~W-#_1WLNcv+3%nd&&F)#2WJ0uXKJfI ztDFm8t;YlIh$ySZ6@egVvAhTngb$qLZ=E80k)499KZ~0oaNA>e9LkloDmn?h zLt;N8Hnh6DC4Ik8Hpmz5R63|tt%BebQ!oI$-U@l*6Fy2R)xPj)+dNhr?9rgC(3uu;%K^GY+B!jRIC$l#|nGAu4x=7yW> zg5>m7;=glCX*mfqU`2zwMxrAYa1Vhg?J_8y*TpAfV)YOEJ@r)z{K&5qiEYr7(nGt z>&^V{X$|SSg{vKH>8&6act(SD!QRY_2K61hX3k*OanEK3`~F7_R%B$RO=(``&ZVJo z=KQIx&)|A8%Tq8Z%+ghDh<3IW9ig$fXF%A{fRVjmE}n+A9j8;L#YHSF%r+XKRJgmw zC%6uD4qaJhYyvsgFcs;qOM`-{93p!N-U01sU1mFaQ}3fw0@lI}&Mk+orKT?+ds(CAhD2c0mHzDkk!GNWU??Q?@vo33B~g`OduT6a|kUO zw=F2HN12vn?1|H|(L{uRTn^!k2$8a^5Gk?{Gt71unqldTaQ^|ewPRVL)q<Uhi?M zQ<|^eJe8Iu-!S(+I=wSJ%{8R*_j5WSE*oc@`_?aR-#d@bJjlt3 zo%dTFIT+kUuI)fvk{Rd+mw};%&!9Vqc-2lsnaeE1iTp!#H|XWgW=eQ(v-2hz{5eQNt&!FW~+g!vrA!5m40xjalw-_5$`wtxHsbEh}D`<_(S?t9II ze_8GmiJBzDdQx3CGJ78L=KGg{nkjOV`aQ-)e4-=cp03?IVQ&OyxL|vB=$9kl`PoEf z3fD*ww2@2ZVj^P4T)?t#$GX!UMjZkQizq&Zf;)+%SHh63bWHlVid2Z{;*kv{6^~VK z@;s`yQ5d~dEhwJ~ig;6*jmQPvJ_uPu7gm}(Je;yFh}jsV-DZv?M$t|y=rB(kLF9Z( zsSyaLnt+as9nJkw}2vt`-s5Hq8lNzLTe4s{}vD#7j%s5oPPDePxwQ78c<%bzn%Hu{e{+3u^3e zk=TAVeb=2X&d3R|4&xZA`a;0}7eiHEp4PECXQPVna9O8uE+J`$m@(}Ubem^cIs8g= znODaX-8m)w_y@loRXXCA*V}rO9=Ll{=7Gv|R+#oElyO5LL|m|QaQwv;V1n(9b>a+2 z^?XD?bTlIZ{!58JFq@4JjeHywfzI~Q^Yd%u4a+WVZZ2J=ODYcJI@FO?1EJrWc`J`= z_gTbYsQKfl;56TVaXxC$2dX?S)3H9iYJHAc3wKQ~)L-dRKhn#%`yZt>$gxcBl3J$o zdk;w|$iwSJ9|&l=?hEScoS58REFs%b$f50ALg-{zLg-;wLfDek%8|}RpML;9RZEDN zKF$l05mqiC{IzOX`J^^mSrqb1LkWLQN6f~jvMDSgtQ)hr7|ypqn6F&2CrYv@-1&185yx{^pc zFHz!W4(EJ!-S}1H$eWMo@=%HGd$qM1N}RHDF29BmZQskST?F{O8mynu%fH3hLu;Yt zT7SUccdrc`UF$Yw|KzXNI+|kp^LuvxE3lMG_tgXBiwrT?B@E<;4Jggb{nN0^9Vc z_?QU8#*TLcKHweh-;V>QB7lTo%KA9WUE=~r7MO>3oLsykcM*JH6p$c98oc9>*Pwt- z&^v5)H39l?SwMocwMu%`ekBY$vu18WFz~Bg8(7@mXo^ZAg;@%{_IH=Bv)YTCj ztNa}bc{v=+cA0Back^8Vz8!zRn*z2nCnXvtAoe{xwi-#pHYn?>55j$X9OTs%H{jD% z=ACYD{Ma-C<6p?XmS+i=<@%c|(dlMCB3bKj^;_yB3+-GqiXdv)jB2bs{T9CA(*!yO z(6M@qgzz_F&we+%_YgjFH}~e&ujKl_v-SDq8A;~J6aW=hiMr%*k_$$X4UG5f{K1Oj z%Y=u7ox^dzhlRf*%tD6@MHC-_-kb)WRw<2%5H9UNcDO)Scj-2klruP#4xkc>6bt54 zPql!>0B(!Mvt}`gPd`#nW0dOCT}D#t+14>Yae>7|N!GMk0&d(V&ljv>S=a?SNbG7g z{xr;!sF5?{MZ{zv+NLm7f~}GsxRa{kb8Pw5b_+H&A@i*Gzz6Vw$>P$LwfV)RYq&H# znZu`RG6j5clclslH1yOtx*s+Fv5l1)6<~NN&}dppT~ts_WJngF-ZS_Jnwn&X!<>p7 zS~)d<0123b>(?(YEaAE=U7TIVrKu}Ri!0BqEY5GPY^*<_J}NULAcxw+9>`t4wn>ug zl2};6ZQCWWIKQ@bjYg}+1o5@`t8)uWYa1^NouNijSu18{pT@5F6-mkJQTH%mYgX=$H4IOiBY!%_5QoKr@%gUJw+F{+~? zzdDDnj%H?aqLhU{0wgar3;e;=V)_#Uauhl9JZ=1GF^Vwu5rA>SSptGcXc4$^qg8#= z;l3Z@qrtWQ4`s>zM|q8w4}ZuH{z>_%E1qSCoF);lGmSP-;-@!5VfggPEN(|O!}rvW zYNvx2#EC<3+_586IY&p}9Dir7}c~JRoPan zZUw92M|?67?Kwu#5hz?=SX)_yPPM*Bqq)Ynz^_3}B*eacMGj_d{>6>!o7ePU?uV=r zPE@1iJ4hW0V;e+)(8Do~Kw;@B4#Z_=cjv^y{5AP~+j((y>G|tx^H&9Zns({hHH?&2 zYV*Y_D1bZ~`B0!kEtVXIVrSX}s)it;6n*9_rH!jj7!9_m5V_l^V$;1x=`e2PpxWUi z+iP{RV3>-Knb$vVFFlcg#rZ3n*FhH;1#JDccAd%0+R8fcg1tZ#L{|gaO1hb#f`P=m)CKbbOU7d8twhSmHDgl&tILtvMg4Ymad$m z&th%7AePovF0ZUB%w5`CJYx?-EsGw9Cfx|SXx;3z?D}K)OfmIzW&R3ul4~oUSh6v! zMRRXx@=E`;^Ocfm9}g%gN|AGdr22FO33ccISgH;u*>q&tv~a*2Mra`7Pr|q@jS6NE zx0;Y77$xy3h9Dv$2u8`U7)N*mfhYy#49*}x2u;lqT;Clg2of>0Iu1DyV%j(*gOK$g z>=BHTXo5b`K`=^&L4P5F5{!~iTM*1iAWEST*q8vpM{Xn$wojR0wj~;DYvT%?cyaCe zl`9)pH#IgjDKM=&H?@Il!s{EGOO09`O$16EIxR!e5IP2)P;v#nwrsM4NbwdrVNy86 z&=tGkZ@W>fKYioP@uYj|kTIHpDovwQbbMf-(I`|bT>#gZ?Y_v;BilhW2N?GWjsn9D z>gbyG&QS-B!K3PcL25XSO-?NsqO~B&>qCmH{QYodE&a9dWgFb!&Jv^sOS9G=olq=V zQMW@v3o*pj|84f{V6FFM@y#sy|Bgd_#ihLz zDUy+>*lt=}7n66JlJ`757%n|<&UI?a}UzxaBXlvdg$Q* z2?=^d?_%BO`<QY6luZdpK`jJ%W^lv|L^~%!aD<@YLHdYtbPOh#mF07us zv{YGLdNDc_Kl%Ln<(1{N=LS{E$<^fxmlrO-cye>8vb=c`ePw3{3mEOt`@;jSZlh!2 z(Xr4ly18(9$?kaRg^kNs9vc&D>zh@yE0!^kskvNEIEOqmG}J393+QCOHp7wLfuAzp z_*gvrtDc_-hesocm>4S*(@$sRTxl=`V2jp9U`NJc@v%^>SNtkr8yje4P!CO~XNL&f zQ^n*=x+KO@Bdx)#2nkyJ0pU67@p!E9`|;`F51%I(4hdDYkSvzc&dPB?n`+=_KASrl z95{NHQrtyBgd;-rSx8Tcf*27=Y|L4N!onU8Vi*aHZ1!v+EwY?fOy_423~@24gJFIh z+6+MfmRdwM&)$ifQjt= z+QmwxQtiUuH!Hb-w|4dr)%K4c)>XHb zG{#UUrl+$qFQO6gTL)SQdMbf{_ULbkNK7zjM;v8Q*IuBx<{dzAFU=M;#O>YT*cd|= zLEPsVzsR%GU$ybo7LF%*w~T*~K=f<$QN=7{5m6{+^AQmZ>nY9Un>JA-F3wNLxmjQt z9T*koQ}al{n4`nuxIz((-fSFp+%cbh+SFSvCQ5S?8de1nRXfYxO1#gomp*!swtS^! z=R}QnkAJ*neCwf#^$btx&FtQNnQGU$k7oMc!t(v?DXeFgk2lD5&$#+-)!zs7x7Q!? z>fqt6hbxxfI*{YW+Fh;vkXysP<70L&AjR$qKtN(7;aF)g9CyYN!_HWIv>~RBo`w+4 zIiIfjPAO&c(>Zb6;iO5m}XZ<7c=SX zbcO~;CjfC%91~3DQ|P;pev-C20Seir>^a6Y>TDH?vQVPjsF=%VXE_)#li*lbFkPi- zqgaUMuX@OeQHoHZ5iucWXXOlnIO(#0?}RAwu(Bd9c&1r_9-o>^rjQvGg(=B+4rk^p z5-`y-_)-&mwDjbFX!&fn$K#vs=1uyz|3mjp_hk6&`K`nC;Qb$@)A!yAmjd>?Sdl)$ zLHK*Ck_B?(jOm`~?yfFEi3e)_1>bZRr{4PVbl2W}E9IW8jEcXqdIXX8Pj{*2ZhfY< znnA*GmHX;Cb%l7BUEtN4PWu?|_gYf+U}#6E+y!rK!Vx=AOMfmcd;XToU1+UMeQwH* z9jQ&XeSW&ljPWOI`H}FfE^FiraL}A-C@T&YX0%Sbm!JT2R05`GU&DH z9V6z95@5=`HQ5JD-3v_J|B~$OFZU6q{*SW1{X%C=`lfECZZ57W*1rB@^O-*<1{I-9*6M$F%AVN)J2mufw zf`$)Y*3HUl=Jp#{U_B~D3b}O|ve59iDl^zE<>NJZ0>C#%gxR_UX2p)4rQL=(j6*0HNAtYHxeKG#%It zPIv5d%8uy{YU#h;oNoVLYQF@w`gx;q4EwKR_aT%DOt({+m7BU$2gb0H_P0DNV>0ri z-I=Cg$i%b{`^Y(ta$Bt;+Zu)J{GOn2OPr<|y5Z5@*VUMJZZI4lD|-y_2y zTlq>9mMif61BO-ZbR*Yb7`|&=*A>y7;ATc_+Z-E48m!?R}W5!2peJ*jeyvDG?h@2*&=g zQKD+aq^c2Xq~@`>?pwrS(S1i3i-aAGq6bB0qG*-LOgIh_Jp+0+EM~Hk$r6Za6clVS z1NJ{00(-!TGzJN}Rs!T4WHF|QqCn;SAd_%VRIC;@d|32OF04JiDJo0PE?iyR6c-?- ziOKa<@%(ZHp@p@IxU#XZ2+6G%+(Ar4MuwuXL<|gZ7@dWNLJ_QOB9<`h>ZF`0$hmw< z2_6nMBr772KfppTwR{?MoIV_n%dC9wgr~N$?fJNB@!uxFGM}_m>v7%M&)&|~$z;n; z?B}lbdrHtC=^}!C--uXn_BCdi&*oEderPs33w=is9*C%+Ksas}XiSgU z4eno&aK37|p&roaJ^PEBCB#C9abnDZhKC(tAY410MMAac;gD0T6Tl&L`A@`2Oi<;b zgq2hf2$#wTXmT87!F1PSjvc3V)DY-SYEl-?CPSf6m_8zk`OiZ*7p3gj*zvhMO?nXg z@+?l_abm}D9$7G@W5{J7B_#86g+XexbX-i~$g1{%JEu#tbV#O%_r-~&&5MW{mDWy7 zfmJrMm;wXMZ5Gp|^sL?BFwQ&HcnTbMb_TO#q&@{kyfj%%&Q4}@F33nJT?CRqNt{1O zg~`)2eYHc777_Ewk^~*50#T8i!XcjGh=Qp-K$03D)Pkpt?(xO0%FeOMeD@r&JJm{8*VA2#M{0A-#w@eQJm0oQ9Of1$&9~3{ z_B!SRbsmq8p|$Aa=J;c^mD4yp-@$AYH?(*NVQ#*}c|}g;W=mY7=v9B#oEoC{_Rjo# z=k7p>ds{qIn-{y?rTM^oPrYrf$PLvn(EI1xxvY;r-`Ku0Gv8){6U&R8D6@EI>vw1U zek-&0kz>UQb!c&Gw|0J4cVGXq77y3dpv=%rp0#qbQ)ihZulJ%(;`Tagvn?3F(5yA< z#Xqm5U~ss$eW$DC%bB;TAIn&8WxQ|Bl}y`Kwm9!Q%2P+73#6zp^0nHX6Y`9Rj?mtN zc5-Mx3KWTrs{N++1@F2D&K&I^h`-Rxq|!Owdl66p+8RR?8=93vynC<_BiKnc>lYpw zfk-V&X>2DjU#SvGL57_H!<5Z~GJ>t+6GGA{Hfx+a;tj7iCgBB=Ae91FpgG+S*8rEP zql)Q?=&2!drZCG{^`i!45KTnISSg(>PG)dW>G%$UVr8EOGnrTFTF`A2$*1R8c{`X( zo+TYlBoxP4n4FtIu^~nk;o+!#gu~$8+{ZtR!)BjG0+Ff(ls%mU<3tFK1!MF!narz^ zhCyWMd>R~ubBgn=5d}sM5JG7k1#=S-iMR+t=m%y3)=(HHXqG0ZApWF~xfG^0mmU}x z5WxApQ|p&6Eo^R*cKO-$%VOj5^4cb8lnqa!Ceer^e>!>uy>g6#l_X6F4U0QUYM8>A zjMk3EZCr%Bn3zbT^E76RSk%T@v?m%c9ukzQL}OCKp-M1lwgCJH1~5-5mJxK92P;^B zqQX|BfUiR$(r^Ya5FJsN5KDv%=7GV>g2pg$!E~C|7M=2{=q=jFyWEvRkbHrG7N#Es zZUw8VYa@)=yYV(o0v5H1(o~pa6eb2>!*JwOqG8Wzm_s&U0a0w=+Uv9s4MkZMrq=*b zfYO2Tf#hHBX!Th0LyYmv*NLcaucf*?ADK_=9bCI}XZ}RBvQmX+xvOjbM9Z~<^C!Ie z+d}F^{3oSMaYff>_YTaDlsmv?Jy@}12L$yFgWaHx(1k{RX}+xfJehri9ebOfkljt+G=(OqKl3~CWD|3eP$HW-^^+3Fj8Aa!9LM}x&Zc2T6q$v~mBsaq7lpjKxp8&#Ziw2}UpFFRjGY)-Cu2#ts*Z+9 zv8(V2X?6|5A=R#psz|?EXFy5E>qHq4(6F}@14_zX7ak)~*07LDtRpnWT(p8DG0FCD zAma73Sf19B{}J!q4h_jiK%K7LOiC8LnR(;TuG()e1K5~mV`Zc@l0RaSjBO7ZZACB8 ztZj2CDN7$wCWjdY2;0PT0hp_jrP)DEk7%Nb9z|>#1qFv9Rv}HIxF!Kv!IYUA0U;DgUse{M2|dHOZ>*XSTg#`<3W(mguaPsD4BDT61){ zZT(o6*nQjtdQ9L!9r&vLeq-DEwi!yzHK}?T&)X*Nu>X;xvZH11(6MdnlQ3!4QU>)J z6W8tCAEqkS7m2U8Ub86My1o0KxtM12cmG^=YFI+4YKN_ib;FK8;o?QK4Ylb*e|m{1 zmb)-pyIa=d$WDfRMRq|yt07+lQ7m_C-+9`espl{D8STs4o^Lw`hxotKa4>T{cx>zX zU8eds&Z@gN?ctYw_nw!JW`qy@`HRf!q9U9BMv=qQe*XiqyJatMEceE?=T8iHatK@H z9wdEAl|zR0T8fs%`pNCx$7GLM2u;#EWlu#V^i3w!2Cj{}%iP-e_3U2DMU&jQasw9a zifo6CK(@bSddA$;Um4~Y8L+xw!BCx512C&}d&}M1cZ%6-M@@xnC+Tj6f%UbD#L%Ci z6u4f95sXNNL8vBja`LoDz<_CMw4oNnajj!5LO}_rWAjStiHI0DH+O*;#09%R1Wcsv zSR=kEQZAyQCn3ihZb4-+UmK1?N^>>|glSiRnCHwg_D{HZ+_et0=FTe0&+`( ziD)VxbMPH8Fb{Q2Z4A=Ueq)S+3v!HtxIt$WP;f>uoTfe_U^dMdBaPaz%AAK6V1!&PrROuiUs5Mtnn zv403M_pqT|>l(p&I(u~jw2Atgy{w&U^b|FI0ZkRHNkV}f9>fjJiqCs*5 zhj13=a;gNIg=Qphkn55sz>c}dJdQpq-AHUTRvfM6B>7b*>77{sO9mVQKO^#rBU#p# zZ()W}3`JD1;18~#VY?ASrcRTSmmo1vx81-vcxO92o&ziJ`Y_DH)}!S0(Naw^!8)z1 z+-~oW|9+}nmp|bDv-UhA`p3)ddk;?-r0TVF>f_~}-FVgK_XlKuFVqH zff?%^G~!A-wGO&<@)rZeSWF0($yQ+41%4UhAo9*V#9> z-@SIK|E=wJ|J39k+1k#4P?BcSO(@mI7qzLbClBzLIe?NF8cT%W{CdDA^xk|-GNGNLpio*@xoC?w2^z&NT3lLfbKAcnQx zpgwYvOpt2Vi5tN&I7o++U|}6a6bjWa%sKcoE}?2aF?BHV97vH7(g-Uj1QfmX5ioLR zbPv4F(l9HDA+r|XLx|icNy~$BO6i87#6AtMAswWUyFoBq7w*)ek_J+30t5h@I`UUU zUa1{P8{9}duolJiVEPQyrAk!|SBnBfLFWiqUD|-)NnJ@pA?-NztjO)72*IC=NW(8F zO_DY;WPBH?qd^w=OUL2IbtPbV4yG!E zZ2!0YMk<4#rGq1oO)|3W_U=bAI>p1yl(i@TZ>n)d`9=q*{K{_aoMuj)@pfJ88&{rY z-jy5mG@D3yrBK7_;98F}3EK9)nB6^gN~M%L_hKt=rLvthov^c{&Cw@z9x)*<${#$g zt=_j%vUBUZ&Do$}Je8WV1=m*3DKZORx6=gEzf5uiwfW$yszkZFc3Kxf0ZRuNI?p#k zN6kaKcN&P4##b`Z_Y2XS_M|p5$#&H=(EgdNPZ(h+(^(g|{l{cq3mX8xaco8paXz@y zqbE5Zl-()_KQW&EV$g=>69z~-9VWzptSUfUWUy$cT-0srcGW&4u+e7uP%XD}Y&^B< z%{|ao)=q)D&rlibk7`*Ao5V@pA=YaYrTEVKRa0AMEN~!ZYSi4z+joW?GQ8}!W%fRA zxo`Wc{i)6lC@_xJ_Vh-~8xSFu*!p?z0v+V#FxDM69+Gz`uabdK>G*kh6~5iI~Kuyr~CuAGciDobJ=3BgSy8+XwFY&U}~O( z?lZ;%aaaYTklN7FWG-7M0QG6+mP~h!uA`8nP^doSCxn@K z!2lQ>4)+BRP2D7OAbM_KFHlzTBu9h85Pp<4JAo1C5NM3nzt6}N76>5J^fV4`$OPeI zA5ku^p7S zRi!h51*W8&&BN7Yu$Z37C&^I`Mo@B-ggcR~yS5?A8fg@O&kD5Q*<|i)L2`|_4L0PW zbK6%PYAm`IWICipEX|r&Sjb`_lVrndon6A&)p9eeG7g4G*`Q#vhco)zOn%T5Vpn~Y zK)1fY1F3y)rbYwAW;RjkoRgX*b|4A0^Y|=MHSJTwc6k~(opwss{&;#KIQMEy+B+VM z*GOF|$Hr9B_)q1+92HO*PcUM0DMfsj3LdhUkPvv^5%_m_Lf>G{7%(e4jFDEqub`IbovjoZ6d;9d;}Y-E>8+nRoOS5I?AeEX11QO%8}Y>?>VcSubuLqwHD9Uvgokz8nt%)$UCGN$jgvo07Ev7 zRuoc(I{hJEX8gMM_Lt?*&baJuFF#S0PpHyQROCrHltI7fQs$0we?A_D_SKF+_n>>( zzVle)q|w89%gQlf-b?&KER=>u-`=dL-mF<5*YqZ}0(q1->lBoGx6vt#)Rew_oEF5& z$Pro899wy)rWZnvkdiB5ewKSvn&YO*(w07Rtn9vx*7UBitHacr?P!Co7y@PVLe6A*+ZrQu< zSarMQb*p@)CeO9({1{7i#@=RQd%ota_WM}lGkUA7w#Z=h*3o(g<#yU}vfW$u(Vl~i zgZ5nGh_K_%dFxd=ADm?10*0cdyvWKjr|b5LHvjq4fb$gpp>?__x(&dp|zoc8t8 z-tyC!lXv@0rw#V$i53@}&TeMI;6oqiwkj@65f zp^a_NU(49eW3s4nyXDmNe&+UX{VUva(7V$2moRY2F`$f3n%YNpPTRS5+Kq;u9yRHQ z$nrCxAf`9*VI##$9Gc6EFea zjhp2$!X{(4cit;AyALndPvP|r+9AdA$y#;Wb5jO)%MBxc%Cwv>mmy`NsDi!XXBjFEOPv9~10a2Lc*G*x`8=F_Xw zRR_?u2TTbsZj)3=XR8-W;f?YHU7+dNdq@h9nI6!b?SEJ$i0*u@w)Gh)i0Ewp!#Oga zg-K0xe(GGBy#d1@zIG%;oU_gu1uJNH`4Na3Q$(2I8VLUqc=n1B=iQSL=>3eLX@u=6 zWM(r`iQy!`yNO|Nlw6-IKehuS+38gK323V{@2;3HSj-gb1nDXa-Bpf+AiIp|LOUWb zqd7D zE9_0peZ{~Hy6Z*()}}Pt{1>DXevOv zS<7%?(%?1~fIvvTkI-pihuTHSD{mSO14i`-q)s~$qAOXZSO_|1ccUSQ z%}r@Ic=bvU3F;AtNDAd|^K{_j?{03i*-ShNjkK%NQJ@W1(gB_mwMp(uA}H(M}b5Yvr5KZet6he-vm_5U&0 zQeh`B0+-hF#~{GD+K=LX$lVMIBxk#dLkhPKD@(IjD5I)xkY<(9)>vLcxXeWG za$j0KK?;42o5dhwEymGc1%`C0Y_d2{G)`@`#eFt)sf2uv>&9A@sQtixE@SO0oiNt^ z61LhE|BoK@i-%^IZFs!gr2~8Sv3yeQHW@u85G0Y3ZXuWZ`1WzRe?m!K{Aqo`8QXds zYD~q=y;hsBm>t}Dk4kuT!crHqKCUy$0{52NW&ci>6tZ8*YvK>g4O~&%`k@ru0?feN zgjTSU9E(3~238k2%DxG&^@{9)3HJp6CvV$!p~bauBNm?@xVr!b=BOf%H_KqS99)qn z_7TH|kUnJWvuxVUK>*AD!lqpbT24=Ao- zfec#|!EFa~z9KM-x(vJ#P%KKqk%TJH=nbI((yq{S9YqJjuo2o`(R4Ef&eO?!9=AGh zNtLX}@J4A!0UM@l#;nU#>`-ek(aZuQnmK?(GdbE9xi=B0IFx-Z3`)9ncTzKfB6Y93 z6mYLQ363_dB)X{UP6CQ|CjnXB4eLkgaSmff1}k8PNo8l!RecwEiGWYCSC>@0bSa!& zpzDY^3^F^1yW~Y)9pHBiSI*l}VpRAlDPvZwu@mKEl@<5A-z{dS*Xz^(t6%Su$YNbd z>vSI?V>3}oL%~|zGJ)};V>(6;UZ}x29d4Y@dkhHAMGr2vCJAd=8b|I1bpU2Wg-x}F zruEjfaZX{p*SV~2&E4AhdtFR@aTQe$?-X2XbJT#nh%fYpi7jKO(ZB?>)%R9IR^J*q^v>C9M|Ak`H>>19tFArnO1LJK+uqKYtI6MK!&T(nKhN!) z$SFmH%Pjlg>BjV)Tf493+kZo8EqE{ip&~2a>-W`G=w7oO7tT0*l~l&XK${8pOdwza z?JAJU-dMRAfETOu^~2o0edj626rA|kPXXVsy7u1sQFzNf2$}JUc80SL#9!D4 zB9&3M?Dd^}bue~*o`dmw_Q6;-heGdTwW)taC!~G{%eb=i%&-eW{j|hzF@-(5l+heg zpr#9?QX&GU4wCXzn@JYvZm0WnVXvDFMJ~0jqY!D{*b!~qa|n=hMb}-iS(QNAAy=vW zMEqv)HVjVAT@i=R3_A>!f;t@Jcjw&ZxVBm^MV4iD7vo$1I%F)$pzbP@_z2D;A72jq z!Y9tDGSdf+IHS5HQpwODCyMt%Aa2_ro#n`1nUrlQwxE&~QDGZ;8w(x>xTrjMI-M>I zswc*jnU(HVIn1eiy~?J%ik#6cE5ij5Ez_c*a@JBxMuIx^0wt&N<6@%dkTi*=X=^Ic zGxM^88t8!VejhuwwK~p}?1HDl0#vfv?Kos@5$^PPT~5`W=7ov%1-;LebxbW z5kBp;Qd~h>aeO!Z?T2#g*5eHv+xoWOe^|CDFQ0#ZOkJ3?zMkCs@Tnbniiw=k=}(x5 z!0SnI6}jH2Ef`+7+&pqhIb^+gD%Ye>7^_r~_S zzp0YG(~sdJx}qlT_qWRSmc8fj@Zx)>*bjKR&EkdRk7L{KDs*?<+4>FrloPkL`<;vo zXlJ)_fNQ-e1M2C=w{X8jPvC-Y>zY+oPe3&^)~_4Wi8R(bo6Zgp$0ZtXxqbW2S?dGb z+zceeyb7tW>uf@p(UBwXd@JWYzx|VMCU?5Wci%JJzWZ=8)m2qXb{$||rtLS~{zi7s zm%R2!6?;{0N$Xs-E9=$3LqXoBo?x7`=0^V=CnhA7ox)Qa(D}@yXC`1SH?n~9d4L!c zR$4wJZy2~L;KiLZyjL8Gb;zg61`xpw5L?|245Cs=l++=}ZYDoWatT`|(1Qv;{=!;chWurD~OM)6!{UklW5{vT}zKhxwC<) z?QG1=o!!hWk{Z%gitHbz5zXogf)nl(;f~Y?Z2gQP(kbZvH z2D*NX?w`a^wR@L)teWTL+2|rXT;fd{Ku8)8{X{AD!3S6Y^4ak!L&rA`UtL8;|9D*Q zhflAybZTA4?tYoKbf&YyDdpQtk4s>m*p8QVP-7>6WjEfR7>?dEusANn1WaYgm>^RM zJ@H4T(UGC}3&7RjY;#M`Ev(XWvALzq&85p^kjT|HmlF!=1y#LfP&Xy>GLMJpa=1dE z=Z_6_PvCq=zfhcXz^7ZoXFphYD+W-1XG;BV1IFF|(F9j-NrUOk-u;T9g3}A1D;SWS z?;Ap|!Ig7vW&-D1;NrG<)cMwKaQtA)UiVtd{~W))8{ye!y51aT zChDCFo~^%P&T{7mNq8}xSKJn-@P}`$!zCdu2=ukn)PFpP>*~xH2m>3>r=>4 zFHIq*sV*3%)e1@+vvV$e9wWk&Q>*8Y{IE$j-{Y6Q!r4Qsk;Yoz<>ZG}gZtOILD}#A z{c3Att-s^sAFSTLf35$++5chnU}LTS%gKMTdSL%r|BthOzdqzUobV9`V96YS2kjKg z#n!zTRFQ@)0{=8Oh{qhs1>IQ&$Iujkhpu)6!TuluzYKTOg!nL1bA;i>fiRRgFJMo_ zkV|)&Uf{Psab&Uc5XQ+x7`cm}3kjsqb5023kXK+79HlT+Ru%Y?h)V)|*CIKPUP6b^ zFD1la43B|?!I=!k5kLcjqxgoQbda>d14s2aQEJe-n~1^Owv0*UN#(Ju{c3?-8vSZ9 z2*c{Id9vF_5H7?;x5AMpEp{?IXVVZ}>^xwEq4i`w9%MImb{UDs-> z&{@mM{xTkz`gTv>-cxrs0Mb*^O&*x^uyKD_dkndpMUYqQP*0~QZzuWKr zvFxX(pSR!rqU>!i`>N8X$Sl1h1m7RqdkBtFjgCf68y)%EE7v8u;-_qMVW55;0?9NX z+nb1vXEVD>UM?=)bRS=rXtVV!+U&~_Y4+uafaVxY%6@z~1UOgkbP3(qsKSsP>@et- z9R{P^>>3eJ_oMuKEFo z=6<{X!qV#c^FssF$aGFlBy&#_XK+`eABweR@c=%T3f{FC=5Dwe`gIW7OsL+g4n8%9 zD-!@laweNQE9lxvF^`vp@Zdf$@w|GczjX#rdd$s;QV#ZMLX~rXJD%dhV|*Gy*=O-< zFKdHq%d00a;0hjmTG-fFTB~5b)g^IdbK&x)=od&3&*HafHa0I`QSbHvuvZ|UUB+us z0|LKuVoyi^s04{<=3=IR7{Oht3C|?YQ0}96KrkMSVsL3gG>&E; z(BAcxPqVYpD=VS_kA`l03rm-A_%1oSJ0UJCTv5M|v>+}oJ$H3=;j*CLELys91!tK+ zwfW)(3Lp>hIb%hm98+UF{!w*jXBc@Mh%4sbyCHK_SwVA&@tU*{b3u` zp4$+Oxohl`y!rz4A8U(*oCxJCE^KUG1rFjpU@Jr_R~etJF0VmbV!x<4*0>yIp1ec! ze7K`lLXE=RQx)%ruP)J1A6$QSaB+S0>LsXMF0U^Vbg}fojfKk#&s|>FsEU=PrHvEx z>iGKeVrg~x((;<#xl5ai1NJC1RLn3O1`zjJXH?f8#*bG~Pa6vx5NNL~|K^gt!E6nL zQv0;pajiVD<61*uV@^o8S_|MzVv!iIXu{Sk5-S-T*{x0t?Z^@a`393ATmyvqFbbU> zDkMQJ6Npk8Md71CMlDLCXjF`l+Xj*-2FV`G4^mnw78m5hixfmA(CP@d9q{-g6b(aA zfTTca6h#ws6Oz&>8YL2qPLM`X$h^4rNJ$h!BXAl;3Mi+-`}WyZ|&fmE1UM4*A7G`Q^ppiD?K1oiV^AW8Un7CsJx#1$y^ z;YoeI_H&i_MVxvirW;-L4EY0 u+6UD(P_bW*h_(K#RE!qW!Sw;t)Kyr)U(MmbF2vbr{l`8W1Fe8~>;DHEhbb!n diff --git a/library/tedit/TEDIT-PCTREE b/library/tedit/TEDIT-PCTREE index eab26b14..dd87c4d0 100644 --- a/library/tedit/TEDIT-PCTREE +++ b/library/tedit/TEDIT-PCTREE @@ -1,547 +1,1089 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "26-Jul-2022 10:35:13" {DSK}larry>medley>library>tedit>TEDIT-PCTREE.;2 26909 +(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}tedit>TEDIT-PCTREE.;219 65397 - :CHANGES-TO (FNS \INSERTTREE) + :EDIT-BY rmk - :PREVIOUS-DATE "14-Jul-2022 17:00:01" {DSK}larry>medley>library>tedit>TEDIT-PCTREE.;1) + :CHANGES-TO (FNS \DELETEPIECES) + + :PREVIOUS-DATE " 3-Mar-2024 08:59:45" {WMEDLEY}tedit>TEDIT-PCTREE.;218) (PRETTYCOMPRINT TEDIT-PCTREECOMS) (RPAQQ TEDIT-PCTREECOMS - [ + ( (* ;; "Balanced tree PIECE TABLE supporting functions") - (FILES TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY - (* ;; "\WORDSINBTREEMAIN = # of words in the child-pointers & offsets section of the node -- everything before SPARE5 (the overflow place).") - - (* ;;  "\BTREEMAXCOUNT = number of children in a full node = maximum value for a node's COUNT field.") - - (* ;; "\BTREELASTREALOFFSET = offset of last real space for a child entry in the node ( = \WORDSINBTREEMAIN - 4)") - - (CONSTANTS (\BTREEMAXENTRIES 8) - (\BTREEMAXCOUNT 8) - (\BTREEWORDSPERENTRY 4) - (\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4)) - (\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES) - 4)) - (\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1) - 4))) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS UPDATEPCNODES FINDPCNODE \FIRSTNODE \DELETETREE \INSERTTREE \LASTNODE \MATCHPCS - \SPLITTREE \TEDIT.UPDATETREE \TEDIT.PIECE-CHNO \TEDIT.SET-TOTLEN) - (FNS DISPTREE TREEGRAPHNODE) - (RECORDS BTREENODE) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA]) + (EXPORT (CONSTANTS (\BTREEWORDSPERSLOT 4) + (\BTREEMAXCOUNT 8)) + (RECORDS BTREENODE BTSLOT) + (MACROS \NTHSLOT \NEXTSLOT \PREVSLOT \LASTSLOT \FIRSTSLOT \MOVESLOT \FILLSLOT + \FINDSLOT) + (MACROS \LASTPIECEP) + (I.S.OPRS inslots inpieces backpieces)) + (MACROS \INSURE.VACANT.BTREESLOT) + (ADDVARS (INSPECTDONTSORTFIELDS BTREENODE))) + (INITRECORDS BTREENODE) + (INITVARS (MULTIPLE-PIECE-TABLES T)) + (* ; "Experimentation") + (GLOBALVARS MULTIPLE-PIECE-TABLES) + (FNS \MAKEPCTB \UPDATEPCNODES \FIRSTPIECE \DELETETREE \INSERTTREE \LASTPIECE \MATCHPCS + \PCTOCH \CHTOPC \TEDIT.SET-TOTLEN \MAKE.VACANT.BTREESLOT \LINKNEWPIECE \UNLINKPIECE + \SPLITPIECE \INSERTPIECE \INSERTPIECES \DELETEPIECES \ALIGNEDPIECE) + (COMS (* ; "Debugging ") + (FNS BTVALIDATE BTVALIDATE.PRINT CHECK-BTREE CHECK-BTREE1 BTFAIL) + (INITVARS (BTVALIDATETAGS 'DONT)) + (GLOBALVARS BTVALIDATETAGS)))) (* ;; "Balanced tree PIECE TABLE supporting functions") - -(FILESLOAD TEDIT-DCL) (DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQQ \BTREEMAXENTRIES 8) +(RPAQQ \BTREEWORDSPERSLOT 4) (RPAQQ \BTREEMAXCOUNT 8) -(RPAQQ \BTREEWORDSPERENTRY 4) -(RPAQ \WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4)) - -(RPAQ \BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES) - 4)) - -(RPAQ \BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1) - 4)) - - -(CONSTANTS (\BTREEMAXENTRIES 8) - (\BTREEMAXCOUNT 8) - (\BTREEWORDSPERENTRY 4) - (\WORDSINBTREEMAIN (UNFOLD \BTREEMAXENTRIES 4)) - (\BTREELASTREALOFFSET (UNFOLD (SUB1 \BTREEMAXENTRIES) - 4)) - (\BTREETOPHALFOFFSET (UNFOLD (LRSH \BTREEMAXENTRIES 1) - 4))) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) -(DEFINEQ - -(UPDATEPCNODES - [LAMBDA (PC DELTA) (* ; "Edited 21-Apr-93 16:09 by jds") - - (* ;; "ADD DELTA TO CHNUM IN NEXTALL NODES OF TOPNODE.") - - (LET ((UPWARD (fetch (PIECE PTREENODE) of PC))) - (while UPWARD do (for I from 0 by 4 as ITEM from 1 to (fetch (BTREENODE COUNT) of UPWARD) - when (EQ PC (\GETBASEPTR UPWARD I)) - do [\PUTBASEFIXP UPWARD (IPLUS I 2) - (IPLUS DELTA (\GETBASEFIXP UPWARD (IPLUS I 2] - (add (fetch (BTREENODE TOTLEN) of UPWARD) - DELTA) - (SETQ PC UPWARD) - (SETQ UPWARD (fetch (BTREENODE UPWARD) of PC)) - (RETURN) finally (HELP "Piece not in its TREENODE"]) - -(FINDPCNODE - [LAMBDA (PC PCTB) (* ; "Edited 13-Apr-93 15:00 by jds") - - (* ;; "Given a piece and the pctb it's in, return pcnode") - - (fetch (PIECE PTREENODE) of PC]) - -(\FIRSTNODE - [LAMBDA (TREE) (* ; "Edited 14-Apr-93 02:06 by jds") - (LET ((COUNT (fetch (BTREENODE COUNT) of TREE)) - CHILD) - (SETQ CHILD (\GETBASEPTR TREE 0)) - (COND - ((type? BTREENODE CHILD) - (\FIRSTNODE CHILD)) - (T TREE]) - -(\DELETETREE - [LAMBDA (OLD PCNODE) (* ; - "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") - - (* ;; "Removes OLD from PCNODE. OLD is either a piece or tree node.") - - (UNINTERRUPTABLY - (LET* ((OLDLEN (ffetch (BTREENODE TOTLEN) of PCNODE)) - NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB) - - (* ;; "NEW CODE") - - (SETQ NODE-COUNT (fetch (BTREENODE COUNT) of PCNODE)) - - (* ;; "Find OLD, .") - - (for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT) - 2) by 4 when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) - do (RETURN) finally (HELP "Piece/node not in PCNODE")) - - (* ;; "Update the previous piece's length, if appropriate:") - - (SETQ BB (\ADDBASE PCNODE ITEM#)) - (\RPLPTR BB 0 NIL) - [for I from 0 to (IDIFFERENCE \BTREELASTREALOFFSET ITEM#) by 4 - do (\PUTBASEPTR BB I (\GETBASEPTR BB (IPLUS I 4))) - (\PUTBASEFIXP BB (IPLUS I 2) - (\GETBASEFIXP BB (IPLUS I 6] - (\PUTBASEPTR PCNODE \BTREELASTREALOFFSET NIL) (* ; - "Because it's been copied, clear the old value before the refcnt-er gets to it.") - - (* ;; " If adding this piece EMPTIES the tree node, DELETE it.") - - (* ;; "FIXMI -- This should coalesce adjacent nodes that are too empty!") - - [COND - ((IEQP NODE-COUNT 1) - (\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE))) - (T (* ; - "No split, so update upper nodes with delta-length.") - [SETQ NEWLEN - (replace (BTREENODE TOTLEN) of PCNODE - with (for I from 2 to NODE-COUNT as ITEM# from 2 by 4 - sum (\GETBASEFIXP PCNODE ITEM#] - (replace (BTREENODE COUNT) of PCNODE with (SUB1 NODE-COUNT)) - (\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN] - - (* ;; "END NEW CODE") - - 1))]) - -(\INSERTTREE - [LAMBDA (NEW OLD PCNODE NEW-PREVLEN NEW-OLDLEN PREV) (* ; - "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") - - (* ;; "inserts NEW in front of OLD in PCNODE. NEW/OLD are either pieces or tree nodes.") - - (* ;; "If NEWE-PREVLEN is non-NIL, it's a DELTA for updating parents of THE PIECE BEFORE OLD. This is used by \SPLITPIECE to pass down the new shortened length for the original piece.") - - (UNINTERRUPTABLY - (LET* ((OLDLEN (ffetch (BTREENODE TOTLEN) of PCNODE)) - NEWLEN INCHNO AFTERFLG NODE-COUNT ITEM# BB) - - (* ;; "NEW CODE") - - (SETQ NODE-COUNT (fetch (BTREENODE COUNT) of PCNODE)) - - (* ;; "Find OLD, and insert the NEW piece (and length) in front of it.") - - (for old ITEM# from 0 to (LLSH (SUB1 NODE-COUNT) - 2) by 4 when (EQ OLD (\GETBASEPTR PCNODE ITEM#)) - do (RETURN) finally (HELP "Old piece not in this PCNODE.")) - (OR NEW (HELP "Inserting empty item")) - - (* ;; "Update the previous piece's length, if appropriate:") - - [AND NEW-PREVLEN (COND - ((ZEROP ITEM#) - - (* ;; - "The hard way -- the previous piece is in a prior btree node, so we have to go there to update it.") - - (LET* ((NODE (fetch (PIECE PTREENODE) of PREV))) - (UPDATEPCNODES PREV NEW-PREVLEN))) - (T - (* ;; "Easy way -- it's in this node. Update it in place.") - - (\PUTBASEFIXP PCNODE (IDIFFERENCE ITEM# 2) - (IPLUS NEW-PREVLEN (\GETBASEFIXP PCNODE (IDIFFERENCE - ITEM# 2] - (COND - (NEW-OLDLEN (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2) - NEW-OLDLEN))) - (SETQ BB (\ADDBASE PCNODE ITEM#)) - (\RPLPTR PCNODE \WORDSINBTREEMAIN NIL) (* ; - "Clean out the slot that's about to be copied over.") - (\BLT (\ADDBASE BB 4) - BB - (IDIFFERENCE \WORDSINBTREEMAIN ITEM#)) - (\PUTBASEPTR PCNODE ITEM# NIL) (* ; - "Because it's been copied, clear the old value before the refcnt-er gets to it.") - (\RPLPTR PCNODE ITEM# NEW) - (COND - ((type? PIECE NEW) - (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2) - (fetch (PIECE PLEN) of NEW)) - (replace (PIECE PTREENODE) of NEW with PCNODE)) - ((type? BTREENODE NEW) (* ; "Inserting a NODE") - (\PUTBASEFIXP PCNODE (IPLUS ITEM# 2) - (fetch (BTREENODE TOTLEN) of NEW)) - (replace (BTREENODE UPWARD) of NEW with PCNODE)) - (T (\ILLEGAL.ARG NEW))) - (SETQ NEWLEN (for I from 0 to NODE-COUNT as ITEM# from 2 by 4 - sum (\GETBASEFIXP PCNODE ITEM#))) - (replace (BTREENODE TOTLEN) of PCNODE with NEWLEN) - - (* ;; " If adding this piece overflows the tree node, split it.") - - [COND - ((IEQP NODE-COUNT \BTREEMAXCOUNT) (* ; - "Tree node is full, so have to split.") - (\SPLITTREE PCNODE OLD NEW)) - (T (* ; - "No split, so update upper nodes with delta-length.") - (replace (BTREENODE COUNT) of PCNODE with (ADD1 NODE-COUNT)) - (\TEDIT.UPDATETREE PCNODE (IDIFFERENCE NEWLEN OLDLEN] - - (* ;; "END NEW CODE") - - 1))]) - -(\LASTNODE - [LAMBDA (TREE) (* ; "Edited 14-Apr-93 16:29 by jds") - (LET ((COUNT (fetch (BTREENODE COUNT) of TREE)) - CHILD) - (for ITEM# from (LLSH (IDIFFERENCE COUNT 1) - 2) to 0 by -4 when (SETQ CHILD (\GETBASEPTR TREE ITEM#)) - do (RETURN (COND - ((type? BTREENODE CHILD) - (\LASTNODE CHILD)) - (T TREE]) - -(\MATCHPCS - [LAMBDA (PCNODE) (* ; "Edited 5-May-93 17:57 by jds") - - (* ;; "Make sure that any pieces pointed to this node point back to this node.") - - (bind PC for OFFSET from 0 to \WORDSINBTREEMAIN by 4 as I from 1 to (fetch (BTREENODE COUNT) - of PCNODE) - do (SETQ PC (\GETBASEPTR PCNODE OFFSET)) - (COND - ((type? PIECE PC) - (replace (PIECE PTREENODE) of PC with PCNODE)) - ((type? BTREENODE PC) - (replace (BTREENODE UPWARD) of PC with PCNODE]) - -(\SPLITTREE - [LAMBDA (PCNODE) (* ; - "Edited 21-Mar-95 15:26 by sybalsky:mv:envos") - - (* ;; "We're adding piece NEW in front of OLD. OLD is represented in the B-tree node PCNODE, which is full.") - - (* ;; "Split PCNODE in two and propogate any changes upward.") - - (UNINTERRUPTABLY - [LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE)) - COUNT ITEM# NEW1 NEW2) - (COND - (UPWARD - - (* ;; - "Easy case: This is not the root node, so split the node and propogate up.") - - (SETQ NEW1 (create BTREENODE using PCNODE)) - - (* ;; "Clean out upper 3 child entries, leaving only the lower 2. Have to tell GC about actual child slots being set to NIL (hence \RPLPTRs):") - - (for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4 - do (\RPLPTR NEW1 OFST NIL) - (\PUTBASEFIXP NEW1 (IPLUS OFST 2) - 0)) - (replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1)) - (\TEDIT.SET-TOTLEN NEW1) - (\MATCHPCS NEW1) - - (* ;; - "Now clean up the old piece, to contain only the upper 3 original children:") - - (for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4 - do (* ; - "For GC, have to tell it we've dropped pointers to first N/2 pieces") - (\RPLPTR PCNODE OFST NIL)) - - (* ;; "Move upper N/2+1 down") - - [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from - \BTREETOPHALFOFFSET - by 4 do (\PUTBASEPTR PCNODE OFST (\GETBASEPTR PCNODE UPPEROFST)) - (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) - (\GETBASEFIXP PCNODE (IPLUS 2 UPPEROFST] - - (* ;; "And clean out upper 2 slots, without the GC seeing it:") - - (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to - \WORDSINBTREEMAIN - by \BTREEWORDSPERENTRY do (\PUTBASEPTR PCNODE OFST NIL) - (\PUTBASEFIXP PCNODE (IPLUS OFST 2) - 0)) - (replace (BTREENODE COUNT) of PCNODE with (ADD1 (LRSH \BTREEMAXENTRIES 1))) - (\TEDIT.SET-TOTLEN PCNODE) - (SETQ COUNT (fetch (BTREENODE COUNT) of UPWARD)) - (\INSERTTREE NEW1 PCNODE UPWARD NIL (fetch (BTREENODE TOTLEN) of PCNODE))) - (T - (* ;; "Hard case: This is the root node. We need to create 2 new nodes, put the split parts there, and re-use this node as the root.") - - (SETQ NEW1 (create BTREENODE using PCNODE)) - (for OFST from \BTREETOPHALFOFFSET to \WORDSINBTREEMAIN by 4 - do (\RPLPTR NEW1 OFST NIL) - (\PUTBASEFIXP NEW1 (IPLUS OFST 2) - 0)) - (replace (BTREENODE UPWARD) of NEW1 with PCNODE) - (replace (BTREENODE COUNT) of NEW1 with (LRSH \BTREEMAXENTRIES 1)) - (\TEDIT.SET-TOTLEN NEW1) - (\MATCHPCS NEW1) - - (* ;; "--") - - (SETQ NEW2 (create BTREENODE using PCNODE)) - (for OFST from 0 to (SUB1 \BTREETOPHALFOFFSET) by 4 - do (* ; - "For GC, have to tell it we've dropped pointers to first N/2 pieces") - (\RPLPTR NEW2 OFST NIL)) - [for OFST from 0 to \BTREETOPHALFOFFSET by 4 as UPPEROFST from \BTREETOPHALFOFFSET - by 4 do (\PUTBASEPTR NEW2 OFST (\GETBASEPTR NEW2 UPPEROFST)) - (\PUTBASEFIXP NEW2 (IPLUS 2 OFST) - (\GETBASEFIXP NEW2 (IPLUS 2 UPPEROFST] - (for OFST from (IPLUS \BTREEWORDSPERENTRY \BTREETOPHALFOFFSET) to - \WORDSINBTREEMAIN - by \BTREEWORDSPERENTRY do (\PUTBASEPTR NEW2 OFST NIL) - (\PUTBASEFIXP NEW2 (IPLUS OFST 2) - 0)) - (replace (BTREENODE UPWARD) of NEW2 with PCNODE) - (replace (BTREENODE COUNT) of NEW2 with (ADD1 (LRSH \BTREEMAXENTRIES 1))) - (\TEDIT.SET-TOTLEN NEW2) - (\MATCHPCS NEW2) - - (* ;; "Now clean out the top-level node, and fill it in with its new children.") - - (for OFST from 0 to \WORDSINBTREEMAIN by \BTREEWORDSPERENTRY - do - (* ;; "Clean out the entries in the node, so we don't over-write them by mistake, thus losing refcount sync.") - - (\RPLPTR PCNODE OFST NIL) - (\PUTBASEFIXP PCNODE (IPLUS 2 OFST) - 0)) - (\RPLPTR PCNODE 0 NEW1) (* ; "Add first new node") - (\PUTBASEFIXP PCNODE 2 (ffetch (BTREENODE TOTLEN) of NEW1)) - (\RPLPTR PCNODE 4 NEW2) (* ; "And the second....") - (\PUTBASEFIXP PCNODE 6 (ffetch (BTREENODE TOTLEN) of NEW2)) - (freplace (BTREENODE COUNT) of PCNODE with 2) - (freplace (BTREENODE TOTLEN) of PCNODE with (IPLUS (ffetch (BTREENODE TOTLEN) - of NEW1) - (ffetch (BTREENODE TOTLEN) - of NEW2])]) - -(\TEDIT.UPDATETREE - [LAMBDA (PCNODE DELTA) (* ; - "Edited 21-Mar-95 14:40 by sybalsky:mv:envos") - - (* ;; "The size of the text represented by PCNODE has grown by DELTA. Update all of PCNODE's parents to reflect the change in length.") - - (LET ((UPWARD (fetch (BTREENODE UPWARD) of PCNODE))) - (while UPWARD do - (* ;; "Keep going up in the tree til we hit the top.") - - (for old ITEM# from 0 by 4 as I from 1 to (ffetch (BTREENODE COUNT) - of UPWARD) - when (EQ (\GETBASEPTR UPWARD ITEM#) - PCNODE) do (\PUTBASEFIXP UPWARD (IPLUS ITEM# 2) - (IPLUS (\GETBASEFIXP UPWARD (IPLUS ITEM# 2)) - DELTA)) - (add (fetch (BTREENODE TOTLEN) of UPWARD) - DELTA) - (RETURN) FINALLY (HELP "PCNODE not in upward node.") - ) - (SETQ PCNODE UPWARD) - (SETQ UPWARD (fetch (BTREENODE UPWARD) of PCNODE]) - -(\TEDIT.PIECE-CHNO - [LAMBDA (PC) - (LET ((PCNODE (fetch (PIECE PTREENODE) of PC)) - (CHARCOUNT 0)) - (while PCNODE do [add CHARCOUNT (for OFST from 0 by 4 while (NEQ PC (\GETBASEPTR PCNODE OFST - )) - sum (\GETBASEFIXP PCNODE (IPLUS OFST 2] - (SETQ PC PCNODE) - (SETQ PCNODE (fetch (BTREENODE UPWARD) of PCNODE))) - (ADD1 CHARCOUNT]) - -(\TEDIT.SET-TOTLEN - [LAMBDA (PCNODE) (* ; "Edited 9-May-93 15:40 by jds") - - (* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths") - - (replace (BTREENODE TOTLEN) of PCNODE with (for I from 1 to (fetch (BTREENODE COUNT) of PCNODE) - as ITEM# from 2 by 4 sum (\GETBASEFIXP PCNODE ITEM# - ]) -) -(DEFINEQ - -(DISPTREE - [LAMBDA (TREE DEPTH) (* ; "Edited 13-Apr-90 15:00 by ON") - (LET [(G (TREEGRAPHNODE TREE NIL (OR (NUMBERP DEPTH) - T] - (SHOWGRAPH (LAYOUTGRAPH (CADR G) - (LIST (CAR G)) - '(VERTICAL)) - NIL - #'(LAMBDA (X) - (INSPECT (fetch NODEID of X]) - -(TREEGRAPHNODE - [LAMBDA (TREE PARENT DEPTH) (* ; "Edited 12-Jun-90 10:33 by mitani") - (LET (THISNODE NEWDEPTH NODEID LONODES HINODES BFNODE BFNODEID RANKNODE RANKNODEID) - (COND - ((ATOM TREE) - (LIST [fetch NODEID of (SETQ THISNODE (NODECREATE (CONS) - TREE NIL NIL (LIST PARENT] - (LIST THISNODE))) - ((OR (EQ DEPTH T) - (AND (NUMBERP DEPTH) - (>= DEPTH 0))) - (SETQ NEWDEPTH (COND - ((NUMBERP DEPTH) - (SUB1 DEPTH)) - (T DEPTH))) - (SETQ NODEID (fetch (PCTNODE PCE) of TREE)) - (SETQ LONODES (TREEGRAPHNODE (fetch (PCTNODE LO) of TREE) - NODEID NEWDEPTH)) - (SETQ HINODES (TREEGRAPHNODE (fetch (PCTNODE HI) of TREE) - NODEID NEWDEPTH)) - (SETQ BFNODE (NODECREATE (SETQ BFNODEID (CONS)) - (fetch (PCTNODE BF) of TREE) - NIL NIL (LIST NODEID))) - (SETQ RANKNODE (NODECREATE (SETQ RANKNODEID (CONS)) - (fetch (PCTNODE RANK) of TREE) - NIL NIL (LIST NODEID))) - [SETQ THISNODE (NODECREATE NODEID (fetch (PCTNODE CHNUM) of TREE) - NIL - (LIST (CAR LONODES) - BFNODEID RANKNODEID (CAR HINODES)) - (AND PARENT (LIST PARENT] - (LIST (fetch NODEID of THISNODE) - (APPEND (LIST THISNODE BFNODE RANKNODE) - (CADR LONODES) - (CADR HINODES]) +(CONSTANTS (\BTREEWORDSPERSLOT 4) + (\BTREEMAXCOUNT 8)) ) (DECLARE%: EVAL@COMPILE -(DATATYPE BTREENODE ( - (* ;; "An order-4 BTREE node for representing the piece table for TEdit.") +(DATATYPE BTREENODE + ( + (* ;; "An order-4 BTREE node for representing the piece table for TEdit.") - DOWN1 - (DLEN1 FIXP) - DOWN2 - (DLEN2 FIXP) - DOWN3 - (DLEN3 FIXP) - DOWN4 - (DLEN4 FIXP) - DOWN5 - (DLEN5 FIXP) - DOWN6 - (DLEN6 FIXP) - DOWN7 - (DLEN7 FIXP) - DOWN8 - (DLEN8 FIXP) - SPARE5 (* ; - "Used only to hold the extra piece when we're overflowing") - (SPARELEN FIXP) (* ; "So the code is easy and fast.") - (COUNT BITS 4) (* ; "# of children of this node") - (UPWARD XPOINTER) (* ; "Parent of this node, if any.") - (TOTLEN FIXP) (* ; + DOWN1 DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DOWN8 + DLEN8 (COUNT BYTE) (* ; "# of children of this node. Must not be BITS 4 because \PUTBASEPTR optimizations smash the high-order bits.") + (UPWARD XPOINTER) (* ; "Parent of this node, if any.") + TOTLEN (* ;  "Total length of this tree and subtrees") - )) + )) + +(BLOCKRECORD BTSLOT (DOWN DLEN)) ) (/DECLAREDATATYPE 'BTREENODE - '(POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP POINTER FIXP - POINTER FIXP POINTER FIXP (BITS 4) - XPOINTER FIXP) + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER BYTE XPOINTER POINTER) '((BTREENODE 0 POINTER) - (BTREENODE 2 FIXP) + (BTREENODE 2 POINTER) (BTREENODE 4 POINTER) - (BTREENODE 6 FIXP) + (BTREENODE 6 POINTER) (BTREENODE 8 POINTER) - (BTREENODE 10 FIXP) + (BTREENODE 10 POINTER) (BTREENODE 12 POINTER) - (BTREENODE 14 FIXP) + (BTREENODE 14 POINTER) (BTREENODE 16 POINTER) - (BTREENODE 18 FIXP) + (BTREENODE 18 POINTER) (BTREENODE 20 POINTER) - (BTREENODE 22 FIXP) + (BTREENODE 22 POINTER) (BTREENODE 24 POINTER) - (BTREENODE 26 FIXP) + (BTREENODE 26 POINTER) (BTREENODE 28 POINTER) - (BTREENODE 30 FIXP) - (BTREENODE 32 POINTER) - (BTREENODE 34 FIXP) - (BTREENODE 32 (BITS . 3)) - (BTREENODE 36 XPOINTER) - (BTREENODE 38 FIXP)) - '40) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + (BTREENODE 30 POINTER) + (BTREENODE 32 (BITS . 7)) + (BTREENODE 34 XPOINTER) + (BTREENODE 36 POINTER)) + '38) +(DECLARE%: EVAL@COMPILE -(ADDTOVAR NLAMA ) +(PUTPROPS \NTHSLOT MACRO ((BTREENODE N) + (\ADDBASE BTREENODE (UNFOLD (SUB1 N) + \BTREEWORDSPERSLOT)))) -(ADDTOVAR NLAML ) +(PUTPROPS \NEXTSLOT MACRO ((SLOT) + (\ADDBASE SLOT \BTREEWORDSPERSLOT))) -(ADDTOVAR LAMA ) +(PUTPROPS \PREVSLOT MACRO ((SLOT) + (\ADDBASE SLOT (IMINUS \BTREEWORDSPERSLOT)))) + +(PUTPROPS \LASTSLOT MACRO ((BTNODE) + (\ADDBASE BTNODE (UNFOLD (SUB1 (ffetch (BTREENODE COUNT) of BTNODE)) + \BTREEWORDSPERSLOT)))) + +(PUTPROPS \FIRSTSLOT MACRO ((BTNODE) + BTNODE)) + +(PUTPROPS \MOVESLOT MACRO ((FROMSLOT TOSLOT) + + (* ;; + "Moves the slot information from FROMSLOT to TOSLOT, and also clears FROMSLOT. ") + + (\PUTBASEPTR TOSLOT 0 (ffetch (BTSLOT DOWN) of FROMSLOT)) + (* ; + "Avoid refcnt fiddling (assumes we are uninterruptable)") + (\PUTBASEPTR FROMSLOT 0 NIL) + (freplace (BTSLOT DLEN) of TOSLOT with (ffetch (BTSLOT DLEN) of FROMSLOT)) + (freplace (BTSLOT DLEN) of FROMSLOT with 0))) + +(PUTPROPS \FILLSLOT MACRO ((SLOT DWN DWNL) + (freplace (BTSLOT DOWN) of SLOT with DWN) + (freplace (BTSLOT DLEN) of SLOT with DWNL))) + +(PUTPROPS \FINDSLOT MACRO [(BTNODE ITEM) + (find S inslots BTNODE suchthat (EQ ITEM (ffetch (BTSLOT DOWN) + of S]) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ) + (AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ)) + PC))) +) +(DECLARE%: EVAL@COMPILE + +(I.S.OPR 'inslots NIL '[SUBST (GETDUMMYVAR) + '$$BTBODY + '(bind $$BTBODY _ BODY $$BTEND declare (LOCALVARS $$BTBODY $$BTEND) + first (SETQ I.V. (\FIRSTSLOT $$BTBODY)) + (SETQ $$BTEND (\LASTSLOT $$BTBODY)) + repeatuntil (EQ I.V. $$BTEND) by (\ADDBASE I.V. \BTREEWORDSPERSLOT] + T) + +[I.S.OPR 'inpieces NIL '(first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) + 'PIECE)) by (\DTEST (OR (NEXTPIECE I.V.) + (GO $$OUT)) + 'PIECE] + +[I.S.OPR 'backpieces NIL '(first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) + 'PIECE)) by (\DTEST (OR (PREVPIECE I.V.) + (GO $$OUT)) + 'PIECE] +) + +(* "END EXPORTED DEFINITIONS") + + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \INSURE.VACANT.BTREESLOT MACRO ((BTNODE TEXTOBJ) + (CL:WHEN (EQ \BTREEMAXCOUNT (ffetch (BTREENODE COUNT) + of BTNODE)) + (\MAKE.VACANT.BTREESLOT BTNODE TEXTOBJ)))) +) + + +(ADDTOVAR INSPECTDONTSORTFIELDS BTREENODE) +) + +(/DECLAREDATATYPE 'BTREENODE + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER POINTER BYTE XPOINTER POINTER) + '((BTREENODE 0 POINTER) + (BTREENODE 2 POINTER) + (BTREENODE 4 POINTER) + (BTREENODE 6 POINTER) + (BTREENODE 8 POINTER) + (BTREENODE 10 POINTER) + (BTREENODE 12 POINTER) + (BTREENODE 14 POINTER) + (BTREENODE 16 POINTER) + (BTREENODE 18 POINTER) + (BTREENODE 20 POINTER) + (BTREENODE 22 POINTER) + (BTREENODE 24 POINTER) + (BTREENODE 26 POINTER) + (BTREENODE 28 POINTER) + (BTREENODE 30 POINTER) + (BTREENODE 32 (BITS . 7)) + (BTREENODE 34 XPOINTER) + (BTREENODE 36 POINTER)) + '38) + +(RPAQ? MULTIPLE-PIECE-TABLES T) + + + +(* ; "Experimentation") + +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS MULTIPLE-PIECE-TABLES) +) +(DEFINEQ + +(\MAKEPCTB + [LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2023 12:41 by rmk") + (* ; "Edited 31-Oct-2023 10:09 by rmk") + (* ; "Edited 8-Sep-2023 16:30 by rmk") + (* ; "Edited 26-Apr-2023 14:03 by rmk") + (* ; "Edited 3-Oct-2022 20:40 by rmk") + (* ; "Edited 15-Apr-93 15:48 by jds") + + (* ;; "Refreshes TEXTOBJ to an initial empty state, e.g. for \TEDIT.INSTALL.NEWPIECES") + + (LET ((NODE (create BTREENODE + COUNT _ 1 + TOTLEN _ 0 + DLEN1 _ 0))) + (replace (BTREENODE DOWN1) of NODE + with (create PIECE + PTYPE _ THINSTRING.PTYPE + PCONTENTS _ (CONCAT "") + PBYTESPERCHAR _ 1 + PLEN _ 0 + PTREENODE _ NODE + PLOOKS _ (GETTOBJ TEXTOBJ DEFAULTCHARLOOKS) + PPARALOOKS _ (GETTOBJ TEXTOBJ FMTSPEC))) + (FSETTOBJ TEXTOBJ LASTPIECE (ffetch (BTREENODE DOWN1) of NODE)) + (FSETTOBJ TEXTOBJ HINTPC NIL) + (FSETTOBJ TEXTOBJ TEXTLEN 0) + (FSETTOBJ TEXTOBJ PCTB (CONS NODE]) + +(\UPDATEPCNODES + [LAMBDA (PC DELTA TEXTOBJ) (* ; "Edited 10-Jun-2023 00:18 by rmk") + (* ; "Edited 8-Jun-2023 23:03 by rmk") + (* ; "Edited 21-Apr-93 16:09 by jds") + + (* ;; + "The size of the text represented by PC has grown by DELTA (negative if text is being deleted).") + + (* ;; "For insertions, this is called by either \INSERTPIECE, if a new piece is being inserted, or by \INSERTCH.EXTEND if the insertion is a string insertion physically adjacent to a previous insertion.") + + (* ;; "It is assumed that PC PLEN and the corresponding DLEN in its node are consistent and correct, this updates the local TOTLEN and then propagates the DELTA upwards to all ancestors.") + + (* ;; "This deliberately does not check for the validity of the btree, since callers are responsible for some aspects of validity (like the HINTPC). Callers are responsible for bracketing this with validity checks.") + + (bind NODE UPWARD first (SETQ NODE (ffetch (PIECE PTREENODE) of PC)) + (SETQ UPWARD (ffetch (BTREENODE UPWARD) of NODE)) + (add (ffetch (BTREENODE TOTLEN) of NODE) + DELTA) while UPWARD do (add (ffetch (BTSLOT DLEN) + of (\FINDSLOT UPWARD NODE)) + DELTA) + (add (ffetch (BTREENODE TOTLEN) of UPWARD) + DELTA) + (SETQ NODE UPWARD) + (SETQ UPWARD (ffetch (BTREENODE UPWARD) + of NODE)) + finally (add (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ) + DELTA]) + +(\FIRSTPIECE + [LAMBDA (TEXTOBJ) (* ; "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) + 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).") + + (RETURN (CL:UNLESS (EQ NODE (FGETTOBJ TEXTOBJ LASTPIECE)) + NODE]) + +(\DELETETREE + [LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 31-Oct-2023 10:23 by rmk") + (* ; "Edited 26-Oct-2023 12:50 by rmk") + (* ; "Edited 30-May-2023 08:58 by rmk") + (* ; "Edited 5-Sep-2022 14:24 by rmk") + (* ; + "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") + + (* ;; + "Old can be a piece or a node, since its length is taken from the commonly correlated DLEN.") + + (* ;; "NOTE: On entry the lengths of the nodes may have been adjusted to anticipate the deletion, in which case the tree is in an inconsistent state (BTVALIDATE will fail). But this should restore the correctness, BTVALIDATE should be OK on exit.") + + (FSETTOBJ TEXTOBJ HINTPC NIL) + (if (EQ 1 (ffetch (BTREENODE COUNT) of PCNODE)) + then + (* ;; "OLD was the last child, delete the whole node") + + (\DELETETREE PCNODE (fetch (BTREENODE UPWARD) of PCNODE) + TEXTOBJ) + else + (* ;; "Move each of the downs above OLDSLOT forward one slot") + + (UNINTERRUPTABLY + + (* ;; "Slide everything after OLD's slot one slot to the left") + + (bind TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE)) + first (SETQ OLDSLOT (\FINDSLOT PCNODE OLD)) + (CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE")) + (CL:WHEN (EQ OLDSLOT LAST) (* ; "Just shrink by one") + (\FILLSLOT OLDSLOT NIL 0) + (GO $$OUT)) + (SETQ TARGET OLDSLOT) until (EQ TARGET LAST) do (\MOVESLOT (\NEXTSLOT TARGET) + TARGET) + (SETQ TARGET (\NEXTSLOT + TARGET)) + finally + + (* ;; + "Make PCNODE consistent with this removal, \DELETEPIECES will fix things up above.") + + (* ;; "If we recursed up the 1-entry branch above, we ended higher up, and every thing between that dangling piece and a node with at least 2 entries is gone. Those nodes are still accessible from the piece, and \UPDATEPCNODES will climb up and adjust them needlessly. But it will eventually get to the ones that matter. Otherwise, \UPDATEPCNODES would have to worry about nodes vs pieces.") + + (add (ffetch (BTREENODE COUNT) of PCNODE) + -1)))]) + +(\INSERTTREE + [LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk") + (* ; "Edited 25-Nov-2023 12:24 by rmk") + (* ; "Edited 31-Oct-2023 11:04 by rmk") + (* ; "Edited 9-Jun-2023 22:33 by rmk") + (* ; "Edited 29-May-2023 23:42 by rmk") + (* ; "Edited 16-Sep-2022 12:52 by rmk") + (* ; + "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") + + (* ;; "Inserts NEW in front of NEXT in NEXT's parent. NEW/NEXT are pieces or nodes. The caller guarantees that the parent has at least one empty slot.. ") + + (* ;; "This should be run uninterruptably, together with whatever is needed to adjust the total length. This by itself may leave the upper lengths in an invalid state.") + + (* ;; "") + + (FSETTOBJ TEXTOBJ HINTPC NIL) + (LET [NEXTSLOT (PARENT (CL:IF (type? PIECE NEXT) + (FGETPC NEXT PTREENODE) + (ffetch (BTREENODE UPWARD) of NEXT))] + (SETQ NEXTSLOT (\FINDSLOT PARENT NEXT)) + + (* ;; "Bump the count after finding the slot, to open up the trailing slot") + + (add (ffetch (BTREENODE COUNT) of PARENT) + 1) + + (* ;; "Move the contents of NEXTSLOT and later slots backwards") + + (for (S _ (\LASTSLOT PARENT)) + PREV by PREV do (SETQ PREV (\PREVSLOT S)) + (\MOVESLOT PREV S) repeatuntil (EQ PREV NEXTSLOT)) + + (* ;; "Insert NEW into the slot now vacated by NEXT, and adjust the TOTLENs") + + (\FILLSLOT NEXTSLOT NEW (if (type? BTREENODE NEW) + then (freplace (BTREENODE UPWARD) of NEW with PARENT) + (ffetch (BTREENODE TOTLEN) of NEW) + else (FSETPC NEW PTREENODE PARENT) + (PLEN NEW))) + + (* ;; "The tree now contains the insert, whether a new piece or a split of an old one. The counts, PLEN and DLEN, and the total TOTLEN are consistent at this level and below, but the caller is responsible for making sure (also uninterruptably) that any length adjustments are propagated upwards.") + + NEW]) + +(\LASTPIECE + [LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 10:20 by rmk") + (* ; "Edited 12-Apr-2023 19:23 by rmk") + (* ; "Edited 21-Aug-2022 17:13 by rmk") + (* ; "Edited 16-Aug-2022 10:16 by rmk") + (* ; "Edited 14-Apr-93 16:29 by jds") + + (* ;; "Returns the LASTPIECE by running down the right side of the B-tree. Should be the same as (fetch LASTPIECE of TEXTOBJ). Argument can also be a node.") + + (bind [CHILD _ (CAR (LAST (GETTOBJ TEXTOBJ PCTB] while (type? BTREENODE CHILD) + do (SETQ CHILD (ffetch (BTSLOT DOWN) of (\LASTSLOT CHILD))) finally (RETURN CHILD]) + +(\MATCHPCS + [LAMBDA (NODE) (* ; "Edited 17-Aug-2022 19:03 by rmk") + (* ; "Edited 15-Aug-2022 23:06 by rmk") + (* ; "Edited 5-May-93 17:57 by jds") + + (* ;; "Make sure that any downs pointed to by this node point back to this node.") + + (for S DOWN inslots NODE do (SETQ DOWN (ffetch (BTSLOT DOWN) of S)) + (if (type? PIECE DOWN) + then (freplace (PIECE PTREENODE) of DOWN with NODE) + elseif (type? BTREENODE DOWN) + then (freplace (BTREENODE UPWARD) of DOWN with NODE]) + +(\PCTOCH + [LAMBDA (PC TEXTOBJ) (* ; "Edited 31-Oct-2023 21:05 by rmk") + (* ; "Edited 21-Oct-2023 11:54 by rmk") + (* ; "Edited 19-Aug-2022 22:58 by rmk") + (* ; "Edited 18-Aug-2022 13:48 by rmk") + (* ; "Edited 8-Aug-2022 21:50 by rmk") + + (* ;; "This returns the character number in the text stream of the first character of PC. Equivalent to mapping through the next chains from the beginning, but only needs to visit the BNODES above and to the left, so more logarithmic than linear.") + + (* ;; "This allows for the possibility that the PCTB is a list of BTREE nodes spread out to avoid lots of big-fixp allocation and deallocation in \UPDATEPCNODES.") + + (* ;; "The initial PC is guaranteed to have a PTREENODE--it doesn't make sense for this to be called on a piece that is not yet in a tree. Such a piece does not have a char count. So the loop is executed at least once.") + + (* ;; "PREV starts at a piece, becomes higher BTREENODEs.") + + (bind (PREV _ PC) + (PCNODE _ (FGETPC PC PTREENODE)) + (CHARCOUNT _ 1) do (add CHARCOUNT (for S inslots PCNODE + until (EQ PREV (ffetch (BTSLOT DOWN) of S)) + sum (ffetch (BTSLOT DLEN) of S))) + (SETQ PREV PCNODE) + (SETQ PCNODE (ffetch (BTREENODE UPWARD) of PCNODE)) repeatwhile PCNODE + finally (RETURN (IPLUS CHARCOUNT (for TOPNODE in (FGETTOBJ TEXTOBJ PCTB) + until (EQ TOPNODE PREV) sum (ffetch (BTREENODE TOTLEN) + of TOPNODE]) + +(\CHTOPC + [LAMBDA (CH# TEXTOBJ TELL-PC-START?) (* ; "Edited 4-Nov-2023 17:56 by rmk") + (* ; "Edited 1-Nov-2023 23:29 by rmk") + (* ; "Edited 13-Apr-2023 22:22 by rmk") + (* ; "Edited 12-Apr-2023 09:49 by rmk") + (* ; "Edited 5-Apr-2023 15:52 by rmk") + (* ; "Edited 11-Sep-2022 13:24 by rmk") + (* ; "Edited 15-Apr-93 16:05 by jds") + + (* ;; "Given a character # in a text object, return a pointer to the piece containing that character, else NIL.") + + (* ;; "The basic algorithm is a logarithmic scan of the B-tree, skipping branches at each level until the branch with CH# is reached.") + + (* ;; "There are 2 acceleration cases:") + + (* ;; " if CH# is after the current text length, the pseudo LASTPIECE is returned to the caller wo can retrieve its looks and PREV (the piece containing the last actual character.") + + (* ;; " If the TEXTOBJ contains a HINTPC and CH# is in the range HINTPCSTARTCH# and HINTPCSTARTCH#+PLEN-1, then HINTPC is returned. Others may cache that, but we cache it here too for repeated sequential calls.") + + (* ;; "If TELL-PC-START? is not NIL, sets the free variable START-OF-PIECE to the ch# of the piece's start.") + + (DECLARE (USEDFREE START-OF-PIECE)) + (LET + (HINTPC STARTCH) + (if (IGREATERP CH# (FGETTOBJ TEXTOBJ TEXTLEN)) + then (CL:WHEN TELL-PC-START? + (SETQ START-OF-PIECE (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN)))) + (FGETTOBJ TEXTOBJ LASTPIECE) + elseif (AND (SETQ HINTPC (FGETTOBJ TEXTOBJ HINTPC)) + (IGEQ CH# (SETQ STARTCH (FGETTOBJ TEXTOBJ HINTPCSTARTCH#))) + (ILESSP (IDIFFERENCE CH# STARTCH) + (PLEN HINTPC))) + then (CL:WHEN TELL-PC-START? (SETQ START-OF-PIECE STARTCH)) + HINTPC + elseif (ILEQ CH# 0) + then (CL:WHEN TELL-PC-START? (SETQ START-OF-PIECE 0)) + NIL + else (if MULTIPLE-PIECE-TABLES + then (LET ((ALLPRIOR 0) + BASE-NODE START) + + (* ;; "When PCTB is a list of top-level BTNODES, we find the sub-tree that contains the global CH# piece, sum the TOTLEN's of all prior top-level nodes, retrieve the piece from the identified subtree after adjusting to its LOCAL#. START-OF-PIECE, if required, is globally correct.") + + (* ;; "This is a performance optimization for \UPDATEPCNODES in the case of building a textstream for a large file (longer than MAXSMALLP characters) by successive BOUT's at the end (e.g. seeing a large Lisp source file). Also look at the LASTPIECE case above. Also look at \INSERTPIECE.") + + (for old BASE-NODE NEXT in (FGETTOBJ TEXTOBJ PCTB) + do (SETQ NEXT (IPLUS ALLPRIOR (ffetch (BTREENODE TOTLEN) of BASE-NODE))) + (CL:WHEN (ILEQ CH# NEXT) (* ; "Found it") + (RETURN)) + (SETQ ALLPRIOR NEXT)) + (bind (LOCALCH# _ (IDIFFERENCE CH# ALLPRIOR)) + (NODE _ BASE-NODE) + (BASE-CH# _ 1) + NBASE-CH# while (type? BTREENODE NODE) + do [SETQ NODE (for S inslots NODE + do (SETQ NBASE-CH# (IPLUS BASE-CH# (ffetch (BTSLOT + DLEN) + of S))) + (if (IGREATERP NBASE-CH# LOCALCH#) + then (RETURN (ffetch (BTSLOT DOWN) of S)) + else (SETQ BASE-CH# NBASE-CH#] + finally + + (* ;; + "Eventually NODE is a piece or NIL. We cache what we just found.") + + (FSETTOBJ TEXTOBJ HINTPC NODE) + (SETQ START (IPLUS BASE-CH# ALLPRIOR)) + (FSETTOBJ TEXTOBJ HINTPCSTARTCH# START) + (CL:WHEN TELL-PC-START? (SETQ START-OF-PIECE START)) + (RETURN NODE))) + else (bind (NODE _ (CAR (FGETTOBJ TEXTOBJ PCTB))) + (BASE-CH# _ 1) + NBASE-CH# START while (type? BTREENODE NODE) + do [SETQ NODE (for S inslots NODE + do (SETQ NBASE-CH# (IPLUS BASE-CH# (ffetch (BTSLOT DLEN) + of S))) + (if (IGREATERP NBASE-CH# CH#) + then (RETURN (ffetch (BTSLOT DOWN) of S)) + else (SETQ BASE-CH# NBASE-CH#] + finally + + (* ;; "Eventually NODE is a piece or NIL") + + (FSETTOBJ TEXTOBJ HINTPC NODE) + (FSETTOBJ TEXTOBJ HINTPCSTARTCH# BASE-CH#) + (CL:WHEN TELL-PC-START? (SETQ START-OF-PIECE BASE-CH#)) + (RETURN NODE]) + +(\TEDIT.SET-TOTLEN + [LAMBDA (PCNODE) (* ; "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) + (replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN) + of S]) + +(\MAKE.VACANT.BTREESLOT + [LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk") + (* ; "Edited 31-Oct-2023 10:32 by rmk") + (* ; "Edited 10-Jun-2023 00:13 by rmk") + (* ; "Edited 30-May-2023 12:11 by rmk") + (* ; "Edited 16-Sep-2022 12:52 by rmk") + (* ; + "Edited 21-Mar-95 15:29 by sybalsky:mv:envos") + + (* ;; "Insures that BTNODE has at least one vacant slot. TEXTOBJ is needed if we have to add a new root node.") + + (* ;; "The intent here is that the tree is valid whenever the code is interruptable (an interrupt should never leave the tree in a trashed state.)") + + (BTVALIDATE '\MAKE.VACANT.BTREESLOT 'START TEXTOBJ) + (CL:WHEN (EQ \BTREEMAXCOUNT (fetch (BTREENODE COUNT) of BTNODE)) + + (* ;; "All the slots of BTNODE are full. We create PREFIXNODE to hold the lower lower half of BTNODE's slots, and install that as the left sister of BTNODE in its parent (perhaps first creating empty space in the parent if it is also full). The remaining slots of BTNODE are shifted down to its front. We first have to make sure that the parent has room for PREFIXNODE.") + + (* ;; "Note that we only have to worry about count-consistency locally, since we are not really adding or subtracting, just moving things between levels.") + + (* ;; "PREFIXNODE will hold the first half of the entries in BTNODE, SUFFIXNODE will hold the trailing entries (moved to the beginning). In the end they will be the only items in BTNODE.") + + (LET (PREFIXNODE (PARENT (ffetch (BTREENODE UPWARD) of BTNODE)) + (PREFIXTOTLEN 0) + (HALFCOUNT (FOLDLO (ffetch (BTREENODE COUNT) of BTNODE) + 2))) + + (* ;; "") + + (if PARENT + then (\INSURE.VACANT.BTREESLOT PARENT TEXTOBJ) + (* ; + "Make sure the parent has room for the coming PREFIXNODE") + (SETQ PARENT (ffetch (BTREENODE UPWARD) of BTNODE)) + (* ; + "It seems that the new root parent doesn't always propagate--don't know why.") + else + (* ;; "We reached the root, add a new root node containing only BTNODE and its TOTLEN. BTNODE's now has a parent with maxcount-1 empty slots.") + + (SETQ PARENT (create BTREENODE + COUNT _ 1 + TOTLEN _ (fetch (BTREENODE TOTLEN) of BTNODE))) + (\FILLSLOT (\FIRSTSLOT PARENT) + BTNODE + (fetch (BTREENODE TOTLEN) of BTNODE)) + (UNINTERRUPTABLY + (replace (BTREENODE UPWARD) of BTNODE with PARENT) + (RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB)) + (HELP "BTNODE NOT FOUND")) + PARENT))) + + (* ;; "Tree is still valid, but PARENT how has a needed empty slot.") + + (* ;; "") + + (* ;; "We now go uninterruptable to redistribute the slots in BTNODE. ") + + (SETQ PREFIXNODE (create BTREENODE + COUNT _ HALFCOUNT)) + (UNINTERRUPTABLY + + (* ;; "The lower entries of BTNODE become the lower entries of a new PREFIXNODE and are deleted from BTNODE. The HALFCOUNT count stops the iteration. ") + + (for PRSLOT DOWN inslots PREFIXNODE as (BTSLOT _ (\FIRSTSLOT BTNODE)) + by (\NEXTSLOT BTSLOT) do + (* ;; "\MOVESLOT doesn't just copy, it smashes the source-slot to avoid refcount trafficking. Does this matter?") + + (\MOVESLOT BTSLOT PRSLOT) + (add PREFIXTOTLEN (ffetch (BTSLOT DLEN) of PRSLOT)) + (SETQ DOWN (ffetch (BTSLOT DOWN) of PRSLOT)) + (if (type? PIECE DOWN) + then (freplace (PIECE PTREENODE) of DOWN + with PREFIXNODE) + else (freplace (BTREENODE UPWARD) of DOWN with + PREFIXNODE + ))) + (freplace (BTREENODE TOTLEN) of PREFIXNODE with PREFIXTOTLEN) + + (* ;; "") + + (* ;; + "Prefix node by itself is complete and valid. Adjust BTNODE to reflect that items were removed.") + + (freplace (BTREENODE COUNT) of BTNODE with HALFCOUNT) + (add (ffetch (BTREENODE TOTLEN) of BTNODE) + (IMINUS PREFIXTOTLEN)) + (freplace (BTSLOT DLEN) of (\FINDSLOT PARENT BTNODE) with (ffetch (BTREENODE TOTLEN) + of BTNODE)) + + (* ;; "Shift the remaining slots in BTNODE to the front") + + (for SUSLOT inslots BTNODE as BTSLOT inslots (\NTHSLOT BTNODE (ADD1 HALFCOUNT)) + do (\MOVESLOT BTSLOT SUSLOT)) + + (* ;; "") + + (* ;; "Finally, add PREFIXNODE in front of BTNODE in its PARENT.") + + (\INSERTTREE PREFIXNODE BTNODE TEXTOBJ)) + + (* ;; "") + + (BTVALIDATE '\MAKE.VACANT.BTREESLOT 'END TEXTOBJ)))]) + +(\LINKNEWPIECE + [LAMBDA (NEW NEXT TEXTOBJ) (* ; "Edited 29-May-2023 23:16 by rmk") + + (* ;; "Set up the linear-chain links to insert the piece NEW in front of the piece NEXT in its piece-chain. This doesn't deal with the btree.") + + (* ;; "NEXT=NIL denotes the last piece LASTPIECE of TEXTOBJ whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece of the text stream.") + + (CL:UNLESS NEXT + (SETQ NEXT (ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ))) + (LET ((NEXTPREV (PREVPIECE NEXT))) + (freplace (PIECE NEXTPIECE) of NEW with (CL:UNLESS (\LASTPIECEP NEXT TEXTOBJ) + NEXT)) + (* ; "NIL for last piece") + (freplace (PIECE PREVPIECE) of NEW with NEXTPREV) (* ; + "Do the new piece first, interrupts OK") + (UNINTERRUPTABLY + (* ; + "Smash existing pieces uninterruptably") + (CL:WHEN NEXTPREV (* ; "Not at the very beginning?") + (freplace (PIECE NEXTPIECE) of NEXTPREV with NEW)) + (freplace (PIECE PREVPIECE) of NEXT with NEW)) + NEW]) + +(\UNLINKPIECE + [LAMBDA (PREV PC TEXTOBJ) (* ; "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?) + (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]) + +(\SPLITPIECE + [LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 28-Dec-2023 22:17 by rmk") + (* ; "Edited 7-Dec-2023 21:07 by rmk") + (* ; "Edited 25-Nov-2023 11:50 by rmk") + (* ; "Edited 31-Oct-2023 10:42 by rmk") + (* ; "Edited 27-Jul-2023 08:38 by rmk") + (* ; "Edited 30-May-2023 00:06 by rmk") + (* ; "Edited 21-Apr-93 17:49 by jds") + + (* ;; "CHOFFSET is a character offset in PC. This modifes PC if necessary so that the character at offset CHOFFST is translated to offset 0. If PC is modified, a new piece is created for the characters of its truncated prefix (characters from original 0 to original (SUB1 CHNO)). The new piece is linked into the piece sequence (as the PREVPIECE of PC), and the original PC (possibly shortened) is returned. ") + + (* ;; "Whether or not a new prev piece is created, on return it is always the case that the character that was at CHOFFSET in PC is now at offset 0 in PC.") + + (* ;; "") + + (BTVALIDATE '\SPLITPIECE 'START TEXTOBJ) + (CL:WHEN (AND PC (IGREATERP CHOFFSET 0)) (* ; "Nothing to do if asking for 0.") + (FSETTOBJ TEXTOBJ HINTPC NIL) + (\INSURE.VACANT.BTREESLOT (FGETPC PC PTREENODE) + TEXTOBJ) (* ; + "Do this before reducing PC, so tree remains valid") + (LET [(PREVPC (create PIECE using PC PPARALAST _ NIL PLEN _ CHOFFSET PBYTELEN _ + (ITIMES (PBYTESPERCHAR PC) + CHOFFSET] (* ; + "There can be no para break before the split, as things now work.") + + (* ;; "PREVPC is the prefix before the split point of length CHOFFSET, PC will be the suffix, a shortened version of a piece that was already in the piece tree.") + + (CL:UNLESS (MEMB (PTYPE PC) + (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")) + + (* ;; "") + + (UNINTERRUPTABLY + (SELECTC (PTYPE PC) + (STRING.PTYPES (* ; + "Adjust the offsets and lengths for strings") + (FSETPC PREVPC PCONTENTS (SUBSTRING (PCONTENTS PC) + 1 CHOFFSET)) + (FSETPC PC PCONTENTS (SUBSTRING (PCONTENTS PC) + (ADD1 CHOFFSET)))) + (FILE.PTYPES (ADD (PFPOS PC) + (ITIMES CHOFFSET (PBYTESPERCHAR PC)))) + NIL) + + (* ;; " PREVPC is now complete, and PC's character pointers are correct .") + + (* ;; " PC itself must now be shortened, including its DLEN in its parent.We don't have to propagate upwards here, because this is all length-conserving..") + + (change (PLEN PC) + (IDIFFERENCE DATUM CHOFFSET)) + (FSETPC PC PBYTELEN (ITIMES (PBYTESPERCHAR PC) + (PLEN PC))) + (freplace (BTSLOT DLEN) of (\FINDSLOT (FGETPC PC PTREENODE) + PC) with (PLEN PC)) + + (* ;; "Insert PREVPC into the piece tree in front of PC. ") + + (\INSERTTREE PREVPC PC TEXTOBJ) + (\LINKNEWPIECE PREVPC PC)) + (BTVALIDATE '\SPLITPIECE 'AFTER-INSERTPIECE TEXTOBJ))) + PC]) + +(\INSERTPIECE + [LAMBDA (NEWPC NEXTPC TEXTOBJ) (* ; "Edited 7-Dec-2023 21:07 by rmk") + (* ; "Edited 31-Oct-2023 23:05 by rmk") + (* ; "Edited 9-Jun-2023 22:40 by rmk") + (* ; "Edited 3-Jun-2023 20:23 by rmk") + (* ; "Edited 29-May-2023 23:23 by rmk") + + (* ;; "Insert the piece NEWPC in front of the piece NEXTPC. At the end, NEWPC appears before NEXTPC in the piece tree, and all counts and lengths are consistent.") + + (* ;; "The last piece LASTPIECE is always a piece in the last node whose NEXTPIECE is NIL and whose PREVPIECE is always the last real piece in the chain. But the lastpiece has its rightful place in the tree.") + + (* ;; "Caller guarantees that the chain links of NEW can be smashed.") + + (BTVALIDATE '\INSERTPIECE 'START TEXTOBJ) + (FSETTOBJ TEXTOBJ HINTPC NIL) + (CL:UNLESS NEXTPC + (SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))) + (CL:WHEN (AND MULTIPLE-PIECE-TABLES (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))) + (* ; "Inserting at the very end") + (LET ((PCTB (FGETTOBJ TEXTOBJ PCTB)) + LASTTREECONS) + + (* ;; "If the TOTLEN of the currently final top-level tree would go above MAX.SMALLP, we create a new tree that contains only the empty last piece. The last piece is also hanging on the last branch of the previous tree, but it should never be encountered.") + + (SETQ LASTTREECONS (LAST PCTB)) + (CL:WHEN (IGEQ (IPLUS (PLEN NEWPC) + (ffetch (BTREENODE TOTLEN) of (CAR LASTTREECONS))) + (SUB1 MAX.SMALLP)) + + (* ;; "Make this uninterruptable. We know that NEXTPC is the zero-PLEN last piece, so no need for \UPDATEPCNODES to fix the lengths.") + + (\DELETETREE NEXTPC (FGETPC NEXTPC PTREENODE) + TEXTOBJ) + [RPLACD LASTTREECONS + (SETQ LASTTREECONS + (CONS (create BTREENODE + COUNT _ 1 + TOTLEN _ 0 + DLEN1 _ 0 + DOWN1 _ NEXTPC] + (FSETPC NEXTPC PTREENODE (CAR LASTTREECONS)) + (FSETTOBJ TEXTOBJ PCTB PCTB)))) + (\INSURE.VACANT.BTREESLOT (FGETPC NEXTPC PTREENODE) + TEXTOBJ) + (UNINTERRUPTABLY + (\INSERTTREE NEWPC NEXTPC TEXTOBJ) + (\LINKNEWPIECE NEWPC NEXTPC TEXTOBJ) + (\UPDATEPCNODES NEWPC (PLEN NEWPC) + TEXTOBJ)) + (BTVALIDATE '\INSERTPIECE 'END TEXTOBJ) + NEWPC]) + +(\INSERTPIECES + [LAMBDA (PIECES NEXTPC TEXTOBJ) (* ; "Edited 7-Dec-2023 21:08 by rmk") + (* ; "Edited 25-Nov-2023 12:03 by rmk") + (* ; "Edited 5-Sep-2023 21:36 by rmk") + (* ; "Edited 29-Aug-2023 11:09 by rmk") + (* ; "Edited 2-Jul-2023 16:35 by rmk") + (* ; "Edited 3-Jun-2023 20:53 by rmk") + (* ; "Edited 21-May-2023 21:00 by rmk") + + (* ;; "Inserts the piece-chain PIECES in front of existing NEXTPC in TEXTOBJ. This assumes that the piece-chain is already linked, that the nextpiece of the final piece in the chain is initially NIL but ends up pointing to NEXTPC (or NIL if it is the last piece).") + + (CL:WHEN PIECES + (\DTEST TEXTOBJ 'TEXTOBJ) + (FSETTOBJ TEXTOBJ HINTPC NIL) + (FSETTOBJ TEXTOBJ \DIRTY T) + (CL:UNLESS NEXTPC + (SETQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE))) + (for PC (PREVPC _ (PREVPIECE NEXTPC)) inpieces PIECES + do + (* ;; "This is a variant of \INSERTPIECE specialized for filling in an empty TEXTOBJ from a piece chain. Insertion always happens before NEXTPC, and the chain-links are not smashed. ") + + (* ;; "This may not be safe against interruptions, for a TEXTOBJ that the user already has (called from \INSERTSELPIECES). The pieces that are inserted into the tree have links do so far uninserted pieces. Maybe the loop itself should be uninterruptable.") + + (UNINTERRUPTABLY + (\INSURE.VACANT.BTREESLOT (FGETPC NEXTPC PTREENODE) + TEXTOBJ) + (\INSERTTREE PC NEXTPC TEXTOBJ) + (\UPDATEPCNODES PC (PLEN PC) + TEXTOBJ)) finally + + (* ;; "PC is the final piece of the chain") + + (CL:UNLESS (EQ NEXTPC (FGETTOBJ TEXTOBJ LASTPIECE)) + (FSETPC PC NEXTPIECE NEXTPC)) + (FSETPC NEXTPC PREVPIECE PC) + (CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PIECES)) + (FSETPC PIECES PREVPIECE PREVPC))) + PIECES]) + +(\DELETEPIECES + [LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 25-Nov-2023 12:12 by rmk") + (* ; "Edited 4-Nov-2023 23:03 by rmk") + (* ; "Edited 22-Oct-2023 11:43 by rmk") + (* ; "Edited 5-Sep-2023 22:32 by rmk") + (* ; "Edited 8-Jun-2023 23:12 by rmk") + (* ; "Edited 3-Jun-2023 22:44 by rmk") + (* ; "Edited 30-May-2023 08:57 by rmk") + (* ; "Edited 20-Apr-93 19:06 by jds") + + (* ;; "As the PC is deleted from the tree on each iteration, the original previous PREV piece is linked to PC's next, and the next PREVPIECE is linked to PREV so that the tree and the links are uninterruptably consistent.") + + (* ;; "PREV is NIL if SPFIRST=\FIRSTPIECE; in that case the tree itself manages the connection. If SPLAST is the final actual piece (its NEXTPIECE is NIL), then LASTPIECE's PREVPIECE will be updated.") + + (* ;; " Since the pieces are not unlinked on the fly, the tree may be invalid until all the pieces are gone.") + + (* ;; "This may not be entirely safe against an interrupt, which only matters on the call from \INSERTSELPIECES (otherwise the data isn't yet visible). Although the tree is consistent with the remaining pieces after each deletion, the fact that we keep the SELPIECE links intact means that the remaining pieces point to pieces that are no longer in the tree. We could do a little more work to incrementally chain the deleted pieces together, one by one, as they are deleted--in the end they would all be out of the tree, and the deletion chain would have been reconnected. Alternatively, we can make the whole loop be uninterruptable. ") + + (BTVALIDATE '\DELETEPIECES 'BEFORE TEXTOBJ) + (for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL) + (SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES))) + (* ; "For incremental chain-update") + (SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES)) + (FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES + do (UNINTERRUPTABLY + (\UPDATEPCNODES PC (IMINUS (PLEN PC)) + TEXTOBJ) + (\DELETETREE PC (FGETPC PC PTREENODE) + TEXTOBJ) + + (* ;; "This piece and its lengths are out of the tree, but its chain-links are still there. To keep the tree valid at each point, we incrementally splice it out.") + + (CL:WHEN PREV (* ; "Not at the very beginning") + (FSETPC PREV NEXTPIECE (NEXTPIECE PC))) + (FSETPC NEXT PREVPIECE PREV)) finally + + (* ;; + "TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.") + + (FSETPC (fetch (SELPIECES SPFIRST) of SELPIECES) + PREVPIECE NIL) + (FSETPC (fetch (SELPIECES SPLAST) of SELPIECES) + NEXTPIECE NIL)) + (BTVALIDATE '\DELETEPIECES 'AFTER TEXTOBJ]) + +(\ALIGNEDPIECE + [LAMBDA (CHNO TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk") + (* ; "Edited 29-May-2023 23:48 by rmk") + (* ; "Edited 20-May-2023 13:53 by rmk") + (* ; "Edited 3-May-2023 18:47 by rmk") + (* ; "Edited 21-Apr-93 17:49 by jds") + + (* ;; "CHNO is a character offset in the text. If CHNO is not the beginning of a piece, this modifies the piecetable so that it is. If the piece table is modified, a new piece is created for the characters before CHNO (characters from original 0 to original (SUB1 CHNO)), and the original piece is shortened so that it no longer includes those characters. The new piece is linked into the piece sequence. ") + + (* ;; "The return is the (possibly shortened) original piece with character CHNO now at offset 0. Its PREVPIECE may or may not be new. ") + + (if (IGREATERP CHNO (FGETTOBJ TEXTOBJ TEXTLEN)) + then + (* ;; "Doesn't return NIL in this case, returns the last piece.") + + (FGETTOBJ TEXTOBJ LASTPIECE) + elseif (ILEQ CHNO 1) + then (\FIRSTPIECE TEXTOBJ) + else (LET (PC START-OF-PIECE) + (DECLARE (SPECVARS START-OF-PIECE)) + (SETQ PC (\CHTOPC CHNO TEXTOBJ T)) + (CL:UNLESS (IEQP CHNO START-OF-PIECE) (* ; + "There can be no para break before the split, as things now work.") + (\SPLITPIECE PC (IDIFFERENCE CHNO START-OF-PIECE) + TEXTOBJ)) + PC]) +) + + + +(* ; "Debugging ") + +(DEFINEQ + +(BTVALIDATE + [LAMBDA (TAG MSG TOBJ PRINT) (* ; "Edited 8-Jun-2023 22:05 by rmk") + (* ; "Edited 3-Jun-2023 17:14 by rmk") + (* ; "Edited 29-Aug-2022 12:10 by rmk") + (DECLARE (SPECVARS TEXTOBJ MSG TAG)) + (CL:WHEN (OR (EQMEMB TAG BTVALIDATETAGS) + (NULL TAG) + (EQMEMB 'ALL BTVALIDATETAGS)) + [LET (DEPTHHIST COUNTHIST PLENHIST (NNODES 0) + (NPIECES 0)) + (DECLARE (SPECVARS DEPTHHIST COUNTHIST NNODES NPIECES PLENHIST)) + (PROG1 [CHECK-BTREE (if TOBJ + then (TEXTOBJ TOBJ) + else (OR (AND (NEQ (GETATOMVAL 'TEXTOBJ) + (EVALV 'TEXTOBJ)) + (TEXTOBJ (EVALV 'TEXTOBJ) + T)) + (TEXTOBJ (WHICHW) + T) + (TEXTOBJ (EVALV 'LASTTESTSTREAM) + T) + (ERROR "NOT A TEXTOBJ"] + (CL:WHEN PRINT (BTVALIDATE.PRINT)))])]) + +(BTVALIDATE.PRINT + [LAMBDA NIL (* ; "Edited 30-May-2023 09:37 by rmk") + (DECLARE (USEDFREE DEPTHHIST COUNTHIST NNODES NPIECES PLENHIST)) + (SETQ DEPTHHIST (SORT DEPTHHIST T)) + (SETQ COUNTHIST (SORT COUNTHIST T)) + (SETQ PLENHIST (SORT PLENHIST T)) + (PRINTOUT T "Number of nodes: " NNODES T "Number of pieces: " NPIECES T "Minimum depth: " + (CAAR DEPTHHIST) + T "Maximum depth: " (CAAR (LAST DEPTHHIST)) + T "Average depth: " .F3.1 (FQUOTIENT (for DH in DEPTHHIST sum (TIMES (CAR DH) + (CDR DH))) + NPIECES) + T "Maximum count: " (CAAR (LAST COUNTHIST)) + T "Average count: " .F1.2 (FQUOTIENT (for CH in COUNTHIST sum (TIMES (CAR CH) + (CDR CH))) + NNODES) + T "Average PLEN: " .F5.1 (FQUOTIENT (for PLH in PLENHIST sum (TIMES (CAR PLH) + (CDR PLH))) + NPIECES) + T "Maximum PLEN: " .I3 (CAAR (LAST PLENHIST)) + T]) + +(CHECK-BTREE + [LAMBDA (TEXTOBJ EMBEDDED) (* ; "Edited 21-Oct-2023 17:33 by rmk") + (* ; "Edited 7-Sep-2022 09:43 by rmk") + (* ; "Edited 4-Sep-2022 16:37 by rmk") + (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) + (for BT (LASTPIECE _ (FGETTOBJ TEXTOBJ LASTPIECE)) inside (FGETTOBJ TEXTOBJ PCTB) + declare (SPECVARS LASTPIECE) do (CHECK-BTREE1 BT 0 NIL)) + (for PC inpieces (\FIRSTPIECE TEXTOBJ) do (SELECTC (PTYPE PC) + (FILE.PTYPES (CL:UNLESS (STREAMP (PCONTENTS PC)) + (BTFAIL + "File piece without a stream" + PC))) + (STRING.PTYPES (CL:UNLESS (STRINGP (PCONTENTS + PC)) + (BTFAIL + "String piece without a string" + PC))) + (OBJECT.PTYPE (CL:UNLESS (IMAGEOBJP (PCONTENTS + PC)) + (BTFAIL + "Imageobject piece without an object" + PC))) + NIL)) + (CL:WHEN (AND (FGETTOBJ TEXTOBJ HINTPC) + (FGETTOBJ TEXTOBJ HINTPCSTARTCH#)) + (CL:UNLESS (IEQP (FGETTOBJ TEXTOBJ HINTPCSTARTCH#) + (\PCTOCH (FGETTOBJ TEXTOBJ HINTPC) + TEXTOBJ)) + (BTFAIL "HINTPC is not valid" (LIST (FGETTOBJ TEXTOBJ HINTPC) + (FGETTOBJ TEXTOBJ HINTPCSTARTCH#) + (\PCTOCH (FGETTOBJ TEXTOBJ HINTPC) + TEXTOBJ))))) + (CL:WHEN TEXTOBJ + (CL:UNLESS [IEQP (FGETTOBJ TEXTOBJ TEXTLEN) + (for BT inside (GETTOBJ TEXTOBJ PCTB) + sum (for S inslots BT sum (fetch (BTSLOT DLEN) of S] + (BTFAIL "TEXTLEN is inconsistent" TEXTOBJ))) + 'VALID]) + +(CHECK-BTREE1 + [LAMBDA (NODE DEPTH PARENT) (* ; "Edited 31-Oct-2023 10:35 by rmk") + (* ; "Edited 30-May-2023 00:06 by rmk") + (* ; "Edited 27-May-2023 15:00 by rmk") + (* ; "Edited 1-Sep-2022 09:49 by rmk") + (* ; "Edited 25-Aug-2022 12:53 by rmk") + (* ; "Edited 21-Aug-2022 16:46 by rmk") + + (* ;; + "Returns the TOTLEN/PLEN of NODE, after verifying that all of the nodes underneath are consistent.") + + (DECLARE (USEDFREE DEPTHHIST COUNTHIST PLENHIST NNODES NPIECES TEXTOBJ LASTPIECE)) + (ADD DEPTH 1) + (if (type? PIECE NODE) + then [if (EQ NODE LASTPIECE) + then (CL:WHEN (AND (PREVPIECE LASTPIECE) + (NEXTPIECE (PREVPIECE LASTPIECE))) + (BTFAIL "(NEXT (PPREV of LASTPIECE is not NULL" LASTPIECE)) + else (CL:UNLESS (IGEQ (PLEN NODE) + 0) + (BTFAIL "Negative PLEN" NODE)) + (CL:UNLESS (OR (NEXTPIECE NODE) + (EQ NODE (PREVPIECE LASTPIECE))) + (BTFAIL "PIECE with no NEXT is not PREV of LASTPIECE" NODE)) + (CL:UNLESS (EQ PARENT (fetch (PIECE PTREENODE) of NODE)) + (BTFAIL "Piece with wrong PTREENODE" NODE)) + (CL:WHEN (PREVPIECE NODE) + (CL:UNLESS (OR (EQ NODE (NEXTPIECE (PREVPIECE NODE))) + (AND (NULL (NEXTPIECE (PREVPIECE NODE))) + (EQ NODE LASTPIECE))) + (BTFAIL "PREVPIECE is not consistent" NODE))) + (CL:WHEN (OR (NEXTPIECE NODE) + LASTPIECE) + (CL:UNLESS (EQ NODE (PREVPIECE (OR (NEXTPIECE NODE) + LASTPIECE))) + (BTFAIL "NEXTPIECE is not consistent" NODE)))] + (add NPIECES 1) + (add [CDR (OR (SASSOC DEPTH DEPTHHIST) + (CAR (PUSH DEPTHHIST (CONS DEPTH 0] + 1) + (add [CDR (OR (ASSOC (fetch (PIECE PLEN) of NODE) + PLENHIST) + (CAR (PUSH PLENHIST (CONS (PLEN NODE) + 0] + 1) + (PLEN NODE) + else (CL:UNLESS (EQ PARENT (fetch (BTREENODE UPWARD) of NODE)) + (BTFAIL "NODE with wrong UPWARD" NODE)) + (add NNODES 1) + (add [CDR (OR (ASSOC (fetch (BTREENODE COUNT) of NODE) + COUNTHIST) + (CAR (PUSH COUNTHIST (CONS (fetch (BTREENODE COUNT) of NODE) + 0] + 1) + (for I S from (ADD1 (fetch (BTREENODE COUNT) of NODE)) to \BTREEMAXCOUNT + eachtime (SETQ S (\NTHSLOT NODE I)) unless [AND (NULL (fetch (BTSLOT DOWN) of S)) + (MEMB (fetch (BTSLOT DLEN) of S) + '(0 NIL] + do (BTFAIL "Upper node entries are not empty" NODE)) + (for S DLEN CHECKLEN inslots NODE sum (SETQ DLEN (fetch (BTSLOT DLEN) of S)) + (CL:UNLESS (IGEQ DLEN 0) + (BTFAIL "Negative DLEN" NODE)) + (CL:UNLESS (IEQP DLEN 0) + (* ; + "Could be intermediate in \INSUREVACANT.BTREESLOT") + (SETQ CHECKLEN (CHECK-BTREE1 (fetch (BTSLOT + DOWN) + of S) + DEPTH NODE)) + (CL:UNLESS (IEQP DLEN CHECKLEN) + (BTFAIL "Mismatching DLEN" + (LIST NODE DLEN CHECKLEN)))) + DLEN + finally (CL:UNLESS (IEQP (fetch (BTREENODE TOTLEN) of NODE) + $$VAL) + (BTFAIL "Mismatching TOTLEN" (LIST NODE (fetch (BTREENODE TOTLEN) + of NODE) + $$VAL)))]) + +(BTFAIL + [LAMBDA (STRING VAL) + (DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk") + (HELP (CONCAT (OR TAG "") + " " + (OR MSG "") + ": " STRING) + VAL]) +) + +(RPAQ? BTVALIDATETAGS 'DONT) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS BTVALIDATETAGS) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2918 22120 (UPDATEPCNODES 2928 . 3897) (FINDPCNODE 3899 . 4135) (\FIRSTNODE 4137 . 4498 -) (\DELETETREE 4500 . 6965) (\INSERTTREE 6967 . 11319) (\LASTNODE 11321 . 11858) (\MATCHPCS 11860 . -12584) (\SPLITTREE 12586 . 19466) (\TEDIT.UPDATETREE 19468 . 20975) (\TEDIT.PIECE-CHNO 20977 . 21559) -(\TEDIT.SET-TOTLEN 21561 . 22118)) (22121 24557 (DISPTREE 22131 . 22587) (TREEGRAPHNODE 22589 . 24555) -)))) + (FILEMAP (NIL (8515 53834 (\MAKEPCTB 8525 . 10070) (\UPDATEPCNODES 10072 . 12239) (\FIRSTPIECE 12241 + . 13149) (\DELETETREE 13151 . 16191) (\INSERTTREE 16193 . 18932) (\LASTPIECE 18934 . 19864) ( +\MATCHPCS 19866 . 20735) (\PCTOCH 20737 . 22828) (\CHTOPC 22830 . 28886) (\TEDIT.SET-TOTLEN 28888 . +29559) (\MAKE.VACANT.BTREESLOT 29561 . 36027) (\LINKNEWPIECE 36029 . 37516) (\UNLINKPIECE 37518 . +38123) (\SPLITPIECE 38125 . 42515) (\INSERTPIECE 42517 . 45505) (\INSERTPIECES 45507 . 48148) ( +\DELETEPIECES 48150 . 51961) (\ALIGNEDPIECE 51963 . 53832)) (53862 65274 (BTVALIDATE 53872 . 55322) ( +BTVALIDATE.PRINT 55324 . 56682) (CHECK-BTREE 56684 . 59560) (CHECK-BTREE1 59562 . 64997) (BTFAIL 64999 + . 65272))))) STOP diff --git a/library/tedit/TEDIT-PCTREE.LCOM b/library/tedit/TEDIT-PCTREE.LCOM index 4b905da70102960be99ad0717b59ae98ab8863d0..07bb0ab2430eeb5687d8362c5a2d8b84442f3096 100644 GIT binary patch literal 12871 zcmb7KX>23ceJ3edD>JrAQjD@ymGv_%CsJZ58XmfGc!r0TBMv#VNSV8~+_hFCThzJG zYMlg0J|u0?0xb%}iIWsTk;Xx6G))RhvViVk4|<1bV!Npt>;`BWvT+DCx42)Y_VpN-4vniBZ3Qgl0&gTRD?v5f&fIFYk^;C!%o{jm{<}X5&(XjYL*< zwysn+R}HqajZUAafT2%g<2jfrpgPM%=ibR(#$CH zw@)cavk6Rjd3V*BbM<3acCS7<%a+m^EmO`E)l4c=VpXg(x2S2%y{GZ<@dz`Pv0Uew z6OqyX_e9b7uW$l3nTX9yu~~ky1 zte~eeOhuubxlq=V^P|l3>KTv6`>Y559x^uGVrNWaJv>Z*d}i>8`?5Xs8+fAYPMIlmd&xczqa zpT6hmm-%dU`KFNzKVVw5*;|Gd4$utUV%e}q&elEQ9(gV7m$45yyEgbt*pm-a9Et zHP=Fh=xnNdy!dO+iq$UGUfJw^`)2L$JOxz)ohGJS$CoA~S1lfEl5NTphLHW&>*hYnSd#ChV<< z1%=iV2kix8OxMySO)rBX;DfSoK0`%`X-bI-6YavUQa2&uM}6BxD+HRwu0 z;uIo%;~=aULRcf0edcA4Y1V!c40sfWF~Ntsl;FcX+A~he8*-jll_yr^jY8w#VX*4y zqrRrTm^roamE0P1CI_+p12F0J+IMqL8EWHT&{X(x;xD$ab?+F;xE3(#-EVr#`L#E@ z&3U8V1Ff7VRh!4)+TVLdX5y@r)fcsNfvW^$-w|ylMQ7Z#>1KuGeR_sPiq+MX)emg% z7^`f1XO93?(1r9sEtE0~WjE2M+KEa8FMy~PBPLi;S;!R1plU0zsShW0AyWaVf7EM} znhV6|lzQkhN<9*ky0UE)RoW=}2~hN+TbGDeM5nC7g{QXu=k1&GP#RDzw??GP)qS8E zQQXWCssGhfWw1b%`RWJb!N3{W_;$n%S`ky;j5wfGAFe${yxPCFEBdwpoa_QP;*e~M zbPG2o-OQMbHJQO?7*{4C>m7@^CQF zZJP$U%{0hl8fx#G7d<1QC+COVGXi-he(;{Ek!yT*EdY*OtbJ90$K<5zOmIwG^n^*& zQ&}4~U?ub-Hv>hMU?q+oFx3kweGzg?@@xSEK?vDs98q!s2O3j2>~o;FPd4hIjbN8= zUR@7HdU7rx$dcH8Q_I(V$G12VJY;I2;~Oer^WpdBmAYp=80sx_9X+V`g>KVHUax)6 zdnu4@95(bmJy0J$zSL(He7{-y5kDV?aj0Y}i`}Q}vq)2{1mxq}o@51b*v3-XN9Ytl z0aq<9%s$$q{KyjE+VvfB+3Y-R_nl&zo>DY1A*Lr4E;68vwIl?XMp?9sGDXvh3#z`r ziO4&F>O{pXybx?!V1lN>`5WV(A3s4_T5FC;(_)P=eQr$fk$F=gudt>{-FNqolV8No z#_g41Q>pg^l)C@I!MkOp{=mgw+&v7-hI%Jk@A<{uFPX^~)s^9FKwiK5YVx(7^_AhZ zz_Vn5Uf%b7b{%FGd{javQ;ZzaHR1csQ=;fw14yL-V(9DH?p0K?JxB}@ZksbflFr{!M`+!q59dn@Ajpzq4(W=$wbBT z`W%z`V@ zXUk9#5?jR%Hm!r>93w24Q!hBuo>jCt7iRE}7EL&E*mkfLJCbFZV3hgNLEs0c5C5aQ zgGeQ)1dF!W+jy<(GyA?r8NDS_FD_hQ$+AIrpn2|=mUBH@=P|DTvJG{9@azL z(&`~HwY*BkRu7T2RrN427=JyN283XL2wTwytPmmR*a3Zjo6sCL1haw!U(70gI;;sQ z{Dm;RG?Lo|dt}7KNHPq3qz+v>+c=o(&q0n%nQvWCz^2N&dWT$ZxEX!=*-L}XqYRm{ zJ_yi07}N)kShefr0S#^JEe=;z(~5Uqqc82vJ{_BZr9h?T4TIavruf4js` zKr}^u^OK6E@<1{%$vt1kbBn@1pb(6w)jKt9r`V*rdyu zWU)!NOA(Dnh5cm`+E2z>h}GgQYdzzR&8FOy#8juzEwRarWsXieBu>MmI2>J}c?2D7 z4yHa$4z8vaa&Smp&X&eTnvSb*ZGmdsX(iX7HJ%2{Nj^BT%F&r*z2~y8?nj6tD+Vf! z7hmgI3-`*|H~qnYH+$5p$Zz`PfE?~MYd>$X=!*r~g=-7#t~0ls!WF@S4?`ciT)6rL zn7v-iioZwqVPU?E3prh2`M5yKQc+V|{mWR}xnQ)xK)61R(dL-~Zmm;UeQpl;Z=wAt z^Qvd;9r0}?1(FebdB>FXyD#s1AElrQN*oeu{YNMzg<^Avk$Krzf2$9f1O<_eT<=qU zNX7uk1)muTdVTVDJY5`{c-L<RcP;l?f|OXUT% za2~2W;jUpaJ2>PSl6)qgM7oLU$+P*i7!i^JsqDVN1k~EXBN{N~F6pc%hoAYt?mEtU-l*^fXu?**(@vlsQDi^Fn zqeK}>F?9q7jj@p!{DcXpY?MjTs1wY(^o(5DR(GZ!2!86$f&g|B{{>E zViJI)pqc+p`JN^|3%>Gn!q+)Em|WNoJ|XboV9!j#`9!cJ@@Nn$)eEY@^L3JbI=rz`JU^F>b-fx64G<6zavuVJrE8UYwh>T9VI7Sitkd2BW zq_Hv;g1OVvos3586t@)*98uw~|$k6=rhdt;am3%g6-1a&405imnF(zD{ga zZJw%4R;sWN-xb35im57OGt@WzCTtT~DaSVPWMLaWXIhyz4VSsI&mBWY5h7I70^IKL zvWh4H#GJGuatc806b8>E3Qh~M*ueyZr#){Sv%^nen7F2L{cClvO9&VE%>XET0~9*x zVF#6Ngji;a8=KlyL;}@0V#6xT*n=%nOGtJ*)M64C*Q`w=#0SaUB&&ubS*BRdS~Yl*7Tw9B6etFyc$tDqNV>2txQpSZ%$LsN z7xy#Dc^q&bR;63!CZKUR%YVDREE~Kq^f|NkUin~{SGeVA9KK6*dF=&W7u{Z~t{cH< zck<{mZ{*}@mKulQW<@~G(ffNn_-9qlo%rmE6ZvGRmw10Oz-zVtB;jpdD@Z&yXAAPU zI5J6ODw|2=#(2aI35_#=DzZlsq6eGPB$rDW41H1pa>SeM@GUA?HI=Qvx;G&}ngDcI z-Dkj0t2iBHxEw&@3==`}q?ouQC}&D#I1m{n50AmQ4`V<#dwE1wc5#v}MC>zwH6;W` zl<}fVqqYz63I2hnep^QHylYDfT&lLgl)ZO%!G1;jLV=57ZwJ9kvztXxOD3VA8l~M5 zATNF(hgqc5W?bTk1RM0nkyTV-z-&22E$Rp>Dga(Ct#I`J@P5c*B_yO`B~%GprEq1y zDh+VQTvRH9;ssrs^AJWaB%hAL-&Ce;7r7Q(;G zbYV<)U#{!unii@Io;HC0Mu?X@{HiM<89H`ICWyzd9c*R#G0`}aQL zeO=3Y^Qhm-`JUdt_bH@?P09;<^#B^J)bM8!EdYDrj6kPY3tFV}7u_&^)bP*PV zQJ_`{SD>UnylZp@QbNc>U84y0MUN;_2X+srW3xw8bcZtyr_1g^Qo|>X!V>YdB=`xU zNt&i>1-_Ovh06_lEsDgg9x=ME6+HmGRwGng%!GBUCU}>2KPahaM8-fAFt_y)cq5t+ z+=v2BV10v%iY92LD1bU89eHy~pwqATv5+3bo4}R5dV$48K{ezK^2;BqZe82rS~82P z`smaoI%v95hMGyEEQ&=V$_uNz%g?ViJ0Zzxbpqkg3F_~3TG_d_y@#p%Ou}KD1?*-H zht}X2tsvo=)){Q9UfElteGv9JW1Uu*??}G7&39}!`Wf&xQnJoGoa9s|-Y;WHEj~Z*qDm?}MKS&NpGn>AnPEW+t7+Ymt_h2Hxi& z^FEm?z-13yQ$*@eS@o!|pW=AlURyA_UcRyRThIvK_4)NRt|eyeUz!nq*u>o)?|b+N zSE<@NH+vcf@3LF}j5p?l^PGcMx6v=x{RfkB{ec4se^3!oIDCRb#yeA!>%-dM;Gh^T zAN6wU7pVIz-;FMAdbFcw@*x`j6ER$LuKj?!i%(NN0^c4*n&FU9p5bti5)Fr819{zV z8k_ewUNtuTjhFZDjX6hoasOV0&$WLq+x0c=jkVv_yl-f}TloTV=6=2JQpj+!uE2*bT0+OTo~%;NFl5$#j4%yCD$Ep@Gc1C)I1&x!8s{1=$Ht&VO_`rbF4Sy8_rbIWr9{%b`$1{!bKq%5<)ZEo)Ro@ zJ4XgC3b=^O;q8!+OZL&~-rCN!J+{oQ?(MEFZ$aZo4QVXhIaIIWo_b|x`)c*--s<)q z^dLUTBGxSvKGH?@3(K2TgHi#|5OoWBxpR4ab!D%8fo&$*p@`Ga!_wYvb^H1DPP7X& zw@|EF$9BrD-cuPEIC>CU z#@B(tl>z%JZUyb_MOwF48N$3nV(ZYT%GrS<>roPFnC0x?%2{ic&0eS5#%E!oxHlWytlGOS}$(z@D?$FcVO-hq|#`HZbb^K&oA#)Us&a84&ymF#UhJWuE41B zCp18#-RkO9w!ABz)2wb?+50%KC5DZSAn;Q)%UR%BPcX+my1Rq5#oIFA6+(^(&lk}) z3F!#TTComT$&>S^^ngnNpGiFI;YeyNQKYOUts7zBQA7}gZ((~!WLK=!_@f8-2o4}c zg!5n@oni%$Bj#t35&kG(q5cU?U^%V;}q=u9TKHm$z5&%oIinejn$D zcxZX`+LbFiyL%*6&t2PI*{i}>MMl|3I+N0HF^qSteu_BWmo%y<2yoW?lLaUOKe1}SXCa%-* zDX*j!^b+$gAr-=J*q2B~M2W;ilt{KjiF*yAnAe}o*o~TImkRuqUvuUqM=pzaIy|C| zm&SG6>w_FuH+S~PH4x4%yS%)zA&RtRYhRQqUR*f&TmU_kboxmJ6OH)MrL!Xtw0e3*x|}j9?1UERtTmeC_$?Nw0`nM2cn}#8tFXA}({*YT7Kj zBe-ZWy*Uw2?~FXLsN-EW$pGiKi!-e~@fA?<0ZX-U2d~hJVrGqZ%n`OLW*jN%JiE<) z)nEUwI^eYa$%{A`^uJ{rB$j-Ge&Cz4YXGy=51*T@@MXp5mR6(;I}9-0SwvSTcz2SQX%&|_5FVxj9iic literal 9124 zcmcIpYiuLeb*3I(ujxi6DPg-2RO6c7$Yi=wI5T`njs*@M5=WwVX_E5pI*MiOl3Gd{ zi2@~MvuFwgbz8LQpC(P42MQ#0{xta$N~(+6MoaYZBU>QuqSX&A&_{~azls72=x>4T zckZ1T4kc}27^tv2ypMCvJ@?%6y61+nxmlx_o0v5Uxe22<%h`)1J+q+CSTDG$A>tAd%x9T(IYO8gBW~*K^>-T5O_1mpgboc7D^}QKTG^!J& zOtqZLO}?szK|bapKQ*l>(`r1(Znx?V{X31-?Ys5e&rLJ$vQez$%2mQ<>sWSnsZd~U z3X_wQK~`JEVi!`L3Wh(??mpFKm>QpoOfm0tCa)Lga+QfHXQA0*g}Jy6v*}Vf_lCij zDic}Amj#umYyXMqNMt&qd`fXDVee9jsFpHCp3PO*bT;V?m6*niYHpF0n92-%BW$U3 zLoa91QCK!tsOo4%SSb@`p5Gkwc=}V9JotMM@b`K0wIBLK@9){b#-@K@V8J*&x{=Dy zKYZYMe3;44oBb!c_<9NFIu1s0$RxoS?>md%6IoR`6bB6UZJ zfDN31&?p*@vve9iF-E*kNJdL6%Jf+{oY}%0=0K#F$rm}ADl6u06mms06~+r$*^H2d z0KB|Zl730bPe_9_6M$jXH}C>P=>Ph&x;ZZN>3zTNvTp0A0?#GPWzwvSU}MEK%#@Ye_#V0ecpH^a5m{wW3T|> zNGGMaiz8FDGj^gzU>I&gQQ{D^+maL_)B_O#4VN0kBGLqL>TWpFB+YFrN&;$N+XI_& zX%RIBV9LO0hXg69S0PKA_M{j|CfNrbIJe1=h9sT_ogpU z@DV8Zy9b{CaH)9eC$3KBaDtC)JpR^!=O=vRnSu8Pe&fLNoiu6dqm29!s$}`<>>rD< zldM!GCuO??`W*?k%xX#Bc7CSGl%yiniVT9No?6$@pb&Z=ee); zv%vOa&&TP1+XNh7Ua75RU5IgC}b_X?qAbzm&@e=7tZR ztn0KOEbv%MYOpA`{V^>L1fx*M&FO_ny*$S>1)kn* z+8Wu2+qBiVim>la4%8^DdiKp+nZst1XYds@-b+v+vvRMXM9wf3k4a|{Q=jHEq6p1h zHxb1W-JYhpy@nQXcOx{xZok_gRAfn2Os5&@UOHB;gVt991%!21P_?cI87Z+-hN zt8eY>-A5d+Zv|O2!GheZu^o4a-)pSzTDCe#j;Wyc#%EV({J$dg6cQ>|q*ewt@)W5) z{9u0J^qUP|Y5^L4>%Hd|w*Ke%!}foli{KEZvohQ#yk}PsuC@%|i+VMaFJ+v(4~fuO zHyOp2WJng#n9t5uax$}!ZV9=??_G9tY%-*M(Mt>Y(;v+nf@4bkmZcB))q*hGzx4Z_ zU9^ln-u=Nz#dRr+-gs?>TD&apH*ji-$M%qC<$PXRH^2HtrI2kMX5 z>E|`S{_MiL2YrigQ@WTEp6)G^nLdC2b3DL(r-$ZnQJkwe2nSXaPEvl&7mz(Y&#&;2 z)5Eo4)3*VnfgwK1ubv*>9R`g-(|6(z_<0cV=?{5O1fieu;4=f?=RrXSLFoq@Ja~H8 zL}+2{ts)ORL}rF$Du85aL;7&E;cNp3Pxe#%ikRkCXyi)!cT#-xVTzB*3@l~#^U)Lf zj`d_oHR=hse;kQI+x`x|$yI8Ka>xBtzOGcwr`bzUw6-Wj3*CY;mM81M_HbHX5hO#DbDyPzQL2H-^KyQ-{El*{O7Px zTu7c8EkVLl|}{DI&1EA!`sG2a!21!o-*9};U?Kk!!m0OKjJl>%F7 zo+7s7F&;%XcuKG}^A4XOwq8#086hQ7p&3W}X24YHcx9&3{)^#M5ebjkUv%dfDLynZ zm@+RxSW*jw)&dIFk}}6_SZ7)$T1ecJQ)hx|a;i76W=X`cp0J&apUDN1F?cL@U{6NR z6H*dqP!tl6weL899l0U7x?sgF(}+U}cRs@6;Kmih5-R)J;D9qwy;aJ+ z{59N_dVr9DIS@>XX&0er;Lrusv!>Ql28p?;sTUG+6-s0vJ(s!K@l;&Po?2HD7qeO1 zj6@Jait$^6eV%SOLY3)H8os<;VVb{lxkFW^#e5aMDfRd;k*~sKh>r+X`X{I|wLe>h zzamOhTRQ6Aj)wED@)MPrluuh`g4(;31p=a+xhwmpmzjF=6Wmv+x+E%gc6n)k=iX|o zhF+~Ma!)CDk>*T@N{S_SCkvrskzTel1FGdY#S>B1o9kww4+4ncefb|5nTbNJtaZ+|9nS59MuG0Q(-qHj zmsfLKMq8-HrnsXG82QuhEXWFpZy_}=uW26|o5$} zoJtvbBm#R8>=Ju7p|%uh`ci!&;J}@uE>WzMa+zw_E9!Y&T)T7;VRP6U6wspi;l?pydf>gdbWanQ)U}_1NCzwqZh(qZx4#ibCQ+y;sOydsQ8$0x*{J<&pI;@ zoakUY%JK${SJ2j2f!l4A`)oQ2rLs~El&@CvMup}e6x9(AGF`o#>#cPDE2KT(|NYCU zZ>O}&hog2Gwy4ja+j5bC`ed*fz~fg1w9H_IxZT;tcrpeg00%Ofq^h z1=m4$7w75jqTttiq`>YSP*I(7$dM%={-RJ#V@yFw&uN1ryNzIMH{sLlCQ=Bi2{QPH z3RksyE5jE{W!$HjuzTyB2ZI$rluP>Sub-P>q0r~qtFN+PdevOrzJqt0y;i+$-Q;97 zcz1tirzvmkYx~=G_ST!*yTLG?R`5zyu?S`}1&nwhsRC38Per*m^g@c*0T9dbVl~4{ zx0qbZ8(hA@%h`%i6kcmlH;U{v_A+a(v3t!{ZI>$idyP7~(^xla6FbfI?Y(+ymyH8p zZMTln|88AyK?npVDwz`#tp1gH>ptoRC@E)m*tS@QDj9g(D_EER*Q{;PYUb+h9&6QCO}4uOCM~Lh2Ug$S zYoTHyMI*Kxg4E7Sa)L#}Vs9B+X;^99+8z_!g)E z^xS!cyi0iDME%sEVv~-B9olDh8nRGAm8CRtMqB6>Vi+p{(<{fTyp-1qvzCk;%tE=6 zKZnT_feU1*lA!|Ev!r`rmv+)D-U83O(79fYx-T_7HF$Tb>y(0Asi&)O=(TcC*Q>QGGr{>2v2(3H8ipHcZ z9pvbj3|Mr-_>-@+6+u(_60&e_2n9@?vg0l{jswxR8H~5yny``)X(wbCt@=)@z6<>& z%Oq2jg}%Mj+on|UY7TGH$h5%zjiSP^46Z#2qvu9Breen!Qe8uu9MW7vQ8^TK4Z-#a zG3FYI%b_^Kv!P8NahbppF0iB=N?JpxZPmZJ*IKnU zcdr4Taj*UgoRIB!uzPZwf)W<92$Kr}#Y$7UJbIKt;j_NFd!Mat*Vr070!bz$jWlh* zoXH{yD=1v1CY1&rIL+#Ny;w*b9vl6d2@ zB;Ex@T4}@ffZ7`FS{{|o3qg~%n!8|eE4>I7uk7bIK*Dk%==ptl8Lsaa!D<(54C(WQ ppciZmpz^>bnTGh_b?pNcXZr|yP6w&C*a(FascF#&G?Oj~{|l!%MXmq< diff --git a/library/tedit/TEDIT-SCREEN b/library/tedit/TEDIT-SCREEN index ac236169..71baf30e 100644 --- a/library/tedit/TEDIT-SCREEN +++ b/library/tedit/TEDIT-SCREEN @@ -1,1037 +1,1860 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 16:55:51"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SCREEN.;1 198321 +(FILECREATED " 4-Mar-2024 22:50:24" {WMEDLEY}tedit>TEDIT-SCREEN.;612 184763 - :PREVIOUS-DATE "14-Jul-2022 12:44:58" -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SCREEN.;3) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.MARK.LINES.DIRTY) + + :PREVIOUS-DATE " 2-Mar-2024 07:40:06" {WMEDLEY}tedit>TEDIT-SCREEN.;611) (PRETTYCOMPRINT TEDIT-SCREENCOMS) (RPAQQ TEDIT-SCREENCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS \FORMATLINE \TEDIT.NSCHAR.RUN \TEDIT.PURGE.SPACES \DOFORMATTING) - (FNS \DISPLAYLINE \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE \TEDIT.BLTCHAR) + ([DECLARE%: EVAL@COMPILE DONTCOPY + (EXPORT (RECORDS THISLINE LINECACHE) + (COMS (* ; "LINEDESCRIPTORS") + (RECORDS LINEDESCRIPTOR) + (I.S.OPRS inlines backlines) + (MACROS GETLD FGETLD SETLD FSETLD SETYPOS LINKLD)) + (MACROS HCSCALE HCUNSCALE) + (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS) + (ALISTS (CHARACTERNAMES EM-DASH SOFT-HYPHEN NONBREAKING-HYPHEN + NONBREAKING-SPACE)) + (COMS (* ; "Formatting slots held by THISLINE") + (RECORDS CHARSLOT) + (MACROS CHAR CHARW PREVCHARSLOT PREVCHARSLOT! NEXTCHARSLOT FIRSTCHARSLOT + NTHCHARSLOT LASTCHARSLOT FILLCHARSLOT BACKCHARS PUSHCHAR POPCHAR + CHARSLOTP) + (CONSTANTS (CELLSPERCHARSLOT 2) + (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) + (MAXCHARSLOTS 256)) + + (* ;; "incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards.") + + (I.S.OPRS incharslots backcharslots) + (MACROS DIACRITICP] + (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 \FORMATLINE \FORMATLINE.SETUP \TEDIT.FORMATLINE.HORIZONTAL \TEDIT.FORMATLINE.VERTICAL + \FORMATLINE.JUSTIFY \FORMATLINE.TABS \FORMATLINE.SCALETABS \FORMATLINE.PURGE.SPACES + \FORMATLINE.EMPTY \FORMATLINE.UPDATELOOKS \FORMATLINE.LASTLEGAL \FORMATBLOCK) + (INITVARS (TEDIT.LINELEADING.BELOW NIL)) + (GLOBALVARS TEDIT.LINELEADING.BELOW) + (FNS \CLEARTHISLINE \TLVALIDATE) + (* ; "Consistency checking") + (INITVARS *TEDIT-CACHED-FMTSPEC*) + (* ; "Heuristic for \FORMATLINE") + (GLOBALVARS *TEDIT-CACHED-FMTSPEC*) + (FNS \DISPLAYLINE \DISPLAYLINE.TABS \TEDIT.LINECACHE \TEDIT.CREATE.LINECACHE \TEDIT.BLTCHAR + \TEDIT.DIACRITIC.SHIFT) (DECLARE%: EVAL@COMPILE DONTCOPY (* ;; "Machine independent version of \TEDIT.BLTCHAR") (MACROS MI-TEDIT.BLTCHAR)) - (FNS TEDIT.CR.UPDATESCREEN TEDIT.DELETELINE TEDIT.INSERT.DISPLAYTEXT - TEDIT.INSERT.UPDATESCREEN TEDIT.UPDATE.SCREEN \BACKFORMAT \FILLWINDOW \FIXDLINES - \FIXILINES \SHOWTEXT \TEDIT.ADJUST.LINES \TEDIT.CLEAR.SCREEN.BELOW.LINE - \TEDIT.CLOSEUPLINES \TEDIT.COPY.LINEDESCRIPTOR \TEDIT.FIXCHANGEDLINE - \TEDIT.FIXCHANGEDPART \TEDIT.INSERTLINE \TEDIT.LINE.LIST \TEDIT.MARK.LINES.DIRTY - \TEDIT.NEXT.LINE.BOTTOM) - (COMS (* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDIT-DCL) - (* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" - "41,115" "41,133" "41,131" "41,127" - "Hira,41" "Hira,43" "Hira,45" - "Hira,47" "Hira,51" "Hira,103" - "Hira,143" "Hira,145" "Hira,147" - "Hira,156" "Kata,41" "Kata,43" - "Kata,45" "Kata,47" "Kata,51" - "Kata,103" "Kata,143" "Kata,145" - "Kata,147" "Kata,156"))) - (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" "41,126"))) - (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS]) - -(FILESLOAD TEDIT-DCL) + (FNS TEDIT.UPDATE.SCREEN \BACKFORMAT \TEDIT.PREVIOUS.LINEBREAK \FILLPANE \TEDIT.UPDATE.LINES + \TEDIT.CREATEPLINE \TEDIT.FIND.DIRTYCHARS \TEDIT.FORMATLINES \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))) (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.") + + (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)) + +(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.") + )) +) + +(/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)) + '4) + + + +(* ; "LINEDESCRIPTORS") + +(DECLARE%: EVAL@COMPILE + +(DATATYPE LINEDESCRIPTOR + ( + (* ;; + "Description of a single line of formatted text, either on the display or for a printed page.") + + YBOT (* ; + "Y value for the bottom of the line (below the descent)") + YBASE (* ; + "Yvalue for the base line the characters sit on") + LEFTMARGIN (* ; "Left margin, in screen points") + 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 (* ; + "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") + 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 (* ; "One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)") + LTEXTOBJ (* ; "A cached TEXTOBJ that this line took its text from. Used only in hardcopy to disambiguate when chno's should be updated.") + 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) (* ; "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 '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) +) + +(/DECLAREDATATYPE 'LINEDESCRIPTOR + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER + FLAG FLAG FLAG FLAG FLAG FLAG FLAG) + '((LINEDESCRIPTOR 0 POINTER) + (LINEDESCRIPTOR 2 POINTER) + (LINEDESCRIPTOR 4 POINTER) + (LINEDESCRIPTOR 6 POINTER) + (LINEDESCRIPTOR 8 POINTER) + (LINEDESCRIPTOR 10 POINTER) + (LINEDESCRIPTOR 12 POINTER) + (LINEDESCRIPTOR 14 POINTER) + (LINEDESCRIPTOR 16 POINTER) + (LINEDESCRIPTOR 18 POINTER) + (LINEDESCRIPTOR 20 POINTER) + (LINEDESCRIPTOR 22 POINTER) + (LINEDESCRIPTOR 24 POINTER) + (LINEDESCRIPTOR 26 POINTER) + (LINEDESCRIPTOR 28 POINTER) + (LINEDESCRIPTOR 30 FULLXPOINTER) + (LINEDESCRIPTOR 32 POINTER) + (LINEDESCRIPTOR 34 POINTER) + (LINEDESCRIPTOR 36 POINTER) + (LINEDESCRIPTOR 38 POINTER) + (LINEDESCRIPTOR 40 POINTER) + (LINEDESCRIPTOR 40 (FLAGBITS . 0)) + (LINEDESCRIPTOR 40 (FLAGBITS . 16)) + (LINEDESCRIPTOR 40 (FLAGBITS . 32)) + (LINEDESCRIPTOR 40 (FLAGBITS . 48)) + (LINEDESCRIPTOR 38 (FLAGBITS . 0)) + (LINEDESCRIPTOR 38 (FLAGBITS . 16)) + (LINEDESCRIPTOR 38 (FLAGBITS . 32))) + '42) + +(DEFPRINT 'LINEDESCRIPTOR (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT)) (DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +[I.S.OPR 'inlines NIL '(bind $$PREVLINE declare (LOCALVARS $$PREVLINE) + first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) + 'LINEDESCRIPTOR)) + by (PROGN (SETQ $$PREVLINE I.V.) + (\DTEST (OR (fetch (LINEDESCRIPTOR NEXTLINE) of I.V.) + (GO $$OUT)) + 'LINEDESCRIPTOR] + +[I.S.OPR 'backlines NIL '(bind $$NEXTLINE declare (LOCALVARS $$NEXTLINE) + first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) + 'LINEDESCRIPTOR)) + by (PROGN (SETQ $$NEXTLINE I.V.) + (\DTEST (OR (fetch (LINEDESCRIPTOR PREVLINE) of I.V.) + (GO $$OUT)) + 'LINEDESCRIPTOR] +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS GETLD MACRO ((L FIELD) + (fetch (LINEDESCRIPTOR FIELD) of L))) + +(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) + (FSETLD LINE YBOT BOTTOM]) + +(PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) + (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) + (CL:WHEN LINE2 (SETLD LINE2 PREVLINE LINE1)))) +) +(DECLARE%: EVAL@COMPILE + +(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)))]) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(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")) -(CONSTANTS (\SCRATCHLEN 64)) + +(* ; "Formatting slots held by THISLINE") + +(DECLARE%: EVAL@COMPILE + +(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; + "If CHAR is NIL, then CHARW is CHARLOOKS.") + )) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS CHAR MACRO ((CSLOT) + (ffetch (CHARSLOT CHAR) of CSLOT))) + +(PUTPROPS CHARW MACRO ((CSLOT) + (ffetch (CHARSLOT CHARW) of CSLOT))) + +(PUTPROPS PREVCHARSLOT MACRO ((CSLOT) + (\ADDBASE CSLOT (IMINUS WORDSPERCHARSLOT)))) + +(PUTPROPS PREVCHARSLOT! MACRO ((CSLOT) + + (* ;; "Backs over looks and invisibles to the last character slot") + + (find CS _ (PREVCHARSLOT CSLOT) by (PREVCHARSLOT CS) while CS + suchthat (CHAR CS)))) + +(PUTPROPS NEXTCHARSLOT MACRO ((CSLOT) + (\ADDBASE CSLOT WORDSPERCHARSLOT))) + +(PUTPROPS FIRSTCHARSLOT MACRO ((TLINE) + (fetch (THISLINE CHARSLOTS) of TLINE))) + +(PUTPROPS NTHCHARSLOT MACRO ((TLINE N) + (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) + (ITIMES N WORDSPERCHARSLOT)))) + +(PUTPROPS LASTCHARSLOT MACRO ((TLINE) + (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) + (TIMES (SUB1 MAXCHARSLOTS) + WORDSPERCHARSLOT)))) + +(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W) + (freplace (CHARSLOT CHAR) of CSLOT with C) + (freplace (CHARSLOT CHARW) of CSLOT with W))) + +(PUTPROPS BACKCHARS MACRO ((CSLOTVAR CHARVAR WIDTHVAR) + (SETQ CSLOTVAR (PREVCHARSLOT CSLOTVAR)) + (SETQ CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR)) + (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR)))) + +(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W) + (FILLCHARSLOT CSLOTVAR C W) + (SETQ CSLOTVAR (NEXTCHARSLOT CSLOTVAR)))) + +(PUTPROPS POPCHAR MACRO ((CSLOTVAR CHARVAR WIDTHVAR) + (SETQ CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR)) + (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR)) + (SETQ CSLOTVAR (NEXTCHARSLOT CSLOTVAR)))) + +(PUTPROPS CHARSLOTP MACRO [OPENLAMBDA (X TL) + + (* ;; "True if TL is a THISLINE and X is a pointer into its CHARSLOTS block. A tool for consistency assertions.") + + (CL:WHEN (TYPE? THISLINE TL) + [LET ((FIRSTSLOT (FIRSTCHARSLOT TL)) + (LASTSLOT (LASTCHARSLOT TL))) + (AND [OR (IGREATERP (\HILOC X) + (\HILOC FIRSTSLOT)) + (AND (EQ (\HILOC X) + (\HILOC FIRSTSLOT)) + (IGEQ (\LOLOC X) + (\LOLOC FIRSTSLOT] + (OR (ILESSP (\HILOC X) + (\HILOC LASTSLOT)) + (AND (EQ (\HILOC X) + (\HILOC LASTSLOT)) + (ILEQ (\LOLOC X) + (\LOLOC LASTSLOT])]) +) +(DECLARE%: EVAL@COMPILE + +(RPAQQ CELLSPERCHARSLOT 2) + +(RPAQ WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) + +(RPAQQ MAXCHARSLOTS 256) + + +(CONSTANTS (CELLSPERCHARSLOT 2) + (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) + (MAXCHARSLOTS 256)) ) -(FILESLOAD (LOADCOMP) - TEDIT-DCL) + +(* ;; +"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." +) + +(DECLARE%: EVAL@COMPILE + +(I.S.OPR 'incharslots NIL '[SUBST (GETDUMMYVAR) + '$$STARTSLOT + '(bind $$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT + declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) + first (SETQ I.V. (COND + ((TYPE? THISLINE $$STARTSLOT) + (FIRSTCHARSLOT $$STARTSLOT)) + (T $$STARTSLOT))) + (SETQ $$CHARSLOTLIMIT (fetch (THISLINE + NEXTAVAILABLECHARSLOT + ) of THISLINE)) + by (NEXTCHARSLOT I.V.) until (EQ I.V. $$CHARSLOTLIMIT) + eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) + (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.] + T) + +(I.S.OPR 'backcharslots NIL '[SUBST (GETDUMMYVAR) + '$$STARTSLOT + '(bind $$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT + declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) + first (SETQ I.V. (COND + ((TYPE? THISLINE $$STARTSLOT) + (PREVCHARSLOT (fetch (THISLINE + NEXTAVAILABLECHARSLOT + ) + of THISLINE))) + (T $$STARTSLOT))) + (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) + by (PREVCHARSLOT I.V.) eachtime (SETQ CHAR + (fetch (CHARSLOT CHAR) + of I.V.)) + (SETQ CHARW (fetch (CHARSLOT + CHARW) + of I.V.)) + repeatuntil (EQ I.V. $$CHARSLOTLIMIT] + T) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) + + (* ;; "An XCCS diacritic") + + (AND (SMALLP CHAR) + (IGEQ CHAR 192) + (ILEQ CHAR 207)))) +) + +(* "END EXPORTED DEFINITIONS") + ) (DEFINEQ -(\FORMATLINE - [LAMBDA (TEXTOBJ FMTSPEC CH#1 OLINE 1STLN) (* ; "Edited 30-Apr-2021 14:38 by rmk:") +(\TEDIT.LINEDESCRIPTOR.DEFPRINT + [LAMBDA (LINE STREAM) (* ; "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) + "*" + "") + (GETLD LINE LCHAR1) + "-" + (GETLD LINE LCHARLIM) + (CL:IF (GETLD LINE LSTLN) + "*" + "") + (CL:IF (GETLD LINE FORCED-END) + " FE" + ""))) + (SETQ LOC (LOC LINE)) + (CONS (CONCAT "{L" (CL:IF (GETLD LINE LDIRTY) + "D" + "") + ":" INFO " " (CAR LOC) + "/" + (CDR LOC) + "}"]) +) - (* ;; "Given a starting place, format the next line of text. Return the LINEDESCRIPTOR; reusing OLINE if it's given.") +(/DECLAREDATATYPE 'THISLINE '(FULLXPOINTER POINTER POINTER POINTER POINTER) + '((THISLINE 0 FULLXPOINTER) + (THISLINE 2 POINTER) + (THISLINE 4 POINTER) + (THISLINE 6 POINTER) + (THISLINE 8 POINTER)) + '10) - (* ;; "If CH#1 is past end of document, \FORMATLINE returns an empty line descriptor that is set up right wrt leading and font. This is used by \FILLWINDOW to create the dummy line at end of document when you hit a CR there.") +(/DECLAREDATATYPE 'LINEDESCRIPTOR + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER POINTER POINTER POINTER + FLAG FLAG FLAG FLAG FLAG FLAG FLAG) + '((LINEDESCRIPTOR 0 POINTER) + (LINEDESCRIPTOR 2 POINTER) + (LINEDESCRIPTOR 4 POINTER) + (LINEDESCRIPTOR 6 POINTER) + (LINEDESCRIPTOR 8 POINTER) + (LINEDESCRIPTOR 10 POINTER) + (LINEDESCRIPTOR 12 POINTER) + (LINEDESCRIPTOR 14 POINTER) + (LINEDESCRIPTOR 16 POINTER) + (LINEDESCRIPTOR 18 POINTER) + (LINEDESCRIPTOR 20 POINTER) + (LINEDESCRIPTOR 22 POINTER) + (LINEDESCRIPTOR 24 POINTER) + (LINEDESCRIPTOR 26 POINTER) + (LINEDESCRIPTOR 28 POINTER) + (LINEDESCRIPTOR 30 FULLXPOINTER) + (LINEDESCRIPTOR 32 POINTER) + (LINEDESCRIPTOR 34 POINTER) + (LINEDESCRIPTOR 36 POINTER) + (LINEDESCRIPTOR 38 POINTER) + (LINEDESCRIPTOR 40 POINTER) + (LINEDESCRIPTOR 40 (FLAGBITS . 0)) + (LINEDESCRIPTOR 40 (FLAGBITS . 16)) + (LINEDESCRIPTOR 40 (FLAGBITS . 32)) + (LINEDESCRIPTOR 40 (FLAGBITS . 48)) + (LINEDESCRIPTOR 38 (FLAGBITS . 0)) + (LINEDESCRIPTOR 38 (FLAGBITS . 16)) + (LINEDESCRIPTOR 38 (FLAGBITS . 32))) + '42) - (DECLARE (SPECVARS LOOKS CHLIST WLIST FONTWIDTHS CHNO ASCENT DESCENT LOOKNO LINE FONT - INVISIBLERUNS DEVICE SCALE NEWASCENT NEWDESCENT TLEN)) - (PROG ([LINE (OR OLINE (create LINEDESCRIPTOR - RIGHTMARGIN _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - YBOT _ (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (CH#B (IMAX CH#1 1)) - (GATHERBLANK T) - (TLEN 0) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (THISLINE (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (CHNO (IMAX CH#1 1)) - (LOOKNO 0) - (INVISIBLERUNS 0) - (ASCENT 0) - (DESCENT 0) - (PREVSP 0) - (%#BLANKS 0) - (DEFAULTTAB 36) - (DS (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - 'DSP)) - LEFTEDGE TX DX TXB CH FORCEEND T1SPACE TXB1 DXB WIDTH LOOK#B FONT FONTWIDTHS TERMSA CLOOKS - TEXTSTREAM CHLIST WLIST LOOKS ASCENTB DESCENTB INVISIBLERUNSB TABPENDING BOX PC PCNO - DEVICE SCALE NEWASCENT NEWDESCENT TABSPEC HARDCOPYMODE ORIGFMTSPEC PREVHYPH PREVDHYPH - ORIGCHLIST ORIGWLIST) +(DEFPRINT 'LINEDESCRIPTOR (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT)) - (* ;; "Variables (TLEN = Current character count on the line)") +(/DECLAREDATATYPE 'LINECACHE '(POINTER FULLXPOINTER) + '((LINECACHE 0 POINTER) + (LINECACHE 2 FULLXPOINTER)) + '4) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE - (* ;; "(CHNO = Current character # in the text)") +(PUTPROPS SPACEBREAK MACRO (NIL + (* ;; "TX is the beginning of the first space of a run. Needed for SPACELEFT in DOBREAK. FIRSTWHITEX is updated on the first space after one or more non-spaces. ") - (* ;; "(DX = width of current char/object)") + (CL:WHEN INWORD + (FORGETHYPHENBREAK) + (SETQ FIRSTWHITEX TX) (* ; "The beginning of the space") + (SETQ FIRSTWHITESLOT CHARSLOT) + (SETQ INWORD NIL) + (SETQ INSPACES T)))) - (* ;; "(TX = current right margin) ") +(PUTPROPS SAVEBREAK MACRO (NIL + (* ;; "Values including the character just before a break") - (* ;; "(TXB1 = right margin of the first space/tab/CR in a row of space/tab/CR) ") + (SETQ ASCENTB TRUEASCENT) + (SETQ DESCENTB TRUEDESCENT) + (SETQ CHNOB CHNO) + (SETQ CHARSLOTB CHARSLOT) + (SETQ TXB TX))) - (* ;; "(CH#B = The CHNO of most recent space/tab)") +(PUTPROPS DOBREAK MACRO [(SPACERUN) - (* ;; "(TXB = right margin of most recent space/tab)") + (* ;; + "Back up to the last potential break, if TXB says that there was one. Otherwise, break here.") - (* ;; "(DXB = width of most recent space/tab)") + (* ;; + "SPACERUN if we are backing up to a space run with unexpandable overhang spaces") - (* ;; "(PREVSP = location on the line of the previous space/tab to this space/tab + 1)") + (CL:WHEN TXB + (SETQ TRUEASCENT ASCENTB) + (SETQ TRUEDESCENT DESCENTB) + (SETQ TX TXB) + (SETQ CHNO CHNOB) + (SETQ CHARSLOT CHARSLOTB)) + (COND + ((AND SPACERUN FIRSTWHITESLOT) (* ; "Clear/register the overhangs") + (CL:WHEN PREVSP + (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP (fetch (CHARSLOT + CHAR) + of FIRSTWHITESLOT)) + )) + (SETQ SPACELEFT (IDIFFERENCE WIDTH FIRSTWHITEX)) + (SETQ OVERHANG (IDIFFERENCE TX FIRSTWHITEX))) + (T (SETQ SPACELEFT (IDIFFERENCE WIDTH TX)) + (SETQ OVERHANG 0]) - (* ;; "(T1SPACE = a space/CR/TAB has been seen)") +(PUTPROPS FORCEBREAK MACRO [NIL (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP)) + (* ; "All spaces are natural") - (* ;; "(#BLANKS = # of spaces/tabs seen) ") + (* ;; "If the EOL comes right after a word-character that was preceded by a space run, those earlier spaces don't count in our overhang. INSPACES tracks that. ") - (* ;; " (LOOKNO = Current index into the LOOKS array. Updated by \TEDIT.LOOKS.UPDATE as characters are read in)") - - (* ;; "(LOOK#B = The LOOKNO of the most recent space/tab)") - - (* ;; "(ASCENTB = Ascent at most recent potential line break point)") - - (* ;; "(DESCENTB = Descent at most recent potential line break point)") - - (SETQ CH#1 (IMAX CH#1 1)) - [SETQ ORIGCHLIST (SETQ CHLIST (fetch (ARRAYP BASE) of (fetch (THISLINE CHARS) of THISLINE] - [SETQ ORIGWLIST (SETQ WLIST (fetch (ARRAYP BASE) of (fetch (THISLINE WIDTHS) of THISLINE] - (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) - (SETQ TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (SETQ TERMSA (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) - (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with (FUNCTION \TEDIT.LOOKS.UPDATE)) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with TEXTLEN) - (* ; - "Force each new line to find its true CHARLIM.") - (freplace (LINEDESCRIPTOR DIRTY) of LINE with NIL) (* ; - "And as unchanged since the last formatting.") - (freplace (LINEDESCRIPTOR CHAR1) of LINE with CH#1) - (freplace (LINEDESCRIPTOR CR\END) of LINE with NIL)(* ; "Assume we won't see a CR.") - (freplace (LINEDESCRIPTOR LHASTABS) of LINE with NIL) - (* ; "And has no TABs.") - (COND - [(COND - ((AND (ILEQ CH#1 TEXTLEN) - (NOT (ZEROP TEXTLEN))) (* ; - "Only continue if there's really text we can format.") - (\SETUPGETCH CH#1 TEXTOBJ) (* ; "Starting place") - (* ; "And starting character looks") - (SETQ CLOOKS (fetch (TEXTSTREAM CURRENTLOOKS) of TEXTSTREAM)) - (COND - ((fetch CLINVISIBLE of CLOOKS) (* ; - "We've hit a run of invisible characters. Skip them, and insert a marker in the line cache") - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (SETQ PC (fetch (TEXTSTREAM PIECE) of TEXTSTREAM)) - (\EDITSETA LOOKS LOOKNO (SETQ INVISIBLERUNS (fetch (PIECE PLEN) of PC))) - (\RPLPTR CHLIST 0 LMInvisibleRun) - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) of PC) - PC TEXTOBJ))) - [while (AND PC (fetch CLINVISIBLE of CLOOKS)) - do (\EDITSETA LOOKS LOOKNO (add INVISIBLERUNS (fetch (PIECE PLEN) - of PC))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) - (AND PC (SETQ CLOOKS (\TEDIT.APPLY.STYLES (ffetch (PIECE PLOOKS) - of PC) - PC TEXTOBJ] - (add CHNO (\EDITELT LOOKS LOOKNO)) - (\SETUPGETCH (create EDITMARK - PC _ (OR PC 'LASTPIECE) - PCOFF _ 0 - PCNO _ NIL) - TEXTOBJ))) - (ILEQ CHNO TEXTLEN))) - (replace (LINEDESCRIPTOR LHASPROT) of LINE with (fetch CLPROTECTED of CLOOKS)) - (* ; - "Remember if the first character on the line is protected.") - (SETQ ORIGFMTSPEC (SETQ FMTSPEC - (\TEDIT.APPLY.PARASTYLES - [OR FMTSPEC (SETQ FMTSPEC (OR (AND (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM) - (fetch (PIECE PPARALOOKS) - of (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM))) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - PC TEXTOBJ))) (* ; "Get the paragraph looks") - (COND - ((NEQ ORIGFMTSPEC *TEDIT-CACHED-FMTSPEC*) - - (* ;; "The cache of character styles for the current paragrpah is invalid; flush it, and note the new paragraph to cache for.") - - (SETQ *TEDIT-CURRENTPARA-CACHE* NIL) - (SETQ *TEDIT-CACHED-FMTSPEC* ORIGFMTSPEC))) - (COND - [(SETQ HARDCOPYMODE (fetch FMTHARDCOPY of FMTSPEC)) - (* ; - "This line is a hardcopy line. Scale things for it.") - [SETQ DEVICE (OR (fetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ) - (replace (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ - with (OPENIMAGESTREAM '{NODIRCORE} 'INTERPRESS] - (SETQ SCALE (DSPSCALE NIL DEVICE)) - (SETQ FMTSPEC (\TEDIT.HCPYFMTSPEC FMTSPEC DEVICE)) - (SETQ DEFAULTTAB (FIXR (FTIMES 36 SCALE))) - (SETQ LEFTEDGE (FIXR (FTIMES 8 SCALE] - (T (* ; - "Regular line. Format at display resolutions") - (SETQ DEVICE (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (SETQ SCALE 1) - (SETQ LEFTEDGE 8))) - (SETQ TABSPEC (fetch TABSPEC of FMTSPEC)) - [COND - ((type? FONTCLASS (SETQ FONT (fetch CLFONT of CLOOKS))) - (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) - 'DEVICE - 'DISPLAY] (* ; - "Grab the initial font for this line") - [SETQ ASCENTB (SETQ NEWASCENT (IPLUS (fetch \SFAscent of FONT) - (OR (fetch CLOFFSET of CLOOKS) - 0] (* ; - "The initial ascent, per the initial font") - [SETQ DESCENTB (SETQ NEWDESCENT (IDIFFERENCE (fetch \SFDescent of FONT) - (OR (fetch CLOFFSET of CLOOKS) - 0] (* ; - "Initial descent, per the initial font.") - [COND - (HARDCOPYMODE (* ; - "If this is a hardcopy line, fetch the hardcopy version of the font") - (SETQ FONT (FONTCOPY (fetch CLFONT of CLOOKS) - 'DEVICE DEVICE] - (\EDITSETA LOOKS 0 CLOOKS) (* ; "Save looks in the line cache") - [SETQ 1STLN (OR (IEQP CH#1 1) - (AND (fetch (TEXTSTREAM PIECE) of TEXTSTREAM) - (fetch (PIECE PREVPIECE) of (fetch (TEXTSTREAM PIECE) of - TEXTSTREAM - )) - (fetch (PIECE PPARALAST) of (fetch (PIECE PREVPIECE) - of (fetch (TEXTSTREAM PIECE) - of TEXTSTREAM))) - (IEQP (fetch (TEXTSTREAM PCSTARTCH) of TEXTSTREAM) - (fetch (STREAM COFFSET) of TEXTSTREAM)) - (IEQP (fetch (TEXTSTREAM PCSTARTPG) of TEXTSTREAM) - (fetch (STREAM CPAGE) of TEXTSTREAM] - (* ; - "If this is the start of a paragraph, mark it so.") - (replace (LINEDESCRIPTOR LMARK) of LINE with NIL) - (* ; - "Start by assuming that we don't want a margin marker for this line.") - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - (* ; - "Are we on the first line of a paragraph?") - [COND - (1STLN - (* ;; "This is the first line of a paragraph. Check for special paragraph types, like headings, that get marked in the margin.") - - (COND - ((EQ (fetch FMTPARATYPE of FMTSPEC) - 'PAGEHEADING) - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ((OR (fetch FMTNEWPAGEBEFORE of FMTSPEC) - (fetch FMTNEWPAGEAFTER of FMTSPEC)) - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ([AND (fetch FMTSPECIALX of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALX of FMTSPEC] - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY)) - ([AND (fetch FMTSPECIALY of FMTSPEC) - (NOT (ZEROP (fetch FMTSPECIALY of FMTSPEC] - (replace (LINEDESCRIPTOR LMARK) of LINE with 'GREY] - [SETQ TX (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS [FIXR (FTIMES SCALE (IPLUS 8 (fetch (TEXTOBJ WLEFT) - of TEXTOBJ] - (COND - (1STLN (fetch 1STLEFTMAR of FMTSPEC)) - (T (fetch LEFTMAR of FMTSPEC] - (* ; "Set the left margin accordingly") - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) - (IPLUS LEFTEDGE (fetch RIGHTMAR of FMTSPEC))) - (T (FIXR (FTIMES SCALE (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - 8] - (* ; - "RIGHTMAR = 0 => follow the window's width.") - (SETQ TXB1 WIDTH) - (for old TLEN from TLEN to 254 as old CHNO from CHNO while (ILEQ CHNO TEXTLEN) - when (SETQ CH (\BIN TEXTSTREAM)) - do (* ; "(The WHILE is there because we may reset TEXTLEN within the loop, and TO TEXTLEN only evaluates it once.)") - - (* ;; "The character loop") - - (* ;; "Get the next character for the line.") - - [SETQ DX (COND - [(SMALLP CH) (* ; "CH is really a character") - (COND - ((AND (IGEQ CH 192) - (ILEQ CH 207)) (* ; - "This is an NS accent character. Space it 0.") - (SETQ DX 0)) - (T (* ; - "Regular character. Get it's width.") - (\FGETCHARWIDTH FONT CH] - (T (* ; "CH is an object") - (SETQ BOX (APPLY* (IMAGEOBJPROP CH 'IMAGEBOXFN) - CH DS TX WIDTH)) - (* ; "Get its size") - (SETQ NEWASCENT (IDIFFERENCE (fetch YSIZE of BOX) - (fetch YDESC of BOX))) - (SETQ NEWDESCENT (fetch YDESC of BOX)) - (IMAGEOBJPROP CH 'BOUNDBOX BOX) - (COND - ([NEQ 1 (fetch (PIECE PLEN) of (SETQ PC (fetch (TEXTSTREAM - PIECE) - of TEXTSTREAM] - - (* ;; "The object is several chars wide, but doesn't have a subsidiary stream to pull those chars from. Build an invisible run to fill the space.") - - (add LOOKNO 1) (* ; - "Fix the counter of charlooks changes") - (\EDITSETA LOOKS LOOKNO (SUB1 (fetch (PIECE PLEN) of PC))) - (\RPLPTR CHLIST 0 LMInvisibleRun) - (* ; - "Note the existence of an invisible run of characters here.") - (\RPLPTR WLIST 0 0) - (add TLEN 1) - (SETQ CHLIST (\ADDBASE CHLIST 2)) - (SETQ WLIST (\ADDBASE WLIST 2)) - (add CHNO (SUB1 (fetch (PIECE PLEN) of PC))) - (add INVISIBLERUNS (\EDITELT LOOKS LOOKNO)) - (* ; - "Keep track of how much invisible text we cross over") - )) - (COND - [HARDCOPYMODE (FIXR (FTIMES SCALE (fetch XSIZE of BOX] - (T (fetch XSIZE of BOX] - (* ; "Get CH's X width.") - [SELCHARQ CH - (SPACE (* ; - "CH is a . Remember it, in case we need to break the line.") - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) (* ; - "put the location # of the previous space/tab in the character array instead of the space itself") - (\RPLPTR CHLIST 0 PREVSP) - (\RPLPTR WLIST 0 DX) - (SETQ PREVSP (ADD1 TLEN)) - (SETQ T1SPACE T) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") (add TX DX) - (SETQ TXB TX) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (COND - (NEWASCENT (* ; "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS) - (add %#BLANKS 1)) - ((CR LF) (* ; - "Ch is a . Force an end to the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with CHNO) - (COND - ((AND NEWASCENT (ZEROP ASCENT) - (ZEROP DESCENT)) (* ; "The ascent has changed; catch it") - (SETQ ASCENT NEWASCENT) - (SETQ DESCENT NEWDESCENT))) - (SETQ FORCEEND T) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (\RPLPTR CHLIST 0 (CHARCODE EOL)) - (\RPLPTR WLIST 0 (SETQ DX (IMAX DX 6))) - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ T1SPACE T) - (freplace (LINEDESCRIPTOR CR\END) of LINE with T) - (SETQ TX (IPLUS TX DX)) - (replace (LINEDESCRIPTOR LSTLN) of LINE with T) - (* ; - "This has to be done better when we get non-para breaking CRs.") - (RETURN)) - (TAB - (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") + (SETQ OVERHANG (CL:IF INSPACES + (IDIFFERENCE TX FIRSTWHITEX) + DX)) + (SETQ SPACELEFT (IDIFFERENCE WIDTH (IDIFFERENCE TX OVERHANG]) - (replace (LINEDESCRIPTOR LHASTABS) of LINE with T) - (* ; "To disable smart screen update") - (COND - (NEWASCENT (* ; "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 CH) - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX DEFAULTTAB - LEFTEDGE TABPENDING 0 NIL)) +(PUTPROPS FORGETHYPHENBREAK MACRO (NIL (CL:WHEN PREVDHYPH (* ; + "Previous soft hyphen becomes invisible") + (add TX (IMINUS (CHARW PREVDHYPH))) + (FILLCHARSLOT PREVDHYPH NIL 1)) + (SETQ PREVDHYPH (SETQ PREVHYPH NIL)))) + +(PUTPROPS FORGETPREVIOUSBREAK MACRO (NIL (FORGETHYPHENBREAK) (* ; "Forget hyphens") + (SETQ FIRSTWHITEX 0) + (SETQ FIRSTWHITESLOT NIL))) +) + +(DECLARE%: EVAL@COMPILE + +(DATATYPE PENDINGTAB ( + (* ;; "The data structure for a tab, within the line formatter, that we haven't finished dealing with yet, e.g. a centered tab where you need to wait for AFTER the centered text to do the formatting.") + + PTRESOLVEDWIDTH + + (* ;; "Width resolved for a prior tab. This results from the resolution of an old RIGHT, CENTERED, or DECIMAL tab.") + + PTOLDTAB (* ; "The pending tab") + PTTYPE (* ; "Its tab type") + PTTABX (* ; "Its nominal X position") + (PTCHARSLOT FULLXPOINTER) (* ; "The CHARSLOT that may need to be updated later. (RMK: I don't know why this is a FULLXPOINTER--maybe an issue in the older THISLINE implementation?)") + PTOLDTX (* ; + "The TX as of when the tab was encountered.") + )) +) + +(/DECLAREDATATYPE 'PENDINGTAB '(POINTER POINTER POINTER POINTER FULLXPOINTER POINTER) + '((PENDINGTAB 0 POINTER) + (PENDINGTAB 2 POINTER) + (PENDINGTAB 4 POINTER) + (PENDINGTAB 6 POINTER) + (PENDINGTAB 8 FULLXPOINTER) + (PENDINGTAB 10 POINTER)) + '12) +) + +(/DECLAREDATATYPE 'PENDINGTAB '(POINTER POINTER POINTER POINTER FULLXPOINTER POINTER) + '((PENDINGTAB 0 POINTER) + (PENDINGTAB 2 POINTER) + (PENDINGTAB 4 POINTER) + (PENDINGTAB 6 POINTER) + (PENDINGTAB 8 FULLXPOINTER) + (PENDINGTAB 10 POINTER)) + '12) +(DEFINEQ + +(\FORMATLINE + [LAMBDA (TEXTOBJ CH#1 LINE REGION IMAGESTREAM FORMATTINGSTATE) + (* ; "Edited 2-Mar-2024 07:39 by rmk") + (* ; "Edited 5-Feb-2024 09:35 by rmk") + (* ; "Edited 26-Jan-2024 11:01 by rmk") + (* ; "Edited 3-Dec-2023 16:48 by rmk") + (* ; "Edited 27-Nov-2023 23:05 by rmk") + (* ; "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)) + + (* ;; + "Format the next line of text starting at CH#1. Return the LINEDESCRIPTOR; reusing LINE if given.") + + (* ;; "The SPECVARS are accessed and reset under the subfunctions, particularly \FORMATLINE.UPDATELOOKS. IMAGESTREAM and FORMATTINGSTATE are passed only for hardcopy. ") + + (* ;; "") + + (* ;; "The objective of this body of code is to find") + + (* ;; " 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.") + + (* ;; " LXLIM: The X coordinate of the right edge of character/object LCHARLIM") + + (* ;; " PREVSP: The slot position in THISLINE of the right most scalable space.") + + (* ;; " SPACELEFT: How much unoccupied space is to be allocated according to justified, right, center alignments.") + + (* ;; " OVERHANG: How far beyond the right margin will trailing spaces/EOL occupy") + + (* ;; " THISLINE: The CHARSLOT vector that contains the actual characters and widths, together with their looks, as abstracted from the piece sequences of the underlying text.") + + (* ;; " ") + + (* ;; "At the end, \FORMATLINE.JUSTIFYmodifies LINE and THISLINE to deal with the vagaries of justification. The overhanging right-margin spaces don't get fattened even though justifying might fatten earlier spaces on the line.") + + (* ;; "") + + (* ;; "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)) + (OFFSET 0) + (TRUEASCENT -1) + (TRUEDESCENT -1) + (ASCENTB 0) + (DESCENTB 0) + (ASCENTC 0) + (DESCENTC 0) + (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)) + + (* ;; + "CHNO = Current character # in the text, CHNOB is the character at the last potential break") + + (* ;; "CHARSLOT = Pointer to the next available slot in THISLINE's CHARS.") + + (* ;; "DX = width of current char/object") + + (* ;; "TX = Right end of current text, TXB is the right end at the last potential break") + + (* ;; "PREVSP = CHARPOS of the last space of the most recent space-run") + + (* ;; + "ASCENT, DESCENT = The ascent and descent values of the line at the current character position") + + (* ;; "ASCENTC, DESCENTC = The ascent and descent from the last CLOOKS (including OFFSET)") + + (* ;; + "ASCENTB, DESCENTB, CHNOB, TXB, CHARSLOTB = The values at the most recent potential break-point") + + (* ;; "LX1 = theoffset from the true left margin of the first character, in native units, accounting for the first-line indentation.") + + (* ;; "") + + (replace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (LASTCHARSLOT THISLINE)) + + (* ;; "Start with LASTCHARSLOT just so STL debugger will show everything before the true end has been determined.") + + (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)) (* ; - "Figure out which tab stop to use, and what we need to do to get there.") - [COND - ((FIXP TABPENDING) (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX of TABPENDING] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (SETQ DX (\GETBASEPTR WLIST 0)) - (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE) - PREVSP) (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) (* ; - "Also reset the count of spaces on this line, so we widen later spaces enough.") - (SETQ PREVSP 0) - (SETQ T1SPACE T) - (SETQ TX (IPLUS TX DX)) - (SETQ TXB TX) (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ PREVDHYPH NIL) - (SETQ PREVHYPH NIL) (* ; - "We're now past needing any hyphens for line breaking, so forget the last hyphen spot.") - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - (PROGN (COND - ((AND (EQ CH (CHARCODE "0,377")) - (NOT (ffetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ))) + "Presumably hardcopy in different page regions.") + (SETQ WIDTH (ffetch (REGION WIDTH) of REGION)) + else (SETQ WMARGIN \TEDIT.LINEREGION.WIDTH) (* ; + "A little more display margin on both sides") + (SETQ WIDTH (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) + (UNFOLD WMARGIN 2] + + (* ;; "") + + (SETQ PC (\CHTOPC CH#1 TEXTOBJ T)) + (CL:WHEN (OR (NULL PC) + (EQ PC (FGETTOBJ TEXTOBJ LASTPIECE))) + + (* ;; + "The dummy line is presumably the one that allows for the cursor to blink after a final EOL.") + + (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 (\FORMATLINE.EMPTY TEXTOBJ CH#1 LINE))) + (SETQ CH#1 (\PCTOCH PC TEXTOBJ)) (* ; + "Unusual, simpler than keeping track on the fly") + (SETQ START-OF-PIECE CH#1)) + (SETQ CHNO CH#1) + (SETQ IMAGESTREAM (\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)) + + (* ;; "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") + + (SETQ LX1 (CL:IF 1STLN + (ffetch (FMTSPEC 1STLEFTMAR) of FMTSPEC) + (ffetch (FMTSPEC LEFTMAR) of FMTSPEC))) + (SETQ RIGHTMARGIN (if (ZEROP (ffetch (FMTSPEC RIGHTMAR) of FMTSPEC)) + then + (* ;; "RIGHTMAR = 0 => follow the window/region's width") + + WIDTH + else (ffetch (FMTSPEC RIGHTMAR) of FMTSPEC))) + (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 (\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 \FORMATLINE.UPDATELOOKS)) + (freplace (TEXTSTREAM CURRENTLOOKS) of TSTREAM with NIL) + (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..") + + (* ;; "") + + (* ;; "TEXTLEN anticipates the EOL error. Wouldn't need it if we reset the ENDOFSTREAMOP.") + + (* ;; + " 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) + (LASTCHARSLOT _ (LASTCHARSLOT THISLINE)) + (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.") + + [SETQ DX (COND + ((SMALLP CH) (* ; "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") + + [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) + + (* ;; "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.") + + (* ;; "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.") + + (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))) + + (* ;; + "The external DX has to be upscaled from its displaystream coordinates. ") + + (CL:IF (EQ LINETYPE 'HARDCOPYDISPLAY) + (HCSCALE SCALE DX) + DX)] + (CL:WHEN KERN (* ; "Unlikely for display") + (add DX KERN)) + [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]") + + (* ;; + " 123abc456xy|z => 123abc|[456]$xyz Line break in front of x, 456 overhangs margin") + + (if UNBREAKABLE + then (add TX DX) + + (* ;; "Not including this space in the justifying chain, so it won't expand. If that looks odd, let it fall through to the PUSHCHAR below.") + + (PUSHCHAR CHARSLOT CH DX) + else (SPACEBREAK) + (add TX DX) + (SAVEBREAK) + + (* ;; "CHAR will be the slot of the previous space, not this space character, CHARW is the natural width of this space. PREVSP is the new chain-header.") + + (PUSHCHAR CHARSLOT (CL:IF JUSTIFIED + (PROG1 PREVSP (SETQ PREVSP CHARSLOT)) + CH) + DX))) + (TAB + (* ;; "Try to be reasonable with tabs. This will create trouble when doing fast-case insert/delete, but Pah! for now.") + + (* ;; "Remove all prior candidate break points and expandable spaces") + + (FORGETPREVIOUSBREAK) + (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP)) + + (* ;; "Now for this tab:") + (* ; + "Start with 0 width, then set up the next tab") + (FILLCHARSLOT CHARSLOT CH 0) + (SETQ TABPENDING (\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX + TABPENDING)) + (* ; + "Proper width is already in CHARSLOT") + (SETQ DX (CL:IF (FIXP TABPENDING) + (PROG1 TABPENDING (SETQ TABPENDING NIL)) + (fetch (PENDINGTAB PTRESOLVEDWIDTH) of TABPENDING))) + (add TX DX) + (CL:WHEN (IGREATERP TX WIDTH) (* ; "Tab pushed beyond the margin") + (SETQ OVERHANG (IDIFFERENCE TX WIDTH)) + (SETQ SPACELEFT 0) + (RETURN)) + (SETQ CHARSLOT (NEXTCHARSLOT CHARSLOT))) + (PROGN + (* ;; "Not an EOL, space, or tab character. ") + + (SETQ INWORD T) (* ; "Space run has ended") + (SETQ INSPACES NIL) + (CL:UNLESS (DIACRITICP CH) + + (* ;; "Assume that diacritics have zero width. \DISPLAYLINE and \TEDIT.HARDCOPY.DISPLAYLINE adjust their alignment, centering on the next character. However, if a diacritic is wider than the the next character, here the next character should be assigned the diacritic's width. ") + + (add TX DX)) + (CL:WHEN (IGREATERP TX WIDTH) + + (* ;; "Overflow: If there's a previous break, go back to it. If this character won't fit no matter what, just put it here and let it run out into the margin (or off the page).") + + (CL:WHEN FIRSTWHITESLOT (* ; "Back to previous space run") + (DOBREAK T) + (RETURN)) + (CL:WHEN (OR PREVHYPH PREVDHYPH) (* ;; - "Character-set change character. This suggests undetected NS characters.") + "A good break-point not followed by spaces. NOTE: Even pending tabs go on the next line.") - (\TEDIT.NSCHAR.RUN CHNO TEXTOBJ TEXTSTREAM) - (* ; - "Leaves us ready to BIN again at the same place.") + (CL:UNLESS TXB (FILLCHARSLOT CH DX)) + (DOBREAK) + (RETURN)) + (CL:WHEN (IGREATERP DX WIDTH) - (* ;; "Back up the cache pointers and counters so that when we go to the top of the loop we're where we are now.") + (* ;; "This character will never fit (e.g. a large image object). Move it to next line, by itself, if this line isn't empty. Otherwise, dump it here by itself.") - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add CHNO -1) - (add TLEN -1) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "Because moving to NS characters changes the TEXTLEN for the shorter.") - ) - (T - (* ;; "Not a formatting character, so gather") + (if (IGREATERP CHNO CH#1) + then - (SETQ GATHERBLANK T) (* ; "Blanks are interesting again.") - (COND - ((IGREATERP (SETQ TX (IPLUS TX DX)) - WIDTH) (* ; - "We're past the right margin; stop formatting at the last blank.") - (SETQ FORCEEND T) - [COND - (PREVDHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (\RPLPTR ORIGCHLIST (LLSH (SUB1 PREVDHYPH) - 1) - (CHARCODE "-")) - (\RPLPTR ORIGWLIST (LLSH (SUB1 PREVDHYPH) - 1) - (\FGETCHARWIDTH FONT (CHARCODE "-"))) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (PREVHYPH (* ; - "There's a hyphen we can break at. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - (T1SPACE (* ; - "There's a breaking point on this line. Go back there and break the line.") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CH#B) - (SETQ TX TXB) - (SETQ DX DXB) - (SETQ ASCENT ASCENTB) - (SETQ DESCENT DESCENTB) - (SETQ LOOKNO LOOK#B) - (SETQ INVISIBLERUNS INVISIBLERUNSB)) - ((IGREATERP TLEN 0) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX (SUB1 CHNO) - CH#1)) - (SETQ TX (IDIFFERENCE TX DX)) - (* ; - "No spaces on this line; break it before this character.") + (* ;; "Move the offender to the next line, by itself. For this line it essentially acts like an EOL wrt breaking and justifying, except that it doesn't get tacked on to the end. There was no good earlier break, otherwise we would have done it. ") - (* ;; "Check line break character.") + (add TX (IMINUS DX)) + (add CHNO -1) (* ; "back up to preceding character") + (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT)) + (SETQ CH (CHAR CHARSLOT)) + (SETQ DX (CHARW CHARSLOT)) - (while (OR (MEMBER (\GETBASEPTR CHLIST -2) - TEDIT.DONT.LAST.CHARS) - (MEMBER CH TEDIT.DONT.BREAK.CHARS)) - do - (* ;; - "This character ch doesn't appear at first of lines. or") + (* ;; "ASCENT/DESCENT for the previous CLOOKS. BUT: if the previous character is an object, it has to back out its box parameters") - (* ;; - "Previous character doesn't appear at the end of lines.") + (SETQ TRUEASCENT ASCENTC) + (SETQ TRUEDESCENT DESCENTC) + else + (* ;; "Dump it here") - (* ;; "So,move previous character to next line.") + (FILLCHARSLOT CHARSLOT CH DX)) + (SETQ OVERHANG 0) + (SETQ SPACELEFT 0) + (RETURN)) + (CL:WHEN (IGREATERP CHNO CH#1) - (SETQ CHLIST (\ADDBASE CHLIST -2)) - (SETQ WLIST (\ADDBASE WLIST -2)) - (add TLEN -1) - (add CHNO -1) - (SETQ CH (\GETBASEPTR CHLIST 0))) - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with (IMAX (SUB1 CHNO) - CH#1))) - (T (* ; - "Can't split BEFORE the first thing on the line!") - (freplace (LINEDESCRIPTOR CHARLIM) of LINE - with CHNO) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX) - (COND - (NEWASCENT - (* ; "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL] - (RETURN)) - (T (* ; "Not past the rightmargin yet...") - (COND - (NEWASCENT (* ; "The ascent has changed; catch it") - (SETQ ASCENT (IMAX ASCENT NEWASCENT)) - (SETQ DESCENT (IMAX DESCENT NEWDESCENT)) - (SETQ NEWASCENT NIL))) - (\RPLPTR CHLIST 0 CH) - (\RPLPTR WLIST 0 DX) - (SELCHARQ CH - (%. (* ; "Check for decimal tabs") - (COND - ((AND TABPENDING (NOT (FIXP TABPENDING)) - (EQ (fetch PTTYPE of TABPENDING) + (* ;; "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 (\FORMATLINE.LASTLEGAL) + + (* ;; "Didn't find one, the offender protrudes on this line") + + (FILLCHARSLOT CHARSLOT CH DX)) + (RETURN)) + + (* ;; "Don't break: can't split before the first thing on the line!") + + (PUSHCHAR CHARSLOT CH DX) + (RETURN)) + + (* ;; "") + + (* ;; + "Not past the rightmargin yet. Save the character and width, then maybe adjust.") + + (SELCHARQ CH + (%. (* ; + "Check for decimal tabs, immediately after TAB") + (PUSHCHAR CHARSLOT CH DX) + (CL:WHEN (AND TABPENDING (EQ (fetch PTTYPE of TABPENDING) 'DECIMAL)) (* ;  "Figure out which tab stop to use, and what we need to do to get there.") - (add (fetch (PENDINGTAB PTTABX) of - TABPENDING - ) - DX) - (* ; + (add (fetch (PENDINGTAB PTTABX) of TABPENDING) + DX) (* ;  "Adjust the tab stop's X value so that the LEFT edge of the decimal point goes there.") - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE - CHLIST WLIST TX DEFAULTTAB LEFTEDGE - TABPENDING 0 T)) + (SETQ TABPENDING + (\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX + TABPENDING T)) (* ;  "Tab over to the LEFT side of the decimal point.") - [COND - ((FIXP TABPENDING) + (add TX (CL:IF (FIXP TABPENDING) + (PROG1 TABPENDING (SETQ TABPENDING NIL)) + (fetch (PENDINGTAB PTRESOLVEDWIDTH) of + TABPENDING + ))) + (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP)) (* ; - "If it returns a number, that is the new TX, adjusted for any prior tabs") - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL)) - (TABPENDING + "Spaces before a tab don't take part in later justification.") + (SAVEBREAK))) + ((- EM-DASH SOFT-HYPHEN) (* ; + "Hyphen, M-dash, discretionary hyphen") + (CL:UNLESS UNBREAKABLE + (FORGETPREVIOUSBREAK) + (SETQ PREVHYPH CHARSLOT) + (CL:WHEN (EQ CH (CHARCODE SOFT-HYPHEN)) + (SETQ PREVDHYPH CHARSLOT) (* ; - "Otherwise, look in the PENDINGTAB for the new TX") - (SETQ TX (fetch PTNEWTX - of TABPENDING] - (COND - (GATHERBLANK (SETQ TXB1 TX) - (SETQ GATHERBLANK NIL))) - (SETQ CH#B CHNO) - (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) - of THISLINE) - PREVSP) + "Discretionary hyphen may become invisible") + (SETQ CH (CHARCODE)) (* ; - "All the spaces before a tab don't take part in justification from here on.") - (SETQ %#BLANKS 0) - (* ; - "Also reset the count of spaces on this line, so we widen later spaces enough.") - (SETQ PREVSP 0) - (SETQ T1SPACE T) - (SETQ TXB TX) - (* ; - "Remember the world in case this is the 'space' before the line breaks") - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)))) - ((- "357,045") - (* ; "Hyphen, M-dash") - (SETQ PREVHYPH (ADD1 TLEN)) - (SETQ PREVDHYPH NIL) - (SETQ TXB1 (SETQ TXB TX)) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,042" (* ; "non-breaking hyphen") - (\RPLPTR CHLIST 0 (CHARCODE "-"))) - ("357,043" (* ; "Discretionary hyphen") - (* ; "And isn't actually displayed.") - (SETQ PREVDHYPH (ADD1 TLEN)) - (SETQ PREVHYPH NIL) - (SETQ TXB1 (SETQ TXB TX)) - (SETQ DXB DX) - (SETQ LOOK#B LOOKNO) - (SETQ CH#B CHNO) - (SETQ ASCENTB ASCENT) - (SETQ DESCENTB DESCENT) - (\RPLPTR WLIST 0 0) - (* ; - "Unless we use it, the prevhyph is 0 wide.") - (\RPLPTR CHLIST 0 NIL) - (add TX (IMINUS DX)) - (SETQ INVISIBLERUNSB INVISIBLERUNS)) - ("357,041" (* ; "non-breaking space.")) - NIL] - (SETQ CHLIST (\ADDBASE CHLIST 2)) (* ; - "Move the pointers forward for the next character.") - (SETQ WLIST (\ADDBASE WLIST 2))) (* ; "End of char loop") - (COND - ((AND (IEQP TLEN 255) - (ILESSP CHNO TEXTLEN)) (* ; - "This line is too long for us to format??") - (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T))) - (COND - (TABPENDING (* ; - "There is a TAB outstanding. Go handle it.") - (add (fetch (PENDINGTAB PTTABX) of TABPENDING) - DX) (* ; - "Adjust the tab stop's X value so that the LEFT edge of the CR goes there.") - (SETQ TABPENDING - (\TEDIT.FORMATTABS TEXTOBJ TABSPEC THISLINE CHLIST WLIST TX DEFAULTTAB - LEFTEDGE TABPENDING 0 T)) + "Otherwise, it shows as a real hyphen") + (SETQ DX (\FGETCHARWIDTH FONT (CHARCODE "-")))) + (SAVEBREAK)) (* ; + "Save the hyphen slot, then fill it") + (PUSHCHAR CHARSLOT CH DX)) + (NONBREAKING-HYPHEN + (* ;; + "Switch the character code and width in case font doesn't have a glyph??") - (* ;; "Finish up processing the outstanding TAB. We get back the new X position, with that taken into account.") + (PUSHCHAR CHARSLOT (CHARCODE -) + (\FGETCHARWIDTH FONT (CHARCODE "-")))) + (NONBREAKING-SPACE (* ; + "This will eventually convert to SPACE") + (PUSHCHAR CHARSLOT (PROG1 PREVSP (SETQ PREVSP CHARSLOT)) + DX)) + (PUSHCHAR CHARSLOT CH DX] - (SETQ TX TABPENDING) - (SETQ TABPENDING NIL) - (\TEDIT.PURGE.SPACES (fetch (THISLINE CHARS) of THISLINE) - PREVSP) (* ; - "Don't use the spaces before the TAB in justification.") - (SETQ PREVSP 0] - (T (* ; - "No text to go in this line; set Ascent/Descent to the default font from the window.") - [SETQ PC (AND (IGREATERP TEXTLEN 0) - (\CHTOPC TEXTLEN (fetch (TEXTOBJ PCTB) of TEXTOBJ] - (* ; - "Grab the last real part of the document, to get paragraph looks") - (\EDITSETA LOOKS 0 CLOOKS) (* ; - "Set up the initial looks so that \DISPLAYLINE doesn't complain") - (SETQ FONT (OR (AND (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ))) - (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ))) - DEFAULTFONT)) + (* ;; "BOUNDS CHECKING!") - (* ;; "The font we use is preferably the caret looks, else the default for this edit, else the system default") + (CL:WHEN (EQ CHARSLOT LASTCHARSLOT) - (SETQ ASCENT (FONTPROP FONT 'ASCENT)) - (SETQ DESCENT (FONTPROP FONT 'DESCENT)) - (SETQ FMTSPEC (OR FMTSPEC (AND PC (fetch (PIECE PPARALOOKS) of PC)) - (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ))) - (* ; - "Use the preceding paragraph's looks") - (SETQ 1STLN (OR (NOT PC) - (fetch (PIECE PPARALAST) of PC))) - (replace (LINEDESCRIPTOR 1STLN) of LINE with 1STLN) - [SETQ TX (COND - [1STLN (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch 1STLEFTMAR of FMTSPEC] - (T (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE - with (IPLUS 8 (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch LEFTMAR of FMTSPEC] - [replace (LINEDESCRIPTOR RIGHTMARGIN) of LINE - with (SETQ WIDTH (COND - ((NOT (ZEROP (fetch RIGHTMAR of FMTSPEC))) - (fetch RIGHTMAR of FMTSPEC)) - (T (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - 8] - (SETQ TXB1 WIDTH))) - [COND - ((ZEROP (freplace (LINEDESCRIPTOR LHEIGHT) of LINE with (IPLUS ASCENT DESCENT))) - (replace (LINEDESCRIPTOR LHEIGHT) of LINE - with (FONTPROP (OR (AND (fetch (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ) - (fetch CLFONT of (fetch (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ))) - DEFAULTFONT) - 'HEIGHT] (* ; - "Line's height (or 12 for an empty line)") - (replace (LINEDESCRIPTOR ASCENT) of LINE with ASCENT) - (replace (LINEDESCRIPTOR DESCENT) of LINE with DESCENT) - (freplace (LINEDESCRIPTOR CHARTOP) of LINE with CHNO) - [COND - (FORCEEND NIL) - (T (SETQ CHNO (SUB1 CHNO)) - (SETQ TLEN (SUB1 TLEN] (* ; - "If we ran off the end of the text, then keep true space left on the line.") - (freplace (LINEDESCRIPTOR LXLIM) of LINE with TX) - [freplace (LINEDESCRIPTOR SPACELEFT) of LINE with (COND - (FORCEEND - (* ; - "The line was forced to end. Back up to start of last blank section") - (IDIFFERENCE WIDTH TXB1)) - (GATHERBLANK - (* ; - "Otherwise, use the rightmost character on the line.") - (IDIFFERENCE WIDTH TX)) - (T + (* ;; + "If too long, we let it roll over to the next line. Should we put something in the margin??") - (* ;; "The line ended with a run of white space. Ignore it for purposes of deciding how much more we can fit on the line.") + (TEDIT.PROMPTPRINT TEXTOBJ "Line too long to format." T) + (RETURN)) finally - (IDIFFERENCE WIDTH TXB1] + (* ;; + "Ran out of TEXTLEN (and paragraph). Back up and force a break. Are ASCENT/DESCENT correct?") + + (SETQ CHARSLOT (PREVCHARSLOT! CHARSLOT)) + (add CHNO -1) + (SETQ DX 0) (* ; "TX is already correct") + (FORCEBREAK)) + + (* ;; "End of character loop. ") + + (freplace (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE with (NEXTCHARSLOT CHARSLOT)) + (freplace (TEXTSTREAM LOOKSUPDATEFN) of TSTREAM with NIL) + + (* ;; "Fix up last tab?") + + (CL:WHEN TABPENDING + (SETQ PREVSP (\FORMATLINE.PURGE.SPACES PREVSP))(* ; "Don't justify spaces before tabs") + (add TX (\FORMATLINE.TABS TEXTOBJ TABSPEC SCALE (FETCH (PENDINGTAB PTCHARSLOT) + OF TABPENDING) + LX1 + (IDIFFERENCE TX OVERHANG) + TABPENDING T))) + + (* ;; "") + + (* ;; + "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 LX1 LX1) (* ; + "Still maybe scaled for hardcopy display") + (FSETLD LINE LXLIM (IPLUS LX1 TX)) + (FSETLD LINE 1STLN 1STLN) (* ; "First line of a paragraph") + [FSETLD LINE LSTLN (AND FORCED-END (PPARALAST (\CHTOPC CHNO TEXTOBJ] + (* ; "Last line of a paragraph") + + (* ;; "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) + '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] + '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))) + (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))) + DEFAULTFONT) + 'DEVICE IMAGESTREAM))) + (CL:WHEN (EQ -1 TRUEASCENT) (* ; "Blank or only ") + (SETQ TRUEASCENT ASCENTC) + (SETQ TRUEDESCENT DESCENTC)) + (FSETLD LINE LTRUEASCENT TRUEASCENT) (* ; + "|FORMATLINE.ALIGNED adjusts ASCENT, DESCENT, LHEIGHT") + (FSETLD LINE LTRUEDESCENT TRUEDESCENT) + + (* ;; "") + + (FSETLD LINE LFMTSPEC FMTSPEC) + (FSETLD LINE LTEXTOBJ TEXTOBJ) (* ; + "XPOINTER, valid if TEXTOBJ is held") (freplace (THISLINE DESC) of THISLINE with LINE) - [freplace (THISLINE LEN) of THISLINE - with (IMIN 254 (COND - ((ILESSP TEXTLEN CH#1) - -1) - (T (IPLUS LOOKNO (IDIFFERENCE (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - TEXTLEN) - (IPLUS INVISIBLERUNS (fetch (LINEDESCRIPTOR - CHAR1) - of LINE] - (\DOFORMATTING TEXTOBJ LINE (OR ORIGFMTSPEC FMTSPEC) - THISLINE %#BLANKS PREVSP 1STLN) - (replace (LINEDESCRIPTOR LFMTSPEC) of LINE with FMTSPEC) - (replace (TEXTSTREAM LOOKSUPDATEFN) of TEXTSTREAM with NIL) + (\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] + + (* ;; "Maybe SETQ instead of add ??") + + (add WMARGIN (ffetch (FMTSPEC FMTSPECIALX) of FMTSPEC))) + (add (FGETLD LINE LEFTMARGIN) + WMARGIN) + (add (FGETLD LINE RIGHTMARGIN) + WMARGIN) + (add (FGETLD LINE LX1) + WMARGIN) + (add (FGETLD LINE LXLIM) + WMARGIN) (RETURN LINE]) -(\TEDIT.NSCHAR.RUN - [LAMBDA (CHNO TEXTOBJ STREAM) (* ; "Edited 29-Apr-93 16:42 by jds") +(\FORMATLINE.SETUP + [LAMBDA (TEXTOBJ PC LINE IMAGESTREAM) (* ; "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") - (* ;; "Given that we've just BIN'd from TEXTOBJ at character # CHNO and it was a 255, rearrange the piece table so that NS characters are available transparently %"as far ahead as makes sense%".") + (* ;; "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. ") - (* ;; "Leave TEXTOBJ ready to BIN at CHNO again, so the line formatter can carry on.") + (* ;; "The global variable *TEDIT-CACHED-FMTSPEC* is a heuristic optimization") - (LET* [(PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PC START-OF-PIECE OFFSET PLEN CH NEXTCH PFPOS NEWPC NEWPLEN PF PS CHARSET TFILE - (OLDFILEPTR (SUB1 (GETFILEPTR STREAM] - (SETQ PC (\CHTOPC CHNO PCTB T)) - (SETQ OFFSET (- CHNO START-OF-PIECE)) - (SETQ PLEN (fetch (PIECE PLEN) of PC)) - (COND - ((fetch (PIECE PFATP) of PC) - (HELP "Hit charset change in a FAT piece"))) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) + (* ;; "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. ") + + [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))) + + (* ;; "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) + IMAGESTREAM]) + +(\TEDIT.FORMATLINE.HORIZONTAL + [LAMBDA (LINE THISLINE PREVSP SPACELEFT OVERHANG LINETYPE) (* ; "Edited 3-Dec-2023 16:49 by rmk") + (* ; "Edited 29-Oct-2023 18:24 by rmk") + (* ; "Edited 2-Jul-2023 15:15 by rmk") + (* ; "Edited 6-Apr-2023 10:13 by rmk") + (* ; "Edited 8-Mar-2023 12:45 by rmk") + + (* ;; "Do the formatting work for justified, centered, etc. lines. We calculate how much space between LX0 and right margin is not occupied by the natural widths of the characters cached in THISLINE. For this calculation we back out spaces at the end of the line. They are present for later display and selection, but are ignored for purposes of right, centered, and justified alignment.") + + (* ;; "") + + (* ;; "In HARDCOPYDISPLAY, LX1, LXLIM, SPACELEFT, and OVERHANG are all in scaled units, otherwise in natural stream units. SPACELEFT+LXLIM-OVERHANG should be the right margin.") + + (* ;; "") + + (* ;; "The display-alignment is controlled by LX0 (offset from LEFTMARGIN) and LXLIM. At entry, LXLIM is the natural width of the line-characters. LXLIM may embrace the extra spaces, but they are out in the right margin or beyond the window, invisible unless selected") + + (* ;; "SPACELEFT is what it takes to push the last visible character out to the right margin. This is done by expanding spaces. OVERHANG is what gets added to LXLIM because of white space after the last visible. The OVERHANG white space is not expanded.") + + (* ;; "") + + (* ;; "Also for HARDCOPYDISPLAY the horizontal positions (margins and character widths) are in hardcopy units. At the end we scale them back to screen points. ") + + (LET* ((FMTSPEC (FGETLD LINE LFMTSPEC)) + (SCALE (ffetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC))) + + (* ;; "Distribute SPACELEFT according to QUAD. ") + + (freplace (THISLINE TLSPACEFACTOR) of THISLINE with 1) + (CL:WHEN (EQ 'JUSTIFIED (fetch (FMTSPEC QUAD) of FMTSPEC)) + (\FORMATLINE.JUSTIFY LINE THISLINE PREVSP SPACELEFT LINETYPE)) + (\FORMATLINE.PURGE.SPACES PREVSP) + + (* ;; "") + + (* ;; "Done with spaces, expanded or not. Down scale if hard-copy display mode") + + (CL:WHEN (EQ LINETYPE 'HARDCOPYDISPLAY) + (change (FGETLD LINE LX1) + (HCUNSCALE SCALE DATUM)) + (change (FGETLD LINE LXLIM) + (HCUNSCALE SCALE DATUM)) + (SETQ SPACELEFT (HCUNSCALE SCALE SPACELEFT)) + (SETQ OVERHANG (HCUNSCALE SCALE OVERHANG)) + + (* ;; "Scale the character widths to points, propagating rounding error along the way. LOST starts at .5 pt so that rounding doesn't clip the last character") + + (for CHARSLOT REDUCED (LOST _ 0.5) incharslots THISLINE when CHAR + do (SETQ REDUCED (FPLUS LOST (FQUOTIENT CHARW SCALE))) (* ; - "This rearranges the piece table, so later insertions better use a fresh piece.") - (* ; "Back up over the 255") - (SETQ CH (BIN STREAM)) - [COND - [(IEQP CH 255) (* ; "A steady run of fat characters.") - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece is in a string.") - (HELP "NS characters in a STRING??")) - ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece is in a file.") - (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) - (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) - PF - (IPLUS OFFSET PFPOS 3) - (IPLUS PFPOS PLEN))) (* ; - "Find the succeeding 255, or end of piece.") - [SETQ NEWPLEN (COND - (NEXTCH (IQUOTIENT (IDIFFERENCE NEXTCH (IPLUS PFPOS OFFSET 3)) - 2)) - (T (IQUOTIENT (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) - 3) - 2] - (\DELETECH (IPLUS START-OF-PIECE OFFSET) - (IPLUS START-OF-PIECE OFFSET 5 (ITIMES NEWPLEN 2)) - (IPLUS 5 (ITIMES NEWPLEN 2)) - TEXTOBJ T) - (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) - (create PIECE using PC PFILE _ PF PFPOS _ (IPLUS PFPOS OFFSET 3) - PFATP _ T PSTR _ NIL PLEN _ NEWPLEN) - NEWPLEN NIL NIL NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - NEWPLEN] - (T (* ; - "Changing to a new character set for succeeding characters.") - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) (* ; "This piece is in a string.") - (HELP "NS characters in a STRING??")) - ((SETQ PF (fetch (PIECE PFILE) of PC)) (* ; "This piece is in a file.") - (SETQ CHARSET CH) - (SETQ PFPOS (fetch (PIECE PFPOS) of PC)) - (SETQ NEXTCH (FFILEPOS (MKSTRING (CHARACTER 255)) - PF - (IPLUS OFFSET PFPOS 2) - (IPLUS PFPOS PLEN))) (* ; - "Find the succeeding 255, or end of piece.") - [SETQ NEWPLEN (COND - ((ZEROP CHARSET) (* ; "If we're moving back to charset 0, we just want to delete the charset change marker, so the newPlen is 0.") - 0) - (NEXTCH (IDIFFERENCE NEXTCH (IPLUS OFFSET PFPOS 2))) - (T (IDIFFERENCE (IDIFFERENCE PLEN OFFSET) - 2] - (\DELETECH (IPLUS START-OF-PIECE OFFSET) - (IPLUS START-OF-PIECE OFFSET 2 NEWPLEN) - (IPLUS NEWPLEN 2) - TEXTOBJ T) - (COND - ((ZEROP NEWPLEN) (* ; - "Do nothing if there weren't really any characters to be put in the new character set.") - ) - ((ZEROP CHARSET) (* ; - "Do nothing if we're switching back to normal character.") - ) - (T (* ; "There really are characters to be moved to the new character set. Create the temporary file for them.") + "Include the previously lost point-fraction") + [SETQ LOST (FDIFFERENCE REDUCED (SETQ REDUCED (FIX REDUCED] + (replace (CHARSLOT CHARW) of CHARSLOT with REDUCED))) - (* ;; "Create the file") + (* ;; "") - (SETQ TFILE (OPENSTREAM '{NODIRCORE} 'BOTH)) - (SETFILEPTR PF (IPLUS OFFSET PFPOS 2)) - (for I from 1 to NEWPLEN do - (* ;; - "Copy the newly fattened characters into the temp file.") + (SELECTQ (ffetch (FMTSPEC QUAD) of FMTSPEC) + (RIGHT (* ; "Move over to the right margin") + (add (FGETLD LINE LX1 LINE) + SPACELEFT) + (add (FGETLD LINE LXLIM) + SPACELEFT)) + (CENTERED (* ; "Split the difference ") + (add (FGETLD LINE LX1) + (FOLDLO SPACELEFT 2)) + (add (FGETLD LINE LXLIM) + (FOLDLO SPACELEFT 2))) + NIL]) - (BOUT TFILE CHARSET) - (BOUT TFILE (BIN PF))) +(\TEDIT.FORMATLINE.VERTICAL + [LAMBDA (LINE TEXTOBJ) (* ; "Edited 17-Dec-2023 00:43 by rmk") + (* ; "Edited 6-Dec-2023 20:13 by rmk") + (* ; "Edited 4-Dec-2023 12:13 by rmk") - (* ;; "Insert a new piece in the document holding the fat characters.") + (* ;; "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.") - (\TEDIT.INSERT.PIECES TEXTOBJ (IPLUS START-OF-PIECE OFFSET) - (create PIECE - using PC PFILE _ TFILE PFPOS _ 0 PFATP _ T PSTR _ NIL PLEN _ - NEWPLEN) - 1 NIL NIL NIL T) - (add (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - NEWPLEN] - (\SETUPGETCH CHNO TEXTOBJ]) + (* ;; "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).") -(\TEDIT.PURGE.SPACES - [LAMBDA (CHLIST PREVSP) (* jds " 9-NOV-83 17:12") - (bind OPREVSP while (IGREATERP PREVSP 0) do (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE]) + (LET ((FMTSPEC (FGETLD LINE LFMTSPEC)) + (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))) + (CL:WHEN (FGETLD LINE LSTLN) (* ; "Set post-paragraph leading") + (add DESCENT (ffetch (FMTSPEC LEADAFTER) of FMTSPEC))) -(\DOFORMATTING - [LAMBDA (TEXTOBJ LINE FMTSPEC THISLINE %#BLANKS PREVSP 1STLN) + (* ;; "Documentation says that lineleading goes above, which automatically makes for reasonable selection marking. It went below in the original implementation, selections are very odd if lineleading is big.") + + (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) + (FSETLD LINE LHEIGHT (IPLUS ASCENT DESCENT]) + +(\FORMATLINE.JUSTIFY + [LAMBDA (LINE THISLINE PREVSP SPACELEFT LINETYPE) (* ; "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") - (* ; - "Do the formatting work for justified, centered, etc. lines") - (PROG ((QUAD (fetch QUAD of FMTSPEC)) - (SPACELEFT (LLSH (fetch (LINEDESCRIPTOR SPACELEFT) of LINE) - 5)) - (EXISTINGSPACE 0) - (CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (SPACEOFLOW 0) - EXTRASP OPREVSP LINELEAD) (* ; - "NB that SPACELEFT, OFLOW, etc. are kept in 32 x value form, for rounding ease.") - (replace (LINEDESCRIPTOR LTRUEDESCENT) of LINE with (fetch (LINEDESCRIPTOR DESCENT) - of LINE)) - (replace (LINEDESCRIPTOR LTRUEASCENT) of LINE with (fetch (LINEDESCRIPTOR ASCENT) - of LINE)) - (* ; - "Save the true ascent value for display purposes") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1) - (* ; - "Start by assuming that we want a space factor of 1.0") - [COND - ((SETQ LINELEAD (fetch LINELEAD of FMTSPEC)) (* ; - "If line leading was specified, set it") - (COND - (T (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LINELEAD of FMTSPEC)) (* ; - "And adjust the line's descent accordingly") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LINELEAD of FMTSPEC] - [COND - ((AND 1STLN (fetch LEADBEFORE of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADBEFORE of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR ASCENT) of LINE) - (fetch LEADBEFORE of FMTSPEC] - [COND - ((AND (fetch (LINEDESCRIPTOR LSTLN) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "If paragraph pre-leading was specified, set it") - (add (fetch (LINEDESCRIPTOR LHEIGHT) of LINE) - (fetch LEADAFTER of FMTSPEC)) (* ; - "And adjust the line's ascent accordingly.") - (add (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (fetch LEADAFTER of FMTSPEC] - (SELECTQ QUAD - (LEFT (* ; - "Do nothing for left-justified lines except replace the character codes")) - (RIGHT (* ; "Just move the right margin over") - (replace (LINEDESCRIPTOR LEFTMARGIN) of LINE with (IPLUS (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE) - (fetch (LINEDESCRIPTOR - SPACELEFT) - of LINE))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR RIGHTMARGIN) - of LINE)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (CENTERED (* ; - "Split the difference for centering") - (add (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (LRSH SPACELEFT 6)) - (add (fetch (LINEDESCRIPTOR LXLIM) of LINE) - (LRSH SPACELEFT 6)) - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN)))) - (JUSTIFIED (* ; - "For justified lines, stretch each space so line reaches the right margin") - (COND - ((OR (ILESSP (fetch (THISLINE LEN) of THISLINE) - 0) - (ZEROP %#BLANKS) - (ZEROP PREVSP)) (* ; - "For empty lines, and lines with no spaces, don't bother fixing blank widths.") - (RETURN))) - (COND - ((OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "This is the last line in the paragraph; don't stretch it out.") - (SETQ EXTRASP 0)) - ((IEQP PREVSP (ADD1 (fetch (THISLINE LEN) of THISLINE))) - (* ; - "Only if the last character on the line is a space should we remove trailing spaces from the list") - (bind (OPREVSP _ (SUB1 PREVSP)) while (AND (IGREATERP PREVSP 0) - (ILEQ OPREVSP PREVSP)) - do - (* ;; "Back up over all trailing white space on the line. So that those blanks don't get counted when computing the space to be added to each REAL space on the line, when it is justified.") + (* ;; "The spaces in this line are to be expanded to eat up SPACELEFT so that the last visible character will align at the right margin. SPACELELEFT may be in hardcopy-display scaled units.") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - (add %#BLANKS -1)) - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks except at end-of-line, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR - RIGHTMARGIN) - of LINE)) - (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) - (* ; - "Now apportion the extra space evenly among blanks.") - ) - (T - (* ;; - "NO SPACE AT END OF LINE -- LINE ENDS IN HYPHEN, ETC, OR MAYBE IS TOO LONG WITH NO SPACES.") + (CL:WHEN (AND PREVSP (IGREATERP SPACELEFT 0)) + (LET (NATURALWIDTHS COMMONWIDTH) + [if (EQ LINETYPE 'TRUEHARDCOPY) + then + (* ;; "Original code removed overhanging spaces, so that LXLIM and the last charslot of THISLINE are consistent, and SPACELEFT is backed off. But now, SPACELEFT only measures out to the margin, so doesn't need to be further adjusted (OVERHANG deals with that). So, if the hardcopy stream doesn't mind printing extra spaces, we don't have to pull things back. Here we just have to measure the sum of the natural widths, to do the space factor.") - (COND - ((ZEROP %#BLANKS) (* ; - "If there aren't any blanks, don't bother going further.") - (RETURN))) - (replace (LINEDESCRIPTOR LXLIM) of LINE with (fetch (LINEDESCRIPTOR - RIGHTMARGIN) - of LINE)) + [SETQ NATURALWIDTHS (for (SPSLOT _ PREVSP) by (CHAR SPSLOT) while SPSLOT + sum (PROG1 (CHARW SPSLOT) + (CL:UNLESS (CHAR SPSLOT) + (* ; "Some early spaces may not expand") + (replace (THISLINE TLFIRSTSPACE) + of THISLINE with SPSLOT)))] + else + (* ;; "Typically all the spaces on the line have the same natural width and we can avoid floating point below.") + + (* ;; "NB we operate in 32 x value form, for rounding ease and accuracy on screen-point display streams. .") + + [SETQ NATURALWIDTHS (for (SPSLOT _ PREVSP) + CHARW FIRSTWIDTH (NSPACES _ 0) + (ALLSAME _ T) by (CHAR SPSLOT) + first (SETQ FIRSTWIDTH (CHARW SPSLOT)) while SPSLOT + sum (SETQ CHARW (CHARW SPSLOT)) + (add NSPACES 1) + (CL:UNLESS (IEQP CHARW FIRSTWIDTH) + (SETQ ALLSAME NIL)) + CHARW + finally (CL:WHEN ALLSAME + (SETQ COMMONWIDTH + (IPLUS (UNFOLD FIRSTWIDTH 32) + (IQUOTIENT (UNFOLD SPACELEFT 32) + NSPACES))))] + (if COMMONWIDTH + then + (* ;; "Fast loop for the more common case where all the spaces on a line are of the same width. Multiply by 32 to keep rounding precision. Avoids floating point allocation.") + + (for (SPSLOT _ PREVSP) + EXPANDED + (LOST _ 0) by (CHAR SPSLOT) while SPSLOT + do (SETQ EXPANDED (IPLUS LOST COMMONWIDTH)) + (replace (CHARSLOT CHARW) of SPSLOT with (FOLDLO EXPANDED 32)) + (SETQ LOST (IMOD EXPANDED 32))) + else + (* ;; "The slow loop is for spaces of difference sizes. It allocates 3 floating point numbers per space. ") + + (for (SPSLOT _ PREVSP) + EXPANDED NEWW (LOST _ 0.0) + (MULTIPLIER _ (FPLUS 1.0 (FQUOTIENT SPACELEFT NATURALWIDTHS))) + by (CHAR SPSLOT) while SPSLOT do + + (* ;; "Spaces are in different fonts with different widths. What we lose in rounding at one space we add back in the next, until we finally get resynchronized. The effect is that a later loss may ripple to a few earlier spaces.") + + (SETQ EXPANDED + (FPLUS LOST (FTIMES (CHARW SPSLOT) + MULTIPLIER))) + (SETQ NEWW (FIXR EXPANDED)) + (freplace (CHARSLOT CHARW) + of SPSLOT with NEWW) + (SETQ LOST (FDIFFERENCE EXPANDED NEWW] + + (* ;; "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) + SPACELEFT) + (freplace (THISLINE TLSPACEFACTOR) of THISLINE with (FQUOTIENT (IPLUS NATURALWIDTHS + SPACELEFT) + NATURALWIDTHS))))]) + +(\FORMATLINE.TABS + [LAMBDA (TEXTOBJ TABSPEC SCALE CHARSLOT LX1 TX PRIORTAB CLEANINGUP) + (* ; "Edited 17-Dec-2023 12:46 by rmk") + (* ; "Edited 9-Mar-2023 23:25 by rmk") + (* ; "Edited 5-Mar-2023 22:54 by rmk") + (* ; "Edited 4-Mar-2023 18:28 by rmk") + (* ; "Do the formatting work for a tab.") + + (* ;; "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.") + + (* ;; "") + + (* ;; "If CLEANINGUP is non-NIL, then we're at the end of the line, and only need to resolve the outstanding tab.") + + (* ;; "This assumes that every thing except the constants is already hardcopy-scaled") + + (* ;; "") + + (* ;; "The return provides the number of (scaled) width-units that must be added to the TX in \FORMATLINE.. This includes resolving (and updating THISLINE) for the prior tab's now-known width, and adding the width for this tab if it can be resolved. If it can't be resolved, the returned PENDINGTAB includes the prior width, so that can be discharged into \FORMATLINE's TX.") + + (* ;; "") + + (* ;; "GRAIN is the granularity of the tab spacing; anything within GRAIN will slop over to the next tab. This is to finesse rounding problems when going among various devices.") + + (* ;; "") + + (add TX LX1) (* ; "Margin relative") + (PROG (NEXTTAB NEXTTABTYPE NEXTTABX DFLTTABX GRAIN (PRIORTABWIDTH 0) + (THISTABWIDTH 0)) + (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") + + (* ;; "TX - OLDTX = W, the width of the segment after the prior tab. The target X (right tab) is TABX - W ") + + [SETQ PRIORTABWIDTH (IMAX (ITIMES SCALE 3) + (IDIFFERENCE + (IDIFFERENCE (fetch (PENDINGTAB PTTABX) of PRIORTAB) + (SELECTQ (fetch (PENDINGTAB PTTYPE) of PRIORTAB) + ((CENTERED DOTTEDCENTERED) + (* ; "Centered around the tab X") + (FOLDLO (IDIFFERENCE TX (fetch (PENDINGTAB + PTOLDTX) + of PRIORTAB)) + 2)) + ((RIGHT DOTTEDRIGHT DECIMAL DOTTEDDECIMAL) + (* ; "Snug up against the tab X") + (IDIFFERENCE TX (fetch (PENDINGTAB PTOLDTX) + of PRIORTAB))) + (SHOULDNT))) + (fetch (PENDINGTAB PTOLDTX) of PRIORTAB] + (replace (CHARSLOT CHARW) of (fetch (PENDINGTAB PTCHARSLOT) of PRIORTAB) with + PRIORTABWIDTH + ) + (add TX PRIORTABWIDTH)) (* ; "Done with the past") + (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))) + (* ; "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 (* ; + "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)) + + (* ;; "No real tab; use the next multiple of the default spacing.") + + (ITIMES DFLTTABX (ADD1 (IQUOTIENT (IPLUS GRAIN TX) + DFLTTABX] + (* ; "The next tab's X value") + (CL:WHEN (FMEMB NEXTTABTYPE '(DOTTEDLEFT DOTTEDCENTERED DOTTEDRIGHT DOTTEDDECIMAL)) + + (* ;; "Change a dotted-leader tab to Meta,TAB, so the line displayers can recognize that they need to do special output that can't be precomputed here. By the same token, we could replace the resolved tab with a widened space, since we know that space-expansion is suppressed when a tab is seen. ") + + (replace (CHARSLOT CHAR) of CHARSLOT with (CHARCODE Meta,TAB))) + (RETURN (if (FMEMB NEXTTABTYPE '(LEFT DOTTEDLEFT)) + then + (* ;; + "Prior and LEFT tabs are both resolved. At least 1 scaled point for display-selection? ") + + (SETQ THISTABWIDTH (IMAX SCALE (IDIFFERENCE NEXTTABX TX))) + (replace (CHARSLOT CHARW) of CHARSLOT with THISTABWIDTH) + (IPLUS PRIORTABWIDTH THISTABWIDTH) + else (replace (CHARSLOT CHARW) of CHARSLOT with 0) + (* ; "All others: wait for this width") + + (* ;; "PTOLDTX and PTTABX in absolute coordinates for future comparisons (on the same line with same LX1).") + + (create PENDINGTAB + PTRESOLVEDWIDTH _ (IPLUS PRIORTABWIDTH THISTABWIDTH) + PTTYPE _ NEXTTABTYPE + PTTABX _ NEXTTABX + PTCHARSLOT _ CHARSLOT + PTOLDTX _ TX]) + +(\FORMATLINE.SCALETABS + [LAMBDA (TABSPEC SCALE) (* ; "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]) + +(\FORMATLINE.PURGE.SPACES + [LAMBDA (PREVSP UNTILSP) (* ; "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") + + (* ;; "Walks PREVSP back through the chain until it reaches UNTILSP, either NIL or a back up point. Each of the slots it passes over is reverted to a space, return is the slot of early expandable spaces, if any.") + + (CL:WHEN PREVSP + (bind OPREVSP until (EQ PREVSP UNTILSP) do (SETQ OPREVSP PREVSP) + (SETQ PREVSP (CHAR OPREVSP)) + (CL:WHEN (SMALLP PREVSP) + (* ; "Sanity check--shouldn't be 32") + (HELP 'PURGE PREVSP)) + (replace (CHARSLOT CHAR) of OPREVSP + with (CHARCODE SPACE)))) + PREVSP]) + +(\FORMATLINE.EMPTY + [LAMBDA (TEXTOBJ CH#1 LINE) (* ; "Edited 26-Jan-2024 11:08 by rmk") + (* ; "Edited 6-Dec-2023 20:15 by rmk") + (* ; "Edited 3-Dec-2023 19:41 by rmk") + (* ; "Edited 26-Sep-2023 17:32 by rmk") + (* ; "Edited 15-Jul-2023 13:52 by rmk") + (* ; "Edited 2-Jul-2023 15:20 by rmk") + (* ; "Edited 7-Mar-2023 23:11 by rmk") + (* ; "Edited 5-Mar-2023 22:57 by rmk") + (* ; "Edited 4-Mar-2023 21:40 by rmk") + + (* ;; "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. ") + + (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))) + (\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) + + (* ;; "Get looks from the TSTREAM, so that \DISPLAYLINE works. ") + + (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 TRUEASCENT (FONTPROP FONT 'ASCENT)) + (SETQ TRUEDESCENT (FONTPROP FONT 'DESCENT)) + (SETQ LM (IPLUS \TEDIT.LINEREGION.WIDTH (FGETTOBJ TEXTOBJ WLEFT) + (fetch 1STLEFTMAR of FMTSPEC))) + (with LINEDESCRIPTOR LINE (SETQ LDUMMY T) + (SETQ LCHAR1 CH#1) + (SETQ LCHARLIM 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 LEFTMARGIN LM) + (SETQ RIGHTMARGIN (CL:IF (ZEROP (fetch RIGHTMAR of FMTSPEC)) + (IDIFFERENCE (FGETTOBJ TEXTOBJ WRIGHT) + \TEDIT.LINEREGION.WIDTH) + (fetch RIGHTMAR of FMTSPEC))) + (SETQ LTRUEASCENT TRUEASCENT) + (SETQ LTRUEDESCENT TRUEDESCENT) + (SETQ LHEIGHT (IPLUS TRUEASCENT TRUEDESCENT))) + + (* ;; "Just to initialize the rest of the fields--no intended transformations.") + + (\TEDIT.FORMATLINE.VERTICAL LINE TEXTOBJ) + (\TEDIT.FORMATLINE.HORIZONTAL LINE THISLINE NIL 0 0) + LINE]) + +(\FORMATLINE.UPDATELOOKS + [LAMBDA (TSTREAM PC) (* ; "Edited 24-Dec-2023 22:54 by rmk") + (* ; "Edited 23-Dec-2023 20:37 by rmk") + (* ; "Edited 22-Aug-2023 16:46 by rmk") + (* ; "Edited 24-Jul-2023 16:39 by rmk") + (* ; "Edited 7-Mar-2023 20:54 by rmk") + (* ; "Edited 30-May-91 21:47 by jds") + +(* ;;; "Called from \TEDIT.INSTALL.PIECE under \FORMATLINE only when the new piece has different looks than the previous piece. This updates the formatting fields such as ASCENTC, DESCENTC, etc. This assumes that the \INSTALL.PIECE caller has passed over any invisible pieces, and that TSTREAM is set up consistently with looks that match PC") + + (* ;; "RMK: Storing the looks in theTEXTSTREAM here seems to be an attempt to avoid calls to the \TEDIT.APPLY.STYLES function in the transition from piece to piece. Presumably, the looks of each piece may be incomplete, and missing fields are filled in from the current (sequence of?) styles. If the style is changed dynamically, then (also presumably) all of the currently displayed pieces should be upgraded. But that doesn't appear to happen.") + + (* ;; "A simpler implementation, whether dynamic or not, would be to expand the looks when the piece is created or the style changes, so that each piece is always references its completed looks. But the piece also needs to keep track of its partial looks, for restyling and for saving.") + + (* ;; "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 + UNBREAKABLE)) + (CL:UNLESS PC (* ; + "Ran off the end ? Skips the ENDOFSTREAMOP") + (RETFROM (FUNCTION \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).") + + (SETQ INVISIBLERUN (for old PC inpieces PC until (VISIBLEPIECEP PC) + sum (PLEN PC))) + (if (EQ 0 INVISIBLERUN) + then + (* ;; "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) + + (* ;; "") + + (SETQ OFFSET (OR (ffetch (CHARLOOKS CLOFFSET) of PLOOKS) + 0)) + (SETQ FONT (fetch (CHARLOOKS CLFONT) of PLOOKS)) (* ; - "Fix the right margin for showing selections &c") - (SETQ EXTRASP (IQUOTIENT SPACELEFT %#BLANKS)) + "CLFONT is a display font or a class") + [if (EQ LINETYPE 'TRUEHARDCOPY) + then (SETQ FONT (FONTCOPY FONT 'DEVICE IMAGESTREAM)) + (* ; "Hardcopy widths and verticals") + (SETQ ASCENTC (ffetch \SFAscent of FONT)) + (SETQ DESCENTC (ffetch \SFDescent of FONT)) + (CL:UNLESS (EQ OFFSET 0) + (SETQ OFFSET (HCSCALE (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 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) (* ; - "Now apportion the extra space evenly among blanks.") - )) - [while (IGREATERP PREVSP 0) - do (* ; - "Fix up the widths of spaces in the line") - (SETQ OPREVSP (SUB1 PREVSP)) - (SETQ PREVSP (\EDITELT CHLIST OPREVSP)) - (add EXISTINGSPACE (\EDITELT WLIST OPREVSP)) - (\EDITSETA CHLIST OPREVSP (CONSTANT (CHARCODE SPACE))) - [OR (fetch (LINEDESCRIPTOR CR\END) of LINE) - (\EDITSETA WLIST OPREVSP (IPLUS (LRSH (IPLUS EXTRASP SPACEOFLOW) - 5) - (\EDITELT WLIST OPREVSP] - (SETQ SPACEOFLOW (LOGAND 31 (IPLUS EXTRASP SPACEOFLOW] - (COND - ([AND (NOT (ZEROP EXISTINGSPACE)) - (OR (NOT (ZEROP EXTRASP)) - (NOT (ZEROP (fetch (LINEDESCRIPTOR SPACELEFT) of LINE] - (* ; "Only if we really expanded the line -- and there are spaces to expand (or else EXISTINGSPACE is 0).") - (replace (THISLINE TLSPACEFACTOR) of THISLINE - with (FQUOTIENT (IPLUS EXISTINGSPACE (fetch (LINEDESCRIPTOR SPACELEFT - ) of LINE)) - EXISTINGSPACE)) (* ; - "And set the space factor for display") - ) - (T (* ; "Pathological cases ") - (replace (THISLINE TLSPACEFACTOR) of THISLINE with 1))) - (RETURN)) - NIL) - (\TEDIT.PURGE.SPACES CHLIST PREVSP) (* ; - "Change all the spaces--chained for justification--back into regular spaces, for the display code.") - ]) + "Mark the line as containing protected text") + (SETQ PROTECTED T)) + (PUSHCHAR CHARSLOT NIL PLOOKS)) + (CL:UNLESS T + + (* ;; "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 (\FORMATLINE.SCALETABS TABSPEC (DSPSCALE NIL IMAGESTREAM))))) + else (add CHNO INVISIBLERUN) + (\TEDIT.INSTALL.PIECE TSTREAM PC 0)) + PC]) + +(\FORMATLINE.LASTLEGAL + [LAMBDA NIL (* ; "Edited 1-Feb-2024 16:51 by rmk") + (* ; "Edited 2-Jul-2023 14:39 by rmk") + (* ; "Edited 17-Mar-2023 05:36 by rmk") + + (* ;; + "An overflowing line without the kind of break point we are looking for (spaces, explicit hyphens).") + + (* ;; "Find the last legal break point, given the global TEDIT control variables TEDIT.DONT.BREAK.CHARS and TEDIT.DONT.LAST.CHARS.") + + (* ;; "If we run back to the beginning without finding a good break, we just take the original overflowed line. (Or, we could just chop at the end, and push the residue to the next line?") + + (* ;; "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)) + (LET [(BESTSLOT (find SLOT PCS backcharslots (PREVCHARSLOT! CHARSLOT) + suchthat (CL:WHEN (AND TABPENDING (EQ SLOT (fetch (PENDINGTAB PTCHARSLOT) + of TABPENDING))) + (SETQ TABPENDING NIL)) + (OR (MEMB CHAR TEDIT.DONT.BREAK.CHARS) + (AND (SETQ PCS (PREVCHARSLOT! SLOT)) + (MEMB (CHAR PCS) + TEDIT.DONT.LAST.CHARS] + + (* ;; "BESTSLOT is our last legal break. Replay to figure out TX, CHNO, ASCENT, DESCENT") + + (CL:WHEN BESTSLOT + (SETQ TX (SETQ TRUEASCENT (SETQ TRUEDESCENT 0))) + (SETQ CHNO (SUB1 CH#1)) + (for old CHARSLOT FONT OFFSET incharslots THISLINE + do [if CHAR + then (add CHNO 1) + (add TX CHARW) + else (* ; "Must be looks") + (SETQ OFFSET (OR (fetch (CHARLOOKS CLOFFSET) of CHARW) + 0)) + (SETQ FONT (fetch (CHARLOOKS CLFONT) of CHARW)) + [SETQ FONT (if (EQ LINETYPE 'TRUEHARDCOPY) + then (SETQ OFFSET (HCSCALE (DSPSCALE NIL IMAGESTREAM) + OFFSET)) + (FONTCOPY FONT 'DEVICE IMAGESTREAM) + else (FONTCOPY FONT 'DEVICE 'DISPLAY] + (SETQ TRUEASCENT (IMAX TRUEASCENT (IDIFFERENCE (ffetch \SFAscent + of FONT) + OFFSET))) + (SETQ TRUEDESCENT (IMAX TRUEDESCENT (IDIFFERENCE (ffetch \SFDescent + of FONT) + OFFSET] + repeatuntil (EQ CHARSLOT BESTSLOT)) + T)]) + +(\FORMATBLOCK + [LAMBDA (TEXTOBJ CHN YBOTN) (* ; "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. ") + + (* ;; "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 (\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 (\FORMATLINE TEXTOBJ CHNO)) (* ; + "The line immediately after a preceding known break") + (LINKLD LN LINE) + (SETQ LN LINE) + (SETQ CHNO (ADD1 (GETLD LINE LCHARLIM))) finally + + (* ;; + "Fill in the YBOT's, given that YBOTN is the YBOT of LN.") + + (for L (YB _ YBOTN) backlines LN + do (SETYPOS L YB) + (add YB (GETLD L LHEIGHT))) + (RETURN (LIST L1 LN]) +) + +(RPAQ? TEDIT.LINELEADING.BELOW NIL) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.LINELEADING.BELOW) +) +(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 7-Nov-2022 10:16 by rmk") + + (* ;; "Check validity of THISLINE, either just before or anytime after \FORMATLINE.JUSTIFY") + + [with THISLINE THISLINE (CL:WHEN (EQ DESC 'NODESC) + (HELP "INVALID THISLINE" DESC)) + (CL:WHEN (EQ TLSPACEFACTOR 'NOSPACEFACTOR) + (HELP "INVALID THISLINE" TLSPACEFACTOR)) + (CL:WHEN (EQ TLFIRSTSPACE 'NOTLFIRSTSPACE) + (HELP "INVALID THISLINE" TLFIRSTSPACE)) + (CL:UNLESS (CHARSLOTP NEXTAVAILABLECHARSLOT THISLINE) + (HELP "INVALID THISLINE" 'NEXTAVAILABLE))] + (for CHARSLOT incharslots THISLINE do (if CHAR + then (CL:UNLESS (OR (SMALLP CHAR) + (CHARSLOTP CHAR THISLINE)) + + (* ;; + "CHARSLOTP if spaces haven't been instantiated") + + (HELP "INVALID THISLINE" 'BADCHAR)) + (CL:UNLESS (SMALLP CHARW) + (HELP "INVALID THISLINE" 'BADCHARW)) + elseif (OR (SMALLP CHARW) + (type? CHARLOOKS CHARW)) + else (HELP "INVALID THISLINE" 'BADCHARW]) +) + + + +(* ; "Consistency checking") + + +(RPAQ? *TEDIT-CACHED-FMTSPEC* NIL) + + + +(* ; "Heuristic for \FORMATLINE") + +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS *TEDIT-CACHED-FMTSPEC*) ) (DEFINEQ (\DISPLAYLINE - [LAMBDA (TEXTOBJ LINE WINDOW) (* ; "Edited 28-Sep-2021 15:00 by rmk:") + [LAMBDA (TEXTOBJ LINE PANE) (* ; "Edited 24-Dec-2023 22:05 by rmk") + (* ; "Edited 2-Dec-2023 11:34 by rmk") + (* ; "Edited 20-Nov-2023 13:57 by rmk") + (* ; "Edited 28-Oct-2023 23:57 by rmk") + (* ; "Edited 11-Oct-2023 10:47 by rmk") + (* ; "Edited 2-Aug-2023 12:50 by rmk") + (* ; "Edited 22-Jun-2023 17:37 by rmk") + (* ; "Edited 24-Apr-2023 00:08 by rmk") + (* ; "Edited 10-Apr-2023 12:41 by rmk") + (* ; "Edited 16-Mar-2023 23:30 by rmk") + (* ; "Edited 9-Mar-2023 14:06 by rmk") + (* ; "Edited 7-Mar-2023 23:11 by rmk") (* ;; "Display the line of text LINE in the edit window where it belongs.") @@ -1039,41 +1862,25 @@ (\DTEST TEXTOBJ 'TEXTOBJ) (\DTEST LINE 'LINEDESCRIPTOR) - (LET ((LOOKS (ffetch (THISLINE LOOKS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ))) - (WINDOWDS (WINDOWPROP (OR WINDOW (CAR (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ))) + (LET ((WINDOWDS (WINDOWPROP (FGETPANE PANE PWINDOW) 'DSP)) - (THISLINE (\DTEST (ffetch (TEXTOBJ THISLINE) of TEXTOBJ) + (THISLINE (\DTEST (FGETTOBJ TEXTOBJ THISLINE) 'THISLINE)) - (OLDCACHE (fetch (LINECACHE LCBITMAP) of (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ))) - (DS (ffetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (HCPYDS (ffetch (TEXTOBJ DISPLAYHCPYDS) of TEXTOBJ)) - (HARDCOPYMODE (fetch (FMTSPEC FMTHARDCOPY) of (ffetch (LINEDESCRIPTOR LFMTSPEC) - of LINE))) - CACHE OFONT OLOOKS XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT DDWIDTHCACHE - DDOFFSETCACHE CURY LHEIGHT SCALE) + (OLDCACHE (fetch (LINECACHE LCBITMAP) of (FGETTOBJ TEXTOBJ DISPLAYCACHE))) + (DS (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) + CACHE XOFFSET CLIPLEFT CLIPRIGHT DISPLAYDATA DDPILOTBBT CURY LHEIGHT) [SETQ LHEIGHT (COND - ((ffetch (LINEDESCRIPTOR PREVLINE) of LINE) - (* ; + ((FGETLD LINE PREVLINE) (* ;  "So if theres a base-to-base measure, we clear everything right.") - (IMAX (IDIFFERENCE (ffetch (LINEDESCRIPTOR YBOT) - of (ffetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (ffetch (LINEDESCRIPTOR YBOT) of LINE)) - (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE))) - (T (ffetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (SETQ SCALE (COND - (HARDCOPYMODE (* ; - "This is a hardcopy-mode line. Scale things.") - (DSPSCALE NIL HCPYDS)) - (T 1))) - (SETQ CACHE (\TEDIT.LINECACHE (ffetch (TEXTOBJ DISPLAYCACHE) of TEXTOBJ) - (COND - (HARDCOPYMODE (FIXR (FQUOTIENT (ffetch (LINEDESCRIPTOR RIGHTMARGIN) - of LINE) - SCALE))) - (T (ffetch (LINEDESCRIPTOR RIGHTMARGIN) of LINE))) + (IMAX (IDIFFERENCE (FGETLD (FGETLD LINE PREVLINE) + YBOT) + (FGETLD LINE YBOT)) + (FGETLD LINE LHEIGHT))) + (T (FGETLD LINE LHEIGHT] + (SETQ CACHE (\TEDIT.LINECACHE (FGETTOBJ TEXTOBJ DISPLAYCACHE) + (FGETLD LINE LXLIM) LHEIGHT)) - (COND - ((NEQ CACHE OLDCACHE) (* ; + (CL:UNLESS (EQ CACHE OLDCACHE) (* ;  "We changed the bitmaps because this line was bigger--update the displaystream, too") (DSPDESTINATION CACHE DS) (DSPCLIPPINGREGION (create REGION @@ -1081,182 +1888,171 @@ BOTTOM _ 0 WIDTH _ (fetch BITMAPWIDTH of CACHE) HEIGHT _ (fetch BITMAPHEIGHT of CACHE)) - DS))) - (BITBLT NIL 0 0 CACHE 0 0 NIL NIL 'TEXTURE 'REPLACE WHITESHADE) - (* ; "Clear the line cache") - [COND - ((AND (NOT (ZEROP (fetch (LINEDESCRIPTOR CHAR1) of LINE))) - (ILEQ (ffetch (LINEDESCRIPTOR CHAR1) of LINE) - (ffetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (IGEQ (ffetch (LINEDESCRIPTOR YBOT) of LINE) - (ffetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) + DS)) + (BLTSHADE WHITESHADE CACHE 0 0 NIL NIL 'REPLACE) (* ; "Clear the line cache") + (CL:WHEN [AND (IGEQ (FGETLD LINE LCHAR1) + 1) + (ILEQ (FGETLD LINE LCHAR1) + (FGETTOBJ TEXTOBJ TEXTLEN)) + (OR (IGEQ (FGETLD LINE YBOT) + (FGETTOBJ TEXTOBJ WBOTTOM)) + (IGREATERP LHEIGHT (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE] - (* ;; "Only display the line of it contains text (CHAR1 > 0), appears before the end of the test, and is on-screen.") + (* ;; "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") - (COND - ((NEQ (fetch (THISLINE DESC) of THISLINE) - LINE) (* ; + (CL:UNLESS (EQ LINE (fetch (THISLINE DESC) of THISLINE)) + (* ;  "No image cache -- re-format and display") - (\FORMATLINE TEXTOBJ NIL (ffetch (LINEDESCRIPTOR CHAR1) of LINE) - LINE))) - (MOVETO (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE) - (ffetch (LINEDESCRIPTOR DESCENT) of LINE) + (\FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1) + LINE)) + (MOVETO (FGETLD LINE LX1) + (FGETLD LINE DESCENT) DS) - (SETQ DISPLAYDATA (fetch (STREAM IMAGEDATA) of DS)) + (SETQ DISPLAYDATA (ffetch (STREAM IMAGEDATA) of DS)) + (* ; + "IMAGEDATA of the display stream, not textstream") (SETQ DDPILOTBBT (ffetch DDPILOTBBT of DISPLAYDATA)) - (SETQ XOFFSET (fetch DDXOFFSET of DISPLAYDATA)) + (SETQ XOFFSET (ffetch DDXOFFSET of DISPLAYDATA)) (* ;; "The X position of the left edge of the window, since \TEDIT.BLTCHAR works on the screen bitmap itself.") - (SETQ CLIPLEFT (fetch DDClippingLeft of DISPLAYDATA)) + (SETQ CLIPLEFT (ffetch DDClippingLeft of DISPLAYDATA)) (* ;  "The left and right edges of the clipping region for the text display window.") - (SETQ CLIPRIGHT (fetch DDClippingRight of DISPLAYDATA)) - (SETQ OFONT (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS 0))) - DS)) (* ; "The starting font") - (SETQ DDWIDTHCACHE (ffetch DDWIDTHSCACHE of DISPLAYDATA)) - (* ; "Cache the character-image widths") - (SETQ DDOFFSETCACHE (ffetch DDOFFSETSCACHE of DISPLAYDATA)) - (* ; - "And the offset-into-strike-bitmap array") - (* ; - "LOOKSTARTX: Starting X position for the current-looks text.") - (AND (fetch CLOFFSET of OLOOKS) - (RELMOVETO 0 (FIXR (FTIMES SCALE (fetch CLOFFSET of OLOOKS))) - DS)) (* ; - "Any sub- or superscripting at start of line") - (bind (LOOKNO _ 1) - DX CH (CHLIST _ (fetch (THISLINE CHARS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ)) - ) - (WLIST _ (fetch (THISLINE WIDTHS) of (ffetch (TEXTOBJ THISLINE) of TEXTOBJ))) - (TX _ (IPLUS XOFFSET (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) - (TERMSA _ (ffetch (TEXTOBJ TXTTERMSA) of TEXTOBJ)) - (LOOKSTARTX _ (ffetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) for I from 0 - to (ffetch (THISLINE LEN) of THISLINE) - do - (* ;; "Display the line character by character") + (SETQ CLIPRIGHT (ffetch DDClippingRight of DISPLAYDATA)) - (SETQ CH (\EDITELT CHLIST I)) (* ; - "Grab the character (or IMAGEOBJ) to display") - (SETQ DX (\EDITELT WLIST I)) (* ; "And its width") - [SELECTC CH - (LMInvisibleRun (* ; - "An INVISIBLE run -- skip it, and skip over the char count") - (add LOOKNO 1)) - (LMLooksChange (* ; "A LOOKS change") - (replace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE TX - XOFFSET)) + (* ;; "We know that the line's first CLOOKS comes before the first CHAR") + + [for CHARSLOT CLOOKS LOOKSTARTX (TX _ (IPLUS XOFFSET (FGETLD LINE LX1))) + (TERMSA _ (FGETTOBJ TEXTOBJ TXTTERMSA)) incharslots THISLINE + do + (* ;; + "Display the line character by character. CHAR and CHARW are bound to CHARSLOT values") + + (CL:WHEN (FMEMB CHAR (CHARCODE (EOL FORM))) + (* ; + "\FORMATLINE used space-width for EOL and FORM. Display them that way.") + (SETQ CHAR (CHARCODE SPACE))) + (SELCHARQ CHAR + ((TAB Meta,TAB) + (CL:WHEN (OR (EQ CHAR (CHARCODE Meta,TAB)) + (ffetch CLLEADER of CLOOKS) + (EQ (ffetch CLUSERINFO of CLOOKS) + 'DOTTEDLEADER)) + + (* ;; "Not just white space, have to fill in with dots.") + + (\DISPLAYLINE.TABS CHARW DS TX TERMSA LINE CLOOKS DISPLAYDATA + DDPILOTBBT CLIPRIGHT TEXTOBJ)) + (add TX CHARW)) + (NIL (* ; + "Must be looks. Line-start looks are guaranteed to come before any character/object") + (CL:WHEN (type? CHARLOOKS CHARW) + (CL:UNLESS LOOKSTARTX (* ; + "LOOKSTARTX: Starting X position for the current-looks text.") + (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET))) + (freplace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE TX XOFFSET)) (* ;  "Make the displaystream reflect our current X position") - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS - (ffetch (LINEDESCRIPTOR DESCENT) of LINE)) - (* ; - "Make any necessary changes to the preceding characters (underline, strike-out &c)") - (DSPFONT (fetch CLFONT of (SETQ OLOOKS (\EDITELT LOOKS LOOKNO)) - ) - DS) (* ; "Set the new font") - (add LOOKNO 1) (* ; "Grab the next set of char looks") - (AND (fetch CLOFFSET of OLOOKS) - (RELMOVETO 0 (fetch CLOFFSET of OLOOKS) - DS)) (* ; "Account for super/subscripting") - (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)) - (* ; - "Remember the starting Xpos for possible later underlining &c") - ) - ((CHARCODE (TAB %#^I)) (* ; - "TAB: use the width from the cache to decide the right formatting.") - [COND - ((OR (IEQP CH (CHARCODE %#^I)) - (fetch CLLEADER of OLOOKS) - (EQ (fetch CLUSERINFO of OLOOKS) - 'DOTTEDLEADER)) - (LET* [[LEADERFONT (COND - (HARDCOPYMODE (FONTCOPY (fetch CLFONT - of OLOOKS) - 'DEVICE HCPYDS)) - (T (fetch CLFONT of OLOOKS] - (DOTWIDTH (CHARWIDTH (CHARCODE %.) - LEADERFONT)) - (TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER - TX DOTWIDTH] - (while (ILEQ TTX (IPLUS TX DX)) - do (COND - (HARDCOPYMODE (MI-TEDIT.BLTCHAR - (CHARCODE %.) - DS - (FIXR (FQUOTIENT (IDIFFERENCE TTX - DOTWIDTH) - SCALE)) - DISPLAYDATA DDPILOTBBT CLIPRIGHT)) - ((OR TERMSA HARDCOPYMODE) - (* ; "Using special instrns from TERMSA") - (\DSPPRINTCHAR DS (CHARCODE %.))) - (T (* ; "Native charcodes") - (MI-TEDIT.BLTCHAR (CHARCODE %.) - DS - (IDIFFERENCE TTX DOTWIDTH) - DISPLAYDATA DDPILOTBBT CLIPRIGHT))) - (add TTX DOTWIDTH]) - ((CHARCODE (EOL LF CR)) (* ; "It's a CR") - NIL) - (NIL (* ; "NIL signifies a character we've suppressed as part of line formatting (e.g., a discretionary hyphen we didn't use to break the line). Show it as a thin black line.") - (BLTSHADE BLACKSHADE DS TX 0 1 100 'PAINT)) - (COND - [(SMALLP CH) (* ; - "Normal character -- just display it.") - (COND - (HARDCOPYMODE (MI-TEDIT.BLTCHAR CH DS (FIXR (FQUOTIENT TX SCALE)) - DISPLAYDATA DDPILOTBBT CLIPRIGHT)) - ((OR TERMSA HARDCOPYMODE) (* ; "Using special instrns from TERMSA") - (\DSPPRINTCHAR DS CH)) - (T (* ; "Native charcodes") - (MI-TEDIT.BLTCHAR CH DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT] - (T (* ; "CH is an object.") - (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) - XOFFSET) - (SETQ CURY (DSPYPOSITION NIL DS)) - DS) (* ; - "Go to the base line, left edge of the image region.") - (APPLY* (IMAGEOBJPROP CH 'DISPLAYFN) - CH DS 'DISPLAY (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - (* ; "Tell him to display himself here.") - (DSPFONT (fetch CLFONT of OLOOKS) - DS) - (MOVETO (IDIFFERENCE (FIXR (FQUOTIENT TX SCALE)) - XOFFSET) - CURY DS) (* ; "Move to after the object's image") - ] - (add TX DX) (* ; "Update our X position") - finally (replace DDXPOSITION of DISPLAYDATA with (IDIFFERENCE (FIXR (FQUOTIENT TX - SCALE)) - XOFFSET)) + (CL:WHEN CLOOKS (* ; + "Underline/overline/strike the just-finished looks run") + (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS CLOOKS (FGETLD LINE + DESCENT))) + (SETQ CLOOKS CHARW) + (DSPFONT (ffetch CLFONT of CLOOKS) + DS) + (CL:UNLESS (EQ 0 (ffetch CLOFFSET of CLOOKS)) + (* ; "Account for super/subscripting") + (RELMOVETO 0 (ffetch CLOFFSET of CLOOKS) + DS)) + (SETQ LOOKSTARTX (IDIFFERENCE TX XOFFSET)))) + (PROGN (if (IMAGEOBJP CHAR) + then + (* ;; "Go to the base line, left edge of the image region.") + + (SETQ CURY (DSPYPOSITION NIL DS)) + (MOVETO (IDIFFERENCE TX XOFFSET) + CURY DS) + (APPLY* (IMAGEOBJPROP CHAR 'DISPLAYFN) + CHAR DS 'DISPLAY (FGETTOBJ TEXTOBJ STREAMHINT)) + (DSPFONT (ffetch CLFONT of CLOOKS) + DS) (* ; + "Restore the character font, move to just after the object.") + (MOVETO (IDIFFERENCE TX XOFFSET) + CURY DS) + elseif TERMSA + then (* ; "Using special instrns from TERMSA") + (\DSPPRINTCHAR DS CHAR) + elseif (DIACRITICP CHAR) + then (MI-TEDIT.BLTCHAR CHAR DS (IPLUS TX (\TEDIT.DIACRITIC.SHIFT + CHARSLOT THISLINE DS)) + DISPLAYDATA DDPILOTBBT CLIPRIGHT) + (SETQ CHARW 0) + else (* ; "Native charcodes") + (MI-TEDIT.BLTCHAR CHAR DS TX DISPLAYDATA DDPILOTBBT CLIPRIGHT)) + (add TX CHARW))) finally (replace DDXPOSITION of DISPLAYDATA + with (IDIFFERENCE TX XOFFSET)) (* ;  "Make any necessary looks mods to the last run of characters") - (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS OLOOKS (ffetch (LINEDESCRIPTOR DESCENT) - of LINE] - (BITBLT CACHE 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBOT) of LINE) - (ffetch (TEXTOBJ WRIGHT) of TEXTOBJ) + (CL:WHEN CLOOKS + (TEDIT.MODIFYLOOKS LINE LOOKSTARTX DS + CLOOKS (FGETLD LINE DESCENT)))]) + (BITBLT CACHE 0 0 WINDOWDS 0 (FGETLD LINE YBOT) + (FGETTOBJ TEXTOBJ WRIGHT) LHEIGHT 'INPUT 'REPLACE) (* ;  "Paint the cached image on the screen (this lessens flicker during update)") - (COND - ((fetch (FMTSPEC FMTREVISED) of (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) + (CL:WHEN (fetch (FMTSPEC FMTREVISED) of (FGETLD LINE LFMTSPEC)) (* ;  "This paragraph has been revised, so mark it.") - (\TEDIT.MARK.REVISION TEXTOBJ (ffetch (LINEDESCRIPTOR LFMTSPEC) of LINE) - WINDOWDS LINE))) - (SELECTQ (ffetch (LINEDESCRIPTOR LMARK) of LINE) + (\TEDIT.MARK.REVISION TEXTOBJ (FGETLD LINE LFMTSPEC) + WINDOWDS LINE)) + (SELECTQ (FGETLD LINE LMARK) (GREY (* ;  "This line has some property that isn't visible to the user. Tell him to be careful") - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'PAINT 42405)) - (SOLID (* ; - "This line has some property that isn't visible to the user. Tell him to be careful") - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'PAINT BLACKSHADE)) - (BITBLT NIL 0 0 WINDOWDS 0 (ffetch (LINEDESCRIPTOR YBASE) of LINE) - 6 6 'TEXTURE 'REPLACE WHITESHADE]) + (BLTSHADE 42405 WINDOWDS 0 (FGETLD LINE YBASE) + 6 6 'PAINT)) + (SOLID (BLTSHADE BLACKSHADE WINDOWDS 0 (FGETLD LINE YBASE) + 6 6 'PAINT)) + (BLTSHADE WHITESHADE WINDOWDS 0 (FGETLD LINE YBASE) + 6 6 'PAINT)) + (FSETLD LINE LDIRTY NIL) + LINE]) + +(\DISPLAYLINE.TABS + [LAMBDA (CW DS TX TERMSA LINE CLOOKS DISPLAYDATA DDPILOTBBT CLIPRIGHT TEXTOBJ) + (* ; "Edited 10-Oct-2023 23:29 by rmk") + (* ; "Edited 4-Oct-2023 21:16 by rmk") + (* ; "Edited 3-Jul-2023 22:02 by rmk") + (* ; "Edited 4-Mar-2023 22:17 by rmk") + (* ; "Edited 1-Oct-2022 11:35 by rmk") + (* ; "Edited 24-Sep-2022 21:19 by rmk") + + (* ;; "Fills in tab-space CW with dotted leaders. LINE is only needed to get the FMTSPEC. TEXTOBJ only needed to get the hardcopy-display stream. ") + + (bind TTX DOTWIDTH (FMTSPEC _ (GETLD LINE LFMTSPEC)) + first + (* ;; "The dots on successive lines may not align so well, in hardcopy display mode. But that's not a mode that looks good anyway. The TERMSA probably screws it anyway.") + + [SETQ DOTWIDTH (CL:IF (fetch (FMTSPEC FMTHARDCOPY) of FMTSPEC) + [HCUNSCALE (fetch (FMTSPEC FMTHARDCOPYSCALE) of FMTSPEC) + (CHARWIDTH (CHARCODE %.) + (FONTCOPY (fetch CLFONT of CLOOKS) + 'DEVICE + (FGETTOBJ TEXTOBJ DISPLAYHCPYDS] + (CHARWIDTH (CHARCODE %.) + (fetch CLFONT of CLOOKS)))] + [SETQ TTX (IPLUS TX DOTWIDTH (IDIFFERENCE DOTWIDTH (IREMAINDER TX DOTWIDTH] + while (ILEQ TTX (IPLUS TX CW)) do (if TERMSA + then (* ; "Using special instrns from TERMSA") + (\DSPPRINTCHAR DS (CHARCODE %.)) + else (* ; "Native charcodes") + (MI-TEDIT.BLTCHAR (CHARCODE %.) + DS + (IDIFFERENCE TTX DOTWIDTH) + DISPLAYDATA DDPILOTBBT CLIPRIGHT)) + (add TTX DOTWIDTH]) (\TEDIT.LINECACHE [LAMBDA (CACHE WIDTH HEIGHT) (* jds "21-Apr-84 00:52") @@ -1327,6 +2123,16 @@ (\CHAR8CODE CHARCODE))) (\PILOTBITBLT DDPILOTBBT 0)) T]) + +(\TEDIT.DIACRITIC.SHIFT + [LAMBDA (CHARSLOT THISLINE IMAGESTREAM) (* ; "Edited 2-Dec-2023 15:58 by rmk") + (* ; "Edited 28-Oct-2023 23:51 by rmk") + + (* ;; "Called when CHARSLOT contains a diacritic. Computes the X position shift that will center the diacritic over the next character. If negative, the caller should move forward by the shift the next character rather than the diacritic. In effect, the diacritic should be treated as if its width is (IMINUS SHIFT) and the next character should be treated as if its with is incremented by (IMINUS SHIFT).") + + (for CS (DWIDTH _ (CHARW CHARSLOT)) incharslots (NEXTCHARSLOT CHARSLOT) when CHAR + do (RETURN (FIXR (FQUOTIENT (- CHARW DWIDTH) + 2))) finally (RETURN 0]) ) (DECLARE%: EVAL@COMPILE DONTCOPY (DECLARE%: EVAL@COMPILE @@ -1342,1437 +2148,801 @@ ) (DEFINEQ -(TEDIT.CR.UPDATESCREEN - [LAMBDA (CH# XPOINT TEXTOBJ SEL LINE BLANKSEEN CRSEEN DS CHWIDTH DONTSCROLL) - (* ; "Edited 23-Feb-88 11:12 by jds") - - (* ;; "Update the edit window image after a CR is typed. Move any text after the CR to a new line, and push or pull text as needed.") - - (* ;; "(PROG ((WINDOW (fetch \WINDOW of TEXTOBJ)) (PREVLINE (fetch PREVLINE of LINE))) (COND ((AND (NOT (fetch CR\END of PREVLINE)) (ILEQ (IDIFFERENCE XPOINT (fetch LEFTMARGIN of LINE)) (IDIFFERENCE (fetch RIGHTMARGIN of PREVLINE) (fetch LXLIM of PREVLINE)))) (* This CR should push the start of the line back upward.) (replace DIRTY of PREVLINE with T) (replace TXTNEEDSUPDATE of TEXTOBJ with T))) (TEDIT.UPDATE.SCREEN TEXTOBJ PREVLINE T) (\FIXSEL SEL TEXTOBJ) (\SHOWSEL SEL NIL T) (COND (DONTSCROLL (* SO DO NOTHING)) ((OR (NOT (fetch NEXTLINE of LINE)) (ILEQ (fetch YBOT of (fetch NEXTLINE of LINE)) (fetch BOTTOM of (DSPCLIPPINGREGION NIL WINDOW)))) (* This pushed the caret off-screen. Move it up.) (replace EDITOPACTIVE of TEXTOBJ with NIL) (SCROLLW WINDOW 0 (LLSH (fetch LHEIGHT of (COND ((fetch NEXTLINE of LINE)) (LINE))) 1)))))") - - (HELP]) - -(TEDIT.DELETELINE - [LAMBDA (LINE TEXTOBJ WINDOW) (* ; "Edited 30-May-91 15:58 by jds") - - (* Remove a complete text line descriptor from the edit window, then move lower - lines up over it.) - - (PROG ((PREV (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (NEXT (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) (* Fix up the line-descriptor chain to - dis-include line) - (COND - (PREV (replace (LINEDESCRIPTOR NEXTLINE) of PREV with NEXT))) - (COND - (NEXT (replace (LINEDESCRIPTOR PREVLINE) of NEXT with PREV))) - (\TEDIT.CLOSEUPLINES TEXTOBJ PREV NEXT NIL WINDOW) (* And fix up the screen to cover the - blank space.) - ]) - -(TEDIT.INSERT.DISPLAYTEXT - [LAMBDA (TEXTOBJ CH CHWIDTH LINE XPOINT DS SEL) (* ; "Edited 30-May-91 16:56 by jds") - (* This function does the actual - displaying of typed-in text on the - edit window.) - (* (PROG ((LOOKS (\TEDIT.APPLY.STYLES - (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) - TEXTOBJ)) (TERMSA (fetch - (TEXTOBJ TXTTERMSA) of TEXTOBJ)) DY - FONT) (DSPFONT (SETQ FONT - (fetch CLFONT of LOOKS)) DS) - (* Change the font) (COND - ((IGREATERP (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE ASCENT)) (fetch - (LINEDESCRIPTOR LTRUEASCENT) of LINE)) - (* The font this character is in is - taller than the existing line. - Adjust the LINEDESCRIPTOR's ascent.) - (\TEDIT.ADJUST.LINES TEXTOBJ LINE DS - (fetch (LINEDESCRIPTOR YBOT) of - (fetch (LINEDESCRIPTOR PREVLINE) of - LINE)) (IDIFFERENCE (fetch - (LINEDESCRIPTOR LTRUEASCENT) of LINE) - (FONTPROP (fetch CLFONT of LOOKS) - (QUOTE ASCENT)))) (* Move other text - to allow for the new height) - (add (fetch (LINEDESCRIPTOR ASCENT) of - LINE) (IDIFFERENCE (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE ASCENT)) (fetch - (LINEDESCRIPTOR LTRUEASCENT) of LINE))) - (replace (LINEDESCRIPTOR LTRUEASCENT) - of LINE with (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE ASCENT))))) (COND - ((IGREATERP (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE DESCENT)) (fetch - (LINEDESCRIPTOR LTRUEDESCENT) of LINE)) - (* If the caret's font will change the - line's descent, adjust lower lines - downward) (\TEDIT.ADJUST.LINES TEXTOBJ - (fetch (LINEDESCRIPTOR NEXTLINE) of - LINE) DS (fetch (LINEDESCRIPTOR YBOT) - of LINE) (IDIFFERENCE - (fetch (LINEDESCRIPTOR LTRUEDESCENT) - of LINE) (FONTPROP (fetch CLFONT of - LOOKS) (QUOTE DESCENT)))) - (add (fetch (LINEDESCRIPTOR DESCENT) - of LINE) (IDIFFERENCE - (FONTPROP (fetch CLFONT of LOOKS) - (QUOTE DESCENT)) (fetch - (LINEDESCRIPTOR LTRUEDESCENT) of LINE))) - (* Fix the line's leading-adjusted - descent to account for this change) - (replace (LINEDESCRIPTOR LTRUEDESCENT) - of LINE with (FONTPROP - (fetch CLFONT of LOOKS) - (QUOTE DESCENT))) (* Also the - unadjusted descent) (replace - (LINEDESCRIPTOR YBOT) of LINE with - (IDIFFERENCE (fetch (LINEDESCRIPTOR - YBASE) of LINE) (fetch - (LINEDESCRIPTOR DESCENT) of LINE))) - (* And note our new location.))) - (BITBLT DS XPOINT (fetch - (LINEDESCRIPTOR YBOT) of LINE) DS - (IPLUS XPOINT CHWIDTH) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IDIFFERENCE (fetch (LINEDESCRIPTOR - RIGHTMARGIN) of LINE) XPOINT) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE INPUT) (QUOTE REPLACE)) - (* Move the old text over) - (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - CHWIDTH (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE) (QUOTE TEXTURE) (QUOTE REPLACE) WHITESHADE) (* Blank out the area we're going to write - into) (MOVETO XPOINT - (IPLUS (fetch (LINEDESCRIPTOR YBASE) - of LINE) (OR (fetch CLOFFSET of LOOKS) - 0)) DS) (* Set the display stream - position) (COND (TERMSA - (* Special terminal table for - controlling character display. - Use it.) (RESETLST (RESETSAVE - \PRIMTERMSA TERMSA) (replace - (TEXTSTREAM REALFILE) of - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - with DS) (COND ((STRINGP CH) (for CHAR instring CH do (SELCHARQ CHAR (TAB (* Put down white) - (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CHAR FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (\DSPPRINTCHAR (fetch - (TEXTOBJ STREAMHINT) of TEXTOBJ) CHAR)))) - (T (SELCHARQ CH (TAB - (* Put down white) (BITBLT NIL 0 0 DS - XPOINT (fetch (LINEDESCRIPTOR YBOT) of - LINE) 36 (fetch (LINEDESCRIPTOR - LHEIGHT) of LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS XPOINT - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CH FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (\DSPPRINTCHAR (fetch - (TEXTOBJ STREAMHINT) of TEXTOBJ) CH)))))) - (T (* No special handling; - just use native character codes) - (COND ((STRINGP CH) (for CHAR instring - CH do (SELCHARQ CHAR - (TAB (* Put down white) - (BITBLT NIL 0 0 DS (DSPXPOSITION NIL - DS) (fetch (LINEDESCRIPTOR YBOT) of - LINE) 36 (fetch (LINEDESCRIPTOR - LHEIGHT) of LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IMAX 6 (CHARWIDTH CHAR FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (BLTCHAR CHAR DS)))) - (T (SELCHARQ CH (TAB - (* Put down white) (BITBLT NIL 0 0 DS - (DSPXPOSITION NIL DS) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - 36 (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (RELMOVETO 36 0 DS)) - (CR (* Blank out the CR's width.) - (BITBLT NIL 0 0 DS (DSPXPOSITION NIL - DS) (fetch (LINEDESCRIPTOR YBOT) of - LINE) (IMAX 6 (CHARWIDTH CH FONT)) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE)) - (BLTCHAR CH DS)))))) - (BITBLT NIL 0 0 DS (fetch - (LINEDESCRIPTOR LXLIM) of LINE) - (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (fetch (LINEDESCRIPTOR LHEIGHT) of - LINE) (QUOTE TEXTURE) - (QUOTE REPLACE) WHITESHADE) - (* Clear after EOL) (TEDIT.MODIFYLOOKS - LINE XPOINT DS LOOKS - (fetch (LINEDESCRIPTOR YBASE) of LINE)) - (* Do underlining, strike-out, etc.))) - (HELP]) - -(TEDIT.INSERT.UPDATESCREEN - [LAMBDA (CH CH# CHARS XPOINT TEXTOBJ SEL OTEXTLEN BLANKSEEN CRSEEN DONTSCROLL INCREMENTAL) - (* ; "Edited 30-May-91 16:06 by jds") - (* ; - "Update the edit window after an insertion") - (PROG ((THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - SELINE EOLFLAG CHORIG CHWIDTH OXLIM OCHLIM OCR\END PREVSPACE FIXEDLINE NEXTLINE LINES - NEWLINEFLG DX PREVLINE SAVEWIDTH OFLOWFN OLHEIGHT DY TABSEEN IMAGECACHE) - (replace (SELECTION CH#) of SEL with (IPLUS CHARS CH#)) - (* ; - "These must be here, since SELs are valid even without a window.") - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of SEL)) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION DCH) of SEL with 0) - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (COND - ((AND INCREMENTAL (\SYSBUFP)) - - (* ;; "We're doing incremental updates, and there's type-in waiting. Bail out, now that we have fixed up the selection.") - - (RETURN)) - ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) (* ; - "Don't update the screen if updates are being inhibited.") - (RETURN)) - ((NOT WINDOW) (* ; - "If this textobj has no window to update, don't bother") - (RETURN)) - ((OR T (LISTP WINDOW) - (TEXTPROP TEXTOBJ 'SLOWUPDATE)) (* ; - "FOR NOW, ALWAYS UPDATE THE SCREEN THE HARD WAY") - (TEDIT.UPDATE.SCREEN TEXTOBJ NIL T (fetch (SELECTION CH#) of SEL)) - (\FIXSEL SEL TEXTOBJ) - (\SHOWSEL SEL NIL T))) - (\COPYSEL SEL TEDIT.SELECTION) - [for WW inside WINDOW as L1 inside (fetch (SELECTION L1) of SEL) as LN - inside (fetch (SELECTION LN) of SEL) as L1LIST on (fetch (SELECTION L1) of SEL) - as LNLIST on (fetch (SELECTION LN) of SEL) - do (COND - (DONTSCROLL - - (* ;; "If scrolling is suppressed, don't bother with the next check:") - - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW)) - [(EQ WW (fetch (TEXTOBJ SELWINDOW) of TEXTOBJ)) - (COND - ([OR (NULL (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT L1) - (RIGHT LN) - NIL)) - (ILEQ (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (fetch (LINEDESCRIPTOR YBOT) of L1)) - (RIGHT (fetch (LINEDESCRIPTOR YBOT) of LN)) - 0) - (fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL WW] - - (* ;; - "The caret is off-window in the selection window. Need to scroll it up so the caret is visible.") - - (while (OR [COND - ((SETQ SELINE (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - NIL)) - (ILESSP (fetch (LINEDESCRIPTOR YBOT) of SELINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (T (ILESSP (fetch (SELECTION Y0) of SEL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (AND (IGEQ (fetch (SELECTION Y0) of SEL) - (fetch (TEXTOBJ WTOP) of TEXTOBJ)) - (NULL SELINE))) - do - (* ;; "The caret just went off-screen. Move it up some.") - - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) - (SCROLLW WW 0 (LLSH (COND - [(SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - NIL) - (fetch (LINEDESCRIPTOR LHEIGHT) - of (SELECTQ (fetch (SELECTION POINT) - of SEL) - (LEFT (CAR L1LIST)) - (RIGHT (CAR LNLIST)) - (SHOULDNT] - (T 12)) - 1] - (T (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WW] - (\COPYSEL SEL TEDIT.SELECTION]) - (TEDIT.UPDATE.SCREEN - [LAMBDA (TEXTOBJ STARTINGLINE INCREMENTAL? NEXTCARETCH#) (* ; "Edited 30-May-91 15:58 by jds") - (* Update the screen, as needed to fix - up "dirty" lines.) - (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (COND - ((NOT (fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ)) (* ; - "Only update the screen if we aren't suppressing updating.") - (bind NLINE for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINE - inside (OR STARTINGLINE (fetch (TEXTOBJ LINES) of TEXTOBJ)) - do (SETQ NLINE (\TEDIT.FIXCHANGEDPART TEXTOBJ LINE WW INCREMENTAL? NEXTCARETCH#)) - (* The last line in the edit window) - (AND NLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of NLINE) - NLINE TEXTOBJ NIL WW NEXTCARETCH#]) + [LAMBDA (TEXTOBJ) (* ; "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 (\FILLPANE (fetch (TEXTWINDOW PLINES) of PANE) + TEXTOBJ PANE] + (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL))]) (\BACKFORMAT - [LAMBDA (LINES TEXTOBJ WHEIGHT) (* ; "Edited 30-May-91 15:58 by jds") + [LAMBDA (TEXTOBJ DY CH1 HEIGHT) (* ; "Edited 30-Nov-2023 21:16 by rmk") + (* ; "Edited 3-Nov-2023 12:02 by rmk") + (* ; "Edited 6-Apr-2023 16:46 by rmk") + (* ; "Edited 5-Apr-2023 09:13 by rmk") + (* ; "Edited 30-May-91 15:58 by jds") - (* Move back to the next preceding CR (to guarantee a line break)%, then format - lines to reach where we are now.) - (* LINES is the dummy first line for - this window in TEXTOBJ) + (* ;; "This computes the shortest sequence of globally correct lines above and including the line with CH1 whose total height is GEQ DY") - (* Returns a pointer to the last of the back-formatted lines - (i.e., the one that comes latest in the document)%, or to LINES if no lines are - formatted) + (* ;; "Returns the head line of the chain whose YBOT is the actual height (possibly a little greater than DY). ") - (PROG ((LINE1 (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - CH1 CHNO CH NLINE) - [SETQ CH1 (COND - (LINE1 (fetch (LINEDESCRIPTOR CHAR1) of LINE1)) - (T (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - (COND - ((ILEQ CH1 1) (* No more lines can be formatted -- - we're at the front of the file.) - (RETURN LINES)) - (T (* There is more to do.) - (\SETUPGETCH (IDIFFERENCE CH1 1) - TEXTOBJ) - [for old CHNO from (IDIFFERENCE CH1 2) to 1 by -1 - do (* Back up until we find a CR) - (SETQ CH (\GETCHB TEXTOBJ)) - (COND - ((EQ CH (CHARCODE CR)) - (RETURN] - (SETQ CHNO (IMAX (ADD1 CHNO) - 1)) (* But never further than the front of - the document) - (while (ILEQ CHNO (SUB1 CH1)) do (* Now move forward, formatting lines - until we catch up with where we were.) - (SETQ NLINE (\FORMATLINE TEXTOBJ NIL CHNO)) - (* Format the next line) - (replace (LINEDESCRIPTOR YBOT) of NLINE with WHEIGHT - ) (* Make sure it thinks it's off-window) - (replace (LINEDESCRIPTOR YBASE) of NLINE - with WHEIGHT) - (replace (LINEDESCRIPTOR PREVLINE) of NLINE - with LINES) - (* Hook it onto the end of the chain) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES - with NLINE) - (SETQ LINES NLINE) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of NLINE))) - (* And find the start of the next line)) - (replace (LINEDESCRIPTOR NEXTLINE) of NLINE with LINE1) + (* ;; "This computes block by block, where the first line of a block either starts a paragraph or comes immediately after a forced break.") - (* Now, with the final line we formatted, hook the rest of the line chain onto - it.) + (bind L1 PAIR (CHNO _ CH1) until (IGREATERP HEIGHT DY) while (IGEQ CHNO 1) + do (SETQ PAIR (\FORMATBLOCK TEXTOBJ CHNO HEIGHT)) (* ; "The block may go beyond DY") + (LINKLD (CADR PAIR) + L1) (* ; + "This block's LN links to previous L1") + (SETQ L1 (CAR PAIR)) + (SETQ HEIGHT (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]) - (AND LINE1 (replace (LINEDESCRIPTOR PREVLINE) of LINE1 with NLINE)) - (RETURN NLINE]) +(\TEDIT.PREVIOUS.LINEBREAK + [LAMBDA (TEXTOBJ CHNO) (* ; "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") -(\FILLWINDOW - [LAMBDA (YBOT CURLINE TEXTOBJ DONTFILLFLG WINDOW NEXTCARETCH#) - (* ; "Edited 30-May-91 16:57 by jds") - (* Fill out TEXTOBJ's window, starting - with the line after CURLINE, whose - ybottom is YBOT) - (* Return T if any lines are moved up.) - (* DONTFILLFLG => Don't bother - printing any new lines at the bottom - of the screen.) + (* ;; "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).") - (* NEXTCARETCH# => always format to at least this CH#, to assure that we know - where the caret will next be.) + (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.") - (PROG* ((LINE (fetch (LINEDESCRIPTOR NEXTLINE) of CURLINE)) - (CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of CURLINE)) - (PREVLINE CURLINE) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (LINES\DELETED NIL) - (WINDOW (OR WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (WHEIGHT (WINDOWPROP WINDOW 'HEIGHT)) - NEXTLINE OFLOWFN) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT)) do (* Do not start with a line which is - above the top of the screen.) - (SETQ PREVLINE LINE) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) - of LINE)) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE))) - [repeatwhile (ILESSP CHARLIM TEXTLEN) - do (* Walk thru the lines below the - starting line.) - [COND - ((AND LINE (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT LINE PREVLINE)) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (* If there is a line to display, and - space to display it, go ahead.) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW)) - [(AND LINE NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - NEXTCARETCH#)) - (* There's a line, and it's earlier - than the next caret location. - Keep going.) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of LINE] - (LINE (* There is a line, but it won't fit.) - [COND - ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) - (T (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] + (CAR (\TEDIT.PARA.FIRST TEXTOBJ CHNO)) + else + (* ;; "Otherwise, move back thru the text until we find a for-sure line break. ") - (* This existing line won't fit. Punt out of this, setting YBOT so the screen - gets cleared right.) + (CL:WHEN (IGREATERP CHNO (FGETTOBJ TEXTOBJ TEXTLEN)) + (SETQ CHNO (FGETTOBJ TEXTOBJ TEXTLEN))) + (LET ((TSTREAM (FGETTOBJ TEXTOBJ STREAMHINT)) + NCHARS) + (\TEXTSETFILEPTR TSTREAM (SUB1 CHNO)) (* ; + "Start at (SUB1 CHNO) because fileptrs are one back from characters") + [SETQ NCHARS (find I from 1 + suchthat (MEMB (\TEXTBACKFILEPTR TSTREAM) + (CHARCODE (EOL FORM %#EOL Meta,EOL CR LF NIL] - [COND - ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (* Try calling any user-supplied - overflow fn, to handle the space - overflow) - (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM '\FILLWINDOW NIL] - (RETURN)) - (DONTFILLFLG (* We are instructed NOT to try - filling the screen, so punt out.) - (RETURN)) - ((OR (ILESSP CHARLIM TEXTLEN) - (AND (IEQP CHARLIM TEXTLEN) - (fetch (LINEDESCRIPTOR CR\END) of CURLINE)) - (ZEROP TEXTLEN)) (* No existing lines to display, but - there's text left (or the doc is empty - and we need a dummy first line)) - (SETQ LINE (\FORMATLINE TEXTOBJ NIL (ADD1 CHARLIM))) - (* Format the next line) - (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) - (* Hook it into the chain of line - descriptors) - (replace (LINEDESCRIPTOR NEXTLINE) of LINE with (SETQ NEXTLINE - (fetch (LINEDESCRIPTOR NEXTLINE - ) of PREVLINE))) - (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with LINE) - (AND NEXTLINE (replace (LINEDESCRIPTOR PREVLINE) of NEXTLINE with LINE)) - (COND - ((IGEQ [COND - [(fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR DESCENT - ) of PREVLINE)) - (IPLUS (fetch FMTBASETOBASE - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE] - (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* If there's room, display the new - line) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( - LINEDESCRIPTOR - DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW)) - [(AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - NEXTCARETCH#)) + (* ;; + "If we didn't find a preceding EOL, we must have backed to the beginning of the file (NIL).") - (* This line is needed to find the next caret location, even tho it won't fit on - the screen) + (CL:IF NCHARS + (ADD1 (IDIFFERENCE CHNO NCHARS)) + 1)]) - (replace (LINEDESCRIPTOR YBOT) of LINE with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS YBOT (fetch ( - LINEDESCRIPTOR - DESCENT) - of LINE] - (T (* Otherwise, we've overflown the - window again) - (SETQ YBOT (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE))) - [COND - ((SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (AND (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM '\FILLWINDOW NIL] - (RETURN] - (COND - (LINE (* Move forward to the next line in - the chain, if any) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (T (* Otherwise, note that we ran off the - end of the file.) - (SETQ CHARLIM (ADD1 TEXTLEN] - (while LINE do +(\FILLPANE + [LAMBDA (PREVLINE TEXTOBJ PANE) (* ; "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") - (* If there are any existing lines which didn't fit, set their YBOTs to 0 so they - don't show) + (* ;; "This executes whether or not TXTNEEDSUPDATE, callers decide that.") - [AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - TEXTLEN) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (COND - ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* If there is space left at the - bottom of the window, blank it out.) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE))) - (COND - ((AND PREVLINE (fetch (LINEDESCRIPTOR CR\END) of PREVLINE) - (OR (ILESSP (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - WHEIGHT) - (ILEQ (fetch (LINEDESCRIPTOR CHARTOP) of PREVLINE) - 0)) - (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) - TEXTLEN)) (* If the last line ends in a CR, put - a dummy line below it.) - [SETQ LINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with (\FORMATLINE - TEXTOBJ NIL - (ADD1 TEXTLEN] - (replace (LINEDESCRIPTOR PREVLINE) of LINE with PREVLINE) - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) - of PREVLINE) - (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE))) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IDIFFERENCE (fetch (LINEDESCRIPTOR - YBOT) of PREVLINE) - (fetch (LINEDESCRIPTOR ASCENT) - of LINE))) - (replace (LINEDESCRIPTOR CHARLIM) of LINE with (ADD1 TEXTLEN)) - (SETQ PREVLINE LINE))) - (COND - ((AND (IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE) - TEXTLEN) - (NOT (fetch (LINEDESCRIPTOR CR\END) of PREVLINE))) - (* This line lies at end of text, so - chop off any following lines.) - (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NIL))) - (RETURN LINES\DELETED]) + (LET (LINE) -(\FIXDLINES - [LAMBDA (LINES SEL CH#1 CH#LIM TEXTOBJ) (* ; "Edited 30-May-91 15:59 by jds") + (* ;; "") + + (* ;; "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.FORMATLINES PREVLINE NIL PANE TEXTOBJ)) + + (* ;; "") + + (CL:WHEN (\TEDIT.INSURE.TRAILING.LINE TEXTOBJ PREVLINE) + (\DISPLAYLINE TEXTOBJ (GETLD PREVLINE NEXTLINE) + PANE)) + + (* ;; "") + + (\TEDIT.CLEARPANE.BELOW.LINE PREVLINE PANE TEXTOBJ) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ PANE) + (FSETTOBJ TEXTOBJ TXTNEEDSUPDATE NIL]) + +(\TEDIT.UPDATE.LINES + [LAMBDA (TEXTOBJ REASON FIRSTCHANGEDCHNO NCHARSCHANGED DONTDISPLAY) + (* ; "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.") + + (* ;; "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 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 + do + (* ;; "Create/format/display new lines between LASTVALID=(CAR VALIDS) and NEXTVALID ") + + (SETQ NEXTVALID (CDR VALIDS)) + (SETQ LASTGAPLINE (\TEDIT.FORMATLINES (CAR VALIDS) + (AND NEXTVALID (SUB1 (FGETLD NEXTVALID LCHAR1))) + PANE TEXTOBJ DONTDISPLAY)) + (LINKLD LASTGAPLINE NEXTVALID) + + (* ;; "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.") + + (if NEXTVALID + then (SETQ DELTA (IDIFFERENCE (FGETLD LASTGAPLINE YBOT) + (FGETLD NEXTVALID YTOP))) + + (* ;; "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 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.") + + (LET (DUMMYLINE) + + (* ;; "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). ") + + (* ;; + "1STLN and LSTLN are NIL, since we don't want to make end paragraph-boundary inferences") + + (SETQ DUMMYLINE + (create LINEDESCRIPTOR + LDUMMY _ T + YBOT _ (fetch HEIGHT of (DSPCLIPPINGREGION NIL PANE)) + LCHAR1 _ 0 + LCHARLIM _ 0 + RIGHTMARGIN _ (SUB1 (FGETTOBJ TEXTOBJ WRIGHT)) + LHEIGHT _ 0 + LX1 _ 0 + LXLIM _ (FGETTOBJ TEXTOBJ WRIGHT) + FORCED-END _ (CHARCODE EOL) + ASCENT _ 0 + DESCENT _ 0 + LTRUEASCENT _ 0 + LTRUEDESCENT _ 0 + LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC + 1STLN _ NIL + LSTLN _ NIL + LTEXTOBJ _ TEXTOBJ)) + (replace (TEXTWINDOW PLINES) of PANE with DUMMYLINE)(* ; "Install PANE's new dummy line") + (LINKLD DUMMYLINE FIRSTLINE) (* ; "Link the possible first line") + DUMMYLINE]) + +(\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") + + (* ;; "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.") + + (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))))]) + +(\TEDIT.FORMATLINES + [LAMBDA (PREVLINE LASTCHAR PANE TEXTOBJ DONTDISPLAY) (* ; "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. ") + + (* ;; "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 (\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 (* ; + "Cached formatting is good for display") + (\DISPLAYLINE TEXTOBJ NEXT PANE)) finally + + (* ;; "Ran out of lines") + + (RETURN (OR L PREVLINE))))]) + +(\FORMAT.GAP.LINES + [LAMBDA (VALIDS PANE TEXTOBJ DONTDISPLAY) (* ; "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") + + (* ;; "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.") + + (* ;; "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.") + + (* ;; "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.") + + (* ;; "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 (\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") + + (\DISPLAYLINE TEXTOBJ LASTVALID PANE)) finally (LINKLD LASTVALID NEXTVALID) + (RETURN LASTVALID]) + +(\TEDIT.LOWER.LINES + [LAMBDA (NEXTVALID LASTVALID PANE TEXTOBJ) (* ; "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) + (\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-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.") + + (\DTEST 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.FORMATLINES LASTVISIBLE NIL PANE TEXTOBJ) + (RETURN))]) + +(\TEDIT.VALID.LINES + [LAMBDA (TEXTOBJ FIRSTCHANGEDCHNO NCHARSCHANGED REASON) (* ; "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:") + + (* ;; " 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.") + + (* ;; " 2. an intermediate sequence of lines that are (or may be) no longer valid because of the change.") (* ;; - "Fix up the list LINES of line descriptors, given that characters CH#1 thru CH#LIM were deleted.") - - (* ;; "Change CHAR1 and CHARLIM entries in each descriptor, and remove any descriptors for lines which disappeared entirely.") - - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - - (* ;; "Only do this if we're allowed to change the document.") - - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (SETQ LINES (WINDOWPROP WW 'LINES)) - (PROG ((NLINES LINES) - (DCH (IDIFFERENCE CH#LIM CH#1)) - (CH#1L (SUB1 CH#1)) - PL NL CHARLIM) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - CHARLIM CHAR1 while LINE - do (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) - (SETQ CHAR1 (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (COND - [(ILESSP CHARLIM CH#1) - (COND - ((AND (IGEQ CH#1 CHAR1) - (ILEQ CH#1 (fetch (LINEDESCRIPTOR CHARTOP) of LINE))) - - (* ;; "This change happened in a place where it may affect this line's break decision. Better reformat to be safe.") - - (replace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) - ((AND (fetch (LINEDESCRIPTOR CR\END) of LINE) - (IEQP CHARLIM CH#1L)) - - (* ;; "This line ends in CR, and the deletion starts immediately thereafter. Best to reformat, for safety.") - - (replace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T] - ((IGEQ CHAR1 CH#LIM) (* ; - "This line contains none of the deleted text but is after it. Update CHAR1, CHARLIM and CHARTOP") - (replace (LINEDESCRIPTOR CHAR1) of LINE with (IMAX 1 (IDIFFERENCE - CHAR1 DCH))) - (replace (LINEDESCRIPTOR CHARLIM) of LINE with (IDIFFERENCE CHARLIM DCH - )) - (replace (LINEDESCRIPTOR CHARTOP) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR CHARTOP) of LINE) - DCH))) - [(OR (ILESSP CHAR1 CH#1) - (IGEQ CHARLIM CH#LIM)) (* ; - "This line contains some of the deleted text, mark it as dirty and update CHAR1 and CHARLIM") - (replace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T) - (replace (LINEDESCRIPTOR CHAR1) of LINE with (IMAX 1 (IMIN CHAR1 CH#1)) - ) - (COND - [(IGEQ CHARLIM CH#LIM) - (replace (LINEDESCRIPTOR CHARLIM) of LINE - with (IDIFFERENCE CHARLIM (IMIN DCH (IDIFFERENCE CH#LIM CHAR1] - (T (replace (LINEDESCRIPTOR CHARLIM) of LINE with CH#1L] - (T (* ; - "This line is totally within the deleted text, remove it") - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (COND - (PL (replace (LINEDESCRIPTOR NEXTLINE) of PL with NL))) - (COND - (NL (replace (LINEDESCRIPTOR PREVLINE) of NL with PL))) - (COND - ((EQ NLINES LINE) - (SETQ NLINES NL))) - (replace (LINEDESCRIPTOR DELETED) of LINE with T) - (* ; - "Mark this line deleted, so DELETETEXTCHARS know to ignore it.") - (AND NL (replace (LINEDESCRIPTOR DIRTY) of NL with T)) - (* ; - "This may well force a reformatting of the next line. Mark it dirty just in case.") - )) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) (* ; - "Fix up the selections in this textobj") - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (\TEDIT.FIXDELSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - TEXTOBJ CH#1 CH#LIM DCH) - (RETURN NLINES]) - -(\FIXILINES - [LAMBDA (TEXTOBJ SEL CH#1 DCH OTEXTLEN) (* ; "Edited 30-May-91 16:07 by jds") - - (* ;; "Fix the list LINES of line descriptors to account for DCH characters inserted before CH#1") - - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - - (* ;; "Only make this change if you're allowed to change the document.") - - (LET (LINES CH# CHLIM CHAR1 CHARLIM) - (SETQ CH#1 (IMAX CH#1 1)) (* ; - "Make sure we're inserting in a legit spot.") - [for WW inside (ffetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 in (fetch (SELECTION L1) of SEL) - do - (* ;; "For each pane in the editing window, examine the pane's list of lines") - - (bind [LINE _ (COND - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINES) - 0) (* ; - "Make sure to skip the initial dummy line") - LINES) - (T (ffetch (LINEDESCRIPTOR NEXTLINE) of LINES] while LINE - do (\DTEST LINE 'LINEDESCRIPTOR) - (COND - ((IGREATERP (SETQ CHAR1 (ffetch (LINEDESCRIPTOR CHAR1) of LINE)) - CH#1) (* ; - "This line starts after the insertion point. Update it's CHAR1") - (freplace (LINEDESCRIPTOR CHAR1) of LINE with (IPLUS CHAR1 DCH))) - ((AND (IEQP CH#1 CHAR1) - (NEQ LINE L1)) (* ; - "The insertion is at the end of the PRIOR line--so go ahead and update this CHAR1") - (freplace (LINEDESCRIPTOR CHAR1) of LINE with (IPLUS CHAR1 DCH)) - (COND - ((ffetch (LINEDESCRIPTOR PREVLINE) of LINE) - (freplace (LINEDESCRIPTOR DIRTY) of (ffetch (LINEDESCRIPTOR PREVLINE - ) of LINE) - with T))) - (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) - CH#1) (* ; - "This line spans the insert point. Mark it DIRTY.") - (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T)) - ((AND (IGEQ (SETQ CHARLIM (ffetch (LINEDESCRIPTOR CHARLIM) of LINE)) - OTEXTLEN) - (NOT (ffetch (LINEDESCRIPTOR CR\END) of LINE))) - - (* ;; "This line is the last in the file, and its CHAR1 is <= the insert point, and it doesn't end in a CR. Therefore, move the line's end upward to accomodate the insertion.") - - (freplace (LINEDESCRIPTOR DIRTY) of LINE with T) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T))) - [COND - ([OR (IGEQ (SETQ CHARLIM (ffetch (LINEDESCRIPTOR CHARLIM) of LINE)) - CH#1) - (AND (IGEQ CHARLIM OTEXTLEN) - (NOT (ffetch (LINEDESCRIPTOR CR\END) of LINE] - (freplace (LINEDESCRIPTOR CHARLIM) of LINE with (IPLUS CHARLIM DCH)) - (COND - ((IGEQ (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) - CH#1) - (freplace (LINEDESCRIPTOR CHARTOP) of LINE - with (IPLUS (ffetch (LINEDESCRIPTOR CHARTOP) of LINE) - DCH] - (SETQ LINE (ffetch (LINEDESCRIPTOR NEXTLINE) of LINE] - (\TEDIT.FIXINSSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - TEXTOBJ CH#1 DCH) - (\TEDIT.FIXINSSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - TEXTOBJ CH#1 DCH) - (\TEDIT.FIXINSSEL SEL TEXTOBJ CH#1 DCH]) - -(\SHOWTEXT - [LAMBDA (TEXTOBJ LINES WINDOW) - - (* ;; "Edited 12-Jan-2022 18:56 by rmk: I took out the WAITINGCURSOR, the resetsave wasn't working for some reason, and it really isn't necessary for modern machines.") - - (* ;; "Edited 12-Jun-90 19:22 by mitani") - - (* ;; "Fill the editor window with text, starting from the top of the file.") - - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* ; - "If there is no edit window, just return.") - (PROG1 (PROG (WREG) - (SETQ WINDOW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - (DSPFILL (PROG1 (DSPCLIPPINGREGION NIL WINDOW) - (* ; "For region within a window:") - - (* ;; "(CREATEREGION (fetch (TEXTOBJ WLEFT) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) (fetch (TEXTOBJ WLEFT) of TEXTOBJ)) (IDIFFERENCE (fetch (TEXTOBJ WTOP) of TEXTOBJ) (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)))") - - ) - WHITESHADE - 'REPLACE WINDOW) (* ; "Clear the window.") - (RETURN (RESETLST - - (* ;; "RMK: For reasons unknown, the original cursor is not restored when this exits. But there is presumably no need for this waiting indicator in modern times. This only fills lines visible within a window, and machines are really fast.") - - (* ;; "Display the hourglass cursor as we work") - - (AND NIL (RESETSAVE (CURSOR WAITINGCURSOR))) - (SETQ LINES - (create LINEDESCRIPTOR - YBOT _ (WINDOWPROP WINDOW 'HEIGHT) - CHAR1 _ 0 - CHARLIM _ 0 - SPACELEFT _ -1 - RIGHTMARGIN _ (SUB1 (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - NEXTLINE _ NIL - CHARTOP _ -1 - LHEIGHT _ 0 - LXLIM _ (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - CR\END _ T - ASCENT _ 0 - DESCENT _ 0 - LTRUEASCENT _ 0 - LFMTSPEC _ TEDIT.DEFAULT.FMTSPEC)) - (* ; - "Make sure we have the anchor pseudo-line") - (WINDOWPROP WINDOW 'LINES LINES) - (\FILLWINDOW (WINDOWPROP WINDOW 'HEIGHT) - LINES TEXTOBJ NIL WINDOW) - (* ; "Fill the window as usual") - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW) - LINES)]) - -(\TEDIT.ADJUST.LINES - [LAMBDA (TEXTOBJ FIRSTLINE WINDOW LINETOP DY) (* ; "Edited 30-May-91 15:59 by jds") - - (* Move all lines from FIRSTLINE (inclusive) on up or down. - Fill in a line or drop one off, accordingly. - Positive DY means move UP.) - - (* LINETOP is the top of the region to be moved as the adjustment is made. - It corresponds to the TOP of FIRSTLINE.) - - (PROG ((OFLOW NIL) - OFLOWFN OYBOT PREVLINE) - [COND - ((ZEROP DY) (* This line's total height HAS NOT - CHANGED. Don't make any adjustments.) - ) - ((ILESSP LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* This line is off the screen. - Don't bother adjusting it.) - ) - (FIRSTLINE - - (* This line's total height changed -- must move the rest of the window, and - adjust YBOT/BASEs.) - - (bind (LL _ FIRSTLINE) while (AND LL (IGEQ (fetch (LINEDESCRIPTOR YBOT) - of LL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do - - (* Loop thru the line descriptors that are affected by the change - (i.e., those below it)%, and adjust their Y locations.) - - (SETQ OYBOT (fetch (LINEDESCRIPTOR YBOT) of LL)) - [COND - ((ILESSP (replace (LINEDESCRIPTOR YBOT) of LL with (IPLUS OYBOT DY)) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* This line moved below the bottom of - the screen) - (BITBLT NIL 0 0 WINDOW 0 OYBOT (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (fetch (LINEDESCRIPTOR LHEIGHT) of LL) - 'TEXTURE - 'REPLACE WHITESHADE) (* So clear the space it used to - occupy.) - (COND - ((AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (SETQ OFLOW T) - (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETURN NIL)) - - (* We walked off the bottom, and the user gave us an OFLOWFN to handle it. - Give it a try.) - - ] - (add (fetch (LINEDESCRIPTOR YBASE) of LL) - DY) (* Adjust the baseline of the line, as - well as its physical bottom.) - (replace (LINEDESCRIPTOR YBOT) of LL with (IDIFFERENCE (fetch ( - LINEDESCRIPTOR - YBASE) - of LL) - (fetch (LINEDESCRIPTOR - DESCENT) - of LL))) - (* I realize this looks redundant, but - the line's descent may have changed, - too.) - (SETQ PREVLINE LL) - - (* Remember the prior line, since we'll need it if we later try to fill out the - window with more text.) - - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL)) - (* Move to the next line.)) - (AND OFLOW (RETURN NIL)) - - (* If there was an overflow, and it got handled by the user's OFLOWFN, don't - bother trying anything further.) - - (COND - [(IGREATERP DY 0) (* The line is shorter; - move the rest up.) - (BITBLT WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WINDOW 0 (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - LINETOP - 'INPUT - 'REPLACE) (* Move the text up) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - DY - 'TEXTURE - 'REPLACE WHITESHADE) (* Now clear the bottom part of the - window, which got vacated by the - adjustment) - (COND - ((AND PREVLINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - - (* If there is space left on the screen, try to fill it with new text.) - - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - PREVLINE TEXTOBJ NIL WINDOW] - (T (* The line is taller; - move the rest down.) - (BITBLT WINDOW 0 (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (IMINUS DY)) - WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE LINETOP (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'INPUT - 'REPLACE) (* Move the text down) - (BITBLT NIL 0 0 WINDOW 0 (IPLUS LINETOP DY) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IMINUS DY) - 'TEXTURE - 'REPLACE WHITESHADE) (* Now clear the region we moved it - out of.) - ] - (RETURN T]) - -(\TEDIT.CLEAR.SCREEN.BELOW.LINE - [LAMBDA (TEXTOBJ WINDOW LINE) (* ; "Edited 30-May-91 15:59 by jds") - (* Clears the edit window to white, - clearing only the sapce below the line - given.) - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE]) - -(\TEDIT.CLOSEUPLINES - [LAMBDA (TEXTOBJ PREVLINE NEXTLINE DONTFILLFLG WINDOW) (* ; "Edited 30-May-91 15:59 by jds") - - (* ;; "Given a gap between PREVLINE and NEXTLINE, move NEXTLINE et seq up to coverthe gap, and adjust the YBOTs. If DONTFILLFLG is T then we're not filling the screen") - (* ; - "NEXTLINE = NIL => remove all lower lines.") - (COND - (PREVLINE (* ; - "PREVLINE = NIL => DON'T close up anything.") - (PROG [DY (WWIDTH (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - (fetch (TEXTOBJ WLEFT) of TEXTOBJ))) - (LOWESTY (COND - (PREVLINE (fetch (LINEDESCRIPTOR YBOT) of PREVLINE)) - (T (ADD1 (fetch (TEXTOBJ WTOP) of TEXTOBJ] - [COND - (NEXTLINE (* ; - "If the gap isn't at the end, move whatever else up over it.") - [SETQ DY (IDIFFERENCE LOWESTY (IPLUS (fetch (LINEDESCRIPTOR YBOT) - of NEXTLINE) - (fetch (LINEDESCRIPTOR LHEIGHT) - of NEXTLINE] - (AND (ILEQ DY 0) - (RETURN)) (* ; - "If there's no gap, don't bother with anything else.") - (BITBLT WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WINDOW - (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (IPLUS DY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - WWIDTH - (IPLUS (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of NEXTLINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (fetch (LINEDESCRIPTOR LHEIGHT) of NEXTLINE)) - 'INPUT - 'REPLACE) (* ; "Move the remaining lines upward.") - (bind (LINE _ NEXTLINE) - (NYBOT _ LOWESTY) while LINE - do (* ; - "Scan the remaining lines, fixing up the vertical spacing information") - (SETQ NYBOT (IDIFFERENCE NYBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE))) - (COND - ((IGEQ NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (SETQ LOWESTY NYBOT))) - [COND - [(ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (* ; - "Line is off screen. Display it at the right spot.") - (AND DONTFILLFLG (RETURN)) - (* ; - "If we're not filling the screen, then stop here.") - (replace (LINEDESCRIPTOR YBOT) of LINE with NYBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS NYBOT (fetch (LINEDESCRIPTOR DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW) - (COND - ((fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - (* ; - "There's a next line after the current one. Use it") - ) - ((IGEQ (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "We're at the end of the text; don't bother trying to add more lines") - ) - (T (* ; - "There's more; try adding another line.") - [replace (LINEDESCRIPTOR NEXTLINE) of LINE - with (\FORMATLINE TEXTOBJ NIL - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE] - (replace (LINEDESCRIPTOR PREVLINE) - of (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - with LINE] - (T (* ; - "Line is visible; just update YBOT/YBASE") - (replace (LINEDESCRIPTOR YBOT) of LINE with NYBOT) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - until (ILESSP NYBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ] - (BITBLT NIL 0 0 WINDOW (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - WWIDTH - (IDIFFERENCE LOWESTY (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE) (* ; - "Clear the part of the screen below the lowest line now displayed") - (RETURN T]) - -(\TEDIT.COPY.LINEDESCRIPTOR - [LAMBDA (FROMLINE TOLINE) (* ; "Edited 30-May-91 16:57 by jds") - - (* Copy the contents of one line descriptor into another -- - except for chaining and Y-location info.) - - (freplace (LINEDESCRIPTOR LEFTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR LEFTMARGIN) - of FROMLINE)) - (freplace (LINEDESCRIPTOR RIGHTMARGIN) of TOLINE with (ffetch (LINEDESCRIPTOR RIGHTMARGIN) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LXLIM) of TOLINE with (ffetch (LINEDESCRIPTOR LXLIM) of FROMLINE)) - (freplace (LINEDESCRIPTOR SPACELEFT) of TOLINE with (ffetch (LINEDESCRIPTOR SPACELEFT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LHEIGHT) of TOLINE with (ffetch (LINEDESCRIPTOR LHEIGHT) of FROMLINE)) - (freplace (LINEDESCRIPTOR CHAR1) of TOLINE with (ffetch (LINEDESCRIPTOR CHAR1) of FROMLINE)) - (freplace (LINEDESCRIPTOR CHARLIM) of TOLINE with (ffetch (LINEDESCRIPTOR CHARLIM) of FROMLINE)) - (freplace (LINEDESCRIPTOR CHARTOP) of TOLINE with (ffetch (LINEDESCRIPTOR CHARTOP) of FROMLINE)) - (freplace (LINEDESCRIPTOR DIRTY) of TOLINE with NIL) - (freplace (LINEDESCRIPTOR CR\END) of TOLINE with (ffetch (LINEDESCRIPTOR CR\END) of FROMLINE)) - (freplace (LINEDESCRIPTOR LDOBJ) of TOLINE with (ffetch (LINEDESCRIPTOR LDOBJ) of FROMLINE)) - (freplace (LINEDESCRIPTOR LHASPROT) of TOLINE with (ffetch (LINEDESCRIPTOR LHASPROT) of FROMLINE) - ) - (freplace (LINEDESCRIPTOR LFMTSPEC) of TOLINE with (ffetch (LINEDESCRIPTOR LFMTSPEC) of FROMLINE) - ) - (freplace (LINEDESCRIPTOR LTRUEDESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR LTRUEDESCENT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR LTRUEASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR LTRUEASCENT) - of FROMLINE)) - (freplace (LINEDESCRIPTOR ASCENT) of TOLINE with (ffetch (LINEDESCRIPTOR ASCENT) of FROMLINE)) - (freplace (LINEDESCRIPTOR DESCENT) of TOLINE with (ffetch (LINEDESCRIPTOR DESCENT) of FROMLINE)) - (freplace (LINEDESCRIPTOR LHASTABS) of TOLINE with (ffetch (LINEDESCRIPTOR LHASTABS) of FROMLINE) - ) - (freplace (LINEDESCRIPTOR LMARK) of TOLINE with (ffetch (LINEDESCRIPTOR LMARK) of FROMLINE)) - (freplace (LINEDESCRIPTOR 1STLN) of TOLINE with (ffetch (LINEDESCRIPTOR 1STLN) of FROMLINE)) - (freplace (LINEDESCRIPTOR LSTLN) of TOLINE with (ffetch (LINEDESCRIPTOR LSTLN) of FROMLINE]) - -(\TEDIT.FIXCHANGEDLINE - [LAMBDA (TEXTOBJ PREVYBOT LINES WINDOW TEXTLEN THISLINE WHEIGHT CHARLIM NEXTCARETCH# PREVDESCENT) - (* ; "Edited 30-May-91 16:57 by jds") - (* Reformat a single line, if need be. - Returns the changed line) - (PROG ((YBOT PREVYBOT) - (FORMATDONE NIL) - LIMITCHANGED WASDIRTY OCHLIM OLHEIGHT (PREVLINE NIL) - (FOUND NIL) - DY OFLOWFN NEWLINE) - [COND - ((IEQP CHARLIM 1) - (SETQ CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] - (COND - ([OR (fetch (LINEDESCRIPTOR DIRTY) of LINES) - (NOT (IEQP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES] - - (* Only act if this line has changed, or if there is a gap or overlap between - this line and the prior one) - - (SETQ OCHLIM (fetch (LINEDESCRIPTOR CHARLIM) of LINES)) - (* This line's old CHLIM, for seeing - if it changes) - (SETQ OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES)) - (* This line's old height, for seeing - if it changes.) - (SETQ NEWLINE (\FORMATLINE TEXTOBJ NIL CHARLIM)) - (* Create the fresh line) - (COND - ((AND (ILESSP CHARLIM (fetch (LINEDESCRIPTOR CHAR1) of LINES)) - (IEQP (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE)) - (fetch (LINEDESCRIPTOR CHAR1) of LINES))) - (* If this is a space-filling line, - just move the other lines down.) - (\TEDIT.INSERTLINE NEWLINE LINES)) - (T (* Otherwise, write over existing - lines) - (\TEDIT.COPY.LINEDESCRIPTOR NEWLINE LINES) - (* Move it into place in the chain) - (replace (THISLINE DESC) of THISLINE with LINES) - (* And pretend that LINES is the line - we just formatted--since it - effectively IS.) - (SETQ NEWLINE LINES) (* And copy it back over the original) - )) - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of NEWLINE))) - (* Find the end of the new line - (this MUST be before this COND, - because LINES is set to NIL inside it.)) - (COND - ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - WHEIGHT) (* Do nothing until we see a change to - a line which is on-screen.) - (replace (LINEDESCRIPTOR YBOT) of NEWLINE with (fetch (LINEDESCRIPTOR YBOT) - of LINES)) - (* Except to make sure that the fresh - line also thinks it is off screen) - ) - ((AND (IGEQ (SETQ YBOT (\TEDIT.NEXT.LINE.BOTTOM YBOT NEWLINE (fetch (LINEDESCRIPTOR - PREVLINE) - of NEWLINE))) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (NEQ LINES NEWLINE)) (* If there's space left on the screen - for this line, (and it is a new line)) - (\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of NEWLINE) - WINDOW - (fetch (LINEDESCRIPTOR YBOT) of (fetch (LINEDESCRIPTOR PREVLINE) - of NEWLINE)) - (IMINUS (fetch (LINEDESCRIPTOR LHEIGHT) of NEWLINE))) - (* Move the existing lines down to fit - it in) - (replace (LINEDESCRIPTOR YBOT) of NEWLINE with YBOT) - (* Display it where we are now) - (replace (LINEDESCRIPTOR YBASE) of NEWLINE with (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of NEWLINE))) - (* Base line for the characters to sit - on) - (\DISPLAYLINE TEXTOBJ NEWLINE WINDOW) (* Display it) - ) - ((IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - - (* If there's space left on the screen for this line, and we're overlaying an - existing line.) - - [\TEDIT.ADJUST.LINES TEXTOBJ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) - WINDOW - (IPLUS YBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES) - (IMINUS OLHEIGHT)) - (COND - ((fetch FMTBASETOBASE of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINES)) - (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINES) - YBOT)) - (T (IDIFFERENCE OLHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LINES] - (* Adjust for the possible difference - in heights between old and new line) - (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) - (* Display it where we are now) - (replace (LINEDESCRIPTOR YBASE) of LINES with (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of LINES))) - (* Base line for the characters to sit - on) - (\DISPLAYLINE TEXTOBJ LINES WINDOW) (* Display it) - ) - ((AND NEXTCARETCH# (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LINES) - NEXTCARETCH#)) (* This line is off-screen, but is - needed for finding the caret's new - location) - (replace (LINEDESCRIPTOR YBOT) of LINES with YBOT) - (replace (LINEDESCRIPTOR YBASE) of LINES with YBOT)) - (T - - (* We have walked off the bottom of the screen. - Chop off the lines from here.) - - (SETQ LINES NEWLINE) - (AND (SETQ OFLOWFN (TEXTPROP TEXTOBJ 'OVERFLOWFN)) - (APPLY* OFLOWFN WINDOW TEXTOBJ) - (RETFROM (FUNCTION \TEDIT.FIXCHANGEDLINE))) - [replace (LINEDESCRIPTOR YBOT) of LINES with (replace (LINEDESCRIPTOR YBASE) - of LINES - with (SUB1 (fetch (TEXTOBJ - WBOTTOM) - of TEXTOBJ] - (* Mark this line as being off-screen) - (COND - ((IGREATERP (fetch (LINEDESCRIPTOR CHARLIM) of LINES) - NEXTCARETCH#) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL))) - - (* Chop off any lines below it, to preserve changes that may propogate off the - bottom of the window) - - (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW (fetch (LINEDESCRIPTOR PREVLINE) - of LINES)) - (* And clear the space below the - bottom line on the screen) - (RETURN))) - (SETQ LINES NEWLINE) - - (* So that if we inserted a line, we start by moving up to the pre-existing line) - - )) - (RETURN LINES]) - -(\TEDIT.FIXCHANGEDPART - [LAMBDA (TEXTOBJ STARTINGLINE WINDOW INCREMENTAL? NEXTCARETCH#) - (* ; "Edited 30-May-91 16:07 by jds") - - (* ;; "Reformat lines as needed after a change. Return the last line changed, or NIL if there's no need for a \FILLWINDOW.") - - (PROG* ((THISW (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - [LINES (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP THISW 'LINES] - (REGION (DSPCLIPPINGREGION NIL THISW)) - (YBOT (fetch (REGION PTOP) of REGION)) - (FORMATDONE NIL) - LIMITCHANGED WASDIRTY CHARLIM OCHLIM OLHEIGHT (PREVLINE NIL) - (TPREVLINE NIL) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WHEIGHT (fetch (REGION PTOP) of REGION)) - (WBOTTOM (fetch (REGION BOTTOM) of REGION)) - (CLEARBOTTOM T) - [NEXTCARETCH# (OR NEXTCARETCH# (fetch (SELECTION CH#) of (fetch (TEXTOBJ SEL) - of TEXTOBJ] - DY OFLOWFN NEWLINE TYBOT) - (AND LINES (SETQ TPREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of LINES))) - [while LINES do (* ; - "Find the first line descriptor of a DIRTY line.") - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES)) - (COND - ((ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM - YBOT LINES (fetch (LINEDESCRIPTOR - PREVLINE) - of LINES)) - YBOT))) - (* ; - "There used to be another line above this one. Move this up to cover it.") - (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR PREVLINE) - of LINES) - LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ))) - (* ; - "This HAS to fill the window, or we may wind up with missing lines at the bottom of the screen") - )) - (COND - ((AND (ILESSP YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINES) - NEXTCARETCH#)) (* ; - "We've run off the bottom of the screen.") - (replace (LINEDESCRIPTOR NEXTLINE) of TPREVLINE with NIL) - (* ; - "There may be unfixed changes there, so chop off any further lines.") - (SETQ LINES NIL)) - ((fetch (LINEDESCRIPTOR DIRTY) of LINES) - (RETURN)) - ([AND [NOT (IEQP (fetch (LINEDESCRIPTOR CHAR1) of LINES) - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of TPREVLINE] - (NOT (ZEROP (fetch (LINEDESCRIPTOR CHARLIM) of TPREVLINE] - - (* ;; "This line doesn't match up with the previous line; we should start updating here. But don't worry about the dummy first line") - - (RETURN)) - (T (SETQ TPREVLINE LINES) - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES] - [COND - ((AND LINES (ILESSP (fetch (LINEDESCRIPTOR CHARTOP) of LINES) - 0)) (* ; - "If we hit on the dummy first line, skip over it -- never try to reformat it.") - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES] - [COND - ((NOT LINES) (* ; - "No changed lines found -- clear below last line on screen") - (BITBLT NIL 0 0 WINDOW 0 (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - (fetch (REGION WIDTH) of (DSPCLIPPINGREGION NIL WINDOW)) - (IDIFFERENCE YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - 'TEXTURE - 'REPLACE WHITESHADE) - (COND - [[OR (ZEROP TEXTLEN) - (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of (WINDOWPROP (OR WINDOW ( - \TEDIT.PRIMARYW - TEXTOBJ)) - 'LINES] - - (* ;; "If there is no text, or no image, force a call to \FILLWINDOW, to provide a dummy empty line descriptor for the guy to type at.") - - (RETURN (WINDOWPROP WINDOW 'LINES] - (T (* ; - "We found no changes; return a NIL last-line-changed") - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (* ; - "Reset the 'needs-update' flag so we don't come back looking for work again.") - (RETURN NIL] - [SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of (SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) - of LINES] - (* ; - "Y bottom of the first line to reformat.") - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE))) - (* ; "char to start formatting with") - (while (AND LINES (OR (IGEQ YBOT (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ)) - (ILEQ CHARLIM NEXTCARETCH#))) - do - (* ;; "Run thru lines, cleaning them up. Start with the first dirty line, and only stop if we're both past the place the caret will be AND off the bottom of the screen.") - - [COND - ([ILESSP 0 (SETQ DY (IDIFFERENCE (\TEDIT.NEXT.LINE.BOTTOM YBOT LINES - (fetch (LINEDESCRIPTOR PREVLINE) - of LINES)) - (fetch (LINEDESCRIPTOR YBOT) of LINES] - (* ; - "There used to be another line above this one. Move this up to cover it.") - (\TEDIT.CLOSEUPLINES TEXTOBJ (fetch (LINEDESCRIPTOR PREVLINE) of LINES) - LINES NIL (OR WINDOW (\TEDIT.PRIMARYW TEXTOBJ] - [COND - ((IGREATERP CHARLIM (IMIN (IMAX 1 (fetch (LINEDESCRIPTOR CHARLIM) of LINES)) - TEXTLEN)) (* ; - "This line has been rendered superfluous -- Delete it.") - (TEDIT.DELETELINE LINES TEXTOBJ WINDOW)) - (T - (* ;; "Try updating the line. If the updater returns NIL, it ran off the bottom of the screen, and we should give up.") - - (COND - ((SETQ LINES (\TEDIT.FIXCHANGEDLINE TEXTOBJ YBOT LINES WINDOW TEXTLEN - THISLINE WHEIGHT CHARLIM NEXTCARETCH# - (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE))) - (* ; - "We're still on screen; update the character and Y-position counters for the next loop") - (SETQ CHARLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINES))) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of LINES))) - (T (* ; - "Ran off the bottom of the window; the bottom has already been cleared, so avoid doing it here.") - (SETQ CLEARBOTTOM NIL) - (RETURN] - (COND - ((IGEQ CHARLIM TEXTLEN) (* ; - "If we've run out of text, chop off any remaining line descriptors, since we won't be needing them.") - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) - (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with NIL) - (* ; - "And there's no more screen updating to do, either.") - ) - ((AND INCREMENTAL? (fetch (LINEDESCRIPTOR NEXTLINE) of LINES) - (IGREATERP CHARLIM NEXTCARETCH#) - (\SYSBUFP)) (* ; - "This is an incremental update, and he hit a key. Stop updating and listen to him") - (* ; - "HOWEVER, NEVER STOP ON THE LAST LINE -- IF THERE ARE NEW LINES TO ADD, ADD ONE.") - (SETQ PREVLINE NIL) - (SETQ CLEARBOTTOM NIL) - (RETURN))) - (SETQ PREVLINE LINES) (* ; - "Remember the last line we really formatted.") - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - (* ; "Move to the next line")) - (COND - (CLEARBOTTOM (* ; - "There had been lines yet to be formatted, so there may be garbage below the end of the screen.") - (\TEDIT.CLEAR.SCREEN.BELOW.LINE TEXTOBJ WINDOW PREVLINE))) - (RETURN PREVLINE]) + " 3. a suffix of post-chamge lines, starting with NEXTVALID, that are known still to be valid.") + + (* ;; "A line is %"valid%" if its line breaking is unaffected by the change and the bits in the screen bitmap that represented it before the change are still correct.") + + (* ;; "") + + (* ;; "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).") + + (* ;; "") + + (* ;; "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.") + + (* ;; "") + + (* ;; "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 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.") + + (* ;; "") + + (* ;; "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.") + + (* ;; "") + + (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 + + (* ;; + "Either within a line or immediately after a line that did not end with an EOL") + + (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. ") + + (* ;; "Figure out the LASTVALIDLINE--somewhere before the FIRSTCHANGEDLINE. Could be PLINES as initialized above") + + (CL:WHEN FIRSTCHANGEDLINE + + (* ;; "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 (find L backlines (FGETLD FIRSTCHANGEDLINE PREVLINE) + suchthat (FGETLD L FORCED-END))) + (CL:WHEN (AND (EQ LASTVALIDLINE PLINES) + (IGREATERP (FGETLD FIRSTCHANGEDLINE LCHAR1) + 1)) + + (* ;; "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 LASTVALIDLINE (CADR (\FORMATBLOCK TEXTOBJ (SUB1 (FGETLD + FIRSTCHANGEDLINE + LCHAR1)) + (FGETLD FIRSTCHANGEDLINE YTOP] + (\TEDIT.INSERTLINE LASTVALIDLINE PLINES T))) + + (* ;; "") + + (* ;; "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. ") + + [SETQ NEXTVALIDLINE (for L inlines LASTCHANGEDLINE + when (OR (FGETLD L FORCED-END) + (GETLD L LSTLN)) + do (RETURN (FGETLD L NEXTLINE] + + (* ;; "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 + (SETLD LASTVALIDLINE NEXTLINE NIL) (* ; "Chop off the useless lines") + (CONS LASTVALIDLINE NEXTVALIDLINE)))]) + +(\TEDIT.CLEARPANE.BELOW.LINE + [LAMBDA (LINE PANE TEXTOBJ) (* ; "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)) + + (* ;; "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)))]) (\TEDIT.INSERTLINE - [LAMBDA (NEWLINE BEFORELINE) (* ; "Edited 30-May-91 16:05 by jds") - (* Inserts NEWLINE in front of - BEFORELINE in the line-descriptor - chain) - (PROG ((PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of BEFORELINE))) - (replace (LINEDESCRIPTOR PREVLINE) of NEWLINE with PREVLINE) - (replace (LINEDESCRIPTOR NEXTLINE) of NEWLINE with BEFORELINE) - (replace (LINEDESCRIPTOR PREVLINE) of BEFORELINE with NEWLINE) - (AND PREVLINE (replace (LINEDESCRIPTOR NEXTLINE) of PREVLINE with NEWLINE]) + [LAMBDA (NEWLINE OLDLINE AFTER) (* ; "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") + (* ; "Edited 30-May-91 16:05 by jds") -(\TEDIT.LINE.LIST - [LAMBDA (TEXTOBJ WINDOW) (* ; "Edited 12-Jun-90 19:23 by mitani") - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES inside (fetch (TEXTOBJ LINES) - of TEXTOBJ) - when (EQ WW WINDOW) do (RETURN LINES]) + (* ;; + "Inserts NEWLINE in the line-descriptor chain either AFTER OLDLINE or before it (AFTER=NIL)") + + (LET (LINE) + (if AFTER + then (SETQ LINE (GETLD OLDLINE NEXTLINE)) + (CL:WHEN LINE (SETLD LINE PREVLINE NEWLINE)) + (SETLD NEWLINE NEXTLINE LINE) + (SETLD NEWLINE PREVLINE OLDLINE) + (SETLD OLDLINE NEXTLINE NEWLINE) + else (SETQ LINE (GETLD OLDLINE PREVLINE)) + (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 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.") + + (* ;; "\FORMATLINE may be overkill--maybe we really want to construct exactly what we want. But \FORMATLINE does get the LHEIGHT.") + + (CL:WHEN (AND (GETLD LASTLINE FORCED-END) + (IEQP (FGETLD LASTLINE LCHARLIM) + (FGETTOBJ TEXTOBJ TEXTLEN))) + (LET [(LINE (\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 CH1 CHLIM) (* ; "Edited 30-May-91 16:05 by jds") - (* Mark dirty the lines that intersect - the range ch1 t chlim inclusive) - (bind (CH# _ (IMIN CH1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (CHLIM# _ (COND - ((IEQP CHLIM -1) - (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (T CHLIM))) for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (bind (LL _ (WINDOWPROP WW 'LINES)) while LL - do (* Mark changed lines as DIRTY.) - (COND - ((AND (ILEQ (fetch (LINEDESCRIPTOR CHAR1) of LL) - CHLIM#) - (IGEQ (fetch (LINEDESCRIPTOR CHARTOP) of LL) - CH#)) + [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") - (* The dirty range overlaps with this line -- - it is between the 1st char on the line, and the last char examined when deciding - where to break the line.) + (* ;; "Mark as dirty the lines that intersect the range FIRSTCHAR to LASTCHAR inclusive, and assert that all panes need to be updated.") - (replace (LINEDESCRIPTOR DIRTY) of LL with T))) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - finally (replace (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ with T]) + [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 -(\TEDIT.NEXT.LINE.BOTTOM - [LAMBDA (CURYBOT LINE PREVLINE) (* ; "Edited 24-Sep-87 10:00 by jds") + (* ;; + "The first line ending after FIRSTCHAR") -(* ;;; "Given a current Y-bottom for PREVLINE, and a LINE to follow it, compute the new line's YBOT value. Takes into account Base-to-base leading, as well as paragraph leadings.") + (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") - (PROG (NEWYBOT PARALEADING PARALOOKS BASETOBASE) - [COND - [[SETQ BASETOBASE (fetch (FMTSPEC FMTBASETOBASE) of (SETQ PARALOOKS (fetch ( - LINEDESCRIPTOR - LFMTSPEC) - of LINE] + (FSETLD L LDIRTY T)) + (RETURN]) - (* ;; "If base-to-base spacing is specified, we have to do this in two parts: First, compute the proper spacing between the lines; then add in any paragraph leading.") +(\TEDIT.LINE.BOTTOM + [LAMBDA (LINE) (* ; "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") - [SETQ NEWYBOT (IDIFFERENCE (IPLUS CURYBOT (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE)) - (IPLUS BASETOBASE (fetch (LINEDESCRIPTOR DESCENT) of LINE] - (COND - ((fetch (LINEDESCRIPTOR 1STLN) of LINE) (* ; - "This is the first line of a new paragraph. Add in any paragraph leading.") - [SETQ PARALEADING (IPLUS (fetch (FMTSPEC LEADBEFORE) of PARALOOKS) - (fetch (FMTSPEC LEADAFTER) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of PREVLINE] + (* ;; "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.") - (* ;; "The inter-paragraph space is the sum of the previous para's post-leading and this para's pre-leading.") + (* ;; "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.") - (SETQ NEWYBOT (IDIFFERENCE NEWYBOT PARALEADING] - (T - (* ;; "If there's no base-to-base spacing, then paragraph leading was taken into account in the line formatter, and is already part of LHEIGHT.") + (* ;; "We can't fetch the YBASE of PREV directly, since we") - (SETQ NEWYBOT (IDIFFERENCE CURYBOT (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (RETURN NEWYBOT]) + (\DTEST LINE 'LINEDESCRIPTOR) + (LET* ((PREV (\DTEST (FGETLD LINE PREVLINE) + 'LINEDESCRIPTOR)) + (PREVYBOT (FGETLD PREV YBOT)) + (FMTSPEC (GETLD LINE LFMTSPEC)) + (BASETOBASE (fetch (FMTSPEC FMTBASETOBASE) of FMTSPEC)) + NEWYBOT) + [SETQ NEWYBOT (if (NOT BASETOBASE) + then + (* ;; + "\TEDIT.FORMATLINE.VERTICAL already compensated for paragraph leading.") + + (IDIFFERENCE PREVYBOT (FGETLD LINE LHEIGHT)) + elseif (FGETLD LINE 1STLN) + 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) + (FGETLD LINE LTRUEHEIGHT))) + else + (* ;; "Between lines inside a paragraph, make the baselines BASETOBASE apart. Oldcode subtracted paragraph leading") + + (IDIFFERENCE (IDIFFERENCE (FGETLD PREV YBASE) + BASETOBASE) + (FGETLD LINE DESCENT] + (SETYPOS LINE NEWYBOT) + NEWYBOT]) + +(\TEDIT.NCONC.LINES + [LAMBDA (HEADLINE TAILLINE HEADYTOP LASTBOTTOM) (* ; "Edited 1-Dec-2023 11:45 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.") + + (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") + + (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))))]) ) - - - -(* RMK%: These duplicate what appears on TEDITHCPY, GLOBALVARS moved to TEDIT-DCL) - - - - -(* (VARS (TEDIT.DONT.BREAK.CHARS (CHARCODE ("41,42" "41,43" "41,53" "41,54" "41,74" "41,115" "41,133" -"41,131" "41,127" "Hira,41" "Hira,43" "Hira,45" "Hira,47" "Hira,51" "Hira,103" "Hira,143" "Hira,145" -"Hira,147" "Hira,156" "Kata,41" "Kata,43" "Kata,45" "Kata,47" "Kata,51" "Kata,103" "Kata,143" -"Kata,145" "Kata,147" "Kata,156"))) (TEDIT.DONT.LAST.CHARS (CHARCODE ("41,114" "41,132" "41,130" -"41,126"))) (GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS))) - (DECLARE%: DONTCOPY - (FILEMAP (NIL (2684 72126 (\FORMATLINE 2694 . 52514) (\TEDIT.NSCHAR.RUN 52516 . 59072) ( -\TEDIT.PURGE.SPACES 59074 . 59468) (\DOFORMATTING 59470 . 72124)) (72127 93156 (\DISPLAYLINE 72137 . -89063) (\TEDIT.LINECACHE 89065 . 89793) (\TEDIT.CREATE.LINECACHE 89795 . 90631) (\TEDIT.BLTCHAR 90633 - . 93154)) (93771 197729 (TEDIT.CR.UPDATESCREEN 93781 . 95000) (TEDIT.DELETELINE 95002 . 95924) ( -TEDIT.INSERT.DISPLAYTEXT 95926 . 111962) (TEDIT.INSERT.UPDATESCREEN 111964 . 117998) ( -TEDIT.UPDATE.SCREEN 118000 . 119100) (\BACKFORMAT 119102 . 122942) (\FILLWINDOW 122944 . 137360) ( -\FIXDLINES 137362 . 143574) (\FIXILINES 143576 . 148697) (\SHOWTEXT 148699 . 152083) ( -\TEDIT.ADJUST.LINES 152085 . 159663) (\TEDIT.CLEAR.SCREEN.BELOW.LINE 159665 . 160403) ( -\TEDIT.CLOSEUPLINES 160405 . 167872) (\TEDIT.COPY.LINEDESCRIPTOR 167874 . 170984) ( -\TEDIT.FIXCHANGEDLINE 170986 . 181369) (\TEDIT.FIXCHANGEDPART 181371 . 192679) (\TEDIT.INSERTLINE -192681 . 193509) (\TEDIT.LINE.LIST 193511 . 193909) (\TEDIT.MARK.LINES.DIRTY 193911 . 195428) ( -\TEDIT.NEXT.LINE.BOTTOM 195430 . 197727))))) + (FILEMAP (NIL (24320 25729 (\TEDIT.LINEDESCRIPTOR.DEFPRINT 24330 . 25727)) (33226 109797 (\FORMATLINE +33236 . 67170) (\FORMATLINE.SETUP 67172 . 70557) (\TEDIT.FORMATLINE.HORIZONTAL 70559 . 74834) ( +\TEDIT.FORMATLINE.VERTICAL 74836 . 76805) (\FORMATLINE.JUSTIFY 76807 . 82741) (\FORMATLINE.TABS 82743 + . 90224) (\FORMATLINE.SCALETABS 90226 . 91223) (\FORMATLINE.PURGE.SPACES 91225 . 92529) ( +\FORMATLINE.EMPTY 92531 . 97234) (\FORMATLINE.UPDATELOOKS 97236 . 104181) (\FORMATLINE.LASTLEGAL +104183 . 107659) (\FORMATBLOCK 107661 . 109795)) (109914 112220 (\CLEARTHISLINE 109924 . 110593) ( +\TLVALIDATE 110595 . 112218)) (112414 132131 (\DISPLAYLINE 112424 . 124536) (\DISPLAYLINE.TABS 124538 + . 127155) (\TEDIT.LINECACHE 127157 . 127885) (\TEDIT.CREATE.LINECACHE 127887 . 128723) ( +\TEDIT.BLTCHAR 128725 . 131246) (\TEDIT.DIACRITIC.SHIFT 131248 . 132129)) (132746 184740 ( +TEDIT.UPDATE.SCREEN 132756 . 134395) (\BACKFORMAT 134397 . 136151) (\TEDIT.PREVIOUS.LINEBREAK 136153 + . 138341) (\FILLPANE 138343 . 140662) (\TEDIT.UPDATE.LINES 140664 . 145543) (\TEDIT.CREATEPLINE +145545 . 147315) (\TEDIT.FIND.DIRTYCHARS 147317 . 149329) (\TEDIT.FORMATLINES 149331 . 152680) ( +\FORMAT.GAP.LINES 152682 . 156546) (\TEDIT.LOWER.LINES 156548 . 160800) (\TEDIT.RAISE.LINES 160802 . +164127) (\TEDIT.VALID.LINES 164129 . 173413) (\TEDIT.CLEARPANE.BELOW.LINE 173415 . 174733) ( +\TEDIT.INSERTLINE 174735 . 175993) (\TEDIT.INSURE.TRAILING.LINE 175995 . 177183) ( +\TEDIT.MARK.LINES.DIRTY 177185 . 179896) (\TEDIT.LINE.BOTTOM 179898 . 182738) (\TEDIT.NCONC.LINES +182740 . 184738))))) STOP diff --git a/library/tedit/TEDIT-SCREEN.LCOM b/library/tedit/TEDIT-SCREEN.LCOM index 3174b747771a9e06df357fba806e5df790c8dc2a..45794b22c8f91ff184634822988a778be7e4b889 100644 GIT binary patch literal 32997 zcmb__4RBl6btV8(G)+qk03i&`(DE}a(~xR000{m_NgORlocZqp@e^? zTuE``G)Zl5nx;*f){5*nb`mFcoW${_0YPELmMmkt?Q{%xYCDe7C6lz9CTW@`+bKD_ zJ3HBFqW#Xf_dPrSl)c?q&4};5`|i8%{+x5}Io~<=!aoupH8Syiqed#e&&Z4lZP&OS z8`BTQwH_mrjZdVE$?+a-*F;<&$?DNmU3OHTjBCNbp0+kW)eu9mY1F z1wvsh6gn^vI1mo@X#SqrlXu@UzjPw6om@tt-bkG^YZ{`je5r|!G`%!&N` zncGo?k=-|m+TxkMcMb+ad$hLtDuclT1E})&sS{S6Cq8t~snfR{(2nx^eQAAStS^Pm zP480gvarhN;A{~dkNg2UmV!G7%kcQQJo zow|EbYda82=$V7@$$eR&`A0L8SL?(c?ZEg%{IDSoP3{}PSYs4J)u9dy9S8>w1O|Jw zw*T9)4en`E<3&R?633_;<5@A$2f`Si010RZMuyw`<62NliI_I71vDlT0~wQ9%y(Kd zkVh}?(HviQIUFvJ=8UvB@bBeb_rk{0Cn@=H{wuR99rl|}v#hpd*{+9e@9*Ghrz6)= zl{2A_%_yHy<% zZD^oAX8`ZjjGGp2c&i^nS6gPdE(2fFf&+tE&qsT-V0gdQ^A5U(FuAz)BmV$hgIW(R zp#iOD1lPc@*7Lim9&H%K@wXpEN8>%(Am4(%diM5c{V1~!6oOaq2A=E%H6I-n6KOq5 zO)}>eZyT7}p+U^;B=|o*Np}NUR7_JMtc~!sUyCK^KBQ&i)7ex!LpSK0KA8piPE4jm zmU4(fro_Yu(r67;JUAdPL2Z1TXlO8?5(E3S4CjRVwdA46tTAdpe2i=8`=Lw})HTL3 z2N^_d`b2i07~MB+#A9(Pgj&E0BZ--DYF7V#zBTWLHOQ;+cxJ@N9Hgg1XuND=lx_#L zQ32vcYCy|Qb5_dHYAK)kSR*1eTvhf(nJ=_j! z!O3ijMkX}G?U@{>^q}>1x*O2A(-4lM#>8ZHDq&>fYV<<=wmfQ1D5Q5x+pg~VDy`$-@dKw(oCSy9JHS&kFscNA?ZORzQ(r^U_v=PYmls==_ z7+I2ZvoquTV!s@ZU`S({NX18Kyn;bZ9F9+rxT3p&M*I=aWT{d6HQh=Nn-6G|hSUQ} z4{F(oLo8|V7Va_rxR)>DHmr%!(aAVZjh0OqlT4`Su$Hyt%>YdYXgG_x1zA808hFo0 zW7)FG^lKCGgNDf9k>pV%f|!MygGdCJf<-i`jcUUn@A#;GD3v9O*rRRNvrb1#bamo= zBxP=lRQ!wU9+xwbH++t=H^1#+D$}arzb(ixjTYQ~(;PcTRFa6n0f12r! zt9-nv(IKvvb`s&ij1Knd>RXTrTHl-bcl86RGSLJwIB{X=Ob!e;sFr@{i{8 zkxI)(ac4RDaxX;Y+{XE)2Uo7kM%|T`g^h2EP-VN6+%18Hjn%Zr{Z0|eKk|UMx6+#b zmNyqFy(6MWxiUAG%iT-wt^NZF*j_AtN8DTb?tJ03NE?0kxGOhtzn+UkL?}A4opV~F z6@RW*baN**zLbC2kCo!m5z#`3=M5vJ6~2>qdYro0Euz2ROmFTZW%04nwc;alUAg-o z6d&o$eXQ(iDt%wv@BPDSv0St)w5H;KCoqCaZly}%c&eF|e7r0^fl5A(NiGve&BbH@hCd`2WH zyDE;-bqgXf$4#p^Udn8hxg&R^oEJwnpDc?b)PgYAgxVfh+5zUq{W-9zta!CUoRw_N zgLAgLv?F)>RT{nRW!dO$f0-8E)LQN+zH*ela`aM0_)_b+yO41gW!&{5wM(4+$&X$` zi+3PVZ8I8kJredJ%2?!9uO?ju- z{YyElkCnw2F#V5V`oHv`c&s<~1)BaJi7$Eo$Sm`K(3YCT``*%?djy~0FN#Na0Ly9d zh|7upF6TP>a~#b-PR&1#{!k{mlt*5k^71c=N4TiVxkiI(HZ3mBF?CLebCNnIL7nGJ z>ilw9Jc;Ig8O{6ZgW}7*xhExce%1TwYOx2zIjZrt&xv#5w#$?}n_tps&hg!BvBx4D zOr&l8!b{Ds<-#k?+r+1fgJS&r+eO!c7_Ye2naIZHsOb2j&sCnwWpd*nzg!>YJ{Q3K zr_1xXM=gR(=i1AeoEv1Ddl!{RQrS_Wlf$1AgUA>xKd{x8n?AL4Ew%EG-~8hX`1Tw= zZQ};BGqh|(h&%DUD7u>3aSe;{RK8z3HK(B2+x#GM@1d4Zv(c;@g`z7IiQH&B} zz6(4nlElD)Vy_r1`Gf{0&2`duaqU=f{TC6aI3&FemJ2_|^DcV6K+i6U%u`~#ctDJ< z?gS~HqwzmGhu&TNGxpa%g4x$Li{m1qZ(=?%m*?b6Dq$jJ%=`1-r1p6)3Ey3X8!C=R z#QRGd^M!vA??-FQA!YvNHr>Lty}gx2^z4f3`kEpuuGX4+%(x^e=LS(=AIn-CsL`!-hJ z3L*Bdw`@F%<}Uy1&D7pcgJV`tzA-_LW4;tQhI1KA61`iz8H7F#;yGL1N~Z1u^bBtTzYch9f;niNq zmjzPAqT==^L`3RLtdo3&3M{?atChu)EHF&!n&Xd58N2#1Q%O=ncl85ihPHatO!lna zVJ16^H(JTu^1{ZSiREog#gJH*+Q=UBVb}RvtYq#Us5fsF_iStWoVbU}JF3P~9G^5(E?;w0_|X~CBaI~Q{Ui9M|ko^riv8wCJBxlR znLC57TrbX0SI%%(o)JAz(>gChVUBWJIH?n{UX;|Qz{J%tj(p)E?l)XEw#upT9Z2Fo@* zo|Q0AC=4U^s6_bKl7@*E>W5ukpBD-Yyg}tb00xZ>3cy&l=MtoliXTL`ftJ{IS zTBQh`sT+V`V1Q=B0$KWMTO0sRk&dUM+J1bp?$!Okfa z5DE>~&RrZN0|EsyU{YZaUy#N)#+3#KjXg9GpE5EdVhY$-e-NZq2azF9qKY>7tv?tT zYAlB_sDC#wT#v8;vH^QFlmkB1m3xrn?FqG|Ka0ugOzwbw7<`^niikLEh73NT8gmB1U5Chgwgh;EV z3qitBnMd)`Xhx$Uv{0m>Va%2ZDGdScRA|xAU@eg!8YgUB&KhC$s@TB(U_%QA7z;F~ zcmSLuIWUYWt5Y9_Fp>HF`}f*lG>!H@_AFS5?0j zB%vt90#UMLy*>&2K{nRZNHBBl00Nz~#wZ9>(YnF-6Yfi>*^u^;=B8RMA=L2Zj}Vd# z$qDE>HNSj9J9F}+wsdm&14wA^KY8lzV`t!P2?oF-e)J^RzemHs1Oxo92AS@Yaz^}OxJ(!B zOz?uwXw>R~NM)k*wg{^w{D%w8_$JE6@s{%Y$Z$w-)|`C(LO$uctvp@mkd;(!dqyS} zk(=P+&^^>M-xufJMirD3@*-7;gwG!%zXT-n$mF;LaQ6>t8M)|&G%OebOk?jq_*>0% zA~rr_ky5A@+lBstHCa-GK0cnB=^NK4u*A-!;**%MV51l$-^gBmVP8y-C4hXZy7xkY z4_J>5O-um9rOIS6JcZI@HUsOcRkFSkEcjM2=o@Bwe}E`U-AR%nf5W(#%ucdrN*f%~ zem5iF(TjDK&uAYUB{$e!2-W zV<~hVpGcu8lus}+E*8#ir%~x9VjP`-X$vnW>aAkw1Wc0y10Di`rY%0J`qNz6PKTof z2(;(7uSryHdtL`O`+FjU9Fd1NSk$~sjk$U*QJX1 zTFWuK8m4B%3cZ9|UMD&X`M#IXmMt3d18R&a1MV9!D;W8Is-U&ZCZX<`@QSYdU(n!v z9wxUmMp|;+WnCs)bGw0O0dR)})(yC~2N$t>W3^Xk#p_{q^ccVVd46Fnx9gt?3h5TR z$ZYK*Erzc<8T)B$c3Z>Pq1xjDt z4ET)JzuJXB8^FR}p9N`OpA~2*6(;v9P{jXuH&UF=s2O5;bFqByK zmcb1O_mims^wU~s-9T@!Zb*vNRU5<*)MY_Esmp0>4IISvi#n9as;{%^w!>g*{qPEN7biAqLy`sCg555b?QTV8Sp6lVoiUq9L zO?C8$-T$21MS|7=@%g=-H8Kza($}gdVrz+C9`U)75PGI$18Id2p-{(&A*kPVSeA=s9|z5uQvupmO3?DCFHXT^Afu+(&Rxx<4#n#$rC`RT);;A!)w-@IWR z0P2@{Pc+QUz*|)k0>UCDtQ-R*8B4|W3@kR-+6Ji7EPxw`tZ7MQ2vQ&dV=#t7FG!z| zN+YWiDpa6GBX<4{{I9L?k;}*17V@4auNwt0{HM{SrtgocwNG7}^OE4cuC8A!$JLXz z^&b}oRPJh*N_@Mn_~W+Xzh7odd);~;G?y3cn@^TS`*SL@H30&MC(x?$!S;s|ZrwEp zTFtqe2%dF3ICmuf*}SWC4Y%peBxim?clK+g=B3@2qCb8yor$ldf3Udr{i9>D-K#g4 z37<+lGp5@3XgRj*ycQ6$dhiW(Ee;~OZ5`YK=Ag#;W?}}kEo05?%z2%0_*K00;Vbvf zuUt7L+^&@?$DM_TVsO&DkMxHdQ4-j3UUZ=9JTYWG1$aLnd!@CUk7M~J#UA2oG9eD7 zMi6HJ*aIsHl-;Tstn}Rwmbnp;h4#%M7a?f8G68ui^DVO)#+%HMt6K=xy}Y-U(GXeT z)yl|-=E~}<_aMSdsttijR%4!HU9SBwARn_0L;Gu*fHhIJWnkD|Ar|1ehQV^N8i`07 z+sD!3>RrRiQH8P;KLP*%RKf9R9P+{hFNq%};2pf&v5NO_q|$!eaeu`5^`+erSJ!bz zSpJp4qW5`d#Xm`UDRvCX0_#kO zu%atkX@NowEv~`;RHFm1S_I-}qDabj5Mp z0q-4?xP-sUi6ss6R`?OY%~~R!8pqdZ{0Pu(Xoy7SR12y$7cGIQG_QV)HCSqeL<%g` z0_dO$nX1Yh5^a`LeX~d#D1kMRHqL);b2^%$rMn~tA!0?v*|e0s|KGxHSg;}F#`D|P zM&_cnC>oALp*R$`bnaAI?v#l!DDd$3z{xO1uHvysrB6!79-s)7aA_O-7Cx-LuE+3S zK5;xSSpmENG2u9f|YRQ9e387@Z9CFe?gU5(aOKP-s)Qiu($%Yt{QAqzshz7(vZ`mDjm zEX+)Osc=KL;Ty6>CRhDQ8JWYzqyar*;t+*oLYPYonHDD#oK)=| z#n+@fMG7I6vO1(yxF=GzNGCFEP!#TLAQSEetyygG{RVs+Fuh@J4!*M zR`BW`&H0_S>l`lqSzce}7}_j*?rB+gK`-3GGUd37BI3TK+vDNBnbKi5zMxlHOMjP| z$uAJ@^f8o}RzOA1#@Q9;N90Yy*Hea-S!!CC?IdCjNI2JWnHpz6lUF2qaDZOrzfe{EdR zt+SoQgxS;=r#e+rI}2K7s`Jg8Y89I8EK3M_s*~GRPQ2U#3;n72S$}z|o7ShPZqlBo z2zHw7{>;>FN0|v4Aw$~0O1;B9Tb8&I5YF-f z(`xrM;E`NJ*r>%F4c^T`2#){Z14mBz5$fr2Iuhr1B=QvpEXyC3n&!QpV=V~@v3{XE zwO6W3ttk1tdDC*qs5mYf71s+>w>@D@-KL6ce0Fa3w(=Nj56ti2{qqK1ybHmkj!zz8 zEAX>MK25<*fHJ(EV4G-X#N_zGY~O5PHZ*l$aeX#CwbyfpTXa}3Z-@Lq3o(${9ss;k ze!?B-;sOdWQSMCVJb z6sm`Sb>Stu*E<_1PxT@DTFS1P!?S%D6d3Ls56!zt)c99^^Bu?*m~IwthXI`^0iq%a z$i%heKnRW;8Tl~4R}ugqF_VMCpjgGI6rrJ#{h+xTp6yqT8p*Tp#@8_DkcwOx0Y~)_ zFZMBmU=g%w2JAF8)r24x{;JME8w0TUtdHO44JfJtXhv0|R6}@$^$tXYmBwh8X}e^I zV(ZkHiFHDG0uK*pGqf2Z45N*Cx8i%7vM*#LF%v{%TS2_CB0_{1_nT|Yqb3{5TXO2kn>s(x$);CxED*IxxZw zf65P&*w!#sSmX2~R-g157N2xRR=WN2C6(G$`rb|> zIoHLua!q^)FmAizPGU$cPUglo-n7SKk1?dEf;u&Bi)fK80z=?cu79yH0;CbaZ_v5r zJQ5x^VNR`_NgjViMVNq(V(XhTBFBb#>=ocZoWKC7gtZ5xMH#xSW$&`nvADM6`u-wM z6h(x}v1~D~GPIsvFbJ$j$U5OVHY-nn9j6OFb@)NaM}cLF7}FaK9@d$tJ|fqjARI30 z22l|fooW<8VKM_&YAX%#o)Os;qvi~Xle(A@oE+5=`-Am9hzwd$Xj6|l6w>#aI;^J* z-l1sW4aAOWaU*>JV7$7ku8`IOSp#c=&dtg-=TopO)&9bYgNIynYwC5;j+VcbuN&ukQ{NTs zvh8n2mYW*y<;2GMHav50-F#}zr?^imSMHl5wG*P55Gf82lL?qSoS+B?PC!lMD{xD? zf@J#<@L*DDKj~{0X@ZukHxzbdK0(Zs`N|X`oN5*XtUuLqFrKS7q#s!|pgKbD^~1W6 z;vI(+x?nvHf)#8xwnhcfBkKuTZl%$rI_3eWYdwX2ZKcCQbxZ|d)OrYA%t~WTRLoYb z2?K_$k%+c|;=Z_*QtKzt%SsZ$zDF_#8dVy&f^me`?* z89avmF*0sIU5-X+k%f^UH$6f$(c9!{G2mU1OE5HF+^LO@1KPA@UPs znn;b9dA8Z4^;*U?q8JBw=;$>q+1&k_HM{9y1phQic9ecR8Ng9-0IuXkAW~7wDRRa= zU)`Zsb``tur{d5nj&)esP~q~TbMtFZ^B$zz4!i+VTy(JUcQl{eSoP<}q-jpA@w_$h%<_T823-@+ehs1smux7a&I;TyCG&n>*7J+gy4x8j^weXrQd ztwFJj=>3}LPOs;B(E&<8{}H>N&_(Z<*o|(gFdVTrx4Ys{RtLrU*I&2@Zy}06dOze7WO!#Fl9G@2c zZO-B}w*B}wu^GUReLt(oRtNs6rLP-RV*q*#`C;JIGzuR**iyJ*%O^6}9=k>M7T#g2 z=LuQZdU>bqUcG{^?7a*-OY~rc%Jr=LW=H|eS0B%vAkD-A)81~;!7b)La*p(hUlPe) z#6ng437v8MvR=_7HG>qEpMLsNvZJ3}zH;UM1**)o)MBUhvd)0{LLMj%VJ7>rctum$ z$%H-<*M=!(S=t4Bs01CrFiBgBhp{m{IuX3#wfjneOda$}Rz$`Kdb49&1V(18b!ybUX$%KI&*n`+Jf3-(gv}!8GhmOMh;sAdB z^Z-10X@sNUl!*Z>QFzAC!vH*sZ0VbE?E_E*&2j(^P;LexcxVMWJphSo6-NBsAOM|| zDjde@VpbX^!-|cmv~4`X&>8J3g4&S)1wd61!h&D}_8C(`l_Z$Q;Sg7wx`Sx3H9tXe zdo~u4VU$o$u}xg(reir%Lr2nBitjBv2E!Poak%&~r&zTo1ud+@fb2O!dzjEA6<<9J z%w!^tJ@g3n9!9&3%=n=!!Za~?_GM-WBbL^UF`*5@VJlMu2(UCQ-vLA$sWc*%!x(Uy zEM?##>f7|+f)**p%eLHv&?8GhK)AT=1{k{aBnWukY$wIlgJRPr6;QX!xQLov&k&LZOml7vq(~s6c$x7vRlS5Fsx(X}p_Gz9ufZgI z%gr(iy*dO!c19LG(QQWJzke?2^?0ty6e0{d-nf)sdJ7ZNr9441FN~FTq~^NrykIO| zo+*4c)qAn;`zkpL*>Mgys>#c z;BjvoG5*F?9vMp->o4R}c#`^?*7As|z^f|w8-yD#+)J!RO9e<9=QI(4!{dyDrT7FD zi~?=BsOc537~8#loa$F}MFCp^{*3n{Y{De(Pz@qagl|b|rhRG`j2#S58pF^8#XSN& zi>Sp!7L*>{azUCLmDWp1!0$=G@5%JWYS-A8Qi<=e8879VJBjy?6#jmJxIhL9qc2!+ zt?!Z_!8D}7<7OJAG^i>e3Z;{rEj_7ylOQh~9b|Dgf<4KwLMQ2zE*@DXdUKW09CJ+; zymTT-JqflbCdn4^UF12#ILm9V8;2MrT?!X_*U z#aM#k0>Mr*b;I~!>=I~>LK4RG&8HR3%|_vHBoX7zA8|SFEDac?Ta(Ti$wH2P z?fkWH&KQ;LYY4hml+&@e{#@ZjE-?n6xbQkB4Z?~4Qd*Xk?)(#+c@&1~=IVb-!4CxT zp*<+FTNXaq7^u+bwQmelXpB;Ts!8)eP^3J*j82fM&9QS}BhqXRH24bx4OmmsA(3VE z*dbc);25hh;vFdvrwf5(n_pRU+u(QDXdaIIc0;d1m2ZblQdFv*p=OoK*43fb}i`rPDkJ8T#L zm@RU@3Z&}JukQ3t=ZiNfPrhVQ^n=()V?gDeDUOV1-gq*FezapFzj?i zOrWvJxS5S;2$fCK)(3B2R;0nkRwY|fCY=bVUfYt;gJf|xk}e2P$H^K*3)_D?X5E>8+{!mn4IBBo^0Fm5%i;cfRS#3v>UWUfsLsakq@!udwy* z{IlMp#s8d0c|2hLeO$v`e4yy+f6bJBHedJ&XXV_S_aB8j*Dk-(&BlJE6V?{&#q@J4 zS3ZWtd!SZf1UXZvYW-9+9%Mj)`Irft3PW-KwK>?@PdShv4U=oJm7Ra=OO@gu>~I46 zVHUvUJQw3i%+MrIfB`a5Im!N%L1()*E(|9B)@TYeSM(B3lTB6li)&~lps*arCB1Y* zjA9e8$qf6-R<%f_yZCneAt_#XD;`O&IP5UPTljvY(iy2(Du&Z@b4vu0|1^*NrKG<3 z)v?s(>U0FhFGk$y(yf{N=lKx{`3!4X7c-U4BdXlaG|HtVTV;rsULW~JETfbRGL;+- zi1p@zPgWmGF0S$Fao6hC(xs*dv{#BCslg?&&9Fv+;MilyLNrOH_=eH6C4T}Wteahm zM5)he2uA>;Hjo7lX{dcq(tw=(K4<}Ifl(wdWX>}pE6jN&dZ#Dvr&E(H!i~k7g7ZJU3PvPACE+qerUpXh8y> zj(sDVQ0^{u9AbCrw-Tirpv0JhoId&I{B@S;zu+XBOh4r0ohw&v2Z=#u*OC+=$&Dn% zXQ)(p8wx+*Dbo#sRdp+R3&9UjOC(T38bnSA&~JSy*z|Q-!A2vEj+Lk{1)#Y;3)ppC z7Mfm{(-81umuPl1N|Ez^lbo%^#-dQP9CWN=vRUShOCW_7A+8FUXux4h?%~uVWPw8A zXFvkxQ+$f@B*H8Yzi5zqCec%A#SjRJycq(dITq!`o!9o&-3oFsg&M?L1e)i9C)|=u ztRKxUY<^|VZMd9Rh$4mlDzRoc2{m>7V&PU!!;OkN(f;erXNCJN`MA6Evz-Psn)hZ( z--#}arPlB#og76*VYa@jo;WlHr$l*ucOfQ9VRrTE7of#6{SC$r{ z3wbljOF9jum$fAwK zuSMK|ts97&qL37mkiVYMB?6g5Dh0|3HEy*C!HBM-xe%Z|(?LQf7u7uuHewK45j+fb zvl5CQk=`KMN>^7M4(O`OY1|^x*zCrA9)p^>9mdWgc9TM}h~x~kqlO#8Hdzh@%;XGo zf{YSogOub4HvSJ@oe3-^ks}9rei18hvjkEVNT7(_bNm`aDKg!!9|6U)W^gv)avp{4 z6)7C35);U$Pq>qyCE7Jru7(|A!xJdAT~g|MP2zuPXAQ5tI{{X>2&#=PB*%<;4k!~n zkHL78TyYIc`}ABi#-pe^JmR6yma@V?qi1kloB((%c?%GF7wL6uXG0-Y76AO%D`k%BU*3V;Ap^q&lg@a z3j-9}#iyIJe@nQD>YaCrcIYb~=MNMPZdLoYtxt7sK1KE6V_mD1TS5FTeT8zLoiBXD z{K~HU>V9v|o7pJ-mS~3pv{}44!U-%E6$k!rU*omNg-y*Fc_b$H&|SDeHK5W}Jda9W zm@hnUR>~uR(b2XGU+Lx*$Dde5zom-ssS&H+LA$yOe{1$6rUEcNTaFfP;t}6Cw-6;w zU*4>aG8W3ZIv*auFPb0i5S^D{l&f1ax07<|paCummHpP8IL_dUd`F5M!d84;aD26~ z<7?$Nt?+uS{Klo4RCt0S)^VDH+JwyqrYNQbwt}M;nSgOno2lx{$ZZJr8ZQ8NcL3E; zVVk`+u!VNhxNw9K1z-1KxKViuD^t%_eYjCo3PZ)Rxe;hP4OlqNfC>dt%05xhMt|d) z(+?=2t|9%6(xbnzpZx%q>t3YYH}zSK*nSXk6?LU>ykkQaT*>vN8b=m^4|Rna&1Hzx zx-wXmDTm+=(;&fI!dZYH%0Seql01`ecuz=-R2HXS&5&|)ON33WvPx?t^>9mLhrW!Z zF^fR)CaD&(1UmnA+YMY=dUVN^cuTu?wNKeV9;b6bUw~dn+MSYW4%|w;PU>N9TC=bf z-&&hMEDcKzG=8FEY8?BrFbK9=3dqlnUADURq#8V;mc#a2VJh%N8rSBMtFN>%Qj&VOF&s1cZ5vhxX8{LIk$ zE4yT|2w?!~ja}6@AP>|Vuk2E9_`1~_$WaH@Y_Up%k=BdVABVH>h7n7EI83w7T~R;wr~s?9HROsuL5+8^`$|gFuJfZhfi5nrEa%@D$yZ#; z{N*$ADvm^D`}&0$(_}D`P{Wd>h3PPK^N*TSVz+sJ!BGV^*rbooAVBk>Ue$Jq_94{e zG!9?A{IHKh!|y$*F~B=eIUr{6SAN0D7tIGo|{5kmiQuKaOnx$9LNmNwj3L@MVoW-INtaiaAnsY*FCegh7Vvkljb?DANOO^g*z95l?i;+e0n<3y~tnhZ8r}tJm zqMP4NFVfGLSn$_B?JWEWPzZ>Q`qd7Hf7VYd8z*%uOsjEPX@@AyJ;`MY$fO_i zfq#H^TmtdLVV#z<01Hs{1`&GZ13NiTeI^E{D1p3SQwrmR=8oSk!(o>63uc6CnQ*tV z{tv5i((lQ{KsAD6PQi_?#Bih{ckfX^S;g_Zlra^*+G4f+;@k^kPa81t3;X0DTdOzV zlr6txHg%+Ur3GQnzJ;~5KS@yES6HTsu6gBHet3L@S&Ns z@4ataO&b}lZgTD8n4zD@s zDF~kC$oa|Ws`>@6ii1EnWgCKfVqa(Vklcl|`=)TKQR!a2UjK^WHcGp61;!az73RQD zh8lB#`4Z&S33B@Z5B2j21Td^WXIO$Ofl*D6;7Y_cSD#HnZ^VI8>_y+=H@~)69vXdL zSb3>iHqpNYmb--zr_FHt1_uWE2QlQpoU#aj!I9hiyKAg)s9(WDCLPo{F|OZnhji1} z9%z0)4&zDb6LI|bT^zPqgz7-R0AsMcUE7Z{)o{X;=AVe;*h~aQno&C3Y>wyJqxtD8 zn!jzY_D&q%TGO4$9y~VRt$lFYGPh)YsG6@nf@#oWer{B2I`&k|?PW zZB$;`zopwIb=LyqkO*Ynfc`pXs4G>o;j_}omk3i$M3Vo+CGNV1{tVj4iM#NZS)smj&PTm zC2DSNVuRdzWGz;_kuH->SWnC~jUQ0#hxMe5!b$iJj>JiR1IMe5Qx3;%(i=E_2tA_{ z#WOr$aU7609-px4zz;I|=@;H=GW}VDhO;eJU)m~(2Xc0&&6*(B2L>q*Blu4I0OS1f z?A)n_u3CS3YopCt17acr{OsAOsOgQ#%+WLmAyy>kS`U#!Ttq*V$$6;PYpkY-;X}ih-&H}P0eQXv22*PDKf8w4K_yfsu?}<~V zAtbbu?>C#FK1V%PtdutP$vISy_K>`wp32 z_6QzT4!<{S50Et*U1bxC@@=kb^{(ChXMV!&?@-0;=(ft*61Y*%Y?y^vDY6=kYE`_! z&{X*>7?c{UvTVvT#B7`Y9crR!_bKoF^51a?KOSnWYnT<8;in%ehR()8?^vJT@Jdol zz2eM12IRa;W`9-Kf|e`aq=eGd>NaP=1vvu2S|-3NhSU;SCAN@)$fKv31yUwnhc z0P3y2SKkYS<=ZI(gj&~Jpmo)^>z~(ju3 z4GqTo_98*nw(A;RSEfHi_0)Huu26V*i;tlr_K$7Vp1LA!TQ;b!5H+aESYh0?VZ~HG zPp%|iZI{sg(L)&-S!$EcRS{HGYu`j_nX0UkuWBx8sRUm$#V<8OF8%g-f<-?3Ppz literal 34695 zcmb__3vgT4c_sipOfwPsfIoX+NG~~JGeg5;G|9uW8(wW&@A#-##m(Lu{6=s=sa50gZPn^hT zW4S^pQ_Sa<7RR)M#Y`eyN+k2P>||moqXh#;`uiuShZL%nGHGors2`pCx%$yiAQaMq z(PNS6V|rvvn;3ia(&JC8)-P1FOBb~j%mDMZ9F;=d0bP2;|3RCY3 z9?|+cM-Cqg&KwI&k7?&GUoeKg@UbT@f8_pS+Qmy(s_0o;#Z+cb=JT3$(o<7YV_M}L zhS{^vU})^fPgru~SS0wbzeFuK6AOoe+OfrA=Aj%rxpXuQh}-8FI;QK#BC#>;Ul+jP z{v-WoXIXI}QOW~pv}5U5|HPse32UsFJ8=rAQqu4l;-9Ik`VML|*>rYgF-ye({wcro z8D4pIp|rG^NugMeY1u?EonnhC3oMEe#N*csislrV5O5F&REgKufY^WQ1p^_r**hohzK6@0gY=Jd|6?0oRKs3rk7L zn?_fB2>un-#CZH8qU9NzU!q#Nra%x5YsT`!A+3~IE-jUCHWsK_P)iw20w^mkEG3X1 zn$c!ip>!&jE@i2^P>g?5YMPI6h{g*=HC}^~5iPyU^K`AWoW#PkP*^JkmvDe-(Kve8 zs}zn#n!YeBfj@*Hd8^(u!MYS}|B8WjUvx$@W5}-uix_1Ae zWIj>gOAdzlUM?+CNk{>SK7tZPln!)46j?KTL3~4Em=;f9m$SJgj#rCXl*25aDWGyh zD~W`zok*0jnIaz^1q5UP6pc5_X}T6%D&-4W4rNT{g{W2#SwT%mNpezngw| zTFJ`V?hCE8)tcf^Fx(0wN#+2y-+uWx6{xAT7ABPm(+d^Z~q^XeAA zT;*iBs`7eOUbjPdA7nBa;7vZvr`tVO@DI=NrPL}r)t$Mde~3Q4 zE%8}<^RP=KlZD-<8}6fp+75mlF7$LgTi|oX*Kji4PrbF&2xH~re2h1G161AhZ`t75 zjq;#TK3Xoe*en}lMKSx{vcFZXx8zb-{W|^k`_WkShDW9UQQy1 zey3Zii@tJkGs3)VR&_FXoef@ZyKa=dsIz$oUv8~BGNPvHE$miz)*o)~W5xJ8X!hmf zsM!1-vrK(sozK#*2I;*)6TN6m^x}1f|9qlyC78z5#;s4V;`%qMR~vW!;~bxk(Wh41 zd138Iz&FrJY#veI8g2TGq?o>UvtMr3vGX1^!SkN-`O2v;@4VEiKKe|HoqzPptpuS`JS|%lHxG&wUpD{2cc}b?ACP~d{7|dP9uhgrt%OXT_q6KcZ29l_ww4dJ z>V4{C{ebLu5iQrs%P1<3$-&zL<=C#mz~*AdfhNhd?b^=fssYlMKV&3D zwf>j$_8bAn0T;pXwR(uC%44@rk|00xPDnCJX__Df^xBsmdE8fWI=cN zV;E(WeT+u=7$4=^Y)lnyt>4X-W#{AdzHNyP-XwesXd>8^4RI3xCL8MM+U)vF!}Z!~ z`2jVBWPQJ!V5Q!RVd}kQnyRq~n(f>gu^XE0mVtR|ZywfKYpnwd^;3v(gI02=Ll8l)CjF(44pvXD`U0}`H{yKn5R#1QOoqf4ig zw9`Buf8!Xqbu-GmaV9t-*zeCdXs?F7V?t zp#XcVS(=+CEUB``*0z6ey?&H%p(Z})VB<``qh_Ay*LnE_mdZl3xGdr49AM3&Bs=8G z{>IH8u}bsZqSv>t_+Q!7Pgn743$@+mMd0(=b|ndMElD#5GH%m6X#H*1BgE1;ru-h8 zG(VaXcKC3(C?K&U_Gq%T{#r-hjhhe1vm-D8NJ=Myoxa+*dEjl2X5(M};itwg)hiC{ z6d~y!v>48ddyW;t8U(ha!mDnw|K3-q?Y`_S$g?4kh6}rj zV~~I%OZBD_t8`hqsWgzdQKWj>>^}9CvJ#x=V94~HI3J14VOD%jahDF+5h87MXH#*W zH-vy=h%Ba{(!5`gF^im_${9GI{7 zqYF`)4fzLTYS{0k(>KB%c!>@?k+QYzYjbSe-#5n|_(uNAOlRYt#gD+Yzn=}vec#0f zp!od8~p(Mv(J6H{+8bppJV4YyAohS zqiiI-{|=%cqI$wVp~Od_h*kaFb6(d(I2wy;XVXwP$Xrt*<3?DYnbywEp3W2*Su4U3 z^CK8Vpg}z;bYwYs6EFCyOUCQ{1Ak1dBuz?L~p?7Iqn!Bw!R+$Sfo?MWh2k zBdv$2Q*IJW!KSm6DZxMiV}|Uautd32FtWf@0khAZLk4LT&LIOabMm1;G+?YG6o9#C z&z=GyT@_d+ADo#cTL8?6Q;S8muvl6w!t4q2#|+E`x#c1ZAb?YD0R~Z63s8kjAhEDL zCxYpBt~3~q!v4a02*b3az#a?%h9Wyeppd%}493hlGZ9pQxq)n8S_~!#^CJ)tji+O> zmuXlp(($%lrs9C!2xB?&xP{XI zSqNrH14<#Ff%y@LT45WU5g5SdO*n5<3}O(-tJGPqLGRG}*y}I_LpEmiU@2Xh9&pvBn@Fm_pQG7(lap zI1n`$!U~KEAtGNA$AckYmjYanNWOhx1k4k~%nFRj*jGns07Osq1;TClh+5`E*ke|M zgTefu!*6sDh9d%GJqynkamOIWw3G&%3k%HbkvBbKKr{eWqM#dyM9nl*_0N{L|y&0%5$Tw+u>9ZOnF4_M2{e<5K_=T7bWG-`3jB78z< zG!5?h3k81G3+yjp^^f^H}}201}yV$bA+!nzgm zVJu%3gfM@}bvYxNI=RSQdm%KS)tXE*1d^Z{SqQI{?m{NA(ioFm5ZzbQDhMtkr%Ljl znUAeg@C|}LtF-iF5$%S=r*fyYPj+{80=2ZVm^t)GaD0%nsIHCWS1(@Bu3WmL)i1%{ zdgYS#*rm&lpSuDNE2NiTfd7MMQIK1USSbCAI2<|hBSDJEr^(H{SSr#ts4#s|lAJt3 z!o&ymj=Qd~C9^1;ArIlAa3RHbnjC;&6SIqq>XAorndBLAHSu3Km!dknNVBsfx594* zkSB_zqipu5*i#H7T!|PaRZ3!th9pD2CIueyHIawwi01jmpv%>z)F9tq4kWn_0u!M7 zu6S11p;qE^e{v=#)VJQVBJqY7=J=Pmv5Gg4hVt5*Ugb*B9Ddw{K^T919v_T{ z+K;hIPaSXoY6O51u0A_-)~c1t>i#~0s@!^sLmoDG1Fhl-K7^O=APkHjUH_3vuB`u+ zoJHf-Ju0)W*0|+kBWzgCY=rqWnH+<4cC2yhVb=uFSV#vYEef$yBtTS^bRQ)RL8>lM zkQy@$P0XSZM5YZ*61qU92qlY%BvcH@j|HJHg%A-C)X+$sY#s6gsVkDi=^#62)0upx zlp&o1JX0D=S~io%xrHKPj0E}2(pM1F$LK2vMq>08 z1pOz1BKitKpyhpm-itm#sim@vA}B+0>PPlZ5Ia#vKLXjnNJB0Ko#e|G3v?Cz|0Xaf~W!_ofJiKnQP>CEnI-GcG@SZ_`1q zqk{p};)Z`fcKya-IKekmSADnXs?X7tnhQ$2t!zaYuAgnqXE-UWdPPR_;f@7#i?4S7 z7T8!vNw2@JrQqq=-55_}Qun4|r%ZFQyKx{>+xd0|rpMpO@Qmg&Rj(SgS?lbpJNG~N zzZ>>J`iz2(!H&>iYEekP%QDw2HBVWZPgC;{nr|K!Yvcg| z&Aa8|hvhNz+}!OBLSkHg2dNUG_JZoFzWjmW8(WXBGf5`ipKeM|rjSK`l%nPh@ zF+XA*=-~F-viQ+W!zTp8^7?-|fa!f3v)k-mAL2uOt?ESCLd9muJh!8=DGS)P3oehXJ&E?fPW!{ZfJ8SV}S^*r%vw_0G7Tq~3<6iCNVX;VCheYn2Svmx_LN&lNFS%jRk#Dp zC|Z~O|!MKF02-oESryz^mtN^o-3>ii!Y(AUeSPJcaT1%ZQuAqO&_-P1= zWC-Aao|FZPSeggo8aY@(dNG%0rDT#O4R}cV8FzFb1FOjA;9jCbfKMDmd`jsL+RCzF zYCuS|a7B>#2?rhr0%k+esb~phq%%MoS_xb~JX{x(Ad?0~zou1v3n{^{2p=YQ46i2P z$W0d_8%crFokC>KH^*VR5PV;7EQFr6`;wcz@wO3biY(5b;%yN{({{z%i}7|b(VpP> zGOW<|&v*O0Ly7jm<_LbYU5U19JJH?;=Y54u?0%!gCO$)-nhIm^)7^Ij*Q6iDpjaeszT!9QeI8O z%1Hh`RGuWMp?jE3k{B>4#enXn7$LZ%^E$^se;Ux)M9T8?T~Hg4<16 ziFS9Q?ahnmBFW7I<&pLz%phz;F!F9lLo)sP7&+lZ{_BTe+sH~@kD!l1nG`Fa0MwDT z7Xg*{HCWbQJrU)-&37TR!1xmJUUC9+ZBK1YZBV=0NcA#5Cb|`GKZswx35^BV6ou3M zBU3R1EN~tFF^f3jX5>VSJcPK$D+sCGc@{A?upNXNo^M`s|N2hzqFf4#G5^ZC z&jtYyX(v*vW1;K#?^vVk&9bxuHDh6NNxbXwgAGp$`#R{3w)O}AQDSOfS3_JEh;n{qBijTA& zwRUv3QQPQXs55In-w_IaPTwfcHf~)!aNt10eLte>VC_O&DdOvpxSJrvv-&qjF5bG8 zXR+E^U7P?BOVDub^tfS|`sG41ZJoipSR9od>u9+C;~oWKG7Z;@w4~<{6U&!`aBWME zzb)Ds>-m`FTeM%lU>VTAU6oirrnWuKq0GCcsIYjRf5+QXh|hfBt^osQT=Kwo^u~;C zuz5Giu@(yeZ3B&)?=TTol9)Xa_W;q3T#cXqaW>9}=0EoH2`N(7o_s!zbk3j!np7~G z_ksRUdr!UBLV+&6_@baeQtf>CHq~z3lGXO=M3ON`|3Mv+TXH^`D<$)YWzfOO%&#y! zeU>lqU@4?8B#QG>FgW1u3nLF8IG9;46eBAVxkGU)CpWty7!;xzRG0+0fEU<9nGyr1 z1ACM)4sbam4uSJ9n9-z<5gr5)Nde!a(FiU`s=5NBe6GZ25QH5}bVFt>IZLdFEOT%h zz|yt=mI!%*3~I=jhEWnd@CXiB2h(%3Bc~OQ%OD4wOhHw#_B8_m9s@09A%$o&WHc0O zSA)kO&0FioAggu`9fLT{`zGy6Bp|9;+f2h!Mza*xd8Wz5O0G1D`G`W|FJ|%*oMdcO zFcjuR`!?v%d(8S2*uzH*LrGE%!w^4Ye<8RPt+%*BP`Z@P7DDKcx#_SuqCJTzi?CZ2 zGbi}Ah|m%QP{5d#5IbdYU12+f;1Q%1aX3S)LN`Llf@{eh782A^vzURa5s?Y_5YBZ3 zj^Kmb=?NZ?qhpImzvB5}n248f!6ywggjR8;0nF8MwOhEL+{DczAS0a=*LH}h|y8?wf2JMTK<^!=EAOX@#&A+9Cn!5lxDZ6q( z;1C+hT8Cz59DJ_UVSi5+5k8|xgG5k4*;BZ`dIZ}JMCK6>#gmH&@yXNv*0GLW-(q*F z(mo#l;m$YXKjdp~NegNqE-s^-NzQLA*APaYe6qHZsbmo+nmt{~?Y&pTd2{@c>^q z#AFu&dqOk_WzOd5x;MlkzB7~*XrdaxQkPo>-$hjvLdf90IB~TalSmcMii_3LNW)1< zSG%JcTNWwe;c6lj??dq zQ-=x?KEISL4izRsh(JLsblwCSnD%KpY{tP75(FU#A;2My0YHRVGP?;3M)ORH1UJQS$r6N6o*_nmc^L{|rYo z=+l27`h8;=aW5~^6|isQ_^;niS65Y^!pM?I3$mH1%4=MiQ$p#K)x7feKu#r8f$!wK zY^wZVi#26!VL)St=D0&x)LQob_6mpZ&81m2!IDK>f z0X1ONi#mGw7}e3;_|0@rS;s}zuI68`2fLbECkCO2zlTL7%;v~cF)C-{m)hZP;2Opk zIFxppDR!*+0bBX=>Y7H|weA=7o@K|xX1JcLRaumS!{a8a#Ot=k==?$1`O7`*xcl_x zl&s;BbAmx@<33y7VdQ;k?wR$E^HJ9SL{zQ%0kmlC_9HZPjL>|qt-_Zv1^2IsiT?&F zJjHih%zxjf>-&BntYwW`C(?2$XyBn;I__z_wE|IwxR^r9(v+a#Q^0h33?d5QdWo~3 zQ(6QpZ7Iu6=F=$9>F_)Bm=HzIle$HxBS?y(@d5SgELxx9B?zoM3rfJ#WU%H+u%LHS z7>*7c+yrNrR+f?{XBUaW!xKaY+oaZ71R8)a{64(jwp&vI4h$Qw0cS zmI@$LicdwLRNDs7v0hcIL+Cae>d=pj60Fiv0%=!_Ng5-clnz>Kso->%h2gvrZAb;P zO(G14@@~Rdq}fdvZUxzfoNcuDFbw{d3ZVRIia}^5W=W9rJVkvVvs)n&q?k&x4BW)> zh2R&}qf|lY^wf=Dsxrv?M~0H@JB3=!%$Z`sMNe-=S_-EnTPKJTjVb0vuA1JY$b zm@pm!81jX>vzuMN+V%D9tJSBn?pL#(@8mYSLC3zHd#(CZ&iz`>^GZBFmrM!y=1lXC zmHT==UY$!x%j5brh?d-8oXh8>Oa=v`|qhakf5T`Ro0F!$q)5$Q;n;u~=WhSwM8 z5X`XtS95Dy;suY>xwY-xjd-Fu#|hq9zEeqPJ;G0rL{Ohd#UV|Kt;<8;%%67&S~CNJ8S6LDH1l zPr{l+R|?po@+BE%NReLRREr>B+@65wCwm~2f=z{sdjhS1RrCfCB8bgniwH38WkVVC zMW{wJM-n*g>J79<-Z5d|3W5O_EtFLVEu7RdlLRH9f>+$& z{?q*0)+@Z3=K-GMSyNGAB-n&ucrVl>1SjP0aihjIpA!Ee?dYw!3LHh^9Tq+`++r!U zHUg!58lyc@!&E&JvS@gofb97h@tLe*R{W4ZjDxzc%-27MQ!PNFx>JB6SJ|E=1KWVP zC_#s~Ql35CaQ}gT=I|?OLr1^UxaHz-zS?-}e8dYJoM~3@}!C9poAf%NMx{~9J6f=doVH{s04F{f)=5`jPO4rp_s-JbgLYgDzt6X?H?@A@N@n)JYtlpd(_1%Zq<;~&& z*?uIQOci7xkj&DYSqGh2V`kQY#;sqH;t##(BO{}S@LExl4evJ3vytTP#zayTjO=c_ zOQ!KWl&d9%U4w|+Kx~g_ErmSy0XEF&B{qnfeYa`j`ada#F5fSU*+^mg)ipTd=AK;h zBaBP*$A$~r^!Shbl2b%g|4762dw6SW_r(4CvmXs-ORAT&By{9+IgA{UXulY4aJjvO-4a+ zP^}rQM$1Eux8BF0&b;L3_(PE%gzUJ!0mYMi=)&#+#UE}M*i2w>hcV5O33PX4QfRup zBIuGKVw}VUGAU+6oSZ-6^lj#gF5aNCGCve4kEV2 zHWb}aQ!@!#m;@w7BcI0@3C`mbH>A^gi9c8ienvu}A&VMRHAlmmR8_24P*3h`5(^@_ z7!zJ6c^jK6^d=1^vM4C6aEd4!lJKKhoGVc8L2&n^qjI%JH1`wmR`duvj-aGJ3)ipl z9II6D2M|gt&2&S))H@dF!ppsGM2HsX=1bR$1q6OpKUZ+$SHbf=Hn4eAJ@<4lo=kCn zh-|K@?}SQ_b7BDJAI^yZH_?Fs4=$}Bq_RD-dzB4-76}~g%{vx653hfLA8H)>_RyK+ z?lWv?KDFf^TK`0nRPknz-W2oiY`ll(Qmuoi(mu#Z1smeO#59PwuBTBpl7zBzx3g>l zWy5FFD7=>qapKz?a@4}BeY_g__*y!@yK%p&3i6l7#E8D~5x#|qwMUSHtG7dqTOp7m z=mI7|fuoX>BODt?CcSH8P##ec2t~Ic6~@x5Jx1D!$6MIlfu6}b>nB0DI#WyC5Gxo>k8k!Qgw#?oD2 zgVTuMM8wS?G|W_Q$-&%F1(82wE0qFaP})f8Aq)fLP>U1-K$26Uql!f_l?xe=!b6D^ z3MkQ#ly58mc7Htd&i%%O3p`KmH-tlw+oi>2T=o!mNlzhIk5eUy1|;7J%4qQz01ZfC zlI^hdxo)?L@^25m`~jcWmE7!;{)FzTh=s0koJewdQ}W%{#Xq^tiT~gpz1DcI8yf%` zPT0w3Do|G=&3Xa0R7?{Ll{?u?Y=?Jnynt%u3C9*gTW9Ihivq8|>p-#(yYNr`TgLiZsryJiog9 zOfp{g_BIhEb@}UYvGLOY4qX7t<-_+m*~DGp7C^jFJJp(=Q84O2XBTm=I^t@K8ZuIn1S=gTJCz@{ za4`z8C5$#H7an0SHU6;kHf0!GSdANookh)!9%wK|u#85pN2&TDm@&jWL%3?EYKI^) z8)+PWBkff9LryCW9tgCr0B>$NvYb*o1pwQY9)wNOV*4QdM@@#*9<_`hz)kr)bQz+r zy%&qE&T@%#4+Eh?ez%x#pefn(Ic^gE^c`U#ZV9Ze{On7U?Vgqp$h@i+RC_3$55`zdwO$6#( zpBZkaI4C^Cl8_5p&AF%uC&P8XQ;1}z(6Rs&0vBR z#P=j9YRUbI0+9SYxt-X2uS_3a+wu*1lDyuzoPwbIy>Dy#bZz$~8CZyrpZ}(4=A>*s zVPq&8Ke3fny{J0dMt3HilC&(D^Le^KJY7Gua1F4Q8+l1K_idk5-Q3)LA^(b^re8DXYq4|MAp}0zrX7-UvW11v4HSDVr!^c;EgH}wH+b)72!- z5Ygow5a*D%1Z6hD@b*3}`)5`A;H^+Y;hk2Mbnc+jAcKk7#;{uBO^#`@j1Jm|Xf{sG zEwJS(B!5$o}};#%Pyqe;7YU{38kT54=jMb1hyyF~C^>%vomjo4d_J%rA5WgfyxC(aW>UFSO0|VU=o$ zSkmP85lTYWrpY|MivZDB~=~4@|Zux2Wq%}D{C36t^!U*Q;JdV+o~-<2N6R}h+q4j zRkP22enBRUvBftHEmN|B7&s}$T|a!n+q_?v44v@qZVWrx`8~|bTy~;Fou+ipuc7nPsynW@K?P_5(eox^0${t zBM_Zc=z$Jz$a@_S#%5g zrf2AElhK{(9=&&MujN#{bf-t1?sD21hMjDhZVcLM!M~s!#9`E7~8NRrwSNyN?i1$vAv-aLLsNb6|w|9hj1y?*2!K^&p0O(+~Wlr=Y(*l*5n9y z=GZZoGd{-|p0fv9IwtJ|JC3h?VRk@U1sGerungyf;MKwTU;~A=C^b5O(PY(7uFc3# z%atLn^vZZCFkFOznja?TM2UrU;>+Zn_y7zotR7Ibe!)O!a(+k;2J4r%Zn=929w$=_ zAi#8p0rbc^{iy~i21Ix~DC7Y$hwzKnWSt~nlJg3ZAZ)!9G7jAq{M{0J8n%aw8@>S2 zS8pFZ-nDNSI;&yu_1)*ma4Ghd`rKXBEYI+{yYn7*-h)4cwdH%^F3AZzc-%xL zV|bv%tZ{A#Y5a}1Rs2bh^rlbNk30v$cd+q=?egK;Zu6eFEI&A3H5MQ_^@3tjkT&j-)rQ#A?r+HlABa0u&#eEZC=w#g zQKO!mA*2&XB^y!MraioZuZbK2P)Fxq4%KA!k=^E)Opcye7k}lc`Iqx$*~usr(dhif zCp)Z~(y9(H8WVLYqxiE~81Fr7w5RJCHp=<%#y!SD9lP|qNi$2{4yIt>s#i|#V0l=8 z*L97_6cz}#Ac6X(F^`*Y{tW_B(C`0dp%d=1BiBy`KO2;FhgEZx8Y|j;c0Qiu zGSYf1zA&G}6DbGrht@Ennv_?VDb7@yQh1QFl#_oLov^{(jU!?NE@to|9{D`47D-^A zERV0>pKAVZIhWDq5BbWPf6m<%%|EG@hs)!iX5-Jq5k11^#D*cDOv8fv69g07OPc+d{aV1QH~B=5P}>d@*Ls`nS2e$l!}tj zbU4iS$c3VB@0&~#>H!EHyir*(@YwEN7pM5meEFUrajw0V5HiIvV+nNS{&q`%IJd_Q ztlFa{7>2ln~W~SfhFLB14txAQ+Iet8Sqf%YLdzbPCQ`H z;>#r2OTllirvaT(VECtuQL&2zxc}n-e8?FG7;?(O6pd&DkTqgC=(JGL%lEbx^c1u` z%Q+Oi%xAjs@%oGb9E-0aYMN}EGn2tWbSvC=580wXNa+W!h$ssKG4NytVuGL_q^?WZ z2bLV2-ba?PBnN$NX@|#sbin`<{!vkgJ4M;bGn`Py{iApqfEz@dw|SfvLFWcLO@wwN zx2}y~3f&35U(+Zh4H5>J$R_nZJbvMkY}*Wp8SBEWj(>xg!&eb=XuYlWUAnFIUEEfi zOYAiN0xw?h1zAjU2HILD!(Th187<)<1hULXaAWJq5gZZGK@<@LIqeW~c%&o*E)^O? zn~}oxvJRt(>(}mpex%-kx^B5eNJ^G>b>v#>;5~#2E z17JaFtsT$z*keG_Udu_DBo)HT?qS^=?;CIou~eR7$0l6#nEH|AS{-v^Xm6Gb3{ekrlL)pb1WexzS^W4#X} zTM^{NlM_mi;eWA?8+khN<>OzsUv9s--bw9!@6*N>&OKVCKYg-#v2x*w3;1#IiuO^w zs=s>aqIT&qwGi3w7&^xLU`700gN58tA?m3iB^3HaZmQV%2#d(IJbNNC1Sd9U4i+147bfV2ud(8}&i|}{Z+R_6^|P1F zO;$Gz2Kxu8{k z?uq*9qvx(%(0;yp?uvHqi6<_cyZjLi`_1=+-f4Y6JCO%H%Rhuyc(lhaee^;Fe-WqO zg7Vbo1TUSCJBwq~@yE#~=zajbE~HJ2>A?r|(3r-5hsE!R`mKxaY5eY|3ixYeA_srb zOC^Fb5t>FKyL$QD13G1i6x9+bYA8}hy@*jS7(m5-Q4V91sv6XdR=BcZ;V6^-lHyaco&nYm4B|!07 n9Hu~k3(1}=TW9Ii`iJ8z+2&Z71^)F5LPuoIvfcdkaplan>local>medley3.5>working-medley>library>tedit>TEDIT-SELECTION.;1 144823 +(FILECREATED " 5-Mar-2024 15:07:12" {WMEDLEY}tedit>TEDIT-SELECTION.;426 125601 - :PREVIOUS-DATE "14-Jul-2022 11:08:01" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-SELECTION.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.UPDATE.SEL) + + :PREVIOUS-DATE " 4-Mar-2024 22:48:20" {WMEDLEY}tedit>TEDIT-SELECTION.;425) (PRETTYCOMPRINT TEDIT-SELECTIONCOMS) (RPAQQ TEDIT-SELECTIONCOMS - ((FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS TEDIT.SEL.AS.STRING TEDIT.SELECTED.PIECES \TEDIT.FIND.FIRST.LINE \TEDIT.FIND.LAST.LINE - \TEDIT.FIND.OVERLAPPING.LINE \TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START - \TEDIT.WORD.BOUND) + ((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS SELECTION SELPIECES) + (CONSTANTS (COPYSELSHADE 30583) + (COPYLOOKSSELSHADE 30583) + (EDITMOVESHADE -1) + (EDITGRAY 32800)) + (MACROS WITHINLINEP LINESELECTEDP) + (MACROS GETSEL SETSEL FGETSEL FSETSEL) + (GLOBALVARS TEDIT.EXTEND.PENDING.DELETE) + (GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION + TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION + TEDIT.DELETESELECTION) + (I.S.OPRS inselpieces))) + (INITRECORDS SELECTION SELPIECES) + (FNS \TEDIT.SELECTION.DEFPRINT) + (FNS \TEDIT.SET.GLOBAL.SELECTIONS) + (P (\TEDIT.SET.GLOBAL.SELECTIONS)) + (FNS TEDIT.SEL.AS.STRING TEDIT.SEL.AS.SEXPR TEDIT.SELECTALL TEDIT.SELECTED.PIECES + \TEDIT.FIND.PROTECTED.END \TEDIT.FIND.PROTECTED.START \TEDIT.WORD.BOUND) (INITVARS (TEDIT.EXTEND.PENDING.DELETE T)) - (FNS \CREATE.TEDIT.SELECTION \CREATE.TEDIT.SHIFTEDSELECTION \CREATE.TEDIT.MOVESELECTION - \CREATE.TEDIT.DELETESELECTION) - (* ; - "Added by yabu.fx, for LOADUP without DWIM.") - (VARS (TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) - (* ; - "Original was %"(create SELECTION)%".") - (TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) - (* ; - "Original was %"(create SELECTION)%".") - (TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - (* ; - "Original was %"(create SELECTION HASCARET _ NIL)%".") - (TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - (* ; - "Original was %"(create SELECTION HASCARET _ NIL)%".") - (TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) - (* ; - "Original was %"(CREATE SELECTION HASCARET _ NIL HOWHEIGHT _ 32767)%".") - (TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) - (* ; - "Original was %"(CREATE SELECTION HOW _ BLACKSHADE HASCARET _ NIL HOWHEIGHT _ 32767)%".") - (* ; - "Changed by yabu.fx, for LOADUP without DWIM.") - (TEDIT.SELPENDING NIL)) - (GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION - TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING - TEDIT.EXTEND.PENDING.DELETE) + (* ; "Setting for a %"Laurel%" mode") (COMS (* ; "Selection manipulating code") - (FNS TEDIT.EXTEND.SEL TEDIT.SELECT TEDIT.SCAN.LINE TEDIT.SELECT.LINE.SCANNER - \TEDIT.SELECT.CHARACTER) - (FNS \FIXSEL \TEDIT.FIXDELSEL \TEDIT.FIXINSSEL \TEDIT.FIXSELS) + (FNS \TEDIT.EXTEND.SEL \TEDIT.SELECT \TEDIT.SCAN.LINE \TEDIT.SCAN.LINE.WORD + \TEDIT.SELECT.LINE.SCANNER \TEDIT.SELECT.OBJECT) + (FNS \FIXSEL \TEDIT.CHTOX \TEDIT.COLLECTSELS \TEDIT.SELECTION.UNSET) (FNS TEDIT.RESET.EXTEND.PENDING.DELETE \TEDIT.SET.SEL.LOOKS) - (FNS \SHOWSEL \SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL \TEDIT.SHOWSELS - \TEDIT.REFRESH.SHOWSEL) + (FNS \SHOWSEL \TEDIT.SHOWSEL.HILIGHT \TEDIT.UPDATE.SHOWSEL \TEDIT.REFRESH.SHOWSEL + \TEDIT.UPDATE.SEL \TEDIT.SEL.L1 \TEDIT.SEL.LN \TEDIT.SEL.DELETEDCHARS) (FNS \COPYSEL \TEDIT.SEL.CHANGED?)) - (COMS - (* ;; "User entries to the selection code") + + (* ;; "User entries to the selection code") - (FNS TEDIT.GETPOINT TEDIT.GETSEL TEDIT.MAKESEL TEDIT.SCANSEL TEDIT.SET.SEL.LOOKS - TEDIT.SETSEL TEDIT.SHOWSEL)))) + (FNS TEDIT.GETPOINT TEDIT.GETSEL TEDIT.GETSEL.PARA TEDIT.MAKESEL TEDIT.SCANSEL + TEDIT.SET.SEL.LOOKS TEDIT.SETSEL TEDIT.SHOWSEL) + + (* ;; "SELPIECES") -(FILESLOAD TEDIT-DCL) + (FNS \SELPIECES \SELPIECES.COPY \SELPIECES.CONCAT \SELPIECES.CHARTRANSFORM + \SELPIECES.FROM.STRING \SELPIECES.TO.STRING))) (DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(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)).") -(CONSTANTS (\SCRATCHLEN 64)) + (* ;; "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 (* ; "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 (* ; + "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) (* ; + "T if there should be a caret for this selection") + SELOBJ (* ; + "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 '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 _ 'LEFT L1 _ + (LIST NIL) + LN _ (LIST NIL)) + +(DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR)) ) +(/DECLAREDATATYPE 'SELECTION + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG + FULLXPOINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER) + '((SELECTION 0 POINTER) + (SELECTION 2 POINTER) + (SELECTION 4 POINTER) + (SELECTION 6 POINTER) + (SELECTION 8 POINTER) + (SELECTION 10 POINTER) + (SELECTION 12 POINTER) + (SELECTION 14 POINTER) + (SELECTION 16 POINTER) + (SELECTION 18 POINTER) + (SELECTION 20 POINTER) + (SELECTION 20 (FLAGBITS . 0)) + (SELECTION 22 FULLXPOINTER) + (SELECTION 24 POINTER) + (SELECTION 26 POINTER) + (SELECTION 28 POINTER) + (SELECTION 28 (FLAGBITS . 0)) + (SELECTION 30 POINTER) + (SELECTION 30 (FLAGBITS . 0)) + (SELECTION 32 POINTER)) + '34) -(FILESLOAD (LOADCOMP) - TEDIT-DCL) +(DEFPRINT 'SELECTION (FUNCTION \TEDIT.SELECTION.DEFPRINT)) + +(/DECLAREDATATYPE 'SELPIECES '(POINTER POINTER POINTER POINTER POINTER) + '((SELPIECES 0 POINTER) + (SELPIECES 2 POINTER) + (SELPIECES 4 POINTER) + (SELPIECES 6 POINTER) + (SELPIECES 8 POINTER)) + '10) +(DECLARE%: EVAL@COMPILE + +(RPAQQ COPYSELSHADE 30583) + +(RPAQQ COPYLOOKSSELSHADE 30583) + +(RPAQQ EDITMOVESHADE -1) + +(RPAQQ EDITGRAY 32800) + + +(CONSTANTS (COPYSELSHADE 30583) + (COPYLOOKSSELSHADE 30583) + (EDITMOVESHADE -1) + (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)) + LINE))) + +(PUTPROPS LINESELECTEDP MACRO [OPENLAMBDA (L CH# CHLIM) + (AND (IGEQ CHLIM (GETLD L LCHAR1)) + (ILEQ CH# (FGETLD L LCHARLIM]) +) +(DECLARE%: EVAL@COMPILE + +(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))) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(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") + +) + +(/DECLAREDATATYPE 'SELECTION + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG + FULLXPOINTER POINTER POINTER POINTER FLAG POINTER FLAG POINTER) + '((SELECTION 0 POINTER) + (SELECTION 2 POINTER) + (SELECTION 4 POINTER) + (SELECTION 6 POINTER) + (SELECTION 8 POINTER) + (SELECTION 10 POINTER) + (SELECTION 12 POINTER) + (SELECTION 14 POINTER) + (SELECTION 16 POINTER) + (SELECTION 18 POINTER) + (SELECTION 20 POINTER) + (SELECTION 20 (FLAGBITS . 0)) + (SELECTION 22 FULLXPOINTER) + (SELECTION 24 POINTER) + (SELECTION 26 POINTER) + (SELECTION 28 POINTER) + (SELECTION 28 (FLAGBITS . 0)) + (SELECTION 30 POINTER) + (SELECTION 30 (FLAGBITS . 0)) + (SELECTION 32 POINTER)) + '34) + +(DEFPRINT 'SELECTION (FUNCTION \TEDIT.SELECTION.DEFPRINT)) + +(/DECLAREDATATYPE 'SELPIECES '(POINTER POINTER POINTER POINTER POINTER) + '((SELPIECES 0 POINTER) + (SELPIECES 2 POINTER) + (SELPIECES 4 POINTER) + (SELPIECES 6 POINTER) + (SELPIECES 8 POINTER)) + '10) +(DEFINEQ + +(\TEDIT.SELECTION.DEFPRINT + [LAMBDA (SEL STREAM) (* ; "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)) + 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 INFO (if (GETSEL SEL SET) + then (CONCAT (GETSEL SEL CH#) + "-" + (GETSEL SEL DCH) + "-" + (NTHCHAR (GETSEL SEL POINT) + 1) + " " + (CL:IF (EQ (GETSEL SEL HOWHEIGHT) + 1) + "_" + (CHARACTER 127))) + else "unset")) + (SETQ LOC (LOC SEL)) + (CONS (CONCAT "{S:" (OR WHICH "?") + " " INFO " " (CAR LOC) + "/" + (CDR LOC) + "}"]) ) (DEFINEQ +(\TEDIT.SET.GLOBAL.SELECTIONS + [LAMBDA (SELOPERATION SOURCESEL) (* ; "Edited 12-Feb-2024 08:15 by rmk") + + (* ;; "This sets the documented global selections (TEDIT.*SELECTION), and some that are not documented (COPYLOOKS, DELETE).") + + (* ;; "SELOPERATION is NIL on loadup, for initialization. Otherwise, SELOPERATION determines which variable is set to a copy of SOURCESEL.") + + (SELECTQ SELOPERATION + ((NORMAL PENDINGDEL) + (SETQ TEDIT.SELECTION (\COPYSEL SOURCESEL))) + (COPY (SETQ TEDIT.SHIFTEDSELECTION (\COPYSEL SOURCESEL))) + (MOVE (SETQ TEDIT.MOVESELECTION (\COPYSEL SOURCESEL))) + (COPYLOOKS (SETQ TEDIT.COPYLOOKSSELECTION (\COPYSEL SOURCESEL))) + (DELETE (SETQ TEDIT.DELETESELECTION (\COPYSEL SOURCESEL))) + (NIL (for S in '(TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.COPYLOOKSSELECTION + TEDIT.MOVESELECTION TEDIT.DELETESELECTION) unless (BOUNDP S) + do (SETATOMVAL S (create SELECTION)))) + (SHOULDNT]) +) + +(\TEDIT.SET.GLOBAL.SELECTIONS) +(DEFINEQ + (TEDIT.SEL.AS.STRING - [LAMBDA (STREAM SEL) (* ; "Edited 22-Apr-93 16:44 by jds") + [LAMBDA (TSTREAM SEL) (* ; "Edited 27-Jan-2024 22:57 by rmk") + (* ; "Edited 23-May-2023 12:36 by rmk") + (* ; "Edited 8-Sep-2022 23:35 by rmk") + (* ; "Edited 22-Apr-93 16:44 by jds") + + (* ;; "RMK: WHAT IF THE STREAM CONTAINS AN OBJECT?") (* ;;  "Given a text stream, go to the TEXTOBJ, get the current selection, and return it as a string.") - (SETQ STREAM (TEXTSTREAM STREAM)) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - LEN TSEL RESULT OFFST BASE) - (SETQ TSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (SETQ LEN (fetch (SELECTION DCH) of TSEL)) - (COND - ((ZEROP LEN) (* ; + (SETQ TSTREAM (TEXTSTREAM TSTREAM)) + (CL:UNLESS SEL + (SETQ SEL (GETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + SEL))) + (LET (RESULT (LEN (GETSEL SEL DCH))) + (COND + ((ZEROP LEN) (* ;  "There is no selection, or it's zero-width. Return ''") - (RETURN "")) - (T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE))) + (CONCAT "")) + (T (SETQ RESULT (ALLOCSTRING LEN (CHARCODE SPACE))) (* ; "The resulting string") - (\SETUPGETCH (fetch (SELECTION CH#) of TSEL) - TEXTOBJ) (* ; + (\TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL CH#))) + (* ;  "Starting point for the string is start of selection.") - (for I from 1 to LEN do (* ; - "Get chars from the stream, and put them in the string.") - (RPLCHARCODE RESULT I (\GETCH TEXTOBJ))) - (RETURN RESULT]) + (for I from 1 to LEN do (RPLCHARCODE RESULT I (BIN TSTREAM))) + RESULT]) + +(TEDIT.SEL.AS.SEXPR + [LAMBDA (TSTREAM SEL RDTBL FLG) (* ; "Edited 25-Dec-2023 18:52 by rmk") + (* ; "Edited 9-Jul-2023 09:37 by rmk") + (* ; "Edited 22-Apr-93 16:44 by jds") + + (* ;; "Return an s-expression from the characters defined by SEL's point position.") + + (* ;; "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)) + [\TEXTSETFILEPTR TSTREAM (SUB1 (\TEDIT.WORD.FIRST (TEXTOBJ TSTREAM) + (TEDIT.GETPOINT TSTREAM SEL) + (TEDIT.ATOMBOUND.READTABLE (OR RDTBL *READTABLE*] + (READ TSTREAM RDTBL FLG]) + +(TEDIT.SELECTALL + [LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 14-Jun-2023 16:58 by rmk") + (* ; "Edited 3-May-2020 17:29 by rmk:") + (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (TEXTLEN (TEXTOBJ TEXTSTREAM))) + 'LEFT]) (TEDIT.SELECTED.PIECES - [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 20-Apr-93 17:06 by jds") + [LAMBDA (TEXTOBJ SEL CROSSCOPY PIECEMAPFN FNARG1 FNARG2) (* ; "Edited 28-Nov-2023 23:14 by rmk") + (* ; "Edited 21-Jun-2023 20:30 by rmk") + (* ; "Edited 9-May-2023 13:16 by rmk") + (* ; "Edited 11-Apr-2023 12:07 by rmk") + (* ; "Edited 20-Apr-93 17:06 by jds") - (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result as the copy of the piece") + (* ;; "Create a list of pieces corresponding to the selection; if FNARG, apply it to each piece, and use the result instead of the piece") - (PROG ((CH1 (fetch (SELECTION CH#) of SEL)) - (CHLIM (fetch (SELECTION CHLIM) of SEL)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (INSERTPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - LEN INSPC INSPC# PC NPC (PCCH 1) - NPCCH OPLEN EVENT REPLACING INSERTCH# PCLST OBJ COPYFN UNDOCHAIN NODE) - (* ; "Find the insertion point") - (AND (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (RETURN NIL)) - (SETQ PCLST (TCONC NIL)) - (first (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) while PC for I from 1 - do - (* ;; "Gather a list of pieces to be copied") - - (SETQ NODE PC) - [COND - ((IGEQ PCCH CHLIM) (* ; - "We've passed beyond the copy region. Bail out.") - (RETURN)) - ((ILEQ (SETQ NPCCH (IPLUS PCCH (fetch (PIECE PLEN) of PC))) - CH1) (* ; - "The current piece isn't inside the region to be copied.") - ) - (T (* ; - "This piece overlaps the copy-source region of the document") - (* ; "Add it to the copy list.") - (COND - ((ILESSP PCCH CH1) (* ; - "The piece overlaps the bottom of the copy region: Chop off its front part.") - (COND - ((EQ PC INSERTPC) - - (* ;; - "We're splitting the insertion piece. Never let the underlying string be touched again.") - - (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with NIL))) - (SETQ PC (\SPLITPIECE PC (- CH1 PCCH) - TEXTOBJ I)) - (SETQ PCCH CH1))) - (COND - ((ILESSP CHLIM NPCCH) (* ; - "This piece overlaps the end of the copy region. Shorten it at the end.") - (\SPLITPIECE PC (- CHLIM PCCH) - TEXTOBJ I))) - (TCONC PCLST (SETQ NPC (COND - (PIECEMAPFN (APPLY* PIECEMAPFN PC TEXTOBJ FNARG1 - FNARG2)) - (T PC] - (add PCCH (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - (RETURN (CDAR PCLST]) - -(\TEDIT.FIND.FIRST.LINE - [LAMBDA (TEXTOBJ WHEIGHT CH# WINDOW) (* ; "Edited 30-May-91 23:02 by jds") - (* Find the first line to be - displayed, given that it must include - character CH#) - (PROG ((LINES (OR (AND WINDOW (WINDOWPROP WINDOW 'LINES)) - (fetch (TEXTOBJ LINES) of TEXTOBJ))) - (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - (TEXTSTREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - LINE CHNO CH) - [COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) (* If there's no text, force an empty - line) - (SETQ CHNO 1) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with NIL) - (RETURN LINES)) - ((IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* If there's no text on the screen, - just return nil) - (RETURN NIL)) - [(fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) (* For a para-formatted object, back - up to the prior para bound.) - (SETQ CHNO (CAR (\TEDIT.PARABOUNDS TEXTOBJ CH#] - (T (* Otherwise, move back thru the text - until we find a for-sure line break) - (\SETUPGETCH CH# TEXTOBJ) - (SETQ CH 0) - (for old CHNO from (SUB1 CH#) to 2 by -1 repeatwhile (NOT (EQ CH (CHARCODE CR))) - do (SETQ CH (\BACKBIN TEXTSTREAM))) - (SETQ CHNO (COND - ((ILEQ CHNO 1) (* If we moved back to start-of-file, - move forward from there;) - 1) - ((IEQP CHNO CH#) (* If we landed on a CR first shot, - let's try moving forward from there.) - CH#) - (T (* Else, skip the CR we passed over) - (ADD1 CHNO] - (SETQ CH# (IMIN CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - [repeatwhile (ILEQ CHNO CH#) do - - (* Starting from the known line break, move forward until we find the line which - has the right CH# in it) - - (SETQ LINE (\FORMATLINE TEXTOBJ NIL CHNO)) - (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with LINE) - (replace (LINEDESCRIPTOR PREVLINE) of LINE with LINES) - (SETQ LINES LINE) - (SETQ CHNO (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE] - (RETURN LINE]) - -(\TEDIT.FIND.LAST.LINE - [LAMBDA (TEXTOBJ LINES) (* ; "Edited 30-May-91 23:02 by jds") - - (* Among the line descriptors in LINES, find the last one on the screen; - then return it.) - - (OR LINES (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ))) - (* Make sure a list of line - descriptors is specified.) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) (* If there's no window, return NIL.) - (bind (OLINE _ LINES) - (LINE _ LINES) - (CURY _ (fetch (LINEDESCRIPTOR YBOT) of LINES)) - while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Find the lowest line above screen - bottom, and put it in OLINE.) - (SETQ OLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) finally (RETURN OLINE))) - (T NIL]) - -(\TEDIT.FIND.OVERLAPPING.LINE - [LAMBDA (LINES Y) (* ; "Edited 30-May-91 22:57 by jds") - (while LINES do (COND - ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - Y) - (RETURN LINES)) - (T (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES]) + (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 (\SELPIECES SEL NIL TEXTOBJ))) + (for PC inselpieces (CL:IF CROSSCOPY + (\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 18-Apr-93 23:49 by jds") - - (* ;; "Starting from a CH# in a selectable region, find the CH# of the last selectable character following that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "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.") - (bind (OURLIMIT _ (IMIN (OR LIMITCH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - START-OF-PIECE PC first (SETQ PC (\CHTOPC CH# (fetch (TEXTOBJ PCTB) of TEXTOBJ) - T)) while PC - 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.") + (SETQ LIMITCH# (IMIN LIMITCH# (TEXTLEN TEXTOBJ))) + (LET (START-OF-PIECE) + (DECLARE (SPECVARS START-OF-PIECE)) + (for PC inpieces (\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.") - [COND - ((IGREATERP START-OF-PIECE OURLIMIT) (* ; - "We've passed the limit, so it's time to give up. Just return the LIMITCH#") - (RETURN OURLIMIT)) - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) + (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)) - (* ;; "We've found the beginning of a protected region -- i.e., the end of the selectable region. Tell the caller about it.") + (* ;; + "We've found the beginning of a protected region, previous char is the last selectable. ") - (RETURN (SUB1 START-OF-PIECE] - (add START-OF-PIECE (fetch (PIECE PLEN) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (RETURN (fetch (TEXTOBJ TEXTLEN) - of TEXTOBJ]) + (RETURN (SUB1 START-OF-PIECE))) + (add START-OF-PIECE (PLEN PC)) finally (RETURN LIMITCH#]) (\TEDIT.FIND.PROTECTED.START - [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "Edited 30-Apr-93 01:39 by jds") + [LAMBDA (TEXTOBJ CH# LIMITCH#) (* ; "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, find the CH# of the earliest contiguously-selectable character preceding that. This is used to limit selections to unprotected text, and to prevent selection of the protected text between tow unprotected areas.") + (* ;; "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.") - (bind (OURLIMIT _ (OR LIMITCH# 1)) - (PCTB _ (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PC START-OF-PIECE first (SETQ PC (\CHTOPC CH# PCTB T)) - (AND (LITATOM PC) - (SETQ PC (\CHTOPC CH# (SUB1 START-OF-PIECE) - T))) while PC - do [COND - ((ILEQ START-OF-PIECE OURLIMIT) (* ; - "If he specified a LIMITCH#, and we have passed it, stop bothering and return the LIMITCH#") - (RETURN OURLIMIT)) - ((fetch (CHARLOOKS CLPROTECTED) of (fetch (PIECE PLOOKS) of PC)) + (LET (START-OF-PIECE) (* ; + "Gets us to the beginning of CH# piece") + (DECLARE (SPECVARS START-OF-PIECE)) + (for PC backpieces (PREVPIECE (\CHTOPC CH# TEXTOBJ T)) until (ILEQ START-OF-PIECE LIMITCH#) + do (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of (PLOOKS PC)) - (* ;; "We hit a PROTECTED piece of text. This is the place to stop. Return the CH# just AFTER the protected text we found.") + (* ;; "Return the CH# just AFTER this first protected piece.") - (RETURN (IPLUS START-OF-PIECE (fetch (PIECE PLEN) of PC] - (SETQ PC (fetch (PIECE PREVPIECE) of PC)) - (SETQ START-OF-PIECE (IDIFFERENCE START-OF-PIECE (fetch (PIECE PLEN) of PC]) + (RETURN START-OF-PIECE)) + (add START-OF-PIECE (IMINUS (PLEN PC))) finally (RETURN LIMITCH#]) (\TEDIT.WORD.BOUND - [LAMBDA (TEXTOBJ PREVCH CH) (* ; "Edited 30-May-91 23:02 by jds") - (PROG ((READSA (fetch READSA of (OR (fetch (TEXTOBJ TXTWTBL) of TEXTOBJ) - TEDIT.WORDBOUND.READTABLE))) - SYN1 SYN2) - (COND - ((NOT (AND (FIXP PREVCH) - (FIXP CH))) - (RETURN T))) - (SETQ SYN1 (\SYNCODE READSA PREVCH)) - (SETQ SYN2 (\SYNCODE READSA CH)) - (RETURN (NEQ SYN1 SYN2]) + [LAMBDA (TEXTOBJ PREVCH CH) (* ; "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))))]) ) (RPAQ? TEDIT.EXTEND.PENDING.DELETE T) -(DEFINEQ - -(\CREATE.TEDIT.SELECTION - [LAMBDA NIL - (create SELECTION]) - -(\CREATE.TEDIT.SHIFTEDSELECTION - [LAMBDA NIL - (create SELECTION - HASCARET _ NIL]) - -(\CREATE.TEDIT.MOVESELECTION - [LAMBDA NIL - (CREATE SELECTION - HASCARET _ NIL - HOWHEIGHT _ 32767]) - -(\CREATE.TEDIT.DELETESELECTION - [LAMBDA NIL - (CREATE SELECTION - HOW _ BLACKSHADE - HASCARET _ NIL - HOWHEIGHT _ 32767]) -) -(* ; "Added by yabu.fx, for LOADUP without DWIM.") +(* ; "Setting for a %"Laurel%" mode") -(RPAQ TEDIT.SELECTION (\CREATE.TEDIT.SELECTION)) - -(RPAQ TEDIT.SCRATCHSELECTION (\CREATE.TEDIT.SELECTION)) - -(RPAQ TEDIT.SHIFTEDSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - -(RPAQ TEDIT.COPYLOOKSSELECTION (\CREATE.TEDIT.SHIFTEDSELECTION)) - -(RPAQ TEDIT.MOVESELECTION (\CREATE.TEDIT.MOVESELECTION)) - -(RPAQ TEDIT.DELETESELECTION (\CREATE.TEDIT.DELETESELECTION)) - -(RPAQQ TEDIT.SELPENDING NIL) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.SELECTION TEDIT.SCRATCHSELECTION TEDIT.MOVESELECTION TEDIT.SHIFTEDSELECTION - TEDIT.COPYLOOKSSELECTION TEDIT.DELETESELECTION TEDIT.SELPENDING TEDIT.EXTEND.PENDING.DELETE) -) - (* ; "Selection manipulating code") (DEFINEQ -(TEDIT.EXTEND.SEL - [LAMBDA (X Y OSEL TEXTOBJ SELOPERATION SELWINDOW NEWSEL) (* ; "Edited 19-Apr-93 13:49 by jds") - (* ; - "Gather a new selected character, and extend OSEL to include it. Return the extended selection.") - (PROG ((NSEL (OR NEWSEL (TEDIT.SELECT X Y TEXTOBJ (SELECTQ (fetch (SELECTION SELKIND) - of OSEL) +(\TEDIT.EXTEND.SEL + [LAMBDA (X Y OSEL TEXTOBJ SELOPERATION PANE) (* ; "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.") + + (* ;; "NEWSEL will be a paragraph selection if OSEL was.") + + (* ;; "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))) + + (* ;; "LINE+WORDSELFLG iff PARA") + + (SETQ NEWSEL (\TEDIT.SELECT X Y TEXTOBJ (SELECTQ SELKIND ((LINE PARA) 'LINE) ((WORD CHAR) 'TEXT) 'TEXT) - (OR (EQ (fetch (SELECTION SELKIND) of OSEL) - 'WORD) - (EQ (fetch (SELECTION SELKIND) of OSEL) - 'PARA)) - SELOPERATION SELWINDOW T))) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (NPOINT NIL) - (SETOSELFLG NIL) - (FIXUPNEEDED NIL)) - (COND - ((ZEROP TEXTLEN) (* ; - "No sense in extending a selection if there's no text!") - (RETURN NSEL))) - (COND - ((AND NSEL (fetch (SELECTION SET) of NSEL)) (* ; - "If there's no second selection, don't bother trying") - (\TEDIT.SET.SEL.LOOKS NSEL SELOPERATION) - - (* ;; "Make the new selection be the same kind as the original, as to what it's for -- regular, copy-source, etc.") - + (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 (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CHLIM) of OSEL)) - (* ; - "The new selection ends to the right of the old one. Move this edge.") + ((IGEQ NCHLIM OCHLIM) (* ; + "NEWSEL ends to the right of OSEL: adding on the right ") 'RIGHT) - ((ILEQ (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL)) - (* ; - "If the new selection starts to left of old one, caret goes at the LEFT") + ((ILEQ NCH# OCH#) (* ; + "NEWSEL starts to the left of OSEL: adding on the left") 'LEFT) - ([IGREATERP (IABS (IDIFFERENCE (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CHLIM) of OSEL))) - (IABS (IDIFFERENCE (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL] + ((IGREATERP (IABS (IDIFFERENCE NCHLIM OCHLIM)) + (IABS (IDIFFERENCE NCH# OCH#))) + + (* ;; "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.") + (SETQ SETOSELFLG T) 'LEFT) - (T (SETQ SETOSELFLG T) + (T + (* ;; + "Must be shrinking from the right. Move OLDSEL's CHLIM back to NEWSEL's") + + (SETQ SETOSELFLG T) 'RIGHT] - [SELECTQ NPOINT + (SELECTQ NPOINT (LEFT (* ; - "Caret's to the left. Keep the same right end") - [replace (SELECTION CHLIM) of NSEL - with (IMAX (fetch (SELECTION CHLIM) of NSEL) - (SELECTQ (fetch (SELECTION POINT) of OSEL) - (LEFT (IPLUS (fetch (SELECTION CH#) of OSEL) - (fetch (SELECTION DCH) of OSEL))) - (RIGHT (fetch (SELECTION CHLIM) of OSEL)) - (SHOULDNT] - (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION XLIM) of OSEL)) - (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION YLIM) of OSEL)) - (replace (SELECTION LN) of NSEL with (COPY (fetch (SELECTION LN) of OSEL))) - (COND - ((NEQ SELOPERATION 'COPY) (* ; - "The old sel is in a protected area. Only let him extend to the start of it.") - [replace (SELECTION CH#) of NSEL - with (IMAX (fetch (SELECTION CH#) of NSEL) - (\TEDIT.FIND.PROTECTED.START TEXTOBJ - (SUB1 (fetch (SELECTION CHLIM) of OSEL)) - (fetch (SELECTION CH#) of NSEL] - (SETQ FIXUPNEEDED T) (* ; - "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") - ))) + "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))) + + (* ;; "Only copying is allowed from a protected area (menu). Otherwise, only extend to its start. If CH# changes, L1 may also change (\FIXSEL)") + + (CL:UNLESS (EQ SELOPERATION 'COPY) + (SETQ NCH# (IMAX NCH# (\TEDIT.FIND.PROTECTED.START TEXTOBJ (SUB1 OCHLIM) + NCH#))))) (RIGHT (* ; - "Point's to the right; keep the same left end.") - [replace (SELECTION CH#) of NSEL - with (IMIN (fetch (SELECTION CH#) of NSEL) - (SELECTQ (fetch (SELECTION POINT) of OSEL) - (LEFT (fetch (SELECTION CH#) of OSEL)) - (RIGHT (IDIFFERENCE (fetch (SELECTION CHLIM) of OSEL) - (fetch (SELECTION DCH) of OSEL))) - (SHOULDNT] - (replace (SELECTION X0) of NSEL with (fetch (SELECTION X0) of OSEL)) - (replace (SELECTION Y0) of NSEL with (fetch (SELECTION Y0) of OSEL)) - (replace (SELECTION L1) of NSEL with (COPY (fetch (SELECTION L1) - of OSEL))) - (COND - ((NEQ SELOPERATION 'COPY) (* ; - "The old sel is in a protected area. Only let him extend to the start of it.") - [replace (SELECTION CHLIM) of NSEL - with (IMIN (fetch (SELECTION CHLIM) of NSEL) - (ADD1 (\TEDIT.FIND.PROTECTED.END - TEXTOBJ - (fetch (SELECTION CH#) of OSEL) - (ADD1 (\TEDIT.FIND.PROTECTED.END - TEXTOBJ - (fetch (SELECTION CH#) of OSEL) - (SUB1 (fetch (SELECTION CHLIM) of NSEL] - (replace (SELECTION CH#) of NSEL with (IMIN (fetch (SELECTION CHLIM) - of NSEL) - (fetch (SELECTION CH#) - of NSEL))) - (SETQ FIXUPNEEDED T) (* ; - "Note that the L1/LN may be invalid as a result of this contraction. Force a \FIXSEL later.") - ))) - (PROGN (replace (SELECTION CHLIM) of NSEL with (fetch (SELECTION CHLIM) - of OSEL)) - (replace (SELECTION XLIM) of NSEL with (fetch (SELECTION XLIM) of OSEL)) - (replace (SELECTION YLIM) of NSEL with (fetch (SELECTION YLIM) of OSEL)) - (replace (SELECTION LN) of NSEL with (COPY (fetch (SELECTION LN) - of OSEL))) - (replace (SELECTION CH#) of NSEL with (fetch (SELECTION CH#) of OSEL)) - (replace (SELECTION X0) of NSEL with (fetch (SELECTION X0) of OSEL)) - (replace (SELECTION Y0) of NSEL with (fetch (SELECTION Y0) of OSEL)) - (replace L1 of NSEL with (COPY (fetch L1 of OSEL))) - (SETQ NPOINT (fetch POINT of OSEL] - (replace DCH of NSEL with (IDIFFERENCE (IMIN (ADD1 TEXTLEN) - (fetch CHLIM of NSEL)) - (fetch CH# of NSEL))) - (* ; - "The selection's length cannot exceed that of the whole text.") - (replace CHLIM of NSEL with (IPLUS (fetch CH# of NSEL) - (fetch DCH of NSEL))) - (* ; - "This assures that the CHLIM corresponds to the DCH.") - (replace POINT of NSEL with NPOINT) - (replace (SELECTION DX) of NSEL with (IDIFFERENCE (fetch XLIM of NSEL) - (fetch X0 of NSEL))) - (COND - ((NEQ (fetch SELOBJ of OSEL) - (fetch SELOBJ of NSEL)) - (replace SELOBJ of NSEL with NIL))) - (COND - (FIXUPNEEDED + "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))) - (* ;; "We're in a menu, and this selection got contracted because of a protection violation. Fix up everything.") + (* ;; "Only copying is allowed from a protected area (menu). Otherwise, only extend to its end. If CHLIM changes, LN may also change (\FIXSEL)") - (\FIXSEL NSEL TEXTOBJ))) - (COND - (SETOSELFLG (* ; - "For whatever reason, it is wise to copy the new sel into the old one.") - (\COPYSEL NSEL OSEL)) - (T (* ; - "Otherwise, set the POINT of the old sel to correspond to the new sel's.") - (* ; - "(replace POINT of OSEL with NPOINT)") - (* ; - "THIS WAS REMOVED, BECAUSE EXTENDING A POINT-SELECTION WOULD DIE WHEN THIS WAS DONE") - )) - (RETURN NSEL)) - (T (* ; - "No new selection was made; just return the old one.") - (RETURN OSEL]) + (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)) (* ; + "Keep object if it is in overlapping part?") + (FSETSEL NEWSEL SELOBJ NIL)) + (\FIXSEL NEWSEL TEXTOBJ) + (CL:WHEN SETOSELFLG (* ; + "It is wise to copy the new sel into the old one.") + (\COPYSEL NEWSEL OSEL)) + (RETURN NEWSEL)))]) -(TEDIT.SELECT - [LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) +(\TEDIT.SELECT + [LAMBDA (X Y TEXTOBJ REGION WORDSELFLG SELOPERATION PANE EXTENDING) + (* ; "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") - (* Select the character word, line, or - paragraph the mouse is pointing at.) - (PROG ((SEL NIL) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - PREVLINE L1 LN) - (SETQ SEL (TEDIT.SELECT.LINE.SCANNER X Y TEXTOBJ (\TEDIT.LINE.LIST TEXTOBJ WINDOW) - REGION WORDSELFLG SELOPERATION WINDOW EXTENDING)) - (COND - ((AND (type? SELECTION SEL) - (fetch (SELECTION SET) of SEL)) (* He pointed at something real; - return that.) - (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) - [COND - ([AND (CAR (fetch (SELECTION L1) of SEL)) - (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of (CAR (fetch (SELECTION L1) of SEL] - (replace (SELECTION X0) of SEL with (FIXR (FQUOTIENT (fetch (SELECTION X0) - of SEL) - 35.27778] - [COND - ([AND (CAR (fetch (SELECTION LN) of SEL)) - (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of (CAR (fetch (SELECTION LN) of SEL] - (replace (SELECTION XLIM) of SEL with (FIXR (FQUOTIENT (fetch (SELECTION XLIM) - of SEL) - 35.27778] - (replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch (SELECTION XLIM) of SEL) - (fetch (SELECTION X0) of SEL))) - (\FIXSEL SEL TEXTOBJ WINDOW T) - (RETURN SEL)) - ((type? LINEDESCRIPTOR SEL) - (* He pointed below the bottom of the text. - Select to the right of the last character on the screen.) + (* ;; "Select the character word, line, or paragraph the mouse is pointing at.") - (COND - ((fetch (LINEDESCRIPTOR LHASPROT) of SEL) (* The last line is protected. - Don't select anything.) - (RETURN))) - (SETQ PREVLINE SEL) - (SETQ SEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of SEL with T) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - [replace (SELECTION CH#) of SEL with (IMAX 1 (ADD1 (IMIN TEXTLEN (fetch (LINEDESCRIPTOR - CHARLIM) - of PREVLINE] - (replace (SELECTION CHLIM) of SEL with (fetch (SELECTION CH#) of SEL)) - (replace (SELECTION DCH) of SEL with 0) - [replace (SELECTION POINT) of SEL with (COND - ((IGREATERP (fetch (SELECTION CH#) - of SEL) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) + (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) + (\FIXSEL SEL TEXTOBJ PANE) (* ; + "This PANE is good, fix all the other ones") + SEL)]) - (* Can't select to the right of a character past EOF, only to the left -- - which is the right edge of the text.) - - 'LEFT) - (T 'RIGHT] - (\TEDIT.SET.SEL.LOOKS SEL SELOPERATION) - (\FIXSEL SEL TEXTOBJ) - (RETURN SEL]) - -(TEDIT.SCAN.LINE - [LAMBDA (TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION WINDOW EXTENDING) +(\TEDIT.SCAN.LINE + [LAMBDA (TEXTOBJ LINE X Y WORDSELFLG SELOPERATION PANE EXTENDING) + (* ; "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 a line, find the character which straddles the mouse.") + (* ;; "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.") - (PROG ((L NIL) - (WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (LLIST (fetch (THISLINE LOOKS) of THISLINE)) - (LOOKNO 1) - (DX 0) - OTX YBOT YBASE TX (CH (CHARCODE SPACE)) - PREVCH CHOBJB TXB CHB (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - L1 LN CLOOKS PCLOOKS) - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If the cache doesn't describe this line, call \FORMATLINE so it will.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) of LINE) - LINE))) - [COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) of LINE)) - (* ; - "This is a hardcopy-mode line. Convert units to micas") - (SETQ X (FIXR (FTIMES X 35.27778] - [SETQ OTX (SETQ TXB (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE] + (PROG (SCRSEL CHARSLOT CLOOKS CHNO TXB TX SELSLOT SELCHAR SELHERE PASTRIGHT + (THISLINE (FGETTOBJ TEXTOBJ THISLINE))) + (CL:UNLESS (EQ LINE (fetch DESC of THISLINE)) (* ; + "Make sure the cache describes this line") + (SETQ LINE (\FORMATLINE TEXTOBJ (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)) (* ; - "The mouse MUST be inside the line being selected.") - (SETQ CHB (SUB1 (fetch (LINEDESCRIPTOR CHAR1) of LINE))) - (SETQ CLOOKS (\EDITELT LLIST 0)) - (\TEDIT.CHECK (IGEQ X (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE))) + "Move over if the click was in the left margin.") + (SETQ CHNO (FGETLD LINE LCHAR1)) + + (* ;; "") + + (* ;; "Step 1: Find the slot, character number, and ending TX for the character at the incoming mouse X position. ") + + (CL:WHEN (SETQ PASTRIGHT (IGREATERP X (FGETLD LINE LXLIM))) (* ; - "The mouse MUST be inside the line being selected.") - (for I from 0 to (fetch LEN of THISLINE) as CHNO from (SUB1 (fetch (LINEDESCRIPTOR CHAR1) - of LINE)) - do (SETQ PREVCH CH) - (SETQ PCLOOKS CLOOKS) - (SETQ CH (\EDITELT CHLIST I)) - [COND - ((EQ CH LMInvisibleRun) (* ; "An invisible run -- skip it") - (add CHNO (\EDITELT LLIST LOOKNO)) (* ; "The length of the run") - (add LOOKNO 1) (* ; - "Move to next CLook for next transition") - (add I 1) (* ; - "Don't count this toward the CHNO counter.") - (SETQ CH (\EDITELT CHLIST I] - (\TEDIT.CHECK (NEQ CH LMInvisibleRun)) (* ; - "Can't have 2 invisible runs in a row.") - [COND - ((EQ CH LMLooksChange) (* ; - "Change of CharLooks -- make the switch") - (SETQ CLOOKS (\EDITELT LLIST LOOKNO)) (* ; "New looks") - (add LOOKNO 1) (* ; - "Move to next CLook for next transition") - (add I 1) (* ; - "Don't count this toward the CHNO counter.") - (SETQ CH (\EDITELT CHLIST I] - [COND - ((AND (ILESSP X TX) - (OR (EQ SELOPERATION 'COPY) - (fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - (NOT (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS))) - (OR (NOT WORDSELFLG) - (NOT (SMALLP PREVCH)) - (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH))) + "Past the end, put it inside the last character") + (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") - (* ;; "If we're beyond the mouse's X, and the character is selectable, and we're in char select or this is a word boundary then SELECT!!!") - - (\TEDIT.CHECK (NOT (ZEROP I))) (* ; - "We had best not have fouled out to the left of the left margin!") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (* ; "Grab the scratch sel") - (replace (SELECTION SET) of L with T) (* ; "Mark it valid") - [replace (SELECTION SELKIND) of L with (COND - (WORDSELFLG 'WORD) - (T 'CHAR] - (\TEDIT.SELECT.CHARACTER TEXTOBJ L PREVCH LINE X Y TXB WINDOW SELOPERATION - EXTENDING) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (replace (SELECTION X0) of L with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) + (SETQ SELHERE (fetch (CHARLOOKS CLSELHERE) of CLOOKS))) + (CL:UNLESS (fetch (CHARLOOKS CLPROTECTED) of CLOOKS) (* ; - "If CLSelHere, then select to RIGHT always.") - TX) - (WORDSELFLG TXB) - (T OTX))) - (replace (SELECTION DX) of L with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - 0) - (WORDSELFLG (IDIFFERENCE TX TXB)) - (T DX))) - [replace (SELECTION CH#) of L with (IMAX 1 (COND - ((fetch (CHARLOOKS CLSELHERE) - of PCLOOKS) - (ADD1 CHNO)) - (WORDSELFLG (ADD1 CHB)) - (T CHNO] - (replace (SELECTION XLIM) of L with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - TX) - (WORDSELFLG TX) - (T TX))) - [replace (SELECTION CHLIM) of L with (ADD1 (COND - ((fetch (CHARLOOKS CLSELHERE) - of PCLOOKS) - CHNO) - (WORDSELFLG CHNO) - (T CHNO] - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) - of L) as WW - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) - do (RPLACA L1 LINE) - (RPLACA LN LINE)) - [replace (SELECTION POINT) of L - with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - (* ; - "Always to the right of an otherwise-protected insertion point marker") - 'RIGHT) - [WORDSELFLG (COND - ((AND (NEQ PREVCH (CHARCODE CR)) - (IGEQ X (LRSH (IPLUS TX TXB) - 1))) - (* ; - "To the right if it isn't a CR and we're right of center.") - 'RIGHT) - (T 'LEFT] - (T (COND - ((AND (IGEQ DX 3) - (NEQ PREVCH (CHARCODE CR)) - (IGEQ X (LRSH (IPLUS TX OTX) - 1))) + "If protected, we keep going beyond the given X") + (RETURN))) + (add CHNO 1) finally - (* ;; "If it's wide enough to sensibly decide on an edge for, this isn't a CR, and we're right of center, then put the caret to the RIGHT") + (* ;; "We lose if all characters after X are protected.") - 'RIGHT) - (T 'LEFT] - (replace (SELECTION DCH) of L with (COND - ((fetch (CHARLOOKS CLSELHERE) of PCLOOKS) - 0) - (WORDSELFLG (IDIFFERENCE CHNO CHB)) - (T 1))) - (RETURN)) - (T - (* ;; "We're not past the mouse yet; just track the last word boundary (or protected-text boundary) for word selection.") + (CL:WHEN (fetch (CHARLOOKS CLPROTECTED) of CLOOKS) + (SETQ CHARSLOT NIL))) + (CL:UNLESS CHARSLOT (* ; "Everything after X was protected.") + (RETURN 'DON'T)) - (COND - ((OR (AND (NOT (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - (\TEDIT.WORD.BOUND TEXTOBJ PREVCH CH)) - (NEQ (fetch (CHARLOOKS CLPROTECTED) of PCLOOKS) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) - (fetch (CHARLOOKS CLSELHERE) of PCLOOKS)) - (SETQ TXB TX) - (SETQ CHB CHNO) - (SETQ CHOBJB PREVCH] - (SETQ OTX TX) - (SETQ DX (\EDITELT WLIST I)) - (SETQ TX (IPLUS TX DX))) - [COND - ((AND (NOT L) - (IGEQ (fetch LEN of THISLINE) - 0) - (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + (* ;; "CHNO and CHARSLOT: the character pointed to, CLOOKS the looks of that character.") - (* ;; "He's pointing to the right of the line, but there's protected text at the end. Select a point at the last legal spot.") + (* ;; "CHNO and CHARSLOT are either flagged as CLSELHERE or are not flagged as CLPROTECTED.") - (COND - ((SMALLP CHOBJB) (* ; - "And the last item wasn't a menu button") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of L with T) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (replace (SELECTION X0) of L with TXB) - (replace (SELECTION DX) of L with 0) - (replace (SELECTION CH#) of L with (IMAX 1 (ADD1 CHB))) - (replace (SELECTION XLIM) of L with TXB) - (replace (SELECTION CHLIM) of L with (IMAX 1 (ADD1 CHB))) - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) of L) - as WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) - do (RPLACA L1 LINE) - (RPLACA LN LINE)) - (replace (SELECTION POINT) of L with 'LEFT) - (replace (SELECTION DCH) of L with 0) - (replace (SELECTION SELOBJ) of L with NIL)) - (T (* ; - "Oops--the last item WAS a menu button. Don't let it be selected.") - (RETURN 'DON'T] - (COND - (L (* ; - "If we found the place he's pointing, set up the inter-pointers so each can find the other") - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ)) - (T (* ; - "We didn't find what he was pointing at. Point to the end of the line.") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (replace (SELECTION SET) of L with T) - [replace (SELECTION SELKIND) of L with (COND - (WORDSELFLG 'WORD) - (T 'CHAR] - (* ; - "THIS MUST PRECEDE THE \TEDIT.SELECT.CHARACTER, SO OBJECTS CAN TURN THE SELECTION VOLATILE.") - (\TEDIT.SELECT.CHARACTER TEXTOBJ L CH LINE X Y TXB WINDOW SELOPERATION EXTENDING) - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - [replace (SELECTION X0) of L with (COND - (WORDSELFLG TXB) - (T (IDIFFERENCE TX DX] - (replace (SELECTION XLIM) of L with TX) - (replace (SELECTION DX) of L with (COND - (WORDSELFLG (IDIFFERENCE TX TXB)) - (T DX))) - [replace (SELECTION CH#) of L with (COND - (WORDSELFLG (ADD1 CHB)) - (T (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - TEXTLEN] - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (replace (SELECTION CHLIM) of L with (ADD1 (IMIN (fetch (LINEDESCRIPTOR CHARLIM) - of LINE) - TEXTLEN))) - [replace (SELECTION POINT) of L - with (COND - [(NEQ CH (CHARCODE CR)) (* ; - "You can select only to the left of a CR; elsewhere, you can select to the right") - (COND - ([IGEQ X (COND - (WORDSELFLG (* ; - "If it's a word, check our location against mid-word to see which side to put the caret on") - (LRSH (IPLUS TX TXB) - 1)) - (T (* ; - "Otherwise, check against mid-character") - (IDIFFERENCE TX (LRSH DX 1] - (* ; - "If we're to the right of mid-item, put the caret on the right.") - 'RIGHT) - (T (* ; "Otherwise, put it on the left.") - 'LEFT] - (T 'LEFT] - (for L1 on (fetch (SELECTION L1) of L) as LN on (fetch (SELECTION LN) of L) - as WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) when (EQ WW WINDOW) - do (RPLACA L1 LINE) - (RPLACA LN LINE)) - (replace (SELECTION DCH) of L with (COND - (WORDSELFLG (IDIFFERENCE - (IMIN (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE) - TEXTLEN) - CHB)) - (T 1))) - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ))) - (RETURN L]) + (* ;; "TXB the end of CHNO-1, TX the end of CHNO. They both may be beyond X, if protected.") -(TEDIT.SELECT.LINE.SCANNER - [LAMBDA (X Y TEXTOBJ LINE.LIST REGION WORDSELFLG SELOPERATION WINDOW EXTENDING) + (* ;; "") + + (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))) + 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. ") + + 'RIGHT + else 'LEFT)) + (CL:WHEN (AND WORDSELFLG (NOT (FGETLD LINE LDUMMY))) + + (* ;; "Expand the selection to its word boundaries") + + (\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]) + +(\TEDIT.SCAN.LINE.WORD + [LAMBDA (X TEXTOBJ THISLINE SCRSEL SELSLOT SELLOOKS) (* ; "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") + (* ; "Edited 6-Mar-2023 22:22 by rmk") + (* ; "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.") + + (* ;; " ") + + (\DTEST SCRSEL 'SELECTION) + (CL:UNLESS (EQ 'CHAR (FGETSEL SCRSEL SELKIND)) + (SHOULDNT "Can only expand CHAR selections to WORD selections")) + (LET (CH# CHLIM X0 XLIM) + + (* ;; "CH# will be the first charno of the word selection") + + (* ;; "CHLIM will be one past the last charno of the word selection") + + (* ;; "X0 will be the X at the beginning of the first char") + + (* ;; "XLIM will be the X at the end of last charL") + + (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) + do (CL:UNLESS CHAR + (SETQ CLOOKS CHARW) + (GO $$ITERATE)) + (CL:WHEN (OR (type? IMAGEOBJ CHAR) + (\TEDIT.WORD.BOUND TEXTOBJ CHAR LASTCHAR) + (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + (* ; "Stop at a protection bounary") + (RETURN)) + (SETQ LASTCHAR CHAR) + (ADD X0 (IMINUS CHARW)) + (ADD CH# -1)) + + (* ;; "And search forward for the end of the word") + + (for CHARSLOT (CLOOKS _ SELLOOKS) + (PREVCHAR _ (CHAR SELSLOT)) incharslots (NEXTCHARSLOT SELSLOT) + do (CL:UNLESS CHAR + (SETQ CLOOKS CHARW) + (GO $$ITERATE)) + (CL:WHEN (OR (type? IMAGEOBJ CHAR) + (\TEDIT.WORD.BOUND TEXTOBJ PREVCHAR CHAR) + (fetch (CHARLOOKS CLPROTECTED) of CLOOKS)) + + (* ;; "XLIM is now the end of the last character of the word.") + + (* ;; "CHLIM and XLIM should be OK if we run off the end.") + + (RETURN)) + (add XLIM CHARW) + (add CHLIM 1) + (SETQ PREVCHAR CHAR)) + (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) + + (* ;; "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) + (AND (IGEQ (IDIFFERENCE XLIM X0) + 3) + (IGEQ X (FOLDLO (IPLUS XLIM X0) + 2] + then 'RIGHT + else 'LEFT]) + +(\TEDIT.SELECT.LINE.SCANNER + [LAMBDA (X Y TEXTOBJ LINES REGION WORDSELFLG SELOPERATION PANE EXTENDING) + (* ; "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") - (* ; - "Find the text line the mouse is pointing at.") - (* ; - "LINE.LIST is the dummy first line for the window in which selection happened.") - (PROG ((L NIL) - (WWIDTH (fetch (TEXTOBJ WRIGHT) of TEXTOBJ)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (WREG (DSPCLIPPINGREGION NIL WINDOW)) - PREVLINE PARABOUNDS PARASTART PARAEND L1 LN) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINE.LIST)) - while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch BOTTOM of WREG))) - do + (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 - (* ;; "Search thru the list of (real) displayed lines, looking for the first one whose bottom is below the mouse. That's the line we're pointing at.") + (* ;; + "Y is below thelast line. Assume it points to the last. ") - (COND - ((ILEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - Y) (* ; "Found it.") - (SELECTQ REGION - ((TEXT WINDOW) (* ; - "We're in the regular text area, so scan accross looking for the character.") - (SETQ L (TEDIT.SCAN.LINE TEXTOBJ LINE THISLINE X Y WORDSELFLG SELOPERATION - WINDOW EXTENDING))) - (LINE (* ; - "He is selecting an entire line, or a paragraph.") - (SETQ L (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (for TL1 on (fetch (SELECTION L1) of L) as TLN - on (fetch (SELECTION LN) of L) as WW inside (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ) - when (EQ WW WINDOW) do (SETQ L1 TL1) - (SETQ LN TLN) - (RETURN)) - (COND - ((AND (fetch (LINEDESCRIPTOR LHASPROT) of LINE) - (NEQ SELOPERATION 'COPY))(* ; - "In a TEDIT menu, you can't select a whole paragraph or line.") - (replace (SELECTION SET) of L with NIL) - (RETURN L))) (* ; "The scratch selection") - (replace (SELECTION \TEXTOBJ) of L with TEXTOBJ) - (* ; - "Make sure he knows what document the selection's in.") - (replace (SELECTION SET) of L with T) - (* ; "Mark it valid.") - (replace (SELECTION SELOBJ) of L with NIL) - (* ; "Not selecting an object just yet") - (COND - [WORDSELFLG (* ; "Select a paragraph.") - (replace (SELECTION SELKIND) of L with 'PARA) - (* ; - "SEARCH FORWARD FROM THE CURRENT LINE TO A LINE WITH A CR OR CHARLIM=EOTEXT") - [COND - ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) + (RETURN (OR L PREV] + (CL:UNLESS LINE (* ; "Can this happen? Empty?") + (RETURN NIL)) + (SELECTQ REGION + ((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)) - (* ;; "If this is a para-formatted document, use the paragraph bounds. Otherwise, delimit a para by the surrounding CRs.") + (* ;; + "Y is below the last line of the text: force selection past the very end of that line.") - (SETQ PARABOUNDS (\TEDIT.PARABOUNDS TEXTOBJ (fetch (LINEDESCRIPTOR - CHAR1) - of LINE))) - (SETQ PARASTART (\TEDIT.FIND.PROTECTED.START TEXTOBJ - (fetch (LINEDESCRIPTOR CHAR1) of LINE) - (CAR PARABOUNDS))) - (SETQ PARAEND (\TEDIT.FIND.PROTECTED.END TEXTOBJ - (fetch (LINEDESCRIPTOR CHAR1) of LINE) - (CDR PARABOUNDS] - (RPLACA L1 LINE) - (RPLACA LN LINE) - (bind (LL _ LINE) - while (AND [COND - ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LL) - PARAEND)) - (T (NOT (fetch (LINEDESCRIPTOR CR\END) of LL] - (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LL) - TEXTLEN)) - do (* ; - "Walk forward thru the lines, looking for the last line in the paragraph.") - [COND - ((fetch (LINEDESCRIPTOR NEXTLINE) of LL) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - (T [replace (LINEDESCRIPTOR NEXTLINE) of LL - with (\FORMATLINE TEXTOBJ NIL - (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LL] - (replace (LINEDESCRIPTOR PREVLINE) - of (fetch (LINEDESCRIPTOR NEXTLINE) of LL) with LL) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL] - finally (RPLACA LN LL)) (* ; - "SEARCH BACK TO A LINE WITH A CR OR BOTEXT") - [COND - ((IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - 1) (* ; - "Only search backward if we're not on the first line already.") - (bind (LL _ LINE) - while [AND (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - 1) - (COND - ((fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - PARASTART)) - (T (NOT (fetch (LINEDESCRIPTOR CR\END) - of (fetch (LINEDESCRIPTOR PREVLINE) - of LL] - do - (* ;; "Back up until we find the first line of the paragraph, or we hit the dummy top line (which claims to end in CR.)") + (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 LL (fetch (LINEDESCRIPTOR PREVLINE) of LL)) - finally - (RPLACA L1 (COND - ((AND (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ) - (IEQP (fetch (LINEDESCRIPTOR CHAR1) - of LL) - PARASTART)) - (* ; "We found a true start of para.") - LL) - ([AND (fetch (LINEDESCRIPTOR PREVLINE) - of LL) - (NOT (ZEROP (fetch (LINEDESCRIPTOR CHARLIM) - of (fetch (LINEDESCRIPTOR - PREVLINE) - of LL] - (* ; - "We hit the first line in the paragraph, fair and square") - LL) - ((IEQP 1 (fetch (LINEDESCRIPTOR CHAR1) - of LL)) - (* ; "We hit the front of the document.") - LL) - (T (\BACKFORMAT LINE.LIST TEXTOBJ - (fetch PTOP of WREG)) - (fetch (LINEDESCRIPTOR NEXTLINE) of LINE.LIST] - [replace (SELECTION CH#) of L with (OR PARASTART (fetch ( - LINEDESCRIPTOR - CHAR1) - of (CAR L1] - [replace (SELECTION CHLIM) of L - with (ADD1 (OR PARAEND (fetch (LINEDESCRIPTOR CHARLIM) - of (CAR LN] - [replace (SELECTION POINT) of L - with (COND - ((ILEQ (IDIFFERENCE (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - (fetch (SELECTION CH#) of L)) - (IDIFFERENCE (fetch (SELECTION CHLIM) of L) - (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - 'LEFT) - (T 'RIGHT] - (replace (SELECTION DCH) of L with (IDIFFERENCE (fetch (SELECTION - CHLIM) - of L) - (fetch (SELECTION CH#) - of L))) - (COND - ((fetch (LINEDESCRIPTOR LHASPROT) of LINE) - (* ; - "We have cause to suspect there may be protected text around this para. Fix the sel the hard way.") - (\FIXSEL L TEXTOBJ)) - (T (* ; - "No protected text is evident. DO it the easy way.") - (replace (SELECTION Y0) of L with (fetch (LINEDESCRIPTOR YBOT) - of (CAR L1))) - (replace (SELECTION YLIM) of L with (fetch (LINEDESCRIPTOR - YBOT) - of (CAR LN))) - (replace (SELECTION X0) of L with (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of (CAR L1))) - (replace (SELECTION XLIM) of L with (fetch (LINEDESCRIPTOR - LXLIM) - of (CAR LN))) - (replace (SELECTION DX) of L - with (IPLUS 1 (IDIFFERENCE (fetch (SELECTION XLIM) - of L) - (fetch (SELECTION X0) of L] - (T (* ; - "Select the line we're pointing at.") - (replace (SELECTION SELKIND) of L with 'LINE) - (RPLACA L1 LINE) - (RPLACA LN LINE) - (replace (SELECTION CH#) of L with (fetch (LINEDESCRIPTOR CHAR1) - of LINE)) - (replace (SELECTION CHLIM) of L with (ADD1 (fetch (LINEDESCRIPTOR - CHARLIM) - of LINE))) - (replace (SELECTION DX) of L with (IDIFFERENCE (fetch ( - LINEDESCRIPTOR - LXLIM) - of LINE) - (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE))) - (replace (SELECTION X0) of L with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE)) - (replace (SELECTION XLIM) of L with (fetch (LINEDESCRIPTOR LXLIM) - of LINE)) - (replace (SELECTION Y0) of L with (replace (SELECTION YLIM) - of L with (fetch ( - LINEDESCRIPTOR - YBOT) - of LINE))) - (replace (SELECTION DCH) of L with (IDIFFERENCE (fetch (SELECTION - CHLIM) - of L) - (fetch (SELECTION CH#) - of L))) - (replace (SELECTION POINT) of L with 'LEFT) - (replace (SELECTION SET) of L with T)))) - (SHOULDNT "Unknown text/line-bar region?")) - (RETURN))) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (RETURN (OR L PREVLINE]) + (* ;; "In a TEDIT menu, you can't select a whole paragraph or line.") -(\TEDIT.SELECT.CHARACTER - [LAMBDA (TEXTOBJ SEL PREVCH LINE X Y TXB SELWINDOW SELOPERATION EXTENDING) + (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") + + (* ;; "Get the lines selected in this pane. How does SCRATCHSEL know this?") + + (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. ") + + (if WORDSELFLG + then + + (* ;; "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") + + (SETQ PARAFIRSTCHNO (CAR (\TEDIT.PARA.FIRST TEXTOBJ + (FGETLD LINE LCHAR1) + T))) + (SETQ PARALASTCHNO (CAR (\TEDIT.PARA.LAST TEXTOBJ + (FGETLD LINE LCHARLIM) + T))) + + (* ;; "If LINE is closer to the beginning of the paragraph, put the point before the first line. Otherwise after the last line. ") + + (\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) + (\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) + + (* ;; "In the line-selection region, we know that the selection's X0 and XLIM are inherited from the LINE. Don't need to fix") + + (FSETSEL SCRSEL X0 (FGETLD LINE LX1)) + (FSETSEL SCRSEL XLIM (FGETLD LINE LXLIM))) finally (RETURN)) + (RETURN SCRSEL)) + (SHOULDNT "Unknown text/line-bar region?"))))]) + +(\TEDIT.SELECT.OBJECT + [LAMBDA (TEXTOBJ SEL OBJ LINE X Y TXB SELPANE SELOPERATION WHERE) + (* ; "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") - - (* ;; "We have moved over a particular character. If it's really a character, OK. Otherwise, call in the selection function!") - - (DECLARE (USEDFREE . WORDSELFLG)) - (COND - ((NULL PREVCH) - (replace (SELECTION SELOBJ) of SEL with NIL)) - ((SMALLP PREVCH) - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (replace (SELECTION SELOBJ) of SEL with PREVCH) - (replace (SELECTION X0) of SEL with TXB) - (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - [PROG ([OBJBOX (OR (IMAGEOBJPROP PREVCH 'BOUNDBOX) - (IMAGEBOX PREVCH SELWINDOW 'DISPLAY] - (DS (WINDOWPROP SELWINDOW '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 (fetch (LINEDESCRIPTOR YBASE) - of LINE) - (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 - (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - TXB)) - HEIGHT _ (fetch YSIZE of OBJBOX)) - DS) - (LIST (FUNCTION DSPCLIPPINGREGION) - (DSPCLIPPINGREGION NIL DS) - DS)) - (SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP PREVCH 'BUTTONEVENTINFN) - PREVCH DS SEL (IDIFFERENCE X TXB) - (IDIFFERENCE Y (fetch (LINEDESCRIPTOR YBASE) - of LINE)) - SELWINDOW - (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (COND - (EXTENDING 'RIGHT) - (WORDSELFLG 'MIDDLE) - (T 'LEFT)) - SELOPERATION))) - (* ; + (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.") - ) - (COND - ((NULL SELRES) (* ; - "If the event fn returns NIL, do nothing untoward") - ) - ((NULL (CAR SELRES)) (* ; - "If it returns something with a CAR of NIL, then UN-SET the object-ness of the selection") - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (* ; - "Otherwise, check to see what he wants us to do") - (COND - ((EQ (CAR SELRES) - 'DON'T) (* ; - "The object declines to be selected. Don't permit the select to happen.") - (replace (SELECTION SET) of SEL with NIL)) - ((AND (LISTP (CAR SELRES)) - (FMEMB 'DON'T (CAR SELRES))) (* ; - "The object declines to be selected. Don't permit the select to happen.") - (replace (SELECTION SET) of SEL with NIL))) - (COND - ((EQ (CAR SELRES) - 'CHANGED) (* ; - "If the object claims to have changed, update the screen.") + (SETQ SELRES (ERSETQ (APPLY* (IMAGEOBJPROP OBJ 'BUTTONEVENTINFN) + OBJ DS SEL (IDIFFERENCE X TXB) + (IDIFFERENCE Y (GETLD LINE YBASE)) + SELPANE + (FGETTOBJ TEXTOBJ STREAMHINT) + WHERE SELOPERATION)))) + + (* ;; "The clipping region is now restored.") + + (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") + (\FORMATLINE TEXTOBJ (GETLD LINE LCHAR1) + LINE) + (\DISPLAYLINE TEXTOBJ LINE SELPANE) (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL))) - ((AND (LISTP (CAR SELRES)) - (FMEMB 'CHANGED (CAR SELRES)))(* ; - "If the object claims to have changed, update the screen.") - (TEDIT.OBJECT.CHANGED TEXTOBJ (fetch (SELECTION SELOBJ) of SEL] - (SETQ WORDSELFLG NIL]) + NIL))]) ) (DEFINEQ (\FIXSEL - [LAMBDA (SEL TEXTOBJ THISWINDOW AVOIDINGTHISW) (* ; "Edited 31-May-91 12:26 by jds") + [LAMBDA (SEL TEXTOBJ AVOIDPANE ONLYPANE) (* ; "Edited 2-Mar-2024 23:38 by rmk") + (* ; "Edited 16-Dec-2023 11:44 by rmk") + (* ; "Edited 3-Nov-2023 12:01 by rmk") + (* ; "Edited 28-Jul-2023 15:58 by rmk") + (* ; "Edited 22-Jun-2023 16:05 by rmk") + (* ; "Edited 6-Jun-2023 13:26 by rmk") + (* ; "Edited 1-Jun-2023 17:41 by rmk") + (* ; "Edited 31-May-91 12:26 by jds") - (* ;; "Given that the selection SEL contains the correct CH# and CHLIM, reset the Y0 X0, DX, and XLIM values.") + (* ;; "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).") - (PROG* ((CH# (fetch (SELECTION CH#) of SEL)) - (CHLIM (fetch (SELECTION CHLIM) of SEL)) - (THISLINE (fetch (TEXTOBJ THISLINE) of TEXTOBJ)) - (WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (THISW (OR THISWINDOW (\TEDIT.MAINW TEXTOBJ))) - (WREG (AND THISW (DSPCLIPPINGREGION NIL THISW))) - (STARTFOUND NIL) - (ENDFOUND NIL) - WLIST CHLIST LOOKS LINE PREVLINE L1HCPY LNHCPY) - (COND - ((NOT WINDOW) (* ; - "There is no window to go with this edit; don't bother to try updating the selection") - (RETURN)) - ((NOT THISW) (* ; - "There is no window to go with this edit; don't bother to try updating the selection") - (RETURN))) - [COND - ((AND AVOIDINGTHISW (fetch (SELECTION Y0) of SEL))) - (T (replace (SELECTION Y0) of SEL with (fetch PTOP of WREG] - (COND - ((AND AVOIDINGTHISW (fetch (SELECTION YLIM) of SEL))) - (T (replace (SELECTION YLIM) of SEL with -1))) - (OR (fetch (SELECTION XLIM) of SEL) - (replace (SELECTION XLIM) of SEL with -1)) (* ; "Initialize it, if need be.") - (for WW inside WINDOW as L1 on (fetch (SELECTION L1) of SEL) as LN - on (fetch (SELECTION LN) of SEL) as LINES inside (fetch (TEXTOBJ LINES) of TEXTOBJ) - do (COND - ([AND (fetch (SELECTION SET) of SEL) - (OR (NOT THISWINDOW) - (NEQ AVOIDINGTHISW (EQ THISWINDOW WW] - (* ; - "Only if a 'real' SELECTION proceed") - (SETQ WLIST (fetch (THISLINE WIDTHS) of THISLINE)) - (SETQ CHLIST (fetch (THISLINE CHARS) of THISLINE)) - (SETQ LOOKS (fetch (THISLINE LOOKS) of THISLINE)) - (RPLACA L1 NIL) - (RPLACA LN NIL) - (bind (LINE _ (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - TX DX while LINE - do (COND - [(AND (IGEQ CH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (* ; - "The selection starts in this line. Fix L1, X0, and Y0.") - (SETQ STARTFOUND T) - (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) - (* ; - "Remember that this is a hardcopy-mode line") - (RPLACA L1 LINE) - (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) - (* ; - "Temp. X value for scanning the line from left margin to the right") - (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE)) - (COND - ((IGREATERP CH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (* ; - "Only bother formatting the line if the selection doesn't include the first character.") - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - LINE))) - (COND - ((IGEQ (fetch LEN of THISLINE) - 0) (* ; - "As long as there's something there on the line...") - (bind (LOOKNO _ 0) for I from 0 - to (fetch LEN of THISLINE) as CHNO - from (fetch (LINEDESCRIPTOR CHAR1) of LINE) - do + (* ;; "") - (* ;; "Run thru the characters on the line, looking for the first selected one. Keep track of our X position, so we know where the selection starts.") + (* ;; "If the first selected line in a pane is the line containing the first character of the selection, then X0 is calculated for the selection. Since panes are all the same width, the X0 is the same for all panes in which the first selected line is visible, and so is computed only once. XLIM is similarly calculated if the last character of the selection is visible in a pane. X0 and XLIM values are irrelevant (and may remain NIL) if the first/last lines are not visible in any pane.") - (SETQ DX (\EDITELT WLIST I)) - (SETQ TX (IPLUS TX DX)) - (COND - ((IGEQ CHNO CH#) - (* ; - "We've found that first character. Time to bail out.") - (RETURN)) - [(EQ LMInvisibleRun (\EDITELT CHLIST I)) - (* ; - "This is INVISIBLE text. Count the characters as though they were there.") - (add LOOKNO 1) - (add CHNO (SUB1 (\EDITELT LOOKS LOOKNO] - ((EQ LMLooksChange (\EDITELT CHLIST I)) - (* ; - "This is a format effector--reduce CHNO to ignore it") - (add LOOKNO 1) - (SETQ CHNO (SUB1 CHNO))) - (T (* ; - "Not yet; update our running X-position in the SEL.") - (replace (SELECTION X0) of SEL with TX] - ((AND (IEQP CH# (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (IGREATERP CH# (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) + (* ;; "") - (* ;; "The selection starts after the end of this line, but it's also the end of the text. Go ahead and select there.") + (* ;; "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.") - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - LINE))) - (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (RPLACA L1 LINE) (* ; - "Make this line be the first in the selection") - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) - (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LXLIM) - of LINE))) - ((AND (NOT STARTFOUND) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - CH#) - (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - CHLIM)) (* ; - "The selection starts before this line, so play catch-up") - (replace (SELECTION Y0) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (RPLACA L1 LINE) (* ; - "Grab this line and make it the apparent first line.") - (SETQ L1HCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) - (replace (SELECTION X0) of SEL with (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE)) - (SETQ STARTFOUND T))) - [COND - ([AND (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE)) - (IGEQ CHLIM (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (ILEQ CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE] - (* ; - "The selection ends in this line. Fix LN, XLIM, and YLIM.") + (* ;; "") - (* ;; "NB that it also has to START before the end of this line. This eliminates the case of a 0-wide selection right after the last char on this line.") + (* ;; "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.") - (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (* ; - "Set the lowest-Y value for the selection") - (RPLACA LN LINE) (* ; "Remember the final line") - (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) - (SETQ TX (fetch (LINEDESCRIPTOR LEFTMARGIN) of LINE)) - (* ; "Temp X position") - (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR LXLIM) - of LINE)) - (* ; - "Start by assuming that the selection extends all the way across the line") - [COND - [(AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) - of LINE))) - (EQ (fetch (SELECTION POINT) of SEL) - 'RIGHT) - (IEQP (fetch (SELECTION DCH) of SEL) - 0) - (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - (fetch (LINEDESCRIPTOR CR\END) of LINE)) - (* ; - "This selection starts AFTER the CR on a line, and doesn't include it.") - (RPLACA LN (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - (* ; - "Change the selection to start on the next line, at the margin, instead.") - (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of (CAR LN))) - (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR - YBOT) - of (CAR LN] - ((ILEQ CHLIM (IMIN (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "Only bother formatting if the selection doesn't include the last char on the line") - (COND - ((NEQ (fetch DESC of THISLINE) - LINE) (* ; - "If this line isn't cached in THISLINE, then reformat it.") - (\FORMATLINE TEXTOBJ NIL (fetch (LINEDESCRIPTOR CHAR1) - of LINE) - LINE))) - (COND - ((IGEQ (fetch LEN of THISLINE) - 0) (* ; - "If there are characters on the line, go looking for the one that ends the selection.") - (bind (LOOKNO _ 0) for I from 0 - to (fetch LEN of THISLINE) as CHNO - from (fetch (LINEDESCRIPTOR CHAR1) of LINE) - do + (* ;; "ONLYPANE is specified in scrolling. to avoid disturbing and redisplaying panes that are not been scrolled.") - (* ;; "Run thru the characters, until we find the final one that is selected. Kep running track of our X position on the line, so we know how wide the final line's hiliting should be.") + (* ;; "") - (SETQ DX (\EDITELT WLIST I)) - (* ; "The current character's width") - (SETQ TX (IPLUS TX DX)) - (* ; "Running Temp-X position") - (COND - ((IGEQ CHNO CHLIM) + (* ;; "Assumes that the per-pane lines are properly broken so that a forced-end selection can safely move to the next line (after an EOL insertion). ") + + (* ;; " ") + + (* ;; "Selection L1 and LN are sequences of CONS cells one for each pane that the text appears in. The running (CAR L1) heads the sub-chain of lines selected for the current pane, the running (CAR LN) points to the pane's last selected line.") + + (* ;; "") + + (* ;; "Each pane's PLINES 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))) + (\DTEST TEXTOBJ 'TEXTOBJ) + (CL:WHEN (AND (FGETTOBJ TEXTOBJ \WINDOW) + (FGETSEL SEL SET) + (NOT (FGETTOBJ TEXTOBJ TXTDON'TUPDATE))) + + (* ;; "CH# is the first selected character, CHLIM is the character just after the last one, hence the SUB1. ") + + (* ;; "For a point selection, CHLIM=(ADD1 CH#) so CHNO=LASTCHNO, and the caret position is determined by POINT. Highlighting is determined separately by DCH, which is 0 for point selections.") + + (for PANE PSTARTLINE PENDLINE X0 XLIM (CH# _ (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) + suchthat + + (* ;; + "The first visible line in PANE that contains or follows CHNO. ") + + (LINESELECTEDP L CH# LASTCHNO) + finally + + (* ;; "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) (* ; - "OK; this character is past the end of the selection. Stop here.") - (RETURN)) - [(EQ LMInvisibleRun (\EDITELT CHLIST I)) - (* ; - "This is a run of INVISIBLE characters. Count them in the character position, though.") - (add LOOKNO 1) - (add CHNO (SUB1 (\EDITELT LOOKS LOOKNO] - ((EQ LMLooksChange (\EDITELT CHLIST I)) - (* ; - "This is a format effector--reduce CHNO to ignore it") - (SETQ CHNO (SUB1 CHNO)) - (add LOOKNO 1)) - (T (* ; - "Keep track of how far across we've gotten.") - (replace (SELECTION XLIM) of SEL with TX] - (RETURN) (* ; - "And stop looking for an ending line--we've obviously found it!") - ) - ((AND (IEQP CHLIM (ADD1 (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (ILEQ CH# (fetch (LINEDESCRIPTOR CHARLIM) of LINE))) - (* ; - "The selection ends either here or at the start of the next line.") - (* ; - "ANN there is something on this line really selected.") - (replace (SELECTION YLIM) of SEL with (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (SETQ LNHCPY (fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE))) - (RPLACA LN LINE) - (replace (SELECTION XLIM) of SEL with (fetch (LINEDESCRIPTOR LXLIM) - of LINE] - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - [COND - (L1HCPY (* ; - "The first line of the selection is hardcopy-mode. Convert the X0 value to screen units") - (replace (SELECTION X0) of SEL - with (FIXR (FQUOTIENT (fetch (SELECTION X0) of SEL) - 35.27778] - [COND - (LNHCPY (* ; - "The last line of the selection is hardcopy-mode. Convert the XLIM value to screen units") - (replace (SELECTION XLIM) of SEL - with (FIXR (FQUOTIENT (fetch (SELECTION XLIM) of SEL) - 35.27778] - (COND - [(IEQP 0 (fetch (SELECTION DCH) of SEL)) - (* ; - "If this is a point selection, put it on the correct side of the character we selected.") - (replace (SELECTION DX) of SEL with 0) - (COND - ((EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) - (replace (SELECTION XLIM) of SEL with (fetch (SELECTION X0) of SEL))) - (T (replace (SELECTION X0) of SEL with (fetch (SELECTION XLIM) - of SEL] - (T (* ; - "Otherwise, fix DX for the selection") - (replace (SELECTION DX) of SEL with (IDIFFERENCE (fetch (SELECTION XLIM) - of SEL) - (fetch (SELECTION X0) - of SEL]) + "This can happen if LASTCHAR is not visible on the screen") + (RETURN $$PREVLINE)) + finally -(\TEDIT.FIXDELSEL - [LAMBDA (SELTOFIX TEXTOBJ CH#1 CH#LIM DCH) (* ; "Edited 30-May-91 23:00 by jds") - (* Fix up a SELTOFIX after deletion - inside that textobj) - (* Only if the Selection is set, and - is in THIS textobj) - (COND - ((AND (fetch (SELECTION SET) of SELTOFIX) - (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) - (COND - ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) - CH#LIM) (* The selection is after the deleted - text. Just move it forward) - (replace (SELECTION CH#) of SELTOFIX with (IDIFFERENCE (fetch (SELECTION CH#) - of SELTOFIX) - DCH)) - (replace (SELECTION CHLIM) of SELTOFIX with (IDIFFERENCE (fetch (SELECTION CHLIM) - of SELTOFIX) - DCH))) - ((IGREATERP (fetch (SELECTION CHLIM) of SELTOFIX) - CH#1) (* It overlaps, at least partially.) - (COND - ((IGEQ (fetch (SELECTION CH#) of SELTOFIX) - CH#1) + (* ;; + "If $$PREVLINE is NIL, we didn't advance--so we must have ended at the start") - (* If the start of the selection was inside the deleted area, it now starts where - the deletion left off.) + (RETURN (OR $$PREVLINE PSTARTLINE] + (CL:UNLESS PENDLINE (* ; + "Start could be the last line in the window, it ends there too.") + (SETQ PENDLINE PSTARTLINE)) - (replace (SELECTION CH#) of SELTOFIX with CH#1))) - (replace (SELECTION CHLIM) of SELTOFIX with (IMAX CH#1 (IDIFFERENCE (fetch (SELECTION - CHLIM) - of SELTOFIX) - DCH))) - (replace (SELECTION DCH) of SELTOFIX with (COND - ((IEQP (fetch (SELECTION CHLIM) of SELTOFIX) - CH#1) - 0) - (T (IDIFFERENCE (fetch (SELECTION CHLIM) - of SELTOFIX) - (fetch (SELECTION CH#) - of SELTOFIX]) + (* ;; + "IMAX to use the first character of PSTARTLINE if it is not the first line of the selection ") -(\TEDIT.FIXINSSEL - [LAMBDA (SELTOFIX TEXTOBJ CH#1 DCH) (* ; "Edited 30-May-91 23:00 by jds") - (* Fix up a SELTOFIX after deletion - inside that textobj) - (* Only if the Selection is set, and - is in THIS textobj) - (PROG (CH# CHLIM) - (COND - ((AND (fetch (SELECTION SET) of SELTOFIX) - (EQ TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELTOFIX))) - [COND - ((IGEQ (SETQ CH# (ffetch (SELECTION CH#) of SELTOFIX)) - CH#1) + (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))) - (* Fix up the selection; if we're beyond the insert point, move the whole sel - forward) + (* ;; + "IMIN to use the last character of PENDLINE if it is not the last line of the selection ") - (freplace (SELECTION CH#) of SELTOFIX with (IPLUS CH# DCH] - (COND - ((IGREATERP (SETQ CHLIM (ffetch (SELECTION CHLIM) of SELTOFIX)) - CH#1) (* And the tail end of the sel, too.) - (freplace (SELECTION CHLIM) of SELTOFIX with (IPLUS CHLIM DCH]) + (CL:UNLESS XLIM + (CL:WHEN (WITHINLINEP LASTCHNO PENDLINE) + (SETQ XLIM (\TEDIT.CHTOX TEXTOBJ PENDLINE LASTCHNO T)) + (FSETSEL SEL XLIM XLIM)))] -(\TEDIT.FIXSELS - [LAMBDA (TEXTOBJ EXCEPT) (* ; "Edited 30-May-91 23:03 by jds") - (* Fixes all the sels for a given - textobj.) - (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) when (NEQ SELN EXCEPT) - do (AND (fetch (SELECTION SET) of SELN) - (\FIXSEL SELN TEXTOBJ]) + (* ;; "Fill in the selection") + + (RPLACA L1 PSTARTLINE) + (RPLACA LN PENDLINE))) + SEL]) + +(\TEDIT.CHTOX + [LAMBDA (TEXTOBJ LINE CH# AFTER) (* ; "Edited 23-Dec-2023 14:07 by rmk") + (* ; "Edited 2-Dec-2023 10:01 by rmk") + (* ; "Edited 16-May-2023 00:20 by rmk") + (* ; "Edited 23-Mar-2023 23:04 by rmk") + + (* ;; "Return the screen-point X position of character CH# in LINE. ") + + (* ;; "If AFTER, returns the Xposition at the end of CH#, otherwise at the beginning.") + + (* ;; "it is an error if CH# is before LCHAR1 or after LCHARLIM.") + + (\DTEST LINE 'LINEDESCRIPTOR) + (LET (X (THISLINE (GETTOBJ TEXTOBJ THISLINE))) + (CL:WHEN (OR (FGETLD LINE LDIRTY) + (NEQ LINE (fetch DESC of THISLINE))) + + (* ;; "Reformat if LINE is dirty or not cached in THISLINE. ") + + (\FORMATLINE TEXTOBJ (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))) + then (FGETLD LINE LXLIM) + elseif (AND (NOT AFTER) + (IEQP CH# (FGETLD LINE LCHAR1))) + then (FGETLD LINE LX1) + else (for CHARSLOT (X _ (FGETLD LINE LX1)) + (CHNO _ (FGETLD LINE LCHAR1)) incharslots THISLINE unless (type? CHARLOOKS CHARW + ) + do + (* ;; "Update the running X-position in the line, skiping look-slots") + + (CL:WHEN (IEQP CHNO CH#) + (if AFTER + then (add X (CHARW CHARSLOT))) + + (* ;; + "Scale selection X down to points for lines in hardcopy-display mode.") + + (RETURN X)) + (CL:WHEN CHAR (* ; "Ignore CHARLOOKS") + (add CHNO 1) + (add X CHARW)) finally (CL:WHEN (AND (IEQP CH# (FGETLD LINE LCHAR1)) + (IGEQ (FGETLD LINE LCHARLIM) + (FGETTOBJ TEXTOBJ TEXTLEN)) + (EQ (FGETLD LINE LXLIM) + (FGETLD LINE LX1))) + + (* ;; + "CH# not found in empty final line, return left margin") + + (RETURN (FGETLD LINE LX1)))]) + +(\TEDIT.COLLECTSELS + [LAMBDA (TEXTOBJ AVOIDSEL) (* ; "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") + + (\DTEST 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) (* ; "Edited 30-May-91 23:03 by jds") - (* Reset the "Extend Pending Delete" - status) - (AND SEL (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL)) - (SETQ TEDIT.PENDINGDEL NIL) - (AND (fetch (SELECTION \TEXTOBJ) of SEL) - (replace (TEXTOBJ BLUEPENDINGDELETE) of (fetch (SELECTION \TEXTOBJ) of SEL) with NIL]) + [LAMBDA (SEL) (* ; "Edited 19-Feb-2024 23:10 by rmk") + (* ; "Edited 24-Dec-2023 00:18 by rmk") + (* ; "Edited 4-May-2023 00:08 by rmk") + (* ; "Edited 21-Oct-2022 18:41 by rmk") + (* ; "Edited 30-May-91 23:03 by jds") + + (* ;; "Reset the 'Extend Pending Delete' status") + + (CL:WHEN SEL + (\TEDIT.SET.SEL.LOOKS SEL 'NORMAL) + (CL:WHEN (GETSEL SEL SELTEXTOBJ) + (SETTOBJ (GETSEL SEL SELTEXTOBJ) + BLUEPENDINGDELETE NIL)))]) (\TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:00 by jds") - (* Set what the selection should be - displayed like, given what it's for - (NORMAL, COPY, MOVE, etc.)) + [LAMBDA (SEL OPERATION) (* ; "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) + + (* ;; + "Set what the selection should be displayed like, given what it's for (NORMAL, COPY, MOVE, etc.)") + (SELECTQ OPERATION - (NORMAL (* Regular selection) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with T)) - (COPY (* Copy source) - (replace (SELECTION HOW) of SEL with COPYSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with NIL)) - (COPYLOOKS (* copylooks source) - (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 2) - (replace (SELECTION HASCARET) of SEL with NIL)) - (MOVE (* Copy source) - (replace (SELECTION HOW) of SEL with EDITMOVESHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL)) - (DELETE (* To be deleted instantly) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL) + (NORMAL (* ; "Regular selection") + (FSETSEL SEL HOW BLACKSHADE) + (FSETSEL SEL HOWHEIGHT 1) + (FSETSEL SEL HASCARET T)) + (COPY (* ; "Copy source") + (FSETSEL SEL HOW COPYSELSHADE) + (FSETSEL SEL HOWHEIGHT 1) + (FSETSEL SEL HASCARET NIL)) + (COPYLOOKS (* ; "copylooks source") + (FSETSEL SEL HOW COPYLOOKSSELSHADE) + (FSETSEL SEL HOWHEIGHT 2) + (FSETSEL SEL HASCARET NIL)) + (MOVE (* ; "Copy source") + (FSETSEL SEL HOW EDITMOVESHADE) + (FSETSEL SEL HOWHEIGHT 16384) + (FSETSEL SEL HASCARET NIL)) + (DELETE (* ; "To be deleted instantly") + (FSETSEL SEL HOW BLACKSHADE) + (FSETSEL SEL HOWHEIGHT 16384) + (FSETSEL SEL HASCARET NIL) NIL) - (PENDINGDEL (* Delete at next type-in) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) + (PENDINGDEL (* ; "Delete at next type-in") + (FSETSEL SEL HOW BLACKSHADE) + (FSETSEL SEL HOWHEIGHT 16384) + (FSETSEL SEL HASCARET T) NIL) - (INVERTED (* For people who really want to see - what's selected.) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - NIL]) + (INVERTED (* ; + "For people who really want to see what's selected.") + (FSETSEL SEL HOW BLACKSHADE) + (FSETSEL SEL HOWHEIGHT 16384) + (FSETSEL SEL HASCARET T) + (SHOULDNT)) + SEL]) ) (DEFINEQ (\SHOWSEL - [LAMBDA (SEL HOW ON) (* ; "Edited 22-May-92 16:11 by jds") + [LAMBDA (SEL ON ONLYPANE) (* ; "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 23-Oct-2023 23:24 by rmk") + (* ; "Edited 14-Oct-2023 12:10 by rmk") + (* ; "Edited 23-May-2023 12:37 by rmk") + (* ; "Edited 1-May-2023 14:34 by rmk") + (* ; "Edited 20-Apr-2023 14:29 by rmk") + (* ; "Edited 9-Apr-2023 15:13 by rmk") + (* ; "Edited 5-Apr-2023 09:13 by rmk") + (* ; "Edited 22-May-92 16:11 by jds") + (\DTEST SEL 'SELECTION) - (* ;; "Highlight the selection SEL, according to HOW, turning it on or off according to ON") + (* ;; "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.") - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of SEL)) - (SHADE (OR (fetch (SELECTION HOW) of SEL) - BLACKSHADE)) - (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of SEL) - 1)) - LL SHOWFN) - (COND - ([OR (NOT (fetch (SELECTION SET) of SEL)) - (NOT (fetch (TEXTOBJ \WINDOW) of (fetch (SELECTION \TEXTOBJ) of SEL] + (* ;; "The selection's lines [L1...LN] are the subset of lines selected globally by CH# to CHLIM that are visible within each pane.") - (* ;; "This operation only makes sense if there is a selection, it has been set, and there's a window to do the highlighting in.") + (CL:WHEN (FGETSEL SEL SET) (* ; "Nothing to do if not set") + (PROG [(TEXTOBJ (\DTEST (FGETSEL SEL SELTEXTOBJ) + 'TEXTOBJ] - (RETURN)) - ((fetch (TEXTOBJ TXTDON'TUPDATE) of TEXTOBJ) (* ; - "We're suppressing screen updating, so don't do anything visible.") - (RETURN))) - [for DS inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as L1 in (fetch (SELECTION L1) of SEL) - as LN in (fetch (SELECTION LN) of SEL) as CARET inside (fetch (TEXTOBJ CARET) - of TEXTOBJ) - do (COND - ((fetch (SELECTION SELOBJ) of SEL) (* ; - "If it is an object and it has a non-nil showselfn then use it") - (\TEDIT.OBJECT.SHOWSEL TEXTOBJ SEL ON DS) - (RETURN))) - (COND - [(AND ON (NOT (fetch (SELECTION ONFLG) of SEL))) - (* ; - "It's off and we want to turn it on") - (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE) - (COND - [(AND (fetch (SELECTION HASCARET) of SEL) - (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) + (* ;; "This operation only makes sense if there is at least one pane to highlight in, and we are allowed to update.") - (* ;; - "If the selection has a caret, turn one on. But only if the document is actively being edited.") + (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)) - (COND - [(EQ (fetch (SELECTION POINT) of SEL) - 'LEFT) (* ; "At the LEFT end of the selection") - (COND - ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) - (\SETCARET (fetch (SELECTION X0) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of L1) - DS TEXTOBJ CARET)) - (T (MOVETO -10 -10 DS] - ((AND LN (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LN) - 0)) (* ; "Or at the RIGHT end.") - (\SETCARET (fetch (SELECTION XLIM) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of LN) - DS TEXTOBJ CARET)) - (T (* ; - "Neither end is on screen. For self-caret flashers, move the caret location off-screen") - (MOVETO -10 -10 DS] - (T (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (AND L1 (MOVETO (fetch (SELECTION X0) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of L1) - DS))) - (RIGHT (AND LN (MOVETO (fetch (SELECTION XLIM) of SEL) - (fetch (LINEDESCRIPTOR YBASE) of LN) - DS))) - NIL] - ((AND (NOT ON) - (fetch (SELECTION ONFLG) of SEL)) (* ; - "The selection is highlighted and we want to turn it off.") - (COND - ((AND (fetch (SELECTION HASCARET) of SEL) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (ffetch (TEXTOBJ TXTEDITING) of TEXTOBJ)) - (* ; - "IF the selection has a caret with it, make sure it's turned off.") - (\EDIT.UPCARET CARET) (* ; "Pick the caret up off the screen.") - )) - (\SHOWSEL.HILIGHT TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE] - (replace (SELECTION ONFLG) of SEL with ON]) + (* ;; "") -(\SHOWSEL.HILIGHT - [LAMBDA (TEXTOBJ SEL LINES L1 LN DS SHADEHEIGHT SHADE X0 XLIM) + (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))) + (* ; "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 + [LAMBDA (TEXTOBJ L1 LN PANE SEL X0 XLIM) (* ; "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) + (* ;; "") - (PROG (LL LEFT RIGHT) - (COND - ((OR L1 LN) + (* ;; "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") - (* One end or the other is on-screen, so it makes sense to try displaying - something.) + (\DTEST L1 'LINEDESCRIPTOR) + (\DTEST LN 'LINEDESCRIPTOR) - (COND - ((AND L1 (EQ L1 LN) - (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) (* It's all in a single line; - just underline the right section and - beat it) - (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) - (fetch (LINEDESCRIPTOR YBOT) of L1) - (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) - (OR X0 (fetch (SELECTION X0) of SEL))) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) - 'TEXTURE - 'INVERT SHADE)) - (T (* Different lines.) - (COND - ((AND L1 (IGEQ (fetch (LINEDESCRIPTOR YBOT) of L1) - 0)) (* If the first line is known, - underline the right section of it.) - [SETQ RIGHT (COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of L1)) - (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR LXLIM) of L1) - 35.27778))) - (T (fetch (LINEDESCRIPTOR LXLIM) of L1] - (BITBLT NIL 0 0 DS (OR X0 (fetch (SELECTION X0) of SEL)) - (fetch (LINEDESCRIPTOR YBOT) of L1) - (IDIFFERENCE RIGHT (OR X0 (fetch (SELECTION X0) of SEL))) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of L1)) - 'TEXTURE - 'INVERT SHADE))) - (SETQ LL (OR L1 LINES)) - (AND LL (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) + (* ;; "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). ") - (* The line after the first, or the top line on the screen -- - if we didn't have a first line) + (* ;; "") - (while LL until (OR (EQ LL LN) - (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Highlight every line between first - and last) - [COND - [(fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LL)) - (* This line is in hardcopy mode. - Scale the margin values) - (SETQ LEFT (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL))) - (SETQ RIGHT (\MICASTOPTS (fetch (LINEDESCRIPTOR LXLIM) of LL] - (T (SETQ LEFT (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL)) - (SETQ RIGHT (fetch (LINEDESCRIPTOR LXLIM) of LL] - (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LL) - (IDIFFERENCE RIGHT LEFT) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LL)) - 'TEXTURE - 'INVERT SHADE) - (SETQ LL (fetch (LINEDESCRIPTOR NEXTLINE) of LL))) - (COND - ((AND LL (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LL) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - (* The final line is on-screen. - Hilight it, too.) - [SETQ LEFT (COND - ((fetch (FMTSPEC FMTHARDCOPY) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LL)) - (\MICASTOPTS (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL))) - (T (fetch (LINEDESCRIPTOR LEFTMARGIN) of LL] - (BITBLT NIL 0 0 DS LEFT (fetch (LINEDESCRIPTOR YBOT) of LN) - (IDIFFERENCE (OR XLIM (fetch (SELECTION XLIM) of SEL)) - LEFT) - (IMIN SHADEHEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of LL)) - 'TEXTURE - 'INVERT SHADE))) (* Highlight the final line of the - selection) - ]) + (* ;; "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)) + (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.") + + (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 TSTFLG) (* ; "Edited 30-May-91 23:03 by jds") - (* Update the selection highlighting - to reflect the differences between - NSEL and OSEL) - (PROG ((TEXTOBJ (fetch (SELECTION \TEXTOBJ) of OSEL))) - (PROG ((SHADE (OR (fetch (SELECTION HOW) of OSEL) - BLACKSHADE)) - (SHADEHEIGHT (OR (fetch (SELECTION HOWHEIGHT) of OSEL) - 1)) - (EXCHFLG NIL) - TSEL LL) - (replace (SELECTION ONFLG) of NSEL with T) (* Make the new selection think that - we've really displayed all its new - aspects.) - [COND - ((fetch (SELECTION HASCARET) of OSEL) (* Turn off the caret, if need be) - (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) do (\EDIT.UPCARET CARET] - [COND - ((NEQ (fetch (SELECTION CH#) of NSEL) - (fetch (SELECTION CH#) of OSEL)) (* The new selection starts earlier; - add hilight at the front) - (COND - ((ILESSP (fetch (SELECTION CH#) of OSEL) - (fetch (SELECTION CH#) of NSEL)) - (* Actually, it starts later; - just exchange the selections) - (swap OSEL NSEL) - (SETQ EXCHFLG T))) - (for NEWL1 inside (fetch (SELECTION L1) of NSEL) as OLDL1 - inside (fetch (SELECTION L1) of OSEL) as LINES - inside (fetch (TEXTOBJ LINES) of TEXTOBJ) as DS - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES NEWL1 OLDL1 DS SHADEHEIGHT SHADE - (fetch (SELECTION X0) of NSEL) - (fetch (SELECTION X0) of OSEL] - (COND - (EXCHFLG (* Put the selections back as they - were.) - (swap OSEL NSEL) - (SETQ EXCHFLG NIL))) - (COND - ((ILESSP (fetch (SELECTION CHLIM) of NSEL) - (fetch (SELECTION CHLIM) of OSEL)) + [LAMBDA (NSEL OSEL TEXTOBJ) (* ; "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") - (* Arrange for NSEL to be the selection that ends later, so that one set of code - will do both earlier AND later cases.) + (* ;; "Update the selection highlighting and caret flashing to represent NSEL. Instead of normal \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.") - (swap OSEL NSEL) - (SETQ EXCHFLG T))) - (for OLDLN in (fetch (SELECTION LN) of OSEL) as NEWLN - in (fetch (SELECTION LN) of NSEL) as LINES inside (fetch (TEXTOBJ LINES) - of TEXTOBJ) as OLDL1 - in (fetch (SELECTION L1) of OSEL) as DS inside (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ) - do (\SHOWSEL.HILIGHT TEXTOBJ OSEL LINES OLDLN NEWLN DS SHADEHEIGHT SHADE - (fetch (SELECTION XLIM) of OSEL) - (fetch (SELECTION XLIM) of NSEL))) - (COND - (EXCHFLG (* Put the selections back as they - were.) - (SETQ TSEL OSEL) - (SETQ OSEL NSEL) - (SETQ NSEL TSEL))) - (COND - ((fetch (SELECTION HASCARET) of NSEL) (* Now put the caret back up.) - (for L1 in (fetch (SELECTION L1) of NSEL) as LN in (fetch (SELECTION LN) - of NSEL) as DS - inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as CARET - inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (COND - ((EQ (fetch (SELECTION POINT) of NSEL) - 'LEFT) (* Left end of the selection) - (AND L1 (\SETCARET (fetch (SELECTION X0) of NSEL) - (fetch (LINEDESCRIPTOR YBOT) of L1) - DS TEXTOBJ CARET))) - (LN (* Right end of the selection) - (\SETCARET (fetch (SELECTION XLIM) of NSEL) - (fetch (LINEDESCRIPTOR YBOT) of LN) - DS TEXTOBJ CARET]) + (* ;; + "It is also the case that the lines of NSEL and OSELfor each pane are drawn from the same lists.") -(\TEDIT.SHOWSELS - [LAMBDA (TEXTOBJ HOW ON) (* ; "Edited 30-May-91 23:03 by jds") - (* Turns all the selections for a - given Textobj on or off) - (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - do (AND (fetch (SELECTION SET) of SELN) - (\SHOWSEL SELN HOW ON]) + (* ;; "") + + (* ;; "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 (\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 NEWSEL OLDSEL OLDOP NEWOP EXTENDING) (* ; "Edited 30-May-91 23:03 by jds") + [LAMBDA (TEXTOBJ SOURCESEL OLDSEL OLDOP NEWOP EXTENDFLG) (* ; "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 NEWSEL.) + (* ;; "Update the screen hilighting to account for the changes that have taken place between OLDSEL and SOURCESEL.") - (DECLARE (USEDFREE . GLOBALSEL)) - (PROG (NOSEL) - (COND - ((AND EXTENDING (EQ OLDOP NEWOP)) + (COND + ((AND EXTENDFLG (EQ OLDOP NEWOP) + (GETSEL OLDSEL ONFLG)) - (* If we're extending a selection and the looks haven't changed, we can do it the - fast way, to prevent flicker.) + (* ;; "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 NEWSEL OLDSEL) - (\COPYSEL NEWSEL OLDSEL) - (replace (SELECTION ONFLG) of OLDSEL with T)) - (T + (\TEDIT.UPDATE.SHOWSEL SOURCESEL OLDSEL TEXTOBJ) + (\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.") + (\SHOWSEL OLDSEL NIL) + (SETSEL OLDSEL SET NIL) + (CL:UNLESS (EQ OLDOP NEWOP) + (\TEDIT.SET.SEL.LOOKS SOURCESEL NEWOP)) + (\COPYSEL SOURCESEL OLDSEL) + (SETSEL OLDSEL ONFLG NIL) (* ; + "Make sure we can turn the highlighting on.") + (\SHOWSEL OLDSEL T) + OLDSEL]) - (* Otherwise, we have to turn the old one off, change things, and turn the new - one on.) +(\TEDIT.UPDATE.SEL + [LAMBDA (SEL CH# DCH POINT DONTFIX) (* ; "Edited 5-Mar-2024 14:45 by rmk") + (* ; "Edited 25-Feb-2024 17:30 by rmk") + (* ; "Edited 16-Feb-2024 23:49 by rmk") + (* ; "Edited 17-Sep-2023 00:05 by rmk") + (* ; "Edited 12-Aug-2023 08:27 by rmk") + (* ; "Edited 6-Jun-2023 13:24 by rmk") + (* ; "Edited 7-May-2023 19:03 by rmk") - (\SHOWSEL OLDSEL NIL NIL) - (COND - ((NEQ OLDOP NEWOP) + (* ;; "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.") - (* He changed his mind about copying, deleting, or whatever -- - change the kind of selection it is.) + (* ;; "Unless DONTFIX, \FIXSEL is called to figure out the pane-lines and screen coordinates.") - (SELECTQ NEWOP - ((NORMAL PENDINGDEL) - (SETQ GLOBALSEL TEDIT.SELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (COPY (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) - (MOVE (SETQ GLOBALSEL TEDIT.MOVESELECTION) - (SETQ NOSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) - (DELETE (SETQ GLOBALSEL TEDIT.DELETESELECTION) - (SETQ NOSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))) - (COPYLOOKS (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION) - (SETQ NOSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ))) - NIL) (* Remember the new operation type.) - (replace (SELECTION SET) of OLDSEL with NIL) - (* Turn off the old kind of selection, - so it doesn't reappear to haunt us.) - (AND (fetch (SELECTION SET) of NOSEL) - (\SHOWSEL NOSEL NIL NIL)) (* If there was a new-type selection - around, turn it off.) - (SETQ OLDSEL NOSEL) (* Now cut over to the new selection) - (\TEDIT.SET.SEL.LOOKS OLDSEL NEWOP) (* And set it up looking right.) - )) - (\COPYSEL NEWSEL OLDSEL) - (replace (SELECTION ONFLG) of OLDSEL with NIL) - (* Make sure we can turn the - highlighting on.) - (\SHOWSEL OLDSEL NIL T))) - (RETURN (OR NOSEL OLDSEL]) + [if (type? TEDITHISTORYEVENT CH#) + then (* ; "History is a pseudo-selection") + (CL:UNLESS DCH + (SETQ DCH (GETTH CH# THLEN))) + (CL:UNLESS POINT + (SETQ POINT (GETTH CH# THPOINT CH#))) + (SETQ CH# (GETTH CH# THCH#)) + else + (* ;; "Get defaults from SEL (either a selection or a textobj whose SEL is indicated)") + + (CL:WHEN (type? TEXTOBJ SEL) + (SETQ SEL (TEXTSEL SEL))) + (CL:UNLESS CH# + (SETQ CH# (GETSEL SEL CH#))) + (CL:UNLESS DCH + (SETQ DCH (FGETSEL SEL DCH))) + (CL:UNLESS POINT + (SETQ POINT (FGETSEL SEL POINT)))] + + (* ;; "Restrict CH# to [1..TEXTLEN], using POINT to designate below or above") + + (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)) + + (* ;; "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) (* ; + "If we are moving around, we are moving away from any old object") + (CL:UNLESS DONTFIX (\FIXSEL SEL)) + SEL]) + +(\TEDIT.SEL.L1 + [LAMBDA (SEL PANE TEXTOBJ) (* ; "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]) + +(\TEDIT.SEL.LN + [LAMBDA (SEL PANE TEXTOBJ) (* ; "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]) + +(\TEDIT.SEL.DELETEDCHARS + [LAMBDA (SELTOFIX TARGETSEL) (* ; "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.") + + (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)) + + (* ;; + "Nothing to do if SELTOFIX is not set or the deletion happened after the selection.") + + [if (ILESSP LASTDELETEDCHNO (FGETSEL SELTOFIX CH#)) + then + (* ;; + "All deleted characters are in front of SELTOFIX, just move SETOFIXL forward") + + (add (FGETSEL SELTOFIX CH#) + (IMINUS NCHARSDELETED)) + (add (FGETSEL SELTOFIX CHLIM) + (IMINUS NCHARSDELETED)) + 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])]) ) (DEFINEQ (\COPYSEL - [LAMBDA (FROM TO) (* ; "Edited 31-May-91 12:27 by jds") - (* Copy a SELECTION record from FROM - to TO, without creating any new ones) - (replace (SELECTION Y0) of TO with (fetch (SELECTION Y0) of FROM)) - (replace (SELECTION X0) of TO with (fetch (SELECTION X0) of FROM)) - (replace (SELECTION DX) of TO with (fetch (SELECTION DX) of FROM)) - (replace (SELECTION CH#) of TO with (fetch (SELECTION CH#) of FROM)) - (replace (SELECTION XLIM) of TO with (fetch (SELECTION XLIM) of FROM)) - (replace (SELECTION CHLIM) of TO with (fetch (SELECTION CHLIM) of FROM)) - (replace (SELECTION DCH) of TO with (fetch (SELECTION DCH) of FROM)) - (replace (SELECTION L1) of TO with (COPY (fetch (SELECTION L1) of FROM))) - (replace (SELECTION LN) of TO with (COPY (fetch (SELECTION LN) of FROM))) - (replace (SELECTION YLIM) of TO with (fetch (SELECTION YLIM) of FROM)) - (replace (SELECTION POINT) of TO with (fetch (SELECTION POINT) of FROM)) - (replace (SELECTION SET) of TO with (fetch (SELECTION SET) of FROM)) - (replace (SELECTION \TEXTOBJ) of TO with (fetch (SELECTION \TEXTOBJ) of FROM)) - (replace (SELECTION SELKIND) of TO with (fetch (SELECTION SELKIND) of FROM)) - (replace (SELECTION HOW) of TO with (fetch (SELECTION HOW) of FROM)) - (replace (SELECTION HOWHEIGHT) of TO with (fetch (SELECTION HOWHEIGHT) of FROM)) - (replace (SELECTION HASCARET) of TO with (fetch (SELECTION HASCARET) of FROM)) - (replace (SELECTION SELOBJ) of TO with (fetch (SELECTION SELOBJ) of FROM)) - (replace (SELECTION ONFLG) of TO with (fetch (SELECTION ONFLG) of FROM]) + [LAMBDA (FROM TO) (* ; "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") + (\DTEST FROM 'SELECTION) + (if TO + then (\DTEST TO 'SELECTION) + (FSETSEL TO X0 (FGETSEL FROM X0)) + (FSETSEL TO CH# (FGETSEL FROM CH#)) + (FSETSEL TO XLIM (FGETSEL FROM XLIM)) + (FSETSEL TO CHLIM (FGETSEL FROM CHLIM)) + (FSETSEL TO DCH (FGETSEL FROM DCH)) + (FSETSEL TO L1 (COPY (FGETSEL FROM L1))) + (FSETSEL TO LN (COPY (FGETSEL FROM LN))) + (FSETSEL TO POINT (FGETSEL FROM POINT)) + (FSETSEL TO SET (FGETSEL FROM SET)) + (FSETSEL TO SELTEXTOBJ (FGETSEL FROM SELTEXTOBJ)) + (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))) + TO]) (\TEDIT.SEL.CHANGED? - [LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* ; "Edited 30-May-91 23:01 by jds") + [LAMBDA (NEWSEL OLDSEL OLDSELOP NEWSELOP) (* ; "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.) + (* ;; "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 (fetch (SELECTION SET) of NEWSEL) - (NOT (AND (fetch (SELECTION SET) of OLDSEL) - (EQ (fetch (SELECTION SET) of OLDSEL) - (fetch (SELECTION SET) of NEWSEL)) - (EQUAL (fetch (SELECTION CH#) of NEWSEL) - (fetch (SELECTION CH#) of OLDSEL)) - (EQUAL (fetch (SELECTION CHLIM) of NEWSEL) - (fetch (SELECTION CHLIM) of OLDSEL)) - (EQ (fetch (SELECTION \TEXTOBJ) of NEWSEL) - (fetch (SELECTION \TEXTOBJ) of OLDSEL)) - (IEQP (fetch (SELECTION DX) of NEWSEL) - (fetch (SELECTION DX) of OLDSEL)) - (EQ (fetch (SELECTION POINT) of NEWSEL) - (fetch (SELECTION POINT) of OLDSEL)) - (EQ (fetch (SELECTION HOW) of NEWSEL) - (fetch (SELECTION HOW) of OLDSEL)) - (EQ (fetch (SELECTION HOWHEIGHT) of NEWSEL) - (fetch (SELECTION HOWHEIGHT) of OLDSEL)) + (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]) ) @@ -1940,193 +1673,461 @@ (DEFINEQ (TEDIT.GETPOINT - [LAMBDA (STREAM SEL) (* ; "Edited 30-May-91 23:03 by jds") + [LAMBDA (STREAM SEL) (* ; "Edited 5-Jun-2023 15:30 by rmk") + (* ; "Edited 30-May-91 23:03 by jds") - (* Given a selection, tell the CH# that type-in would be inserted in front of. - IF SEL is given, use it to decide. Otherwise, use STREAM's current selection.) + (* ;; "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.") - (PROG [(TSEL (OR SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ STREAM] - (RETURN (IMAX 1 (SELECTQ (fetch (SELECTION POINT) of TSEL) - (LEFT (fetch (SELECTION CH#) of TSEL)) - (RIGHT (fetch (SELECTION CHLIM) of TSEL)) - (SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."]) + (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.") + + (SELECTQ (FGETSEL SEL POINT) + (LEFT (FGETSEL SEL CH#)) + (RIGHT (FGETSEL SEL CHLIM)) + (SHOULDNT "Selection's POINT is neither RIGHT nor LEFT."]) (TEDIT.GETSEL - [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") - (create SELECTION using (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) + [LAMBDA (TSTREAM) (* ; "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]) + +(TEDIT.GETSEL.PARA + [LAMBDA (TSTREAM) (* ; "Edited 16-Jan-2024 14:59 by rmk") + (* ; "Edited 1-May-2023 21:07 by rmk") + (* ; "Edited 30-May-91 23:03 by jds") + + (* ;; "Returns a selection that runs from the beginning of the paragraph containing the first currently selected character to the end of the paragraph that contains the last currently selected character.") + + (LET* [(TEXTOBJ (TEXTOBJ TSTREAM)) + (SEL (FGETTOBJ TEXTOBJ SEL)) + [PCH# (CAR (\TEDIT.PARA.FIRST TEXTOBJ (GETSEL SEL CH#] + (PCHLIM (ADD1 (CAR (\TEDIT.PARA.LAST TEXTOBJ (SUB1 (GETSEL SEL CHLIM] + (create SELECTION using SEL CH# _ PCH# CHLIM _ PCHLIM DCH _ (IDIFFERENCE PCHLIM PCH#) + ONFLG _ NIL SET _ T]) (TEDIT.MAKESEL - [LAMBDA (STREAM CH# LEN POINT) (* ; "Edited 30-May-91 23:03 by jds") - (PROG ((SEL (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (\SHOWSEL SEL NIL NIL) - (replace (SELECTION CH#) of SEL with CH#) - (replace (SELECTION CHLIM) of SEL with (IMAX CH# (IPLUS CH# LEN))) - (replace (SELECTION DCH) of SEL with LEN) - (replace (SELECTION POINT) of SEL with (OR POINT 'LEFT)) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (replace (SELECTION SET) of SEL with T) - (AND (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - (\FIXSEL SEL TEXTOBJ)) - (\SHOWSEL SEL NIL T]) + [LAMBDA (STREAM CH# LEN POINT) (* ; "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))) + (\SHOWSEL SEL NIL) + (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) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL T]) (TEDIT.SCANSEL - [LAMBDA (STREAM) (* ; "Edited 30-May-91 23:03 by jds") + [LAMBDA (TSTREAM) (* ; "Edited 26-May-2023 22:35 by rmk") + (* ; "Edited 8-Sep-2022 23:29 by rmk") + (* ; "Edited 30-May-91 23:03 by jds") - (* Set up to read the selected text; return the sel's length or NIL if nothing - selected.) + (* ;; "Set up to read the selected text; return the sel's length or NIL if nothing selected.") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - SEL) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (COND - ((fetch (SELECTION SET) of SEL) - (\SETUPGETCH (fetch (SELECTION CH#) of SEL) - TEXTOBJ) - (RETURN (fetch (SELECTION DCH) of SEL))) - (T (RETURN NIL]) + (LET [(SEL (fetch (TEXTOBJ SEL) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM] + (CL:WHEN (GETSEL SEL SET) + (\TEXTSETFILEPTR TSTREAM (SUB1 (GETSEL SEL CH#))) + (GETSEL SEL DCH))]) (TEDIT.SET.SEL.LOOKS - [LAMBDA (SEL OPERATION) (* ; "Edited 30-May-91 23:01 by jds") - (* Set what the selection should be - displayed like, given what it's for - (NORMAL, COPY, MOVE, etc.)) - (PROG ((WASON (fetch (SELECTION ONFLG) of SEL))) - (\SHOWSEL SEL NIL NIL) - (SELECTQ OPERATION - (NORMAL (* Regular selection) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with T)) - (COPY (* Copy source) - (replace (SELECTION HOW) of SEL with COPYSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 1) - (replace (SELECTION HASCARET) of SEL with NIL)) - (COPYLOOKS (* copylooks source) - (replace (SELECTION HOW) of SEL with COPYLOOKSSELSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 2) - (replace (SELECTION HASCARET) of SEL with NIL)) - (MOVE (* Copy source) - (replace (SELECTION HOW) of SEL with EDITMOVESHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL)) - (DELETE (* To be deleted instantly) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with NIL) - NIL) - (PENDINGDEL (* Delete at next type-in) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - (INVERTED (* For people who really want to see - what's selected.) - (replace (SELECTION HOW) of SEL with BLACKSHADE) - (replace (SELECTION HOWHEIGHT) of SEL with 16384) - (replace (SELECTION HASCARET) of SEL with T) - NIL) - NIL) - (\SHOWSEL SEL NIL WASON]) + [LAMBDA (SEL OPERATION) (* ; "Edited 12-Oct-2023 22:32 by rmk") + (* ; "Edited 10-Jun-2023 13:35 by rmk") + (* ; "Edited 20-May-2023 23:53 by rmk") + (* ; "Edited 18-Apr-2023 23:53 by rmk") + (* ; "Edited 30-May-91 23:01 by jds") + + (* ;; "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))) + (\SHOWSEL SEL NIL) + (\TEDIT.SET.SEL.LOOKS SEL OPERATION) + (\SHOWSEL SEL WASON) + SEL]) (TEDIT.SETSEL [LAMBDA (STREAM CH# LEN POINT PENDINGDELFLG LEAVECARETLOOKS OPERATION) + (* ; "Edited 22-Sep-2023 18:09 by rmk") + (* ; "Edited 3-Aug-2023 23:12 by rmk") + (* ; "Edited 23-May-2023 16:50 by rmk") + (* ; "Edited 18-Apr-2023 23:54 by rmk") + (* ; "Edited 27-Mar-2023 13:07 by rmk") (* ; "Edited 30-May-91 23:05 by jds") (* ;; "Given a text stream or textobj, and a piece of text to select, set the internal selection, and return it.") - (* ; "Make sure we got a stream") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - SEL TEXTLEN) - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (\SHOWSEL SEL NIL NIL) (* ; "First turn the old sel off.") - [COND - ((type? SELECTION CH#) (* ; + + (LET ((TEXTOBJ (TEXTOBJ STREAM)) + SEL TEXTLEN PC) + (SETQ SEL (TEXTSEL TEXTOBJ)) + (SETQ TEXTLEN (TEXTLEN TEXTOBJ)) + (\SHOWSEL SEL NIL) (* ; "First turn the old sel off.") + [COND + ((type? SELECTION CH#) (* ;  "He gave use a selection; just plug it in") - (\COPYSEL CH# SEL) - (replace (SELECTION ONFLG) of SEL with NIL) (* ; + (\COPYSEL CH# SEL) (* ;  "And make sure it can be turned on.") - ) - (T (* ; "He fed us numbers; use them") - (replace (SELECTION CH#) of SEL with (IMIN (IMAX 1 CH#) - (ADD1 TEXTLEN))) - (* ; "Starting character") - [replace (SELECTION CHLIM) of SEL with (IMAX 1 CH# (IMIN (IPLUS CH# LEN) - (ADD1 TEXTLEN] - (* ; "Last selected character") - [replace (SELECTION DCH) of SEL with (IMIN LEN TEXTLEN (IDIFFERENCE - (fetch (SELECTION CHLIM) - of SEL) - (fetch (SELECTION CH#) - of SEL] - (replace (SELECTION POINT) of SEL with (OR (AND (IGREATERP CH# TEXTLEN) - 'LEFT) - POINT - 'LEFT)) - (* ; "Which side the caret should go on") - (COND - ((OR (IGREATERP (fetch (SELECTION CH#) of SEL) - TEXTLEN) - (NEQ 1 LEN)) - (replace (SELECTION SELOBJ) of SEL with NIL)) - (T (replace (SELECTION SELOBJ) of SEL with (fetch (PIECE POBJ) - of (\CHTOPC (fetch (SELECTION CH#) - of SEL) - (fetch (TEXTOBJ PCTB) - of TEXTOBJ] - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) (* ; + (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))) (* ; + "Starting character. If beyond TEXTLEN, then just after EOF") + (SETSEL SEL CH# CH#) + [SETSEL SEL CHLIM (IMAX CH# (IMIN (IPLUS CH# LEN) + (ADD1 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 (\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 (* ; + [COND + [PENDINGDELFLG (* ;  "This selection is to be a pending-deletion sel.") - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T) - (* ; + (SETTOBJ TEXTOBJ BLUEPENDINGDELETE T) (* ;  "Warn TEdit that there's a deletion pending") - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'PENDINGDEL)) - (* ; - "And make the selection look right.") - ) - (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) - (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] - (replace (SELECTION SET) of SEL with T) (* ; + (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (\TEDIT.SET.SEL.LOOKS SEL (OR OPERATION 'NORMAL] + (SETSEL SEL SET T) (* ;  "Mark the selection as valid for others to use") - [COND - ((NOT LEAVECARETLOOKS) (* ; + (CL:UNLESS LEAVECARETLOOKS (* ;  "And set the insertion looks to follow.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL] - (\FIXSEL SEL TEXTOBJ) (* ; + (SETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))) + (\FIXSEL SEL TEXTOBJ) (* ;  "Update the selection's screen location") - (\SHOWSEL SEL NIL T) (* ; "Highlight it on the screen") - (RETURN SEL]) + (\SHOWSEL SEL T) (* ; "Highlight it on the screen") + SEL]) (TEDIT.SHOWSEL - [LAMBDA (STREAM ONFLG SEL) (* ; "Edited 30-May-91 23:04 by jds") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (COND - (SEL (* He's giving us a selection to - highlight. Connect it to this textobj.) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ) - (\FIXSEL SEL TEXTOBJ))) - (\SHOWSEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - NIL ONFLG]) + [LAMBDA (STREAM ONFLG SEL) (* ; "Edited 3-May-2023 09:23 by rmk") + (* ; "Edited 18-Apr-2023 23:54 by rmk") + (* ; "Edited 21-Oct-2022 18:36 by rmk") + + (* ;; "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))) + (CL:UNLESS SEL + (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) + (CL:WHEN SEL + (SETSEL SEL SELTEXTOBJ TEXTOBJ) + (\FIXSEL SEL TEXTOBJ) + (\SHOWSEL SEL ONFLG))]) +) + + + +(* ;; "SELPIECES") + +(DEFINEQ + +(\SELPIECES + [LAMBDA (SEL/FIRSTCHAR LASTCHAR TEXTOBJ) (* ; "Edited 4-Mar-2024 22:47 by rmk") + (* ; "Edited 12-Dec-2023 12:06 by rmk") + (* ; "Edited 11-Dec-2023 10:05 by rmk") + (* ; "Edited 2-Jun-2023 20:36 by rmk") + (* ; "Edited 31-May-2023 10:27 by rmk") + (* ; "Edited 5-Sep-2022 14:40 by rmk") + + (* ;; "This converts a selection to the SELPIECES of the properly aligned pieces that SEL/FIRSTCHAR selects. .") + + (* ;; "The first character of SPFIRST is the first character selected in TEXTOBJ and the last character of SPLAST is the last character of the last selected piece in TEXTOBJ. The pieces maintain their chain-sequence pointers in TEXTOBJ. The pieces must be copied and re-chained if they are going to be used in any way that is inconsistent with where they may still be linked into the text.") + + (* ;; "") + + (* ;; "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.") + + (* ;; "SPLEN is the sum of the lengths of the selected pieces.") + + (* ;; "The I.S.OPR inselpieces iterates over the pieces in SELPIECES.") + + (* ;; "") + + (* ;; "For convenience the %"selection%" can be specified by FIRSTCHAR and LASTCHAR parameters, plus TEXTOBJ. ") + + (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)))] + elseif (type? TEDITHISTORYEVENT SEL/FIRSTCHAR) + then (SETQ FIRSTCHAR (GETTH SEL/FIRSTCHAR THCH#)) + (SETQ LASTCHAR (GETTH SEL/FIRSTCHAR THCHLIM)) + else (SETQ FIRSTCHAR SEL/FIRSTCHAR)) + + (* ;; "Do the right first so that we retain the center piece when FIRTCHAR and LASTCHAR are in the same original piece.") + + (SETQ RIGHTPC (\ALIGNEDPIECE (ADD1 LASTCHAR) + TEXTOBJ)) + (SETQ LEFTPC (\ALIGNEDPIECE FIRSTCHAR TEXTOBJ)) + (create SELPIECES + SPFIRST _ LEFTPC + SPLAST _ (PREVPIECE RIGHTPC) + SPLEN _ (ADD1 (IDIFFERENCE LASTCHAR FIRSTCHAR)) + SPFIRSTCHAR _ FIRSTCHAR + SPLASTCHAR _ LASTCHAR]) + +(\SELPIECES.COPY + [LAMBDA (SELPIECES OPERATION TOTEXTOBJ FROMTEXTOBJ) (* ; "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") + (* ; "Edited 7-May-2023 17:26 by rmk") + + (* ;; "Produces a copy of SELPIECES where the pieces from first to last are chained-together copies of the original pieces so that later inpieces can run from first to last. OPERATION determines which imageobject functions will be invoked, if any.") + + (* ;; "FROMTEXTOBJ is optional. Providing a FROMTEXTOBJ that is different from TOTEXTOBJ is a signal that this is a cross-copy needing to create private copies of strings and files. ") + + (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") + + (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]) + +(\SELPIECES.CONCAT + [LAMBDA (SP1 SP2 TEXTOBJ) (* ; "Edited 3-Mar-2024 12:24 by rmk") + (* ; "Edited 11-Dec-2023 23:03 by rmk") + (* ; "Edited 3-Jun-2023 17:08 by rmk") + (* ; "Edited 2-Jun-2023 12:09 by rmk") + (* ; "Edited 21-May-2023 22:20 by rmk") + + (* ;; "The returned SELPIECE concatenates the pieces in SP1 and SP2. Probably only sensible if those pieces are consecutive with respect to some textobj or some operation. ") + + (* ;; "NOTE: This modifies the actual pieces to connect them together. Caller is responsible for insuring that this is safe.") + + (if (NULL (fetch (SELPIECES SPFIRST) of SP1)) + then SP2 + elseif (NULL (fetch (SELPIECES SPFIRST) of SP2)) + then SP1 + else (freplace (PIECE NEXTPIECE) of (ffetch (SELPIECES SPLAST) of SP1) + with (ffetch (SELPIECES SPFIRST) of SP2)) + (freplace (PIECE PREVPIECE) of (ffetch (SELPIECES SPFIRST) of SP2) + with (ffetch (SELPIECES SPLAST) of SP1)) + (create SELPIECES + SPFIRST _ (ffetch (SELPIECES SPFIRST) of SP1) + SPLAST _ (ffetch (SELPIECES SPLAST) of SP2) + SPLEN _ (IPLUS (ffetch (SELPIECES SPLEN) of SP1) + (ffetch (SELPIECES SPLEN) of SP2)) + SPFIRSTCHAR _ (ffetch (SELPIECES SPFIRSTCHAR) of SP1) + SPLASTCHAR _ (ffetch (SELPIECES SPLASTCHAR) of SP2]) + +(\SELPIECES.CHARTRANSFORM + [LAMBDA (SELPIECES CHARFN OBJECTSTOO TEXTOBJ) (* ; "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.") + + (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 + + (* ;; "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.") + + (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)]) + (OBJECT.PTYPE (CL:WHEN OBJECTSTOO + (FSETPC PC PCONTENTS (APPLY* CHARFN PCONTENTS TEXTOBJ)))) + (SUBSTREAM.PTYPE + (HELP "SUBSTREAM PIECE ?")) + (SHOULDNT))) + SELPIECES]) + +(\SELPIECES.FROM.STRING + [LAMBDA (STRING TEXTOBJ CHECKFOREOL CHARLOOKS PARALOOKS) (* ; "Edited 3-Mar-2024 13:00 by rmk") + (* ; "Edited 28-Jan-2024 08:28 by rmk") + (* ; "Edited 11-Dec-2023 08:12 by rmk") + (* ; "Edited 25-Nov-2023 15:22 by rmk") + (* ; "Edited 11-Nov-2023 15:49 by rmk") + (* ; "Edited 2-Jun-2023 11:59 by rmk") + (* ; "Edited 24-May-2023 15:26 by rmk") + + (* ;; "Creates SELPIECES with pieces representing STRING. If CHECKFOREOL and the string contains a paragraph-breaking character, then the string will be coded as a sequence of pieces with EOL-terminated pieces (but not necessarily the last piece) marked as PPARALAST. ") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (CL:UNLESS CHARLOOKS + (SETQ CHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS))) + (CL:UNLESS PARALOOKS + (SETQ PARALOOKS (FGETTOBJ TEXTOBJ FMTSPEC))) + (CL:WHEN (AND TEXTOBJ (FGETTOBJ TEXTOBJ FORMATTEDP)) + (SETQ CHECKFOREOL T)) + (LET (FIRSTPIECE EOLPOS (BYTESPERCHAR 1) + (PTYPE THINSTRING.PTYPE) + (PBINABLE T)) + (SETQ STRING (CONCAT STRING)) + (CL:WHEN (fetch (STRINGP FATSTRINGP) of STRING) + (SETQ PTYPE FATSTRING.PTYPE) + (SETQ PBINABLE NIL) + (SETQ BYTESPERCHAR 2)) + (if (AND CHECKFOREOL (SETQ EOLPOS (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL))) + STRING))) + then + (* ;; "Break it up into PPARALAST pieces") + + [bind PC STR PREVPC (NCHARS _ (NCHARS STRING)) + (LASTEOLPOS _ 0) + collect (SETQ STR (SUBSTRING STRING (ADD1 LASTEOLPOS) + (SETQ LASTEOLPOS EOLPOS))) + (PROG1 + (SETQ PC + (create PIECE + PTYPE _ PTYPE + PCONTENTS _ STR + PLEN _ (NCHARS STR) + PBYTELEN _ (ITIMES (NCHARS STR) + BYTESPERCHAR) + PLOOKS _ CHARLOOKS + PPARALOOKS _ PARALOOKS + PPARALAST _ T + PREVPIECE _ PC + PBINABLE _ PBINABLE)) + (CL:WHEN PREVPC (FSETPC PREVPC NEXTPIECE PC)) + (SETQ PREVPC PC) + (SETQ EOLPOS (OR (STRPOS (CONSTANT (CHARACTER (CHARCODE EOL))) + STRING + (ADD1 LASTEOLPOS)) + NCHARS))) repeatuntil (IGEQ LASTEOLPOS NCHARS) + finally (CL:UNLESS (EQ (CHARCODE EOL) + (NTHCHARCODE STR -1)) + (* ; "Last piece didn't end in EOL") + (FSETPC PC PPARALAST NIL)) + (RETURN (create SELPIECES + SPFIRST _ (CAR $$VAL) + SPLAST _ PC + SPLEN _ NCHARS + SPFIRSTCHAR _ 1 + SPLASTCHAR _ (NCHARS STRING] + else (SETQ FIRSTPIECE (create PIECE + PTYPE _ PTYPE + PCONTENTS _ STRING + PLEN _ (NCHARS STRING) + PBYTELEN _ (ITIMES (NCHARS STRING) + BYTESPERCHAR) + PBYTESPERCHAR _ BYTESPERCHAR + PBINABLE _ PBINABLE + PLOOKS _ CHARLOOKS + PPARALOOKS _ PARALOOKS)) + (create SELPIECES + SPFIRST _ FIRSTPIECE + SPLAST _ FIRSTPIECE + SPLEN _ (NCHARS STRING) + SPFIRSTCHAR _ 1 + SPLASTCHAR _ (NCHARS STRING]) + +(\SELPIECES.TO.STRING + [LAMBDA (SELPIECES OBJECTCHARCODE TEXTOBJ) (* ; "Edited 3-Mar-2024 12:24 by rmk") + (* ; "Edited 2-Jun-2023 12:07 by rmk") + (* ; "Edited 24-May-2023 20:00 by rmk") + + (* ;; "Produce a string representing the contents of SELPIECES. Optional OBJECTCHARCODE is a code to be used to represent an image object. If it is a TEXTOBJ with an OBJECTBYTE property, then that code is used. Otherwise, arbitrarily the escape character.") + + (* ;; "Would it be better to take the chracters from the PREPRINTFN, if present?") + + (for PC PCONTENTS (I _ 1) + (RESULT _ (ALLOCSTRING (fetch (SELPIECES SPLEN) of SELPIECES))) inselpieces SELPIECES + do (SETQ PCONTENTS (PCONTENTS PC)) + (SELECTC (PTYPE PC) + (STRING.PTYPES (RPLSTRING RESULT I PCONTENTS) + (add I (PLEN PC))) + (FILE.PTYPES (SETFILEPTR PCONTENTS (PFPOS PC)) + (for J from 1 to (PLEN PC) do (RPLCHARCODE RESULT I (\INCCODE PCONTENTS)) + (add I 1))) + (OBJECT.PTYPE (* ; + "Could run the PREPRINTFN ? But we then have to let the string grow.") + (RPLCHARCODE RESULT I (OR (SMALLP OBJECTCHARCODE) + [AND (SETQ OBJECTCHARCODE (GETTEXTPROP + TEXTOBJ + 'OBJECTBYTE] + (CHARCODE ESCAPE))) + (add I 1)) + (SUBSTREAM.PTYPE + (HELP "SUBSTREAM PIECE?")) + (SHOULDNT)) finally (RETURN RESULT]) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4062 18300 (TEDIT.SEL.AS.STRING 4072 . 5538) (TEDIT.SELECTED.PIECES 5540 . 8917) ( -\TEDIT.FIND.FIRST.LINE 8919 . 12548) (\TEDIT.FIND.LAST.LINE 12550 . 13830) ( -\TEDIT.FIND.OVERLAPPING.LINE 13832 . 14246) (\TEDIT.FIND.PROTECTED.END 14248 . 16140) ( -\TEDIT.FIND.PROTECTED.START 16142 . 17741) (\TEDIT.WORD.BOUND 17743 . 18298)) (18344 18823 ( -\CREATE.TEDIT.SELECTION 18354 . 18424) (\CREATE.TEDIT.SHIFTEDSELECTION 18426 . 18529) ( -\CREATE.TEDIT.MOVESELECTION 18531 . 18660) (\CREATE.TEDIT.DELETESELECTION 18662 . 18821)) (19575 77628 - (TEDIT.EXTEND.SEL 19585 . 31241) (TEDIT.SELECT 31243 . 35576) (TEDIT.SCAN.LINE 35578 . 53641) ( -TEDIT.SELECT.LINE.SCANNER 53643 . 71700) (\TEDIT.SELECT.CHARACTER 71702 . 77626)) (77629 104700 ( -\FIXSEL 77639 . 99627) (\TEDIT.FIXDELSEL 99629 . 102654) (\TEDIT.FIXINSSEL 102656 . 103984) ( -\TEDIT.FIXSELS 103986 . 104698)) (104701 108153 (TEDIT.RESET.EXTEND.PENDING.DELETE 104711 . 105286) ( -\TEDIT.SET.SEL.LOOKS 105288 . 108151)) (108154 129235 (\SHOWSEL 108164 . 113480) (\SHOWSEL.HILIGHT -113482 . 119629) (\TEDIT.UPDATE.SHOWSEL 119631 . 125313) (\TEDIT.SHOWSELS 125315 . 126016) ( -\TEDIT.REFRESH.SHOWSEL 126018 . 129233)) (129236 132971 (\COPYSEL 129246 . 131413) ( -\TEDIT.SEL.CHANGED? 131415 . 132969)) (133024 144800 (TEDIT.GETPOINT 133034 . 133743) (TEDIT.GETSEL -133745 . 133985) (TEDIT.MAKESEL 133987 . 134884) (TEDIT.SCANSEL 134886 . 135534) (TEDIT.SET.SEL.LOOKS -135536 . 138691) (TEDIT.SETSEL 138693 . 144152) (TEDIT.SHOWSEL 144154 . 144798))))) + (FILEMAP (NIL (12813 14678 (\TEDIT.SELECTION.DEFPRINT 12823 . 14676)) (14679 15800 ( +\TEDIT.SET.GLOBAL.SELECTIONS 14689 . 15798)) (15837 24072 (TEDIT.SEL.AS.STRING 15847 . 17434) ( +TEDIT.SEL.AS.SEXPR 17436 . 18422) (TEDIT.SELECTALL 18424 . 18754) (TEDIT.SELECTED.PIECES 18756 . 20100 +) (\TEDIT.FIND.PROTECTED.END 20102 . 21591) (\TEDIT.FIND.PROTECTED.START 21593 . 23407) ( +\TEDIT.WORD.BOUND 23409 . 24070)) (24206 55670 (\TEDIT.EXTEND.SEL 24216 . 31192) (\TEDIT.SELECT 31194 + . 32576) (\TEDIT.SCAN.LINE 32578 . 40579) (\TEDIT.SCAN.LINE.WORD 40581 . 44701) ( +\TEDIT.SELECT.LINE.SCANNER 44703 . 51752) (\TEDIT.SELECT.OBJECT 51754 . 55668)) (55671 70565 (\FIXSEL +55681 . 66203) (\TEDIT.CHTOX 66205 . 69192) (\TEDIT.COLLECTSELS 69194 . 70245) (\TEDIT.SELECTION.UNSET + 70247 . 70563)) (70566 73705 (TEDIT.RESET.EXTEND.PENDING.DELETE 70576 . 71413) (\TEDIT.SET.SEL.LOOKS +71415 . 73703)) (73706 95087 (\SHOWSEL 73716 . 77434) (\TEDIT.SHOWSEL.HILIGHT 77436 . 80949) ( +\TEDIT.UPDATE.SHOWSEL 80951 . 87264) (\TEDIT.REFRESH.SHOWSEL 87266 . 89502) (\TEDIT.UPDATE.SEL 89504 + . 92626) (\TEDIT.SEL.L1 92628 . 92916) (\TEDIT.SEL.LN 92918 . 93206) (\TEDIT.SEL.DELETEDCHARS 93208 + . 95085)) (95088 98176 (\COPYSEL 95098 . 96786) (\TEDIT.SEL.CHANGED? 96788 . 98174)) (98229 108797 ( +TEDIT.GETPOINT 98239 . 99188) (TEDIT.GETSEL 99190 . 99510) (TEDIT.GETSEL.PARA 99512 . 100461) ( +TEDIT.MAKESEL 100463 . 101445) (TEDIT.SCANSEL 101447 . 102121) (TEDIT.SET.SEL.LOOKS 102123 . 103004) ( +TEDIT.SETSEL 103006 . 107972) (TEDIT.SHOWSEL 107974 . 108795)) (108825 125578 (\SELPIECES 108835 . +111812) (\SELPIECES.COPY 111814 . 113683) (\SELPIECES.CONCAT 113685 . 115558) ( +\SELPIECES.CHARTRANSFORM 115560 . 118580) (\SELPIECES.FROM.STRING 118582 . 123497) ( +\SELPIECES.TO.STRING 123499 . 125576))))) STOP diff --git a/library/tedit/TEDIT-SELECTION.LCOM b/library/tedit/TEDIT-SELECTION.LCOM index 0a41f917e3d8843e54c1343416a5566702b4c871..9a5c77d1e0c877c2c80d57a0fa53c7f6190dcd9c 100644 GIT binary patch literal 25624 zcmcJ2dvILWdEf2=1mQIWEf#ACf?((hqGV7mAnXGV(jI&7K7hUZx)87+0Es3x_aIPCBHzH=YD0F`Pom1eN_oO{l>=kYy$-*>)qIGjpP8^!d&z(o1FDw?)seF3*H$S@yQ|W?1gi7v*&*G`3o;RazZ=B zO^hzgrqG{Jw4|-!gVPK7yyk9XbaZq`E1$tv4`@AdVk|s#?Eh(CA7mg}I5Ivl7S>Mi zAQQ{lg=Z_8|3osQ7iZG*BPCNCo-WSsAHgy0#Oz%9q+u@1kI<+vf6dbon>rC08`AtA zpflsg{A#A0$p%5p&SB}b6R9cx@T?Zq@@7(-)gl^`$E+6C7BfaNgRC*FlwK;CiL7QI zcfN$xFW_-ZLu$_V;)nLbSR9_{IxD%m@pI*7M1}eMX;`Em{{_%(CtNGU`f9;7xK)FC{Y(ZG6IBh}fi+twpEo z+z7X+p%2!AjXO=DKX@~#4gKa2e#f+-$A`4=@hIpEzf;KP--tH!X{0A(+Rzu~PvB`H ztPOqc{0rwU;yH%r75qlVrS#Z@HZ(G%Q6nQ@A)CfZqceFkq34Msg}3J|GQ)%j6`2cj z$u!Oz5# zug+9j&-j+AZ*)>aOi@^ujJc3cf&U_7F)UK4WX_({^IA9>(-P)FF$D%38`n-H&Dmv| zrKza%JP~uAV-e>$;*=rc10Chl(;!-u`Hl8Ado4=Kv+0L_1LR0#0tq~t!YY+$Eo7~< z;}e=>X;Va7RD`;bH_hC!^$5p|CdD7Jq*n~1PkgK#apE0KKPuC`v;lwp|)Cxi+`7ilOF?_4ULIvIj&3jj>-;aWGdahwp{k-e`Mt1 z+J}kQ>bc6Tr>Z|QKy+d7{@iSyL{rjCrM0Q!q1eN&ssy#aciSPSh>nK#i6Z3PXrl6}0gwZ3x1mc}mkuvvV?|1~k!h zeg+d5(dJU61PKV1qWA^DN;}##o*%Qp%43+?agW#2E+YP{r(EWlit9WriS4#oPV!&kY@qUZ=M zJWCnX6Ra@EULzi4HBQ1|f@K4qn!le;jm{cr2xg1CC$w2Y1-t_4jR6{%F6whLfC^en z9>aKyYFwb8&rTElN3`UeIX}@@& zSQ|{fT#TpE8|}$^yDk-P2mYR9NOrJI-vRvLU#6)=0@);*D2Iks^>h zmTAr`fncy;kdfAEVF?7o&6o7K(ug@d!cFpO81XO?VIUUzwQ&OY$AD;ROT@7X zK5wRM>|L%K!L#k%TALnUSl)q;PxN0 zl^r6!N$8~vlv)x!pBQ6^#0o@w%7-y^YhHT@nRTPl zv2*K9qv5v)@m40WSNnz0G>DxHh5-HO3?T+>2gxZz0Ib_L1eOmh46KfeRGHU>7cxBW z1nq&To2UMHFS@BmwX2l`{``spyQ%HNPZK9AQU-JA8+Z0IIOR?Ne>!ilj7|cyZ%aU! z5G3#jHPD>2%Ez$CKw%CWGeRbSjM;)y_6YGw$prnAGMI(%Dkd`^VLVRIgMrY#-Q zyno(>Pl{C9{gI&n>`QePQ@h1Q2)I%!0b`RvC$MaPA z6@djT=`JS%xs+(JM#rf{!~Yp@;ptq%ztUAOyY^~{Vt(%j+-~)gW>;ZnC0JiKgL|)< z!QaO3PBFi;5<*T0IU(ePcJ^LgTM0-PzG^=`Syp|le3IF$xP)p&587m*A&dfP{K%+=0wmEQZ9iu|(@0 zgMnlt^eAkgyNllFIN-R@`vHPE3PGpTe7RJDyC*F2X>m&gy9KC8(?U~k!-EHIWoo{M;n3& zqmVK)FcDEFVu2YvyI9mS4O!Y5*AvrBe!SF4xH@LK#GogL@vn)?u0AA^QQ$;RCe1}N ziD{<13{wZ$S&AO8I0vo?EMYsJrf!rbV{|^L7mMT#V7a;oxnnLuU(aG@d1!}Qv{VXtA|RU=A>H6iphtQd!~79sr!}9|7;a?Jb7?#?*igk7Ow8v^ zDg#Ht5`G|xmlF7e4VEdIctG<)Ya~6Xo+=Ocmz+aaQ3Q05G3I&A{~qf|GBu(t@#3kr zTwug^I7F-1nCiabx3rvRcPnJsJH0xu(pldnWdQk4mp_vz7a_LFXWR8g@2P~|=-gWg zeH%ZOowM!rOn11;>@D-szYO^#g1Y0HQjeW01NCgf196jW_#k1j=D_aO6K3C!&HnNs z@3-oCv%h-$dUdM!8MFV^JBi}n)-f~qQsFdOu1@6y{rCdwP^^%@D$QuSll^srI-T+WL6hFavrbS(r}GbbX5}{$5Ic zr5UgluSDHw1dK+PLN3AXXpcF#GE_GQR*u$9ZM)qFwEe);RvxXde$~{x_%$`(idHv| zw$=X19BQlmh56|8?#t$o-iJK;GvuS{M}5^lhLDc9n2(tZ;DO{{6!xmceHN!M=FlLG zPEC`$phUz)Y!@X5g*Y)|@E)+}i-Csfo@=V2rITfB!gNcON1rA6j#8EB@baTC3#rnJCcX2Y|AGt z;OuKX1kRXk**}wTock;tPJxuqn z)D?*9L_UC$N_7C+m;tb9kbZo?RAzAduo=2h9ph?SG2ILb3fekW5P?7fpf+Fz-^mj0 zx^*q{?44V0ngKwh-B&j~|D@i-pNDMdP6o{ZTQ&`F?MBDSp!M-i;-W!(92_%UVSI(5>r6<VEVFgIF2d zytBeho(hHXz*bRlr&xBtsMtnfu!`bYm&F7%YN0LAa1<=S3>pPCA!-uBh@z^)nKr{l z$PsB5io^snfD=I?7QK+a+fIa!yWWK1K6h#p_Od?#r@UPUlE!`pEU=#yy9@n7CXxS| z{p{LM^2~W`e{KAlhRv!o=ga&R?S*q2=bpK^_T2dww2RLPvU0NAF7*9i!s1}qp7|m% z5jZK21Qh-({s$fd*Wv*J0)N58fN#Q%tlA@-!452??3VBz--b2X1qP&24>^U zzzo9E0%n2_$;p2gi01t>IH*3fI@867D=w=1YTK7KJ-55#u+|SHFXe>=2Db0XZ?_eK zOXaQmSHG^z8|HKn~R#85X9m|^w=R+DBZ1C`o~KhA3g83r0eThw6h z4o{%dP^RIBwT2R8`*wTS{F%1E=jK7!=ymW*Ja%9%% z9a}|g1tQ`2VUU1{gkBW$u!Wx(!4BC%8qUg3wH@(!*5chk-#n8oi;`>erIU+Yi-DcR z;GzQfzMaLs#s0?V!eVISL)m+~R{NhB;0om48@ENhvdzYiYbRur2~^QC@6`Ro0(R+& z>67VV347!u=xzU%m~o@7X_gr->V>pS<3f?_z!BxPrTLYSJtjk&&g(Oj8Py&`kz_iZ z!gSB4=P3`9(=r8+u4;9X`LteKn5Fe8pfD{4uL)Ly77x2p*xs?;P13q0%;vR0*HKCq zh-i(T9CXEN)6yj@z`r@v>G6uhSm4QDSncocUkt2D>h@xn&*$^*ND8k`_CIrEfANsW zd7r!1-&JY7yx8Sk>}?#yLc3hm_@I}%(BJgQ?tt%Uvi2AI`n$W^bF!tt{n)+QmJL1= zBs!R~MbiFN6lMv7G53iT%u@J(T)0nBblIGq#>{IFH?9=6zFaAoBuFi(l7K+2lr*j0 zfzW7!-lEMgHd|c;;U*VQ=|Me(^QKvfXaH8Oo^T!KV+T{UB{IgL>oGKVtq`1IQ?Z-S zh>9tmXbJF(yba9UL}P^fL7gO86d@WA4kA1ZaaK6;fxHV?5ak*ok41tF1#%t4*ma;> zQG_%|9v!gB1X?EllABYdgI9Y?l*N9()9#qF>!C- zo0#e1BwM>P;=pWpAb(DFKXi!SFm3T4aY`QT@b+ZeuFht?<=1tSJ*+TpGQyDOryvXS&3)wtOCg+!Ll((iQ}(McRx4z9OV3g`f=(atedZ>&wi@ z6uaRvgEa~{fl%P35^y*~piI&Ps?-9_ zN|J^__tFZvxx(6uxZ75o)VGh?jW&@3`s*3wjt<~WClxYgX=qNMA{%6 zRIEUUg`7bOM1nxd2@{f>_7b38I1idgVQK}bmBBhC1}lItwkLQ}$$2)*E?bo(M<}Ew z6FpnM3T}&G3sqUnFDoL(_WDWFNU4+~WLcV1ES2w>pa;9yEEe_cBg&uBtF}J%MzEHT zi^nph-&`WI?vwEbJV#yeMh9G*mCW9i%%w^&-tbp;TxsPc3wHm`5d+XP18ADxZjT4r zUd!KDeKGI7k@vk#fb?esNdH$M0mr`g?c_^^Byg#Bt6S?TIK1#hQyHiO+aEDQs{}0R zPk-?A*2t#!%iMK%({fg^UV!j-;ZJMy?QQ+3Ik4Tf28*%!XK`XQM*UwaHu`H**&;A4 z#`Ac*5fY}T9W6EnY7gSi=|=C9*W=kxM?Ib;=T|+>B@l8`#IArDKyTZ!MbRbr9CjuC z+Dc;YVAJzgMZoL7(2H5SZ3f0b;c+tnkc+>Yo_7k&U_Nj6L*2#d{ifFNn1g$-nM2h+ z7`a2zI=T-#4;c)!_I`-l#A-I~-2qW3{Y=tWuzvkQN1u>QCAb1U#0 zaNwR=`>^qN2N+v9uNiLpBu)!!?f0!zL&9I4tZI zh95^HMQhf6)Eq-7SxYI}qG`>F?bBy5?5nqwiXv#m0`>y>U2e1}F@B3@4YE++Kenrt zuWxMMx5LoyEfvFX2()I=rV5&$*T{*W998as7`NkppV$)VE~}tqm*cjxy>?AbJCdeK z?vP_Y4E@;Rs*h?qBCqD4CCRfdQ2^9MWVk%m%Drv^~92F{k>^VU62!iJGN`(TNs_QPm1ZlR;bN% zO+dt*m~sLNU4Ylskk!qw<_4ua4M38A?OHL*`E-9h&XJ*U1c}BuT$HzQ6w0gh#m|5K z^PzrzyH3HRG7{aY-jC{BV8e&{t`bTi-XDJ!VW;u)aZmGWyMY1g`>jP*tu8#EIw%F4 zF0KZ2^^phfQi4%!APxW;f#G7gd@$J&h+d<3GCha2;J{&5&}JBtT7{BQ_#qQ+Q`{)Q zKnnka13+2ct<-c1pW=WH3&o*^4o?M1If!CLZ4kEP2qllGKryf-WyGwsE#X-FxeyuF zmUffXqIy4$0FO4IIKf$f77xT5;!U8S%tnwfi?=hw=!@~o-{|q1gOHA^yA%)czrnV( zBoLXBZo%%ML)o_NwimrOa@&V`s!zAQmV0~k#hmx;obP&}7D{|0pV)mR6Gvq0J%>P2 zo_f~zWc4SRMnr&}-Aw8pGl00{>Y$e#i(T~C;{~cHqVcbI$qOIc_V>i~+DfJR8SJ(N z0rcQ<40?I5!UxA=;#+1Yv0EE4dutDveYN`-g8euH(9maw;_B;hI1AzTS1B{VzRE6= z%thZjn|FR|efhmXPu-y5lKYQB3>+qug^57Ezl( z8U!*SJ6N<)g&i!lMTK8-v$GCmQX~Nn!fVo~-b2u+hn306LM*)%Nikf{C|nNIxVn3_ z+e-FPs!b1mBh~PI2|DbozdlV>1k-1fquHvYl2R!Vyqvm(aGkS9>ZwNm_8~~4R0E*3 zvMTW}K)3Uq>sU+!Z+2gnjpJ80eAjdV?kJ1Mckbn>h9?I!`}2HR-~DDiy?rR(@ZZRn z6G%)`qVpXiS%53v?ApO5b2i^N0zFnoIX;b^;C{9W0^E^ATbeb=H!^{;Y)9f5LGSjnJH$<5-Qe~>s|+&< z@*(ieO5hNRgub=z!lu4^zb zuj`0Fs~%N)0^%cpHvzl>Vcr0pR(7m_EdAyH1mf0xiALm~mc8BHPE#VsdVFo$d&tZh z_HIck0K*fq>_HY`A$kmXVLzHdk!#rU>?4|lMC-$jC?r~+7r$no53|qX=gYlf%&t%;o6Rp=y_3i!8?7xceV&A3Jyvt;T-2a%J zCd0|wXAZFF?}qiZ>HTm5t@fi`yAZc)r>NZlLZE2Z{uqitL%e6F**N`Ue4mWUx6p@8 z&z8(C22sVlVp8{NPgtKSy85@(Yp3i_bzWL6xJP-;PQh+m!eLX8H6!3-BK#Hf5#`bzxfz|acf08 z0xyblR4p&bfNsr-?vq8){hf}$lx(RO+3(mT5!+g7zv&$z!+O+A=m(uXS(!UPe(~+)?CsVt% zF%b<6skR>06LEHf>Jqgn?;Jsu2qae7Hj)>P9fOvBs7u^zy{Yax2|32yi8ZN7E>%PX z**KHJED4iRr=2axCKE%0hrljRM?|dhIK^aBtQ<)dn#NRy5pe0)OmwWz3hmdhC+Z|% z)z}I53RwCEy|R!nY*;IbhUQX^9kDMJCweHh4(NnWppX_waoD*N`Hzoa=Kp=0$8$($ zW4m@N@rD8R$*Y{#hMmvCq#>{=#tIg1 zl8$Vs>Fu&L>JXh@guQXyV7>X8ac%WQ!+Xu}y_MB>FXsYu67j!^P4C)iy&JZsz7#)T zUjqOC`Xa_8Xc?iY79YTL+ zlUso`<^zaeV1sR;?uXlz>%9bYkpYUx8+ZW57?CAV3(>Kj-MIxiWwfF4{FL`p$e#-! z)ROVi&fDwxy({@k>nz>aOBEioqZu7u2VKx^pDik|?cyXL>Rk!f8=)pkC@~@NSWO-z z?eAlNe~!a3mdk0o`)P<^Pn;#dv}s5tAi&;RU_= z1&f+grk^sc(?Um7<`K$#LY3@QnZ3JLKc%ulDl4>m_2Vk5UuE_0UhPv^11f7^_v)cU zk~S)pz(AymYZjZu>bUE;8aCG4#7R+hu6j+rM0G$;_U(96-6;ugtSjO6Kms;8Z<<&H z`w`9?Y)v`|IUa9)$kiJ2i#QV?3`A$zT!Z=|8>~~8Ijp5m-|iM|BUS}YC$d(&q6c)@ zpc~d3A!SB=vkp0;JaF)l`vXo06>~mNoP}yBW=6IP&?jus$UX!jDP?EEt(qL+jiMT` z>d?FuT==mUl;U4|K|6nL?c(aW3#z5_&t2fAM(q>0O8Tkc!ck_QF8wHuQh1vNi7mya zF?dhL@<$^w+hQ?bL8s?Hl?U(_{Buqb>)fe)f0PfCa3|PpXCWIP7_oI3B0;pej3hcRp)|&GqX3ae_V3Gr728hHVQ^+kl;iAlfo}-iXmexCH zLfm-II)pBJJ)kg)eCOLp6mg`2%+#_#XanfV(8~$NTvzH@95MjbGLqYJJ4YyFWSS2r z2o)FtqcJxKoVP(SWU#gS?#9;cnIJ<2CWvc<6wv1yAv36ZnJF^K8OJBQUXS+)S!3$} zJst0Hno?}YF>y8zbNEyotQ8*O@555rfg zX!A^m@_qL&XArM%$V@0(AIG`gFP@zpPV|rW8 zH2gDzS(h?|F=a?n%`u45ex0ezaIN3Ij(`6vXo= z0)Mc(Lvcn{BtG_X4yHKljtgDA-}YYwXh5B;rn^Scb8|S@0PJmhfeLdQZUs-$-+0{WYY~ft`uSgT`5R8 zR|+F=r4T{tq;Pu+w+-7;G&+S0kpBe{#7?QEUs&uoZ- zx3#!6TehsRhD@eEz5q6*tuA3jmof-L=(H(@^Li57_gXx6w!K^vsR~j|2moqQ28FtoJjj1BX6!b+2Q4$?jd#oq*+YUd) zm*Q{2J0aevCo}T9%n;(ivH^^cZTRW#9~e!U9TqB~_IeqobLwRswiBi<4DvdqV>=AT zy5w>OayYp&poPM4Pzp?tX;N4AOsY$Anp_M(kIZsSnQ&0;&&0mm{!CEq{!ABYX8r6e znB06}12q^pJnb?PK6ZjrC`ySG)pFv8EGDu$-DFw91s2v3t^-t}j2vtETUd|wNKq)=?UCY@QfD<9J{3_?hvTDqESXr<#U1_RmDNCQdo+7W-TaYz*I&sBE-J~T0!^$i`1|GC_ z)@wNdETf}1bB7mzrlkdlB0G2g{PRs@yaKH(F+WRJvVa?A!irTROFYUYXk>(N|FPzk-^%5O?qJSv;Fbu;lj)LGX zPCMbsHpHHk=8=NqOi0inI1U-6=$w*CUJ*HG#`o5+Fp=fKl@I-J(6qVN6MkzTAXPW*m-qy38;ZSQ&7daD1R3qnz8l91nmmHtz%}003)ho&SkI>}0UOxK|FQtLv_* zFkN3}6q9`M6h#cWubB$--2wI`RA3)>RfGbl3-zcnxIsX<;vezqSP85%-7F(V;MEes zHjd!3f}#0^gy3{lhR?{@)Hq7QspV!b7_oGuPJ|eM1Ct%B8OeYGhmSFB=4ICw*0^{f znFQ@@NIkkTO1i~lnJ|icza~>9$#qn~(UN6czy?fB7z^Y`fh#z@M;ERk#i7y)dJ)Sf zGwEawtbwmE={i)+njOFgg!{9PkY}F>HTk;Uh(mg&@O$DcJb2p=RW{nzx?ejYnjiON z-J~<3TldMeS=FAKCuslnKdnJ$R{ul%rtd2osoigHw7<1_ZNv9w0^6-UjH*R$o@1|e{;Lt?0=gM$!gnAnM14n zD;jMWW7Cu3U(thS?=U}Y+_U=w^XNK#M7n4qv<7$f;m#BOEOo~0C-q%HH)W>k-J7y@l!GjLMSTC^kscIr__mM~RxjB7#gvflPxKKzS{uJyhmuZ5P=^)zy zY9b1mf^23Qg?#9Q-~lBgfXt8hv7@uE0t66VxB;mfc8-?J7G|H+vdp<|wV|xxrn~(N zaGYa=FskOu2#9fc?o=?Dl0KT}|8znNS1bg{gdgvY9Ja1#shYprMoDH96;4&1Ipp4%{wV52ePni z<$yCAtQ=_b*)8EIq#9->NijM;f&&_uakugyYr|F^Xa(*S>&8OZdMFBtV>(2PvvYkR zVKVIBN}L(VS32}$3w*ll&q;t4L_~{|M-~sr!Y+Zv_!ga3H9}fs7+RuKT27h;xlotk zv~#U7^665Sxmo>*Cj@FYzte_?Q|V+L5kR=mIE@pIacT)SGSZ=#67OgX<9bAMuA~jm zrIWafXP)|{+}KVJwP8OP3nx})rQ*k`$L8BMq@ekNDpzRPk^WERWm za7bjPG~{U$P;OCQx254gwb;5Tx0m3rsg=YYQXX_|O_ z)kUobuCG?28GTIq1Z`eiytsD$v)Zpw=PsPvcw|U>_PO%8A(SFMlCpkh zr$c-8%=xwFKeus)>pr83y5?7X7Rz86ZL%VE%05JHPq&pL7pK^Zu>VGe=2s$U)UsF} z5miLaa#&w*9}H+}1Bc}#R$sLutM-1bG`qShZryM7!Sc{pg<9gPRJOI*EN`uOX$|;k zDU9i~MuYjJa0Tll5-{LO**orFcB^MfI=L%Bfzm0)Pb-4>1a4|ycmexX=gwceuy&5G z%fLRCbAg8DUTm2tNEz`l+eun>cS5$ABuDM1_*DUG^Fdw`Tk^mdg4=mcdunbmAW$!n zuf_gEs!V@&4ra=J7WYY0n$3B4PLuKLdf_%vT-i31@k2cMhaXqU1mQ})5OP81xJeeeg#19U)XKinP%<&!CSKyflV56&K@ z2}&4H@1q(kWT&Ip>hZfLym@*K?iab64*Jktx`ivZ{deyGklsO!A^UxL4a486L~Ji) z8I6IE{lG-(-zPYLey10TeASLie#kO9O7{IZ!Pe9tj1!zr4i7sDALhF?3MNX09-Xnd sb6b|eMw$n;Fr`_X#=t}RihqRzW3%P!LFhri=BJflyPM+mlcVnc0>h@S8UO$Q literal 35900 zcmc(I3vgW5dEV{+oN z3Po3TnoMNXb?iypM2cT>WTledvg6=ExUoceXPnwC*hW^zN<;KDQzz4;$#e>g?RL^c zX21WO|J-}dU68Wkbjsmi&-?M8|NQ5FopZy5;#j#_JUmve6c3lHW41LgmCa9Nj}@)K za&@*iT`A8@4O#=!#cW|Vo2z(|bJ>}q6^$J1=m=8_c@OcT&;_&$U&K{0MVlgY4 z8cC){5{W@8Jb3z%haX)!d!}YRa?TpGI{tBCX5v?myzj9y=N~&-Kl$j{ljn|}edP4X zvqv93Q#*U+1M#8c(Z?S-Utc=+&|#T!^z729^C!=L;OK=jwWSM3(N}r)@Jtas&z9}# z&@V&}S{-KR@sa58NF+UIojQNU>HW<6A3gurog>z{M=mU)acc>q8JnwAEPdQVLqmgB z?Ie2IwasX3@Zg)wIysVz{Xdx{#+k^(;#SAV)O7LQvOPC*xB$R=;2s@`WJV&wM9wx+D4B@krFN?7*T*vu@F;?{I= zX0AfPm^F*K2t=()v5Mb_HCsGBYv;yMIciZ}8EI&^n4LUm`F^e4=L?M9=)=ELzFHgo zZuWNFvnRXJQIfH~`#5>;iQ4k^*J`yrEzdP-qQ)m4q4L4N57+xA>`rcO$oe@d+ps(9uP=12{P{%C7mh{~*7Q^*U&>DB?LyJYB(3{rinDW5 z$BMK0l9i5F*-FLEGc=OO9lNhMZ4)eLay*%R;b2-$x0ly;wdc>OFM<4aRrHe zVJj821_uxBa~1$~i-n=7axq_=QA-euiZzH1TU8n;z?`w>ss$TEFB7z*X)A9}ofs40 zlto}iV$zz*SHwzTqUGvLaT?RQgK}u)rYhMytumr9t9Wm*O6wSnTK1G&!Dz&)PUQiI zDGS|BFrw_{Ysef-;6 z@A~onu3(6xfraq$_Sfz3o|cRI?65$si>-@65m*?gclmD~7vW9cLa<>6H`@2x1O7m8 z;jTuxva|N1iXG(ct}KK~J8Sorkb0*btW9h`+mKx>hFVdvRQZ!p`_Nv(KQvUjWQWQ- zpS6Q!H@RUC!>-#0*z31${?JrawzWVygUsY=L zofjJQkLI?Px1Y*AS*c&SBAx>Wkpqp1;`G;vV-!S#S8ysj zoz2-GM>AGBqY#OR3dpEjhdGd*DG*M=u0%#GQ=vGMpDs_$+S67no^DD4v7|BRrGSi{ zq-X|s&saI^A|O&d1ye44PPkMU)LGRA$~!>^J3!~CotY+Vtz>6r4P*s%nwvf$u#svA zT(m`q5KlB>qMfhYg7Yu?BI8casQ?p<&F+h_Y>iJoUsp?@ymot8E|nr;;Wu`^TIS{J zKe6&(OF>_?T-g`KCZ?V=kR@>{GkCC7J(+R2U9{pjQ&e#WNKJFM?*$*3otnbQp@D#= zNraiVAjt90V><;#YyX@{q%XVk{3!2)&HhuqmA{aK#=+(pmv`}+MgT;bm1ktJT5!pQ zIA#(!SF_WzhwZV$l5i2>;FBk2*>hllC(A?vV(1njIu2><^4D2;jQ?=}y(Q<+f`HoP zT>*coR^EB4QSRm>U)SKCtO_rQz4xBAL}h&Esqx^XT)MsD=W?61y#2XKeJfbu^tRV8 zaj1Rek5v!YiNtE;OSAS=9$yw{`z*oRhL6}$;4`}I77f8<#j=UuZKiDcD+)`Jt>l$pymL&l1tHnpRKa-uP zZ^`&e;}`FoDD6C73No*!LG;B5#s6JVxg9S#XlPcArGCJ7i?dighpnwWkF>B^T72pACArKV=fyAzvtiU}SZG?5i@Qa|1co#q! zS{NjSjT;`oKJqaE=(;_Sja$Eyi(Ahx1+!-RNkbsTNAb62m1 z`Wm(6@8QI&iPJn3YAn|JrM1Q3T4qm7 z74P_!-3C@Fk70;T!QIEV{QqrylOWW)49?boCkJ=#*RKA9fDeb|TL51HY~k#i4bWLq zT4WyQ-+z7IY=9Esa9-kAAwgK}We6qZ<8xEhB97Jqb~5p_vo;EhRY-V>K{m3XUJ;v} zsH>8HA#ah;o3g6Kc^MQOu)~?+tSVOQsp52&^c^VaveCBu&P{1#tX%zeUQR^zPwBhbgk_zgRMPM z23s2`ZM5d(*?l<##&!KirGn&FnS^w3V;yhoytwk95R=yaxD@2vHqLF^`J(7-rR=S? z^~&<(&hwK`E>CWG>uh~%xw`Xw^~vSx*3PGvUKR~}n1Ao%iN3Jv`}fS)dRh)~iM5`F z8U+9Dy|QwPocgEL;6Ee)0LHs!cY?jPJ3}4ZDwk*vwVMgup>8ulii@Bx1=;q~tN#Bk zhot7E7OSJ~OjU3RVEJoykh%?q+8RrjR{bloi5FJ=KW8?B+hvutkeU+z z?%m?Kxv~K|k*#u(04Si5;B$lpF3~C0HPoriZJ#l)4mGznCm{1TFi4AkX2d!ZCmI;nI0ioV z79ZAQfU=ec0b7ejz$H4`kqiK>$Mkxcl-_0ryqQ)KLY@`_52nSy(`Yg1XtbCCm`p^U zQF>T!B|WTLp{aCBrVPlZjJc#bkQ~+?S9M^@bC}`tTA!ciB`Tsn0u+Fk;3ANMK89t)o)`g}Bj8+~_8bZrm#IwBA4* zS_LhSwz-3{ai|cq7z8Uh*th}XI7C*rR16ZAfI`f`_m~0RSXzfd3~Mf{fI`R~VpwXK zWPmtk;8E1TV$v14!-!_M&1hPmd(_xkQDa@BaeXyO{pB_X%Aw?Hv`6|d%YYl?c@lgq z=)T-a38|eS`J7ZB7F1rMCL|{j*NKG?Ky=FIGN%>N`9nKOLM9|mh?JtX5IsTgl_iF_ z(lRt!lD{RrKe46`Gb+|xXGRlZ#277cxx|}J7mrCc)m19FS|4zy{%3CR`P%uk3Ur-p z8_niwW8!qm!!UWQbDv-)PSpO0cuw$d-;sJP!CpSS>ib5yD33B$cXj&LMx3DJP{ZQq zaySTnbU@~DiGZ*O{k3FQ0u4?Lx=jTAZ`MS+-b6b$!40*mZs1O!@~t{?y-(D^n#jW3 zX&V>?8C(W4VP+|C?|eeAfgcio!A>}^luSVxOaYy`iVKJjJ14YxzQ%xzs!$Y#z%@+6 zS`?819D>X#n6*Ihblenr!J(OawpuMhy9*11%q6@;-V7bvacmi;7N9<2FUPU#)h@a& z*)eue9Li&NPsI&d7>`J+fu`e(8AQQLgmlUmOSzjmhJ%JiuQvpXh&RbN>|+Lnh#5pb zYMd=mgZM=O<*~`xnW-YoIiRb_Lwm_*oLu-zRTqguH{b1YoEuZg3-uFt(ZsmA;efg}V^vGTR`{u4-59j!@+w1#B z7uhb_lNAK4!BLH_emyV9;9m(!da6y8XkF-8=wArtNjiJJQ9Gp!tvxVY4KOA1!AyEU z5u|0+Q+=zeQQgmLw&Av+>ECC!W zzo#OktVgL27uP~|?;iiNqjvA45M`10OAO=wg-(~k+cI1_QQgy6Ua)&UTzuN@hdCIc`Yr{YU;aq(6Lyc?zx70gEX{HRdJ~_w zWA!T^DSq4@s9*V@9a{)D>UMbN1v@Ox8M6XO-R+)6upV`iRJo)x-foq$8RV?ZP6kSM zSNt|RwJ_4K6AMQgc4p(Y{boOxX>RM%;=1yImM_|wg`*fVCm3A$!5cg4cZxM#x#Mh0 zWoNxtWd8x>1}XOo<{`Pus3bsR_P`e4v$uhPZ?rtQ+H&8r!s{KVcb>2hNPHm_LHtp> zZ;u~3o3C64D;&VN3*GOo>9V$XSSZ-_>-HgZ<@<mc({I8Ei{c|aa%97 zxV`spBaQ*2#Jtx0jsHhaYuS$Wqr7vVB3!gsE{2%n?f#fv)nYLDGXTB`)ySRDS6 z)H_3DXv)GJ3Or~8;t^+R=C%aP`PZrvho+*r1~fv<%p%uyb|6hs+Td@%hk-XRnZ9Vs z;60-$s4*1F8ci7*6?oq0a&I)L1YhuU8D@Q>$)v7FfCfy8ej1yJG@Un#CYufBaMRHF z)@TBJyLa3Pli^Gl>a1u2g0;*4MH5h+=ursvP3^&wtQCpFuZY$Pq5^;}L|ue*2{{@! zG&j*WIBExSaVRJYcJ=MEU>#w>)*6nP0E&Sf6|w?YOk<4XspK>lix^Oi!K|q@Ns0jP zbfOt!tWiUA1^c_vR|Kqdc6vH{f*4D9mbg}8=v~RFO&Q~%nly7E5xBX-fSEh2;k4ez zu%SpBMys9?4;w=oh5)8D1)Ye3#W3dXc1b!$hrP@gW6eOEahu2h=>(iJ*mY7&OJmj? z!ZbK!v`&g-w~3VIbCWXEMkzz4NHshEqzoZ01ypmVkTTXb32DyFOJ?+SPl7aPd4|d? ziLI*T8M0Xdsv$QoVJJ8ga0>9OL;|`Uch(8Oo+?`jAf#0JK=^R;J!&`%SglkXd(iDR zj^S!C2;fqS2N|AG52BV6gtlL$Lab7_si7%ESS^ov|tEGMFqRbI-^Af zq(SM8_%n%vj;c*gLg-ASYzPUH{CEt-Tk9J)yAq)iz%q(qT|Cw)B#y4n?_)b}|3cq$ zb|3S869NAlJ0GuXv`hw_v@AH!)-SU;^TmR)r{2=Y*?r~FEa~zf#|Q~=sMA z82PhK+Cq5clHILUUU$l)Hhfoq#}2P7IK|fvIzb7=-i02>hWqWFJuRQIdjyVs4mA!# zYGp8U8@J|jz}<;JAmEpiZz%Nc-7l9EvfEy}+t1a&Pjhk*$stY#y(^ z)#cA-JO2i@u0Whz{ky|5t}t6iN|~dkMYeV`WjC<2tKzMs1UJiT<6|JY!!t|z7J4x~ zyVsev%--zaUtutpVL9-Snk6aGSO507P)`ZGKy2LZd(Z0Mz5}vDj5u0lfF1?|p|sfP z6od+LVwSwVm4+QsnVE@k)?@&S%wjAt2(NV06iy87?z!>=iIdS?YPz+9gmkj39CuWp z7+wMQCn{y(Mk}d32_P}BEH1AQjln$5+^#7E#0=|cG-e7OF~gP{je^PW9N$RO8Ac4z z;O0pK-BiP1;lL6%a}vU2J0+Y^$hW8p@ zXqjk+NhY?07Ch#SCf?Ge{ZTgmOzp zK}&?(6ougH83`0J&RWq$7p;~d3PV%jmSZd+nS?FpBvFGY$Fbt=0Dd{1E}OTKu0C?* zBBw)PStIv{!MStwbB{cJ&bn~s{TJSOcIn)i!>3N3x6Yq=Xz7u2@5bdpK6m6KT(wy? z5{bm=PfGafy0zd-9MFUPNADZgTR(VH}r-MX5v97z7`7 zRUad>*bGtx1;Ve#wlxNs>Nt`!y7#~sWG^z*jR`{>{X{iW8KM$Wlp)rcL5rw+@c|KZ ziJ@03usz>%_}*+~u83h5KL)N{0r}s7&5Aj0lwcf1Ka&5lTKi?y39+(eqX}5dOtDnZv zXY|_@3_L*oEAzd5U0tmcf)VW&gW0~=GTwb!h6!~*8Qy$X5*2D<1+hPNVGu2lJrq4b zm#>Q;IHID8;Xu>!phiaQIG4oXp~Ym=oCm~H8rLD;J9$w_yS z(6GtIid|viJBX_`Hc`jz{+f8N2o|;!p&eLk+=+MaTt`J=qsPkz$DuSLjxNZYYxvenJ@N<#tBY@iQQ03<$5-MlPn) zfuqJmRFRZ{Ccvi~vZtG($1DZIDq_B|p;pr`mF{M;J{+Wh;+H(FN~{VzIQuiQ6Yle=&G zSvL2R>Sg6tf6H30Xl2~r|Ew%7bTZ2gr@~W>-$bcCRqDA>S!{DajIgnP@iZBBVmLOX z2!v%|vrhFG?ovdF-UHLbYD$`hBLec;Bz)Mgmf+T}yN4`THSWh%^ttIGuNjo0f?yL} zf)3q7yva)7p7Z3A10Aaz3Ash9u*V$-TT9v|JXR9NW&y^?ZI$E$&y>I$6o3nrEc~R? zmQXO#_?lTEgYh>66~oO@V{zok!M@$B0wu>+zB3JERn9ADj=XG0lgw^6VER-hb~Rst7{fMN*W7{%@&N1{D#Cb9;RK9vkn!sn25o`~bD6cisJ&=0yQI7WAZDJO10-|EC- z>@kB3&5wq-X?FgBBarLG2e4#IO$YGN@`Yo|R zb8a`^6MpzAbSIqF?xwY?G-cH89Otq0bQNxaYV;7arZCjo2e9>Tg+BEFG=b2k9`NHA zdQwuy-nD^;50G`&!VqQM<;SmmSAZ0*ceh;p3;R&Z#UIF?*%?)D zV%2Xi!E-@&t;z{^8Lp%GE-h}0cMN?4X1?ge7eIPfx88Hw%E+c`0SC_@PE@+-+F!F$Vz0FdcVE>S*IF2v5tI{=Ncp5 zgACfspgsH?f#Uap{j0vebY>0>9~7x;zf@vO3GA$$c{4befE0^xNC&oeDa`Wip}@+6 zcK`Zm2W<3Yh7+kk<6Saqywx6PX$e`}Nn*hQPgI;f2)zQ2I&r{&5*EC@LO*%;wdaLL z8m@_4LhGrrC5WM2|FP^~GbGMQ*h+kV#wmN3uaJ|O@B6AwKO*1dh|sJ9rM^L<;XMO) zG7+-x_REx3sDV96q(9zo2iFE+E@Kwa$&6S>zne@JOF<6O%YAsa97j2Zn!~v)IRFjaHFr;qvnRI*ac(5aS7gV zIqZyF!!EcRF87+9;|*8PH=I+CHe3Nat&9Bpmb=wVk+Ds2v&=peprhgL z!0O-pIRqBE2BK@jqcJG7r2}{jhrS4O-W=E1YT)karg zM$>RJa9Josb&e{UHf;Wg>e`@a3fGgo5_YQDDjhX162X%P-tEfGI@PS2fp1Tf;#K(j zXyZ&Zs{kR;H4FS+Hy`j-%G^!>RN(}a#ZDMpoD&8E<(**ym&cTq91IpY61b-HW@Qw# zSeokxuChqA75H&f-esb3sfkgS>f)wJft={sFk!e{z_2-ePQ;+%Pb~TL%l{O=8|(@63>% zhRKhP_fMvI7{cCQj?8n5v3VHegX9@T1|o?!2{3WNmH{zP!=P)6p2Bn;p(#lxE@|lO zyak{>aW+$0Q+TAC7a(QGiYZKhH*E@|?TC4ND1FRb0sJrq4&83YZD3uct|(GEGT(lksK)N4$9$bZyYvj6T^ISy2=* zqZ>MI#PkM)o=WLk$YkkGEovCF$h%3)Gwut~MPn_`#BhCkVh!DLpv|gd5|!C0$8d?% zhJ*8tuEb;0N81P3SV+9t;DM;Q$EI?iMpW|8%MZQtlQrm>Cl<9PKC8 z4tgxqQEE@A8Bxz9(j!%I#)daXfg?bH)-KC00V|*Hc!!1q*63#2aje@HM@#uDv}l_h zC$OY9j+PPaP(TOE=gy%?_=XDw9#%ikOGHI{4q`jX>a0(H0h*OeA z+)9rb4?e`ea<~Wx<*Z40^xnzRe`IRSJ#z={8spp%iq!L8xk>^9}mx?pH8CO4M%F6n8_R zi>z)x-P`OAkdtj_qnnTH927%et*`pOj5b2JS%!ikKix131)%Ze;SD@n8qL`~Qj@y! zuc*!)GVAgH-jzbMtAs0UcAwpE_l%e2i&R|saz9Ey1NN!Xh!&i65Hm9-^l`10-3D{H$#y;gZ9_1lS-IB&SClSh9EmCN<88Ll5F+#F5d|9rjb0JW0k&BXk|gTR=T(BA!KZCSV>KriR6H78q0!>N^L5(g{`iSP^+v zkfqCT?)(9AHv$l-QV=dx&}4aa;28&xp*_+L5Xqc)(N106;B_JzE0%#sENCzp?T<_G zCu1FtAdZuOXfi@LAT;VsmUo`fcXG^LB#;@2VF2d%(6Zos?GU5~cq zH*P8j!g^aC+xV~ZwZit=d}CSJ-gnl^i_5j*vEW9BQfaHKW8F?#yPm%_#wGT?T$>U)CA>Z4lbw6HuQ>4BK9a}p2g*H!eJ1iW&A zXQnTmHjHn{JGjlmAkvwHLrV^CV$bIA<%0zFoD-pEiJS<%B?S3snur;gG|AgpM4V_d z!DYcpHtX2vVw$@Llg&DqM6(_=(X8%GfVwz}9Cn4)GNPdo z-PAwuxA0Q2U7S9fm7hf7ycOBUKpSTq`gJvpUEgwXrx9y*KP9%=(+9mY&NGXFgsYjw zaI|?#0tW6vMB(u1DL@KotpGU#n)IF?YVjtado>^8puO46T4x9ao^_!^7>3Q{w*LPrO^>w3^?xnU5zJs$-Og*jAMih9R8)BW@X4@M(&x~eI`5JgI ze(7aqB0IT|k^mIv-`!QX2~7ULO1P>bZ1LI}Id2>?%erjd)CvW)4&N)bu zPsC4-Fct;x^y57la(od!F}pavgg3hOPpsXSy)+7FSMX;26owFn9|z_g_T$$M;|n4* zgdzJ7479QFGI!ms*n9Qbi*&M)7Zb$=#?`BLGnY>?&iZ{^;ab96tgCRlo#F``!OJQ< zfur=kikv_Owr30skEp-~Egw-CVW*xEn7NTP;wN*rct3@^V=?ME`^ef5Ck5;yAG43H z-Nw;&`zRlk_9&iMl5$kTP6ZZH7)1ciEvr|TpoIg0aJl^?l>SZJK3x`QN~Ft4hQtA) zly1HgVVaB6hPojQN-fyMw86}#H0SXYqz`r8C5;O_N#kwHr1A2k_gP2%WKQ5@a!D&0 zW8Ikkv_Tvvzv?+|*gNBf$vbWswPMB?W5yWqW`xrs-NI6>dtL%Fd=g>1)W&BTG7ST+ zp`Xz%@Z$h?=Z7h|5#v=)L;h%D`=z#&j|)d;h90HTK2nY6jteN z?yfgp8L0U|izTxs^u=E;Wpk3*-5+S#_%kW{I*15#1Fjm=Q2-@loU-h=i|7C!HJy`i zx;O^CamjlW;;7(5BWZXYC+M)kSENWl!TBaan0Q~;tr6Xt6_n&f$HRksPTff?LwfpAA1Ee20?RZh+`P)ny;`N45> zO3QSL<`(5=AsQtJFyvtjHHD%r@Kr^G^oIma`k2wK+Hm6eoGREyP8eddQyca`u52

    cDeFsd2IA zoqk}wkrhZCqZJ3!L@98sra_69l)WD^fcaHuU-3?gY7Sf?7k1PVU_CXxGt{?yD@NCh z$UUN#LWudoa%l@bimn|2liyE9A$e}{nFGH+BaU~2@;5=V{Vp&))#jBs)q;S*AZ1%j`W5jzyy+*t* z)Mv!|L;ZSOu#RpYu*H;{`xsDH2;_`~Cef{f4J7Me=g`$RvDze$PylO2HhULk=m^td zhDp^t#K>^(mW;t?L5mqjOU!shhF^AS~12FGsY4#4pe%))U8L)Q))3| zEKy@DUPl7Gch5UOhME!HOnMK7BSF;ko-)`JV_@dBSnUACBkfx2h8Ki!DZv1b;pkuh z$FNAl3Eu^c)~9~Jp#WVfq^lC|R(8ZVA5+HhB_fcO)LDijP<;FXhxmWM0n<7P?UL_L zq?U$0E3qg&68=bHxY$3O^mQYN@mN-ob(AT1-jSRA+ZXrb@?;9-uUQ#4vpqO?T_*+u zTa5+wx~~{|31eBwYt3Csx=5qPbQbVBOrMSo#!YaO)6-fLh$4>%d_72h3x!p>;9oEV z!PCfJR8wC7ofdR|<0knLP$^{KPMx0>b?&DwIH7H&U-B8B=7f%qx^F>zvko7Va&z!!1o40R&%#zbx zddxa^X6eG>ne*K2xkt{6riPpkdjd2B0zL#aINS#2mR&VA`R)K7W04;?k{>iB1}9@x z<#&-{7zGaZ=5G{{Ia8h2*v1mf#H2DGkewhtK&fe5R)Mtaa&cfu79X+^8gubnIC-Iv z?};|t-)wR3!KmT#uIRI29fg( zT)Cn4k`Gmw9I#=dm6(G-D2crx(6@^#043?c?L2frclLvt9>;fdX zlErP{`Y0ofiZx~Mcp7fV9OqXmxxM_qx&*amTfX^I=HK-}=$h{HJQdZZYiPly@2!*uhGK|!HO z2IfPJq;=Q!i=oJgK}(@T8RM09?`!Eg^1_dw1scOG#`Eb0^X$SgNt~{9Nx@Sw+K8a% zcZUa)f*XNHj^LAxml=&dA&I%g!A-M3q_v2hr^qoj4+^VYBPq9fPmVH7YJe{~Yd%|0 zY!|cl7KNT$PJ%3+F3i;z8{V9n`%mA1FN(<%7+-9V^mnuG1P225mDSD^A39jOCCl_z zQX7)RSA8$ZNF87J%sx>cuU{c+=TnUdcorHt+1wRmvN4hjea|;0olhI&a5y~G7-uTh z!M|-=Y>C5zS~4j+zVm{6V5sN7+s1c3m#c4oS(aH`IUob76`qd#ysspTop}CDW|v;= zDXiThi`2;>uROLP?>+xkS$b9=L7q_Z?2*;n!>RZOvNE4dp+uuB&+RfFQuOr&QVKdd zl0+)?J{9dp)-ixZ7?NM<7B6_nr6n)1-4z(*87(CE>-j8_#Y=tplC-jf!-QXOVRnY2 z>$Kvq<13mUH#kVT^uZ`iP6#f#;o7j%0-p8PH%$y4=lm&YYzWmZ-6nE(3i(27F;iAD zj%NC}wcyV@A8j#qp;t&V4ti}bdPFLH48}%=T&KqEYLxYjY`UAdvm`ExAWa$%yDImj zcB&^eon|l2z}(s`QY8j_Y~=V$_W1rR<8I$#)}ijSj>_r=u)6NA7`QW5oiD+(U3M^x z%hj{9C-U~>)HHpzP~gyEX9bWxbFd>kJ(a!Zp55}SaCod-fj5P$SI9#f87>s_6ik&S` z)q`5wlw0M_gi~yGW(bp^@7GA=mjf>rh6J9?SRK4syq^`#0zSnO`>6Gx@0% z^g~aF8lAXV@*Oy?=Dt#mIh3pA*?Y6on7$nK?heMY0vMQX$Nks%2&yODtGY9@P1T>L zO^+fGV?2a+KnC&c=`%I!)Ca5&oILfup$Ff8xAh>2GFX|pDeG~FIFG#Vf>oF=PeQV> z!g5L-`by9@g2LuF9NePmiC*mUOAjrbJ9*Z6{N!WSorB@i=g*wHaKk0 z#yIW#!*}2Xq<03Md^M4d!8e@~Y!K~b1Wo0In-pcVGa+>`%S#sMGP1uIv*15Xk>Rg?< z9qROT9A~+fX(V#kHpwB(sJO>ks9IN?nHo7j;OJZl`JEL3m7aSHnx-@7E}UOF^O$wv z5eu3p>oKL3+GSxJy&OZHl~IgttQle?W!(hF^s6Xp9i`~P1?1!o;$Me6$LXw)B@YvG zAX$lbbKPCh&6?#>P6zbyhwC3CvRPH(r#~OedfrXtA%xAu*QmbB=6h=mm>btedit>TEDIT-STREAM.;614 141190 + + :EDIT-BY rmk + + :CHANGES-TO (FNS \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.DELETE.SELPIECES \INSERTCH.HISTORY) + + :PREVIOUS-DATE " 2-Mar-2024 07:10:22" {WMEDLEY}tedit>TEDIT-STREAM.;613) + + +(PRETTYCOMPRINT TEDIT-STREAMCOMS) + +(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 SETPC FSETPC GETPC FGETPC) + (MACROS THINPIECEP) + (MACROS VISIBLEPIECEP \NEXT.VISIBLE.PIECE \PREV.VISIBLE.PIECE) + (MACROS GETTOBJ SETTOBJ FGETTOBJ FSETTOBJ TEXTLEN TEXTSEL) + (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) + (UTF8.PTYPE 11) + (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE + UTF8.PTYPE)) + (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) + (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) + (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))) + (GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV))) + (INITRECORDS PIECE TEXTOBJ TEXTSTREAM) + (COMS + (* ;; "The BIN-level functions") + + (FNS \TEXTBIN \TEXTPEEKBIN \TEXTBACKFILEPTR \TEDIT.INSTALL.FILEBUFFER \TEXTBOUT) + (DECLARE%: EVAL@COMPILE DONTCOPY (MACROS \ENDOFPIECEP \STARTOFPIECEP \ENDOFBUFFERP + \STARTOFBUFFERP))) + + (* ;; "External format functions: equivalent to BIN-level except for COUNTP") + + (FNS \TEXTSTREAM.OUTCHARFN \TEXTSTREAM.INCCCODEFN \TEXTSTREAM.BACKCCODEFN + \TEXTSTREAM.FORMATBYTESTREAM) + + (* ;; "High-level stream operations") + + (FNS OPENTEXTSTREAM COPYTEXTSTREAM TEDIT.STREAMCHANGEDP TEXTSTREAMP TXTFILE REOPENTEXTSTREAM) + (FNS \TEDIT.OPENTEXTSTREAM.PIECES \TEDIT.OPENTEXTSTREAM.PROPS \TEDIT.OPENTEXTSTREAM.SETUP.SEL + \TEDIT.OPENTEXTSTREAM.WINDOW \TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS \TEDIT.OPENTEXTFILE + \TEDIT.CREATE.TEXTSTREAM \TEDIT.REOPEN.STREAM \TEXTINIT \TEXTTTYBOUT) + [INITVARS (*TEDIT-EXTENSIONS* '(TEDIT TED TXT TEXT BRAVO NIL] + + (* ;; "Low-level generic stream operations") + + (FNS \TEXTCLOSEF \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR \TEXTGETFILEPTR \TEXTOPENF \TEXTSETEOF + \TEXTSETFILEPTR \TEXTDSPXPOSITION \TEXTDSPYPOSITION \TEXTLEFTMARGIN \TEXTRIGHTMARGIN + \TEXTDSPCHARWIDTH \TEXTDSPSTRINGWIDTH \TEXTDSPLINEFEED) + (COMS + (* ;; "Editing support") + + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (INSERTSTRINGLENGTH 512)) + (MACROS \INSERTCH.EXTENDABLE)) + (FNS \TEDIT.DELETE.SELPIECES \INSERTCH \INSERTCH.HISTORY \INSERTEOL \INSERTCH.INSERTION + \INSERTCH.EXTEND) + (FNS \SETUPGETCH)) + (* ; + "Deprecated, maybe still external callers") + (FNS \TEDIT.INSTALL.PIECE) + (COMS (* ; "Support for TEXTPROP") + (FNS GETTEXTPROP PUTTEXTPROP TEXTPROP)) + [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)") + + (INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN] + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT))) + (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) + (NLAML) + (LAMA TEXTPROP]) +(DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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).") + (PTYPE BITS 4) (* ; + "How the characters are delivered: thinfile, fatstring, object, substream") + PBYTELEN (* ; + "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") + PFPOS (* ; + "The FILEPTR of the start of the piece in the file") + PLEN (* ; + "Length of the piece, in characters.") + NEXTPIECE (* ; "-> Next piece in this textobj.") + (PREVPIECE FULLXPOINTER) (* ; + "-> Prior piece in this text object.") + PLOOKS (* ; "Character formatting info ") + PBYTESPERCHAR (* ; + "The number of bytes per character, given that all characters in a piece are the same length.") + (PPARALAST FLAG) (* ; "This piece ends paragraph") + PPARALOOKS (* ; "Paragraph looks for this piece") + (PNEW FLAG) (* ; + "This text is new here; used by the tentative edit system, and anyone else interested.") + (NIL FLAG) (* ; "Was PFATP") + (PBINABLE FLAG) (* ; + "8-bit bytes are binable (THINSTRING and THINFILE) ") + (PTREENODE 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 _ 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") + LASTPIECE (* ; + "The last (end-of-stream) piece of the textstream, for easy insertion at the end") + NIL (* ; + "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 (* ; "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 (* ; "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 (* ; + "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) (* ; + "T if this TEXTOBJ is a tedit-style menu") + FMTSPEC (* ; + "Default Formatting Spec to be used when formatting paragraphs") + (FORMATTEDP FLAG) (* ; + "Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") + (TXTREADONLY FLAG) (* ; + "This is only available for shift selection.") + (TXTEDITING FLAG) (* ; "T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing.") + (TXTNOTSPLITTABLE FLAG) (* ; "Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation.") + TXTTERMSA (* ; + "Special instructions for displaying characters on the screen") + EDITOPACTIVE (* ; + "T if there is an editing operation in progress. Used to interlock the TEdit menu") + DEFAULTCHARLOOKS (* ; "The default character looks -- if any -- to be applied to characters coming into the file from outside.") + TXTRTBL (* ; + "The READTABLE to be used by the command loop for command dispatch") + TXTWTBL (* ; + "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) (* ; + "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") + DISPLAYCACHE (* ; + "The bitmap to be used when building the image of a line for display") + DISPLAYCACHEDS (* ; + "The DISPLAYSTREAM that is used to build line images") + DISPLAYHCPYDS (* ; "The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode") + TXTPAGEFRAMES (* ; + "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) (* ; "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 (* ; + "Document properties that are stored with the document (not used yet)") + TXTSTYLESHEET (* ; + "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 _ 'TEXT THISLINE _ (create THISLINE) + MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL) + +(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) of DATUM) + (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) + (* ; + "The TEXTOBJ that is editing this text") + (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 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))) + (CREATE (create STREAM + BINABLE _ NIL + BOUTABLE _ NIL + ACCESS _ 'BOTH + USERCLOSEABLE _ T + USERVISIBLE _ T + DEVICE _ \TEXTFDEV + F1 _ NIL + F2 _ 0 + F3 _ NIL + F4 _ NIL + F5 _ NIL + MAXBUFFERS _ 10 + IMAGEOPS _ \TEXTIMAGEOPS + IMAGEDATA _ NIL))) +) + +(/DECLAREDATATYPE 'PIECE + '(POINTER (BITS 4) + POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG + FLAG XPOINTER BYTE BYTE) + '((PIECE 0 POINTER) + (PIECE 0 (BITS . 3)) + (PIECE 2 POINTER) + (PIECE 4 POINTER) + (PIECE 6 POINTER) + (PIECE 8 POINTER) + (PIECE 10 FULLXPOINTER) + (PIECE 12 POINTER) + (PIECE 14 POINTER) + (PIECE 14 (FLAGBITS . 0)) + (PIECE 16 POINTER) + (PIECE 16 (FLAGBITS . 0)) + (PIECE 16 (FLAGBITS . 16)) + (PIECE 16 (FLAGBITS . 32)) + (PIECE 18 XPOINTER) + (PIECE 20 (BITS . 7)) + (PIECE 20 (BITS . 135))) + '22) + +(/DECLAREDATATYPE 'TEXTOBJ + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER 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) + '((TEXTOBJ 0 POINTER) + (TEXTOBJ 2 POINTER) + (TEXTOBJ 4 POINTER) + (TEXTOBJ 6 POINTER) + (TEXTOBJ 8 POINTER) + (TEXTOBJ 10 POINTER) + (TEXTOBJ 12 POINTER) + (TEXTOBJ 14 POINTER) + (TEXTOBJ 16 POINTER) + (TEXTOBJ 16 (FLAGBITS . 0)) + (TEXTOBJ 18 POINTER) + (TEXTOBJ 20 POINTER) + (TEXTOBJ 22 POINTER) + (TEXTOBJ 24 POINTER) + (TEXTOBJ 26 POINTER) + (TEXTOBJ 28 POINTER) + (TEXTOBJ 30 POINTER) + (TEXTOBJ 32 POINTER) + (TEXTOBJ 34 POINTER) + (TEXTOBJ 36 POINTER) + (TEXTOBJ 38 POINTER) + (TEXTOBJ 40 POINTER) + (TEXTOBJ 42 POINTER) + (TEXTOBJ 44 POINTER) + (TEXTOBJ 44 (FLAGBITS . 0)) + (TEXTOBJ 46 FULLXPOINTER) + (TEXTOBJ 48 POINTER) + (TEXTOBJ 50 POINTER) + (TEXTOBJ 52 POINTER) + (TEXTOBJ 54 POINTER) + (TEXTOBJ 56 POINTER) + (TEXTOBJ 56 (FLAGBITS . 0)) + (TEXTOBJ 58 POINTER) + (TEXTOBJ 58 (FLAGBITS . 0)) + (TEXTOBJ 58 (FLAGBITS . 16)) + (TEXTOBJ 58 (FLAGBITS . 32)) + (TEXTOBJ 58 (FLAGBITS . 48)) + (TEXTOBJ 60 POINTER) + (TEXTOBJ 62 POINTER) + (TEXTOBJ 64 POINTER) + (TEXTOBJ 66 POINTER) + (TEXTOBJ 68 POINTER) + (TEXTOBJ 70 POINTER) + (TEXTOBJ 70 (FLAGBITS . 0)) + (TEXTOBJ 72 POINTER) + (TEXTOBJ 74 FULLXPOINTER) + (TEXTOBJ 76 POINTER) + (TEXTOBJ 78 POINTER) + (TEXTOBJ 80 POINTER) + (TEXTOBJ 82 POINTER) + (TEXTOBJ 84 POINTER) + (TEXTOBJ 86 POINTER) + (TEXTOBJ 88 POINTER) + (TEXTOBJ 88 (FLAGBITS . 0)) + (TEXTOBJ 88 (FLAGBITS . 16)) + (TEXTOBJ 90 POINTER) + (TEXTOBJ 92 POINTER) + (TEXTOBJ 94 POINTER)) + '96) +(DECLARE%: EVAL@COMPILE + +(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 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))) + +(PUTPROPS PFPOS MACRO ((PC) + (ffetch (PIECE PFPOS) of PC))) + +(PUTPROPS PBYTELEN MACRO ((PC) + (ffetch (PIECE PBYTELEN) of PC))) + +(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))) +) +(DECLARE%: EVAL@COMPILE + +(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))) +) +(DECLARE%: EVAL@COMPILE + +(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))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS VISIBLEPIECEP MACRO [(PC) + (NOT (OR (EQ 0 (PLEN PC)) + (fetch (CHARLOOKS CLINVISIBLE) of (PLOOKS PC]) + +(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 (VISIBLEPIECEP PPC)))) +) +(DECLARE%: EVAL@COMPILE + +(PUTPROPS GETTOBJ MACRO ((TOBJ FIELD) + (fetch (TEXTOBJ FIELD) of TOBJ))) + +(PUTPROPS SETTOBJ MACRO ((TOBJ FIELD NEWVALUE) + (replace (TEXTOBJ FIELD) of TOBJ with NEWVALUE))) + +(PUTPROPS FGETTOBJ MACRO ((TOBJ FIELD) + (ffetch (TEXTOBJ FIELD) of TOBJ))) + +(PUTPROPS FSETTOBJ MACRO ((TOBJ FIELD NEWVALUE) + (freplace (TEXTOBJ FIELD) of TOBJ with NEWVALUE))) + +(PUTPROPS TEXTLEN MACRO ((TOBJ) + (ffetch (TEXTOBJ TEXTLEN) of TOBJ))) + +(PUTPROPS TEXTSEL MACRO ((TOBJ) + (fetch (TEXTOBJ SEL) of TOBJ))) +) +(DECLARE%: EVAL@COMPILE + +(RPAQQ THINFILE.PTYPE 0) + +(RPAQQ FATFILE1.PTYPE 1) + +(RPAQQ FATFILE2.PTYPE 2) + +(RPAQQ THINSTRING.PTYPE 3) + +(RPAQQ FATSTRING.PTYPE 4) + +(RPAQQ SUBSTREAM.PTYPE 5) + +(RPAQQ OBJECT.PTYPE 6) + +(RPAQQ LOOKS.PTYPE 7) + +(RPAQQ UTF8.PTYPE 11) + +(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.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)) + + +(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) + (UTF8.PTYPE 11) + (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE)) + (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) + (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) + (THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))) +) +(DECLARE%: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV) +) + +(* "END EXPORTED DEFINITIONS") + +) + +(/DECLAREDATATYPE 'PIECE + '(POINTER (BITS 4) + POINTER POINTER POINTER POINTER FULLXPOINTER POINTER POINTER FLAG POINTER FLAG FLAG + FLAG XPOINTER BYTE BYTE) + '((PIECE 0 POINTER) + (PIECE 0 (BITS . 3)) + (PIECE 2 POINTER) + (PIECE 4 POINTER) + (PIECE 6 POINTER) + (PIECE 8 POINTER) + (PIECE 10 FULLXPOINTER) + (PIECE 12 POINTER) + (PIECE 14 POINTER) + (PIECE 14 (FLAGBITS . 0)) + (PIECE 16 POINTER) + (PIECE 16 (FLAGBITS . 0)) + (PIECE 16 (FLAGBITS . 16)) + (PIECE 16 (FLAGBITS . 32)) + (PIECE 18 XPOINTER) + (PIECE 20 (BITS . 7)) + (PIECE 20 (BITS . 135))) + '22) + +(/DECLAREDATATYPE 'TEXTOBJ + '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER FLAG POINTER 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) + '((TEXTOBJ 0 POINTER) + (TEXTOBJ 2 POINTER) + (TEXTOBJ 4 POINTER) + (TEXTOBJ 6 POINTER) + (TEXTOBJ 8 POINTER) + (TEXTOBJ 10 POINTER) + (TEXTOBJ 12 POINTER) + (TEXTOBJ 14 POINTER) + (TEXTOBJ 16 POINTER) + (TEXTOBJ 16 (FLAGBITS . 0)) + (TEXTOBJ 18 POINTER) + (TEXTOBJ 20 POINTER) + (TEXTOBJ 22 POINTER) + (TEXTOBJ 24 POINTER) + (TEXTOBJ 26 POINTER) + (TEXTOBJ 28 POINTER) + (TEXTOBJ 30 POINTER) + (TEXTOBJ 32 POINTER) + (TEXTOBJ 34 POINTER) + (TEXTOBJ 36 POINTER) + (TEXTOBJ 38 POINTER) + (TEXTOBJ 40 POINTER) + (TEXTOBJ 42 POINTER) + (TEXTOBJ 44 POINTER) + (TEXTOBJ 44 (FLAGBITS . 0)) + (TEXTOBJ 46 FULLXPOINTER) + (TEXTOBJ 48 POINTER) + (TEXTOBJ 50 POINTER) + (TEXTOBJ 52 POINTER) + (TEXTOBJ 54 POINTER) + (TEXTOBJ 56 POINTER) + (TEXTOBJ 56 (FLAGBITS . 0)) + (TEXTOBJ 58 POINTER) + (TEXTOBJ 58 (FLAGBITS . 0)) + (TEXTOBJ 58 (FLAGBITS . 16)) + (TEXTOBJ 58 (FLAGBITS . 32)) + (TEXTOBJ 58 (FLAGBITS . 48)) + (TEXTOBJ 60 POINTER) + (TEXTOBJ 62 POINTER) + (TEXTOBJ 64 POINTER) + (TEXTOBJ 66 POINTER) + (TEXTOBJ 68 POINTER) + (TEXTOBJ 70 POINTER) + (TEXTOBJ 70 (FLAGBITS . 0)) + (TEXTOBJ 72 POINTER) + (TEXTOBJ 74 FULLXPOINTER) + (TEXTOBJ 76 POINTER) + (TEXTOBJ 78 POINTER) + (TEXTOBJ 80 POINTER) + (TEXTOBJ 82 POINTER) + (TEXTOBJ 84 POINTER) + (TEXTOBJ 86 POINTER) + (TEXTOBJ 88 POINTER) + (TEXTOBJ 88 (FLAGBITS . 0)) + (TEXTOBJ 88 (FLAGBITS . 16)) + (TEXTOBJ 90 POINTER) + (TEXTOBJ 92 POINTER) + (TEXTOBJ 94 POINTER)) + '96) + + + +(* ;; "The BIN-level functions") + +(DEFINEQ + +(\TEXTBIN + [LAMBDA (TSTREAM) + + (* ;; "Edited 3-Feb-2024 14:27 by rmk") + + (* ;; "Edited 1-Feb-2024 11:44 by rmk") + + (* ;; "Edited 7-Jan-2024 12:00 by rmk") + + (* ;; "Edited 17-Jun-2023 13:47 by rmk") + + (* ;; "Edited 3-May-2023 15:09 by rmk") + + (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objects") + + (* ;; "Edited 28-Mar-94 15:33 by jds") + +(* ;;; "The BIN slow case for a text stream. For the fast, binable (THINFILE, THINSTRING) cases, this is called when an end-of-buffer is reached. If it is not also an end-of-piece, get a new buffer and continue. Otherwise, get a new piece (which may not be binable).") + +(* ;;; "If the stream is not binable (all other piece types) this gets called on every BIN. Then we start an extra test to distinguish between buffer overflow and piece overflow.") + +(* ;;; "The external filepointer (GETFILEPTR, SETFILEPTR) is calculated in characters: the total number of characters in all previous pieces, plus the characters (based on the offset) in the current piece.") + + (DECLARE (LOCALVARS . T)) + (LET ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM)) + (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))) + (if (ffetch (STREAM BINABLE) of TSTREAM) + then + (* ;; "The BIN opcode detected a buffer overflow, move either to the next buffer for this piece, or the next piece. The opcode doesn't manages only COFFSET, so here we have to figure out what4 PCCHARSOFFSET should have been. NOTE: PCCHARSOFFSET cannot be changed in the stream unless the STARTINGCOFFSET is also bumped to the COFFSET.") + + (* ;; "The COFFSET goes from 0 to CBUFFSIZE--when it is = to CBUFSIZE we get an overflow. That maps to 0 in the next buffer. When we come here in that case, we haven't actually read that characte.") + + [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET) + of TSTREAM) + (ffetch (TEXTSTREAM + STARTINGCOFFSET) + of TSTREAM] + (* ; "1-byte characters") + (if (\ENDOFPIECEP TSTREAM PCCHARSLEFT) + then + (* ;; "Move to next piece. EOF handled below") + + (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC) + 0)) + else + (* ;; "Set up for the next buffer in the same piece. We want to set it for the next unread character. We don't SUB1 because the character hasn't yet been read.") + + (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)) + (CL:IF PC + (BIN TSTREAM) + (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM)) + else + (* ;; + "Not binable, more complicated return values. Opcode kicked out, didn't test for buffer overflow .") + + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + + (* ;; "Buffer overflow. Installers replace PCCHARSLET") + + [if (\ENDOFPIECEP TSTREAM PCCHARSLEFT) + then (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC) + 0)) + else (AND NIL (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT]) + (if (NOT PC) + then (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM) + elseif (ffetch (STREAM BINABLE) of TSTREAM) + then (BIN TSTREAM) + else (ADD (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM) + -1) (* ; + "Where we will be when the operation completes") + (SELECTC (PTYPE PC) + (FATSTRING.PTYPE (* ; + "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) + 1))) + (FATFILE2.PTYPE + (PROG1 (\WIN (PCONTENTS PC)) + (ADD (ffetch (STREAM COFFSET) of TSTREAM) + 2))) + (OBJECT.PTYPE + (* ;; + "Return the object as BIN's result, and make sure we'll go to the next page next time.") + + (* ;; + "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects") + + (PROG1 (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ) + of TSTREAM) + 'OBJECTBYTE) + (PCONTENTS PC)) + (ADD (ffetch (STREAM COFFSET) of TSTREAM) + 1))) + (FATFILE1.PTYPE + (PROG1 (LOGOR (LLSH (PCHARSET PC) + 8) + (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)))) + (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))) + (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]) + +(\TEXTPEEKBIN + [LAMBDA (TSTREAM NOERROR) (* ; "Edited 1-Feb-2024 11:13 by rmk") + (* ; "Edited 9-Aug-2022 10:19 by rmk") + (* ; "Edited 7-Aug-2022 23:53 by rmk") + + (* ;; "Return the next character (object) without advancing TSTREAM") + + (DECLARE (LOCALVARS . T)) + (LET (ORIGPC BUFFERCHANGED (PC (fetch (TEXTSTREAM PIECE) of TSTREAM)) + (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))) + (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM) (* ; "See notes at \TEXTBIN") + [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET) + of TSTREAM) + (ffetch (TEXTSTREAM STARTINGCOFFSET) + of TSTREAM]) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) (* ; "Buffer overflow.") + (if (\ENDOFPIECEP TSTREAM PCCHARSLEFT) + then (SETQ ORIGPC PC) + (SETQ PC (\TEDIT.INSTALL.PIECE TSTREAM (NEXTPIECE PC) + 0)) + else (SETQ BUFFERCHANGED T) + (\TEDIT.INSTALL.FILEBUFFER TSTREAM (SUB1 PCCHARSLEFT)))) + (if (NOT PC) + then (CL:IF NOERROR + NIL + (STREAMOP 'ENDOFSTREAMOP TSTREAM TSTREAM)) + else (PROG1 (SELECTC (PTYPE PC) + (THINFILE.PTYPE + (\PEEKBIN (PCONTENTS PC))) + (THINSTRING.PTYPE + (\GETBASEBYTE (ffetch (STREAM CBUFPTR) of TSTREAM) + (ffetch (STREAM COFFSET) of TSTREAM))) + (FATSTRING.PTYPE + (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM) + (ffetch (STREAM COFFSET) of TSTREAM))) + (FATFILE2.PTYPE + (PROG1 (LOGOR (LLSH (BIN (PCONTENTS PC)) + 8) + (\PEEKBIN (PCONTENTS PC))) + (\BACKFILEPTR (PCONTENTS PC)))) + (OBJECT.PTYPE + (* ;; + "Return the object as BIN's result, and make sure we'll go to the next page next time.") + + (* ;; + "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects") + + (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + 'OBJECTBYTE) + (PCONTENTS PC))) + (UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC))) + (FATFILE1.PTYPE + (LOGOR (LLSH (PCHARSET PC) + 8) + (\PEEKBIN (PCONTENTS PC)))) + (SUBSTREAM.PTYPE (* ; "A substream stored as an object") + (BIN (IMAGEOBJPROP (PCONTENTS PC) + 'SUBSTREAM))) + (SHOULDNT "UNKNOWN PIECE TYPE")) + + (* ;; "If we had to advance, go back to where we were.") + + (if ORIGPC + then (\TEDIT.INSTALL.PIECE TSTREAM ORIGPC (IDIFFERENCE (PLEN ORIGPC) + PCCHARSLEFT)) + elseif BUFFERCHANGED + then (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)))]) + +(\TEXTBACKFILEPTR + [LAMBDA (TSTREAM) (* ; "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") + (* ; "Edited 15-Oct-2023 12:08 by rmk") + (* ; "Edited 22-Sep-2023 10:11 by rmk") + (* ; "Edited 17-Jun-2023 13:47 by rmk") + (* ; "Edited 3-May-2023 15:05 by rmk") + (* ; "Edited 12-Oct-2022 15:26 by rmk") + (* ; "Edited 28-Mar-94 15:32 by jds") + + (* ;; "BACKFILEPTR of a text stream backs over a character.") + + (LET ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM)) + (PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)) + PPC) + (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM) + + (* ;; "The stream was keeping track of BINS, we have to recalibrate.") + + [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET) + of TSTREAM) + (ffetch (TEXTSTREAM STARTINGCOFFSET) + of TSTREAM]) + + (* ;; "Back the offset one character's worth of bytes") + + (CL:WHEN (if (\STARTOFPIECEP TSTREAM PCCHARSLEFT) + then (CL:WHEN (SETQ PPC (\PREV.VISIBLE.PIECE PC)) + (* ; + "Back up to last char of previous piece, if any.") + (\TEDIT.INSTALL.PIECE TSTREAM PPC (SUB1 (PLEN PPC))) + (SETQ PC PPC)) + elseif (AND (MEMB (PTYPE PC) + FILE.PTYPES) + (\STARTOFBUFFERP TSTREAM)) + then + (* ;; "Must be a buffered file, needs to back up 1 character (not bytes) ") + + (\TEDIT.INSTALL.FILEBUFFER TSTREAM (ADD1 PCCHARSLEFT)) + else + (* ;; + "This piece can be backed up at least one character's worth of bytes, back it up") + + (ADD (ffetch (STREAM COFFSET) of TSTREAM) + (CL:IF (MEMB (PTYPE PC) + FILE.PTYPES) + (IMINUS (PBYTESPERCHAR PC)) + -1)) + + (* ;; "If not binable, PCCHARSLEFT is maintained here.") + + (CL:UNLESS (ffetch (STREAM BINABLE) of TSTREAM) + (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with (ADD1 PCCHARSLEFT))) + T) + + (* ;; "We have now backed up to a piece that has at least one character. We are supposed to return the character we backed over. These special cases are copied from \TEXTPEEKBIN.") + + (SELECTC (PTYPE PC) + (THINFILE.PTYPE + (\PEEKBIN (PCONTENTS PC))) + (THINSTRING.PTYPE + (\GETBASEBYTE (ffetch (STREAM CBUFPTR) of TSTREAM) + (ffetch (STREAM COFFSET) of TSTREAM))) + (FATSTRING.PTYPE + (\GETBASEFAT (ffetch (STREAM CBUFPTR) of TSTREAM) + (ffetch (STREAM COFFSET) of TSTREAM))) + (FATFILE2.PTYPE + (PROG1 (LOGOR (LLSH (BIN (PCONTENTS PC)) + 8) + (\PEEKBIN (PCONTENTS PC))) + (\BACKFILEPTR (PCONTENTS PC)))) + (OBJECT.PTYPE + (* ;; + "Return the object as BIN's result, and make sure we'll go to the next page next time.") + + (* ;; + "OBJECTBYTE is for callers (like COMPARETEXT) that can't deal with image objects") + + (OR (GETTEXTPROP (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + 'OBJECTBYTE) + (PCONTENTS PC))) + (UTF8.PTYPE (UTF8.PEEKCCODEFN (PCONTENTS PC))) + (FATFILE1.PTYPE + (LOGOR (LLSH (PCHARSET PC) + 8) + (\PEEKBIN (PCONTENTS PC)))) + (SUBSTREAM.PTYPE (* ; "A substream stored as an object") + (BIN (IMAGEOBJPROP (PCONTENTS PC) + 'SUBSTREAM))) + (SHOULDNT "UNKNOWN PIECE TYPE")))]) + +(\TEDIT.INSTALL.FILEBUFFER + [LAMBDA (TSTREAM PCCHARSLEFT) (* ; "Edited 28-Dec-2023 17:53 by rmk") + (* ; "Edited 7-Dec-2023 16:10 by rmk") + (* ; "Edited 8-Sep-2023 10:40 by rmk") + (* ; "Edited 8-Sep-2022 14:17 by rmk") + (* ; "Edited 21-Aug-2022 22:35 by rmk") + (* ; "Edited 7-Aug-2022 20:35 by rmk") + (* ; "Edited 31-Jul-2022 20:09 by rmk") + + (* ;; "Sets up the buffer and buffering parameters ofTSTREAM and the underlying PFILE of its piece so that the next BIN wlil return the character PCCHARSLEFT away from the end of the piece. PCCHARSLEFT is piecewise, STARTINGCOFFSET and other buffering parameters are bufferwise.") + + (* ;; "The buffer may overflow even when the piece itself is not exhausted.") + + (* ;; "Called on buffer overflow when the piece itself is not exhausted. .") + + (* ;; "A binable stream doesn't track the number of 1-byte chars left in this piece, but COFFSET minus STARTINGCOFFSET enables the PCCHARSLEFT to be determined at the end of the buffer. ") + + (LET* ((PC (fetch (TEXTSTREAM PIECE) of TSTREAM)) + (PFILE (PCONTENTS PC)) + PCBYTESLEFT) + (CL:UNLESS (MEMB (PTYPE PC) + FILE.PTYPES) + (HELP "FILE BUFFER FOR NON-FILE PIECE" PC)) + (CL:UNLESS (AND PFILE (\GETSTREAM PFILE 'INPUT T)) (* ; + "The file was closed for some reason; reopen it.") + (SETQ PFILE (\TEDIT.REOPEN.STREAM TSTREAM PFILE))) + (CL:UNLESS PCCHARSLEFT (* ; "First character of the piece") + (SETQ PCCHARSLEFT (PLEN PC))) + + (* ;; "PCBYTESLEFT is the number of bytes already covered so that PCCHARSLEFT characters are left in the piece.") + + (SETQ PCBYTESLEFT (ITIMES (IDIFFERENCE (PLEN PC) + PCCHARSLEFT) + (PBYTESPERCHAR PC))) + + (* ;; "Set PFILE to the byte position of the next character of this piece, establishing the PFILE buffer, offset") + + (\SETFILEPTR PFILE (IPLUS (PFPOS PC) + PCBYTESLEFT)) + (\PEEKBIN PFILE T) + + (* ;; + "PFILE's buffer parameters should now be good; steal the fields needed to simulate that stream. ") + + (* ;; + "The TSTREAM buffersize is reduced so that it only covers bytes that remain in the current piece.") + + (freplace (STREAM CPPTR) of TSTREAM with (ffetch (STREAM CPPTR) of PFILE)) + (freplace (STREAM CBUFSIZE) of TSTREAM with (IMIN (IPLUS (ffetch (STREAM COFFSET) + of PFILE) + (IDIFFERENCE (PBYTELEN PC) + PCBYTESLEFT)) + (ffetch (STREAM CBUFSIZE) of PFILE))) + (freplace (STREAM COFFSET) of TSTREAM with (ffetch (STREAM COFFSET) of PFILE)) + (freplace (TEXTSTREAM STARTINGCOFFSET) of TSTREAM with (fetch (STREAM COFFSET) of TSTREAM)) + (freplace (TEXTSTREAM PCCHARSLEFT) of TSTREAM with PCCHARSLEFT]) + +(\TEXTBOUT + [LAMBDA (TSTREAM CHAR) (* ; "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") + + (* ;; "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) + (\ILLEGAL.ARG CHAR)) + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (CH# (ADD1 (\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 (\INSERTCH CHAR CH# TEXTOBJ)) + + (* ;; "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. ") + + (\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]) +) +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \ENDOFPIECEP MACRO ((TSTREAM PCLEFT) + (EQ 0 PCLEFT))) + +(PUTPROPS \STARTOFPIECEP MACRO ((TSTREAM PCLEFT) + (IEQP (PLEN (ffetch (TEXTSTREAM PIECE) of TSTREAM)) + PCLEFT))) + +(PUTPROPS \ENDOFBUFFERP MACRO ((TSTREAM) + (IGEQ (ffetch (STREAM COFFSET) of TSTREAM) + (ffetch (STREAM CBUFSIZE) of TSTREAM)))) + +(PUTPROPS \STARTOFBUFFERP MACRO ((TSTREAM) + (ILEQ (ffetch (STREAM COFFSET) of TSTREAM) + (ffetch (TEXTSTREAM STARTINGCOFFSET) of TSTREAM)))) +) +) + + + +(* ;; "External format functions: equivalent to BIN-level except for COUNTP") + +(DEFINEQ + +(\TEXTSTREAM.OUTCHARFN + [LAMBDA (TSTREAM CHARCODE) (* ; "Edited 18-Oct-2023 21:05 by rmk") + (* ; "Edited 22-Jul-2022 19:05 by rmk") + (* ; "Edited 12-Oct-2021 15:38 by rmk:") + + (* ;; "OUTCHARFN for TEXTSTREAM -- BOUTs the 16-bit CHARCODE (via \TEXTBOUT), because TEdit streams deal in complete charcodes rather than bytes. Updates the CHARPOSITION of the stream, which is used by some code to decide things.") + + (COND + ((EQ CHARCODE (CHARCODE EOL)) + (\TEXTBOUT TSTREAM (CHARCODE CR)) + (freplace (STREAM CHARPOSITION) of TSTREAM with 0)) + (T (\TEXTBOUT TSTREAM CHARCODE) + (freplace (STREAM CHARPOSITION) of TSTREAM with (PROGN + (* ; "Ugh. Don't overflow") + (IPLUS16 (ffetch (STREAM + CHARPOSITION + ) + of TSTREAM) + 1]) + +(\TEXTSTREAM.INCCCODEFN + [LAMBDA (STREAM COUNTP) (* ; "Edited 31-Jan-2024 16:34 by rmk") + (* ; "Edited 7-Aug-2022 22:25 by rmk") + (* ; "Edited 22-Jul-2022 18:47 by rmk") + (* ; "Edited 6-Aug-2021 15:57 by rmk:") + +(* ;;; "Returns a 16 bit character code. ") + +(* ;;; "If COUNTP is non-NIL, the variable *BYTECOUNTER* is set freely to 1, since we only read 1 16-bit %"byte%".") + + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* 1)) + (BIN STREAM]) + +(\TEXTSTREAM.BACKCCODEFN + [LAMBDA (STREAM COUNTP) (* ; "Edited 22-Jul-2022 19:01 by rmk") + (* ; "Edited 19-Jul-2022 17:12 by rmk") + (* ; "Edited 13-Aug-2021 14:08 by rmk:") + (DECLARE (USEDFREE *BYTECOUNTER*)) + (CL:WHEN COUNTP (SETQ *BYTECOUNTER* -1)) + (\TEXTBACKFILEPTR STREAM]) + +(\TEXTSTREAM.FORMATBYTESTREAM + [LAMBDA (STREAM BYTESTREAM) (* ; "Edited 24-Jun-2021 16:47 by rmk:") + (REPLACE (STREAM CHARSET) OF BYTESTREAM WITH (FETCH (STREAM CHARSET) OF STREAM]) +) + + + +(* ;; "High-level stream operations") + +(DEFINEQ + +(OPENTEXTSTREAM + [LAMBDA (TEXT WINDOW START END PROPS) + + (* ;; "Edited 21-Jan-2024 10:31 by rmk") + + (* ;; "Edited 20-Dec-2023 10:47 by rmk") + + (* ;; "Edited 11-Dec-2023 09:50 by rmk") + + (* ;; "Edited 26-Oct-2023 10:59 by rmk") + + (* ;; "Edited 23-Oct-2023 22:14 by rmk") + + (* ;; "Edited 21-Oct-2023 12:21 by rmk") + + (* ;; "Edited 12-Oct-2023 23:44 by rmk") + + (* ;; "Edited 31-Jan-2022 17:25 by rmk: A string TEXT is converted here to a stream") + + (* ;; "Edited 4-May-93 14:38 by jds") + + (* ;; "Create a TEXTSTREAM to describe the segment of TEXT between START and END. Optionally, connect that to WINDOW for display. This is the user entry for creating a (sub) textstream. ") + + (* ;; "") + + (* ;; "If TEXT designates a file, we want to make sure that the file exists and can be opened before bothering the user to do anything else (like define a window region). ") + + (* ;; "") + + (* ;; "If TEXT is already a text stream, that stream and its text are reused. But if START and/or END are non-NIL, the pieces before START and after END are deleted from the given text stream. (An alternative interpretation would be to create a new textstream and insert characters from START to END into it.)") + + (* ;; "") + + (* ;; "If the WINDOW argument is non-NIL, this is responsible for reusing or creating a window and associating it with the text. To avoid needless user interaction, we ask for a region and create the window after we have been able to open the text stream. But we do the other Tedit window initiallization after the textstream and textobj have been populated. Note that we do need to make sure the TEXTOBJ exists before we actually get the file, so that the window and its promptwindow are available for messages as the file is read.") + + (* ;; "") + + (* ;; " Finally, WINDOW is passed as T (e.g. from TEDIT) to say that a region must be obtained for a required window.") + + (RESETLST + (LET ((TSTREAM (TEXTSTREAMP TEXT)) + TEXTOBJ TEDIT.GET.FINISHEDFORMS) + (DECLARE (SPECVARS TEDIT.GET.FINISHEDFORMS)) (* ; + "Undocumented, but available for special-purpose actions specified somewhere below.") + (if TSTREAM + then (SETQ TEXTOBJ (TEXTOBJ TSTREAM)) + (CL:WHEN (OR START END) (* ; "Do the end first") + (CL:WHEN (AND END (ILESSP END (TEXTLEN TEXTOBJ))) + (\DELETEPIECES (\SELPIECES (ADD1 END) + (TEXTLEN TEXTOBJ) + TEXTOBJ) + TEXTOBJ)) + (CL:WHEN (AND START (IGREATERP START 1)) + (\DELETEPIECES (\SELPIECES 1 (SUB1 START) + TEXTOBJ) + TEXTOBJ))) + (\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS) + (if (\TEDIT.PRIMARYW TSTREAM) + then (* ; + "If there is an existing window, clean and reuse it, and ignore WINDOW.") + (\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 -1) + (TEDIT.UPDATE.SCREEN TEXTOBJ) + (SETTOBJ TEXTOBJ \DIRTY NIL) + (SETQ WINDOW NIL) + else (SETQ WINDOW (\TEDIT.CREATEW WINDOW TSTREAM PROPS)) + (* ; "Set up a new window") + (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS)) + else (SETQ TSTREAM (\TEDIT.CREATE.TEXTSTREAM PROPS)) + (SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (CL:WHEN TEXT (* ; + "Verify/open the file before the window") + (SETQ TEXT (\TEDIT.OPENTEXTFILE TEXT PROPS)) + (FSETTOBJ TEXTOBJ TXTFILE TEXT)) + + (* ;; "Get the window before populating pieces, so that the local promptwindow is availabe for messages and queries") + + (CL:WHEN WINDOW (* ; + "If NIL, don't create a window. It's T on call from TEDIT") + (SETQ WINDOW (\TEDIT.CREATEW WINDOW TSTREAM PROPS))) + (CL:WHEN TEXT + + (* ;; "TEXT is a stream. The fresh TEXTSTREAM is updated to hold that text, ready for window and process attachments.") + + (\TEDIT.OPENTEXTSTREAM.PIECES TEXT TSTREAM START END PROPS)) + + (* ;; "We now have all the pieces, even for TEXT=NIL (empty document) case.") + + (CL:WHEN WINDOW (* ; "Connect to the window") + (\TEDIT.OPENTEXTSTREAM.WINDOW WINDOW TSTREAM PROPS))) + (\TEDIT.OPENTEXTSTREAM.SETUP.SEL TSTREAM) + (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) + (\TEXTSETFILEPTR TSTREAM 0) + TSTREAM))]) + +(COPYTEXTSTREAM + [LAMBDA (ORIGINAL CROSSCOPY) (* ; "Edited 16-Jan-2024 12:27 by rmk") + (* ; "Edited 22-Sep-2023 20:48 by rmk") + (* ; "Edited 18-Sep-2023 08:21 by rmk") + (* ; "Edited 16-Sep-2023 13:06 by rmk") + (* ; "Edited 21-Jun-2023 00:02 by rmk") + (* ; "Edited 7-May-2023 11:42 by rmk") + (* ; "Edited 25-Apr-2023 18:07 by rmk") + (* ; "Edited 18-Mar-2023 21:15 by rmk") + (* ; + "Edited 24-Apr-95 12:02 by sybalsky:mv:envos") + + (* ;; "Given a stream, textobj or window, returns a new textstream with the same contents. CROSSCOPY is a documented argument, but it doesn't control what happens. It is supposed to force a copy of a file piece to a new underlying source (a string or nodircore piece), so that there is no sharing between the original and the copy so that future edits in one stream are independent and safe even if the original file is deleted or modified by operations on the other stream. But edit operations don't change the source file until the file is saved, and tne you get a new version anyway. In any event, CROSSCOPY is T in all calls within TEDIT (e.g. for installing edit menus).") + + (LET ((TEXTOBJ (TEXTOBJ ORIGINAL)) + NEWSTREAM NEWTEXTOBJ) (* ; + "Create an empty textstream into which the pieces can be hammered") + [SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (COPY (FGETTOBJ TEXTOBJ EDITPROPS] + (SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM)) + (for PC inpieces (\FIRSTPIECE TEXTOBJ) do (\INSERTPIECE (\TEDIT.COPYPIECE PC TEXTOBJ + NEWTEXTOBJ NIL 'COPY) + NIL NEWTEXTOBJ)) + (FSETTOBJ NEWTEXTOBJ FORMATTEDP (FGETTOBJ TEXTOBJ FORMATTEDP)) + (FSETTOBJ NEWTEXTOBJ DEFAULTCHARLOOKS (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)) + (FSETTOBJ NEWTEXTOBJ FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC)) + (FSETTOBJ NEWTEXTOBJ TXTRTBL (FGETTOBJ TEXTOBJ TXTRTBL)) + (FSETTOBJ NEWTEXTOBJ TXTWTBL (FGETTOBJ TEXTOBJ TXTWTBL)) + (FSETTOBJ NEWTEXTOBJ TXTSTYLESHEET (FGETTOBJ TEXTOBJ TXTSTYLESHEET)) + (FSETTOBJ NEWTEXTOBJ TXTPAGEFRAMES (FGETTOBJ TEXTOBJ TXTPAGEFRAMES)) + (FSETTOBJ NEWTEXTOBJ TXTPARALOOKSLIST (FGETTOBJ TEXTOBJ TXTPARALOOKSLIST)) + (FSETTOBJ NEWTEXTOBJ TXTCHARLOOKSLIST (FGETTOBJ TEXTOBJ TXTCHARLOOKSLIST)) + (FSETTOBJ NEWTEXTOBJ MENUFLG (FGETTOBJ TEXTOBJ MENUFLG)) + NEWSTREAM]) + +(TEDIT.STREAMCHANGEDP + [LAMBDA (STREAM RESET?) (* ; "Edited 31-May-91 13:57 by jds") + (PROG1 (fetch (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM)) + (COND + (RESET? (replace (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM) with NIL))))]) + +(TEXTSTREAMP + [LAMBDA (STREAM) (* jds " 3-Apr-84 14:34") + (* Returns the stream if it is a text + stream, else NIL) + (AND (STREAMP STREAM) + (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) + STREAM]) + +(TXTFILE + [LAMBDA (TEXTOBJ) (* ; "Edited 13-Jul-2023 19:49 by rmk") + (* ; "Edited 31-May-91 13:58 by jds") + + (* ;; "This function is for compiled access to the TXTFILE field in RESETSAVE expressions. But maybe user functions should be able to call it, hence the call to TEXTOBJ") + + (fetch (TEXTOBJ TXTFILE) of (TEXTOBJ TEXTOBJ]) + +(REOPENTEXTSTREAM + [LAMBDA (STREAM) (* ; "Edited 22-Jan-2024 10:20 by rmk") + + (* ;; "RMK: Not sure whether this should operate on any stream, or just (by virtue of its name) a text stream. I put in the TEXTSTREAMP test.") + (* ; "Edited 31-May-91 14:18 by jds") + (CL:WHEN (TEXTSTREAMP STREAM) + (replace (STREAM ACCESS) of STREAM with 'BOTH) + (replace (STREAM BINABLE) of STREAM with T) + (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \TEXTBIN)) + (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \TEXTBOUT))) + STREAM]) +) +(DEFINEQ + +(\TEDIT.OPENTEXTSTREAM.PIECES + [LAMBDA (TEXT TSTREAM START END PROPS) (* ; "Edited 27-Dec-2023 13:33 by rmk") + (* ; "Edited 23-Oct-2023 13:47 by rmk") + (* ; "Edited 28-Sep-2023 10:17 by rmk") + (* ; "Edited 27-Sep-2023 00:13 by rmk") + (* ; "Edited 18-Sep-2023 17:15 by rmk") + (* ; "Edited 17-Sep-2023 15:13 by rmk") + (* ; "Edited 12-Sep-2023 16:46 by rmk") + (* ; "Edited 9-Sep-2023 16:41 by rmk") + + (* ;; "Don't set TXTFILE here, because TEDIT.GET still needs it. WINDOW is available for size information, but it has not yet been setup for TEDIT. ") + + (* ;; "The intent is that the window's promptwindow is available for local messages during the fetch, and the RESETSAVE of PROMPTWINDOW would make even messages to the global promptwindow appear locally. An example is the mouseconfirm in READIMAGEOBJ that asks whether the imageobj code should be loaded from a given file. The problem is that the Tedit prompt window is usually just 1 line hight and doesn't automatically grow to show multiple lines, so key information may not be displayed. If the Tedit prompt grows (and it can be determined when/if it should later shrink), then this feature can be enabled.") + + (RESETLST + (LET* [(TEXTOBJ (\DTEST (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + 'TEXTOBJ)) + (PWINDOW (GETTOBJ TEXTOBJ PROMPTWINDOW)) + (READONLY (GETTEXTPROP TEXTOBJ 'READONLY] (* ; + "READONLY only after creation, if specified") + (AND NIL (CL:WHEN PWINDOW (RESETSAVE PROMPTWINDOW PWINDOW))) + (FSETTOBJ TEXTOBJ TXTREADONLY NIL) + (FSETTOBJ TEXTOBJ TXTDON'TUPDATE T) (* ; + "Don't display or record histories until done") + (FSETTOBJ TEXTOBJ TXTHISTORY 'DON'T) + [if (OR (GETTEXTPROP TEXTOBJ 'CACHE) + (NOT (RANDACCESSP TEXT))) + then (* ; + "If the file device isn't random access, cache the file locally.") + (* ; + "Also do this if he asks for a local cache.") + (SETQ TEXT (\TEDIT.CACHEFILE TEXT TEXTOBJ START END)) + + (* ;; + "Since we only copied the relevant part of the file into the cache, the whole file is now relevant.") + + (SETQ START 0) + (SETQ END (GETEOFPTR TEXT)) + else (SETQ START (IMAX 0 (OR START 0))) + (SETQ END (IMIN (GETEOFPTR TEXT) + (OR END (GETEOFPTR TEXT] + (if (OR (GETTEXTPROP TEXTOBJ 'CLEARGET) + (GETTEXTPROP TEXTOBJ 'UNFORMATTED?) + (GETTEXTPROP TEXTOBJ 'UNFORMATTED) + (GETTEXTPROP TEXTOBJ 'PLAINTEXT)) + then (\TEDIT.GET.UNFORMATTED.FILE TEXT TSTREAM START END PROPS) + elseif (\TEDIT.GET.FORMATTED.FILE TEXT TSTREAM START END PROPS) + elseif (\TEDIT.GET.FOREIGN.FILE TEXT TSTREAM START END PROPS) + else (\TEDIT.GET.UNFORMATTED.FILE TEXT TSTREAM START END)) + (FSETTOBJ TEXTOBJ TXTREADONLY READONLY) + (FSETTOBJ TEXTOBJ TXTHISTORY NIL) + (FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) + (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ :Get)) + (FSETTOBJ TEXTOBJ TXTDON'TUPDATE NIL))) + TSTREAM]) + +(\TEDIT.OPENTEXTSTREAM.PROPS + [LAMBDA (TEXTOBJ PROPS) (* ; "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.") + + (* ;; "After this, all values should be retrieved 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)))]) + +(\TEDIT.OPENTEXTSTREAM.SETUP.SEL + [LAMBDA (TSTREAM) (* ; "Edited 15-Dec-2023 23:05 by rmk") + (* ; "Edited 12-Oct-2023 22:48 by rmk") + (* ; "Edited 17-Sep-2023 12:52 by rmk") + (* ; "Edited 12-Sep-2023 11:26 by rmk") + (* ; "Edited 9-Sep-2023 13:43 by rmk") + (* ; "Edited 1-Sep-2023 23:02 by rmk") + + (* ;; "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) + (\SHOWSEL SEL NIL) + (CL:UNLESS (EQ SELPROP 'DON'T) + (if (type? SELECTION SELPROP) + then (* ; + "We came in with an explicit initial selection. Set it up.") + (\COPYSEL SELPROP SEL) + (FSETSEL SEL SELTEXTOBJ TEXTOBJ) + 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 (OR (FIXP SELPROP) + 1) + 0 + 'LEFT) + (FSETSEL SEL SELKIND 'CHAR)) + [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 + DEFAULTCHARLOOKS + ] + (CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY) (* ; + "Don't blink for read-only, but do highlighting") + (FSETSEL SEL HASCARET NIL)) + (\SHOWSEL SEL T)) + SEL]) + +(\TEDIT.OPENTEXTSTREAM.WINDOW + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "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 ") + + (LET ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + (FILEPTR (\TEXTGETFILEPTR TSTREAM))) + (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)) + (\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]) + +(\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS + [LAMBDA (TEXTOBJ) (* ; "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") + + (* ;; + "The default looks must be created before the first piece, so that they can provide field-defaults.") + + (LET (FONT CHARLOOKS PARALOOKS) + + (* ;; "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 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))) + (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) + )) + 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") + (* ; "Edited 28-Oct-2023 10:33 by rmk") + (* ; "Edited 26-Sep-2023 18:00 by rmk") + (* ; "Edited 24-Sep-2023 23:13 by rmk") + (* ; "Edited 18-Sep-2023 22:40 by rmk") + (* ; "Edited 17-Sep-2023 21:29 by rmk") + (CL:WHEN TEXT + (if (OR (LITATOM TEXT) + (STRINGP TEXT) + (CL:PATHNAMEP TEXT)) + then (* ; "String detects empty extension") + [OPENSTREAM (OR (if (OR (CL:PATHNAMEP TEXT) + (FILENAMEFIELD.STRING TEXT 'EXTENSION)) + then (FINDFILE TEXT T) + elseif (FINDFILE-WITH-EXTENSIONS TEXT NIL *TEDIT-EXTENSIONS*)) + TEXT) + 'INPUT + 'OLD + `((TYPE TEXT) + (FORMAT ,(LISTGET PROPS 'FORMAT] + elseif (\GETSTREAM TEXT 'INPUT T) + else + (* ;; "Perhaps this should be an error--remove T from the \GETSTREAM?") + + TEXT))]) + +(\TEDIT.CREATE.TEXTSTREAM + [LAMBDA (PROPS) (* ; "Edited 21-Jan-2024 15:16 by rmk") + (* ; "Edited 17-Sep-2023 00:38 by rmk") + (* ; "Edited 12-Sep-2023 11:27 by rmk") + + (* ;; "Creates and initializes an empty, windowless textstream") + + (LET (TSTREAM (TEXTOBJ (create TEXTOBJ))) + (SETQ TSTREAM (create TEXTSTREAM + TEXTOBJ _ TEXTOBJ)) + (SETTOBJ TEXTOBJ STREAMHINT TSTREAM) + (\TEDIT.OPENTEXTSTREAM.PROPS TEXTOBJ PROPS) + (\MAKEPCTB TEXTOBJ) + (\TEDIT.INSTALL.PIECE TSTREAM (FGETTOBJ TEXTOBJ LASTPIECE) + 0) + TSTREAM]) + +(\TEDIT.REOPEN.STREAM + [LAMBDA (TSTREAM PIECESTREAM) (* ; "Edited 23-Jan-2024 00:28 by rmk") + (* ; "Edited 9-Nov-2023 17:05 by rmk") + (* ; "Edited 8-Sep-2023 00:23 by rmk") + (* ; "Edited 15-Sep-2022 22:56 by rmk") + (* ; "Edited 11-Jun-99 15:12 by rmk:") + (* ; "Edited 15-Apr-93 15:53 by jds") + + (* ;; "Re-open a backing file stream, and propogate the change thru the entire piece table. Also, if TXTFILE is set to the closed stream, fill it in as well. If there is a reopen operation that simply smashes the existing stream-datum, we wouldn't have to do the sweep.") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + NEWSTREAM) + (CL:UNLESS PIECESTREAM + (SETQ PIECESTREAM (FGETTOBJ TEXTOBJ TXTFILE))) + [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:") + + (for PC inpieces (\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:") + + (CL:WHEN (EQ (FGETTOBJ TEXTOBJ TXTFILE) + PIECESTREAM) + (FSETTOBJ TEXTOBJ TXTFILE NEWSTREAM)) + + (* ;; "Return the new value for the stream:") + + NEWSTREAM]) + +(\TEXTINIT + [LAMBDA NIL (* ; "Edited 7-Mar-2023 15:01 by rmk") + (* ; "Edited 28-Aug-2022 22:19 by rmk") + (* ; "Edited 22-Jul-2022 20:02 by rmk") + (* ; "Edited 3-Jul-2022 00:34 by rmk") + (* ; "Edited 5-May-2022 15:12 by rmk") + (* ; "Edited 7-Oct-2021 08:40 by rmk:") + (* ; + "Create the FDEV and STREAM prototypes for TEXT streams.") + + (* ;; "TEXT streams make use of the following STREAM fields:") + + (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)") + + (* ;; "F1 Number of characters to the end of the current piece") + + (* ;; "F2 Starting offset for the character in this piece end of underlying file's page") + + (* ;; "F3 The TEXTOBJ for this stream") + + (* ;; "F4 LOOKSUPDATEFN") + + (* ;; "F5 The PIECE we're currently inside") + + (* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)") + + (* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)") + + (* ;; "(FW8 WORD)") + + [SETQ \TEXTIMAGEOPS (create IMAGEOPS + IMAGETYPE _ 'TEXT + IMXPOSITION _ (FUNCTION \TEXTDSPXPOSITION) + IMYPOSITION _ (FUNCTION \TEXTDSPYPOSITION) + IMLEFTMARGIN _ (FUNCTION \TEXTLEFTMARGIN) + IMRIGHTMARGIN _ (FUNCTION \TEXTRIGHTMARGIN) + IMFONT _ (FUNCTION \TEXTDSPFONT) + IMCLOSEFN _ (FUNCTION NILL) + IMFONTCREATE _ 'DISPLAY + IMLINEFEED _ (FUNCTION \TEXTDSPLINEFEED) + IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH) + IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH) + IMSCALE _ (FUNCTION (LAMBDA NIL 1] + + (* ;; "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") + + (MAKE-EXTERNALFORMAT :TEXTSTREAM (FUNCTION \TEXTSTREAM.INCCCODEFN) + (FUNCTION \TEXTPEEKBIN) + (FUNCTION \TEXTSTREAM.BACKCCODEFN) + (FUNCTION \TEXTSTREAM.OUTCHARFN) + (FUNCTION \TEXTSTREAM.FORMATBYTESTREAM) + 'CR) + (SETQ \TEXTFDEV (create FDEV + DEVICENAME _ 'TEXT + RESETABLE _ T + RANDOMACCESSP _ T + PAGEMAPPED _ NIL + GETFILENAME _ (FUNCTION NILL) + BIN _ (FUNCTION \TEXTBIN) + BOUT _ (FUNCTION \TEXTBOUT) + CLOSEFILE _ (FUNCTION \TEXTCLOSEF) + OPENFILE _ (FUNCTION \TEXTOPENF) + DELETEFILE _ (FUNCTION NILL) + DIRECTORYNAMEP _ (FUNCTION NILL) + EVENTFN _ (FUNCTION NILL) + GENERATEFILES _ (FUNCTION \GENERATENOFILES) + GETFILEINFO _ (FUNCTION NILL) + HOSTNAMEP _ (FUNCTION NILL) + READPAGES _ (FUNCTION NILL) + REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM) + (replace (STREAM ACCESS) of STREAM + with 'BOTH) + STREAM] + SETFILEINFO _ (FUNCTION NILL) + BACKFILEPTR _ (FUNCTION \TEXTBACKFILEPTR) + SETFILEPTR _ (FUNCTION \TEXTSETFILEPTR) + PEEKBIN _ (FUNCTION \TEXTPEEKBIN) + GETEOFPTR _ (FUNCTION \TEXTGETEOFPTR) + GETFILEPTR _ (FUNCTION \TEXTGETFILEPTR) + EOFP _ (FUNCTION \TEXTEOFP) + FDBINABLE _ T + FDBOUTABLE _ NIL + FDEXTENDABLE _ NIL + TRUNCATEFILE _ (FUNCTION NILL) + WRITEPAGES _ (FUNCTION NILL) + DEFAULTEXTERNALFORMAT _ :TEXTSTREAM)) + (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN) + (FUNCTION (LAMBDA (CONDITION) + (LET ((STREAM (STREAM-ERROR-STREAM CONDITION))) + (COND + [(AND (BOUNDP 'ERRORPOS) + (TEXTSTREAMP STREAM)) (* ; + "This happened in the error handler, and it happened to a TEdit stream, so try the fix:") + (LET ((XCL::RESULT (REOPENTEXTSTREAM STREAM))) + (CL:WHEN XCL::RESULT + (ENVAPPLY (STKNAME ERRORPOS) + (SUBST XCL::RESULT STREAM (STKARGS ERRORPOS)) + (STKNTH -1 ERRORPOS ERRORPOS) + ERRORPOS T T))] + (*TEDIT-OLD-STREAM-ERROR-HANDLER* + (* ; + "Some other kind of stream, so punt to the old handler (if there is one):") + (APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION]) + +(\TEXTTTYBOUT + [LAMBDA (STREAM BYTE) (* ; "Edited 18-Mar-2023 20:08 by rmk") + (* ; "Edited 31-May-91 14:18 by jds") + (* Do BOUT to a text stream, which is + an insertion at the caret.) + (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) + (COND + ((EQ BYTE ERASECHARCODE) + (\TEDIT.CHARDELETE TEXTOBJ (fetch (TEXTOBJ SEL) of TEXTOBJ))) + ((EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ) + \PRIMTERMSA) + BYTE))) (* Nothing, ignore it) + ) + (T (SELCHARQ BYTE + ((EOL CR LF) + (\TEXTBOUT STREAM BYTE) + (replace (STREAM CHARPOSITION) of STREAM with 0)) + (PROGN (\TEXTBOUT STREAM BYTE) + (add (fetch (STREAM CHARPOSITION) of STREAM) + 1]) +) + +(RPAQ? *TEDIT-EXTENSIONS* '(TEDIT TED TXT TEXT BRAVO NIL)) + + + +(* ;; "Low-level generic stream operations") + +(DEFINEQ + +(\TEXTCLOSEF + [LAMBDA (TSTREAM) (* ; "Edited 28-Aug-2023 13:12 by rmk") + (* ; "Edited 26-Oct-2022 11:17 by rmk") + (* ; "Edited 22-Aug-2022 14:18 by rmk") + (* ; "Edited 8-Aug-2022 14:56 by rmk") + (* ; "Edited 15-Apr-93 16:43 by jds") + (* ; + "Close the files underlying a stream") + (LET ((TEXTOBJ (TEXTOBJ TSTREAM))) + (for PC inpieces (\FIRSTPIECE TEXTOBJ) when (AND (MEMB (PTYPE PC) + FILE.PTYPES) + (PCONTENTS PC)) + do (CLOSEF? (PCONTENTS PC))) + + (* ;; "And close the REAL file as well, in case we'd made a local cache.") + + (CLOSEF? (GETTOBJ TEXTOBJ TXTFILE]) + +(\TEXTDSPFONT + [LAMBDA (STREAM NEWFONT) (* ; "Edited 15-Oct-2023 17:13 by rmk") + (* ; "Edited 8-Sep-2022 14:16 by rmk") + (* ; "Edited 31-May-91 14:02 by jds") + + (* ;; "Set the font for a TEdit window. Need change the caret looks, for character insertion, and the WINDOW's looks, so that TEXEC type-out to the window does the right thing.") + + (LET ((TEXTOBJ (TEXTOBJ STREAM))) + (PROG1 (fetch (CHARLOOKS CLFONT) of (FGETTOBJ TEXTOBJ CARETLOOKS)) + (CL:WHEN NEWFONT (* ; + "Only do this if there's a new font to set:") + (TEDIT.CARETLOOKS STREAM (\GETFONTDESC NEWFONT 'DISPLAY)) + (for PANE inpanes (PROGN TEXTOBJ) do (DSPFONT NEWFONT PANE))))]) + +(\TEXTEOFP + [LAMBDA (TSTREAM) (* ; "Edited 23-Dec-2023 11:53 by rmk") + (* ; "Edited 1-Jun-2023 17:07 by rmk") + (* ; "Edited 10-Aug-2022 12:41 by rmk") + (* ; "Edited 5-Aug-2022 16:37 by rmk") + (* ; "Edited 31-May-91 14:18 by jds") + + (* ;; "Test for EOF on a text stream: At end of a piece, and there are no more pieces (visible or not). This assumes that there are no zero-length pieces.") + + (OR (ZEROP (TEXTLEN (TEXTOBJ TSTREAM))) + (CL:WHEN (\ENDOFBUFFERP TSTREAM) + [LET ((PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM))) + (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM) + [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET) + of TSTREAM) + (ffetch (TEXTSTREAM + STARTINGCOFFSET + ) of TSTREAM]) + (AND (\ENDOFPIECEP TSTREAM PCCHARSLEFT) + (NULL (NEXTPIECE (fetch (TEXTSTREAM PIECE) of TSTREAM])]) + +(\TEXTGETEOFPTR + [LAMBDA (STREAM) (* ; "Edited 31-May-91 13:58 by jds") + (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) + +(\TEXTGETFILEPTR + [LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2023 20:57 by rmk") + (* ; "Edited 2-Sep-2022 17:45 by rmk") + (* ; "Edited 30-Jul-2022 00:07 by rmk") + (* ; "Edited 28-Mar-94 15:32 by jds") + + (* ;; "GETFILEPTR fn for text streams. Measured in characters (and objects), not 8-bit bytes.") + + (LET ((TEXTOBJ (ffetch (TEXTSTREAM TEXTOBJ) of TSTREAM)) + PC PCCHARSLEFT) + (SETQ PC (ffetch (TEXTSTREAM PIECE) of TSTREAM)) + (if (OR (NULL PC) + (\LASTPIECEP PC TEXTOBJ)) + then + (* ;; "Not set or off the end") + + (FGETTOBJ TEXTOBJ TEXTLEN) + else (* ; "Somewhere inside the document") + (SETQ PCCHARSLEFT (ffetch (TEXTSTREAM PCCHARSLEFT) of TSTREAM)) + (CL:WHEN (ffetch (STREAM BINABLE) of TSTREAM) + + (* ;; "PCCHARSLEFT may lag. If binable, everything is thin, no need to multiply. We don't change anything in TSTREAM") + + [SETQ PCCHARSLEFT (IDIFFERENCE PCCHARSLEFT (IDIFFERENCE (ffetch (STREAM COFFSET) + of TSTREAM) + (ffetch (TEXTSTREAM + STARTINGCOFFSET) + of TSTREAM]) + + (* ;; "-1 to go from TEDIT-selection character-indexing back to nominal %"byte%" positions. SETFILEPTR goes the other way.") + + (IPLUS -1 (\PCTOCH PC TEXTOBJ) + (IDIFFERENCE (PLEN PC) + PCCHARSLEFT]) + +(\TEXTOPENF + [LAMBDA (TSTREAM ACCESS) (* ; "Edited 7-Dec-2023 21:01 by rmk") + (* ; "Edited 22-Aug-2022 15:16 by rmk") + (* ; "Edited 31-May-91 13:58 by jds") + (* ; + "Return the stream, opened for input") + (for PC inpieces (\FIRSTPIECE (TEXTOBJ TSTREAM)) when [AND (MEMB (PTYPE PC) + FILE.PTYPES) + (EQ NoBits (fetch (STREAM ACCESSBITS) + of (PCONTENTS PC] + DO (\TEDIT.REOPEN.STREAM TSTREAM (PCONTENTS PC))) + TSTREAM]) + +(\TEXTSETEOF + [LAMBDA (STREAM EOFPTR) (* ; "Edited 31-May-91 14:19 by jds") + (* Set the EPAGE/EOFFSET of the stream + to be (SUB1 of EOFPTR)) + (replace (STREAM EPAGE) of STREAM with (fetch (BYTEPTR PAGE) of EOFPTR)) + (replace (STREAM EOFFSET) of STREAM with (fetch (BYTEPTR OFFSET) of EOFPTR]) + +(\TEXTSETFILEPTR + [LAMBDA (TSTREAM FILEPOS) (* ; "Edited 23-Dec-2023 12:14 by rmk") + (* ; "Edited 22-Oct-2023 16:14 by rmk") + (* ; "Edited 2-Sep-2022 11:34 by rmk") + (* ; "Edited 8-Aug-2022 23:55 by rmk") + (* ; "Edited 22-Apr-93 13:44 by jds") + (* ; + "Sets the file ptr for a text stream.") + + (* ;; "FILEPOS is known to be a positive number. For other filedevices there is no error if the ptr is set beyond the EOF, and GETFILEPTR will return the new position. But the length of an input file doesn't change and a BIN at any position after the EOF causes the error. An output file grows. Filepos is a %"byte%" position, have to add 1 to get to the notion of character in a Tedit selection.") + + (LET ((TEXTOBJ (\DTEST (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM) + 'TEXTOBJ)) + START-OF-PIECE PC CH#) + (DECLARE (SPECVARS START-OF-PIECE)) + (CL:WHEN (IGREATERP FILEPOS (FGETTOBJ TEXTOBJ TEXTLEN)) + (* ; + "If the fileptr is not within the text, punt. OR: SET IT TO EOF?") + (\ILLEGAL.ARG FILEPOS)) + (CL:UNLESS (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + (SETQ CH# (ADD1 FILEPOS)) + (SETQ PC (\CHTOPC CH# TEXTOBJ T)) + (\TEDIT.INSTALL.PIECE TSTREAM PC (- CH# START-OF-PIECE)))]) + +(\TEXTDSPXPOSITION + [LAMBDA (STREAM XPOSITION) (* ; "Edited 3-Jan-2001 17:27 by rmk:") + (* ; + "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") + + (* ;; + "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") + + (LET [(WINDOW (CAR (fetch \WINDOW of (TEXTOBJ STREAM] + (COND + (WINDOW (DSPXPOSITION NIL WINDOW)) + (T (* ; + "If there is no window, estimate from character position") + (TIMES (CHARWIDTH (CHARCODE SPACE) + STREAM) + (POSITION STREAM]) + +(\TEXTDSPYPOSITION + [LAMBDA (STREAM YPOSITION) (* ; "Edited 31-May-91 13:59 by jds") + + (* Simply returns the XPOSITION of the primary window's display stream, this is a + read-only function) + + (LET [(WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM] + (IF WINDOW + THEN (DSPYPOSITION NIL WINDOW) + ELSE (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1) + (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE]) + +(\TEXTLEFTMARGIN + [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") + +(* ;;; "Returns the left margin of the textstream. This is a read-only function") + + (IF (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM))) + THEN [IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (fetch (TEXTOBJ FMTSPEC) of (TEXTOBJ STREAM] + ELSE 0]) + +(\TEXTRIGHTMARGIN + [LAMBDA (TSTREAM XPOSITION) (* ; "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. ") + + (CL:WHEN XPOSITION (* ; + "Error if not NIL or greater than 1, implicit NUMBERP test") + (IGEQ XPOSITION 1)) + + (* ;; "If RIGHTMAR is 0 and there is no window (WRIGHT), estimate from the stream's linelength.") + + (* ;; "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) + then (LET* ((FMTSPEC (FGETTOBJ TEXTOBJ FMTSPEC)) + (RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of FMTSPEC)) + LEFTMAR NEWPOS) + (CL:WHEN (ZEROP RIGHTMAR) + (SETQ RIGHTMAR (fetch (TEXTOBJ WRIGHT) of TEXTOBJ))) + (CL:WHEN (AND XPOSITION (NEQ XPOSITION RIGHTMAR)) + (* ; "Changing the default FMTSPEC") + (SETQ LEFTMAR (fetch (FMTSPEC LEFTMAR) of FMTSPEC)) + (CL:WHEN (ILEQ RIGHTMAR LEFTMAR) + (\ILLEGAL.ARG XPOSITION)) + (FSETTOBJ TEXTOBJ FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS (create FMTSPEC + using FMTSPEC + RIGHTMAR _ + XPOSITION) + TEXTOBJ)) + (LINELENGTH (IQUOTIENT (IDIFFERENCE RIGHTMAR XPOSITION) + (CHARWIDTH (CHARCODE A) + TSTREAM)) + TSTREAM)) + RIGHTMAR) + elseif XPOSITION + then + (* ;; "Even") + + (LINELENGTH (IQUOTIENT XPOSITION (CHARWIDTH (CHARCODE A) + TSTREAM)) + TSTREAM) + else (TIMES (CHARWIDTH (CHARCODE A) + TSTREAM) + (LINELENGTH NIL TSTREAM]) + +(\TEXTDSPCHARWIDTH + [LAMBDA (STREAM CHARCODE) (* ; "Edited 9-Feb-99 12:59 by kaplan") + (CHARWIDTH CHARCODE (DSPFONT NIL STREAM]) + +(\TEXTDSPSTRINGWIDTH + [LAMBDA (STREAM STRING) (* ; "Edited 9-Feb-99 13:00 by kaplan") + (STRINGWIDTH STRING (DSPFONT NIL STREAM]) + +(\TEXTDSPLINEFEED + [LAMBDA (STREAM VALUE) + (FONTPROP (DSPFONT NIL STREAM) + 'HEIGHT]) +) + + + +(* ;; "Editing support") + +(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE + +(RPAQQ INSERTSTRINGLENGTH 512) + + +(CONSTANTS (INSERTSTRINGLENGTH 512)) +) + +(DECLARE%: EVAL@COMPILE + +(PUTPROPS \INSERTCH.EXTENDABLE MACRO [(PREVPC INSERTION INSERTPTYPE) + + (* ;; + "Is INSERTION physcially adjacent to the PCONTENTS of PREVPC ? ") + + (AND (EQ INSERTPTYPE (PTYPE PREVPC)) + (EQ (ffetch (STRINGP BASE) of INSERTION) + (ffetch (STRINGP BASE) of (PCONTENTS PREVPC))) + (IEQP (IPLUS (PLEN PREVPC) + (ffetch (STRINGP OFFST) of (PCONTENTS PREVPC) + )) + (ffetch (STRINGP OFFST) of INSERTION]) +) +) +(DEFINEQ + +(\TEDIT.DELETE.SELPIECES + [LAMBDA (TEXTOBJ TARGETSEL) (* ; "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. ") + + (BTVALIDATE '\TEDIT.DELETE.SELPIECES 'START TEXTOBJ) + (LET (SELPIECES PREVPC) + (SETQ SELPIECES (\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))) + (\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) + do + (* ;; + "(NEXTPIECE PREVPC) is the first retained piece linked in after the deletion") + + (FSETPC PC PPARALOOKS PPLOOKS) repeatuntil (PPARALAST PC))) + (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") + + (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ :Delete + THCH# _ (FGETSEL TARGETSEL CH#) + THLEN _ (FGETSEL TARGETSEL DCH) + THDELETEDPIECES _ SELPIECES)) + T)))]) + +(\INSERTCH + [LAMBDA (CH CH# TEXTOBJ PARALAST) (* ; "Edited 21-Jan-2024 14:06 by rmk") + (* ; "Edited 9-Dec-2023 13:14 by rmk") + (* ; "Edited 18-Oct-2023 21:16 by rmk") + (* ; "Edited 15-Oct-2023 15:59 by rmk") + (* ; "Edited 18-Aug-2023 14:36 by rmk") + (* ; "Edited 2-Aug-2023 13:12 by rmk") + (* ; "Edited 25-May-2023 09:14 by rmk") + (* ; "Edited 23-May-2023 22:44 by rmk") + (* ; "Edited 25-Oct-2022 12:48 by rmk") + + (* ;; "This inserts CH (a character code or string) into the text just in front of character CH#. After execution the first character of CH will be CH# in the text, the previous CH# char is at CH#+ (NCHARS CH). If PARALAST, PARALAST will be set for the piece that ends in CH.") + + (* ;; "This is optimized for the common case that the next character to be inserted is at the position one beyond the position of the previously inserted character.") + + (* ;; " 1. \INSERTCH.INSERTION allocates a string to contain the new character, by chomping the next character from the TEXTOBJ's INSERTSTRING resource.") + + (* ;; " 2. The insertion will go into a piece at position CH#, and this stores that piece in the HINTPC field of the TEXTOBJ, together with its starting position. If the next insertion comes immediately have that piece, \CHTOPC can find that piece without searching the BTREE. ") + + (* ;; " 3. If the piece just before the target is a string piece whose string ends at the position in the same string just before the insertion, then the insertion can be accomplished by extending the string of the previous piece, by adjusting the string offset and length of that piece's string and compensating by shrinking the INSERTIONSTRING resource.") + + (* ;; "") + + (* ;; "The net effect is that typically the target piece is found quickly, and that a sequence of characters that are inserted individually end up in a single string in a single piece (until a paragraph break, or some jumping around that eliminates the string contiguity).") + + (* ;; "") + + (* ;; "In the nonoptimal, atypical case, the next insertion point is unrelated to the last one, a jump to a new place in the stream. In which case it might be between 2 existing pieces, or it might come in the middle of an existing piece that has to be split. At that point a new string piece can be introduced to hold the insertion, maybe still sucking from the existing insertion string.") + + (* ;; "") + + (BTVALIDATE '\INSERTCH 'BEGIN TEXTOBJ) + + (* ;; "") + + [SETQ CH# (MIN CH# (ADD1 (FGETTOBJ TEXTOBJ TEXTLEN] + (PROG (PREVPC INSERTPTYPE INSERTPC INSERTION (ILEN (CL:IF (type? STRINGP CH) + (NCHARS CH) + 1))) + (CL:WHEN (ZEROP ILEN) (* ; "Nothing to insert, really!") + (RETURN)) + + (* ;; "") + + (* ;; "Step 1: Construct the insertion string, presumably chomping the TEXTOBJ resource. May or may not be contiguous with last insertion.") + + (SETQ INSERTION (\INSERTCH.INSERTION CH TEXTOBJ)) + (SETQ INSERTPTYPE (CL:IF (fetch (STRINGP FATSTRINGP) of INSERTION) + FATSTRING.PTYPE + THINSTRING.PTYPE)) + + (* ;; "") + + (* ;; "Step 2: Find or create a piece with CH#at offset 0. This may involve splitting off an initial substring into a separate previous piece.") + + (SETQ INSERTPC (\ALIGNEDPIECE CH# TEXTOBJ)) + + (* ;; "") + + (* ;; "Step 3: Insert the insertion, with luck, just by extending the previous piece, otherwise the insertion goes into its own new previous piece.") + + (FSETTOBJ TEXTOBJ HINTPC NIL) (* ; + "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) + (FGETTOBJ TEXTOBJ CARETLOOKS)) + (NOT (PPARALAST PREVPC))) + then + (* ;; "Heuristic optimization: avoid a new piece if it is clear that won't get us into trouble. We can't append to a paralast candidate piece, because the new material would become part of a new paragraph that may or may not eventually end a different paragraph.") + + (\INSERTCH.EXTEND PREVPC ILEN TEXTOBJ) + else (SETQ PREVPC (create PIECE + PTYPE _ INSERTPTYPE + PCONTENTS _ INSERTION + PLEN _ ILEN + PLOOKS _ (FGETTOBJ TEXTOBJ CARETLOOKS) + PPARALOOKS _ (PPARALOOKS INSERTPC) + PNEW _ T)) + (SELECTC INSERTPTYPE + (THINSTRING.PTYPE + (FSETPC PREVPC PBYTESPERCHAR 1) + (FSETPC PREVPC PBYTELEN ILEN) + (FSETPC PREVPC PBINABLE T) + (FSETPC PREVPC PCHARSET 0)) + (FATSTRING.PTYPE + (FSETPC PREVPC PBYTESPERCHAR 2) + (FSETPC PREVPC PBYTELEN (UNFOLD ILEN 2)) + (FSETPC PREVPC PBINABLE NIL) + (FSETPC PREVPC PCHARSET \NORUNCODE)) + NIL) + (\INSERTPIECE PREVPC INSERTPC TEXTOBJ)) + + (* ;; "The insertion is done and the pieces are properly integrated into the stream. ") + + (* ;; "") + + (* ;; " Register this event in the TEDIT history.") + + (\INSERTCH.HISTORY TEXTOBJ PREVPC CH# ILEN) + + (* ;; "Finally, as a heuristic for continuous typing, set up the TEXTOBJ hint to speed up the \CHTOPC piece search if the next insertion comes just after this one (and this one is not PARALAST). This really doesn't matter for typing, but may make it noticeaby faster for programmatic insertions..") + + (if PARALAST + then (FSETPC PREVPC PPARALAST T) + else (FSETTOBJ TEXTOBJ HINTPCSTARTCH# (IPLUS ILEN CH#)) + (FSETTOBJ TEXTOBJ HINTPC INSERTPC)) + (BTVALIDATE '\INSERTCH 'END TEXTOBJ) + (RETURN INSERTPC]) + +(\INSERTCH.HISTORY + [LAMBDA (TEXTOBJ PREVPC CH# ILEN) (* ; "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) (* ; + "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") + + (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) (* ; + "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.") + + (* ;; "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?") + + (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT + THACTION _ :Insert + THLEN _ (PLEN PREVPC) + THCH# _ CH# + THFIRSTPIECE _ PREVPC + THPOINT _ 'RIGHT]) + +(\INSERTEOL + [LAMBDA (CH CH# TEXTOBJ) (* ; "Edited 11-Aug-2023 15:49 by rmk") + (* ; "Edited 5-May-2023 17:00 by rmk") + (* ; "Edited 31-May-91 14:00 by jds") + + (* ;; "Handle insertion of EOL and meta-EOL. The former causes a paragraph break, while the latter doesn't. Note that inserting a meta-EOL causes the document to become formatted. \INSERTEOL might add this on to an extendable insertion piece, but a subsequent extension is foreclosed by setting PPARALAST.") + + (* ;; "") + + (* ;; "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))) (* ; + "Inserting a meta-EOL into an unformatted document. Start by setting up para breaks.") + (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ)) + (SETQ INPC (\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))]) + +(\INSERTCH.INSERTION + [LAMBDA (CH TEXTOBJ) (* ; "Edited 20-Oct-2023 23:57 by rmk") + (* ; "Edited 15-Oct-2023 14:45 by rmk") + (* ; "Edited 12-Apr-2023 16:55 by rmk") + (* ; "Edited 13-Aug-2022 12:48 by rmk") + + (* ;; "Find string-storage that can hold the insertion, and stick it in. Try to chomp from the current INSERTSTRING resource held in the TEXTOBJ, if any.") + + (LET ((INSERTSTRING (FGETTOBJ TEXTOBJ INSERTSTRING)) + LEN FATP INSERTION) + (if (type? STRINGP CH) + then (SETQ LEN (ffetch (STRINGP LENGTH) of CH)) + [SETQ FATP (AND (ffetch (STRINGP FATSTRINGP) of CH) + (for C instring CH never (IGREATERP C \MAXTHINCHAR] + else (SETQ LEN 1) + (SETQ FATP (IGREATERP CH \MAXTHINCHAR))) + [if (AND INSERTSTRING (EQ FATP (fetch (STRINGP FATSTRINGP) of INSERTSTRING)) + (ILEQ LEN (ffetch (STRINGP LENGTH) of INSERTSTRING))) + then (SETQ INSERTION (SUBSTRING INSERTSTRING 1 LEN)) + (* ; + "Chunk it off, keep whatever might be left") + (FSETTOBJ TEXTOBJ INSERTSTRING (SUBSTRING INSERTSTRING (ADD1 LEN) + -1 INSERTSTRING)) + else + (* ;; "Allocate a string of the right type, to avoid an extra fattening pass") + + (if (IGREATERP LEN INSERTSTRINGLENGTH) + then + (* ;; + "Don't throw out the current cached resource if our new one is already full") + + (SETQ INSERTION (ALLOCSTRING LEN NIL NIL FATP)) + else (SETQ INSERTSTRING (ALLOCSTRING INSERTSTRINGLENGTH NIL NIL FATP)) + (SETQ INSERTION (SUBSTRING INSERTSTRING 1 LEN)) + (* ; + "Let the old one go--we may be starting a new sequential run") + (FSETTOBJ TEXTOBJ INSERTSTRING (SUBSTRING INSERTSTRING (ADD1 LEN) + -1 INSERTSTRING] + + (* ;; "INSERTION can now hold the insertion, smash it in") + + (CL:IF (type? STRINGP CH) + (RPLSTRING INSERTION 1 CH) + (RPLCHARCODE INSERTION 1 CH)) + INSERTION]) + +(\INSERTCH.EXTEND + [LAMBDA (PC ILEN TEXTOBJ) (* ; "Edited 21-Jan-2024 14:09 by rmk") + (* ; "Edited 12-Apr-2023 09:37 by rmk") + (* ; "Edited 1-Sep-2022 08:26 by rmk") + (* ; "Edited 30-Aug-2022 11:13 by rmk") + (* ; "Edited 21-Aug-2022 08:50 by rmk") + + (* ;; "Since INSERTION is physically adjacent to the PCONTENTS of PC, we can smash it on and adjust the lengths above. We also have to adjust the DLEN for PC in its node. ") + + (add (PLEN PC) + ILEN) + (FSETPC PC PBYTELEN (ITIMES (PLEN PC) + (PBYTESPERCHAR PC))) + (add (ffetch (STRINGP LENGTH) of (PCONTENTS PC)) + ILEN) + (add (ffetch (BTSLOT DLEN) of (\FINDSLOT (ffetch (PIECE PTREENODE) of PC) + PC)) + ILEN) + (\UPDATEPCNODES PC ILEN TEXTOBJ]) +) +(DEFINEQ + +(\SETUPGETCH + [LAMBDA (CH# TEXTOBJ) (* ; "Edited 23-Dec-2023 12:14 by rmk") + (* ; "Edited 22-Aug-2022 13:04 by rmk") + (* ; "Edited 10-Aug-2022 17:20 by rmk") + (* ; "Edited 8-Aug-2022 15:07 by rmk") + (* ; "Edited 31-Jul-2022 21:27 by rmk") + (* ; "Edited 14-Apr-93 17:14 by jds") + +(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#") + + (* ;; "NB that 1st char in the textobj is #1.") + + (* ;; "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 (\CHTOPC CH# TEXTOBJ T)) + (\TEDIT.INSTALL.PIECE (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ) + PC + (- CH# START-OF-PIECE]) +) + + + +(* ; "Deprecated, maybe still external callers") + +(DEFINEQ + +(\TEDIT.INSTALL.PIECE + [LAMBDA (TSTREAM PC CHOFFSET) (* ; "Edited 1-Feb-2024 00:23 by rmk") + (* ; "Edited 21-Jan-2024 13:00 by rmk") + (* ; "Edited 5-Jan-2024 10:30 by rmk") + (* ; "Edited 28-Dec-2023 10:59 by rmk") + (* ; "Edited 23-Dec-2023 12:16 by rmk") + (* ; "Edited 7-Dec-2023 15:46 by rmk") + (* ; "Edited 26-Nov-2023 20:47 by rmk") + (* ; "Edited 3-May-2023 15:10 by rmk") + (* ; "Edited 11-Oct-2022 18:14 by rmk") + (* ; "Edited 8-Sep-2022 20:46 by rmk") + + (* ;; "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))) + + (* ;; "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.") + + (freplace (TEXTSTREAM PIECE) of TSTREAM with PC) + + (* ;; "") + + (* ;; "Now set up for binning.") + + (SETQ PCCHARSLEFT (IDIFFERENCE PLEN CHOFFSET)) + (freplace (STREAM COFFSET) of TSTREAM with 0) + (SELECTC (PTYPE PC) + (THINFILE.PTYPE (* ; "Sets up the buffers") + (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)) + ((LIST FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE) + + (* ;; "These don't really need a file buffer, offsets, etc, but the underlying file has to be positioned according to ffset, and maybe reopened") + + (\TEDIT.INSTALL.FILEBUFFER TSTREAM PCCHARSLEFT)) + (STRING.PTYPES (freplace (STREAM CPPTR) of TSTREAM with (ffetch (STRINGP BASE) + of PCONTENTS)) + (freplace (STREAM COFFSET) of TSTREAM + with (IPLUS (ffetch (STRINGP OFFST) of PCONTENTS) + CHOFFSET)) + (freplace (STREAM CBUFSIZE) of TSTREAM + 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) + (RETURN PC)))]) +) + + + +(* ; "Support for TEXTPROP") + +(DEFINEQ + +(GETTEXTPROP + [LAMBDA (TEXTOBJ PROP) (* ; "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") + (* ; "Edited 9-Feb-89 11:20 by jds") + + (* ;; "Gets values for document properties. Used by TEXTPROP.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (SELECTQ PROP + ((READONLY READ-ONLY) + (FGETTOBJ TEXTOBJ TXTREADONLY)) + ((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 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.") + + (\DTEST TEXTOBJ 'TEXTOBJ) + (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)) + ((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 \WINDOW (MKLIST VALUE))) + (DIRTY (FSETTOBJ TEXTOBJ \DIRTY VALUE)) + (LENGTH (ERROR "TEXT property LENGTH is read-only")) + NIL) + (LISTPUT (FGETTOBJ TEXTOBJ EDITPROPS) + PROP VALUE))]) + +(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))))]) +) + + + +(* ;; +"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)" +) + + +(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)) +(DECLARE%: DONTEVAL@LOAD DOCOPY + +(\TEXTINIT) +) +(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS + +(ADDTOVAR NLAMA ) + +(ADDTOVAR NLAML ) + +(ADDTOVAR LAMA TEXTPROP) +) +(DECLARE%: DONTCOPY + (FILEMAP (NIL (33424 57078 (\TEXTBIN 33434 . 40939) (\TEXTPEEKBIN 40941 . 45164) (\TEXTBACKFILEPTR +45166 . 50720) (\TEDIT.INSTALL.FILEBUFFER 50722 . 54553) (\TEXTBOUT 54555 . 57076)) (57982 60902 ( +\TEXTSTREAM.OUTCHARFN 57992 . 59428) (\TEXTSTREAM.INCCCODEFN 59430 . 60171) (\TEXTSTREAM.BACKCCODEFN +60173 . 60651) (\TEXTSTREAM.FORMATBYTESTREAM 60653 . 60900)) (60949 71557 (OPENTEXTSTREAM 60959 . +66450) (COPYTEXTSTREAM 66452 . 69617) (TEDIT.STREAMCHANGEDP 69619 . 69921) (TEXTSTREAMP 69923 . 70337) + (TXTFILE 70339 . 70808) (REOPENTEXTSTREAM 70810 . 71555)) (71558 95310 (\TEDIT.OPENTEXTSTREAM.PIECES +71568 . 75877) (\TEDIT.OPENTEXTSTREAM.PROPS 75879 . 76935) (\TEDIT.OPENTEXTSTREAM.SETUP.SEL 76937 . +80304) (\TEDIT.OPENTEXTSTREAM.WINDOW 80306 . 81670) (\TEDIT.OPENTEXTSTREAM.DEFAULTLOOKS 81672 . 83519) + (\TEDIT.OPENTEXTFILE 83521 . 85120) (\TEDIT.CREATE.TEXTSTREAM 85122 . 85941) (\TEDIT.REOPEN.STREAM +85943 . 87941) (\TEXTINIT 87943 . 93991) (\TEXTTTYBOUT 93993 . 95308)) (95428 110166 (\TEXTCLOSEF +95438 . 96629) (\TEXTDSPFONT 96631 . 97632) (\TEXTEOFP 97634 . 99251) (\TEXTGETEOFPTR 99253 . 99467) ( +\TEXTGETFILEPTR 99469 . 101570) (\TEXTOPENF 101572 . 102544) (\TEXTSETEOF 102546 . 103061) ( +\TEXTSETFILEPTR 103063 . 104907) (\TEXTDSPXPOSITION 104909 . 105769) (\TEXTDSPYPOSITION 105771 . +106318) (\TEXTLEFTMARGIN 106320 . 106742) (\TEXTRIGHTMARGIN 106744 . 109700) (\TEXTDSPCHARWIDTH 109702 + . 109879) (\TEXTDSPSTRINGWIDTH 109881 . 110060) (\TEXTDSPLINEFEED 110062 . 110164)) (111213 130292 ( +\TEDIT.DELETE.SELPIECES 111223 . 114190) (\INSERTCH 114192 . 121250) (\INSERTCH.HISTORY 121252 . +124332) (\INSERTEOL 124334 . 126294) (\INSERTCH.INSERTION 126296 . 129127) (\INSERTCH.EXTEND 129129 . +130290)) (130293 131686 (\SETUPGETCH 130303 . 131684)) (131744 136844 (\TEDIT.INSTALL.PIECE 131754 . +136842)) (136882 140661 (GETTEXTPROP 136892 . 138137) (PUTTEXTPROP 138139 . 140159) (TEXTPROP 140161 + . 140659))))) +STOP diff --git a/library/tedit/TEDIT-STREAM.LCOM b/library/tedit/TEDIT-STREAM.LCOM new file mode 100644 index 0000000000000000000000000000000000000000..6fa7572e2ca5a228c74dc23fc8fe4e6d2f125a54 GIT binary patch literal 29769 zcmcJ2dvIIVc_#=`w1U_QNMRGNqQ=LvoluU5@Pgn&j2q*U1a&V60x$rIq@=`_1;%_p zkIHfqPqVX5($;A={liK8h?CS4H;+EzgrdYhBxj3B`bP!LsLIT`S*hEZO?I1^&dzj) z+WmJs+TZtm=iCPfO35~xiNSNv`|-WM?;Q0_W~bajwtvdaXZzj4R8f7PWKT@nhq7v) zTc~EsdACy9r#?{5+LKj#Jl~Q%ZdbC(8rUC;^-&KKs8-ERs(mWmKXd$Se`+9=R;kq3 z(7;&Q+Nb*Voj85+%yNCPrcR$irQe;K$xi083;*u1`ts9fkDq=1W9JrY%jZ6ZF5GH= zrHbBWk{=zm()(4cwM)wy8$y>)pI!9&T>Q+Lv(G*Na*E3FY=gPaO%@;FnjQ%#9 zFK1L-S9|nwW;M4fj%HUn{^iyW-IdL+`z_{QaNaWY-p;H}?~3c8)_=^iFmpJ0`<+C> zxfV}k>I`yco)V;ah zue-nh8JaauePajOg3H=;G@HM1g*m>}euDyWn-6h^O6v=|4&rol_qva&`-{VuGO<$sK(TBj74FtDKA zd;xl?kyHTTQr18SF|baJbf63d{q6$GsnN9B=YcSBWfg?u;A)sP~ zX#xzeT*+srs>mO}w{in;t~y@rYR6Z4qZwu^KL|6GO9mh4z(Fi?J@HPb_R0&>%~5Z$)Ykx!F&oIR( zvc4z4%5MDyQ0E5cuRR_n%;8oquYiu<{2cfZSdC2o>rx->6N$$1#Zwx~zUF~EI8x{4 zYX-;g)#YIvFiiN>`?td{6a&5Xw81XoR49G-W^km{%{N+5E4~%8gr_iO5kDCKRW?{K zcrX>lg253WkHLb$q4ZWP7z9-hGMT{v0DTZ{h`@VYq|!l@0G!TbXU3H^JlqQM0erC1 zDX9j0-3BoRfqDT>lsXthjKLJJMi^7dPgG8#UNJR4!M*C#tG5O0uou)ezYD5d@>7x%$;mQ%QOxG_a=xL8k_?T z(ti2a7e>kuHb(vw*yu5x9;*{@bSVtweQS)9lI#61mIVHsdyPS5fW z((+}B^g-noO0!iJI!F*n-e4^fO@WaYiUn5G1S%k!5Bg`QM%6*m#EigQM1LOnoO274 z#W|*+qUA6-wE$}m@d1*!26+cGl=AFyn3zVMq2se_J33x&tk}0+u^Ep&_M73))f+wg zI-RRyaZtZ8r`db-HOH+9^R!)u6Gzq`%;b#Z-k4tB?dXoYOgaKWT~Xi+FbWQgjw;EX zEsttSVD&GL`Mk;oTo`2`(p(+-#QV<-$qFAXHuLkR7-rA z8ak)IBp)R-o}i*^`O*CfT1W>b_LbEWU@s~jp}yPnPvrIgae(*m0AD?Mn?^7^z*~?n zytG{x;C{wtFZ0i4?( z3#-rez`%ed=UT95vZ~^ajXgSBAY|%?a)V8*J___1R5V9ME&)VqI_l7iLTST>VisrP7MjrwUR-N@MSo8s<)rH=?qIN&F>A%Pv=; zN58*oN2KF0Z*I?nQD@^=mDBUQ4bA&69o`t5-T3g~jek44aj&3V?tJ9uPE{~;?SDFR z@wr{q`=A^^nO^$`U2r1SSi4qb_&jlM!#$ih&{(_79bcM@zd5(-)wx|8N9W=jkGoQ- zAziQ6+|`q}rE8a~H{7cSpw7SLE^%iKcjfwlNMi~8pTGU=>aF!3ug=9+Z@Sz>YxHYx zft3Htt#u5udIQOD;g@E;DVjx`zrDZK(bLg6%_HuPc5eJHXN8Az2%AQjuD~4RBYJ8W z8+q8yv(~B!L>L5;dhb(dkNAs?YYxO0C@E$nCQua^xWwhSz_~ssy&I0RbqY{E!Y>Hh`HA z1QwlbmObL-wDu|XHR6Uc`Id6Mlj-y}uin4H8Glww^Q2Rj@UJ8>U zED;DFZpF)?7WT}!oE&1p{YnuKC3)cE5_Pke_^fVBsi@O<3KE%7EuwWXZUgqh~f zjbH4}L0SM!_}1zRD@U)7MH!XoIo;o4!3AI)8e-R&idlM~Ci`78TDYsmy%I6@Voe*hYa`*sL zYC!SM2mk_Qu=7I)b)J^f`7i|dWrraez)Cw=@`VFF@W*+7r3!Y}>hN}#spQh84M~Z2 zw5J1xIHsJArkoB_&fQocY(^T>Lev8~zgb0Ku9~C!P~y$WW1Zlf0MHH@_+qco|Nfew z_F`uSBN|@GhzBmFH_OvRWc~9jNSP&j)v(a_`27oCI>4Rke$X1$1^;7zOyq2T&VHZX z-u<@U<$5~fTQRkCx_UhZnS%%8vc$uouMg6y2=721>}p8K+J49rohz4Da<{&fd%@3#gt1d< zXkG3^ybXs65=P6pq12qA#NJA&04Us)oXiIo^2xmp8CpN9UO!nj?41pd~CE0NnZa5Np zK}jG-LLgwfpwJbTEsN!>d#Iqxphs!|(`BKS;4^{Jtvy2oKr;e)G1ngqTUM-5D_jnd zB~%}Va(ritQ*3;MQ6caJ90+`oW-V)&uqPaN9kDQ&P|9{;Qc$m?AZ-LY2VMm}fl6d_ zWs@Hne8vtfo`d#gsn2$Ga=&^*vxnjKBZJ~Yp9Rr|RU&VbBNKeuf-xts1CTRdVfFX= zaoB_g6-nY{468<9ilK=r2#LVF4^`Em4I#KI+W-F&O^ledt!(nZ z-DDFRP@wp(gYIBCV|Nrfz&{H=3$TWZyEB5K+?0Q?X4vBdI!kbG3H~Wq#RCASzzTw&+e)&q z)Z4T9su=O0CBU@fBN$Qg!`U*s&DAlx1Vhqf3fnadnbRK`j3)S{r=~lGgb&s54lw46 z(t1lFy+W>L(HCw!a@@6Y4h=Zi+p7V~`Tb<8^NIa}2zP&6>p1HC?Rz1xT~9$@cV}+{*R6kw#9efjMID2Z_Hs z#W_(eJoRM4E@$P8k~j}{Y60l)ktm!q*+LNykPO&keI3i#ps=f?Igw;Y-IGFRhVqrK zi6V?i6Hq+!&=EuQ6lX|EpdlY*b!PLM1*;SjI`S(bQemR%7Gdg2YeHm!&R{enY}^47 zw49*90Mv~Z&46HxU12}~urex=HV~vG(hs2HKL9#9Z7mpxA+QHtm5oONU~=(&A}Iv2 zjwJHAxINBjDL~X#td%pouvbeOsV}uE^nW0Y8@3n;=y<^;KvY6{Jt@9|%mrekdG|zPakn9aeKwbzH{R(FuB0nAhDA{FOC=!tYAE@d4r;6}K1}H3Rw7MHA!@0i< zzR}S$5Dn1L`9ON1_O;qlhL3mSL5I=(%g)C8oNvf^F@4_HS>eA6HNn}1K>LjzCgv>^ zUFsbX`Q1%qOd>6b98^St0N-9PTX3J41u7@~)mkw1=>tY)CF>W#3{0vvB%p%W8Bz)Y zLh#_=pEb~8I`%gX%)$FePT}~Hyp4d6cG<8%Q?U$$UPA==8zhv*{^Y`DhMOtn(VPAGW5ATsGMEhxby>u(vr(VGzIy#h9)ynuGJ zhDA9BG$I>@fQTvwP=dvoC(;ij%@!)4WECle9*d6qOnxl zqdSc^di{@GG(sZU&}I7?z22Out5xdtU(uiP`uk1I@B?0ttGw8M?F{$+hWp!t4P}f$ zBmqus7abF}*V<8k_X9W*SWoCTj;+1EbAW#DMUH?*j2fWTO5(kgx}SbtlLX*O{JxE^bM%O#9ciltXM3Hel z+S~Yetr-)6WNG6b?ncDS8R=6#L|V*YmPd13dHQdYIpHrk=1S8!#BnfTnI>(3Vi1IU zhP{v@F%{C%m4EbMnOsf(3QoRlnK$$^0XeX`TD`u6m6*cz%1%V4RM zoiPjtSlU8QJSvja+P`6FKGKZXn_tbjAfa%kZ~XIabY^dU#c>k{$QX|O4H~);Qxo8K zaBaz?h!<%4r`Wf_p0s5g<`x6D?4z_{4FTk_nTm88W?#gaQV1();Y{;Y_(H2Nbb{&9 z#=#V=B3OJRvbxpVtgE7PEl{M?q&p*G1DgZJ-Rg`T^l4)&7tmMdxS%_tk(LCnMLYRf ze7pP$DqJ!AwI@E#bOF0J3VaB}11NyC%))^g&Vi-KQj?WZWx|F<3*KvyDY`DKJm9O5m|jsn7FqPW=UUD)aFtj~I~7#!AgpYr3thC==Tvk(f8_I7=K zBF`Q{*p7Jb^@h+u6U71qJTd}IVJ=LkOGSzf7&O8)uLFmBXTbel)21xJ7zd;tvsucw`MWqx@0p7O7!NZEXab!YP9l);57A9Ge z9`e_14osFBMhD(cqA{IEaV(Li=;r|~UU&j#mk~I+O#;%4h#>cx#7>idpdm$&X(a)P zL=q5kB;m<4`%KO!OyZbH95IP`lQ?V=Rg);2M9CxyCXqLZoJlw)F=Y~yCNXXj8I$;! zNjzo}knLsiqb4zI5)jv<2*R5rJXsCmyySe)Bpx;iWfC7S35bGH8G@lCASOxzLZc)g zLQ107B;t+t(W!Cnoqz7ThblfrKM&|$a9XR^5yV2jBtBk`c#H8y@($8l9%{-YyrcEz z=K+KVBHkLj?e<{BJ9Td{-q~zDV{c+5GrD)!I3&y;hlly26u(cII!~K~m$PJYJb<{v z@q4H4ov1R++Z|iGlVFMfv>ydx!??|ILmH+^l8aee_T^jP=I9VxV1guX6uj_}M?9it zXq6fTBO@v(l&>FBYd;ApYE%p+S^ym-)9RsY0n~XSS=I_Td6RHA1BjnTVn8Qg1mTsN1H%79fCfOwS zOKngvP7G5pDb*lX8SKOy1rv%o9EQV*Yrrm{{b|DzqYU4izS}V@`bNmuNs>Re3kEXibz= znnF4J&4rn*B_c45=>#iiDF-o`>EUqGU=Sl|FWky(ZW>pYg53lnD$_Xh;Q6Lufa9v3 zq>@HRx~vDrJ4rx@lLUA?CkEk(kOb_EI-$XXE;31na!j~6G-&4T%V&cK3=7q=)F6y? z(iM~;NkAEs1XLYKz+1`*3X9hXJ#I?O-v&1aAa~P+52*xMRua$`j!l;Bxl%E|aHv>F zYSh5JC_N_KRgtQY|0RK_3P}u@G2sB_9EwDj1g@k=0wSg)pr}X!zBWmaek^0di|dU{ z;p@k6d2}v0p638u33lV0`Qp?RAtkO&>N*QvP8b;g{}w0&Zz;*!Y_$`?9rVIv6Ov0N z(GCJc)Fq8_DvPVGJ;mCZMd&utG&*lW*eH_c-ko#jh*{r0W(-*TnF3vbva z#Z@=%S^2zc|D=BZFY7xuFZ?z|LH`B)e8;ZGa5YPZKWiV8{CR>s$KeGJ0BIQv8=Zp+rGu^@n)k#zv||53-pYm04We(j&B$x` zkLB}*3r+tYcI!hpV6;{2fQDFz?)oq0W1bW-U1O~WF#<4f~|=ae=JF1kMzBf z@C^e4-FlVq9NGoB4q|#CeG$Qii~~NbVabJn=>q|7&9p#G#9n_WBldfS8vbeM_4W4j zMBR<9-SJxIo0pfq&~e#~Ub3}AdF`K|f((+%%ww_pjP2o`i&W_HDJLQCX zHy-!yRt{@SOOTFym2N)&FnmRA;RW2jytqqO+uPi^v>7K{AXJz-l5MrzK)x{0?Au%n>eDb#IFaRNTyc-vRNJ|9_ zz-(KbAOi|wH}wudRMIJ*25eoHNH}^$@SD(uLl{aVXfS;6S&B~SiAThz#dx`vVi2DX zVKZOK=KQPC-j&U-WpFJ@!#ptiryOy~w2fdnY=DHcA?S=H1<={^8)JbG4D_ewV-T^FmOw)gp#aeOH0=NW-xB%+>{A`Le@Xrr_gb%ay}~1=TQ?FTwZI3$ z68IhxT`^;GDn}{y7pMBg`WOZk@w$=qBfRVRz{O@SWYGqsco&wCK8CBBAI$IQd^OL< za$%3XdgEx#5#QjEOm5o!J5g>3w?rnR%@6wkC`@F+sTMI?l1?=GLGlS&32_28Wq|kml}TCqDF*Csg(YlXg?~OZ_RsMgG<`vtpj!n##p}SQB1>g)H?uY`! z_-xv)?um={l~3MAc;{!Z3^8oq6GA1(r6{_LMydU4$Nr*c6Bm@WB!CZ2&F9VN}*77APa@lM{T`l z%s6PDB!o;boV^bu@PsY?KxA}+2nDI-4I`OMSMNGVu!HS~p}l4`$r}ULt!A^~A>y|(-#96;Pd%AV!HRhuorsGQ zsP_}6=fUp0(2B@L*V@N8`5$#o^sgk*m_gA)kPztlePTwx$&y*(AeL_}y*N`VY_5O0 zvD|y{cOWP${qu4sZ%v0EF&r}*|*v;0Q ztq1nj9P+n|EmViFFUOlZKYspp?dmSbrRzU%oAI8Wo$i`2*(c-0U2xME<6Qc35p_5I zY4_R}K@N#Iimx>g>uv$d#;bq=m){q%#CAjH7>d8M$dnYmJV$6O-Laz~2`Wk^9&i`` z2w}hQI|q=YU{n(!A_c90oy93cs$&Vfk-oYymd9 zvM-qmEAwYU61WFhFl5OrV9@h($rs{PfgmrJGoV@OWo{WONN2#4B|vq;F>*FV5mCr0 zxrxY;D_;!eY4gFpS$5t#SJ09cBG!Sr_0s8gnoGkEs@~juwJskndhLH^FcM9CF>k! zXqGRW#(a5urg_W&?hiwVW$e*tMEsYq#bYudMiTiYwA(JN(mEY8=Vb&fiFP^C%KLH{SF|17$Shw5cLXh;B z1Nc{)8elOjd&6{`R%7m|XBW?&Q;1}`10R8Vd}~LrMr_T5KgF9j?tqx?Io`K*L*P!? z+JOmg3T;wbzL72F4dWP~_#HB6Y)|zg8R(sz;|wYy01d*zVZI?3ydvQ;jrx5$%zqxC zC!4P$Ht!YuN5qP5;nOvGgG+3a;}s;~3B(|^E z0bj(gSlIhqrss)wCXl9FIXZ!-bXm*=# zfH&*GZhgDqtSR?YG;-_f?ov&d%F(q)kYT>&SLMZpw`~UxO`W{$FyjG(k~P0Jy(%*A zizY#FljLD4m-3#zk^+aox87&+HU-GE|Fjr|O{W0+@}81>A@+#EB281+-b3H?NDEAj z#ABx1dC+|L5!4qFc*tuD`dj)LUyt zF-)|P(U=^scm4Fz+J7e95}aBt#FQoqc#*CGXEJQ6v;HxV4>kBrey+gg0DGa!3ES6_ zxga#Gg0m%5^rczPO59=%WGzj5VFXzp!d8v2ZIW5(`ujM1lI1_UnaoI3Z@fo!WNb0? zEg;*?INH>Qd+nIC5F#8>;EhUHhK-?*tb6UMfZoz`PgsP%913CEN5NlaMTiW{!&OL^ z31sd2*rG;^F+8BAVUWZ_2J@6$!H}JY&O;%mB}2(dAf6D=s-(Y??4f~`1rVa?Fh>A~ z@RBY>_XDu|blSBy&v$$X0i%E-Vf}l09_q?{gM#*Q@7eWq^uk{Aj3czd#6Inovzu{5 zaZ3w3vDY2Hc{HxUYd z5RLjgG+KhVmdq=i<2UHlyDi!7jcXliBlJ++D^PZk{xII0TmMk*!oxB_kwcmT-i&p| zK3a}_HLm2{iDMMt&X>8R8C(bn{UF%1eh>`KYJ>Df>fK5itgS*W2Sx->n2g@~Eid2D zWRBl21SF+Mk<^dJL0~sY|M7uTz_#zZFjIh0U6<5M=>Yyqoq`OZQ=XfHQ4dH*td)a! zG)*GW6`{ak!S#EPQjPUrM8!Y1wMhCkyh})zFX5AFSAxyk>Aui}NmN!{eN z%+-16!jy8a1L3y4URx@qhcSXZ!zt99vOi?JRAdyCPj+k5EQ=ZEtp2vY~W%p=!dT%Fw!FoQWLVFja!+A5ypsU;4D~HKS`{>a(G*)T0cM5 z0AlAo+z^(+f|r6lR$z={?GB(L2@+?xL366}&oVad#q3E;0iYT4#B&PAx;_=CnwfEW zvVfg4^lX9Kdp`0DIiYQ9DX#Ul)Osa@2UyNW-ZEYO33}ApLgKOWk(d2iljkEZnp$8Y z!GZDof!n*bWa_S79~)RZV(NYqRcoDpT6+l$s&{QdDy{DyH;21ChzEc*hi^EfBu;bewPO=}%}BqX7_u)}TQQrtc7l!RF{VZC5Ogxc!N+0$pBr95xeviz(%yLi0TfBIDYd9b1|`V(`}vNlV~^TJ)D zkwv%)5Y~O`6%i{NtH+teQpj*UdYnPf0oDILebqaUvmcGl08t1*V8;doHW`m*d83hG zAYfMaM5jJjYZ1*dfg7?gT31Eu(ZSBhq?_>NlKsRJTMATP-(+?ok0=1V3QrGxWvCC( zVLG8IKj+hzg^#3MRecoSU7m!WMINNp0tRh_P|f|SFE(RO;Dsc3WI!&t8k>fKg_YOtmP#>`p96qXq7&(4zzr>H+l@Pc9I|t^VrvTvs z3L6<=@CVyTANQ!*)QZA_1k3=0vP6$uC!{0hB^BqZ~_T;b~HnmC{)$WKlz$ z1IVmo#?+ux3}!0)I{|&(ldQV+5b`i(T%p$)!^mKNfc_rAH$P!6bE3yl`(pkiF>Ah) z+cNc*Y3oljWxqc>NZ1#gqv>=N8YNI*wJHK6~=`Ie&3uN-h4*bIYGPUSB+QPMtd)*nq{) zoLD@As;AH5W(U2|8QKVd0sX@lei*Clip~y%rSksh>|khXFuyfg7W<*8%Q-OlTvpnuOln9vjpE`Z6AC&8q)Jjq-2)OwF(&E|01L|q4{<&ut)$^yH!@oLI ze_nn1xRB%8X?2cj77G*E0}71klv@5ISF4{sUSo{YLZ&+TT>aegnfjtSw|sK(S=D#^ zSu{vKlRQBGMo^7-+UYYVLFM=Fi(!2}erxpJ_HG^vN7!y0s&@xQ-&fv4Bma4#bLc314x>>m5ThYOOcEN!4QI*$=L2M{X) zf7vx+Mp9qFQngiPDmT z@VZ!VMP7F>9d4<+bqHumeY8M5LA?5IrVZPU-##WwLEiSYgC*8*sH0%fAQL>@->5Qs zigEQIFnh>ZCe?`FOCT4w^#y)q=Tqo#duSnY0jV9`x4?^DoLS^u|K1r=e%;=-tG{KG z)`|j+K@e`OvE4Vf)P*tSL$#mUuH|<5!5&o*2+d~3OyXDmd)LVjL>P?IXRBgCq%)a8 z@Hcru_&0e$FgJNYG&6bDfVUbHkpMFb zm_FKMwwnbEQ@SSc7q5N0kq~~kwNu!L+GMsH35HSw%z=^M#o5}Pvc56+TJN-;=DTu@KbInM2(W6af+mY^Yr0^Et z-+J^9CVZx_3~wC+*9zNY`cw4jkVo_JtkU*1pisOep_#Fid@bAo6rAY$@A H7xI4r)8qQ( literal 0 HcmV?d00001 diff --git a/library/tedit/TEDIT-TEXTOFD b/library/tedit/TEDIT-TEXTOFD deleted file mode 100644 index f7704f06..00000000 --- a/library/tedit/TEDIT-TEXTOFD +++ /dev/null @@ -1,2624 +0,0 @@ -(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - -(FILECREATED "20-Jul-2022 08:09:55"  -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-TEXTOFD.;2 174869 - - :CHANGES-TO (FNS \CREATEPIECEORSTREAM) - - :PREVIOUS-DATE "14-Jul-2022 17:00:29" -{DSK}kaplan>Local>medley3.5>working-medley>library>TEDIT>TEDIT-TEXTOFD.;1) - - -(PRETTYCOMPRINT TEDIT-TEXTOFDCOMS) - -(RPAQQ TEDIT-TEXTOFDCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - (FNS COPYTEXTSTREAM OPENTEXTSTREAM REOPENTEXTSTREAM TEDIT.STREAMCHANGEDP TEXTSTREAMP TXTFILE - \DELETECH \SETUPGETCH \TEDIT.REOPEN.STREAM \TEDIT.COPYTEXTSTREAM.PIECEMAPFN \TEXTINIT - \TEXTMARK \TEXTTTYBOUT) - (FNS \INSERTCH \INSERTCR) - (COMS - -(* ;;; "Functions to manipulate the Piece Table (PCTB)") - - (FNS \CHTOPC \CHTOPCNO \CLEARPCTB \CREATEPIECEORSTREAM \DELETEPIECE \FINDPIECE - \INSERTPIECE \MAKEPCTB \SPLITPIECE \INSERT.FIRST.PIECE)) - (COMS (* ; - "Generic-IO type operations support") - (FNS \TEXTCLOSEF \TEXTCLOSEF-SUBTREE \TEXTDSPFONT \TEXTEOFP \TEXTGETEOFPTR - \TEXTGETFILEPTR \TEXTOPENF \TEXTOPENF-SUBTREE \TEXTOUTCHARFN \TEXTBACKFILEPTR - \TEXTBOUT \TEDITOUTCCODEFN \TEXTSETEOF \TEXTSETFILEPTR \TEXTDSPXPOSITION - \TEXTDSPYPOSITION \TEXTLEFTMARGIN \TEXTRIGHTMARGIN \TEXTDSPCHARWIDTH - \TEXTDSPSTRINGWIDTH \TEXTDSPLINEFEED) - (FNS \TEXTBIN \TEDIT.TEXTBIN.STRINGSETUP \TEDIT.TEXTBIN.FILESETUP - \TEDIT.TEXTBIN.NEW.PAGE) - (FNS \TEXTPEEKBIN \TEDIT.PEEKBIN.NEW.PAGE)) - (COMS (* ; "Support for TEXTPROP") - (FNS CGETTEXTPROP CTEXTPROP GETTEXTPROP PUTTEXTPROP TEXTPROP)) - [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 TEXTOFD multiple times (as, e.g., in development)") - - (INITVARS (*TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN] - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\TEXTINIT))) - (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) - (NLAML) - (LAMA TEXTPROP]) - -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) -(DEFINEQ - -(COPYTEXTSTREAM - [LAMBDA (ORIGINAL CROSSCOPY) (* ; - "Edited 24-Apr-95 12:02 by sybalsky:mv:envos") - - (* ;; "Given a stream, textobj or window, returns a new textstream with the same contents. If CROSSCOPY then strings will really be allocated providing copies of the text else the fileptrs still will be aliases as in the rest of TEDIT.") - - (PROG ((TEXTOBJ (TEXTOBJ ORIGINAL)) - TSEL PCTB PCLST NEWSTREAM NEWTEXTOBJ) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (SETQ TSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (SETQ NEWSTREAM (OPENTEXTSTREAM NIL NIL NIL NIL (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ))) - (* ; - "First create an empty textstream into which the pieces can be hammered") - (SETQ NEWTEXTOBJ (TEXTOBJ NEWSTREAM)) - (replace (SELECTION CH#) of TSEL with 1) (* ; - "Set up to select the whole source text") - (replace (SELECTION CHLIM) of TSEL with (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (replace (SELECTION DCH) of TSEL with (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ PCLST (TEDIT.SELECTED.PIECES TEXTOBJ TSEL CROSSCOPY (FUNCTION - \TEDIT.COPYTEXTSTREAM.PIECEMAPFN - ) - TEXTOBJ NEWTEXTOBJ)) (* ; - "now get a list of copies of the pieces to be inserted into the empty textstream") - (\TEDIT.INSERT.PIECES NEWTEXTOBJ 1 PCLST (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - NIL NIL CROSSCOPY) (* ; - "Put the pieces into the copy textstream") - (replace (TEXTOBJ TEXTLEN) of NEWTEXTOBJ with (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (* ; - "The copy is the same length as the original") - (replace (TEXTOBJ MENUFLG) of NEWTEXTOBJ with (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) - (* ; - "And if the original is a menu, so's the copy") - (RETURN NEWSTREAM]) - -(OPENTEXTSTREAM - [LAMBDA (TEXT WINDOW START END PROPS) - - (* ;; "Edited 22-Jun-2022 21:09 by rmk: Pass FORMAT prop to OPENSTREAM FWIW") - - (* ;; "Edited 4-Jun-2022 15:42 by rmk") - - (* ;; "Edited 31-Jan-2022 17:25 by rmk: A string TEXT is converted here to a stream") - - (* ;; "Edited 4-May-93 14:38 by jds") - (* ; - "Create a text-type STREAM to describe TEXT. Optionally, connect that to WINDOW for display.") - (PROG* ([WAS-TEXTSTREAM (AND (type? STREAM TEXT) - (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT] - [TEXTOBJ (COND - (WAS-TEXTSTREAM (* ; - "If the guy gave us a text stream to edit, use its TEXTOBJ as ours.") - (create TEXTOBJ reusing (fetch (TEXTSTREAM TEXTOBJ) of TEXT) - \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 - \INSERTPCVALID _ NIL)) - ((type? TEXTOBJ TEXT) - (create TEXTOBJ using TEXT \INSERTFIRSTCH _ -1 \INSERTNEXTCH _ -1 - \INSERTPCVALID _ NIL)) - (T (create TEXTOBJ] - (TEDIT.GET.FINISHEDFORMS NIL) - [PROPS (APPEND PROPS (COPY TEDIT.DEFAULT.PROPS) - (COPY (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ] - [TEXTOBJ.WINDOW.VALID (AND WINDOW (EQ WINDOW (\TEDIT.PRIMARYW TEXTOBJ)) - (EQ TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ] - FONT SEL PCTB PC TEXTSTREAM OTEXTOBJ PROP CLEARGET? PARALOOKS PWINDOW) - (* ; - "Remember if the textobj had a window already.") - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with (AND WINDOW (LIST WINDOW))) - (* ; - "Necessary because some incoming object types depend on knowing where the window is.") - (replace (TEXTOBJ LINES) of TEXTOBJ with NIL) - - (* ;; "This is here so if we re-OPENTEXTSTREAM an existing stream/window pair we don't get two sets of line descriptors") - - (for PROPNAME in PROPS by (CDDR PROPNAME) as PROPVAL in (CDR PROPS) - by (CDDR PROPVAL) do (TEXTPROP TEXTOBJ PROPNAME PROPVAL)) - (* ; - "Save the PROPS for later people who'd like to know them") - [SETQ FONT (COND - ((type? CHARLOOKS (LISTGET PROPS 'FONT)) - (LISTGET PROPS 'FONT)) - (T (\TEDIT.PARSE.CHARLOOKS.LIST [OR (LISTGET PROPS 'LOOKS) - (COND - [(LISTP (LISTGET PROPS 'FONT)) - (FONTCREATE (LISTGET PROPS - 'FONT] - (T (OR (LISTGET PROPS 'FONT) - DEFAULTFONT] - NIL TEXTOBJ] (* ; - "Find the default font for this session -- either what the guy tells us, or the global default font") - (SETQ PARALOOKS (LISTGET PROPS 'PARALOOKS)) - - (* ;; "Get the default paragraph looks. This must come before the first piece is created, so its fields can be filled in right.") - - (replace (TEXTOBJ FMTSPEC) of TEXTOBJ with (\TEDIT.UNIQUIFY.PARALOOKS - [SETQ PARALOOKS - (\TEDIT.PARSE.PARALOOKS.LIST - (OR PARALOOKS (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ] - TEXTOBJ)) - [COND - [WAS-TEXTSTREAM (* ; - "We got a TEXTOFD stream to edit; just use it") - (SETQ OTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TEXT)) - (SETQ TEXTSTREAM TEXT) - (for SELN in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - do - (* ;; "Make all the selections point to the CURRENT textobj!") - - (COND - ((EQ OTEXTOBJ (fetch (SELECTION \TEXTOBJ) of SELN)) - (replace (SELECTION \TEXTOBJ) of SELN with TEXTOBJ)) - (T (replace (SELECTION SET) of SELN with NIL))) - (replace (SELECTION ONFLG) of SELN with NIL)) - (replace (TEXTSTREAM TEXTOBJ) of TEXTSTREAM with TEXTOBJ) - (replace (TEXTOBJ STREAMHINT) of TEXTOBJ with TEXTSTREAM) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with NIL) - (* ; "Mark the edit incomplete.") - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with NIL) - (* ; "And mark it not changed.") - (COND - (FONT (* ; - "If a new default font was specified, set it up.") - (replace (TEXTOBJ DEFAULTCHARLOOKS) of TEXTOBJ with ( - \TEDIT.UNIQUIFY.CHARLOOKS - FONT TEXTOBJ] - ((type? TEXTOBJ TEXT) (* ; - "We got a TEXTOBJ to edit; fill in the stream, since it might have been GC'd.") - (SETQ TEXTSTREAM (replace (TEXTOBJ STREAMHINT) of TEXTOBJ - with (create TEXTSTREAM - TEXTOBJ _ TEXTOBJ))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM))) - (T (* ; - "Otherwise, create a TEXTOFD to describe the text we're editing.-") - (CL:WHEN (AND TEXT (OR (LITATOM TEXT) - (STRINGP TEXT) - (CL:PATHNAMEP TEXT)))(* ; "rmk: Strings are now file names") - [SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD - `((TYPE TEXT) - (FORMAT ,(LISTGET PROPS 'FORMAT]) - (SETQ TEXTSTREAM (replace (TEXTOBJ STREAMHINT) of TEXTOBJ - with (create TEXTSTREAM - TEXTOBJ _ TEXTOBJ))) - [replace (TEXTOBJ PCTB) of TEXTOBJ with (SETQ PCTB - (TEDIT.BUILD.PCTB TEXT TEXTOBJ START END - FONT PARALOOKS (LISTGET PROPS - 'CLEARGET] - - (* ;; "(setq pc (\\editelt pctb (add1 |\\FirstPieceOffset|)))") - - (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) - (for FORM in TEDIT.GET.FINISHEDFORMS do (EVAL FORM)) - (replace (TEXTOBJ TEXTLEN) of TEXTOBJ with (fetch (BTREENODE TOTLEN) of PCTB] - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.UNIQUIFY.CHARLOOKS - (\TEDIT.CARETLOOKS.VERIFY - TEXTOBJ - (replace (TEXTOBJ DEFAULTCHARLOOKS) - of TEXTOBJ with ( - \TEDIT.UNIQUIFY.CHARLOOKS - FONT TEXTOBJ))) - TEXTOBJ)) - (replace (TEXTOBJ CARET) of TEXTOBJ with (create TEDITCARET - TCCARETDS _ (AND WINDOW - (WINDOWPROP WINDOW - 'DSP)) - TCFORCEUP _ T)) - (replace (TEXTOBJ TXTREADONLY) of TEXTOBJ with (LISTGET PROPS 'READONLY)) - (replace (TEXTOBJ TXTTERMSA) of TEXTOBJ with (AND (SETQ PROP (LISTGET PROPS 'TERMTABLE)) - (fetch TERMSA of PROP))) - (replace (TEXTOBJ TXTRTBL) of TEXTOBJ with (LISTGET PROPS 'READTABLE)) - (replace (TEXTOBJ TXTWTBL) of TEXTOBJ with (LISTGET PROPS 'BOUNDTABLE)) - [COND - ((LISTGET PROPS 'PAGEFORMAT) (* ; - "A default page formatting was supplied. Impose it on the document.") - (TEDIT.PAGEFORMAT TEXTOBJ (LISTGET PROPS 'PAGEFORMAT] - (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SETQ PROP (LISTGET PROPS 'SEL)) (* ; "Initial Selection, if any.") - (COND - ((EQ PROP 'DON'T) (* ; - "A SEL prop of DON'T means don't make an initial selection") - (replace (SELECTION SET) of SEL with NIL)) - ((type? SELECTION PROP) (* ; - "We came in with an explicit initial sel. Set it up.") - (\COPYSEL PROP SEL) - (replace (SELECTION SET) of SEL with T) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ)) - ((AND (fetch (SELECTION SET) of SEL) - (NOT PROP)) (* ; - "If we came into this with a valid selection, highlight it.") - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ)) - (T (* ; - "Starting without a selection; let's start with a point selection before the first character.") - (replace (SELECTION CH#) of SEL with (COND - ((FIXP PROP)) - (PROP (CAR PROP)) - (1))) - (replace (SELECTION CHLIM) of SEL with (COND - ((FIXP PROP)) - (PROP (IPLUS (CAR PROP) - (CADR PROP))) - (1))) - (replace (SELECTION DCH) of SEL with (COND - ((FIXP PROP) - 0) - (PROP (CADR PROP)) - (0))) - (replace (SELECTION DX) of SEL with 0) - (replace (SELECTION POINT) of SEL with 'LEFT) - (replace (SELECTION SELKIND) of SEL with 'CHAR) - (replace (SELECTION SET) of SEL with (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) - (replace (SELECTION \TEXTOBJ) of SEL with TEXTOBJ))) - [COND - ((fetch (SELECTION SET) of SEL) (* ; - "If there's an initial selection, it implies initial caret looks, too.") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL - ] - (COND - ((AND WINDOW (NOT TEXTOBJ.WINDOW.VALID)) (* ; - "Only if there's a window to display it in:") - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL) - (\TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS) - (* ; - "Set up the window, and display the initial text.") - ) - ((SETQ PWINDOW (LISTGET PROPS 'PROMPTWINDOW)) - - (* ;; "There is no window for the session, but he has passed in a promptwindow to use, install it in the textobj") - - (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with PWINDOW))) - (\SETUPGETCH (create EDITMARK - PC _ (\GETBASEPTR (\FIRSTNODE PCTB) - 0) - PCOFF _ 0 - PCNO _ 1) - TEXTOBJ) (* ; "Set the file ptr to 0") - (RETURN TEXTSTREAM]) - -(REOPENTEXTSTREAM - [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") - (replace (STREAM ACCESS) of STREAM with 'BOTH) - (replace (STREAM BINABLE) of STREAM with T) - (replace (STREAM STRMBINFN) of STREAM with (FUNCTION \TEXTBIN)) - (replace (STREAM STRMBOUTFN) of STREAM with (FUNCTION \TEXTBOUT)) - STREAM]) - -(TEDIT.STREAMCHANGEDP - [LAMBDA (STREAM RESET?) (* ; "Edited 31-May-91 13:57 by jds") - (PROG1 (fetch (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM)) - (COND - (RESET? (replace (TEXTOBJ \DIRTY) of (TEXTOBJ STREAM) with NIL))))]) - -(TEXTSTREAMP - [LAMBDA (STREAM) (* jds " 3-Apr-84 14:34") - (* Returns the stream if it is a text - stream, else NIL) - (AND (STREAMP STREAM) - (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - STREAM]) - -(TXTFILE - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 13:58 by jds") - (* This function is for compiled - access to the TXTFILE field in - RESETSAVE expressions) - (fetch (TEXTOBJ TXTFILE) of TEXTOBJ]) - -(\DELETECH - [LAMBDA (CH# CHLIM LEN TEXTOBJ DONTDIRTY) (* ; "Edited 29-Jan-99 17:28 by kaplan") - - (* ;; "Delete the indicated characters from the text object represented by TEXTOBJ") - - (* ;; "If DONTDIRTY is non-NIL, then don't notice this change for purposes of UNDO or dirtiness.") - - (COND - ((OR DONTDIRTY (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) - - (* ;; "Only delete characters if changes are permitted, or if it's a TEdit-internal fixup change, e.g., when an NS character 255-x sequence is seen.") - - (LET ((\INFIRSTCH (fetch (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - START-OF-PIECE PCLST) - (\TEDIT.CHECK (IGEQ LEN 0) - "LEN of delete must be >0.") - (\TEDIT.CHECK (IEQP LEN (IDIFFERENCE CHLIM CH#))) - [COND - ((AND (fetch (TEXTOBJ \INSERTPCVALID) of TEXTOBJ) - (IEQP CHLIM (fetch (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ)) - (IGEQ CH# \INFIRSTCH)) (* ; - "The deletion is from the end of the most recent type-in. Just adjust the buffer string.") - (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with (replace (PIECE PLEN) - of (fetch (TEXTOBJ \INSERTPC) - of TEXTOBJ) - with (IDIFFERENCE CH# \INFIRSTCH)) - ) (* ; "Cut back the length") - (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS (fetch (TEXTOBJ \INSERTLEN) - of TEXTOBJ) - \INFIRSTCH)) - (* ; - "and ch# of next insertion (i.e., 1 past the top CH# in the insert piece.)") - (replace THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with (IDIFFERENCE (fetch THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - LEN)) (* ; - "Reduce the length of the insertion in the history list, too.") - (COND - ((ZEROP (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ)) - - (* ;; "He's completely emptied the type-in piece. Remove it and force creation of a fresh one at next type-in.") - - (\DELETEPIECE (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) - PCTB) (* UPDATEPCNODES (fetch - (TEXTOBJ \INSERTPC) of TEXTOBJ) - (IMINUS LEN) PCTB) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Force the next insertion to be in a fresh piece.") - ) - (T (UPDATEPCNODES (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ) - (IMINUS LEN) - PCTB))) (* ; "Adjust CH#s in the Piece Table.") - ) - ((ILEQ CH# TEXTLEN) (* ; - "General case of deletion: Remove pieces as needed to do it.") - (PROG (PCN PC1 PCNON PCSOUT (HIPC NIL) - HI LO) - (SETQ PC1 (\CHTOPC CH# PCTB T)) (* ; - "Piece # of piece containing start of deleted text") - (COND - ((IGREATERP CH# START-OF-PIECE) (* ; - "Split the piece, so the deleted text now starts on a piece boundary") - (\SPLITPIECE PC1 (- CH# START-OF-PIECE) - TEXTOBJ)) - (T (SETQ PC1 (fetch (PIECE PREVPIECE) of PC1)) - (* ; - "PC1 _ piece before the first piee to be deleted.-") - )) - (COND - ((ILEQ CHLIM TEXTLEN) (* ; - "Find the peice that contains the END of the deleted section") - (SETQ PCN (\CHTOPC CHLIM PCTB T))) - (T - (* ;; - "Deleting past end, so n+1-th piece is the symbol LASTPIECE, which starts 1 past end of all text.") - - (SETQ START-OF-PIECE (ADD1 TEXTLEN)) - (SETQ PCN 'LASTPIECE) - (SETQ HIPC NIL))) - [COND - ((ATOM PCN) (* ; "Deleting before the end of text.") - ) - (T (* ; - "Deleting in front of a real piece of text") - (COND - ([AND (IGREATERP CHLIM START-OF-PIECE) - (ILESSP CHLIM (IPLUS START-OF-PIECE (fetch (PIECE PLEN) - of PCN] - (SETQ HIPC (\SPLITPIECE PCN (- CHLIM START-OF-PIECE) - TEXTOBJ PCNON)) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ))) - (T (SETQ HIPC PCN] (* ; - "if not on a piece bound, split the last piece.") - (AND PC1 (EQ PC1 HIPC) - (HELP "circular")) - [SETQ PCLST (bind NPC [PC _ (COND - (PC1 (fetch (PIECE NEXTPIECE) of PC1)) - (T - (* ;; - "(\EDITELT PCTB (ADD1 \FirstPieceOffset))") - - (\GETBASEPTR (\FIRSTNODE PCTB) - 0] - while (AND PC (NEQ PC HIPC)) - collect (PROG1 PC - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)))] - [OR DONTDIRTY (\TEDIT.HISTORYADD TEXTOBJ - (create TEDITHISTORYEVENT - THACTION _ 'Delete - THLEN _ LEN - THCH# _ CH# - THFIRSTPIECE _ (CAR PCLST] - (* ; - "Add this event to the history list") - - (* ;; "Actually delete the pieces:") - - (for PC in PCLST do [AND (fetch (PIECE POBJ) of PC) - (IMAGEOBJPROP (fetch (PIECE POBJ) of PC) - 'WHENDELETEDFN) - (APPLY* (IMAGEOBJPROP (fetch (PIECE POBJ) - of PC) - 'WHENDELETEDFN) - (fetch (PIECE POBJ) of PC) - (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ] - (* \DELETEPIECE PC PCTB) - (\DELETETREE PC (fetch (PIECE PTREENODE) of PC))) - - (* ;; "Link around the deleted pieces:") - - (COND - (PC1 (replace (PIECE NEXTPIECE) of PC1 with HIPC))) - (COND - (HIPC (replace (PIECE PREVPIECE) of HIPC with PC1))) - - (* ;; "Unchain the deleted pieces from the rest of the document.") - - (AND (CAR (FLAST PCLST)) - (replace (PIECE PREVPIECE) of (CAR (FLAST PCLST)) with NIL)) - (AND (CAR PCLST) - (replace (PIECE PREVPIECE) of (CAR PCLST) with NIL)) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Force the next insertion to be in a fresh piece.") - (\TEDIT.DIFFUSE.PARALOOKS PC1 HIPC) (* ; - "PROPOGATE PARALOOKS THRU THE DELETION") - ] - (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ with (IDIFFERENCE TEXTLEN LEN)) - (* ; "Update the file's length") - (OR DONTDIRTY (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T]) - -(\SETUPGETCH - [LAMBDA (CH# TEXTOBJ) (* ; "Edited 14-Apr-93 17:14 by jds") - -(* ;;; "Set up TEXTOBJ so that the next \GETCH will retrieve character # CH#") - - (* ;; "NB that 1st char in the textobj is #1.") - - (* ;; "(declare (localvars . t))") - - (PROG (PC PCNO PS PF CHOFFSET CHARSLEFT (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (STREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)) - FPOS OFFST SUBSTREAM START-OF-PIECE) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) - [COND - [(LISTP CH#) (* ; - "If CH# is a piece-offset pair, make use of it.") - (SETQ PC (fetch (EDITMARK PC) of CH#)) - (SETQ CHOFFSET (fetch (EDITMARK PCOFF) of CH#)) - (COND - ((ATOM PC) (* ; - "This SETUPGETCH is to the final pseudo-piece!") - (freplace (TEXTSTREAM PIECE) of STREAM with PC) - (freplace (STREAM COFFSET) of STREAM with 0) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0) - (freplace (TEXTSTREAM PCOFFSET) of STREAM with 0) - (RETURN] - ((IGREATERP CH# (IMAX 1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (ERROR "TRYING TO \SETUPGETCH BEYOND END OF TEXT")) - (T - (* ;; "CH# is indeed a character number. Find the corresponding piece, its pcno, and the offset within that piece.") - - (SETQ PC (\CHTOPC CH# PCTB T)) - - (* ;; "(setq pc (\\editelt pctb (add1 pcno)))") - - (SETQ CHOFFSET (- CH# START-OF-PIECE] - (freplace (TEXTSTREAM PIECE) of STREAM with PC) - (replace (STREAM BINABLE) of STREAM with T) - (SETQ CHARSLEFT (IDIFFERENCE (fetch (PIECE PLEN) of PC) - CHOFFSET)) - (freplace (TEXTSTREAM PCOFFSET) of STREAM with CHOFFSET) - (COND - ((SETQ PS (ffetch (PIECE PSTR) of PC)) (* ; "This piece resides in a STRING.") - (\TEDIT.TEXTBIN.STRINGSETUP CHOFFSET CHARSLEFT STREAM PS)) - ((SETQ PF (ffetch (PIECE PFILE) of PC)) (* ; "This piece resides on a FILE") - (\TEDIT.TEXTBIN.FILESETUP PC CHOFFSET CHARSLEFT STREAM PF (fetch (PIECE PFATP) - of PC))) - [(SETQ PF (ffetch (PIECE POBJ) of PC)) (* ; - "This piece points to an object. set up so \TextBin will be called, and will return it.") - (COND - ((SETQ SUBSTREAM (IMAGEOBJPROP PF 'SUBSTREAM)) - (* ; - "There is a stream below this one! Reflect things upward.") - (* ; - "This is a simple object. Just set things up so it gets read.") - (\SETUPGETCH (ADD1 CHOFFSET) - (fetch (TEXTSTREAM TEXTOBJ) of SUBSTREAM)) - (replace (STREAM BINABLE) of STREAM with NIL) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (freplace (STREAM COFFSET) of STREAM with CHOFFSET) - (freplace (STREAM CBUFSIZE) of STREAM with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with CHOFFSET) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) of SUBSTREAM) - ) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (fetch (TEXTSTREAM CURRENTLOOKS) - of SUBSTREAM)) - (RETURN)) - (T (* ; - "This is a simple object. Just set things up so it gets read.") - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 1) - (freplace (STREAM COFFSET) of STREAM with 0) - (freplace (STREAM CBUFSIZE) of STREAM with 1) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (replace (STREAM BINABLE) of STREAM with NIL) - (* ; - "Force the next BIN to go thru our code.") - ] - (T (ERROR "Piece is neither a file nor a string??" PC))) - (replace (TEXTSTREAM CURRENTPARALOOKS) of STREAM with (\TEDIT.APPLY.PARASTYLES - (fetch (PIECE PPARALOOKS) - of PC) - PC TEXTOBJ)) - (* ; - "Set the character looks and font caches.") - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES (ffetch (PIECE - PLOOKS) - of PC) - PC TEXTOBJ]) - -(\TEDIT.REOPEN.STREAM - [LAMBDA (TEXTSTREAM PIECESTREAM) (* ; "Edited 11-Jun-99 15:12 by rmk:") - (* ; "Edited 11-Jun-99 15:12 by rmk:") - (* ; "Edited 11-Jun-99 14:24 by rmk:") - (* ; "Edited 15-Apr-93 15:53 by jds") - - (* ;; "Re-open the backing file stream, and propogate the change thru the entire piece table. Also, if TXTFILE is set to the closed stream, fill it in as well.") - - (LET* ([NEWSTREAM (OPENSTREAM PIECESTREAM 'INPUT NIL '((TYPE TEXT] - (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - PC) - (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0)) - - (* ;; "Run thru the pieces, correcting any that used this stream to use the new one:") - - (while PC do (COND - ((EQ (fetch (PIECE PFILE) of PC) - PIECESTREAM) - (replace (PIECE PFILE) of PC with NEWSTREAM))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC))) - - (* ;; "Check the TXTFILE, and if it uses the closed stream, fix it as well:") - - (COND - ((EQ (fetch (TEXTOBJ TXTFILE) of TEXTOBJ) - PIECESTREAM) (* ; - "Yup, it was the old, closed stream. Fix it.") - (replace (TEXTOBJ TXTFILE) of TEXTOBJ with NEWSTREAM))) - - (* ;; "Return the new value for the stream:") - - NEWSTREAM]) - -(\TEDIT.COPYTEXTSTREAM.PIECEMAPFN - [LAMBDA (PC TEXTOBJ FROMOBJ TOOBJ) (* ; "Edited 31-May-91 14:00 by jds") - (* Called by COPYTEXTSTREAM via - TEDIT.SELECTED.PIECES, to do the - copy-operation processing on the - candidate pieces.) - (PROG (OBJ NEWOBJ COPYFN) - (SETQ PC (create PIECE using PC PNEW _ T)) (* No matter what, we need a fresh - copy.) - [COND - ((fetch (PIECE POBJ) of PC) (* This piece describes an object) - (SETQ OBJ (fetch (PIECE POBJ) of PC)) - [COND - [(SETQ COPYFN (IMAGEOBJPROP OBJ 'COPYFN)) - (SETQ NEWOBJ (APPLY* COPYFN OBJ (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOOBJ))) - (COND - ((EQ NEWOBJ 'DON'T) (* He said not to copy this piece -- - abort the whole copy.) - (TEDIT.PROMPTPRINT TEXTOBJ "COPY of this object not allowed." T) - (RETFROM 'TEDIT.COPY)) - (NEWOBJ (replace (PIECE POBJ) of PC with NEWOBJ)) - (T (replace (PIECE POBJ) of PC with (COPYALL OBJ] - (OBJ (* No copy fn; just strike off a copy - of our own) - (replace (PIECE POBJ) of PC with (COPYALL OBJ] - (COND - ((SETQ COPYFN (IMAGEOBJPROP OBJ 'WHENCOPIEDFN)) - (* If there's an eventfn for copying, - use it.) - (APPLY* COPYFN OBJ (CAR (fetch (TEXTOBJ \WINDOW) of TOOBJ)) - (fetch (TEXTOBJ STREAMHINT) of FROMOBJ) - (fetch (TEXTOBJ STREAMHINT) of TOOBJ] - (RETURN PC]) - -(\TEXTINIT - [LAMBDA NIL (* ; "Edited 3-Jul-2022 00:34 by rmk") - (* ; "Edited 5-May-2022 15:12 by rmk") - (* ; "Edited 7-Oct-2021 08:40 by rmk:") - (* ; - "Create the FDEV and STREAM prototypes for TEXT streams.") - - (* ;; "TEXT streams make use of the following STREAM fields:") - - (* ;; "(DEVICE (* FDEV of this guy -- The TEXT device)") - - (* ;; "F1 (* The STREAM for the PFILE of the current piece (or NIL))") - - (* ;; "F2 (* # chars left in piece at end of underlying file's page)") - - (* ;; "F3 (* The TEXTOBJ for this stream)") - - (* ;; "F4") - - (* ;; "F5 (* The PIECE we're currently inside)") - - (* ;; "(FW6 WORD) (* CPAGE for the start of the piece, for BACKFILEPTR)") - - (* ;; "(FW7 WORD) (* COFFSET for the start of the piece, for BACKFILEPTR)") - - (* ;; "(FW8 WORD)") - - [SETQ \TEXTIMAGEOPS (create IMAGEOPS - IMAGETYPE _ 'TEXT - IMXPOSITION _ (FUNCTION \TEXTDSPXPOSITION) - IMYPOSITION _ (FUNCTION \TEXTDSPYPOSITION) - IMLEFTMARGIN _ (FUNCTION \TEXTLEFTMARGIN) - IMRIGHTMARGIN _ (FUNCTION \TEXTRIGHTMARGIN) - IMFONT _ (FUNCTION \TEXTDSPFONT) - IMCLOSEFN _ (FUNCTION NILL) - IMFONTCREATE _ 'DISPLAY - IMLINEFEED _ (FUNCTION \TEXTDSPLINEFEED) - IMCHARWIDTH _ (FUNCTION \TEXTDSPCHARWIDTH) - IMSTRINGWIDTH _ (FUNCTION \TEXTDSPSTRINGWIDTH) - IMSCALE _ (FUNCTION (LAMBDA NIL 1] - - (* ;; "Maybe more functions later?") - - (MAKE-EXTERNALFORMAT :TEDIT NIL NIL NIL (FUNCTION \TEDITOUTCCODEFN) - NIL - 'CR NIL NIL T) - (SETQ \TEXTFDEV (create FDEV - DEVICENAME _ 'TEXT - RESETABLE _ T - RANDOMACCESSP _ T - PAGEMAPPED _ NIL - GETFILENAME _ (FUNCTION NILL) - BIN _ (FUNCTION \TEXTBIN) - BOUT _ (FUNCTION \TEXTBOUT) - CLOSEFILE _ (FUNCTION \TEXTCLOSEF) - OPENFILE _ (FUNCTION \TEXTOPENF) - DELETEFILE _ (FUNCTION NILL) - DIRECTORYNAMEP _ (FUNCTION NILL) - EVENTFN _ (FUNCTION NILL) - GENERATEFILES _ (FUNCTION \GENERATENOFILES) - GETFILEINFO _ (FUNCTION NILL) - HOSTNAMEP _ (FUNCTION NILL) - READPAGES _ (FUNCTION NILL) - REOPENFILE _ [FUNCTION (LAMBDA (FILE ACCESS RECOG OTHERINFO FDEV STREAM) - (replace (STREAM ACCESS) of STREAM - with 'BOTH) - STREAM] - SETFILEINFO _ (FUNCTION NILL) - BACKFILEPTR _ (FUNCTION \TEXTBACKFILEPTR) - SETFILEPTR _ (FUNCTION \TEXTSETFILEPTR) - PEEKBIN _ (FUNCTION \TEXTPEEKBIN) - GETEOFPTR _ (FUNCTION \TEXTGETEOFPTR) - GETFILEPTR _ (FUNCTION \TEXTGETFILEPTR) - EOFP _ (FUNCTION \TEXTEOFP) - FDBINABLE _ T - FDBOUTABLE _ NIL - FDEXTENDABLE _ NIL - TRUNCATEFILE _ (FUNCTION NILL) - WRITEPAGES _ (FUNCTION NILL) - DEFAULTEXTERNALFORMAT _ :TEDIT)) - - (* ;; "The prototypical Text stream") - - (SETQ \TEXTOFD - (create STREAM - BINABLE _ T - BOUTABLE _ NIL - ACCESS _ 'BOTH - USERCLOSEABLE _ T - USERVISIBLE _ T - DEVICE _ \TEXTFDEV - F1 _ NIL - F2 _ 0 - F3 _ NIL - F5 _ NIL - FW6 _ 0 - FW7 _ 0 - MAXBUFFERS _ 10 - IMAGEOPS _ \TEXTIMAGEOPS - IMAGEDATA _ (create TEXTIMAGEDATA))) - - (* ;; "Set up so that FILE NOT OPENs on TEdit streams are caught and fixed.") - - (CL:SETF (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN) - (FUNCTION (LAMBDA (CONDITION) - (LET ((STREAM (STREAM-ERROR-STREAM CONDITION))) - (COND - [(AND (BOUNDP 'ERRORPOS) - (TEXTSTREAMP STREAM)) (* ; - "This happened in the error handler, and it happened to a TEdit stream, so try the fix:") - (LET ((XCL::RESULT (REOPENTEXTSTREAM STREAM))) - (CL:WHEN XCL::RESULT - (ENVAPPLY (STKNAME ERRORPOS) - (SUBST XCL::RESULT STREAM (STKARGS ERRORPOS)) - (STKNTH -1 ERRORPOS ERRORPOS) - ERRORPOS T T))] - (*TEDIT-OLD-STREAM-ERROR-HANDLER* - (* ; - "Some other kind of stream, so punt to the old handler (if there is one):") - (APPLY* *TEDIT-OLD-STREAM-ERROR-HANDLER* CONDITION]) - -(\TEXTMARK - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:18 by jds") - (PROG ((STREAM (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ))) - (RETURN (CONS (ffetch (TEXTSTREAM PIECE) of STREAM) - (IDIFFERENCE (create BYTEPTR - PAGE _ (ffetch (STREAM CPAGE) of STREAM) - OFFSET _ (ffetch (STREAM COFFSET) of STREAM)) - (create BYTEPTR - PAGE _ (ffetch (TEXTSTREAM PCSTARTPG) of STREAM) - OFFSET _ (ffetch (TEXTSTREAM PCSTARTCH) of STREAM]) - -(\TEXTTTYBOUT - [LAMBDA (STREAM BYTE) (* ; "Edited 31-May-91 14:18 by jds") - (* Do BOUT to a text stream, which is - an insertion at the caret.) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (COND - ((EQ BYTE ERASECHARCODE) - (\TEDIT.CHARDELETE TEXTOBJ "" (fetch (TEXTOBJ SEL) of TEXTOBJ))) - ((EQ IGNORE.CCE (fetch CCECHO of (\SYNCODE (OR (fetch (TEXTOBJ TXTTERMSA) of TEXTOBJ) - \PRIMTERMSA) - BYTE))) (* Nothing, ignore it) - ) - (T (SELCHARQ BYTE - ((EOL CR LF) - (\TEXTBOUT STREAM BYTE) - (replace (STREAM CHARPOSITION) of STREAM with 0)) - (PROGN (\TEXTBOUT STREAM BYTE) - (add (fetch (STREAM CHARPOSITION) of STREAM) - 1]) -) -(DEFINEQ - -(\INSERTCH - [LAMBDA (CH CH# TEXTOBJ INSERTMARK) (* ; "Edited 29-Jan-99 17:19 by kaplan") - - (* ;; "If the current ch is 1+last ch in the distinguished INPUTPIECE, then append this text to that piece (make a new one if need be.), and fix up ch#s in the PCTB") - - (* ;; "else, create a new input piece (as a substring of the old one) and INSERT it at the right spot, perhaps after splitting a piece to make room.") - - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - - (* ;; "Only insert if the document is allowed to change.") - - (PROG (PC (LEN (COND - ((type? STRINGP CH) - (NCHARS CH)) - (T 1))) - [FATP (COND - [(type? STRINGP CH) - (AND (fetch (STRINGP FATSTRINGP) of CH) - (NOT (NULL (for CHAR instring CH thereis (IGREATERP CHAR - \MAXTHINCHAR] - (T (IGREATERP CH \MAXTHINCHAR] - CHNO NEWPC PREVPC EVENT REPLACING (NEWFLAG NIL) - (\INEXTCH (fetch (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ)) - (\INLEN (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ)) - (\INLEFT (fetch (TEXTOBJ \INSERTLEFT) of TEXTOBJ)) - (\INSTRING (fetch (TEXTOBJ \INSERTSTRING) of TEXTOBJ)) - (\INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - (\INFIRSTCH (fetch (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ)) - (PCTB (ffetch (TEXTOBJ PCTB) of TEXTOBJ)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (IMARKPC (fetch (EDITMARK PC) of INSERTMARK)) - (IMARKCH (fetch (EDITMARK PCOFF) of INSERTMARK)) - PLOOKS NLOOKS START-OF-PIECE) - [COND - ((ZEROP LEN) (* ; "Nothing to insert, really!") - (RETURN)) - [(ZEROP (fetch (BTREENODE COUNT) of PCTB)) (* ; "PCTB is empty.") - (\INSERT.FIRST.PIECE TEXTOBJ) - (SETQ \INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - (SETQ \INSTRING (fetch (TEXTOBJ \INSERTSTRING) of TEXTOBJ)) - (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") - (RPLSTRING \INSTRING 1 CH)) - (T (* ; - "If it's a single charcode, move it to the piece's string") - (RPLCHARCODE \INSTRING 1 CH))) - (replace (PIECE PLEN) of \INPC (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ - with LEN)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN)) - (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with LEN) - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ 'Insert - THLEN _ (fetch (PIECE PLEN) of \INPC) - THCH# _ CH# - THFIRSTPIECE _ (LIST \INPC) - THPOINT _ 'RIGHT] - ((OR [AND (fetch (TEXTOBJ \INSERTPCVALID) of TEXTOBJ) - (OR (IEQP CH# \INEXTCH) - (AND INSERTMARK (EQ IMARKPC (fetch (PIECE NEXTPIECE) of \INPC)) - (EQ IMARKCH 0] - (AND NIL (EQ CH# 1) - (EQ \INEXTCH -1))) - - (* ;; "We're inserting at the end of a previous insertion, for which we already have a piece built. Just add to it.") - - (* ;; "Or, First insertion to empty document.") - - (COND - ((IGEQ \INLEFT LEN) (* ; - "There's enough room in this piece -- fill it in.") - (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") - (RPLSTRING \INSTRING (ADD1 \INLEN) - CH)) - (T (* ; - "If it's a single charcode, move it to the piece's string") - (RPLCHARCODE \INSTRING (ADD1 \INLEN) - CH))) - (replace (PIECE PLEN) of \INPC with (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ - with (IPLUS \INLEN LEN))) - (* ; - "Fix the length of the insert piece") - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE \INLEFT LEN)) - (* ; "And the space left in the piece") - (freplace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS \INEXTCH LEN)) - (* ; "And the next CH#") - (* ; "And the piece # for future use") - ) - (T (* ; - "No room. Chop this piece & start a new one.") - (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN)) - (* ; - "Chop the current piece's string to length") - (SETQ NEWPC (create PIECE - PSTR _ (ALLOCSTRING 512 '% ) - PLOOKS _ (fetch (PIECE PLOOKS) of \INPC) - PPARALOOKS _ (fetch (PIECE PPARALOOKS) of \INPC) - PPARALAST _ NIL - PNEW _ T)) (* ; "Create the new piece") - (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ with (SETQ \INSTRING - (fetch (PIECE PSTR) - of NEWPC))) - (* ; - "Set the \INSTRING field in TEXTOBJ") - (COND - ((type? STRINGP CH) (* ; - "If input is a string, copy it to the insert piece's string") - (RPLSTRING \INSTRING 1 CH)) - (T (* ; - "If it's a single charcode, move it to the piece's string") - (RPLCHARCODE \INSTRING 1 CH))) - (replace (PIECE PLEN) of NEWPC with LEN) - (* ; - "So far, the present input is the only thing in the piece") - (replace (TEXTOBJ \INSERTPCNO) of TEXTOBJ - with (\INSERTPIECE NEWPC (OR (fetch (PIECE NEXTPIECE) of \INPC) - 'LASTPIECE) - TEXTOBJ)) (* ; - "Insert the new piece into the text and save the piece #") - - (* ;; "(SETQ PCTB (fetch PCTB of TEXTOBJ))") - (* ; - "Which may have caused a PCTB overflow") - (* ; - "This does not happen, after change pctree.") - (freplace (TEXTOBJ \INSERTPC) of TEXTOBJ with (SETQ \INPC NEWPC)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN)) - (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with LEN) - (replace (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ with CH#) - (* ; - "CH# of the first inserted character") - (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS CH# LEN)) - (* ; - "The CH# of the next character, if it's inserted at the current caret.") - (replace THFIRSTPIECE of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - with (NCONC1 (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ) - NEWPC)) - (SETQ NEWFLAG T) (* ; "Note the new piece's creation") - )) - (add (fetch THLEN of (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - LEN) (* ; - "Update the length of the insertion/replacement text.") - ) - (T - (* ;; "NEW INSERTION POINT; IF THERE'S ANYTHING LEFT OF THE PREVIOUS INSERT PIECE, CRACK OFF A NEW ONE & FILL IT. THEN FIGURE OUT WHERE TO SHOEHORN IT IN.") - - (SETQ PC (OR IMARKPC (\CHTOPC CH# PCTB T))) - [COND - ((AND \INPC (IGEQ \INLEFT LEN)) (* ; - "There's room left in the prior input-piece's string; re-use it.") - (SETQ NEWPC (create PIECE - PSTR _ (SUBSTRING \INSTRING (ADD1 \INLEN)) - PLOOKS _ (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - PPARALOOKS _ (fetch (PIECE PPARALOOKS) of \INPC) - PPARALAST _ NIL - PNEW _ T)) (* ; "Build the new piece") - (replace (PIECE PSTR) of \INPC with (SUBSTRING \INSTRING 1 \INLEN)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE \INLEFT LEN))) - (T (* ; - "No room left; build a whole new piece.") - (SETQ NEWPC (create PIECE - PSTR _ (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ - with (ALLOCSTRING 512)) - PLOOKS _ (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ) - PPARALOOKS _ (OR (AND \INPC (fetch (PIECE PPARALOOKS) - of \INPC)) - (\TEDIT.UNIQUIFY.PARALOOKS - (create FMTSPEC - copying (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - TEXTOBJ)) - PPARALAST _ NIL - PNEW _ T)) - (freplace (TEXTOBJ \INSERTLEFT) of TEXTOBJ with (IDIFFERENCE 512 LEN] - (freplace (TEXTOBJ \INSERTPC) of TEXTOBJ with (SETQ \INPC NEWPC)) - (replace (PIECE PLEN) of NEWPC with LEN) - (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ with (SETQ \INSTRING - (fetch (PIECE PSTR) - of NEWPC))) - (COND - ((type? STRINGP CH) (* ; - "Insert the characters into the piece") - (RPLSTRING \INSTRING 1 CH)) - (T (RPLCHARCODE \INSTRING 1 CH))) - (freplace (TEXTOBJ \INSERTLEN) of TEXTOBJ with LEN) - (freplace (TEXTOBJ \INSERTFIRSTCH) of TEXTOBJ with CH#) - (* ; - "Cache the first-inserted-ch #, for backspace speed") - (SETQ NEWFLAG T) - (COND - ((OR (IGREATERP CH# TEXTLEN) - (IEQP CH# START-OF-PIECE)) (* ; - "We're inserting on a piece boundary; do it, then remember the prior piece.") - (\INSERTPIECE \INPC PC TEXTOBJ NIL)) - (T (* ; - "Not on a piece boundary; split the piece we're inside of, then insert.") - (\INSERTPIECE \INPC (\SPLITPIECE PC (- CH# START-OF-PIECE) - TEXTOBJ) - TEXTOBJ NIL))) - [COND - ((NOT (fetch (PIECE PPARALOOKS) of \INPC)) - (* ; - "There weren't any paralooks available at creation time. Find some now.") - [SETQ PLOOKS (AND (fetch (PIECE PREVPIECE) of \INPC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE PREVPIECE) - of \INPC] - [SETQ NLOOKS (AND (fetch (PIECE NEXTPIECE) of \INPC) - (fetch (PIECE PPARALOOKS) of (fetch (PIECE NEXTPIECE) - of \INPC] - (replace (PIECE PPARALOOKS) of \INPC with (COND - ((NOT PLOOKS) - (* ; - "No preceding para to take looks from") - (OR NLOOKS (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ))) - ((NOT NLOOKS) - (* ; - "No succeeding paras to take looks from") - (OR PLOOKS (fetch (TEXTOBJ - FMTSPEC) - of TEXTOBJ))) - (T PLOOKS] - (replace (TEXTOBJ \INSERTPCNO) of TEXTOBJ with 0) - (* ; - "Save the pcno for future insertions") - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (* ; - "The PCTB may have expanded during the insert.") - (SETQ PREVPC (OR (fetch (PIECE PREVPIECE) of NEWPC) - PC)) (* ; - "The piece we're to take the inserted characters' looks from") - (replace (PIECE PLOOKS) of NEWPC with (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) - [replace (PIECE PPARALOOKS) of NEWPC with (COND - ((ZEROP TEXTLEN) - (* ; - "No text yet; use default paralooks") - (fetch (TEXTOBJ FMTSPEC) - of TEXTOBJ)) - ((SETQ PREVPC (fetch (PIECE - NEXTPIECE - ) - of \INPC)) - (* ; - "There's later text. Use its para looks") - (fetch (PIECE PPARALOOKS) - of PREVPC)) - ((SETQ PREVPC (fetch (PIECE - PREVPIECE - ) - of \INPC)) - (* ; - "There's earlier text. Use its looks, copied if need be.") - (COND - ((fetch (PIECE PPARALAST) - of PREVPC) - (fetch (PIECE PPARALOOKS) - of PREVPC)) - (T (fetch (PIECE PPARALOOKS) - of PREVPC] - (SETQ EVENT (fetch (TEXTOBJ TXTHISTORY) of TEXTOBJ)) - (* ; "Prior edit event.") - [SETQ REPLACING (AND (EQ (fetch THACTION of EVENT) - 'Delete) - (IEQP CH# (fetch THCH# of EVENT] - (COND - ((AND (fetch (TEXTOBJ \INSERTPCVALID) of TEXTOBJ) - (IEQP CH# \INEXTCH) - (EQ (fetch THACTION of EVENT) - 'Insert)) - - (* ;; "We're continuing a prior insertion, even if we had to create a new piece. Just continue the old history event, too.") - - (add (fetch THLEN of EVENT) - LEN)) - (T (* ; - "Nope, this is a new insertion/replacement. Make the new history event.") - (\TEDIT.HISTORYADD TEXTOBJ (create TEDITHISTORYEVENT - THACTION _ (COND - (REPLACING 'Replace) - (T 'Insert)) - THLEN _ (fetch (PIECE PLEN) of \INPC) - THCH# _ CH# - THFIRSTPIECE _ \INPC - THPOINT _ 'RIGHT - THOLDINFO _ (AND REPLACING EVENT] - [OR NEWFLAG (PROGN (* ; - "We didn't add a piece, so we must update character numbers in the PCTB") - (* ; "The insert-piece's PCTB entry") - - (* ;; "(for I from (IPLUS PCNO \EltsPerPiece) to (\EDITELT PCTB \PCTBLastPieceOffset) by \EltsPerPiece do (\EDITSETA PCTB I (IPLUS (\EDITELT PCTB I) LEN)))") - - (COND - ((NOT (AND (EQ CH# 1) - (EQ \INEXTCH -1))) - (* ; - "Update character numbers in the PCTB doesn't need when 1st insertion.") - (UPDATEPCNODES \INPC LEN PCTB] - (freplace (TEXTOBJ TEXTLEN) of TEXTOBJ with (SETQ TEXTLEN (IPLUS LEN TEXTLEN))) - (replace (TEXTOBJ \INSERTNEXTCH) of TEXTOBJ with (IPLUS CH# LEN)) - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with T) - (replace (TEXTOBJ \DIRTY) of TEXTOBJ with T) - (replace (PIECE PFATP) of \INPC with (OR (fetch (PIECE PFATP) of \INPC) - FATP]) - -(\INSERTCR - [LAMBDA (CH CH# TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") - - (* ;; "Handle insertion of CR and meta-CR. The former causes a paragraph break, while the latter doesn't. Note, though, that inserting a meta-CR causes the doucment to become formatted.") - - (COND - ((fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (T (LET (INPC) - (COND - ([AND (NOT (fetch (TEXTOBJ FORMATTEDP) of TEXTOBJ)) - (NOT (IEQP CH (CHARCODE CR] (* ; - "Inserting a meta-CR into an unformatted document. Start by setting up para breaks.") - (\TEDIT.CONVERT.TO.FORMATTED TEXTOBJ))) - (\INSERTCH (CHARCODE CR) - CH# TEXTOBJ) (* ; "Put the CR in") - (COND - ((IEQP CH (CHARCODE CR)) (* ; - "It's really a CR, rather than a meta-CR so do para breaking.") - (SETQ INPC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ)) - (AND INPC (replace (PIECE PPARALAST) of INPC with T)) - (* ; - "Mark the end of the paragraph (INPC might be NIL if the insert got refused somehow).") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "FORCE A NEW PIECE ON THE NEXT CHARACTER") - ]) -) - - - -(* ;;; "Functions to manipulate the Piece Table (PCTB)") - -(DEFINEQ - -(\CHTOPC - [LAMBDA (CH# PCTB TELL-PC-START?) (* ; "Edited 15-Apr-93 16:05 by jds") - - (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL.") - - (* ;; "If TELL-PC-START? is not NIL, sets the free variable START-OF-PIECE to the ch# of the piece's start.") - - (LET ((TREE PCTB) - (BASE-CH# 1) - TBASE-CH# FOUND) - (while (type? BTREENODE TREE) do [for I from 1 to (fetch (BTREENODE COUNT) of TREE) - as OFST from 2 by 4 - do (COND - ((IGREATERP (SETQ TBASE-CH# - (IPLUS BASE-CH# (\GETBASEFIXP TREE - OFST))) - CH#) - (SETQ FOUND (\GETBASEPTR TREE (- OFST 2))) - (RETURN)) - (T (SETQ BASE-CH# TBASE-CH#] - (SETQ TREE FOUND)) - (AND TELL-PC-START? (SETQ START-OF-PIECE BASE-CH#)) - (OR TREE 'LASTPIECE]) - -(\CHTOPCNO - [LAMBDA (CH# PCTB) (* ; "Edited 13-Jun-90 00:47 by mitani") - - (* ;; "Given a character # in a text object, and the object's piece table, return a pointer to the piece containing that character, else NIL") - - (DECLARE (LOCALVARS . T)) - (LET ((INDEX 0) - (TREE (fetch (PCTNODE HI) of PCTB)) - CHNUM) - [while TREE do (COND - [(IEQP CH# (SETQ CHNUM (fetch (PCTNODE CHNUM) of TREE))) - (* ; "FIND NODE") - (RETURN (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) of TREE] - ((IGREATERP CH# CHNUM) (* ; "MOVE RIGHT") - (SETQ INDEX (IPLUS INDEX (fetch (PCTNODE RANK) of TREE))) - (SETQ TREE (fetch (PCTNODE HI) of TREE))) - ((ILESSP CH# CHNUM) (* ; "MOVE LEFT") - (SETQ TREE (fetch (PCTNODE LO) of TREE] - (IMAX INDEX 1]) - -(\CLEARPCTB - [LAMBDA (PCTB) (* ; "Edited 23-Feb-88 11:11 by jds") - - (* ;; "(PROG ((OLASTPC (\EDITELT PCTB \PCTBLastPieceOffset))) (\EDITSETA PCTB \FirstPieceOffset 1) (* Create the LASTPIECE pseudo-piece placeholder in the first piece of the table) (\EDITSETA PCTB (ADD1 \FirstPieceOffset) (QUOTE LASTPIECE)) (for I from \SecondPieceOffset to OLASTPC do (* Now remove the other pieces, setting them to NIL) (\EDITSETA PCTB I NIL)) (\EDITSETA PCTB \PCTBLastPieceOffset (ADD1 \FirstPieceOffset)) (* Fix up the last-piece pointer) (\EDITSETA PCTB \PCTBFreePieces (IPLUS (\EDITELT PCTB \PCTBFreePieces) (LRSH (IDIFFERENCE OLASTPC (ADD1 \FirstPieceOffset)) 1))) (* And the free count of pieces.) (RETURN PCTB))") - - (HELP]) - -(\CREATEPIECEORSTREAM - [LAMBDA (TEXT LOOKS PARALOOKS START END) (* ; "Edited 20-Jul-2022 08:09 by rmk") - (* ; "Edited 13-Jul-2022 18:46 by rmk") - (* ; "Edited 11-Jun-99 14:25 by rmk:") - (* ; "Edited 31-May-91 14:18 by jds") - - (* ;; "Given a source for text, build a PIECE to describe it.") - - (* ;; "HOWEVER-- if it's aformatted file, return the stream for that file.") - - (PROG (PC) - [SETQ PC - (COND - ((STRINGP TEXT) (* ; "It's a string.") - (HELP "STRING TEXTS ARE NOW INTERPRETED AS FILE NAMES" TEXT) - (create PIECE - PSTR _ TEXT - PFILE _ NIL - PLEN _ (NCHARS TEXT) - PPARALAST _ NIL - PPARALOOKS _ PARALOOKS - PFATP _ (fetch (STRINGP FATSTRINGP) of TEXT))) - ((NULL TEXT) (* ; - "If it's NIL, use an empty string for the text.") - (create PIECE - PSTR _ "" - PFILE _ NIL - PLEN _ 0 - PPARALAST _ NIL - PPARALOOKS _ PARALOOKS)) - ((ATOM TEXT) (* ; "An atom is a file name. Open it.") - (HELP "ATOM TEXTS SHOULD ALREADY HAVE BEEN COERCED TO STREAMS" TEXT) - [SETQ TEXT (OPENSTREAM TEXT 'INPUT 'OLD '(TYPE TEXT] - (RETURN TEXT)) - ((STREAMP TEXT) (* ; - "Make sure it's open, then bail out") - (CL:UNLESS (\GETSTREAM TEXT 'INPUT T) - [OPENSTREAM TEXT 'INPUT 'OLD `((TYPE TEXT) - (:EXTERNAL-FORMAT ,(GETSTREAMPROP TEXT - :EXTERNAL-FORMAT]) - (RETURN TEXT)) - ((type? PIECE TEXT) - TEXT) - (T (* ; - "Anything else is coerced to a string first.") - (HELP "ONLY STREAMS CAN BE EDITGED" TEXT) - (SETQ TEXT (MKSTRING TEXT)) - (create PIECE - PSTR _ TEXT - PFILE _ NIL - PLEN _ (NCHARS TEXT) - PPARALAST _ NIL - PPARALOOKS _ PARALOOKS - PFATP _ (fetch (STRINGP FATSTRINGP) of TEXT] - (replace (PIECE PLOOKS) of PC with (OR LOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT))) - (replace (PIECE PPARALOOKS) of PC with (OR PARALOOKS (create FMTSPEC using - TEDIT.DEFAULT.FMTSPEC - ))) - (RETURN PC]) - -(\DELETEPIECE - [LAMBDA (PC PCTB PC#) (* ; "Edited 20-Apr-93 19:06 by jds") - - (* ;; "Remove piece PC from the piece table PCTB. Adjust the character numbers of succeeding pieces, if need be.") - - (PROG (PCNODE (NEXT (fetch (PIECE NEXTPIECE) of PC)) - (PREV (fetch (PIECE PREVPIECE) of PC))) - (\DELETETREE PC (fetch (PIECE PTREENODE) of PC)) - (COND - (NEXT (replace (PIECE PREVPIECE) of NEXT with PREV))) - (* ; - "Break any forward link from the piece") - (COND - (PREV (replace (PIECE NEXTPIECE) of PREV with NEXT))) - (* ; "and any backward link.") - ]) - -(\FINDPIECE - [LAMBDA (PC PCTB) (* ; "Edited 31-May-91 13:53 by jds") - - (* Given a piece and the pctb it's in, return the elt %# of the CH# entry for - that piece in the table) - - (LET ((NODE (FINDPCNODE PC PCTB))) - (INDEX (fetch (PCTNODE CHNUM) of NODE) - PCTB]) - -(\INSERTPIECE - [LAMBDA (NEW OLD TEXTOBJ DONTUPDATECH#S PC# NEW-PREVLEN PREV) - (* ; "Edited 7-Oct-94 17:43 by jds") - - (* ;; "Insert the piece NEW in front of the piece OLD; re-allocate PCTB if need be") - - (PROG* ((PLEN (fetch (PIECE PLEN) of NEW)) - (PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - OLDLEN PCNODE PREVPC) - (COND - ((ZEROP (fetch (BTREENODE COUNT) of PCTB)) (* ; "PCTB is empty.") - (replace (PIECE NEXTPIECE) of NEW with NIL) - (replace (PIECE PREVPIECE) of NEW with NIL) - (replace (BTREENODE DOWN1) of PCTB with NEW) - (replace (BTREENODE COUNT) of PCTB with 1) - (replace (BTREENODE TOTLEN) of PCTB with PLEN) - (RETURN 1))) - (SETQ OLDLEN (fetch (BTREENODE TOTLEN) of PCTB)) - [SETQ PCNODE (COND - ((OR (NULL OLD) - (ATOM OLD)) (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker. Go find the node that contains it.") - (\LASTNODE PCTB)) - (T (* ; - "Normal case; go find the btree node that contains the piece we're inserting in front of.") - (FINDPCNODE OLD PCTB] - (\INSERTTREE NEW OLD PCNODE NEW-PREVLEN NIL PREV) - - (* ;; "Update inter-piece linkages:") - - (COND - [(OR (NULL OLD) - (ATOM OLD)) (* ; "Inserting in front of a symbol OR NIL, which must be LASTPIECE, the end-of-doc marker. Go find the node that contains it.") - (replace (PIECE NEXTPIECE) of NEW with NIL) - (replace (PIECE PREVPIECE) of NEW with (AND (NOT (ZEROP OLDLEN)) - (SETQ PREVPC (\CHTOPC OLDLEN PCTB] - (T (* ; - "Normal case; go find the btree node that contains the piece we're inserting in front of.") - (replace (PIECE NEXTPIECE) of NEW with OLD) - (replace (PIECE PREVPIECE) of NEW with (SETQ PREVPC (ffetch (PIECE PREVPIECE) - of OLD))) - (replace (PIECE PREVPIECE) of OLD with NEW))) - (AND PREVPC (replace (PIECE NEXTPIECE) of PREVPC with NEW]) - -(\MAKEPCTB - [LAMBDA (PC1 MINLEN) (* ; "Edited 15-Apr-93 15:48 by jds") - - (* ;; "Create a new piece table, with PC1 as its first piece, and a dummy piece at the end, with 1st ch# of 1+ (chlim of pc1)") - - (* ;; "A piece Table has the following format: It's an array, with 2 header words (1_# of pieces left in table unused) (2_offset of last used word in tbl), followed by 2-word entries: the first ch# in the piece, and a pointer to the piece.") - - (* ;; "NEW piece tree ") - - (* ;; "ROOT->LO: total hight of piece tree") - - (* ;; "ROOT->HI : Top node of piece tree") - - (LET ((PCTB (CREATE BTREENODE)) - PLEN) - (COND - (PC1 (FREPLACE (BTREENODE COUNT) OF PCTB WITH 2) - (FREPLACE (BTREENODE TOTLEN) OF PCTB WITH (SETQ PLEN (FETCH (PIECE PLEN) - OF PC1))) - (FREPLACE (BTREENODE DOWN1) OF PCTB WITH PC1) - (FREPLACE (BTREENODE DLEN1) OF PCTB WITH PLEN) - (FREPLACE (BTREENODE DOWN2) OF PCTB WITH 'LASTPIECE) - (FREPLACE (BTREENODE DLEN2) OF PCTB WITH 0) - (FREPLACE (PIECE PTREENODE) OF PC1 WITH PCTB)) - (T - (* ;; - "No initial piece, so create a 0-long document, with only the ending-piece dummy") - - (FREPLACE (BTREENODE COUNT) OF PCTB WITH 1) - (FREPLACE (BTREENODE TOTLEN) OF PCTB WITH 0) - (FREPLACE (BTREENODE DOWN1) OF PCTB WITH 'LASTPIECE) - (FREPLACE (BTREENODE DLEN1) OF PCTB WITH 0))) - PCTB]) - -(\SPLITPIECE - [LAMBDA (PC CH TEXTOBJ PC#) (* ; "Edited 21-Apr-93 17:49 by jds") - - (* ;; "Split the piece PC before CH (rel to start of PIECE); return the new second piece.") - - (* ;; "PC#, if present, points at the CH# entry for the piece being split.") - - (PROG* ((PCTB (ffetch (TEXTOBJ PCTB) of TEXTOBJ)) - (NEWPC (create PIECE using PC)) - CHNO NEWLEN NEXTPC) - (SETQ CHNO CH) (* ; - "Offset within the piece before which to break") - (COND - ((ILEQ CHNO 0) - (SHOULDNT "Splitting a piece at the start."))) - (replace (PIECE PPARALAST) of PC with NIL) (* ; - "There can be no para break before the split, as things now work.") - (COND - ((ffetch (PIECE PSTR) of PC) (* ; - "This piece points to a string. Split it for the two new pieces") - (freplace (PIECE PSTR) of NEWPC with (SUBSTRING (ffetch (PIECE PSTR) of PC) - (ADD1 CHNO))) - (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE PLEN) of PC) - CHNO)) - (freplace (PIECE PSTR) of PC with (SUBSTRING (ffetch (PIECE PSTR) of PC) - 1 CHNO)) - (freplace (PIECE PLEN) of PC with CHNO)) - ((ffetch (PIECE PFILE) of PC) (* ; - "This piece points to a file. Set the fileptrs accordingly") - (freplace (PIECE PFILE) of NEWPC with (ffetch (PIECE PFILE) of PC)) - [freplace (PIECE PFPOS) of NEWPC with (COND - ((fetch (PIECE PFATP) of NEWPC) - (* ; - "This is a FAT piece; need to allow 2 bytes per char skipped") - (IPLUS (ffetch (PIECE PFPOS) of PC) - CHNO CHNO)) - (T (* ; - "Regular piece; allow 1 byte per char") - (IPLUS (ffetch (PIECE PFPOS) of PC) - CHNO] - (freplace (PIECE PLEN) of NEWPC with (IDIFFERENCE (ffetch (PIECE PLEN) of PC) - CHNO)) - (FREPLACE (PIECE PLEN) OF PC WITH CHNO))) - (PROGN (* UNINTERRUPTABLY) - (SETQ NEXTPC (ffetch (PIECE NEXTPIECE) of PC)) - (* LET ((PCNODE (FETCH - (PIECE PTREENODE) OF PC))) - (* ;; - "Update the length of the original piece in it's tree entry.") - (for ITEM# from 0 by 4 as I from 1 to - (fetch (BTREENODE COUNT) of PCNODE) - when (EQ (\GETBASEPTR PCNODE ITEM#) PC) - do (* ;; "FIXME - I think this can be done as aport of \INSERTPIECE / \INSERTTREEE, by looking back 1 from the OLD entry and updating. --JDS") - (\PUTBASEFIXP PCNODE - (IPLUS ITEM# 2) (fetch - (PIECE PLEN) of PC)) - (RETURN))) - (\INSERTPIECE NEWPC (OR NEXTPC 'LASTPIECE) - TEXTOBJ NIL NIL (IMINUS (fetch (PIECE PLEN) of NEWPC)) - PC) - - (* ;; "update nextlink and prevlink") - - (COND - ((NULL NEXTPC) (* ; "PC is last piece (not LASTPIECE)") - (* ; "NEWPC is new last piece.") - (replace (PIECE NEXTPIECE) of NEWPC with NIL)) - (T (replace (PIECE NEXTPIECE) of NEWPC with NEXTPC) - (replace (PIECE PREVPIECE) of NEXTPC with NEWPC))) - (replace (PIECE NEXTPIECE) of PC with NEWPC) - (replace (PIECE PREVPIECE) of NEWPC with PC)) - (* ; "Now set its starting CH#") - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Whenever you split a piece, you can't add to it anymore.") - (RETURN NEWPC]) - -(\INSERT.FIRST.PIECE - [LAMBDA (TEXTOBJ) (* ; "Edited 31-May-91 14:00 by jds") - - (* ;; "Insert 1st piece to empty PCTB.") - - (PROG (PC) - (\INSERTPIECE [SETQ PC (\CREATEPIECEORSTREAM NIL (CHARLOOKS.FROM.FONT DEFAULTFONT) - (COND - (TEXTOBJ (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ)) - (T (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC] - NIL TEXTOBJ) - (replace (TEXTOBJ \INSERTPC) of TEXTOBJ with PC) - (replace (PIECE PSTR) of PC with (freplace (TEXTOBJ \INSERTSTRING) of TEXTOBJ - with (ALLOCSTRING 512]) -) - - - -(* ; "Generic-IO type operations support") - -(DEFINEQ - -(\TEXTCLOSEF - [LAMBDA (STREAM) (* ; "Edited 15-Apr-93 16:43 by jds") - (* ; - "Close the files underlying a stream") - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - PCTB PC) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - [OR (ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (COND - ((TYPE? PIECE (SETQ PC (\GETBASEPTR (\FIRSTNODE PCTB) - 0))) - (fetch (PIECE PFILE) of PC) - (CLOSEF? (fetch (PIECE PFILE) of PC)) - (SETQ PC (FETCH (PIECE NEXTPIECE) OF PC)) - (WHILE PC DO (AND (fetch (PIECE PFILE) of PC) - (CLOSEF? (fetch (PIECE PFILE) of PC))) - (SETQ PC (FETCH (PIECE NEXTPIECE) OF PC] - - (* ;; "And close the REAL file as well, in case we'd made a local cache.") - - (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ]) - -(\TEXTCLOSEF-SUBTREE - [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:00 by jds") - - (* ;; "Run thru the pieces in the document, closing the underlying file") - - (* ;; "by traverse pctree") - - (LET (PC) - (COND - ((NULL PCTREE) - NIL) - (T (SETQ PC (fetch (PCTNODE PCE) of PCTREE)) - (AND (NOT (ATOM PC)) - (fetch (PIECE PFILE) of PC) - (CLOSEF? (fetch (PIECE PFILE) of PC))) - (\TEXTCLOSEF-SUBTREE (fetch (PCTNODE LO) of PCTREE)) - (\TEXTCLOSEF-SUBTREE (fetch (PCTNODE HI) of PCTREE]) - -(\TEXTDSPFONT - [LAMBDA (STREAM NEWFONT) (* ; "Edited 31-May-91 14:02 by jds") - - (* ;; "Set the font for a TEdit window. Need change the caret looks, for character insertion, and the WINDOW's looks, so that TEXEC type-out to the window does the right thing.") - - (LET ((TEXTOBJ (TEXTOBJ STREAM))) - (PROG1 (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) - [COND - (NEWFONT - - (* ;; "Only do this if there's a new font to set:") - - (TEDIT.CARETLOOKS STREAM (\GETFONTDESC NEWFONT 'DISPLAY)) - (COND - ((fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - - (* ;; "Update the windows, if there are any.") - - (for WIN in (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - do (DSPFONT NEWFONT WIN])]) - -(\TEXTEOFP - [LAMBDA (STREAM) (* ; "Edited 31-May-91 14:18 by jds") - - (* ;; "Test for EOF on a text stream: At end of a piece, and there's no more pieces.") - - (OR (NOT (fetch (TEXTSTREAM PIECE) of STREAM)) - (EQ (fetch (TEXTSTREAM PIECE) of STREAM) - 'LASTPIECE) - (AND (IEQP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) - (ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) - (OR (NOT (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) of STREAM))) - (bind (PC _ (fetch (PIECE NEXTPIECE) of (fetch (TEXTSTREAM PIECE) of STREAM))) - while PC do (COND - ((NOT (ZEROP (fetch (PIECE PLEN) of PC))) - (RETURN NIL))) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC)) finally (RETURN T]) - -(\TEXTGETEOFPTR - [LAMBDA (STREAM) (* ; "Edited 31-May-91 13:58 by jds") - (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) - -(\TEXTGETFILEPTR - [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") - - (* ;; "GETFILEPTR fn for text streams.") - - (PROG ((PC (fetch (TEXTSTREAM PIECE) of STREAM)) - (CHARSLEFT (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) - (OFFSET (fetch (STREAM COFFSET) of STREAM)) - (LIMIT (fetch (STREAM CBUFSIZE) of STREAM)) - PLEN) - (COND - ((EQ PC 'LASTPIECE) (* ; "STREAM is Empty Document") - (RETURN 0)) - [PC (* ; - "There's a piece. That means he's inside the file somewhere.") - (SETQ PLEN (fetch (PIECE PLEN) of PC)) - (RETURN (IMIN [SUB1 (IPLUS (\TEDIT.PIECE-CHNO PC) - (IDIFFERENCE PLEN CHARSLEFT) - (COND - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "This is a 16-bit stream; The difference is in BYTES, and needs to be divided by 2 to get chars") - (IQUOTIENT (IDIFFERENCE OFFSET LIMIT) - 2)) - (T (IDIFFERENCE OFFSET LIMIT] - (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM] - (T (* ; - "Lack of a current piece means he walked off the end.") - (RETURN (IMAX 1 (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) - -(\TEXTOPENF - [LAMBDA (STREAM ACCESS ASDF QWER ZXCV) (* ; "Edited 31-May-91 13:58 by jds") - (* Return the stream, opened for input) - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - PCTB PC) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) - (\TEXTOPENF-SUBTREE (fetch (PCTNODE HI) of PCTB)) - - (* ;; "(for I from (ADD1 \FirstPieceOffset) to (SUB1 (\EDITELT PCTB \PCTBLastPieceOffset)) by \EltsPerPiece do (SETQ PC (\EDITELT PCTB I)) (COND ((AND (fetch PFILE of PC) (EQ (fetch ACCESSBITS of (fetch PFILE of PC)) NoBits)) (\TEDIT.REOPEN.STREAM STREAM (fetch PFILE of PC)))))") - - (RETURN STREAM]) - -(\TEXTOPENF-SUBTREE - [LAMBDA (PCTREE) (* ; "Edited 31-May-91 14:19 by jds") - (LET (PC) - (COND - ((NULL PCTREE) - NIL) - (T (SETQ PC (fetch (PCTNODE PCE) of PCTREE)) - [COND - ((AND (fetch (PIECE PFILE) of PC) - (EQ (fetch (STREAM ACCESSBITS) of (fetch (PIECE PFILE) of PC)) - NoBits)) - (\TEDIT.REOPEN.STREAM STREAM (fetch (PIECE PFILE) of PC] - (\TEXTOPENF-SUBTREE (fetch (PCTNODE LO) of PCTREE)) - (\TEXTOPENF-SUBTREE (fetch (PCTNODE HI) of PCTREE]) - -(\TEXTOUTCHARFN - [LAMBDA (CH STREAM) (* ; "Edited 31-May-91 13:59 by jds") - (\INSERTCH CH (fetch (TEXTOBJ TEXTLEN) of (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (fetch (TEXTSTREAM TEXTOBJ) of STREAM]) - -(\TEXTBACKFILEPTR - [LAMBDA (STREAM) (* ; "Edited 28-Mar-94 15:32 by jds") - - (* ;; "Use this to BACKFILEPTR a text stream.") - - [PROG (PC PS PF REALFILE) - (COND - [(AND (IEQP (fetch (STREAM CPAGE) of STREAM) - (fetch (TEXTSTREAM PCSTARTPG) of STREAM)) - (IEQP (fetch (STREAM COFFSET) of STREAM) - (fetch (TEXTSTREAM PCSTARTCH) of STREAM))) - (* ; - "Hit start of piece; back to PREVPIECE & keep going.") - [SETQ PC (replace (TEXTSTREAM PIECE) of STREAM with (fetch (PIECE PREVPIECE) - of (fetch (TEXTSTREAM PIECE) - of STREAM] - (* ; "Move to previous piece") - (replace (STREAM BINABLE) of STREAM with T) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) - (* add (fetch (TEXTSTREAM PCNO) of - STREAM) -1) - (while (AND PC (ZEROP (fetch (PIECE PLEN) of PC))) do - (* ; - "Skip over any zero-length pieces as we back along.") - (SETQ PC (fetch (PIECE PREVPIECE) - of PC))) - (COND - [PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM with (\TEDIT.APPLY.STYLES - (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM))) - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC))(* ; "This piece lives in a string.") - (\TEDIT.TEXTBIN.STRINGSETUP (SUB1 (fetch (PIECE PLEN) of PC)) - 1 STREAM PS) - - (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.") - - ) - ((SETQ PF (fetch (PIECE PFILE) of PC)) - (* ; "This piece lives on a file.") - (\TEDIT.TEXTBIN.FILESETUP PC (SUB1 (fetch (PIECE PLEN) of PC)) - 1 STREAM PF (fetch (PIECE PFATP) of PC) - 'PEEKBIN)) - ((fetch (PIECE POBJ) of PC) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0)) - (T (ERROR "CAN'T GET TO NEXT PIECE"] - (T (ERROR "Trying to BACKFILEPTR thru start of text."] - ((ZEROP (fetch (STREAM COFFSET) of STREAM)) (* ; "Move back 1 file page") - (SETQ REALFILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IPLUS (fetch (TEXTSTREAM CHARSLEFT) - of STREAM) - (fetch (STREAM CBUFSIZE) - of STREAM))) - (replace (STREAM COFFSET) of REALFILE with 0) - (COND - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) (* ; - "16 bit stream, so back up 2 bytes.") - (\BACKFILEPTR REALFILE) - (\BACKFILEPTR REALFILE)) - (T (\BACKFILEPTR REALFILE))) - (\PEEKBIN REALFILE) - (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of REALFILE)) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of REALFILE)) - (replace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM CBUFSIZE) of REALFILE)) - (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of REALFILE))) - (T (* ; "JUST ACT CASUAL & DO IT.") - (COND - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM)(* ; - "16 bit stream, so back up 2 bytes.") - (\PAGEDBACKFILEPTR STREAM) - (\PAGEDBACKFILEPTR STREAM)) - (T (\PAGEDBACKFILEPTR STREAM] - T]) - -(\TEXTBOUT - [LAMBDA (STREAM BYTE) (* ; "Edited 10-May-93 16:59 by jds") - (* ; - "Do BOUT to a text stream, which is an insertion at the caret.") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM)) - (CH# (ADD1 (\TEXTGETFILEPTR STREAM))) - WINDOW TEXTLEN PS PC PSTR OFFST) - (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - (SETQ WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (AND WINDOW (\TEDIT.MARK.LINES.DIRTY TEXTOBJ CH# CH#)) - (\INSERTCH BYTE CH# TEXTOBJ) - (AND WINDOW (TEDIT.UPDATE.SCREEN TEXTOBJ)) - (AND (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (RETURN)) (* ; - "If teh stream is readonly, nothing happened!") - [SETQ PS (ffetch (PIECE PSTR) of (SETQ PC (fetch (TEXTOBJ \INSERTPC) of TEXTOBJ] - (* ; "This piece resides in a STRING.") - (replace (TEXTSTREAM PIECE) of STREAM with PC) - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) - (LRSH (SETQ OFFST (ffetch (STRINGP OFFST) - of PS)) - 1))) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (STREAM COFFSET) of STREAM with (IPLUS (freplace (TEXTSTREAM PCSTARTCH) - of STREAM with (LOGAND 1 OFFST)) - (fetch (TEXTOBJ \INSERTLEN) of TEXTOBJ))) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) (* ; - "Page # within the 'file' where this piece starts") - (freplace (STREAM CBUFSIZE) of STREAM with (fetch (STREAM COFFSET) of STREAM)) - (freplace (STREAM EPAGE) of STREAM with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (freplace (TEXTSTREAM REALFILE) of STREAM with NIL]) - -(\TEDITOUTCCODEFN - [LAMBDA (STREAM CHARCODE) (* ; "Edited 12-Oct-2021 15:38 by rmk:") - - (* ;; "OUTCCODEFN for TEdit streams -- always BOUTs the character, because TEdit streams deal in complete charcodes rather than bytes (via \TEXTBOUT). BUT -- does update the CHARPOSITION of the stream, which is used by some code to decide things.") - - (COND - ((EQ CHARCODE (CHARCODE EOL)) - (\BOUT STREAM (CHARCODE CR)) - (freplace (STREAM CHARPOSITION) of STREAM with 0)) - (T (\BOUT STREAM CHARCODE) - (freplace (STREAM CHARPOSITION) of STREAM with (PROGN - (* ; "Ugh. Don't overflow") - (IPLUS16 (ffetch (STREAM CHARPOSITION - ) - of STREAM) - 1]) - -(\TEXTSETEOF - [LAMBDA (STREAM EOFPTR) (* ; "Edited 31-May-91 14:19 by jds") - (* Set the EPAGE/EOFFSET of the stream - to be (SUB1 of EOFPTR)) - (replace (STREAM EPAGE) of STREAM with (fetch (BYTEPTR PAGE) of EOFPTR)) - (replace (STREAM EOFFSET) of STREAM with (fetch (BYTEPTR OFFSET) of EOFPTR]) - -(\TEXTSETFILEPTR - [LAMBDA (STREAM FILEPOS) (* ; "Edited 22-Apr-93 13:44 by jds") - (* ; - "Sets the file ptr for a text stream.") - (PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of STREAM))) - (COND - ((ZEROP (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - ((OR (IEQP FILEPOS -1) - (IEQP FILEPOS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; "Means end of file") - (\SETUPGETCH (IMAX 1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - TEXTOBJ) - (\BIN STREAM)) - ((OR (ILESSP FILEPOS 0) - (IGREATERP FILEPOS (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* ; - "If the fileptr is not within the text, punt.") - (\ILLEGAL.ARG FILEPOS)) - (T (\SETUPGETCH (IMAX 1 (ADD1 FILEPOS)) - TEXTOBJ]) - -(\TEXTDSPXPOSITION - [LAMBDA (STREAM XPOSITION) (* ; "Edited 3-Jan-2001 17:27 by rmk:") - (* ; - "Edited 24-Oct-88 23:09 by rmk:; Edited 26-Sep-85 16:30 by ajb:") - - (* ;; - "Simply returns the XPOSITION of the primary window's display stream, this is a read-only function") - - (LET [(WINDOW (CAR (fetch \WINDOW of (TEXTOBJ STREAM] - (COND - (WINDOW (DSPXPOSITION NIL WINDOW)) - (T (* ; - "If there is no window, estimate from character position") - (TIMES (CHARWIDTH (CHARCODE SPACE) - STREAM) - (POSITION STREAM]) - -(\TEXTDSPYPOSITION - [LAMBDA (STREAM YPOSITION) (* ; "Edited 31-May-91 13:59 by jds") - - (* Simply returns the XPOSITION of the primary window's display stream, this is a - read-only function) - - (LET [(WINDOW (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM] - (IF WINDOW - THEN (DSPYPOSITION NIL WINDOW) - ELSE (AND \#DISPLAYLINES (NEQ \CURRENTDISPLAYLINE -1) - (DIFFERENCE \#DISPLAYLINES \CURRENTDISPLAYLINE]) - -(\TEXTLEFTMARGIN - [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") - -(* ;;; "Returns the left margin of the textstream. This is a read-only function") - - (IF (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM))) - THEN [IPLUS 8 (fetch (FMTSPEC LEFTMAR) of (fetch (TEXTOBJ FMTSPEC) of (TEXTOBJ STREAM] - ELSE 0]) - -(\TEXTRIGHTMARGIN - [LAMBDA (STREAM XPOSITION) (* ; "Edited 31-May-91 14:03 by jds") - -(* ;;; "Returns the right margin of the textstream. This is a read-only function") - - (LET ((TEXTOBJ (TEXTOBJ STREAM))) - (IF (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) - THEN (LET [(RIGHTMAR (fetch (FMTSPEC RIGHTMAR) of (fetch (TEXTOBJ FMTSPEC) of TEXTOBJ] - (IF (ZEROP RIGHTMAR) - THEN (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - ELSE RIGHTMAR)) - ELSE (TIMES (CHARWIDTH (CHARCODE A) - STREAM) - (LINELENGTH NIL STREAM]) - -(\TEXTDSPCHARWIDTH - [LAMBDA (STREAM CHARCODE) (* ; "Edited 9-Feb-99 12:59 by kaplan") - (CHARWIDTH CHARCODE (DSPFONT NIL STREAM]) - -(\TEXTDSPSTRINGWIDTH - [LAMBDA (STREAM STRING) (* ; "Edited 9-Feb-99 13:00 by kaplan") - (STRINGWIDTH STRING (DSPFONT NIL STREAM]) - -(\TEXTDSPLINEFEED - [LAMBDA (STREAM VALUE) - (FONTPROP (DSPFONT NIL STREAM) - 'HEIGHT]) -) -(DEFINEQ - -(\TEXTBIN - [LAMBDA (STREAM) - - (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return value of OBJECTCHAR property for image objecdts") - - (* ;; "Edited 28-Mar-94 15:33 by jds") - -(* ;;; "Do BIN slow case for a text stream") - (* ; - "NB that PEEKBIN and BACKFILEPTR need to track changes in this code") - (DECLARE (LOCALVARS . T)) - (LET (BYTE) (* ; - "RMK: Capture all return values for any special imageobject coercion") - [SETQ BYTE (PROG (CH FILE STR PF PS PC PO NPC OPC SUBSTREAM) - (COND - [(ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) - (* ; - "Simple case -- just do the usual BIN") - (COND - [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) - of STREAM))) - (* ; "Handle objects specially") - (COND - ((SETQ SUBSTREAM (IMAGEOBJPROP PO 'SUBSTREAM)) - (* ; - "If this object has a substream in it, go to that substream") - (add (fetch (STREAM COFFSET) of STREAM) - 1) - (RETURN (\BIN SUBSTREAM))) - (T - (* ;; "Otherwise, just return the object as BIN's result, and make sure we'll go to the next page next time.") - - (replace (STREAM COFFSET) of STREAM - with (fetch (STREAM CBUFSIZE) of STREAM)) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (RETURN PO] - [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "This is a 16 bit BIN. grab 2 bytes.") - (* ; - "WHAT HAPPENS IF THE SECOND BYTE IS ON ANOTHER PAGE??") - (RETURN (LOGOR (UNFOLD (\PAGEDBIN STREAM) - 256) - (COND - ((ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) - (* ; - "This pair of characters doesn't straddle a file page bound. Just grab the next char.") - (\PAGEDBIN STREAM)) - (T (* ; - "Need to move to the next page on the backing file. Doing so also grabs the next character.") - (\TEDIT.TEXTBIN.NEW.PAGE STREAM T] - (T (RETURN (\PAGEDBIN STREAM] - (T (* ; - "We've either hit a page bound in a file, or a piece bound.") - (RETURN (COND - [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) - (* ; "Time for a new piece.") - [repeatwhile (AND PC (ZEROP (fetch (PIECE PLEN) - of PC))) - do (* ; - "Skip over any zero-length pieces at the end of the file.") - (SETQ OPC (fetch (TEXTSTREAM PIECE) of STREAM)) - (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM - with (AND OPC (fetch (PIECE NEXTPIECE) - of OPC] - (replace (STREAM BINABLE) of STREAM with T) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL) - (* ; - "Move to the next piece in the chain") - (COND - [PC (* ; "There IS a next piece to move to.") - (AND (fetch (TEXTSTREAM LOOKSUPDATEFN) - of STREAM) - (SETQ NPC (APPLY* (fetch (TEXTSTREAM - LOOKSUPDATEFN - ) - of STREAM) - STREAM PC)) - (replace (TEXTSTREAM PIECE) of STREAM - with (SETQ PC NPC))) - (* ; - "Take care of any piece-change uproar. uproar -- which may include picking a new piece to go to.") - [COND - (NPC (* ; - "If we got an NPC, this was taken care of by the LOOKSUPDATEFN") - ) - ([AND (SETQ PO (fetch (PIECE POBJ) of PC)) - (SETQ SUBSTREAM (IMAGEOBJPROP - PO - 'SUBSTREAM] - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTPARALOOKS) - of STREAM with (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) of SUBSTREAM - )) - (replace (TEXTSTREAM CURRENTLOOKS) - of STREAM with (fetch (TEXTSTREAM - CURRENTLOOKS) - of SUBSTREAM))) - [(NEQ (fetch (PIECE PPARALOOKS) of OPC) - (fetch (PIECE PPARALOOKS) of PC)) - (replace (TEXTSTREAM CURRENTPARALOOKS) - of STREAM with (\TEDIT.APPLY.PARASTYLES - (fetch (PIECE PPARALOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM))) - (replace (TEXTSTREAM CURRENTLOOKS) - of STREAM with (\TEDIT.APPLY.STYLES - (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] - ((NOT (EQCLOOKS (fetch (PIECE PLOOKS) - of PC) - (fetch (PIECE PLOOKS) of OPC))) - (replace (TEXTSTREAM CURRENTLOOKS) - of STREAM with (\TEDIT.APPLY.STYLES - (fetch (PIECE PLOOKS) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM] - (COND - ((SETQ PS (fetch (PIECE PSTR) of PC)) - (* ; "This piece lives in a string.") - (\TEDIT.TEXTBIN.STRINGSETUP - 0 - (fetch (PIECE PLEN) of PC) - STREAM PS) - - (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.") - (* ; - "Then actually grab the next character to hand back to the caller.") - (\BIN STREAM)) - ((SETQ PF (fetch (PIECE PFILE) of PC)) - (* ; "This piece lives on a file.") - (\TEDIT.TEXTBIN.FILESETUP PC 0 - (fetch (PIECE PLEN) of PC) - STREAM PF (fetch (PIECE PFATP) - of PC) - 'PEEKBIN) - (\BIN STREAM)) - [(SETQ PO (fetch (PIECE POBJ) of PC)) - (replace (STREAM BINABLE) of STREAM - with NIL) - (COND - (SUBSTREAM - (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM - TEXTOBJ) - of SUBSTREAM)) - (freplace (STREAM COFFSET) - of STREAM with 0) - (freplace (TEXTSTREAM CHARSLEFT) - of STREAM - with (fetch (PIECE PLEN) - of PC)) - (freplace (STREAM CBUFSIZE) - of STREAM - with (fetch (PIECE PLEN) - of PC)) - (freplace (STREAM CPAGE) - of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) - of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTPG) - of STREAM with 0) - (replace (TEXTSTREAM - CURRENTPARALOOKS) - of STREAM - with (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) of SUBSTREAM - )) - (replace (TEXTSTREAM CURRENTLOOKS) - of STREAM - with (fetch (TEXTSTREAM - CURRENTLOOKS) - of SUBSTREAM)) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) - of STREAM with 0) - (RETURN PO] - (T (ERROR "CAN'T GET TO NEXT PIECE"] - (T (* ; - "There are no more pieces. Punt gracefully") - (COND - ((fetch (STREAM ENDOFSTREAMOP) of STREAM) - (* ; - "If there's an EOF handler, call it & return the result") - (RETURN (APPLY* (fetch (STREAM ENDOFSTREAMOP) - of STREAM) - STREAM))) - (T (* ; "Otherwise, return NIL") - (RETURN NIL] - [(SETQ PO (fetch (PIECE POBJ) of (fetch (TEXTSTREAM PIECE) - of STREAM))) - (* ; "This is an object") - (replace (STREAM BINABLE) of STREAM with NIL) - (COND - (SUBSTREAM (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM TEXTOBJ) - of SUBSTREAM)) - (freplace (STREAM COFFSET) of STREAM - with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM - with 0) - (freplace (STREAM CBUFSIZE) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM - with 1) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM - with 0) - (replace (TEXTSTREAM CURRENTPARALOOKS) - of STREAM with (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) of SUBSTREAM) - ) - (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (fetch (TEXTSTREAM CURRENTLOOKS) - of SUBSTREAM)) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) of STREAM - with 0) - (RETURN PO] - (T (* ; - "Need to move to the next page in a file.") - (RETURN (\TEDIT.TEXTBIN.NEW.PAGE STREAM] - (IF (IMAGEOBJP BYTE) - THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM) - 'OBJECTBYTE) - BYTE) - ELSE BYTE]) - -(\TEDIT.TEXTBIN.STRINGSETUP - [LAMBDA (CHOFFSET CHARSLEFT STREAM PS) (* ; "Edited 31-May-91 14:21 by jds") - (PROG (OFFST) - (COND - ((fetch (STRINGP FATSTRINGP) of PS) - - (* The string is FAT. Therefore, make all the offsets and things take account of - the fact that each char is really 2 bytes.) - - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) - (ffetch (STRINGP OFFST) of PS))) - - (* The char page ptr can point to the real first char, since it's a word.) - - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (STREAM COFFSET) of STREAM with (UNFOLD CHOFFSET 2)) - (* Offset into the string, in bytes. - That 2 should really be something like - BYTESPERFATCHAR.) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (* Page %# within the "file" where - this piece starts) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with 0) - (* Char within "page" where the piece - starts (for BACKFILEPTR)) - (freplace (STREAM CBUFSIZE) of STREAM with (IPLUS (UNFOLD CHARSLEFT 2) - (ffetch (STREAM COFFSET) of STREAM))) - (* Since the chars-left field is - words, and we're talking bytes.) - (freplace (STREAM EPAGE) of STREAM with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - - (* When we hit the end of the string, we'll have run out off the piece, too.) - - (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) - (replace (STREAM BINABLE) of STREAM with NIL) (* To force BINs thru the \TEXTBIN - function so we can get two bytes.) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with T) - (* And mark the stream as having wide - characters, so \TEXTBIN knows what to - do.) - ) - (T (* Characters are thin in this string - (the usual case)) - (freplace (STREAM CPPTR) of STREAM with (ADDBASE (ffetch (STRINGP BASE) of PS) - (LRSH (SETQ OFFST (ffetch (STRINGP - OFFST) - of PS)) - 1))) - (freplace (STREAM CPAGE) of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTPG) of STREAM with 0) - (* Page %# within the "file" where - this piece starts) - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with (LOGAND 1 OFFST)) - (* Char within "page" where the piece - starts (for BACKFILEPTR)) - (freplace (STREAM COFFSET) of STREAM with (IPLUS (LOGAND 1 OFFST) - CHOFFSET)) - (freplace (STREAM CBUFSIZE) of STREAM with (IPLUS CHARSLEFT (ffetch (STREAM COFFSET) - of STREAM))) - (freplace (STREAM EPAGE) of STREAM with 1) - (freplace (TEXTSTREAM CHARSLEFT) of STREAM with 0) - (freplace (TEXTSTREAM REALFILE) of STREAM with NIL) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with NIL]) - -(\TEDIT.TEXTBIN.FILESETUP - [LAMBDA (PC CHOFFSET CHARSLEFT STREAM PF FATP OPERATION NOERRORFLG) - (* ; "Edited 8-Jun-99 23:37 by rmk:") - (* ; "Edited 8-Jun-99 23:33 by rmk:") - (* ; "Edited 8-Jun-99 23:32 by rmk:") - (* ; "Edited 15-Apr-93 15:53 by jds") - (* ; - "Do the setup needed to make a text stream read from a file.") - (PROG ((BYTESLEFT (COND - (FATP (UNFOLD CHARSLEFT 2)) - (T CHARSLEFT))) - (BYTEOFFSET (COND - (FATP (UNFOLD CHOFFSET 2)) - (T CHOFFSET))) - CH FPOS) - [COND - ((IEQP (ffetch (STREAM ACCESSBITS) of PF) - NoBits) (* ; "ASSURE THAT THE FILE IS OPEN") - (SETQ PF (\TEDIT.REOPEN.STREAM STREAM PF] - [freplace (TEXTSTREAM PCSTARTPG) of STREAM with (ffetch (BYTEPTR PAGE) - of (SETQ FPOS (ffetch (PIECE PFPOS) - of PC] - (* ; - "Page within the file where the piece starts") - (freplace (TEXTSTREAM PCSTARTCH) of STREAM with (ffetch (BYTEPTR OFFSET) of FPOS)) - (* ; - "Char within the page where it starts.") - (SETFILEPTR PF (IPLUS FPOS BYTEOFFSET)) - [COND - ((ZEROP (GETEOFPTR PF)) (* ; - "For zero-length files, do nothing.") - ) - ((ILESSP (IPLUS FPOS BYTEOFFSET) - (GETEOFPTR PF)) (* ; - "Only get the next character if we aren't positioning past the end of the file.") - (SETQ CH (IF (EQ OPERATION 'BIN) - THEN (CL:IF FATP - (LOGOR (UNFOLD (\PAGEDBIN PF) - 256) - (\PAGEDPEEKBIN PF NOERRORFLG)) - (\BIN PF)) - ELSE (CL:IF FATP - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PF) - 256) - (\PAGEDPEEKBIN PF NOERRORFLG)) - (\PAGEDBACKFILEPTR PF)) - (\PEEKBIN PF NOERRORFLG))] - -(* ;;; "Move all the relevant fields from the backing file's stream into the text stream, so that microcoded BINs will do the right thing.") - - (freplace (STREAM CPPTR) of STREAM with (ffetch (STREAM CPPTR) of PF)) - (freplace (STREAM CPAGE) of STREAM with (ffetch (STREAM CPAGE) of PF)) - (freplace (STREAM COFFSET) of STREAM with (ffetch (STREAM COFFSET) of PF)) - (freplace (STREAM EPAGE) of STREAM with 32767) - (freplace (STREAM CBUFSIZE) of STREAM with (IMIN (ffetch (STREAM CBUFSIZE) of PF) - (IPLUS (ffetch (STREAM COFFSET) - of PF) - BYTESLEFT))) - [freplace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE BYTESLEFT - (IDIFFERENCE (ffetch (STREAM - CBUFSIZE - ) - of STREAM) - (ffetch (STREAM COFFSET) - of STREAM] - (freplace (TEXTSTREAM REALFILE) of STREAM with PF) - (replace (TEXTSTREAM FATSTREAMP) of STREAM with FATP) - (* ; - "Mark the stream, if it contains fat characters for this piece.") - (replace (STREAM BINABLE) of STREAM with (NOT FATP)) - (* ; - "A stream that has fat chars can't use the micrododed BIN.") - (* ; - "And return the next character in line") - (RETURN CH]) - -(\TEDIT.TEXTBIN.NEW.PAGE - [LAMBDA (STREAM SPLITCHAR) (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 15:10 by rmk:") - (* ; "Edited 11-Jun-99 15:01 by rmk:") - (* ; "Edited 11-Jun-99 15:01 by rmk:") - (* ; "Edited 11-Jun-99 14:18 by rmk:") - (* ; "Edited 31-May-91 14:21 by jds") - - (* * Handle crossing a file-page boundary within TEXTBIN) - - (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte - character, and only need to read the second byte. - Otherwise, this function will read 2 bytes for a fat character.) - - (PROG ((FILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - CH) (* Get the STREAM which describes the - file for real) - [COND - ((IEQP (fetch (STREAM ACCESSBITS) of FILE) - NoBits) (* The file was closed for some - reason; reopen it.) - (SETQ FILE (\GETSTREAM [OPENFILE (fetch (STREAM FULLNAME) of FILE) - 'INPUT NIL '((TYPE TEXT] - 'INPUT] - (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) of FILE)) - (* Force it to do a page switch for us) - (SETQ CH (\BIN FILE)) (* Get the next character in the usual - manner) - (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of FILE)) - (* Steal the fields we need to - simulate that stream) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of FILE)) - (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of FILE)) - (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT) of STREAM) - (fetch (STREAM CBUFSIZE) of FILE))) - (* Can't read farther than - end-of-piece, tho) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) - of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM))) - (COND - [(AND (fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (NOT SPLITCHAR)) - - (* This piece contains fat characters. Need to grab a second byte from the file, - and construct a 16-bit character) - - (RETURN (LOGOR (UNFOLD CH 256) - (\PAGEDBIN STREAM] - (T (* Regular, 8-bit characters. - Just return the one we BINned.) - - (* or we only need the second byte, since the first byte was on the prior page.) - - (RETURN CH]) -) -(DEFINEQ - -(\TEXTPEEKBIN - [LAMBDA (STREAM NOERRORFLG) - - (* ;; "Edited 22-Dec-2021 10:29 by rmk: Return OBJECTCHAR for image objects, if present") - - (* ;; "Edited 28-Mar-94 15:34 by jds") - (* ; "DO PEEKBIN for a text stream") - (LET (BYTE) (* ; - "BYTE to capture all returns for imageobject coercion") - [SETQ BYTE (PROG (CH FILE STR PF PS PC PO SUBSTREAM) - (SETQ PC (fetch (TEXTSTREAM PIECE) of STREAM)) - (COND - [(ILESSP (fetch (STREAM COFFSET) of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM)) - (* ; - "Simple case -- just do the usual PEEKBIN") - (COND - ((AND PC (SETQ PO (fetch (PIECE POBJ) of PC))) - (RETURN PO)) - [(fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (* ; - "This is a 16 bit PEEKBIN. Grab two chars...") - (RETURN (COND - [(\EOFP STREAM) - (COND - (NOERRORFLG NIL) - (T (\PEEKBIN STREAM] - ((ILESSP (fetch (STREAM COFFSET) of STREAM) - (SUB1 (fetch (STREAM CBUFSIZE) of STREAM))) - (* ; - "We're sure of staying on the same page. Just grab the characters") - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN STREAM) - 256) - (\PAGEDPEEKBIN STREAM NOERRORFLG)) - (\PAGEDBACKFILEPTR STREAM))) - (T (SETQ PS (fetch (STREAM F1) of STREAM)) - (replace (STREAM COFFSET) of PS - with (fetch (STREAM COFFSET) of STREAM)) - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN PS) - 256) - (\PAGEDPEEKBIN PS NOERRORFLG)) - (\PAGEDBACKFILEPTR PS] - (T (RETURN (\PAGEDPEEKBIN STREAM NOERRORFLG] - [PC (* ; - "We've either hit a page bound in a file, or a piece bound.") - (RETURN (COND - [(ZEROP (fetch (TEXTSTREAM CHARSLEFT) of STREAM)) - (* ; "Time for a new piece.") - (SETQ PC (replace (TEXTSTREAM PIECE) of STREAM - with (fetch (PIECE NEXTPIECE) of PC))) - (* ; - "Move to the next piece in the chain") - (COND - [PC (replace (TEXTSTREAM CURRENTLOOKS) of STREAM - with (\TEDIT.APPLY.STYLES (fetch (PIECE PLOOKS - ) - of PC) - PC - (fetch (TEXTSTREAM TEXTOBJ) - of STREAM))) - (COND - [(SETQ PO (fetch (PIECE POBJ) of PC)) - (replace (STREAM BINABLE) of STREAM - with NIL) - (freplace (STREAM CBUFSIZE) of STREAM - with (fetch (PIECE PLEN) of PC)) - (freplace (STREAM COFFSET) of STREAM - with 0) - (COND - (SUBSTREAM - (* ; - "There is a stream below this one, to feed chars upward.") - (\SETUPGETCH 1 (fetch (TEXTSTREAM - TEXTOBJ) - of SUBSTREAM)) - (freplace (TEXTSTREAM CHARSLEFT) - of STREAM - with (fetch (PIECE PLEN) - of PC)) - (freplace (STREAM CPAGE) - of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTCH) - of STREAM with 0) - (freplace (TEXTSTREAM PCSTARTPG) - of STREAM with 0) - (replace (TEXTSTREAM - CURRENTPARALOOKS) - of STREAM - with (fetch (TEXTSTREAM - CURRENTPARALOOKS - ) - of SUBSTREAM)) - (replace (TEXTSTREAM CURRENTLOOKS) - of STREAM - with (fetch (TEXTSTREAM - CURRENTLOOKS) - of SUBSTREAM)) - (RETURN (\BIN SUBSTREAM))) - (T (replace (TEXTSTREAM CHARSLEFT) - of STREAM with 0) - (RETURN PO] - ((SETQ PS (fetch (PIECE PSTR) of PC)) - (* ; "This piece lives in a string.") - (\TEDIT.TEXTBIN.STRINGSETUP - 0 - (fetch (PIECE PLEN) of PC) - STREAM PS) - - (* ;; "Set the stream up so that it will use PS for BINs, starting at offset 0 (the front of the piece), and will run for as many chars as there are in the piece.") - - (\PEEKBIN STREAM NOERRORFLG)) - ((SETQ PF (fetch (PIECE PFILE) of PC)) - (* ; "This piece lives on a file.") - (\TEDIT.TEXTBIN.FILESETUP PC 0 - (fetch (PIECE PLEN) of PC) - STREAM PF (fetch (PIECE PFATP) - of PC) - 'PEEKBIN NOERRORFLG)) - (T (ERROR "CAN'T GET TO NEXT PIECE"] - (NOERRORFLG (* ; - "There are no more pieces. Punt gracefully") - (RETURN NIL)) - (T (* ; "He wants it the hard way.") - (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) - STREAM] - (T (* ; - "Need to move to the next page in a file.") - (RETURN (\TEDIT.PEEKBIN.NEW.PAGE STREAM NOERRORFLG] - (NOERRORFLG (* ; - "There are no more pieces. Punt gracefully") - (RETURN NIL)) - (T (* ; "He wants it the hard way.") - (APPLY* (fetch (STREAM ENDOFSTREAMOP) of STREAM) - STREAM] - (IF (IMAGEOBJP BYTE) - THEN (OR (GETTEXTPROP (FETCH (TEXTSTREAM TEXTOBJ) OF STREAM) - 'OBJECTBYTE) - BYTE) - ELSE BYTE]) - -(\TEDIT.PEEKBIN.NEW.PAGE - [LAMBDA (STREAM NOERRORFLG) (* ; "Edited 11-Jun-99 15:11 by rmk:") - (* ; "Edited 31-May-91 14:21 by jds") - - (* * Handle crossing a file-page boundary within \TEXTPEEKBIN) - - (* If SPLITCHAR is non-NIL, we've already read the first byte of a two-byte - character, and only need to read the second byte. - Otherwise, this function will read 2 bytes for a fat character.) - - (PROG ((FILE (fetch (TEXTSTREAM REALFILE) of STREAM)) - CH) (* Get the STREAM which describes the - file for real) - [COND - ((IEQP (fetch (STREAM ACCESSBITS) of FILE) - NoBits) (* The file was closed for some - reason; reopen it.) - (SETQ FILE (\GETSTREAM [OPENFILE (fetch (STREAM FULLNAME) of FILE) - 'INPUT NIL '((TYPE TEXT] - 'INPUT] - (replace (STREAM COFFSET) of FILE with (fetch (STREAM CBUFSIZE) of FILE)) - (* Force it to do a page switch for us) - [SETQ CH (COND - [(\EOFP FILE) - (COND - (NOERRORFLG NIL) - (T (\PEEKBIN FILE] - ((fetch (TEXTSTREAM FATSTREAMP) of STREAM) - (PROG1 (LOGOR (UNFOLD (\PAGEDBIN FILE) - 256) - (\PAGEDPEEKBIN FILE NOERRORFLG)) - (\PAGEDBACKFILEPTR FILE))) - (T (\PEEKBIN FILE NOERRORFLG] (* Get the next character in the usual - manner) - (replace (STREAM CPPTR) of STREAM with (fetch (STREAM CPPTR) of FILE)) - (* Steal the fields we need to - simulate that stream) - (replace (STREAM COFFSET) of STREAM with (fetch (STREAM COFFSET) of FILE)) - (replace (STREAM CPAGE) of STREAM with (fetch (STREAM CPAGE) of FILE)) - (replace (STREAM CBUFSIZE) of STREAM with (IMIN (fetch (TEXTSTREAM CHARSLEFT) of STREAM) - (fetch (STREAM CBUFSIZE) of FILE))) - (* Can't read farther than - end-of-piece, tho) - (replace (TEXTSTREAM CHARSLEFT) of STREAM with (IDIFFERENCE (fetch (TEXTSTREAM CHARSLEFT) - of STREAM) - (fetch (STREAM CBUFSIZE) of STREAM))) - (RETURN CH]) -) - - - -(* ; "Support for TEXTPROP") - -(DEFINEQ - -(CGETTEXTPROP - [LAMBDA (TEXTOBJ PROP) (* ; "Edited 20-Oct-87 12:36 by jds") - - (* ;; "compiles calls on TEXTPROP that are fetching values. This needs to be changed whenever GETTEXTPROP is changed.") - - (SELECTQ PROP - ((READONLY READ-ONLY) - `(fetch (TEXTOBJ TXTREADONLY) of ,TEXTOBJ)) - `(LISTGET (fetch (TEXTOBJ EDITPROPS) of ,TEXTOBJ) - ',PROP]) - -(CTEXTPROP - [LAMBDA (FORMTAIL) (* ; "Edited 31-May-91 13:59 by jds") - - (* ;; "compiles calls to TEXTPROP") - - (COND - ((NULL (CDR FORMTAIL)) (* ; "less that 2 args") - (printout T "Possible error in call to TEXTPROP: less than 2 args" T (LIST 'TEXTPROP FORMTAIL - ) - T) - (CGETTEXTPROP (LIST 'TEXTOBJ (CAR FORMTAIL)) - NIL)) - ((NOT (EQ (CAADR FORMTAIL) - 'QUOTE)) (* ; "property is not quoted.") - 'IGNOREMACRO) - [(NULL (CDDR FORMTAIL)) (* ; "fetching a TEXTPROP property.") - (CGETTEXTPROP (LIST 'TEXTOBJ (CAR FORMTAIL)) - (CADR (CADR FORMTAIL] - (T (* ; "storing a window property") - (LET ((TEXTOBJ (CAR FORMTAIL)) - (PROP (CDADR FORMTAIL)) - (VAL (CADDR FORMTAIL))) - [SELECTQ PROP - ((READONLY READ-ONLY) - `(REPLACE (TEXTOBJ TXTREADONLY) OF ,TEXTOBJ WITH ,VAL)) - `(COND - [(FETCH (TEXTOBJ EDITPROPS) OF (TEXTOBJ ,TEXTOBJ)) - (LISTPUT (FETCH (TEXTOBJ EDITPROPS) OF (TEXTOBJ ,TEXTOBJ)) - ',PROP - ',VAL] - (T (REPLACE (TEXTOBJ EDITPROPS) OF (TEXTOBJ ,TEXTOBJ) - WITH (LIST ,PROP ,VAL] - (LIST 'COND (LIST (LIST 'FETCH 'EDITPROPS 'OF (LIST 'TEXTOBJ (CAR FORMTAIL))) - (LIST 'LISTPUT (LIST 'FETCH 'EDITPROPS 'OF (LIST 'TEXTOBJ - (CAR FORMTAIL))) - (CADR FORMTAIL) - (CADDR FORMTAIL))) - (LIST T (LIST 'REPLACE 'EDITPROPS 'OF (LIST 'TEXTOBJ (CAR FORMTAIL)) - 'WITH - (LIST 'LIST (CADR FORMTAIL) - (CADDR FORMTAIL]) - -(GETTEXTPROP - [LAMBDA (TEXTOBJ PROP) (* ; "Edited 9-Feb-89 11:20 by jds") - - (* ;; "Gets values for document properties. Used by TEXTPROP.") - - (SELECTQ PROP - ((READONLY READ-ONLY) - (FETCH (TEXTOBJ TXTREADONLY) OF TEXTOBJ)) - ((BEING-EDITED ACTIVE) - (FETCH (TEXTOBJ TXTEDITING) OF TEXTOBJ)) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - (FETCH (TEXTOBJ TXTNONSCHARS) OF TEXTOBJ)) - (LISTGET (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ) - PROP]) - -(PUTTEXTPROP - [LAMBDA (TEXTOBJ PROP VALUE) (* ; "Edited 9-Feb-89 11:19 by jds") - (* ; - "put a value on prop list for a textobj") - (SELECTQ PROP - ((READONLY READ-ONLY) - (PROG1 (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (replace (TEXTOBJ TXTREADONLY) of TEXTOBJ with VALUE))) - ((BEING-EDITED ACTIVE) - (PROG1 (fetch (TEXTOBJ TXTEDITING) of TEXTOBJ) - (replace (TEXTOBJ TXTEDITING) of TEXTOBJ with VALUE))) - ((NO-NS-CHARS NONSCHARS NO-NSCHARS) - (PROG1 (fetch (TEXTOBJ TXTNONSCHARS) of TEXTOBJ) - (replace (TEXTOBJ TXTNONSCHARS) of TEXTOBJ with VALUE))) - (COND - ((fetch (TEXTOBJ EDITPROPS) of (TEXTOBJ TEXTOBJ)) - (PROG1 (LISTGET (ffetch (TEXTOBJ EDITPROPS) of (TEXTOBJ TEXTOBJ)) - PROP) - (LISTPUT (ffetch (TEXTOBJ EDITPROPS) of (TEXTOBJ TEXTOBJ)) - PROP VALUE))) - (T (freplace (TEXTOBJ EDITPROPS) of (TEXTOBJ TEXTOBJ) with (LIST PROP VALUE)) - NIL]) - -(TEXTPROP - [LAMBDA X (* ; "Edited 9-Feb-89 11:20 by jds") - - (* ;; "general top level entry for both fetching and setting window properties.") - - (COND - ((IGREATERP X 2) - (PUTTEXTPROP (TEXTOBJ (ARG X 1)) - (ARG X 2) - (ARG X 3))) - ((EQ X 2) - (GETTEXTPROP (TEXTOBJ (ARG X 1)) - (ARG X 2))) - (T (\ILLEGAL.ARG NIL]) -) - - - -(* ;; -"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 TEXTOFD multiple times (as, e.g., in development)" -) - - -(RPAQ? *TEDIT-OLD-STREAM-ERROR-HANDLER* (CONDITION-HANDLER 'XCL:STREAM-NOT-OPEN)) -(DECLARE%: DONTEVAL@LOAD DOCOPY - -(\TEXTINIT) -) -(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS - -(ADDTOVAR NLAMA ) - -(ADDTOVAR NLAML ) - -(ADDTOVAR LAMA TEXTPROP) -) -(DECLARE%: DONTCOPY - (FILEMAP (NIL (2939 51978 (COPYTEXTSTREAM 2949 . 5688) (OPENTEXTSTREAM 5690 . 20957) (REOPENTEXTSTREAM - 20959 . 21385) (TEDIT.STREAMCHANGEDP 21387 . 21689) (TEXTSTREAMP 21691 . 22105) (TXTFILE 22107 . -22560) (\DELETECH 22562 . 32978) (\SETUPGETCH 32980 . 39758) (\TEDIT.REOPEN.STREAM 39760 . 41585) ( -\TEDIT.COPYTEXTSTREAM.PIECEMAPFN 41587 . 44059) (\TEXTINIT 44061 . 50011) (\TEXTMARK 50013 . 50765) ( -\TEXTTTYBOUT 50767 . 51976)) (51979 77528 (\INSERTCH 51989 . 75820) (\INSERTCR 75822 . 77526)) (77594 -96846 (\CHTOPC 77604 . 79056) (\CHTOPCNO 79058 . 80212) (\CLEARPCTB 80214 . 80998) ( -\CREATEPIECEORSTREAM 81000 . 84388) (\DELETEPIECE 84390 . 85309) (\FINDPIECE 85311 . 85683) ( -\INSERTPIECE 85685 . 88451) (\MAKEPCTB 88453 . 90279) (\SPLITPIECE 90281 . 96018) (\INSERT.FIRST.PIECE - 96020 . 96844)) (96898 118873 (\TEXTCLOSEF 96908 . 98122) (\TEXTCLOSEF-SUBTREE 98124 . 98834) ( -\TEXTDSPFONT 98836 . 99832) (\TEXTEOFP 99834 . 100897) (\TEXTGETEOFPTR 100899 . 101113) ( -\TEXTGETFILEPTR 101115 . 103047) (\TEXTOPENF 103049 . 103819) (\TEXTOPENF-SUBTREE 103821 . 104557) ( -\TEXTOUTCHARFN 104559 . 104850) (\TEXTBACKFILEPTR 104852 . 110401) (\TEXTBOUT 110403 . 112957) ( -\TEDITOUTCCODEFN 112959 . 114070) (\TEXTSETEOF 114072 . 114587) (\TEXTSETFILEPTR 114589 . 115822) ( -\TEXTDSPXPOSITION 115824 . 116684) (\TEXTDSPYPOSITION 116686 . 117233) (\TEXTLEFTMARGIN 117235 . -117657) (\TEXTRIGHTMARGIN 117659 . 118407) (\TEXTDSPCHARWIDTH 118409 . 118586) (\TEXTDSPSTRINGWIDTH -118588 . 118767) (\TEXTDSPLINEFEED 118769 . 118871)) (118874 154212 (\TEXTBIN 118884 . 139763) ( -\TEDIT.TEXTBIN.STRINGSETUP 139765 . 144729) (\TEDIT.TEXTBIN.FILESETUP 144731 . 150252) ( -\TEDIT.TEXTBIN.NEW.PAGE 150254 . 154210)) (154213 169086 (\TEXTPEEKBIN 154223 . 165716) ( -\TEDIT.PEEKBIN.NEW.PAGE 165718 . 169084)) (169124 174344 (CGETTEXTPROP 169134 . 169594) (CTEXTPROP -169596 . 171944) (GETTEXTPROP 171946 . 172545) (PUTTEXTPROP 172547 . 173878) (TEXTPROP 173880 . 174342 -))))) -STOP diff --git a/library/tedit/TEDIT-TEXTOFD.LCOM b/library/tedit/TEDIT-TEXTOFD.LCOM deleted file mode 100644 index e5e8719557ca448a069caba5c5d6228d1a91e936..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 39845 zcmchAeQ;aXbteGIG|R{|NFxf%DAEffJCq`__#*gW$H4;#3Lrr|7=$EBRt(Dq9g?6W zjV!0hv^#a3w&};FGf5LCvGY-`i4)7=r>QIy#xU1@h`H))dHKX#@= zO?PIeGuzev&c}W4futPoOm;Okalb##J@?#m&OPV8p{d+-p_Ch*E);Xah0?TR9Vpw` zS^HSd8Z4Bmxk|AxUmmm$RC4xI)y@>RC1>pUoE3{6?(QC<7P2T-%}rT@@#yf(v#Z1L zXgqF3$0wr`lcS@9*3jUS=byf?yt-Jo&Y!aet?pl%nxFj_4;_DI@!~TNH_l#IJ$vrq z;`t}fu0H(qVtsY-qluBxhkx<>#m4fv4-HGo!>h|rTs(X6qYtB(LRJ0_S91$hXL@Sn z!T4dTyS?k^WOQ^gIyPuMadFY@d+{R|EmU{%Jp7gb@H3yV6&p*ArzWh)Y~C&%%gqm09c!q2x-`G*2ZXr83bZhbv{=_AZnRf1texG&ip*}U=@(#R0_umCA)ao z3jD?0fj}tza{>J8J=>Y@q`+q2v*dCCE00|t541`v zTT5HTa9}8wh+AhE&qoTS`CO$s!k9X5#bSU1;r|GLk;@`zaz-fwn*q>FCM~C&!wz;~ zK5FuStFe>^!PschIBk|JYP*{;|{$C;g{Xv)eKb9UueuKEFrj&el`0mueih{;%8 z1Wpp(QYmyK_?wKWJqGZ%MX@d%Qt6spal4c6nQMu9-_DI~CuiBL=LNQC{OdE%4S<}{N%E~Nc?MjX# zV-`*b`*^X+<3;W`NDF0FKtK*#UH>@V5x6V;ZNl*@_oiis^>eiM*1f%32YSs%khCvinHJyD5NrLY)URz~ z4$eS(n;4F>KXSmd+2HxU`6v&d$^mWBLfC3=aS%y^n5Hh?TWRqSsvOc5u?)@w?JZ(? zoFQ5O1N!=T!U0skDl*LX63n{|{wzYiV>TvajXLgq)e)!K72~*y#ApVC|`v^F+tS{`;I6 z9_xE~^E8i|=-NWCwuJi5Q_j-cXbvr>9tzd!sD+;=T5I1hB{v>0p^h(_5RdzJOl)J% z$%{+QG&fT#VIe%?#&IzvSOh@|75S$a=88P9_K&@iJOOdDvzHt=i?dAKN>H6l;C7u=kK{ju5r}UNe z;JS|1DVd3<*Mlz!dBXgEQ?pm!<^hUB2Wy}X&JlFR(alf|B*Qt19bOx$Z+6Q}mp1NZ zz-zZ7b#E56C=EaA11ZlT{|N$C%30;rpt;{#58jjB=y-lT@VPsWC62!1zOf_`PtsUY zcN$B|KbCPC%eXg|v@@N_0wRwY#1Y=6RsrpDDm*lRyxMZ|Ysc$}G+->e*B=|W-9DM- ziSr-ckQ_420Wt6&)8!`ut@Yc7Y0_iPId9TtRVoaz)dvJ8LuO^MqykE_YPHEoy5&rA zF|&|KQ(6|xuD@VL{t&?P5S>QLAQ2}oaB}ToBt8tDI5bv62Wx3$ zrU6h2XAsT+5|Oy+z|8BD;O(wYhPNlzPS;-$ga||)+MXH7>`0k%H|&=|4s`Dt)Rl$? zYGt<&nrG;4eW~S?Ih*#`UvSvGIQ<6v&jOcx+Y zmYk^^;$Zxgfmha!OCuu+CQ3MXV(65+hX_{@jx#nfj+(?=6So+fh)sYuBlfQhxt!QO zy9&V%46bluBO=ElDS>Ke?RX`pY+Ym zXT?(E?l^a=oJyfPOn{UC(}e|yXQ{-fl_TytmWqwB{GrTnY&4Yu(^)B$j-l8nIA|ZB zVxtM-oN0oY$*~FR3|P`!1;U(}butbiQRW-BVu^{U_Ll%hy`yk^++R38 z>dtky*gu}5IwXrDeNwm7LKP_a?m9o9}`iDIDBhtJZ@n*Wc0@&F-j^RZ(6Jr=IqL; zlhzmnp)+HuYYHKIT=e-v`DKZ+gfk3yT}k3takqS&;JSfeY#bo-Gg3nFLMtm5jx`juKdSx7P&L+4P!7_&h#~lJN(HFs?<>dejUL@sfEr#uCh8+VX@S%AOSm2KWFMZJ{(9$1;lE>{KiY?$p zl0M9cLNVgy;1u&BAig?~36M7-!@6=K({t7NaxQC4jExbW9Gmd8RAU&6n~vkq4YMYT&NwrA z(aNO8WVTic7{w%N6o`u1xKPyjjACO-J_zzI`N>fwaY@;k+v_LL5!X)u*t^t^ zIm!sQy*`oXvcq=**yPZbnJ~fDgaI8iUCkHfi?~%Vn+5x5_l1kacq$4bEe`5WZOCb$ zY3R=Y63Vz8*-)Y>l3+zmK@d<)G$@2q2}A*lHAKyF!NXQ+Jc=6({&%>$lG{zKNXjv3 z3OeQSKp+qlF@~8zk%Sx9y92ETsct1MZ0;d{6u}Ip zgRWMbMd76_yO~lgc`%R{5lV#QNGrchNY1m2EFw7OLrkcQpp9w5p3&spStg%4+1( zh6ANS5zA$;iz}a*g8sdl1MjceXLQ3FUu@-)1fVJ=6)8442qohl6vBGjP#gC)(K1H&Kv)HtGV9^+i2E_u-J*>I=H~A zzvhIgcHc&BMimmh_I=KQ&p8L6jooTGEywD6ed_XivfLT}$)t-xy2E0H8ve-qitB-| zQ9svT(64z--YjeDF!O9QpRn$=qSgmdVD+F)z#*Gc^n zafW2{JEF0meJeki*;WB5sXhZNz zfw9sM7+xhN#1i8QCT=myiJLqY;zq&HwIw7+K}m8&x^!}-OPsn@r*g`kn!?=?hUlpx zhzmV4UoIA^LNZ7&K9kK?9gv_nj{CMe(ps22Qd9_$lZud0(C+CRiJK4=tm9?6M<${* zm80Wqj4svaJ{=c*AYmLzO?WJ4$|s4WaM7eC=%$Rz61T4*z|frJqhNG370kxTJj7Ne zyi>Sn93{b0>H@Ia^1yg#Ud*(c90N(_^2GLQ2p6i%`Xs?xO)ai2URtyg=*je-z(PsM zICyDVJB@+6)ezWJQ#uYF(u5%dkvpIpB9`L0owF7SGpoTW1-1thQb1AIthd`4XPXDd1IQ`ExZoTMH)K8@Ia$LNccJ_V$F>L`o zN%I~-(gUR${>LjVjq)GyM2O(w&Qn+a% z4k8ouG#Lpfsytedz#*Y!;viK@5Fy324c2<|9Y*;aMRSA$#ld63pWUOcT2vU3()i z)UMz6DSC0dk$|lugB=n!pe!-evJ!xbO9KA0&UY4jDyvb^0n!>_3k~^%`ok_@?`)xD zL^jrPgOQ+P2`3B|2xsIMj5em0e}0P#0F0)aif(GcG$s^Ln5B#b8l z%J24o(!QkPWY2;}f=@Sd`HVnxM49E0)sC5adrs-~U2}iS=2es9ro~m6OJ3XmqBL0e z-MkTj^PGcIF7NN+-FcS}-_h3|^u?+PY>GCj8G{yr;Ag`cl5Eak^g}QpZ3)nq@1t0w zUk16Wl5N$t+Wy-B(iqVOB>>`5$_x803808&1`d4|VBS>1W-{a?Mv^siZ85ND(m7vK zfRPn7y01;2A`@C=Du%W^l4E!_)){i6qGTdG0`VE-cF#X$U0T9+KmWwa;**!K%`aJJ zS69#f;$nS7b}a~RsZh0X^%H05AL;=s03-+m8lo#;eF5X4TNFf@v5sW!slpug0hz?n z_RSQku$x2Br{6e*wmLG31Yd3~30B#>zJC|KQ~G7Ay;~HD8|3+R%=q5}J3iFjdW4Ai-`H)~u}>l#6a26p@lA)v)NQ0XYKNDk26p}xc&)XtS7rpJZ)Lbf?Dzdtus%?qm)aQq!2=PD3KvP677?T;6RVc%^fKw!HT)_HVYXC;=EiO2D-*gvF$!z}`{C#u%obO!2i)&}wbQ3g| zUh1h6J#}5*b2l{wOjx-d>T7|>;X0;UPNa4t!hD}ByC^t4L}OgwKTPMCgcFB-yvlk- zm`T8938Jc!f7tdzoCU4&8{H&9{O0W0+;Dq3QLiX&kRiet4u=Ro7_9p)-oE7;$xR3`HkEjL%5B zBWQPo+htpt9f`OrJd<-^9Ydo11Vl)^P2}U*cf~&;Mm;KElO6szbwb1B!*m=My1p0) zIc%XyI9szLl^h)fe6KVPb`@m1XpKR0C;?pWN&xGi0jP_;x;F0b#>BKrnuEe&UQBjO zA-XL@5||rl0B~{}AXbQ!Zesw~B%h*S<;);p4aPN8LydKIrlG0>ug6n?^$?A^T&-9s zaM31>3Q-c_3eCTq%gxfwWXhOJpg*@BlpI_r12-}^5oQ_EFN{MtSD9yUD=DZCIByge z%o>1nOE4QHGdP|zl*};cB&7?OPna2TF1S(&K(Q(Tk~M6v<|U@Ft1nk;btk5-DWs@NyXPVv++ zrvwibMp`S5VM752>|jEFi5t!CbfkhUk8GNKkTyPU1r&D`i`GLJg6{`_Xo4}Xxq8n__|R}Ub@SyvC zfKaKy(+{w449`IpOtd};3umBon8PVGH*aIGFNK1EkjiEKy}dyj*2C|}v(iMzJ;2A` z+OrycXrrU@4SV(Wt>(K_$MxKoZ4=@%bmQ)o=L_~U$s}e zx0?5*Z8>SB)0MS>_5?}3+S&NtHC!dQzIE{;r)tPw?Fhy$7`h=VRn7`+IH5p_gr7oT;ZX%1~efo%<`2{kxpj)tMyIMvd#dZ~_ z#mfN%CYwd_+-wiK2x0i?$yBa#o50)g^ly+!p7T{e`B_BZpyw z;-l`2Bj==4d_zo4Li4s0hLOqTgW0dFhoIhY`h{Y3!R{oKat6u%Bn0L#LIx-|UEsaw z>~s1WH_}WW)&rkqKsCQ6YO}zG-GECA{3<4?IVU2m zIpGqlW!8i5*LE-hr;jHD-2jUk2aVe!FLMn-85~{UL!mI*t6nZ>SX094+CpN<^&Ut^ ztjw-udc#MZO#N!#xvjuYmj2zjdvE{b$JgN9mRSW1zq|Ce*8=xJjDhU3LjH6lxzvU* z&LLTfKy4pH9D&~FT`>Ko8!}cS3@fhU44DCSsn1kK=0&p~s`aB6KT!ATD%lXHWW8*H zj9EKa4~0Uyj(KNjN$h3%Tg$bmuSh*u`d^gAXlDvQ)ee%iX(UY3V!1GdSnK3j)bqh~rZ+t7%Pp@b;@aCI9HkNGS8@UUUbz@pc{jB-hQz#Gt)#D%(e0?G2AO)t#fRzS*d~ zwbI2?%-{uo%UHtuDMM>a3uikAZhg&mQrP>ScKV$|pP)a8e_t>qv&5HO-XdJaZN8vm z_Z659X;6N`HTZ66QkR$8Wpd#@h>rQgxfPvOp#7X|C6W_SUB>XDe?hFdje$ezl zZNI_s&F+mo&LMaU>a?{)l2$~vi*taf;BPwzK0K>(>XqN8ELc{wR$6aJ>AaP!?%mj0)WuvQR?_^W1WYrmgy zMn1#s{@U&o%o(||$2kfWSG!r76TSQnyRr2dC;as7tyi4>lCz)pGN_?*;7090M7Jhy zS?P_54%=x-+%xIQY%}S~cqUzDiDaeNeBx715BcELPFxSe3-1KkQ!rOHF2X7?Ty5s7 zFl}Pqnlg4bV2zEz_NUGI35Z?#N}uRGI)a+E!=Wx5VR+ z_)O7p-}J{Z1UDUf#e~NINzaIJ%w482>~Xh@i*jS`)jN52$}q{hQ$nLK?!4cErf&Of zI5ceTGIo^7{WO3{( zQyxx;UKna8H{G{)@JN-LPS!`J47Qycb{7!a(UX-co(_ct#y6Ac0xM9cbm%cg?#)YE z8;|yeRr+~j687?6#I-gKXd`>9-eU_3Bgt2W^#tCtP=8TuN*csPN-A5kvsVV6$xu0v z(V8pMdnXe}INW=yBUNWaTxJwEDo2mxcG%igM3#&1IPl36jW4m8Zvgf zdI2h+Q+Edg9d@I4up|HN0RH`1=JyIu!U{&khOj7pAVD@(L%kiHbH#tWJW$A&MC?6X zPv81dD_>d-egC_gf!FSvU08el8*`2CeY3Q>=X>8;`=0o@_*|Um;!2za2TU;q`ZA)S#Jwqo>;!Ez+Dq9&)Ey?voVGoMy{RNyp_;tP3=b>CQ68%fXH zYW906f2nz$r`Fz>N#APzwZ`|HT6;C$xb<=)oL9vhUHxRmJslcc6U6atg0#i80BKxI zSrgLf&|^r*%gB6aT_}cm+zrSFy9oZkz$9C!duAECJ-4P9!x|K*^L)A{Y7hTi6rtq@x9NH z4$GS!zn8{iC~f_*xPa$7bVA#}NAD^9bnxMkBm=%$4<_yO?3lIF<4v2j4GTgO?Tw#1 z*~eqR%WNzXWj1>FJ4Y*yLlVRTrC`Cz_pWiez;TmsSz>HsK_g-IGj?s$}K)Xupn5)H6f@i-uH4(*2+-j?oXL_xH#OTjh32?D1(SdWBrI^*2VFooZ)NS0 zmC0G8Du=)0pcMxbhvVI#U4`)?op1BjeBL>ZVcJEk$kZt-Z=cAaJt%Xt zPOg&0)eUTSwXeZ$@(YKK9Hz(CpsuvEf@jdI5+00W^*6NBI7%%W_Di^@wCDzSp7iQ| z_Zg*jWYNoR?{o%|RvU*QskCuzL+4*POR8Ysp~n`c58{Y0MrmDo*U^oWBHiXsmH)gT zeE|+lh5F}s1LPxJB<|sTY!?B8)a~y6GAyTbEHSVq^x~%33?0?Z|@ah3q}ffI=>X4 zn3K6Cz^o{{fKC|51$l3Bm?DxvcK`(I1UpBHI1dhE9!VZgNV6lnr4t6%4mdUL0$A_X zCFq2bT^X~$H-G!wr)`kwnK>p?M#1u*q`@Vq zD>Z~Al$u0CCDgcXb!c$)fjp~E8ew~m3EOLF*k~+G-@|L(GQC8%H(OlU+PJ59SI3nu zaj{$4x^ko_Eu3Dnq_pi0!rtsYjd2KPl16Aokt!`ng@-m=9RYcW8_}A~^p*W&zK*t# zx6-ieg$e;iD8vBr(=k4&oHPx@O!0!!WqUi{MK{iZgmG}S8geBJa>tM~a!=C`!~+e1 zytu3xBzf4b(&)G+GA#CDpx9Ey6$L?}y=?U7MbM1ln%lMu+01xc5^=wPNIR2*O)eNr z+zzw2F>6k)m4vH`fvNgkVh-gv#ocDQSg(yk=Y`ALt1wk;svsQXtG;$K?< z@^ts-Z^HoE{5TjqE*c2rMX+wN9DJ?qg5H0x?NgyCrJ##N7^~1l9?t9BNr5z!D|%r_ zX`JfuF7i={V1%{VecxH>5aWoHfMSJRt&W^O#s zf3cum^%-hov+MOj(Oi%$)mMx>a5F70w6%(_ND`>a+S?^q#2zm)t)R0)5UGGP$)&CC zNtOj#aZ+RY=`nVOr?&$~)6H3YRv8NMK3alQ$>V{w6R4^^;$33Pbz0<)GtzHwg<{$1DIOBVrY| zvAKYZ&p87GS3&7tDJiFy|@3PBrxt+k9&fgB;Uvp5r6I<$}7?QoHv98k_ zz1q-G&M@E&HUG=nbznGjATsC=;4LjT2*U4kr6#be`q-}niQya+xB+j?%v{99ktUh0 z3enYc`E)8!ENji}Kpe*2;$w6>9^%lz`31NY$Xo~Nq;&oF6=y;V_2z*(o+0>o1H3Pq zfS*Eb?%|j@NS?qE@G8_Dm@|z%{U*eZ zX$Eb1hL~O;xCQzK$;FHc*B5GqLk}H`eu2(A5e{ff@OICFoAj2;r-H>nXAl6F6~+Jz z+7x&1(Q_bPRoyOZiRr>a>5RKCz62h?m}BjS>hPQ{*nXbv*2ZHJzZ%eAy6L-8&_er& z1t+#IPi&v~MD$&GpJ_sX*M(O5wdmKCEqPp@o!eFjZ*i;v*T#%p)8>(ttR z!2TgEqwWnrQ-fG^cDoVpElnL{)SXv23sJrmb=C@R7lsep5WNv0+kn>uO52h{i|MCWIJnKy zx$A_bS7PUF1ZWt&RrFR22eKw(duRxvr-pVyob)2oM(O@$CrZ*fy^s}$r$Y}sLgy^w1dYW|M!RZ|R(jz8K2%t`DC!zm3 zsGi#RwvUR0H(B~N$7IZst_5_Ke)?|?KTv;NJX~4nIbZ_2odfE+2McQ5mS)<#GsqS$ za1gsQlvdTaL30yjW(tc!2EOL9gVw@r2H0daut8PiD^c*9sOt{K#dQv^jgkh3_Ab9# z0ira|htswV8~g{_u)P;L6~I06d-VWlFP@N&Xw;D8gPa`rXGzvNV%WCXeFjb@#lMt9 zc2JQZ-n3}tn-N{l&JTk9smwv8Finqe|Dlx8%)NPSvY&y1SL8J#aH@IOG|;%&NEcWI zydL-hqjd8xG_QMM?Qisg6?8<|I!V+3BnWK4Z1eRNicmT)w53~Uk8(lO{qchZZJXIF`6JGN)zKz*i&)Aus%hUpKvR(nf#Jdo2SCt)yD%&hj9K%sEgmp6n$w-TMvQ^W_C0%mK znnpvO6?@EWh9AR}9_fi$DG7%F9fkMSg!?oQ#-*7aE8`h)WAQcDJ4y|JupkgwVV+&R z_)!vAFP+DQspnL4Y3bs#BDGrNt-kmXNUu=5L&k-691qKaW~LAomxg zcetm}XM6xOj0AL!&N2J|a76Wlej3$@SVTvLjTmu$2Y=tD5wh=ipp&^QUe zQIHhtG4P}2YR2^@fmwta53x}Y^dqw4M9Dld4^bVuX;N>RbBjJRquY`!#PQy9DK|eN zFZSUW%#K_C3lWN2(P1OpCpP+~8bAZBKQV6{!q zbZbshs0Mt#Q0_@i@(x?DwQ<|;BLR*)DahP`8I&}<9aqBYKmqM!XXCqnOTLkXYn`Nc z0%LWC9VN&xp90>EG7Shc4V=BlKPa2u)~CfnBXdahkN)1QqkS%T`zO*-A3B164!Bzv zj@u{6J#FLnJwOp($(it9Z|nM3=4L|$#o+UTz!Q zj`9r>PfA$bK0HPk$bWW8KoDNFMD;2(1 ztYmRFbJru4@5?5@9K4Qy+8lhoWA1*u1Ek*G~!#>wv@hr35S0Q;TY6uz+fR1Y{DE^ZYT*X}UvM|M*L^)*Ly%jl5tZbz`Nvh_-# zepknrd5(t3Jrpj4S8YKeeI$jj2m%hR5e_`^D^|k*!6Rauc2WKL4E1oDyCCq$G0q2JYMq zfs9=q-9GRYh~soKY`7mFeVFE<(_nLSMPkez>!4Q~j;h z$}I0N+-v>KcS=c99u9uwMq{maG}|(Qu0TN#2{?W09iK|e6Qn<0@Ax<);(EugNR`cf zI1E0u9{5YTEGB=auW7nB=C7=G6eW=!y+emc7;zmL^wGX_qpj1l`|d2sGW58Bw9o*z zqix|)1MMox3u62VB*stmNxsRzQ++(!&|mWu;P7-(8`w{NQPRjh^I4m&(~xRsYGHcx zRwzg(De$lR6!_nkI@?5ECk$V$q_(Vs+0!%%OOxUlQbKBV`BM6(+@YdyDYU{zxaFoy6R7pC}T3czufsGxIm$qeK239)E0Ip7TaH_o+ zT$?a`?KQ)a=Y1}}M@xpK!M)pu0_ba2pw`nISTV8Aw9_MgE@^8$_+FD7daU^iPS{tf zq&Yh!`4%b${=rlP$gp=54_%ZCe0;~mJ;B>l?F7Ex3H9g!4VfXm64?%Y1ZQNS$cY2VCV^Adbad6ju{%Rcj$+l|5Jc@Wu zUl7=qDMVPaA(m>kUwX$Q4|uQg5nRvEH!D-5YVa|1^l<@q*z|aBia0>O4#4;FWzu)Y zmGBh#EMof`jlt+jH5VYx`0$5maTid)-iMz<(D#fX)p|9dNOU70__#{r=lAesQv5lG1vqI*^5ifta26c*!PrZv@7FN}F_Bf44z za=DRmW8Tci+#B^Vj7a+#!%9oZ6#RBHnAqo7weOd?=nf?n(N=_)Pi-JZnY<)KAm9s-jcmPrMTFhLJpVqOcR zv~yp4_SAvc=UUAhjJrUP98H^E_of0iH&I2HV!o+{iYyHXSljiM%>I#dASx>|+bfHy zo_0y%Br(Nu#YViRd4d{7dl3kfdvJ@A6(v!YY5&I%BWHOWcF$$na-Pp_wikUqd$j|) zqgIAEsZ9C@;I-6121l6*9c*RnA7t=423W2P6h zsw?fD*#kO5rGb3oCpcL%_(?;1g)zLfA>ej_wF9t}Gs-HXzk;QWNn-sK3<6ACivZnC z3YUQCriuHU+_2<+C9St};!q&yvc-vHs211L?Z&(UWNc=z%2O)G;LoF}-T{HBNScux z{K({;v5HFYOrZw{>86L@Zh%J$G?+R;!ZeB+Y=RvPjDzuN)O3-aOyrkr@eyQs!V|JD zz52jkTc%q^GYkYpP&2I%hH3|dpye!3^X+#B0$sUJWq$BnCif}(2hZ8PmCh-;%Db_$ z_4(`+iylvyuVKIh?9m_n{j~$~pzAE@u&y1Pnk|TF*%YJo8F1NWVdME(QH5SUj%>-n z7bx=6%;s!0-)BOklDlFI0&RkMduo%M|DZA_2{U3F|Zr@x}2qAFQF1^O9-!lXdtun zi3g&9h?x!{cz+L<+eQZ&aWA(O!Q9KiF7UjJ8B5GlvpC@~#0$@fVnzPqek_o;P6?ZB zl$21cGhNamzzBbw@I>PBcXOX<3eGY>lo_blxw^@g->X3&j3y1dWdCvDhr+)980s6S zqQGx?D+$)Y=Tw2CnQyfL96%GF*>l0}SBtx(2cEBP0q<%n=D!4Td6^iFbF+rNyJjq> zNd*g`K`>n!@(yJ0;tL8U&4n6CydpqYCEzhtyK1HBEA=}cz4l&bGgtzTZ#;Jk=8Imo z@eXuEaU;er=MWh}HZH!17J?b2Z#D1?@kan;YC$)><$-~gpB|ct;JZP8gr{Re zz2!Z<vkbAK(OLe@6*%xg|$W5g^kPT`j|+${p|L%sOQal;wt>1)2*ZoYjz6qj_o z!qWU3XWx40J%SDEA-ziWns3|$t$U|r|4=U%ek@UZ_UFHAKarYz*+-&$5A2Bh&<~wH zaaZ`UCZN`awzD4m69->T2>zb7LJAzbmJapJUbn<=iEw#KikNR5s7iz?XWMi3I%+Ur z)DDpK^`i`!?KWvVZL&I9w}Ug^>2E%}Lpo<*xkX7Z_tZc?16dr;p~xIqu-=EyJDI)$ zwZ7(o6%&JYqEEFG0@AgH$qGR`H0(tDMZ=os*HPH_bU}F-SWEcC{rB2NU9x%PwRB?^ za(=}AGhLA*ucsT(47HXZ=F37DBCj;M zndbZ%#m?PU5}Vw;edfcEIrmhUI|s z9hCIS-nN6VO%A7fK_#ZXTKEp{_F6nwwpgI!m0pR^F@esea8Tm4F(bUwGm=W+=)*@Q z=&^46V1T|SISRTca?B_h7m37&vs^>&4gM(BMADL&fVN5B^fW<;$tDOx+jhY#>7B~- zRO7ZxPpD7g+Q>8l-d2MNNS)Gk!jm@XO$n3l8ulill{SZ8Z0pd?)ZF#LF_XO!Rxz~E`LxMyqOo@iKE zY=!t+klc2lr^{>O7(%~dJAfZ~Xq@?$I~*jzZr|nU&yaDEGsHV$I`WO#p1v>GpITar zi^aj3+A3`hG=E-Fewf$OKur>UL*xJ7cp&z{Aj3REWnvze+qPYeYRxT2x49m-3tV=a zcr%76j=l^&cv~j!VKw=0m;&B@j(ZqR4=ZSan5RggXBAAUrx+sx9FywDW|wIL`zFus zy0!mbF;Q9nVZg{M4*R4wb#EpQgRL&peU_M;Z~c+}HsyHXV~UyQG@Paf2IP}VoUlEM z6K!#=Ht%PGhCXuK!K;@LCScoxg??)B(vwSgNfwur^Kf~EZ*q)sKoTVfS{rg@9cC}t zQ4Uj(wk=MMA)<2h1|)fLkRp5jFtoW|aupAd>Svzu>69#$W_35uo?Zhe)1!lBURcX*}n0k2R{ zN^;_Ef709>0e81tuPuf@8cgFoD-P4(cB{e-dKtbdTn%IA|FA~z6oGw#A5E~4+Tzem z!_g0Kl=62+aP-IMX-iEa6)z=WacB?mN8saF$&&@#ILAS9&1#W!1Jf4zNRqp7_)Iu` zVSwJq#M4mzmv2B@QJ8dnzQVY(o@SE{dP9_Yf(sshq{#F^2L@Gx3ei^$L_(`UH%U)< zTfWzKa0V5Qm7Gd$&d%bMJZL8sS$!iH>kvXBLP0b#SU&&EGs{ollSzvgFXE#~%jc{o z@kJFfYBT6IX{|0k^9-D^&YpwP?6ahTCwB)rsF04*>0Hsc@LY9aq6 z6*|~*Y-vk&;nptM7QM%!*?+EE`49E?i^5XAF&X7T%3x00?=>bvko62SanPC|G*KmI zxHQiSNj%?;n2F#N<}8@h(|b=~yG$i4lAWy<;EfJuDU$=sI83Vozj8(&*~Czn-C?gE z?#A*`TmIb}x6EDqu7LY*u%qbEslH+W*BokxoJ=}Hk20{q)b+`5tI*d{i0xL5A-c1g z<*Ro2KJC^ep6_h~_0HN+t}Q~G9OBc>cS&>;3*v_4-JF&_b75z&b0gEF>Lg9Mfi;~} zW=F)~gJRN2Q{aX@&p6;QxfHuOzEz8<>YpeqX`6iOj!&`s7M>pd^{+fwNYfrRl?j6S zD-vK!w;_T5Wg`!1-V7h8O%EC909(Ljc@WPf2Nubms=gY!)!f%=oMrO88alh$aaN4# zS3_G@`n+_Z##{<;1ee=pKL#@6->Ax0^Q*()mwh-1MnR|PnyL)JA0O{OXB|9^0sm;^ z1LKFe)btcm>ARwpvi-;-J9D7_U=d7nrm{GohNg1aBK)@QpTyh2b}>!uk^+N1f6SkD z8Uj7T^Fbv%12J?4c9=FaW@O*mol4?V*9M1*j!m7H5Bu7tTs*~3tqio^$WgUw?&j2-xUp!Q?uT9ZtnGeUck43yy@g*rZRG^wXW-cLq zbePlht!PEz_`P-K6!Yn-IS+&N?C4C2XHF=F;Xb25E@Djb=uvu8hmI^UCo?HPY}drh zq#1iKg9-#sXu5e082PT(d#LNr@^mZPGK?DB-?ou;%(mDrgwn<~I1Nmgm*uve0wY30 zBMNEOzKxIbSYbbTYdd94{kAS1w7T0m5uOK(O??%X{F9bd#nw5$T32R>Gw@MK8jtv* zUtB!<^zga!mxh6)=cLpK)xsy~@E<-vxp>riV)4nd&pxwgef0dZ*7^b3+AK1QnSDK9enhQqi8nM+AoGm(CB0x>&)Z g>y|@-ha;yGoiuVPec-2ls_g$79NoT&@;B}N4^Dd&ga7~l diff --git a/library/tedit/TEDIT-TFBRAVO b/library/tedit/TEDIT-TFBRAVO index 68c32427..99b16b1a 100644 --- a/library/tedit/TEDIT-TFBRAVO +++ b/library/tedit/TEDIT-TFBRAVO @@ -1,549 +1,1246 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "14-Jul-2022 17:00:58"  -{DSK}kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;1 72340 +(FILECREATED "17-Jan-2024 12:12:29" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;150 90820 - :PREVIOUS-DATE "14-Jul-2022 11:25:23" -{DSK}kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-TFBRAVO.;2) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDITFROMBRAVO) + + :PREVIOUS-DATE "16-Jan-2024 18:30:43" {WMEDLEY}TEDIT>TEDIT-TFBRAVO.;149) (PRETTYCOMPRINT TEDIT-TFBRAVOCOMS) (RPAQQ TEDIT-TFBRAVOCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) - [DECLARE%: EVAL@COMPILE DONTCOPY - (COMS (* ; "Compile-time needs") - (RECORDS FONT PARA RUN TFBRAVOPAGEFRAMES) - (CONSTANTS (PTSPERINCH 72.27) - (DefaultLeftMargin 2540) - (DefaultFirstLineLeftMargin 2540) - (DefaultRightMargin 19050) - (HardwareLeftMargin 2540) - (HardwareRightMargin (ITIMES 8 2540)) - (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v - V w W t f o % \ 0 1 2 3 4 5 6 7 8 9] - (FNS \TFBRAVO.FIND.LAST.TRAILER \TFBRAVO.HANDLE.HEADING \TFBRAVO.INIT.CHARLOOKS - \TFBRAVO.INIT.PAGEFORMAT \TFBRAVO.INSTALL.PAGEFORMAT \TFBRAVO.PARSE.PROFILE.PARA - \TFBRAVO.PARSE.PROFILE.VALUE \TFBRAVO.GET.FONTSIZE \TFBRAVO.GET.FONTSTYLE - \TFBRAVO.WRITE.RUN \TFBRAVO.ASSERT \SHIFT.DOCUMENT \TEDIT.BRAVOFILE? - \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS) - (FNS \TFBRAVO.COPY.NAMEDTAB \TFBRAVO.PUT.NAMEDTAB \TFBRAVO.GET.NAMEDTAB \TFBRAVO.ADD.NAMEDTAB - \NAMEDTABNYET \NAMEDTABSIZE \NAMEDTAB.INIT) - (FNS \TFBRAVO.APPLY.PARALOOKS TEDITFROMBRAVO \TFBRAVO.WRITE.PARAGRAPH \TFBRAVO.WRITE.RUNS - \TFBRAVO.SPREAD.LOOKS \TFBRAVO.PARSE.PARA \TFBRAVO.INIT.PARALOOKS - \TFBRAVO.READ.PARALOOKS \TFBRAVO.READ.CHARLOOKS \TFBRAVO.READ.USER.CM \TFBRAVO.GETPARAMS - \TFBRAVO.PARAMNAMEP \TFBRAVO.EOLS \TFBRAVO.LCASER \TFBRAVO.FONT.FROM.CHARLOOKS) - (INITVARS (USER.CM.RDTBL (COPYREADTABLE)) + [[DECLARE%: EVAL@COMPILE DONTCOPY (* ; "Compile-time needs") + (FILES TEDIT-EXPORTS.ALL) + (RECORDS BRAVOFONT PARA RUN) + (MACROS \TFBRAVO.GETFONT \TOPOINTS) + (CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V + w W t f o % \ 0 1 2 3 4 5 6 7 8 9] + + (* ;; "Interface to TEDIT") + + (FNS TEDIT.BRAVOFILE? TEDITFROMBRAVO) + (ADDVARS (TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO))) + + (* ;; "Initial looks, USER.CM") + + (FNS \TFBRAVO.GET.USER.CM \TFBRAVO.USER.CM.LOOKS \TFBRAVO.READ.USER.CM + \TFBRAVO.INIT.PARALOOKS \TFBRAVO.INIT.PAGEFORMAT \TFBRAVO.GETPARAMS + \TFBRAVO.FIND.LAST.TRAILER) + + (* ;; "Decoding the Bravo file") + + (FNS \TFBRAVO.PARSE.PARA \TFBRAVO.READ.PARALOOKS \TFBRAVO.CREATE.RUNS \TFBRAVO.READ.CHARLOOKS + \TFBRAVO.FONT.FROM.CHARLOOKS \TFBRAVO.READNUM?) + + (* ;; "Profile paragraphs") + + (FNS \TFBRAVO.HANDLE.HEADING \TFBRAVO.PARSE.PROFILE.PARA) + + (* ;; "Creating the text stream") + + (FNS \TFBRAVO.INSERT.PARA \TFBRAVO.INSERT.RUN \TFBRAVO.SPLIT.PARA \TFBRAVO.RUN.TABSPEC + \TFBRAVO.INSTALL.PAGEFORMAT) + (FNS \TFBRAVO.ASSERT \TEST.CHARACTER.LOOKS \TEST.PARAGRAPH.LOOKS) + (INITVARS (TEDIT-DEFAULT-USER.CM "TEDIT-DEFAULT-USER.CM") + (USER.CM.RDTBL (COPYREADTABLE)) (PROFILE.PARA.RDTBL (COPYREADTABLE))) - (P (SETSYNTAX (CHARCODE %:) + (P (SETBRK (CHARCODE (%, %: = CR)) + NIL USER.CM.RDTBL) + (SETSEPR '(% ) + NIL USER.CM.RDTBL) + (SETSYNTAX (CHARCODE %:) 'SEPRCHAR PROFILE.PARA.RDTBL) - (SETSYNTAX (CHARCODE EOL) + (SETSYNTAX (CHARCODE CR) 'BREAKCHAR PROFILE.PARA.RDTBL) (SETSYNTAX (CHARCODE ^Z) - 'SEPRCHAR PROFILE.PARA.RDTBL)) - (GLOBALVARS \NAMEDTAB.IMAGEFNS) - (DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE? - TEDITFROMBRAVO)) - (\NAMEDTAB.INIT]) - -(FILESLOAD TEDIT-DCL) -(DECLARE%: EVAL@COMPILE DONTCOPY -(DECLARE%: EVAL@COMPILE - -(RPAQQ \SCRATCHLEN 64) - - -(CONSTANTS (\SCRATCHLEN 64)) -) - - -(FILESLOAD (LOADCOMP) - TEDIT-DCL) -) + 'BREAKCHAR PROFILE.PARA.RDTBL)) + (COMS (* ; "Named tabs. To be removed") + (FNS \TFBRAVO.ADD.NAMEDTAB \TFBRAVO.COPY.NAMEDTAB \TFBRAVO.PUT.NAMEDTAB + \TFBRAVO.GET.NAMEDTAB \NAMEDTABNYET \NAMEDTABSIZE \NAMEDTABPREPRINT \NAMEDTAB.INIT + ) + (GLOBALVARS \NAMEDTAB.IMAGEFNS) + (DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND NIL (\NAMEDTAB.INIT]) (DECLARE%: EVAL@COMPILE DONTCOPY - - -(* ; "Compile-time needs") +(FILESLOAD TEDIT-EXPORTS.ALL) (DECLARE%: EVAL@COMPILE -(RECORD FONT (SIZE STYLE THICKNESS . SLANT)) +(RECORD BRAVOFONT (BFFONTNUM BRFAMILY BRSIZE BRWEIGHT BRSLOPE)) -(RECORD PARA (PARALOOKS . RUNS)) +(RECORD PARA (PARAFMTSPEC RUNS FORMATPTRS) + (ACCESSFNS (PARATABDEFS (fetch (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC) + of DATUM)) + (replace (FMTSPEC FMTUSERINFO) of (fetch (PARA PARAFMTSPEC) + of DATUM) with NEWVALUE)))) -(RECORD RUN (RUNLENGTH . RUNLOOKS)) - -(RECORD TFBRAVOPAGEFRAMES (TFBRAVODEFAULT TFBRAVOODD TFBRAVOEVEN)) +(RECORD RUN (RUNLENGTH RUNLOOKS RUNSTART RUNLAST) + (ACCESSFNS (RUNTABS (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of DATUM)) + (replace (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of DATUM) + with NEWVALUE)))) ) + (DECLARE%: EVAL@COMPILE -(RPAQQ PTSPERINCH 72.27) +(PUTPROPS \TFBRAVO.GETFONT MACRO [(FONTNUM FIELD) + (fetch (BRAVOFONT FIELD) of (FASSOC FONTNUM (FASSOC 'Font + USER.CM.ALIST]) -(RPAQQ DefaultLeftMargin 2540) +(PUTPROPS \TOPOINTS MACRO ((DIMENSION) -(RPAQQ DefaultFirstLineLeftMargin 2540) + (* ;; "Assumes that the next token in LINE is a number to be converted to points, according to the conventions specified in the Bravo user manual. Negative distances are relative to an 8.5 x 11 US Letter page. ") -(RPAQQ DefaultRightMargin 19050) + (* ;; "This positions LINE at the token after the unit, if any.") -(RPAQQ HardwareLeftMargin 2540) + (LET ((NUM (pop LINE)) + (UNIT (CAR LINE))) + [SETQ UNIT (SELECTQ (U-CASE UNIT) + ((IN INCH INCHES %") + (pop LINE) + 'INCH) + ((CM CMS) + (pop LINE) + 'CM) + ((POINT POINTS PT PTS) + (pop LINE) + 'POINT) + (CL:IF (FLOATP NUM) + 'INCH + 'POINT)] + (SETQ NUM (SELECTQ UNIT + (INCH (FIXR (TIMES NUM 72))) + (CM (FIXR (FQUOTIENT (TIMES NUM 2.54 72)))) + NUM)) + (CL:WHEN (ILESSP NUM 0) + (SETQ NUM (SELECTQ DIMENSION + (HEIGHT (IPLUS (CONSTANT (ITIMES 11 72)) + NUM)) + (WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72))) + NUM)) + (NIL NUM) + (HELP "UNKNOWN DIMENSION" DIMENSION)))) + NUM))) +) -(RPAQ HardwareRightMargin (ITIMES 8 2540)) +(DECLARE%: EVAL@COMPILE (RPAQQ BRAVO.TRAILER.CHARS (l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 2 3 4 5 6 7 8 9)) -[CONSTANTS (PTSPERINCH 72.27) - (DefaultLeftMargin 2540) - (DefaultFirstLineLeftMargin 2540) - (DefaultRightMargin 19050) - (HardwareLeftMargin 2540) - (HardwareRightMargin (ITIMES 8 2540)) - (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ 0 1 - 2 3 4 5 6 7 8 9] +[CONSTANTS (BRAVO.TRAILER.CHARS '(l d z x e y k j c q %( %) %, s S u U b B i I g G v V w W t f o % \ + 0 1 2 3 4 5 6 7 8 9] ) ) + + + +(* ;; "Interface to TEDIT") + +(DEFINEQ + +(TEDIT.BRAVOFILE? + [LAMBDA (STREAM TEXTOBJ) (* ; "Edited 28-Nov-2023 10:34 by rmk") + (* ; "Edited 17-Aug-2023 08:09 by rmk") + (* ; "Edited 11-Aug-2023 22:59 by rmk") + (* ; "Edited 5-Aug-2023 23:05 by rmk") + (* ; "Edited 1-Aug-2023 08:15 by rmk") + (* gbn " 3-Jun-85 21:06") + + (* ;; "T if the open STREAM looks like a Bravo file.") + + (PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR STREAM)) + NAME DIRS USER.CM) (* ; + "first look for a ^z, (beginning of a Bravo trailer)") + (CL:UNLESS (\TFBRAVO.FIND.LAST.TRAILER STREAM) + (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) + (RETURN NIL)) (* ; "BIN past the ^z") + (BIN STREAM) + (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS STREAM)) (* ; + "if the next symbol is a slash then check if the character looks are valid") + [SETQ ENDCONDITION (CL:WHEN (EQ (CAR PLOOKS) + '\) + (repeatuntil (\TEST.CHARACTER.LOOKS STREAM)))] + (SETFILEPTR STREAM ORIGINAL.FILE.POSITION) + (CL:WHEN (EQ ENDCONDITION 'BADLOOKS) + (RETURN NIL)) + (RETURN T]) + +(TEDITFROMBRAVO + [LAMBDA (BFILE TEXTSTREAM PROPS USER.CM) (* ; "Edited 17-Jan-2024 12:11 by rmk") + (* ; "Edited 26-Nov-2023 00:29 by rmk") + (* ; "Edited 14-Nov-2023 17:09 by rmk") + (* ; "Edited 22-Sep-2023 08:53 by rmk") + (* ; "Edited 20-Aug-2023 20:25 by rmk") + (* ; "Edited 18-Aug-2023 22:18 by rmk") + (* ; "Edited 17-Aug-2023 10:17 by rmk") + (* ; "Edited 13-Jun-90 01:00 by mitani") + +(* ;;; "Top level entry for conversion from a Bravo file to a textstream. The textstream is returned, %"Writing%" here means sticking it in the textstream, not saving to a Tedit file. Assumes that a stream BFILE is positioned at the first byte to be included.") + + (RESETLST + (CL:UNLESS TEXTSTREAM + (SETQ TEXTSTREAM (OPENTEXTSTREAM NIL))) (* ; + " Produce the USER.CM's alist of default values") + (bind PARA NEXTFMTSPEC USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST START (BSTREAM _ BFILE + ) + (TEXTOBJ _ (TEXTOBJ TEXTSTREAM)) declare (SPECVARS USER.CM.FMTSPEC USER.CM.CHARLOOKS + USER.CM.ALIST) + first (CL:UNLESS (SETQ USER.CM (\TFBRAVO.GET.USER.CM BFILE USER.CM TEXTOBJ)) + (* ; "Go for plain text") + (RETURN)) + (SETTOBJ TEXTOBJ FORMATTEDP T) + (\TFBRAVO.USER.CM.LOOKS USER.CM TEXTOBJ) (* ; "Set up the USER.CM look defaults") + (CL:UNLESS (GETSTREAM BSTREAM 'INPUT T) (* ; + "We keep it open, since we point to it") + (SETQ BSTREAM (OPENSTREAM BFILE 'INPUT))) + (STREAMPROP BSTREAM :EXTERNAL-FORMAT :THROUGH) + (PUTTEXTPROP TEXTOBJ 'OUTPUT-FORMAT :DEFAULT) + [RESETSAVE (STREAMPROP BSTREAM 'ENDOFSTREAMOP (FUNCTION NILL)) + `(PROGN (STREAMPROP ,BSTREAM 'ENDOFSTREAMOP OLDVALUE] + (SETQ NEXTFMTSPEC USER.CM.FMTSPEC) eachtime (SETQ START (GETFILEPTR BSTREAM)) + (* ; + "Profiles and headings have to back up") + (SETQ PARA (\TFBRAVO.PARSE.PARA NEXTFMTSPEC + BSTREAM TEXTOBJ)) + + (* ;; "No runs signals the very end") + while (fetch (PARA RUNS) of PARA) do (SETQ NEXTFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA)) + + (* ;; "Valid profile paragraphs have a special interpretation, invalid ones must be mismarked ordinary text") + + (CL:UNLESS (AND (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE) + of NEXTFMTSPEC)) + (\TFBRAVO.PARSE.PROFILE.PARA BSTREAM PARA + TEXTOBJ START)) + (\TFBRAVO.INSERT.PARA PARA BSTREAM TEXTOBJ)) + finally (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ) + (\TEDIT.UNIQUIFY.ALL TEXTOBJ) (* ; "Lists are complete and unique") + (for PARALOOKS in (GETTOBJ TEXTOBJ TXTPARALOOKSLIST) + do (replace (FMTSPEC FMTUSERINFO) of PARALOOKS with NIL)) + (for CHARLOOKS in (GETTOBJ TEXTOBJ TXTCHARLOOKSLIST) + do (replace (CHARLOOKS CLUSERINFO) of CHARLOOKS with NIL)) + (\TEDIT.TRANSLATE.ASCIICHARS TEXTOBJ) + (TEDIT.SETSEL TEXTOBJ 1 0 'LEFT) + (RETURN TEXTSTREAM)))]) +) + +(ADDTOVAR TEDIT.INPUT.FORMATS (TEDIT.BRAVOFILE? TEDITFROMBRAVO)) + + + +(* ;; "Initial looks, USER.CM") + +(DEFINEQ + +(\TFBRAVO.GET.USER.CM + [LAMBDA (BFILE CANDIDATE TEXTOBJ) (* ; "Edited 28-Nov-2023 17:38 by rmk") + (* ; "Edited 11-Sep-2023 13:15 by rmk") + (* ; "Edited 19-Aug-2023 23:24 by rmk") + (* ; "Edited 17-Aug-2023 09:46 by rmk") + + (* ;; " BFILE's directory, connected directory, logindirectory, DIRECTORIES") + + (DECLARE (USEDFREE TEDIT-DEFAULT-USER.CM)) + (CL:WHEN (STREAMP BFILE) + (SETQ BFILE (FULLNAME BFILE))) + (CL:WHEN (EQ CANDIDATE T) (* ; + "Because the test function's non-NIL value is passed in as CANDIDATE.") + (SETQ CANDIDATE NIL)) + + (* ;; "Returns the name of the user.cm file to be used in the conversion of Bravo BFILE. If CANDIDATE can't be found, the heuristic search is to search in the following order:") + + (PROG [USER.CM (DIRS `(,(PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY BFILE) + T NIL ,@DIRECTORIES] + (CL:WHEN [AND CANDIDATE (SETQ USER.CM (CL:IF (STREAMP CANDIDATE) + (FULLNAME CANDIDATE) + (FINDFILE CANDIDATE T DIRS))] + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM) + T) + (RETURN USER.CM)) + [SETQ USER.CM (OR (FINDFILE 'USER.CM T DIRS) + (AND TEDIT-DEFAULT-USER.CM (FINDFILE TEDIT-DEFAULT-USER.CM T DIRS] + (* (SELECTQ (MKATOM (U-CASE + (TEDIT.GETINPUT TEXTOBJ + (CONCAT "USER.CM = " USER.CM " ? ")))) + (NIL (TEDIT.PROMPTPRINT TEXTOBJ "Yes") + T) ((Y YES T) T) NIL)) + (if USER.CM + then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "USER.CM = " USER.CM) + T) + else (do (SETQ USER.CM (TEDIT.GETINPUT TEXTOBJ + "USER.CM file: (CR suppresses BRAVO conversion) ")) + (CL:WHEN (OR (NULL USER.CM) + (INFILEP USER.CM)) + (RETURN)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT USER.CM " not found") + T T) + (DISMISS 3000))) + (RETURN USER.CM]) + +(\TFBRAVO.USER.CM.LOOKS + [LAMBDA (USER.CM TEXTOBJ) (* ; "Edited 18-Aug-2023 18:47 by rmk") + (* ; "Edited 16-Aug-2023 21:33 by rmk") + (* ; "Edited 5-Aug-2023 17:15 by rmk") + (DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC USER.CM.ALIST)) + (SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM)) + (SETQ USER.CM.CHARLOOKS (create CHARLOOKS + CLNAME _ (\TFBRAVO.GETFONT 0 BRFAMILY) + CLSIZE _ (\TFBRAVO.GETFONT 0 BRSIZE) + CLOFFSET _ 0)) + (\TFBRAVO.FONT.FROM.CHARLOOKS USER.CM.CHARLOOKS) + (\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ) + (SETQ USER.CM.FMTSPEC (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST)) + (SETQ USER.CM.CHARLOOKS (\TEDIT.UNIQUIFY.CHARLOOKS USER.CM.CHARLOOKS TEXTOBJ)) + (SETQ USER.CM.FMTSPEC (\TEDIT.UNIQUIFY.PARALOOKS USER.CM.FMTSPEC TEXTOBJ)) + (SETTOBJ TEXTOBJ DEFAULTCHARLOOKS USER.CM.CHARLOOKS) + (SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC]) + +(\TFBRAVO.READ.USER.CM + [LAMBDA (USER.CM) (* ; "Edited 18-Aug-2023 22:26 by rmk") + (* ; "Edited 10-Aug-2023 13:02 by rmk") + (* ; "Edited 7-Aug-2023 12:52 by rmk") + (* ; "Edited 1-Aug-2023 22:11 by rmk") + (* ; "Edited 30-Jul-2023 18:57 by rmk") + (* gbn "17-Sep-84 18:53") + (CL:UNLESS USER.CM + (SETQ USER.CM 'USER.CM)) + + (* ;; "digests a user.cm file returning an alist of contents. Returns ((Font)) if no bravo section of user.cm file") + + (RESETLST + (PROG (ALIST LINE) + (CL:UNLESS (GETSTREAM USER.CM 'INPUT T) + [RESETSAVE (SETQ USER.CM (OPENSTREAM USER.CM 'INPUT 'OLD)) + `(PROGN (CLOSEF? OLDVALUE]) + (SETFILEINFO USER.CM 'EOL 'ANY) + (AND NIL (STREAMPROP USER.CM :EXTERNAL-FORMAT :THROUGH)) + (CL:UNLESS (AND (FILEPOS "[BRAVO]" USER.CM NIL NIL NIL T) + (EQ (CHARCODE EOL) + (READCCODE USER.CM))) + (RETURN NIL)) + + (* ;; "Read lines of the user.cm file until getting the empty line caused by eof (and the errortypelst entry) or until a line starts with '[' .") + + LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) + USER.CM USER.CM.RDTBL))) + (RETURN ALIST)) (* ; + "If the '[BRAVO]' section is the last one") + (COND + ((NULL LINE) (* ; "ignore blank lines") + (GO LLP)) + ((EQ (CAR LINE) + 'END.OF.FILE) + (RETURN ALIST)) + ((EQ (NTHCHAR (CAR LINE) + 1) + '%[) + + (* ;; "if '[' is the first character of the line, return the alist so far, because this is the beginning of the next section of the user.cm") + + (RETURN ALIST)) + ((NEQ (CADR LINE) + '%:) + (GO LLP))) + + (* ;; "CDDR to skip the :") + + (SELECTQ (PROG1 (CAR LINE) + (SETQ LINE (CDDR LINE))) + (FONT (CL:WHEN (FIXP (CAR LINE)) + (NCONC1 [OR (FASSOC 'Font ALIST) + (CAR (PUSH ALIST (CONS 'Font] + (create BRAVOFONT + BFFONTNUM _ (POP LINE) + BRFAMILY _ (POP LINE) + BRSIZE _ (POP LINE))))) + (TABS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((DefaultTab standard tab width) + ) + 'MICATOPOINTS) + ALIST))) + (MARGINS (SETQ ALIST (NCONC (\TFBRAVO.GETPARAMS LINE '((FirstLineLeftMargin + paragraph margin) + (LeftMargin left margin) + (RightMargin right margin)) + 'MICATOHALFPICAPOINTS) + ALIST))) + (LEAD (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((ParagraphLeading paragraph + leading) + (LineLeading line leading] + ALIST))) + NIL) + (GO LLP)))]) + +(\TFBRAVO.INIT.PARALOOKS + [LAMBDA (ALIST) (* ; "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") + + (* ;; "creates the default paragraph looks from the USER.CM. The numeric values are Bravo defaults as specfied in the Bravo documentation. This assumes that all mica values in the USER.CM have already been converted to points. ") + + (LET ((INITFMTSPEC (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC))) + + (* ;; "Bravo User Manual says that default tab is 36, the Bravo file format document says 60. I'm going with 36.") + + (with FMTSPEC INITFMTSPEC (SETQ LEFTMAR (OR (CADR (ASSOC 'LeftMargin ALIST)) + 85)) + (SETQ 1STLEFTMAR (OR (CADR (ASSOC 'FirstLineLeftMargin ALIST)) + LEFTMAR)) + (SETQ RIGHTMAR (OR (CADR (ASSOC 'RightMargin ALIST)) + 527)) + (SETQ LINELEAD (OR (CADR (ASSOC 'LineLeading ALIST)) + 1)) + (SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST)) + 0)) + (SETQ LEADAFTER 0) + (SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST)) + 36))) + (SETQ FMTSPECIALX 0) + (SETQ FMTSPECIALY 0)) + INITFMTSPEC]) + +(\TFBRAVO.INIT.PAGEFORMAT + [LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:03 by rmk") + (* ; "Edited 10-Aug-2023 10:02 by rmk") + (* gbn "31-May-85 17:13") + + (* ;; + "Page numbers centered and 1/2 inch from top of US Letter page. One inch top/bottom margins") + + (PUTTEXTPROP TEXTOBJ 'PAGENUMBERS T) + (PUTTEXTPROP TEXTOBJ 'PAGENUMBERX (FIXR (FQUOTIENT (TIMES 8.5 72) + 2))) + (PUTTEXTPROP TEXTOBJ 'PAGENUMBERY (IDIFFERENCE (ITIMES 11 72) + 36)) + (PUTTEXTPROP TEXTOBJ 'TOPMARGIN 72) + (PUTTEXTPROP TEXTOBJ 'BOTTOMMARGIN 72) + (PUTTEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T]) + +(\TFBRAVO.GETPARAMS + [LAMBDA (LINE NAMES SCALE) (* ; "Edited 10-Aug-2023 13:19 by rmk") + (* ; "Edited 7-Aug-2023 12:34 by rmk") + (* jds "27-Aug-84 09:37") + + (* ;; "If SCALE is provided, the values after = are numbers that will be scaled by SCALE.") + + (* ;; "LINE is a list of tokens for a particular line in the USER.CM. It may contain several parameters separated by commas, where each parameter is heading by a list of identifying names (CDR of the corresponding entry in NAMES) ending in =. (CAR N) for each N in NAMES is the tag that identifies that parameter in the resulting alist.") + + (LET (SEGMENTS VALUE ALIST) + + (* ;; "To simplify, first chop LINE into its comma-separated segments") + + (for LTAIL PREV (START _ LINE) on LINE do (if (NULL (CDR LTAIL)) + then (push SEGMENTS START) + (* ; "last one") + elseif (EQ '%, (CAR LTAIL)) + then (CL:WHEN PREV + (* ; "Cut off the comma") + (RPLACD PREV NIL)) + (push SEGMENTS START) + (SETQ START (CDR LTAIL)) + (SETQ PREV START) + else (SETQ PREV LTAIL))) + (SETQ SEGMENTS (DREVERSE SEGMENTS)) (* ; "Now aligned with NAMES") + [for N SEG in NAMES + when [SETQ SEG (find S in SEGMENTS + suchthat (for NTAIL on (CDR N) as SS in S + always (OR (AND (EQ '= SS) + (NULL (CDR NTAIL))) + (STRING.EQUAL SS (CAR NTAIL] + do (CL:WHEN (SETQ VALUE (CADR (MEMB '= SEG))) + (PUSH ALIST (LIST (CAR N) + (SELECTQ SCALE + (MICATOPOINTS (FIXR (FQUOTIENT VALUE MICASPERPT))) + (MICATOHALFPICAPOINTS + [ITIMES 6 (FIXR (FQUOTIENT VALUE (FTIMES MICASPERPT 6]) + VALUE))))] + (DREVERSE ALIST]) + +(\TFBRAVO.FIND.LAST.TRAILER + [LAMBDA (BSTREAM) (* ; "Edited 1-Aug-2023 23:35 by rmk") + (* ; "Edited 8-Sep-2022 17:15 by rmk") + (* jds "27-Dec-84 19:13") + + (* ;; "scans backwards from the end of the file trying to find the beginning of the last Bravo trailer. Returns NIL if not found, otherwise T") + + (LET [(STREAM (GETSTREAM BSTREAM 'INPUT] + (SETFILEPTR STREAM -1) + (CL:WHEN (AND (IGREATERP (GETFILEPTR STREAM) + 0) + (EQ (\BACKBIN STREAM) + (CHARCODE CR))) (* ; + "empty files are not Bravo files. It says here!") + (bind C while (AND (SETQ C (\BACKBIN STREAM)) + (FMEMB (CHARACTER C) + BRAVO.TRAILER.CHARS)) do NIL) + (EQ (\PEEKBIN STREAM) + (CHARCODE ^Z)))]) +) + + + +(* ;; "Decoding the Bravo file") + +(DEFINEQ + +(\TFBRAVO.PARSE.PARA + [LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "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") + (* ; "Edited 16-Aug-2023 21:28 by rmk") + (* ; "Edited 13-Jun-2021 09:46 by rmk:") + + (* ;; "OLDFMTSPEC are the paragraph looks of the previous paragraph, and RUNi are the character runs in the form returned by \TFBRAVO.READ.CHARLOOKS, except that here we fill in the character count for the last run. Leaves the input file pointer at the end of the trailer, after the CR.") + + (* ;; "^Z marks the end of a Bravo-looks paragraph which may have internal CR's that mark the end of Tedit paragraphs. The Bravo runs with different charlooks want to end up in different pieces all within the same paragraph.") + + (* ;; + "The carriage return that ends the trailer is its own final run, the trailer itself is skipped.") + + (DECLARE (USEDFREE USER.CM.CHARLOOKS USER.CM.FMTSPEC)) + (LET (BYTE PLEN ^ZPTR ENDCHAR FMTSPEC RUNS FORMATPTRS PARAGRAPH TABPTRS (PSTART (GETFILEPTR + BSTREAM)) + (FMTSPEC USER.CM.FMTSPEC)) + + (* ;; "BYTE=NIL at EOF, no terminating ^Z") + + (until (SELCHARQ (SETQ BYTE (BIN BSTREAM)) + (^Z (* ; + "End of Bravo paragraph, maybe some looks") + (SETQ ^ZPTR (SUB1 (GETFILEPTR BSTREAM))) + (* ; "Exclude the ^Z") + (SETQ PLEN (IDIFFERENCE ^ZPTR PSTART)) + (* ; + "Length of the Bravo paragraph without the ^Z") + [AND NIL (CL:WHEN FORMATPTRS + (PUSH FORMATPTRS (CONS (CHARCODE ^Z) + (SUB1 ^ZPTR))))] + (SETQ FORMATPTRS (DREVERSE FORMATPTRS)) + (SETQ TABPTRS (DREVERSE TABPTRS)) + T) + ((CR FORM LF) + (* ;; "Remember the position of an internal formatting char, i.e. the byte that perhaps should be the end of an internal paragraph.") + + [PUSH FORMATPTRS (CONS BYTE (SUB1 (GETFILEPTR BSTREAM] + NIL) + (TAB (* ; "Collect tab byte positions") + (PUSH TABPTRS (SUB1 (GETFILEPTR BSTREAM))) + NIL) + (NIL T) + NIL)) + (SELCHARQ BYTE + (^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")) + (create PARA + PARAFMTSPEC _ FMTSPEC + RUNS _ RUNS + FORMATPTRS _ FORMATPTRS]) + +(\TFBRAVO.READ.PARALOOKS + [LAMBDA (OLDFMTSPEC BSTREAM) (* ; "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") + (* ; "Edited 15-Aug-2023 00:23 by rmk") + (* ; "Edited 13-Aug-2023 19:58 by rmk") + (* ; "Edited 3-Aug-2023 00:20 by rmk") + (* ; "Edited 31-May-91 15:26 by jds") + (DECLARE (USEDFREE USER.CM.FMTSPEC)) + + (* ;; + "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)) + + (* ;; "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))) + + (* ;; "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)))) + do (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) + (l (SETQ LMFLAG T) + (replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\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))) + (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))) + (w 'HardcopyMode) + (j (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED)) + (c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED)) + (q + (* ;; "Profiles are marked here but then interpreted at the top") + + (replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with '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)))) + (%, (CL:WHEN (IGREATERP TABX 14) + (HELP 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")) + + (* ;; "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.") + + [if (EQ TABX 65535) + then (SETQ NAMEDTABS (DREMOVE (ASSOC TABNAME NAMEDTABS) + NAMEDTABS)) + else (RPLACD [OR (ASSOC TABNAME NAMEDTABS) + (CAR (push NAMEDTABS (CONS TABNAME] + (create TAB + TABX _ (FIXR (FQUOTIENT TABX MICASPERPT)) + TABKIND _ 'LEFT]) + (HELP "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)) + (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"]) + +(\TFBRAVO.CREATE.RUNS + [LAMBDA (BSTREAM PSTART PLEN) (* ; "Edited 14-Nov-2023 13:01 by rmk") + (* ; "Edited 9-Sep-2023 21:41 by rmk") + (* ; "Edited 20-Aug-2023 23:03 by rmk") + (bind RUNS RUN RLEN (RUNSTART _ PSTART) + (OLDCHARLOOKS _ USER.CM.CHARLOOKS) do (SETQ RUN (\TFBRAVO.READ.CHARLOOKS BSTREAM + OLDCHARLOOKS RUNSTART PLEN)) + (push RUNS RUN) + (SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN)) + (CL:WHEN (fetch (RUN RUNLAST) of RUN) + (RETURN (DREVERSE RUNS))) + (SETQ RLEN (fetch (RUN RUNLENGTH) of RUN)) + (* ; "Set up for next run") + (ADD RUNSTART RLEN) + (ADD PLEN (IMINUS RLEN)) + (SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN]) + +(\TFBRAVO.READ.CHARLOOKS + [LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "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") + + (* ;; "Read the character looks trailer building a TEDIT charlooks record. Most fields are immediately valid, however, the tabcolor is stored in the cluserinfo field of the looks, and the font is still in numeric form") + + (* ;; "The charlooks trailer (from \ to CR) consists of a sequence of run-looks. Each run-look is a sequence of commands followed by the length of the run. If the first run has no commands (i.e. the \ is followed immediately by a length-number), than the first run gets the USER.CM default looks.") + + (bind COMMAND LEN LAST VALUE TABNAMES (NEWCHARLOOKS _ (create CHARLOOKS using OLDCHARLOOKS)) + until (SETQ LEN (\TFBRAVO.READNUM? BSTREAM)) + do + (* ;; "Some command letters are followed by numeric arguments (f1 vs b). Any spaces around command letters are skipped. BIN is used here for one-byte arguments, but perhaps a version that skips initial spaces would be safter?") + + (SELCHARQ (SETQ COMMAND (BIN BSTREAM)) + (s (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with T)) + (S (replace (CHARLOOKS CLSTRIKE) of NEWCHARLOOKS with NIL)) + (u (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with T)) + (U (replace (CHARLOOKS CLULINE) of NEWCHARLOOKS with NIL)) + (b (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with T)) + (B (replace (CHARLOOKS CLBOLD) of NEWCHARLOOKS with NIL)) + (i (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with T)) + (I (replace (CHARLOOKS CLITAL) of NEWCHARLOOKS with NIL)) + (g "Graphic T --unsupported") + (G "Graphic NIL") + (v (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with NIL)) + (V (AND NIL (replace (CHARLOOKS CLINVISIBLE) of NEWCHARLOOKS with T))) + (t + (* ;; "Collect the named tabs for writerun") + + (PUSH TABNAMES (CHARACTER (BIN BSTREAM)))) + (f (* ; "Save the fontface until the end") + (SETQ VALUE (CHARACTER (BIN BSTREAM))) + (replace (CHARLOOKS CLSIZE) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRSIZE)) + (replace (CHARLOOKS CLNAME) of NEWCHARLOOKS with (\TFBRAVO.GETFONT VALUE BRFAMILY))) + (o (SETQ VALUE (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Superscript") + (replace (CHARLOOKS CLOFFSET) of NEWCHARLOOKS with (CL:IF (IGREATERP VALUE 127) + (IDIFFERENCE VALUE 256) + VALUE))) + (SPACE) + (CR + (* ;; "We hit the trailer-terminating CR, It is either the end-marker for the last run, or a signal that this paragraph has no run-look information. ") + + (if (EQ 0 PLEN) + then + (* ;; "If we have already accounted for all the pre-trailer characters, just return a trivial paragraph-final run pointing at the end-of-trailer CR") + + (SETQ RUNSTART (SUB1 (GETFILEPTR BSTREAM))) + (SETQ LEN 1) + (SETQ LAST T) + else (\BACKFILEPTR BSTREAM) (* ; + "Leave the CR to be read on the next (PLEN=0) call.") + (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")) + finally + + (* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length") + + (replace (CHARLOOKS CLUSERINFO) of NEWCHARLOOKS with (DREVERSE TABNAMES)) + (\TFBRAVO.FONT.FROM.CHARLOOKS NEWCHARLOOKS) + (RETURN (create RUN + RUNSTART _ RUNSTART + RUNLENGTH _ LEN + RUNLOOKS _ NEWCHARLOOKS + RUNLAST _ LAST]) + +(\TFBRAVO.FONT.FROM.CHARLOOKS + [LAMBDA (CHARLOOKS) (* ; "Edited 1-Aug-2023 13:21 by rmk") + (* ; "Edited 31-May-91 15:26 by jds") + + (* ;; "Takes a TEDIT CHARLOOKS with fields filled in (CLNAME = family name) and creates the font to fill it.") + + [replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS) + (fetch (CHARLOOKS CLSIZE) of CHARLOOKS) + (LIST (CL:IF (fetch (CHARLOOKS CLBOLD) + of CHARLOOKS) + 'BOLD + 'MEDIUM) + (CL:IF (fetch (CHARLOOKS CLITAL) + of CHARLOOKS) + 'ITALIC + 'REGULAR) + 'REGULAR] + CHARLOOKS]) + +(\TFBRAVO.READNUM? + [LAMBDA (BSTREAM REQUIRED SCALE) (* ; "Edited 10-Aug-2023 13:06 by rmk") + (* ; "Edited 9-Aug-2023 07:53 by rmk") + (* ; "Edited 5-Aug-2023 20:31 by rmk") + + (* ;; "If a digit appears as the first non-space character from the current stream position, the integer starting at that digit is returned. If MICAS, it is assumed that NUM is in micas and should be scaled to a multiple of 6 points (= 1/2 pica so that Tedit's margins aren't displayed as goofy decimals. The stream is left positioned before the first nondigit nonspace character.") + + (bind C (NUM _ 0) first (while (EQ (CHARCODE SPACE) + (SETQ C (\PEEKCCODE BSTREAM T))) do (BIN BSTREAM)) + (CL:UNLESS (DIGITCHARP C) + (CL:WHEN REQUIRED + (ERROR "Bravo command without a numeric argument at position " + (GETFILEPTR BSTREAM))) + (RETURN NIL)) do [SETQ NUM (IPLUS (ITIMES NUM 10) + (IDIFFERENCE (BIN BSTREAM) + (CHARCODE 0] + repeatwhile (DIGITCHARP (\PEEKCCODE BSTREAM T)) + finally (while (EQ (CHARCODE SPACE) + (\PEEKCCODE BSTREAM T)) do (BIN BSTREAM)) + (RETURN (SELECTQ SCALE + (MICATOHALFPICAPOINTS + [ITIMES 6 (FIXR (FQUOTIENT NUM (FTIMES MICASPERPT 6]) + (MICATOPOINTS (FIXR (FQUOTIENT NUM MICASPERPT))) + NUM]) +) + + + +(* ;; "Profile paragraphs") + +(DEFINEQ + +(\TFBRAVO.HANDLE.HEADING + [LAMBDA (BSTREAM TEXTOBJ HEADINGSTART) (* ; "Edited 20-Aug-2023 20:11 by rmk") + (* ; "Edited 18-Aug-2023 10:37 by rmk") + (* ; "Edited 12-Aug-2023 12:25 by rmk") + (* ; "Edited 9-Aug-2023 23:37 by rmk") + (* ; "Edited 4-Aug-2023 10:39 by rmk") + (* ; "Edited 1-Aug-2023 22:24 by rmk") + (* ; "Edited 31-May-91 15:26 by jds") + + (* ;; "Called from \TFBRAVO.PARSE.PROFILE.PARA. The heading is a paragraph beginning at the current position, presumably just a line with a looks trailer. Its paralooks have to be marked with special heading properties--heading type and special X and Y locations.") + + (DECLARE (USEDFREE USER.CM.FMTSPEC)) + (LET (HEADINGDESC HEADINGPARA HEADINGFMTSPEC) (* ; + "skip over the trailer of the profile para") + (SETFILEPTR BSTREAM HEADINGSTART) + (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.FMTSPEC BSTREAM TEXTOBJ)) + (SETQ HEADINGFMTSPEC (fetch (PARA PARAFMTSPEC) of HEADINGPARA)) + (replace (FMTSPEC FMTPARATYPE) of HEADINGFMTSPEC with 'PAGEHEADING) + + (* ;; "This is where the vertical tab info is placed for the heading, remove the special x and y and use them as the position for the descriptor") + + (SETQ HEADINGDESC (LIST (GENSYM 'PageHeading) + (OR (fetch (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC) + 0) + (OR (fetch (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC) + 0))) + (replace (FMTSPEC FMTPARASUBTYPE) of HEADINGFMTSPEC with (CAR HEADINGDESC)) + (replace (FMTSPEC FMTSPECIALX) of HEADINGFMTSPEC with (CADR HEADINGDESC)) + (replace (FMTSPEC FMTSPECIALY) of HEADINGFMTSPEC with (CADDR HEADINGDESC)) + (* ; + "now write out the heading paragraph") + (\TFBRAVO.INSERT.PARA HEADINGPARA BSTREAM TEXTOBJ MAX.FIXP) + HEADINGDESC]) + +(\TFBRAVO.PARSE.PROFILE.PARA + [LAMBDA (BSTREAM PARAGRAPH TEXTOBJ START) (* ; "Edited 22-Sep-2023 20:02 by rmk") + (* ; "Edited 19-Aug-2023 23:33 by rmk") + (* ; "Edited 17-Aug-2023 14:51 by rmk") + (* ; "Edited 10-Aug-2023 10:37 by rmk") + (* ; "Edited 1-Aug-2023 13:29 by rmk") + (* gbn " 3-Jun-85 17:23") + + (* ;; "Parse a Bravo profile paragraph, and set up the corresponding TEdit page looks, headings, page numbers.") + + (* ;; "START is the beginning of the profile lines, current fileptr (END) is the end of its looks information (which is kind of odd, since %"Margins: %" has no looks. At best it sets carryover tabs.") + + (* ;; "This code processes the profile settings, storing them away as TEXTOBJ properties for later installation. Presumably, if there are multiple valid profile paragraphs in the same file, then the settings of the last one will override earlier ones.") + + (* ;; "Heading lines are followed by separate paragraphs containing the formatted text of the heading. The parameters are saved in the HEADINGDESC") + + (* ;; "Returns T if this is truly a profile paragraph, beginning with one of the profile keywords, otherwise NIL. Either way, BSTREAM is positioned at the beginning of the next unprocessed paragraph") + + (* ;; "START") + + (bind LINE ROMAN UPPERCASE (END _ (GETFILEPTR BSTREAM)) first (SETFILEPTR BSTREAM START) + while (ILESSP (GETFILEPTR BSTREAM) + END) + do [ + (* ;; "Each RATOMS reads a line, the last line including the trailer characters. ^Z is a break so processing on the last line can stop at that token. Presumably the RATOMS will have reached END (and not gone past it), but we set the fileptr back to that position just in case, to set up for the next paragraph. Semi-colon is a sepr in the readtable, we don't have to worry about those.") + + (SETQ LINE (U-CASE (RATOMS (CHARACTER (CHARCODE CR)) + BSTREAM PROFILE.PARA.RDTBL))) + + (* ;; "Now we have to parse, checking and skipping the irrelevant keywords. Each keyword starts a line, each while runs until its end-token (CR?)") + + (SELECTQ (pop LINE) + (PAGE (* ; "parse the page numbers stuff") + (\TFBRAVO.ASSERT 'NUMBERS (pop LINE)) + (while LINE do (SELECTQ (pop LINE) + (NO (PUTTEXTPROP TEXTOBJ 'PAGENUMBERS 'NO)) + (YES (* ; "this is default ") + (PUTTEXTPROP TEXTOBJ 'PAGENUMBERS NIL)) + (FIRST (\TFBRAVO.ASSERT 'PAGE (pop LINE)) + (PUTTEXTPROP TEXTOBJ 'FIRSTPAGENO (pop LINE))) + (NOT-ON-FIRST-PAGE + (PUTTEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T)) + (X (PUTTEXTPROP TEXTOBJ 'PAGENUMBERX (\TOPOINTS 'WIDTH))) + (Y (PUTTEXTPROP TEXTOBJ 'PAGENUMBERY (\TOPOINTS 'HEIGHT))) + (ROMAN (SETQ ROMAN T)) + (UPPERCASE (SETQ UPPERCASE T)) + NIL))) + (COLUMNS (* ; "parse the columns numbers stuff") + (PUTTEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS (pop LINE)) + (while LINE do (SELECTQ (pop LINE) + (EDGE (\TFBRAVO.ASSERT 'MARGIN (pop LINE)) + (PUTTEXTPROP TEXTOBJ 'EDGEMARGIN (\TOPOINTS + 'WIDTH))) + (BETWEEN (\TFBRAVO.ASSERT 'COLUMNS (pop LINE)) + (PUTTEXTPROP TEXTOBJ 'BETWEENCOLUMNS + (\TOPOINTS 'WIDTH))) + NIL))) + (MARGINS (* ; "parse the margins stuff") + (while LINE do (SELECTQ (pop LINE) + (TOP (PUTTEXTPROP TEXTOBJ 'TOPMARGIN (\TOPOINTS + 'HEIGHT))) + (BOTTOM (PUTTEXTPROP TEXTOBJ 'BOTTOMMARGIN + (\TOPOINTS 'HEIGHT))) + (BINDING (PUTTEXTPROP TEXTOBJ 'BINDING (\TOPOINTS))) + NIL))) + (ODD (\TFBRAVO.ASSERT 'HEADING (pop LINE)) + (CL:WHEN (EQ (CAR LINE) + 'NOT-ON-FIRST-PAGE) + (pop LINE) + (PUTTEXTPROP TEXTOBJ 'ODDHEADING.NOTONFIRSTPAGE T)) + (* ; "Heading is on the next line") + (PUTTEXTPROP TEXTOBJ 'ODDHEADINGDESC (\TFBRAVO.HANDLE.HEADING BSTREAM TEXTOBJ END + )) + + (* ;; "We advance past the heading paragraph, presumably we are done.") + + (SETQ END (GETFILEPTR BSTREAM))) + (EVEN (\TFBRAVO.ASSERT (pop LINE) + 'HEADING) + (CL:WHEN (EQ (CAR LINE) + 'NOT-ON-FIRST-PAGE) + (pop LINE) + (PUTTEXTPROP TEXTOBJ 'EVENHEADING.NOTONFIRSTPAGE T)) + (PUTTEXTPROP TEXTOBJ 'EVENHEADINGDESC (\TFBRAVO.HANDLE.HEADING BSTREAM TEXTOBJ + END)) + (SETQ END (GETFILEPTR BSTREAM))) + (HEADING (CL:WHEN (EQ (CAR LINE) + 'NOT-ON-FIRST-PAGE) + (pop LINE) + (PUTTEXTPROP TEXTOBJ 'HEADING.NOTONFIRSTPAGE T)) + (PUTTEXTPROP TEXTOBJ 'HEADINGDESC (\TFBRAVO.HANDLE.HEADING BSTREAM TEXTOBJ + END)) + (SETQ END (GETFILEPTR BSTREAM))) + ((LINE PRIVATE) (* ; + "Line numbers, private data not supported") + NIL) + (PROGN (* ; + "Not a profile line, presumably a mistaken q.") + (SETFILEPTR BSTREAM END) + (replace (FMTSPEC FMTPARATYPE) of (fetch (PARA PARAFMTSPEC) of PARAGRAPH) + with NIL) + (RETURN NIL] repeatuntil [EQ (CAR LINE) + (CONSTANT (CHARACTER (CHARCODE ^Z] + finally (CL:WHEN ROMAN + (PUTTEXTPROP TEXTOBJ 'ROMAN (CL:IF UPPERCASE + 'X + 'x))) + + (* ;; "Set the file to the beginning of the next paragraph") + + (SETFILEPTR BSTREAM END) + (RETURN T]) +) + + + +(* ;; "Creating the text stream") + +(DEFINEQ + +(\TFBRAVO.INSERT.PARA + [LAMBDA (PARA BSTREAM TEXTOBJ) (* ; "Edited 20-Aug-2023 16:13 by rmk") + + (* ;; "Inserts pieces into TEXTOBJ that correspond to the runs in PARA. PARA may be broken up at internal CR's to get spacing and tabs right.") + + (for P PFMTSPEC in (\TFBRAVO.SPLIT.PARA PARA) + do (SETQ PFMTSPEC (fetch (PARA PARAFMTSPEC) of P)) + (for RUN in (fetch (PARA RUNS) of P) do (SETQ PFMTSPEC (\TFBRAVO.RUN.TABSPEC RUN PFMTSPEC)) + (\TFBRAVO.INSERT.RUN RUN BSTREAM PFMTSPEC TEXTOBJ]) + +(\TFBRAVO.INSERT.RUN + [LAMBDA (RUN BSTREAM PARAFMTSPEC TEXTOBJ) (* ; "Edited 16-Jan-2024 18:28 by rmk") + (* ; "Edited 29-Dec-2023 11:50 by rmk") + (* ; "Edited 23-Sep-2023 12:11 by rmk") + (* ; "Edited 23-Aug-2023 08:31 by rmk") + (* ; "Edited 20-Aug-2023 16:12 by rmk") + (* ; "Edited 19-Aug-2023 14:47 by rmk") + + (* ;; "A Bravo run can include many CR's each of which should end a separate TEDIT paragraph. Unless we want to think of those as paragraph internal meta-CRs ?") + + (* ;; "PARAFMTSPEC is the intended paragraph PARALOOKS for the paragraph, providing the margins, line leading etc. common to all runs. It may be specialized for each run to encode the tabs that that run actually selects (via \TFBRAVO.RUN.TABSPEC") + + (CL:WHEN (IGREATERP (fetch (RUN RUNLENGTH) of RUN) + 0) (* ; "No need for an empty piece") + (LET ((NCHARS (fetch (RUN RUNLENGTH) of RUN)) + (RUNSTART (fetch (RUN RUNSTART) of RUN)) + FATP PC) + (SETQ PC (create PIECE + PLEN _ NCHARS + PLOOKS _ (\TEDIT.UNIQUIFY.CHARLOOKS (fetch (RUN RUNLOOKS) of RUN) + TEXTOBJ) + PPARALOOKS _ (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ) + PPARALAST _ (fetch (RUN RUNLAST) of RUN))) + (if (STRINGP RUNSTART) + then + (* ;; "Run with at least one character converted to XCCS.") + + (SETQ FATP (fetch (STRINGP FATSTRINGP) of RUNSTART)) + (with PIECE PC (SETQ PCONTENTS RUNSTART) + (SETQ PTYPE (CL:IF FATP + FATSTRING.PTYPE + THINSTRING.PTYPE)) + (SETQ PBYTESPERCHAR (CL:IF FATP + 2 + 1)) + (SETQ PBINABLE (NOT FATP)) + (SETQ PBYTELEN (UNFOLD NCHARS 2)) + (SETQ PUTF8BYTESPERCHAR 2)) + else (with PIECE PC (SETQ PCONTENTS BSTREAM) + (SETQ PFPOS RUNSTART) + (SETQ PTYPE THINFILE.PTYPE) + (SETQ PBINABLE T) + (SETQ PBYTESPERCHAR 1) + (SETQ PBYTELEN NCHARS) + (SETQ PUTF8BYTESPERCHAR 2))) + (\INSERTPIECE PC NIL TEXTOBJ) + PC))]) + +(\TFBRAVO.SPLIT.PARA + [LAMBDA (PARA) (* ; "Edited 9-Sep-2023 21:35 by rmk") + (* ; "Edited 22-Aug-2023 23:45 by rmk") + + (* ;; "The Bravo paragraph PARA may contain internal CRs or FORMS that should be broken out into separate Tedit paragraphs. All of them share the same basic FMTSPEC, except that paragraphs after the first should have 0 for paragraph leading and first-paragraph margins. The charlooks for each run are carried over to the splits.") + + (* ;; "However, we leave alone a paragraph with a special location, since we don't know how to arrange the positions of the later sub-paragraphs.") + + (* ;; "After the paragraphs have been split, we make another pass to see if we can decode tab t0. We could also try to merge runs with the same charlooks, but TEDIT.PUT does that merging when the convereted text is saved.") + + (* ;; "This smashes PARA's runs.") + + (LET ((PARAFMTSPEC (fetch (PARA PARAFMTSPEC) of PARA)) + NEWPARAS) + + (* ;; + "RUNSTART is STRINGP for a math/hippo or other character that has been translated to XCCS") + + (SETQ NEWPARAS + (if [AND (fetch (PARA FORMATPTRS) of PARA) + (FMEMB (fetch (FMTSPEC FMTSPECIALX) of PARAFMTSPEC) + '(0 NIL)) + (FMEMB (fetch (FMTSPEC FMTSPECIALY) of PARAFMTSPEC) + '(0 NIL] + then [for PTR POS RUN FIRSTRUN NEWRUNLENGTH (RUNS _ (fetch (PARA RUNS) of PARA)) + in (fetch (PARA FORMATPTRS) of PARA) eachtime (SETQ POS (CDR PTR)) + (SETQ FIRSTRUN RUNS) + when [SETQ RUN (find R in old RUNS unless (STRINGP (fetch (RUN RUNSTART) + of R)) + suchthat (AND (IGEQ POS (fetch (RUN RUNSTART) of R)) + (ILESSP POS (IPLUS (fetch (RUN RUNSTART) + of R) + (fetch (RUN RUNLENGTH) + of R] + collect (SETQ RUNS (PROG1 (CDR RUNS) + (RPLACD RUNS))) + (* ; "Chop off but keep the next batch.") + (replace (RUN RUNLAST) of RUN with T) + (* ; "RUN ends its paragraph") + [SETQ NEWRUNLENGTH (ADD1 (IDIFFERENCE POS (fetch (RUN RUNSTART) + of RUN] + (CL:UNLESS (EQ NEWRUNLENGTH (fetch (RUN RUNLENGTH) of RUN)) + (* ; "POS pointed to the middle of RUN") + + (* ;; "Shorten RUN to characters up to and including the POS character. Subsequent characters go into a new suffix-run that will start the next paragraph.") + + (push RUNS (create RUN using RUN RUNSTART _ (ADD1 POS) + RUNLENGTH _ (IDIFFERENCE + (fetch (RUN RUNLENGTH) + of RUN) + NEWRUNLENGTH))) + (replace (RUN RUNLENGTH) of RUN with NEWRUNLENGTH)) + + (* ;; "Fill in RUNS here, FMTSPEC below. No more FORMATPTRS") + + (create PARA + RUNS _ FIRSTRUN) + finally (CL:WHEN RUNS (* ; "Pick up anything that's left.") + (NCONC1 $$VAL (create PARA using PARA RUNS _ RUNS))) + + (* ;; "The first paragraph has LEADAFTER=0, all the others have 1STLEFTMAR=LEFTMAR and LEADAFTER=LEADBEFORE=0, except that the last one keeps the original LEADAFTER. Tabs are retained across all the runs.") + + (replace (PARA PARAFMTSPEC) of (CAR $$VAL) + with (create FMTSPEC using PARAFMTSPEC LEADAFTER _ 0)) + (for PTAIL (NEWFMTSPEC _ (create FMTSPEC + using PARAFMTSPEC 1STLEFTMAR _ + (fetch (FMTSPEC LEFTMAR) of PARAFMTSPEC + ) + LEADBEFORE _ 0 LEADAFTER _ 0)) + on (CDR $$VAL) + do (replace (PARA PARAFMTSPEC) of (CAR PTAIL) + with (CL:IF (CDR PTAIL) + NEWFMTSPEC + (create FMTSPEC using NEWFMTSPEC LEADAFTER _ + (fetch (FMTSPEC LEADAFTER) + of PARAFMTSPEC)))] + else (CONS PARA))) + + (* ;; "If t0 is the first tab specfied for a run, tx is the last tab of the previous run, and t(x+1) is defined, then change t0 to t(x+1).") + + [for NP in NEWPARAS + do (for RUN LASTTAB RUNTABS TAB0TAIL (TABDEFS _ (fetch (PARA PARATABDEFS) of NP)) + in (fetch (PARA RUNS) of NP) + do (SETQ RUNTABS (fetch (RUN RUNTABS) of RUN)) + (if (AND (SETQ TAB0TAIL (MEMB 0 RUNTABS)) + (SETQ LASTTAB (OR (CAR (NLEFT RUNTABS 1 TAB0TAIL)) + LASTTAB)) + (ASSOC (ADD1 LASTTAB) + TABDEFS)) + then (SETQ RUNTABS (COPY RUNTABS)) + (RPLACA (MEMB 0 RUNTABS) + (ADD1 LASTTAB)) + (SETQ LASTTAB (CAR (LAST RUNTABS))) + (change (fetch (RUN RUNLOOKS) of RUN) + (create CHARLOOKS using DATUM)) + (replace (RUN RUNTABS) of RUN with RUNTABS) + else (SETQ LASTTAB (CAR (LAST RUNTABS] + NEWPARAS]) + +(\TFBRAVO.RUN.TABSPEC + [LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 22-Aug-2023 16:54 by rmk") + (* ; "Edited 19-Aug-2023 15:47 by rmk") + + (* ;; "The CLUSERINFO contains a list of named tabs specified for this and presumably defined in the paragraph-wide PARAFMTSPEC. This returns a FMTSPEC for this run that only includes the named tabs that this run calls for.") + + (* ;; "") + + (* ;; "For the first run, the PARAFMTSPEC is the unspecialized run for the paragraph, with empty TABSPEC. Each subsequent run is given the FMTSPEC for the last run, so the tabs that were selected there are known. This is because t0 is loosely specified as picking the next tab in the FMTUSERINFO after the last tab that was used in the previous run (I think). (Or perhaps as setting the next tabs TABX as the interval?)") + + (* ;; "") + + (* ;; "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. ") + + (* ;; "") + + (* ;; "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))) + (RUNTABS (fetch (RUN RUNTABS) of RUN)) + TAB TABSPEC) + (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 + + (* ;; + "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] + + (* ;; "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 \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)) + )) + PARAFMTSPEC]) + +(\TFBRAVO.INSTALL.PAGEFORMAT + [LAMBDA (TEXTOBJ) (* ; "Edited 22-Sep-2023 20:04 by rmk") + (* ; "Edited 17-Aug-2023 14:31 by rmk") + (* ; "Edited 13-Jun-90 01:00 by mitani") + + (* ;; "using the information from the profile paragraphs, this function installs the pageframes") + + (LET (FIRSTPAGENO PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS + BETWEENCOLUMNS COLUMNWIDTH ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC + HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE + ODDHEADING.NOTONFIRSTPAGE FIRST VERSO RECTO PAGEPROPS ROMAN) + (for VAR + in '(FIRSTPAGENO PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN + NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC + EVENHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE + EVENHEADING.NOTONFIRSTPAGE ODDHEADING.NOTONFIRSTPAGE ROMAN) + do (SET VAR (GETTEXTPROP TEXTOBJ VAR))) + + (* ;; "this assumes that TEdit does not build a default page spec. If it ever does, then this logic must change.") + + (* ;; "the default page frame is always built. It is sometimes built as the only page frame when there is no headings specified. However, if heading is specified with the not-on-first-page specified, then we must build the default page frame simply for that reason") + + (CL:WHEN NUMBEROFCOLUMNS + + (* ;; "if this is to be printed multicolumn then determine the column width from the numberofcolumns and the space between them. 72 is points per inch, US Letter width.") + + (SETQ COLUMNWIDTH (IQUOTIENT (IDIFFERENCE [IDIFFERENCE (CONSTANT (TIMES 8.5 72)) + (ITIMES 2 (GETTEXTPROP TEXTOBJ + 'EDGEMARGIN] + (ITIMES (SUB1 NUMBEROFCOLUMNS) + BETWEENCOLUMNS)) + NUMBEROFCOLUMNS))) + [SETQ PAGEPROPS `(STARTINGPAGE# ,(OR FIRSTPAGENO 1] + (PUSH PAGEPROPS 'FOLIOINFO (LIST (SELECTQ ROMAN + (x 'LOWERROMAN) + (X 'UPPERROMAN) + 'ARABIC) + "" "")) + (SETQ PAGENUMBERS (NEQ PAGENUMBERS 'NO)) + (SETQ FIRST (TEDIT.SINGLE.PAGEFORMAT (AND PAGENUMBERS (NOT PAGENUMBER.NOTONFIRSTPAGE)) + PAGENUMBERX PAGENUMBERY NIL NIL 0 0 TOPMARGIN BOTTOMMARGIN + NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS [COND + (HEADINGDESC + (CL:UNLESS + HEADING.NOTONFIRSTPAGE + (LIST HEADINGDESC)) + ) + (ODDHEADINGDESC + (CL:UNLESS + ODDHEADING.NOTONFIRSTPAGE + (LIST HEADINGDESC)) + ) + (EVENHEADINGDESC + (CL:UNLESS + EVENHEADING.NOTONFIRSTPAGE + (LIST + EVENHEADINGDESC + ] + 'POINTS PAGEPROPS)) + (CL:WHEN (OR ODDHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) + (SETQ VERSO (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 + TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS + (COND + (ODDHEADINGDESC (LIST ODDHEADINGDESC)) + (HEADINGDESC (LIST HEADINGDESC))) + 'POINTS PAGEPROPS))) + (CL:WHEN (OR EVENHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) + (SETQ RECTO (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 + TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS COLUMNWIDTH BETWEENCOLUMNS + (COND + (EVENHEADINGDESC (LIST EVENHEADINGDESC)) + (HEADINGDESC (LIST HEADINGDESC))) + 'POINTS PAGEPROPS))) + (TEDIT.PAGEFORMAT TEXTOBJ (TEDIT.COMPOUND.PAGEFORMAT FIRST VERSO RECTO]) +) (DEFINEQ -(\TFBRAVO.FIND.LAST.TRAILER - [LAMBDA (FILE) (* jds "27-Dec-84 19:13") - - (* scans backwards from the end of the file trying to find the beginning of the - last Bravo trailer. Returns NIL if not found, otherwise T) - - (PROG ((STREAM (GETSTREAM FILE))) - (SETFILEPTR STREAM -1) - (RETURN (COND - [(IGREATERP (GETFILEPTR STREAM) - 0) - (COND - ((NEQ (\BACKBIN STREAM) - (CHARCODE CR)) (* last character of a trailer must be - a carriage return) - NIL) - (T (while (AND (IGREATERP (GETFILEPTR STREAM) - 0) - (FMEMB (CHARACTER (\BACKBIN STREAM)) - BRAVO.TRAILER.CHARS)) do NIL) - (COND - ((EQ (\PEEKBIN STREAM) - (CHARCODE ^Z)) (* this is a potentially legal trailer) - T) - (T NIL] - (T (* empty files are not Bravo files. - It says here!) - NIL]) - -(\TFBRAVO.HANDLE.HEADING - [LAMBDA (INPUT TEXTOBJ) (* ; "Edited 31-May-91 15:26 by jds") - (* Called from - \tfbravo.parse.profile.para) - (DECLARE%: USEDFREE NEXTPARAPTR) - (PROG ((AFTERHEADINGPTR) - PARALOOKS HEADINGDESC) - (SETFILEPTR IN NEXTPARAPTR) (* skip over the trailer of the - profile para) - (SETQ HEADINGPARA (\TFBRAVO.PARSE.PARA USER.CM.PARALOOKS IN)) - (SETQ AFTERHEADINGPTR (GETFILEPTR IN)) - (SETQ PARALOOKS (fetch PARALOOKS of HEADINGPARA)) - (replace (FMTSPEC FMTPARATYPE) of PARALOOKS with 'PAGEHEADING) - - (* This is where the vertical tab info is placed for the heading, remove the - special x and y and use them as the position for the descriptor) - - (SETQ HEADINGDESC (LIST (GENSYM 'PageHeading) - (OR (fetch (FMTSPEC FMTSPECIALX) of PARALOOKS) - 0) - (OR (fetch (FMTSPEC FMTSPECIALY) of PARALOOKS) - 0))) - (replace (FMTSPEC FMTPARASUBTYPE) of PARALOOKS with (CAR HEADINGDESC)) - (replace (FMTSPEC FMTSPECIALX) of PARALOOKS with NIL) - (replace (FMTSPEC FMTSPECIALY) of PARALOOKS with NIL) - (* now write out the paragraph) - (SETFILEPTR IN NEXTPARAPTR) - (\TFBRAVO.WRITE.PARAGRAPH HEADINGPARA IN TEXTOBJ MAX.FIXP) - (SETQ NEXTPARAPTR AFTERHEADINGPTR) - (RETURN HEADINGDESC]) - -(\TFBRAVO.INIT.CHARLOOKS - [LAMBDA NIL (* ; "Edited 31-May-91 15:25 by jds") - - (* * Creates the charlooks instance which is used as the template for the rest) - - (PROG ((LOOKS (create CHARLOOKS))) - (replace (CHARLOOKS CLSIZE) of LOOKS with (\TFBRAVO.GET.FONTSIZE 0)) - (replace (CHARLOOKS CLNAME) of LOOKS (\TFBRAVO.GET.FONTSTYLE 0)) - (* (FONTCREATE (\TFBRAVO.GET.FONTSTYLE) - (fetch (CHARLOOKS CLSIZE) of LOOKS))) - (replace (CHARLOOKS CLOFFSET) of LOOKS with 0) - (RETURN LOOKS]) - -(\TFBRAVO.INIT.PAGEFORMAT - [LAMBDA (TEXTOBJ) (* gbn "31-May-85 17:13") - - (* * installs the default values of the page formatting nonsense as textprops) - - (TEXTPROP TEXTOBJ 'PAGENUMBERS T) - (TEXTPROP TEXTOBJ 'PAGENUMBERX 307) - (TEXTPROP TEXTOBJ 'PAGENUMBERY 756) - (TEXTPROP TEXTOBJ 'TOPMARGIN 72) - (TEXTPROP TEXTOBJ 'BOTTOMMARGIN 72) - (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE T]) - -(\TFBRAVO.INSTALL.PAGEFORMAT - [LAMBDA (TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") - - (* * using the information from the profile paragraphs, this function installs - the pageframes) - - (PROG (PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS BETWEENCOLUMNS - ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC HEADING.NOTONFIRSTPAGE - PAGENUMBER.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE ODDHEADING.NOTONFIRSTPAGE - PAGEFRAMES) - (for VAR - in '(PAGENUMBERS PAGENUMBERX PAGENUMBERY TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS - BETWEENCOLUMNS ODDHEADINGDESC HEADINGDESC EVENHEADINGDESC - HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE EVENHEADING.NOTONFIRSTPAGE - ODDHEADING.NOTONFIRSTPAGE) do (SET VAR (TEXTPROP TEXTOBJ VAR))) - (SETQ PAGEFRAMES (replace (TEXTOBJ TXTPAGEFRAMES) of TEXTOBJ with (create TFBRAVOPAGEFRAMES - ))) - - (* this assumes that TEdit does not build a default page spec. - If it ever does, then this logic must change.) - - (* * the default page frame is always built. - It is sometimes built as the only page frame when there is no headings specified. - However, if heading is specified with the not-on-first-page specified, then we - must build the default page frame simply for that reason) - - (replace (TFBRAVOPAGEFRAMES TFBRAVODEFAULT) of PAGEFRAMES - with (TEDIT.SINGLE.PAGEFORMAT (AND PAGENUMBERS (NOT PAGENUMBER.NOTONFIRSTPAGE)) - PAGENUMBERX PAGENUMBERY NIL NIL 0 0 TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS - NIL BETWEENCOLUMNS [COND - (HEADINGDESC (if HEADING.NOTONFIRSTPAGE - then NIL - else (LIST HEADINGDESC))) - (ODDHEADINGDESC (if ODDHEADING.NOTONFIRSTPAGE - then NIL - else (LIST HEADINGDESC))) - (EVENHEADINGDESC (if EVENHEADING.NOTONFIRSTPAGE - then NIL - else (LIST EVENHEADINGDESC] - 'POINTS)) - [COND - ((OR ODDHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) - (replace TFBRAVOODD of PAGEFRAMES - with (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 - TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS - (COND - (ODDHEADINGDESC (LIST ODDHEADINGDESC)) - (HEADINGDESC (LIST HEADINGDESC)) - (T NIL)) - 'POINTS] - [COND - ((OR EVENHEADINGDESC HEADING.NOTONFIRSTPAGE PAGENUMBER.NOTONFIRSTPAGE) - (replace TFBRAVOEVEN of PAGEFRAMES - with (TEDIT.SINGLE.PAGEFORMAT PAGENUMBERS PAGENUMBERX PAGENUMBERY NIL NIL 0 0 - TOPMARGIN BOTTOMMARGIN NUMBEROFCOLUMNS NIL BETWEENCOLUMNS - (COND - (EVENHEADINGDESC (LIST EVENHEADINGDESC)) - (HEADINGDESC (LIST HEADINGDESC)) - (T NIL)) - 'POINTS] - (RETURN]) - -(\TFBRAVO.PARSE.PROFILE.PARA - [LAMBDA (IN PARA TEXTOBJ) (* gbn " 3-Jun-85 17:23") - - (* * Parse a Bravo profile paragraph, and set up the corresponding TEdit page - looks, headings, page numbers, Much of the state for building the pageframe must - be stuffed on the textstream, so that after this fn has been called for the last - time, the pageframe can be built) - - (DECLARE%: USEDFREE NEXTPARAPTR) - (PROG (TOKEN TOKENS (PARAEND NEXTPARAPTR)) - - (* * check that the positioning takes into account binding and edgemargin etc.) - - (while (ILESSP (GETFILEPTR IN) - PARAEND) - do (SETQ TOKENS (U-CASE (RATOMS (CHARACTER (CHARCODE EOL)) - IN PROFILE.PARA.RDTBL))) - (SELECTQ (SETQ TOKEN (pop TOKENS)) - (PAGE (* parse the page numbers stuff) - (\TFBRAVO.ASSERT 'NUMBERS (pop TOKENS)) - (while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS)) - (NO (TEXTPROP TEXTOBJ 'PAGENUMBERS 'NIL)) - (YES (* this is default)) - (FIRST (\TFBRAVO.ASSERT 'PAGE (pop TOKENS)) - - (* If a first page is specified, we can't handle that yet, but at least number - the first page, since the only way to number the first page in Bravo is to - specify the number for the first page. Not-on-first-page is assumed) - - (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE - 'NIL) - (TEXTPROP TEXTOBJ 'FIRSTPAGENO (pop TOKENS))) - (NOT-ON-FIRST-PAGE - (TEXTPROP TEXTOBJ 'PAGENUMBER.NOTONFIRSTPAGE - 'T)) - (X (TEXTPROP TEXTOBJ 'PAGENUMBERX ( - \TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (Y (TEXTPROP TEXTOBJ 'PAGENUMBERY ( - \TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (ROMAN (* tough, I don't do Roman Numerals) - NIL) - (PROGN (* otherwise, just presume we've hit - the end of the page number stuff) - NIL)))) - (COLUMNS (* parse the columns numbers stuff) - (TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS (pop TOKENS)) - (while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS)) - (EDGE (\TFBRAVO.ASSERT 'MARGIN (pop TOKENS)) - (TEXTPROP TEXTOBJ 'EDGEMARGIN ( - \TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (BETWEEN (\TFBRAVO.ASSERT 'COLUMNS (pop TOKENS)) - (TEXTPROP TEXTOBJ 'BETWEENCOLUMNS - (\TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (PROGN NIL)))) - (MARGINS (* parse the margins stuff) - (while TOKENS do (SELECTQ (SETQ TOKEN (pop TOKENS)) - (TOP (TEXTPROP TEXTOBJ 'TOPMARGIN ( - \TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (BOTTOM (TEXTPROP TEXTOBJ 'BOTTOMMARGIN - (\TFBRAVO.PARSE.PROFILE.VALUE TOKENS - ))) - (BINDING (TEXTPROP TEXTOBJ 'BINDING ( - \TFBRAVO.PARSE.PROFILE.VALUE - TOKENS))) - (PROGN (* otherwise, just presume we've hit - the end of the page number stuff) - NIL)))) - (ODD (\TFBRAVO.ASSERT (pop TOKENS) - 'HEADING) - (COND - ((AND TOKENS (EQ (CAR TOKENS) - 'NOT-ON-FIRST-PAGE)) - (pop TOKENS) - (TEXTPROP TEXTOBJ 'ODDHEADING.NOTONFIRSTPAGE T))) - (TEXTPROP TEXTOBJ 'ODDHEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ))) - (EVEN (\TFBRAVO.ASSERT (pop TOKENS) - 'HEADING) - (COND - ((AND TOKENS (EQ (CAR TOKENS) - 'NOT-ON-FIRST-PAGE)) - (pop TOKENS) - (TEXTPROP TEXTOBJ 'EVENHEADING.NOTONFIRSTPAGE T))) - (TEXTPROP TEXTOBJ 'EVENHEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ))) - (HEADING (COND - ((AND TOKENS (EQ (CAR TOKENS) - 'NOT-ON-FIRST-PAGE)) - (pop TOKENS) - (TEXTPROP TEXTOBJ 'HEADING.NOTONFIRSTPAGE T))) - (TEXTPROP TEXTOBJ 'HEADINGDESC (\TFBRAVO.HANDLE.HEADING IN TEXTOBJ))) - (LINE (* don't support Line Numbers) - NIL) - (PRIVATE (* private data stamp bull, ignore) - NIL) - (PROGN (* do nothing with this line,) - NIL))) (* The left margin is 0 for all bravo - relative measurements) - (COND - ((TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS) - - (* if this is to be printed multicolumn then determine the column width from the - numberofcolumns and the space between them) - - (TEXTPROP TEXTOBJ 'COLUMNWIDTH (IQUOTIENT [IDIFFERENCE - [IDIFFERENCE (CONSTANT (TIMES 8.5 PTSPERINCH - )) - (ITIMES 2 (TEXTPROP TEXTOBJ - 'EDGEMARGIN] - (ITIMES (SUB1 (TEXTPROP TEXTOBJ - 'NUMBEROFCOLUMNS)) - (TEXTPROP TEXTOBJ 'BETWEENCOLUMNS] - (TEXTPROP TEXTOBJ 'NUMBEROFCOLUMNS]) - -(\TFBRAVO.PARSE.PROFILE.VALUE - [LAMBDA (TOKENLIST) (* gbn "15-Nov-84 13:48") - - (* * returns a value always specified in pts, regardless of whether it was that - way in the token list (NB since RPLNODE is being used, there must always be a - token after the value and/or inches sign)) - - (PROG ([VALUE (PROG1 (CAR TOKENLIST) - (RPLNODE2 TOKENLIST (CDR TOKENLIST)))] - (POINTSPERINCH 72.27) - (INCHES '%")) - (if (EQ (CAR TOKENLIST) - INCHES) - then (SETQ VALUE (TIMES VALUE POINTSPERINCH)) - (RPLNODE2 TOKENLIST (CDR TOKENLIST))) - (RETURN (FIX VALUE]) - -(\TFBRAVO.GET.FONTSIZE - [LAMBDA (FONT) (* gbn "19-Sep-84 01:47") - - (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING L FREE, BEST TO REPLACE WITH AN - ARRAY IN FACT) - - (CADDR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST]) - -(\TFBRAVO.GET.FONTSTYLE - [LAMBDA (FONT) (* gbn "19-Sep-84 01:46") - - (* ADD CL:DECLARATION TO ADMIT THAT YOU ARE USING USER.CM.ALIST FREE, BEST TO - REPLACE WITH AN ARRAY IN FACT) - - (CADR (FASSOC FONT (FASSOC 'Font USER.CM.ALIST]) - -(\TFBRAVO.WRITE.RUN - [LAMBDA (RUN IN PARALOOKS TEXTOBJ) (* ; "Edited 13-Jun-2021 09:44 by rmk:") - (PROG (START END NAMEDTABNUMBER (LOOKS (fetch (RUN RUNLOOKS) of RUN))) - (SETQ NAMEDTABNUMBER (fetch (CHARLOOKS CLUSERINFO) of (fetch (RUN RUNLOOKS) of RUN))) - (COND - ((ILEQ (fetch (RUN RUNLENGTH) of RUN) - 0) - (RETURN)) - ([AND NAMEDTABNUMBER (EQUAL (PEEKC) - (CHARACTER (CHARCODE ^I] - - (* only treat the run like a tab if it has charcode 9, even if it has a tab - number. Color is overloaded onto tab numbers in BRAVO. - Jerks! Jerks!) - - (\TFBRAVO.ADD.NAMEDTAB TEXTOBJ NAMEDTABNUMBER PARALOOKS)) - (T (SETQ END (IPLUS (SETQ START (GETFILEPTR IN)) - (fetch (RUN RUNLENGTH) of RUN))) - (TEDIT.RAW.INCLUDE TEXTOBJ IN START END) - (TEDIT.LOOKS TEXTOBJ LOOKS]) - (\TFBRAVO.ASSERT - [LAMBDA (X Y) (* gbn "19-Sep-84 21:39") - (if (NEQ X Y) - then (HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y - " was found."]) - -(\SHIFT.DOCUMENT - [LAMBDA (PCTB DELTAX) (* ; "Edited 31-May-91 15:26 by jds") - - (* ;; "shifts all tabs, left and right margins by deltax. DOES NOT VERIFY that this produces reasonable values") - (* ; "a change for DFNFLG") - (PROG ((PC (\EDITELT PCTB (ADD1 \FirstPieceOffset))) - TSPEC LASTPARALOOKS PARALOOKS) - (while PC - do (COND - [(NEQ (fetch (PIECE PPARALOOKS) of PC) - LASTPARALOOKS) (* ; - "This is a new set of looks -- go ahead and change it.") - (COND - ((SETQ TAB.OBJECT (fetch (PIECE POBJ) of PC)) - (* ; "shift the tabspec by deltax") - (IMAGEOBJPROP TAB.OBJECT 'OBJECTDATUM (IPLUS (fetch OBJECTDATUM of TAB.OBJECT - ) - DELTAX))) - ((SETQ PARALOOKS (fetch (PIECE PPARALOOKS) of PC)) - (SETQ PARALOOKS (replace (PIECE PPARALOOKS) of PC - with (create FMTSPEC using PARALOOKS))) - (replace (FMTSPEC 1STLEFTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC - 1STLEFTMAR - ) - of PARALOOKS) - DELTAX)) - (replace (FMTSPEC LEFTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC LEFTMAR) - of PARALOOKS) - DELTAX)) - (replace (FMTSPEC RIGHTMAR) of PARALOOKS with (IPLUS (fetch (FMTSPEC RIGHTMAR - ) - of PARALOOKS) - DELTAX)) - (SETQ TSPEC (fetch (FMTSPEC TABSPEC) of PARALOOKS)) - - (* ;; "only subtract the deltax from the absolute positions, not from the relative tabstop (the car of the tabspec)") - (* ; - "this has too much leeway. I think tabspecs are fixed format. Check!") - [replace (FMTSPEC TABSPEC) of PARALOOKS - with (CONS (CAR TSPEC) - (for ELEMENT in (CDR TSPEC) - collect (SELECTQ (TYPENAME ELEMENT) - (FIXP (IPLUS DELTAX ELEMENT)) - (LISTP (CONS (IPLUS DELTAX (CAR ELEMENT)) - (CDR ELEMENT))) - (NILL] - (replace (PIECE PPARALOOKS) of PC with (\TEDIT.UNIQUIFY.PARALOOKS PARALOOKS - TEXTOBJ] - (T (replace (PIECE PPARALOOKS) of PC with LASTPARALOOKS))) - (SETQ LASTPARALOOKS (fetch (PIECE PPARALOOKS) of PC)) - (SETQ PC (fetch (PIECE NEXTPIECE) of PC]) - -(\TEDIT.BRAVOFILE? - [LAMBDA (FILE A B C) (* gbn " 3-Jun-85 21:06") - - (* Test a file to see if it is a BRAVO file, asking if it is to be converted) - - (* Returns the name of the user.cm file to be used in the conversion of this file) - - (PROG (PLOOKS ENDCONDITION (ORIGINAL.FILE.POSITION (GETFILEPTR FILE)) - NAME DIRS) (* first look for a ^z, - (beginning of a Bravo trailer)) - (COND - ((NOT (\TFBRAVO.FIND.LAST.TRAILER FILE)) - (SETFILEPTR FILE ORIGINAL.FILE.POSITION) - (RETURN NIL))) (* BIN past the ^z) - (BIN FILE) - (SETQ PLOOKS (\TEST.PARAGRAPH.LOOKS FILE)) - - (* if the next symbol is a slash then check if the character looks are valid) - - [SETQ ENDCONDITION (COND - ((EQ (CAR PLOOKS) - '\) - (repeatuntil (\TEST.CHARACTER.LOOKS FILE] - (COND - ((EQ ENDCONDITION 'BADLOOKS) - (SETFILEPTR FILE ORIGINAL.FILE.POSITION) - (RETURN NIL)) - (T (SETFILEPTR FILE ORIGINAL.FILE.POSITION) - - (* look for user.cm files in the following order, the directory the file came - from, the connected directory, the login dir, {dsk} device) - - (SETQ NAME (FULLNAME FILE)) - (SETQ DIRS '(T NIL {DSK})) - (if (LITATOM NAME) - then (push DIRS (PACKFILENAME 'NAME NIL 'EXTENSION NIL 'VERSION NIL 'BODY NAME))) - (RETURN (MKATOM (TEDIT.GETINPUT TEXTOBJ - "USER.CM file:(NIL to suppress BRAVO conversion) " - (FINDFILE 'USER.CM T DIRS]) + [LAMBDA (X Y) (* ; "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.")))]) (\TEST.CHARACTER.LOOKS - [LAMBDA (FILE) (* gbn " 6-Feb-84 19:11") - (* returns nil until done when it - returns BADLOOKS or T) + [LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk") + (* ; "Edited 2-Aug-2023 07:48 by rmk") + (* ; "Edited 29-Jul-2023 20:25 by rmk") + (* gbn " 6-Feb-84 19:11") + + (* ;; "returns nil until done when it returns BADLOOKS or T") + (PROG (PROPERTY VALFLAG TEM (VALUE 0) CHAR) - LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE CHAR) + LP (while [FIXP (SETQ CHAR (FCHARACTER (BIN BSTREAM] do (SETQ VALUE CHAR) (SETQ VALFLAG T)) (COND - (PROPERTY (COND - ((NULL VALFLAG) + (PROPERTY (CL:UNLESS VALFLAG (RETURN 'BADLOOKS)) - (T NIL)) (SETQ PROPERTY NIL)) - (VALFLAG [SETFILEPTR FILE (IDIFFERENCE (GETFILEPTR FILE) - (COND - ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] - 2) - (T 1] + (VALFLAG [SETFILEPTR BSTREAM (IDIFFERENCE (GETFILEPTR BSTREAM) + (COND + ([EQ CHAR (CONSTANT (CHARACTER (CHARCODE CR] + 2) + (T 1] (RETURN NIL))) [COND ((SETQ TEM (SELECTQ CHAR @@ -566,46 +1263,117 @@ (GO LP]) (\TEST.PARAGRAPH.LOOKS - [LAMBDA (FILE) (* gbn " 6-Feb-84 18:30") - (* test if the sequence form valid - paragraph looks, do not allow empty - paragraph looks) + [LAMBDA (BSTREAM) (* ; "Edited 5-Aug-2023 10:58 by rmk") + (* ; "Edited 2-Aug-2023 07:46 by rmk") + (* gbn " 6-Feb-84 18:30") + + (* ;; "test if the sequence form valid paragraph looks, do not allow empty paragraph looks") + (PROG ((VALUE 0) - CHAR PROPERTY (TABS) - NONEMPTY) - LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE CHAR)) + CHAR PROPERTY TABS NONEMPTY) + LP (while [FIXP (SETQ CHAR (FCHARACTER (BIN BSTREAM] do (SETQ VALUE CHAR)) [COND ((SELECTQ PROPERTY ((l d z x e y k j c q) (SETQ NONEMPTY T)) - NIL) (* keep going, these are all ok) + NIL) (* ; "keep going, these are all ok") NIL) (T (SELECTQ PROPERTY (%( (SELECTQ CHAR (%) (SETQ NONEMPTY T)) (%, (COND - ((IGREATERP VALUE 14) (* not a legal tab no) + ((IGREATERP VALUE 14) (* ; "not a legal tab no") (RETURN NIL)) (T (SETQ NONEMPTY T))) T) - (* not legal after) (RETURN NIL))) (%, (SETQ NONEMPTY T)) ((%) (SETQ NONEMPTY T))) - (* not a legal paragraph look) - (RETURN NIL] + (RETURN NIL] (* ; "not a legal paragraph look") (COND ((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] (NEQ CHAR '\)) (SETQ PROPERTY CHAR) (SETQ VALUE 0) (GO LP))) - (if NONEMPTY - then (RETURN CHAR) - else (RETURN]) + (RETURN (AND NONEMPTY CHAR]) ) + +(RPAQ? TEDIT-DEFAULT-USER.CM "TEDIT-DEFAULT-USER.CM") + +(RPAQ? USER.CM.RDTBL (COPYREADTABLE)) + +(RPAQ? PROFILE.PARA.RDTBL (COPYREADTABLE)) + +(SETBRK (CHARCODE (%, %: = CR)) + NIL USER.CM.RDTBL) + +(SETSEPR '(% ) + NIL USER.CM.RDTBL) + +(SETSYNTAX (CHARCODE %:) + 'SEPRCHAR PROFILE.PARA.RDTBL) + +(SETSYNTAX (CHARCODE CR) + 'BREAKCHAR PROFILE.PARA.RDTBL) + +(SETSYNTAX (CHARCODE ^Z) + 'BREAKCHAR PROFILE.PARA.RDTBL) + + + +(* ; "Named tabs. To be removed") + (DEFINEQ +(\TFBRAVO.ADD.NAMEDTAB + [LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "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") + + (* ;; "The CLUSERINFO contains a list of tab-looks appearing in this run, and FMTUSERINFO contains the definition of tabs that have been declared in this paragraph or inherited from previous paragraphs. ") + + (* ;; "") + + (* ;; "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") + + (LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN)) + (TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC)) + (TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC))) + (TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN)) + TAB TABNAMES TABSPEC) + (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)) + 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] + 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))) + (\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ))) + PARAFMTSPEC]) + (\TFBRAVO.COPY.NAMEDTAB [LAMBDA (OBJ PIECE OLDCH NEWCH) (* jds " 8-Feb-84 19:58") (* just creates a named tab stop with @@ -631,644 +1399,63 @@ (IMAGEOBJCREATE (RATOM CHARSTREAM) \NAMEDTAB.IMAGEFNS]) -(\TFBRAVO.ADD.NAMEDTAB - [LAMBDA (TEXTOBJ TABNO PARALOOKS) (* ; "Edited 31-May-91 15:26 by jds") - [COND - ((NEQ TABNO 0) - (BIN) (* Advance the input stream past the - tab character) - (TEDIT.INSERT.OBJECT (IMAGEOBJCREATE (LISTGET (fetch (FMTSPEC FMTUSERINFO) of PARALOOKS) - (SUB1 TABNO)) - \NAMEDTAB.IMAGEFNS) - TEXTOBJ - (ADD1 (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ] - - (* one is subtracted from the tabno because BRAVO seems to specify there numbers - differently in the run from the paragraph looks) - - ]) - (\NAMEDTABNYET [LAMBDA NIL (* gbn "30-Dec-83 17:23") (PROMPTPRINT "Can't do that to a named tab!"]) (\NAMEDTABSIZE - [LAMBDA (TABOBJECT IMAGESTREAM CURRENTX RIGHTMARGIN MODE) (* gbn "19-May-84 22:52") - (PROG [(PTSIZE (IMAGEOBJPROP TABOBJECT 'OBJECTDATUM)) - (MODE (if (STKPOS '\FORMATLINE) - then 'DISPLAY - else 'HARDCOPY] (* hack until I get called with the - right mode. SHit!) - (RETURN (create IMAGEBOX - XSIZE _ (IMAX 1 (IDIFFERENCE (COND - ((EQ MODE 'DISPLAY) - PTSIZE) - (T (ITIMES PTSIZE 35))) - CURRENTX)) - YSIZE _ 1 - YDESC _ 0 - XKERN _ 0]) + [LAMBDA (TABOBJECT IMAGESTREAM CURRENTX RIGHTMARGIN) (* ; "Edited 6-Aug-2023 14:24 by rmk") + (* gbn "19-May-84 22:52") + (create IMAGEBOX + XSIZE _ (IMAX 1 (IDIFFERENCE (HCSCALE (DSPSCALE NIL IMAGESTREAM) + (IMAGEOBJPROP TABOBJECT 'OBJECTDATUM)) + CURRENTX)) + YSIZE _ 1 + YDESC _ 0 + XKERN _ 0]) + +(\NAMEDTABPREPRINT + [LAMBDA (TABOBJ) (* ; "Edited 6-Aug-2023 18:56 by rmk") + (CONCAT "[TAB" (IMAGEOBJPROP TABOBJ 'TABNAME) + "]"]) (\NAMEDTAB.INIT - [LAMBDA NIL (* jds "22-Aug-84 14:49") - (SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE 'NILL '\NAMEDTABSIZE '\TFBRAVO.PUT.NAMEDTAB - '\TFBRAVO.GET.NAMEDTAB '\TFBRAVO.COPY.NAMEDTAB 'NILL 'NILL - 'MOVE.NAMED.TAB - 'NILL - 'NILL - 'NILL - 'NILL - 'NIL]) + [LAMBDA NIL (* ; "Edited 6-Aug-2023 18:59 by rmk") + (* jds "22-Aug-84 14:49") + (SETQ \NAMEDTAB.IMAGEFNS (IMAGEFNSCREATE 'NILL (FUNCTION \NAMEDTABSIZE) + (FUNCTION \TFBRAVO.PUT.NAMEDTAB) + (FUNCTION \TFBRAVO.GET.NAMEDTAB) + (FUNCTION \TFBRAVO.COPY.NAMEDTAB) + (FUNCTION NILL) + (FUNCTION NILL) + (FUNCTION MOVE.NAMED.TAB) + (FUNCTION NILL) + (FUNCTION NILL) + (FUNCTION NILL) + (FUNCTION NILL) + (FUNCTION \NAMEDTABPREPRINT]) ) -(DEFINEQ - -(\TFBRAVO.APPLY.PARALOOKS - [LAMBDA (PARALOOKS LENGTH TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") - - (* Returns the smaller of%: the left margin so far, the smallest left margin in - this para) - - (PROG (TABPHRASE (SMALLEST.MARGIN MARGIN.CANDIDATE)) - (TEDIT.PARALOOKS TEXTOBJ PARALOOKS (ADD1 (IDIFFERENCE (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - LENGTH)) - LENGTH) - (TEDIT.SETSEL TEXTOBJ (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - 1 - 'RIGHT) (* now return the smallest margin) - (RETURN (IMIN (fetch (FMTSPEC RIGHTMAR) of PARALOOKS) - (fetch (FMTSPEC LEFTMAR) of PARALOOKS) - (fetch (FMTSPEC 1STLEFTMAR) of PARALOOKS) - MARGIN.CANDIDATE]) - -(TEDITFROMBRAVO - [LAMBDA (FILIN USER.CM TEXTSTREAM) (* ; "Edited 31-Jan-2022 23:28 by rmk") - (* ; "Edited 13-Jun-90 01:00 by mitani") - - (* * Top level entry for conversion from Bravo to a Textstream which is returned) - - (INFILE FILIN) - (PROG (OLDPLOOKS CURRENT.PARAGRAPH USER.CM.ALIST START NEXTPARAPTR TEDITWINDOW TEXTOBJ - (NONFEATURES NIL) - (SMALLEST.MARGIN MAX.FIXP) - (NEWSTREAM (OR TEXTSTREAM (OPENTEXTSTREAM NIL))) - USER.CM.PARALOOKS USER.CM.CHARLOOKS) - (DECLARE (SPECVARS NOUT)) - (SETQ TEXTOBJ (TEXTOBJ NEWSTREAM)) - (SETQ USER.CM.ALIST (\TFBRAVO.READ.USER.CM USER.CM)) - (* read the user.cm file and produce - the alist of default values) - (CLOSEF? USER.CM) - (SETQ OLDPLOOKS (SETQ USER.CM.PARALOOKS (\TFBRAVO.INIT.PARALOOKS USER.CM.ALIST))) - (SETQ USER.CM.CHARLOOKS (\TFBRAVO.INIT.CHARLOOKS)) - (SETFILEPTR FILIN 0) - (\TFBRAVO.INIT.PAGEFORMAT TEXTOBJ) - (ERSETQ (first (SETQ START (GETFILEPTR FILIN)) - (SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN)) - while (fetch RUNS of CURRENT.PARAGRAPH) - do (SETQ NEXTPARAPTR (GETFILEPTR FILIN)) - (SETFILEPTR FILIN START) - (SETQ SMALLEST.MARGIN (\TFBRAVO.WRITE.PARAGRAPH CURRENT.PARAGRAPH FILIN - TEXTOBJ SMALLEST.MARGIN)) - (SETFILEPTR FILIN NEXTPARAPTR) - (SETQ OLDPLOOKS (fetch PARALOOKS of CURRENT.PARAGRAPH)) - (SETQ START (GETFILEPTR FILIN)) - (SETQ CURRENT.PARAGRAPH (\TFBRAVO.PARSE.PARA OLDPLOOKS FILIN)) finally - (* (\SHIFT.DOCUMENT (fetch - (TEXTOBJ PCTB) of TEXTOBJ) - (MINUS SMALLEST.MARGIN))) - NIL)) - (CLOSEF (INPUT)) - (\TFBRAVO.INSTALL.PAGEFORMAT TEXTOBJ) - (RETURN NEWSTREAM]) - -(\TFBRAVO.WRITE.PARAGRAPH - [LAMBDA (PARA INFILE TEXTOBJ MARGIN.CANDIDATE) (* ; "Edited 31-May-91 15:26 by jds") - - (* outputs the character runs, writes an EOL, then apply paragraph looks. - Returns the smallest left margin seen to date) - - (* * this is not a guaranteed free field. - Perhaps later the profile bit will have to be elsewhere.) - - (SELECTQ (fetch (FMTSPEC FMTPARATYPE) of (fetch PARALOOKS of PARA)) - (PROFILE (replace (FMTSPEC FMTPARATYPE) of (fetch PARALOOKS of PARA) with NIL) - (\TFBRAVO.PARSE.PROFILE.PARA INFILE PARA TEXTOBJ) - MARGIN.CANDIDATE) - (PROG (LENGTH) - (SETQ LENGTH (ADD1 (\TFBRAVO.WRITE.RUNS PARA INFILE TEXTOBJ))) - (\TFBRAVO.EOLS 1 TEXTOBJ) - (RETURN (\TFBRAVO.APPLY.PARALOOKS (fetch PARALOOKS of PARA) - LENGTH TEXTOBJ MARGIN.CANDIDATE]) - -(\TFBRAVO.WRITE.RUNS - [LAMBDA (PARA INFILE TEXTOBJ) (* ; "Edited 13-Jun-2021 09:45 by rmk:") - (DECLARE (USEDFREE UNDERLINE SUPERSCRIPT)) - (PROG ((RUNS (fetch (PARA RUNS) of PARA)) - (PARALOOKS (fetch (PARA PARALOOKS) of PARA)) - (LENGTH 0)) - (for RUN in old RUNS do (\TFBRAVO.WRITE.RUN RUN INFILE PARALOOKS TEXTOBJ) - (SETQ LENGTH (IPLUS (fetch (RUN RUNLENGTH) of RUN) - LENGTH))) - (RETURN LENGTH]) - -(\TFBRAVO.SPREAD.LOOKS - [LAMBDA (RUN LOOKS) (* jds "22-Aug-84 14:53") - (DECLARE (USEDFREE STYLE SLANT THICKNESS SIZE OVERSTRIKE UNDERLINE SUPERSCRIPT)) - (for INSTR in (fetch RUNLOOKS of RUN) do (SELECTQ (CAR INSTR) - (Bold [LISTPUT LOOKS 'WEIGHT (COND - ((CDR INSTR) - 'BOLD) - (T 'MEDIUM]) - (Font (LISTPUT LOOKS 'SIZE (\TFBRAVO.GET.FONTSIZE - (CDR INSTR))) - (LISTPUT LOOKS 'FAMILY (\TFBRAVO.GET.FONTSTYLE - (CDR INSTR)))) - (Italic [LISTPUT LOOKS 'SLOPE (COND - ((CDR INSTR) - 'ITALIC) - (T 'REGULAR]) - (Overstrike (add OVERSTRIKE 1)) - (Underline [LISTPUT LOOKS 'UNDERLINE - (COND - ((CDR INSTR) - 'ON) - (T 'OFF]) - (Superscript (COND - ((IGREATERP (CDR INSTR) - 127) - (* turn off subscripting and set - superscripting, though possibly to - zero) - (LISTPUT LOOKS 'SUBSCRIPT - (IDIFFERENCE 256 - (CDR INSTR))) - (LISTPUT LOOKS 'SUPERSCRIPT NIL)) - (T (LISTPUT LOOKS 'SUPERSCRIPT - (CDR INSTR)) - (LISTPUT LOOKS 'SUBSCRIPT NIL)))) - NIL)) - LOOKS]) - -(\TFBRAVO.PARSE.PARA - [LAMBDA (OLDPLOOKS FILE) (* ; "Edited 13-Jun-2021 09:46 by rmk:") - - (* PLOOKS are the paragraph looks, and RUNi are the character runs in the form - returned by READCHARACTERLOOKS, except that the character count for the last run - has been filled in correctly. Leaves the input file pointer at the end of the - trailer, after the EOL.) - - (PROG (LEN PLOOKS RUNS ORIGPTR) - (SETQ ORIGPTR (GETFILEPTR FILE)) - (SETQ LEN (FILEPOS (CHARACTER (CHARCODE ^Z)) - FILE)) - [COND - ((NOT LEN) - (RETURN (create PARA - PARALOOKS _ DefaultParagraphLooks - RUNS _ NIL] - (SETQ LEN (IDIFFERENCE LEN ORIGPTR)) - (BIN FILE) (* BIN past the ^z) - (SETQ PLOOKS (\TFBRAVO.READ.PARALOOKS OLDPLOOKS FILE)) - [COND - ((NEQ [CAR (PROG1 PLOOKS - (SETQ PLOOKS (CDR PLOOKS)))] - '\) - (RETURN (create PARA - PARALOOKS _ PLOOKS - RUNS _ (LIST (create RUN - RUNLENGTH _ LEN - RUNLOOKS _ (\TFBRAVO.FONT.FROM.CHARLOOKS - USER.CM.CHARLOOKS] - CLP [while [fetch (RUN RUNLENGTH) of (CAR (push RUNS (\TFBRAVO.READ.CHARLOOKS FILE] - do (SETQ LEN (IDIFFERENCE LEN (fetch (RUN RUNLENGTH) of (CAR RUNS] - (replace (RUN RUNLENGTH) of (CAR RUNS) with LEN) - (RETURN (create PARA - PARALOOKS _ PLOOKS - RUNS _ (DREVERSE RUNS]) - -(\TFBRAVO.INIT.PARALOOKS - [LAMBDA (USER.CM.LOOKS) (* ; "Edited 31-May-91 15:26 by jds") - - (* * creates the first paragraph looks from the USER.CM) - - (PROG ((INITPARALOOKS (create FMTSPEC using TEDIT.DEFAULT.FMTSPEC)) - LM VALUE 1LM (MICASPERPOINT 35)) - (SETQ HardwareWidth (IDIFFERENCE HardwareRightMargin HardwareLeftMargin)) - (* Basic page width) - (SETQ DefaultParagraphLooks USER.CM.LOOKS) - (COND - [(SETQ LM (CDR (ASSOC 'LeftMargin DefaultParagraphLooks] - (T (SETQ LM HardwareLeftMargin))) - (COND - [(SETQ 1LM (CDR (ASSOC 'FirstLineLeftMargin DefaultParagraphLooks] - (T (SETQ 1LM LM))) - (replace (FMTSPEC LEFTMAR) of INITPARALOOKS with (IQUOTIENT LM MICASPERPOINT)) - (replace (FMTSPEC 1STLEFTMAR) of INITPARALOOKS with (IQUOTIENT 1LM MICASPERPOINT)) - (replace (FMTSPEC LINELEAD) of INITPARALOOKS with (COND - ((SETQ VALUE (ASSOC 'LineLeading - DefaultParagraphLooks - )) - (CDR VALUE)) - (T 1))) - (replace (FMTSPEC LEADBEFORE) of INITPARALOOKS with (COND - ((SETQ VALUE (ASSOC - ' - ParagraphLeading - - DefaultParagraphLooks - )) - (CDR VALUE)) - (T 1))) - (replace (FMTSPEC RIGHTMAR) of INITPARALOOKS with (IQUOTIENT (COND - ((SETQ VALUE - (ASSOC 'RightMargin - DefaultParagraphLooks - )) - (CDR VALUE)) - (T DefaultRightMargin)) - MICASPERPOINT)) - (replace (FMTSPEC LEADAFTER) of INITPARALOOKS with 0) - (replace (FMTSPEC TABSPEC) of INITPARALOOKS with (LIST NIL)) - (replace (FMTSPEC FMTSPECIALX) of INITPARALOOKS with 0) - (replace (FMTSPEC FMTSPECIALY) of INITPARALOOKS with 0) - (RETURN INITPARALOOKS]) - -(\TFBRAVO.READ.PARALOOKS - [LAMBDA (OLDLOOKS FILE) (* ; "Edited 31-May-91 15:26 by jds") - (PROG ((TEDITPARALOOKS (create FMTSPEC using USER.CM.PARALOOKS)) - LMFLAG FLLMFLAG PROPERTY CHAR TABINDEX TEM (VALUE 0) - (MICASPERPOINT 35)) - (replace (FMTSPEC TABSPEC) of TEDITPARALOOKS with (COPY (fetch (FMTSPEC TABSPEC) - of OLDLOOKS))) - (replace (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS with (COPY (fetch (FMTSPEC FMTUSERINFO) - of OLDLOOKS))) - LP (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] do (SETQ VALUE (IPLUS (ITIMES VALUE 10) - CHAR))) - [COND - ((SELECTQ PROPERTY - (l (SETQQ LMFLAG LeftMargin) - (replace (FMTSPEC LEFTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE MICASPERPOINT - ))) - (d (SETQQ FLLMFLAG FirstLineLeftMargin) - (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE - MICASPERPOINT))) - (z (replace (FMTSPEC RIGHTMAR) of TEDITPARALOOKS with (IQUOTIENT VALUE - MICASPERPOINT))) - (x (replace (FMTSPEC LINELEAD) of TEDITPARALOOKS with VALUE)) - (e (replace (FMTSPEC LEADAFTER) of TEDITPARALOOKS with 0) - (replace (FMTSPEC LEADBEFORE) of TEDITPARALOOKS with VALUE)) - (y (* (COND ((IEQP VALUE 65535) - (SETQ VALUE NIL)))) - (* vertical tabs are supported) - (replace (FMTSPEC FMTSPECIALX) of TEDITPARALOOKS with 0) - (replace (FMTSPEC FMTSPECIALY) of TEDITPARALOOKS with VALUE)) - (k (* same with Keep) - 'Keep) - (w 'HardcopyMode) - NIL)) - ((SETQ TEM (SELECTQ PROPERTY - (j (replace (FMTSPEC QUAD) of TEDITPARALOOKS with 'JUSTIFIED)) - (c (replace (FMTSPEC QUAD) of TEDITPARALOOKS with 'CENTERED)) - (q - - (* not a legal value for FMTPARATYPE But it signals that this is a profile - paragraph) - - (replace (FMTSPEC FMTPARATYPE) of TEDITPARALOOKS with 'PROFILE)) - NIL))) - (T (SELECTQ PROPERTY - (%( (SELECTQ CHAR - (%) (RPLACA (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) - (IQUOTIENT VALUE MICASPERPOINT))) - (%, [COND - ((IGREATERP VALUE 14) - (HELP VALUE '" is not a legal tab #"] - (SETQ TABINDEX VALUE)) - (HELP CHAR '" is not legal after ("))) - (%, [COND - ((NOT (IEQP VALUE 65535)) (* this is not a delete tab, record it) - (SETQ VALUE (IQUOTIENT VALUE MICASPERPOINT)) - - (* * returning to adding a normal tab as well, since there are docs, e.b. - refreminder.bravo which do not have named tab looks on the tab chars - (* I no longer gratuitously add a normal tab at the position of each named tab. - Turns out that, in some cases, that will change the meaning of an already present - unnamed tab. (RPLACD (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) - (CONS (CONS VALUE (QUOTE LEFT)) (CDR (fetch - (FMTSPEC TABSPEC) of TEDITPARALOOKS)))))) - - [RPLACD (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS) - (CONS (CONS VALUE 'LEFT) - (CDR (fetch (FMTSPEC TABSPEC) of TEDITPARALOOKS] - (replace (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS - with (NCONC (LIST TABINDEX VALUE) - (fetch (FMTSPEC FMTUSERINFO) of TEDITPARALOOKS]) - ((%) NIL)) - (HELP CHAR '" is not a legal paragraph look"] - (COND - ((AND [NEQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] - (NEQ CHAR '\)) - (SETQ PROPERTY CHAR) - (SETQ VALUE 0) - (GO LP))) - [COND - ((AND LMFLAG (NOT FLLMFLAG)) (* If there was a Left margin but no - firstline left then default it) - (replace (FMTSPEC 1STLEFTMAR) of TEDITPARALOOKS with (fetch (FMTSPEC LEFTMAR) - of TEDITPARALOOKS] - (RETURN (CONS CHAR TEDITPARALOOKS)) (* return the looks together with the - indication of how the looks ended) - ]) - -(\TFBRAVO.READ.CHARLOOKS - [LAMBDA (FILE) (* ; "Edited 31-May-91 15:25 by jds") - - (* this function reads the character looks trailer building a TEDIT charlooks - record. Most fields are immediately valid, however, the tabcolor is stored in the - cluserinfo field of the looks, and the font is still in numeric form) - - (PROG ((TEDITCHARLOOKS (create CHARLOOKS using USER.CM.CHARLOOKS)) - PROPERTY VALFLAG TEM (VALUE 0) - CHAR) - (RETURN (while T do (* Keep going until we run out of - things to read) - (while [NUMBERP (SETQ CHAR (FCHARACTER (BIN FILE] - do (* If we're looking at digits, read - them as a number) - (SETQ VALUE (IPLUS (ITIMES VALUE 10) - CHAR)) - (SETQ VALFLAG T)) - [COND - (PROPERTY [COND - ((NULL VALFLAG) - (HELP PROPERTY '"- no value for character look")) - (T (SELECTQ PROPERTY - (TabColor - - (* Hide the named tab in the user field of the looks where writerun can look for - it) - - (replace (CHARLOOKS CLUSERINFO) - of TEDITCHARLOOKS with VALUE)) - (Font (replace (CHARLOOKS CLSIZE) of - TEDITCHARLOOKS - with (\TFBRAVO.GET.FONTSIZE VALUE)) - (replace (CHARLOOKS CLNAME) of - TEDITCHARLOOKS - with (\TFBRAVO.GET.FONTSTYLE VALUE)) - (* (* a hack so that font is - cumulative. Change the - "default charlooks" to reflect this - font each time) (replace - (CHARLOOKS CLSIZE) of - USER.CM.CHARLOOKS with - (fetch (CHARLOOKS CLSIZE) of - TEDITCHARLOOKS)) (replace - (CHARLOOKS CLNAME) of - USER.CM.CHARLOOKS with - (fetch (CHARLOOKS CLNAME) of - TEDITCHARLOOKS))) - ) - (Superscript (replace (CHARLOOKS CLOFFSET) - of TEDITCHARLOOKS - with (COND - ((IGREATERP VALUE 127) - (* is a negative numero) - (IDIFFERENCE VALUE 256) - ) - (T VALUE)))) - (HELP PROPERTY - " is unknown property in \TFBRAVO.READ.CHARLOOKS" - ] - (SETQ PROPERTY NIL)) - (VALFLAG [SETFILEPTR FILE - (IDIFFERENCE (GETFILEPTR FILE) - (COND - ([EQ CHAR (CONSTANT (CHARACTER - (CHARCODE EOL] - 2) - (T 1] - (RETURN (CONS VALUE (\TFBRAVO.FONT.FROM.CHARLOOKS - TEDITCHARLOOKS] - (COND - ((SELECTQ CHAR - (s (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS with T)) - (S (replace (CHARLOOKS CLSTRIKE) of TEDITCHARLOOKS with NIL) - T) - (u (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS with T)) - (U (replace (CHARLOOKS CLULINE) of TEDITCHARLOOKS with NIL) - T) - (b (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS with T)) - (B (replace (CHARLOOKS CLBOLD) of TEDITCHARLOOKS with NIL) - T) - (i (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS with T)) - (I (replace (CHARLOOKS CLITAL) of TEDITCHARLOOKS with NIL) - T) - (g '(Graphic . T)) - (G '(Graphic)) - (v (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS - with NIL) - T) - (V (replace (CHARLOOKS CLINVISIBLE) of TEDITCHARLOOKS - with T)) - NIL) - (SETQ PROPERTY NIL)) - ((SETQ TEM (SELECTQ CHAR - (t 'TabColor) - (f 'Font) - (o 'Superscript) - NIL)) - (SETQ PROPERTY TEM)) - [[EQ CHAR (CONSTANT (CHARACTER (CHARCODE EOL] - (RETURN (CONS NIL (\TFBRAVO.FONT.FROM.CHARLOOKS TEDITCHARLOOKS] - ((NEQ CHAR '% ) - (HELP CHAR " is not a legal character look"))) - (SETQ VALUE 0) - (SETQ VALFLAG NIL]) - -(\TFBRAVO.READ.USER.CM - [LAMBDA (FILE) (* gbn "17-Sep-84 18:53") - - (* digests a user.cm file returning an alist of contents. - Returns ((Font)) if no bravo section of user.cm file) - - (PROG ((RDTBL USER.CM.RDTBL) - [ALIST (LIST (LIST 'Font] - LINE) (* (ERRORTYPELST (CONS - (QUOTE (16 (RETFROM (QUOTE RATOM) - (QUOTE END.OF.FILE)))) ERRORTYPELST)) - The errortypelist inclusion guarantees - that eof's will return from RATOM as - (CHARCODE 13)) - (* (DECLARE (SPECVARS ERRORTYPELST))) - (SETBRK (CHARCODE (%, %: = EOL)) - NIL RDTBL) - (SETSEPR '(% ) - NIL RDTBL) - [OR (OPENP FILE) - (SETQ FILE (OPENSTREAM FILE 'INPUT 'OLD] - (COND - ((NOT (FILEPOS [CONCAT '"[BRAVO]" (CONSTANT (CHARACTER (CHARCODE EOL] - FILE NIL NIL NIL T)) - (RETURN ALIST))) - - (* Read lines of the user.cm file until getting the empty line caused by eof - (and the errortypelst entry) or until a line starts with "[" %.) - - LLP (COND - ([NOT (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL))) - FILE RDTBL] - (RETURN ALIST))) (* If the "[BRAVO]" section is the - last one) - (COND - ((NULL LINE) (* ignore blank lines) - (GO LLP)) - ((EQ (CAR LINE) - 'END.OF.FILE) - (RETURN ALIST)) - ((EQ (NTHCHAR (CAR LINE) - 1) - '%[) - - (* if "[" is the first character of the line, return the alist so far, because - this is the beginning of the next section of the user.cm) - - (RETURN ALIST)) - ((NEQ (CADR LINE) - '%:) - (GO LLP))) - (SELECTQ (PROG1 (CAR LINE) - (SETQ LINE (CDDR LINE))) - (FONT [COND - ((NUMBERP (CAR LINE)) - (NCONC1 (FASSOC 'Font ALIST) - (LIST (CAR LINE) - (CADR LINE) - (CADDR LINE]) - (TABS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((Tabs standard tab width] - ALIST))) - (MARGINS (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((LeftMargin left margin) - (RightMargin right margin] - ALIST))) - (LEAD (SETQ ALIST (NCONC [\TFBRAVO.GETPARAMS LINE '((ParagraphLeading paragraph leading - ) - (LineLeading line leading] - ALIST))) - NIL) - (GO LLP]) - -(\TFBRAVO.GETPARAMS - [LAMBDA (LIS NAMES) (* jds "27-Aug-84 09:37") - (PROG ((L LIS) - ALIST TEST REST) - [MAP L (FUNCTION (LAMBDA (WORDL) - (COND - ((LITATOM (CAR WORDL)) - (FRPLACA WORDL (\TFBRAVO.LCASER (CAR WORDL] - LP (COND - ((NULL L) - (RETURN ALIST))) - (SETQ TEST NAMES) - NLP (COND - ((SETQ REST (\TFBRAVO.PARAMNAMEP L (CDAR TEST))) - (SETQ ALIST (CONS (CONS (CAAR TEST) - (CAR REST)) - ALIST))) - ((SETQ TEST (CDR TEST)) - (GO NLP))) - (SETQ L (CDR (FMEMB '%, L))) - (GO LP]) - -(\TFBRAVO.PARAMNAMEP - [LAMBDA (LIS NAME) (* lpd "16-JUL-77 19:55") - (PROG ((L LIS)) - (RETURN (AND [EVERY NAME (FUNCTION (LAMBDA (WORD) - (PROG1 (EQ WORD (CAR L)) - (SETQ L (CDR L)))] - (EQ (CAR L) - '=) - (CDR L]) - -(\TFBRAVO.EOLS - [LAMBDA (N TEXTOBJ) (* ; "Edited 13-Jun-90 01:00 by mitani") - - (* ;; "Insert N carriage-returns into the document named by TEXTOBJ at the current location.") - - (for I FROM 1 to N do (TEDIT.INSERT TEXTOBJ (CHARCODE EOL))) - (TEDIT.SETSEL TEXTOBJ (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ) - 1 - 'RIGHT]) - -(\TFBRAVO.LCASER - [LAMBDA (WORD) (* lpd "23-SEP-77 14:40") - (PROG ((LST (CHCON WORD)) - Z) - [MAP LST (FUNCTION (LAMBDA (L) - (COND - ((AND (IGREATERP (SETQ Z (CAR L)) - 64) - (ILESSP Z 91)) (* Z is an uppercase character) - (FRPLACA L (IPLUS Z 32] - (RETURN (PACKC LST]) - -(\TFBRAVO.FONT.FROM.CHARLOOKS - [LAMBDA (CHARLOOKS) (* ; "Edited 31-May-91 15:26 by jds") - - (* Takes a CHARLOOKS with fields filled in - (CLNAME = family name) and creates the font to fill it.) - - [replace (CHARLOOKS CLFONT) of CHARLOOKS with (FONTCREATE (fetch (CHARLOOKS CLNAME) of CHARLOOKS) - (fetch (CHARLOOKS CLSIZE) of CHARLOOKS) - (LIST (COND - ((fetch (CHARLOOKS CLBOLD) - of CHARLOOKS) - 'BOLD) - (T 'MEDIUM)) - (COND - ((fetch (CHARLOOKS CLITAL) - of CHARLOOKS) - 'ITALIC) - (T 'REGULAR)) - 'REGULAR] - CHARLOOKS]) -) - -(RPAQ? USER.CM.RDTBL (COPYREADTABLE)) - -(RPAQ? PROFILE.PARA.RDTBL (COPYREADTABLE)) - -(SETSYNTAX (CHARCODE %:) - 'SEPRCHAR PROFILE.PARA.RDTBL) - -(SETSYNTAX (CHARCODE EOL) - 'BREAKCHAR PROFILE.PARA.RDTBL) - -(SETSYNTAX (CHARCODE ^Z) - 'SEPRCHAR PROFILE.PARA.RDTBL) (DECLARE%: DOEVAL@COMPILE DONTCOPY (GLOBALVARS \NAMEDTAB.IMAGEFNS) ) (DECLARE%: DONTEVAL@LOAD DOCOPY -(ADDTOVAR TEDIT.INPUT.FORMATS (\TEDIT.BRAVOFILE? TEDITFROMBRAVO)) - -(\NAMEDTAB.INIT) +(AND NIL (\NAMEDTAB.INIT)) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (4139 33719 (\TFBRAVO.FIND.LAST.TRAILER 4149 . 5677) (\TFBRAVO.HANDLE.HEADING 5679 . -7567) (\TFBRAVO.INIT.CHARLOOKS 7569 . 8327) (\TFBRAVO.INIT.PAGEFORMAT 8329 . 8791) ( -\TFBRAVO.INSTALL.PAGEFORMAT 8793 . 12804) (\TFBRAVO.PARSE.PROFILE.PARA 12806 . 21423) ( -\TFBRAVO.PARSE.PROFILE.VALUE 21425 . 22169) (\TFBRAVO.GET.FONTSIZE 22171 . 22468) ( -\TFBRAVO.GET.FONTSTYLE 22470 . 22779) (\TFBRAVO.WRITE.RUN 22781 . 23847) (\TFBRAVO.ASSERT 23849 . -24154) (\SHIFT.DOCUMENT 24156 . 28249) (\TEDIT.BRAVOFILE? 28251 . 30223) (\TEST.CHARACTER.LOOKS 30225 - . 31947) (\TEST.PARAGRAPH.LOOKS 31949 . 33717)) (33720 37329 (\TFBRAVO.COPY.NAMEDTAB 33730 . 34178) ( -\TFBRAVO.PUT.NAMEDTAB 34180 . 34460) (\TFBRAVO.GET.NAMEDTAB 34462 . 34839) (\TFBRAVO.ADD.NAMEDTAB -34841 . 35671) (\NAMEDTABNYET 35673 . 35833) (\NAMEDTABSIZE 35835 . 36767) (\NAMEDTAB.INIT 36769 . -37327)) (37330 71837 (\TFBRAVO.APPLY.PARALOOKS 37340 . 38310) (TEDITFROMBRAVO 38312 . 40880) ( -\TFBRAVO.WRITE.PARAGRAPH 40882 . 41892) (\TFBRAVO.WRITE.RUNS 41894 . 42507) (\TFBRAVO.SPREAD.LOOKS -42509 . 45642) (\TFBRAVO.PARSE.PARA 45644 . 47575) (\TFBRAVO.INIT.PARALOOKS 47577 . 50971) ( -\TFBRAVO.READ.PARALOOKS 50973 . 56789) (\TFBRAVO.READ.CHARLOOKS 56791 . 64630) (\TFBRAVO.READ.USER.CM -64632 . 68217) (\TFBRAVO.GETPARAMS 68219 . 69035) (\TFBRAVO.PARAMNAMEP 69037 . 69472) (\TFBRAVO.EOLS -69474 . 69891) (\TFBRAVO.LCASER 69893 . 70432) (\TFBRAVO.FONT.FROM.CHARLOOKS 70434 . 71835))))) + (FILEMAP (NIL (6652 13034 (TEDIT.BRAVOFILE? 6662 . 8392) (TEDITFROMBRAVO 8394 . 13032)) (13145 28131 ( +\TFBRAVO.GET.USER.CM 13155 . 15965) (\TFBRAVO.USER.CM.LOOKS 15967 . 17142) (\TFBRAVO.READ.USER.CM +17144 . 21481) (\TFBRAVO.INIT.PARALOOKS 21483 . 23244) (\TFBRAVO.INIT.PAGEFORMAT 23246 . 24126) ( +\TFBRAVO.GETPARAMS 24128 . 26982) (\TFBRAVO.FIND.LAST.TRAILER 26984 . 28129)) (28173 48186 ( +\TFBRAVO.PARSE.PARA 28183 . 31870) (\TFBRAVO.READ.PARALOOKS 31872 . 38506) (\TFBRAVO.CREATE.RUNS 38508 + . 39896) (\TFBRAVO.READ.CHARLOOKS 39898 . 44916) (\TFBRAVO.FONT.FROM.CHARLOOKS 44918 . 46287) ( +\TFBRAVO.READNUM? 46289 . 48184)) (48223 58974 (\TFBRAVO.HANDLE.HEADING 48233 . 50865) ( +\TFBRAVO.PARSE.PROFILE.PARA 50867 . 58972)) (59017 79934 (\TFBRAVO.INSERT.PARA 59027 . 59680) ( +\TFBRAVO.INSERT.RUN 59682 . 62764) (\TFBRAVO.SPLIT.PARA 62766 . 70008) (\TFBRAVO.RUN.TABSPEC 70010 . +74239) (\TFBRAVO.INSTALL.PAGEFORMAT 74241 . 79932)) (79935 83895 (\TFBRAVO.ASSERT 79945 . 80292) ( +\TEST.CHARACTER.LOOKS 80294 . 82180) (\TEST.PARAGRAPH.LOOKS 82182 . 83893)) (84380 90660 ( +\TFBRAVO.ADD.NAMEDTAB 84390 . 87723) (\TFBRAVO.COPY.NAMEDTAB 87725 . 88173) (\TFBRAVO.PUT.NAMEDTAB +88175 . 88455) (\TFBRAVO.GET.NAMEDTAB 88457 . 88834) (\NAMEDTABNYET 88836 . 88996) (\NAMEDTABSIZE +88998 . 89513) (\NAMEDTABPREPRINT 89515 . 89713) (\NAMEDTAB.INIT 89715 . 90658))))) STOP diff --git a/library/tedit/TEDIT-TFBRAVO.LCOM b/library/tedit/TEDIT-TFBRAVO.LCOM index 3237631c98210c6c07aed579e896f790aea43b66..4f2b73559c494f7a2b4ea76a46bb0b43d003ac1e 100644 GIT binary patch literal 27095 zcmdsgdvIgdc^?2$>lLM?NG?RJ;I({2Yd7R}i2xS>K`@a`kOT>k04@c9yG!j#6qleD zAhD#(r5<+DMt0IT<4NnWY{{|}*<;lYC2>>`TsGR(1D!r*DtE@pv~H?({&3t$+lezx zu}wQ|GoxjH-*?Wr_X4EWvh!D^k%)88`|-WM?;Q0{BqmeY#NcEqofu4ICrxqBY_}7T_iT=K&^^1>{E6YW(z9#y_ubs{$Cen%dzyGV1^7)O$jZb|XjZ+2rcd#%y zmW!V<{l5~71O`M$UvS9o(+G_ik&#faPn_RawmMxZEv{WyzI1Fva6gkdGs9hoGDe%6 zOQ(gi55M2vCyI-kn9aVONBRcd*Q(zCDnu+WYy`vzEpl*dUTj=k6&)kv$#`}uksmCW zqJJ`*Z<+gm7@5r_PNmGb{NMyO7klg2hv4u?C@>NZ^@)!6JB@H`po6!^&wE41_6adE zG2GEVD99&teKa!Qm9o(oGF-N(;|gx`2t`hGay{411^_m^i~)C>3-lAnRt0L*+Chl zu2CU#=8NtNl+(C;o6M;FZRtT(Yg(3U|NC;6tA7YxCkiz7Y#}GYF>$Vt$QS(B++2Jd zaO{^e4H>Fn7Wq@T_-s-Y7>2WbFpO#n{(v77{&XCj6>@R(pTjmySwjIvhK9sgd_wjg z4v2HeQd?|6U_1~A1m!OCX692PBPZsvr_uG`Y|bns#tSE~i!nj-)q6TDXp;IXimi+1 z3aB-tPstw#c2bUYZvM$kAwQcKM_$;fW=yWfCamksdWfA9a zaXrOpM~3~KT&J#mzLL+^+6-BzeZD1MJ#)66sEry@x$*JAW`|p1vQ&+?y22fEkEgu={t(El#A$4DK9Lq791joxm`XsK&8I;*{PFyFDn-DM7e<8e zKmm9v3#2dj3D|@Yb`&5d4^+;X5~aC35YZjaWm6B#r6%VAg&?f4;ie7?$V87*2|Dt4 zK?H}Xof=T}OZ^3-VFxmaU}Q*92#gA#3<3w{3PeBTH;_m|9DfdnggKkYDj19gs3-Li ziQ2;{nx-j0$Sy&BzovK~%$iOObGP&*djmp;f-#X!OcsO@8*(72F>JRoKnFBp8KHns z`z8z{Wak4n^eDkdP-IiIci|zTtmdQ~jn-|%oa+qYc+uNb78?=*6-i9S=hE2I046$D zzy>i|VwW+ukwP+O&P^pn4D<#oNaR41b$N7Hq_U_lhQcZlCct6pj70)jBci|mfjJPQ z<{1qLGd*!Co}Nn#w30T>I}E`n4kCrdL{D1L9+?3_;>4LGQLPjhi{ASbcnh6q9=Vbb zsbeILp~*_fZVdKuPn+A-p6|Zb!>GWB!G8`Cn$_<+;09V?<7pB+FG*|xhvHo36q8MC zWwV&TL>k*L+}er>x&^&Xpiz7?Xsv|S$b6HQq)(a_H691wWCreB6V)MMKpp9z+7PVo zn#b*GlPvFf`E%Y?kCz)?DxLS#dCjFge@74T>dU1^XcK%sUw5}Vz7yhlh>J6S3Ia7r7GypgBoJYVgosUKzit9x%5t0-@L2bPIa%pQ z2uyT*hI&_>+5<#%_kbagIt}ocF`xuoA5v2yFF*js%!zpc>ETo&mnZ2e6c&WNS^hAF zSq5VijYUPD?&eX*(j%gOJSQ$a{@7z1%a<-KUlLN}U0PpzVtM0Id3|jFl6G(?hQDj; zo8r;+$JdI;2oKxc+)p(Ep{9(14h!JbXo`L^$ZIs!Qk|aAB%oeb*R*ibMsy{xOztO~ z0Oo(q)8WHIIS)O+kqE4RJgQ(W;Ls4pEXGL%W+&2xIG zy%1*@TsoLjiS{@%)`E9bCUV}990*2?#YO@(i@Dh%7(i07RIAXItN;(zex%ohA4F|yDq#Xd(<(!eyc0w4r~Lx5H(R|f-8D-95uTwmJ+Lsq|r z`1STSYodku*~G_wy_ujnduAF)e+*666(I+rjVA|liNahiJ4mx6c@;7@35OGNnan)# zm_e>Z;-LiwNLzH?pPML*rI8Z`DbJFq2=qV)*)+tK2L>g70crQNdtBvFoHtXhT%IY{ z(!r8%se^NHQdoU1UNAFxEX9b5kt~TBX$a8AI)29Dezp`I5hpAyXAsI6RMgzy7%)GT zor3I3qBSpDPJ1#PpQ6l=I05=Jo=8k!7xD?N2%Vy3d8inai>KX_@;j?Vw2ym)Y)jI| zRzd!!Iu1D+nZtVqox~p8Z2Azs7Y;!9?iTJ-k}>e^Zuc=6msy-IH~n^!gFAgoo%PnD zx@=G?7R!einJ#yoVsxt z>+Y1tbEPQ1Yxmbv?vOzC?{G%4cjpi%O1`A;j5~$8^Xk7Vm;;y{iSgWhwV?aBvo5(4 zH{=CXgEuL=Qw@EmgQrP_^h~|G%fl4ubeFHpD?i=i>u$SchL_wU8(wak?s;ZwwELFb#`BII_Vp_RA*mMs-N6En7$u=8NGN zgtPd>__#Td5X`#3cg;MBfl6s+(@!Ysl&7HsV?bL14h>sq76SKnK(-U^g@OK|EKUdm z#4VEoMKF``^yDm3vnDt$m2{y2x)vWJwjWj$3%SoNEeYS)<2tsp6^f?WARNw?dev@XItLqix~V)@a<$19tK z#q;9Q=Hgm$aib_U@$qE2xLJbWE}$ayon`spp*~>*ML$jsS_L-2%qJ#4;Slm2?B5Bz znkoGJ!hS%@1)y5Zl6*fTdH3jd8HFI@{tTHuv{$AF7-*RuFmIuSbKY9C2YwLTIyC}| z#y0bf7ACF){Q#gSWtmTia5D*q?DB@&<#IEH;6F@=y4|iMlSW?KC}fzO_R1V2nAY45 znemp#>)KOx%bMp7Z~LC?wpDM(-b@mKWM3=ZgL{hGEBBRr-cGB=5i8{*k_Cj%N(-)m zy$B8)mf9MOI?@n#9e_rHq?Yu8AQ4s?2DLqS6AVV}3Lt(?oPqAD+d@rs!g|!!pNH&u zL?GzwgHT}*3uOZXTsUwEprH$5O3qhWmt`~ylc=OB?I$R;N^eROwoCv3gJl=MV3f~W zs#7w}9HWx_Q~v!c<{8Y6WNGELO7cgQ`>r{&q`IccogcDW92YDuPTR=vP}3(i%~=YC z!}$rS>-+@um`t6?fs{J40R%C!4^AbrbD1%iP_t&igwB@BgFC@N5RE}=DL@F5#9YAs zQ7~uKM>y(eIS+Ns@p%SvpWQ8qZ~{u1;m3c581_dT#K&fNTGa;2B7-xu_iO>?SV}?+ z#Sc(BF@@i#AltN|ge#J_Sg=GMnTV${3F1Mdp6AEouvd~QLuwo4k$obYfQZz4hs)L0 z9q^16yZa8zJk+-1J1mWWXX4%W9?Z7w7>B3%6uXL^@6^*t->cQ5N|5sb`@Jl1-K2#Oz{X;c?F+>qWEEJ*GvJi%NWv z08{<6d%bP6)ywC`%x z^YGU0L8$ISr27I|NQZ}b0IArYcwi3FH}Pc&M^KtGiOiUQJ!t~o3+S|P6UD4FPTXev zEz&^{hO7I*+lQLvf*>@K`vuIF$4(NwkO4Ck@f*=7h(!?at3MpDv)6F1VMvgH9MHg; zKcBlYc;o2*lgGkfi-=#`<)j3GmFt(=KD*^sR$)lH{8{bpa?5fYqx*Sj8dm4<%$EBf z*vU(FvScS8vXePGIb|n*)lO;|7X2Q#b3be+yX@pGR?_vicJja5$-l6Z*X-mE?Bu_+ zldsyzKeCfA*~zci$=|h;pHa!}Cv{>?Czf^MoKEC*Vp=ESIx$>aX>5mztBq}cvEpfL z_ZKT|jqSc-rMNvE5s&9B8~!tbC~P`^Cz^#yT9~M)fg;8;V z4b7lZXj^72U<^`ZNStTLpJTcCafp3H`V3&!C0NlQ4W9&-Ma8iJNY6v!7!10Qoj(cd zPgpF$wjL5IjH9c-n4tI+kSrjUG4+^uN`RYuS`0@;QDB}G5NI~U0o5D`<*?gpOakwV zk6{Cd0LMVol~WC0B&(C@Ulm40ZVvK3d9O4ZCchPV6iGuNrTXCqX(vgOo`oe12}6v{ zD`T?V28>KP!ia=x3kVT$r_Tx^ziz>7y!M-Z3M5lYZpXrE;2a5oV+OfLK zT)lQKdF?f`i>drVSKXBEsReJndOvXfd(*|r?TzmiD;HaC)BB@NiR58P-~gmI()hXZfJprFDPF z5kC2$Q5NgpQVzcDqw2fU{iaIwO1SB)$Hm!VrP8Q@CG&Whc`YBg*His*rP!$X z%2)R(bXEVwOtJFmM(u7Ts5dojuYRlYRHJrSH{`i_JF5Q}ZI&Cgk6OaLRs`Z@S>?di z?rP;zjoLk0Q_y;VuHf6+okl0Cn3pv$H~r%3(<^WLTwA+;uks}9H@nABYXwtKwRm0L zuC3kMD@%=U$li6{jsJtXpKPsrbnC{SSNa=d{859y&KovB71IuB`Qfb_e_T1)sFl;j zO6T<#xP+%vPp`i7hTXO@(D(xf4yD(2cN;He%+6l3ldEstSfj6<+cG7e+38#8bUR1k z$@=czx-nz-v329)n7P1mZ$yCj-^ItdMs2*Fs`XB9tId~7b*OJyhn{72GAwv|>oaKo ztRxCaNm%T4Y`yy*DTrZMBok>sI>@n;At^4Tu{RQp+DICKOO_jj!7Et&3WHhzhco7> zgb2f^BTGT-n~)De{U_jYP$P!mOy$NQs0w@QkJ29ww6Agq2?nvPEm zM=mWZ4FO?aJ6aI75UUadko_w`648}lncKGxY>c`J?20<+SUn^ky(xeqU148!SqzaQ zNt7?Kw`mbpunUV7(ZV4HA6?(LxVR}0u(h$cw7I;|CnDfaeei~p(14AUPArgkLE$WY zA`E3yi}-+PqeJwOa}c_RAmbJN4nSmK)1hpz-!xzh8(dqwxZDS6ENb=VU`kGIsyI?u zjFM!6WG^Eu)gd|omT@>rhlCTBVu;;X0*f73L#_`klvrIrEE&0l#FDvg zqkS}$9AkItS?FFf9`}`*qQ~QLf2FPzPxtG|^bcPhTS;I0;raGDRjB>|W@o3u)oKj0 z2kKz%?N~S)%dB#3=Cc?sG2^hMN5g)Ha46mixixTaTRfPVt=$v3`PD|iXb2HdZBNVQ zu~S^>W0S2BPSDD>4#3^dmNn_YvqHumgc5XNRLmDEml`iBKD7F_$5pTXq>^v^o?>yF z@h7Qb<#9))c2TdsUYWBiQN|yl(s^g4u6p$=l`%&pWc)TNl^b8ThHH1#w{|xwsm6-y2)IAFVvvs12!{ z*Ja;nW>Tl%5%st&yP%!vhIw)8#(zO)>y6sI^-;<5b=zX)H?Dta&F#7dJK@%ie=gbD z6;wXdsEyXgR~p}tu?DNx08^`1%dh>8{H~8H`6MHG8BC9ys81)yW=KZ$wemA`zX&A@ zlp{$DEll*&(y+qh_|VZn`}sXXpre))O1R2Om}Y+=Fe8Ut8iFmz>Wu)IIh#S8!5Yy3 zV%T3$nD#aR1$A(c5V(yE#pEimzYOR}?2#Z}ha;N;fXMf1fO`1Y}ZVc8x+I zA}1DHL6TlWOND_tmzbJMLzRS_VI>h{f=IN~IM|ClH-Vrh@R-zG2C6wsn9@CDO`Qx? zjt}PvOBmv#Yu1b{sMC6}vM>P>TTG2Pn930OG0|*wa=p+FgX2nfuuUQCJWzA{zSPx9 zVEX#Erz^4RwWIONhgn>d7|GHs#mUyIKS)+Oel#j7fot!)s+zx63Cvvo_6)WA3zdZq zzf86Nhh<*utyd1n2uR!5*TtI+YR5xK3t$&J2gu&eHey&RH~|!8`-$`_!rtuof>S_x z)xsesrUJ$6O4va%+)0T3=zmsn7Jt_r`aYQGP_N7MSe9kOq@F{~#Ta?im7mB@y8z4WQAxpkh z13N$gqO=bPShQ?oI4$TeddG-ZDzO%XTqnthta1smw3rPW(&B~Xr1G=EouWjNFOOaB;#J;}~BCz6^+ibrNGF0u!!}OBGgTB;URM($>KX zl|y{2qo?@bIZc5MIxga+EzfVr_&*APxFS2CNQ;B_I%?JKtdB7!^B?Z1`e(|F`gK)Q zlG*=CWyA8tl^xy6E;vKheZHj&>5Hmr`!3Y@AFIw~d`7qD7AY{OcH2Ic_^0akyXyCA zb*zPlucqF+$ghfE?B%+R?ZYbZvigO@qdU?Dby!}~@VxOxR!`K^x3txMB1ihM?4;(E zCV)Rht&*g8Pp4mBNnd|<%~MRj^K`n07r%Am1vSVAZkcUI9Ls$7vRdY|_40#T?|w&a z(o0+KzF0oH^{zJX0}S1cqrSphR3|vR<*N=j#8&puP_Tglz39@83&XH{RtP z+ZT;KIP1O9Z6SkahtIw3o6YC`!J-6BD6(rW{sTtvnwELvgvR|F_u8!B|7RFhl>FTX zG`pDIL!46DjSoH|7cH5bB6g!=G8RM9JIT1uY`MOrJ4_*JQF9>0n}2~0tJ(=#i=jVx z3g7rSCWPxlvXR9X`>cLm+WOzmOxFy#wwc;JT(Nqzt}fNp<8BrxOWva;sSK#4%0NiE zYKIFg@J3nE9)dQ=KIpinV;BJ|u#jAOkkXoN`4~Y+>`e`tJXbA}IKm8CY6o!Z#-aZk zftFwwBLF4a5>i{c3&1eYG1Qi~3@L!Y#R*JJ=+o?01$LqGQ$Q-GlOc#mf-}G)7^S3&Vo*rl zF(0y^Na04zDY|uKkc*!q>(Myeq?Q7SEWNcgj>{n5Fk-s~O+@xnbk`tsjCEb0dDNM?r{e%NVZV+6CzehZK==W5OpyyQVNOgqM+n9MK6YN~0C1l~ z_8A};W2cu?o@N{dF>DI`Llh{c&B1^u#lBIm zVZfkl7lJuJr>uPr;kbF$AtF+kbqK4~vknoFma`7QMM&L+a3zXo9YR&1Da@WGA4K%5o_r9Hq3Q+T9;EI93>%nM0KmZ+@KDNL0{{-1d_VyPO+J8;R4Gc;5m6i=EHMZ!H7E5_qGT^u%Nl}T*0#_Lfx=7jHw2u4ZR?=>W*Lj88*TF9X|)*%>%6H9G^{^MD2z5@yG8nH9cE{3AkK1kM+G&U;C!u^&Yx z7qJff&6=PIm^Q@#bNDwE06zgk)?kEy5iw7&3_eCJh!Z=Cu|>!Q63FAn=406?XUkp; zOE&!QpMyUKRVoa&Eb~CoWh#asP|g~{E^;Ca*r9~O8tAlQDl?$%$(_}PM>6@%?y>GU zL(0g~2LtU88R{(yUb1bcz0~ENcVA6;+||2^?z7V@^5c%1(x>Go?$93!I$y(nm1-L>qMED(BGcCs}nX3WH z^acPKHEqK*NG}$sx1%*k3hm*9z3oFTSTEfw0M;|=9)%CGJEyK{7L#x)j(XhEsQG#^ z?Y+G|CO_UNX1rY}L-jX{S&ky=bk%WTvz`8U>StxRZ0&67`yTj&z9T<>6JMXJOf;^} zutt)?~2== zHg;!8%um*=c;5DYu0B&5XN_ovG$Ba7=j8s+rV`^o2T=ZF$KttMe14GpZG#fJ@$id^ zltyR|xjy+ivvrM>c3%1eL1SABEmssUgIJav$RHtwhcqA&s1%5)N)fWj2?5Vk3i^sl zfsCpYaa>uC;`L<;1YV`!^pq*kMcjJM?x4&_4;y=QV7og)rms*t40q!57~A&LBQrf7cx%+<#d=oWB9iJhu;XC; zNIfg#4`rU}-*dG%4RGdL&s?p$r^`ILAlh~io$mVAhqFCfuK(s@483yj^F zww(&D9`x28$#^ojoA8E-AOcVM2!dNF<-WH1&VtYEbvL#L@YnQRL$2HOuD-+d-29iO z>O*jX*=zca)Jx`(65YL|0NKu+DT-HJ=zKHnIk&a@5%)qL`eeKN_Ag-s`g-^J_ED8I z``qumd;JBokLJ5uDR1qTGMw!?JYO>JsUGF95Az--tZMNGUn|b= z&Y;fL?xE3=Z@yR+MZB5PW8Q~3-zSY2Z}oPM9Wjr$?Q|Tb2ULEN>T)lf@Tjtm1%G|T z^mDfhf!dv>f7J{yYU7%gd2-?8j@R__^xX?5>*jIK!tv@KV=wx9Yk#Q<96gvPSKq-# zIvSjihh}0x9s{L%Y}1c8%~xFg5wLI_a{viNVg|$!b$cR0QVs>TMIc#m$W0hX3|PlI zB%~3`D;ALatUf3*O7Tb&*WZ|bvGXA|L&Zr+aW@PX9t&3rrMc9(pwrJkAD zX^(fY5BGmQ$3JJEp6QO?W_Gsi+-`RDywM%FHC27wz0jNL_3R9py@=KwO?BVPH;B}Q zq04tB&7&R!+~Qu4+vC2qmVGGpE( z^P7ZsVtJ6w_do{>jJ71T2Mz#mHb4V~_5u>9zskf20+qAC5 zE`V;85g)-!ET^%QVBz@1LpH!a++w5`J}4RGcRe_X7$KIIksG;*X#>T$z-${_TIF<< zha3X+KE+n(!aij|XV+}YL4VDG48$sJ%ZsW*^oW$t)2RvOwo$EgYK4vNceE;W#B7_a z1suI^-4x^tAC_h?PkZWE*csYB$G7CtPF;lJj+7h=8TDK*7H31KA#Un3Sa{iC5Wmm76o%s1P05O}!lRIszh^AOL&R=G~vaEka zmR7x--FTLNevAL|xcrBrFwEoBSUy75C^hDbmk*e}Qe%3iR9q>hGg-3>_dL8`HIHly z!m;Xy&7SAYd$teL$M2fGmv1wVe#`7F`JR^V{g}rO-2sy3S`cQ>cg!RI#Propq?$YH z**Rc(i(f4H$0u!0mjbV4DMjki^MH1lfh$VySw@cmu&lhd9jpm3snWp{!jTdMmjvDOcjN-Q zDR5iq{RXUYI!U53DcR6ZA&`@PiYbCVk0Dkp2o0Q#4id3Rfjz^LecC)tQB4#g0sq}6?l1by53L3D;**Xo0z2Ld+z;AH_P7*ivy3)^Xczm-4l zuwFIcQ!BzbakRx|)Pm7YTdRZEFt)3*J=DXRPiu*zgVrK@*wzx>PAAP(R(Phf#5LzR zvgQmp<$VBq&uF}{eGenoDF1Z?Fi8L{5r~ql8&RiZDCD=Bl-5l8MxS_c@sfN73GaV` z2Fr})ryg5IBzp0rIFGooJ`lgY(-5}`ea-2l3?JL?l}W`Uq+kUC zMv69t8yOTrZQV~IxP`BYC?2i=(&K8pRQoFG-QfA|6$*704;3rB*PmnQpn5OD`o8)I zHp7*vbX@yFC6KxPtqh|7ep}}K$+?i&xg&+pi_cI00h55PSIbwcZBbWv z8AG_TNj9!B-K0EEq~UQGL~$<@LWMOhIRVYJ<#Aklh;Oc699z7!Ocbj%57Q+fgdmI5 zQRg$I7G!13Yyyv=5%2)Ilxj^uXBwnr-0FM5mg~kZ23zxht;K0RfyQ=TC#H2Gt`oyL z@yj}KTqi!F6JC}0eSOpSYxVNEXRDc4aUES1)jp=f!MaPTnm{Emuq1J`V_szxJ(ynpMp0OS8LI- z2!AH7*1mrrASa;c2U~jp97-K`p@~*bO!)PE$-k2h6nAuFDM7eiOEwhw9*=xfmUST- zk;E{z@o4xnCnqsc%0{#I)`uXhOH0>&fs|TMCy7ofNB{W{SzA5sJqi&YaQDQAls%y1 zA)F(tcN~fjj3EEWy>R5>?hhA^6ff>Jo`Vk4^Ki8SE$CeBu5_{7cx9m%W)J8! z5Um!xP-V<6&q7!A-90H!Q8 ziM-aNCV@^ME@7{F1P`ayZve6mqqFmvCA`2!VCzc22Ym!q2PC+_kJta`^5#-W^y65R zEl(ZzfLMQ&56hu8kFJ%Qs7 zUF|h_!#%&Je`$u$FFHu-=Xl^jc7GV%w>ji}c_fk)sCOmdv&lfjL46{oSU$A0v1urB zc)W8iqe!!Q*9+`s&pe?2Lnd{MO#3T8vA!NmKs|Bz2$C)>RFlg|4J+?7kb#mOxT7H)9A33|JmCQwUn>?My8Ug+<@^;@U55isHK1 zEFms_bDaX_aX*fqjk=ejop5Y_q89LSvY9Kcd z%l~D(lGI+3yY4uKpYlA%uHnI?)#UYWCZAsISzRfT_C%N8L0UPk1CqSnBRU!oriuJ4 zKjK201gL5~COvsPpe_$r36*SXMr};!D9*smTjiJzf3wa*qZ1IycSh|qQlNp8!Rlxj z%z#V*eRx+3+j~kx~yA7mM=a5NM&xbr=1?wBQ`mpkQ5s z0b8;T%mNhnEbUxtC!nqYRPa1nM9?*13B_bigPT#70O>6|NHao1J+exgFaX@oDriDc z$GjMj@X!;`vYM$P* zMiJ~bW^N)cZ=v#&b3}8%! z4#7jNkXa$ao&)KG@k(@r0C*ALL=-P?#0KaeUOkqdTEh+7M;Dit3Bh@PdHL{uNZpzz zNW1X~nPI(Jj~>7=VCSM`$h!P0h+nGp$o*LzI46NCH@FE**U2uO)OTO?L~N5A0hE4C z*4koyQ&x%&R<`qnH~TzVUT(9yZhgMX>IY-e`NGF;W$k%8NbhDx-vs`L6a2QtW@%Yn zY$nA}FU9HtUFyp*RvypT=IU0y^WL#NVXkenXRG#pSMaPteHBelxNo*qab@W5p#Rl` z)u<(Y(aKkAa9m}vx*gwGUfd+bn6_ba`Ke93If$%_dLQg%I6d%I&knD(mFMsyT6qrZ zu4wAA#W0I`HLXaQ5u_GHd&q%!>J8(4bu0AHK_DXGogusRU2f60Z#FGigQ$Gs76f2+ zo=yT3HH|mZ(KT2G;TUUl>LJ|LTBtV5^8Q$E1~ded<_A0bK?^|P?#C-C=!rOd(_m;t zk~df!Mv-r~_a75CsW}f<>={S@$41bFY)HM(xC8rMU+V9mfm)kmR=W8ZmOOKl_WLz| z_(7{VNafAiqaHB?MbxuePPyb4g>`X$S!^s{Tz_J@r~%LdA*a;qfT3olX4P(DTvl!q zpR<@Oi(S?ivo>2~vUsgkfyDrT1fWZ1v;`^JU+n>%pf=BR-4eXsLp|K|S#-`O(W literal 25307 zcmcJ2dvIIVc_#qUvQ1kIDAA0eE$Lo`AX&C01scGL z)_7p_C>uJuxcu=Y@GeQ}}o&=X6Q z+S1dZk;p?&t#7O@uRVTTlsr^her#i52z{U&3)Ct>}Eghf4DYtIb8V^RsgQ0)Y^lM8`bv)SMaL*Za$^e(ik!+$=9w`?S zxbq?#pB(KODzE@6m2v+$W+O?^FwDGv?e%!P@jE^E*XQ-5pSaOO$uuumxqh+hH@Cgt z5xLs_y;rJ!RrBh$_p2h!n^qpDZhOyed;g`I+;o#wH~EO0EV{{QH~CRFX}QV!-Q@e- zq~A^6rjwqZxyc{9$^YRduer(p;wJxtn|#epe#=e1>Ly=slfUOCKP!{FPpQP3N-U|w z8I>rhL`EeNDluAF+1m|OR`+&CDmCBU?og%HwYPh;QtRH^JzS~XwzoS_sqNeQ(@O33 zy>C`(ckF$=QoD2S*~ao`8`WpG-+n~i*x=s9u4TVxC>#s0Glf)YX2Q<1XoMxxiDDuN z+QFizm;gDUits3#PL&BR3gsdTMco?E2&2Y|vXa{_LRA8;fPA5`QFexfM#tDOhMxdi zXQ7zI&SAJ9+hU zA_&MRTVYlx##WgXjIyVhWkuK$sA8CXij9TXr`c$bRT$P;!xjuoN+Mo+SumL@C0T)4tbpUpI?hZ9xd2N{;bdhKI!PNX%BhoOXClKf&(0TS%WR5;7!G}k zg;^ezGz2xCVi7ew6(JvGv!zsVB$*r0(+o4u7rVMWzI8%6fx7`;smxLLM2Y___LO+V z$yx7wWgoTU7}|fB|L`iC7r%MvQrC)14kB3{92`6)@)>Xc5s|9)A5w`yInQhSQ#glaVMZEIhuHURtPtgR$@!ZgM)M zt{YG)N5UL{ABzAk79I^n0f}KYgln0cDyCBA{S6z?W9RMi2%(w)4NZi37FQSr>GeEH z$MFs(C@pCBgTFA6^c$F zTPpK>fSL8ggk)>*q1EmtJ|sYMs?Y1SFM$Vn{!#3n1Mf0Gw14X0L6>W_wD$HJt=GJv zcWUqXp4r~_lXqU z{ad_7=C*Ha@$8!KC$eKi!0fBUC^AP`lEj%A`np>WVm0|9lp<(3D>#&mgbG~%W~ zR~2=$fN?qvXj5r)Rmq4;3nQu!z!i!FIPT?Va}%lJNic`7k)H>Hzz|L$mncqyXodn2 zHsO@ZPEHmCLB$CkMfZ`sQ+D!Gb`iTHIXM^;h%IWtH^2gK(HcBatu`2rx@mC1=1DDg zhs16#2vU}mB3VWBd|!> zz7>T_Wr*3J&#hPt_I@H!B=i+mFjY+CQpDLnWu3`MNgZ3y7}Y_RI+4oXyx!bzhwcHz z_uA{m%#kJ69aYU`K4vUV7Dd@asyvrU<&#c!HkYS8M3?{qXUZ)LH(zT3jM=@u0t*^P zJI|?_d(d=ns@v!I{nX9>qi`a{gBi9f;0F` z^^1=Gcbx+l?{W@3Q~jKCpgPF$eSa^J4Yc_qr~hltz|N3!*q1g(>b)K#juc5WZ7@)PvowlXMls=^FRCGw7=VF**(_ye-lP!mu*fIfp*_nZ8#$lZ& zC6pHvsr)3#=KMm0I4gu-Dc5r8wON|QZ5c}#DNdFrvcv55dvEi3x?J&fw(o;J!Oqh^ zzYZnRJHbUD$sIW`e~5HZ&*wx%pSNp9v(E19rJBe|u6M5H>(KxE*E$rgb}H=H@&}yF zR|VT$^Zjb(5X}7L+J3(M_z9lp=~Lc}@AACV521Yjb%Spx(k({I+CO`zG2kOU!5b^!{h7Eu zStL!ngt^SqnHsO!c(z1sL?EcGAu`1rqqrHbtWpq|NG`o)j% zA5Q+N)}@Z{OO5US^Y{4g$1tgk23&p2ibY(N17cN7YhlO)UA@1>Ze_(F25F-}Yh^U1 z6)}iZk+3^v6l#`IHmr!D^C5GK0VB{XZ#r89Rv>pws1&+oq69NnnXGjocL`zWfx3AZ z8i`U(t#H6Ffwb-^G#YaUZmW#A0*pnfZ`%?=un+2qLgwK$OI0Tl*;#m3f-raLF*>)1 z7$-?4Og(xKYT!HceaHE&n4wl$Pz&|w7UsS6=oYN7@6aOPs_a$(7F9iZ0KjtVz5!U7 zZrNhYFb#~sf~y-#Xc&WxujU(r30c>7I_5F+E;}|b^y)EeOOGaJ8-=-9%{FSZjg7fy z8Ur5aew`+XMc?66VjiWnyv zF|a*6<^oX|<*I!cb{xH5c}|3TYV43{hA@ecY)f{d+2cuaLk3|UDkfmHfe8i(N+w3( zg$Tl`p~edW!qnWskZbJ-8rBxeSS#81ReQ^5ZyD{4<^};Ztt4Zn3A)9)Jj$s-9*8~~ zxT%rCBDlDT?E`i0jRRTTgNAVk773?(+{wei3wzaZQcB^yfECx&CgIKqH5WwTXwln_ zj=J|{MPXT&eL>IR`?!TBX%Up%vOZ`|;~JC5wG!&I@(7fDV?eI^f(lt33Ju$u6)`U( z0@Twx2!krnfM5(U)5g=H`l1@-;ij4~s*Rhs!mgD7HLzWDxPvgfQSNwRBjnL)D>M0L z2#2q)B?Jbo_YuM@=n5+u+)i+}agP#MN65$+#yvQyj5`g&7vc5+a5PydtRM|(+CweN zpsSVz(A0|}tBGg}HyAt~uBpqif-PBN1s1rF9wPu39s0q#5*=m21PgOa0I=3#Ah80l z-n5q){5N2b*)h1`lv!>JW>eXbjlpc1nw(BaWA7OFXH(Wa@-YMHN3lrRV-y2Z4>k&7 z(Q4CyKc_>PJLae{W^4>(OBxenO;+W37K7Mhnv`Pjb*dAK!C#}(FlD1P*pJ)#B#Q#F zn(_uz5k{-tQSdml#<9AsTTvlunPa!rLZDQmMSxs7jT3K2g9zrn`AiY=ktsWS-eD1V zbDQ#HwwJEYh#^geaUnM!l@ML^3P;^j3`;XN3&U#2r(t231Lt9#4ud|r1HuA6YF-BA z-C;uD@@jbUJ7C>}oXR^8lBWm5qtyl&CRPT~w*|I?23-jPn_6K_m`Q~zI0(o$z&L1% zSwL6;W^?vr8Lra~D*5C=?UF+D;od|tTap|B=jw;M$e-wqSA0TO z=C($zxAk@T;@-^O%W37~C9w9tt57cZstF(S*GhWFB!t38-e|>kz(dn|vfXq=9f* z1wc@+13YxJObm{TaNyYOj{EwouDDN_Y##t~X}2e_*ZZ&=Up%q5dxV2qoc}e# zB>4LM0;w0aBAz7XPsN=u@JR@)mq>=>s z&}1b_JONx8MpIMn@!#eG)_gEL@EY1{GoA;t}{bn}gmFRIxJv zU?VyQ6jnv&!1Us#0rt8a5UFLmArpTbSJW=fMAdx7E5PjH zU7}#;XVp^@4tKvRn>R$&6;65Hn5l%~dpq~?Zq>HGGy6G|W(VJxb-CkmmV-L~!&d}i zWkG$*&5+_wT9zcWpsga1%?ji0pwIA)K@|ZlNzPD)10X<%qIh{4a+eV}i0i=(AWBu+ z0VFl&Mg*!L62xQ2WCeiG=nrL7Q}p(bS00u~t3Xg4QF8#B45I^~g3jekBIE)FmlLUC ziLR7{9xybxJt;Q^EFtuPx-gNL6gLgfJ%f=z*FbsISVVBghk$o%Yn^RgIDdX)X>*ft zkYbDLYfmC>dU<_q7~~r0GE^oEWjv;uyJ|b_Uef0<=RO<;%c&d(K?pii*~GMfKHxH} zr4)}4K)42(A-QCL4I`N9eV|+3mA;2>i?c^6wHw!;=QmmZU~TOBi-L02daix37RX)y zdaf3@_FJOtturD2rT5q%vcH@86Amr@*Oo8Wzg>MjD*$h|q7tW7qNozKO2kznrV=A6 zaZDu+tHeQ>_+$BtaMja0!^^L)yjH!uePc4S^V{(XU%RY-w&wed)oW4=xYZ!LjjTkC zXO@M_7QRfeClRb*01|1>hNJ+ELPI3(n`~1W27(AHMPO?XH0D?jk4RldMCusgTZ1s_ zZGn5Ez6a!R6rrsYgE|dTNa3s&EOQgUo)AJ<2^OI)LyLbBuoy+iD*@s%gGJ{t22=6{ z1~Ge+LBQ7Yk`2yTTS`_JHWFLwPfRRqE>T=WYndWz9dJj3Ro=;`as>`KVC#tqqH_@7 zTzC?4PiMf||NjSA^8l;`;pg1jEvZCCB@!wzsuCYoiThRJ11ixk6W>%((_d*UpLwnx zdu{v16S8V2sT?VP&{%$>E<#@SUQE||uRl}uFTe4xq=)X}giP#4RN_JV@(M<}R}Ibw z_<;of?`A5TQ10z~r&0fp*^6B^5yuvA0f9sqGM)oaP%;@U&v2eePyw6F10p~f;mRO} z6s`;kL*dGxp$Jz7pSJu4KrU1RSaED#nN zWkUe^hoSCD04ST`B1xw(?+V3Iwgvx7%|Xo~9_C~xc}j6tA~#_9U|+;VB-g@ukmg#L zm*T9U%OK9MZG6Gp)tdwXc*YY2G5kRc-z5|#j`#`wSDbtSY9L%j0WFCT90LoQq!Eb~ z@(l{9Yed^g(^2Z0Fs~Rh69JGh?aXrk3y{$%k0R;O^GEcwLZSjw=jLrph$Wp-vy5;t zX)0f8UP!{!LgazBYEq<)Ih?X9REY5!fbYi$$nCq^U?r*tljKuaH^+#ZxdC+-86oKQq4C z=Xg>$yZa9KB&m2N{ke4Q-tSLbyS$pY{z~RIR##UlaIy~$0x}^4mC7>(hm4~7XeDR@ z(cRmQqmEnyGR$p4*MRbzb55iLLX8kck*SGmA%=9;Oj}?Q z)N)%BGMWNi6SY7GwFG|aFgIa}7HldMvZgvD`5o6u3+W=cpGZ_Hh82z|p4N&1G4o{ENW!o&5tnG_OI%yMn&7}bp;3?@HZKz) zo^N)`U*F|Q=K3>@jLdqjRA!K!sU)xeeiFCA4R}0i67OqL(Cf(LLV0%$Jwq{9KZ1Wl z=|>Q)RT3UCjuKGt^qxpl7seZYhJ4g1U?Ue>6M+CkVSRihdwl!>*e8ybK$A#cK1yhLH5A&3KclbQZahMs39D5h@1Mmo8A34Dk{OZ%CIQ z4I27!k@|THL`7|^!mU7j7|+w=3IXQLSEO$T2T4~TPJ?sHMb7P&Fj^$Zr6G{DV44|L|xw)rZ_!lX=y zS`QoH7E!eA1SBMrx}ZTONJt`*a(BjKfwG#o>z#45RqzPX+Hy9)W+JbASHE$odH=;?LVA| z3#)X}-{<$l6C$&E_2jAutc!co6G=`qK(k?p)+du_;Ygs*x-R8p;j=Odv^gHGDuZ)M z3SmT01ZY(KgC zzyM*@hc&?-j zgc#x#rKli2Oj`g_FbE$csM|9zdw72C^?H2qZO`=z9$9$OUTFc?IowEaCY<)Yz<;+r z|5^V2nQC&sZo+YtOU=zi+nz6}#)G=%c|K14Q{v~7vcU_DhgZM1=&PT*X@_aiL5Q1s zI}fFOwO_x!b66~M4QuyZGnY^wP#Z8yMW}Y;AWX^#jlZ!!L6Rqo5jv6vGNn$##-Y+? zY#a$-?%P4IIMoP_eGRR;k$6TJM9fHOb^^y@lhD(s((By3+q6SUS zhQ%6KHvxu2a`;?|bO|MV5)$|!KzSIpzN?*K7u%at9!C!<=nZEyD;J3Y&Rdk|`hKb`S<(U2Ep22XjtyFbo&(}xESX9}(jv-f92LNPZ6g8=K*}Epp@f*JZTPt8TGVlio1+W3 z+0{f@dSRpT)WXKn+;U~Bifg%o_blE=!S+4;4;Kh(_x1(5*HT-HcgGid_$AB^_)dLo z?asdwA^OOjc_s6P@P=jVAN0#7zF8#YOJLdS^rc5u`+JO+q_YF3FHNuFDKO_+x|Ow- zSwUy@aJc^tQ4gWFzgHwz`VXnZVA}7if7e&P;;VlHW-KUGu3v}(4m6Kx^5q!iKpx!& z#)0DUQJg3J>^I4GgF%2|Jle!ooJS z3^E`(ol|o{o6auj9H|7PEaB@ZiP=q`0152RHJ`$%mCfd)p&s;9B|&LgV9?TFN~#$a>mmkeohG?ZAPIi2pj0;=X1?e4 zgYj{|n;Ybyw*uJv+TG%&rFz-RQ5|l_rqTgXI?zb4vj+@U!ToR*yu?Rz4!~DXzo!;( z4qX2RGJ$KqEz95fM9BYTyVmpl{MGsTpXC&@J1icUToLownID|(hwIhp-}dYXO0@HS z{wo2W8VtZ)>kJ?qUk`GRTqe~Xf}7SkRNoZ6UzX$c_cZMKS>0h!c3A1ZLv_WIdb|EH zIp_OCH^9HH9z^vKHNf*?)&E*F7cYG95bZsxen<7=4dA5Zzx9vE;omEUZ>~I&6SWub zF>B@dob|)aUDv};H1hHQ|BYPWo4wflp>2;`(#|2f0t5C-TtyM8seQJ$Ud!`>`dPV< zX?yL)jcc$DmeKolF)v2qwSy|_8+@Of#Obxc4P^NMAGUv>{$9E8Z{=PR!;AUyVvawR zzkihf_R9SB&;QfR&Omnepcq4rb(Nl|bCg~U+`JCg_mvVBN@liHwx?`rjMvg>*t@& ztyf^H#iH<86_DbYrKR(DG9QHpfxfAt`UNq)PUAYB<{@sn1dLp#At1rSWSk5|vwaG} zo-qPO{xlB*P`xM$pc7@LkkbmJIhTYZ=GG+E79`3Vmszoe*One%s8Jk^kib|CBG^$zVaU3XXtHo_YiR>t$pQpZ zoKDLCFj2F6$wsY|uNFy3G7|yw;2RXcr{xvNF*qzK*KQk!aHTF1SU8860#i~vL05w( zIJYCtOz?zW!4vw5`{L{q29bCD!Fk~i&R_p}Ui*XdZ#@$7e}(9K?&|BySL%PBfoJ&l zX8vtP5S#_&B6~>_)Smjok_vrL&;emS0r_sq`sxp;zB>b|ssaV*OVE6-_3!%~gTz%Y zYYG{aO;`WY=h^n&J+t#arEgdgE5kS3u*CMSJlYf{>F0sGpg;&?!cbCWlUgUzR z`VZwuD}T8!fNtVp|K5(|H>*^-y0TZ@`%?8(eO`5XL2{=Lh?#{0;|q!#-OfwTT)Ia! zf4Nar=XI*yFZ%quoN)^)uUD^Z|NPJ4A%JiusJZ#ZtCQ3pG~WhwYydINFiHjS(7+Y? zdE6482vPs8`k)n29uG!OtH?1d>KJsp;y5rGjTJWtb z_=}A)Qh|kg8UYMA8>0$a+l1OH4o?h=mwrtLM2>2=2YpS;$Px3SW20~ex0oKP=+lEM zr}_Os5m6Bfh>YBjbUTa@ho(0W0J*#fj*U1Am183evB4I23LoUc z+UnZ+Q)?7B35&$m)AY?j4N%Rr`)ChEW*j{ZhQXd(s9jh>eC7sgnYoqnOS1gS@~BYQ z7>sxH1qGzYo&y^Rsi}r7m3u^>j~?;CPQbk&9G#0LZa7-JqdF*6QHW*$Zt)t6Y>F}E zZ-ANqSWmOI&5uHEMp+S~>;WAQcU-)%EFPCnRJg}MEUU#g5pFfVgA2ku)b5#}a6{~l zRCnbjfYFa{y(8ySr!v|$0eOdRwN!*lefah+k9SUdT&W7{2%Nl}_*KQnl>~uS8R00{ zy+_b%e!Bc@AM=QIyo58{I6mgGOc6644@CV}Z9jdX!SfYqk3rFujCYl{6eJfV2x{@k z`ki&Wa)*mh)a~4lC)FYUjtES(2k3n@)qBb1Top=R{bRE6mm88tGg>g3i z=eGIZ`9`0=OGpd;!DYVtxdVfJUHgQywN`45GSrje!nALx;&3l+b<1#9v}iU=+84aDoPx3Gpz< zu=vQ}IBbvL9;dm$iU|1;XNpIDGH4ydQ{ef4Arbo*{u*?}7+4gfZNva3v*W2^(J6u! zxo|HLXc!@7Xfo7hE-^$?VI>)6L#EAy8%S%iY8Zqa_&hXZm_ur?jIbxTaRyyYQ_TjM zZB!K&03m#62n2hRZEh{BRiI!{=mmR<8@h(+BZ)^(b4T$bpos`$A3DZ}q_QFCWY{{` zixn~hi`@IxR=PQ-IGN>`4@V+BDfPmb;CDao}`M*WXv^ z^LA&w6yy40w&LZMj6>WU{=@Vuwm)$hHcs*S=p!u4&Z|9bHL6UREqb_qJ6qi2Bd%0~emSSN9T!dn5GhF%+N z3)&fhkW=oAFy$ziRNb~sf}2n%xxmJOW(aPya(O<9_$nSB$FEm?gc+q2h*m5l9)1|N ziHkOCfcr#yOR{D%iH|i6>2Gb~A#NfYr*X;SI7vID*rg%d2z=M{O|GFcr6h!kWE#Fj z))Nf_`sIK_Sto%|r(9v!82jA~4qh?z0Q(4n!^Fp_k8dqMvBcJvmMWV^F+xu~5= z1c@eeBsUC`N;tg=6rZp|Q)8h8deS0Zk%<>w*r)Ks7-SP#On_#PHJywbvWaYAQdVm$ z5TV}6SI}WxRb_S?!s`K|d842}m>mOfa;rY(%sneOkcVd-d}4a22FuE)VVPNiHD?uZ zql>UP!9WF573^4>5cMyx*&b*M6VNPdXd%0E`GzTr_9CRJ%LT7*>__iqoF;H+= zwPToiY?%MU<-u{Rd3Sr5y=&`e`O1dw!(BBl;5L`@%MsrYH7eTTAlzASyA(2GIKYkrE~PE0xH#sny(z9#2hQ<$Or7ISP@Uspgsn?y4PWTtv_gl8xd+o4mZ8_D57B_2 zCJ(=EDQ}K2*WE{pk54z|vL>CQ&`_JpI{=y~n;OHra)};+2F(fPugf^!)j7%NbiM=E z!8!KO((w&VV5zdq3H=20r!Y_JffosZFlcH*viLY25vis|)QX30m*(^IBsS3lS)blO_Zssf80u;$a^b z?KH&Fakqdx(Kzux3_!>LCKK$Cn4VyeAJ>-E&iAKUwVznqE%tOg!FPLsoqONp0^3)E X?fg^jujd_({+&<0r}gCdYuEn=LW|~? diff --git a/library/tedit/TEDIT-WINDOW b/library/tedit/TEDIT-WINDOW index 062703fa..37d95e1f 100644 --- a/library/tedit/TEDIT-WINDOW +++ b/library/tedit/TEDIT-WINDOW @@ -1,65 +1,73 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Oct-2023 21:46:58" {MEDLEY}tedit>TEDIT-WINDOW.;7 180689 +(FILECREATED " 4-Mar-2024 15:15:31" {DSK}frank>il>medley>ncmedley>library>tedit>TEDIT-WINDOW.;2 195339 - :EDIT-BY rmk + :CHANGES-TO (FNS TEDIT.NORMALIZECARET) - :CHANGES-TO (FNS TEDIT.DEACTIVATE.WINDOW) - - :PREVIOUS-DATE "14-Jul-2022 16:55:53" {MEDLEY}tedit>TEDIT-WINDOW.;5) + :PREVIOUS-DATE "29-Feb-2024 17:04:41" +{DSK}frank>il>medley>ncmedley>library>tedit>TEDIT-WINDOW.;1) (PRETTYCOMPRINT TEDIT-WINDOWCOMS) (RPAQQ TEDIT-WINDOWCOMS - [(FILES TEDIT-DCL) - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\SCRATCHLEN 64)) - (FILES (LOADCOMP) - TEDIT-DCL)) + [(DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITCARET TEXTWINDOW PANE) + (MACROS FGETPANE GETPANE SETPANE FSETPANE) + (I.S.OPRS inpanes))) + (INITRECORDS TEDITCARET PANE) (FILES ATTACHEDWINDOW) - (FNS TEDIT.CREATEW \TEDIT.CREATEW.FROM.REGION TEDIT.CURSORMOVEDFN TEDIT.CURSOROUTFN - TEDIT.WINDOW.SETUP TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.ACTIVE.WINDOWP \TEDIT.BUTTONEVENTFN - \TEDIT.WINDOW.OPS \TEDIT.EXPANDFN \TEDIT.MAINW \TEDIT.PRIMARYW \TEDIT.COPYINSERTFN - \TEDIT.NEWREGIONFN \TEDIT.SET.WINDOW.EXTENT \TEDIT.SHRINK.ICONCREATE \TEDIT.SHRINKFN - \TEDIT.SPLITW \TEDIT.UNSPLITW \TEDIT.WINDOW.SETUP \SAFE.FIRST) + (FNS \TEDIT.CREATEW \TEDIT.WINDOW.SETUP \TEDIT.MINIMAL.WINDOW.SETUP \TEDIT.ADD.CARET + \TEDIT.CLEARPANE) + (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) + (P (MOVD? 'NILL 'GRAB-TYPED-REGION) + (MOVD? 'NILL 'REGISTER-TYPED-REGION)) (INITVARS (\TEDIT.OP.WIDTH 12) - (\TEDIT.OP.BOTTOM 12)) - (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM)) - (CURSORS BXCARET BXHICARET TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR + (\TEDIT.OP.BOTTOM 12) + (\TEDIT.LINEREGION.WIDTH 8)) + (DECLARE%: DONTEVAL@LOAD DOCOPY (GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM + \TEDIT.LINEREGION.WIDTH)) + (CURSORS BXCARET BXHICARET \TEDIT.LINECURSOR \TEDIT.SPLITCURSOR \TEDIT.MOVESPLITCURSOR \TEDIT.UNSPLITCURSOR \TEDIT.MAKESPLITCURSOR) - (INITVARS (TEDIT.DEFAULT.WINDOW NIL)) - (GLOBALVARS TEDIT.DEFAULT.WINDOW) (COMS (* ;  "User-level %"is this a TEdit window?%" function.") (FNS TEDITWINDOWP)) (COMS (* ; "User-typein support") (FNS TEDIT.GETINPUT \TEDIT.MAKEFILENAME)) (COMS (* ; "Attached Prompt window support.") - (FNS TEDIT.PROMPTPRINT TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN) - (INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10)) + (FNS TEDIT.PROMPTPRINT TEDIT.PROMPTCLEAR TEDIT.PROMPTFLASH \TEDIT.PROMPT.PAGEFULLFN) + (INITVARS (TEDIT.PROMPT.FONT (FONTCREATE 'TERMINAL 10)) (TEDIT.PROMPTWINDOW.HEIGHT NIL)) (GLOBALVARS TEDIT.PROMPT.FONT TEDIT.PROMPTWINDOW.HEIGHT)) (COMS (* ; "Title creation and update") - (FNS TEXTSTREAM.TITLE \TEDIT.ORIGINAL.WINDOW.TITLE \TEDIT.WINDOW.TITLE - \TEXTSTREAM.FILENAME)) + (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.RESHAPEFN \TEDIT.SCROLLFN)) + (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)) (COMS (* ; "Process-world interfaces") (FNS \TEDIT.PROCIDLEFN \TEDIT.PROCENTRYFN \TEDIT.PROCEXITFN)) (COMS (INITVARS (\CARETRATE 333)) (* ; "Caret handler; stolen from CHAT.") - (FNS \EDIT.DOWNCARET \EDIT.FLIPCARET TEDIT.FLASHCARET \EDIT.UPCARET - TEDIT.NORMALIZECARET \SETCARET \TEDIT.CARET)) + (FNS \TEDIT.DOWNCARET \TEDIT.FLASHCARET \TEDIT.UPCARET TEDIT.NORMALIZECARET + \TEDIT.SETCARET \TEDIT.CARET)) [COMS (* ; "Menu interfacing") (FNS TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENUFN TEDIT.REMOVE.MENUITEM \TEDIT.CREATEMENU \TEDIT.MENU.WHENHELDFN \TEDIT.MENU.WHENSELECTEDFN) (GLOBALVARS TEDIT.DEFAULT.MENU) [DECLARE%: DONTEVAL@LOAD DOCOPY - (VARS (TEDIT.DEFAULT.MENU (\TEDIT.CREATEMENU '((Put 'Put NIL - (SUBITEMS + (VARS (TEDIT.DEFAULT.MENU (\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| - Plain-Text Old-Format - )) + Plain-Text)) (Get 'Get NIL (SUBITEMS |Get Formatted Document| @@ -78,763 +86,527 @@ '(TEdit '(TEDIT) "Opens a TEdit window for use."] (SETQ BackgroundMenu NIL] - (COMS (* ; "titled icon info") + (COMS (* ; "titled icon info, ") (FILES ICONW) (BITMAPS TEDITICON TEDITMASK) (INITVARS (TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD)) - [TEDIT.ICON.TITLE.REGION (CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL] - (* ; - "Original was (create REGION BOTTOM _ 4 LEFT _ 16 WIDTH _ 64 HEIGHT _ 77).") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - [TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS - TEDIT.ICON.TITLE.REGION - NIL] - (* ; "Original was (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ TEDIT.ICON.TITLE.REGION).") - (* ; - "Changed by yabu.fx, for SUNLOADUP without DWIM.") - ]) - -(FILESLOAD TEDIT-DCL) + (TEDIT.ICON.TITLE.REGION (CREATEREGION 16 4 64 77)) + (TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK + TITLEREG _ TEDIT.ICON.TITLE.REGION]) (DECLARE%: EVAL@COMPILE DONTCOPY +(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE + +(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 NOT VISIBLE. Used to track the current state of the + caret) + + TCCARETDS (* The display stream that the caret + appears in) + TCCURSORBM (* The CURSOR representing the caret) + TCCARETRATE (* %# of MSEC between caret up/down + transitions) + TCFORCEUP + + (* T => The caret is not allowed to become visible. + Used to keep the caret up during screen updates) + + TCCARETX (* X position in the window that the + caret appears at) + 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 'TEDIT-NEXT-PANE-DOWN) + (PUTWINDOWPROP DATUM 'TEDIT-NEXT-PANE-DOWN NEWVALUE)) + (WTEXTSTREAM (GETWINDOWPROP DATUM 'TEXTSTREAM) + (PUTWINDOWPROP DATUM 'TEXTSTREAM NEWVALUE)) + (WTEXTOBJ (GETWINDOWPROP DATUM 'TEXTOBJ) + (PUTWINDOWPROP DATUM 'TEXTOBJ NEWVALUE)) + (PTEXTOBJ (GETWINDOWPROP DATUM 'TEXTOBJ) + (PUTWINDOWPROP DATUM 'TEXTOBJ NEWVALUE)) + (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)))) + +(DATATYPE PANE ((XPWINDOW FULLXPOINTER) + PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER)) + (ACCESSFNS (PWINDOW (PROGN DATUM)))) +) + +(/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER) + '((TEDITCARET 0 POINTER) + (TEDITCARET 2 POINTER) + (TEDITCARET 4 POINTER) + (TEDITCARET 6 POINTER) + (TEDITCARET 8 POINTER) + (TEDITCARET 10 POINTER) + (TEDITCARET 12 POINTER) + (TEDITCARET 14 POINTER) + (TEDITCARET 16 POINTER) + (TEDITCARET 18 POINTER) + (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) (DECLARE%: EVAL@COMPILE -(RPAQQ \SCRATCHLEN 64) +(PUTPROPS FGETPANE MACRO ((P FIELD) + (ffetch (PANE FIELD) of P))) +(PUTPROPS GETPANE MACRO ((P FIELD) + (fetch (PANE FIELD) of P))) -(CONSTANTS (\SCRATCHLEN 64)) +(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))) +) +(DECLARE%: EVAL@COMPILE + +[I.S.OPR 'inpanes NIL '(inside (fetch (TEXTOBJ \WINDOW) of BODY] ) +(* "END EXPORTED DEFINITIONS") -(FILESLOAD (LOADCOMP) - TEDIT-DCL) ) +(/DECLAREDATATYPE 'TEDITCARET '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER + POINTER POINTER POINTER) + '((TEDITCARET 0 POINTER) + (TEDITCARET 2 POINTER) + (TEDITCARET 4 POINTER) + (TEDITCARET 6 POINTER) + (TEDITCARET 8 POINTER) + (TEDITCARET 10 POINTER) + (TEDITCARET 12 POINTER) + (TEDITCARET 14 POINTER) + (TEDITCARET 16 POINTER) + (TEDITCARET 18 POINTER) + (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) + (FILESLOAD ATTACHEDWINDOW) (DEFINEQ -(TEDIT.CREATEW - [LAMBDA (PROMPT FILE PROPS) (* ; "Edited 1-Jan-2022 23:54 by rmk") +(\TEDIT.CREATEW + [LAMBDA (WINDOW TSTREAM PROPS) (* ; "Edited 14-Jan-2024 22:13 by rmk") + (* ; "Edited 18-Dec-2023 23:01 by rmk") + (* ; "Edited 25-Nov-2023 10:37 by rmk") + (* ; "Edited 23-Oct-2023 22:11 by rmk") + (* ; "Edited 21-Oct-2023 12:20 by rmk") + (* ; "Edited 18-Oct-2023 09:56 by rmk") + (* ; "Edited 1-Jan-2022 23:54 by rmk") (* ; "Edited 30-Dec-2021 23:00 by rmk") (* ; "Edited 29-Dec-2021 16:35 by rmk") - (* ; "Edited 24-Dec-2021 19:21 by rmk") - (* ; "Edited 27-Oct-2021 12:25 by rmk:") - - (* ;; "RMK: PROPS are passed to CREATEW and \TEDIT.ORIGINAL.WINDOW.TITLE. .") - - (* ;; - "RMK: If PROMPTWINDOW is in PROPS, I don't see how it gets attached to the new Tedit window.") - - (* ;; - "Also odd: The argument PROMPT gets printed, but then gets replaced by the property PROMPT") - - (* ;; "Don't set the global TEDIT default window if we have a region property, that must be special purpose.") + (* ; "Edited 24-Dec-2021 19:21 by rmk") (* jds "23-May-85 15:19") - (CLRPROMPT) - (printout PROMPTWINDOW PROMPT T) - (LET ((PROMPT (LISTGET PROPS 'PROMPTWINDOW)) + (* ; "Edited 27-Oct-2021 12:25 by rmk:") + + (* ;; + "Don't set the global TEDIT default window if we have a REGIONTYPE, that must be special purpose.") + + (* ;; "If the region/window is typed, we grab (or create) a region of that type. The usual entry (TEDIT) defaults to type Tedit, giving a stack of regions in TYPED-REGIONS. The effect is that the next (Tedit) window will open where the last Tedit window closed. It's a little tricky for REGIONMANAGER to compensate for the prompt window, but it means that the user can reshape what is initially offered.") + + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) (PHEIGHT 0) - REGION - (REGIONTYPE (LISTGET PROPS 'REGION-TYPE)) - WINDOW) + TITLE REGIONTYPE PROMPTPROP REGION FILE PWINDOW PREPROMPT WTEXTOBJ) + (CL:WHEN (AND (WINDOWP WINDOW)) + (CL:WHEN (SETQ WTEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) + WINDOW)) + + (* ;; "Reusing an existing Tedit window, undo its splits.") + + (for P in (REVERSE (CDR (FGETTOBJ WTEXTOBJ \WINDOW))) do (\TEDIT.UNSPLITW P))) + [SETQ TITLE (OR (WINDOWPROP WINDOW 'TITLE) + (LISTGET PROPS 'TITLE]) + (SETQ REGIONTYPE (OR (GETTEXTPROP TEXTOBJ 'REGION-TYPE) + (AND (LITATOM WINDOW) + WINDOW))) + (SETQ FILE (GETTOBJ TEXTOBJ TXTFILE)) + (CL:UNLESS TITLE + (SETQ TITLE (\TEDIT.DEFAULT.TITLE FILE PROPS))) + (SETQ PROMPTPROP (GETTEXTPROP TEXTOBJ 'PROMPTWINDOW)) (* ;; "All this prompt-height calculation would be unnecessary if the attachment in GETPROMPTWINDOW does the proper shrinking of the main window.") - [COND - ((EQ PROMPT 'DON'T)) - [PROMPT (CL:WHEN (WINDOWP PROMPT) (* ; - "RMK: If not a window, PHEIGHT remains 0") - (SETQ PHEIGHT (FETCH (REGION HEIGHT) OF (WINDOWREGION PROMPT))))] - (T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT] - (SETQ REGION (OR (REGIONP REGIONTYPE) - (GETREGION 32 (IPLUS PHEIGHT 32) - REGIONTYPE))) - (add (fetch HEIGHT of REGION) - (IMINUS PHEIGHT)) - (SETQ WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE NIL PROPS) - NIL NIL PROPS)) - (WINDOWPROP WINDOW 'TEDITCREATED T) - (OR PROMPT (GETPROMPTWINDOW WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - TEDIT.PROMPT.FONT)) - (CL:UNLESS REGIONTYPE (SETQ TEDIT.DEFAULT.WINDOW WINDOW)) + (CL:UNLESS (EQ PROMPTPROP 'DONT'T) (* ; "PHEIGHT remains 0 otherwise") + [SETQ PHEIGHT (if (WINDOWP PROMPTPROP) + then (SETQ PWINDOW PROMPTPROP) + (FETCH (REGION HEIGHT) OF (WINDOWREGION PWINDOW 'REGION)) + else (HEIGHTIFWINDOW (ITIMES (OR (GETTEXTPROP TEXTOBJ + 'PROMPTWINDOWHEIGHT) + TEDIT.PROMPTWINDOW.HEIGHT 1) + (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT]) + (CL:UNLESS (WINDOWP WINDOW) + + (* ;; "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)) + else (GRAB-TYPED-REGION REGIONTYPE))) + (CL:UNLESS REGION + (CLRPROMPT) (* ; "System promptwindow") + (printout PROMPTWINDOW "Please specify a " (OR REGIONTYPE "Tedit") + " window region") + (CL:WHEN FILE + (printout PROMPTWINDOW " for " T " " (FULLNAME FILE))) + (TERPRI PROMPTWINDOW) + (SETQ REGION (GETREGION 32 (IPLUS PHEIGHT 32) + REGIONTYPE)) (* ; + "We don't want the default to keep shrinking") + (SETQ PREPROMPT (create REGION using REGION))) + (add (fetch (REGION HEIGHT) of REGION) + (IMINUS PHEIGHT)) + (SETQ WINDOW (CREATEW REGION TITLE NIL NIL PROPS)) + + (* ;; "If we grabbed a typed-region, (maybe just a Tedit region by default. We stash it back onto the window so it will be remembered for next time.") + + (REGISTER-TYPED-REGION REGION REGIONTYPE WINDOW)) + (WINDOWPROP WINDOW 'TEDITCREATED (OR PREPROMPT T)) + (CL:UNLESS [OR PWINDOW (EQ PROMPTPROP 'DON'T) + (SETQ PWINDOW (WINDOWP (CAR (WINDOWPROP WINDOW 'PROMPTWINDOW] + (* ; "Set up the promptwindow") + + (* ;; + "GETPROMPTWINDOW sets WINDOW's PROMPTWINDOW to (PWINDOW . NLINES), but returns the window") + + (SETQ PWINDOW (GETPROMPTWINDOW WINDOW (OR (GETTEXTPROP TEXTOBJ 'PROMPTWINDOWHEIGHT) + TEDIT.PROMPTWINDOW.HEIGHT 1) + 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 'TEDIT.PROMPTWINDOW T)) + + (* ;; "Make the window's dimensions available thru TSTREAM even though it hasn't yet been configured for the text") + + (\TEDIT.MINIMAL.WINDOW.SETUP WINDOW TSTREAM PROPS) + (WINDOWPROP WINDOW 'TITLE TITLE) WINDOW]) -(\TEDIT.CREATEW.FROM.REGION - [LAMBDA (REGION FILE PROPS) (* gbn "15-Nov-84 18:04") - (PROG ((PROMPT (LISTGET PROPS 'PROMPTWINDOW)) - (PHEIGHT 0) - PWINDOW) - [COND - ((EQ PROMPT 'DON'T)) - (PROMPT) - (T (SETQ PHEIGHT (HEIGHTIFWINDOW (ITIMES (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - (FONTPROP TEDIT.PROMPT.FONT 'HEIGHT] - (SETQ TEDIT.DEFAULT.WINDOW (CREATEW REGION (\TEDIT.ORIGINAL.WINDOW.TITLE FILE))) - (WINDOWPROP TEDIT.DEFAULT.WINDOW 'TEDITCREATED T) - (OR PROMPT (GETPROMPTWINDOW TEDIT.DEFAULT.WINDOW (OR (LISTGET PROPS 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - TEDIT.PROMPT.FONT))) - TEDIT.DEFAULT.WINDOW]) +(\TEDIT.WINDOW.SETUP + [LAMBDA (PANE TSTREAM PROPS AFTERPANE FIRSTLINE) (* ; "Edited 9-Feb-2024 10:51 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:") + (* ; "Edited 30-May-91 23:34 by jds") -(TEDIT.CURSORMOVEDFN - [LAMBDA (W) (* ; "Edited 12-Oct-2021 13:14 by rmk:") + (* ;; "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.") - (* Watch the mouse and change the cursor to reflect the region of the window it's - in (line select, window split eventually?)) - - (PROG ((X (LASTMOUSEX W)) - (Y (LASTMOUSEY W)) - (TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) - (CURSORREG (WINDOWPROP W 'TEDIT.CURSORREGION)) - LINE LEFT RIGHT) - (COND - ((INSIDE? CURSORREG X Y) (* Do nothing) - NIL) - (T (SETQ LINE (\TEDIT.FIND.OVERLAPPING.LINE (for LINES inside (fetch (TEXTOBJ LINES) - of TEXTOBJ) - as WINDOW - inside (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ) - when (EQ W WINDOW) - do (RETURN LINES)) - Y)) - [COND - (LINE (replace BOTTOM of CURSORREG with (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (replace HEIGHT of CURSORREG with (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE] - (SELECTQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ) - (TEXT [COND - ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - \TEDIT.OP.WIDTH))) - (IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - \TEDIT.OP.BOTTOM))) - - (* ;; "The region to the right of text, for splitting operations.") - - (CURSOR \TEDIT.SPLITCURSOR) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH)) - ([ILESSP X (SETQ LEFT - (OR [AND LINE (COND - ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE) - 35.27778))) - (T (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE] - (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - 8] (* In left margin; switch to the - line-select cursor) - (CURSOR TEDIT.LINECURSOR) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'LINE) - (replace LEFT of CURSORREG with 0) - (replace WIDTH of CURSORREG with LEFT)) - (T (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - (IPLUS LEFT 8]) - (LINE (COND - ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - \TEDIT.OP.WIDTH))) - (IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - \TEDIT.OP.BOTTOM))) - (CURSOR \TEDIT.SPLITCURSOR) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH)) - [[IGEQ X (SETQ LEFT (OR [AND LINE (COND - ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of LINE)) - (FIXR (FQUOTIENT - (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE) - 35.27778))) - (T (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE] - (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - 8] - (CURSOR T) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - (IPLUS LEFT 8] - (T (replace LEFT of CURSORREG with 0) - (replace WIDTH of CURSORREG with LEFT)))) - (WINDOW (COND - ((AND (IGEQ X (SETQ LEFT (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - \TEDIT.OP.WIDTH))) - (IGEQ Y (IPLUS (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ) - \TEDIT.OP.BOTTOM))) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'WINDOW) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH)) - ([IGEQ X (SETQ LEFT - (OR [AND LINE (COND - ((fetch (FMTSPEC FMTHARDCOPY) - of (fetch (LINEDESCRIPTOR LFMTSPEC) - of LINE)) - (FIXR (FQUOTIENT (fetch (LINEDESCRIPTOR - LEFTMARGIN) - of LINE) - 35.27778))) - (T (fetch (LINEDESCRIPTOR LEFTMARGIN) - of LINE] - (IPLUS (fetch (TEXTOBJ WLEFT) of TEXTOBJ) - 8] - (CURSOR T) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT) - (replace LEFT of CURSORREG with LEFT) - (replace WIDTH of CURSORREG with (IDIFFERENCE (fetch (TEXTOBJ WRIGHT) - of TEXTOBJ) - LEFT))) - (T (CURSOR TEDIT.LINECURSOR) - (replace LEFT of CURSORREG with 0) - (replace WIDTH of CURSORREG with LEFT)))) - NIL]) - -(TEDIT.CURSOROUTFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:32 by jds") - (* Cursor leaves edit window; - make sure we think we're in the text - region.) - (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] - (CURSOR T) - (replace (TEXTOBJ MOUSEREGION) of TEXTOBJ with 'TEXT]) - -(TEDIT.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:32 by jds") - - (* ;; "Set up the window and TEXTOBJ so they correspond, and the window is a TEDIT window.") - - (* ;; "Do the minimal, everyone-wants-it style of setup. Leave more specialized setup for other functions.") - - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - TEDITPROMPTWINDOW DS PROP TWIDTH THEIGHT) - (OR WINDOW (\ILLEGAL.ARG WINDOW)) - (WINDOWPROP WINDOW 'BUTTONEVENTFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (* ; - "Set the window up with the right mouse interfaces for TEDIT.") - (WINDOWPROP WINDOW 'RIGHTBUTTONFN (FUNCTION \TEDIT.BUTTONEVENTFN)) - (WINDOWPROP WINDOW 'HARDCOPYFN (FUNCTION TEDIT.HARDCOPYFN)) - (* ; - "Hook into the system standard hardcopy interface") - (SETQ PROP (LISTGET PROPS 'MENU)) (* ; + (CL:WHEN (EQ PANE AFTERPANE) + (HELP "PANE=AFTERPANE")) + (\DTEST PANE 'WINDOW) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + (MENUPROP (LISTGET PROPS 'MENU)) + SEL PLINE) (* ;  "The Command menu, or list of items for it") - (COND - ((type? MENU PROP) (* ; "It's a menu. just use it.") - (WINDOWPROP WINDOW 'TEDIT.MENU PROP)) - (PROP (* ; - "It's a list of menu items. Force a new menu on next middle button.") - (WINDOWPROP WINDOW 'TEDIT.MENU.COMMANDS PROP) - (WINDOWPROP WINDOW 'TEDIT.MENU NIL))) - (TEDIT.MINIMAL.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW]) + (COND + ((type? MENU MENUPROP) (* ; "A menu. just use it.") + (WINDOWPROP PANE 'TEDIT.MENU MENUPROP)) + (MENUPROP (* ; + "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))) -(TEDIT.MINIMAL.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 30-May-91 23:33 by jds") + (* ;; "") - (* ;; "Do the absolute minimum setup so that TEXTOBJ and WINDOW know about each other. Does NOT include mouse interface or scrolling.") + (\TEDIT.CLEARPANE PANE) + (SETQ PLINE (\TEDIT.CREATEPLINE TEXTOBJ PANE FIRSTLINE)) + (\TEDIT.ADD.CARET TEXTOBJ PANE AFTERPANE) + (SETQ SEL (TEXTSEL TEXTOBJ)) + (\SHOWSEL SEL NIL (AND AFTERPANE PANE)) + (\FIXSEL SEL TEXTOBJ NIL (AND AFTERPANE PANE)) + (FSETSEL SEL HASCARET (NOT (FGETTOBJ TEXTOBJ TXTREADONLY))) + (\SHOWSEL SEL T (AND AFTERPANE PANE]) - (* ;; "If AFTERWINDOW is non-NIL, the new window will be placed after AFTERWINDOW in the TEXTOBJ's list. This lists us maintain an ordering of windows, for splitting and unsplitting.") +(\TEDIT.MINIMAL.WINDOW.SETUP + [LAMBDA (WINDOW TSTREAM PROPS AFTERPANE) (* ; "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") - (PROG ((SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - TEDITPROMPTWINDOW DS PROP TWIDTH THEIGHT LINES OLDWINDOWS) - (OR WINDOW (\ILLEGAL.ARG WINDOW)) - (replace (TEDITCARET TCCARETDS) of (COND - [(LISTP (fetch (TEXTOBJ CARET) of TEXTOBJ)) - (CAR (FLAST (fetch (TEXTOBJ CARET) of TEXTOBJ] - (T (fetch (TEXTOBJ CARET) of TEXTOBJ))) - with (WINDOWPROP WINDOW 'DSP)) (* ; + (* ;; "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") + + (* ;; "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) + (LET ((TEXTOBJ (TEXTOBJ TSTREAM)) + DS PROP OLDPANES) (* ;  "The displaystream for flashing the caret") - (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with WINDOW) - (WINDOWPROP WINDOW 'PROCESS NIL) (* ; - "For the moment, this window has no process") - (WINDOWPROP WINDOW 'TEDIT.PROPS PROPS) (* ; - "Put the props on the window for others ... **this should go**") - (WINDOWPROP WINDOW 'TEXTSTREAM TEXTSTREAM) (* ; - "Save the text stream for the user to get at via the window.") - (WINDOWPROP WINDOW 'TEXTOBJ TEXTOBJ) (* ; - "Give a handle on the TEXTOBJ for the text being edited.") - (WINDOWPROP WINDOW 'TEDIT.CURSORREGION (LIST 0 0 0 0)) + (FSETTOBJ TEXTOBJ PANES (CONS (create PANE + XPWINDOW _ WINDOW))) + (* ; "NOT IMPLEMENTED YET") + (FSETTOBJ TEXTOBJ SELPANE WINDOW) + (WINDOWPROP WINDOW 'PROCESS NIL) (* ; + "For the moment, this pane has no process") + (replace (TEXTWINDOW WTEXTSTREAM) of WINDOW with TSTREAM) + (* ; "TSTREAM is accessible from WINDOW") + (replace (TEXTWINDOW WTEXTOBJ) of WINDOW with TEXTOBJ) + (* ; "TEXTOBJ is accessible from WINDOW") + (replace (TEXTWINDOW CURSORREGION) of WINDOW with (CREATEREGION 0 0 0 0)) (* ; "Used by CursorMovedFn") - (WINDOWPROP WINDOW 'CURSORMOVEDFN (FUNCTION TEDIT.CURSORMOVEDFN)) - (WINDOWPROP WINDOW 'CURSOROUTFN (FUNCTION TEDIT.CURSOROUTFN)) - (SETQ DS (WINDOWPROP WINDOW 'DSP)) - (DSPRIGHTMARGIN 32767 DS) (* ; + (SETQ DS (WINDOWPROP WINDOW 'DSP)) + (DSPRIGHTMARGIN 32767 DS) (* ;  "So we don't get spurious RETURNs printed out by the system") - (SETQ OLDWINDOWS (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - [replace (TEXTOBJ \WINDOW) of TEXTOBJ - with (COND - [(LISTP OLDWINDOWS) (* ; - "There are windows already. Add this to the list.") - (COND - (AFTERWINDOW (* ; - "We know which window to put it after. Put it there") - [RPLACD (FMEMB AFTERWINDOW OLDWINDOWS) - (CONS WINDOW (CDR (FMEMB AFTERWINDOW OLDWINDOWS] - OLDWINDOWS) - (T (* ; - "Otherwise, just add it at the end of the list") - (NCONC1 OLDWINDOWS WINDOW] - (WINDOW (LIST WINDOW] - (replace (TEXTOBJ DISPLAYCACHE) of TEXTOBJ with (CAR (\TEDIT.CREATE.LINECACHE 1))) + (FSETTOBJ TEXTOBJ DISPLAYCACHE (CAR (\TEDIT.CREATE.LINECACHE 1))) (* ; - "and a CACHE for creating line images for display") - [replace (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ with (DSPCREATE (fetch LCBITMAP - of (fetch (TEXTOBJ - DISPLAYCACHE - ) - of TEXTOBJ] + "A CACHE for creating line images for display") + [FSETTOBJ TEXTOBJ DISPLAYCACHEDS (DSPCREATE (fetch LCBITMAP of (GETTOBJ TEXTOBJ DISPLAYCACHE + ] (* ; - "A displaystream for changeing the image caches") - (DSPOPERATION 'PAINT (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ)) - (DSPCLIPPINGREGION (create REGION - LEFT _ 0 - BOTTOM _ 0 - WIDTH _ 100 - HEIGHT _ 15) - (fetch (TEXTOBJ DISPLAYCACHEDS) of TEXTOBJ))(* ; "Remember its size, too.") - [COND - ((SETQ PROP (LISTGET PROPS 'REGION)) (* ; - "The caller wants to set a region. Use his") - (replace (TEXTOBJ WTOP) of TEXTOBJ with (fetch PTOP of PROP)) - (replace (TEXTOBJ WRIGHT) of TEXTOBJ with (fetch RIGHT of PROP)) - (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with (fetch BOTTOM of PROP)) - (replace (TEXTOBJ WLEFT) of TEXTOBJ with (fetch LEFT of PROP))) - (T (* ; + "A displaystream for changing the image caches") + (DSPOPERATION 'PAINT (FGETTOBJ TEXTOBJ DISPLAYCACHEDS)) + (DSPCLIPPINGREGION (create REGION + LEFT _ 0 + 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") - (replace (TEXTOBJ WLEFT) of TEXTOBJ with 0) - (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with 0) - (replace (TEXTOBJ WTOP) of TEXTOBJ with (fetch HEIGHT of (DSPCLIPPINGREGION NIL DS))) - (replace (TEXTOBJ WRIGHT) of TEXTOBJ with (fetch WIDTH of (DSPCLIPPINGREGION NIL DS] - (SETQ LINES (\SHOWTEXT TEXTOBJ NIL WINDOW)) - (WINDOWPROP WINDOW 'LINES LINES) (* ; - "Display the text in the window, for later use.") - [replace (TEXTOBJ LINES) of TEXTOBJ with (COND - [AFTERWINDOW (for LINE - in (fetch (TEXTOBJ LINES) - of TEXTOBJ) as WINDOW - in OLDWINDOWS - join (COND - ((EQ WINDOW AFTERWINDOW - ) - (LIST LINE LINES)) - (T (LIST LINE] - ((LISTP (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (NCONC1 (fetch (TEXTOBJ LINES) of TEXTOBJ) - LINES)) - (LINES (LIST LINES] - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ SEL) - (\SHOWSEL SEL NIL T) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW) - (\COPYSEL SEL TEDIT.SELECTION]) + (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]) + +(\TEDIT.ADD.CARET + [LAMBDA (TEXTOBJ PANE AFTERPANE) (* ; "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. ") + + (* ;; "The OR handles the case where the CARET list has not yet been set up for the first pane.") + + (CL:UNLESS (AND AFTERPANE (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))) + [change (FGETTOBJ TEXTOBJ CARET) + (NCONC1 DATUM (create TEDITCARET + TCFORCEUP _ T + TCCARETDS _ (WINDOWPROP PANE 'DSP])]) + +(\TEDIT.CLEARPANE + [LAMBDA (PANE PBOTTOM) (* ; "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]) +) +(DEFINEQ + +(\TEDIT.CURSORMOVEDFN + [LAMBDA (PANE) (* ; "Edited 26-Jan-2024 12:48 by rmk") + (* ; "Edited 1-Oct-2022 16:07 by rmk") + + (* ;; "Watch the mouse and change the cursor to reflect the region of the pane it's in (line select, pane split eventually?)") + + (PROG ((X (LASTMOUSEX PANE)) + (Y (LASTMOUSEY PANE)) + (TEXTOBJ (\DTEST (fetch (TEXTWINDOW WTEXTOBJ) of PANE) + 'TEXTOBJ)) + (CURSORREG (fetch (TEXTWINDOW CURSORREGION) of PANE)) + LINE LEFT) + (CL:UNLESS (INSIDE? (DSPCLIPPINGREGION NIL 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) + \TEDIT.OP.BOTTOM)) + (NOT (FGETTOBJ TEXTOBJ TXTNOTSPLITTABLE))) + then + (* ;; "We're in the split region on the right") + + (CURSOR \TEDIT.SPLITCURSOR) + (FSETTOBJ TEXTOBJ MOUSEREGION 'PANE) (* ; + "PANE just signals \TEDIT.BUTTONEVENTFN to do a split operation.") + (replace LEFT of CURSORREG with LEFT) + (replace WIDTH of CURSORREG with \TEDIT.OP.WIDTH) + else + (* ;; "Not in the split region. Are we in the line-select region on the left?") + + (SETQ LINE (find L inlines (fetch (TEXTWINDOW PLINES) of PANE) + suchthat (ILEQ (FGETLD L YBOT) + Y))) + (CL:WHEN LINE (* ; + "The CURSORREGION picks out just LINE") + (replace BOTTOM of CURSORREG with (FGETLD LINE YBOT)) + (replace HEIGHT of CURSORREG with (FGETLD LINE LHEIGHT))) + + (* ;; "The line region gets wider if the paragraph is indented") + + (SETQ LEFT (OR (AND LINE (FGETLD LINE LEFTMARGIN)) + (IPLUS (FGETTOBJ TEXTOBJ WLEFT) + \TEDIT.LINEREGION.WIDTH))) + (if (ILESSP X LEFT) + then + (* ;; "In left margin; switch to the line-select cursor") + + (CURSOR \TEDIT.LINECURSOR) + (FSETTOBJ TEXTOBJ MOUSEREGION 'LINE) + (replace LEFT of CURSORREG with 0) + (replace 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])]) + +(\TEDIT.CURSOROUTFN + [LAMBDA (PANE) (* ; "Edited 20-Jul-2023 20:32 by rmk") + (* ; "Edited 30-May-91 23:32 by jds") + + (* ;; "Cursor leaves edit pane; make sure we think we're in the text region.") + + (CURSOR T) + (SETTOBJ (fetch (TEXTWINDOW PTEXTOBJ) of PANE) + MOUSEREGION + 'TEXT]) (\TEDIT.ACTIVE.WINDOWP - [LAMBDA (W) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (W) (* ; "Edited 11-Sep-2023 00:22 by rmk") + (* ; "Edited 30-May-91 23:33 by jds") - (* Decides whether a TEdit window is really in use. - The function TEDIT will set the TEXTOBJ prop of the window to T pro tem, to - reserve a window. Once the TEdit has really started, the TEXTOBJ property will be - a real textobj.) + (* ;; "RMK: Not sure that TEXTOBJ is ever T. Or that windows ever have a TEXTSTREAM property (vs TEXTOBJ).") - (PROG [(TEXTOBJ (OR (WINDOWPROP W 'TEXTOBJ) - (AND (WINDOWPROP W 'TEXTSTREAM) - (TEXTOBJ (WINDOWPROP W 'TEXTSTREAM] - (RETURN (COND - ((EQ TEXTOBJ T) (* Can have a TEXTOBJ of T as a - placeholder during creation...) - T) - (TEXTOBJ (AND (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - (PROCESSP (WINDOWPROP W 'PROCESS]) + (* ;; "Decides whether a TEdit window is really in use. The function TEDIT will set the TEXTOBJ prop of the window to T pro tem, to reserve a window. Once the TEdit has really started, the TEXTOBJ property will be a real textobj.") -(\TEDIT.BUTTONEVENTFN - [LAMBDA (W STREAM) (* ; "Edited 19-Sep-2021 22:58 by rmk:") - - (* ;; "Handle button events for a TEdit window. If no button is down, we got control on button-up transition, so ignore it.") - - (TOTOPW W) - - (* ;; "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.") - - (CL:WHEN (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (NOT TEDIT.SELPENDING)) - - (* ;; "(RMK: old comment): Bail out if the mouse isn't down or there is a pending selection--don't want another selection to interfere.") - - (AND STREAM (SETQ STREAM (TEXTOBJ STREAM))) - [LET* ((OSEL NIL) - (SEL NIL) - [TEXTOBJ (OR STREAM (WINDOWPROP W 'TEXTOBJ] - (DS (WINDOWPROP W 'DSP)) - USERFN - (GLOBALSEL TEDIT.SELECTION) - (X (LASTMOUSEX W)) - (Y (LASTMOUSEY W)) - (CLIPREGION (DSPCLIPPINGREGION NIL W)) - (SELOPERATION 'NORMAL) - (SELFN (TEXTPROP TEXTOBJ 'SELFN)) - (EXTENDFLG NIL) - (OLDX -32000) - (OLDY -32000) - SELFINALFN PROC NOSEL) - (replace (SELECTION CH#) of TEDIT.SCRATCHSELECTION with 0) - (* ; - "Mark the user-visible scratch selection fresh, so changes can be detected...") - (COND - [[OR (NOT TEXTOBJ) - (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) - (AND (NOT (WINDOWPROP W 'PROCESS)) - (NOT (TEXTPROP TEXTOBJ 'READONLY)) - (NOT (SHIFTDOWNP 'SHIFT)) - (NOT (SHIFTDOWNP 'CTRL)) - (NOT (SHIFTDOWNP 'META)) - (NOT (KEYDOWNP 'MOVE)) - (NOT (KEYDOWNP 'COPY] (* ; "There's no edit session behind this window. You can only do window ops, or re-establish a session.") - (COND - ((\TEDIT.MOUSESTATE RIGHT) (* ; - "Right button gets the window command menu") - (DOWINDOWCOM W)) - ((AND TEXTOBJ (NOT (TEXTPROP TEXTOBJ 'READONLY)) - (NOT (TEXTPROP TEXTOBJ 'SELECTONLY)) - [NOT (PROCESSP (WINDOWPROP W 'PROCESS] - (\TEDIT.MOUSESTATE MIDDLE)) (* ; - "Middle button on a dead window gives a menu for re-starting TEDIT") - (COND - ((EQ (MENU TEDIT.RESTART.MENU) - 'NewEditProcess) - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with NIL) - (TEDIT (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - W] - [(IGREATERP Y (fetch TOP of CLIPREGION)) (* ; - "It's not inside the window's REAL region, so call on a menu.") - - (* ;; "RMK: This comment was originally just after the DON'T below, which generated a value-of-comment used message.") - - (* ;; "HAD BEEN: (COND ((AND (SETQ PROC (WINDOWPROP W 'PROCESS)) (PROCESSP PROC)) ; This window has a live process behind it; go evaluate the button fn there. (PROCESS.APPLY PROC USERFN (LIST W))) (T ; Otherwise, create a new process to handle the menu. (ADD.PROCESS (LIST USERFN (KWOTE W)))))") - - (COND - ((\TEDIT.MOUSESTATE RIGHT) - (DOWINDOWCOM W)) - ((MOUSESTATE (OR LEFT MIDDLE)) - (AND TEXTOBJ (SETQ USERFN (WINDOWPROP W 'TEDIT.TITLEMENUFN)) - (NEQ USERFN 'DON'T) - (ADD.PROCESS (LIST USERFN (KWOTE W] - ((AND TEXTOBJ (EQ (fetch (TEXTOBJ MOUSEREGION) of TEXTOBJ) - 'WINDOW)) (* ; - "We're in the window-ops region of the window. Do a window split or something") - (\TEDIT.WINDOW.OPS TEXTOBJ W)) - ((AND TEXTOBJ (NOT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ))) - (* ; - "Usual case -- he's really selecting something. And there's nothing else going on now.") - (\CARET.DOWN) (* ; - "Make sure the caret isn't being displayed.") - (RESETLST - (RESETSAVE TEDIT.SELPENDING TEXTOBJ) - - (* ;; "Tell all TEdits not to run, since there is a selection in progress. This is reset to NIL on return from here, to re-enable TEdit runs.") - - (RESETSAVE (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (replace TCCARET of CARET with (\CARET.CREATE BXHICARET))) - (LIST '\TEDIT.CARET (fetch (TEXTOBJ CARET) of TEXTOBJ))) - (* ; - "Then make the caret be the special, tall one so he can see it.") - (COND - ((KEYDOWNP 'COPY) (* ; - "In a read-only document, you can only copy.") - (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) - (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - (SETQ SELOPERATION 'COPY)) - ((AND (KEYDOWNP 'MOVE) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) - (* ; - "The MOVE key is down, so set MOVE mode.") - (SETQ GLOBALSEL TEDIT.MOVESELECTION) - (SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) - (SETQ SELOPERATION 'MOVE)) - [(SHIFTDOWNP 'SHIFT) (* ; - "the SHIFT key is down; mark this selection for COPY or MOVE.") - (COND - ((AND (SHIFTDOWNP 'CTRL) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) - (* ; "CTRL-SHIFT select means MOVE.") - (SETQ GLOBALSEL TEDIT.MOVESELECTION) - (SETQ OSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) - (SETQ SELOPERATION 'MOVE)) - (T (SETQ GLOBALSEL TEDIT.SHIFTEDSELECTION) - (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - (SETQ SELOPERATION 'COPY] - ((SHIFTDOWNP 'META) (* ; - "He's holding the meta key down , do a copylooks selection") - (SETQ GLOBALSEL TEDIT.COPYLOOKSSELECTION) - (SETQ OSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - (SETQ SELOPERATION 'COPYLOOKS)) - ((AND (SHIFTDOWNP 'CTRL) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ))) - (* ; - "He's holding the control key down; note the fact.") - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) - (SETQ GLOBALSEL TEDIT.DELETESELECTION) - [COND - ((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - (* ; - "There's a pending delete selection. Use it, and turn off the existing normal selection.") - ) - (T (* ; - "No existing delete selection. Use the normal selection as a starting point.") - (\COPYSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ] - (replace (SELECTION SET) of (fetch (TEXTOBJ SEL) of TEXTOBJ) with NIL) - - (* ;; "Remember to turn off the normal selection, since we'll be moving it to a new spot after the deletion.") - - (SETQ OSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - (SETQ SELOPERATION 'DELETE) - (TEDIT.SET.SEL.LOOKS OSEL 'DELETE) - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL)) - (T (SETQ OSEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with NIL) - (* ; "Reset the pending-delete flag.") - )) - (\COPYSEL OSEL GLOBALSEL) - (bind (OSELOP _ SELOPERATION) - 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") - [COND - ((ZEROP (LOGAND LASTMOUSEBUTTONS 7)) - (* ; - "No mouse buttons are down; don't try anything.") - (SETQ OLDX -32000) (* ; - "However, remember that pushing a mouse button is a change of status that we should notice.") - ) - ((KEYDOWNP 'MOVE) (* ; - "the MOVE key is down; mark this selection for MOVE.") - (SETQ SELOPERATION 'MOVE)) - [(OR (SHIFTDOWNP 'SHIFT) - (KEYDOWNP 'COPY)) (* ; - "the SHIFT key is down; mark this selection for COPY or MOVE.") - (COND - ((SHIFTDOWNP 'CTRL) (* ; - "He's holding down both ctrl and shift -- do a move.") - (SETQ SELOPERATION 'MOVE)) - (T (* ; "Just the SHIFT key. It's a COPY") - (SETQ SELOPERATION 'COPY] - ((SHIFTDOWNP 'META) (* ; - "He's holding the meta key down; note the fact.") - (SETQ SELOPERATION 'COPYLOOKS)) - ((SHIFTDOWNP 'CTRL) (* ; - "He's holding only the CTRL key -- mark the selection for deletion.") - (SETQ SELOPERATION 'DELETE)) - (T (* ; - "No key being held down; revert to normal selection.") - (SETQ SELOPERATION 'NORMAL] - (COND - [(AND (OR [NOT (IEQP OLDX (SETQ X (LASTMOUSEX DS] - [NOT (IEQP OLDY (SETQ Y (LASTMOUSEY DS] - (NEQ OSELOP SELOPERATION)) - (INSIDEP CLIPREGION X Y)) - - (* ;; "Only do selection if (1) the mouse is inside the window proper and (2) 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) - [COND - ((\TEDIT.MOUSESTATE LEFT) (* ; - "Left button is character selection") - (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ MOUSEREGION) - of TEXTOBJ) - NIL SELOPERATION W)) - (SETQ EXTENDFLG NIL)) - ((\TEDIT.MOUSESTATE MIDDLE) - (* ; "Middle button is word selection") - (SETQ SEL (TEDIT.SELECT X Y TEXTOBJ (fetch (TEXTOBJ MOUSEREGION) - of TEXTOBJ) - T SELOPERATION W)) - (SETQ EXTENDFLG NIL)) - [(\TEDIT.MOUSESTATE RIGHT)(* ; "RIght button extends selections") - (COND - ((NEQ 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.") - - (\COPYSEL OSEL GLOBALSEL))) - (COND - ((fetch (SELECTION SET) of GLOBALSEL) - (AND TEDIT.EXTEND.PENDING.DELETE (EQ SELOPERATION - 'NORMAL) - (SETQ SELOPERATION 'PENDINGDEL) - (replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ - with T)) (* ; - "If TeditBluePendingDelete flag is set, then simulate Laurel's blue-pending-delete feature.") - (SETQ SEL (TEDIT.EXTEND.SEL X Y GLOBALSEL TEXTOBJ - SELOPERATION W)) - (SETQ EXTENDFLG T] - (T (* ; - "The mouse buttons are up, leaving us with a pro-tem 'permanent' selection") - (\COPYSEL OSEL GLOBALSEL) - (* ; - "And SEL is NOT SET ANY LONGER, so it won't get copied into OSEL down below") - (AND SEL (replace (SELECTION SET) of SEL with NIL] - [COND - ((AND SEL (fetch (SELECTION SET) of SEL) - SELFN) (* ; - "The selection was set, but there's a SELFN that has veto authority") - (COND - ((EQ (APPLY* SELFN TEXTOBJ SEL SELOPERATION 'TENTATIVE) - 'DON'T) (* ; - "The selfn vetoed this selection, so mark it un-set.") - (replace (SELECTION SET) of SEL with NIL] - (COND - ((\TEDIT.SEL.CHANGED? SEL OSEL OSELOP SELOPERATION) - (* ; - "Something interesting about the selection changed. We have to re-display its image.") - (COND - ((OR (EQ SELOPERATION 'NORMAL) - (EQ SELOPERATION 'PENDINGDEL)) - (* ; - "For a normal selection, set the 'window last selected in' for the TEXTOBJ") - (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with W))) - (SETQ OSEL (\TEDIT.REFRESH.SHOWSEL TEXTOBJ SEL OSEL OSELOP - SELOPERATION EXTENDFLG)) - (SETQ OSELOP SELOPERATION)) - ([AND OSEL (fetch (SELECTION SET) of OSEL) - (EQ (fetch (SELECTION SELKIND) of OSEL) - 'VOLATILE) - (OR (NOT SEL) - (NOT (fetch (SELECTION SET) of SEL] - - (* ;; "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.") - - (\SHOWSEL OSEL NIL NIL) - (replace (SELECTION SET) of OSEL with NIL] - ((IN/SCROLL/BAR? W LASTMOUSEX LASTMOUSEY) - (* ; - "If he moves to the scroll bar, let him scroll without trouble") - (SCROLL.HANDLER W))) - (BLOCK) (* ; "Give other processes a chance") - (GETMOUSESTATE) (* ; "And get the new mouse info") - (TEDIT.CURSORMOVEDFN W)) - (\COPYSEL OSEL GLOBALSEL) - (COND - ((fetch (SELECTION SET) of OSEL) (* ; - "Only if a selection REALLY got made should we do this....") - (SELECTQ SELOPERATION - (COPY (* ; - "A COPY selection -- set the copy flag, and see if this is a copy to a non-TEdit window") - (SETQ TEDIT.COPY.PENDING T) - (replace (SELECTION SET) of OSEL with NIL) - (* ; - "And turn off OSEL, to avoid spurious highlighting") - (\TEDIT.FOREIGN.COPY? GLOBALSEL) - (* ; - "Maybe copy into the SYSBUF, if the recipient isn't a TEdit window.") - ) - (COPYLOOKS (* ; "A COPYLOOKS selection") - (SETQ TEDIT.COPYLOOKS.PENDING T) - (* ; - "And turn off OSEL, to avoid spurious highlighting") - (replace (SELECTION SET) of OSEL with NIL)) - (MOVE (* ; - "A MOVE selection -- set the flag to signal the TEdit command loop,") - (SETQ TEDIT.MOVE.PENDING T) - (* ; - "And turn off OSEL, to avoid spurious highlighting") - (replace (SELECTION SET) of OSEL with NIL)) - (DELETE (SETQ TEDIT.DEL.PENDING T) - (replace (SELECTION SET) of OSEL with NIL) - (* ; - "And turn off OSEL, to avoid spurious highlighting") - ) - (NORMAL (* ; - "This is a normal selection; set the caret looks") - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ OSEL))) - NIL))) - (AND SELFN (APPLY* SELFN TEXTOBJ GLOBALSEL SELOPERATION 'FINAL)) - (* ; - "Give a user exit routine control, perhaps for logging of selections.") - (for CARET inside (fetch (TEXTOBJ CARET) of TEXTOBJ) - do (OR (fetch TCUP of CARET) - (\EDIT.FLIPCARET CARET T)))) - (AND OSEL (fetch (SELECTION SET) of OSEL) - (fetch (SELECTION SELOBJ) of OSEL) - (SETQ SELFINALFN (IMAGEOBJPROP (fetch (SELECTION SELOBJ) of OSEL) - 'WHENOPERATEDONFN)) - (APPLY* SELFINALFN (fetch (SELECTION SELOBJ) of OSEL) - (WINDOWPROP W 'DSP) - 'SELECTED OSEL (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ])]) - -(\TEDIT.WINDOW.OPS - [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 12-Oct-2021 15:01 by rmk:") - -(* ;;; "Do window operations for TEdit, e.g., splitting a window, moving the split location, or unsplitting.") - - (PROG ([WINDOWOPREGION (create REGION - LEFT _ (DIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) - \TEDIT.OP.WIDTH) - BOTTOM _ \TEDIT.OP.BOTTOM - WIDTH _ \TEDIT.OP.WIDTH - HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP WINDOWTOSPLIT - 'REGION] - Y OPERATION) - [while [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) - (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) - (SETQ Y (LASTMOUSEY WINDOWTOSPLIT] do - - (* ;; - "Wait until he lets up on a button, and signal which button was last pushed.") - - (BLOCK) - (COND - ((MOUSESTATE MIDDLE) - (CURSOR \TEDIT.MAKESPLITCURSOR - ) - (SETQ OPERATION 'SPLIT)) - ((MOUSESTATE LEFT) - (CURSOR \TEDIT.MOVESPLITCURSOR - ) - (SETQ OPERATION 'MOVE)) - ((MOUSESTATE RIGHT) - (CURSOR \TEDIT.UNSPLITCURSOR) - (SETQ OPERATION 'UNSPLIT] - (COND - ((INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) - (SETQ Y (LASTMOUSEY WINDOWTOSPLIT))) - (CURSOR \TEDIT.SPLITCURSOR) - (SELECTQ OPERATION - (SPLIT (* ; "Splitting the window") - (\TEDIT.SPLITW WINDOWTOSPLIT Y)) - (UNSPLIT (* ; "Rejoining two panes") - (\TEDIT.UNSPLITW WINDOWTOSPLIT)) - (MOVE (* ; - "Moving the divider between two panes.") - (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T)) - (SHOULDNT))) - (T (CURSOR T]) + (LET [(TEXTOBJ (OR (WINDOWPROP W 'TEXTOBJ) + (AND (WINDOWPROP W 'TEXTSTREAM) + (TEXTOBJ (WINDOWPROP W 'TEXTSTREAM] + (COND + ((EQ TEXTOBJ T) (* ; + "Can have a TEXTOBJ of T as a placeholder during creation...") + T) + (TEXTOBJ (AND (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) + (PROCESSP (WINDOWPROP W 'PROCESS]) (\TEDIT.EXPANDFN [LAMBDA (W) (* jds " 7-May-85 15:56") @@ -846,66 +618,36 @@ (TTY.PROCESS (WINDOWPROP W 'PROCESS]) (\TEDIT.MAINW - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (TSTREAM) (* ; "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") - (* ;; "Get the MAIN edit window for this edit session (i.e., the one with the title, and all the props & stuff)") + (* ;; "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).") - (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - WINDOWS WINDOW) - (SETQ WINDOWS (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))) - (COND - (WINDOWS (* ; - "This question only makes sense if there ARE windows for this editor.") - (SETQ WINDOW (COND - ((LISTP WINDOWS) (* ; - "how do we know we can just take the first window as the main one?") - (CAR WINDOWS)) - (T WINDOWS))) - (COND - ((AND (fetch (TEXTOBJ MENUFLG) of TEXTOBJ) - (WINDOWPROP WINDOW 'MAINWINDOW)) + (* ;; "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).") - (* ;; "If this is a menu window, and it's attached to a main TEdit window, then look to the main TEdit window.") + (LET ((PANES (FGETTOBJ (TEXTOBJ TSTREAM) + \WINDOW))) + (for PANE M inside PANES do (SETQ M (WINDOWPROP PANE 'MAINWINDOW)) + (if M + then - (WINDOWPROP WINDOW 'MAINWINDOW)) - (T WINDOW]) + (* ;; "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 (TEXTSTREAM) (* ; "Edited 30-May-91 23:33 by jds") + [LAMBDA (TSTREAM) (* ; "Edited 19-Sep-2023 08:21 by rmk") + (* ; "Edited 30-May-91 23:33 by jds") - (* Given an edit session with possibly several PANES on the same document, give - me the PRINCIPAL one of them--i.e., the original edit window that has all the - back pointers, props &c on it.) + (* ;; "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).") - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - WINDOWS WINDOW) - (SETQ WINDOWS (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TEXTSTREAM))) - (* The edit window (s) associated with - this edit session) - (SETQ WINDOW (COND - ((LISTP WINDOWS) - - (* If there are several panes, the first one in the list is the original window) - - (CAR WINDOWS)) - (T (* If there's only the one window, - that's the guy.) - WINDOWS))) - (RETURN WINDOW]) - -(\TEDIT.COPYINSERTFN - [LAMBDA (INSERTIONS WW) (* ; "Edited 30-May-91 23:33 by jds") - - (* Given a string, an imageobj, or a list of any of them, insert it in the tedit - window WW.) - - (PROG [[TEXTSTREAM (TEXTSTREAM (WINDOWPROP WW 'MAINWINDOW] - (SEL (fetch (TEXTOBJ SEL) of (TEXTOBJ (WINDOWPROP WW 'MAINWINDOW] - (for INSERTION inside INSERTIONS do (COND - ((STRINGP INSERTION) - (TEDIT.INSERT TEXTSTREAM INSERTION SEL)) - ((IMAGEOBJP INSERTION) - (TEDIT.INSERT.OBJECT INSERTION TEXTSTREAM SEL]) + (CAR (MKLIST (GETTOBJ (TEXTOBJ TSTREAM) + \WINDOW]) (\TEDIT.NEWREGIONFN [LAMBDA (FIXEDPOINT MOVINGPOINT WINDOW) (* jds "24-FEB-83 17:43") @@ -946,91 +688,84 @@ (RETURN MOVINGPOINT]) (\TEDIT.SET.WINDOW.EXTENT - [LAMBDA (TEXTOBJ WINDOWS) (* ; "Edited 30-May-91 23:33 by jds") - (* Set the window's EXTENT property - according to 1st and last char on - screen.) - (for WINDOW inside WINDOWS - do (PROG* ((REGION (DSPCLIPPINGREGION NIL WINDOW)) - (WHEIGHT (fetch HEIGHT of REGION)) - (LINES (WINDOWPROP WINDOW 'LINES)) - (TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ)) - TOPCHAR BOTCHAR PREVLINE EXTHEIGHT EXTBOT YBOT) + [LAMBDA (TEXTOBJ PANE) (* ; "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") + (* ; "Edited 11-May-2023 00:35 by rmk") + (* ; "Edited 4-May-2023 21:52 by rmk") + (* ; "Edited 28-Apr-2023 11:23 by rmk") + (* ; "Edited 15-Feb-2023 23:41 by rmk") + (* ; "Edited 3-Nov-2022 23:23 by rmk") + (* ; "Edited 30-May-91 23:33 by jds") + + (* ;; "Set the window's EXTENT property according to 1st and last char on screen.") + + (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)) + + (* ;; "First visible line") + + (SETQ FIRSTLINE (find L inlines (fetch (TEXTWINDOW PLINES) of PANE) + suchthat (ILESSP (FGETLD L YBOT) + PHEIGHT))) + + (* ;; "Last visible line") + + (for L inlines FIRSTLINE while (IGEQ (FGETLD L YBOT) + PBOTTOM) do (SETQ LASTLINE L)) + + (* ;; "Start of first visible line") + + (SETQ TOPCHAR (CL:IF FIRSTLINE + (FGETLD FIRSTLINE LCHAR1) + TEXTLEN)) (COND - ((TEXTPROP TEXTOBJ 'NOEXTENT) (* If he doesn't want the extent set, - don't bother him.) - (RETURN))) - (OR WINDOW (RETURN)) (* Do nothing if there's no window to - do it in.) - (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - WHEIGHT)) do (* Run thru the lines looking for the - first one on the screen.) - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) - of LINES))) - (COND - (LINES + (LASTLINE - (* IF there are lines on the screen, then get the CH# of the start of the first - line -- notionally, the CH at the top of the screen.) + (* ;; "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 TOPCHAR (fetch (LINEDESCRIPTOR CHAR1) of LINES))) - (T (* Otherwise, everything is scrolled - off the top, so we're at the end.) - (SETQ TOPCHAR TEXTLEN))) - (while (AND LINES (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINES) - (fetch (TEXTOBJ WBOTTOM) of TEXTOBJ))) - do (* Then go looking for the last line - on the screen) - (SETQ PREVLINE LINES) - (SETQ LINES (fetch (LINEDESCRIPTOR NEXTLINE) of LINES))) - (COND - (PREVLINE - - (* 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 (fetch (LINEDESCRIPTOR CHARLIM) of PREVLINE))) - (SETQ YBOT (fetch (LINEDESCRIPTOR YBOT) of PREVLINE))) + (SETQ BOTCHAR (IMIN TEXTLEN (FGETLD LASTLINE LCHARLIM))) + (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.) + (* ;; "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.") (SETQ BOTCHAR TEXTLEN) - (SETQ YBOT WHEIGHT))) + (SETQ YBOT PHEIGHT))) [COND ((AND (IEQP BOTCHAR TEXTLEN) - (IEQP TOPCHAR TEXTLEN)) (* If we're really at the bottom of - the document) - (SETQ EXTBOT (SUB1 YBOT)) (* Set up the extent bottom and height - fields to account for that.) - (SETQ EXTHEIGHT WHEIGHT)) + (IEQP TOPCHAR TEXTLEN)) (* ; "At the bottom of the document") + (SETQ EXTBOT (SUB1 YBOT)) + (SETQ EXTHEIGHT PHEIGHT)) (T + (* ;; "Otherwise, set the bottom in proportion to what is left below the bottom of the screen, and the extent height in proportion to how much text appears in the window") - (* Otherwise, set the bottom in proportion to what is left below the bottom of - the screen, and the extent height in proportion to how much text appears in the - window) - - [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE WHEIGHT YBOT) + [SETQ EXTHEIGHT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT) TEXTLEN) (IMAX (IDIFFERENCE BOTCHAR TOPCHAR) 1] - (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE WHEIGHT + (SETQ EXTBOT (IDIFFERENCE YBOT (FIXR (FQUOTIENT (ITIMES (IDIFFERENCE PHEIGHT YBOT) (IDIFFERENCE TEXTLEN BOTCHAR)) (IMAX (IDIFFERENCE BOTCHAR TOPCHAR ) 1] - (WINDOWPROP WINDOW 'EXTENT (create REGION - BOTTOM _ EXTBOT - HEIGHT _ (IMAX 1 EXTHEIGHT) - WIDTH _ (fetch WIDTH of REGION) - LEFT _ 0]) + (WINDOWPROP PANE 'EXTENT (create REGION + BOTTOM _ EXTBOT + HEIGHT _ (IMAX 1 EXTHEIGHT) + WIDTH _ (fetch WIDTH of PREG) + LEFT _ 0)))))]) (\TEDIT.SHRINK.ICONCREATE - [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 25-Apr-88 23:53 by jds") + [LAMBDA (W ICON ICON-POSITION) (* ; "Edited 20-Dec-2023 23:44 by rmk") + (* ; "Edited 10-Apr-2023 09:44 by rmk") + (* ; "Edited 25-Apr-88 23:53 by jds") (* ;; "Create the icon that represents this window.") @@ -1041,7 +776,7 @@ ((NOT (WINDOWPROP W 'TEXTOBJ)) (* ;  "This isn't really a TEdit window any more. Don't do anything") NIL) - ((WINDOWPROP W 'TEDITMENU) (* ; + ((TEDITMENUP W) (* ;  "This is a text menu, and shrinks without trace.") NIL) ((OR (IGREATERP (FLENGTH SHRINKFN) @@ -1051,7 +786,7 @@ 2))) (* ;  "There are other functions that expect to handle this. Don't bother.") NIL) - ((OR [AND ICONTITLE (EQUAL ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM W] + ((OR [AND ICONTITLE (EQUAL ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W] (AND (NOT ICONTITLE) ICON)) @@ -1062,279 +797,688 @@ (ICON (* ;; "There's an existing icon window; change the title in it") - [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM - W] + [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM + W] (ICONTITLE ICONTITLE NIL NIL ICON)) (T (* ; "install a new icon") - [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (TEXTSTREAM.TITLE (TEXTSTREAM W] + [WINDOWPROP W 'TEDIT.ICON.TITLE (SETQ ICONTITLE (\TEXTSTREAM.TITLE (TEXTSTREAM W] (WINDOWPROP W 'ICON (TITLEDICONW TEDIT.TITLED.ICON.TEMPLATE ICONTITLE TEDIT.ICON.FONT ICON-POSITION T NIL 'FILE] (WINDOWPROP W 'ICON]) (\TEDIT.SHRINKFN - [LAMBDA (W ICON ICONW) (* jds "14-Dec-84 08:56") - (* hands off the tty to the exec - process) + [LAMBDA (W ICON ICONW) (* ; "Edited 24-Sep-2023 23:32 by rmk") + (* jds "14-Dec-84 08:56") + + (* ;; "Hands to othe EXEC process, or MOUSE if EXEC isn't found.") + + (CL:WHEN (AND (EQ (WINDOWPROP W 'PROCESS) + (TTY.PROCESS))) + (TTY.PROCESS T]) + +(\TEDIT.PANEREGION + [LAMBDA (PANE) (* ; "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.") + + (LET [(PREG (DSPCLIPPINGREGION NIL PANE)) + (WREG (WINDOWPROP PANE 'REGION] + (if (OR (ILESSP (fetch (REGION LEFT) of WREG) + 0) + (ILESSP (fetch (REGION BOTTOM) of WREG) + 0) + (IGREATERP (fetch (REGION PRIGHT) of WREG) + SCREENWIDTH) + (IGREATERP (fetch (REGION PTOP) of WREG) + SCREENHEIGHT)) + then [LET [[LDIFF (IMAX 0 (IDIFFERENCE 0 (fetch (REGION LEFT) of WREG] + [BDIFF (IMAX 0 (IDIFFERENCE 0 (fetch (REGION BOTTOM) of WREG] + (RDIFF (IMAX 0 (IDIFFERENCE (fetch (REGION RIGHT) of WREG) + SCREENWIDTH))) + (TDIFF (IMAX 0 (IDIFFERENCE (fetch (REGION HEIGHT) of WREG) + SCREENHEIGHT] + + (* ;; + "The diffs are positive or 0--how much is outside the screen and needs to be added/subtracted.") + + (CREATEREGION (IPLUS (fetch (REGION LEFT) of PREG) + LDIFF) + (IPLUS (fetch (REGION BOTTOM) of PREG) + BDIFF) + (IDIFFERENCE (fetch (REGION WIDTH) of PREG) + (IPLUS LDIFF RDIFF)) + (IDIFFERENCE (fetch (REGION HEIGHT) of PREG) + (IPLUS BDIFF TDIFF] + else PREG]) +) +(DEFINEQ + +(\TEDIT.BUTTONEVENTFN + [LAMBDA (PANE) (* ; "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.") + + (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)) + (\DTEST TEXTOBJ 'TEXTOBJ) + + (* ;; "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) + (\TEDIT.PANE.SPLIT TEXTOBJ PANE)) + (RETURN)) + + (* ;; "") + + (* ;; "The usual case -- he's really selecting something in this pane. And there's nothing else going on now.") + + (\CARET.DOWN) (* ; + "Make sure the caret isn't being displayed.") + (* ; + "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)) + + (* ;; "") + + (* ;; "Polling loop, track the mouse until the buttons/keys come up.") + + (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))) + (\TEDIT.SET.SEL.LOOKS OSEL SELOPERATION) + (SELECTQ SELOPERATION + ((NORMAL DELETE) + (\COPYSEL (FGETTOBJ TEXTOBJ SEL) + SOURCESEL) + (\SHOWSEL (FGETTOBJ TEXTOBJ SEL) + NIL) + (\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 (\COPYSEL OSEL SOURCESEL))) + (SETQ SOURCESEL (\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 (\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.") + + (\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.") + + (\SHOWSEL OSEL NIL) + (FSETSEL OSEL SET NIL))) + (CL:WHEN SOURCESEL (* ; "Maybe clicked in the boonies?") + (SETQ OSEL (\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) + X Y) (* ; + "Didn't end inside the window, abort cleanly") + (\SHOWSEL SOURCESEL NIL) + (\SHOWSEL (FGETTOBJ TEXTOBJ SEL) + NIL) + (\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)) + + (* ;; "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. ") + + (\SHOWSEL SOURCESEL NIL)) + + (* ;; "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) + DS + 'SELECTED SOURCESEL (FGETTOBJ TEXTOBJ STREAMHINT))) + (CL:WHEN SELFN (* ; "Maybe for logging of selections?") + (APPLY* SELFN TEXTOBJ SOURCESEL SELOPERATION 'FINAL))]))]) + +(\TEDIT.DO.SELOPERATION + [LAMBDA (SOURCESEL SELOPERATION TEXTOBJ PANE) (* ; "Edited 21-Feb-2024 20:08 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. ") + + (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) + + (* ;; "Order of variables matters: SELOPERATION must be last.") + + [PROCESS.EVAL TTYPROC `(PROGN (SETQQ SOURCESEL ,SOURCESEL) + (SETQQ SELPANE ,PANE) + (SETQQ SELOPERATION ,SELOPERATION])]) + +(\TEDIT.TTY.TEXTOBJP + [LAMBDA NIL (* ; "Edited 8-Feb-2024 16:52 by rmk") + + (* ;; + "Returns the TEXTOBJ of the TTY process, if it is a TEDIT command-loop process, otherwise NIL.") + + (LET* [(TTYPROC (TTY.PROCESS)) + (TTYW (PROCESSPROP TTYPROC 'WINDOW] + (CL:WHEN TTYW + (fetch (TEXTWINDOW PTEXTOBJ) of TTYW))]) + +(\TEDIT.BUTTONEVENTFN.SELOPERATION + [LAMBDA (TEXTOBJ) (* ; "Edited 27-Jan-2024 12:55 by rmk") (COND - ((AND (EQ (WINDOWPROP W 'PROCESS) - (TTY.PROCESS))) - (TTY.PROCESS T) + ((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]) - (* per bvm, this means "Hand the TTY to some other process" %. - It tries EXEC first; if that's not found, it hands it to MOUSE.) +(\TEDIT.BUTTONEVENTFN.INACTIVE + [LAMBDA (TEXTOBJ) (* ; "Edited 9-Feb-2024 00:00 by rmk") + (* ; "Edited 27-Jan-2024 11:40 by rmk") - ]) + (* ;; "TEXTOBJ is the textobj associated with some window and presumably therefore has (or had) an associated editing process. This returns T if the session is currently inactive or if this TEXTOBJ or TEXTOBJ cannot still be used as a source of information. If inactive, this also either executes the generic window operations (if RIGHT is down, whether or not in the title region) or perhaps reestablishes the process.") + + (* ;; "If EDITOPACTIVE, something else is going on that we don't want to interfere with") + + (if [AND (NOT (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)) + (NOT (FGETTOBJ TEXTOBJ EDITOPACTIVE)) + (OR (WINDOWPROP PANE 'PROCESS) + (GETTOBJ TEXTOBJ TXTREADONLY) + (SHIFTDOWNP 'SHIFT) + (SHIFTDOWNP 'CTRL) + (SHIFTDOWNP 'META) + (KEYDOWNP 'MOVE) + (KEYDOWNP 'COPY] + then NIL + elseif (\TEDIT.MOUSESTATE RIGHT) + then + (* ;; + "Right button anywhere in a dead window gets the window command menu. Window is still inactive") + + (DOWINDOWCOM PANE) + T + elseif (AND (\TEDIT.MOUSESTATE MIDDLE) + (NOT (GETTEXTPROP TEXTOBJ 'READONLY)) + (NOT (GETTEXTPROP TEXTOBJ 'SELECTONLY)) + [NOT (PROCESSP (WINDOWPROP PANE 'PROCESS] + (EQ (MENU TEDIT.RESTART.MENU) + 'NewEditProcess)) + then + (* ;; + "Middle button in a dead window gives a menu for re-starting TEDIT. Window is no longer inactive") + + (SETTOBJ TEXTOBJ EDITOPACTIVE NIL) + (TEDIT (GETTOBJ TEXTOBJ STREAMHINT) + PANE) + NIL]) + +(\TEDIT.BUTTONEVENTFN.INTITLE + [LAMBDA (Y PANE TEXTOBJ) (* ; "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))))] + T)]) + +(\TEDIT.COPYINSERT + [LAMBDA (TTYW SOURCESEL) (* ; "Edited 17-Feb-2024 12:52 by rmk") + + (* ;; "Inserts the information in SOURCESEL into the TTY window.") + + (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") + + (COPYINSERT (OBJECTFROMSEL SOURCESEL)) + else + (* ;; "Have to go character by character because COPYINSERT does (PRIN2 BKSYSBUF), which creates undesired string quotes.") + + (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)))]) +) + +(MOVD? 'NILL '\TEDIT.COPYINSERT) +(DEFINEQ + +(\TEDIT.PANE.SPLIT + [LAMBDA (TEXTOBJ WINDOWTOSPLIT) (* ; "Edited 27-Jan-2024 11:39 by rmk") + (* ; "Edited 1-Oct-2023 23:30 by rmk") + (* ; "Edited 12-Oct-2021 15:01 by rmk:") + + (* ;; "If in the split region, determine and execute the splitting operations for PANE.") + + (CL:WHEN (EQ (GETTOBJ TEXTOBJ MOUSEREGION) + 'PANE) (* ; "In the split/ops region") + [LET ([WINDOWOPREGION (create REGION + LEFT _ (DIFFERENCE (fetch (TEXTOBJ WRIGHT) of TEXTOBJ) + \TEDIT.OP.WIDTH) + BOTTOM _ \TEDIT.OP.BOTTOM + WIDTH _ \TEDIT.OP.WIDTH + HEIGHT _ (fetch (REGION HEIGHT) of (WINDOWPROP WINDOWTOSPLIT + 'REGION] + Y OPERATION) + [while [AND (MOUSESTATE (OR LEFT MIDDLE RIGHT)) + (INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) + (SETQ Y (LASTMOUSEY WINDOWTOSPLIT] do + + (* ;; + "Wait until he lets up on a button, and signal which button was last pushed.") + + (BLOCK) + (COND + ((MOUSESTATE MIDDLE) + (CURSOR + \TEDIT.MAKESPLITCURSOR + ) + (SETQ OPERATION + 'SPLIT)) + ((MOUSESTATE LEFT) + (CURSOR + \TEDIT.MOVESPLITCURSOR + ) + (SETQ OPERATION + 'MOVE)) + ((MOUSESTATE RIGHT) + (CURSOR + \TEDIT.UNSPLITCURSOR + ) + (SETQ OPERATION + 'UNSPLIT] + (COND + ((INSIDE? WINDOWOPREGION (LASTMOUSEX WINDOWTOSPLIT) + (SETQ Y (LASTMOUSEY WINDOWTOSPLIT))) + (CURSOR \TEDIT.SPLITCURSOR) + (SELECTQ OPERATION + (SPLIT (* ; "Splitting the window") + (\TEDIT.SPLITW WINDOWTOSPLIT Y)) + (UNSPLIT (* ; "Rejoining two panes") + (\TEDIT.UNSPLITW WINDOWTOSPLIT)) + (MOVE (* ; + "Moving the divider between two panes.") + (TEDIT.PROMPTPRINT TEXTOBJ "Split-point moving is not yet implemented" T)) + (SHOULDNT))) + (T (CURSOR T] + T)]) (\TEDIT.SPLITW - [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:38 by jds") + [LAMBDA (OLDPANE Y) (* ; "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 W AT W-RELATIVE Y into 2 %"panes%" that can scroll independently.") + (* ;; "Split window OLDPANE at window-relelative Y into 2 panes that can scroll independently.") - (PROG* ((WREG (WINDOWPROP WINDOW 'REGION)) - (TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ)) - (OLDWINDOWS (COPY (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (SUBWINDOW (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN)) - ATTACHEDWINDOWS NEWW OLDW OTITLE OLDCARET NEWCARET OLINES) - (SETQ Y (OR Y (LASTMOUSEY WINDOW))) (* ; "Get the Y-position where we're to make the split--it's either supplied or we use the mouse's Y position.") - (COND - (SUBWINDOW (* ; + (* ;; "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 (\DTEST (WINDOWPROP OLDPANE 'TEXTOBJ) + 'TEXTOBJ)) + (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 (* ;  "If there's already a pane below this one, detach it for the moment.") - (DETACHWINDOW SUBWINDOW))) - (SHAPEW WINDOW (create REGION using WREG BOTTOM _ (IPLUS (fetch BOTTOM of WREG) - Y) - HEIGHT _ (IDIFFERENCE (fetch HEIGHT of WREG) - Y))) + (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%".") + "Reshape the original window to form the upper pane. This fixes/displays the current selection.") - (* ;; "Attach the new window, without disturbing the pre-existing attached windows") + (* ;; "Attach the new window, without disturbing the pre-existing attached windows") - (SETQ ATTACHEDWINDOWS (WINDOWPROP WINDOW 'ATTACHEDWINDOWS NIL)) - (ATTACHWINDOW (SETQ NEWW (CREATEW (create REGION using WREG HEIGHT _ Y) - NIL NIL NIL)) - WINDOW - 'BOTTOM - 'JUSTIFY - 'MAIN) (* ; "and attach a lower %"pane%".") - [WINDOWPROP WINDOW 'ATTACHEDWINDOWS (APPEND ATTACHEDWINDOWS (WINDOWPROP WINDOW - 'ATTACHEDWINDOWS] + (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] - (* ;; "[end of attached-window hackery to prevent disturbance]") + (* ;; "[end of attached-window hackery to prevent disturbance while short]") - (WINDOWPROP NEWW 'TEDITCREATED T) - (DSPFONT (fetch (CHARLOOKS CLFONT) of (fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)) - NEWW) (* ; + (* ;; "") + + (WINDOWPROP NEWPANE 'TEDITCREATED T) + (DSPFONT (fetch (CHARLOOKS CLFONT) of (FGETTOBJ TEXTOBJ CARETLOOKS)) + NEWPANE) (* ;  "Set the font on the display stream to be the current one from CARETLOOKS") - (SETQ OLDW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (SETQ OTITLE (\TEDIT.WINDOW.TITLE TEXTOBJ)) - (SETQ OLDCARET (fetch (TEXTOBJ CARET) of TEXTOBJ)) - (SETQ NEWCARET (create TEDITCARET - TCCARETDS _ (WINDOWPROP NEWW 'DSP) - TCFORCEUP _ T)) - [replace (TEXTOBJ CARET) of TEXTOBJ with (COND - ((LISTP OLDCARET) - (NCONC1 OLDCARET NEWCARET)) - (T (LIST OLDCARET NEWCARET] - (for SEL in (LIST (fetch (TEXTOBJ SEL) of TEXTOBJ) - (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - do (replace (SELECTION L1) of SEL with (NCONC1 (fetch (SELECTION L1) of SEL) - NIL)) - (replace (SELECTION LN) of SEL with (NCONC1 (fetch (SELECTION LN) of SEL) - NIL))) - (SETQ OLINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) - (\TEDIT.WINDOW.SETUP NEWW TEXTOBJ (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ) - (APPEND '(NOTITLE T PROMPTWINDOW DON'T) - (fetch (TEXTOBJ EDITPROPS) of TEXTOBJ)) - WINDOW) - [for CARET in (fetch (TEXTOBJ CARET) of TEXTOBJ) as WINDOW - in (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) do (replace TCCARETDS of CARET - with (WINDOWPROP WINDOW 'DSP] - (replace (TEXTOBJ WINDOWTITLE) of TEXTOBJ with OTITLE) - (WINDOWPROP NEWW 'PROCESS (WINDOWPROP WINDOW 'PROCESS)) - (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN NEWW) (* ; - "Tell the main window about its new lower pane.") - (COND - (SUBWINDOW (* ; + + (* ;; "Not sure if same PROPS as for PANE (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) + + (* ;; "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 FIRSTLINE of NEWPANE starting at the character just after the last line of the now-shrunken OLDPANE.") + + [SETQ NEWFIRSTLINE (for L inlines (fetch (TEXTWINDOW PLINES) of OLDPANE) + unless (FGETLD L NEXTLINE) + do (RETURN (\FORMATLINE TEXTOBJ (ADD1 (FGETLD L LCHARLIM] + (\TEDIT.WINDOW.SETUP NEWPANE (FGETTOBJ TEXTOBJ STREAMHINT) + PROPS OLDPANE NEWFIRSTLINE) + (CL:WHEN NEWFIRSTLINE + (\FILLPANE (GETLD NEWFIRSTLINE PREVLINE) + TEXTOBJ NEWPANE)) + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (\FIXSEL SEL TEXTOBJ NIL NEWPANE) + (CL:WHEN (GETSEL SEL ONFLG) + (SETSEL SEL ONFLG NIL) (* ; + "Turn it off, so we can turn it on for NEWPANE") + (\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 (* ;  "There was already a pane below this one. Attach it to the new lower pane.") - (ATTACHWINDOW SUBWINDOW NEWW 'BOTTOM 'JUSTIFY 'MAIN) - (WINDOWPROP NEWW 'TEDIT-NEXT-PANE-DOWN SUBWINDOW) + (ATTACHWINDOW NEXTPANE NEWPANE 'BOTTOM 'JUSTIFY 'MAIN) (* ;  "Tell the lower pane about its lower, lower pane..") - ]) + (replace (TEXTWINDOW NEXTPANE) of NEWPANE with NEXTPANE))]) (\TEDIT.UNSPLITW - [LAMBDA (WINDOW Y) (* ; "Edited 30-May-91 23:34 by jds") - -(* ;;; "Re-attach two panes of a split editing window, to make a single larger pane.") - - (PROG* ([WREG (COPY (WINDOWPROP WINDOW 'REGION] - (TEXTOBJ (WINDOWPROP WINDOW 'TEXTOBJ)) - (WINDOWS (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - (MAINW (WINDOWPROP WINDOW 'MAINWINDOW)) - (SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (SCRATCHSEL (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ)) - (MOVESEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) - (SHIFTEDSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - (DELETESEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - (SUBWINDOW (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN)) - NEWW OLDW OTITLE ATTACHEDWINDOWS LINES CARETS) - (COND - ((NOT MAINW) - (TEDIT.PROMPTPRINT TEXTOBJ "Can't UNSPLIT the main window." T) - (RETURN))) - (\TEDIT.SHOWSELS TEXTOBJ NIL NIL) (* ; + [LAMBDA (PANE) (* ; "Edited 21-Feb-2024 08:31 by rmk") + (* ; "Edited 11-Feb-2024 11:14 by rmk") + (* ; "Edited 2-Jan-2024 21:11 by rmk") + (* ; "Edited 30-Sep-2023 14:17 by rmk") + (* ; "Edited 21-Sep-2023 09:02 by rmk") + (* ; "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 (\DTEST (WINDOWPROP PANE 'TEXTOBJ) + 'TEXTOBJ)) + (PANES (GETTOBJ TEXTOBJ \WINDOW)) + (PRIMARYPANE (\TEDIT.MAINW PANE)) + (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)) + (\SHOWSEL SEL NIL) (* ;  "Turn off selections during the unsplit.") - (DETACHWINDOW WINDOW) (* ; "Detach the pane") - (COND - (SUBWINDOW (* ; "The pane that's going away had a yet lower pane attached to it. Detach it from here, so we can reattach it to the unsplit part later.") - (DETACHWINDOW SUBWINDOW) - (WINDOWPROP WINDOW 'TEDIT-NEXT-PANE-DOWN NIL))) - (WINDOWPROP MAINW 'TEDIT-NEXT-PANE-DOWN NIL) - (for CARET in (SETQ CARETS (fetch (TEXTOBJ CARET) of TEXTOBJ)) as LINE - in (SETQ LINES (fetch (TEXTOBJ LINES) of TEXTOBJ)) as OLDW in WINDOWS - when (EQ WINDOW OLDW) do (* ; - "Remove the caret from our list, and the starting line") - (replace (TEXTOBJ CARET) of TEXTOBJ with (DREMOVE CARET CARETS - )) - (replace (TEXTOBJ LINES) of TEXTOBJ with (DREMOVE LINE LINES)) - ) (* ; "Close the pane") - (replace (TEXTOBJ SELWINDOW) of TEXTOBJ with MAINW) - (* ; - "Forget that we ever selected in the alternate window") - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with (SETQ WINDOWS (DREMOVE WINDOW WINDOWS))) - (* ; - "Have TEdit forget the window as well") - (replace (SELECTION L1) of SEL with (CDR (fetch (SELECTION L1) of SEL))) - (replace (SELECTION LN) of SEL with (CDR (fetch (SELECTION LN) of SEL))) - (replace (SELECTION L1) of SCRATCHSEL with (CDR (fetch (SELECTION L1) of SCRATCHSEL))) - (replace (SELECTION LN) of SCRATCHSEL with (CDR (fetch (SELECTION LN) of SCRATCHSEL))) - (for REMAININGWINDOW inside WINDOWS do (* ; - "Run thru the remaining panes for this edit, fixing things up in the selections") - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ REMAININGWINDOW)) - (TEDIT.DEACTIVATE.WINDOW WINDOW T T) (* ; - "Disable all the TEdit-related stuff on the window") - (CLOSEW WINDOW) + (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)) + (WINDOWPROP PANE 'CURSOROUTFN NIL) + (WINDOWPROP PANE 'CURSORMOVEDFN NIL) + (replace (TEXTWINDOW WTEXTOBJ) of PANE with NIL) (* ; "Disconnect") + (replace (TEXTWINDOW WTEXTSTREAM) of PANE with NIL) + (SETTOBJ TEXTOBJ \WINDOW (DREMOVE PANE PANES)) + (replace (TEXTWINDOW NEXTPANE) of PANE with NIL) + (\FIXSEL (TEXTSEL TEXTOBJ) + TEXTOBJ) + (replace (TEXTWINDOW NEXTPANE) of PRIORPANE with NEXTPANE) - (* ;; "Reshape the window, without affecting the placement of attached windows") + (* ;; "") - (SETQ ATTACHEDWINDOWS (WINDOWPROP MAINW 'ATTACHEDWINDOWS NIL)) - [SHAPEW MAINW (UNIONREGIONS WREG (WINDOWPROP MAINW 'REGION] - (WINDOWPROP MAINW 'ATTACHEDWINDOWS ATTACHEDWINDOWS) + (* ;; "Done with the deleted pane, assign its region to the pane above and redisplay. ") - (* ;; "[end of attached window hackery]") + (* ;; + "Now rearrange the pane window-attachment linkages. This gives PANE's region to its prior pane.") - (COND - (SUBWINDOW (* ; "The pane that's going away had a yet lower pane attached to it. Detach it from here, so we can reattach it to the unsplit part later.") - (ATTACHWINDOW SUBWINDOW MAINW 'BOTTOM 'JUSTIFY 'MAIN) - (WINDOWPROP MAINW 'TEDIT-NEXT-PANE-DOWN SUBWINDOW))) - (\TEDIT.SHOWSELS TEXTOBJ NIL T]) + (* ;; "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.") -(\TEDIT.WINDOW.SETUP - [LAMBDA (WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) (* ; "Edited 11-Jun-99 15:48 by rmk:") - (* ; "Edited 11-Jun-99 15:44 by rmk:") - (* ; "Edited 11-Jun-99 15:31 by rmk:") - (* ; "Edited 30-May-91 23:34 by jds") + (DETACHWINDOW PANE) + (SETQ ATTACHEDWINDOWS (WINDOWPROP PRIORPANE 'ATTACHEDWINDOWS NIL)) + [SHAPEW PRIORPANE (UNIONREGIONS (WINDOWPROP PANE 'REGION) + (WINDOWPROP PRIORPANE 'REGION] + (WINDOWPROP PRIORPANE 'ATTACHEDWINDOWS ATTACHEDWINDOWS) + (CL:WHEN NEXTPANE - (* ;; "Set up the window and TEXTOBJ so they correspond, and the window is a TEDIT window.") + (* ;; + "PANE had a yet lower pane attached to it. Promote it to PANE's position in the NEXTPANE chain") - (PROG ((ICONFN (WINDOWPROP WINDOW 'ICONFN)) - TEDITPROMPTWINDOW) - (OR WINDOW (\ILLEGAL.ARG WINDOW)) - (TEDIT.WINDOW.SETUP WINDOW TEXTOBJ TEXTSTREAM PROPS AFTERWINDOW) - - (* ;; "Do the general-purpose window setting up--the kind that every user will want.") - - (* ;; "Then do the stuff that a TEdit session needs as well.") - - (WINDOWADDPROP WINDOW 'RESHAPEFN (FUNCTION \TEDIT.RESHAPEFN)) - (WINDOWADDPROP WINDOW 'NEWREGIONFN (FUNCTION \TEDIT.NEWREGIONFN)) - (OR (WINDOWPROP WINDOW 'SCROLLFN) - (WINDOWPROP WINDOW 'SCROLLFN (FUNCTION \TEDIT.SCROLLFN))) - (WINDOWPROP WINDOW 'REPAINTFN (FUNCTION \TEDIT.REPAINTFN)) - [OR (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN) - (WINDOWPROP WINDOW 'TEDIT.TITLEMENUFN (OR (LISTGET PROPS 'TITLEMENUFN) - (FUNCTION TEDIT.DEFAULT.MENUFN] - (* ; - "Only put our menu function on the window if the originator didn't supply one.") - (WINDOWADDPROP WINDOW 'CLOSEFN (FUNCTION TEDIT.DEACTIVATE.WINDOW) - T) (* ; - "To clean up when the window is closed") - (WINDOWPROP WINDOW 'WINDOWENTRYFN (FUNCTION \TEDIT.PROCIDLEFN)) - (* ; - "For grabbing the TTY when the mouse clicks in the window") - (OR ICONFN (WINDOWPROP WINDOW 'ICONFN (FUNCTION \TEDIT.SHRINK.ICONCREATE))) - (* ; - "Only set up to create a shrink icon if nobody else has.") - (WINDOWADDPROP WINDOW 'SHRINKFN (FUNCTION \TEDIT.SHRINKFN)) - (* ; - "But always give up control of the keyboard on shrinking.") - (WINDOWADDPROP WINDOW 'EXPANDFN (FUNCTION \TEDIT.EXPANDFN)) - (* ; "And grab it back on expansion") - (WINDOWPROP WINDOW 'TEDIT.CURSORREGION (LIST 0 0 0 0)) - [WINDOWPROP WINDOW 'HARDCOPYFILEFN (FUNCTION (LAMBDA (W EXT) - (LET [(STRM (FETCH (TEXTOBJ TXTFILE) - OF (SETQ W (TEXTOBJ W] - (CL:WHEN STRM - (PACKFILENAME 'VERSION NIL - 'EXTENSION - (OR EXT 'IMAGEFILE) - 'BODY - (FULLNAME STRM)))] - (* ; "Used by CursorMovedFn") - (COND - ((NOT AFTERWINDOW) (* ; - "Only set the window's title if we aren't splitting windows.") - (\TEDIT.WINDOW.TITLE TEXTOBJ (\TEDIT.ORIGINAL.WINDOW.TITLE WINDOW (fetch (TEXTOBJ - \DIRTY) - of TEXTOBJ))) - (COND - ((EQ 'DON'T (LISTGET PROPS 'PROMPTWINDOW)) (* ; - "He said not to provide a feedback region, so don't.") - ) - ((AND (NOT (LISTGET PROPS 'READONLY)) - [NOT (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with (LISTGET PROPS - 'PROMPTWINDOW] - (NOT (fetch (TEXTOBJ MENUFLG) of TEXTOBJ))) - (* ; - "The window is read-write, so give it a feedback region") - (SETQ TEDITPROMPTWINDOW (GETPROMPTWINDOW WINDOW (OR (LISTGET PROPS - 'PROMPTWINDOWHEIGHT) - TEDIT.PROMPTWINDOW.HEIGHT 1) - TEDIT.PROMPT.FONT)) - (replace (TEXTOBJ PROMPTWINDOW) of TEXTOBJ with TEDITPROMPTWINDOW) - (WINDOWPROP TEDITPROMPTWINDOW 'TEDIT.PROMPTWINDOW T) - (* ; - "And remember that this is a TEdit-supplied prompt window") - (WINDOWPROP TEDITPROMPTWINDOW 'PAGEFULLFN (FUNCTION \TEDIT.PROMPT.PAGEFULLFN]) - -(\SAFE.FIRST - [LAMBDA (LIST.OR.ATOM) (* ; "Edited 26-Apr-91 13:00 by jds") - (* ; - "gives the first element whether the arg is a list or an atom. Should be a macro eventually") - (COND - ((LISTP LIST.OR.ATOM) - (CAR LIST.OR.ATOM)) - (T LIST.OR.ATOM]) + (DETACHWINDOW NEXTPANE) + (ATTACHWINDOW NEXTPANE PRIORPANE 'BOTTOM 'JUSTIFY 'MAIN)) + (CLOSEW PANE) + (\SHOWSEL SEL T]) ) +(MOVD? 'NILL 'GRAB-TYPED-REGION) + +(MOVD? 'NILL 'REGISTER-TYPED-REGION) + (RPAQ? \TEDIT.OP.WIDTH 12) (RPAQ? \TEDIT.OP.BOTTOM 12) + +(RPAQ? \TEDIT.LINEREGION.WIDTH 8) (DECLARE%: DONTEVAL@LOAD DOCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM) +(GLOBALVARS \TEDIT.OP.WIDTH \TEDIT.OP.BOTTOM \TEDIT.LINEREGION.WIDTH) ) ) (RPAQ BXCARET (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@A@@@CH@@CH@@FL@@FL@@LF@@ ) (QUOTE NIL) 3 4)) (RPAQ BXHICARET (CURSORCREATE (QUOTE #*(16 16)A@@@A@@@A@@@A@@@A@@@A@@@A@@@A@@@CH@@GL@@FL@@LF@@HB@@@@@@@@@@@@@@ ) (QUOTE NIL) 4 7)) -(RPAQ TEDIT.LINECURSOR (CURSORCREATE (QUOTE #*(16 16)@@@A@@@C@@@G@@@O@@AO@@CO@@GO@@@O@@AK@@AI@@C@@@C@@@F@@@F@@@L@@@L@ +(RPAQ \TEDIT.LINECURSOR (CURSORCREATE (QUOTE #*(16 16)@@@A@@@C@@@G@@@O@@AO@@CO@@GO@@@O@@AK@@AI@@C@@@C@@@F@@@F@@@L@@@L@ ) (QUOTE NIL) 15 15)) (RPAQ \TEDIT.SPLITCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OO@@HA@@HA@@HA@@HA@@HA@@HA@@OO@@ ) (QUOTE NIL) 4 4)) @@ -1345,12 +1489,6 @@ (RPAQ \TEDIT.MAKESPLITCURSOR (CURSORCREATE (QUOTE #*(16 16)@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@OO@@HA@@HA@@MK@@MK@@HA@@HA@@OO@@ ) (QUOTE NIL) 4 4)) -(RPAQ? TEDIT.DEFAULT.WINDOW NIL) -(DECLARE%: DOEVAL@COMPILE DONTCOPY - -(GLOBALVARS TEDIT.DEFAULT.WINDOW) -) - (* ; "User-level %"is this a TEdit window?%" function.") @@ -1358,25 +1496,16 @@ (DEFINEQ (TEDITWINDOWP - [LAMBDA (WINDOW) (* ; "Edited 16-Jan-89 10:28 by jds") + [LAMBDA (WINDOW) (* ; "Edited 22-Jan-2024 10:57 by rmk") + (* ; "Edited 15-Sep-2023 21:03 by rmk") + (* ; "Edited 16-Jan-89 10:28 by jds") - (* ;; "Returns non-NIL if WINDOW is a legal TEdit window: I.e., if it 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 window. The test is that the returned window has a TEXTOBJ property, and the TEXTOBJ thinks this is its window.") - (COND - ((WINDOWP WINDOW)) - ((DISPLAYSTREAMP WINDOW) - (SETQ WINDOW (WFROMDS WINDOW))) - (T (SETQ WINDOW NIL))) - (LET* [(CHECKED-WINDOW (COND - ((WINDOWP WINDOW) - WINDOW) - ((DISPLAYSTREAMP WINDOW) - (WFROMDS WINDOW)) - (T NIL))) - (TEXTOBJ (AND CHECKED-WINDOW (WINDOWPROP CHECKED-WINDOW 'TEXTOBJ] - (AND (type? TEXTOBJ TEXTOBJ) - (MEMBER CHECKED-WINDOW (fetch (TEXTOBJ \WINDOW) of TEXTOBJ)) - T]) + (LET* [(TEXTOBJ (TEXTOBJ WINDOW T)) + (CHECKED-WINDOW (AND TEXTOBJ (\TEDIT.PRIMARYW TEXTOBJ] + (AND CHECKED-WINDOW (MEMB CHECKED-WINDOW (FGETTOBJ TEXTOBJ \WINDOW)) + CHECKED-WINDOW]) ) @@ -1386,50 +1515,64 @@ (DEFINEQ (TEDIT.GETINPUT - [LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* ; "Edited 21-Jan-2022 23:14 by rmk") + [LAMBDA (STREAM PROMPTSTRING DEFAULTSTRING DELIMITER.LIST) (* ; "Edited 22-Jan-2024 00:09 by rmk") + (* ; "Edited 22-Sep-2023 19:57 by rmk") + (* ; "Edited 30-Jul-2023 08:51 by rmk") + (* ; "Edited 21-Jan-2022 23:14 by rmk") (* ; "Edited 30-May-91 23:34 by jds") (* ;; "Ask for input (file names, &c) for TEdit, perhaps with a default.") - (PROG* ((TEXTOBJ (TEXTOBJ STREAM)) - (TPROMPT (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (SETQ TPROMPT (SELECTQ TPROMPT - (DON'T [COND - ((TEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND) - (GETPROMPTWINDOW (\TEDIT.MAINW STREAM]) - (NIL [GETPROMPTWINDOW (\TEDIT.MAINW STREAM) - NIL NIL (NOT (TEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]) - TPROMPT)) - (COND - (TPROMPT (* ; + (LET* ((TEXTOBJ (TEXTOBJ STREAM)) + (TPROMPT (GETTOBJ TEXTOBJ PROMPTWINDOW)) + RESULT) + (SETQ TPROMPT (SELECTQ TPROMPT + (DON'T [COND + ((GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND) + (GETPROMPTWINDOW (\TEDIT.MAINW STREAM]) + (NIL [GETPROMPTWINDOW (\TEDIT.MAINW STREAM) + NIL NIL (NOT (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND]) + TPROMPT)) + (COND + (TPROMPT (* ;  "If it's our own promptwindow, just clear it.") - (CLEARW TPROMPT)) - (T (* ; + (CLEARW TPROMPT) + (FRESHLINE TPROMPT)) + (T (* ;  "If it's the system's window, just move to a new line.") - (FRESHLINE PROMPTWINDOW))) - (RETURN (PROG1 (TTYINPROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT PROMPTWINDOW - ) - NIL - 'TTY - (OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE))) - NIL) (* ; "Get what the guy wants to tell us") - (WINDOWPROP (OR TPROMPT PROMPTWINDOW) - 'PROCESS NIL) (* ; - "Now detach the prompt window from its process, to avoid a circularity.") - )]) + (FRESHLINE PROMPTWINDOW))) + (SETQ RESULT (TTYINPROMPTFORWORD PROMPTSTRING DEFAULTSTRING NIL (OR TPROMPT PROMPTWINDOW) + NIL + 'TTY + (OR DELIMITER.LIST (CHARCODE (EOL LF TAB ESCAPE ^X))) + NIL)) + (CL:WHEN (AND (EQ (CHARCODE %") + (CHCON1 RESULT)) + (EQ (CHARCODE %") + (NTHCHARCODE RESULT -1))) + + (* ;; "Presumably it is not intended to have a string with string quotes on the edges.") + + (SETQ RESULT (SUBSTRING RESULT 2 -2)) + (WINDOWPROP (OR TPROMPT PROMPTWINDOW) + 'PROCESS NIL)) + RESULT]) (\TEDIT.MAKEFILENAME - [LAMBDA (STRING) (* jds " 8-Feb-85 11:25") - (* Takes a string, removes leading and - trailing spaces, and converts it to an - ATOM.) - (PROG ((FIRSTNONSPACE (STRPOSL '(% ) - STRING NIL T)) - (LASTNONSPACE (STRPOSL '(% ) - STRING NIL T T))) - (COND - ((AND FIRSTNONSPACE LASTNONSPACE) - (RETURN (MKATOM (SUBSTRING STRING FIRSTNONSPACE LASTNONSPACE]) + [LAMBDA (STRING) + + (* ;; "Edited 18-Dec-2023 22:45 by rmk") + + (* ;; "Edited 9-Sep-2023 17:13 by rmk") + + (* ;; "Edited 24-Oct-2022 00:02 by rmk: Originally returned an atom, which is no longer a valid filename.") + (* jds " 8-Feb-85 11:25") + + (* ;; "Removes leading and trailing spaces from a non-NIL string") + + (CL:UNLESS (STRING.EQUAL STRING NIL) + (CL:STRING-TRIM `(#\Space) + STRING))]) ) @@ -1439,49 +1582,69 @@ (DEFINEQ (TEDIT.PROMPTPRINT - [LAMBDA (TEXTSTREAM MSG CLEAR?) (* ; + [LAMBDA (TEXTSTREAM MSG CLEAR? FLASH?) (* ; "Edited 26-Nov-2023 10:10 by rmk") + (* ; "Edited 10-Sep-2023 00:27 by rmk") + (* ; "Edited 30-Jul-2023 08:52 by rmk") + (* ; "Edited 9-Jul-2023 12:37 by rmk") + (* ; "Edited 5-Apr-2023 15:08 by rmk") + (* ;  "Edited 4-Jun-93 12:04 by sybalsky:mv:envos") (* ;; "Print a message in the editor's prompt window (if none, use the global promptwindow). Optionally clear the window first.") - (PROG (WINDOW PWINDOW (TEXTOBJ (AND TEXTSTREAM (TEXTOBJ TEXTSTREAM))) - MAINTEXTOBJ) - (COND - [(AND TEXTOBJ (fetch (TEXTOBJ MENUFLG) of TEXTOBJ)) - (* ; - "There is a known textobj, and it's a menu. Go use the main editor's promptwindow.") - (SETQ MAINTEXTOBJ (WINDOWPROP (\TEDIT.MAINW TEXTOBJ) - 'TEXTOBJ)) (* ; - "Find the TEXTOBJ for the main edit window, and use ITS prompting window.") - (SETQ WINDOW (AND MAINTEXTOBJ (fetch (TEXTOBJ PROMPTWINDOW) of MAINTEXTOBJ] - (TEXTOBJ (SETQ WINDOW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) - (* ; - "There IS an editor window to get to; use its prompt window") - )) - [SETQ WINDOW (CAR (NLSETQ (SELECTQ WINDOW - (DON'T [COND - ((TEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND) - (GETPROMPTWINDOW (\TEDIT.MAINW STREAM]) - (NIL [AND TEXTSTREAM (GETPROMPTWINDOW - (\TEDIT.MAINW TEXTSTREAM) - NIL NIL (NOT (TEXTPROP TEXTOBJ - 'PWINDOW.ON.DEMAND]) - WINDOW] (* ; + (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) + PWINDOW MAINWINDOW) + (CL:WHEN (SETQ MAINWINDOW (\TEDIT.MAINW TEXTOBJ)) + [SETQ PWINDOW (CAR (NLSETQ (SELECTQ PWINDOW + (DON'T (CL:WHEN (GETTEXTPROP TEXTOBJ 'PWINDOW.ON.DEMAND) + (GETPROMPTWINDOW MAINWINDOW))) + (NIL (CL:WHEN TEXTSTREAM + [GETPROMPTWINDOW MAINWINDOW NIL NIL + (NOT (GETTEXTPROP TEXTOBJ + 'PWINDOW.ON.DEMAND])) + PWINDOW]) (* ;  "Try to find an editor's prompt window for our message") - (COND - (WINDOW (* ; + (COND + ((WINDOWP PWINDOW) (* ;  "We found a window to use. Print the message.") + (CL:WHEN CLEAR? (CLEARW PWINDOW)) + (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75)) + (PRIN1 MSG PWINDOW)) + (T (* ; + "Failing all else, use global PROMPTWINDOW.") + (FRESHLINE PROMPTWINDOW) + (CL:WHEN FLASH? (FLASHWINDOW PWINDOW 1 75)) + (printout PROMPTWINDOW MSG]) - (* ;; "WAS (RESETLST (RESETSAVE (TTYDISPLAYSTREAM WINDOW)) (COND (CLEAR? (CLEARW WINDOW))) (PRIN1 MSG WINDOW))") +(TEDIT.PROMPTCLEAR + [LAMBDA (TEXTSTREAM FONT) (* ; "Edited 14-Mar-98 12:52 by rmk:") + (* ; "Edited 14-Oct-87 15:35 by bvm:") - (COND - ((AND CLEAR? (WINDOWP WINDOW)) - (CLEARW WINDOW))) - (PRIN1 MSG WINDOW)) - (T (* ; - "Failing all else, use PROMPTWINDOW.") - (FRESHLINE PROMPTWINDOW) - (printout PROMPTWINDOW MSG]) + (* ;; "Clears the promptwindow attached to TEXTSTREAM and shrinks it back to a single line in font FONT (or TEDIT.PROMPT.FONT) if it has grown. TEXTSTREAM could actually be a stream on the promptwindow itself.") + + (LET [MW (PW (IF (CAR (NLSETQ (GETPROMPTWINDOW (\TEDIT.MAINW TEXTSTREAM) + NIL NIL T))) + ELSEIF (WINDOWPROP (WFROMDS TEXTSTREAM) + 'TEDIT.PROMPTWINDOW) + THEN (WFROMDS TEXTSTREAM] + (CL:WHEN PW + (WINDOWPROP PW 'TEDIT.NLINES 1) + (CL:WHEN [AND (SETQ MW (WINDOWPROP PW 'MAINWINDOW)) + (SETQ MW (LISTP (WINDOWPROP MW 'PROMPTWINDOW] + (RPLACD MW 1)) + (LET [PROP [HEIGHT (HEIGHTIFWINDOW (FONTPROP (OR FONT TEDIT.PROMPT.FONT) + 'HEIGHT] + (REG (WINDOWPROP PW 'REGION] + (CL:UNLESS (EQ HEIGHT (FETCH HEIGHT OF REG)) + (WINDOWPROP PW 'MINSIZE (CONS 0 HEIGHT)) + + (* ;; + "Have to adjust the fixed size of the window before shaping, since SHAPEW obeys the minimum.") + + (WINDOWPROP PW 'MAXSIZE (CONS 64000 HEIGHT)) + (SHAPEW PW (CREATE REGION USING REG HEIGHT _ HEIGHT))) + (CL:WHEN (OPENWP PW) + (CLEARW PW))))]) (TEDIT.PROMPTFLASH [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") @@ -1535,7 +1698,7 @@ (WINDOWPROP PROMPT-WINDOW 'TEDIT.NLINES %#LINES]) ) -(RPAQ? TEDIT.PROMPT.FONT (FONTCREATE 'GACHA 10)) +(RPAQ? TEDIT.PROMPT.FONT (FONTCREATE 'TERMINAL 10)) (RPAQ? TEDIT.PROMPTWINDOW.HEIGHT NIL) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -1549,81 +1712,135 @@ (DEFINEQ -(TEXTSTREAM.TITLE - [LAMBDA (STREAM) (* ; "Edited 24-Aug-2021 23:25 by rmk:") - - (* ;; "returns a string with which you can talk to the user about this stream") - - (PROG ((TEXTOBJ (TEXTOBJ STREAM)) - TXTFILE) - (SETQ TXTFILE (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (RETURN (OR (CL:TYPECASE TXTFILE - (STRINGP TXTFILE) - (STREAM (fetch (STREAM FULLNAME) of TXTFILE)) - (LITATOM TXTFILE) - (T TXTFILE)) - ""]) - -(\TEDIT.ORIGINAL.WINDOW.TITLE - [LAMBDA (FILE DIRTY? PROPS) (* ; "Edited 27-Oct-2021 12:25 by rmk:") +(\TEXTSTREAM.TITLE + [LAMBDA (STREAM) (* ; "Edited 18-Oct-2023 00:02 by rmk") (* ; "Edited 24-Aug-2021 23:25 by rmk:") - (* ;; "Given a file name, derive a title for the TEdit window that is editing it. RMK: Title may be provided in a property") + (* ;; "returns a string with which you can talk to the user about this stream. e.g. for Get and Put prompts") - (LET (TITLE) - [SETQ TITLE (COND - ((LISTGET PROPS 'TITLE)) - ((NULL FILE) (* ; + (LET ((TEXTOBJ (TEXTOBJ STREAM)) + TXTFILE) + (SETQ TXTFILE (FGETTOBJ TEXTOBJ TXTFILE)) + (OR (CL:TYPECASE TXTFILE + (STRINGP TXTFILE) + (STREAM (fetch (STREAM FULLNAME) of TXTFILE)) + (LITATOM TXTFILE) + (T TXTFILE)) + ""]) + +(\TEDIT.DEFAULT.TITLE + [LAMBDA (FILE PROPS) (* ; "Edited 18-Oct-2023 13:47 by rmk") + (* ; "Edited 21-Sep-2023 22:47 by rmk") + (* ; "Edited 17-Sep-2023 09:20 by rmk") + (* ; "Edited 8-Sep-2023 00:38 by rmk") + (* ; "Edited 27-Oct-2021 12:25 by rmk:") + (* ; "Edited 24-Aug-2021 23:25 by rmk:") + + (* ;; "Given a file name, derive a title for the TEdit window that is editing it. ") + + (LET [(TITLE (LISTGET PROPS 'TITLE] + (CL:UNLESS TITLE + [SETQ TITLE (CONCAT (CL:IF (LISTGET PROPS 'READONLY) + "See " + "Tedit ") + (COND + ((NULL FILE) (* ;  "Just calling (TEDIT) should give a 'Text Editor Window'") - "Text Editor Window") - ((AND (STRINGP FILE) - (ZEROP (NCHARS FILE))) (* ; "So should editing an empty string") - "Text Editor Window") - ((WINDOWP FILE) (* ; + "Window") + ((AND (STRINGP FILE) + (ZEROP (NCHARS FILE))) + (* ; "So should editing an empty string") + "Window") + ((WINDOWP FILE) (* ;  "if \TEDIT.WINDOW.SETUP has assigned a title, use it") - (OR (WINDOWPROP FILE 'TITLE) - "Text Editor Window")) - (T (* ; + (OR (WINDOWPROP FILE 'TITLE) + "Window")) + (T (* ;  "Strings use the string itself, otherwise grab the full file name.") - (CONCAT "Edit Window for: " (CL:TYPECASE FILE - (STRINGP FILE) - (STREAM (fetch (STREAM FULLNAME) - of FILE)) - (LITATOM FILE) - (T FILE))] - (COND - (DIRTY? (CONCAT "* " TITLE)) - (T TITLE]) + (CONCAT (CL:TYPECASE FILE + (STRINGP FILE) + (STREAM (fetch (STREAM FULLNAME) of FILE)) + (LITATOM FILE) + (T FILE))]) + TITLE]) (\TEDIT.WINDOW.TITLE - [LAMBDA (TEXTSTREAM NEW.TITLE) (* jds "23-May-85 15:20") - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - W) - (RETURN (COND - ((AND (SETQ W (\TEDIT.PRIMARYW TEXTOBJ)) - (NOT (TEXTPROP TEXTOBJ 'NOTITLE)) - (TEXTPROP TEXTOBJ 'TEDITCREATEDWINDOW)) + [LAMBDA (TEXTOBJ DIRTYFLAG TITLE) (* ; "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") + (* ; "Edited 19-Sep-2023 00:47 by rmk") + (* ; "Edited 24-Oct-2022 13:14 by rmk ") + (* jds "23-May-85 15:20") - (* Only change the title if there IS a window, and he isn't suppressing title - changes.) + (* ;; "This puts * or clears * in the title of a tedit window. TITLE may override the current window title (e.g. for get and put)") - (COND - (NEW.TITLE (WINDOWPROP W 'TITLE NEW.TITLE)) - (T (WINDOWPROP W 'TITLE]) + (CL:UNLESS (GETTOBJ TEXTOBJ MENUFLG) + (LET ((W (\TEDIT.PRIMARYW 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.") + (if TITLE + then (WINDOWPROP W 'TITLE TITLE) + else (SETQ TITLE (OR (WINDOWPROP W 'TITLE) + ""))) + (CL:UNLESS (EQ DIRTYFLAG (FGETTOBJ TEXTOBJ \XDIRTY)) + (if DIRTYFLAG + then (SETQ TITLE (CONCAT "* " TITLE)) + elseif (AND (EQ (CHARCODE *) + (CHCON1 TITLE)) + (EQ (CHARCODE SPACE) + (NTHCHARCODE TITLE 2))) + then (SETQ TITLE (OR (SUBSTRING TITLE 3) + ""))) + (WINDOWPROP W 'TITLE TITLE)) + TITLE)))]) (\TEXTSTREAM.FILENAME - [LAMBDA (TEXTSTREAM) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (TEXTSTREAM UNFORMATTED?) (* ; "Edited 18-Jan-2024 09:03 by rmk") + (* ; "Edited 29-Dec-2023 00:33 by rmk") + (* ; "Edited 18-Dec-2023 14:06 by rmk") + (* ; "Edited 30-May-91 23:34 by jds") - (* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed") + (* ;; "Offer TXT for plaintext, TEDIT for formatted (including BRAVO)") - (PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) - OFILE) - [COND - ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (SETQ OFILE (PACKFILENAME 'VERSION NIL 'BODY (fetch FULLFILENAME (fetch (TEXTOBJ - TXTFILE) - of TEXTOBJ] - (RETURN OFILE]) + (* ;; "If the input file is a foreign format (e.g. bravo), we probably don't want to put out a Tedit or plaintext file with its old extension. Perhaps the input format should mark the stream so as to avoid overwriting.") + + (* ;; "returns the name of the file associated with this stream if there is one. NIL otherwise. Version numbers suppressed.") + + (LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM)) + (DEFAULTEXT (CL:IF UNFORMATTED? + 'TXT + 'TEDIT)) + (TXTFILE (GETTOBJ TEXTOBJ TXTFILE)) + EXT) + (CL:WHEN (type? STREAM TXTFILE) + (SETQ TXTFILE (fetch FULLFILENAME of TXTFILE)) + [SETQ EXT (U-CASE (FILENAMEFIELD TXTFILE 'EXTENSION] + (if (OR (NULL EXT) + (EQ EXT 'BRAVO)) + then (SETQ EXT DEFAULTEXT) + elseif (AND UNFORMATTED? (MEMB EXT *TEDIT-EXTENSIONS*) + (NEQ EXT 'TEXT)) + then (SETQ EXT 'TXT)) + (PACKFILENAME 'EXTENSION EXT 'VERSION NIL 'BODY TXTFILE))]) + +(\TEDIT.UPDATE.TITLE + [LAMBDA (TEXTOBJ FILENAME) (* ; "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) + (\TEDIT.WINDOW.TITLE TEXTOBJ NIL (\TEDIT.DEFAULT.TITLE (OR FILENAME TITLE))) + (SETQ MENUSTREAM (TEDITMENU.STREAM TEXTOBJ)) + (CL:WHEN (AND MENUSTREAM (type? 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))]) ) @@ -1633,614 +1850,796 @@ (DEFINEQ (TEDIT.DEACTIVATE.WINDOW - [LAMBDA (W FORCEFLG DISCONNECTONLYFLG) (* ; "Edited 20-Oct-2023 21:46 by rmk") + [LAMBDA (W) (* ; "Edited 17-Oct-2023 08:54 by rmk") + (* ; "Edited 10-Oct-2023 10:23 by rmk") + (* ; "Edited 30-Sep-2023 13:42 by rmk") + (* ; "Edited 22-Sep-2023 00:07 by rmk") + (* ; "Edited 9-Mar-2023 15:12 by rmk") + (* ; "Edited 5-Nov-2022 23:29 by rmk") (* ; "Edited 16-Oct-2021 18:51 by rmk:") - (* ;; "Deactivate the various button fns for this window") + (* ;; "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.") - (PROG [(TEXTOBJ (WINDOWPROP W 'TEXTOBJ] (* ; - "Can't be a call to TEXTOBJ, since window may NOT have a textobj on it.") - (CL:WHEN TEXTOBJ - (replace (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ with T) - [COND - ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + (PROG ((TEXTOBJ (TEXTOBJ W T))) + (CL:UNLESS TEXTOBJ (* ; + "Return NIL if not an editing window (rather than error?)") + (RETURN)) + (\DTEST TEXTOBJ 'TEXTOBJ) - (* ;; "If something is going on, DON'T CLOSE THE WINDOW") + (* ;; "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.") - (TEDIT.PROMPTPRINT TEXTOBJ "Not closed; edit operation in progress" T) - (RETURN 'DON'T)) - ((AND (PROCESSP (WINDOWPROP W 'PROCESS)) - (NOT (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ)) - (NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (NOT FORCEFLG)) (* ; - "This is an un-quit TEdit window. Try to QUIT out of TEdit.") - (COND - ((\TEDIT.QUIT W T)) - (T - (* ;; "Always return DON'T: If we didn't quit, we don't want to close the window; if we did quit, the window is closed already, and will be reopened to reclose it.") + (CL:WHEN (GETTOBJ TEXTOBJ EDITOPACTIVE) - (RETURN 'DON'T] - (COND - ([OR FORCEFLG (fetch (TEXTOBJ EDITFINISHEDFLG) of TEXTOBJ) - (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ) - (NOT (PROCESSP (WINDOWPROP W 'PROCESS] (* ; - "Only do this if it's a TEdit window, and has been QUIT out of.") - [COND - ((AND (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ) - (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ))) - (CLEARW (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ] - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) (* ; + (* ;; "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))) + (\SHOWSEL (TEXTSEL TEXTOBJ) + NIL) (* ;  "Before the window is closed, make SURE that the caret is down, or the window will reappear.") - (COND - ((AND (\TEDIT.WINDOW.TITLE TEXTOBJ) - (OPENWP (fetch (TEXTOBJ PROMPTWINDOW) of TEXTOBJ)) - (OPENWP W) - (EQ W (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - (NOT DISCONNECTONLYFLG)) - (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]") - (* ; + (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") - )) - [COND - ((NOT DISCONNECTONLYFLG) - (for PANE in (REVERSE (CDR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ))) - do - (* ;; "Run thru any split-off sub-panes, and reattach them, so we get a whole window back before the end of the world.") + (\TEDIT.WINDOW.TITLE TEXTOBJ "Edit Window [Inactive]")) + (for PANE in (REVERSE (CDR (GETTOBJ TEXTOBJ \WINDOW))) do - (\TEDIT.UNSPLITW PANE)) - (replace (TEXTOBJ \WINDOW) of TEXTOBJ with NIL) - (COND - ((type? STREAM (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (* ; + (* ;; "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.") + + (\TEDIT.UNSPLITW PANE)) + (SETTOBJ TEXTOBJ \WINDOW NIL) + (CL:WHEN (type? STREAM (GETTOBJ TEXTOBJ TXTFILE)) (* ;  "Close the file that this window was open on.") - (COND - ((NOT (WINDOWPROP W 'TEDIT-CLOSING-FILE T)) - (CLOSEF? (fetch (TEXTOBJ TXTFILE) of TEXTOBJ)) - (WINDOWPROP W 'TEDIT-CLOSING-FILE NIL] - (WINDOWPROP W 'TEXTOBJ NIL) (* ; - "Detach the edit data structures from the window") - (WINDOWPROP W 'TEXTSTREAM NIL) - (WINDOWPROP W 'LINES NIL) - (WINDOWPROP W 'THISLINE NIL) - (WINDOWPROP W 'PROCESS.EXITFN NIL) - (WINDOWPROP W 'PROCESS.IDLEFN NIL) - (WINDOWPROP W 'CURSOROUTFN NIL) - (WINDOWPROP W 'CURSORMOVEDFN NIL) - (WINDOWPROP W 'BUTTONEVENTFN 'TOTOPW) (* ; "And the button functions") - (WINDOWPROP W 'RIGHTBUTTONFN 'DOWINDOWCOM) - (WINDOWDELPROP W 'CLOSEFN 'TEDIT.DEACTIVATE.WINDOW) - (WINDOWPROP W 'SCROLLFN NIL) - (WINDOWDELPROP W 'RESHAPEFN '\EDITRESHAPEFN) - (AND (NOT DISCONNECTONLYFLG) - (WINDOWPROP W 'PROCESS) - (\TEDIT.INTERRUPT.SETUP (WINDOWPROP W 'PROCESS) - T)) (* ; - "Make sure any disarmed interrupts are restored.") - (for MENUW in (ATTACHEDWINDOWS W) when (AND (WINDOWPROP MENUW 'TEDITMENU) - (WINDOWPROP MENUW 'TEXTOBJ)) - do (* ; - "Detach all the TEDITMENU windows that belong to this window.") - (replace (TEXTOBJ EDITFINISHEDFLG) of (TEXTOBJ MENUW) with T) - (* ; "Mark it finished") - (WINDOWPROP MENUW 'TEDITMENU NIL) (* ; - "And mark it no longer a menu window") - (GIVE.TTY.PROCESS MENUW) (* ; - "Then give it a chance to kill itself off") - (DISMISS 300)) - (COND - ((NOT DISCONNECTONLYFLG) - (GIVE.TTY.PROCESS W) - (DISMISS 300))) - [replace (TEXTOBJ \WINDOW) of TEXTOBJ with (COND - ((LISTP (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ)) - (* ; "It's a list; remove this window") - (DREMOVE W (fetch (TEXTOBJ \WINDOW) - of TEXTOBJ] + (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) (* ; - "Disconnect the window from the edit data structures as well.") - )))]) + "Mark it finished so it closes itself") + (WINDOWPROP MENUW 'TEDITMENU + NIL) + (* ; + "And mark it no longer a menu window") + (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) + (replace (TEXTWINDOW WTEXTOBJ) of W with NIL) (* ; "Disconnect") + (replace (TEXTWINDOW WTEXTSTREAM) of W with NIL]) (\TEDIT.REPAINTFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (PANE) (* ; "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") - (* Will eventually do the right thing w/r/t text margins. - For now, it's a place holder.) + (* ;; "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%".") - (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) - (TEXTSTREAM (WINDOWPROP W 'TEXTSTREAM)) - (WREG (DSPCLIPPINGREGION NIL W)) - (CH# 0) - WHEIGHT FIRSTCH# LINES LINE WWIDTH) - (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on it - yet, just leave.) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) (* Turn off the selection while we - make changes) - (SETQ WHEIGHT (fetch PTOP of WREG)) (* Old window height) - (OR (SETQ LINES (WINDOWPROP W 'LINES)) - (RETURN)) (* If no text has been displayed yet, - just leave) - (SETQ LINE LINES) - (while LINE do + (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))) - (* Now hunt for the first line that had been visible, so we can find the CH# that - has to appear at the top of the window.) + (* ;; + "The window is clear before this is called, so no highlighting to worry about. Tell the selection.") - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT) (* This line was visible) - (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (* Note its first character %#) - (RETURN))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (COND - (LINE + (FSETSEL SEL ONFLG NIL) + (for P PLINES inpanes (PROGN TEXTOBJ) do (\TEDIT.FORMATLINES (fetch (TEXTWINDOW PLINES) + of P) + NIL P TEXTOBJ)) + (CL:WHEN WASON + (\FIXSEL SEL TEXTOBJ) (* ; + "Account for new lines and highlighting") + (\SHOWSEL SEL T)))]) - (* You can only do this if there IS text on the screen to start with.) +(\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") - (\DISPLAYLINE TEXTOBJ LINE W) (* Actually display it) - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL W) (* Fill out the window with more - lines, to fill or to EOF) - )) - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* Fix up the selection to account for - the line shuffling) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL T) (* And highlight it) - ]) + (* ;; "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 20-Jan-2024 23:23 by rmk") + (* ; "Edited 21-Dec-2023 17:17 by rmk") + (* ; "Edited 17-Dec-2023 17:27 by rmk") + (LET ((REGION (WINDOWREGION WINDOW)) + (SCREEN (fetch (WINDOW SCREEN) of WINDOW)) + HORIZONTAL VERTICAL) + [SETQ HORIZONTAL (OR (ILESSP (fetch LEFT of REGION) + 0) + (IGREATERP (fetch RIGHT of REGION) + (fetch (SCREEN SCWIDTH) of SCREEN] + [SETQ VERTICAL (OR (ILESSP (fetch BOTTOM of REGION) + 0) + (IGREATERP (fetch TOP of REGION) + (fetch (SCREEN SCHEIGHT) of SCREEN] + (if VERTICAL + then (CL:IF HORIZONTAL + '(HORIZONTAL VERTICAL) + 'VERTICAL) + elseif HORIZONTAL + then 'HORIZONTAL]) (\TEDIT.RESHAPEFN - [LAMBDA (W BITS OLDREGION) (* ; "Edited 30-May-91 23:34 by jds") + [LAMBDA (PANE BITS OLDREGION) (* ; "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.) + (* ;; "Will eventually do the right thing w/r/t text margins. For now, it's a place holder.") - (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) - (TEXTSTREAM (WINDOWPROP W 'TEXTSTREAM)) - (NEWWHEIGHT (fetch HEIGHT of (DSPCLIPPINGREGION NIL W))) - (NEWWWIDTH (fetch WIDTH of (DSPCLIPPINGREGION NIL W))) - (NEWLEFT 0) - (NEWBOTTOM 0) - (CH# 0) - WHEIGHT FIRSTCH# LINES LINE WWIDTH) - (OR TEXTOBJ (RETURN)) (* If this window has no TEXTOBJ on it - yet, just leave.) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL NIL) (* Turn off the selection while we - make changes) - (SETQ WHEIGHT (fetch HEIGHT of OLDREGION)) (* Old window height) - (replace (TEXTOBJ WTOP) of TEXTOBJ with NEWWHEIGHT)(* Save new height/width for later use) - (replace (TEXTOBJ WRIGHT) of TEXTOBJ with NEWWWIDTH) - (replace (TEXTOBJ WBOTTOM) of TEXTOBJ with NEWBOTTOM) - (replace (TEXTOBJ WLEFT) of TEXTOBJ with NEWLEFT) - (OR (SETQ LINES (WINDOWPROP W 'LINES)) - (RETURN)) (* If no text has been displayed yet, - just leave) - (SETQ LINE LINES) - (while LINE do + (PROG ((TEXTOBJ (WINDOWPROP PANE 'TEXTOBJ)) + (PREG (DSPCLIPPINGREGION NIL PANE)) + NEWPHEIGHT PLINES LINE) + (CL:UNLESS TEXTOBJ (* ; "Not a Tedit window") + (RETURN)) + (CL:UNLESS (SETQ PLINES (fetch (TEXTWINDOW PLINES) of PANE)) + (* ; "No lines: should never happen") + (RETURN)) + (\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)) - (* Now hunt for the first line that had been visible, so we can find the CH# that - has to appear at the top of the window.) + (* ;; "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.") - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT) (* This line was visible) - (SETQ FIRSTCH# (fetch (LINEDESCRIPTOR CHAR1) of LINE)) - (* Note its first character %#) - (RETURN)) - (T (replace (LINEDESCRIPTOR YBOT) of LINE with NEWWHEIGHT))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - (AND FIRSTCH# (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ NEWWHEIGHT FIRSTCH# W))) - (COND - (LINE + (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") + [SETQ LINE (CADR (\FORMATBLOCK 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))) + (\DISPLAYLINE TEXTOBJ LINE PANE) (* ; "Actually display it") + (\FILLPANE LINE TEXTOBJ PANE)) + (\FIXSEL (FGETTOBJ TEXTOBJ SEL) + TEXTOBJ) (* ; + "Fix up the selection to account for the line shuffling") + (\SHOWSEL (FGETTOBJ TEXTOBJ SEL) + T]) - (* You can only do this if there IS text on the screen to start with.) +(\TEDIT.PANEWITHINSCREEN? + [LAMBDA (PANE) (* ; "Edited 20-Nov-2023 13:43 by rmk") + (* ; "Edited 10-May-2023 23:37 by rmk") - (COND - ((NEQ LINE LINES) - (replace (LINEDESCRIPTOR NEXTLINE) of LINES with LINE) - (replace (LINEDESCRIPTOR PREVLINE) of LINE with LINES))) - (* Forget the old chain of line - descriptors) - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE NEWWHEIGHT - (fetch (LINEDESCRIPTOR LHEIGHT) - of LINE))) - (* Fix the line to appear at the top - of the window) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR YBOT) - of LINE) - (fetch (LINEDESCRIPTOR DESCENT - ) of LINE))) - (\DISPLAYLINE TEXTOBJ LINE W) (* Actually display it) - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL W) (* Fill out the window with more - lines, to fill or to EOF) - )) - (\FIXSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - TEXTOBJ) (* Fix up the selection to account for - the line shuffling) - (\SHOWSEL (fetch (TEXTOBJ SEL) of TEXTOBJ) - NIL T) (* And highlight it) - ]) + (* ;; "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.SCROLLFN - [LAMBDA (W DX DY) + (* ;; " \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. ") (* ;; - "Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for windows that are partially off-screen") + "Since TEDIT doesn't (yet) support horizontal scrolling), we only test the vertical dimension") - (* ;; "Edited 19-Sep-2021 23:10 by rmk:") - (* Handle scrolling of the edit window) - (TOTOPW W) - (PROG* (WHEIGHT (TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) - (PRIORCR 0) - SELWASON SHIFTEDSELWASON MOVESELWASON DELETESELWASON (WREG (DSPCLIPPINGREGION - NIL W)) - LINES TRUEY TRUEX WWIDTH SEL (PREVLINE NIL) - (PRESCROLLFN (TEXTPROP TEXTOBJ 'PRESCROLLFN)) - (POSTSCROLLFN (TEXTPROP TEXTOBJ 'POSTSCROLLFN)) - TEXTLEN THEIGHT TOPLINE RHEIGHT LOWESTY YBOT LINE CH# CHNO CH) - (COND - ((ZEROP (SETQ TEXTLEN (fetch (TEXTOBJ TEXTLEN) of TEXTOBJ))) - (* Don't scroll a zero-length file) - (RETURN)) - ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) (* Don't scroll while something - interesting is happening!) - (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T) - (RETURN))) (* Displaystream for the window) - (SETQ WHEIGHT (fetch HEIGHT of WREG)) (* Height of the window) - (SETQ LOWESTY WHEIGHT) (* Lowest Y of a line-bottom yet seet) - (SETQ WWIDTH (fetch WIDTH of WREG)) (* Width of the window) - (SETQ LINES (WINDOWPROP W 'LINES)) (* List of formatted lines) - (AND PRESCROLLFN (DOUSERFNS PRESCROLLFN W)) (* If there's a pre-scroll fn, execute - it now.) - (COND - ((fetch (SELECTION SET) of (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - (* Turn off the selection during the - scroll.) - (SETQ SELWASON (fetch (SELECTION ONFLG) of SEL)) - (\SHOWSEL SEL NIL NIL))) - (SETQ SHIFTEDSELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - ) - (\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - NIL NIL) - (SETQ MOVESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ))) - (\SHOWSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - NIL NIL) - (SETQ DELETESELWASON (fetch (SELECTION ONFLG) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ))) - (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - NIL NIL) - (COND - [(AND (FIXP DY) - (NOT (ZEROP DY))) (* Regular up/down scrolling) - (SETQ TRUEY (IDIFFERENCE WHEIGHT (IABS DY))) - (COND - [(ILESSP 0 DY) (* Scroll text up) - (SETQ LINE LINES) - (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - WHEIGHT)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE))) - (first [COND - ((AND LINE (ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - TRUEY)) (* Make sure we scroll up at least one - line.) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] while LINE - do (* Find the line whose top is to move - to the top of the window) - [COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of LINE) - TRUEY) - (RETURN)) - (T (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR DESCENT) of LINE) - (replace (LINEDESCRIPTOR YBOT) of LINE with WHEIGHT] - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE))) - [COND - (LINE (* There is a line to go to the top) - (SETQ RHEIGHT (IPLUS (fetch (LINEDESCRIPTOR YBASE) of LINE) - (fetch (LINEDESCRIPTOR ASCENT) of LINE))) - (* Find the Ypos of the top of the - line's image) - (BITBLT W 0 0 W 0 (IDIFFERENCE WHEIGHT RHEIGHT) - WWIDTH RHEIGHT 'INPUT 'REPLACE) - (BITBLT NIL 0 0 W 0 0 WWIDTH (IDIFFERENCE WHEIGHT RHEIGHT) - 'TEXTURE - 'REPLACE WHITESHADE) - [bind NL (PL _ PREVLINE) for I from 1 to 50 while PL - do (* Let him keep 50 lines above what he - can see on the screen) - (SETQ PL (fetch (LINEDESCRIPTOR PREVLINE) of PL)) - finally (COND - ((AND PL (NEQ PL LINES)) - (* There were more than 50 lines - (and we aren't pointing at the root)%, - so lop the spare ones off.) - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - (UNINTERRUPTABLY - (replace (LINEDESCRIPTOR NEXTLINE) of LINES - with PL) - (replace (LINEDESCRIPTOR PREVLINE) of PL with LINES)) - (bind NNL while (AND NL (NEQ NL PL)) - do (SETQ NNL NL) - (SETQ NL (fetch (LINEDESCRIPTOR NEXTLINE) - of NL)) - (replace (LINEDESCRIPTOR NEXTLINE) of NNL - with NIL] - (while (AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch BOTTOM of WREG))) - do (* Update the bottom and baseline) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IDIFFERENCE WHEIGHT RHEIGHT))) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch (LINEDESCRIPTOR DESCENT) of LINE))) - (SETQ PREVLINE LINE) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE] - (COND - ((AND LINE (IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (fetch BOTTOM of WREG))) - (* Fill the rest of the window) - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL W)) - (PREVLINE (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - PREVLINE TEXTOBJ NIL W] - (T (* Scroll text down in window, adding - lines at top to fill.) - (SETQ PREVLINE (SETQ TOPLINE LINES)) (* Find the top line on the screen%:) - [while TOPLINE do + (* ;; " ") - (* Run thru the lines, until we hit the first one that is below the top of the - edit window) + (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]) +) +(DEFINEQ - (COND - ((ILESSP (fetch (LINEDESCRIPTOR YBOT) of TOPLINE) - WHEIGHT) - (RETURN)) - (T (SETQ PREVLINE TOPLINE) - (SETQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) - of TOPLINE] - [COND - ((AND (EQ PREVLINE LINES) - (OR (NOT (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of (fetch (LINEDESCRIPTOR - NEXTLINE) - of PREVLINE)) - 1))) (* There's nothing between us and - start of file that's formatted; - start by making some.) - (SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT] - (SETQ THEIGHT 0) +(\TEDIT.SCROLLFN + [LAMBDA (PANE DX DY) - (* Accumulates the heights of the lines we've backed over. - When this exceeds the scrolling distance, we've found the line.) + (* ;; "Edited 22-Oct-2023 08:31 by rmk") - (bind (FIRSTTIME _ T) while (OR FIRSTTIME (AND (ILESSP THEIGHT (IABS DY)) - (IGEQ (fetch (LINEDESCRIPTOR - CHAR1) of PREVLINE) - 1))) - do + (* ;; "Edited 11-May-2023 12:03 by rmk") - (* Starting with PREVLINE, accumulate LHEIGHTs until we hit top of text or have - accumulated enough lines to fill the screen) + (* ;; + "Edited 18-Feb-2022 14:53 by rmk: Repaint after scrolling for panes that are partially off-screen") - (add THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) of PREVLINE)) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE)) - [COND - ((OR (NOT PREVLINE) - (ILESSP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE) - 1)) (* We need to format some lines above - where we are -- go do it.) - (SETQ PREVLINE (\BACKFORMAT LINES TEXTOBJ WHEIGHT] - (SETQ FIRSTTIME NIL)) - [COND - ([OR (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (EQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR - NEXTLINE) - of PREVLINE] + (TOTOPW PANE) + (PROG [(TEXTOBJ (\DTEST (fetch (TEXTWINDOW PTEXTOBJ) of PANE) + 'TEXTOBJ] + (if (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) + then + (* ;; "Don't scroll a zero-length file") - (* Always move at least one line backward. - So if we're about to move no lines, force a single line.) + (RETURN) + elseif (FGETTOBJ TEXTOBJ EDITOPACTIVE) + then + (* ;; "Don't scroll while something interesting is happening!") - ) - ((ILESSP (IABS DY) - THEIGHT) (* BACK UP ONE LINE TO GET TO THE ONE - WHICH PUSHED US OVER TOP) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (SETQ THEIGHT (IDIFFERENCE THEIGHT (fetch (LINEDESCRIPTOR LHEIGHT) - of PREVLINE] - [COND - ((NEQ TOPLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE)) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE] - (* Move to the first line to be - formatted.-) - (BITBLT W 0 THEIGHT W 0 0 WWIDTH (IDIFFERENCE WHEIGHT THEIGHT) - 'INPUT - 'REPLACE) - (BITBLT NIL 0 0 W 0 (IDIFFERENCE WHEIGHT THEIGHT) - WWIDTH THEIGHT 'TEXTURE 'REPLACE WHITESHADE) - (bind (LINE _ TOPLINE) while LINE - do (COND - ((IGEQ (fetch (LINEDESCRIPTOR YBOT) of LINE) - (IPLUS (fetch BOTTOM of WREG) - THEIGHT)) (* This line will be on screen. - Adjust its YBOT/YBASE) - (replace (LINEDESCRIPTOR YBOT) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBOT) of LINE) - THEIGHT)) - (replace (LINEDESCRIPTOR YBASE) of LINE - with (IDIFFERENCE (fetch (LINEDESCRIPTOR YBASE) of LINE) - THEIGHT)) - (SETQ LOWESTY (fetch (LINEDESCRIPTOR YBOT) of LINE))) - (T (replace (LINEDESCRIPTOR YBOT) of LINE - with (SUB1 (fetch BOTTOM of WREG))) - (replace (LINEDESCRIPTOR NEXTLINE) of (fetch (LINEDESCRIPTOR - PREVLINE) - of LINE) with NIL) - (SETQ LINE (fetch (LINEDESCRIPTOR PREVLINE) of LINE)) - (RETURN))) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE)) - (* Clear anything below us)) - (BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG) - WWIDTH - (IDIFFERENCE LOWESTY (fetch BOTTOM of WREG)) - 'TEXTURE - 'REPLACE WHITESHADE) - (SETQ YBOT WHEIGHT) - (while (AND PREVLINE (NEQ PREVLINE TOPLINE)) - do + (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress." T) + (RETURN)) + (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))) + NIL]) - (* Move down lines to be added, adjusting YBOT/YBASE and DISPALYLINE-ing them, - until the next line to do EQ TOPLINE) +(\TEDIT.SCROLLFLOAT + [LAMBDA (TEXTOBJ PANE DY) (* ; "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") - [replace (LINEDESCRIPTOR YBOT) of PREVLINE - with (COND - [(AND (fetch (LINEDESCRIPTOR PREVLINE) of PREVLINE) - (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of PREVLINE) - 0) - (fetch (FMTSPEC FMTBASETOBASE) of (fetch (LINEDESCRIPTOR - LFMTSPEC) - of PREVLINE))) - (SETQ YBOT (IDIFFERENCE (IPLUS YBOT (fetch (LINEDESCRIPTOR - DESCENT) - of (fetch ( - LINEDESCRIPTOR - PREVLINE) - of PREVLINE))) - (IPLUS (fetch (FMTSPEC FMTBASETOBASE) - of (fetch (LINEDESCRIPTOR LFMTSPEC - ) of PREVLINE)) - (fetch (LINEDESCRIPTOR DESCENT) - of PREVLINE] - (T (SETQ YBOT (IDIFFERENCE YBOT (fetch (LINEDESCRIPTOR LHEIGHT) - of PREVLINE] - (replace (LINEDESCRIPTOR YBASE) of PREVLINE - with (IPLUS (fetch (LINEDESCRIPTOR YBOT) of PREVLINE) - (fetch (LINEDESCRIPTOR DESCENT) of PREVLINE))) - (\DISPLAYLINE TEXTOBJ PREVLINE W) - (SETQ PREVLINE (fetch (LINEDESCRIPTOR NEXTLINE) of PREVLINE] - ((FLOATP DY) (* Do a thumbing-type scroll) - (SETQ CH# (IMAX (IMIN (SUB1 TEXTLEN) - (FIXR (FTIMES TEXTLEN DY))) - 1)) - (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINES)) - [while (AND LINE (ILESSP (fetch (LINEDESCRIPTOR CHARLIM) of LINE) - CH#)) do (SETQ LINE (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE)) - finally (COND - ((AND LINE (IGREATERP (fetch (LINEDESCRIPTOR CHAR1) of LINE) - CH#)) - (SETQ LINE NIL] (* find out if any line currently - formatted includes the target char) - (COND - ((AND LINE (fetch (LINEDESCRIPTOR NEXTLINE) of LINE) - (IGEQ (fetch (LINEDESCRIPTOR CHAR1) of LINE) - 1)) + (* ;; "Thumb scrolling, DY is FLOATP.") - (* If so, let's do this as a fast scroll, rather than a complete repaint of the - screen) + (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") + + (* ;; + "Does any currently formatted line include the target char? This will become the new top line") + + (SETQ NEWTOP (find L inlines (GETLD (fetch (TEXTWINDOW PLINES) of PANE) + NEXTLINE) suchthat (WITHINLINEP CH# L))) + (COND + (NEWTOP + + (* ;; + "If so, convert to an integer scroll so the screen is not blanked and reformatted unnecessarily") [SETQ DY (COND - [(ILEQ WHEIGHT (fetch (LINEDESCRIPTOR YBOT) of LINE)) - (* this line is off the top of the - window) - (IMINUS (for (DESCENDLINE _ (fetch (LINEDESCRIPTOR NEXTLINE) - of LINE)) - by (fetch (LINEDESCRIPTOR NEXTLINE) of DESCENDLINE) - while (AND DESCENDLINE (ILEQ WHEIGHT (fetch ( - LINEDESCRIPTOR - YBOT) - of DESCENDLINE))) + [(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") - (* sum the heights of all the lines in between the new top line and the present - top line) + (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") - (fetch (LINEDESCRIPTOR LHEIGHT) of DESCENDLINE] - (T (IDIFFERENCE (IDIFFERENCE WHEIGHT (fetch (LINEDESCRIPTOR YBOT) - of LINE)) - (fetch (LINEDESCRIPTOR LHEIGHT) of LINE] - (\TEDIT.SCROLLFN W 0 DY) + [SETQ NEWTOP (CADR (\FORMATBLOCK 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) - (* recurse telling to normally scroll instead of thumb scroll so that the screen - is not blanked and reformatted unnecessarily) + (* ;; + "Maybe replace the rest of this with \TEDIT.REPAINTFN ? \FILLPANE adds the dummy lines") - ) - (T [for LINE inside (fetch (SELECTION L1) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM - of WREG] - (* Make sure it thinks the old - selection is off-screen for now) - [for LINE inside (fetch (SELECTION LN) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 (fetch BOTTOM - of WREG] - (BITBLT NIL 0 0 W 0 (fetch BOTTOM of WREG) - WWIDTH - (IDIFFERENCE WHEIGHT (fetch BOTTOM of WREG)) - 'TEXTURE - 'REPLACE WHITESHADE) - (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT CH# W)) - (* Find the first line to go in the - window) - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE WHEIGHT - (fetch (LINEDESCRIPTOR - LHEIGHT) - of LINE))) - (* Set it up as the top line.) - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR - YBOT) of LINE) - (fetch (LINEDESCRIPTOR - DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE W) - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL W))) (* And fill out the window from there.) - )) - (AND POSTSCROLLFN (DOUSERFNS POSTSCROLLFN W)) (* For user subsystem cleanup) - [COND - ((fetch (SELECTION SET) of SEL) - (\FIXSEL SEL TEXTOBJ) - (AND SELWASON (\SHOWSEL SEL NIL T] - [COND - ((fetch (SELECTION SET) of (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ)) - (\FIXSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - TEXTOBJ) - (AND SHIFTEDSELWASON (\SHOWSEL (fetch (TEXTOBJ SHIFTEDSEL) of TEXTOBJ) - NIL T] - [COND - ((fetch (SELECTION SET) of (fetch (TEXTOBJ MOVESEL) of TEXTOBJ)) - (\FIXSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - TEXTOBJ) - (AND MOVESELWASON (\SHOWSEL (fetch (TEXTOBJ MOVESEL) of TEXTOBJ) - NIL T] - [COND - ((fetch (SELECTION SET) of (fetch (TEXTOBJ DELETESEL) of TEXTOBJ)) - (\FIXSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - TEXTOBJ) - (AND DELETESELWASON (\SHOWSEL (fetch (TEXTOBJ DELETESEL) of TEXTOBJ) - NIL T] - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ W)) + (\FILLPANE (fetch (TEXTWINDOW PLINES) of PANE) + TEXTOBJ PANE) + (\FIXSEL SEL TEXTOBJ NIL PANE) + (CL:WHEN (FGETSEL SEL ONFLG) - (* ;; "rmk: This makes scrolling for partially off-screen window work properly.") + (* ;; "Tell the selection that none of its hilighting is current onscreen (BLTSHADE above), then restore it. ") - (CL:UNLESS (LET [(WREG (WINDOWPROP W 'REGION] - (AND (IGEQ (FETCH (REGION BOTTOM) OF WREG) - 0) - (IGEQ (FETCH (REGION LEFT) OF WREG) - 0) - (ILEQ (FETCH (REGION PTOP) OF WREG) - SCREENHEIGHT) - (ILEQ (FETCH (REGION PRIGHT) OF WREG) - SCREENWIDTH))) - (\TEDIT.REPAINTFN W)) + (FSETSEL SEL ONFLG NIL) + (\SHOWSEL SEL T PANE))]) + +(\TEDIT.SCROLLUP + [LAMBDA (TEXTOBJ PANE DY) (* ; "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.") + + (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") + + (* ;; "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.") + + (RETURN)) + + (* ;; "") + + (SETQ WHERESEL (\TEDIT.WHERE.SEL TEXTOBJ OLDTOPLINE PANE)) + + (* ;; "") + + (* ;; "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.") + + [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 (\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 (\FORMATLINE TEXTOBJ (ADD1 (FGETLD L LCHARLIM] + (LINKLD L NEXT) (* ; + "So we find NEXT on the next iteration") + (\TEDIT.LINE.BOTTOM 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. ") + + (* ;; "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. ") + + (LINKLD PLINES NEWTOPLINE) (* ; + "Chop off lines above that are no longer visible") + + (* ;; "") + + (CL:UNLESS (IGEQ (GETLD NEWTOPLINE YBOT) + PBOTTOM) (* ; + "Not visible, SUB1 to display not quite at the top, then raise") + (\TEDIT.LINE.BOTTOM NEWTOPLINE) + (\DISPLAYLINE TEXTOBJ NEWTOPLINE PANE)) + + (* ;; "") + + (* ;; "Raise NEWTOPLINE so that its top is at PHEIGHT, and reposition all lines below. DELTA presumably is (or is close to) the original DY.") + + (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)) + + (* ;; "") + + (* ;; "The effective PBOTTOM is the bottom of the clipping region that is onscreen") + + (BITBLT PANE 0 PBOTTOM PANE 0 (IPLUS PBOTTOM DELTA) + (fetch WIDTH of PREG) + (FGETLD NEWTOPLINE YTOP) + 'INPUT + 'REPLACE) + (CL:WHEN LASTVISIBLE + + (* ;; "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.FORMATLINES LASTVISIBLE NIL PANE TEXTOBJ)) + (\TEDIT.SCROLL.SHOWSEL 'UP WHERESEL PANE TEXTOBJ LASTVISIBLE]) + +(\TEDIT.SCROLL.SHOWSEL + [LAMBDA (DIRECTION WHERESEL PANE TEXTOBJ VISIBLELINE) (* ; "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) + (\FIXSEL SEL TEXTOBJ NIL PANE) + (\SHOWSEL SEL T PANE) + else + (* ;; + "Old lines were visible and therefore highlighted, newly revealed lines may need to catch up. ") + + (FSETSEL SEL ONFLG T) + (\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))))]) + +(\TEDIT.SCROLLDOWN + [LAMBDA (TEXTOBJ PANE DY) (* ; "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.") + + (* ;; " ") + + (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))) + + (* ;; + "Look backwards from the line before OLDTOP. IMAX and HEIGHT+1 to scroll at least one line") + + (CL:WHEN (AND OLDTOPLINE (ILEQ (GETLD OLDTOPLINE LCHAR1) + 1)) + (RETURN)) + + (* ;; "") + + (SETQ NEWTOPLINE (if OLDTOPLINE + then (SETQ TOPOFOLD (FGETLD OLDTOPLINE YTOP)) + (\BACKFORMAT TEXTOBJ (IMAX DY (ADD1 (FGETLD OLDTOPLINE LHEIGHT))) + (SUB1 (FGETLD OLDTOPLINE LCHAR1)) + (FGETLD OLDTOPLINE LHEIGHT)) + else + + (* ;; "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. ") + + (\BACKFORMAT TEXTOBJ DY (FGETTOBJ TEXTOBJ TEXTLEN) + 0))) + (CL:UNLESS NEWTOPLINE (RETURN)) + (SETQ WHERESEL (\TEDIT.WHERE.SEL TEXTOBJ OLDTOPLINE PANE)) + + (* ;; "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. ") + + (SETQ LASTVISIBLE (\TEDIT.NCONC.LINES NEWTOPLINE OLDTOPLINE PHEIGHT PBOTTOM)) + (LINKLD PLINES NEWTOPLINE) + + (* ;; "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. ") + + (CL:UNLESS (\TEDIT.OFFSCREEN.SCROLL TEXTOBJ PANE 'VERTICAL) + (CL:WHEN (AND OLDTOPLINE (IGEQ (FGETLD OLDTOPLINE YBOT) + (FGETLD LASTVISIBLE YBOT))) + + (* ;; "The images for at least OLDTOPLINE and any lines below are currently in the bitmap. Move it down. ") + + (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)) + + (* ;; + "Display the new lines. No need to clear the rectangle first, \DISPLAYLINE fills the bitmap") + + (for L inlines NEWTOPLINE until (EQ L OLDTOPLINE) do (\DISPLAYLINE TEXTOBJ L PANE)) + (\TEDIT.SCROLL.SHOWSEL 'DOWN WHERESEL PANE TEXTOBJ OLDTOPLINE))) NIL]) + +(\TEDIT.OFFSCREEN.SCROLL + [LAMBDA (TEXTOBJ PANE DIRECTION) (* ; "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 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.") + + (CL:WHEN (EQMEMB DIRECTION (WINDOWPROP PANE 'OFFSCREEN)) + (LET (SEL WASON PREVLINE) + (SETQ SEL (FGETTOBJ TEXTOBJ SEL)) + (CL:WHEN (SETQ WASON (GETSEL SEL ONFLG)) + (\SHOWSEL SEL NIL)) (* ; + "Turn off the selection while we make changes") + + (* ;; "Find the precursor of the target top line.") + + [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) + (\FILLPANE PREVLINE TEXTOBJ PANE) + (CL:WHEN WASON + (\FIXSEL SEL TEXTOBJ) (* ; + "Account for any line shuffling and re-highlight") + (\SHOWSEL SEL T))) + T)]) + +(\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 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 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))) + + (* ;; + "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 is used to do incremental highlighting that avoids flickering with wheel-scroll spinning.") + + (LET (LASTVISIBLE) + + (* ;; + "Our search ends either when we run off PANE or we encounter the last line of the selection.") + + (* ;; "If we stop at the last SEL line, we will determine that the it is not BELOW") + + [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] + + (* ;; "(Don't put comment between ifs--they go into the CONS)") + + (CONS (if (ILESSP (FGETSEL SEL CH#) + (FGETLD TOPLINE LCHAR1)) + then + (* ;; "SEL begins above TOPLINE, the first visible line") + + 'ABOVE + elseif (IGREATERP (FGETSEL SEL CH#) + (FGETLD LASTVISIBLE LCHARLIM)) + then + (* ;; "") + + 'BELOW + else 'IN) + (if (ILESSP (SUB1 (FGETSEL SEL CHLIM)) + (FGETLD TOPLINE LCHAR1)) + then + (* ;; "SEL ends above TOPLINE (presumably SELBEGIN is also ABOVE)") + + 'ABOVE + elseif (IGREATERP (SUB1 (FGETSEL SEL CHLIM)) + (FGETLD LASTVISIBLE LCHARLIM)) + then + (* ;; "Not above, not displayed: must be below.") + + 'BELOW + else 'IN]) +) +(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") + + (* ;; "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.") + + (LET [VAL (PREG (DSPCLIPPINGREGION NIL PANE)) + (BORDER (OR 0 (WINDOWPROP PANE 'BORDER] + (SELECTQ PROP + (BOTTOM (SETQ VAL (fetch (REGION BOTTOM) of (fetch REG of PANE))) + (if (ILESSP VAL 0) + then (IPLUS BORDER (IDIFFERENCE (fetch BOTTOM of PREG) + VAL)) + else (fetch BOTTOM of PREG))) + (TOP (SETQ VAL (fetch (REGION TOP) of (fetch REG of PANE))) + (if (IGREATERP VAL SCREENHEIGHT) + then (IDIFFERENCE (IDIFFERENCE (fetch 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))) + (if (ILESSP VAL 0) + then (IPLUS (WINDOWPROP PANE 'BORDER) + (IDIFFERENCE (fetch LEFT of PREG) + VAL)) + else (fetch (REGION LEFT) of PREG))) + (RIGHT (SETQ VAL (fetch (REGION RIGHT) of (fetch REG of PANE))) + (if (IGREATERP VAL SCREENWIDTH) + then (IDIFFERENCE (IDIFFERENCE (fetch RIGHT of PREG) + (IDIFFERENCE VAL SCREENWIDTH)) + (WINDOWPROP PANE 'BORDER)) + else (fetch RIGHT of PREG))) + (SHOULDNT]) + +(\TEDIT.PANE.SCREENREGION + [LAMBDA (PANE) (* ; "Edited 19-Nov-2023 23:58 by rmk") + + (* ;; "For scrolling when the window is partially offscreen.") + + (* ;; "If the clipping region is entirely onscreen, this returns the clipping region.") + + (* ;; "If it is off the screen at the bottom or top, this returns the subregion of the clipping region that is actually onscreen.") + + (* ;; "This assumes that the clipping region is in the window's coordinate system.") + + (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") + + 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]) ) @@ -2250,30 +2649,28 @@ (DEFINEQ (\TEDIT.PROCIDLEFN - [LAMBDA (WINDOW) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (WINDOW) (* ; "Edited 25-Sep-2023 10:30 by rmk") + (* ; "Edited 19-Sep-2023 23:25 by rmk") + (* ; "Edited 30-May-91 23:35 by jds") - (* TEDIT's PROC.IDLEFN for regaining control. - If the shift key is down, we're not trying to restart this window, just to copy - from it.) + (* ;; "TEDIT's PROC.IDLEFN for regaining control. If the shift key is down, we're not trying to restart this window, just to copy from it.") (GETMOUSESTATE) (COND - [[AND (INSIDE? (DSPCLIPPINGREGION NIL WINDOW) + ([AND (INSIDE? (DSPCLIPPINGREGION NIL WINDOW) (LASTMOUSEX WINDOW) (LASTMOUSEY WINDOW)) [NOT (OR (SHIFTDOWNP 'SHIFT) (SHIFTDOWNP 'META) (KEYDOWNP 'MOVE) (KEYDOWNP 'COPY] - (PROCESSP (WINDOWPROP WINDOW 'PROCESS] (* No SHIFT key down; - let's regain control.) - (TTY.PROCESS (WINDOWPROP WINDOW 'PROCESS)) - (COND - ((fetch (TEXTOBJ MENUFLG) of (WINDOWPROP (WHICHW) - 'TEXTOBJ)) (* This is a MENU -- - always select.) - (\TEDIT.BUTTONEVENTFN WINDOW] - (T (* Otherwise, let him select.) + (PROCESSP (WINDOWPROP WINDOW 'PROCESS] + (TTY.PROCESS (WINDOWPROP WINDOW 'PROCESS)) (* ; + "No SHIFT key down; let's regain control.") + (CL:WHEN (GETTOBJ (WINDOWPROP WINDOW 'TEXTOBJ) + MENUFLG) (* ; "This is a MENU -- always select.") + (\TEDIT.MENU.BUTTONEVENTFN WINDOW))) + (T (* ; "Otherwise, let him select.") (\TEDIT.BUTTONEVENTFN WINDOW]) (\TEDIT.PROCENTRYFN @@ -2302,158 +2699,198 @@ (DEFINEQ -(\EDIT.DOWNCARET - [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:25 by jds") +(\TEDIT.DOWNCARET + [LAMBDA (CARET X Y) (* ; "Edited 26-Oct-2023 08:51 by rmk") + (* ; "Edited 13-Nov-87 08:25 by jds") (* ;; "Put the caret down -- i.e., MAKE IT VISIBLE -- as fast as possible") - (LET* ((DS (fetch (TEDITCARET TCCARETDS) of CARET)) - (X (DSPXPOSITION NIL DS)) - (Y (DSPYPOSITION NIL DS))) - (replace (TEDITCARET TCCARETX) of CARET with X) - (replace (TEDITCARET TCCARETY) of CARET with Y) - (replace (TEDITCARET TCFORCEUP) of CARET with NIL) - (\CARET.FLASH? DS (fetch (TEDITCARET TCCARET) of CARET) - 10 NIL X Y]) + (\DTEST CARET 'TEDITCARET) + (LET ((DS (ffetch (TEDITCARET TCCARETDS) of CARET))) + (freplace (TEDITCARET TCCARETX) of CARET with X) + (DSPXPOSITION X DS) + (freplace (TEDITCARET TCCARETY) of CARET with Y) + (DSPYPOSITION Y DS) + (freplace (TEDITCARET TCFORCEUP) of CARET with NIL) + (\CARET.FLASH? DS (ffetch (TEDITCARET TCCARET) of CARET) + 10 NIL X Y]) -(\EDIT.FLIPCARET - [LAMBDA (CARET FORCE) (* ; "Edited 30-Mar-87 16:50 by jds") - (* ; - "changes the caret from on to off or off to on.") +(\TEDIT.FLASHCARET + [LAMBDA (TEXTOBJ) (* ; "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") - (* ;; "(COND ((OR FORCE (fetch TCFORCEDDOWN of CARET) (AND (IGREATERP (CLOCK0 (fetch TCNOWTIME of CARET)) (fetch TCTHENTIME of CARET)) (NOT (fetch TCFORCEUP of CARET)))) (UNINTERRUPTABLY (* note the time of the next change.) (* must be done without creating boxes because happens during keyboard wait.) (\BOXIPLUS (CLOCK0 (fetch TCTHENTIME of CARET)) (fetch TCCARETRATE of CARET)) (* Set the time for the next caret transition) (replace TCUP of CARET with (NOT (fetch TCUP of CARET))) (* Invert the sense of the caret's UPness) (replace TCFORCEDDOWN of CARET with NIL) (* Turn off the force-down & Force-up flags) (replace TCFORCEUP of CARET with NIL) (PROG ((DS (fetch TCCARETDS of CARET)) (CURS (fetch TCCURSORBM of CARET))) (COND ((fetch TCUP of CARET)) (T (* We're putting the caret down -- set the new X,Y position) (replace TCCARETX of CARET with (DSPXPOSITION NIL DS)) (replace TCCARETY of CARET with (DSPYPOSITION NIL DS)))) (BITBLT (fetch (CURSOR CUIMAGE) of CURS) 0 0 DS (IDIFFERENCE (fetch TCCARETX of CARET) (fetch (CURSOR CUHOTSPOTX) of CURS)) (IDIFFERENCE (fetch TCCARETY of CARET) (fetch (CURSOR CUHOTSPOTY) of CURS)) CURSORWIDTH CURSORHEIGHT (QUOTE INPUT) (QUOTE INVERT))))))") + (* ;; + "Unless the caret is constrained to be INVISIBLE/UP, give it a chance to flash in every pane.") - NIL]) + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY) + [bind (FIRSTTIME _ T) for CARET in (FGETTOBJ TEXTOBJ CARET) unless (fetch (TEDITCARET + TCFORCEUP) + of CARET) + do (* ; + "The caret need not stay invisible.") + (if FIRSTTIME + then (SETQ FIRSTTIME NIL) + (\CARET.FLASH? (fetch (TEDITCARET TCCARETDS) of CARET) + (fetch (TEDITCARET TCCARET) of CARET) + NIL NIL (fetch (TEDITCARET TCCARETX) of CARET) + (fetch (TEDITCARET TCCARETY) of CARET)) + else (\CARET.FLASH.AGAIN (fetch (TEDITCARET TCCARET) of CARET) + (fetch (TEDITCARET TCCARETDS) of CARET) + (fetch (TEDITCARET TCCARETX) of CARET) + (fetch (TEDITCARET TCCARETY) of CARET])]) -(TEDIT.FLASHCARET - [LAMBDA (CARETS) (* jds "16-Jul-85 12:35") - (* Unless the caret is constrained to - be INVISIBLE, give it a chance to - flash.) - (bind (FIRSTTIME _ T) for CARET inside CARETS - do (COND - ((NOT (fetch TCFORCEUP of CARET)) (* The caret need not stay invisible.) - (* (\EDIT.FLIPCARET CARET)) - (COND - (FIRSTTIME (SETQ FIRSTTIME NIL) - (\CARET.FLASH? (fetch TCCARETDS of CARET) - (fetch TCCARET of CARET) - NIL NIL (fetch TCCARETX of CARET) - (fetch TCCARETY of CARET))) - (T (\CARET.FLASH.AGAIN (fetch TCCARET of CARET) - (fetch TCCARETDS of CARET) - (fetch TCCARETX of CARET) - (fetch TCCARETY of CARET]) +(\TEDIT.UPCARET + [LAMBDA (CARET X Y) (* ; "Edited 26-Oct-2023 08:49 by rmk") + (* ; "Edited 12-Oct-2023 00:06 by rmk") + (* ; "Edited 13-Nov-87 08:27 by jds") -(\EDIT.UPCARET - [LAMBDA (CARET) (* ; "Edited 13-Nov-87 08:27 by jds") - - (* ;; "Take the caret up -- i.e., MAKE IT INVISIBLE -- and keep it up") + (* ;; "Take the caret up -- i.e., MAKE IT INVISIBLE -- and keep it up. Tedit and the system seem to have opposite notions of up and down. System thinks that caret is %"down%" when it is off the screen, Tedit thinks it is up.") (\CARET.DOWN (fetch (TEDITCARET TCCARETDS) of CARET)) (* ;; "The TCFORCEUP field is set so that the caret will stay off-screen:") - (replace (TEDITCARET TCFORCEUP) of CARET with T]) + (replace (TEDITCARET TCFORCEUP) of CARET with T) + (CL:WHEN X + (freplace (TEDITCARET TCCARETY) of CARET with X) + (DSPXPOSITION X (ffetch (TEDITCARET TCCARETDS) of CARET)) + (freplace (TEDITCARET TCCARETY) of CARET with Y) + (DSPYPOSITION Y (ffetch (TEDITCARET TCCARETDS) of CARET)))]) (TEDIT.NORMALIZECARET - [LAMBDA (TEXTOBJ SEL) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (TEXTOBJ SEL EVEN.IF.VISIBLE) (* ; "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") + (* ; "Edited 11-May-2023 00:39 by rmk") + (* ; "Edited 30-May-91 23:35 by jds") - (* ;; "Scroll the text window so that the caret is visible in it.") + (* ;; "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.") (SETQ TEXTOBJ (TEXTOBJ TEXTOBJ)) - (PROG* ((SEL (OR SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))) - [WINDOW (OR (fetch (TEXTOBJ SELWINDOW) of TEXTOBJ) - (CAR (fetch (TEXTOBJ \WINDOW) of TEXTOBJ] - (WREG (AND WINDOW (DSPCLIPPINGREGION NIL WINDOW))) - (WHEIGHT (AND WREG (fetch PTOP of WREG))) - (WBOTTOM (AND WREG (fetch BOTTOM of WREG))) - (SELWASON (fetch (SELECTION ONFLG) of SEL)) - CH# Y LINE) - (OR WINDOW (RETURN)) - (OR (fetch (SELECTION SET) of SEL) - (RETURN)) (* ; - "If there is no selection set, don't bother.") - (COND - (SELWASON (* ; - "The selection is hilited, so turn it off.") - (\SHOWSEL SEL NIL NIL))) - (for WW inside (fetch (TEXTOBJ \WINDOW) of TEXTOBJ) as L1 inside (fetch (SELECTION L1) - of SEL) as LN - inside (fetch (SELECTION LN) of SEL) when (EQ WW WINDOW) - do - (* ;; "Get to the line info for the SELWINDOW. (failing that, the main/only edit window) Use that info to decide where the caret is.") + (CL:UNLESS (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE) + (CL:UNLESS SEL + (SETQ SEL (FGETTOBJ TEXTOBJ SEL))) + (\DTEST SEL 'SELECTION) + (CL:WHEN (FGETSEL SEL SET) (* ; + "If the selection isn't set, don't bother.") - (SELECTQ (fetch (SELECTION POINT) of SEL) - (LEFT (* ; - "The caret is at the left end of the selection; hunt for the first selected character") - (SETQ CH# (fetch (SELECTION CH#) of SEL)) - (SETQ Y (OR (AND L1 (fetch (LINEDESCRIPTOR YBOT) of L1)) - (fetch (SELECTION Y0) of SEL)))) - (RIGHT (* ; - "The caret is at the right end of the selection; hunt for the last selected character") - (SETQ CH# (SUB1 (fetch (SELECTION CHLIM) of SEL))) - (SETQ Y (OR (AND LN (fetch (LINEDESCRIPTOR YBOT) of LN)) - (fetch (SELECTION YLIM) of SEL)))) - NIL)) - (COND - ((AND (OR (IGEQ Y WHEIGHT) - (ILESSP Y WBOTTOM)) - (NOT (fetch (TEXTOBJ TXTNEEDSUPDATE) of TEXTOBJ))) - (* ; - "The caret is off-screen. Scroll to get it on") - (for LINE inside (fetch (SELECTION L1) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 WBOTTOM))) - (* ; - "Make sure it thinks the old selection is off-screen for now") - (for LINE inside (fetch (SELECTION LN) of SEL) when LINE - do (replace (LINEDESCRIPTOR YBOT) of LINE with (SUB1 WBOTTOM))) - (SETQ LINE (\TEDIT.FIND.FIRST.LINE TEXTOBJ WHEIGHT (IMAX 1 (IMIN CH# - (fetch (TEXTOBJ - TEXTLEN) - of TEXTOBJ))) - WINDOW)) (* ; - "Find the first line to go in the window") - (replace (LINEDESCRIPTOR YBOT) of LINE with (IDIFFERENCE WHEIGHT (fetch ( - LINEDESCRIPTOR - LHEIGHT) - of LINE))) - (* ; "Set it up as the top line.") - (replace (LINEDESCRIPTOR YBASE) of LINE with (IPLUS (fetch (LINEDESCRIPTOR YBOT) - of LINE) - (fetch (LINEDESCRIPTOR DESCENT) - of LINE))) - (\DISPLAYLINE TEXTOBJ LINE WINDOW) - (\FILLWINDOW (fetch (LINEDESCRIPTOR YBOT) of LINE) - LINE TEXTOBJ NIL WINDOW) (* ; + (* ;; "This is essentially %"find selpane in panes%" and the corresponding L1/LN in SEL. SELPANE is the pane of the last selection") + + (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. ") + + (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.") + + (\SHOWSEL SEL NIL SELPANE) + (SETQ TOPLINE (CADR (\FORMATBLOCK TEXTOBJ (SUB1 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) + (\DISPLAYLINE TEXTOBJ TOPLINE SELPANE) + (\FILLPANE TOPLINE TEXTOBJ SELPANE) (* ;  "And fill out the window from there.") - (\FIXSEL SEL TEXTOBJ) - (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ WINDOW))) - (COND - (SELWASON (* ; - "The selection is hilited, so turn it back on.") - (\SHOWSEL SEL NIL T]) + (\FIXSEL SEL TEXTOBJ NIL SELPANE) + (\TEDIT.SET.WINDOW.EXTENT TEXTOBJ SELPANE) + (\SHOWSEL SEL T SELPANE)) + (RETURN))))]) -(\SETCARET - [LAMBDA (X Y DS TEXTOBJ CARET) (* ; "Edited 30-May-91 23:35 by jds") - (PROG ((CLIPREGION (DSPCLIPPINGREGION NIL DS))) - (COND - [(AND (ILESSP Y (fetch PTOP of CLIPREGION)) - (IGEQ Y (fetch BOTTOM of CLIPREGION))) - (MOVETO X Y DS) - (COND - ((NOT (fetch (TEXTOBJ TXTREADONLY) of TEXTOBJ)) - (\EDIT.DOWNCARET CARET] - (T +(\TEDIT.SETCARET + [LAMBDA (SEL PANE TEXTOBJ DISPOSITION CARET) (* ; "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") - (* The caret is off screen. Do a MOVETO so the system carets don't appear at odd - times.) + (* ;; "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. ") - (MOVETO (IPLUS (fetch PTOP of CLIPREGION) - 12) - 0 DS))) (* Only put down the caret the line it - points to is on-screen) - ]) + (* ;; "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") + + (\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.CARET [LAMBDA (CARETS) (* jds "12-Jul-85 11:18") @@ -2503,16 +2940,23 @@ (UPDATE/MENU/IMAGE MENU]) (TEDIT.DEFAULT.MENUFN - [LAMBDA (W) (* ; "Edited 30-May-91 23:35 by jds") + [LAMBDA (W) (* ; "Edited 29-Feb-2024 17:02 by rmk") + (* ; "Edited 27-Feb-2024 07:55 by rmk") + (* ; "Edited 22-Sep-2023 20:14 by rmk") + (* ; "Edited 19-Sep-2023 11:55 by rmk") + (* ; "Edited 16-Sep-2023 22:16 by rmk") + (* ; "Edited 6-May-2023 17:28 by rmk") + (* ; "Edited 30-May-91 23:35 by jds") (* ;;  "Default MENU Fn for editor windows--displays a menu of items & acts on the commands received.") (PROG ((TEXTOBJ (WINDOWPROP W 'TEXTOBJ)) (WMENU (WINDOWPROP W 'TEDIT.MENU)) - THISMENU CH OFILE OCURSOR PCTB LINES SEL ITEM) + THISMENU CH OFILE OCURSOR LINES SEL ITEM) + (\DTEST TEXTOBJ 'TEXTOBJ) (COND - ((EQ (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + ((EQ (FGETTOBJ TEXTOBJ EDITOPACTIVE) T) (* ;; @@ -2520,15 +2964,14 @@ (TEDIT.PROMPTPRINT TEXTOBJ "Edit operation in progress; please wait." T) (RETURN)) - ((fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + ((FGETTOBJ TEXTOBJ EDITOPACTIVE) (* ;; "We know specifically what's happening. Tell him:") - (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (fetch (TEXTOBJ EDITOPACTIVE) of TEXTOBJ) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (FGETTOBJ TEXTOBJ EDITOPACTIVE) " in progress; please wait.") T) (RETURN))) - (SETQ PCTB (fetch (TEXTOBJ PCTB) of TEXTOBJ)) (SETQ THISMENU (COND (WMENU) ((SETQ WMENU (WINDOWPROP W 'TEDIT.MENU.COMMANDS)) @@ -2539,20 +2982,16 @@ (ERSETQ (RESETLST [RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ) '(AND (\TEDIT.MARKINACTIVE OLDVALUE] - (replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with (OR (CAR ITEM) - T)) - (* ; + (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 (TEXTPROP TEXTOBJ 'CLEARPUT))) + (TEDIT.PUT TEXTOBJ NIL NIL (GETTEXTPROP TEXTOBJ 'CLEARPUT))) (Plain-Text (TEDIT.PUT TEXTOBJ NIL NIL T)) - (Old-Format (* ; - "Write out the file in the OLD TEdit format.") - (TEDIT.PUT TEXTOBJ NIL NIL NIL T)) ((Get |Get Formatted Document|) (* ;  "Get a new file (overwriting the one being edited.)") - (TEDIT.GET TEXTOBJ NIL (TEXTPROP TEXTOBJ 'CLEARGET))) + (TEDIT.GET TEXTOBJ NIL (GETTEXTPROP TEXTOBJ 'CLEARGET))) (Unformatted% Get (TEDIT.GET TEXTOBJ NIL T)) (Include (* ; "Insert a file where the caret is") @@ -2562,47 +3001,38 @@ (Substitute (* ; "Search-and-replace") (RESETLST (RESETSAVE (CURSOR WAITINGCURSOR)) - (TEDIT.SUBSTITUTE (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))) + (TEDIT.SUBSTITUTE TEXTOBJ))) (Find (* ;  "Case sensitive search, with * and # wildcards") [SETQ OFILE (TEDIT.GETINPUT TEXTOBJ "Text to find: " - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING) - (CHARCODE (EOL LF ESC] - [COND - (OFILE (SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)) - (\SHOWSEL SEL NIL 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.") - (replace (SELECTION CH#) of SEL with (CAR CH)) + (\TEDIT.GET.TARGET.STRING TEXTOBJ + 'TEDIT.LAST.FIND.STRING] + (CL:WHEN OFILE + (SETQ SEL (TEXTSEL TEXTOBJ)) + (\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") - (replace (SELECTION CHLIM) of SEL - with (ADD1 (CADR CH))) - [replace (SELECTION DCH) of SEL - with (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH] - (replace (SELECTION POINT) of SEL - with 'RIGHT) - (replace (TEXTOBJ CARETLOOKS) of TEXTOBJ - with (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) + (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) (* ; "And never pending a deletion.") - (\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\SHOWSEL SEL NIL T) - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING OFILE) - (* ; "And get it into the window") - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") - (\SHOWSEL SEL NIL T] - (replace (TEXTOBJ \INSERTPCVALID) of TEXTOBJ with NIL) - (* ; - "Doing a FIND invalidates the insertion-piece cahce? I don't understand this. Check it.") - ) + (\FIXSEL SEL TEXTOBJ) + (TEDIT.NORMALIZECARET TEXTOBJ) + (\SHOWSEL SEL T) (* ; "And get it into the TEXTOBJ") + (PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING OFILE)) + (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") + (\SHOWSEL SEL T))))) (Looks (* ;  "He wants to set the font for the current selection") (\TEDIT.LOOKS TEXTOBJ)) @@ -2621,14 +3051,13 @@  "Open the paragraph formatting menu") (\TEDIT.EXPANDEDPARA.MENU TEXTOBJ)) (Page% Layout (* ; "Open the page-layout menu") - (\TEXTMENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) + (\TEDIT.MENU.START (COPYTEXTSTREAM TEDIT.EXPANDED.PAGEMENU T) (\TEDIT.PRIMARYW TEXTOBJ) - "Page Layout Menu" 150)) - (COND - ((CAR ITEM) (* ; - "This is a user-supplied entry. Get the function, and apply it to the TEXTSTREAM for him") + "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])]) + (fetch (TEXTOBJ STREAMHINT) of TEXTOBJ)))])]) (TEDIT.REMOVE.MENUITEM [LAMBDA (MENU ITEM) (* gbn "26-Apr-84 04:06") @@ -2662,7 +3091,8 @@ WHENSELECTEDFN _ '\TEDIT.MENU.WHENSELECTEDFN]) (\TEDIT.MENU.WHENHELDFN - [LAMBDA (ITEM MENU BUTTON) (* jds "10-Apr-84 15:14") + [LAMBDA (ITEM MENU BUTTON) (* ; "Edited 4-Oct-2022 09:17 by rmk") + (* jds "10-Apr-84 15:14") (COND ((ATOM ITEM) (CLRPROMPT) @@ -2673,7 +3103,8 @@ (Find "Searches for a string") (Quit "Ends the edit session") (Hardcopy "Formats and sends the file to a printer.") - (Press% File "Creates a PRESS or INTERPRESS file of the document.") + (Hardcopy% File + "Creates a hardcopy-format file of the document.") ""))) (T (DEFAULTMENUHELDFN ITEM]) @@ -2692,7 +3123,7 @@ (DECLARE%: DONTEVAL@LOAD DOCOPY (RPAQ TEDIT.DEFAULT.MENU - [\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text Old-Format)) + [\TEDIT.CREATEMENU '((Put 'Put NIL (SUBITEMS |Put Formatted Document| Plain-Text)) (Get 'Get NIL (SUBITEMS |Get Formatted Document| Unformatted% Get)) Include Find Looks Substitute Quit (Expanded% Menu 'Expanded% Menu NIL (SUBITEMS Expanded% Menu @@ -2711,7 +3142,7 @@ -(* ; "titled icon info") +(* ; "titled icon info, ") (FILESLOAD ICONW) @@ -2724,30 +3155,38 @@ (RPAQ? TEDIT.ICON.FONT (FONTCREATE 'HELVETICA 8 'BOLD)) -(RPAQ? TEDIT.ICON.TITLE.REGION [CONS 16 (CONS 4 (CONS 64 (CONS 77 NIL]) +(RPAQ? TEDIT.ICON.TITLE.REGION (CREATEREGION 16 4 64 77)) -(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (CONS TEDITICON (CONS TEDITMASK (CONS TEDIT.ICON.TITLE.REGION NIL)) - )) +(RPAQ? TEDIT.TITLED.ICON.TEMPLATE (create TITLEDICON ICON _ TEDITICON MASK _ TEDITMASK TITLEREG _ + TEDIT.ICON.TITLE.REGION)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7098 90034 (TEDIT.CREATEW 7108 . 9881) (\TEDIT.CREATEW.FROM.REGION 9883 . 10863) ( -TEDIT.CURSORMOVEDFN 10865 . 20764) (TEDIT.CURSOROUTFN 20766 . 21309) (TEDIT.WINDOW.SETUP 21311 . 23136 -) (TEDIT.MINIMAL.WINDOW.SETUP 23138 . 30916) (\TEDIT.ACTIVE.WINDOWP 30918 . 31911) ( -\TEDIT.BUTTONEVENTFN 31913 . 55621) (\TEDIT.WINDOW.OPS 55623 . 58835) (\TEDIT.EXPANDFN 58837 . 59400) -(\TEDIT.MAINW 59402 . 60699) (\TEDIT.PRIMARYW 60701 . 61862) (\TEDIT.COPYINSERTFN 61864 . 62660) ( -\TEDIT.NEWREGIONFN 62662 . 65178) (\TEDIT.SET.WINDOW.EXTENT 65180 . 70723) (\TEDIT.SHRINK.ICONCREATE -70725 . 72926) (\TEDIT.SHRINKFN 72928 . 73487) (\TEDIT.SPLITW 73489 . 78954) (\TEDIT.UNSPLITW 78956 . -83812) (\TEDIT.WINDOW.SETUP 83814 . 89637) (\SAFE.FIRST 89639 . 90032)) (91364 92275 (TEDITWINDOWP -91374 . 92273)) (92312 95102 (TEDIT.GETINPUT 92322 . 94382) (\TEDIT.MAKEFILENAME 94384 . 95100)) ( -95151 101579 (TEDIT.PROMPTPRINT 95161 . 98096) (TEDIT.PROMPTFLASH 98098 . 100007) ( -\TEDIT.PROMPT.PAGEFULLFN 100009 . 101577)) (101814 105786 (TEXTSTREAM.TITLE 101824 . 102449) ( -\TEDIT.ORIGINAL.WINDOW.TITLE 102451 . 104373) (\TEDIT.WINDOW.TITLE 104375 . 105029) ( -\TEXTSTREAM.FILENAME 105031 . 105784)) (105829 147611 (TEDIT.DEACTIVATE.WINDOW 105839 . 113108) ( -\TEDIT.REPAINTFN 113110 . 115958) (\TEDIT.RESHAPEFN 115960 . 120804) (\TEDIT.SCROLLFN 120806 . 147609) -) (147653 149784 (\TEDIT.PROCIDLEFN 147663 . 148958) (\TEDIT.PROCENTRYFN 148960 . 149405) ( -\TEDIT.PROCEXITFN 149407 . 149782)) (149863 160829 (\EDIT.DOWNCARET 149873 . 150542) (\EDIT.FLIPCARET -150544 . 152063) (TEDIT.FLASHCARET 152065 . 153346) (\EDIT.UPCARET 153348 . 153773) ( -TEDIT.NORMALIZECARET 153775 . 159472) (\SETCARET 159474 . 160402) (\TEDIT.CARET 160404 . 160827)) ( -160863 174657 (TEDIT.ADD.MENUITEM 160873 . 163164) (TEDIT.DEFAULT.MENUFN 163166 . 172136) ( -TEDIT.REMOVE.MENUITEM 172138 . 173135) (\TEDIT.CREATEMENU 173137 . 173574) (\TEDIT.MENU.WHENHELDFN -173576 . 174342) (\TEDIT.MENU.WHENSELECTEDFN 174344 . 174655))))) + (FILEMAP (NIL (12950 32526 (\TEDIT.CREATEW 12960 . 19335) (\TEDIT.WINDOW.SETUP 19337 . 22026) ( +\TEDIT.MINIMAL.WINDOW.SETUP 22028 . 30449) (\TEDIT.ADD.CARET 30451 . 31915) (\TEDIT.CLEARPANE 31917 . +32524)) (32527 53583 (\TEDIT.CURSORMOVEDFN 32537 . 36345) (\TEDIT.CURSOROUTFN 36347 . 36792) ( +\TEDIT.ACTIVE.WINDOWP 36794 . 37920) (\TEDIT.EXPANDFN 37922 . 38485) (\TEDIT.MAINW 38487 . 40627) ( +\TEDIT.PRIMARYW 40629 . 41269) (\TEDIT.NEWREGIONFN 41271 . 43787) (\TEDIT.SET.WINDOW.EXTENT 43789 . +48652) (\TEDIT.SHRINK.ICONCREATE 48654 . 51077) (\TEDIT.SHRINKFN 51079 . 51488) (\TEDIT.PANEREGION +51490 . 53581)) (53584 77349 (\TEDIT.BUTTONEVENTFN 53594 . 68649) (\TEDIT.DO.SELOPERATION 68651 . +70933) (\TEDIT.TTY.TEXTOBJP 70935 . 71359) (\TEDIT.BUTTONEVENTFN.SELOPERATION 71361 . 72750) ( +\TEDIT.BUTTONEVENTFN.INACTIVE 72752 . 74778) (\TEDIT.BUTTONEVENTFN.INTITLE 74780 . 76299) ( +\TEDIT.COPYINSERT 76301 . 77347)) (77384 92113 (\TEDIT.PANE.SPLIT 77394 . 81614) (\TEDIT.SPLITW 81616 + . 87949) (\TEDIT.UNSPLITW 87951 . 92111)) (93469 94254 (TEDITWINDOWP 93479 . 94252)) (94291 97279 ( +TEDIT.GETINPUT 94301 . 96744) (\TEDIT.MAKEFILENAME 96746 . 97277)) (97328 104978 (TEDIT.PROMPTPRINT +97338 . 99774) (TEDIT.PROMPTCLEAR 99776 . 101495) (TEDIT.PROMPTFLASH 101497 . 103406) ( +\TEDIT.PROMPT.PAGEFULLFN 103408 . 104976)) (105216 113095 (\TEXTSTREAM.TITLE 105226 . 105916) ( +\TEDIT.DEFAULT.TITLE 105918 . 108297) (\TEDIT.WINDOW.TITLE 108299 . 110356) (\TEXTSTREAM.FILENAME +110358 . 112028) (\TEDIT.UPDATE.TITLE 112030 . 113093)) (113138 128179 (TEDIT.DEACTIVATE.WINDOW 113148 + . 119570) (\TEDIT.REPAINTFN 119572 . 121147) (\TEDIT.AFTERMOVEFN 121149 . 121903) (OFFSCREENP 121905 + . 123110) (\TEDIT.RESHAPEFN 123112 . 127001) (\TEDIT.PANEWITHINSCREEN? 127003 . 128177)) (128180 +155813 (\TEDIT.SCROLLFN 128190 . 129877) (\TEDIT.SCROLLFLOAT 129879 . 134465) (\TEDIT.SCROLLUP 134467 + . 141843) (\TEDIT.SCROLL.SHOWSEL 141845 . 144469) (\TEDIT.SCROLLDOWN 144471 . 149687) ( +\TEDIT.OFFSCREEN.SCROLL 149689 . 151804) (\TEDIT.WHERE.SEL 151806 . 153026) (\TEDIT.WHERE.SEL1 153028 + . 155811)) (155814 160936 (\TEDIT.ONSCREEN 155824 . 157279) (\TEDIT.ONSCREEN? 157281 . 159594) ( +\TEDIT.PANE.SCREENREGION 159596 . 160934)) (160978 163223 (\TEDIT.PROCIDLEFN 160988 . 162397) ( +\TEDIT.PROCENTRYFN 162399 . 162844) (\TEDIT.PROCEXITFN 162846 . 163221)) (163302 176029 ( +\TEDIT.DOWNCARET 163312 . 164105) (\TEDIT.FLASHCARET 164107 . 165924) (\TEDIT.UPCARET 165926 . 167030) + (TEDIT.NORMALIZECARET 167032 . 171760) (\TEDIT.SETCARET 171762 . 175602) (\TEDIT.CARET 175604 . +176027)) (176063 189309 (TEDIT.ADD.MENUITEM 176073 . 178364) (TEDIT.DEFAULT.MENUFN 178366 . 186649) ( +TEDIT.REMOVE.MENUITEM 186651 . 187648) (\TEDIT.CREATEMENU 187650 . 188087) (\TEDIT.MENU.WHENHELDFN +188089 . 188994) (\TEDIT.MENU.WHENSELECTEDFN 188996 . 189307))))) STOP diff --git a/library/tedit/TEDIT-WINDOW.LCOM b/library/tedit/TEDIT-WINDOW.LCOM index 192e965ad1372ce75c03f8ca71d31f2ebc40cfb0..eb1d02a0b97d1351104eef127ec282890ab112d8 100644 GIT binary patch literal 57794 zcmeIb33Oc7c_vs@pePEKpaNK;Ac&@(AjtyR0*qP!khCLJ6;NPRp{gE)Di8!o8Kzi} z3JaGZDKCk8BF9TINqVt5mTbq%NZzv8>0*JHX{|NsPWPnL=h!(D`wW>rJ(KuM+TF99 z1|~Uure}`L`TqaE_r3dG6|^MoK4;EYHc{{0ci(+?`S<_7{~emjOy^3O;ptoiY7>A3c9oU97J>dFjlhk3V{4xw>-YQM8_`3@_wLQ})8h2Vw`&O4R$Q z(W7IdgVq)L()zt9k})c5EOqc<`+TGESI(4{vXckLt&EkJYtc6PEM8!_$ zadX&0r)KBu;%o(X6V|M(4z9;70t#G=S#z0VIlF|*1Zq=N{H2!S>PcmBmMX@qO0L4M zM6KCuCU-1LZH{6#ca#Pz5pA3bP=e(^nlKv(Lv0RCI;{gvC2 zeARd$`81Vu)1Rfj&2v)R8rr-q%?}=aCF@q$>`qqW$*pT$$y3?g^hWEE59PmIP4nAk z#nV-OX=~%js(dC^Sn6@x357zz`gE%=#1H>oHP{>Mwj+GAH`KMcef8!qdA|B#`qpOG z8vpW#|G4|lxcbY|-{-Cd{&%_he6sdrp!t~@e)_~_*RNa+e0LAM-n>A6KTLnPyUm%+ zTm41;`%>dke-Sspjkh&e;$q_qM%{HQw{BgZ!4d=lPXvo0{Gb2HpU?pQTM9Q(7@~i{ z)!dCA^f!z7S~Y#gE%Xk?RGdlj>rGiPJG|Mo!UcBE#$-Xw_fcaxgWR8`o{fi+JI^M! zu+-C(^|X5;1-qyEyVb6*S3g%92rl(-8;xPR$7q5U*x^y@SVlED zU(U=)>9|wL0u7-WCPaK)hjarE#(GD#p#(}+_t|!Ju89~e71jB@* zQ^N|A6ChfeIK&T6P;2T*d?EpSMIUokd^`?x&6T27d@ODe6)vTU87rO`*TtADT{ntZ zkh-IoLB5I|CUQaV$1qrRmB5D!GzCO(VsU(WE|vCnE(W$Ey#YyyCY)i%Mkg$xD!FMj zOVNoV)OTl=qT{1_vF1zV*+QhRh{jiuJa5G-mO<5Vq<#!(L5IO2r?w+B)_ zG7HvD3o%`?#tvgnjoS&DViSN8AjgXEj-g9t`y<`Ogf(TC9U6gmB15bn=t|ct^(k&;_-1vH~4=XjSgB*UATn5F+jwi z_0g5{)e9fBE-gR3a^XA*(XYV@30Sxu8?y#y*O$*+UbZe@Tt2(<)W@we76c+i!qkX_ zbSbd_SYCh>$qc-lDd0D16*HxI^q-i#$-fhj3FgWbt_}iWrKSo0Q+Ro2-cFAXT7mC^ zMck6CPHuf!c#^QEBr{53_==bJ#&+fY8IkNS2yxEU@5wdxt7|6Iin-L(4Y!m{PVw!j zY;uw>6z?B6S*=Y%7T~gcmamy189sc(DJ^7DGI56?6M3jMA&sYi zkyk(mlq8!e%mO~5Q5U@@G}O|nS)kg|8@d~rw2Q@5X{v0ELE>V7=SqnLFEJ2Meq%93 z1_|^aCl1o8{erW+E&z4pfes+qg(-Tm%&?^3Cu-sAUNCxRfFrO9q3|oa0)bs7r1VC+ zvL7Z8xv!f1UZ7bUi0sNHzn2#n5wMW!6fe76XN~LCYPHHxAY}|et-#{>U%r`RxhuQI zMZriZTNN3yBtHQzkIb@Qk!{U#?bYgfb^Xp7$w#_K!Scz*-^u1f!90me*CX$1X7h9% zyngQH^~i&`3k4%XR2Vr_pUBqa+qh}!Yk967P$Sfaa~nh(GB)mxF~0wd_cC_}Hum~^ z@@~4e!i(W=LGDFlHU`IY{x|-fyshYoTBglg-3e=ETYaaJ)tRl0_cp6t&*N(U#@=Rj za`VoaWNm=oj`StNGy9X1Gy6jW_cUkf+mIU}YMm}k+NH^uH4ZHGV({2uLnLrTKyXfh zanKD$mNAGHz7im+uPxA?4&r3{H-W|W^fWkLCR2jub_A@~Lsk-?Jl>BbNKEtAfw<-? ziTmkQ0+h%r03|>Xy)DPVw|phUOg-OX;lNu05yn>sgZGt?QtNpu2G;H?nTUY~%}y3_ zv$MIFq zam=W23N7{$$AH8+4*8fR6?H#`zDY$->0!-(Jf&CyHR{X>u!t#=V4<+MH;{@{g>n{3 z!wgjb&vI`ti=GN2IYKv?)G_cex}}$5QRi|r;i3RAAg&t#vQ6fu3K>*S05t_NGo{Mh zB9%DobSjgYtmKZvR-;rtJc~kovCI6Xt7|ZyEZWDp7!sK09ss5K4MR%`W;yx>24mdC z9BBdQYO{Es07rIjMx(loQf5Kc8Lh;z0G@k*g7c|zHZ@EAi9`LI%Q$zCE>x9lYHn)M zo?Rp>57iq_SpFiYeX_vL1Jr}OYTiPHQw^r)D;2v0O^b&Z2g)!YOEG-`E7Q4Zblmd2 zJnD>Oa(=FC&)M@dZE@(9=6%c%sJI%f0f82&o>Eblkfx}mbb^0c2w-N+GO!Q2hnCSD z7?4)fo0uY9VNAp?Wy4AU=Kxcga@m4X^@&|wBn6Si{lF(+J`?zYWaWtAuAu0MPLq{X zj%06;JQk)M*^7;3)E-;P^!KM>xl5lAVRITLz0-UNiUV0Yc-x*(pexmrt2EaUN^7g z(_4)bGaY*HTD5@BtFOOaEk+{vX8V`lsForj>H^F|Rak}s%^70KD_3vcGZVUc^UfON z_!!h{nV%6&gn{*5vKl2gRty|`*;^eH)Ki<}Z$JpvnbCu%UadA@t5Y%XU9TKW5c<+X zcOBrEbaVp+90XjMV*&?h8%QQbQ-TR7R$)=(fQ z(xLjx1LTQdXAuqq0A-;S z;QF|@y}w!btwL+p=6mw3L-M63vfGXKE2uX*GAI548fh?Tv4jHvjQT{W~%c zqpoxZLn%s=H~JX~pckqMjlo!_E~8^?KobhZGH4V8Og#k8hUk%-$~@M?^GoVLx?fj}TAi)_FZ!-0Z8{vmsXp&9T@LoyU( z=^j#42c}r=3Jj}mmz+zpODy_m!Dm*xkW6C`M0${)$3cFAM#nbqGj6W+88^a5f`M#x zW$SY*;cNFQ6U}IC>)M@y!L1Rlgt5S0h9M9~g;xr4gGUAiVbb#nE13gbj%Ec*T6-bH z+O|Rr7zp6BCCw_H4$Ck-Pvy*g_~Gjb0tm>y62$bb)($|6~MSzaJ@z%w}C z{lV^1u3(4`MMy4=M=x#_nXEF55;dg@a<5^Xq~qw%5tvVOfBL{7vc30r<*JSM8QfTC z8B@wro4fMiEMIQ?s~M~Wgz#dfn6@C}w9Ox|S4|$KB|c_x=h(e#P7@RwXfund*WS+E z?M{|hSo*YEhdynz&RU7qQ5;@rioc2##jVAuOretEi8-M!#iS{8geK~t2kdFmV{(;D zktR&*!pvnMG(u0DwMj;#?!xSsnc`ba=RBsfEA?VB+?(u51(U%WCsUzh=*Fql{PuTJ z$>6$`-+nRw_t&l8z|FZo&u@P&|H*TIe!aiBIz!Jx>(dno6w>Q7}7ugTZH2SkMt^TEbkPr85Ki9PP zK~$V+1wNg{Z(%6{&tUcj82eo%`uVaQS-Y{+hX>(i{b<3C+{pf!-BY?zUE6-Kx%R&? zdBP(bE=WAGdv3HnrMG1$t9IX-9o~M)4nMoL)ZfHlgLXfg30VXQGh2rD&8v*ZAVLD* z=0Kv=1;kGW^O&y3$)@VJX9#^Gbfh}KzZg_%+!547;cB8KH5ngl4Zb31?!JcF0Cm27FSTAQr^Hml^h=FtTtUOcdgtl)y@B0GgTw7OY6}qdIEdFuelx zsY-Iqz*{wyqaEg0qpmKw{~ek#N?W*3O$E7?}zH>9Yk-1Ib<47{Q03am$6LF`snFmQ`5=qR<0 zp!;2bb5Ln%s@J=F)3>ZvbHVM6gJ2Td8-uwZQPJx>nC*?dC}b9*3L58DbHN+0fD^x% ze|B{hPj9>mw)^7Dvnb~m;dtS9Z@jiz*nY8qa^gTz^!jRX`^Dn3tG&B!%LYr=p*Y(; z_!|nA?C|v)tVG*AcHi|IjJe?~<}f;b*lT=kvxRrotfQEGSodI=*G^=>y%dOu0;$yV z9J-0|*jx&a;Vd;e3R5933CC)bb4QOJnlBO94TCFGGLw}&$RL056E$6jGbv0{88sRAzp97+Gjm23DW!J=%>&q2=R)*+cu zD^U4~1+;kuM=kCynLmKn!_$bKD<1+`kHH5)<}c8HRR#9UOvQN)ZkRri&2e`QTD!jb z-mXA!;ixN2EF5LR+zO}*_0#*;eZ8Z1Wvee;?K;jP!_2}_@ew|EwQDlV@8If4cHt<~ zSzHhA0S*PYWu?2sz|Qq${T_-D+h;$*tt~vtEkq&|EcS0})q#P94-TCDpb_NsA^FA= zRSw^(*3@@;AKag9?SC!XIo5eKFl>6&RanTD#)~|PW|6zU^*idfaeuZoP>@HssySEoIA4CYpx(2` zS7Gbpm(|n+{?K!`;ko-J_uMU78fZcUvIlWSoV0UpZmDgh}h%mRR9)&@oKZs z7{ced-%I25dl!!K@c0i)JufK4Z88?BzpCu&Po7rjqgG|(KHW7BRIhOJwQ%;$!x+>H zMb*h7uLVE*wtlZr1m^R+6j}!wWB9{e=Sq$Dd2W{uHF2Ng=Y?!*Wc?QV(49Ta5@|d? z{g0lBYhL~7kHI%65DiN4u?+Mj7U`oDiRLSDZBA46h=;PmQ3#X26Phx5Sn24|QP;mi zy5q5eokqYS-Ua1{FA`R+Q3!9wn-JcNJM_x91LYS}AISA63|F0W4w2$qi5VD*nhh1;fTxOcwUL*RY!;q1+aXC{Mk%;Z7$E*o*3+m5IkY7MV zFxG9RXzHv9_^O>(D^xU6utzvl=-&C;U7LdeKJFFRO9d+Ic?BtAWQ%Y z&gNAxP6(Nf85A~AxaOVP6V@2DBfau)doN6k(Ne0fkthH3OlFaU0QltQi)qYpg5b$t z7zgN-v$^RCLh=zN5Qn61-U3+6TUgtiL6{Q}heY8_L>!>vtVo;yL{D!FzQ~U6Q{Y_( z=%V3zt0Y#8u&cq^=~KCq7((Iw)^B;& z05&3y-h&6)S+Yf#s@=O27FOD80&g}{72y~R=Hk4(G>pu+9RpK@e1JTGzfb!!R zYXa}UXqExSPQdCv3n>w{FqBvmFqO-e1^~X+R1})1Y9snhL~S}Bmia0pFwN+VE*yg+ zwXG&arnVI(umS`~h%*In(__H0kd`=NLW%IeBaT(_K7yYPIFJHlLt?GW71)8zFb%?nMba_N{rJ>aPAgYdnRj4abb(l(3M zrrb<+7up^K$+;|6PAz1+#n2%ScLlZaSlF(}B)39P+qkdXdw+Iw0~oJ)ZntK6NdfzxJ5)hAZ(O1howexVMwu+Z5f>KZ$%} zvjJ)D?7JAr9A|0;bQCJBus=%vb}1o*1(VCnRX{#GWEw`4_BtS<9=b@BQ+-U6N#Lw! z>Z3q;K>Fj4qb^+)c(tPVnkoe=be0C&*__&-B53m%#b+UmhPP?~qp{j9#Y59fR=^x+ zAnC>QOnI@Ko}We_kkBHg01D;x)&gj~JK0UhoT7lpajCTf9RTQ|P#_R^2LOZxdHXqg zm!0$=qgTdI7AMCGh@M_YT(=ld7>Jk%PzX2cX*p8UURlfk__bFH*%_^z^{sAwo-2oW zgzx6PFH6h{hi-2??7rE!-?;v!QK|6-`I7rsecCN(M2!08Q!?;CAT$IZ;?d?UScQ2D zMs3`ZNZ}W^z!&{xAX71L4$XZaFKILa zgi30zGD1dNc#IC-LctuZ(dVuPUQV_i#ZP0NVW~9&ZTn7Rg-EFi+;o=@Rku8MKl0rD z;9bKQ8vNS3eraQkU#YH>w*G~t^nE2vs{OUc#g@;6d}GqQ8P{Xvp>8~UoPW9hTh|6; z(6z{;a?u)@=O)-~1g(WBEFAhV6~d2Y)3g#sJBZyLw{i^9mnkMwz=Y?X0M8Z!H8u@c zQ3z&!P=yZHUPe^cRUiP6#vR%)?htn3=@UUdjOrR(V;poR#54vyq_q6e3^ujQUb=90 z`SN90A7M>oMb<7AAYsFVir`O(u(*k0I{fUPH-0eyb7Y4H!Vx0Opif$~=K_#17Xk%deqQvYquLi}oBA_(pgWxw_FEK?f85FtbP~_Dun1Wu}6Tp9B zzgph~0S}1qt={nME;?=e2Vbk&b|*%;ebhEgkZX3&k73*+H))?8vBR3~LuA~PZ)By< z@|TS}8~3K!M%8*`^A3s1XINkA-@IjST}-K8w)=T({O6PErdj`y+3j1fYiHA4e!-XW?;Q!oWv;IGVnF8)8I8z}KVpa`_#PO`fVPpsH z7{X}`07$T=WE}$Q;tV1%X!%L&b#_n2;9!%;3|PX)*=%`$D-cqgQY_)f0f2~;2UXdFOuK%_fBBD4pVn^j0J4e$ZPuhEtmEG8AywkO z-x%vq2m-oMmKDoueeR>pl&tX8z*nSYqy06Isz0d68%&H|sej6N%oO+^i+mtz+$&da zo;53km_*;SMQCv9JSODs1sPub0g3I}`f`$O+_L}uH@Kb8h%b1BlnCIZ%p?cd!)Q8R zm_pzPZKe?j0)^tl4-^wcL`*4f&Nk~9?d;}gLl7%Jbs_;*Jw(b3AMK371gRgwO6n!7 zL;=KV9HlK*(iesZgfD<8>lYyn2N|HQ zV07{I1mkO$UX;`wL%-EbFg0_oK@OcZHEE*oTb4dzU?Xi$qhuVXo$Ijmbg+WaW+HiP zn)-CpWCE5cawAe5i?$oM3f|(cX6$`{+``g`Lxw>jz{Cz)gXN3sD_4duURXJQ#X5K4 zBP-{hwpK1%=Pz8bKE8a#T0zd1<#WsDk(b5YFRGSGi$qu%kWh?}9m2eQ#f&gxm3)@A zi^9~HS>SF^5V=2o0=yE>!8S>!V7rY{dB}9b0R}{q7D1V?2~PH;VjpQfOi^i!aV;}O zn~Aa^miM0BllmR02h&NOU2cCU&t-GzsbrSo>QfvYz<~iNjt}4z87z13bBZ0H82k{I z*VLBN)6x=SDgTk=8B#i9bb}jW;Yd7sg1Wg@LYPQEd{>Osxz;ofi(h%7kZX+;lkB<@ z$7NkS;LWQyKUfVeh2{OQtuA_UQqb2M@3A9r)Y^SZ`{9t?yqjFtf6^Pi)96&a*!3+$ z(DgTKzh>_Xl1q1A2vVTEzpL@5_CQzTdv<@4yn6#Rdw@1#*!ycXZGXS~>-*_+(b~B<50%No+ua=K&ZB$;>s;cHHv*Zw@D!h{E~e9T4rr@|Qpq(5*z_e*g=RemN3%6h?E;)R9v} zHuHcFfR6G8w*|P|d~HLRbV%$XZFhIt=7}(8#`ze=WKKB9-x%~kUuYz`+x$hWB*GUu zOtfj3h|@58oW_XaBW@d;@Do;kzFf&o!^sD}q#|%>Ya)|v|BDIQC949(6Xc82j$GbB z=-$Oi|MkXq#=&wWQj_!#El{)i;WQG1(%?2iX);JiRHh}?%rO|5W%!}Mr$p3kgg=`pL`3~Cl@7#I z7Y;i95=UauJPA5dfufgyJ>>$R6@~*Rwh5n|#s6T1#{W3b3BSapa<-&z5KiTAqRy;J z1;9JpiY|!Bx$8oVib}zy?&_s*eI`^)YM2J~_6Aj$QJ=~t)tlOl$c8tP`K_;H4au$+ z&h_^0v3t5UQ?ge>DZq9_wr4(D=Dmgdvpv_u6HVI_jheRRL_7>G?TU{&)ku% z=aJ6oyDRnIvwK2IJ@u~ziJtH4+T2yYCrAt<(zV(3n?VZ2>BAL_bbq13RE25!vUczQ zJ3W!EBt>wJ^m$)X{T#@0k5n*|qSr$HRhhK>YEiTMqGJ2}p82u_@iYsYed_&^ju8>j zTt&V38Ar4JKLinYl(Yx78b#@qyn5#_1G63e5hr^x z?Py+L-@lhI$6-=bgf$NFcfJH|PjtRANGTYPNhVqM_m#kE;cF2Hl#odCDdq%Z+m>RjVHOl%X_F|CO$1$roA8}C4E zaS&R{eom*Z00`AmKmYEsdO#3c`Fyx_^nBm46$|xn=ekvOY4JMjp6*c zn>?p}|eqVS3w7?+>>i5wAKu&o+t%e>2+88D?NCc2Jvxu^f;*uS< zSO69}ApS4dbC8a(orVL>NajN98i*<~JS|vAM1bY;2q>VqC?Xg{F{BE^4n|x1Ky&?X zkm*5|UWg02V76d_F}cIhtZXd=q4#__3VI9|G~C==$;~!M9(zws75Vgt92>Nt{qM>35R{|q@A8n~%b1zF_B>u?M1Jqr&`+AY2GPbjiWFDVS6%?vqh}O^pr^^@5oL$C;HDWm?EF(~! zkcOjUCR5lahYX38`MJ{YG**{F<FELMn?1I_oHxi&?#Dx&NpDRh^Ntn~v)ZZ+-m~!oXVkfL0*tqxjwR>{==+<5c4>JP< z-tRE+nr4k#hk#C?)DS6#RTSuO8v7LBF+tQn?fQx!aBsjjZBu4NM6hp z!9x8LOy(iR6yA!8_ndz6it4qZ*dDZ8&OQc15&Q*&v2=-G+A^hE5XvsAghiWZ`#5DL zc&lMxX+MJ`1qR(@%676b+#Bvi{e}f4l5k1On%K11c)|dybw0}gNnZyfd&edS@Gi!lD zDxwA_uV#WyAfP}J3qvY^%TLz~@(_jHzyo>|FXt(MDMf=G>KZF-u0IhPqBEcfnYlTn zbsRBjDxmUVKab#Ng8c+V4s5goA=dr?EPo2Ed1-1@$#Vuo-K`N-3=p27gJhc29)kq^ zRFlz$R6HJyR2(cd3mB)2r{s4YR|!*b38kDO+h9+ipZHtCEhD!yun~l;F~P zO99(`0$<}tYldl+QRIoQ$_59%>3U-GV<{zlu(tNc-Mof^p{?D$eS1pKgJI#_+DM8O zakVsHS|iW@-vOt=rLRNRy%ukDfF@Y+4i`maJRB@snrZZm&OfX)RjQFzbIdhZfVg*3=1*07!7&2J47q)$pC;_obN-$~c zQg&K_+@zmF&^6hxi->?}%BE9HohTz$I_ylKzvQ8zYe2p~b1UUfXwTdV^~ZxmP3#9&G@+fZZ>Q=@4PG%=T{_(=}d;N6fMrlA@|k+FeNPl0ww{&h#r0?uhK zDlWZBg-dEcRhHd!4wMJ8aYTf1-q5mfpKM@qVgFS1c?REBVX`@b>oHJ;O?wsd*}7+4c=PH^HqNB zhiCWcW)}4hTC{OCVoPqL-rn2naMxyduQaFJBf+IUCV}vn2a7-XtBr`=x4IB1+~7v} zPty*EmcsS_p5i9yY=8pk`LfMitjNyReli^U2osjuN4$XiPU3DD3cU4UCGrC!f0K=4 zFdO+T9OBRQ5jnEjcx+fO)VEVTWN;H2N0driC^RX7J<0$gR)SnYqd`cXSY#Z^KV(#2bkELKmtfU9YEt(m(Ysbsij2FYEu?@3q8OF^-ACoD}ZoE^1XnKYE784Ji{`n zSA)XT^&-GwqAy7xkOhGQ&W(t~lF|&*B1M5agA1H9e9!{Db*^ElbFM*QC5Jd?8HcNX zdAU7pxMyK0B?oVca8`0EH&NTX``N>_)RPxP7;2^GTZEYM&eVJD_&FfS@m}cl$KeW}j zKdqSCx&u@`<5E4Ct%qPnN0w)(*xY3R~WMtE>G855xFT@~D;DME9@DP?ArfG%D z4!QDLX^0U*Z~;Sv2<8wesQY3^lt-rI5``&M{Ns?eNVE27)KKSH3>(I)8AyECpn3=d z;M2Q;0TrhK2`42X`JZNj@UjwM9(kqqst~nnC-WlU>^Uj66JAqZ@>A6plsV`P6TU+1cpI7;>6xH}TFT0-!!+~gYqLMQYv?GM9wUB$~*#v=YoJ_ZfkWS|^ zg((j)jbhExHqt0Wfu?i>1%=B+AqY4FX6(ddQpR{9!n92$J(oIeBR#HBi{g+KDRxkw z1!`?s$IDk!gfv*Hr;`=0R4lG2*GyxKFXoyOZ*K>$m0mj5@l7J~v8s))!MJQ4S_zse7k!w{!2SX zUH)uqL>54?q~5N4*JgFE+?@|T!gZvds<(Yz*TPAC%@Y$*nGVg*y!CZ096ZG>H%4ao zmscH2*;KSh=0~12bvK&%&`HFBBKQb?0;mqf9C8kiA>`s1Ht&wm{xa59sStGE$7EdH ziK9;#ehEe)f589etxSoreI-!ReI@W+_(~wYX!mRaD5ravpdHWt9>ziQ{9<~XHfsxF zk(xX=HxIQ=g)u?C_p(uPUJH`LyM=LsL4h25dqj?FUmZyOzB-r~UkO5ryd{*F)K`M9 z`${k$k{aj0$g6x9#2yeI1qH!@CXh?I6V8<2 z0AfvFk#601MB6GoX}c4k@1{H0>-9D)1275e55&m?LA(ze%5=(eIMR(fiul)Q)#Jz< zD?@1~+jNqjPVP<#4a|KHahTwI+01Es4{u0D#56Kpd6J*2LyE`?H=+{F#{j(wHAgZh za+JNT9O_^nfV2Eq8I4Is;9Mk9R~U9*rO4^cACHn(;x#a2i3E^fejRoNHbv zSsIc3w#N$WaM77LtD5^_91BZ$Y(%vmg)DG)Z?);gvS5`i< z`~=Q3!nsBzgbbfuzi@fE`T>g$F0w9MT)uSX3XU_PBOfnby72TRZ259EOE*`(;;oR% zwFw3!h$Yg6R2jk*Fg?^!_e((La%xvDZH-9ahlVGHr@Q`rV*JoaXTb`3DFn=z4yIDrjy{0MFtZUQ!KBm9PMH!2EqYmKkBk!=f#q^< z90X!XMj^X-ZUIj;34s!p7I+^_3g*l`FYHlqY`I~M1%VFAq?a&4PBYFT0ku^hbl0_$ z4H{j;JUK5yvUaYy*Up`@mpV@JSp})UIGLH1wdZmtk+^|xF%{5=kh7FP!`Zn4DU8j3 zP&>}JhE=8d$9f05RR%LH|ME`ySJ-f$%~~z;^)Ho zYjVU4CP$wKAYH&fKp~BeVwIgSP(YCM8N6IwVVPBrfoKS&9Wvh4FS@RFmkcVz!5#-p z0JsIB;+>qY*rY&F3#8vUXhi|`3vLy#LvbmYXocNDj$M>YIq6(QEI9%*!8;(=n8`PF zmioEfqVvBY;uzz{DYgQ9$H~^jiTO@u^O5&uDRW=sLHyvfq-+l7Bc;jei7>~RPwE(U zq*wnh`cBWV2$hcn3Jp73Xzk;Mkzkfi^Vy5DG(TFXevzxpeD6TBkVgXc8*evAS6Cq%`X%XS!ue@;7XIoE+< z9n$F-L_<4h2*n^W(efL)VPmjjv=xzE&{Hdl4dnhJwpV#;flvBsA4X34)kiLAjjIqR`2U4N&w64UjC+=+8B%&MFJ10qzVGWZi6qV6cS2>vJ$! zeo-_j+Eak~O5jQQpEfGQF3Olg%);Zb(jHYN+8)0t%mrs1ThIO|N? z;5`K#Q$+_!3LHR00%3G+$@Z&6B8 zlJr__L{GK`dds)5!wK2CyTu;Qp!7*Q!raqTSy@BX?7R$ky#YpuI-@>T8?- z+TPb!k2s&Yp}u+hjVE_i0ss1t-!R~xxyx@lCCNOzWh}0Qf*-2t7H+?Rn0IVFlJ>*M z_8JCHK=xNK1!KH8g1S`Nd`#R3MtM@KTLqZMByXVXSsF%iMC?{#>9MdPb%cA^ec(g& zm-%xgVi3PiXcwpR4m67(g+;T7IOHmqMUaZ(6&5-1nt(oQbiCkk@EC8k7!1T7RuY4L z=Rr9}PCACyQwrpSe(P-uoTme$p<_Z%%n>DpO6e!{z*c_|bQmH3F~u6N^9U9=Up3lf z=`Vts<130HM&4fpmBwEL_USKz``=##wZ>mWyGgx#5Ectx35bHP1dcK)DYx?y%&JCn zB!L0#AWRp8=R|BsT}Jy)km?O&h7}tO8N1z&=gPS>AGWRu0(}5=*^3SOpl+ca@t5%g zq`@H7TL=}U^C!`m$;VrhjsFMf{dIl{(2d@g-b1?_gQpB!IB8s;RtU9U@Txzz z{Uv5!Om3RUFi}7@2ZhtsjeGl^s1mjYzmzNrvMhyrtvibKD_ms>%V~O{TqKLNkwV{AMIV~-<+@qs=v)| z+x*E6zu%!AY~3Ai-5=kg3_yZWZUWsRX3N^bC{* zlwflrY+R)@T+-X{(0&B``_n`;0P_zlxGO(y_UecHK+9;NDT6 zg6oMjEgW^!PSJq1v~dHdnt+#0orz^7(42D(tA@nn)8UuYK|`F5x6>awQQcn)RM=M( zYo}$j58Gd>otDwQOn)s*jIW3?_xp=r8uS&xZsjY1j70JW>}tLT2;uORU|OgI^c?HY zN0+rzKnHdlnVQxthfqaD*fc*6*eyW#LxizO2iavy-(n^X%-32+-l|8Zm8TqK3&wKTPWA?6IcP%EDBm zGS%7-g)=P&Pd74?xYu{-tYA%jL_XiRUw5SO-br0)s&zou`}7`0Ks=FHQ4+&llQ;xx zm1`2g1Wu9$N_MBQQBJEK$>s`lh$vg)^dm}Ji~S2ELORjKo?@0YxEafCg0o-cBlShYEg8b4GAj z@Fwt3599N3MG3BAU?C|PAZky;KGBgSI=s)v69rhwht-uUUz4;+F z<^SuI`kxgyFDFT0UuBS8>R|>Ia@i&5cX38`&tvPLBry1f-NS)2|1c@tVc{1X>&@aO z7)4_Mtf0WGpwG(+&`G=JYTzHX0!8quHIuh+WQp8 zbmnUFM|-&);!8!BEyZCE(*Vp0nnPOR@Wyz#39o+>*_auX#vi_gC_MW`#MrtbD7W3n7qb=u{$IX~g+V`61 zh|Pjh4VyDx%`5XuUhIe~q6y+eN1R^Oc(v3zQ2&=8`K0w}+Dd_6nDE>{I)5c4a1 zv^~-bXjnOK0o;mhP)30)?k5dF$uJdC76#vnQ*fCqFi5=bnG$<&+>OrMN8vByJ}Z73 z;%K7pa&}Tn^g26yU#mFYRh}VhTk2YttQD}X$-x6hvZ9Gcvnk>3i`8mS`0)l#)2J$m z;18PFw3z6auI4xb%yq#!%$HJb$gDfq9tDy@J%t>bBBcz{o$xn^h;97MeMxJ6z#~Al zS0$Uw60<`w@YdjZ9?{2~0?ZF&o)?jgwF_G%l9X_)CJ}Hjl@IPp{R13%24&*+W==C~ zLru7+u-TRBJCQ_MvKA~c4UtglNBQ}yIWgDJlZ}6&Z(yQ%Wv1HrZ|iU3t!%4*+lLbh^8rlXnL&I2dRXJQe|X0l!EMd#tHyAeQuHVaD;-Zx$Uom$$uLEayP*L z)G53OvsQ-{ea9^O?1xG0%iTa8GMXMfS6+X!vqA!nAR3EO=^=ZY_nn60*v(@WC2l4u zCyl+UNFitF{p9F@a8Fo8s0Nt&DPT$;FuaP?zD~O815M>8LqPaR9J=%Z4Ksh^dKf<{ z>0)C>S2<+_tDmg$aJL(lIR|+zym3Q(iLFO&P&+IwQGk2c`Rt(cS^nx*bp5P++xc`x zfBJN=0P%wwaXx&&b?9~YtmEtpvowwsi2)=Xd7E7E9-je+Qu;~&sNRy!%Sd~BWZl#m zx1guyJvoBJlnxFGel1cx#1LIb8WtV8OoZ430Ftyl_t+Au-T`$Y{SDH-Zln`$rqw68 z2QE`_RcdUAyPL`=E{@NmCRoz&Y5^$nqzd6+#zcrA(+1S| zHvu|V zi1xRn3OJy;01CL;p)c5l!ij_*avY}bDI%#H=|jsBNZ1R{nGvi;`$fFyLP{;oJ)Zzf z=dAf2lOW_zT}pbezYL*LW;#;{jBc`G2&ZuU@d4Llf(D!AjH(FN6&owxA!T3(p&Zr; zjLJ>G3Xq|bryb{y5l};iy-5;Nc%Hn;NMV@b{VK4icpre=$f*?oOzN*6BC&61ZV@3w z3M8ZK&sW?22|~$tFSmeF0#Fsa3;b}@e_wo^lVn1zCBH9$O3qiPS!NAz#+GN%w8c#` z{IW{tUR}FQ1*sDCbks86H*s2bC*UBBTUK7hwm5EKShp4O8Al?MW+Y}2B|5?mL~#f) z&HxxyN6d2#ba}$vjgV~Zfn_L}iiA_*-cP0@eQ9-Bi}XN>jI4LpQfVh39F`4rlnif- zdyKR?NHUAg#wKW9xIdxqv2N6Ngl);^jb3vDo^E5SObY1-m@#u!#7eG6hA+p-jNbne z@BQKY_t$!ot=LL$Unq+lOo%2GrKQz_BP1FlwU>2Ry!wsQs_H7Ne*0up^@nv0^}EMk zkEP*eHgux?1;{1{F*m1RBz253n~~DYy&sW@!N4gchC6gHC>n>J2^>aa-XZAGcm`}Y z?>z58kvE>{$V8bqP$>7Ai8AxE#zgM~7-N8CwN0h9hsm`F5G#?M)V2M9lD-rGhQXZS zMBflj5yTl#0DfXZ0XcMx6NqSTJR@ua5gx^eq+Y;2Sflge9O5`P=wcAo$Sv%;auB2H zxOfo1E1qD?isKH#9)5x`b!s#=Ex||3yTZZkSqy|8p;WAxl{ua%jpU|Bw6BRYYth3D zkPNo^Xx@0jo(xpqJb`UEY>@hIuz$MR8hA3q3Pp-lG34_9YO6Es@+%G{-PZz ziQoAi6?f*n{MD79SJa+vrah=50UMe&Oi-3F*DygI53jk6qI3nS4c9cxMUH3yiVwpMd2hsCCQ(kD3``qB zh`~BSIE6d|$0iH8*;xe1DiM`j+wvI%Da)br4(|ZkB@p84(+CqF8ona!oI#Q^sQUhg z?H&?3g27jdqQ6B}r*juXK*x?%CB9=LH5b7vtOW*q2$-dO7Y3Jbj1G#mf%;0aLRecE z`(ePw{}72TxIWG)y2tp8RWZnbf#`gOn|r{v8{q4)nz1n<`1{D0drR`o{Xl34 zt}jk)+?Q^}RGR)ighqnzbbUJbYHssDt?$V_%}MPYdAK=s?mtuo;Oi^E9iCK)aO!+4L%x67#kum1Gk zU9q8ql{3j)WT7uF$BYa5e7R594ng}Y-RF#FSAr46$w%NplsnlVVoDt zH;|_u3eovyWGbxw*Wqf{OE1?x6?{1x`X}OypJT3uvvun~q8#a(i9>b7o;rM#yQf7O z?u1Mb9U(!w5S?nE)n?8_jjd|HN7&lw0dz)Vle|S`ngnBBa#Yw zicf4t334`abK#)7xRrr4D{rma20ZwDaK9Lyj8&8$XI6Vyt4{evsP%IF61*txadQ?gm zSU|aeh9wt}5&43)1X2~a82A@1ZvMsU^DoFH|01t0su?q{H}_HTbcqxF(4QFnK{l(Y z!`(xic8t<{w4IDi3&IbGM|sYmR^=3e;~qTi2KbR8guD%m=pQCbWw_zPMP>)i1|H{I zQG^6Qcn5K=GLIuOU<;K!FBk>3Dy5JTt8`3Ch;Z`;nRhV2w;LPmJ@D(G`|s*Zz|OPb zA|)N{L=qvTG@H!g2L@aMZOV*g(_T_s!PY{P?VCH=KF)bC+(QU)tCRwSjY0^W%HSXt zoRP~*Y=utkx-Agoo!ycR4bzKcKxg|ZEYvLY1UI`@B9G!%QS9H*l>6=`GNx5rA&T{x zuzLC>dZ>Ku{ul46)Qs1d&g$2`h}R?`yDoWNdZlk)Scu4~>t0w3`>@-Dd%+L*kC1gb zE>Tqj)A^q&GDx?>{N=M@2}D|y@wSldty*KWm-^D1%7UCEf-#9-^z7}`#>b=vR~FCe z@nB@Px(Wr?u1C6^o8!S7xW8TQxeJkqe6b?OPel@PD8;;Nrj}99i#JPVYauLCWqws{ zj!~oZ&DGE1mb<#ucwnJlb%p1bXL4Qq5i%cP0LZln{vd&hn#qy1nLB$(i*r4{1ajC= zj04IL=Hi&QT$vKIj7&Pjo7C>BF*mM41Me(OXkj*h9dS-flYZ!A+Ez8(xFuaf9wf+8 zMr!j&c5-%+Q7QpDmnurlO|fZ-4o6kYS<-hWC>mP}&IyER$_tRPol`s#Fri_a4vm3@ z?}WKEfx?*N6`vN$rwFTUNR)P5Dlu|Pus3j4PEgc`!E(M~sRn6(1Qs{!(V+vFRi<&u zN88>zid&UZ9Ev-|XSEt9Dk(+ZlY%!!=081T$_?y%Q+c+@sp^!CU~#ECSU%8OB-Vmz z3o^w6QAd@MzM;=5rL#KZ-M8j2M)Ux0ounKg@?NeqS(u+9daqXxp9jU$Ly~bGNA7;;7I`j0UGZ$+QS<@FTojY^o3Z3pT27)|U!=tlTmM@|Hg$rw!acaSY zmHF7kGv}+z)rYL&^7&_YTjwlo*~8l_>&pm}o3OHHE>+K7xcG6L*9-MX-h^r?;~`rs zHu{%vz_!eP9Pz%or*ZUD#KkxaqmEjHRDWP4T1kR#X6|Q;dv>=`sIYF06tEpW8iTw% zjl?K0N24v@>XS*j{LGV=udG~o=E^cenF;IhXRuX~{4wMlz?4(oH(F&3 z_!E?epwr8=ig@Ho$XIVAjX*LFT3o%hv^;}2Eda$sbWqDv7oIs^J&0YHP$UPZE}UN; z8N}Hx$ox@WK6B}84U0Z9LPhifcjw9l>nTjpQ6vaKrbS8vJEV|^Ak8`Q5rI~m-1MN6 zZ?OZOXi=CVObkf`^XwN8NLq0P1M)6$m3Nt(bJgq)hf%iZY3T@c~_2cZyOvOz}6w3swrA{;ln(J$9M_EtLo}yI# z+>A)0$X0VRH>!wU=8$14fYXCSH1il9($~r;fr_OhPqGP$07v0A5bbD1$m&m=5jTjt zR9B8Eko6fB>SF$`V4}Z%J1JT`hb)H}m%W$v$gWy!dRp-xXMnOsf416slvz2yDv}OP zI@r9+Xk~G8ltpiq78*h0;oG=ip&y|j@3BQ3b23G$6W11{g&a#P&H5j~zzu#6+!Hqg zGe)A=3g$)gb3e|K7GSY?%x0}>88Agwv>FNcAf{1}lYDqj$^97XmGb`52zy&=&3 zwn6|9(I{y_x(eCE0XXPn1|FCoL&tl{TPEz{q>8ecOFZlo3t zntQrGVBwIcGnbdGkDgh%0zv~+c#C~ezS=sUupD*3nB~>5=}x6LZ`ZNcD6d%WXedQF zYQ8OzS&c!hLod=n7Lnk|uFc)KQ2nohslRUg$2^XIay0T2413oO$_vV26xrpd()wbz z<1r!_dL2hI!{-1mW>7;%)gCOpAV*PPBui^3~yx zGt5O9hO!EtpsS*4H`Hu{pd;kC--TxGk`g}A1 z#Uvnl7s4S*jw9v$WC}Ft6T7--@RVTfflruIK&9NedSA^0Y(1Qrfvqk)eWc{m++b>c z9h!Pq^0$)lJ&nJ+2iE}|;Qd0AsZITiXcf=PUD^Lw4l3PJj}!jK4|v{Iv}()DU?&=) z3oyV_g?iLgH4-}N$fOgX|IYLhu7d_>SxbpufFNCB!Pd-T3lNb-9f%Ynj8Qx)Nh@gl znJZ`qq9}Miu7BF=zqal{A75;H!A? z@)f-K^dJG#Amq{WPvZ%7;HeAeue|^A$}cXzfBDMU5$e`i^p~a8%b+cz-PRz+NW(b4 z{88!p8F^E8-9pFc^Ca^iF-6(wwOQc|zv}MMbYRVZ~A1=ej16;lYQhWQlyh8=|Z7lIt$Q+ym< z9JGdVBjpjC4q67`hnlc_8A2fnOO&If?MvzvQf$jsw>KRS-lCny9wN7(Z>4)GH;^VG z_((BT(3_9Zqxo4~pKP)+xNhAbi`mj;^E;lLG`cPq$|)tPD20tC$ho8h1^pS(-VvIi zzaklW)H{v^LER&uLOfS^K^39Xy8l=N1bR3Rvd~m#Msg%1umRfnM46wsP0*Z5v)&o> zM&_vRP1&?Z3W$MXPXWaR!H*T}bgIA~b(@#>^@6zHQ#JfwqVI@KP}Xh}{AR(8DOAOHNhuDxVV-VP zrfN~BQ-@-;6u!FNGl8iSAa~Z#A?pKH_u%~HxGgq`BVtY1M|0e<>MEZk%8#)GZ!yjxOBzy+6V}q7?SjG zjAKmvjis(!IdirKWgn;4pS!60q}%oO$7942Ia=5~n*o$$EhQXV<6x+i8A-1(N*Bt^ zmPR-o|Bx%CX+#2~BG)>OO#uU^F?dc&Q504MlmG##h5=LUUocBNZ~Nz`vT_At#95Lu zDCrXk49{GwLgdg>jycw*Rh7U|&AL`iJd{IyOUeiWop*_^u){~aZl=TZc51MU?kt~| zevt9&nJX(e?sjDvd8h<>)a0~h4pVJo+YIG)cj>U1Ps!Qp;t*5VKvcpqjWa~FJc&-! zhgJIsQI(_<-g{0J;VA;s(@n}d&ORtlHQrIAN}TTLtxl@k*{q;Z-6@C?xEK`I37Xd} zIy-7rfskadE*((pn}49nS;&CHAH8sCy$aC*lHyZmPy)HjBL@KNbwsXinW6<%M5I~7 z(Tna^T-=agEHFGeu|7^Ugsx1Uxdf3I0%mo6`O*h0$ekC~0TNFEiD3gtRUE`sUva(c zs=x^9QzhD=u7Jm9O;?q`^F8#GZ`_Vk=LXr(s%M3yVJ}pAT+V`r8dXSK1yD+%Uw2kL zFbo^2#1V2u4e8bZ;FP<zyDKQpk zlr;q3D(k*Gn@+o3b1O|UsX?k0T(-4Bk2@J){f1vOrR~D3X?2U9W!R8e5gYQ^&efN_ zrT$KMpIY5*M)}V6d(+GhA)Nnv`?Y}Rg|l>qy369kR~=;LdeBOrIlK1sC9)zDKu%sb zcMjNc8MDaFf9xpf_*~ELkg#agq+&OixIz2k@_9cCXXWpi%P>(>$FZA%r!G8#ROTQdtYVP(yns8vNHI05lpZP+{3xc%GkEHf3c(txpqOZP zI~R2f6bE5kRbwOL1^3!$fcevi$Z-&8Scq45Frg*LST-?1BUO07^`}_khbUgeaS|X{ zL(DaoCE52B_niMM$pHA8Mq#M}zUG$jDHN)N1Xc{5h4!vKYD$+)$NbuDI;&BLJ z(nUkFHV1SgL(;qZ?S7jVXbwc|9|FYa02>%?)O&br6l3F@eBWD~u=HoV->^cC%4*3E{{JeRt|R|V#rweM)*c z^B4}^p#eaXBxYyIF5%JRS>DpMd|H&kV0qUR|Nj;ueD{vw4?hzTzWeQD_`kgf-|eU) zJ{kUREW&rQbpD@QIPVsr2J*l=5YD@I6wXaXPBJH@`Y~J#!p*2Ha$dnHd)N$k_a>XmrlwDjQZJQa>FkaiLgs`8$_IF zI=6(_yY~OkR6)J$c}V3cPl?=6d2&)Zz@JfnxLkGY=jH$ZnxCo8>s~BOb)JV~>CWX- zrOxHa9opZayznz>AGp)8KgH}0<>`?N?6ZN*v$ zYI`7a&{k~A3mwY&L8o#O*nVD)8Tk1;2pIf)9)3O#CPDZ)Jp3FUehv@j4E&AZp_7b4 zd}pWf4k8NksZKHt8(um!g!ccYLXfspvPW{KK&7{Ev1)Uq7#`dFns4D~^}hL^+1uI; I-$(cV3)m9#d;kCd literal 56474 zcmeIbeQ;dYl^@vMASntWVKmT&DF~*XAc+PzL<{{1fO1LQ02=HD8vP)k!6qcy5QK&V zfDp-$;Kk;Xb@E+d+e^vWH(DEYi}wuJLLSanK(&R zHc4%fJE`4DZOPo6S(qwS3PV$+a$%@c znX;{ubNPvx{JDbFU#e6K^X1aQT)%a4zL1}+=EuvvAY;b$ci|oJ?8C#MyNAY-Y6I8t7lW^6J%%t+l#!<+9ap{oHI}vRqjD`44YxymW2l z+Q*;SUaN0xKZ6=d)uCFcGHKW1Pmc^*?VkD)>9gtd+0;nC_0qL9r^2<5UA=bw$+H%J z9G@)YC#t3M=uBMdu{O}))MB}8nO%#=Bc19Wd`AO&X9KYkqr=(JG3zXk zZ+ywR_Ua|8{p>_BUpZG;7^>RVz*J@7pb-pOXXoY%=S%kD!q6lJX7wl1L(@05Xp)mw z0yCUBn@ROs?eC~FnZb6MDOs|bb#`*JePGT?TWY@MtduohI9IYO)|{18kJY8Q0$vl= zT(M9(SFGZB*qWQSXXmO`38nBjw}7XFMbLl;ojYiS{>|Y~sO@M7|K(n!zwPv=`6B&& zkp7InLVrKBseYr6A1ZRn-MyjWe%q&ZLw{H0?6<#2CHLDd@$V6O`5)W=oGW>Ant%2? zwye^Yb$j|D%6y?7i9}}bFT7d0^Cu@}^6TTAzFr?cj!uO_7wg>82B#MH9xb}Y;s7X}wmmD5b37EREly$C9l{r&WoycP57OV0` zQ)ng9W0qc+M0(h|C~IZUm(G+0ag8oUM=Yvsvam2QUz)4h^VVq6Q>`>MlJ+Ee+sbAYAbOh03|o_S z*sc~qtxJ3gQx;c~t~L)UmDYd4JtDPWk9?{P zdqi)9Xjeq9q*&Ej7Fiv+i=D`Md0e1LEQ7{w2zqnKb1 zkd6#HFq+N0J&0yTe1JH39BquK6v zmYd*WCz`vFMf9WZ)LJ0IxUk*OIkVuRzS9A zD(!rdN~rAQa7Je*K(rK%0!u#`2j-YB=jY~1m2+`M5x`xg%0g+f@T`?$E<|w7;sS95 z;5r29`x1dE%K3%rEZEM%k_D`zUoL*$S7e`!962jZJg&!l2MgG z=0`w>scU9Z0yuZJx-eImuttE6eA(Ht5j{wI4!p@^wPEr z@o~FawP&p?rqd~qHVde_Qbv9UPQi&FBGbabD9-FImOEm4}z*`D-svNxP%yx$pz*; zc#2FWhk22OLK)mh+R9HsAW^%wq`oE*Qr3L|VoiP)uP)f}EU<0>Q}N3f@!`C13BA$h z4(ICM5TYZ~!&AWw$&Y)V;G!RTq5j82wm&DuXLcT*Y4oXQuBIt3>*^&xJ~1gGB+oW) z4#+j}*;1u6>&j^|Zwai1mxE3KeR@+s0K5r6E8YZvt2ZGrYF#Xq%Y}1jFF$_{tCmP; z8E&>vS%fS@i_G1^Ykb0{QaE3z5ZnU$F_S8(NC1$jed{diUEaT8+y+5@?72us~mP@HW0ihg294*#-#Whj@zw?eU_lAQbgv-F_s{AZ-S&356w+zLH^`4{d_GtyDL>RRrQC%dDqVNLFL*d4j` zUM{iIV|VoBCh;fI`!KltPv`2dulL5fr2HirU92Lns=A77V`6Gdn{G;oGm?za4u*Cq=@s0sS0~o!Nsd=0#owP7jxt`;x{HV-zgkaz)$z19q%y zrxIR1(X?asiOIXaW%pFpdp~9OsCgvuqbov!5(^XF;-Dq$!uC9B}rixc_KeiEPxNj zgs4s@#?tf^BeYqd*HQ&KFR(0Nq!;H43i~8R{CGS8=E*z01h{WsN-~fFgyt)Q`SYd( zCN2x6$J3j1(wZVJ9Ub*khHP3>1}shi8gk4_M)B>WD$uMgKSQ$6JV6?>;5=ja#4s&b zX@eC?Ltb%8U|`NO1Qq8Qs!9EvGFnZ6t##5Bk48O6p|@(~Q;JdHWJBmk(fs6LsIZb? z1gTqU2^Eh{<&z+3y82{>ST@DIfhTgFnMO)_g1bYcPk1Nc#)y&hyfatqmePuv1XPYv z&Pn0EyCpT7h~?4E6C*&+irwMarVogf0-RaXWMK|dbI z)+u_-MiOlzaX34-D$Q{|=i@l{9~C6WIOJxR@xq833~8~xargC&&YO=2PkL*3{qD{8 zDdH99Lcl!Wh%rJM7^pThQeH4NfPxj=ve{f|wUr2a0Gn$FeM*2)Gp*J@y*U%dtZyrx zB|kh25r^52N`AIrEtJllJ-t|=t_@)*RqUzL;53q!jSU8onrtPqKs1$HdZJv&R~F}n zrhqjUPDAJBw2J2}e~5<>i!0E`Yswn6&Xw))e3`K7lr=`#_{DgYI`0C#C9Ng;Nl8od z1)y-J8EiyG4Y(OyCA)6+cOJhYYftqi^>XB zPe<6eL0K|RU8O2XE$ZP>i(IoVLzz&nfZV9viFXo(sWuv~E;nc${wIeY4uzR9sWTk+ z^7A5Zg=Vd{cU2__CzAxLvZx-T(Qt7;*}Y!x?RCp>9gVSC|7vGb6|`25HM!E&j@|Gl z>uq0ubNv^?Zx$neP~wVer}-ObEq5AROsW`^ufKN|TF6FU?FqNOlV*Lx#wWJ%{LVfP z-8-nGp+7S!>#GgB&6~ps?YgC)wf%Lo&;N}Ye(!pnd8cMA=~mLuL;qeZgu$KA1=VlA z%)L(KlAAw>h4g&(yW?-3=l0DHHh(Y`+Id)ijH2>L$<58?`C2Czu60BoJLL9#&zQPB z;XQd3_C|~{KVv*U$~@QB1OM)Y&AXr3jr{h^;kM7u@F#ftjLy6W1@dF%!)^QTcRy`B z%+EWUvdsUU^~$T(&azwNAG(i?N8IPn%7+R0IUUG2;imi+KYp73u68tQR_zowx7u?D z6aH{*K);{B`y11>4h$mvd$rM8PwfOR*4KB#U##`4TFu&t)d8{U*0&DP$4@k=&|+OS zL2SL&QHvdafH=@q*Z@}hc0*skMCJND#WwuKc79GKDMDp0)HJ43r97)ju=f0)=oB_ zTeR<;h+PQFhy_{Cb6`Q3R;)iD}tBdfdgyZS+OsTTYGbQ6_P(OTbe>Cmxet>gKf zmGh0|^G3V#@^VWS?rvke*7ar8p6raodA)a}B<+HoM`|&iI{w3p^+qkmtJ^$ET~mK` z+U{GAbnA&Q8vhJ-Ypp|>92$>c!s1Q05i9}Mxbw0u(Tx&Wqr^_x%sFf3B+Z;NW{w)@ zS7q@Q&+}G{rJI=l?!{WCXa4nWPZFA~|8{5Fe_MQW{nJGQao#$z_wP#^viEoXS7^sb zpL&sT{1h<1kSmzm9W5d>W^wQ&g?X@oP<$}O0CjZ>fVjdBq5_@D+|sikzhHI+qJ<$%3)#2PQ#6EpOfuofof?Q$8amkRu2=8*=HUaCAL$xn^v z=h0YV6#dk~SOTwFo|!L9f$|sQPTnxg@QRrMC8eRj-(>PxYYf_6r@Ld!S{l?7MXfQY zD4i0cj+IpCu{G-0JypWUsJ1YGp99b3*b0`c5%BWP>jiLo;9!WyfQwHBg~3!AuUW`b z<||~inZlA3%|bvh^GJU@^?ZTs7g@}KQ!YdLbCr=nU)&66%iR|+%SLS(@FeCdluE{H zdJI)+K{?F|f0{3nlWATBJkk(yoI)uG3C49u#-fC0A0JfA^P&bi1yUyaXb zf*c51LN>Oc^L_#Q0TQKAJdwqGI_zsAft5IKm!S$^j~S>u%uIp;x9sqkDVd>K#j|3d zm{2H6^<)e~qhWpr$P#ap#4vA-3O09%W?)#jZN*DNA!~MZj3G&6&oKz^Mr&h`s#RlS z;L_c;MzJK$;6;fFInl6Ej52pEm5!P-r3;Th5K>i-V13jgjzCJ7sLq$MBV`!`sIvfv z*+MlBQyVM_Kz3|%L>S(7Z9T-w`K78Oe&;4gk4J6fRM8Hm=wMBq}cE`uqN zZvpn)i468RH<^LhEG?z6DjHtXa7=NY4S7Eeg|!-Hnp8$CKUirN3S^?vo;gml$BE>m z4EtXS?n=7;6ik5bs-&R4cXH60^K9(0l{4`lmN z`UzIYkf^GVIFTJar%2W822vfV9n`>`29(h5Sat~@}qK|cRN&cSyNY|b?67DY68&#Px zlI+oiDWxwwdGo{ii9cqpeYx-EDV?gOF~qsrMJT>?*zS8@2N^X$3%&ZpEV;kT!m%Cr zj`XTfe2bop@x~(S@T?5z>c!df*fLc-JE+WqheQXM0e_*GFk(!t3^+7}_(V||C)I5R zd~SYnk`%eDzfEVyf_8W-oq~3+AU-yN)lzVCVYF$bFc3D#rieAr+R_v_7Vq%LBS>TD zq`|$BUK|}{gE>sUASDJTnFQ!!3&~p~Tg;9h#YmHj7V36Fr3^;HiLLOLR4ZYCX4ERA=1NeZrJ~kOt z^4ucS##S0MUwJA++7XJ$?%lNZ=t>&U>r9d6;nFa)1QISm#h>ZSkE81_vq&&IG;e<#HR?u0`5mKDFnXY9Fv;w zNe*M)g)1>^KnVyEy6S{akkBL-g0ou&;HcPF!wLl|@9z_F77%CroQ1JR9p`P6mM55a zL%Yr!$JT0LBF2(bwb^qPLu zBkkt2R@1!J%!`liZs^NWvr+#gRR7;q_BYW!*^1r!g=I`ELH48*g0Mx@i z?=ABzS9bRe>G96v)AIhM9J2&s-~KhO=WmKL6q&Y@VAaJK2lYO{sAw;iC&^goJ4!$& zA&?3OMYVit#%r)$I4)EqfO@esd8Dc86Ht!$GGW5jnb^F(OkjMa?;&AcamWNSHE^8n zhuCmHtn9LBN>0F-#?HN9VQjjXxh+Xdb2r2VAQ@jbFgOnt!DgW?EISvSR?`5sG2=di z(D*kQj*|@xIy?W(mH!i`yn1zO?bWr*I1Yw$U#f+| zg*j;9fPooJXoKj(A#%ZE2)z{#8aBz|RfSDUQGIfV@X$x!`{40PsZ5^#s?Awgw4D=K zrjL`tJtQ%>SVv3y4%h2#pJ~>^&kHB@y-_e;d%d!q zn9KU2@!UC0yi_al3*r`}$p#PNPX2Ltm{>d{#-$*D=9@{z9ZF-`U$Hmgc(L?Xn2$#f zo)0w_7~}z6cd4J*C!%p!P$-5qV36aZq{xXmSBN93=E!fL9yKNzPT2)4*o%ikp-7$) z8m|DumH%B5H9zEeVZ3*XJ>Ieh?ZM z(`Hy{I}Sb=Vj}Tg4qFU0EhsEW>rw_x63L#h*J6AI?Qdm|2ap>>6_!j$r8e1P23aj8 z{0PKV6DW)qbEYeWnpkAbiC%*41}p`M%@_2exG!oi)M4w%$L%TNol4chtoV~kXIP#F zf}=6ng!O6rz+0&>$*)+AMXW|!{%g6;Xs#_E&V}zhpO54scV5_>zW4k2TzJcxzW251 zzqMuk8eU%gi|Ko>PydZq|Kj$E=H?9LN4Bh)dtaN8{K%_+F>~+r8Onb+-x;D^?%nC6 zJC=Tl(YmU=YoUsu*(?`WFM*Y_=g0(sF@rh)<>?nFCvhm09AA(%Myd+ODR-3KP!t(Z zMaYBc3<-8uoh3?ZHyctu7}F$=G|Qc8e!xD#4_~r7F5STypjqf9cAlBFJMP%Me~v;Y?$j^c`&#qT zf8!V6WK!+={pe^PLWKnAAg8`0>hwFn8}cKa`}Aj{(LhqL5^(YU zQfSqm1U}xE1ktc!tIoloq@@Cb&4;p*zF9C4#X=EiY9?MHUqf;6bNG760s-zq`y0k9R8((>4r#0H9$tQxchq#>@2SMdy}h3;HM&c(g%|+;^IpC5 z_lk|vJ0B@Fo|LMLTw(N^rS*D|t4*#NQ@kQZ=f zOhVd~38c9NqYDL#7rqnf_>Ry^eZCpyOOvudrBC0>A|?WR1ZFIwxUK`b4YLmP&3)Bn zsC$4rMXW(Cr+|LX;Zy^Z=K2v#eQ>A{c7ut~9Rw3W^n!^8(8?rs3j<*iQUIT)CleQ^ z$f*{l(*$v9DxBj7R7NFYiUs`h)hao+I*#%B3^wbQ*ix;?GAV&*D`CH|QNhagxZ)T8~vcPxLD4Xp7{FJb4nP;T3r<<+|iiko@ zzl_3ez|OHmbQc!KoyOV6P7_ozfuDhmO9Jr3nU@f#k>6~o0yIDfkc zVuXKqyhA?`IwT-Y6Hx@{Id!;NlD)@sVEvWM|wmMY9)$$)f zEVlU0i8S9-Lr5!{ZL41Bk%9Wp3eg3{mNH5B$}?a+YKyx1R_M)oDR#73--yAhX@HA^ zL4faEy>>cw41Wh=?UZ|@xfOZz+x3}PgdYB|UWWS^h`H2j$Lej3_uE~{$^JLEn&$40 z{%1<+jU{#Sy{a31>i4AjwbXAvllb19XX@c-_OsM^AlOolaI~ccg9q zk5zR&U?%L|S>;(3XGMt0n&L^#$=M{`y)KoRjP`fi{c;51iKcC}?Z4P9S$0n>iz<1+ z^hTAHk>#}IvLPjfoWpse0Y4=B#`_X=6*=p|I zze<886lIV+T+jL}jE!Crkp=pf9jkUp7LJ>~BG}Zv6rgr*#TnS@m9#DOkQ>J$_9b|W zi#Rk3FV&=#rW1$iAOIb>)X(GuF$tySL{asDJlLH~7^S`58Ki>uww{DW+uORJ7IGN^ zyT+k4NMY(71!+#bDWrCBdP_$YS`ZhAbe{QQ2X*FZ}R!sP&0MZ9GvtZxq1f@lUWqOMjaL7vwyH z@o>G>h&OX`nCqeG=jERSL4;@3MNWhmMq^wRFy zkIyi%P{(JdRb4&HJ?aVcJDPgG{Y2aT!#i?H#Cza&=N~gEA=>rp;pG9QU1YTW%WkP) z2ClU7l#}Cn&&TN4oKPP5xz!ON0_#odjKn}nJEWZasB+#kE;k*Ge!xD%(MrDCo!jsZ z(i|Wdl$oMv;%*&rS)HbovBhy3XZ!Y#mDB;f^-jqPkW}?am!hcuBD{PW(MV3;ZJd(f z+NbOow*Y2Dr3~0Tk^)7@6Om;QdXwD#=*x(3a%MSB5l+s8@oS%nET7Tq-CMHb($wz# z4}=E9mr_pjWk{od-A3L-WWLnTX($D}q$CaHp@;I&@jXTLly54|kOioB8v9XEAo9Rk ztU#eEDnOJb=SmNQkb<_r+iVJ|k%=-~XKI!lECUj15f3g2;-mXc-c#O6$hpu%;Ys51 z7NHnj-Xb7S{^7y*5&M>UAoxrSO$i|4Af-lq!9>VA!9;v69$4PV02a*{*6xgpU%|<^ z1R~AybPLo>p+*?Z)4@JXc8RDdG@k}a^^=Aa`~U)JupGH`kd9{>Z!lRKZ}8GG-pDfS z(AFeeAdEL?f{ZsXV8$Ez?a(-M*LenxZpmLH47E~%RoVOZT^ zJJH?oxFQI#AxzP53>e&w}zze5yF zHr6<%M$`ft4T+%u_C^FuNaIiAOrIhZFNFl-pP_?$H%|$U=D+#<2V7hvf$olTS;*?( zQ7BX-X(sqA987x@U{Rj+h%gL5!?=xeVX*YDp@CHy&{d!_1=u#BfCEZFtQvk~7DZ1$ z%dt5ca#>pspP*HGP)7WfV@rg82WF$gCY6IN%?U5zMt+bIJWGr+1Mf`zZk^myS~It# zqHS)1(b%4nkkz?%wG4`$x=XUb(zd_J;yZ53-}c)_1(<{m^0)H2{P)hVvz9^9R5!W0 zyL(sF>)tDJK3%;&A1fnz;)0~H-SOtRoE~61%k4U-BMO zSUWF%CR*W5Nr6NGnR+0GPKCFW#K;j$Fn8;yi)2ssR!{B&z7$}8*_QADL$kz`YCj;I zLL!{^D~hS;OMwB^TMr!h{beu#Ehq(i7QA%@=p~7+9+C>O?QIMw)tkUl6A?8@R-!X- zml=qJIOITw2pxdFtC^LRh|j?(k1z*zEm3^qRgNLJ{8O0-mT zS9Mfbyi!2LCKTvoU@DEQ>A<;J#7Y^5+EY*;LWF|97CA^kRus=IK8$XPElG$=Uf^OS zgJ5Smita>H0S?9Jlkf_Wv54b{I*Uq&gH$z+H$oCF2JQ>w5>>#_-6q*LUMq4*u_84~ z0n<)GQXpxJ(E;*eQROiBi4sm9ajN!%g1u;-0>O~%C)EW5?UGwL^IufXIRd2vFe-Pp z1c4AmFV*iXEYm`JQUNN`j3*Vmnd;?l421%rbhX-DuPitwolKpJ#vAwN}!PnG83H_Ae3*%}}t)j~CH z&&TtKJT?fD`#^{sGwN-BC+x8Wb5{jIoiq5Zj(}(y6!#M|g-I0?+0YTA(v=8R%0y0(e(|M{GO)g$`wf+;G{1aE|MQGR8IecB;nE+YgQ1(^M%NffEkwYls3?jUuALn;mTMBs}lS`6aQWz;z&{5C|baryR8GzH%Dz%wbLq z7LCuH35N#ri`t<)?Xt+|O{oGbXK)6xbs<{2Ivolw1u?rc3y*+#MEk%>k*z`jCb~+e z(#d8a-#Q7*J|PGdruv(h>O(S%bjVPcrt*^Zi+i#u9Fn9fTlUS2e83B|GqCrhyut#< zDW0CEtt;awN$dTI*$3@!?6Vj zo?;HnL)`~D;-v;039SlW78x|oGuG^RD2Bj>@gYL8WmsUuF~w3sVPIvaBV8FdT(wa| zZ6VIOp3)E}JVi{co3oxcohE3R9i<72c9uTbeLdmc4F0O z#fIZ%eu7*x$Zikh;G~dCg@72~DotCMS2VXS9G!ltiv~Xmi_Fcg5**D`d{qVvVtXL5 z%@BHlgD@$f6x0Hn;tA$#99V-3vpgyryLTwn;4H@P@FyF~FUhPV{Pw9tGH9$gJ5*~#gH3W8WvpBuvY#6>cm zvx^Z$d865jL4o5;8IgEbZ-DBd7>e)9pN5!F3_Snzt4VaKv+Gk6*Z&{#W-14pdWAn72ekgtZ+IpU#lIN$-xA?gUJBYEv)Ef6p093^I~ z)2M5r08%r7$o^cg#hQ_`8x2x-i8Pg}(4A@X8h=qv~eJNo5UVCy%YQ#;)#vVblE}46w{)JB!Kc{i`o6*igj96=(y&Jsg zYF)k2wg<$p*u|gWTuiwuyi{-WjDJ}|etfp15OZm#o4;1C{LD0y!vSJT(tb(+b(rWh zfeok;GLVTT{LIt3tgf*W0a*YxDW`quz>j)ys`xGdApKLr$-AcNIk zgRh=;b)~f*GuQsn;M#vy)9f9q_yr9FOZ&Z=C=2#o`iv&2TM=hDK?S+x*tp?9W^#do6GHx>$bBL&L@P*-KB7}B~pheRw=5aM>S$~|8ct$cbxbwcN0TRaOpOV70LqNIuZ@HIRXC=;14c{ zc>Rv?0URKT72c(a*L|QO27>8Jf4Zu0#H}Msk#LC|A1FxRYRv8soDzMIqV#okOLcOk z1cHK#X9dn#glFIS%e|Q0wONam?{M|}N5b{({8MmXuprJC%A_&}4@T-~w!b;vW(oLG zdqwaTUQO7+aP)+hjE<9opYn+8P-6Ijk=tY~JsR|DXhGRpU=)Z|o?2UK6u_ekpHFxO zm`PahiogKmT?2?5=}mI+0WlkzzAFbMZNdXeJbU(uC&;*|I0K?2)eBWt7kWvF!IGad ze7hZ%{LE4vz+t$t?>#cjqRkhSU~_c;p@G1Kp@NE zFhB8G%vuq<0#5-2&cbeyM=|*mxu4PTi+=YgL2E_Q+f4wl9bfT5f(mxh9J%6x{Fmmd z2sa{*%VpXqU&So6;oPmh+JS6hpUmw)$P{ho2E*}J1;;JH+y6r)gcy26-W!j}@2!FT zSt&ln#T!4Aw^9Dd9WbBDkJgyaoCu8<@?Yc+B>-h-5wn{BIRQ@s9uc!d=fvcZOzqC3 zL$1(4JAnMW;0TF8(@IdI3fZ_92%TaPXzFpugXpYYCko=MmWRyK`VkHSsyx^Yo?Jd4 z2K3s08aEO_%I&8Ua#oGi>(W**CPBt7sia%{uhM>q%qdc^>(y$_Wqf}%Qx?FKdx z?F#@4q25yJjEsXqf?}855?#1h2NUhu56;M39%a$IvxLb3 z9D5BPM*lqML3JDFEX4wXk!U-I0i75Ht6fSk;^>Vjo5Hg4gZ-&tjIfAl*SpmmhC|9cK?TD zufvr<6;#0TGctcNF?%1>nOuq2Z$S#`sNn)*rY+~)&EfjZ>VJHKrvpau@jb;F-->@l zuat_QC9lzF+jQIhX!rOx<-K`1d`2cfrbA6iSKG}_XAOAXV_oZ=;TO0mes4T2J`VB{ z7q$|~P- zR%Agt7UYVuEgj#oz)#wHAWOais@V+r;Q5=S!{L4oEJJ1&;hjj1o}XWw<498Ef=E^a z5Ar3KHD3zQuOLmRG>J1{_bKn#G9Y{2GHJ*#-ZFIT+?RsZeJRlG`cgoDeJP}s^UN%{ zxp`Ak(9!!+;5^_opilIr!1g5u2D-<@-%1kdKQ*zAn;6BE(#-RLu9v6@2f!;e z$TT2m`VsasRhx%olS{r6*o$HzXn`Kfsy^j_&pKWM;%50)5Fw&;&ClVG8mUpSjuHzu z5W4~^Ah06h6zc|B+t(2AKs#9yq3~XaV)#j9wSS(Ja%n80sJXhPEW|WT#4=DSaIieX z1Omclyb(>)HkJ(bqI5Y($}*5&w1p@QO@tYqB8}dAZx5ir;1bONy!Wv0#(*?LC$W{0 zs6)qeDNur>NZjT$L5NIjT-meIQ*ikyqrRSHdhx$2bxQ!&iD?91N+9c3R zolZif^9(fRJR2GuQk*;Ku9#vmxQOQ4(CWh)ri_~IS4IUcQwPmBg+26e%`cQLudHrw z{OsCC`bjU{U%>(E)vYVn*XmDObi=201!p)`wl{DIC_GuNUc2(jHH4#Z1tr&#r?{R` z9Gg}5i>RAwNM9jqM3Nfo)+dUOgBt?QbIvuw5XouKM$-Wc7APJ0)5ke6TNL^O&@S_8 z6@x=kA&NGm)uV`7b49p9&3{Zs!qcodxM+Ow(R!n}+)>}h6$p*Tintg-XtMG%ycM!L zitE}%U(v~46|i5|F1*FMa$O9S-@5lj{dv!KcK(5WhO6ez7a(C_vR$l1hx=6+ev*Lj zTrMj{o17jDRSO+(3Q|5G9j7wjhrlsHvgHN80z?NANmT&HG+Hm?rYEvS`IB0l88p13 zNTzc@7#P_1HFl?fgmIinZ5XxRT(DJ=1o7G~22;=m%H@C?hC_7%Smc}{Y0Bv6C2TnY zTe$1ffj7`4hBvk(8@e+{aq6-@Ias7&ImwR4&gU{X)m5(~$j6YB(vA4}@lsWe<${+F ze*~h5$;%rcsDPG0(|HWT$tPNSs7SG&eo+IOc(IOC!Q~DC#_5;}wlot{9R6%J;a;(0eu{*z1oVGi2EGyBy6|w#KcLv#Z$6NQlqz~-kV9U-QsF!IR#L?+} z%dwp=)$Ojkdmn_`EO*_G#rkx<-Sz#G`gvM^bL@^=fldqQhtAtL?^Cp6dS~hb!*%Zovr7_h2mS;73)PBl2EcYskGE=UXQ)-*<2Md0qgOtUJjZ89S(XC&Y6sWVS z&cKmEQ5NY!U-7v?f{c$4D6Ht!`9)kOh(|0F9xu?N7wy8o7m36bJMj&`1_&L8_%UCC zN@E@+_&iQ6zW_f{Vg=lT6*^7AWuiKrzj%B#g(IWmI&i%DYef{BRXRnI!7gs@jelx${LUQ&kr>~+2X)nhcHeRuvFFd&`jlw#t$V+x zU;1|btxdTdIw55DB6vhxz3S9X^-u(*C=x}`8L0bj*y%=2zw_sN3H7Q|TYSDO#OW3) z*!d&sLg?3Y>4<*lxQ+7`xy^cRvuK~WgGdr*SQ)~9j*Dt)opS4T4;64TH;)S+xs^l! ziD>spd(_VUA0qPS;;`u2VQWOuaFvOoMe`@?nnEUpS@ zcJF*jK0CR5wrP)E`jh3+-TN;tD@y^@Wy|wA>e>0Hs+&%4X{@)2WXpm&>H2|5ww*R+ zc=!JM0R{2puKkkTg^oAQ=+X7jpX`^CQ#d3V-D}X*gP!Th)D!fM@>bGNmg8KB!$>pvu8Rc%i&un;o zd3@(@b=z@W81tPs-c*Zs_s%##Zx5s44?5*3(umvc9ctI8>>rxta+~(Bf}>#rj!Ymc z+QS5baybZtnuanv9u4=~llzBvL!XvjF`U@Lber-ydy>=C55Q@d*)4Bsgi^7qB=uH^ z@RWM)Tb|tchOPu~ddc|wmf#Zt6IG(w%{zhs8l62&zs7iUkBf9L3{W0MY?Znlry#X& zNH5izoov{8dU`hRHOBSJfQ;{0W7r4^^XQJ3Z~lytef@+frmn6Cer$yY~S*Cf508GmmB28So{^+FosH{Ia>HEmIb7oI})UQ68(I53YAE}Xa^M6WN4$p+6 zi1ZT)-$QKM1fKX|fFW2y_p;9r<#rF_?#NnL+mYSH3FXX}_f3dH@e^{ol??h3@T*Z|c0h&1hu6t~7q8XjcR*k$uvh({I3Gb4~ry zw_MrzGkdOU2Q)}8;T`>S?9NMvK*8jO$=x3%aiVZ)xkx7pr^5KPry|Q!O}hxx@z&3A zOEhfW;k$2bqVV)`nF>#b@oP^5U0_1 z^c*~_>zfk{xdm5wLvMmp_OA2>J+CR(jgjI+>r}=dRydLx4&S4HP8QUOZq}&z)hMK+ zNxDoM@xLL2j8Y|rUGDR73We(j{qkuV zQiWSGiHS4bAQ!lA!!UMV9H*0AbgyI88Y6pz@t%cx#VMV|{5UV9AJyjj6dm@|SCFL0 zV@1Ct(P#Gs0*v!QjxxsFKnWU9B|&z;)T(0&opn8XRkeuI=&7Nd}q@KZV=X#M=18ZabPz&uKU1)B zio@b>kPa>f(x3uyW}i+j6TtE8)1fkdX*$LnNNX`~6pcMl4nP`6111inwSYM~Nfsyv zLy$j>jwuGxTEGbf0&zy2#Ns)lrf@QD4nSRw%<#22{+a>ef!11S>p7aQ4>~AFcc4C~ zhXQFW)Of=|&0%5~7C!&C!@yF3w4hQG_v{45K@{Bg=~!_6=o%h>DQMsPNx>nE2KOIf zBj1Ok!QD3s8=Aiqe2M%?N=az!tQMGTG)S~Yg0M0I2RmQ&BSD?)2zHLYRB%?aa3k=Q z%Cc=(uwNG1NezfuutpjVvw(B~LyBAAs~`h5!Jh=^_9q3GJrnFQxkC6pOhf1EPXhbl zPYQM-9n@vhU10tX5$V>S6r|PZAbCj{RF3WnatT8Utd^#lN#j1EB%N(^$*vL4z;oL% zQFgZ!@RL&)kb#>+=aJ1f*Z8b40Jv78Cq~!#XHqDSPj-@%++O zgypZT2mT0w=wILbm&|%U5dbTQ3xW6w*{j) zylCAw7<*BcgU%B&$5rBdwFb`KVMppWx^b-qN9_xA&rag52SEZzK`%VwPG6+jaQ}$h zc|s1qo&-P%UmXFCpL@p+J5aljQE}VMa9eau# zV)sX4=kLWu#AyZA+&QkF97g6)wZ&Dti|sz$d{B8nqDeBxi?HHrlPoMP@O=9eBu=pwa|!f#4*ud{rI9@f*UxovJAm7x z^Q7*VD8)LZ+;preJX(`+8~G2?zpiO$EN=gEG(3ean!!mfV95{C+{dqx&qY z!3Zy1XKxkf4QxBlm*jEea3{~qGG@WO#*=3Ohp?6FE1*Hfj=^K>p$MFujcDAmF5GKr z&6z}bC8H10f8&9qOfqFfv zeqmryPo3(wOXjh;qrZ&#K5+`Nb-lUsIvhU8uY)a_h}=o%&mrKcF%hWKh&+u40D?Ofmot~8=L<4yy{y8m(Ee}?vBaWsglI72@E9X= zWsTjeow7i_j!y^EWoZMSAzr8Ng(Tj79YRgUUKct?z!Y|x>aD9f!OEi3_Tz?}H=D_Q>qxlER_19qs)DFwa zB!|#$>&qSAjdr%r&{ba%<=(-nRNO+{V|RY8s10$t5#_z1TtaSjMpK=3&;FsEEcACh zFfBrV*ApfaV^4%4uAe~GBgi_je3G(Ggz;;ih#(T0-MhcmJzKf=hTTiQ`R4Lt2C&rWA-Ud`!;=zPo#0odQJ#M^$P& zBEjPW>kGCe3*>&#_1)bc{cCih9|70UiT8P2ET;MkmzVV!6&<#y6xTU{CD@Q} zK2%g%Z8{4=9?*`8E(?W^B4a^CYL=9FN(Y*Sv}-Chvk*!=dQH05Q`HnuYm%pfRu@7O z7F66hv=E3O8xH%sA!xStGF5hvS6;c4$@nB?-0o=gtIJm)um&0^Y%nr>jvNMJpfRiZM z7eIX%!-&zfKCX~p2!W_2bTy2VjX`>Yk@B%zUQ86t35I??opSThNv1K)o%cK6Y#qC; zj2V0cO0G<;+PElC-4gCHS>Vsf;TV|+{?p=q1bV83}_)qa#Y*dp6_@<2-jCfvk6a2=_GXJFZP#2#rSBSyxkI?u7J#ZX+b0Z@L#n zpTp*G=B28{h~o@mai|o!@eNFIB-$CuE3A8nCmZzrAYFH{e-;h)VvOA z4NH*}JbLNwSLJa%c4X&~eB|MsDV25P(%sMNtfRVodn9uCL!Bp#SMz-x=2nrYXw4E( z&n?bPB0l<4)cdD6-W(zayTO^UaqNjw|O4YZg%TF70L3b%RkG?fQHx;#Kv z!4KGu{0of=|6*ugPP5bb1;!ob&+nT*B0n7ntYQeU7#5{^J8eGw`34WZgP&8hT*)%6xtGTGNu=W%!SUarl1cBXD{0 zkxxEM)0qdwz^2)FOkH72B=>XSCSQ2*0_Wj`ZW%75xVo38m5M=!qpnShJ2QYILrR+V z1OQGke?T7*>kEfpXu4)F+o%}szDlt5enD%X`=8VTJGChabW#Ebl}Jgb&VR!XK6JAzrcpz=75lE#t+C?fe#Lp&*UenI9~}GlLb$!i->`NYSl2v(NCBT(`5m3 zE3d3QX_Z$#e&xnCAQtY!E7w+Dxwdk3{Yh);%C%Qlwzugn$PA8DO{^npb$jg^%3ry1 z>AFRNL*ZjrS1#Ar>Q7p;YnN}}geFcY(vc;6y|J|h5FN3KE7$6)SFV2C%8;2}zJ!?Y zG%ikXBzzoT)6hzaPF{R$MPBx_5#lKgMXQJcX-vG!Xwww|#+#4tX2k-S1&XLk4i|cI zk{lD7CMVD+83?8j=>U-@(T*Qb$Vz?VrR&=p+c&n?$kuN?cLRsF$lJbjd3EbXeGMAn zVQcX+q9o81()^smJ(?8HgwI1VC}2zJo{;+Y6I4RY`C8qYys~@ASPj;U{sFoV^yMozF4qV9AyXkT#N?IBYjHe7r0ri=Te-Hn4rqzTkwjN}sGx8N z2?w`(e9s--zGA(Mi9Kue9|vPJKq2S`3@9#D1db`J4#z5e#JmZCmLY+ny8NB0b!FAJIq0on5fZ8@hJ)5G?)w+E78)_)RVhG zh>Imo6r=NX3RAv+oa8~CP3BvS$LOaXRH~_GHtv4ejMuQ~xM#~<&>eC@t+zKCJ!bdtnmb|A)`fjsk{U{)bK3bQkjuz4 z=s6xv6hiF>i2=fM0gn&t=>zBy8@;3$G(JIM2f<9y4}%kc@m&R)ajG^M1<;0IMOghn zBA|cg z>uaV^vps5b}YgS=R(Vuu_(fqpom46A@POl?pL07y{RRsi%=C|gLjLVn4>2I9&K z3zW{k;4k=L;T&hF}=M?Y8)FfRYX{W@PBrpmWBNmfTxLEM8V`v=_uyiAnm1-!ww=>0{V zj>9H_`-;n859E}*qs4V{i-j_spNGwE97KtXl1PDyt2B`Z1;Y(QR8sC9GN-`*y_yFo zvKFfdLBkM1Wf&r8ZZI{!3K6C)_nW!Y(ZOM37`p+2?Y2! zJRn$EW|g3MV)lwu$jlN#T3{XrHQ(4qCBSLesQrv2`X{cft!%Gdw^rC!V!=Y3DK-_8 z=fnco32>TMUbg54h`QpMu#w5M-!FU*z62|GeeH7nI+x-vz=*8ih&^sRU%M6uGXmzV zzo1L-Vf^c0WN{Q9!K{E2guOv0UPkLH*7a?C`AR=QQ$IN4%da4ZI`Hz9%iB*~-}vim zPpxgQ#;IGYns2@ic==~D3{k>ldiAGm%8f~I!4VC69ryu!RfVGV1++*@3?S) z%>dH@e#xZ4uD zMpr*))9r{Gt|}ZT+xbcQbkL~V$@K=9p=7w13w00#QPcQ9y~ZhwA7tBeBrmk9l8f^T z&?~A?8fKaV(~uMu2?hGb#W~f)EbiW#&6m9w0<nM_WKlU1K1q&pln7($%+Cr~ldRZ%q^-tQ?+ zwo%qI6Vj#@ePs5mc6ew|SB;^yDo2CCjAmk<1!+YT)9jhWyW5Smgjhae06Sr{OTH_m0Z7Z_3D*t+x=+O-C6bZM@Vjpm!!QjH7Nf)!GBEA5(J`G>07wQ`VIU*UTVJt8y413rzaYT29WAC)(^ zJ*cW}t<^P^zfiOBe?NX%=Bxn(G#_YJ=3>=BCL@E^_{!>~SFVwYkYID-%B!zp|6Io` z@@2s|5!W(b&+mW`BUPoswwSnn`|8?dKe1v){Kj?YAF1P5V_co!tDhEMG7UNit?d?w z%*HAQ*?Rd(Kd~OdnbKuHh#NEjV42N>)8g&H_sa9rY<^(|xi0FE?ZcPKGk$MDJ{(aI z)D+ib2u&e5lKX5_z*t#xoy_)m%`9m2Hk7bgtQi?;c#aRa+SLrzy;3<`N+1@m>W&!mn zMa0!p;wJv^xc6wIhRfkUnryI<2x!`sWE$T_QC?tP+@;YxflttR_xeNaoBexd{qagz z?@n)~3%OhgD@On5nP%&q^~NXKy^E_g3n-$0dgb1}KhG*wPqR@X3NR7Th(+Ms6jxf1 zGea6`^_@qk@zn0)vORlCcZyj}E$08^yj}Z&md>A&w`)JpB-?_y`{{YRb}#$(_RQT+ z&)c;#+xB0bYikD+2Rqd}};YHxg!227`#f1 zz7zZpRh8Apo=i&5ds5_u(sL8i0d7Y9;dIrp_tO9WH9wQB*L}7;*?Jz%jkivpth7$g z9Z>%P>E(B+e(ar={h2KukUn+5xC-T#_27P|*6HI1q~{N)=O^uFuJyXi9?+lJiPrs@ ztsIa(G2MDxxv2xvTi5dw&;LR5a8P>rfOR~e|FZ}5f42CO_5Yx8y_XKc0SNj3`aEC= zE#Vx3TI=)!@Cm4F%kp`<*fJfWU+_OFc>o;;YtXWMyO#-KHO9No1O=KFt|5@DnV>+1 z%t0X8mJeE_b4IIlV%XkG#|*qT4*~}7&BJ^1U?PO~;Nd-Zcn==T8ThH;p%srpbmyS- z7Ay+Wsa8ArT(tkveyC%}sOH>Gh`2 zW$v!`N2~jMzu)(E7bImX*Jx~F-`lru-}}Dr@9+1$9i2_h*}2r%oSjLH*||B#IFvV& z^X7?^F=FRRsY1ps=0}V}g_Jp4G836?)d{nhGNR*$dwWNzha{SnQnSX0acnHRd~qx` z9-B1Ar;kS`k55HMjM0&E7oL7*wYE|=E}TcBpIOYNW;3a!pZ%%Y>e-9S7oYv{8^Bsqx9fM(>C*>Gc(hp`+td$3~2^7gyZQRzCjB#r5|eH%h6KB`1+KR?+#~ zLMCJQAB{vJBSv`{Z`h^J*zxh`$l=?X#JdmLh{nc`9vwH1(=^5sOUA{gtH$x9W#&$# zien|G*BG7472VO&sEZ{)E{iIfc-DC=b=WwbFQgu`orU7qEMN*~Z3Dyj@z~^u(fcmL znVgw9+?zG$Q)ArsSn6cnDU^y46VN$6JKZ~)H^z;}%#1N-MCJ9gj>W@9U^*BK1p32) z)jIfbF+5Am^^BnFiTddpx$guMh#hY zx*MBN&7#x3+Gzv#Qpu82Sjw5%)ZyNoo#`DlCZ>!LMvyTq_=Ss?)+5Wc+K4eRZj31W z`5@mOF`^T0m7o;Xb|Fu26fo$iPh;A7kQgp#Khp`O zPu>v>1mj!Xiv#`3J=RvY9q#&?^;+dQEBKlfdg;RimHz&HPG8s7LzRIi8~^zuR8!%< zxjX5aLH0!B-{i9G#z?&xJQHqaoG>?Fn6^LbgzNv-=?k6dtG||A<+@kXTX)P?hEKg* z|JC^qyi)(=z-TlYEl-(Tqvv`1p8K;K)4`?c>LfEaVpL-0WDs;FPd@ zM*vK~%^>LU?PMlp<`(i}b50>!Ji;i)^@UV1RdOq1odEtP!B8N`;3zYwhWXlqPxH~? zbD=_gs2uDM1}wo&`Pm=p+WPMmK}K5Pq?64XlT$pcxq_25Vn+?Uxa8!C0HWi@30=Tk zV^L!%RWzc49J7hJ%n4(XALZ+9(9j4KGk7k=5|L~kB(-CH1QOz@CoQ{J0thC&5{Pc1 z3q z^_wvg^TnlNVqp#w0u9n|eNUs(n4B<1&77H8I+Zej7Iv;x(G>xU2b@-X$9MGZWiWL(vJ*v7J;GG7Gl#*A4fS1RVsMNA$mN*L}eGEx)g#-jZ< zOsqS}Gh^yJ+tY6d#;zuZhtKxJ&8@vW&q_IY*B%1ENt4%d;~uMrime0kGY~u*Y9_v5 znZi~zf{%ltbj5jj zUH*ACVDh@RzikRKv>Q)0<7fa&>oLT` z?zm=}i7zL-7F$Dn?fu~wp6#|0A`&WXu1E-JwHpPmC13H~ZFM|Q7S;Wsy;jcYtE>tY z=L8~7pZwy^a99CubDw||1Tz6#7d$AYG7+;FDMAw}7!%NpN$Qbc#(GXb(D;kvGa9F{ zf{}c(lz>1MqEQGDJ37NOq>B@~JTak(FCwUgaY%DuObqw|a?_84Y^eyDb*y7xQQ*9< zT@;GlX~;?SSadR`$N&$MK^+STGy*voGvh`fpCMdMIt_` zSSn^M3OHagYFdD`T;)k5#inPB(a{XdF6dz=Fxt}L!(=lUBaozmDhiH@GXOU*yS$xB zvQjZ+lIcUsfFXfvNIkSdvj`Q3Z_QwgcF8s~jCIr<@eU}#)Lyj# zcP}asE8YU0N6n%}Qq`jXp{piIY^9jWn*|fp!CC%&a`4Hf(^uC0$d2U`0oHq$x!>2n5{uc#ZD$k{ZZ=^%7NYVRgTCqB9-lC>^NIwBYBURo z%%+$VMA5gd1A-l!(nDRy*^e&Rb4zTdMvwZ2MeHS#2ltpOz-}S^e8PZGC!+;A0Wl{# zS4q-~7Fu8`3FbCIY9=>x z^-QS1e#-R^(Ia9OznCZpm-!3F3vs$C!#q$YZcJer60cU7}V^=u<|) zK4F!lJxr6-oVq5S1cH_uut=y?A$0;qozOA0^vYz}vXUVUNN?E5C0Kdr;0t8bxeNi$ zgJVY0T^3OOS3&7r{m=B6OxRspsr^>9f8b6c!Ps5x&3K>@%8=lnJnWm|LMQ~ zZjq!{gYN@t5IwncW*}(s?U$T^P|)VfmvI>iruq66F_(Wic;-OeAj2^17%bJDA-?Y% z2$IG-Km0h^h=1V>f?S%;Q1$IIL!j>`-sQ2(@af$ii@wWa+2JR4d+ZKj00&#)Glyh) z2YION#zW3Q=4j3#8ML|$RxuO`zERE%9%_QwIS0WLUf*v9TP2SJof|0!=lQ9{kx($B zuR=iqZG3TLu(UWrcB7x>nYchdC7@x%g2xZiyJ$>+h&qvbXOro7Z*t6S0^BdA{1h^A z%+*sCay#$Bs?CXg8G|5?u@B=2TLt9JIKpJFu0ZE%sL)aP72Z6e-c)zq^yawp9`Pj~ zn}kB7EfoV|Utbd&nFKK@E-?X<0$f5Bg-@`SM^vI<3)dAWTRjk)nO3YP2BpYaSuU@h z{|G!}P|Q>TJ_>j*RAJ75??&-7yxQeIJBP3NkCC^)Ori$8oc#er!ZaG;1u$f2qNZEzE*$ucqWDl7A<{jCtEi(sCW0)A}lg`ipQ#LtD?7@9@IC#2aX}*<# zqwr346cTJ-C12s+1BU$g$df>0xv z``o8|G=ZjY(1XM}&m3x&okLKtoP(htbd@qxl~D7{aML-k1$6}79RMq3zIyfMNoV*2 zXAU&$|1&TOHT-mrph!l36btBIvMBEARfVPaX&@HTWDl zB*(n#);R_TjS1gcX2~0Kgw(-Bdlp6!uLq46L8xreuRRmzSb3`al}gxpa}IXb?^$ba%>|liOWc~jq%WG{ zukrU|ie{+{KMEg2$%hUoFA`OfgAm%lNxp^&?%jZ!KWk6;k<(nS_1j-a`QKv|D0>%z%^Mt1`$}qDKYdcdy-HP#iImEuJ9y!xHDnyO^O+ zkC-}$6~F1agF`!LTIN=7Sr&Vk*M)c_;4HjQjR>wLDJx#-cMBng zrENXtK-yiTeJhHc?lP%KarGw)4x*zxN4C&tW^k`M&|0Zl>|dUra)V)lFCqr8M^NxH zuxaF~zdvY}C*tidXy?Hdx!Alcze{WFja7S3*XPB(zVSq&49Fa8T8XM(S}0(g?f#W- zyKw5hlK7Hvxi<%a-@j?Gmr~*em2mR&@g&2pX(p^$CI&`iC`BEp$O@$Z(zlXPa0jV` z1VmUR4=-NHfUVvEawy`b=T4=_=MRYIi2lh|(2gz&%WCOF=%ts$9f6PeN7?!5;v#fD z-5Tb&zJzN}$v4p8v@w#ett_vv80#ywm2;PjW#gIJ^0^h`sS6j4OO+L*0IaWEytI1Z ze8lys&D&ngnNVCG!{@pZ}Wl_T%fYj(Zn=(Ogk0Cl3QL=ZEf?63jTml|T!$M>QE?U3}$huHS zskSZ@L85TOoGvWnaxl^K!#=`=_oSrB7V&n|&TXGyl%oC%5)E+4^l4ym$i-byVwX&I zGcWG*C7vMTCZkt-~1y?L*`x7n|+xYhHOFiX2;{V%{=A;D(tV%9Fg zTXR%TK7ynayJ)3m;qZW8y8{Y9gwBd7_(XgWDJWE(_rWMNOgTd3GF>2c)+{V7a->GH z3Gy~=1FQkt;_y6n z$dYw1<0=?PctjW>M5y|M+eOM8*NOmr@w$k5C){krzA+|0;%GKV(m|uhQNlqu(b#U8 zg8!$e3qPvZ4i4^Rv0Y)0Dp=tscL?rS_qz-3&9r5=8;{s=MzhVIvKi;%m9lt8o2J}o zige$2U#EDl-=iMf_HP=vozv=0hVFb?*{@cxKh%?D z=FFoT3^b*bv#s`5>?@UFgsv@dxbWh6UJi==Be?}}QaH|lTUv}$u*Fp_ps}gN?$jru zV7DDy+@~}|NfGG85GZP@W~Yup=C%8djKY^$Vdb9MBAGK03Ro14W3Dq+u*>&yk_fjy29>e z4BCV8{|Y42m1sN@U+XXQSmifEVFU`8Q-1P$U9WXkv;wbZp1yg_s&zAETzj?S_NU$q z{ZehV{YGZ~#>RcQ&t)@z^1Z;PvYGF`VyDdnQ{>w(XR6mu*S~Lvf4pydsPk=Q7%ZP{ z)*k!?v1HU+uS)`f-=>HHpWgp|vrsUX#>m7U%PnLRsRH};Db7dTf{v4Izy#{s-Xif#>64xo8Y3L*~FqzVR8W{tAP~Na+s)UXD3KClDAWsGzwKn!#c{ra#umzrY=f= zm{x&xR9PNy9{sehBM4BL22-#kUAh4)ycB4LjHcCfXr&rEj(wZbC z80AHDvM5)cm2owAP_#+1Toz{Yh;KbN-{&uc&8@ywtP+!YYc#AcWa}e9P!9l}Zm*%J#n;Uz-O^hERj90!5iuaaZ z5CbLx1;+2PX5B?=U9SIHivX>ffTAgB1q?tO1*E34>wv8?I2b4~kC&mtd+?bqN^2=M zB(sWbBxs~AMVLG8Xf-AAIVORZ3MsYdVu#IDURl4idVZPgEZ6cvQv_N@irm2n zC4Y>}dd)_9DIs;_X^8L<1ByE`!k>8-gtculKI(E)mW1zux<2Sp*V#b%&EpW48;8nB zvg4KUmd6Dz4_n({{WEV+{&F{%pK;r>5}`p@N?ne9DC)I~uD$ZAMWaWs<<{Hs;KY zv7*J4!Qo?%;gRbCF$dD)Jl~9};J`c43wdgMR&KBh6r+6D$U0p!Z+y|DT(4_y!zWWU zZ+wGFH(n6OMKi%X>pSxEP5Egiw@z5C$d~ay6a3m+y@94#y{2?+`B{>-jVXKWt+3Iw z6VRINTF+a7uBKfX?8Be>Q z7OD@~wJxr&@@uM8T}6ljFX>L=De3gf@*_jLk{rAd zky{13DK>#T8eD);LFMo~9}s%f9A-ahHKcaH4UsxwA{DG~0{(Ey`s1gdihF5Mu!K*W z8T&*I7BHtHkQLlfLDqr4C!{`jkE=1#S|d>q8hb}eEf|4l6i{?$V<6C}^cD&z3J7u~ ziyAQ6C=?{Av<(IQxVHnf0_)^fKu)YuePZ#}5HI3OCMb8t1g?QLdY_B8daBofZutHC z8^2|u>hEuC46oId((@AGB#_X&R=p-Tx$!0O6`$5K+}cN+%!U{NkS>k)CI0X zd)JweQJ8K1GBSSsMRLXXT0>>@ttnwNf*`kE@@e2M=Oxl^n<%0iZs|kJcI8R6uc6Z; zh=J!g3mlofw4TZV)WJj<)4Q~05BIOQ&4g)+dM7t)d*2ET_+Z%>@)ce-^wqzS9$u%>n2km2SWcpG^fv6|o~{vs(MqGflm z7PUa+XDWDpN{YJYSk)s75rPeYbV+NbXcfwcVGu7W!f%2_AeE3FDB_A9$dLkwY%tJY zQM>R-*%HN;mJDhS)1bWfuo2o9hRhSG@|ml_e=xtK{BPt^|8jyg3FUoDh)+(7KQU{Y z3HeR51`v+28-vN;QZ-E#lxoVNH-_R?LM*R?tO_=(SA*}5_dmLCew(@fMrTDUfM9$M z2LHS^_+Rg6pbUP*@pIW58%Lb*3r=4SM*q*_=ewsVnD{OF^L0cje?7DHp4DH>Rj)l+ z|Fg;fqNXpzt^NXH|Jz1@Nd2}t41xmt7=;to!=UJX$CG*_NK!oD4Bgn6at?kTd5H%w znCIyCyJrTSfrK;2Kvh6+4pgtv>jsc`HPEboZ~vzOCP~E-iQ%y0HH_rG(v`PlpBYxu&t*%iD;Nlhok7?a356qQ1n zhys+jBe71Z$vb$&X(yr53VcQwMkbZo$bv+eL>{^F2~L8Gaw;Xwh%%o)YrEN~rn_Ti3SG!7gc3kePoPAelNwo$!oi2oJ;_l#N-}ph9D>ph zx_dWFdI3p<-SIL6%=6;+32aiD?{gJVV)de{-$4KVE=#27HxetN=(~$?wEM&@KyJ7NpQ0N9D?kt?^(tFa!?ow80q)EpRJ6!tnZ!EK*B*$x8V?Hi+&D$LNK?pc^o;vR3CW{CrkO&ceb zkfv?vC*c?c-U#Rt&Pgg^6SLa_`GahfK}*M-31f+VCU=Y!m7X)q2>jWe_o(gHi{S;f z^;!W+{aYMZ3}0Iu3?b+K`U2AzY9AXucPFpI;?M#&8eSZ_w)1X9s<_Eod9hFUL}9q(B@uxa#%L(Cr*4-WVDchB?S z2Y7hx&8{@qK@2Lg@4CK8-C=$Qu#f(w95_zqw}`VuUDG!`+p%^b`B94WWFIH^THkBtqH;9 z1=z+%8};G*;mz$b;ttfL?J3^ocG|(p7)QuR`&TvkQEs#b6A_CB5)lb;4zlc)@OPYW z+D2n$BP5c*Mo62<(6$)Qp3^dt5#D`2c*i&26AbJzTcJcNV73lbW(7~>2NjG9T-X1B zz1hvD*UGbAmG6@E6U%1HWb;JYYqNF0SAeCKo~?zPzPtOLOl;l1IMjc?FeOGj{Z+HsGTgK9O&miyj*{qWYf;g`%&`Usonb&54$z8g7AI*Lk`?2P5^+i)sOubKtOvo z^&tZ&E&C}HHbbq3JW`=I_7F^NtAN7X;n0DTz=ua*7#)a2mH=f7%%)(7+j-g;NGV%{ z;EX})XacDJ8a=?1KvD^3Ava6N0zqn}h+mUBFX41Vdl#)#4jItcX_$hM58>e3_JDrL zCy9PsPaN(3EG;p<5CF&_*Xgx^Dg+$)T{tIQmko2G%Anr#a6p-#@Z=x|x||SW^K3vE z)`6ETTQz8J4BFyFZraxK)hlacqwZHa&H-L~aUJY%0_ip$Qf(gES%>YC$|=OEFb8T0 z>v?6P5O-KVuM8moOmRIrq@F654nVGO$nVlICl!x@cqFUjlkZQ2nR5$Ux% z*amRm7kT3gFB2k4qK;Ot(~g(58=J>1m4dZYe|Wxn-JhDNqMXh8J?XOD{#J8-E#2z5 zjxF%5-mPv$HVi^w{{#(-9IqXNH_YrRsTA?5W85kYH@s4 z4CS3E-!){otew^=JJQ+6QX#0RTx9a3=>oj8tfx|54r`OULz?!EF9PhEvcRUcyZ?W5 zi2v*^5GQ!Y5oFpJ_aOejEg=5O^8h3Pdfz((`p-K7{f7+b?^yNk{P+P4aqfd{M_dJa zQ#gvVE1=!2whE)!LjsR#VIeQs^{hJPHfyM7CAl1#;SuGAf&9N zAqh@lmt-4|^u*>mIhluzZ zELX4}xm}}H&wTlN1Lxa;A5{MI{M|Qy@Rxry(44OgRImL><=_8NVE;3TwUTB&X*@ps; zLmHjNTiyI$Pn?1p;$4ViJ9zyO3aVfT-4qlNSA_g+1(^8j2N3jV4B6#YVAf2egx!}L z3+Ol5h}o?>nTR(=ZG>`PW4OrH%JSMW!h=s^cAjul)HqwJP$59(wB!$-9 z<>Dtv?g8@WAE1NmNq#MHwg;Pn#B0(1yzIBDk1@`-U*Mnmefstba{E{0?xq|tB)TlZ zPK^ij9;k>ZEq*&GN=xKQrPgKL-S?}i{sqxUuEdwhUgkvOzS*s=gxUh*RSTI`^dTpW zgfE-vWMeX}UNI14Vrm7HKQW?TUF*h+z3w*tm88^cbx{N>2HV8dF@c@fK9I`d)D!Yq z`zsQOB`!W2hE{hat;#C(?NLt6G_k^ zVJ@;=G#~Znkw#%+>3TZ7fK*cSV&m{QY@&fPhIui|T=Wg4+zX6@7L?}V%Tj~MNL|Pc z>I304)e8Pjx+UHn?jO=aO60$$dz351XJBDYl+6t_ir!B{kxf2?-9&Ap(3c-7acJx? zsOl(ETP{3>eGs2VEo5f>t;OJxFGIh1g#P4*;uZctvhdQoQk)G5fmpwUwpwz*V>E= z(wP;djmMR~HaMyLh?c#^C@)r<2(H98Es6cCs=NTd{}}EropkN#$39()BG7_gm}O^@ zG=*JU<%{+OBPbAY`JJ&N=p#AQUerh6>2pE*9oz0}eE|tLm1!3Y9p%T*asof-49ZOQr(I$SIII5Lm=wh2mR%$ePQy!nCWYo_w

    e>VwQ(mbmtdwuN&EY^Y{`v%mgFawAR_65rjtOWp3>`mcz(@yTwm_e2b6 z$>5)ce=iH2$;EMIavQ+r%LDmhQin7^@*Bu~i3w{;B^@W{K#j%uIplL&#GL*R;|lrs z7Y~!t6&ZJgk>1~B_xJC~Z1wFIZKK_os)Wm3Uwysu^TF3Mq1ROH#(zn#wm1G$cD21V zklnmHjsz&H+?uO(XYcNNrT$%uZN!ZStT(3#WcS)=JcK8HU+vklS{e2%e3Et+;lQhb z#<;mLCYb}QV|XKK({*XPJ70)rfot-HBjKf9 z#*E$_6D3}ZgGg~`3l5URVQP@t9rh;Y6Nu%g^M0U`kPABnLjVzWh-f;`;2$rALGoE?qDly^QnMmd`)?vE^rJ!iv@G%!)yl=GF_k`g=#3_NMO*(+nbISTi+?(NcD@_i5QWMpa z-rf4W)l6xgY>&OqovCG8KdzY)@Na*jq!%-bD88c^%AFD$5IE8z^A)jVmQQ|`K#kQ6 z4v&1$Z3_PISuA!}|F7*+IcvknSv%X^L~7bgQ0XD2jvzg)dcFRjy8jc(XVY_1U34QK z;ko!r=GQFbswEVrsO*qaOxE|=q1Vb8GFd{em$Qh7rh|46(4~`I5GW18pICPK5X(x_ znOJ2f41)`F?(G>Sm_&HS(AX6caUIVCC?o1OgqA=~sozkl84Ei?k-*JeDoJ7^+}_dh zRw;2b7=gNyGBA3{NQILDu|;UZxK^$MT142S#kdrZzF#YTOmc%#e9~EqmiD*(+;jL&_QSa{AS^{{FpoBWu^^TKnon?)^-k z$i?Zzi%y^G;(_C*@d1>{^K-yg57*BNI5iNCj5qMNck7M$+;yDCu^}q?Fe$~f!GViQaSBN(#~xAjt_uvS!M~)EVJw;)A&6RFUNF7D+Rpyb7nnp$Ct(wMVg2X`RdW_6 za}bx+4gexudV*c~;=bCQbc4Uc>&8?QZ$%PYcg9<@TYH%^Dnji)yVopNZ+xX129#bc z&jU*HXG4}*z0T^HWt@`Z{~8ac`TP&%%DM8QK9T4Ox1;kv?DThQgYD9#AE)HYy3t@HwIqoS1;8$ZHmZO6@Cwclt^QXn7@4 zwyC6u5J#_QhZt=ib>FMg?PV0|q!lSBNJ#-3vWT|009i?gAW+tuOISGQSbvV;mTIAB z28t=ueb-oCX;fr+CjjNYXY9{B;a{X${qpF zD*{eeuL}uhez=jBn0~{$t;a#Y_w7c&pSO%x&Fb6r-&4Jf-BxddZ5$7}PNUJpoBQEL zNp zY07j1gM37%`w)4Sy@$xfy@Gaf!87FMlNMayhcVr-em6~q*r-`j?w;qQ>IX` z@({sq48g1|8K_zAo&?g7ao1I~m}pVKs3ZN1YGUN!kQW>_0{?q2 z6l9YP*UwxH{Eb}UOBG^)V2=lFk}Ahxg_Nr>HLTVo*&=r~%iKWD(pAUkp7ME1PB(rc zUE4#?rZXa~541vfUUgfgG`uu*nuc9dPEbN#0_F>QGAuTfA1`k{si<*ysVpwO1Z(QQ zq1?tju(woDJ<&L5CwMm+j3cN4IiH8GIj=G^L=M~H=OY80Fj=Q>vKv&^KoY~;lx>PZ zDC0@3jtBghcb=rrWRC**q^n)e_#k(*`&!O8bUTzo5wHoR(|_&qa5y~FP>8{+qtVF! z%sxLl(FT)1S#n3d*vvmZ6S!jxC2loAl#e^S>V9*kPl*9%}YMB5OL3@ z-1Wp;Y0HvH@XbSLs)QSwExuHSFqKR`aTf1}#W<6fv02MaVD78HTzwYJa*w%HvRcFH z&D`C$X(%z$_e3+h^@LS@>tvu=rR@ZQDq$vz#cxGFr5^na>iFCVuon#6v1^2+piZ(KN7RF47n-0_w+*&V&42_?6u@*98#`-fW=T@Iu zrB6I@WC76xq=jtXIegxrFD5LXt*z()#8aym*Dra8HTkE$-D|BGo<B>C*B ztxuB>css!caDADONc=FeSf%1aP(92823hPV5z(%ku#o? zM#NKAy3E)rK4#u0qXHc`a*}e8G>a7mD}CxZaZ2fu@J-1}d)1sL5dFgZ)~8qNzW^{1 zk93po!H--FhT!i+V8KM%v98-gzAL8Ikz7PJgFK2enC4~UOGHw(C`(%zzDRA7jf1H2 z`9V67Scj8|p0tB6%2Xr_k(2NFk}#IgFF=9h$Zt}j`sMH{R>{m%PnFXn0gxDf$6Ry zyTXU5%B^r3DHD{2@Nfp{5#qbL-%2NHUFO|=k2i*rU$oLV(sg*)9)5YA1#0`-R)$bK zLv96iN&)bKrQ*P@*rH6!PYy zj|u`%4Wj7sbHsSW7|C2%E?<7eSif}nsi#H`8>5fW0df2^se<@C0DlGT7T+f8{9G6D z9{F+?p2Fer85}!^@4Zp5F@=?g)7PE2#Nk)Bn#N2yGou*KBlzlDi2|MQhV=XIF3v zwQ;Vpa;~~ke%M&QV0?_u+*>g|x?H=wGWN0Mi|5f`-47f=fvicnNrvnqAH#Xhh>QXz zC!h?N8AgSql}gU5&(g_#1TzUO==gbVF}iyb1K-O)GyMj|mFY7gi$%U8%Oh|FAAxLC z3#*hKxr1@irdEAR7?<2K6A6%xy2GZ(VfE3zTYu;ZBa%UL7x)quom$Ih0~8GeIdNOx z$RUB+Mz~&T)js=Sd3+WSaB*N6CFhM%$=~g)lMf@wThv1g4)q3=A}e3z z8hwX}5O96#w0+o8?ieo~IAZjI#zq#-uh*8>E1;*RE}uU~2ZO9f3?qN}Y;E-%c&q;M zA?O*b(*F@8=~X3cD8V2l|4H#WvIk>x+v)C|k3jwHJj9;6$MPe*truKl1;^_p$yh;( zsZ&pr!-rB(O0^XDI7zwW2(@az+o^wYi&Hez8)PK%QZ2E#m7FcaCNq1a6vVWoR42M> z$>~}N0$0^}j%-)OYCDb)k#YF;%jS1{`dJLUQ=nG`3KD>~fp5Yh~l?igA7w=LXJxZUC!m^Q%fZJd~3+4&@rQuF!dv3srGkk@H~PJtr$RkU2MTFA z<|&a1x$`6HFn)!7r-sr2Zrt|kDV_H^gg+}Qa$hDN`A2Fj9ev%t*5Zeoc7yB!%pV)6 wtJT%CE(>zIq}~Bfk3f-_x!aesF%6Jc$pL{OF#_iv_{fXj`=e49e^L4W0lxpCNB{r; literal 39334 zcmd6QdvIIVc_#=`w9H5}NWqFsE6O#k*raQs#EYaD*C7Cc21o!G21!w}Wy6#}n=g}& zB**bIO`SA-?6yrdX;M3{P3x}Hahf(1DDF0X1T*Q(Hguc1lXYgKnYO#lBs<&L=`1zb z>He{kcz@sH+y_WGPTJ|L#s<$l_uO;NJ?A^$sTe58lOp}3r*SS)O6O04)%9+^id5N6r0J8TfNc5z~qyw z1F^wa%!&?=Mh8cuL%mjC@45BIpIBO5s9Ec4RLGVs(D) z-opC1`PF+LU#P7vJROfD?|o|h{L0eWV*`?N@9NUo^YiDQz89_JXXH2X-o$W!Q z{d-+4fz;S)Fn3euq4ecPOgVXcaA{}r_NFY~GblYsyZHILTPT!l<2^$rSAA?1U8^u{bqn zMPqaWBptzQ7E`71NWr$t{Rh#?pi^gbBu?pUs%S-r+)ATEQ71bogU!83xTWJsrwh^8 zh*LW1b}~A6!eoz(Sg8rD{QGC~GZQ6iBFQYj3`JZE@#v>qjpImrNc%wxU;o<*wr$b|>d;2ddq6 z_vYPpXnAMzRy(w>b?co)Q!r?UuD*l%@=!4()q@vmdw4tib=I|+x*jTZnwYj z@TI^Xm?FVyc&p!Bbk;xYDfSJ2M>f{DrLTywxk#Kk(D>9M;dky{`72o?~tdthktXOM#}CsRXu;{$1j=+_hYzz{6(3o z`kYR~-8`lB5p#J)hH3v+Yk^BHa)k$|Rx`JEbCDG=sm4l<8`6g(AwvrFkw*FpX|8|^ zY#rvb`@?T?I+y3W=@;@mEcp-@*ttC97UUF{{(3IY7yQWL5_hTPC3&)upX>oY8X8Fm zH<_@8nEMbn0kubXy$oUPp1Ch;Xn!ar8+XWh)iCVkHJgtV+26;Z@1l<5??CTr$fmwLDX? z;^>L8zDkxVj%Y*i#IQCL8%|IS$Omh+V#I}J)8-2N=FG$c*@_Le0XF2M6KKUL6&)PL zoqT0_rbJyB8Mab|f}PPi;$Xh{LLqx!st`$4?gN(^8cJAcdnRWMC8Jg;J7*0+{z?Yg z`$bfe$IDc*zhn)?!DY*Z{ERg;n3SS}gHkjJ0pTs01p5{SWF?2A77u+AyxWM6q|30A zahEeEF(vsDro&2NBz16-Xv931I1w}1i4m94CqM*RI)T?I=d+otl|XkT6-RG01zDmg z$O%nBZ_^YpV}3Sv0=!pJ&a<&0Q!bWtQjl_54s2ag(G#YP=m>Z`XaVwVYMMo+mhi}^ z6A9<#M%?#=%yC|s2ZE>}&LW9LZp?jm$PqJ8n!u!jKoeG9AG3U_sK4JzV90wjsZz@i&o0Illv99v$y{suZYy(;9!(~RO2b7idkzqKRSBXY>9N8fpW#3$!2Em z5_v*5GKFlaG+Q2+uq(ysyQ~RTg=kqq=}yfSW+JL1K@-rXA)`=Dc^YNoMuVELXgKJx z>6ugo%Pms0OZgcaLztODL3(Z6Roz>vgtqnTf%ZVl%%aOfrZ=BjI@eL*j5}W}KU)@o z62HHGi22<8e9au@W0FyMgjk=O&8%pnS03DMzkkpBjq65|jauuyl^z z(27P`7oyjap3g;S;3JjneR;bC6#)DyRR%v8hXpYR)@GMaTTq71#&Bg(9L7Rpfq|aNl%wDsTnJA!Xka2rw%JY`A#Y`lRuf&$)KKDc6uh2FL}oqN`DmO zV+ioX32oQRq|DmT@SfSRxFxSOz{EF%nVrd*+EFujht*qNU6{YHU|o1(;oQ=rPh0cW z`Gv=pU?x4fe%`vcxL}d`O-9R8OKY|Dr(mNH?KVHO)>Mq2hQ;Diu&C?TCtke2P<16s zTv{l%49aCvCz8vK4=4e?6{*Ku@&$*a)!?ZR*K?#jhj$H6*wKLsY| zq0NK^4V>l$3UXiH{j*rtX6E~?Qohiy11e)ls_60KL;w&`$B(m0di=Oj3SUEf(O_cv zqM|ZZcJp|!`bw7esT_5j=3w`lMm82v#m<1ifUh!}Af{_}~s&aT_qcsBMJ>qBFy#af2vhq=SSeKZSa12rzI3el+5 zSXtg#+{xGb#GdQwYA=dDHSzG4B}r~!2~!-NIFzn`cr2wXLh^;Z{Eu3EZ0AL>44=RB zrZBKnrl;p@dt>ozuyN_lSt_x4NSb+3baj**9^-2Ghdaxu4FBGVHt`?pO=knBql2@@ zYV||4rJb+FLtF2V3>3o4f(Co|`no@RKbfgr4*TlMNV`2f2XCM;JH_>-_(dC;M<|QO zkcXA;-T8tT7&#DlA_{ggb2>tEo}HeCCIyyhm|Gkyh`C!F+KiSUnqd7ZH9qb-KXw0&VD{=F(#41aG)k9F8%;H@k&yBG2bJjS_Q04h?a7$T}aV%y{#n8M+0<=nE z5|(Qm%hz0ikKsCMLGu{rep&HB=Pu(~@j>brn5-2$F=R1=j6wU5`eQ>zTEwhaV$dSK z2ze5VC!8dtgIyT6V$l<-uEp?P<KV~ue+T$#N1t|PU^<&+@_0Ma%1|H+sVrun5fZ|k zn9c4|!W`X@bS#}n(y^4hNTEs%67B*+3a|rfY7^kG%t~kSGleW(`p<*Vt}0z!EfrqC zn`h;3{brU>e_F|{26;W-)VVPs0&aTi5a)3Dts6Kkj6kb+H)pv&d=oV>b7YE>1^ZB<6&-jm_ZavL?<1qjMx;Z{L>b!01qpoB>_R3$`E&h6oo1;b|K@? z$zhmCP^-;S!}9WT9B@YxY}58EFgUWN2rW`3AP=Dnu4ltji%CeWd=#l$}wt* z*2H>)vnrqy5eY+A0AMCutVwO4p+xIRG~VVBsoaC5u3)oDmg5fQg|tL7gRyKnX<gr@oM=Bj4YT4?mI__xaRWXu-6?d8u(># zI>j0h&o{AyOb)O0zX*g*KYuCkmt(7MUaP+=Ejr3GUm7zhUMX8QEPpgT_RZBJKd7x9 z*{PpsjII9iwJ+i42T&hYZ%=WdXO>s3G0GkLKIJ}aa<7a@>Po1#8rrGn8)LQAgF9cL zpBHMY9Xs`#`#NZ2mnn8!CKor+&y+=jPW?>5V(}@2nmt9!yBHGe|M$5z{$)wlGc$0rc+PibA4z zu9DC(oX4V=O3xMa2=@vQgnKdUtpjEjEbClqItLS+fF{%@jwDED=Yo-8CJq4LFxeCq z1}!iYO?eRL0C@qS08&Q+hB8CNC*XD%w^31^?$djkvfvL=77dj%(9P+762f^pTLE50 z*fDI-O14}`Wgvp+GHzv0LaU)939CYu>jVT;&H&&-E);M{ouEAA0M?*C!&GfKLv;>G z5~(CO3{?Pvwk3t3uGrJl{ECcNgL`TpQHD|sO56AY@k2PogvGE1o5^^w2pPoaEP(1) zZfOYw7th7Uz92C5YvI81PW^C7==m_SepRof!1e*qTW)!0>tJqQ>*f8TXLdg~wpbJ9 zVxHs*UK<4*UH^f(DK#v=9u72?YtZsjTZgq$UqkXJb!78H< zY>HXPWd0yOU$s&KjaHB5rkI=mik^B#l`O$@YFtLTiUk{{o8)^p~c$N;?hBulhr$Ht1EiMzN>ZXmP6X3 zT(u`}AFU_39~<$Os^G%goz+PF7CXY(%p$6T&)Sg{d+?^thJ9DCde_D)e2;&MX!;KO z=;byW7BAZzB+U6S?daX;=;F@O&e!s_?Yo!w4*xXrE3e-jP=kwKuvoYf4(3z#v0_2Y zGta9o?sx`aac5_<$8+@rtl-850>x`&hW$q>5L<9g;4F4@hD;+$ITrm2g<9 zTz);I6e3N!*E*-EMWIOog@&MKp8+G9o6Z)jAqZSRw5KSY#0_Bvvt{yTMy8<-V<{y` zPcdAgbP~%rGGj*^S#Krd4D+7K7vR#K23~5+7{zuXBKi^lGPN4JlD{us0`4oypD6$} zM+=ZWZdXpjpt2I+Bl#jc<5;I+X%PS}-4Uh|VaRaWipPLcy+uD`KrNjYkD;)X9k(Ot z!faNTI2>N^EW(~pb18z6f#l1=vLg_dbS`rTy(yMw$}sA{&j(?tm_Y?_?xdl)7;v1? zWnw9w2MP7YYa7dA2=C^kfy85+a=^G@7)mz?qhsuwJH=OE)}DI=!MgXz=ya}<0Om~H zNm9+!vLOK6N%N?P#ghQ2XYvzJwF=n@0(T&r)}MG9(*iw*{FTc1;||mu2T4^H5LIw) z0ah`o6;fXu%7)vUIN*QJmB+e@0l+uU#30n%QZbmIo+~JV+@}~h9h}#U!PDwIPP1Yt zg4j4sVKG&PP>aHE<32=oqUQ?Gy!Xo6Y812LxkqkYr)l=)I#(D5(+?>3ZYd16djZMn zUO>({7lfQg0nR&E&MqvhA@`#7^a9E&&JJ*#313wJ7xX98i&geas*;@%{{d;SBw9&q zqQ@*ZMb(9>_X|+<)G(#kfLh$D_dtJ21I!XhW1M}wN{1fRMT_%qMt z;*N@|J>@zIf80p#hLLOf*T}g8DYhINQt9^Lv6{%+c2h1TvZNtqy;fr?3wLP7a`=Fz zR2CQ|wK1mL9-$R1N*nA9ApKL;0wXaIEK6uLMzt~XAN5LyC_pYF9il*e-p1pAndpge zkp*B1XJiVY$N{}_*dkyrWs8`pC^!wTtU3dhYqwd=z@A=N|M+&lMbm zW*t&ghr2$#&wx+4cc47G7aor2ROF#95kW?ChN7Dy?HcMQI#E(}7m9fWCMhYUC#-ZK zRhrT(F%PDZPewHfPf}!I*pn6u`1=%0Mp0!?m2DC;gkn=cBuMpVW!ibWJXBsrrJ?O2 zx{4PryZdOlqOgrlP__`gZ_x&SD;x;y6KXjdNXM-&*3v6XR!XXb{XQq?FqUeXJ@}hp zrO6{gzddK$8d9YGZuz^H=KIOTP<<#%gNht?B>QhOLm z?O{@C48k?4K-4eU6n(2PwllJ z-uwk#q96HI>&n$?FCr{_xrkCZ-mrV^o>hs|xKg#6ihT67;IFTa?^N$VG4!|Bwytf? z*mpc@AGdq|`dfjI(cf=YkHJ*^ntg2bw|8EI-nrI7hHGP~8g4)rJ}Mx>MtIfQ`JJU| zw*sOPBXt0`3ThbgY*i(E-+QmXibsljA4^65!CR1|i$Ys%pX z`O!b6P@s@c7wv94JbqB-?9z|^4r(gk4Bu{D@05{+P>#KsY)evnjMA%rP*RSi+otL6vIJ5muLlsC87XK zL5{?X505w*_QV8a6vtO!`4jpU7hDGNkq}o#svR~MgUFYcED9zb>@Z)VE(+(J{F82tSPB!7HbtxVr>|A0L5SufmUWqC9E2!36H4+ zkjzY&R|9l4Ix>Z1sySBC1VYN&zz7h5YalNGL1j!pl;CHc2o|#>EMY8=a;S|#L7Z=e zf~doJSVr}zUaAw8hc_4uwsf@ybHBeB%BhAInEcVT%Qvac8_53%;fkxl)J>ftG&Zm3 zouj8V{xZ-9Eo2x_VoM3bz9f)-J<}*uVMSm9CbyDNyTFA-&q>4BNA~CXY-gKP8jV z{>Ilewg2V9${Vk2e48nmRauQi!=S<9DF&DOe3j zWRfaPIwN3S59pa>TvKCs2^rNSOn(JQ;g@(ju&A*iiWm@MJM>$v2ahl;I{2>wi~bBS zsIj$FRrFs5{EOMSG^GeL{imC|tanb1m3XN-nCWqYnOdqd2F_?AS3Rb+8ndtcYPD0d z97|8H4@|O}E#TcA2H~U^T-**mXmDA1+=CCx>nTqAoc6!{*EP`r1v3wA^0?i(SSv|v zgml*h44VN&xn2ynskVIe?#5&_;+VU3#J*cyq(3XJYIjZvu-c21 z_vINx-i568%3JWwui_1BcBeqAzp8NaBy(gR&f4qXtZ2glTJ6s3A+4zzqF-)pj7^G; zs&mz&mwVu>!xR+fK!OwqtT^j11#Or#^a_(6V!(|6LO=d00O20_ge{6NfTMUfE<5DH zD0|bxuS3z05uMD%^87FBc@&A3Y8FtlLL6+H0n z)ezi$o-1fao-07AMw1x=9_XamHV_jh>4`8-0u450lD;+*z-|Pkg(_BD|G)ym^59|@ zELN_E-TD(C4^vNqL2bo-eeg*F#+BRGIP_}K+kH?9!MvVAo{Hl>=sM1RdcxBQx{iB7 zhbc(NQ-j|s03ht%i}`@tm=Cy(L6)0Wig|hwqgZnx6_Hym4jhB1^;GVATb~u-dtnNv zHVyIqBiHi4Dst}l@aia3V7H|x5OvQLU^CB^55@PGFFz}ej8*lvaAX=BACAmK^V8wT zw13HHN`qDr4q~!rqSnb2oGeHg0}P7vzaykoESAryBs_8*8wLTBWX6PyZ0^21CpONh zM_{=GSQ;^7-r4*G)f*$s^Ba7he|9!|&8^F~m=qWK!~IlAW8-_QD8hmr&rcWg({T1+ zUeuoUc*m75;J?8_r2=aQxpS2x$wU9Gd*UP?p3Uqw~uI4jS*EVl0eWq9d!1d8$ z;hQhzCsS!g`QG^Y#^2{d|I%&U?r*Dx2#?=stRDYW3H?BuSMwC@L56@EwgKG9fJ792 zZqOt`Abe;NIh0I6+1Cpj&txc?M3MNyzT5`DXG|$?{bXl*!72zBQ;cgzC(X4~-hU7w zfV4wU8c;k;R&c@UbBt(aP*}YP=fSjotBt0$#%RNH2K_uj{+`c^vdM7~U(9*%T$sV4 zo_5y{E8yT zR8~}rY>eesCUdDNc>b3Taw%T&j^|rd6(80Z#ai{~Nl^$H9VJkIG>Mz?REF(t8AeQj zAof^|j3a!Z6V1;8#mLVx*!bC%_lK0 z_y{x=PJqSG&YoSO;w|AU>7V-3Jk0%9z)=;p`s7$hxP0B&3|zm(Fnl2)bEO`u`mMs< z>*^M8`MVbQf(Q26Ix2;IdHW>~>yozKdKoF$_uwAbQxsq@*gh=t(=r-lXYW-I@>uvQ zP_F166#=6%BE#@uKqCT-8R!gde#8BVuQSLd1L<*oL$xtHn$Sm?E03~B9(2hh_m`yH zNo__koRIO|Q}u7$slvd^B0cgYli&$*rqJxpjr>eAb^9JOb(7>>me^dLFcOyT&OnaC z-VGKq{OF%BK!&@^VKF%Kwby(i#Gq+*Xm?%Hd?ic{?+%9=TUx)!o2h7qbnJEioL*_z zzFv7DN;fXRv%o!52!&K8(}!C+wp6Ati_MfeiwK=7(Z+uw07Uq)ro~$v{g5SuaG;Hq z9E@+m%4G|959Rw##pE$DMw%jfP#ihPgQEa}X(_lxyTLQ|tc2{5%|U<@h?oH=iejL? z4A>I`g0K-%HC@S=&E?R1@PZ6gd2uvE|MT;-G_of-iBTs=ivkd+1*jVcIyPQU17X1k zWC$yds6YbZprl|Jpu-{H7-6f}-H`WzVR`sg!LTW8kUXZGL@I8*=XP<}FiuIkR;Bl( zyi%jS5e=5%Fun1<&do!zOgM0lx1Qgl>&76&fmGL@b*AzXe|2`h+;#DmR4sRH^JY7I zb$REH$5VFryJIYs&hBrFGt=97aa|@nV?4AF$%(EFd43YZK1U!_l*vF);V6_{U zf2^0>5BG=r7Y<_6I5)j{T#MP=ZW$K)jA>Q7xu~hx*>G+$f+o?{oOmq+@90-dZu@`x z4JUa;oYH!YkT|$3x#On9fiZqn1V}X92K;O> z31}N7*~1d!P%W)%wv>liHh};rr?LbjMe|)Ee`zXC0m)cPvLM7bclM6QU0;Y=n+z%#5W0=;DSIK>w7PHuez$Z9DCxk$d-54E-O9nx`c z{}48nVs{Vkh9=ZWQ}9E1L(vjY(3&1gAl^+IAd8MGNWhBI6tEge(e^G)LCk9kPEkz( zxYHE&5ornn*`y#yxaK&NHBCW1lN4=g;*CmpCyA<$IUB%ZzyfHyI|V56?g!f7T0~)I-ZxJ_*s(wlyb?yM9-@dpskH(MzUkl*Jnh*!vM z+AusmTP&WY{XYZPyPe6=26{y0WBzF47R(1#Y9}B&0piiVEqbg}Ky1MM1A_9<7A};; zO&4aEfOzK7njx?tEkr5FH>-zkhJoPHDyown%$ zy4Gpuz9%FGcT`q@f^ZSHPSYQ9uhV`VB$LgZ$E0lRdxvfgpX;1u;l3RpN6uVmuJg)V zH#xMg&hk1#?#Z5W2Url!g=e`?&s_M*?z@YU#YL8Db4TaYV}5)tbQQCotL3kKvXSpb z?Jevx^3^bRELL)Ga)>X zX+{-723KYdFsLMNou~#{^;pD)AW6n~rr%2(m?@Xd0Z-W7E+mSlT}1LZ&0e2+omJhm z)txZyW?CZH65f5!W_RUgL`kHfgXwUzIqj~Q6FT7?HbiaA#fKbPqwqvCCbZGUly#lb!*XZyhR{L@i({}kj*(Sqk%L#R&AXy0YvVy=PSaf*C z=Tt#ZGHAy*lpw*J3qN4yb@F(;N#3P}dC(o~Dl4J282b^z8)G!hw5kl-kSmDuyRB~I zip0V$hMm*&UX$HKUAG14JcqP6v(E;E9*#U9>Wmi3?QDh{lh|}5q3}#|jmg|6SDslu zO*@bBv@c05&Y$@#zdKaVk+T4$A9~JTS4#_>dg6)Ir?HPx_bTeKc@(kk z^bxAIF-5@D*+ekKJkevkqeIa%P^Wo<9Fmgj(ang#OD2(*KID2;OnY9kA`{BLw}RSe z!bbqsiQz@uRKW>SFa(?+wE`&z`4BXORAr5-684E6Ww1;#Idn`w5J#y5k^bEcM5N4> z93?u?HQ(M8%KSwG=C`k0ePH8erh}c&X`zmlt1nG1UqeLOWKIB$2ZeqPObKl9>Qw!1 zIden~#e25~Vs*S+!lR{S6QOnWjc-hC{by8l`9GQB7J|UPBJIfUWVpRCxq`?H?a>O% zc{iF{jDkjbO!|SdMINUOw@xI2**GFckn#SuC`A;SfDGWQN_L25E1bq5Pp1orzlW7( ztW+<6N@V4-7TS;Rxf=2?6ew2Y6f<^o6hVBVv_~l-jIBfR;<+V8jOpnMcLioI_&%NK z;jlC)F%0jMQQ~Am)+@pLsE&87QhT!9Nm&~Dh8rx+`Ghr6>q+sazXXB3J@c&P26%tk zy2e@`fpiP(ZJq%?`U7P&UIXocdN!xT}s+NO`3qE15CrOwSxjT2c^&2^8+vQ8%}Y( zwdL2_tp?n{Rm#AOLMq%&K9O0xq z;LB0O3eND3Wb#D_Fa$~DY&!(8`D8SR!8Ar}64VEX!0C))C^5ucs7VRCNmF!SgiE## z3=;JOo{)0l@K#TdbQInRlG5mQo=sNvnhUMN)ncfga0PO5(c4)-t{~0toUwqun>qoz znb@r1u4+W^{zjPQ@fTfSnFq(X}jDSQ2P1R)%B+qY7~5})8uEzbOIjY zmgcY!2nIn2rfjgm;MtTU~!)0mbm%g+@vdKumgxU=s@Sd@j6B~2EcD; zDrX3;M;&4eD6EY!0^)77C1$+7btL7cg9nzDd&pXb@X-UdG@J7zDQ3&T4rDc za~c7}q}oI8=T1@*tG+;g5%EvEi{wq|ARu~6fJ4Zb)&MN(C#Io7<}Q+e=jkquKvMNI z5DZR6rgA238%f!qL|d4M5o%A6x*a+0T(id_TY&8<`oD-$HkD};UU2g`q?K%#>AH4P z*Y6p3Vf)v0X?DD%9^k_-8@KW+iw`|q?ZhsXu24@`=vExnS`AmRZ>QQ*Jz70hwW__< zp4`D@QFZzRmpug1U*ZnI-J7&bh)yz@tswSBGi zF!PhoE&nF}t^dRFM83^POphM(s<|Q5aBp>jYPh!rf9-pN)q5K`dklEI4tO8<_ltV5ee5Il*jCO~-^tPX zd!3{Vqd7;R0|EKBHQm#J-ERNUwNEa7#2&ZPwaYysBcu(LCPzPFrx)!BnJJLnr62!S zIuF*}a!iN2&gwpcB-X#OA5}rHQ=Tw*4Fr{=MRx~z(gqoWl@ns@iH;<>S-m`gt&aZ9Gg1mB-ks$!p%?0q{%~^EnwWGic z0U2p3kOV((&ce7hXYKAF?Q3r?1I03KB#AxU@Z{?*HbOaVcs0u1{wN1hW+yF#SlR3jhtfKWKfo!E$7e_i>RIWc}e72Dc(XyZR} zpQ1FdvE-)%w9Y#_J=amFz zP7**WB!QJB31~%<04}2mM;QXy7&nY}i~;)sgDbI$^gaXb0o8%%1XKxpB4VbDM6PCl zXS|Q)uG*s_c##89jVK1vYk-UJab3>iDrkYTnFwprp4|N$Ej>53AbN*KZTm2+MAm~@ ze6TKj+RPnaJyffU8(PXMn6S8WMk_e*Fz=%O^U}W7&z4wHed4`xqx1b_n}lLmPj4$l24sc&?iw#%Pf`wqy)khsF<@JwhmO zbP$fBo|-;Aot}m31nwMCtg(3xdr4^zzW4BM+M6ig9*(HCahwJw6Pn*%VJcB*%FelO z;7ByLIKVAJ$2XD_RXI2xa44Zfpk)WqbGO(zPZFXM0KdC^vDL}q57DP<)3Vi&O-Y1pStDr(vwy_{_d^fF@IUM2|00jj-foHV6o$16! z_g%NO=DWJ~6}CDLO)^>T)N_lWTI=(#F8)f(tA*ezn!EYENqipTZ;Lp&^wW){mp1;o z{#Qk0Y>(-Jh?rf26RT~-n>t_G_*#x(!p*o8cx{Au;vIQBa~sukRIINsU zyjL`ci|f|?PvR8R`L(B?nt$43tj^h$algSz45eg)TIpao{9%|-3@mJt#(|1BfseSq zBM*3iGZmXY!2xLC1gf7Qc$@*Q9~%Oxf1$(W|2{k;pS2yZfzY{y?OQK zo%+u$ZuHZMfyZ>i)iYlzm=w#Nt-o2`xH?(*=EfUK^{5K`qtY=Cu2VPqzL4`P#mC=# zW8*U`MVxj3#og|H6{i&ZaI>G<9hG+9b=|r)?=_~HywytaTK#=18+@+eb$j_I%Nu`0 zz5KEnNM2pikB_YeanhH{!6`yKrQ)gL)$jq8W{!0vBZg&2=lA;Yj07FLW$;Zp(bw1( zaS94g_ z#QeyQ^pn5a^aggvwDB3>#%H9VFTRgB390Y$I_(xq{~vwBDF)@h|2-nMW%S?)&weN9 z2WG~>TGhXVVOP5MxtGAu{3q3tbf5#!v|5q?N=c+(nR=rLnKRiQ05XaQZIcZ!(kV@6 zm>IW^8^_Dh`I-%!*6V2km79loQ$FaYXo1+hWjyvJ$WH6`C{tu&Ywcz=2yux=7g{~x z2I{|z6tksSrZ>dPSb2p}`v6nq(7Bb>3XwD1(2>s>y-es1Byh5r77 z{52YIAhsJxrz%h+kcIxWh+j&1Ah{C0n<*^>2mrmiB6o-WDW&!anx7B1P9_Qs7rx=tMh(%M!0YA+U5tGEG8QF zolFtEe?*oS$2^%wy1H8@^FQ3YQ;SBd2W$IUcH5$pD{nloaaBGV!?VJty3t3ch|Ht- zXcBM+S|mtOyaMNuBgL^kX&15N^QlM(*mFN3Ma&Ef8o}{cTv~|2M!A{(%}&$}&ZgWy*~9*dX0276!VQiYScK4Uy)uvK(6jpN{^G#G zS`9f+NT>vDp1~Cyp17J>e}bBf4GwZc+8t7#dNYgj=c9C!;8S{V;ljCvHSRr~IEI{* zlK~cl>)gW9V~bn>ObgfP`3npDLfp0VI^8-5vD`aA|KPdBfr-4W$%$hiOq4dGvMSA6 zpvd55k*+7{|1L#k(T;IumRkoszzqUmu%UdJS#^4=LrSb%rM#|SaI%*FAxdb zdIGajWGV4pQkc!BZtwxq>2fwhx6Bczj>(6kjV8N-jw|~8Hz<5rs;c&Qmdpe7TWxWI zD*U2{eg;t~b>fBe6t=K^8s82L{}%n=Qg&g>Z^Khn^%!hXeXH)4%j!Mf?r!0=gOKyo zDmH^5K1a(0sv&K9yQ6xvR?lk8BsqCD?=ZLaI~{a#L^}&@q%_A?U?{Zl^G=!S(K?Re zetv$95XZcUmVP8X4u8_KBsYOgi<)wLwh1yH7-mekUR%=IB@Z%MQzW7#57VS6$16;*tK`KU z9Fnv&)3Z2CA}8%RyD5%&q_8=mB@Ud6LDx1#2@zF6O~)EZ3*_!_r62iAnzsOwN@`ro zi2QQ9K`5@N8(OG4DQHLWPj3hWY1e$B<6%Zb0gwPnqNjkWcpznAY#f`oM>o6tI1$ne~ zGgrX+P9bvAVSVgw3^f_9g^7=WqWu;RymnslBCypZHaa}Ta|KrEx$^j~DfHD)E9@?} z5DY;jCwST2Y|pyFyBW09!En9&6FzSGLc%K$;H!5HCAjBuM@aeHz zhw`~?oNB5xz5mq4|HN^q|EQOpshv6wJpyg8WW>HJK7Q5v%7khtpVI_nmg$6h_K)Wc zBH%KBoSkzf+`f}yj+OWXyc5B(+V4qx&UTP|;fp(4`*ZRAms^**>*n;!HaXa5>#Cw% z?KrylFEkyLwTTxnOE_SVU-Q`Wp2t2N=yT5L*{iE;QxQ?`aTAmprM=i0{S-Nbg(eBN z(WE16Ahb*#?Kjukgaeu9P0GXiU_Y7FrqfR@BssSNu^srl8}m8(E}DskRYpmEAwAiG z&z?XDJ;MXTt|^^CjQodjPHvkHOJ|yCr7PB!R%=%NG}0@~*V3N2c+T)#zmiL>1`ANL z^+5e}itEZ;UAgk0JpA~Z{8#dyP3h$nNKGQl9J?|Ka`JvtkfJ|4W+#BFGvjlJaG^jI z*EVG*qEiPLgOB&X0dpobgKz-)0=xefDUfhkZx`EFb$rA9)9P*oH4&RhdpPu3GF(9B?1(rNc-UHeyEK@5Vlt)t(>fL09`X`m< zpLl>QL|3Z8?DT!_5;J_M9h)6>hL3dJzfUGP^WBFe@u2)Uot9k)>8ZscM+l!0cMi|l z7sdok=lBmZ!xCLr2zN>XmZ3@LR!S3ohp*bn((I5w2R4k2F}BrtlF3BO26I^IHXU9; zu??zH@39er4$2~xkUhNe(Q*Dnpq~m@hom*^6>peBA8BAsk{j0K0V4BK8{jjS0?0{A zWCXVp6gD@X_yOV9%oXLUup0D4u(jkmCq{C_5|C=MrKyrV zhv;~rI1xx_6#BB&JC~}^spg~B`1-jg9|uxqom*eKIFEDUttZ!3*4Cd|vz8v8f6NG) z3lt3^a#$Ef1mj47_nvRH5(^ROf|nv(g-K09FTrgB~eo9NHdsjS{5uyuw&D&*?j?AEvRllCNQDA z!(eT~v*h#557f3gUFS+;vgJ&!ARqV;Y53C^)A;-wFAq`eRGON&b7{UutzteT4wivq zy3sZrN8!fbLLfKIfRoeFF0t<6*?$ODJHPeph0XW$}sE9tl%30I1*-~_g8kv>5Oy5-NY@|2gopJSy8Pn|lY z&r+>=pcSFU{6T57+6N30p=yW|5Ivcj!__ptVp=Ju?!RB!qa2)VLPBF&at6jT*oD$J zp3M~S)vNc6;*9oGVT|e_HjZGg83Hh@J^-}9C-EV8tMAOTY`!G9FqFU$F?{cA)p`o94Q0EQ_~cQ{me_G#lhc=Eo2olX^a9Ggc=u6^T#2RbH7)4Glcw8uyBKxem>3J}JnsKHs4=h9SE9@wFHYltx0D94tc5NBug? zqyAF6cP{AT{&0KEYk&;_&2t5ViuiD?_q!~6~SMH=RX#mUF975q}rQDZ+nTd2Ib<#GqWgs==Mj2a0HObseawket z+0)a$VeEi7gCMY`pM2tp_45}&ANa7)u8 z-fdl2$1Y%e`SR%t7g6=O`89ks^W0Kx!CHD0O+LB=3<2V zZFnh}WRhWUF}uv8n3};T;#>Ea1^SrcG@WWMf)4%Ue;q1h{QwD*L!kd?a2k}4(rsy`SlOtOT_2FW`q?2c7|gI zKMDFt($5h64AajD{hYuL%rN{!tq%NRpidx_3_nyFAQfQr5&XoW{rw%_H68yCv>;s9 diff --git a/library/tedit/tedit-exports.all b/library/tedit/tedit-exports.all new file mode 100644 index 00000000..2f07540a --- /dev/null +++ b/library/tedit/tedit-exports.all @@ -0,0 +1,598 @@ +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) + +(FILECREATED " 4-Mar-2024 22:49:16"  +{DSK}kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;111 46338 + + :EDIT-BY rmk + + :PREVIOUS-DATE " 3-Mar-2024 08:55:19" {WMEDLEY}tedit>tedit-exports.all;110) + + +(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)))))))) +(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 " 4-Mar-2024 21:32:36")) +(RPAQQ \BTREEWORDSPERSLOT 4) +(RPAQQ \BTREEMAXCOUNT 8) +(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8)) +(DATATYPE BTREENODE ((* ;; "An order-4 BTREE node for representing the piece table for TEdit.") DOWN1 +DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DOWN8 DLEN8 (COUNT BYTE) + (* ; +"# of children of this node. Must not be BITS 4 because \PUTBASEPTR optimizations smash the high-order bits." +) (UPWARD XPOINTER) (* ; "Parent of this node, if any.") TOTLEN (* ; +"Total length of this tree and subtrees"))) +(BLOCKRECORD BTSLOT (DOWN DLEN)) +(PUTPROPS \NTHSLOT MACRO ((BTREENODE N) (\ADDBASE BTREENODE (UNFOLD (SUB1 N) \BTREEWORDSPERSLOT)))) +(PUTPROPS \NEXTSLOT MACRO ((SLOT) (\ADDBASE SLOT \BTREEWORDSPERSLOT))) +(PUTPROPS \PREVSLOT MACRO ((SLOT) (\ADDBASE SLOT (IMINUS \BTREEWORDSPERSLOT)))) +(PUTPROPS \LASTSLOT MACRO ((BTNODE) (\ADDBASE BTNODE (UNFOLD (SUB1 (ffetch (BTREENODE COUNT) of BTNODE +)) \BTREEWORDSPERSLOT)))) +(PUTPROPS \FIRSTSLOT MACRO ((BTNODE) BTNODE)) +(PUTPROPS \MOVESLOT MACRO ((FROMSLOT TOSLOT) (* ;; +"Moves the slot information from FROMSLOT to TOSLOT, and also clears FROMSLOT. ") (\PUTBASEPTR TOSLOT +0 (ffetch (BTSLOT DOWN) of FROMSLOT)) (* ; "Avoid refcnt fiddling (assumes we are uninterruptable)") ( +\PUTBASEPTR FROMSLOT 0 NIL) (freplace (BTSLOT DLEN) of TOSLOT with (ffetch (BTSLOT DLEN) of FROMSLOT)) + (freplace (BTSLOT DLEN) of FROMSLOT with 0))) +(PUTPROPS \FILLSLOT MACRO ((SLOT DWN DWNL) (freplace (BTSLOT DOWN) of SLOT with DWN) (freplace (BTSLOT + DLEN) of SLOT with DWNL))) +(PUTPROPS \FINDSLOT MACRO ((BTNODE ITEM) (find S inslots BTNODE suchthat (EQ ITEM (ffetch (BTSLOT DOWN +) of S))))) +(PUTPROPS \LASTPIECEP MACRO (OPENLAMBDA (PC TOBJ) (AND (EQ PC (ffetch (TEXTOBJ LASTPIECE) of TOBJ)) PC +))) +(I.S.OPR (QUOTE inslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$BTBODY) (QUOTE (bind $$BTBODY _ BODY + $$BTEND declare (LOCALVARS $$BTBODY $$BTEND) first (SETQ I.V. (\FIRSTSLOT $$BTBODY)) (SETQ $$BTEND ( +\LASTSLOT $$BTBODY)) repeatuntil (EQ I.V. $$BTEND) by (\ADDBASE I.V. \BTREEWORDSPERSLOT))))) T) +(I.S.OPR (QUOTE inpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE))) by + (\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 " 3-Mar-2024 08:59:45")) +(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 (* ; +"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 (* ; +"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) (* ; +"T if there should be a caret for this selection") SELOBJ (* ; +"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)) +(DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR)) +(DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT)) +(RPAQQ COPYSELSHADE 30583) +(RPAQQ COPYLOOKSSELSHADE 30583) +(RPAQQ EDITMOVESHADE -1) +(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))))) +(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))) +(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 " 4-Mar-2024 22:48:20")) +(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)) +(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."))) +(* ; "LINEDESCRIPTORS") +(DATATYPE LINEDESCRIPTOR ((* ;; +"Description of a single line of formatted text, either on the display or for a printed page.") YBOT ( +* ; "Y value for the bottom of the line (below the descent)") YBASE (* ; +"Yvalue for the base line the characters sit on") LEFTMARGIN (* ; "Left margin, in screen points") +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 (* ; +"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") +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 (* ; + +"One of SOLID, GREY, NIL. Tells what kind of special-line marker should be put in the left margin for this paragraph. (For hardcopy, can also be an indicator for special processing?)" +) LTEXTOBJ (* ; +"A cached TEXTOBJ that this line took its text from. Used only in hardcopy to disambiguate when chno's should be updated." +) 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) (* ; +"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) +(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 ( +fetch (LINEDESCRIPTOR NEXTLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR)))))) +(I.S.OPR (QUOTE backlines) NIL (QUOTE (bind $$NEXTLINE declare (LOCALVARS $$NEXTLINE) first (SETQ I.V. + (\DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$NEXTLINE I.V.) (\DTEST (OR ( +fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR)))))) +(PUTPROPS GETLD MACRO ((L FIELD) (fetch (LINEDESCRIPTOR FIELD) of L))) +(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) ( +FSETLD LINE YBOT BOTTOM))))) +(PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN + LINE2 (SETLD LINE2 PREVLINE LINE1)))) +(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))))) +(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")) +(* ; "Formatting slots held by THISLINE") +(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))) +(PUTPROPS PREVCHARSLOT MACRO ((CSLOT) (\ADDBASE CSLOT (IMINUS WORDSPERCHARSLOT)))) +(PUTPROPS PREVCHARSLOT! MACRO ((CSLOT) (* ;; +"Backs over looks and invisibles to the last character slot") (find CS _ (PREVCHARSLOT CSLOT) by ( +PREVCHARSLOT CS) while CS suchthat (CHAR CS)))) +(PUTPROPS NEXTCHARSLOT MACRO ((CSLOT) (\ADDBASE CSLOT WORDSPERCHARSLOT))) +(PUTPROPS FIRSTCHARSLOT MACRO ((TLINE) (fetch (THISLINE CHARSLOTS) of TLINE))) +(PUTPROPS NTHCHARSLOT MACRO ((TLINE N) (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) (ITIMES N +WORDSPERCHARSLOT)))) +(PUTPROPS LASTCHARSLOT MACRO ((TLINE) (\ADDBASE (fetch (THISLINE CHARSLOTS) of TLINE) (TIMES (SUB1 +MAXCHARSLOTS) WORDSPERCHARSLOT)))) +(PUTPROPS FILLCHARSLOT MACRO ((CSLOT C W) (freplace (CHARSLOT CHAR) of CSLOT with C) (freplace ( +CHARSLOT CHARW) of CSLOT with W))) +(PUTPROPS BACKCHARS MACRO ((CSLOTVAR CHARVAR WIDTHVAR) (SETQ CSLOTVAR (PREVCHARSLOT CSLOTVAR)) (SETQ +CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR)) (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR)))) +(PUTPROPS PUSHCHAR MACRO ((CSLOTVAR C W) (FILLCHARSLOT CSLOTVAR C W) (SETQ CSLOTVAR (NEXTCHARSLOT +CSLOTVAR)))) +(PUTPROPS POPCHAR MACRO ((CSLOTVAR CHARVAR WIDTHVAR) (SETQ CHARVAR (fetch (CHARSLOT CHAR) of CSLOTVAR) +) (SETQ WIDTHVAR (fetch (CHARSLOT CHARW) of CSLOTVAR)) (SETQ CSLOTVAR (NEXTCHARSLOT CSLOTVAR)))) +(PUTPROPS CHARSLOTP MACRO (OPENLAMBDA (X TL) (* ;; +"True if TL is a THISLINE and X is a pointer into its CHARSLOTS block. A tool for consistency assertions." +) (CL:WHEN (TYPE? THISLINE TL) (LET ((FIRSTSLOT (FIRSTCHARSLOT TL)) (LASTSLOT (LASTCHARSLOT TL))) (AND + (OR (IGREATERP (\HILOC X) (\HILOC FIRSTSLOT)) (AND (EQ (\HILOC X) (\HILOC FIRSTSLOT)) (IGEQ (\LOLOC X +) (\LOLOC FIRSTSLOT)))) (OR (ILESSP (\HILOC X) (\HILOC LASTSLOT)) (AND (EQ (\HILOC X) (\HILOC LASTSLOT +)) (ILEQ (\LOLOC X) (\LOLOC LASTSLOT))))))))) +(RPAQQ CELLSPERCHARSLOT 2) +(RPAQ WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) +(RPAQQ MAXCHARSLOTS 256) +(CONSTANTS (CELLSPERCHARSLOT 2) (WORDSPERCHARSLOT (TIMES CELLSPERCHARSLOT WORDSPERCELL)) (MAXCHARSLOTS + 256)) +(* ;; +"incharslots can be used only if THISLINE is properly bound in the environment, to provide upperbound checking. Operand can be THISLINE (= FIRSTCHARSLOT) or a within-range slot pointer. The latter case is not current checked for validity (some \HILOC \LOLOC address calculations?). backcharslots runs backwards." +) +(I.S.OPR (QUOTE incharslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$STARTSLOT) (QUOTE (bind +$$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first ( +SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (FIRSTCHARSLOT $$STARTSLOT)) (T $$STARTSLOT))) (SETQ +$$CHARSLOTLIMIT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of THISLINE)) by (NEXTCHARSLOT I.V.) until (EQ + I.V. $$CHARSLOTLIMIT) eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch ( +CHARSLOT CHARW) of I.V.)))))) T) +(I.S.OPR (QUOTE backcharslots) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$STARTSLOT) (QUOTE (bind +$$STARTSLOT _ BODY CHAR CHARW $$CHARSLOTLIMIT declare (LOCALVARS $$STARTSLOT $$CHARSLOTLIMIT) first ( +SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEXTAVAILABLECHARSLOT) of + THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.) +eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.)) +repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T) +(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR + 192) (ILEQ CHAR 207)))) +(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE " 2-Mar-2024 07:40:06")) +(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)." +) (PTYPE BITS 4) (* ; "How the characters are delivered: thinfile, fatstring, object, substream") +PBYTELEN (* ; "Length of this character piece in bytes. PBYTELEN = PLEN*PBYTESPERCHAR") PFPOS (* ; +"The FILEPTR of the start of the piece in the file") PLEN (* ; "Length of the piece, in characters.") +NEXTPIECE (* ; "-> Next piece in this textobj.") (PREVPIECE FULLXPOINTER) (* ; +"-> Prior piece in this text object.") PLOOKS (* ; "Character formatting info ") PBYTESPERCHAR (* ; +"The number of bytes per character, given that all characters in a piece are the same length.") ( +PPARALAST FLAG) (* ; "This piece ends paragraph") PPARALOOKS (* ; "Paragraph looks for this piece") ( +PNEW FLAG) (* ; +"This text is new here; used by the tentative edit system, and anyone else interested.") (NIL FLAG) ( +* ; "Was PFATP") (PBINABLE FLAG) (* ; "8-bit bytes are binable (THINSTRING and THINFILE) ") (PTREENODE + 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 _ +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" +) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end") +NIL (* ; +"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 (* ; +"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 (* ; +"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 (* ; +"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) (* ; +"T if this TEXTOBJ is a tedit-style menu") FMTSPEC (* ; +"Default Formatting Spec to be used when formatting paragraphs") (FORMATTEDP FLAG) (* ; +"Flag for paragraph formatting. T if this document is to contain paragraph formatting information.") +(TXTREADONLY FLAG) (* ; "This is only available for shift selection.") (TXTEDITING FLAG) (* ; +"T => This document is in a window and there is an edit process behind it. For example, it only makes sense to have a caret show up if you are editing." +) (TXTNOTSPLITTABLE FLAG) (* ; +"Can't split into panes, split-region not show. Was TXTNONSCHARS: T => If TEdit rns into a 255, it won't attempt to convert to NS characters. Used for REALLY plain-text manipulation." +) TXTTERMSA (* ; "Special instructions for displaying characters on the screen") EDITOPACTIVE (* ; +"T if there is an editing operation in progress. Used to interlock the TEdit menu") DEFAULTCHARLOOKS +(* ; +"The default character looks -- if any -- to be applied to characters coming into the file from outside." +) TXTRTBL (* ; "The READTABLE to be used by the command loop for command dispatch") TXTWTBL (* ; +"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) (* ; +"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") +DISPLAYCACHE (* ; "The bitmap to be used when building the image of a line for display") +DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPLAYHCPYDS (* ; +"The DISPLAYSTREAM used to build line images of lines that are displayed in 'hardcopy' simulation mode" +) TXTPAGEFRAMES (* ; "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) (* ; +"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 (* ; +"Document properties that are stored with the document (not used yet)") TXTSTYLESHEET (* ; +"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) +(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) +of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that is editing this text") +(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 +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))) (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 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))) +(PUTPROPS PFPOS MACRO ((PC) (ffetch (PIECE PFPOS) of PC))) +(PUTPROPS PBYTELEN MACRO ((PC) (ffetch (PIECE PBYTELEN) of PC))) +(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 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)))))) +(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 ( +VISIBLEPIECEP PPC)))) +(PUTPROPS GETTOBJ MACRO ((TOBJ FIELD) (fetch (TEXTOBJ FIELD) of TOBJ))) +(PUTPROPS SETTOBJ MACRO ((TOBJ FIELD NEWVALUE) (replace (TEXTOBJ FIELD) of TOBJ with NEWVALUE))) +(PUTPROPS FGETTOBJ MACRO ((TOBJ FIELD) (ffetch (TEXTOBJ FIELD) of TOBJ))) +(PUTPROPS FSETTOBJ MACRO ((TOBJ FIELD NEWVALUE) (freplace (TEXTOBJ FIELD) of TOBJ with NEWVALUE))) +(PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ))) +(PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ))) +(RPAQQ THINFILE.PTYPE 0) +(RPAQQ FATFILE1.PTYPE 1) +(RPAQQ FATFILE2.PTYPE 2) +(RPAQQ THINSTRING.PTYPE 3) +(RPAQQ FATSTRING.PTYPE 4) +(RPAQQ SUBSTREAM.PTYPE 5) +(RPAQQ OBJECT.PTYPE 6) +(RPAQQ LOOKS.PTYPE 7) +(RPAQQ UTF8.PTYPE 11) +(RPAQ FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.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)) +(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) (UTF8.PTYPE 11) (FILE.PTYPES ( +LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE UTF8.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE +FATSTRING.PTYPE)) (BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST +THINFILE.PTYPE THINSTRING.PTYPE))) +(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV) +(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE " 2-Mar-2024 07:10:22")) +(RPAQQ NONE.TTC 0) +(RPAQQ CHARDELETE.TTC 1) +(RPAQQ WORDDELETE.TTC 2) +(RPAQQ DELETE.TTC 3) +(RPAQQ FUNCTIONCALL.TTC 4) +(RPAQQ REDO.TTC 5) +(RPAQQ UNDO.TTC 6) +(RPAQQ CMD.TTC 7) +(RPAQQ NEXT.TTC 8) +(RPAQQ EXPAND.TTC 9) +(RPAQQ CHARDELETE.FORWARD.TTC 10) +(RPAQQ WORDDELETE.FORWARD.TTC 11) +(RPAQQ PUNCT.TTC 20) +(RPAQQ TEXT.TTC 21) +(RPAQQ WHITESPACE.TTC 22) +(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) ( +REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) ( +WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22)) +(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.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)))))) +)) (T (CONS COMMENTFLG ARGS))))) +(ACCESSFNS TEDITTERMCODE ((TTCLASS (LOGAND DATUM 224)) (TTDECODE (LOGAND DATUM 31)))) +(RPAQQ NOTBEFORE.LB 1) +(RPAQQ NOTAFTER.LB 2) +(RPAQQ BEFORE.LB 4) +(RPAQQ AFTER.LB 8) +(RPAQQ DISAPPEAR-IF-NOT-SPLIT.LB 16) +(RPAQQ NEWCHAR-IF-SPLIT.LB 32) +(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16) +(NEWCHAR-IF-SPLIT.LB 32)) +(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "26-Feb-2024 11:22:29")) +(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 "16-Feb-2024 23:55:44")) +(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "21-Jan-2024 10:27:59")) +(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.") +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) (* ; +"T if the characters are to be underscored, else NIL") (CLOLINE FLAG) (* ; +"T if the characters are to be overscored, else NIL") (CLSTRIKE FLAG) (* ; +"T if the characters are to be struck thru, else nil.") CLOFFSET (* ; +"A superscripting offset in points (?) else NIL (SUBSCRIPTING IF NEGATIVE.)") (CLSMALLCAP 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 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 (* ; +"Any information that an outsider wants to include") CLLEADER (* ; +"For creating dotted and other kinds of leader") CLRULES (* ;; +"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)))) +(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 (* ; +"Right margin for the paragraph") LEADBEFORE (* ; +"Leading above the paragraph's first line, in points") 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") 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 (* ; +"A special horizontal location on the printed page for this para.") FMTSPECIALY (* ; +"A special vertical location on the page for this para") (FMTHEADINGKEEP FLAG) (* ; +"This para should be kept with the top line or so of the next para..") FMTPARATYPE (* ; +"What kind of para this is: TEXT, PAGEHEADING, whatever") FMTPARASUBTYPE (* ; +"Sub type of the type, e.g., what KIND of page heading this is.") FMTNEWPAGEBEFORE (* ; +"Start a new box (if T) or back up the page formatting tree to make a new box of the type named in the value -- by going the least distance back up the tree, then back down until you find that kind of box." +) FMTNEWPAGEAFTER (* ; "Similarly") FMTKEEP (* ; +"For information about how this paragraph is to be kept with other paragraphs.") FMTCOLUMN (* ; +"For setting up side-by-side paragraphs easily ala BravoX") FMTVERTRULES (* ; +"For Keeping track of vertical rules in force") (FMTMARK FLAG) (* ; +"Used to keep track of which PARALOOKSs are really being used -- a mark & collect is done just before a PUT, so that only 'real' PARALOOKSs make it into the file" +) (* ; +"Used for a mark&sweep of para looks at PUT time -- T means this looks really IS in use in the document, so it makes sense to save it on the file." +) (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)) +(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 "24-Feb-2024 12:34:14")) +(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 + NOT VISIBLE. Used to track the current state of the caret) TCCARETDS (* The display stream that the +caret appears in) TCCURSORBM (* The CURSOR representing the caret) TCCARETRATE (* %# of MSEC between +caret up/down transitions) TCFORCEUP (* T => The caret is not allowed to become visible. Used to keep +the caret up during screen updates) TCCARETX (* X position in the window that the caret appears at) +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 (GETWINDOWPROP DATUM (QUOTE TEXTOBJ)) ( +PUTWINDOWPROP DATUM (QUOTE TEXTOBJ) NEWVALUE)) (PTEXTOBJ (GETWINDOWPROP DATUM (QUOTE TEXTOBJ)) ( +PUTWINDOWPROP DATUM (QUOTE TEXTOBJ) NEWVALUE)) (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 " 4-Mar-2024 15:15:31")) +(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 " 1-Mar-2024 20:35:49")) +(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 3-Mar-2024 20:44:51")) +(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE " 3-Mar-2024 20:44:44")) +(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "19-Jan-2024 23:19:53")) +(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)) +(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 " 4-Mar-2024 21:33:56")) +(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." +) MINPAGE# (* ; "The page # of the first page to be printed, or NIL") MAXPAGE# (* ; +"The page # of the last page to be printed, or NIL") STATE (* ; "One of FORMATTING or SEARCHING.") +REQUIREDREGIONTYPE (* ; +"If STATE is SEARCHING, the kind of box we're looking for. If STATE is :SEARCHING-FOR-EQUIVALENT-PAGE, this is the page count for the matching page." +) MAINSTREAM (* ; "The principal textobj/stream source") CHNO (* ; "Our position in that stream") +PRESSREGION (* ; "The press code's REGION info.") PAGEHEADINGS (* ; +"The list of current values to be printed, indexed by heading type") PAGE#GENERATOR (* ; +"List of page numbers; later, maybe, a function to generate page numbers. Used to fill in PAGE#TEXT, below" +) PAGE#TEXT (* ; +"If special page numbers are in use, this is the place to take them from. PAGE# is still used for recto/verso decisions &c" +) PAGEISRECTO (* ; "T if this is a recto page, NIL if it's a VERSO page.") PAGEFOOTNOTELINES (* ; +"A list of extant footnote lines that should appear at the next opportunity") PAGEFLOATINGTOPLINES (* +; "A list of lines that should float to the top of the next available place") PAGECOUNT (* ; +"The number of pages we've formatted so far.") PAGELINECACHE (* ; +"A cache for pre-created LINEDESCRIPTOR/THISLINE sets, to avoid the overhead of re-allocating them all the time" +) NEWPAGELAYOUT (* ; +"If we switch page layouts in mid-document, this is where the new layout gets cached until we get started again." +)) PAGECOUNT _ 0) +(DATATYPE PAGEREGION ((* ;; +"Describe a part of a page for page formatting. Can be made into compound descriptions.") +REGIONFILLMETHOD (* ; "What kind of a region this is -- TEXT, FOLIO, PAGEHEADING, etc.") REGIONSPEC (* + ; "The page-relative region this occupies") REGIONLOCALINFO (* ; "A PLIST for local information") ( +REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") REGIONSUBBOXES (* ; +"The sub-regions of this region") REGIONTYPE (* ; "A user-settable region type"))) +(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 "16-Feb-2024 23:05:08")) +(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "12-Jun-2023 10:34:12")) +(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Jan-2024 12:12:29")) +(DECLARE%: DONTCOPY + (FILEMAP (NIL))) +STOP diff --git a/lispusers/COMPARESOURCES b/lispusers/COMPARESOURCES index 579fd1d5..e2116c12 100644 --- a/lispusers/COMPARESOURCES +++ b/lispusers/COMPARESOURCES @@ -1,18 +1,15 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "17-Jun-2023 15:22:40" {WMEDLEY}COMPARESOURCES.;131 39663 +(FILECREATED " 7-Feb-2024 16:08:54" {WMEDLEY}COMPARESOURCES.;137 40939 :EDIT-BY rmk - :CHANGES-TO (FNS CSBROWSER \CS.COMPARE.MASTERS) + :CHANGES-TO (VARS COMPARESOURCESCOMS) + (FNS COMPARESOURCES CSBROWSER \CS.IGNOREFORMS) - :PREVIOUS-DATE "22-May-2022 18:46:01" {WMEDLEY}COMPARESOURCES.;128) + :PREVIOUS-DATE "17-Jun-2023 15:22:40" {WMEDLEY}COMPARESOURCES.;131) -(* ; " -Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. -") - (PRETTYCOMPRINT COMPARESOURCESCOMS) (RPAQQ COMPARESOURCESCOMS @@ -21,7 +18,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (FNS \CS.ISFNFORM \CS.COMPARE.FNS \CS.FNSID \CS.ISVARFORM \CS.COMPARE.VARS \CS.ISMACROFORM \CS.ISRECFORM \CS.REC.NAME \CS.ISCOURIERFORM \CS.ISTEMPLATEFORM \CS.COMPARE.TEMPLATES \CS.ISPROPFORM \CS.PROP.NAME \CS.COMPARE.PROPS \CS.ISADDVARFORM \CS.COMPARE.ADDVARS - \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO) + \CS.ISFPKGCOMFORM \CS.COMPARE.FPKGCOMS \CS.COMPARE.DEFINE-FILE-INFO \CS.IGNOREFORMS) [COMS (FNS CSOBJ.CREATE CSOBJ.DISPLAYFN CSOBJ.IMAGEBOXFN CSOBJ.BUTTONEVENTINFN CSOBJ.COPYBUTTONEVENTINFN) (INITVARS (COMPARESOURCES-IMAGEFNS (IMAGEFNSCREATE 'CSOBJ.DISPLAYFN 'CSOBJ.IMAGEBOXFN @@ -36,7 +33,8 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (COMPARESOURCES - [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNORECOMMENTS LABELX LABELY) + [LAMBDA (FILEX FILEY EXAMINE DW? LISTSTREAM IGNOREFORMS LABEL1 LABEL2) + (* ; "Edited 7-Feb-2024 16:08 by rmk") (* ; "Edited 22-May-2022 18:45 by rmk") (* ;;; "Compare two lisp source files, reporting differences. LISTSTREAM if given is an open stream, or an object window") @@ -54,13 +52,13 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (SETQ CONTEXTSTREAM (CL:MAKE-STRING-OUTPUT-STREAM)) (LINELENGTH 65535 COMPARESTREAM) (* ; "Let the receiver do the wrapping") (LINELENGTH 65535 CONTEXTSTREAM)) - (OR (STREAMP FILEX) - (INFILEP FILEX) - (SETQ FILEX (FINDFILE FILEX T)) + (CL:UNLESS (OR (STREAMP FILEX) + (INFILEP FILEX) + (SETQ FILEX (FINDFILE FILEX T))) (RETURN (printout CONTEXTSTREAM FILEX " not found" T))) - (OR (STREAMP FILEY) - (INFILEP FILEY) - (SETQ FILEY (FINDFILE FILEY T)) + (CL:UNLESS (OR (STREAMP FILEY) + (INFILEP FILEY) + (SETQ FILEY (FINDFILE FILEY T))) (RETURN (printout CONTEXTSTREAM FILEY " not found" T))) (* ;; "Read the two files, throwing out extraneous forms & such:") @@ -71,23 +69,28 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (CL:MULTIPLE-VALUE-SETQ (BODYY ENVY) (READFILE FILEY)) (SETQ BODYY (\CS.FILTER.GARBAGE BODYY)) - (CL:WHEN IGNORECOMMENTS + (CL:WHEN (EQMEMB T IGNOREFORMS) (* ; + "Extra tests to recognize killable comments") + (SETQ IGNOREFORMS (REMOVE T IGNOREFORMS)) (LET ((*REMOVE-INTERLISP-COMMENTS* T)) (DECLARE (SPECVARS *REMOVE-INTERLISP-COMMENTS*)) (SETQ BODYX (REMOVE-COMMENTS BODYX)) (SETQ BODYY (REMOVE-COMMENTS BODYY)))) - (CL:UNLESS LABELX (SETQ LABELX FILEX)) - (CL:UNLESS LABELY (SETQ LABELY FILEY)) + (CL:WHEN IGNOREFORMS + (SETQ BODYX (\CS.IGNOREFORMS BODYX IGNOREFORMS)) + (SETQ BODYY (\CS.IGNOREFORMS BODYY IGNOREFORMS))) + (CL:UNLESS LABEL1 (SETQ LABEL1 FILEX)) + (CL:UNLESS LABEL2 (SETQ LABEL2 FILEY)) [SETQ DATECOL (PLUS 2 (CONSTANT (NCHARS "Comparing")) - (IMAX (NCHARS LABELX) - (NCHARS LABELY] - (printout CONTEXTSTREAM "Comparing " LABELX .TAB0 DATECOL "dated " (GETFILEINFO + (IMAX (NCHARS LABEL1) + (NCHARS LABEL2] + (printout CONTEXTSTREAM "Comparing " LABEL1 .TAB0 DATECOL "dated " (GETFILEINFO FILEX 'CREATIONDATE) .TAB [SUB1 (CONSTANT (IDIFFERENCE (NCHARS "Comparing ") (NCHARS "and "] - " and " LABELY .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE) + " and " LABEL2 .TAB0 DATECOL "dated " (GETFILEINFO FILEY 'CREATIONDATE) T T) [SETQ DECLAREX (for EXPR in BODYX collect EXPR when (EQ (CAR EXPR) 'DECLARE%:] @@ -107,7 +110,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. BODYX] (* ;  "Add placeholders for any declaration types in Y not in X to simplify what follows") - [for X in BODYX bind Y TYPE + (for X in BODYX bind Y TYPE do (SETQ Y (SASSOC (CAR X) BODYY)) (SETQ TYPE (CAR X)) @@ -117,8 +120,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. X :TEST (FUNCTION EQUALALL)))) :TEST (FUNCTION EQUALALL))) - (COND - ((OR X Y) + (CL:WHEN (OR X Y) (printout CONTEXTSTREAM T "------" [CONS 'DECLARE%: (APPEND ( CL:SET-DIFFERENCE TYPE @@ -129,7 +131,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation.  "REVERSE because \CS.SORT.DECLARES delivered expressions in reverse order") (\CS.COMPARE.MASTERS (REVERSE X) (REVERSE Y) - DW?] + DW?))) (TERPRI CONTEXTSTREAM)) (CL:WHEN INSERTOBJECTS (CL:UNLESS (EQ 0 (GETFILEPTR CONTEXTSTREAM)) @@ -489,6 +491,24 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. *DEFAULT-EXTERNALFORMAT*) (OR (LISTGET :FORMAT DFI2) *DEFAULT-EXTERNALFORMAT*]) + +(\CS.IGNOREFORMS + [LAMBDA (EXPR IGNOREFORMS CDRFLG) (* ; "Edited 7-Feb-2024 15:39 by rmk") + + (* ;; "Replaces each sublist of X that begins with something in IGNOREFORMS by '**IGNORED**. If IGNOREFORMS is or contains T, then comment-looking forms will be deleted.") + + (* ;; "Tricky because we only want to check the CAR's at each level, but also don't want to lose any NLISTP tails.") + + (if (NLISTP EXPR) + then EXPR + elseif (AND (NOT CDRFLG) + (EQMEMB (CAR EXPR) + IGNOREFORMS)) + then '**IGNORE** + else (CONS (\CS.IGNOREFORMS (CAR EXPR) + IGNOREFORMS) + (\CS.IGNOREFORMS (CDR EXPR) + IGNOREFORMS T]) ) (DEFINEQ @@ -622,7 +642,9 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (DEFINEQ (CSBROWSER - [LAMBDA (FILE1 FILE2 DW? LABEL1 LABEL2 REGION IGNORECOMMENTS TITLE) + [LAMBDA (FILE1 FILE2 DW? LABEL1 LABEL2 REGION IGNOREFORMS TITLE) + + (* ;; "Edited 7-Feb-2024 15:52 by rmk") (* ;; "Edited 17-Jun-2023 15:21 by rmk") @@ -662,7 +684,7 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (GETPROMPTWINDOW WINDOW T) (WINDOWPROP WINDOW 'UNDERSCONTRUCTION NIL) (COMPARESOURCES FILE1 FILE2 '(T 2WINDOWS) - DW? WINDOW IGNORECOMMENTS LABEL1 LABEL2) + DW? WINDOW IGNOREFORMS LABEL1 LABEL2) (OPENW WINDOW) WINDOW]) ) @@ -680,18 +702,18 @@ Copyright (c) 1985-1988, 2018, 2020-2021 by Xerox Corporation. (GLOBALVARS COMPARESOURCETYPES CLISPRECORDTYPES MACROPROPS DEFAULT.DECLARE.TAGS) ) ) -(PUTPROPS COMPARESOURCES COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988 2018 2020 2021)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1751 25612 (COMPARESOURCES 1761 . 7888) (\CS.COMPARE.MASTERS 7890 . 15411) ( -\CS.COMPARE.TYPES 15413 . 18679) (\CS.EXAMINE 18681 . 21859) (\CS.FIXFNS 21861 . 23363) ( -\CS.SORT.DECLARES 23365 . 23708) (\CS.SORT.DECLARE1 23710 . 25130) (\CS.FILTER.GARBAGE 25132 . 25610)) - (25613 30149 (\CS.ISFNFORM 25623 . 25891) (\CS.COMPARE.FNS 25893 . 26135) (\CS.FNSID 26137 . 26281) ( -\CS.ISVARFORM 26283 . 26388) (\CS.COMPARE.VARS 26390 . 27052) (\CS.ISMACROFORM 27054 . 27192) ( -\CS.ISRECFORM 27194 . 27522) (\CS.REC.NAME 27524 . 27843) (\CS.ISCOURIERFORM 27845 . 27945) ( -\CS.ISTEMPLATEFORM 27947 . 28045) (\CS.COMPARE.TEMPLATES 28047 . 28412) (\CS.ISPROPFORM 28414 . 28569) - (\CS.PROP.NAME 28571 . 28716) (\CS.COMPARE.PROPS 28718 . 28875) (\CS.ISADDVARFORM 28877 . 28970) ( -\CS.COMPARE.ADDVARS 28972 . 29137) (\CS.ISFPKGCOMFORM 29139 . 29346) (\CS.COMPARE.FPKGCOMS 29348 . -29555) (\CS.COMPARE.DEFINE-FILE-INFO 29557 . 30147)) (30150 36214 (CSOBJ.CREATE 30160 . 30573) ( -CSOBJ.DISPLAYFN 30575 . 31328) (CSOBJ.IMAGEBOXFN 31330 . 33491) (CSOBJ.BUTTONEVENTINFN 33493 . 35964) -(CSOBJ.COPYBUTTONEVENTINFN 35966 . 36212)) (37095 39236 (CSBROWSER 37105 . 39234))))) + (FILEMAP (NIL (1748 26130 (COMPARESOURCES 1758 . 8406) (\CS.COMPARE.MASTERS 8408 . 15929) ( +\CS.COMPARE.TYPES 15931 . 19197) (\CS.EXAMINE 19199 . 22377) (\CS.FIXFNS 22379 . 23881) ( +\CS.SORT.DECLARES 23883 . 24226) (\CS.SORT.DECLARE1 24228 . 25648) (\CS.FILTER.GARBAGE 25650 . 26128)) + (26131 31474 (\CS.ISFNFORM 26141 . 26409) (\CS.COMPARE.FNS 26411 . 26653) (\CS.FNSID 26655 . 26799) ( +\CS.ISVARFORM 26801 . 26906) (\CS.COMPARE.VARS 26908 . 27570) (\CS.ISMACROFORM 27572 . 27710) ( +\CS.ISRECFORM 27712 . 28040) (\CS.REC.NAME 28042 . 28361) (\CS.ISCOURIERFORM 28363 . 28463) ( +\CS.ISTEMPLATEFORM 28465 . 28563) (\CS.COMPARE.TEMPLATES 28565 . 28930) (\CS.ISPROPFORM 28932 . 29087) + (\CS.PROP.NAME 29089 . 29234) (\CS.COMPARE.PROPS 29236 . 29393) (\CS.ISADDVARFORM 29395 . 29488) ( +\CS.COMPARE.ADDVARS 29490 . 29655) (\CS.ISFPKGCOMFORM 29657 . 29864) (\CS.COMPARE.FPKGCOMS 29866 . +30073) (\CS.COMPARE.DEFINE-FILE-INFO 30075 . 30665) (\CS.IGNOREFORMS 30667 . 31472)) (31475 37539 ( +CSOBJ.CREATE 31485 . 31898) (CSOBJ.DISPLAYFN 31900 . 32653) (CSOBJ.IMAGEBOXFN 32655 . 34816) ( +CSOBJ.BUTTONEVENTINFN 34818 . 37289) (CSOBJ.COPYBUTTONEVENTINFN 37291 . 37537)) (38420 40605 ( +CSBROWSER 38430 . 40603))))) STOP diff --git a/lispusers/COMPARESOURCES.LCOM b/lispusers/COMPARESOURCES.LCOM index b1a05ab2c38cb2ddf6b2830aa7d810711c49a45a..70a5f6a1947c062967c3d3ab706f8f84999f169c 100644 GIT binary patch delta 1653 zcmZux&2QX96ko@IBu*s~6462{^5jyqiR8r}V|(m^$n1JHaq-%V?Ic7BNDZ5oRY_9P zA|Y{D3B(zY)idJC0hMmJ74=w&e}eKKw48cEJg?W;ZHNz^H}7lSd-I#${cnZuzY~7g zS_E5Z?(HhNsuR#GSEa5=e!N9{_A*E^m}5r6HC2~T8Fr8MK0VyO-Ti#81AAZHKDu+o zg@ePppLGvzLiYgV=0*^}cxbIwlc96{F8ZI9)70fVoK@D>)t(JR zbqohw?)j-w--e_8TOhfObr!DiL`fs4Zn8LmM$~Gvm?zOj+~5iBl4Yni!_x+6B=tDj zN_Y%AjilzUg;C6#QJlNG?U--+(MFO9a;G+`8* z8RAvpuk28amuhULf?xkavHr@sQoi4vI2OP8O?aL?5uNwCPk-SZ@xj}Vy8P0Er7kZ# zq(|L(VJ;YiKWq(_j~Dn)L1BK_D%L;xwaI@cdQ=0fmB$GO$0iWfuhp36wOF{FMqA)m z26!iSVh>s!4ye{*Ns58skg*&F8RgS0K!8I1lD+(1FW6KU}AB@j!aXBow9gScLtM5qByO2ybQ8x!Ij&O};tpLvpI@Ln3w4zO}Af{S8OcT%?=l?od`XSHc)9b$_%?lFE@4m%> z((L`&3)?n@;pmZ6DA9p`xWNL3ghCA)+>|FNQ0!@>Mo<=N8w(l5T9!GsBQ(1|`&!RY zVSo%j3I}i6z~FHO(h#EDK>oRLc(i{<8GJIr+Jvg2ECaPHkV~ya2s$G1q4Spq9T_ZL zeNkc9Hpm6<$zTxcbu?c;=-}T_Eoo%Z?fxg{{)FBs3If-oQq>0?8eZHC){th9YDN@= zdlmRc?RXg~RH#(MRq^N5xqAQ2RbgJJth1-TpJU?j^g6qAEOuYLcQa?6xmAG;2xfJH zb!T(U8*`Ov{tOz)JLCKZq(J!Cc{m*;hLx2S9tY48RD?P{8BJ;q4)*)yXHP|PoY&05u|3;uSE(E_T0}IOR9Pp+ zsS=1YLq73OARtIwIC12}75)Y!{sYA4Bu+Z^4&VFU_xtDj=4`^R?@8c(>VZgO_INAWZgivxm08AjBLDzo;@KU`vk)&$12B%YU>x z4I*c6HQv*1A3+ELBEPGmhlp|r`*D(~AQ=o)T$IJeUG10h`9}8cb${~}JhQFE{k=cZ ztM{YE&l_L8_`_w*TMYy=+^A>YyUPn%mxfjWw`>EGDy1jJASV> z@Z+N*IRqDb&|C2>2NP=bU2Cl)UAEGfQb3`yGz&pGF5n&8AceESEI9VlRK-04l3S(S zytO4MsoBI@X`>@#ZaC7d?oS=gAoue;3Ba*rjS73^PT1Dc3U_PA+$FU=j)5(r;SR4c zVPl`FbQc{4&PDn6_I8^y27Ogjy-$k_I0m>(irZwJ0F$M**?gNx8;*m#lP6ix>8T*{ zGnE5#XjQ4(468fvKU5|TQBP&2iVwmpiK`9*Bjs?jrCFubY+h1~Yw3jwxkl|}w3PEY zs4(73fHGQhs11eR1xi-380I2dYGFx{N8GwRM6QyX+ablK^JQ>4%LDzgt($B2*2`TOke~rm78K(^G=6Jj9YlAfS|c66om_q zb4$U1PbSl|C+7SZIH??VOtTG=2rz1@uow!CCl@IEbbMj}m)45}N*yp3Ka2s?LR}b+ zPY@Czbhx=<5jy+p_1|H3*!k_X8_PP*ww)W-OSbDZK%brOzVqsEC*3d7EJ^WmNd{>( zWXXOO;HU*jdX$Czdj;$m4^O9)XAn%L=acF1Vl){WV7ro6Kvck~fCOUM6~KK%V7J?P H97g(oN&H#e diff --git a/lispusers/DOC-OBJECTS b/lispusers/DOC-OBJECTS index a526d43e..1c5c4baf 100644 --- a/lispusers/DOC-OBJECTS +++ b/lispusers/DOC-OBJECTS @@ -1,50 +1,48 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10) -(FILECREATED " 9-May-2018 11:09:43"  -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>DOC-OBJECTS.;7 50515 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (FNS DOCOBJ-INCLUDE-EDIT DOCOBJ-INCLUDE-BEFOREHARDCOPYFN) +(FILECREATED "16-Feb-2024 23:54:59" {WMEDLEY}DOC-OBJECTS.;28 52405 - previous date%: " 9-May-2018 10:35:47" -{DSK}kaplan>Local>medley3.5>lispcore>lispusers>DOC-OBJECTS.;4) + :EDIT-BY rmk + :CHANGES-TO (FNS DOCOBJ-INCLUDE-BEFOREHARDCOPYFN) + + :PREVIOUS-DATE "11-Dec-2023 11:32:46" {WMEDLEY}DOC-OBJECTS.;27) -(* ; " -Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights reserved. -") (PRETTYCOMPRINT DOC-OBJECTSCOMS) (RPAQQ DOC-OBJECTSCOMS [ -(* ;;; "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.") +(* ;;; "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 IMAGEOBJ) + TEDIT TEDIT IMAGEOBJ) + (DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) (VARS (DocObjectsMenu NIL) (DocObjectsConfirmEditMenu NIL)) [INITVARS (DocObjectsMenuCommands NIL) (DocObjectsMenuFont (FONTCREATE '(MODERN 12 BOLD] (COMS - (* ;; "The hook into GET.OBJ.FROM.USER") + (* ;; "The hook into GET.OBJ.FROM.USER") (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)) [COMS - (* ;; "Eval'd Form") + (* ;; "Eval'd Form") (FNS DOCOBJ-ACQUIRE-EVALED-OBJECT) (ADDVARS (DocObjectsMenuCommands ("Eval'd Form" (DOCOBJ-ACQUIRE-EVALED-OBJECT) "Insert the value of a form to be typed in"] [COMS - (* ;; "Screen Snap") + (* ;; "Screen Snap") (FNS DOCOBJ-ACQUIRE-SNAPPED-OBJECT) (ADDVARS (DocObjectsMenuCommands ("Screen Snap" (DOCOBJ-ACQUIRE-SNAPPED-OBJECT) "Insert a snap from the screen"] [COMS - (* ;; "Time Stamp") + (* ;; "Time Stamp") (DECLARE%: DONTCOPY (RECORDS DOCOBJ-TIMESTAMP)) (FILES (SYSLOAD) @@ -58,7 +56,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (ADDVARS (DocObjectsMenuCommands ("Time Stamp" (DOCOBJ-MAKE-TIMESTAMP) "Date & time this document is PUT"] [COMS - (* ;; "File Stamp") + (* ;; "File Stamp") (FNS DOCOBJ-MAKE-FILESTAMP DOCOBJ-MAKE-FILESTAMP-IMAGEFNS DOCOBJ-FILESTAMP-COPYFN DOCOBJ-FILESTAMP-DISPLAYFN DOCOBJ-FILESTAMP-GETFN DOCOBJ-FILESTAMP-IMAGEBOXFN @@ -70,7 +68,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re "Name of file to which this document was last PUT." ] (COMS - (* ;; "Horizontal Rule") + (* ;; "Horizontal Rule") (FILES (SYSLOAD) HRULE READNUMBER) @@ -82,15 +80,16 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re "One or more horizontal rules"))) (P (DOCOBJ-HRULE-INIT))) [COMS - (* ;; "INCLUDE") + (* ;; "INCLUDE") (DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS INCLOBJ)) + (INITVARS (DOCOBJ-INCLUDE-SAFE T)) (FNS DOCOBJ-MAKE-INCLUDE DOCOBJ-MAKE-INCLUDE-IMAGEFNS DOCOBJ-INCLUDE-CREATE-OBJ DOCOBJ-INCLUDE-EDIT DOCOBJ-INCLUDE-EDIT-WINDOWP DOCOBJ-INCLUDE-RESET-OBJ) - (FNS DOCOBJ-INCLUDE-AFTERHARDCOPYFN DOCOBJ-INCLUDE-BEFOREHARDCOPYFN - DOCOBJ-INCLUDE-CLEANUPFN DOCOBJ-INCLUDE-BUTTONEVENTINFN DOCOBJ-INCLUDE-COPYFN - DOCOBJ-INCLUDE-DISPLAYFN DOCOBJ-INCLUDE-GETFN DOCOBJ-INCLUDE-IMAGEBOXFN - DOCOBJ-INCLUDE-PREPRINTFN DOCOBJ-INCLUDE-PUTFN) + (FNS DOCOBJ-INCLUDE-BEFOREHARDCOPYFN DOCOBJ-INCLUDE-CLEANUPFN + DOCOBJ-INCLUDE-BUTTONEVENTINFN DOCOBJ-INCLUDE-COPYFN DOCOBJ-INCLUDE-DISPLAYFN + DOCOBJ-INCLUDE-GETFN DOCOBJ-INCLUDE-IMAGEBOXFN DOCOBJ-INCLUDE-PREPRINTFN + DOCOBJ-INCLUDE-PUTFN) (INITVARS (DOCOBJ-INCLUDE-EDITMENU) (DOCOBJ-INCLUDE-IMAGEFNS (DOCOBJ-MAKE-INCLUDE-IMAGEFNS))) (ADDVARS (DocObjectsMenuCommands ("Include" (DOCOBJ-MAKE-INCLUDE) @@ -109,7 +108,11 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (FILESLOAD (SYSLOAD) - TEDIT IMAGEOBJ) + TEDIT TEDIT IMAGEOBJ) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD TEDIT-EXPORTS.ALL) +) (RPAQQ DocObjectsMenu NIL) @@ -126,20 +129,20 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (DEFINEQ (DOCOBJ-ACQUIRE-OBJECT - [LAMBDA NIL (* ; "Edited 15-Oct-87 16:27 by Koomen") + [LAMBDA NIL (* ; "Edited 22-Jun-2023 14:14 by rmk") + (* ; "Edited 15-Oct-87 16:27 by Koomen") (* ;;; "This function is invoked by TEdit's GET.OBJ.FROM.USER (cf. the Library file IMAGEOBJ) after (CHANGENAME (QUOTE GET.OBJ.FROM.USER) (QUOTE PROMPTFOREVALED) (QUOTE DOCOBJ-ACQUIRE-OBJECT))") (* ;;; "When adding more items to the DocObjectsMenuCommands, do (SETQ DocObjectsMenu)") (DECLARE (GLOBALVARS DocObjectsMenu DocObjectsMenuCommands DocObjectsMenuFont)) - (if (NOT (type? MENU DocObjectsMenu)) - then (SETQ DocObjectsMenu - (create MENU - TITLE _ "Select object type: " - CENTERFLG _ T - ITEMS _ DocObjectsMenuCommands - MENUFONT _ DocObjectsMenuFont))) + (CL:UNLESS (type? MENU DocObjectsMenu) + (SETQ DocObjectsMenu (create MENU + TITLE _ "Select object type: " + CENTERFLG _ T + ITEMS _ DocObjectsMenuCommands + MENUFONT _ DocObjectsMenuFont))) (MENU DocObjectsMenu]) (DOCOBJ-INIT @@ -164,58 +167,39 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM]) (DOCOBJ-GET-LOOKS - [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* 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) + [LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "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) - (* He handed us a - CHARLOOKS. Unparse it for - him.) + ((type? CHARLOOKS CH#ORCHARLOOKS) (* ; + "He handed us a CHARLOOKS. Unparse it for him.") (SETQ LOOKS CH#ORCHARLOOKS)) - ((ZEROP (fetch TEXTLEN of TEXTOBJ)) - - (* There's no text in the document. - Use the extant caret looks.) - + ((ZEROP (fetch TEXTLEN of TEXTOBJ)) (* ; + "There's no text in the document. Use the extant caret looks.") (SETQ LOOKS (fetch CARETLOOKS of TEXTOBJ))) - [(FIXP CH#ORCHARLOOKS) - - (* He gave us a CH# to geth the looks of. - Grab it.) - - (SETQ LOOKS (fetch PLOOKS - of (\CHTOPC (IMIN (fetch TEXTLEN - of TEXTOBJ) - CH#ORCHARLOOKS) - (fetch PCTB of TEXTOBJ] - [(type? SELECTION CH#ORCHARLOOKS) - (* Get the looks of the - selected text) - (SETQ LOOKS (fetch PLOOKS - of (\CHTOPC (IMIN (fetch TEXTLEN - of TEXTOBJ) - (fetch (SELECTION CH#) - of CH#ORCHARLOOKS)) - (fetch PCTB of TEXTOBJ] - ((NULL CH#ORCHARLOOKS) (* Get the looks of the - selected text) - (SETQ LOOKS - (fetch PLOOKS - of (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) - (fetch (SELECTION CH#) - of (fetch SEL of TEXTOBJ))) - (fetch PCTB of TEXTOBJ] + [(FIXP CH#ORCHARLOOKS) (* ; + "He gave us a CH# to get the looks of. Grab it.") + (SETQ LOOKS (PLOOKS (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) + CH#ORCHARLOOKS) + TEXTOBJ] + [(type? SELECTION CH#ORCHARLOOKS) (* ; + "Get the looks of the selected text") + (SETQ LOOKS (PLOOKS (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) + (fetch (SELECTION CH#) of CH#ORCHARLOOKS)) + TEXTOBJ] + ((NULL CH#ORCHARLOOKS) (* ; + "Get the looks of the selected text") + (SETQ LOOKS (PLOOKS (\CHTOPC (IMIN (fetch TEXTLEN of TEXTOBJ) + (fetch (SELECTION CH#) of (fetch SEL of TEXTOBJ))) + TEXTOBJ] (RETURN LOOKS) - - (* * Now break the looks apart into a PROPLIST) + +(* ;;; "Now break the looks apart into a PROPLIST") (SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS)) (RETURN NLOOKS]) @@ -260,61 +244,106 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re then (RETURN NIL)) finally (RETURN T]) (DOCOBJ-INVOKE-IMAGEOBJFN - [LAMBDA (CH# PIECE PC# IMAGEOBJFNNAME) (* ; "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. ") + [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") - (PROG (IMAGEOBJ IMAGEOBJFN) - (if (NOT (type? PIECE PIECE)) - then (RETURN)) - (SETQ IMAGEOBJ (fetch POBJ of PIECE)) - (if (NOT (IMAGEOBJP IMAGEOBJ)) - then (RETURN)) - (SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME)) - (if (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN)) - then (APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE PC#]) + (* ;; "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 25-May-93 13:07 by sybalsky:mv:envos") + [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "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") - (* ;; "Bug in TEDIT.FORMAT.HARDCOPY!!! This function is called with the arguments TEXTSTREAM and TEXTOBJ, but TEXTSTREAM is undefined!") + (* ;; "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.") - (* ;; "*DOCOBJ-FORMS* is used to enable insertion and deletion of pieces. DocObjects can postpone insertion or deletion by added appropriate forms to *DOCOBJ-FORMS*. Can't do it while under TEDIT.MAPPIECES as the pointers get screwed up. ") + (RESETLST - (DECLARE (SPECVARS *DOCOBJ-FORMS*)) - (LET ((TEXTSTREAM (TEXTSTREAM TEXTOBJ)) - (*DOCOBJ-FORMS*)) - (TEXTPROP TEXTSTREAM 'DOCOBJ-VIRGINP (NOT (TEDIT.STREAMCHANGEDP TEXTSTREAM))) + (* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces. ") - (* ;; "After hardcopy, TEXTSTREAM is reset if this flag is T") + (RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T) + `(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE)) + (LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY)) + (OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY)) + (PREVSEL (\COPYSEL (TEXTSEL TEXTOBJ))) + FAILED) - (do (SETQ *DOCOBJ-FORMS*) - (TEDIT.MAPPIECES TEXTOBJ (FUNCTION DOCOBJ-INVOKE-IMAGEOBJFN) - 'BEFOREHARDCOPYFN) - [WITHOUT-UPDATES TEXTOBJ (FETCH (TEXTOBJ SCRATCHSEL) OF TEXTOBJ) - (for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM) - (CDR FRM] repeatwhile - *DOCOBJ-FORMS*]) + (* ;; "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 _ (\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 + (* ;; + "Nothing affected this PC, advance") + + (add CH# (PLEN PC)) + PC + else + (* ;; + "Otherwise investigate its replacement") + + PREVPC)) + elseif (EQ PC (\FIRSTPIECE TEXTOBJ)) + then (add CH# (PLEN PC)) + (NEXTPIECE PC) + else + (* ;; + "Investigate the replacement of the previous first piece.") + + (\FIRSTPIECE TEXTOBJ)) + else (add CH# (PLEN PC)) + (NEXTPIECE PC] (* ; "Restore previous settings") + (* ; + "The history event may restore SEL, but...") + (SETTOBJ TEXTOBJ \DIRTY OLDDIRTY) + + (* ;; "Make a single undoing event for the after fn") + + (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)) + (if FAILED + then (DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM TEXTOBJ) + (* ; "UNDO whatever was saved") + (SETTOBJ TEXTOBJ SEL PREVSEL) + 'DON'T)))]) (DOCOBJ-AFTERHARDCOPYFN - [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; - "Edited 25-May-93 13:08 by sybalsky:mv:envos") - - (* ;; "Bug in TEDIT.FORMAT.HARDCOPY!!! This function is called with the arguments TEXTSTREAM and TEXTOBJ, but TEXTSTREAM is undefined, and TEXTOBJ is NIL!") - - (DECLARE (SPECVARS *DOCOBJ-FORMS*)) - (LET ((*DOCOBJ-FORMS*)) - (do (SETQ *DOCOBJ-FORMS*) - (TEDIT.MAPPIECES TEXTOBJ (FUNCTION DOCOBJ-INVOKE-IMAGEOBJFN) - 'AFTERHARDCOPYFN) - [WITHOUT-UPDATES TEXTOBJ (fetch (TEXTOBJ SCRATCHSEL) of TEXTOBJ) - (for FRM in *DOCOBJ-FORMS* do (APPLY (CAR FRM) - (CDR FRM] repeatwhile - *DOCOBJ-FORMS*) - (COND - ((TEXTPROP TEXTSTREAM 'DOCOBJ-VIRGINP) - (TEDIT.STREAMCHANGEDP TEXTSTREAM T]) + [LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 15-Jul-2023 15:57 by rmk") + (* ; + "Edited 25-May-93 13:08 by sybalsky:mv:envos") + (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)))]) ) @@ -333,7 +362,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re ) (ADDTOVAR DocObjectsMenuCommands ("Eval'd Form" (DOCOBJ-ACQUIRE-EVALED-OBJECT) - "Insert the value of a form to be typed in")) + "Insert the value of a form to be typed in")) @@ -347,7 +376,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re ) (ADDTOVAR DocObjectsMenuCommands ("Screen Snap" (DOCOBJ-ACQUIRE-SNAPPED-OBJECT) - "Insert a snap from the screen")) + "Insert a snap from the screen")) @@ -470,7 +499,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (RPAQ? DOCOBJ-TIMESTAMP-IMAGEFNS (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("Time Stamp" (DOCOBJ-MAKE-TIMESTAMP) - "Date & time this document is PUT")) + "Date & time this document is PUT")) @@ -582,7 +611,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (RPAQ? DOCOBJ-FILESTAMP-IMAGEFNS (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("File Stamp" (DOCOBJ-MAKE-FILESTAMP) - "Name of file to which this document was last PUT.")) + "Name of file to which this document was last PUT.")) @@ -654,7 +683,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (RPAQQ DOCOBJ-HRULE-BLANK-PAD NIL) (ADDTOVAR DocObjectsMenuCommands ("Horizontal Rule" (DOCOBJ-MAKE-HRULE) - "One or more horizontal rules")) + "One or more horizontal rules")) (DOCOBJ-HRULE-INIT) @@ -668,6 +697,8 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (RECORD INCLOBJ (FILENAME ENABLEDP)) ) ) + +(RPAQ? DOCOBJ-INCLUDE-SAFE T) (DEFINEQ (DOCOBJ-MAKE-INCLUDE @@ -699,23 +730,21 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re WHENMOVEDFN WHENINSERTEDFN WHENDELETEDFN WHENCOPIEDFN WHENOPERATEDONFN PREPRINTFN]) (DOCOBJ-INCLUDE-CREATE-OBJ - [LAMBDA (INCLOBJ) (* ; "Edited 23-Oct-87 14:06 by Koomen") - + [LAMBDA (INCLOBJ) (* ; "Edited 21-Jun-2023 20:37 by rmk") + (* ; "Edited 23-Oct-87 14:06 by Koomen") (DECLARE (GLOBALVARS DOCOBJ-INCLUDE-IMAGEFNS)) - (PROG (IMAGEOBJ) - [if INCLOBJ - then (if (NLISTP INCLOBJ) - then - - (* ;; "Just a file name") + (LET (IMAGEOBJ) + (CL:WHEN (AND INCLOBJ (NLISTP INCLOBJ)) - (SETQ INCLOBJ (create INCLOBJ - FILENAME _ (MKSTRING INCLOBJ) - ENABLEDP _ T] - (SETQ IMAGEOBJ (IMAGEOBJCREATE INCLOBJ DOCOBJ-INCLUDE-IMAGEFNS)) - (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ) - (DOCOBJ-REGISTER-OBJECT IMAGEOBJ) - (RETURN IMAGEOBJ]) + (* ;; "Just a file name") + + (SETQ INCLOBJ (create INCLOBJ + FILENAME _ (MKSTRING INCLOBJ) + ENABLEDP _ T))) + (SETQ IMAGEOBJ (IMAGEOBJCREATE INCLOBJ DOCOBJ-INCLUDE-IMAGEFNS)) + (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ) + (DOCOBJ-REGISTER-OBJECT IMAGEOBJ) + IMAGEOBJ]) (DOCOBJ-INCLUDE-EDIT [LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:") @@ -793,8 +822,8 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (DOCOBJ-INCLUDE-EDIT-WINDOWP FILENAME (WINDOWPROP WINDOW 'ICONFOR]) (DOCOBJ-INCLUDE-RESET-OBJ - [LAMBDA (IMAGEOBJ) (* ; "Edited 23-Oct-87 14:09 by Koomen") - + [LAMBDA (IMAGEOBJ) (* ; "Edited 16-Jul-2023 10:02 by rmk") + (* ; "Edited 23-Oct-87 14:09 by Koomen") (DECLARE (GLOBALVARS DOCOBJ-INCLUDE-IMAGEFNS)) (PROG (INCLOBJ FNAME) (if (SETQ INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)) @@ -803,118 +832,87 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (IMAGEOBJPROP IMAGEOBJ 'DONTINCLDISPLAYSTRING (CONCAT "@DoNotInclude[" FNAME "]")) ) (IMAGEOBJPROP IMAGEOBJ 'BEFOREHARDCOPYFN (FUNCTION DOCOBJ-INCLUDE-BEFOREHARDCOPYFN)) - (IMAGEOBJPROP IMAGEOBJ 'AFTERHARDCOPYFN (FUNCTION DOCOBJ-INCLUDE-AFTERHARDCOPYFN]) + + (* ;; "There is now no need to cleanup afterwards--the TEDIT history undoes the inclusion and any other hardcopy stuff.") + + (AND NIL (IMAGEOBJPROP IMAGEOBJ 'AFTERHARDCOPYFN (FUNCTION DOCOBJ-INCLUDE-AFTERHARDCOPYFN]) ) (DEFINEQ -(DOCOBJ-INCLUDE-AFTERHARDCOPYFN - [LAMBDA (IMAGEOBJ CH#) (* ; - "Edited 3-Jun-93 12:42 by sybalsky:mv:envos") - (DECLARE (SPECVARS TEXTSTREAM)) - (COND - ((IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM) - - (* ;; "Just record current position, let endmarker do the rest") - - (IMAGEOBJPROP IMAGEOBJ 'INCLSTARTPOS (ADD1 CH#))) - (T - (* ;; "Hit an end marker") - - (PROG (HEADOBJ STARTPOS) - (SETQ HEADOBJ (IMAGEOBJPROP IMAGEOBJ 'INCLIMAGEOBJ)) - (SETQ STARTPOS (IMAGEOBJPROP HEADOBJ 'INCLSTARTPOS)) - (IMAGEOBJPROP HEADOBJ 'INCLUDEDP NIL) - (push *DOCOBJ-FORMS* `(DOCOBJ-INCLUDE-CLEANUPFN ,TEXTSTREAM ,STARTPOS - ,(ADD1 (IDIFFERENCE CH# STARTPOS]) - (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN - [LAMBDA (IMAGEOBJ CH#) (* ; "Edited 9-May-2018 11:08 by rmk:") - (* ; "Edited 9-May-2018 09:50 by rmk:") - (* ; "Edited 9-May-2018 09:20 by rmk:") - (* ; - "Edited 1-Jun-93 10:56 by sybalsky:mv:envos") - (DECLARE (SPECVARS *DOCOBJ-FORMS* TEXTOBJ)) + [LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "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") - (* ;; "RMK: Changed to default to file in same directory as the including file. ") + (* ;; "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.'") - (LET [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] - (COND - ([AND INCLOBJ (fetch (INCLOBJ ENABLEDP) of INCLOBJ) - (NOT (IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP] + (* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.") - (* ;; "We're under MAP.PIECES -- dangerous to insert here, so postpone") + (* ;; "Not sure why the INCLUDEDP property. If enabled, it's included.") - (push - *DOCOBJ-FORMS* - (LIST [FUNCTION (LAMBDA (STARTPOS INCLFILE IMAGEOBJ ENDOBJ WINDOWS) - (DECLARE (SPECVARS TEXTSTREAM)) - (COND - (WINDOWS (TEDIT.PROMPTPRINT TEXTSTREAM "Including " T) - (TEDIT.PROMPTPRINT TEXTSTREAM INCLFILE) - (TEDIT.PROMPTPRINT TEXTSTREAM "...")) - (T (PROMPTPRINT "[TEdit hardcopy: including " INCLFILE "...]"))) - (WITHOUT-UPDATES - (TEXTOBJ TEXTSTREAM) - (fetch (TEXTOBJ SCRATCHSEL) of (TEXTOBJ TEXTSTREAM)) - (TEDIT.SETSEL TEXTSTREAM STARTPOS 0 'RIGHT) + (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") - (* ;; "Force paragraph boundary, so that the first paragraph of the included document doesn't inherit the paralooks of the paragraph containing the @Include.") + (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.") - (TEDIT.INSERT TEXTSTREAM " -") - (TEDIT.PARALOOKS TEXTSTREAM - '(NEWPAGEAFTER NIL NEWPAGEBEFORE NIL LINELEADING 0 - POSTPARALEADING 0 PARALEADING 0)) + (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME + ) + of OBJ) + " not found") + T T) + NIL)) + else + (* ;; "Succeeded as intended") - (* ;; - "For space efficiency, tell TEdit to assume that the file will exist as long as we need it.") - - (TEDIT.INCLUDE - TEXTSTREAM - (OR [FINDFILE INCLFILE T (CONS (PACKFILENAME.STRING - 'HOST - (FILENAMEFIELD (FETCH TXTFILE - OF - (TEXTOBJ - TEXTSTREAM - )) - 'HOST) - 'DIRECTORY - (FILENAMEFIELD (FETCH TXTFILE - OF - (TEXTOBJ - TEXTSTREAM - )) - 'DIRECTORY] - INCLFILE) - NIL NIL T) - (TEDIT.INSERT.OBJECT ENDOBJ TEXTSTREAM) - (IMAGEOBJPROP ENDOBJ 'INCLIMAGEOBJ IMAGEOBJ) - (IMAGEOBJPROP IMAGEOBJ 'INCLUDEDP T)) - (COND - (WINDOWS (TEDIT.PROMPTPRINT TEXTSTREAM " done.")) - (T (PROMPTPRINT "[TEdit hardcopy: including " INCLFILE - "... done.]"] - (ADD1 CH#) - (fetch (INCLOBJ FILENAME) of INCLOBJ) - IMAGEOBJ - (DOCOBJ-INCLUDE-CREATE-OBJ) - (fetch (TEXTOBJ \WINDOW) of TEXTOBJ]) + T]) (DOCOBJ-INCLUDE-CLEANUPFN - [LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; - "Edited 3-Jun-93 12:43 by sybalsky:mv:envos") + [LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; "Edited 11-Dec-2023 11:32 by rmk") + (* ; "Edited 22-Jun-2023 16:53 by rmk") + (* ; "Edited 6-Sep-2022 10:08 by rmk") + (* ; + "Edited 3-Jun-93 12:43 by sybalsky:mv:envos") (* ;; "Do the cleanup of removing an included file's pieces (and closing it) after hardcopying with inclusions.") - (LET* ((SEL (TEDIT.SETSEL TEXTSTREAM STARTPOS LEN)) - (PCS (TEDIT.SELECTED.PIECES (TEXTOBJ TEXTSTREAM) - SEL))) - (for PC in PCS when (AND (fetch (PIECE PFILE) of PC) - (OPENP (fetch (PIECE PFILE) of PC))) - do (CLOSEF (fetch (PIECE PFILE) of PC))) - (TEDIT.DELETE TEXTSTREAM STARTPOS LEN) - (BLOCK]) + (HELP "NOTUSED?" 'DOCOBJ-INCLUDE-CLEANUPFN) + (LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))) + (for PC inselpieces (\SELPIECES STARTPOS (SUB1 (IPLUS STARTPOS LEN)) + TEXTOBJ) when (MEMB (PTYPE PC) + FILE.PTYPES) do (CLOSEF? (PCONTENTS PC))) + + (* ;; "We don't want these deletes on the history list") + + (replace (TEXTOBJ TXTHISTORY) of TEXTOBJ with (PROG1 (fetch (TEXTOBJ TXTHISTORY) + of TEXTOBJ) + (TEDIT.DELETE TEXTSTREAM STARTPOS LEN)) + ) + (BLOCK]) (DOCOBJ-INCLUDE-BUTTONEVENTINFN [LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) @@ -933,15 +931,14 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (DOCOBJ-INCLUDE-CREATE-OBJ (COPYALL (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM]) (DOCOBJ-INCLUDE-DISPLAYFN - [LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* ; "Edited 23-Oct-87 14:42 by Koomen") - - (PROG [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] - (if [AND INCLOBJ (OR (EQ IMAGESTREAMTYPE 'DISPLAY) - (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ] - then (printout IMAGESTREAM (IMAGEOBJPROP IMAGEOBJ (if (fetch (INCLOBJ ENABLEDP) - of INCLOBJ) - then 'INCLDISPLAYSTRING - else 'DONTINCLDISPLAYSTRING]) + [LAMBDA (IMAGEOBJ IMAGESTREAM IMAGESTREAMTYPE HOSTSTREAM) (* ; "Edited 22-Jun-2023 14:00 by rmk") + (* ; "Edited 23-Oct-87 14:42 by Koomen") + (LET [(INCLOBJ (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM] + (CL:WHEN [AND INCLOBJ (OR (EQ IMAGESTREAMTYPE 'DISPLAY) + (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ] + [printout IMAGESTREAM (IMAGEOBJPROP IMAGEOBJ (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ) + then 'INCLDISPLAYSTRING + else 'DONTINCLDISPLAYSTRING])]) (DOCOBJ-INCLUDE-GETFN [LAMBDA (FILESTREAM) (* ; "Edited 26-Oct-87 22:00 by Koomen") @@ -999,7 +996,7 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (RPAQ? DOCOBJ-INCLUDE-IMAGEFNS (DOCOBJ-MAKE-INCLUDE-IMAGEFNS)) (ADDTOVAR DocObjectsMenuCommands ("Include" (DOCOBJ-MAKE-INCLUDE) - "Include another document right here when hardcopying")) + "Include another document right here when hardcopying")) (DECLARE%: DONTEVAL@LOAD DOCOPY (DOCOBJ-INIT) @@ -1008,35 +1005,33 @@ Copyright (c) 1986, 1987, 1993, 2018 by Johannes A. G. M. Koomen. All rights re (PUTPROPS DOC-OBJECTS FILETYPE :TCOMPL) -(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE - 10)) +(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10)) ) -(PUTPROPS DOC-OBJECTS COPYRIGHT ("Johannes A. G. M. Koomen" 1986 1987 1993 2018)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (7690 17683 (DOCOBJ-ACQUIRE-OBJECT 7700 . 8574) (DOCOBJ-INIT 8576 . 9204) ( -DOCOBJ-TEDIT-MENU-ENTRY 9206 . 9628) (DOCOBJ-GET-LOOKS 9630 . 12365) (DOCOBJ-REGISTER-OBJECT 12367 . -13021) (DOCOBJ-STRING-IMAGEBOX 13023 . 13971) (DOCOBJ-WAIT-MOUSE 13973 . 14433) ( -DOCOBJ-INVOKE-IMAGEOBJFN 14435 . 15219) (DOCOBJ-BEFOREHARDCOPYFN 15221 . 16614) ( -DOCOBJ-AFTERHARDCOPYFN 16616 . 17681)) (17713 17980 (DOCOBJ-ACQUIRE-EVALED-OBJECT 17723 . 17978)) ( -18184 18326 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 18194 . 18324)) (18669 23465 (DOCOBJ-EDIT-TIMESTAMP 18679 - . 19208) (DOCOBJ-MAKE-TIMESTAMP 19210 . 19621) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 19623 . 20693) ( -DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 20695 . 21226) (DOCOBJ-TIMESTAMP-COPYFN 21228 . 21553) ( -DOCOBJ-TIMESTAMP-DISPLAYFN 21555 . 21848) (DOCOBJ-TIMESTAMP-GETFN 21850 . 22090) ( -DOCOBJ-TIMESTAMP-IMAGEBOXFN 22092 . 22448) (DOCOBJ-TIMESTAMP-PREPRINTFN 22450 . 22681) ( -DOCOBJ-TIMESTAMP-PUTFN 22683 . 23052) (DOCOBJ-TIMESTAMP-TO-STRING 23054 . 23463)) (23763 28070 ( -DOCOBJ-MAKE-FILESTAMP 23773 . 24114) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 24116 . 25158) ( -DOCOBJ-FILESTAMP-COPYFN 25160 . 25475) (DOCOBJ-FILESTAMP-DISPLAYFN 25477 . 25765) ( -DOCOBJ-FILESTAMP-GETFN 25767 . 26120) (DOCOBJ-FILESTAMP-IMAGEBOXFN 26122 . 26460) ( -DOCOBJ-FILESTAMP-GET-FULLNAME 26462 . 27080) (DOCOBJ-FILESTAMP-NEW-FULLNAME 27082 . 27555) ( -DOCOBJ-FILESTAMP-PREPRINTFN 27557 . 27766) (DOCOBJ-FILESTAMP-PUTFN 27768 . 28068)) (28397 30894 ( -DOCOBJ-MAKE-HRULE 28407 . 28821) (DOCOBJ-EDIT-HRULE 28823 . 29295) (DOCOBJ-HRULE-INIT 29297 . 29629) ( -DOCOBJ-HRULE-GET-WIDTH 29631 . 30442) (DOCOBJ-HRULE-BUTTONEVENTINFN 30444 . 30892)) (31282 39731 ( -DOCOBJ-MAKE-INCLUDE 31292 . 31693) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 31695 . 32700) ( -DOCOBJ-INCLUDE-CREATE-OBJ 32702 . 33491) (DOCOBJ-INCLUDE-EDIT 33493 . 38092) ( -DOCOBJ-INCLUDE-EDIT-WINDOWP 38094 . 38956) (DOCOBJ-INCLUDE-RESET-OBJ 38958 . 39729)) (39732 49830 ( -DOCOBJ-INCLUDE-AFTERHARDCOPYFN 39742 . 40626) (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 40628 . 45403) ( -DOCOBJ-INCLUDE-CLEANUPFN 45405 . 46172) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 46174 . 46708) ( -DOCOBJ-INCLUDE-COPYFN 46710 . 46928) (DOCOBJ-INCLUDE-DISPLAYFN 46930 . 47662) (DOCOBJ-INCLUDE-GETFN -47664 . 48387) (DOCOBJ-INCLUDE-IMAGEBOXFN 48389 . 49398) (DOCOBJ-INCLUDE-PREPRINTFN 49400 . 49619) ( -DOCOBJ-INCLUDE-PUTFN 49621 . 49828))))) + (FILEMAP (NIL (7686 20755 (DOCOBJ-ACQUIRE-OBJECT 7696 . 8697) (DOCOBJ-INIT 8699 . 9327) ( +DOCOBJ-TEDIT-MENU-ENTRY 9329 . 9751) (DOCOBJ-GET-LOOKS 9753 . 12253) (DOCOBJ-REGISTER-OBJECT 12255 . +12909) (DOCOBJ-STRING-IMAGEBOX 12911 . 13859) (DOCOBJ-WAIT-MOUSE 13861 . 14321) ( +DOCOBJ-INVOKE-IMAGEOBJFN 14323 . 15446) (DOCOBJ-BEFOREHARDCOPYFN 15448 . 20041) ( +DOCOBJ-AFTERHARDCOPYFN 20043 . 20753)) (20785 21052 (DOCOBJ-ACQUIRE-EVALED-OBJECT 20795 . 21050)) ( +21252 21394 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21262 . 21392)) (21733 26529 (DOCOBJ-EDIT-TIMESTAMP 21743 + . 22272) (DOCOBJ-MAKE-TIMESTAMP 22274 . 22685) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22687 . 23757) ( +DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 23759 . 24290) (DOCOBJ-TIMESTAMP-COPYFN 24292 . 24617) ( +DOCOBJ-TIMESTAMP-DISPLAYFN 24619 . 24912) (DOCOBJ-TIMESTAMP-GETFN 24914 . 25154) ( +DOCOBJ-TIMESTAMP-IMAGEBOXFN 25156 . 25512) (DOCOBJ-TIMESTAMP-PREPRINTFN 25514 . 25745) ( +DOCOBJ-TIMESTAMP-PUTFN 25747 . 26116) (DOCOBJ-TIMESTAMP-TO-STRING 26118 . 26527)) (26823 31130 ( +DOCOBJ-MAKE-FILESTAMP 26833 . 27174) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27176 . 28218) ( +DOCOBJ-FILESTAMP-COPYFN 28220 . 28535) (DOCOBJ-FILESTAMP-DISPLAYFN 28537 . 28825) ( +DOCOBJ-FILESTAMP-GETFN 28827 . 29180) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29182 . 29520) ( +DOCOBJ-FILESTAMP-GET-FULLNAME 29522 . 30140) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30142 . 30615) ( +DOCOBJ-FILESTAMP-PREPRINTFN 30617 . 30826) (DOCOBJ-FILESTAMP-PUTFN 30828 . 31128)) (31453 33950 ( +DOCOBJ-MAKE-HRULE 31463 . 31877) (DOCOBJ-EDIT-HRULE 31879 . 32351) (DOCOBJ-HRULE-INIT 32353 . 32685) ( +DOCOBJ-HRULE-GET-WIDTH 32687 . 33498) (DOCOBJ-HRULE-BUTTONEVENTINFN 33500 . 33948)) (34369 43047 ( +DOCOBJ-MAKE-INCLUDE 34379 . 34780) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 34782 . 35787) ( +DOCOBJ-INCLUDE-CREATE-OBJ 35789 . 36557) (DOCOBJ-INCLUDE-EDIT 36559 . 41158) ( +DOCOBJ-INCLUDE-EDIT-WINDOWP 41160 . 42022) (DOCOBJ-INCLUDE-RESET-OBJ 42024 . 43045)) (43048 51864 ( +DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43058 . 46780) (DOCOBJ-INCLUDE-CLEANUPFN 46782 . 48186) ( +DOCOBJ-INCLUDE-BUTTONEVENTINFN 48188 . 48722) (DOCOBJ-INCLUDE-COPYFN 48724 . 48942) ( +DOCOBJ-INCLUDE-DISPLAYFN 48944 . 49696) (DOCOBJ-INCLUDE-GETFN 49698 . 50421) ( +DOCOBJ-INCLUDE-IMAGEBOXFN 50423 . 51432) (DOCOBJ-INCLUDE-PREPRINTFN 51434 . 51653) ( +DOCOBJ-INCLUDE-PUTFN 51655 . 51862))))) STOP diff --git a/lispusers/DOC-OBJECTS.LCOM b/lispusers/DOC-OBJECTS.LCOM index f29690ceae7a6c23a28a96c79e29d84c80c0d445..53d2736c3d498447dfc07146468735901bd98271 100644 GIT binary patch delta 5937 zcmd5=TTola8J4&>_}Iq6U@ij0BCruQl68(Ggyf`fkdDv+=^R-)LSP62BOGI6<6F|C zX(K;$GLvNL#@>f^nl!f4^gh#KFil&JBd49tgfva#X&;iNm%Ox-&a?@cPTHn3&Gg^h zql;~(>0|Y<+WpVJ|L*?RZ};=B82`O&+-(a=Az6{^Avq%1WhJB{OH2%mh(i*x%8Dk% zBXS~Uy-?G1p}#82aW=vih)bd-1(6lG?a`UjcEKsQks$azPCxImBAaz~@%YL4g}Dq` zJONCPrlL|XB8`9U-i7%yCm%dBclykyf@;974h~BJE#cTN^mQZdPGLOn_wZJ9dafXB zZp*_b7v^W@&n`T&%a1LS=IlI(4<#cJRJsv|!(l~SX67uczmZUnwfl}^@V)lX+#&rK zF2Bd^_xS#oZFlq`kKlHCkY5VQntgB_oj!gH`2%558IlrqP34dcpPHz}m-|ghH}c2g z(x|K^6ZRme4_SHM9-Nyc%eoMp)+PAey|D97R+qP%!(v&Jk;4;ZS!mxbyA17T%Uc>a z&?~4F3@K~KAME24If4wk@D*n*{z>_M;QF|H6xw7(q&3eAmW0hmB_(N>6fHhZ=i!$s zq*gMUvvubgha}A&QPq(I<3N=W<2Uf}O6yclq_TV!i5VAK-jfS&GQe-GEF*q!At#18 zI@)U5O#YXDr+;;ueoDvIJh#YZZMu<(!n9~%nz+)9D>t?Ac`>rdVB{#=G4pA%V+kvZ^57a~D4J z^_I}ReFeH3KV4I|1MzMI#*R~^fK!24+7b;FMDI9u&-+bwNb0m)H_RX9*c zQN*Z(WW=MGECoo<3A^j)Mh178!B8$zjbG~#Up163Y+Aq8A+8x}YK-AQs@n0)wH+C1 zqibAvKwK!7w^xIzT|UI}LokLwU-`9SpkvsK2XS;Mwy#A~E8Ev=TU#@r8A%ht`C`b2 zh~I;)VyF*=6!`NZVgRrbqErvrCJbFD1T!G7z*=+;7!LY8QX|2j9M{HS;G`dE)a2=QPo+3(*ImlBc|QsdFY9t2co^MnRjE82~Whqsp-j1Lg^OIa4lpV^$U z(DD2hGCTrfWS&JS3-ifv%JOQD;pqC2^*qH)6;;zwaV(X!u)eTaS#i|r3_82Kz5YzA*O}>t zJ59#4Ij1(RnpE=;oXn@~e6{XlrrHIgw}3|Pw1Hvor0Hrs)u3RR+nshb4Cs2E8~-H>S( zw>5ZazOa#Sp)Q}$NL?Wjb5|IU$RU+{EG#E9{Bd=25+cJ@Bte$2lp76YiJJB@YFO%Y zw5cLNk?Y)KgnR&|BBJSPNre~y5qm^OLAD0z6`wG*HbFY*yOWKjhzp5&oU7RkDG+jm z$wgy12}V@Nt_7^!(~kePwLV+Szaiwg>nyOs&}m+1v1bZ}K+T^898 z)Z=xboV)`%N%JhHvDh}%7|YpIMi{9xX~zWpBXfTC*~G-qa9FwlHHh~Sy!JR8m>cj{|2HVi=N=6(3&bTj^RLo2J}xnvtHax2#x z_8TiX8^8e=009sS4g-tv)UC#}wV~}+y z@QAm*vhiexr46PjmeGA1$<~2mK{s~r?7YZdSsvb4WV+1)A|GojQQ!>PiQj3f0P-K( z#-Z&;`Zi~f6^7Rv-o%sb>2lB<7Evv})&5m>ig!|t3_YB;J^~cpgV9VgE@<=A8DgWwt0Hz5%Ofy$9ZMDzbrkEExpDj-MQAew8=cBuxtGP=dxM?@B z7D9Qh)b59ilW(@Su)Y3ccYl$3WvpHoIo|d7UgA1;8BkYpR2-4);dm0t7Bv}Xd$cI# z+#Vf4e#>^Qi%Rh;0A<7oJ(Mni`f*XhirPI(faS`bL1_QJr?YSopghIv0Ot3$gVzE& z!;J@9@R_~LtuG$b*Zlt8_dvjNJ%54rDSH>Rz^0#y__W_~9H6O-AU1Nx2?B(R%0al? zF^#|MXn-kiIi9Sf0fmq3+XLg59kuw_1Xqk3pshP!p?1GGVrHuR4gUg=vqB4Vhf4xT zT6s};y$q<2dzN6}?d>)0K6e$bbt9*enQlF~BG#D2@Rj2Z3QjJ^{gFM38E?5AHGW5JCFnV&ed7$jT7% z_5uqdg=8rL9_YM-Ab9Zy`z=}Ua=>wUL+}8pB2tJHYoS1d+a261AjJY=loALImLHCz zUci9*w{hh0ps)%62cRDPcNGzeAe2Tqz!g1d@6)q3_^S_|AxiL4cd8-hRk!so+L97V64gtbj`#wMo$f1{mrw8pO=to5$V?Q)|_< zm&?q&hSiFt{j~dIol5606_*>%jI1wrfq9Ka0mb{mAD;Q7JlzAa_iHtts?R zAV9$d3%OAk=#WVGQYxe>%Hf8{0s|GN_R=f6E(Z+6E)(p!uTy>SNYsQtBI@%Xn-g%c z0G`)PFoU9MaNiF0lk71u1eIy!v7s80I-U-9T1xKbx(nNNTu;;WdFwE4k)@4G;w3(x zaW2Yg!+l1Bp<kJFFNT4!3TwBD}Wb>+kaLXNvXV*-5iW z_Y)@~+XIKgS3B>+&x~9FY4=6KEcHDRX@%i8Bkqm&d26z68%uZO#Q;JI^DPayD=KWv zemsgm+W9Czh?Va}dq{nM`#@7QwRYixhN~tzTS#;!m>bxov6vc%7d|l(>F!20cn^u! z;Y(AMxG~;=?~RlC^5K+kJA4YL(FC&XLHqY34u3a3+?2;7w9=J4PI0(8(O;{7EqOWN z@N^>42-B?+z`(8yBB;sr}+8DGM`A4R~Z!h2HzEX1qEYgkCOb!Hp?5?d`;eQenaexaVf74|*S^6leip z;JGpK;&x?h2HMt?6`z~wgx>J@VQ8 zgYtni!c5QgvZD@KqCY&s<+}>+o+L*fo1B97#mOYJ+wLd3 zI54{tKXHEudT-FNcZzrtlueWA z`_diw4chxS-40_kO$;5LCjFz+1ffulX`+k|X=|RzQ}ZhFz&F?iUZ1JChqJ|F;(-JB zMo+^Qc#(v7W@FLbSV_lJ-qAyW3XWWiuO6yxV=Vm})m~5@hktgctt!t0s_^Q28k!{# S`HB1cYPq7`Wtc!7LjMEgG_1z} delta 8458 zcmeHNTX0*)c?LjIq9j8mMT!^jq7_IS1|y_ut)r|I4@k|3jbNbbk4#PMZdvD|FiVBPHfu z#A)f|D6_LQFfia{rP(WBW&^wa=upT%6o`5Ie*2yLv7u1Vy2I)J;U!quA6CL_Zee!i z>G{j-%IcvZ=1XRa%+04Jdib}U`^pzD&3}Gz_3CB8Gp08%O#%)Ng&^bq4Vi}e+>kLu z+^@zbCiQ{_ar1{=^-ec$bCuEliR;^FV>O+P7NMTi4K|dBy7{>p19N{-Glh0vZ5r*_ z+77hO)@ohute$rJD!Y$rMt?e&8!yV0AA|a5{AiuG98K5N+&-q3g6!ttdTNIQ|K4$x z)O**~RkP>VO@nggp@v=5x%q)P7i#z`(I2o@s*-NUTcr%P$ZWfXx)!#`Q+%zir7YKM zJV$SE_>`ERJrPeCxqO@{!NJORG{BxnKCTsVc{UiUjE0$^%@`0RtVxN5Szg!T8f-LZ zjWcC1%8D9%$Ix?G^b|Ss*^x1(gl%LY#abMQRTnEE`(poKWhQ3d6)c-<bolm2v1SDl|F3mM+f*m2HOEi{|NMUI+2mdq70#iO`@&*^eFCxqQCzcRM>Wa~&_nIB+OC@4w*_?3MsEXH?pI>Tp zIa4~Zt?yg9TLz^NIv9L-e++%(*RZWpbv5B*p-2}Ep$5971OB}KjTI3bL-$H{nMYN5?nXV5b1?Irc5i$-rR z`T_LKtwdkhq$ZHavx)}Zx(s(Vbd({%59=Hbmnv@D*yv1|A2nlArpYt6Yrb^D@ip0f zn#3zf7Va*1Jk80bg&(P6R5U`c>(Y3CHq$^x(CDlcQ(|Ayn6^#YD${-@{X3mieW}YP zkyMpQk-q6!zTUQh2XWwy`_C(fOeKWPBd zNHC;lDVlgn&5mktBqa=xe2}ICumV%nOz}t96PYQ571+%m;Gb*gDzgYFly=R)+6g?1 zEJXOX-9cn%0&JPI0?CMQ)(|tjZAveU>RE6#XvbC?q5{&ZaO_bwfNgb2ECTjA7efrN zZyg%(vk?v6tfkaKBA&~i2FeWrQRGv)6#+v*YtCXSST*%P!Br;YIPfz}c1XgWM|^shGMF2=ZSxDxN`jtmVE0=%)9EA{0VM zi&2!lFf- zttOGa*t}HnTWhv>sr0_rnixFqFPr-6LAyX&psmS>yWF}cvJ zRfq1T_nVaOH4kI5VgCskLSceur*_H7wdMX36kvV7`IXKu zY(MSq?2sFTyKF+sW?JOvH@i;b-in{UJLNIC`j@G0Q)VZ+BhEUvFXU(Z#okWN4}4w9 z=+y%i8IAFm*m0b{&P*BIVNyoVS2c9;VDnB(2saKsjXeU2?Yy67%qyPpe$&3lGJu0U zuQqOx4S&CfGM``f97Maf_Y2j9FZLe5(D!>!^;lM8DuuFWsT91a7C#M#e*Y2NKlUI^ zW>kdMslp^ObCH7m_|UVP_oeqzl8`?HB;DD=&x2{~JCsEXs#358bh~>Pw!OCF$Q+sC zl5Yg<>%QJrE7KF_pdw)9d;jdC+wJaqOp1NHk2HO*?-R6>M}LiWxX>$}(dWi9-3LgHGfj^U{ ze`eStPq}vdyD_M+^6Z=Y$^-<7wcQb{Ig*hO%-V|o=PsQ0SnxU|@kwydx!;X2hIzHp z;uWT^%$>hlnn!(rFHK0RSUVkVBWYb4?3aA}$MJT_$J>L4ovZwx20wFXSU|04M8HLX z6-7K&`XiDIJ{~a;t0MZT0+J9&|7OUFMYf5gbNp?kW{=UugY7i%O8n5Hy}Ne zBVu-@B*Y=UPp8E9f}j(hMP1c@vHTGtWRIudnX4s%A)MMEFT6P$`al8d@1Y!1W^G~q z;;C*ZCE~yKfhUKz%@hd&Q@m2tsfd6wKJ={(8B)9r^IMUWUvnOKSfqP4uljUP2XAcj zl`8=VPLNC4?ml&WRRLL%;2HGPm&uZ&w1a&T{8@28*vc&OYC)A{DBy|30*B}3L)oQqN+^JTT^JSr)|tr?1H%p8#UhZu=aMxBO7la%}nK5mGMR!8XCRB45WmJzOsGD6i}->K9R>|@mgRTdP)+_J0|$e`3E zQ(D{5)&hf7Ul6MaNnr+3RU4}e3bbI!JyH!RBM&Y<3_{ptD~+rqVJsk1N-`=~Vm0Ws zc86wcMLpn@btG803n zL{>pCs*_cKhS1zX7lB8_VFkMX!Rd6=C2sai2sD916Nax(sKVpd<*4|6Nf4-_6>h&i zQB`lHUf~e9ASOg(qp6sMeWAT@A!*CY_BCb=!#0$%(i=G@P7x_i;u|(@8#Z$bTL~a6 zz~hj~8+ky8f&7FJgWTLcT2`V~BDBe*L_tf|8I-|l4nj!xz&eMmawUPzT#u;2G89UA zDs~kMwNxge7&jBEXpq0`WL5VJFk9vmMp4vut)S%*_CeHJwqCX3J2pyza8=(?fI1aM z4{s>GDYoicthyo+-N{7K1ey1YA!4kB*-NFl)r-#z zu|*MWEv`I`A3Op8QT%2@^j;Pk6w9#?kNyMK9iWA7hAIx71C78HnyQqJLe&~{kG)_o$@ z@pvXYbFKyocfx*tcDTb83{VjBF!GCPeLol@@g9;O0ew`TqHV&Ie;?{>qk=^c)pJC8 zu#>oq_<&5@cj8F-sal7l2BmP}&|q8E2vX)PoO)wp%~;Lt#wLq|*mg8H&zOLHvwPh9 z5^ng)hTi&^>+$P>LSgpJC@l z+FWiQ?>^Mc|6nArJ5;CnK_Y^-2FX+znP&m7Y}yv`s@jOC9<<<-%fjZ|8y_D zev_r$j2yLl`#SlDIok7$Y&&nAiSO#`gB0@2=jJcuXY1q-w7Vx1j=U2;)HZ{1X(G}~ zeycX)k&&MyfQ{f{kxM#D(n6GJL=877=Iz%!DCZoEwt>pDH7by47GnV zMfCz2wZuuv`ornNXg`>4=D#_*%Vgt&X|G8M!M3^kz_ux~YJ~wl`|=F&bA5*F;m!kaplan>local>medley3.5>working-medley>lispusers>EDITKEYS.;3 7073 +(FILECREATED " 4-Dec-2023 21:06:15" {WMEDLEY}EDITKEYS.;6 7146 - :CHANGES-TO (FNS BUILDFNKEYS) - (VARS EDITKEYSCOMS) + :EDIT-BY rmk - :PREVIOUS-DATE " 9-Feb-87 21:28:31" -{DSK}kaplan>Local>medley3.5>working-medley>lispusers>EDITKEYS.;1) + :CHANGES-TO (VARS EDITKEYSCOMS) + :PREVIOUS-DATE "25-Oct-2022 10:58:27" {WMEDLEY}EDITKEYS.;5) -(* ; " -Copyright (c) 1985, 1987 by Xerox Corporation. -") (PRETTYCOMPRINT EDITKEYSCOMS) (RPAQQ EDITKEYSCOMS ((VARS KEY.TEMPLATE) (FNS BUILDFNKEYS KEY.BITMAP) - (P (* could have (STRIKEOUT)) + (P (* ; "could have (STRIKEOUT)") + (* ; "RMK: Removed (HELP HELP)") (BUILDFNKEYS '((BOLD BOLD) (ITALICS ITALICS) + (CASE CASE) + (STRIKEOUT (STRIKE- OUT)) (UNDERLINE (UNDER- LINE)) (SUPERSCRIPT (SUPER/ SUB)) (LARGER (LARGER SMALLER)) (DEFAULTS DEFAULTS) - (CASE CASE) (CENTER JUSTIFY) - (AGAIN REDO) - (HELP HELP)) + (AGAIN REDO)) '(Tedit Keys) 1)))) @@ -124,21 +120,22 @@ Copyright (c) 1985, 1987 by Xerox Corporation. (RETURN BITMAP]) ) - (* could have (STRIKEOUT)) + (* ; "could have (STRIKEOUT)") + + (* ; "RMK: Removed (HELP HELP)") (BUILDFNKEYS '((BOLD BOLD) (ITALICS ITALICS) + (CASE CASE) + (STRIKEOUT (STRIKE- OUT)) (UNDERLINE (UNDER- LINE)) (SUPERSCRIPT (SUPER/ SUB)) (LARGER (LARGER SMALLER)) (DEFAULTS DEFAULTS) - (CASE CASE) (CENTER JUSTIFY) - (AGAIN REDO) - (HELP HELP)) + (AGAIN REDO)) '(Tedit Keys) 1) -(PUTPROPS EDITKEYS COPYRIGHT ("Xerox Corporation" 1985 1987)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (2103 6525 (BUILDFNKEYS 2113 . 5141) (KEY.BITMAP 5143 . 6523))))) + (FILEMAP (NIL (2120 6542 (BUILDFNKEYS 2130 . 5158) (KEY.BITMAP 5160 . 6540))))) STOP diff --git a/lispusers/EDITKEYS.LCOM b/lispusers/EDITKEYS.LCOM index 21452fbb2787ce040f2b00b4558485f318bade95..98975a589f54eeb7fa39e0b54ae57939d3342233 100644 GIT binary patch delta 555 zcmZ{gO-jR16osjXkbsU9tynxh6%!$)Nt;xjg2d*vjg6_~2kEf3p)K}Dv^o)SBu4l@4V9u zni%v!aC36R42#un_nw~T?=%rSL3Ui2qiUAm^dk6GHrn-mE4bXG=nsbNPQQgt#47rh zg;8-johE43hmqGrYMzL^P&6%8aG35f18Zb*=&_JQLtf5lpv*8m>7a&--Wh12tlK5# zN?sKLAHF5lp{P=|F^u~wkTX=>p-TQw--P;Fp1Pme-$nG5t8NqR`gH)o^&GRps=g-@ zUWBlX=|+hC4m+AQw81^b8C5a%Se~{`i~k1v5Rm%- delta 687 zcmb_a%Syvg6r@n34X8WuiHCrYEE4jtq(%wU^rnpsZEO-B;3nFOL}L?@7F$%haw|eU zrC;GUxN+%ccuP^Lt^_x;xXhV3Gv~gozivDqk0gOR=!cvnND>HTbz4-05)BM}5#7W= zh&vENFnq`YBFQ?b?q+zpI7Og&%4+xD(=`%$Ky=D7g;0m)!J43xhPC@=?`v z8|c*GcV!mnZ-&B%*r|d-9L^K`<%tJzl5VN6@0nKBXikP9AbS{|Wx=cf&+{~N{2tl! zhwwyKlxUV>4AVk-8&zCX{XrseN7KCjl@Am_kwMk#m1Ye&oZAA%XgWa61Yvkaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;2 10662 +(FILECREATED " 3-Nov-2023 22:12:06" {WMEDLEY}MULTIPLE-HARDCOPY.;7 10341 - :CHANGES-TO (FNS TOC) + :EDIT-BY rmk - :PREVIOUS-DATE "22-Aug-86 12:23:34" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;1) + :CHANGES-TO (VARS MULTIPLE-HARDCOPYCOMS) + + :PREVIOUS-DATE " 3-Nov-2023 22:11:07" {WMEDLEY}MULTIPLE-HARDCOPY.;6) (PRETTYCOMPRINT MULTIPLE-HARDCOPYCOMS) -(RPAQQ MULTIPLE-HARDCOPYCOMS [(FNS MH.GET.INPUT.FILE MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY +(RPAQQ MULTIPLE-HARDCOPYCOMS [(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) + (FNS MH.GET.INPUT.FILE MH.MAKE.GLOSSARY MULTIPLE.HARDCOPY MH.SET.STARTINGPAGE# MH.GET.PAGE# TOC) - (P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY + (P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Multiple% Hardcopy 'MULTIPLE.HARDCOPY - "HARDCOPY A LIST OF FILES." - ]) + "Hardcopy a list of files"]) +(DECLARE%: EVAL@COMPILE DONTCOPY + +(FILESLOAD TEDIT-EXPORTS.ALL) +) (DEFINEQ (MH.GET.INPUT.FILE @@ -50,85 +54,65 @@ (T (PRINTOUT T "MULTIPLE.HARDCOPY MUST BE RUN FIRST" T]) (MULTIPLE.HARDCOPY - [LAMBDA (STREAM FILELST GLOSSARY.FILE TOFILE? DONTSEND UNFORMATTED? BREAKPAGETITLE SERVER - PRINTOPTIONS) (* edited%: "22-Aug-86 12:23") + [LAMBDA (STREAM FILES GLOSSARY.FILE TOFILE? DONTSEND UNFORMATTED? BREAKPAGETITLE SERVER + PRINTOPTIONS) (* ; "Edited 21-Jun-2023 12:19 by rmk") + (* edited%: "22-Aug-86 12:23") - (* HARDCOPIES all the files in FILELST making sure that the files are numbered - consecutively. If STREAM is supplied then it should be a TEdit stream. - The intent is that one could set up one's desired page looks in a TEdit window - and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page - looks. If a STREAM is not given then a fresh TEdit window is started. - FILELST should be a list of files to hardcopy in the order that they should be - numbered. GLOSSARY.FILE, if given, should be the name of a file. - If given then after MULTIPLE.HARDCOPY is done hardcopying it will use the - MH.MAKE.GLOSSARY to make a table of contents for the files and save the table of - contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created - for each file in FILELST that is the same name as the file but with extension IP. - If DONTSEND is NON-NIL then the files will not be sent to the printer - (this only makes sense if you're creating IP files)%. - If UNFORMATTED? is NON-NIL then the files will be hardcopied without formatting - information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as per - TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable - MULTIPLE.HARDCOPY.LIST which is a useful list of information about this hardcopy - process. The list is of the form%: ( %. - ) where each pair is of the form - ( )) + (* ;; "HARDCOPIES all the files in FILES making sure that the files are numbered consecutively. If STREAM is supplied then it should be a TEdit stream. The intent is that one could set up one's desired page looks in a TEdit window and then pass that TEdit stream to MULTIPLE.HARDCOPY which will use those page looks. If a STREAM is not given then a fresh TEdit window is started. FILES should be a list of files to hardcopy in the order that they should be numbered. GLOSSARY.FILE, if given, should be the name of a file. If given then after MULTIPLE.HARDCOPY is done hardcopying it will use the MH.MAKE.GLOSSARY to make a table of contents for the files and save the table of contents in GLOSSARY.FILE. If TOFILE? is NON-NIL then an IP file will be created for each file in FILES that is the same name as the file but with extension IP. If DONTSEND is NON-NIL then the files will not be sent to the printer (this only makes sense if you're creating IP files). If UNFORMATTED? is NON-NIL then the files will be hardcopied without formatting information. BREAKPAGETITLE, SERVER and PRINTOPTIONS are the same as per TEDIT.HARDCOPY. After MULTIPLE.HARDCOPY is done, it returns a variable MULTIPLE.HARDCOPY.LIST which is a useful list of information about this hardcopy process. The list is of the form: ( . ) where each pair is of the form ( )") - (PROG* (FRAME LOCALINFO INITIAL.DEFAULTPG PG) - (OR FILELST (SETQ FILELST (TTYIN "FILELST TO HARDCOPY>>")) - (RETURN (PRINTOUT T "No filelst specified."))) - [OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE (CAR FILELST))) - 'WINDOW] - (COND - ((ATOM FILELST) - (SETQ FILELST (LIST FILELST))) - (FILELST)) - (SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM)) - TEDIT.PAGE.FRAMES)) - [SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND - ((LISTP FRAME) - (CAR FRAME)) - (T FRAME] - [SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO 'STARTINGPAGE#) - (SUB1 (LISTGET LOCALINFO 'STARTINGPAGE#] - (SETQ PG (OR INITIAL.DEFAULTPG 0)) - (SETQ MULTIPLE.HARDCOPY.LIST NIL) - (ADVISE 'TEDIT.PROMPTPRINT 'BEFORE '(SETQ PG MSG)) - [for FILE in FILELST do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE)) - (OR FILE (RETURN)) - (PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME FILE)) - (TEDIT.GET (TEXTOBJ STREAM) - FILE UNFORMATTED?) - (replace TXTPAGEFRAMES of (TEXTOBJ STREAM) with FRAME) - (MH.SET.STARTINGPAGE# (ADD1 PG) - FRAME) - (TEDIT.HARDCOPY STREAM (COND - (TOFILE? (PACKFILENAME - 'NAME TOFILE? - 'EXTENSION - 'IP)) - (T NIL)) - DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS) - (SETQ PG (MKATOM (MH.GET.PAGE# PG))) - (SETQ MULTIPLE.HARDCOPY.LIST (NCONC1 MULTIPLE.HARDCOPY.LIST - (CONS FILE PG] - (UNADVISE TEDIT.PROMPTPRINT) - (MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG)) - FRAME) - (RETURN (COND - (MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST - (CONS (OR (AND INITIAL.DEFAULTPG (ADD1 + (PROG (FRAME LOCALINFO INITIAL.DEFAULTPG PG) + (OR FILES (SETQ FILES (TTYIN "FILELST TO HARDCOPY>>")) + (RETURN (PRINTOUT T "No filelst specified."))) + [OR STREAM (SETQ STREAM (TEXTSTREAM (PROCESSPROP (TEDIT (MH.GET.INPUT.FILE (CAR FILES))) + 'WINDOW] + (COND + ((ATOM FILES) + (SETQ FILES (LIST FILES))) + (FILES)) + (SETQ FRAME (OR (fetch TXTPAGEFRAMES of (TEXTOBJ STREAM)) + TEDIT.PAGE.FRAMES)) + [SETQ LOCALINFO (fetch REGIONLOCALINFO of (COND + ((LISTP FRAME) + (CAR FRAME)) + (T FRAME] + [SETQ INITIAL.DEFAULTPG (AND (LISTGET LOCALINFO 'STARTINGPAGE#) + (SUB1 (LISTGET LOCALINFO 'STARTINGPAGE#] + (SETQ PG (OR INITIAL.DEFAULTPG 0)) + (SETQ MULTIPLE.HARDCOPY.LIST NIL) + (ADVISE 'TEDIT.PROMPTPRINT 'BEFORE '(SETQ PG MSG)) + [for FILE in FILES do (PROGN (SETQ FILE (MH.GET.INPUT.FILE FILE)) + (OR FILE (RETURN)) + (PROMPTPRINT "MULTIPLE.HARDCOPY: " (FULLNAME FILE)) + (TEDIT.GET (TEXTOBJ STREAM) + FILE UNFORMATTED?) + (replace TXTPAGEFRAMES of (TEXTOBJ STREAM) with FRAME) + (MH.SET.STARTINGPAGE# (ADD1 PG) + FRAME) + (TEDIT.HARDCOPY STREAM (COND + (TOFILE? (PACKFILENAME 'NAME TOFILE? + 'EXTENSION + 'IP)) + (T NIL)) + DONTSEND BREAKPAGETITLE SERVER PRINTOPTIONS) + (SETQ PG (MKATOM (MH.GET.PAGE# PG))) + (SETQ MULTIPLE.HARDCOPY.LIST (NCONC1 MULTIPLE.HARDCOPY.LIST + (CONS FILE PG] + (UNADVISE TEDIT.PROMPTPRINT) + (MH.SET.STARTINGPAGE# (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG)) + FRAME) + (RETURN (COND + (MULTIPLE.HARDCOPY.LIST (SETQ MULTIPLE.HARDCOPY.LIST + (CONS (OR (AND INITIAL.DEFAULTPG (ADD1 INITIAL.DEFAULTPG - )) - 1) - MULTIPLE.HARDCOPY.LIST)) - (COND - (GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE) - (PRINTOUT T (CONCAT "Glossary file in: " (FULLNAME - GLOSSARY.FILE) - ) - T))) - MULTIPLE.HARDCOPY.LIST]) + )) + 1) + MULTIPLE.HARDCOPY.LIST)) + (COND + (GLOSSARY.FILE (MH.MAKE.GLOSSARY GLOSSARY.FILE) + (PRINTOUT T (CONCAT "Glossary file in: " (FULLNAME + GLOSSARY.FILE)) + T))) + MULTIPLE.HARDCOPY.LIST]) (MH.SET.STARTINGPAGE# [LAMBDA (PG# PAGE.FRAMES) (* edited%: "22-Aug-86 12:15") @@ -181,10 +165,10 @@ TOCOUTSTREAM]) ) -(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(MULTIPLE% HARDCOPY 'MULTIPLE.HARDCOPY - "HARDCOPY A LIST OF FILES.")) +(TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Multiple% Hardcopy 'MULTIPLE.HARDCOPY + "Hardcopy a list of files")) (DECLARE%: DONTCOPY - (FILEMAP (NIL (925 10481 (MH.GET.INPUT.FILE 935 . 1531) (MH.MAKE.GLOSSARY 1533 . 2062) ( -MULTIPLE.HARDCOPY 2064 . 7788) (MH.SET.STARTINGPAGE# 7790 . 8485) (MH.GET.PAGE# 8487 . 9049) (TOC 9051 - . 10479))))) + (FILEMAP (NIL (975 10161 (MH.GET.INPUT.FILE 985 . 1581) (MH.MAKE.GLOSSARY 1583 . 2112) ( +MULTIPLE.HARDCOPY 2114 . 7468) (MH.SET.STARTINGPAGE# 7470 . 8165) (MH.GET.PAGE# 8167 . 8729) (TOC 8731 + . 10159))))) STOP diff --git a/lispusers/MULTIPLE-HARDCOPY.LCOM b/lispusers/MULTIPLE-HARDCOPY.LCOM index a7b020139cffbf8eada3dc41f9ec6dd76bca3b04..c3b3359e998a7d899dec0bff0a58107b07032d02 100644 GIT binary patch literal 3673 zcmc&%U2h{v6}6M>!gyy_3A+Ljq}7#23vHpa+}-|23=A&YWxJF9n(lHY+1YtW;>;u@ z8%Ie7X@%e~phfVuKLClBVP+zPc<>|Q9}N5%ICZ=Ik;$wyZ{(pb*Zf(%M1>;Rb0<2DYQ0ghinM=mI6d;~q;;pAvi=}sR=3R{kJWj=;hU~a%t+h)RU!G8*(e8_&CzCZ5 zlCdq~gl_rW4*jG=jVPAeZa7HRIzaX|uvVj7FH+$hjj5Fie&6g#Wx7E$P^OL{wZot-6s;3750^)!Lg0D@gMe32?M9MB5URe6u?}1Mk`xaDfDtE3JDL$@>OtyhMAa0ph#ZP~6p;-SUF8bT1m^|5;#rHl zuq`~Mex#Ei*3h_!i4L3!Bjtucf{8jMGTzp)pc=Ih-K_{JpBpWcyZvm4zOOZX%dn&{amuxP<=<45`~j}gr@c_;9#i^pcz%%Z?e50O8$56 zFXZm5G#ACoA8~j%Ui%AwnTyqO^CgKqFYtrI%MndC=f-0A>O0PN|0Ir9_ZP-Zo_$~E zz`xY>(!-B-hQq}_jEDJjYH4@K2mIvK2W~nz`S<6;>&0I^Iy$(^6a3)&KhTGWm6i9r z#q0RvnSGnXuTNh0*@W#^-`o7-=E>{p#gpyTgS)NkrR`-lAf;K0$Gr0f zk6-+m5B6s}GZ%cx_s=`j|3riwW7{*k?`o4f-QGvNmvA6KWU;k_545x0<7lCHA4aRSfza>=YV~A8wbw}sSJ#wH6X$&W{BL@nh zE00bSW~Woe_kA;gSS3ot$_;wy$M%MWk9Snq+5}B1*+ED}vg`WTY^7dC28Vv6IFHG$ zfe)w!e70S+CI-z3p$*xYh}0a1*C#S%qnOQ(u=t3Z8e^>^ZQo|IRo4U&oo!dw%W93X z;krFFxTf`EM`Z-40*yFq%Ot_Sh$>n>k@EzV$&j2kd?OPa3)|GL8$etfr%W!mZ&wMY z${+!a$+0#l1z-belp$qRz-I~a!ZJpHxitr!Wmmw<`4CvR=#80j4dLs_SoZWq>$5;q z%kJHn$;b#lGpYm>Ei#ZD545`Z zNv}i*Pcazrx2Km^ba{SwaQx)>aA+0_D8gt3kXjxD6vbnbcK7e6rQ&v$aaGiU$nuDK ziPlII za#25=b<(8=r2;?!w43-M0p{R!>^GJX<+){~=IjlpO{>11y*H^3Woq{)nhO_xoY!Ta z*}am_^?Bedf74H=nCWTVgRS<)loM|-+roQF`YQE;_N1VL+(jU*3t$E;c#HH76e_c> zQ0%QXj|&x+!oh?J5m3j(v_fH=kz}rE`Tcva9_rsj40fOYkilh}ci54?r~ZtO`0aBy z|Hysr4)ZJdrA;rb^1PWJE3FRung57N>5iv_O9kW#^pT7m? zp@p=LqRM43TdPB-rXSWO7iWvL3fEZ8{jMv$4#Bc80{k<@K~A;NE6FZMnl^6`3%w@= zTPI~E9*8lEk0!Kb*TGKFO47c}a3EtQO22LcJlR#H62)$>uY3{r+yFXOE8#OVwa_Va zxT!WzT9|3i&%JNKh$Hdf!L$#!u}X%~k!?@J68*m17G6`I27+_jp?^0J{~}3Jkk;f* zgmy78h3CN}ql=d2Ev+!5^`@XtESoh~ZYwAz<>b*2JQm`4sQSf diff --git a/lispusers/TEDIT-PF-SEE b/lispusers/TEDIT-PF-SEE index dc2e767f..93e89f3d 100644 --- a/lispusers/TEDIT-PF-SEE +++ b/lispusers/TEDIT-PF-SEE @@ -1,10 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "25-Sep-2022 11:00:07"  -{DSK}kaplan>local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;113 7734 +(FILECREATED "25-Dec-2023 12:29:39" {WMEDLEY}TEDIT-PF-SEE.;118 8191 - :PREVIOUS-DATE " 5-May-2022 23:48:59" -{DSK}kaplan>local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;112) + :EDIT-BY rmk + + :CHANGES-TO (FNS PF-TEDIT) + + :PREVIOUS-DATE " 5-Dec-2023 23:52:07" {WMEDLEY}TEDIT-PF-SEE.;117) (PRETTYCOMPRINT TEDIT-PF-SEECOMS) @@ -21,7 +23,12 @@ (DEFINEQ (PF-TEDIT - [LAMBDA (FN IFILES REPRINT) (* ; "Edited 5-May-2022 23:11 by rmk") + [LAMBDA (FN IFILES REPRINT) (* ; "Edited 25-Dec-2023 12:24 by rmk") + (* ; "Edited 5-Dec-2023 23:50 by rmk") + (* ; "Edited 12-Oct-2023 00:19 by rmk") + (* ; "Edited 14-Sep-2023 22:33 by rmk") + (* ; "Edited 14-Jul-2023 00:14 by rmk") + (* ; "Edited 5-May-2022 23:11 by rmk") (* ; "Edited 12-Jan-2022 13:15 by rmk") (* ; "Edited 30-Dec-2021 23:17 by rmk") @@ -59,7 +66,7 @@ [SETQ WINDOW (FIND W IN (OPENWINDOWS) SUCHTHAT (AND (EQUAL TFPROP (WINDOWPROP W 'TF)) (WINDOWPROP W 'TEXTOBJ] - [IF (AND WINDOW (NOT REPRINT)) + (IF (AND WINDOW (NOT REPRINT)) THEN (* ;;  "If already an open PF window on this function in this file, just raise it to the top") @@ -101,21 +108,18 @@ ELSE (PFI.MAYBE.PP.DEFINITION ISTREAM TSTREAM (POP LOC) (POP LOC))) (TERPRI TSTREAM) - [TEDIT TSTREAM (OR WINDOW 'PF-TEDIT) + [TEDIT TSTREAM (OR WINDOW 'TF) NIL `(READONLY T LEAVETTY T TITLE ,(CONCAT FN " from " (FULLNAME ISTREAM] + (TEXTPROP TSTREAM 'ITEM-NAME FN) + (TEXTPROP TSTREAM 'BOUNDTABLE (TEDIT.ATOMBOUND.READTABLE + *READTABLE*)) (* ;; "The windowprop allows for reprinting as a window action, or reprinting from a command that can find and reuse the previous (presumably unprettied) window.") (WINDOWPROP (WFROMDS TSTREAM) - 'TF TFPROP) - - (* ;; "Remove this when TEDIT honors the TITLE property") - - (WINDOWPROP (WFROMDS TSTREAM) - 'TITLE - (CONCAT FN " from " (FULLNAME ISTREAM] + 'TF TFPROP))) ELSEIF (EQ LOC 'FILE.NOT.FOUND) THEN (printout T "file " IFILE " not found." T) ELSE (printout T FN " not found on " LOC "." T))) @@ -126,7 +130,7 @@ (DEFCOMMAND ts (FILE WINDOW FORMAT) (TEDIT-SEE (OR (FINDFILE-WITH-EXTENSIONS FILE NIL '(NIL TEDIT TED TXT TEXT TEX)) (ERROR "FILE NOT FOUND" FILE)) - (OR WINDOW 'SEE-TEDIT) + (OR WINDOW 'SEE) FORMAT)) (DEFCOMMAND tf (FN . IFILES) (PF-TEDIT FN IFILES)) @@ -144,5 +148,5 @@ (ADDTOVAR LAMA ) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (810 7208 (PF-TEDIT 820 . 7206))))) + (FILEMAP (NIL (782 7671 (PF-TEDIT 792 . 7669))))) STOP diff --git a/lispusers/TEDIT-PF-SEE.LCOM b/lispusers/TEDIT-PF-SEE.LCOM index b2ff0e6f029f3d25935458aca101a0450e9c6d0f..ddda9c618664ebaefda590c57e33967aa307d421 100644 GIT binary patch delta 645 zcmZut&2G~`5Ux|&(C{M;J@rsV3l(uCTk(1wJF9YVy6e`G|75Rgia1cxsI5v{C>0lk zdgQ_ZFGH`2r5)GA|DTxIV4xI)dGuGfDQ}wKh^)ZO;$*ddgk72LZy?lzgiCFO|<7 zaEzV-v?A8}+i-ex2rat4=|&qo(?kqyFUls;RG>-9xBNKIG$vW3>1!O=q!y+f`=3iR z>{hwb`01`nVNAIFfUklF27#0(sUL}|u%PfG78h0C1>q%WoK(3DZpW}q6_l&FJ0oZI zt)eWK-)_+Jy&3t6#amUl$j8;vLRI~N>U@kt4b{N@09`zsSMJTUiDSXDa4YaL0mSJ* zl8do~nwoSSD7-WdSq7wQfZ$KW_`{O&ID6m=-4$`zkMoG>6JtOKp7f4B&b?NUZAv>5 y??K&L`v+oL;0qpVksI>zc2jK#uYBBGD?c=|S?RaDY;II>^yub~`SRD@ufGAayPmcH delta 700 zcmcaBw@`jUR9J9ofv%B(k&%L-p_PGwm7%ecf`(FZer`c#PHKumex8Do0#~(5uy?IZ zX>n>%v0ZjzK~7?xT~2;-Vvb#IYD!LOrLmr=U3q>{c4l6>E=0s`@*YO19AixdB_l&! zWE+ftmH=(wN-9c)+mTvPP*kjHrI43jk^wYAArok)Td0qZ0J zEUZi|l@!PeAV#CfHy9rqgnRnA_=hXFDHxh41i1zTdHRKbIHn3AZUI650U)-Sf}??f ziHW8H<0n?0&3~B67#XD|7qeK^b20!yI*16D;|5XtLy?3;^1(6!U?H$Hm;iG#k`?x= zurUfSXqZ@7D8%@N`FIA0D419nD+GjwK%4}&-Nf8N!P(!>*%2sdZma-`7(Yi}R|OMO z6NPXUw;+FCmtX}G6LWNJ#-+6w-?Fa}|^(yR(Nf13f%>KD#@J-u#mNA{!f2@h-l_0Llcs+yDRo diff --git a/lispusers/TEDIT-PROCESS-KILLER.LCOM b/lispusers/TEDIT-PROCESS-KILLER.LCOM index 7843858d7c5730cd1897d72fac8b675061b017b3..6d0a82c6dbcfd526c3d734bd350d4c2da794d77b 100644 GIT binary patch delta 795 zcmaKqOK1~O6oyG3roFAuMH`bQ(>WQGCg{|;lRh$oMbl)`B+biAVl9eLn^cSTLE426 zVmEGdp|*G9Ru?YBUBI0S!IgC*R1kN9ZloJ`y7QlaT1C8z?>z23=lmS*_xSz9gXvR@ zg_7y46)#z_vXvl3*VMwohN^3Ngfz|M+~k@CS`S5?G{~`5~PJCSF8ksE(Q*%^bzCz55r(*eO%T~(;3MKRQ-x9-Q z7E9KdbfIFa3G4|QFx1?9U5y&V$4m`N8dHevAEmgM_~`P0-&|k8FKs*E^Y$Ac?`VRb zJ8Tzg8l7EjFjMY(Fyd|Zb#R7V0H3lN*w?cT-tK7}W1&%l&bOAwDH5e*p_C&YrF<-B zVHd=8Qp#3!X#<-PYHtu_h2Br-J$f+H4ztsLrAlG;IRwAGtV%BUC&Vj+g@kh zVvBFQRruVu2tM>dr`YqI15<-%!AFD6?E(Khc-fx;oBpjf7T%V_Vl^<1_(>oFeh5fz z7Ah5Er%#HY*X!mQ4#Y{4AGd}igDXRaMMIiwd6IZ9CE=~nAu&EQ(aOz$dp@O$X2Z^L z3MAo@r;tv_q1F>g+?CVtc4bGLbDyCUym#`1cuhkckYI^h{^P3Osdz1xlxL8BwNzsWU?h?MP}WeZ?vLfSDS=7-DG$ZBi+rU_uo6 z14hsnH?GjXz`~6ts4L^j_y-!JF~N;n6BE7Dk{ER5Tbz6Dd-vnKdv_8)CU>VU6EUf$ z>7+s9d71zL#-!9nMT&+%Ry0-BlyLz>p;*1WTCP|nsIFkh-Gn*4HBl+oR*Tg&E5Ap{=@}?K>Z%N?1dIN*L8pL(e7`sJS(f*3Fr#CN<1hh9=Tc8m77)#$a?jh24XU6vTb+Ib^un_tUKlEMy;U?pKNJKYe|YkKnZE8 zqRBWF(rElYeU$()^Km0DHDxvBfR>1mte%Dzxdo5Ag?U@QILKq?dk0|$9o?+%Tt+t4 zwvSjq|5W=W2iecHyIaxByB?xpUr%f{UKbG$IxNKVoi)U#om(SB3`OC3qooR?5lH5Y z3@8!E#xoS>3yKOto|ek%IBoX2%im@TVpi8@ET1ANCz>axU!h@UH)`7F&pdaa^TsoT z&Y@@6c09dy&wCC0)LTM6)wj&*Z65ZvFUDloSvKg6;_ae$9`S|Oj_~yt5byV=5a0Db zY9#@7VIahIeZzQBhaUFP=R@}0$045N200=cGx6D3IJQ)30uB$A=QtkYK5!g+z$F^2 z=ptG?nWqN($@$ovf8^->nLmh<23>Oj`!sX*csJvD4I{4c;!)fluOmC;ZOL}s8*l~L hH+~$|`H}qs`x~g2?F{sIi1_brvG~h@Y`eW)@*9=P?7RQ~ diff --git a/lispusers/TEDITDORADOKEYS b/lispusers/TEDITDORADOKEYS index 4f459d0a..5c6597df 100644 --- a/lispusers/TEDITDORADOKEYS +++ b/lispusers/TEDITDORADOKEYS @@ -1,311 +1,50 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "16-Jul-2022 23:40:36"  -|{DSK}kaplan>Local>medley3.5>working-medley>lispusers>TEDITDORADOKEYS.;2| 22214 +(FILECREATED "26-Feb-2024 11:19:15" |{WMEDLEY}TEDITDORADOKEYS.;8| 5385 + + :EDIT-BY |rmk| :CHANGES-TO (VARS TEDITDORADOKEYSCOMS) - :PREVIOUS-DATE "19-Apr-2018 12:27:21" -|{DSK}kaplan>Local>medley3.5>working-medley>lispusers>TEDITDORADOKEYS.;1|) + :PREVIOUS-DATE "15-Sep-2022 10:10:07" |{WMEDLEY}TEDITDORADOKEYS.;4|) -; Copyright (c) 1987, 2018 by Xerox Corporation. - (PRETTYCOMPRINT TEDITDORADOKEYSCOMS) (RPAQQ TEDITDORADOKEYSCOMS - ((FILES TEDIT-DCL TEDIT-FNKEYS) - (COMS - (* |;;| - "These functions were fixed after Lyric went out so they'll ignore the meta key being down.") - - (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.FIND \\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)) + ((DECLARE\: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL)) (COMS (* |;;| "Specialized functions for this module") - (FNS \\TEDIT.DK.ABORT \\TEDIT.DK.FIND \\TEDIT.DK.SUBSTITUTE \\TEDIT.DK.INSERT-PARENS - \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES)) - (VARS (\\TEDIT.DORADO.KEYS '(("1,a" FN \\TEDIT.DK.ABORT) - ("1,A" FN \\TEDIT.DK.ABORT) - ("1,U" UNDO) - ("1,u" UNDO) - ("1,f" FN \\TEDIT.DK.FIND) - ("1,F" FN \\TEDIT.DK.FIND) - (ESC REDO) - ("1,n" NEXT) - ("1,N" NEXT) - ("1,S" FN \\TEDIT.DK.SUBSTITUTE) - ("1,s" FN \\TEDIT.DK.SUBSTITUTE) - ("1,x" EXPAND) - ("1,X" EXPAND) - ("1,c" FN \\TEDIT.CENTER.SEL) - ("1,C" FN \\TEDIT.CENTER.SEL.REV) - ("1,b" FN \\TEDIT.BOLD.SEL.ON) - ("1,B" FN \\TEDIT.BOLD.SEL.OFF) - ("1,i" FN \\TEDIT.ITALIC.SEL.ON) - ("1,I" FN \\TEDIT.ITALIC.SEL.OFF) - ("1,=" FN \\TEDIT.STRIKEOUT.SEL.ON) - ("1,+" FN \\TEDIT.STRIKEOUT.SEL.OFF) - ("1,-" FN \\TEDIT.UNDERLINE.SEL.ON) - ("1,_" FN \\TEDIT.UNDERLINE.SEL.OFF) - ("1,^" FN \\TEDIT.SUBSCRIPTSEL) - ("1,|" FN \\TEDIT.SUPERSCRIPTSEL) - ("1,SPACE" FN \\TEDIT.DEFAULTSSEL) - ("1,?" FN \\TEDIT.SHOWCARETLOOKS) - ("1,(" FN \\TEDIT.DK.INSERT-PARENS) - ("1,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES) - ("1,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES)))) + (FNS \\TEDIT.DK.ABORT \\TEDIT.DK.INSERT-PARENS \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES + \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES)) + (VARS (\\TEDIT.DORADO.KEYS '(("Meta,x" EXPAND) + ("Meta,X" EXPAND) + ("Meta,c" FN \\TEDIT.CENTER.SEL) + ("Meta,C" FN \\TEDIT.CENTER.SEL.REV) + ("Meta,b" FN \\TEDIT.BOLD.SEL.ON) + ("Meta,B" FN \\TEDIT.BOLD.SEL.OFF) + ("Meta,i" FN \\TEDIT.ITALIC.SEL.ON) + ("Meta,I" FN \\TEDIT.ITALIC.SEL.OFF) + ("Meta,=" FN \\TEDIT.STRIKEOUT.SEL.ON) + ("Meta,+" FN \\TEDIT.STRIKEOUT.SEL.OFF) + ("Meta,-" FN \\TEDIT.UNDERLINE.SEL.ON) + ("Meta,_" FN \\TEDIT.UNDERLINE.SEL.OFF) + ("Meta,^" FN \\TEDIT.SUBSCRIPTSEL) + ("Meta,|" FN \\TEDIT.SUPERSCRIPTSEL) + ("Meta,SPACE" FN \\TEDIT.DEFAULTSSEL) + ("Meta,?" FN \\TEDIT.SHOWCARETLOOKS) + ("Meta,(" FN \\TEDIT.DK.INSERT-PARENS) + ("Meta,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES) + ("Meta,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES)))) (P (FOR ENTRY IN \\TEDIT.DORADO.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY))))))) +(DECLARE\: EVAL@COMPILE DONTCOPY -(FILESLOAD TEDIT-DCL TEDIT-FNKEYS) - - - -(* |;;| "These functions were fixed after Lyric went out so they'll ignore the meta key being down.") - -(DEFINEQ - -(\\TEDIT.BOLD.SEL.OFF - (LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* \; "Edited 20-Oct-87 10:42 by jds") - - (\\TEDIT.BOLD.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT MEDIUM) SEL))) - -(\\TEDIT.BOLD.SEL.ON - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 10:42 by jds") - - (\\TEDIT.BOLD.CARET.ON TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(WEIGHT BOLD) SEL))) - -(\\TEDIT.CENTER.SEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 24-Sep-87 10:07 by jds") - - (* |;;| "makes the current paragraph centered") - - (PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS PARASEL (SAVECH# (|fetch| CH# |of| SEL)) - (SAVEDCH (|fetch| DCH |of| SEL))) - (|for| PARA |in| (\\PARAS.IN.SEL SEL TEXTOBJ) - |do| (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - (SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT JUSTIFIED CENTERED LEFT))))) - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (|push| NEWQUADS NEWQUAD)) - (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) - (COND - (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) - T)))))) - -(\\TEDIT.CENTER.SEL.REV - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 24-Sep-87 10:07 by jds") - - (* |;;| "acts like center.sel but cycles in the opposite direction") - - (PROG (LOOKS OLDQUAD NEWQUAD NEWQUADS PARASEL (SAVECH# (|fetch| CH# |of| SEL)) - (SAVEDCH (|fetch| DCH |of| SEL))) - (|for| PARA |in| (\\PARAS.IN.SEL SEL TEXTOBJ) - |do| (SETQ LOOKS (TEDIT.GET.PARALOOKS TEXTSTREAM PARA)) - (SETQ OLDQUAD (LISTGET LOOKS 'QUAD)) - (SETQ NEWQUAD (CADR (MEMB OLDQUAD (CONSTANT '(LEFT CENTERED JUSTIFIED LEFT))))) - (LISTPUT LOOKS 'QUAD NEWQUAD) - (SETQ PARASEL (TEDIT.SETSEL TEXTSTREAM PARA 1)) - (TEDIT.PARALOOKS TEXTSTREAM LOOKS PARASEL) - (|push| NEWQUADS NEWQUAD)) - (TEDIT.SETSEL TEXTSTREAM SAVECH# SAVEDCH) - (COND - (TEDIT.FNKEY.VERBOSE (TEDIT.PROMPTPRINT TEXTSTREAM (DREVERSE NEWQUADS) - T)))))) - -(\\TEDIT.DEFAULTS.CARET - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* |jds| "21-Sep-85 11:24") - (PROGN (TEDIT.CARETLOOKS TEXTSTREAM (|create| CHARLOOKS |using| TEDIT.DEFAULT.CHARLOOKS)) - (\\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL)))) - -(\\TEDIT.DEFAULTSSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:12 by jds") - (* |acts| |on| |the| |selection|) - (TEDIT.LOOKS TEXTSTREAM (|create| CHARLOOKS |using| TEDIT.DEFAULT.CHARLOOKS) - SEL))) - -(\\TEDIT.SETDEFAULT.FROM.SEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* |jds| " 8-Nov-85 15:22") - (* |Set| |the| |defaults| |from| |the| - |current| |selection.|) - (PROG ((LOOKS (TEDIT.GET.LOOKS TEXTSTREAM SEL))) - (SETQ TEDIT.DEFAULT.CHARLOOKS (\\TEDIT.PARSE.CHARLOOKS.LIST LOOKS))))) - -(\\TEDIT.FIND - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 28-Oct-87 19:35 by jds") - - (* |;;| "ENCAPSULATION FOR FIND KEY") - - (* |;;| "just calls the normal tedit.find starting at the right of the current selection") - - (PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - SEL CH W) (* \; - "Case sensitive search, with * and # wildcards") - - (SETQ W (CAR (|fetch| \\WINDOW |of| TEXTOBJ))) - (SETQ TARGET (TEDIT.GETINPUT TEXTOBJ "Text to find: " (WINDOWPROP W 'TEDIT.LAST.FIND.STRING - ) - (CHARCODE (EOL LF ESC)))) - (COND - (TARGET (SETQ SEL (|fetch| SEL |of| TEXTOBJ)) - (\\SHOWSEL SEL NIL NIL) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET) - NIL NIL T)) - (COND - (CH (* \; "We found the target text.") - - (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (|replace| CH# |of| SEL |with| (CAR CH)) - (* \; - "Set up SELECTION to be the found text") - - (|replace| CHLIM |of| SEL |with| (ADD1 (CADR CH))) - (|replace| DCH |of| SEL |with| (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH)))) - (|replace| POINT |of| SEL |with| 'RIGHT) - (|replace| CARETLOOKS |of| TEXTOBJ |with| (\\TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (* \; "And never pending a deletion.") - - (\\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\\SHOWSEL SEL NIL T) - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING TARGET) - (* \; "And get it into the window") - - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") - (\\SHOWSEL SEL NIL T))))) - (|replace| \\INSERTNEXTCH |of| TEXTOBJ |with| -1)))) - -(\\TEDIT.ITALIC.SEL.OFF - (LAMBDA (TEXTSTREAM TEXTOBJ SEL CHARCODE) (* \; "Edited 20-Oct-87 10:43 by jds") - - (\\TEDIT.ITALIC.CARET.OFF TEXTSTREAM TEXTOBJ SEL) - (TEDIT.LOOKS TEXTSTREAM '(SLOPE REGULAR) SEL))) - -(\\TEDIT.ITALIC.SEL.ON - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 10:43 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(SLOPE ITALIC) SEL))) - -(\\TEDIT.LARGERSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* |jds| "21-Sep-85 08:58") - (COND - ((SHIFTDOWNP 'META) - (\\TEDIT.LARGER.CARET TEXTSTREAM TEXTOBJ SEL)) - (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT 2) - SEL))))) - -(\\TEDIT.LCASE.SEL - (LAMBDA (STREAM TEXTOBJ SEL) (* \; "Edited 3-Sep-87 10:49 by jds") - - (* |;;| "LOWER-CASEs the selection") - - (PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL)) - (POS (|fetch| CH# |of| SEL)) - (LEN (|fetch| DCH |of| SEL)) - (POINT (|fetch| POINT |of| SEL))) - (TEDIT.DELETE STREAM SEL) - (TEDIT.INSERT STREAM (L-CASE STR)) - (TEDIT.SETSEL STREAM POS LEN POINT) - (TEDIT.NORMALIZECARET TEXTOBJ) - (|replace| (TEDITHISTORYEVENT THACTION) |of| (|fetch| (TEXTOBJ TXTHISTORY) |of| TEXTOBJ) - |with| '|LowerCase|)))) - -(\\TEDIT.SHOWCARETLOOKS - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* |gbn| "30-Jan-85 16:06") - - (* * |comment|) - - (PROG ((LOOKS (|fetch| CARETLOOKS |of| TEXTOBJ))) - (TEDIT.PROMPTPRINT TEXTSTREAM (CONCAT (\\TK.DESCRIBEFONT (|fetch| CLFONT |of| LOOKS)) - (COND - ((AND (|fetch| CLOFFSET |of| LOOKS) - (NEQ (|fetch| CLOFFSET |of| LOOKS) - 0)) - (CONCAT " offset " (|fetch| CLOFFSET |of| LOOKS))) - (T "")) - (COND - ((|fetch| CLOLINE |of| LOOKS) - " overlined") - (T "")) - (COND - ((|fetch| CLULINE |of| LOOKS) - " underlined") - (T ""))) - T) - (RETURN)))) - -(\\TEDIT.SMALLERSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* |jds| "21-Sep-85 08:58") - (COND - ((SHIFTDOWNP 'META) - (\\TEDIT.SMALLER.CARET TEXTSTREAM TEXTOBJ SEL)) - (T (TEDIT.LOOKS TEXTSTREAM (LIST 'SIZEINCREMENT -2) - SEL))))) - -(\\TEDIT.SUBSCRIPTSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:12 by jds") - - (TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT -2) - SEL))) - -(\\TEDIT.SUPERSCRIPTSEL - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:13 by jds") - - (TEDIT.LOOKS TEXTSTREAM (LIST 'OFFSETINCREMENT 2) - SEL))) - -(\\TEDIT.UCASE.SEL - (LAMBDA (STREAM TEXTOBJ SEL) (* \; "Edited 3-Sep-87 10:53 by jds") - (* \; "uppercasifies the selection") - - (PROG ((STR (TEDIT.SEL.AS.STRING STREAM SEL)) - (POS (|fetch| CH# |of| SEL)) - (LEN (|fetch| DCH |of| SEL)) - (POINT (|fetch| POINT |of| SEL))) - (TEDIT.DELETE STREAM SEL) - (TEDIT.INSERT STREAM (U-CASE STR)) - (TEDIT.SETSEL STREAM POS LEN POINT) - (TEDIT.NORMALIZECARET TEXTOBJ) - (|replace| (TEDITHISTORYEVENT THACTION) |of| (|fetch| (TEXTOBJ TXTHISTORY) |of| TEXTOBJ) - |with| '|UpperCase|)))) - -(\\TEDIT.UNDERLINE.SEL.OFF - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:26 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE OFF) SEL))) - -(\\TEDIT.UNDERLINE.SEL.ON - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(UNDERLINE ON) SEL))) - -(\\TEDIT.STRIKEOUT.SEL.ON - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT ON) SEL))) - -(\\TEDIT.STRIKEOUT.SEL.OFF - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 20-Oct-87 11:27 by jds") - - (TEDIT.LOOKS TEXTSTREAM '(STRIKEOUT OFF) SEL))) +(FILESLOAD TEDIT-EXPORTS.ALL) ) @@ -318,63 +57,6 @@ (LAMBDA (TEXTOBJ) (TEDIT.GET TEXTOBJ))) -(\\TEDIT.DK.FIND - (LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* \; "Edited 28-Oct-87 18:25 by jds") - - (* |;;| "FIND command for TEDITDORADOKEYS: Offers you the current selected text if there is not any other cached text to offer. Otherwise, behaves just like the FIND button of the 1186.") - - (PROG (TARGET (TEXTOBJ (TEXTOBJ TEXTSTREAM)) - SEL CH W) - - (* |;;| "Case sensitive search, with * and # wildcards") - - (SETQ W (CAR (MKLIST (|fetch| \\WINDOW |of| TEXTOBJ)))) - (SETQ TARGET (TEDIT.GETINPUT TEXTOBJ "Text to find: " (OR (WINDOWPROP W ' - TEDIT.LAST.FIND.STRING) - (TEDIT.SEL.AS.STRING TEXTSTREAM - SEL)) - (CHARCODE (EOL LF ESC)))) - (COND - (TARGET (SETQ SEL (|fetch| SEL |of| TEXTOBJ)) - (\\SHOWSEL SEL NIL NIL) - (TEDIT.PROMPTPRINT TEXTOBJ "Searching..." T) - (SETQ CH (TEDIT.FIND TEXTOBJ (MKSTRING TARGET) - NIL NIL T)) - (COND - (CH (* \; "We found the target text.") - - (TEDIT.PROMPTPRINT TEXTOBJ "Done.") - (|replace| CH# |of| SEL |with| (CAR CH)) - (* \; - "Set up SELECTION to be the found text") - - (|replace| CHLIM |of| SEL |with| (ADD1 (CADR CH))) - (|replace| DCH |of| SEL |with| (ADD1 (IDIFFERENCE (CADR CH) - (CAR CH)))) - (|replace| POINT |of| SEL |with| 'RIGHT) - (|replace| CARETLOOKS |of| TEXTOBJ |with| (\\TEDIT.GET.INSERT.CHARLOOKS - TEXTOBJ SEL)) - (TEDIT.RESET.EXTEND.PENDING.DELETE SEL) - (* \; "And never pending a deletion.") - - (\\FIXSEL SEL TEXTOBJ) - (TEDIT.NORMALIZECARET TEXTOBJ) - (\\SHOWSEL SEL NIL T) - (WINDOWPROP W 'TEDIT.LAST.FIND.STRING TARGET) - (* \; "And get it into the window") - - ) - (T (TEDIT.PROMPTPRINT TEXTOBJ "(not found)") - (\\SHOWSEL SEL NIL T))))) - (|replace| \\INSERTNEXTCH |of| TEXTOBJ |with| -1)))) - -(\\TEDIT.DK.SUBSTITUTE - (LAMBDA (TEXTSTREAM) (* \; "Edited 28-Oct-87 19:35 by jds") - - (* |;;| "KEYBOARD SUBSTITUTE INTERFACE for TEDITDORADOKEYS") - - (TEDIT.SUBSTITUTE TEXTSTREAM))) - (\\TEDIT.DK.INSERT-PARENS (LAMBDA (TEXTOBJ TEXTSTREAM SEL) (* \; "Edited 28-Oct-87 19:42 by jds") @@ -410,54 +92,33 @@ ) (RPAQQ \\TEDIT.DORADO.KEYS - (("1,a" FN \\TEDIT.DK.ABORT) - ("1,A" FN \\TEDIT.DK.ABORT) - ("1,U" UNDO) - ("1,u" UNDO) - ("1,f" FN \\TEDIT.DK.FIND) - ("1,F" FN \\TEDIT.DK.FIND) - (ESC REDO) - ("1,n" NEXT) - ("1,N" NEXT) - ("1,S" FN \\TEDIT.DK.SUBSTITUTE) - ("1,s" FN \\TEDIT.DK.SUBSTITUTE) - ("1,x" EXPAND) - ("1,X" EXPAND) - ("1,c" FN \\TEDIT.CENTER.SEL) - ("1,C" FN \\TEDIT.CENTER.SEL.REV) - ("1,b" FN \\TEDIT.BOLD.SEL.ON) - ("1,B" FN \\TEDIT.BOLD.SEL.OFF) - ("1,i" FN \\TEDIT.ITALIC.SEL.ON) - ("1,I" FN \\TEDIT.ITALIC.SEL.OFF) - ("1,=" FN \\TEDIT.STRIKEOUT.SEL.ON) - ("1,+" FN \\TEDIT.STRIKEOUT.SEL.OFF) - ("1,-" FN \\TEDIT.UNDERLINE.SEL.ON) - ("1,_" FN \\TEDIT.UNDERLINE.SEL.OFF) - ("1,^" FN \\TEDIT.SUBSCRIPTSEL) - ("1,|" FN \\TEDIT.SUPERSCRIPTSEL) - ("1,SPACE" FN \\TEDIT.DEFAULTSSEL) - ("1,?" FN \\TEDIT.SHOWCARETLOOKS) - ("1,(" FN \\TEDIT.DK.INSERT-PARENS) - ("1,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES) - ("1,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES))) + (("Meta,x" EXPAND) + ("Meta,X" EXPAND) + ("Meta,c" FN \\TEDIT.CENTER.SEL) + ("Meta,C" FN \\TEDIT.CENTER.SEL.REV) + ("Meta,b" FN \\TEDIT.BOLD.SEL.ON) + ("Meta,B" FN \\TEDIT.BOLD.SEL.OFF) + ("Meta,i" FN \\TEDIT.ITALIC.SEL.ON) + ("Meta,I" FN \\TEDIT.ITALIC.SEL.OFF) + ("Meta,=" FN \\TEDIT.STRIKEOUT.SEL.ON) + ("Meta,+" FN \\TEDIT.STRIKEOUT.SEL.OFF) + ("Meta,-" FN \\TEDIT.UNDERLINE.SEL.ON) + ("Meta,_" FN \\TEDIT.UNDERLINE.SEL.OFF) + ("Meta,^" FN \\TEDIT.SUBSCRIPTSEL) + ("Meta,|" FN \\TEDIT.SUPERSCRIPTSEL) + ("Meta,SPACE" FN \\TEDIT.DEFAULTSSEL) + ("Meta,?" FN \\TEDIT.SHOWCARETLOOKS) + ("Meta,(" FN \\TEDIT.DK.INSERT-PARENS) + ("Meta,\"" FN \\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES) + ("Meta,'" FN \\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES))) (FOR ENTRY IN \\TEDIT.DORADO.KEYS DO (SELECTQ (CADR ENTRY) (FN (TEDIT.SETFUNCTION (CAR ENTRY) (CADDR ENTRY))) (TEDIT.SETSYNTAX (CAR ENTRY) (CADR ENTRY)))) -(PUTPROPS TEDITDORADOKEYS COPYRIGHT ("Xerox Corporation" 1987 2018)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (4080 15768 (\\TEDIT.BOLD.SEL.OFF 4090 . 4328) (\\TEDIT.BOLD.SEL.ON 4330 . 4564) ( -\\TEDIT.CENTER.SEL 4566 . 5636) (\\TEDIT.CENTER.SEL.REV 5638 . 6733) (\\TEDIT.DEFAULTS.CARET 6735 . -7027) (\\TEDIT.DEFAULTSSEL 7029 . 7367) (\\TEDIT.SETDEFAULT.FROM.SEL 7369 . 7826) (\\TEDIT.FIND 7828 - . 10689) (\\TEDIT.ITALIC.SEL.OFF 10691 . 10933) (\\TEDIT.ITALIC.SEL.ON 10935 . 11121) ( -\\TEDIT.LARGERSEL 11123 . 11418) (\\TEDIT.LCASE.SEL 11420 . 12136) (\\TEDIT.SHOWCARETLOOKS 12138 . -13521) (\\TEDIT.SMALLERSEL 13523 . 13821) (\\TEDIT.SUBSCRIPTSEL 13823 . 14030) (\\TEDIT.SUPERSCRIPTSEL - 14032 . 14240) (\\TEDIT.UCASE.SEL 14242 . 14998) (\\TEDIT.UNDERLINE.SEL.OFF 15000 . 15191) ( -\\TEDIT.UNDERLINE.SEL.ON 15193 . 15382) (\\TEDIT.STRIKEOUT.SEL.ON 15384 . 15573) ( -\\TEDIT.STRIKEOUT.SEL.OFF 15575 . 15766)) (15826 20620 (\\TEDIT.DK.ABORT 15836 . 15903) ( -\\TEDIT.DK.FIND 15905 . 18934) (\\TEDIT.DK.SUBSTITUTE 18936 . 19193) (\\TEDIT.DK.INSERT-PARENS 19195 - . 19582) (\\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES 19584 . 20076) (\\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES -20078 . 20618))))) + (FILEMAP (NIL (2626 4130 (\\TEDIT.DK.ABORT 2636 . 2703) (\\TEDIT.DK.INSERT-PARENS 2705 . 3092) ( +\\TEDIT.DK.INSERT-NEUTRAL-DOUBLEQUOTES 3094 . 3586) (\\TEDIT.DK.INSERT-REAL-DOUBLEQUOTES 3588 . 4128)) +))) STOP diff --git a/lispusers/TEDITDORADOKEYS.LCOM b/lispusers/TEDITDORADOKEYS.LCOM index a7697372f70c660266347fa52706aa5a5e3f2372..d65bf602ad150691dd8cfb4f26c53336fad85e59 100644 GIT binary patch literal 3405 zcmeHJ?{4En5YH9q1V)wM1x};=f(_V;o#d|Pa&V5lZk9N<>)rGcsRH$n?}$i~C~2h= zm>1#^cmuw}`!H*#j-95bBEbjHRaLyZ{>^V^cIG#0)uTQOsqV9Y>MZmlcoI8q-#MZ{ zSSV-`Fdh?ll2FGJPB*~iksIJb*Wnb*rlu&Wv~>|6s0YM)s{84=ZZ)kon5Jz$x6KX# zm0ZlP7L#du3G*2c$bNn`pk6@7zkD^FtQI$`bh-K(?V0eR#POm&9dqOGAk#o0mbGED zT1aQNo5*m!Om8_e$kMlq<;upvY<~U2WcCI}lUWAD9|i$b84SZfS^+wD2w5#_pwKs|914qM^7(SU1U#|b@Q(U9vNo-Yuy zqw{njkJrM}xADLEjDYemU)q_boSx?U7+&9Sx=|v)_6`)4K@;~MiKzRn28|CJjmD#w zAK`D~lZM(UJTs1{(Dp+X?5o;-g@uKjCPI&$goeCei@^l97q9`u$m{k@U|<2K0Y1%q zA1<(71~{#5YwtB0A9NqfZGV5fekz~tJ#yx9iG3`8i*c_Q_ojQS_vat^L^^uwDW^hi z*0$E37cN3eZiZPfin+G0nl0%Sbp?w;=xoOL3R+Krs06T#iAHus9MYjkoIv-YA?o6I z7zz4+i~p1q2Y}CACxAKp2g7gQm;ULm>)cO&+nxCK^L1j^iO1Ac6Ajk0+Wg&#$G50C zA;u`cIKduR*lzk#E=)yDV(0jH*E>*EkGcWs;nW6t;sh@x6ZS~(qENU|Jchhwt`)D- zQH(m|h7$yu2CAe7^>fG$4`qYmi}Yf0Hl6&0t@HKG?BaSdpRM5adUMV5uQD+_gOY(&@Z`sT$5N462O3+ z&_kJO_ajMy$4}nw=9XzYoKlvc#_13!V=NV5vAK3i0_w} zNsWaGCt&V254#tW6Rn+oQA1%1WPKV9#WvX&?}Akv({o(u{4n(7Z5`5WzVB;%Td)e> zcQqUzcDb9dSa#CQxo2CLm?l+JksOX+5VQuwj|^uR2wrd%sBdya=|1m8uUyoO2%@Nu z7vH)#ume|00WYmu8J95Gs1R4OZGgL~x-|Rj9`+qIuE{cwQD#vB3RYw?2DYiuqB|4? z@8N}xf#R)ljB0kg1adforl89_7OPmz7RHYu1!%7gTJR`}n9aub)M%LKl8STty?cFRNjx~;z z)k-eeCc7X`7Li!uiwY- zz1KbYrqMEOqu4SnqiEVKhu-MujWvD6AjPzO!?jGWqtF|!p*MZKZlQa#VWFe0dj_d< zgO=-#g^=SjhC7j;lAF zHRGOFdRv$zl4Y3=wKJKum3j%(aC zovv4GLPt>1Vo~24Lq+NWsoIiOThi2Lt`c=p$US(#`6<;Mt6B04tK_s=wA5V4)(;$;H!dv{R*ubXm)K~F5$DchPhP7Ux%`jNNWE&fIx_Z+?qaqu4E)(WsFYv69kW>c} z_w>6)v(ZNH9Di=K-@JfEs6`8*&|5Z~uyogO>yBqYQ$Kqlo4HcI#x(SoYvJ!pH{5G= zJ;(Y!TJ2?TWWT)Zyv&>T-(#J(-r*YMJu}%qt@2Kb>-q?k5Bbxdmsf4kWv$=*-m5cL zKKa9P+vGhPuYCN<^7@Nxsy^@7WoDt(LKZu&v)=JLE)WeCuTm2ZVYm#yRAy#C6UfzP z0$kMO5QtU?X`!4Zsg((!=y$q4RTp4E>vgKgSyo_aOetcdR)r<9rdKj;rn$oP{CthL z5-RiJ7siMeM#DE98_J8GK}uB^s%5l%TJ3ti*)oBz!V2)f`cJfu6884oLcVAg64^y; zDpMAMK(BW#-z#xEyePQA&!ugL6O z4ZgN;4s||st7M-_w#Xzj*ngEKSFc2?`S&`;n-g@$U@f=A95)Or=YjP(`7zi| z+?O)on{#_ZzuFdo5)0YxjD;{B7oMA?eNgyFC#W#0U`pj@l-l za<|vNjs-HAcQE8bLBVG`TIDOPWoNI+$C>QIf6nIO)>`&o=y)mY;Ec@99*Je!t9+K( z%F!xc=V-MprWJBOTHOu#5E~F->Z8|F3`i0&t~zQB~FRaIz+r|2P&y0$vi$Dbpu~?d&rb&h@-SbO~fl|1(T4S~@a!eI#x;zb3 z=eeDRQCP+DQ5;6Lh#V=3(5i+kDQZ>O9>rv3xvAqzRwNON=~}r)N*=`r?TikGy@G-w zYJrsIXc(a0s8vYug01m3D@}L>g47}p`65rzY6VyWDSq(yfDT5q(;xPhNQr&a^r7em z!HZEQN#_AIAkkZY`TE!|C|EJ=1RlWe~XXTCCB0Z3p>q8HMsyjWZ;l~@~` ztgr;|!f^xmdW)^gL4Z5_FQO>7%sU4&yEkt};i4=dH4GOEkqe2X!zjE+UfXP;mff&B z+=$78tC}nbt|Q+^0>5tfdMfBy4OHIA08*xo!xCGb)*Ci{RrIj*AExTNrzZ1JY1O^T z1S$f@blx7eXK!4U6w3nOIM^+lt7{yPbuJQJV0W9#<7*7d;9(-NOu^8+)K{2xS0%^^ zaG^?#tRmZJoLYxyB<0Gi9C@{HYX}ISGOC!W`g@nhZ+*eI_eM-ht zsS3|6m^g(p&yUos3d%yLp+G7K$ID@~%5X`AjcdRAhJ1Se)8D_w1Dx#O0{$@3_1CL& z?|=Gh-jVL6bT?PXMXI2NV>fgJ{|bdqB3WAl@Our{tQ#%I_92(WMP93m%>zH9q=SHe zaRW#dHvormLrsz;K^viCo)kbJ;7uXGVK5%_he1!F#WL$(09MlIM^SGLWC|fZqIYL! zKR8IjpNBYSJ!7YS^zVx~b-4D^d$rfCGnsdI5qiN~7FPBu$3pIJX;!1`Is`-{(>MWv zw?){JHu!D_lKX57qyg}f40OLBsMftas&)7Fo(-yX?It_VwR!YNrU>UJ>6uFf-Dn|Z zbBU-M^@|+ka|`;>I^@`i_Lk3xh)^9bLR5#QRuT4e`5WV_?v4bz3#Za ztd&{DD$-}lyZ|7{iXseQJCS~e2a|D@iCI3!V({jP#bEEsuX;b#&sIKDjXeuicHDp*EYA8!Y?sjHzh~(hx;t-W;c=C{_ zU*nRI+mbqmL|2xFi!#Ma?upl+vL=qQN0fx3JVZ($7D=UrgxdL>su2ZOlqZ%Yr^ib; zUMPoEBUlNm##%D7RKXQik7~$TvW0RWewWBiQ49*ck1rW9hCodkj)JGEMpg=jRpTPk zqIA_*oljPcs9;a88sX0@`S4A@i()@aJp?oWNW|sK$>2(s#Nj{ufz+9;u~TNcWfJ7A2$HSrqjiJ>7B0Q8~<DWrF*u zH}M9dBuyrx(ezVqSPC~~KZ>^(Z1=YY{U5_#Vk6oajbRr3eR?$N9S(wHmH>zn`JZGP z9b5&8c8uwf0%Bwfu{`25esdz`C8j+M7}(bMhYR_5QvO{>iGA2Xd5)g&E=7H7OQBXQ zKDif+$2^SGeE&Rx#|jyn9bIy?nP{?|Y^TP@o+@TLvEcm@3Ej=V1JbFAf7lb;WXO4M`pqU6Movn2S_5ny#uJyn<04tt^oG(GBx*G zU0ZzU03u1l2Sg*-iV?YY&-V3AMvx+w4bEWr2^P-z@ns7ic|82)!pI!~QiAp8*aC}v zjxGEXp!E5WM1<$q!oN5;v%Yx>Y{93KPYWxTK$RTFEe>RtfR$Vx=O^rnIn3zeY#&!8 noqMAE&nuh3c=VVWqw(Hoyu}iE++-}`&VqeeSt#W2wPEhR_r^J% diff --git a/lispusers/TEDITKEY b/lispusers/TEDITKEY index d0cfc111..a5761430 100644 --- a/lispusers/TEDITKEY +++ b/lispusers/TEDITKEY @@ -1,36 +1,36 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") -(FILECREATED "10-Nov-87 14:55:24" {ERINYES}LISPCORE>TEDITKEY.;1 95396 +(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) - changes to%: (VARS TEDITKEYCOMS) +(FILECREATED "14-Oct-2023 14:53:17" {WMEDLEY}TEDITKEY.;4 93014 - previous date%: " 1-Apr-86 22:36:26" {ERINYES}LYRIC>LISPUSERS>TEDITKEY.;1) + :EDIT-BY rmk + + :CHANGES-TO (FNS \SEL.LINEDESC) + + :PREVIOUS-DATE "24-Oct-2022 15:25:58" {WMEDLEY}TEDITKEY.;2) -(* " -Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1985-1987 by Xerox Corporation. ") (PRETTYCOMPRINT TEDITKEYCOMS) -(RPAQQ TEDITKEYCOMS +(RPAQQ TEDITKEYCOMS [(COMS (* ;;; "This is the Lyric-and-later version of TEditKey") ) (COMS (* ;  "functions for affecting the selection") - (FNS NTHCAR \TEXTOBJ.WINDEX \TK.PREVSCREEN \TK.UNDERLINE.SEL.ON \TK.UNDERLINE.SEL.OFF \TK.BOLD.SEL.ON \TK.BOLD.SEL.OFF \TK.ITALIC.SEL.ON \TK.ITALIC.SEL.OFF \TK.SMALLERSEL \TK.LARGERSEL \TK.SUPERSCRIPTSEL \TK.SUBSCRIPTSEL \TK.DEFAULTSSEL \TK.DEL.WORD.FORWARD \TK.UCASE.SEL \TK.CAPITALISE.SEL \CAPITALISE \TK.LCASE.SEL) (* ;  "functions for affecting the paralooks of the selection") - (FNS \TK.CENTER.SEL \TK.CENTER.SEL.REV \TK.NEST \TK.UNNEST)) (COMS (* ;  "functions for affecting (and displaying) the caret character looks") - (FNS \TK.SHOWCARETLOOKS \TK.BOLD.CARET.ON \TK.BOLD.CARET.OFF \TK.ITALIC.CARET.ON \TK.ITALIC.CARET.OFF \TK.UNDERLINE.CARET.ON \TK.UNDERLINE.CARET.OFF \TK.SUPERSCRIPT.CARET \TK.SUBSCRIPT.CARET \TK.SMALLER.CARET \TK.LARGER.CARET @@ -38,37 +38,30 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. \TK.FONT5 \TK.FONT6 \TK.FONT7 \TK.FONT8) (* ;  "the functions which aren't currently used, which toggle the caret looks") - (FNS \TK.BOLDTOGGLE \TK.ITALICTOGGLE \TK.UNDERLINETOGGLE)) (COMS (* ;  "functions dealing with the default looks") - (FNS \TK.SETDEFAULTLOOKS)) (COMS (* ;  "functions for positioning within a document") - (FNS GOTONEXTTTYWINDOW \TK.NEXTLINE \TK.PREVLINE \TK.GOTODOCBEGIN \TK.GOTODOCEND \TK.GOTOLINEBEGIN \TK.GOTOLINEEND \TK.PREVCHAR \TK.NEXTCHAR \TK.FORWARD.WORD \TK.BACK.WORD \TK.SELECT.ALL)) (COMS (* ; "other utilities") - (FNS \TK.FIND \TK.REDISPLAY \TK.DELLINEFORWARD \TK.OPENLINE \TK.DELCHARFORWARD \TK.TRANSPOSECHARS)) (COMS (* ;  "little selection utilities etc., for building hacks") - (FNS \SEL.LIMIT \TK.SETFILEPTR.TO.CARET \SEL.LINEDESC) (MACROS \SEL.LIMIT.FORWARD \TK.ONOROFF \LINEDESC.LAST.REAL.CHAR)) (COMS (* ; "fns for the key interface itself") - (FNS \SHIFTACTION \ACTION TEDITKEY.INSTALL TEDITKEY.DEINSTALL \TK.ACTIONTOCHARCODE \TK.BUILD.MENU \TK.HELP \TK.SETFONTINLOOKS WRITE.CHARDESC.AUX CHARDESC TEDITKEY.CONFIGURE \TK.ADDKEY \TK.CHANGEKEY \TK.APPLYPENDING \TK.NTHFONT) (* ; "redefinition of system junk") - (FNS METASHIFT)) - - (* ;; "(\TK.BOLDTOGGLE (##H ##h) 'toggle Bold caret looks') (\TK.ITALICTOGGLE (##i ##I) 'toggle Italic caret looks') (\TK.SUPERSCRIPT.CARET (##^) 'Superscript the caret looks') (\TK.SUBSCRIPT.CARET (##_) 'Subscript the caret looks')") + + (* ;; "(\TK.BOLDTOGGLE (##H ##h) 'toggle Bold caret looks') (\TK.ITALICTOGGLE (##i ##I) 'toggle Italic caret looks') (\TK.SUPERSCRIPT.CARET (##^) 'Superscript the caret looks') (\TK.SUBSCRIPT.CARET (##_) 'Subscript the caret looks')") (FNS TEDIT.FULL.FIND) [VARS \TK.WHITESPACE (TEDIT.INTERRUPTS `((%, (CHARCODE ^G) @@ -184,8 +177,7 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. (FONT FONTDOWN . FONTUP) (KEYBOARD USERMODE1DOWN . USERMODE1UP] (COMS - - (* ;; "(TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##^B), (CHARCODE ##^C))) (BOLD (, (CHARCODE ##^D), (CHARCODE ##^E) NOLOCKSHIFT)) (ITALICS (, (CHARCODE ##^F), (CHARCODE ##^G) NOLOCKSHIFT)) (UNDERLINE (, (CHARCODE ##^H), (CHARCODE ##^I) NOLOCKSHIFT)) (SUPERSCRIPT (, (CHARCODE ##^J), (CHARCODE ##^K) NOLOCKSHIFT)) (SUBSCRIPT (, (CHARCODE ##^L), (CHARCODE ##^N) NOLOCKSHIFT)) (LARGER (, (CHARCODE ##^O), (CHARCODE ##^P) NOLOCKSHIFT)) (DEFAULTS (, (CHARCODE ##^Q), (CHARCODE ##^R) NOLOCKSHIFT)) (BS (, (CHARCODE ^H), (CHARCODE ^D) NOLOCKSHIFT)))))") + (* ;; "(TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##^B), (CHARCODE ##^C))) (BOLD (, (CHARCODE ##^D), (CHARCODE ##^E) NOLOCKSHIFT)) (ITALICS (, (CHARCODE ##^F), (CHARCODE ##^G) NOLOCKSHIFT)) (UNDERLINE (, (CHARCODE ##^H), (CHARCODE ##^I) NOLOCKSHIFT)) (SUPERSCRIPT (, (CHARCODE ##^J), (CHARCODE ##^K) NOLOCKSHIFT)) (SUBSCRIPT (, (CHARCODE ##^L), (CHARCODE ##^N) NOLOCKSHIFT)) (LARGER (, (CHARCODE ##^O), (CHARCODE ##^P) NOLOCKSHIFT)) (DEFAULTS (, (CHARCODE ##^Q), (CHARCODE ##^R) NOLOCKSHIFT)) (BS (, (CHARCODE ^H), (CHARCODE ^D) NOLOCKSHIFT)))))") ) [TEDITKEY.DLION.KEYBINDINGS '(((\ACTION 'OPEN) \TK.OPENLINE) @@ -202,8 +194,7 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. ((\SHIFTACTION 'DEFAULTS) \TK.SETDEFAULTLOOKS] (COMS - - (* ;; "NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT)) NEXT) ((\ACTION (QUOTE UNDO)) UNDO) ((\ACTION (QUOTE BS)) CHARDELETE))))") + (* ;; "NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT)) NEXT) ((\ACTION (QUOTE UNDO)) UNDO) ((\ACTION (QUOTE BS)) CHARDELETE))))") ) [TEDITKEY.DORADO.KEYACTIONS `((BS (%, (CHARCODE ^H) %, @@ -1207,38 +1198,40 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. (SETFILEPTR TEXTSTREAM (SUB1 (\SEL.LIMIT.FORWARD SEL]) (\SEL.LINEDESC - [LAMBDA (SEL) (* gbn "10-Oct-85 20:57") - - (* * Returns the line descriptor of the point of the selection in the last - selected window) + [LAMBDA (SEL) (* ; "Edited 14-Oct-2023 14:53 by rmk") + (* ; "Edited 24-Oct-2022 15:24 by rmk") + (* gbn "10-Oct-85 20:57") - (NTHCAR (if (EQ (fetch POINT of SEL) +(* ;;; "Returns the line descriptor of the point of the selection in the last selected window") + + (NTHCAR (if (EQ (fetch (SELECTION POINT) of SEL) 'LEFT) - then (fetch L1 of SEL) - else (fetch LN of SEL)) - (\TEXTOBJ.WINDEX (fetch \TEXTOBJ of SEL]) + then (fetch (SELECTION L1) of SEL) + else (fetch (SELECTION LN) of SEL)) + (\TEXTOBJ.WINDEX (fetch (SELECTION SELTEXTOBJ) of SEL]) ) (DECLARE%: EVAL@COMPILE -[PUTPROPS \SEL.LIMIT.FORWARD MACRO (LAMBDA (SEL) - (* gbn "13-Dec-84 11:43") - (* returns the character in front of the caret - (ch# for left and chlim for right)) - (if (EQ (fetch POINT of SEL) - 'LEFT) - then - (fetch CH# of SEL) - else - (fetch CHLIM of SEL] -[PUTPROPS \TK.ONOROFF MACRO (LAMBDA (FLG) - (if FLG then "on" else "off"] -[PUTPROPS \LINEDESC.LAST.REAL.CHAR MACRO (LAMBDA (LINEDESC) - (if (fetch CR\END of LINEDESC) - then - (* there is a CR at the end so the last real char - CHLIM-1) - (SUB1 (fetch CHARLIM of LINEDESC)) - else - (fetch CHARLIM of LINEDESC] + +(PUTPROPS \SEL.LIMIT.FORWARD MACRO [LAMBDA (SEL) (* gbn "13-Dec-84 11:43") + (* returns the character in front of + the caret (ch# for left and chlim for + right)) + (if (EQ (fetch POINT of SEL) + 'LEFT) + then (fetch CH# of SEL) + else (fetch CHLIM of SEL]) + +(PUTPROPS \TK.ONOROFF MACRO [LAMBDA (FLG) + (if FLG + then "on" + else "off"]) + +(PUTPROPS \LINEDESC.LAST.REAL.CHAR MACRO [LAMBDA (LINEDESC) + (if (fetch CR\END of LINEDESC) + then (* there is a CR at the end so the + last real char CHLIM-1) + (SUB1 (fetch CHARLIM of LINEDESC)) + else (fetch CHARLIM of LINEDESC]) ) @@ -1636,6 +1629,7 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. (RPAQQ \TK.WHITESPACE 22) + (CONSTANTS (\TK.WHITESPACE 22)) ) @@ -1655,131 +1649,136 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. (RPAQ? TEDITKEY.FNKEYFLG T) (DECLARE%: EVAL@COMPILE -[PUTPROPS METACODE MACRO (LAMBDA (CHARCODE) - (LOGOR CHARCODE 128] -[PUTPROPS CONTROLCODE MACRO (LAMBDA (CHARCODE) - (LOGAND CHARCODE 31] -[PUTPROPS LCMETACODE MACRO (LAMBDA (CHARCODE) - (LOGOR 160 CHARCODE] + +(PUTPROPS METACODE MACRO [LAMBDA (CHARCODE) + (LOGOR CHARCODE 128]) + +(PUTPROPS CONTROLCODE MACRO [LAMBDA (CHARCODE) + (LOGAND CHARCODE 31]) + +(PUTPROPS LCMETACODE MACRO [LAMBDA (CHARCODE) + (LOGOR 160 CHARCODE]) ) (RPAQ? \TK.SELKEY 'OPEN) (RPAQ? \TK.PENDING ) -(RPAQ? TEDITKEY.KEYBINDINGS `((\TK.FONT1 (%##1) - %, - (CONCAT "change to font " (\TK.NTHFONT 1))) - (\TK.FONT2 (%##2) - %, - (CONCAT "change to font " (\TK.NTHFONT 2))) - (\TK.FONT3 (%##3) - %, - (CONCAT "change to font " (\TK.NTHFONT 3))) - (\TK.FONT4 (%##4) - %, - (CONCAT "change to font " (\TK.NTHFONT 4))) - (\TK.FONT5 (%##5) - %, - (CONCAT "change to font " (\TK.NTHFONT 5))) - (\TK.FONT6 (%##6) - %, - (CONCAT "change to font " (\TK.NTHFONT 6))) - (\TK.FONT7 (%##7) - %, - (CONCAT "change to font " (\TK.NTHFONT 7))) - (\TK.FONT8 (%##8) - %, - (CONCAT "change to font " (\TK.NTHFONT 8))) - NIL - (\TK.DEFAULTS.CARET (%##/) - "restore the default caret looks") - (\TK.SMALLER.CARET (%##9) - "decrease the caret font size") - (\TK.LARGER.CARET (%##0) - "increase the caret font size") - (\TK.SHOWCARETLOOKS (%##=) - "display the current caret looks") - NIL - (\TK.REDISPLAY (%##R %##r) - "Restore the display") - (\TK.HELP (%##?) - "displays the current key bindings") - NIL - (\TK.PREVCHAR (^B ^b) - "Back one character") - (\TK.NEXTCHAR (^F ^f) - "Forward one character") - (\TK.FORWARD.WORD (%##F %##f) - "Forward one word") - (\TK.BACK.WORD (%##B %##b) - "Back one word") - (\TK.GOTOLINEBEGIN (^A ^a) - "go to stArt of line") - (\TK.GOTOLINEEND (^E ^e) - "go to End of line") - (\TK.PREVLINE (^P ^p) - "go to Previous line") - (\TK.NEXTLINE (^N ^n) - "go to Next line") - (\TK.GOTODOCBEGIN (%##<) - "start of document") - (\TK.GOTODOCEND (%##>) - "end of document") - (\TK.SELECT.ALL (%##S %##s) - "Select whole document") - NIL - (\TK.DELLINEFORWARD (^K ^k) - "Kill line") - (\TK.OPENLINE (^O ^o) - "Open up blank line") - (\TK.DELCHARFORWARD (^D ^d) - "Delete character forward") - (\TK.DEL.WORD.FORWARD (%##D %##d) - "Delete word forward") - (\TK.TRANSPOSECHARS (^T ^t) - "Transpose characters") - NIL NIL (\TK.NEST (|##[|) - "indents margins (nest)") - (\TK.UNNEST (|##]|) - "exdents margins (unnest)") - (\TK.CENTER.SEL (%##J %##j) - "alter Justification") - (\TK.UCASE.SEL (%##U %##u) - "Uppercasify selection") - (\TK.CAPITALISE.SEL (%##C %##c) - "Capitalize selection") - (\TK.LCASE.SEL (%##L %##l) - "Lowercasify selection") - (GET.OBJ.FROM.USER (%##O %##o) - "insert Object"))) +(RPAQ? TEDITKEY.KEYBINDINGS + `((\TK.FONT1 (%##1) + %, + (CONCAT "change to font " (\TK.NTHFONT 1))) + (\TK.FONT2 (%##2) + %, + (CONCAT "change to font " (\TK.NTHFONT 2))) + (\TK.FONT3 (%##3) + %, + (CONCAT "change to font " (\TK.NTHFONT 3))) + (\TK.FONT4 (%##4) + %, + (CONCAT "change to font " (\TK.NTHFONT 4))) + (\TK.FONT5 (%##5) + %, + (CONCAT "change to font " (\TK.NTHFONT 5))) + (\TK.FONT6 (%##6) + %, + (CONCAT "change to font " (\TK.NTHFONT 6))) + (\TK.FONT7 (%##7) + %, + (CONCAT "change to font " (\TK.NTHFONT 7))) + (\TK.FONT8 (%##8) + %, + (CONCAT "change to font " (\TK.NTHFONT 8))) + NIL + (\TK.DEFAULTS.CARET (%##/) + "restore the default caret looks") + (\TK.SMALLER.CARET (%##9) + "decrease the caret font size") + (\TK.LARGER.CARET (%##0) + "increase the caret font size") + (\TK.SHOWCARETLOOKS (%##=) + "display the current caret looks") + NIL + (\TK.REDISPLAY (%##R %##r) + "Restore the display") + (\TK.HELP (%##?) + "displays the current key bindings") + NIL + (\TK.PREVCHAR (^B ^b) + "Back one character") + (\TK.NEXTCHAR (^F ^f) + "Forward one character") + (\TK.FORWARD.WORD (%##F %##f) + "Forward one word") + (\TK.BACK.WORD (%##B %##b) + "Back one word") + (\TK.GOTOLINEBEGIN (^A ^a) + "go to stArt of line") + (\TK.GOTOLINEEND (^E ^e) + "go to End of line") + (\TK.PREVLINE (^P ^p) + "go to Previous line") + (\TK.NEXTLINE (^N ^n) + "go to Next line") + (\TK.GOTODOCBEGIN (%##<) + "start of document") + (\TK.GOTODOCEND (%##>) + "end of document") + (\TK.SELECT.ALL (%##S %##s) + "Select whole document") + NIL + (\TK.DELLINEFORWARD (^K ^k) + "Kill line") + (\TK.OPENLINE (^O ^o) + "Open up blank line") + (\TK.DELCHARFORWARD (^D ^d) + "Delete character forward") + (\TK.DEL.WORD.FORWARD (%##D %##d) + "Delete word forward") + (\TK.TRANSPOSECHARS (^T ^t) + "Transpose characters") + NIL NIL (\TK.NEST (|##[|) + "indents margins (nest)") + (\TK.UNNEST (|##]|) + "exdents margins (unnest)") + (\TK.CENTER.SEL (%##J %##j) + "alter Justification") + (\TK.UCASE.SEL (%##U %##u) + "Uppercasify selection") + (\TK.CAPITALISE.SEL (%##C %##c) + "Capitalize selection") + (\TK.LCASE.SEL (%##L %##l) + "Lowercasify selection") + (GET.OBJ.FROM.USER (%##O %##o) + "insert Object"))) -(RPAQ? TEDITKEY.DLION.KEYACTIONS `((STOP (%, (CHARCODE ^G) - %, - (CHARCODE ^C) - NOLOCKSHIFT)) - (OPEN (%, (CHARCODE 2,1) - %, - (CHARCODE 2,41) - NOLOCKSHIFT)) - (FONT FONTDOWN . FONTUP) - (KEYBOARD USERMODE1DOWN . USERMODE1UP))) +(RPAQ? TEDITKEY.DLION.KEYACTIONS + `((STOP (%, (CHARCODE ^G) + %, + (CHARCODE ^C) + NOLOCKSHIFT)) + (OPEN (%, (CHARCODE 2,1) + %, + (CHARCODE 2,41) + NOLOCKSHIFT)) + (FONT FONTDOWN . FONTUP) + (KEYBOARD USERMODE1DOWN . USERMODE1UP))) (RPAQ? COMS - - (* ;; "(TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##^B), (CHARCODE ##^C))) (BOLD (, (CHARCODE ##^D), (CHARCODE ##^E) NOLOCKSHIFT)) (ITALICS (, (CHARCODE ##^F), (CHARCODE ##^G) NOLOCKSHIFT)) (UNDERLINE (, (CHARCODE ##^H), (CHARCODE ##^I) NOLOCKSHIFT)) (SUPERSCRIPT (, (CHARCODE ##^J), (CHARCODE ##^K) NOLOCKSHIFT)) (SUBSCRIPT (, (CHARCODE ##^L), (CHARCODE ##^N) NOLOCKSHIFT)) (LARGER (, (CHARCODE ##^O), (CHARCODE ##^P) NOLOCKSHIFT)) (DEFAULTS (, (CHARCODE ##^Q), (CHARCODE ##^R) NOLOCKSHIFT)) (BS (, (CHARCODE ^H), (CHARCODE ^D) NOLOCKSHIFT)))))") + (* ;; "(TEDITKEY.FNKEYACTIONS (BQUOTE ((CENTER (, (CHARCODE ##^B), (CHARCODE ##^C))) (BOLD (, (CHARCODE ##^D), (CHARCODE ##^E) NOLOCKSHIFT)) (ITALICS (, (CHARCODE ##^F), (CHARCODE ##^G) NOLOCKSHIFT)) (UNDERLINE (, (CHARCODE ##^H), (CHARCODE ##^I) NOLOCKSHIFT)) (SUPERSCRIPT (, (CHARCODE ##^J), (CHARCODE ##^K) NOLOCKSHIFT)) (SUBSCRIPT (, (CHARCODE ##^L), (CHARCODE ##^N) NOLOCKSHIFT)) (LARGER (, (CHARCODE ##^O), (CHARCODE ##^P) NOLOCKSHIFT)) (DEFAULTS (, (CHARCODE ##^Q), (CHARCODE ##^R) NOLOCKSHIFT)) (BS (, (CHARCODE ^H), (CHARCODE ^D) NOLOCKSHIFT)))))") ) -(RPAQ? TEDITKEY.DLION.KEYBINDINGS '(((\ACTION 'OPEN) - \TK.OPENLINE) - ((\ACTION 'HELP) - \TK.HELP) - ((\ACTION 'MARGINS) - \TK.NEST) - ((\SHIFTACTION 'MARGINS) - \TK.UNNEST) - ((\SHIFTACTION 'NEXT) - GOTONEXTTTYWINDOW))) +(RPAQ? TEDITKEY.DLION.KEYBINDINGS + '(((\ACTION 'OPEN) + \TK.OPENLINE) + ((\ACTION 'HELP) + \TK.HELP) + ((\ACTION 'MARGINS) + \TK.NEST) + ((\SHIFTACTION 'MARGINS) + \TK.UNNEST) + ((\SHIFTACTION 'NEXT) + GOTONEXTTTYWINDOW))) (RPAQ? TEDITKEY.FNKEYBINDINGS '(((\ACTION 'DEFAULTS) \TK.DEFAULTSSEL) @@ -1787,26 +1786,26 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. \TK.SETDEFAULTLOOKS))) (RPAQ? COMS - - (* ;; "NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT)) NEXT) ((\ACTION (QUOTE UNDO)) UNDO) ((\ACTION (QUOTE BS)) CHARDELETE))))") + (* ;; "NOT NEEDED (TEDITKEY.DLION.KEYSYNTAX (QUOTE (((\ACTION (QUOTE NEXT)) NEXT) ((\ACTION (QUOTE UNDO)) UNDO) ((\ACTION (QUOTE BS)) CHARDELETE))))") ) -(RPAQ? TEDITKEY.DORADO.KEYACTIONS `((BS (%, (CHARCODE ^H) - %, - (CHARCODE ^H))) - (BLANK-BOTTOM (%, (CHARCODE %##^A) - %, - (CHARCODE %##^A))) - (BLANK-TOP FONTDOWN . FONTUP) - (BLANK-MIDDLE USERMODE1DOWN . USERMODE1UP) - (CENTER (2,101 2,141 NOLOCKSHIFT)) - (BOLD (2,102 2,142 NOLOCKSHIFT)) - (ITALICS (2,103 2,143 NOLOCKSHIFT)) - (UNDERLINE (2,106 2,146 NOLOCKSHIFT)) - (SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT)) - (SUBSCRIPT (2,114 2,154 NOLOCKSHIFT)) - (LARGER (2,110 2,150 NOLOCKSHIFT)) - (DEFAULTS (2,115 2,155 NOLOCKSHIFT)))) +(RPAQ? TEDITKEY.DORADO.KEYACTIONS + `((BS (%, (CHARCODE ^H) + %, + (CHARCODE ^H))) + (BLANK-BOTTOM (%, (CHARCODE %##^A) + %, + (CHARCODE %##^A))) + (BLANK-TOP FONTDOWN . FONTUP) + (BLANK-MIDDLE USERMODE1DOWN . USERMODE1UP) + (CENTER (2,101 2,141 NOLOCKSHIFT)) + (BOLD (2,102 2,142 NOLOCKSHIFT)) + (ITALICS (2,103 2,143 NOLOCKSHIFT)) + (UNDERLINE (2,106 2,146 NOLOCKSHIFT)) + (SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT)) + (SUBSCRIPT (2,114 2,154 NOLOCKSHIFT)) + (LARGER (2,110 2,150 NOLOCKSHIFT)) + (DEFAULTS (2,115 2,155 NOLOCKSHIFT)))) (RPAQ? TEDITKEY.DORADO.KEYSYNTAX '(((CHARCODE %##N) NEXT) @@ -1816,8 +1815,10 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. UNDO) ((\ACTION 'BS) CHARDELETE))) -(TEDITKEY.INSTALL) -(\TK.BUILD.MENU) + +(TEDITKEY.INSTALL) + +(\TK.BUILD.MENU) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) @@ -1828,34 +1829,34 @@ Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved. ) (PUTPROPS TEDITKEY COPYRIGHT ("Xerox Corporation" 1985 1986 1987)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (15418 27849 (NTHCAR 15428 . 15557) (\TEXTOBJ.WINDEX 15559 . 16116) (\TK.PREVSCREEN -16118 . 18028) (\TK.UNDERLINE.SEL.ON 18030 . 18510) (\TK.UNDERLINE.SEL.OFF 18512 . 18995) ( -\TK.BOLD.SEL.ON 18997 . 19589) (\TK.BOLD.SEL.OFF 19591 . 20187) (\TK.ITALIC.SEL.ON 20189 . 20537) ( -\TK.ITALIC.SEL.OFF 20539 . 20890) (\TK.SMALLERSEL 20892 . 21529) (\TK.LARGERSEL 21531 . 22162) ( -\TK.SUPERSCRIPTSEL 22164 . 22809) (\TK.SUBSCRIPTSEL 22811 . 23460) (\TK.DEFAULTSSEL 23462 . 24181) ( -\TK.DEL.WORD.FORWARD 24183 . 25779) (\TK.UCASE.SEL 25781 . 26347) (\TK.CAPITALISE.SEL 26349 . 26963) ( -\CAPITALISE 26965 . 27279) (\TK.LCASE.SEL 27281 . 27847)) (27921 32598 (\TK.CENTER.SEL 27931 . 29199) -(\TK.CENTER.SEL.REV 29201 . 30379) (\TK.NEST 30381 . 31361) (\TK.UNNEST 31363 . 32596)) (32682 42410 ( -\TK.SHOWCARETLOOKS 32692 . 34003) (\TK.BOLD.CARET.ON 34005 . 34568) (\TK.BOLD.CARET.OFF 34570 . 35136) - (\TK.ITALIC.CARET.ON 35138 . 35703) (\TK.ITALIC.CARET.OFF 35705 . 36273) (\TK.UNDERLINE.CARET.ON -36275 . 36714) (\TK.UNDERLINE.CARET.OFF 36716 . 37158) (\TK.SUPERSCRIPT.CARET 37160 . 37802) ( -\TK.SUBSCRIPT.CARET 37804 . 38462) (\TK.SMALLER.CARET 38464 . 39106) (\TK.LARGER.CARET 39108 . 39695) -(\TK.DEFAULTS.CARET 39697 . 40022) (\TK.FONT1 40024 . 40196) (\TK.FONT2 40198 . 40370) (\TK.FONT3 -40372 . 40544) (\TK.SETCARETFONT 40546 . 41538) (\TK.FONT4 41540 . 41712) (\TK.FONT5 41714 . 41886) ( -\TK.FONT6 41888 . 42060) (\TK.FONT7 42062 . 42234) (\TK.FONT8 42236 . 42408)) (42499 44831 ( -\TK.BOLDTOGGLE 42509 . 43384) (\TK.ITALICTOGGLE 43386 . 44197) (\TK.UNDERLINETOGGLE 44199 . 44829)) ( -44889 45351 (\TK.SETDEFAULTLOOKS 44899 . 45349)) (45412 58534 (GOTONEXTTTYWINDOW 45422 . 47701) ( -\TK.NEXTLINE 47703 . 49591) (\TK.PREVLINE 49593 . 51693) (\TK.GOTODOCBEGIN 51695 . 52053) ( -\TK.GOTODOCEND 52055 . 52406) (\TK.GOTOLINEBEGIN 52408 . 53192) (\TK.GOTOLINEEND 53194 . 54018) ( -\TK.PREVCHAR 54020 . 54549) (\TK.NEXTCHAR 54551 . 55115) (\TK.FORWARD.WORD 55117 . 56654) ( -\TK.BACK.WORD 56656 . 58224) (\TK.SELECT.ALL 58226 . 58532)) (58567 61606 (\TK.FIND 58577 . 58848) ( -\TK.REDISPLAY 58850 . 59108) (\TK.DELLINEFORWARD 59110 . 59650) (\TK.OPENLINE 59652 . 59859) ( -\TK.DELCHARFORWARD 59861 . 60248) (\TK.TRANSPOSECHARS 60250 . 61604)) (61675 63029 (\SEL.LIMIT 61685 - . 62100) (\TK.SETFILEPTR.TO.CARET 62102 . 62529) (\SEL.LINEDESC 62531 . 63027)) (64449 81285 ( -\SHIFTACTION 64459 . 64705) (\ACTION 64707 . 64949) (TEDITKEY.INSTALL 64951 . 72392) ( -TEDITKEY.DEINSTALL 72394 . 72657) (\TK.ACTIONTOCHARCODE 72659 . 73122) (\TK.BUILD.MENU 73124 . 74440) -(\TK.HELP 74442 . 74753) (\TK.SETFONTINLOOKS 74755 . 77230) (WRITE.CHARDESC.AUX 77232 . 77988) ( -CHARDESC 77990 . 78296) (TEDITKEY.CONFIGURE 78298 . 78453) (\TK.ADDKEY 78455 . 78655) (\TK.CHANGEKEY -78657 . 78852) (\TK.APPLYPENDING 78854 . 80960) (\TK.NTHFONT 80962 . 81283)) (81330 82491 (METASHIFT -81340 . 82489)) (82737 85563 (TEDIT.FULL.FIND 82747 . 85561))))) + (FILEMAP (NIL (15387 27818 (NTHCAR 15397 . 15526) (\TEXTOBJ.WINDEX 15528 . 16085) (\TK.PREVSCREEN +16087 . 17997) (\TK.UNDERLINE.SEL.ON 17999 . 18479) (\TK.UNDERLINE.SEL.OFF 18481 . 18964) ( +\TK.BOLD.SEL.ON 18966 . 19558) (\TK.BOLD.SEL.OFF 19560 . 20156) (\TK.ITALIC.SEL.ON 20158 . 20506) ( +\TK.ITALIC.SEL.OFF 20508 . 20859) (\TK.SMALLERSEL 20861 . 21498) (\TK.LARGERSEL 21500 . 22131) ( +\TK.SUPERSCRIPTSEL 22133 . 22778) (\TK.SUBSCRIPTSEL 22780 . 23429) (\TK.DEFAULTSSEL 23431 . 24150) ( +\TK.DEL.WORD.FORWARD 24152 . 25748) (\TK.UCASE.SEL 25750 . 26316) (\TK.CAPITALISE.SEL 26318 . 26932) ( +\CAPITALISE 26934 . 27248) (\TK.LCASE.SEL 27250 . 27816)) (27890 32567 (\TK.CENTER.SEL 27900 . 29168) +(\TK.CENTER.SEL.REV 29170 . 30348) (\TK.NEST 30350 . 31330) (\TK.UNNEST 31332 . 32565)) (32651 42379 ( +\TK.SHOWCARETLOOKS 32661 . 33972) (\TK.BOLD.CARET.ON 33974 . 34537) (\TK.BOLD.CARET.OFF 34539 . 35105) + (\TK.ITALIC.CARET.ON 35107 . 35672) (\TK.ITALIC.CARET.OFF 35674 . 36242) (\TK.UNDERLINE.CARET.ON +36244 . 36683) (\TK.UNDERLINE.CARET.OFF 36685 . 37127) (\TK.SUPERSCRIPT.CARET 37129 . 37771) ( +\TK.SUBSCRIPT.CARET 37773 . 38431) (\TK.SMALLER.CARET 38433 . 39075) (\TK.LARGER.CARET 39077 . 39664) +(\TK.DEFAULTS.CARET 39666 . 39991) (\TK.FONT1 39993 . 40165) (\TK.FONT2 40167 . 40339) (\TK.FONT3 +40341 . 40513) (\TK.SETCARETFONT 40515 . 41507) (\TK.FONT4 41509 . 41681) (\TK.FONT5 41683 . 41855) ( +\TK.FONT6 41857 . 42029) (\TK.FONT7 42031 . 42203) (\TK.FONT8 42205 . 42377)) (42468 44800 ( +\TK.BOLDTOGGLE 42478 . 43353) (\TK.ITALICTOGGLE 43355 . 44166) (\TK.UNDERLINETOGGLE 44168 . 44798)) ( +44858 45320 (\TK.SETDEFAULTLOOKS 44868 . 45318)) (45381 58503 (GOTONEXTTTYWINDOW 45391 . 47670) ( +\TK.NEXTLINE 47672 . 49560) (\TK.PREVLINE 49562 . 51662) (\TK.GOTODOCBEGIN 51664 . 52022) ( +\TK.GOTODOCEND 52024 . 52375) (\TK.GOTOLINEBEGIN 52377 . 53161) (\TK.GOTOLINEEND 53163 . 53987) ( +\TK.PREVCHAR 53989 . 54518) (\TK.NEXTCHAR 54520 . 55084) (\TK.FORWARD.WORD 55086 . 56623) ( +\TK.BACK.WORD 56625 . 58193) (\TK.SELECT.ALL 58195 . 58501)) (58536 61575 (\TK.FIND 58546 . 58817) ( +\TK.REDISPLAY 58819 . 59077) (\TK.DELLINEFORWARD 59079 . 59619) (\TK.OPENLINE 59621 . 59828) ( +\TK.DELCHARFORWARD 59830 . 60217) (\TK.TRANSPOSECHARS 60219 . 61573)) (61644 63231 (\SEL.LIMIT 61654 + . 62069) (\TK.SETFILEPTR.TO.CARET 62071 . 62498) (\SEL.LINEDESC 62500 . 63229)) (64698 81534 ( +\SHIFTACTION 64708 . 64954) (\ACTION 64956 . 65198) (TEDITKEY.INSTALL 65200 . 72641) ( +TEDITKEY.DEINSTALL 72643 . 72906) (\TK.ACTIONTOCHARCODE 72908 . 73371) (\TK.BUILD.MENU 73373 . 74689) +(\TK.HELP 74691 . 75002) (\TK.SETFONTINLOOKS 75004 . 77479) (WRITE.CHARDESC.AUX 77481 . 78237) ( +CHARDESC 78239 . 78545) (TEDITKEY.CONFIGURE 78547 . 78702) (\TK.ADDKEY 78704 . 78904) (\TK.CHANGEKEY +78906 . 79101) (\TK.APPLYPENDING 79103 . 81209) (\TK.NTHFONT 81211 . 81532)) (81579 82740 (METASHIFT +81589 . 82738)) (82986 85812 (TEDIT.FULL.FIND 82996 . 85810))))) STOP diff --git a/lispusers/TEDITKEY.LCOM b/lispusers/TEDITKEY.LCOM index dc838a595e17d6c92e44de790857ed6ea728f145..a303ab732f7831a6389d1db7e0224645522a1e22 100644 GIT binary patch delta 2609 zcmaJ?YfPKx6_zOw_!82zKnA4LZ*2^p12(=AVi@$Z{TVxazQmW3q)FTm?2T|SF@|ty z63B&;5DMn3Oi4PGtbf|>rp;0Nqe+%!>9lL3YMLgdHOn+Chhsf`o!yZR7VBjS zHrnPE?UK0ncw=&*=%h)_xb==ki^*g$qGNkJlJSfT^~L*D7PdbiN?Hlaw2J{7>%@4D zkR)NY$CCF~{*5n1{zEM_*@cpt}Vs1Ut zMxQeI_sQ)_wE=v}2B>@PT1Kmf1B#m&?eh$(hpQDo&1i*iUGb*5U{Mg;Ka_$%j8RwXJBr=2Lm;K{A^Yl9ft$*!()$UwS@|0w%57 z;Wq;IGnKSvuN(0PwlnMWVUb^(;C72Yoj?f|XX6UG)qn`Irs=ep~7rc$d9Ixi~2b?ZPP_PAEUeEG{_}JTw=jFZ@bdUJ1=c1x) zqxpZ*hU=Yb-@{SFo_#)4ZtQyxmDJz?B^7Y#U=PZ?uovZ?Fir29VT_gfeYh!m1IN3V zj(Ol8nyp~ysK&#C9Y4cERV4KUDvMt~gi_m83c=0>M6;a-QGV9hf%4vy#n5>~SUJCa z#EGb&E1JtO9)AIZm#zL z!h^jC;e)iSiBWI2h+l#E7*+q*7+Ki+$l^PFdr)Q{twY&x^e-soapEW9H1NCeXbxvk zGajxNl)#~W2XZGSOW}Ao+gv0uT2GcOv?8MIr1s=0Y@nj7~m1M!j(ly@>Mdv>bc21j>i0PvK!= z-yhzOvSfr>abkp;aCd~5hEeh_PcpbQYD9E2X#oCZ6P+g=@aD@5kvJzp{&6`D=!bKa zG;rU^NIthe*s67kk`ILOLI}TRMZRdP9VItk1KIP%Ak7!Tuf__HSsa@|**Q){emG7x z`cstlkH@z`>XZ%9gHu#e+i9}6cAAP*oQalj*h@)p3(PGBh4gZ&>5qejGvvPEERC`2 zELFR3mb!62&3GoFWgK2O0pC$Ki$&S$E4J+X;RH4K(}@7eW&EwU{27k-`-I)i3|}c% zuvOfveL?hFz4-bDF<pXl=71ML<)L52^@vN>EU zD9vU@j8QlFQu(SwCW*s?sT@*EI!kJjn)t6t{AGj2bF{kS=dkN=igaJ7`J5UP$OfOU}GSPwB^m+Nz>UnqyFEXuEn*Z8h1!_}+b+lNB zaJAr#3uTC!j#=S97syLKjY~2&B*D+8i&4EhO*io;LpH$uLWCOze|S}eCNngUzYW&_ z%oq^u8ZpA>GfG5PMjB!7>~=(XqXu|)mX@q{)JQ9bs3{rQ#;KIbn3^d%d;25t1oO5Z zi5yNSmS=S%NpV$kkt&X9Stua--Cnz>5Bbu^D-*GK-2ujLXAKQ(c}251T9O;dQuy)i ze2AU2Z^TXd(tXuo^xwWlYqVpYFIpYX+JLmY=)O8n20i0pdW`?)9zV@_ypq?}x^`dl rF1BNeu8Ykoj?c{A{?u&5SD)DqBV!}xFqhsYXT(5 delta 2599 zcmaJ?ZA@F|6&@s%d~iz>U?m|LFSiA*X>I%k7=ui&?Mr-vzhaw`v;^XTvj7Ggj3GcG zAbgV$0!KmWsP>x63IuJ$9KL{L z+fq2IEHhP>vz9aAuJ1(>tT$F@Wy0%XAjr6lEQik%)UbF@q^~WOOsJ({63+~3Yc1u> zXtbKjt;TYmRcznZ<~|XS9qPVo6>LaS$2f1ua=k1mlQ_|2l=UEi2c=O<&UX9 zNkN+8DuVf40r+>?K6o)Lw#{>Hi}g4?V==uA9gVvu;BorEX6U}^dx{v|TMbKlew)H6 z;k~;^JG@tbN7~(RliLqJ%y_uX^Vc*^@H0KE7QCw5c|M=gM;w*Pp%)g2KFGcggZty_ z?9;3+WJTE@qV$7o3nnOyxqK?TlB-v#D|HWvnVDY zM@hW9NCMAG0T0)GU+Fx!Q&nkVW7#7u zrR;(ydfS#X^281Q?RoNyCvJQu$4JA_T||}ImG@0W>xC;%&7E7$pxi9CZj_K^`93cB z*m46aYpTpbx6)(XnTkLC)us3Y1vNbU#@3*+w-ImE{2GJfuc@OjCw_&lIk5!Zv;P_0 zBMyaxM;xU}izI9;|M*A%ohhzn#IS1u^ZxEKQyyvCj@GN!Y+ymj&0y3~0Jm+s;qFnI zxWzh=L_YUSBF>2gu$;!hjCY3P1exh+g@%303@e_4Q0c42oIYQ54ku{1#-K~C4T+AB z?DMWYl)JtfjHmmLpsde->p3*I2AY9~4TI=%AKybeHN4?RCOOUpCuzrf`d`s0glB>Plur*@4ELGhxKSwh-cATNC1++FB8h4dy_w zT|{=Zoie^@KaJSbL70-33y(VNU?|A~V>F1K$*2YKvnX{fzq18#tdlao>^zC+>LPwa z#c#&~VDlb;(U=!~4`LM8#VLL@ejM>1@p8n%?!O`K?je7?hc5J<%1aa9MZTDz3cpEE zbhWp5aW)NRd+{B@&wI(W(ksBxWErxNMv1y;wvyX&sIrE)P>P9u8;2^3_A2 z8!@649-%rQGAy0(@|y(q?j>&I+xQh z!7X}3=8;08I%yjE<6w52mVZ4?w^cu3Mx33H5kH?Gk7bgg?@s3CaYDc^9y`VwLv^|a zmmHFUe$gS}_W(71KNKI}>!fNQflwEW3ZHFhbv5&Ip+-b)IQ+4mgA7cNpezrILs!heaTT&V_*pb@ydZ~*ax1v*dWVx*X3Iz}H_kIyL?>iz0vuD5_b z;!G%ERaIAJ% z5}qubrWyaAgSemb`rJN8-PVD7vUCtK-g2S-jj@_SPT0JD*&7UrZZ}p+GiI-s-Akaplan>Local>medley3.5>my-medley>lispusers>WHEELSCROLL.;21 11690 +(FILECREATED " 2-Oct-2023 10:15:55" {WMEDLEY}WHEELSCROLL.;24 10480 - changes to%: (FNS INSTALL-WHEELSCROLL) + :EDIT-BY rmk - previous date%: "29-Nov-2021 21:58:55" -{DSK}kaplan>Local>medley3.5>my-medley>lispusers>WHEELSCROLL.;20) + :CHANGES-TO (VARS WHEELSCROLLCOMS) + (FNS ENABLEWHEELSCROLL) + + :PREVIOUS-DATE " 6-Apr-2023 18:34:48" {WMEDLEY}WHEELSCROLL.;22) (PRETTYCOMPRINT WHEELSCROLLCOMS) @@ -17,11 +18,8 @@ (* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys") - (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS (\WSUP 156) - (\WSDOWN 157) - (\WSLEFT 158) - (\WSRIGHT 159))) - (GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS) + (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * WHEELSCROLLCHARS)) + (GLOBALVARS WHEELSCROLLENABLED WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS) (* ;; "To restore the keyactions for PAD..., if the keyaction table has been reinitialized") @@ -37,77 +35,59 @@ (DEFINEQ (ENABLEWHEELSCROLL - [LAMBDA (ON EXCLUDEHORIZONTAL) (* ; - "Edited 23-Oct-2021 16:31 by larry") - (* ; - "Edited 11-Jun-2021 12:50 by rmk:") - (* ; - "Edited 28-May-2021 11:46 by rmk:") + [LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 2-Oct-2023 10:05 by rmk") + (* ; "Edited 23-Oct-2021 16:31 by larry") + (* ; "Edited 11-Jun-2021 12:50 by rmk:") + (* ; "Edited 28-May-2021 11:46 by rmk:") (* ;; "So we can toggle this scrolling.") (if ON then (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS) - (GETD 'LISPINTERRUPTS.WHEELSCROLL)) - (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL) - (* ; "In case of LOADFROM?") - (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG) - (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))) + (GETD 'LISPINTERRUPTS.WHEELSCROLL)) + (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL) (* ; "In case of LOADFROM?") + (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG) + (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))) - (* ;; "In some situations these other keyactions seem to be installed, hit them all.") + (* ;; "In some situations these other keyactions seem to be installed, hit them all.") - (for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION) - do (for K in [if EXCLUDEHORIZONTAL - then `((PAD1 ,\WSUP) - (PAD2 ,\WSDOWN) - (PAD4 IGNORE) - (PAD5 IGNORE)) - else `((PAD1 ,\WSUP) - (PAD2 ,\WSDOWN) - (PAD4 ,\WSLEFT) - (PAD5 ,\WSRIGHT] - do (KEYACTION (CAR K) - (CONS (CL:IF (EQ (CADR K) - 'IGNORE) - 'IGNORE - `(,(CADR K) - ,(CADR K))) - `IGNORE) - KAT))) - (for I in WHEELSCROLLINTERRUPTS - do (INTERRUPTCHAR (CAR I) - (CADR I) - (CADDR I)) - (CL:WHEN (BOUNDP 'TEDIT.READTABLE) - - (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts") - - (TEDIT.SETFUNCTION (CAR I) - `[LAMBDA NIL - ,(CADR I] - TEDIT.READTABLE))) - (SETQ WHEELSCROLLENABLED T) + (for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION) + do (for K in [if EXCLUDEHORIZONTAL + then `((PAD1 ,\WSUP) + (PAD2 ,\WSDOWN) + (PAD4 IGNORE) + (PAD5 IGNORE)) + else `((PAD1 ,\WSUP) + (PAD2 ,\WSDOWN) + (PAD4 ,\WSLEFT) + (PAD5 ,\WSRIGHT] + do (KEYACTION (CAR K) + (CONS (CL:IF (EQ (CADR K) + 'IGNORE) + 'IGNORE + `(,(CADR K) + ,(CADR K))) + `IGNORE) + KAT))) + (for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I) + (CADR I) + (CADDR I))) + (SETQ WHEELSCROLLENABLED T) else (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL) - (GETD 'LISPINTERRUPTS)) - (MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS)) - (for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I) - NIL) - (CL:WHEN (BOUNDP 'TEDIT.READTABLE) - - (* ;; "These actions are invoked when the caret is in the Tedit window, because TEDIT disables the interrupts") - - (TEDIT.SETFUNCTION (CAR I) - NIL TEDIT.READTABLE))) - (for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION) - do (KEYACTION 'PAD1 '(IGNORE . IGNORE) - KAT) - (KEYACTION 'PAD2 '(IGNORE . IGNORE) - KAT) - (KEYACTION 'PAD4 '(IGNORE . IGNORE) - KAT) - (KEYACTION 'PAD5 '(IGNORE . IGNORE) - KAT)) - (SETQ WHEELSCROLLENABLED NIL]) + (GETD 'LISPINTERRUPTS)) + (MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS)) + (for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I) + NIL)) + (for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION) + do (KEYACTION 'PAD1 '(IGNORE . IGNORE) + KAT) + (KEYACTION 'PAD2 '(IGNORE . IGNORE) + KAT) + (KEYACTION 'PAD4 '(IGNORE . IGNORE) + KAT) + (KEYACTION 'PAD5 '(IGNORE . IGNORE) + KAT)) + (SETQ WHEELSCROLLENABLED NIL]) (WHEELSCROLL [LAMBDA (DIRECTION DELTA) (* ; @@ -195,6 +175,11 @@ ) (DECLARE%: EVAL@COMPILE DONTCOPY + +(RPAQQ WHEELSCROLLCHARS ((\WSUP 156) + (\WSDOWN 157) + (\WSLEFT 158) + (\WSRIGHT 159))) (DECLARE%: EVAL@COMPILE (RPAQQ \WSUP 156) @@ -214,7 +199,7 @@ ) (DECLARE%: DOEVAL@COMPILE DONTCOPY -(GLOBALVARS WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS) +(GLOBALVARS WHEELSCROLLENABLED WHEELSCROLLDELTA WHEELSCROLLSETTLETIME \WHEELSCROLLINPROGRESS) ) @@ -242,6 +227,6 @@ (ENABLEWHEELSCROLL T) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1636 10642 (ENABLEWHEELSCROLL 1646 . 5903) (WHEELSCROLL 5905 . 8506) (WHEELSCROLL.DOIT -8508 . 9144) (INSTALL-WHEELSCROLL 9146 . 10363) (LISPINTERRUPTS.WHEELSCROLL 10365 . 10640))))) + (FILEMAP (NIL (1459 9251 (ENABLEWHEELSCROLL 1469 . 4512) (WHEELSCROLL 4514 . 7115) (WHEELSCROLL.DOIT +7117 . 7753) (INSTALL-WHEELSCROLL 7755 . 8972) (LISPINTERRUPTS.WHEELSCROLL 8974 . 9249))))) STOP diff --git a/lispusers/WHEELSCROLL.LCOM b/lispusers/WHEELSCROLL.LCOM index e2b0d9585fd80cb7276c2c5acd005eb24246a12c..3550ee114430b4cc515b9713869ac9d4682ff53e 100644 GIT binary patch delta 1022 zcmZuv!EVz)5KZhtf)Sz+Bzh`?Q6UB;cz3<2ZE>g@Z&DY>PHm@AB#?l#q7k$yp$7y) z{R4!$f506HR3XlALh7IN0-wO9O&cq%weq}~**E)kc7ESGocr9?0hhw=P6_Ln0Mczl zZAw)rs@?wPcJKB28uYh7g%9lpbA8tN_=rE0W_Aq?6cx~ziFKP=HWADhgY{GD`n&DH z+c_Jy`a2uFt(VXfrD`qThcvZZE~~Kid`BF0UQL6jno_KJKC4E|Nti3t+&WkDq(*Ta z!_>iMu9uV+J22RM1$K4G3F<5^C7}YvRVRv}y~LOwSEJDPt6?M7pjZoHV1cvfvs6w4 zyBV=nFKopnSLhHjDkW!oFzTFX6T>!46_k+-dDN>*SW}LR@oc`pyAt7lrJ37C`rPBZ zt3kFeOBre5%lFJ5J}1|&KFf%2{NsJOIU9ewxt6__m6o&1l2}sq@^Di@l7Afbx_K^5 zJ-8Ep8tvFnPICXoRgMsUI@Q|EPiKmRR^Tz~IMu`p10cjodl;uZou)iYP4I$*MNzAn zh^|I}4GfKN)dh?zz*d^VBB--O1keZ|3#UlAAq!E9zrRquYfxx9E(Ld? znaBXvCqw1E+!d9Id(?w4Vt|O~!wJ++prsF$Y9>8LsF=w!I{DtkuM*X{le-}ia%50N zn1YNg>&PNR`9W@$|IA&Nk#6oE{=GhE^}KL5g1`eLX6?; zjo5JU=-osmo=rS>F!A8gqgPM*2blQE#vHhVHqGnj^ZkC`=Y784mwuoAaO9kx z+IoGDB;?e_-b|aM!g=N0$x_LW(Xz$0qDFsZ-u| zi|~AStR%qJc71oP`M7m#kETxhLrGan%5grC_$x^(6BY>gRZ*esJ}>B}-h1N3>n8m*V2XZ$0xE#LuX`>q=vO~>6}KOV3;xxMTvj}MA9RGfe;)4`uFMR?DbGr z7@SP8(DhoR{?zc-;En58LVu+Q3iE@Lcd$rPMsC400BI+a=-xRXNrcRzoA)e0Sm{Ef zbzt~u@YMrN1HMy~=)?seD(V-NrG8PO_K6~qgkR2!tgg_{)KUCG{G!d5OU0l7NLB=h uu$eEpl&NjzShi1@)@EL2aVes@AP6zw7oGfq;j9>55kmL!MEDLEY>TEDIT-PROCESS-KILLER.;2 16040 - changes to%: (FNS MAKE-NEW-TEDIT-PROCESS) +(FILECREATED "20-Oct-2023 00:11:10" {WMEDLEY}tedit-process-killer.;2 16210 - previous date%: " 2-Feb-88 14:21:07" {ERINYES}MEDLEY>TEDIT-PROCESS-KILLER.;1) + :EDIT-BY rmk + + :CHANGES-TO (FNS TEDIT-PROCESS-P) + + :PREVIOUS-DATE " 9-Mar-89 15:01:15" {WMEDLEY}tedit-process-killer.;1) -(* " -Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. +(* ; " +Copyright (c) 1987-1989 by Xerox Corporation. ") (PRETTYCOMPRINT TEDIT-PROCESS-KILLERCOMS) (RPAQQ TEDIT-PROCESS-KILLERCOMS [ - (* ;; "This package provides various ways to kill tedit processes. Using START-TEDIT-KILLER, one can keep the total number of tedit processes under the threshold TEDIT-PROCESS-LIMIT. One can also call KILL-PROCESS-OF-TEDIT-WINDOW to kill the Tedit processes for a given window and its attached windows.") + (* ;; "This package provides various ways to kill tedit processes. Using START-TEDIT-KILLER, one can keep the total number of tedit processes under the threshold TEDIT-PROCESS-LIMIT. One can also call KILL-PROCESS-OF-TEDIT-WINDOW to kill the Tedit processes for a given window and its attached windows.") (GLOBALVARS TEDIT-PROCESS-LIMIT TEDIT-KILLER-WAIT-TIME TEDIT-PROCESSES TEDIT-CREATION-TIME) -(* ;;; "These two vars are advertised.") +(* ;;; "These two vars are advertised.") (INITVARS (TEDIT-PROCESS-LIMIT 5) (TEDIT-KILLER-WAIT-TIME 10000)) @@ -27,13 +30,13 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. (TEDIT-CREATION-TIME NIL)) -(* ;;; "Here are the advertised functions.") +(* ;;; "Here are the advertised functions.") (FNS START-TEDIT-KILLER STOP-TEDIT-KILLER KILL-PROCESS-OF-TEDIT-WINDOW RESTART-PROCESS-OF-TEDIT-WINDOW WITHOUT-TEDIT-PROCESS) -(* ;;; "The rest of these are internal.") +(* ;;; "The rest of these are internal.") (FNS TEDIT-KILLER \TEDIT.BUTTONEVENTFN-BEFORE-ADVICE) (FNS MARK-AS-WITHOUT-PROCESS UNMARK-AS-WITHOUT-PROCESS WITHOUT-PROCESS) @@ -41,11 +44,11 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. MAKE-NEW-TEDIT-PROCESS RESTART-PROCESS-OF-TEDIT-WINDOW1 TEDIT-KILLER-CLEANUP) -(* ;;; "NOTE: this advising smashes whatever advice was previously on these functions!") +(* ;;; "NOTE: this advising smashes whatever advice was previously on these functions!") (DECLARE%: DONTEVAL@LOAD DOCOPY (ADVISE \TEDIT.QUIT TEDIT \TEDIT.BUTTONEVENTFN - (* ;; "PROCESS.APPLY advice is mainly for NoteCards - fixes a misuse of this function that makes it impossible to use monitors inside a TEdit menu fn.") + (* ;; "PROCESS.APPLY advice is mainly for NoteCards - fixes a misuse of this function that makes it impossible to use monitors inside a TEdit menu fn.") (PROCESS.APPLY :IN \TEDIT.BUTTONEVENTFN) (PROCESSP :IN TEDIT.DEACTIVATE.WINDOW) @@ -210,15 +213,17 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. (for P in \PROCESSES when (TEDIT-PROCESS-P P) collect P]) (TEDIT-PROCESS-P - [LAMBDA (PROCESS) (* ; "Edited 2-Feb-88 14:15 by Randy.Gobbel") - - (* ;; "rg 2/2/88: Now looks at process name instead of checking TTYENTRYFN = \TEDIT.PROCENTRYFN, which failed for TEdits that had never been given the TTY (look at \TEDIT.COMMAND.LOOP code). This will miss processes that have been given another name, but works in practice for all cases that I know of.") + [LAMBDA (PROCESS) (* ; "Edited 20-Oct-2023 00:11 by rmk") + (* ; + "Edited 2-Feb-88 14:15 by Randy.Gobbel") + + (* ;; "rg 2/2/88: Now looks at process name instead of checking TTYENTRYFN = \TEDIT.PROCENTRYFN, which failed for TEdits that had never been given the TTY (look at \TEDIT.COMMAND.LOOP code). This will miss processes that have been given another name, but works in practice for all cases that I know of.") (AND (PROCESSP PROCESS) (EQ (STRPOS "TEdit" (PROCESSPROP PROCESS 'NAME)) 1) (EQ (CAR (PROCESSPROP PROCESS 'FORM)) - '\TEDIT2]) + '\TEDIT1]) (KILL-PROCESS-OF-TEDIT-WINDOW1 [LAMBDA (WINDOW) (* SCB%: " 1-May-86 17:37") @@ -361,12 +366,12 @@ Copyright (c) 1987, 1988, 1989 by Xerox Corporation. All rights reserved. ) (PUTPROPS TEDIT-PROCESS-KILLER COPYRIGHT ("Xerox Corporation" 1987 1988 1989)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3085 4859 (START-TEDIT-KILLER 3095 . 3585) (STOP-TEDIT-KILLER 3587 . 3978) ( -KILL-PROCESS-OF-TEDIT-WINDOW 3980 . 4287) (RESTART-PROCESS-OF-TEDIT-WINDOW 4289 . 4695) ( -WITHOUT-TEDIT-PROCESS 4697 . 4857)) (4910 7835 (TEDIT-KILLER 4920 . 6736) ( -\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE 6738 . 7833)) (7836 8340 (MARK-AS-WITHOUT-PROCESS 7846 . 8018) ( -UNMARK-AS-WITHOUT-PROCESS 8020 . 8185) (WITHOUT-PROCESS 8187 . 8338)) (8341 14699 (ALL-TEDIT-PROCESSES - 8351 . 8655) (TEDIT-PROCESS-P 8657 . 9279) (KILL-PROCESS-OF-TEDIT-WINDOW1 9281 . 9642) ( -KILL-TEDIT-PROCESS 9644 . 11199) (MAKE-NEW-TEDIT-PROCESS 11201 . 13641) ( -RESTART-PROCESS-OF-TEDIT-WINDOW1 13643 . 14039) (TEDIT-KILLER-CLEANUP 14041 . 14697))))) + (FILEMAP (NIL (3081 4855 (START-TEDIT-KILLER 3091 . 3581) (STOP-TEDIT-KILLER 3583 . 3974) ( +KILL-PROCESS-OF-TEDIT-WINDOW 3976 . 4283) (RESTART-PROCESS-OF-TEDIT-WINDOW 4285 . 4691) ( +WITHOUT-TEDIT-PROCESS 4693 . 4853)) (4906 7831 (TEDIT-KILLER 4916 . 6732) ( +\TEDIT.BUTTONEVENTFN-BEFORE-ADVICE 6734 . 7829)) (7832 8336 (MARK-AS-WITHOUT-PROCESS 7842 . 8014) ( +UNMARK-AS-WITHOUT-PROCESS 8016 . 8181) (WITHOUT-PROCESS 8183 . 8334)) (8337 14869 (ALL-TEDIT-PROCESSES + 8347 . 8651) (TEDIT-PROCESS-P 8653 . 9449) (KILL-PROCESS-OF-TEDIT-WINDOW1 9451 . 9812) ( +KILL-TEDIT-PROCESS 9814 . 11369) (MAKE-NEW-TEDIT-PROCESS 11371 . 13811) ( +RESTART-PROCESS-OF-TEDIT-WINDOW1 13813 . 14209) (TEDIT-KILLER-CLEANUP 14211 . 14867))))) STOP diff --git a/lispusers/tmax/TMAX b/lispusers/tmax/TMAX index e37fada6..1b45c86a 100644 --- a/lispusers/tmax/TMAX +++ b/lispusers/tmax/TMAX @@ -1,11 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "18-Jul-2023 12:34:39" {DSK}frank>il>medley>gmedley>lispusers>tmax>TMAX.;2 25955 +(FILECREATED " 4-Mar-2024 16:23:18" {WMEDLEY}tmax>TMAX.;10 25460 - :CHANGES-TO (VARS TMAXCOMS) + :EDIT-BY rmk - :PREVIOUS-DATE "17-Mar-2022 23:12:47" {DSK}frank>il>medley>gmedley>lispusers>tmax>TMAX.;1 -) + :CHANGES-TO (FNS TSP.LIST.OF.OBJECTS) + + :PREVIOUS-DATE "19-Jul-2023 09:14:13" {WMEDLEY}tmax>TMAX.;9) (PRETTYCOMPRINT TMAXCOMS) @@ -18,11 +19,10 @@ (FILES (COMPILED SYSLOAD) TEDIT FREEMENU) (VARS TMAX.FILE.LIST) - [DECLARE%: DONTCOPY (P (DOFILESLOAD (LIST* '(SOURCE) + (DECLARE%: DONTCOPY (P (DOFILESLOAD (LIST* '(SOURCE) TMAX.FILE.LIST))) - (DECLARE%: EVAL@COMPILE DONTCOPY (P (OR (GETPROP 'EXPORTS.ALL 'FILE) - (FILESLOAD (FROM LOADUPS) - EXPORTS.ALL] + (DECLARE%: EVAL@COMPILE (FILES (FROM LOADUPS) + EXPORTS.ALL))) (P (DOFILESLOAD TMAX.FILE.LIST)) @@ -97,11 +97,10 @@ (DOFILESLOAD (LIST* '(SOURCE) TMAX.FILE.LIST)) -(DECLARE%: EVAL@COMPILE DONTCOPY +(DECLARE%: EVAL@COMPILE -(OR (GETPROP 'EXPORTS.ALL 'FILE) - (FILESLOAD (FROM LOADUPS) - EXPORTS.ALL)) +(FILESLOAD (FROM LOADUPS) + EXPORTS.ALL) ) ) @@ -517,22 +516,18 @@ (DEFINEQ (TSP.LIST.OF.OBJECTS - [LAMBDA (TEXTOBJ TESTFN TESTFNARG) (* ss%: "27-Jun-87 16:32") - (* * Loop through each PIECE of the TEdit document and call the user supplied - function on those PIECEs that are ImageObjects.) + [LAMBDA (TEXTOBJ TESTFN TESTFNARG) (* ; "Edited 4-Mar-2024 16:22 by rmk") + (* ; "Edited 6-Nov-2022 09:38 by rmk") + (* ; "Edited 6-Sep-2022 10:16 by rmk") + (* ss%: "27-Jun-87 16:32") - (AND TESTFN (LET ((OBJLIST (TCONC NIL))) - (TEDIT.MAPPIECES TEXTOBJ [FUNCTION (LAMBDA (CH# PIECE PC# OBL) - (AND (TYPENAMEP PIECE 'PIECE) - (IMAGEOBJP (fetch POBJ of PIECE)) - (APPLY* TESTFN (fetch POBJ - of PIECE) - TESTFNARG) - (TCONC OBL - (LIST (fetch POBJ of PIECE) - CH#] - OBJLIST) - (CDAR OBJLIST]) +(* ;;; "Loop through each PIECE of the TEdit document and call the user supplied function on those PIECEs that are ImageObjects. The extra loop is because the callers expect the results to be of the form (OBJ CH#)") + + (CL:WHEN TESTFN + (LET ((OBJECTS (TEDIT.MAP.OBJECTS TEXTOBJ TESTFN TESTFNARG T))) + (for X in OBJECTS do (swap (CAR X) + (CADR X))) + OBJECTS))]) ) (DECLARE%: DOEVAL@COMPILE DONTCOPY @@ -559,14 +554,14 @@ (TSP.FUNCTION.HOOKS) (DECLARE%: DONTCOPY - (FILEMAP (NIL (8270 15485 (TSP.DISPLAY.FMMENU 8280 . 8845) (TSP.SETUP.FILENAMES 8847 . 10098) ( -TSP.SETUP.FMMENU 10100 . 10560) (TSP.FMMENU 10562 . 11748) (TSP.FM.APPLY 11750 . 12069) (UPDATE.ALL -12071 . 12743) (DOWNDATE.ALL 12745 . 13115) (TSP.FUNCTION.HOOKS 13117 . 14547) (TSP.GETFN 14549 . -15109) (TSP.PUTFN 15111 . 15483)) (15531 17780 (AutoUpdate.TOGGLE 15541 . 15777) (UPDATE? 15779 . -15924) (NGROUP.Menu.TOGGLE 15926 . 16308) (NGROUPMENU.ENABLED? 16310 . 16546) ( -NGROUP.Text-Before.TOGGLE 16548 . 16798) (TEXTBEFORE.ENABLED? 16800 . 16963) (NGROUP.Text-After.TOGGLE - 16965 . 17213) (TEXTAFTER.ENABLED? 17215 . 17376) (Manual.Index.TOGGLE 17378 . 17617) ( -MANUALINDEX.ENABLED? 17619 . 17778)) (17814 23287 (GET.TSP.FONT 17824 . 18988) (GET.TSP.FONT.FAMILY -18990 . 19838) (GET.TSP.FONT.SIZE 19840 . 20328) (GET.TSP.FONT.FACE 20330 . 21029) (ABBREVIATE.FONT -21031 . 22531) (TMAX.SHADEOBJ 22533 . 23285)) (23327 24543 (TSP.LIST.OF.OBJECTS 23337 . 24541))))) + (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))))) STOP diff --git a/lispusers/tmax/TMAX-XREF b/lispusers/tmax/TMAX-XREF index e234f857..40348033 100644 --- a/lispusers/tmax/TMAX-XREF +++ b/lispusers/tmax/TMAX-XREF @@ -1,15 +1,14 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10) -(FILECREATED "18-Mar-2022 07:07:27"  -|{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;5| 23662 +(FILECREATED "26-Dec-2023 11:56:52" |{WMEDLEY}TMAX>TMAX-XREF.;4| 23618 - :CHANGES-TO (VARS TMAX-XREFCOMS) + :EDIT-BY |rmk| - :PREVIOUS-DATE "17-Mar-2022 23:36:37" -|{DSK}kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;4|) + :CHANGES-TO (FILES TMAX) + (FNS XREF.BUTTONEVENTINFN) + :PREVIOUS-DATE "15-Jul-2023 10:49:41" |{WMEDLEY}TMAX>TMAX-XREF.;3|) -; Copyright (c) 1987, 1997, 2000 by Xerox Corporation. (PRETTYCOMPRINT TMAX-XREFCOMS) @@ -155,12 +154,12 @@ (error "Unknown TARGET stream type" (imagestreamtype target.stream))))) (XREF.BUTTONEVENTINFN - (LAMBDA (XREFOBJ STREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) - (* \; "Edited 9-Nov-97 08:09 by rmk:") - (* |fsg| "29-Jul-87 16:43") + (LAMBDA (XREFOBJ STREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON) + (* \; "Edited 26-Dec-2023 11:56 by rmk") + (* \; "Edited 9-Nov-97 08:09 by rmk:") + (* |fsg| "29-Jul-87 16:43") - (* * |Show| |what| TAG |is| |being| |referenced| |and| |how| |it| |is| - |referenced.|) +(* |;;;| "Show what TAG is being referenced and how it is referenced.") (LET ((XREF.TAG (|fetch| OBJECTDATUM |of| XREFOBJ)) (XREF.DISPLAY (IMAGEOBJPROP XREFOBJ 'REFERENCE.BY))) @@ -179,16 +178,15 @@ (IMAGEOBJPROP XREFOBJ 'OBJECTDATUM)))) (IF DEF THEN (CL:WHEN (CDR DEF) - (TEDIT.PROMPTPRINT STREAM - "NOTE: Reference has multipled definitions!!" - T)) - (TEDIT.SETSEL HOSTSTREAM (CADR (CAR DEF)) - 1 - 'RIGHT NIL T 'INVERTED) - (AND NIL (TEDIT.SHOWSEL HOSTSTREAM T) - (TEDIT.NORMALIZECARET HOSTSTREAM)) - (RETFROM (FUNCTION TEDIT.SELECT.LINE.SCANNER) - (TEDIT.GETSEL HOSTSTREAM)) + (TEDIT.PROMPTPRINT STREAM + "NOTE: Reference has multipled definitions!!" T)) + (TEDIT.SETSEL HOSTSTREAM (CADR (CAR DEF)) + 1 + 'RIGHT NIL T 'INVERTED) + (AND NIL (TEDIT.SHOWSEL HOSTSTREAM T) + (TEDIT.NORMALIZECARET HOSTSTREAM)) + (RETFROM (FUNCTION \\TEDIT.SELECT.LINE.SCANNER) + (TEDIT.GETSEL HOSTSTREAM)) ELSE (TEDIT.PROMPTPRINT STREAM "Reference has not definition!" T)) NIL)) (|Change Reference| @@ -202,16 +200,17 @@ 'CHANGED)) NIL))))) -(xref.whendeletedfn - (lambda (imobj targ.window.stream source.str targ.str) (* |fsg| "29-Jul-87 16:35") - (* * |Note| |that| |this| |function| |is| not |called| |when| \a |Reference| - |is| |deleted.| i\t |is| |called| |when| \a |NGroup| |or| |Endnote| |is| - |deleted.|) +(XREF.WHENDELETEDFN + (LAMBDA (IMOBJ TARG.WINDOW.STREAM) (* \; "Edited 15-Jul-2023 10:48 by rmk") + (* |fsg| "29-Jul-87 16:35") - (tsp.putcode (imageobjprop imobj 'tag) - nil targ.window.stream) - (and (update? targ.window.stream) - (update.xrefs targ.window.stream)))) + (* |;;| "Note that this function is NOT called when a Reference is deleted. It is called when a NGroup or Endnote is deleted.") + + (LET ((WINDOW (\\TEDIT.MAINW TARG.WINDOW.STREAM))) + (TSP.PUTCODE (IMAGEOBJPROP IMOBJ 'TAG) + NIL WINDOW) + (AND (UPDATE? WINDOW) + (UPDATE.XREFS WINDOW))))) (XREF.TEDIT-TO-TEX-FN (LAMBDA (OBJ STREAM) @@ -476,16 +475,15 @@ (FILESLOAD (COMPILED SYSLOAD) TMAX) -(PUTPROPS TMAX-XREF COPYRIGHT ("Xerox Corporation" 1987 1997 2000)) (DECLARE\: DONTCOPY - (FILEMAP (NIL (3709 11045 (XREF 3719 . 4286) (XREFP 4288 . 4675) (XREF.DISPLAYFN 4677 . 5111) ( -XREF.IMAGEBOXFN 5113 . 5765) (XREF.PUTFN 5767 . 6013) (XREF.GETFN 6015 . 6489) (XREF.COPYFN 6491 . -7101) (XREF.BUTTONEVENTINFN 7103 . 10095) (XREF.WHENDELETEDFN 10097 . 10594) (XREF.TEDIT-TO-TEX-FN -10596 . 11043)) (11046 13030 (XREF.GET.DISPLAY.TEXT 11056 . 12340) (XREF.GET.TOOBJ 12342 . 12879) ( -TSPOBJ.GETTYPE 12881 . 13028)) (13031 19405 (UPDATE.XREFS 13041 . 15424) (INSERT.REF 15426 . 15838) ( -GET.REF 15840 . 16895) (GET.REFERENCE.BY 16897 . 17884) (TSP.LIST.REFS 17886 . 18338) (TSP.GET.INCODE -18340 . 18994) (TSP.GETCODEVAL 18996 . 19218) (TSP.PUTCODE 19220 . 19403)) (19497 20468 ( -XREF.ADD.DISPLAYFN 19507 . 20021) (XREF.GET.DISPLAYFN 20023 . 20466)) (20528 22890 ( -NGROUP.XREF.DISPLAYFN 20538 . 21498) (NGROUP.XREF.DISPLAY.TEXT 21500 . 22136) (NOTE.XREF.DISPLAYFN -22138 . 22888))))) + (FILEMAP (NIL (3650 11069 (XREF 3660 . 4227) (XREFP 4229 . 4616) (XREF.DISPLAYFN 4618 . 5052) ( +XREF.IMAGEBOXFN 5054 . 5706) (XREF.PUTFN 5708 . 5954) (XREF.GETFN 5956 . 6430) (XREF.COPYFN 6432 . +7042) (XREF.BUTTONEVENTINFN 7044 . 10042) (XREF.WHENDELETEDFN 10044 . 10618) (XREF.TEDIT-TO-TEX-FN +10620 . 11067)) (11070 13054 (XREF.GET.DISPLAY.TEXT 11080 . 12364) (XREF.GET.TOOBJ 12366 . 12903) ( +TSPOBJ.GETTYPE 12905 . 13052)) (13055 19429 (UPDATE.XREFS 13065 . 15448) (INSERT.REF 15450 . 15862) ( +GET.REF 15864 . 16919) (GET.REFERENCE.BY 16921 . 17908) (TSP.LIST.REFS 17910 . 18362) (TSP.GET.INCODE +18364 . 19018) (TSP.GETCODEVAL 19020 . 19242) (TSP.PUTCODE 19244 . 19427)) (19521 20492 ( +XREF.ADD.DISPLAYFN 19531 . 20045) (XREF.GET.DISPLAYFN 20047 . 20490)) (20552 22914 ( +NGROUP.XREF.DISPLAYFN 20562 . 21522) (NGROUP.XREF.DISPLAY.TEXT 21524 . 22160) (NOTE.XREF.DISPLAYFN +22162 . 22912))))) STOP diff --git a/lispusers/tmax/TMAX-XREF.LCOM b/lispusers/tmax/TMAX-XREF.LCOM index 4f707a56c0767ff144aeab3ecdbc0735c208bdc2..45c691c20f573c14acd94f874b2386afcd61edd4 100644 GIT binary patch delta 720 zcma))&2HL25XTK|C9;&NmD+1Ha(lq4Y~i&bu<4h<3mBQTgV%A8xTIha6hb0sPIbjA zRN~fGXr&&~SLvazQK|Q?U83X=solfO&d%=4{QlZs;n(of{ulC5cR3;(&5LK^V#bBVihk}uX*1(%#3OcX#eHm?g} zofx|W8=}CwWqegKfn8MMYOQJxQ^9P;}RTz!LAP(31mct@Jp_@C`Jg*)+dHhtU#`&=2 Z_5FdvcqVi9-^58EnD^yj;VyGr^arT{y08EM delta 789 zcmb_aON-M`6s|f-O^vuv5JWg!W|1rs@|ZT$j6^eO+D6+Z<}qZJaT+>h(j=r6W-!u~ zd!;-7g6`@cap~U>+gSA_s@cPT+FqzC{LnP8)PR@qRrxQ5?{!CQ=46ISB{oU=lR>q zRDY<4T3M?KTy zd>fb}-SvRlbi%NQ9t*1Dnn#vB4m_@dy8hEHw^SJiaUH7m)^~3Hx=quJxCg%8V`+w^ zKYf3+ep=tXb%S0VHYTetjUQ-zxc36QBId-jH-^XnZ h<03l;BP;T(h!)cwbR(L^U)EnqH|(9b@4~$IBNqFQno~>TGw=4 zD~cx2B&4AUL7A@5cml>78-s_y3oq3qUic3t^<@(eAT*$Wgv0|9$1$qP=7*o|Irsj4 z=i}bvAKut~{exu=6&Ss>$>g|P0r7J}E-&zVw9 zf9pyff8GcA zIQ~53hR0E7U52T>#DNE=lPq-}Y{F3XB($^8KM_e>0L#9R)Gv+?7HyjSCT>i;}Z zv1O}I(_8D?tu7$7S zw~_l3O)uC*blTyfEa1oJ9^lfXjyj?g%hZu(ic+Iir;)r;GcCK$ikgNwI_n|ud3p+8 zrz;Tx9eKs9qU*BJK=>iO7$78b*>LXJVIja^a_@Zs^Z79T zGQ;BEq7k^BGZ2BFoxtX-8YWOxwpk~NVj4E9h!q*(FJ>$FQ92x;5mnX9vZ$RCEttPx zwsL|v+c0ezinMgqfZ0IscY$O0QdR|3eEJlAlBGrnH*mkAPnir>85VZW%@^@~CIPGO MnW^3{%wK_j0XP*z4FCWD delta 1660 zcmah}OKclu5VoD9O*U`GX%eR?lWm&pHu1`jIFB`QvRMtpdG-69y^Fh{iNNf3ArKCRBM=IUkx?-kVS!^8*H+h83i%~iD*_A5^`t%b>a)vh ztNHkg8@b|3@s&b+HNRBI@5HZE&%(;)`u1jiV>7;SSb+> zi_xGM46?9AD-?EzmSCj_3@e$Y4Uc;Yg22L3ZVM?qDZ?nsGh8a8Dzc?Wj*m=%B$7Z5;{h$V zL0b(&I3nUeN5`K!y=R_2z7YA&{ezn!UwF=;{Kdnf-1GQKe9c#GH}h8A%ZNAX=1_iI zx8Kfip-B*R!_p)br^7R)!ine5kK8+{q3o<5a5E*b{#R-em^&zsm|>LljX$CMqj8Md zn*gQJ^x+`Gg(tvL(wbz=8HrgF#z4<%3B{tIoIYt>)X99)ATgWwFz9}BUv0Unr{!BL zQ95q*(n>$KT|3D*wkf0)@_~1fyx0B_T9>?X*_qt-zKc-r2vy*Xjst}Ay#ple>qPB& zALa9!FVVqpQIN8Zku~Y8EB$@xtEDBr?xfUPPf^$4slQMPT{r3&4x-~E=R1wK$ot8U zU2mX9Qy+BqqE<)Oy;&)Q+;?B$Sk4RSJ-OzK2}yc@)QxZhzau*jc~U{m)n_ zA&k`AQS>NwN~7MRBkbkZ=y8AUavv_&(59Sr5}S1Ud`B! zV59{6aEk2MQZN_{ftZ|NxC}(VNT`s3FqraLJVRh+6j?zn2=dHXNa5)ywv*B&D~%{r zMLf7-E|05L`qYKL!-#Z(o}afgl;Hq{FHme2JoBwBhd%j%!}PM>&rqi}7Z)7^M>cdB zA3kI>DXmnm)@ZcK0&if2PAF1Us{d3*{7I9qz1)Y1EHRcg3Z!vx=yIRi<*Jbm{mW%O z?QYlf6?L*Zcf25(rHye`xKw) zd~~%1MVAt)lAOYS_W5aY%=cl+KlzLgunB=Sp2F?~dezWn;k-<4x;vY>v}zeGy*=`K%ir4! Bt!n@P diff --git a/sources/SEDIT-COMMANDS.DATABASE b/sources/SEDIT-COMMANDS.DATABASE deleted file mode 100644 index 5ef573f4..00000000 --- a/sources/SEDIT-COMMANDS.DATABASE +++ /dev/null @@ -1 +0,0 @@ -(PROGN (PRIN1 "Use LOADDB to load database files! " T) (ERROR!)) ("22-Apr-2018 17:13:59" . {DSK}kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;2) FNS (SEDIT::PSEUDO-SELECTION-FROM-SELECTION SEDIT::COMPOSE-PSEUDO-SELECTION SEDIT::DECOMPOSE-PSEUDO-SELECTION SEDIT::SELECTION-FROM-PSEUDO-SELECTION SEDIT::SELECT-PSEUDO-SEGMENT SEDIT:ADD-COMMAND SEDIT:GET-SELECTION SEDIT:REPLACE-SELECTION SEDIT:RESET-COMMANDS SEDIT:DEFAULT-COMMANDS SEDIT::EQUALIZE-STRING-WIDTHS SEDIT::MINIMUM-STRING-WIDTH SEDIT::MAXIMUM-STRING-WIDTH SEDIT::FIND-AND-DISPLAY-STRUCTURE SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS SEDIT::FIND-NTH-STRUCTURE SEDIT::FIND-NODE-SUBSTRUCTURE SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS SEDIT::FIND-OBJ SEDIT::FIND-SELECTION SEDIT::FIND-SELECTION-BACKWARDS SEDIT::FIND-STRUCTURE SEDIT::FIND-STRUCTURE-BACKWARDS SEDIT::FIND-SUBSTRUCTURE SEDIT::FIND-SUBSTRUCTURE-BACKWARDS SEDIT::GET-USER-STRING SEDIT::SEARCH-OBJ SEDIT::SEARCH-OBJ-BACKWARDS SEDIT::SUBSTITUTE-OBJ SEDIT::SUBSTITUTE-STRUCTURE SEDIT::SUBSTITUTE-SUBSTRUCTURE SEDIT::STRUCTURE-FROM-SELECTION SEDIT::STRUCTURE-FROM-STRING SEDIT::COMMENT-OUT-SELECTION SEDIT::ADD-MENU SEDIT::BACKSPACE SEDIT::CHANGE-PACKAGE SEDIT::CHANGE-PRINTBASE SEDIT::CHANGE-QUOTE SEDIT::CONVERT-COMMENT SEDIT::CONVERT-COMMENT-STRUCTURE SEDIT::CONVERT-COMMENT-TAIL SEDIT::CREATE-COMMAND-TABLE SEDIT::DEFAULT-EDIT-FN SEDIT::DELETE-SELECTION SEDIT::DELETE-WORD SEDIT::DO-MUTATION SEDIT::EDIT-SELECTION SEDIT::EVAL-SELECTION SEDIT::EXPAND SEDIT::EXTRACT-CURRENT-SELECTION SEDIT::FIND-COMMENT SEDIT::GET-MENU SEDIT::EDIT-HELP SEDIT::HELPMENU SEDIT::INPUT-DOT SEDIT::INPUT-ESCAPE SEDIT::INPUT-NORMAL-CHAR SEDIT::INPUT-QUOTE SEDIT::INPUT-SQUARE-BRACKET SEDIT::INPUT-STRINGDELIM SEDIT::INPUT-TOKENDELIM SEDIT::INSERT-MULTI-ESCAPE SEDIT::INSERT-SPECIAL-CHARACTER SEDIT::INSPECT-SELECTION SEDIT::JOIN SEDIT::MENU-CLOSEFN SEDIT::MENU-FIND-SELECTEDFN SEDIT::MENU-INIT-STATE SEDIT::MENU-PACKAGE-SELECTEDFN SEDIT::MENU-PRINTBASE-SELECTEDFN SEDIT::MENU-SELECTEDFN SEDIT::MENU-SUBSTITUTE-SELECTEDFN SEDIT::MUTATE SEDIT::QUOTE-CURRENT-SELECTION SEDIT::REDISPLAY SEDIT::REDO SEDIT::SELECTED-FN-NAME SEDIT::SKIP-TO-GAP SEDIT::UNDO SEDIT::UNDO-EXTRACT) (READATABASE) ( CALL SEDIT::PSEUDO-SELECTION-FROM-SELECTION (SEDIT::COMPOSE-PSEUDO-SELECTION) SEDIT::COMPOSE-PSEUDO-SELECTION (LIST CL:FIRST + CL:1- CL:LENGTH) SEDIT::DECOMPOSE-PSEUDO-SELECTION ( CL:VALUES CL:FIRST CL:SECOND CL:THIRD) SEDIT::SELECTION-FROM-PSEUDO-SELECTION (CL:UNLESS CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION ) SEDIT::SELECT-PSEUDO-SEGMENT (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION SEDIT::SELECT-NODE-SEGMENT SEDIT::SELECT-NODE) SEDIT:ADD-COMMAND (CL:WHEN CL:COPY-TREE LIST NCONC) SEDIT:GET-SELECTION (CL:VALUES SEDIT::STRUCTURE-FROM-SELECTION) SEDIT:REPLACE-SELECTION (CL:UNLESS CL:ERROR CL:MAPCAR CL:FUNCTION SEDIT::PARSE-NEW CL:COPY-LIST SEDIT::SELECT-PSEUDO-SEGMENT SEDIT::COMPOSE-PSEUDO-SELECTION) SEDIT:RESET-COMMANDS ( SEDIT::CREATE-COMMAND-TABLE CL:FIRST CL:SECOND) SEDIT:DEFAULT-COMMANDS (CL:COPY-TREE SEDIT:RESET-COMMANDS ) SEDIT::EQUALIZE-STRING-WIDTHS (SEDIT::MAXIMUM-STRING-WIDTH CL:DO CHARWIDTH CL:CHAR-CODE CL:FIRST CL:CONCATENATE CL:MAKE-STRING CL:CEILING - STRINGWIDTH CL:REST) SEDIT::MINIMUM-STRING-WIDTH (CL:APPLY) SEDIT::MAXIMUM-STRING-WIDTH (CL:APPLY) SEDIT::FIND-AND-DISPLAY-STRUCTURE (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::FIND-STRUCTURE CL:FORMAT SEDIT::FIND-AND-DISPLAY-STRUCTURE) SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::FIND-STRUCTURE-BACKWARDS CL:FORMAT SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::FIND-SUBSTRUCTURE CL:FORMAT SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::FIND-SUBSTRUCTURE-BACKWARDS CL:FORMAT SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE) SEDIT::FIND-NTH-STRUCTURE (SEDIT::SUBNODE CL:DO SEDIT::FIND-STRUCTURE SEDIT::SELECT-NODE + SEDIT::NEXT-NODE ) SEDIT::FIND-NODE-SUBSTRUCTURE (CL:FIRST CL:DO CL:NTHCDR + CL:1- SEDIT::FIND-NODE-SUBSTRUCTURE CL:FUNCTION LIST CL:REST CL:1+) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (CL:FIRST CL:DO CL:NTHCDR - CL:REVERSE CL:1- SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS CL:FUNCTION LIST) SEDIT::FIND-OBJ ( SEDIT::CLOSE-OPEN-NODE SEDIT::CLOSE-NODE SEDIT::FIND-SELECTION-BACKWARDS SEDIT::FIND-SELECTION SEDIT::SEARCH-OBJ-BACKWARDS SEDIT::SEARCH-OBJ) SEDIT::FIND-SELECTION (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE SEDIT::STRUCTURE-FROM-SELECTION LIST CL:1+ SEDIT::NEXT-NODE SEDIT::FIND-AND-DISPLAY-STRUCTURE CL:FORMAT) SEDIT::FIND-SELECTION-BACKWARDS ( SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS SEDIT::STRUCTURE-FROM-SELECTION LIST CL:1- SEDIT::PREV-NODE SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CL:FORMAT) SEDIT::FIND-STRUCTURE (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION CL:DO* CL:1+ SEDIT::SUBNODE NTH CL:UNLESS SEDIT::NEXT-NODE) SEDIT::FIND-STRUCTURE-BACKWARDS (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION CL:DO* CL:1+ SEDIT::SUBNODE NTH CL:UNLESS SEDIT::PREV-NODE) SEDIT::FIND-SUBSTRUCTURE (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION SEDIT::FIND-NODE-SUBSTRUCTURE CL:LENGTH CL:DO) SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS CL:LENGTH CL:DO) SEDIT::GET-USER-STRING (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW TTYINPROMPTFORWORD) SEDIT::SEARCH-OBJ (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::STRUCTURE-FROM-STRING SEDIT::GET-USER-STRING SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::NEXT-NODE CL:1+ SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE SEDIT::FIND-AND-DISPLAY-STRUCTURE CL:FIRST) SEDIT::SEARCH-OBJ-BACKWARDS (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::STRUCTURE-FROM-STRING SEDIT::GET-USER-STRING SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE SEDIT::PREV-NODE CL:1+ CL:1- SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS CL:FIRST) SEDIT::SUBSTITUTE-OBJ (SEDIT::CLOSE-OPEN-NODE SEDIT::CLOSE-NODE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::PSEUDO-SELECTION-FROM-SELECTION CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::STRUCTURE-FROM-STRING SEDIT::GET-USER-STRING CL:VALUES SEDIT::SUBSTITUTE-SUBSTRUCTURE SEDIT::SUBSTITUTE-STRUCTURE CL:FIRST CL:FORMAT CL:WHEN SEDIT::SELECT-PSEUDO-SEGMENT) SEDIT::SUBSTITUTE-STRUCTURE (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION CL:LENGTH - REPLACEFIELD CONS FETCHFIELD CL:DO* SEDIT::FIND-STRUCTURE SEDIT::NEXT-NODE CL:MAPCAR CL:FUNCTION SEDIT::COLLECT-UNDO-BLOCK CL:VALUES CL:COPY-LIST SEDIT::SUBNODE NTH + CL:1- CL:THIRD CL:1+) SEDIT::SUBSTITUTE-SUBSTRUCTURE (CL:MULTIPLE-VALUE-BIND CL:MULTIPLE-VALUE-LIST CL:MULTIPLE-VALUE-CALL LIST SEDIT::DECOMPOSE-PSEUDO-SELECTION CL:LENGTH - REPLACEFIELD CONS FETCHFIELD CL:DO* SEDIT::FIND-SUBSTRUCTURE CL:MAPCAR CL:FUNCTION SEDIT::COLLECT-UNDO-BLOCK CL:VALUES CL:COPY-LIST + CL:THIRD CL:1+) SEDIT::STRUCTURE-FROM-SELECTION (CL:WHEN CL:NTHCDR CL:DO CL:NREVERSE CL:1+) SEDIT::STRUCTURE-FROM-STRING (CL:VALUES CL:WITH-INPUT-FROM-STRING CL:WITH-OPEN-STREAM CL:MAKE-STRING-INPUT-STREAM CL:MULTIPLE-VALUE-PROG1 .UNWIND.PROTECT. FUNCTION CL:DO LIST CL:READ CL:NREVERSE CL:1+) SEDIT::COMMENT-OUT-SELECTION (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW CL:WITH-OUTPUT-TO-STRING CL:MAKE-STRING-OUTPUT-STREAM CL:MULTIPLE-VALUE-PROG1 .UNWIND.PROTECT. FUNCTION NTH PLUS CL:GET-OUTPUT-STREAM-STRING CL:FORMAT CL:WHEN SEDIT::PARSE-NEW LIST REPLACEFIELD CONS FETCHFIELD SEDIT::END-UNDO-BLOCK SEDIT::COLLECT-UNDO-BLOCK) SEDIT::ADD-MENU (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW PRIN1 SEDIT::GET-MENU) SEDIT::BACKSPACE (SEDIT::BACKSPACE-QUOTE) SEDIT::CHANGE-PACKAGE (SEDIT::CLOSE-NODE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW U-CASE TTYINPROMPTFORWORD CL:FIND-PACKAGE CL:PACKAGE-NAME FM.CHANGELABEL WINDOWPROP CL:PACKAGE-USE-LIST PRIN1) SEDIT::CHANGE-PRINTBASE ( SEDIT::CLOSE-NODE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW TTYINPROMPTFORWORD FIXP NLSETQ READ OPENSTRINGSTREAM FM.CHANGESTATE WINDOWPROP PRIN1) SEDIT::CHANGE-QUOTE (SEDIT::QUOTE-WRAPPER LISTGET SEDIT::NOTE-CHANGE) SEDIT::CONVERT-COMMENT (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SUBNODE NTH REPLACEFIELD CONS FETCHFIELD SEDIT::FIND-COMMENT SEDIT::NEXT-NODE SEDIT::PARSE-NEW SEDIT::CONVERT-COMMENT-STRUCTURE PLUS SEDIT::COLLECT-UNDO-BLOCK PRIN1) SEDIT::CONVERT-COMMENT-STRUCTURE (EQMEMB CONS NCHARS LIST CONCATLIST SEDIT::CONVERT-COMMENT-TAIL) SEDIT::CONVERT-COMMENT-TAIL (LIST NTHCHARCODE) SEDIT::CREATE-COMMAND-TABLE (CL:MAKE-HASH-TABLE CL:FIRST LIST* CL:THIRD CL:REST LIST CL:SECOND KWOTE MAPC CL:GETHASH SEDIT::CHARCODE) SEDIT::DEFAULT-EDIT-FN (ED LIST*) SEDIT::DELETE-SELECTION (SEDIT::SET-SELECTION-NOWHERE) SEDIT::DELETE-WORD (SEDIT::CLOSE-NODE IDIFFERENCE ADD1 NTHCHARCODE SUB1 NCHARS CL:WHEN SEDIT::SET-SELECTION-NOWHERE) SEDIT::DO-MUTATION (NLSETQ CL:FUNCALL CL:WHEN SEDIT::PARSE-NEW) SEDIT::EDIT-SELECTION (SEDIT::GET-SELECTED-STRUCTURE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW) SEDIT::EVAL-SELECTION (SEDIT::GET-SELECTED-STRUCTURE CL:COPY-TREE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW FIND.PROCESS PRIN1 RESETFORM TTY.PROCESS PROCESS.EVAL BQUOTE LIST SEDIT::REPLACE-NODE SEDIT::PARSE-NEW PROCESS.EVALV printout PRIN2 INSPECT) SEDIT::EXPAND (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW PRIN1 NLSETQ EDITGETD printout SEDIT::REPLACE-NODE SEDIT::PARSE-NEW) SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::CLOSE-NODE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::SET-SELECTION-ME PRIN1 CL:THIRD CL:LOOP CL:MULTIPLE-VALUE-SETQ CL:READ-FROM-STRING CL:MAPCAR CL:FUNCTION CL:NREVERSE REPLACEFIELD CONS FETCHFIELD LIST COPY SEDIT::COLLECT-UNDO-BLOCK) SEDIT::FIND-COMMENT (CL:WHEN SEDIT::NEXT-NODE) SEDIT::GET-MENU (FREEMENU) SEDIT::EDIT-HELP ( SEDIT::CLOSE-NODE NCHARS SEDIT::INSERT SEDIT::SELECTED-FN-NAME SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW NLSETQ SMARTARGLIST STRINGWIDTH CONS WINDOWPROP PRIN1) SEDIT::HELPMENU (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW FONTCREATE CL:FIRST SEDIT::EQUALIZE-STRING-WIDTHS CL:SECOND CL:THIRD SEDIT::MINIMUM-STRING-WIDTH STRINGWIDTH CL:1- SEDIT::MAXIMUM-STRING-WIDTH + CL:NREVERSE CL:CONCATENATE STRING CL:REST CONS CL:WHEN MENU SEDIT::AWAKE-COMMAND-PROCESS) SEDIT::INPUT-DOT (CL:WHEN SEDIT::QUOTE-WRAPPER) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (PRIN1 CHARACTER IDIFFERENCE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::TYPE-OF-INPUT CONCAT SEDIT::ESCAPE-CHAR FETCHFIELD U-CASE L-CASE SEDIT::SET-SELECTION-NOWHERE) SEDIT::INPUT-QUOTE (SELECTQ SEDIT::TYPE-OF-INPUT SEDIT::CLOSE-NODE CL:WHEN SEDIT::QUOTE-WRAPPER CHCON1 NCHARS REPLACEFIELD CONS FETCHFIELD SEDIT::COLLECT-UNDO-BLOCK) SEDIT::INPUT-SQUARE-BRACKET (CL:WHEN SEDIT::TYPE-OF-INPUT SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW PRIN1) SEDIT::INPUT-STRINGDELIM (SEDIT::TYPE-OF-INPUT CL:WHEN ALLOCSTRING SEDIT::CREATE-SIMPLE-NODE) SEDIT::INPUT-TOKENDELIM (SEDIT::TYPE-OF-INPUT SEDIT::SET-SELECTION-NOWHERE CHARACTER) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::TYPE-OF-INPUT ALLOCSTRING NTHCHARCODE ADD1 PLUS FETCHFIELD REPLACEFIELD) SEDIT::INSERT-SPECIAL-CHARACTER (ALLOCSTRING SELECTQ SEDIT::TYPE-OF-INPUT) SEDIT::INSPECT-SELECTION (SEDIT::GET-SELECTED-STRUCTURE INSPECT printout PRIN1 SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW) SEDIT::JOIN (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW SEDIT::CLOSE-NODE PRIN1 SEDIT::SUBNODE NTH CONSTANT REPLACEFIELD CONS FETCHFIELD LIST PLUS printout SEDIT::PARSE-NEW CL:INTERN CONCATLIST CL:SYMBOL-PACKAGE SEDIT::INSERT NCONC IMAX APPLY* LAST ADD1 SEDIT::SET-POINT SEDIT::COLLECT-UNDO-BLOCK) SEDIT::MENU-CLOSEFN (CONS WINDOWPROP MAINWINDOW) SEDIT::MENU-FIND-SELECTEDFN (LISTGET FM.ITEMPROP WINDOWPROP MAINWINDOW FM.EDITITEM LIST TTY.PROCESS) SEDIT::MENU-INIT-STATE (CL:PACKAGE-NAME FM.GETITEM FM.ITEMPROP) SEDIT::MENU-PACKAGE-SELECTEDFN ( LISTGET FM.ITEMPROP FM.EDITITEM CL:FIND-PACKAGE SEDIT::MENU-SELECTEDFN LIST PRIN1 GETPROMPTWINDOW MAINWINDOW FM.CHANGELABEL) SEDIT::MENU-PRINTBASE-SELECTEDFN (LISTGET FM.ITEMPROP FM.EDITITEM SEDIT::MENU-SELECTEDFN LIST PRIN1 GETPROMPTWINDOW MAINWINDOW FM.CHANGESTATE) SEDIT::MENU-SELECTEDFN ( WINDOWPROP MAINWINDOW SEDIT::AWAKE-COMMAND-PROCESS APPEND SEDIT::LOOKUP-COMMAND CL:GETHASH FM.ITEMPROP ) SEDIT::MENU-SUBSTITUTE-SELECTEDFN (LISTGET FM.ITEMPROP WINDOWPROP MAINWINDOW FM.EDITITEM LIST TTY.PROCESS) SEDIT::MUTATE (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW TTYINPROMPTFORWORD NLSETQ READ OPENSTRINGSTREAM PRIN1) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::CLOSE-NODE SEDIT::CREATE-QUOTED-GAP REPLACEFIELD CONS FETCHFIELD SEDIT::SUBNODE SEDIT::END-UNDO-BLOCK SEDIT::COLLECT-UNDO-BLOCK) SEDIT::REDISPLAY (SEDIT::VERIFY-STRUCTURE) SEDIT::REDO (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW PRIN1) SEDIT::SELECTED-FN-NAME (SEDIT::CLOSE-NODE SEDIT::GET-SELECTED-STRUCTURE CL:WHEN) SEDIT::SKIP-TO-GAP (SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW printout PRIN1) SEDIT::UNDO (SEDIT::CLOSE-NODE SEDIT:GET-PROMPT-WINDOW GETPROMPTWINDOW PRIN1) SEDIT::UNDO-EXTRACT (PLUS SEDIT::NOTE-CHANGE) NIL BIND SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH (SEDIT::STRING-LIST SEDIT::FONT SEDIT::PRIN2?) SEDIT::MAXIMUM-STRING-WIDTH (SEDIT::STRING-LIST SEDIT::FONT SEDIT::PRIN2?) SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE (SEDIT::CHARCODE) SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ ( SEDIT::CHARCODE) SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (SEDIT::END-START) SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ (SEDIT::CHARCODE) SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::TSTART) SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION (SEDIT::CHARCODE) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE (SEDIT::CHARCODE) SEDIT::CHANGE-PRINTBASE (SEDIT::CHARCODE *PRINT-BASE*) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION ( SEDIT::CHARCODE) SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND (SEDIT::CHARCODE SEDIT::POINT) SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT (SEDIT::CONTEXT) SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE (SEDIT::CONTEXT) SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET (SEDIT::CHARCODE) SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN (SEDIT::CONTEXT) SEDIT::MENU-INIT-STATE (SEDIT::CONTEXT *PRINT-BASE*) SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN ( SEDIT::BUTTONS) SEDIT::MENU-SUBSTITUTE-SELECTEDFN (SEDIT::CONTEXT) SEDIT::MUTATE (SEDIT::POINT SEDIT::RESULT) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::CHARCODE) SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL NLAMBDA SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING (CHARCODE) SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (CL:UNWIND-PROTECT) SEDIT::COMMENT-OUT-SELECTION (CL:UNWIND-PROTECT) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE (CHARCODE) SEDIT::CHANGE-PRINTBASE (CHARCODE) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE (CHARCODE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM (CHARCODE) SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE (CHARCODE) SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL NOBIND SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE T SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL RECORD SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS (SEDIT::EDIT-ENV) SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE (SEDIT::EDIT-NODE) SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION (SEDIT::EDIT-CONTEXT) SEDIT::EVAL-SELECTION ( SEDIT::EDIT-CONTEXT) SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP (SEDIT::EDIT-NODE) SEDIT::HELPMENU NIL SEDIT::INPUT-DOT ( SEDIT::EDIT-SELECTION) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::EDIT-CONTEXT READTABLEP SEDIT::EDIT-NODE) SEDIT::INPUT-QUOTE (SEDIT::EDIT-NODE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::EDIT-SELECTION SEDIT::EDIT-CONTEXT) SEDIT::INPUT-TOKENDELIM ( SEDIT::EDIT-CONTEXT SEDIT::EDIT-SELECTION) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::EDIT-NODE) SEDIT::INSERT-SPECIAL-CHARACTER (SEDIT::EDIT-NODE) SEDIT::INSPECT-SELECTION (SEDIT::EDIT-CONTEXT) SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME (SEDIT::EDIT-NODE) SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL CREATE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::EDIT-SELECTION) SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU (MENU) SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL FETCH SEDIT::PSEUDO-SELECTION-FROM-SELECTION (SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END ) SEDIT::COMPOSE-PSEUDO-SELECTION (SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION (SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SELECT-START) SEDIT:REPLACE-SELECTION (SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-TYPE) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE (SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT) SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE (SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT) SEDIT::FIND-NTH-STRUCTURE (SEDIT::SUB-NODES SEDIT::ROOT) SEDIT::FIND-NODE-SUBSTRUCTURE (SEDIT::SUB-NODES CL:STRUCTURE) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (SEDIT::SUB-NODES CL:STRUCTURE) SEDIT::FIND-OBJ (SEDIT::OPEN-NODE-CHANGED? SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-TYPE) SEDIT::FIND-SELECTION (SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-START) SEDIT::FIND-SELECTION-BACKWARDS (SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END) SEDIT::FIND-STRUCTURE (CL:STRUCTURE SEDIT::DEPTH SEDIT::SUB-NODES SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) SEDIT::FIND-STRUCTURE-BACKWARDS (CL:STRUCTURE SEDIT::DEPTH SEDIT::SUB-NODES SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) SEDIT::FIND-SUBSTRUCTURE (SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) SEDIT::GET-USER-STRING (SEDIT::DISPLAY-WINDOW) SEDIT::SEARCH-OBJ (SEDIT::FIND-CANDIDATE SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT SEDIT::CARET-POINT SEDIT::POINT-TYPE SEDIT::POINT-NODE SEDIT::POINT-INDEX SEDIT::SELECTION SEDIT::SELECT-TYPE SEDIT::SELECT-NODE SEDIT::SELECT-START) SEDIT::SEARCH-OBJ-BACKWARDS (SEDIT::FIND-CANDIDATE SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::ROOT SEDIT::CARET-POINT SEDIT::POINT-TYPE SEDIT::POINT-NODE SEDIT::POINT-INDEX SEDIT::SELECTION SEDIT::SELECT-TYPE SEDIT::SELECT-NODE SEDIT::SELECT-END SEDIT::SELECT-START) SEDIT::SUBSTITUTE-OBJ ( SEDIT::OPEN-NODE-CHANGED? SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::FIND-CANDIDATE SEDIT::SUBSTITUTE-CANDIDATE) SEDIT::SUBSTITUTE-STRUCTURE (SEDIT::ROOT SEDIT::CARET-POINT SEDIT::SELECTION SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX SEDIT::SUB-NODES) SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::CARET-POINT SEDIT::SELECTION) SEDIT::STRUCTURE-FROM-SELECTION ( SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END SEDIT::SUB-NODES CL:STRUCTURE) SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION (SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-TYPE SEDIT::DISPLAY-WINDOW SEDIT::SUB-NODES SEDIT::SELECT-END CL:STRUCTURE) SEDIT::ADD-MENU (SEDIT::DISPLAY-WINDOW) SEDIT::BACKSPACE ( SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::BACK-SPACE SEDIT::NODE-TYPE SEDIT::POINT-INDEX SEDIT::POINT-STRING SEDIT::SELECT-NODE SEDIT::SUPER-NODE) SEDIT::CHANGE-PACKAGE (SEDIT::OPEN-NODE-CHANGED? SEDIT::DISPLAY-WINDOW SEDIT::PROFILE) SEDIT::CHANGE-PRINTBASE (SEDIT::OPEN-NODE-CHANGED? SEDIT::DISPLAY-WINDOW SEDIT::PROFILE) SEDIT::CHANGE-QUOTE (CL:STRUCTURE SEDIT::QUOTE-STRING SEDIT::ENVIRONMENT) SEDIT::CONVERT-COMMENT (SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-TYPE SEDIT::SUB-NODES SEDIT::SELECT-END SEDIT::SUB-NODE-INDEX SEDIT::DEPTH CL:STRUCTURE) SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION (SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END SEDIT::CARET-POINT SEDIT::SELECT-STRING SEDIT::NODE-TYPE) SEDIT::DELETE-WORD (SEDIT::OPEN-NODE-CHANGED? SEDIT::CARET-POINT SEDIT::SELECTION SEDIT::POINT-NODE SEDIT::POINT-INDEX SEDIT::POINT-STRING SEDIT::SELECT-NODE SEDIT::PENDING-DELETE? SEDIT::POINT-TYPE SEDIT::NODE-TYPE SEDIT::\X SEDIT::SUB-NODES ) SEDIT::DO-MUTATION (CL:STRUCTURE) SEDIT::EDIT-SELECTION (SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::DISPLAY-WINDOW) SEDIT::EVAL-SELECTION (SEDIT::EVAL-IN-PROCESS SEDIT::DISPLAY-WINDOW SEDIT::SELECT-NODE SEDIT::SELECTION) SEDIT::EXPAND (SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SELECT-START CL:STRUCTURE) SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::OPEN-NODE-CHANGED? SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::POINT-NODE SEDIT::POINT-TYPE SEDIT::SELECT-TYPE SEDIT::SELECT-START SEDIT::SELECT-END SEDIT::SUB-NODES SEDIT::NODE-TYPE CL:STRUCTURE) SEDIT::FIND-COMMENT (SEDIT::DEPTH SEDIT::SUB-NODE-INDEX CL:STRUCTURE) SEDIT::GET-MENU NIL SEDIT::EDIT-HELP ( SEDIT::OPEN-NODE-CHANGED? SEDIT::CARET-POINT SEDIT::POINT-NODE CL:STRUCTURE SEDIT::POINT-INDEX SEDIT::DISPLAY-WINDOW) SEDIT::HELPMENU (SEDIT::HELP-MENU SEDIT::ENVIRONMENT SEDIT::DISPLAY-WINDOW) SEDIT::INPUT-DOT (SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::SELECT-TYPE SEDIT::NODE-TYPE SEDIT::SELECT-START SEDIT::SELECT-NODE SEDIT::SUPER-NODE SEDIT::SELECT-END SEDIT::POINT-TYPE SEDIT::POINT-INDEX CL:STRUCTURE) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::DISPLAY-WINDOW SEDIT::CARET-POINT CASEINSENSITIVE SEDIT::POINT-NODE SEDIT::UNDO-LIST SEDIT::SELECT-NODE SEDIT::SELECTION ) SEDIT::INPUT-QUOTE (SEDIT::OPEN-NODE-CHANGED? SEDIT::SELECTION SEDIT::SELECT-NODE SEDIT::SUPER-NODE SEDIT::NODE-TYPE CL:STRUCTURE SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::POINT-INDEX SEDIT::POINT-STRING ) SEDIT::INPUT-SQUARE-BRACKET (SEDIT::DISPLAY-WINDOW) SEDIT::INPUT-STRINGDELIM (SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::SELECT-NODE SEDIT::NODE-TYPE SEDIT::SELECTION SEDIT::ENVIRONMENT SEDIT::DEFAULT-FONT SEDIT::DEPTH CL:STRUCTURE SEDIT::UNDO-LIST) SEDIT::INPUT-TOKENDELIM (SEDIT::CARET-POINT SEDIT::SELECTION SEDIT::PENDING-DELETE? SEDIT::POINT-NODE SEDIT::NODE-TYPE SEDIT::SELECT-NODE) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::POINT-STRING SEDIT::POINT-INDEX SEDIT::SELECT-NODE SEDIT::POINT-TYPE SEDIT::SELECTION) SEDIT::INSERT-SPECIAL-CHARACTER (SEDIT::CARET-POINT SEDIT::POINT-NODE SEDIT::SELECT-NODE SEDIT::SELECTION) SEDIT::INSPECT-SELECTION (SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::DISPLAY-WINDOW) SEDIT::JOIN (SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END SEDIT::OPEN-NODE-CHANGED? SEDIT::SELECT-TYPE SEDIT::NAME SEDIT::NODE-TYPE SEDIT::SUB-NODES CL:STRUCTURE SEDIT::UNASSIGNED) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN ( SEDIT::COMMAND-TABLE SEDIT::ENVIRONMENT) SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE ( SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SELECT-START) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::OPEN-NODE-CHANGED? SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SUB-NODES) SEDIT::REDISPLAY NIL SEDIT::REDO (SEDIT::UNDO-UNDO-LIST SEDIT::DISPLAY-WINDOW SEDIT::SELECTION SEDIT::CARET-POINT) SEDIT::SELECTED-FN-NAME (SEDIT::OPEN-NODE-CHANGED? SEDIT::CARET-POINT SEDIT::POINT-NODE CL:STRUCTURE) SEDIT::SKIP-TO-GAP ( SEDIT::SELECTION SEDIT::CARET-POINT SEDIT::DISPLAY-WINDOW SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::POINT-NODE SEDIT::POINT-TYPE SEDIT::POINT-INDEX) SEDIT::UNDO (SEDIT::OPEN-NODE-CHANGED? SEDIT::UNDO-LIST SEDIT::DISPLAY-WINDOW SEDIT::UNDO-UNDO-LIST SEDIT::SELECTION SEDIT::CARET-POINT) SEDIT::UNDO-EXTRACT (SEDIT::SUB-NODES SEDIT::DEPTH) NIL REPLACE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::SELECT-NODE SEDIT::SELECT-START SEDIT::SELECT-END) SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS (SEDIT::COMMAND-TABLE SEDIT::HELP-MENU) SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ (SEDIT::FIND-CANDIDATE) SEDIT::SEARCH-OBJ-BACKWARDS ( SEDIT::FIND-CANDIDATE) SEDIT::SUBSTITUTE-OBJ (SEDIT::FIND-CANDIDATE SEDIT::SUBSTITUTE-CANDIDATE) SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION (SEDIT::PENDING-DELETE?) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE ( SEDIT::UNASSIGNED) SEDIT::CONVERT-COMMENT (SEDIT::PENDING-DELETE?) SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION (SEDIT::EVAL-IN-PROCESS) SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION ( SEDIT::POINT-NODE SEDIT::POINT-TYPE SEDIT::PENDING-DELETE?) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU (SEDIT::HELP-MENU ITEMS ITEMWIDTH CHANGEOFFSETFLG MENUOFFSET TITLE) SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::ATOM-STARTED SEDIT::ATOM-STARTED-UNDO-POINTER) SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::POINT-NODE SEDIT::POINT-INDEX SEDIT::POINT-TYPE SEDIT::POINT-STRING SEDIT::ATOM-STARTED SEDIT::ATOM-STARTED-UNDO-POINTER) SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE (SEDIT::POINT-INDEX SEDIT::POINT-TYPE) SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (SEDIT::PENDING-DELETE?) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO ( SEDIT::UNDO-UNDO-LIST) SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO (SEDIT::UNDO-LIST SEDIT::UNDO-UNDO-LIST SEDIT::CHANGED-STRUCTURE?) SEDIT::UNDO-EXTRACT (SEDIT::SUPER-NODE SEDIT::SUB-NODE-INDEX) NIL REFFREE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND (SEDIT::COMMAND-TABLE-SPEC) SEDIT:GET-SELECTION ( :SUB-LIST) SEDIT:REPLACE-SELECTION (:SUB-LIST) SEDIT:RESET-COMMANDS (SEDIT::COMMAND-TABLE-SPEC) SEDIT:DEFAULT-COMMANDS (SEDIT::DEFAULT-COMMAND-TABLE-SPEC) SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ ( SEDIT:*WRAP-SEARCH*) SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE (SEDIT::TYPE-GAP SEDIT::TYPE-QUOTE) SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE (SEDIT::QUOTE-WRAPPER-LIST) SEDIT::CONVERT-COMMENT (SEDIT::COMMENT-MARKERS) SEDIT::CONVERT-COMMENT-STRUCTURE (COMMENTFLG SEDIT::LEVEL-3-COMMENT SEDIT:CONVERT-UPGRADE SEDIT::LEVEL-2-COMMENT SEDIT::LEVEL-1-COMMENT) SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN (:DISPLAY :DONTWAIT) SEDIT::DELETE-SELECTION (SEDIT::TYPE-GAP) SEDIT::DELETE-WORD (SEDIT::TYPE-COMMENT SEDIT::WORD-DELIM-CHARS SEDIT::TYPE-GAP) SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION (SEDIT:*EDIT-FN*) SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::TYPE-COMMENT :SEDIT-READ-END-FLG) SEDIT::FIND-COMMENT ( COMMENTFLG) SEDIT::GET-MENU (SEDIT::MENU-DESCRIPTION) SEDIT::EDIT-HELP (PROMPTWINDOW) SEDIT::HELPMENU (MENUFONT) SEDIT::INPUT-DOT (SEDIT::TYPE-QUOTE) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR ( *READTABLE* *PRINT-CASE*) SEDIT::INPUT-QUOTE (SEDIT::TYPE-GAP SEDIT::TYPE-QUOTE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::TYPE-STRING) SEDIT::INPUT-TOKENDELIM (SEDIT::TYPE-COMMENT) SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (SEDIT::COMMENT-MARKERS) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE (*PACKAGE* *PRINT-BASE*) SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::BASIC-GAP ) SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL REF SEDIT::PSEUDO-SELECTION-FROM-SELECTION (SEDIT::SEL) SEDIT::COMPOSE-PSEUDO-SELECTION (SEDIT::NODE) SEDIT::DECOMPOSE-PSEUDO-SELECTION (SEDIT::PSEL) SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::PSEL A0319 A0320 SEDIT::NODE SEDIT::START SEDIT::END) SEDIT::SELECT-PSEUDO-SEGMENT (SEDIT::PSEL A0321 A0322 SEDIT::CONTEXT SEDIT::NODE SEDIT::END SEDIT::SET-POINT? SEDIT::WHERE) SEDIT:ADD-COMMAND (SEDIT::FORM SEDIT::HELP-STRING SEDIT::SCROLL? SEDIT::KEY-CODE) SEDIT:GET-SELECTION (SEDIT::CONTEXT SEDIT::SELECTION ) SEDIT:REPLACE-SELECTION (SEDIT::SELECTION-TYPE SEDIT::CONTEXT SEDIT::SELECTION SEDIT::S CL:STRUCTURE SEDIT::POINT) SEDIT:RESET-COMMANDS (SEDIT::COMMANDS) SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS (SEDIT::STRING-LIST SEDIT::FONT SEDIT::PRIN2? SEDIT::PAD-CHAR SEDIT::DESIRED-WIDTH SEDIT::PAD-CHAR-WIDTH) SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE (SEDIT::CONTEXT SEDIT::STR SEDIT::SCOPE SEDIT::TOP SEDIT::PROMPTWINDOW) SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (SEDIT::CONTEXT SEDIT::STR SEDIT::SCOPE SEDIT::TOP SEDIT::PROMPTWINDOW) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE (SEDIT::CONTEXT SEDIT::STR SEDIT::SCOPE SEDIT::TOP SEDIT::PROMPTWINDOW) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (SEDIT::CONTEXT SEDIT::STR SEDIT::SCOPE SEDIT::TOP SEDIT::PROMPTWINDOW) SEDIT::FIND-NTH-STRUCTURE (SEDIT::CONTEXT CL:STRUCTURE SEDIT::TOP SEDIT::N) SEDIT::FIND-NODE-SUBSTRUCTURE (SEDIT::NODE SEDIT::SUBNODES SEDIT::STRLEN SEDIT::STR SEDIT::LASTINDEX SEDIT::S SEDIT::N) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (SEDIT::NODE SEDIT::SUBNODES SEDIT::SUBLENGTH SEDIT::STRLEN SEDIT::STR SEDIT::S SEDIT::N) SEDIT::FIND-OBJ ( SEDIT::CONTEXT SEDIT::SELECTION SEDIT::WRAP?) SEDIT::FIND-SELECTION (SEDIT::CONTEXT SEDIT::SELECTION SEDIT::NODE SEDIT::PROMPTWINDOW) SEDIT::FIND-SELECTION-BACKWARDS (SEDIT::CONTEXT SEDIT::SELECTION SEDIT::NODE SEDIT::PROMPTWINDOW) SEDIT::FIND-STRUCTURE (SEDIT::SCOPE A0325 A0327 SEDIT::START A0328 SEDIT::SCOPE-NODE SEDIT::STR SEDIT::MIN-DEPTH) SEDIT::FIND-STRUCTURE-BACKWARDS (SEDIT::SCOPE A0329 A0332 SEDIT::END A0333 A0334 SEDIT::SCOPE-NODE SEDIT::STR SEDIT::MIN-DEPTH) SEDIT::FIND-SUBSTRUCTURE ( SEDIT::SCOPE A0335 A0337 A0338 SEDIT::STR SEDIT::SCOPE-NODE SEDIT::SCOPE-START SEDIT::SCOPE-END SEDIT::START-START SEDIT::STRLEN) SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (SEDIT::SCOPE A0339 A0342 A0343 A0344 SEDIT::STR SEDIT::SCOPE-NODE SEDIT::SCOPE-START SEDIT::SCOPE-END SEDIT::END-END SEDIT::STRLEN) SEDIT::GET-USER-STRING (SEDIT::CONTEXT SEDIT::PROMPTWINDOW SEDIT::PROMPT SEDIT::DEFAULT) SEDIT::SEARCH-OBJ (A0345 SEDIT::STRLEN SEDIT::POINT SEDIT::SELECTION SEDIT::POINT-NODE SEDIT::POINT-TYPE SEDIT::POINT-INDEX SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SCOPE SEDIT::STR) SEDIT::SEARCH-OBJ-BACKWARDS (A0346 SEDIT::STRLEN SEDIT::POINT SEDIT::SELECTION SEDIT::POINT-NODE SEDIT::POINT-TYPE SEDIT::POINT-INDEX SEDIT::SELECT-NODE SEDIT::SELECT-TYPE SEDIT::SELECT-END SEDIT::SCOPE SEDIT::STR) SEDIT::SUBSTITUTE-OBJ (SEDIT::SELECTION SEDIT::PROMPTWINDOW TYPE A0347 SEDIT::OLDLEN A0348 SEDIT::NEWLEN SEDIT::OLD SEDIT::NEW A0349 SEDIT::SUBCOUNT) SEDIT::SUBSTITUTE-STRUCTURE (A0350 A0351 SEDIT::CONTEXT SEDIT::NEW SEDIT::NEWLEN SEDIT::OLD SEDIT::S SEDIT::POINT SEDIT::SELECTION SEDIT::ROOT SEDIT::SCOPE-NODE SEDIT::DELTA-LENGTH SEDIT::N) SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::SCOPE A0352 A0353 SEDIT::CONTEXT SEDIT::NEW SEDIT::NEWLEN SEDIT::OLD SEDIT::S SEDIT::POINT SEDIT::SELECTION A0356 A0357 SEDIT::TNODE SEDIT::SCOPE-NODE SEDIT::TEND SEDIT::DELTA-LENGTH SEDIT::N) SEDIT::STRUCTURE-FROM-SELECTION (SEDIT::SELECTION SEDIT::NODE SEDIT::END ) SEDIT::STRUCTURE-FROM-STRING (CL::$STRING$ CL::$START$ SEDIT::S SEDIT::EOF) SEDIT::COMMENT-OUT-SELECTION (SEDIT::CONTEXT SEDIT::S SEDIT::POINT SEDIT::NEW-NODE) SEDIT::ADD-MENU (SEDIT::CONTEXT SEDIT::WINDOW SEDIT::PROMPTWINDOW) SEDIT::BACKSPACE (SEDIT::CONTEXT SEDIT::POINT SEDIT::SELECTION) SEDIT::CHANGE-PACKAGE (SEDIT::CONTEXT SEDIT::PROMPTWINDOW SEDIT::WINDOW) SEDIT::CHANGE-PRINTBASE (SEDIT::CONTEXT SEDIT::PROMPTWINDOW) SEDIT::CHANGE-QUOTE (SEDIT::QUOTE-TYPE SEDIT::CONTEXT) SEDIT::CONVERT-COMMENT ( SEDIT::CONTEXT SEDIT::DEPTH SEDIT::PROMPTWINDOW SEDIT::POINT) SEDIT::CONVERT-COMMENT-STRUCTURE (SEDIT::EXPR ) SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE (SEDIT::DESCRIPTION SEDIT::COMMAND SEDIT::KEY SEDIT::TABLE) SEDIT::DEFAULT-EDIT-FN (SEDIT::OBJ SEDIT::OPTIONS) SEDIT::DELETE-SELECTION (SEDIT::CONTEXT SEDIT::SELECTION) SEDIT::DELETE-WORD (SEDIT::CONTEXT SEDIT::POINT SEDIT::SELECTION SEDIT::END STRING) SEDIT::DO-MUTATION (SEDIT::MUTATOR SEDIT::NODE SEDIT::CONTEXT) SEDIT::EDIT-SELECTION (SEDIT::CONTEXT SEDIT::OPTIONS) SEDIT::EVAL-SELECTION (SEDIT::PROMPTWINDOW SEDIT::STRUCTURE-COPY) SEDIT::EXPAND ( SEDIT::CONTEXT SEDIT::SELECTION CL:STRUCTURE SEDIT::PROMPTWINDOW) SEDIT::EXTRACT-CURRENT-SELECTION ( SEDIT::CONTEXT SEDIT::PROMPTWINDOW STRING SEDIT::S) SEDIT::FIND-COMMENT (SEDIT::MIN-DEPTH SEDIT::LAST-SUBNODE SEDIT::COMMENTCHAR) SEDIT::GET-MENU (SEDIT::CONTEXT) SEDIT::EDIT-HELP (SEDIT::CONTEXT SEDIT::POINT SEDIT::NODE SEDIT::PROMPTWINDOW) SEDIT::HELPMENU (SEDIT::CONTEXT SEDIT::PROMPTWINDOW SEDIT::FONT SEDIT::TAB-WIDTH SEDIT::LEFT-WIDTH SEDIT::MENU-RIGHT SEDIT::MENU-ITEMS) SEDIT::INPUT-DOT ( SEDIT::CONTEXT SEDIT::POINT SEDIT::SELECTION SEDIT::CHARCODE SEDIT::SUPER-NODE) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR ($$OUTPUT SEDIT::POINT-TYPE SEDIT::POINT) SEDIT::INPUT-QUOTE (SEDIT::CONTEXT SEDIT::QUOTE-TYPE SEDIT::SELECTION SEDIT::CHARCODE SEDIT::POINT) SEDIT::INPUT-SQUARE-BRACKET ( SEDIT::CONTEXT SEDIT::PROMPTWINDOW) SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM (SEDIT::CONTEXT SEDIT::POINT SEDIT::CHARCODE SEDIT::POINTNODE) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::CONTEXT TYPE CL:CHAR ) SEDIT::INSERT-SPECIAL-CHARACTER (SEDIT::CONTEXT CL:CHAR SEDIT::POINT STRING) SEDIT::INSPECT-SELECTION (SEDIT::CONTEXT $$OUTPUT) SEDIT::JOIN (SEDIT::CONTEXT SEDIT::PROMPTWINDOW SEDIT::POINT) SEDIT::MENU-CLOSEFN (SEDIT::W) SEDIT::MENU-FIND-SELECTEDFN (SEDIT::ITEM SEDIT::WINDOW SEDIT::FIND-ITEM SEDIT::BUTTONS) SEDIT::MENU-INIT-STATE (SEDIT::PRINT-BASE SEDIT::MENU CL:PACKAGE-NAME) SEDIT::MENU-PACKAGE-SELECTEDFN (SEDIT::ITEM SEDIT::PACKAGE-NAME-ITEM CL:PACKAGE-NAME SEDIT::BUTTONS SEDIT::WINDOW $$OUTPUT) SEDIT::MENU-PRINTBASE-SELECTEDFN (SEDIT::ITEM SEDIT::PRINTBASE-VALUE-ITEM SEDIT::BUTTONS SEDIT::WINDOW $$OUTPUT) SEDIT::MENU-SELECTEDFN (SEDIT::WINDOW SEDIT::CONTEXT SEDIT::COMMAND SEDIT::ITEM SEDIT::EXTRA-ARGS) SEDIT::MENU-SUBSTITUTE-SELECTEDFN (SEDIT::ITEM SEDIT::WINDOW SEDIT::FIND-ITEM SEDIT::SUBITEM SEDIT::BUTTONS) SEDIT::MUTATE (SEDIT::CONTEXT SEDIT::SELECTION SEDIT::PROMPTWINDOW) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::CONTEXT SEDIT::SELECTION SEDIT::QUOTE-TYPE SEDIT::POINT) SEDIT::REDISPLAY (SEDIT::CONTEXT) SEDIT::REDO (SEDIT::PROMPTWINDOW) SEDIT::SELECTED-FN-NAME (SEDIT::CONTEXT SEDIT::POINT SEDIT::NODE) SEDIT::SKIP-TO-GAP (SEDIT::CONTEXT SEDIT::SELECTION SEDIT::PROMPTWINDOW SEDIT::POINT) SEDIT::UNDO (SEDIT::PROMPTWINDOW) SEDIT::UNDO-EXTRACT (SEDIT::NODE SEDIT::SUBNODES SEDIT::CONTEXT) NIL SETFREE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND (SEDIT::DEFAULT-COMMAND-TABLE-SPEC SEDIT::FIRST-ADD-COMMAND SEDIT::FIRST-ADD-COMMAND-MENU-ENTRY) SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS (SEDIT::COMMAND-TABLE-SPEC SEDIT::FIRST-ADD-COMMAND-MENU-ENTRY) SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ (SEDIT::FIND-CANDIDATE) SEDIT::SEARCH-OBJ-BACKWARDS ( SEDIT::FIND-CANDIDATE) SEDIT::SUBSTITUTE-OBJ (SEDIT::FIND-CANDIDATE SEDIT::SUBSTITUTE-CANDIDATE) SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE (SEDIT::PACKAGE-CANDIDATE *PACKAGE*) SEDIT::CHANGE-PRINTBASE ( SEDIT::PRINTBASE-CANDIDATE *PRINT-BASE* *PRINT-RADIX*) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU (SEDIT::MENUS) SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE (SEDIT::THIS-CHAR-ESCAPED) SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN (SEDIT::MENUS) SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE (SEDIT::MUTATE-CANDIDATE) SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL SET SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::SEL) SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION (SEDIT::NEW-NODES) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS (SEDIT::STR) SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE (SEDIT::M SEDIT::TARGET) SEDIT::FIND-NODE-SUBSTRUCTURE (SEDIT::START SEDIT::MATCH SEDIT::SUBS SEDIT::INDEX SEDIT::ENDINDEX SEDIT::DOSUBS?) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS ( SEDIT::END SEDIT::MATCH SEDIT::SUBS SEDIT::INDEX SEDIT::STARTINDEX SEDIT::DOSUBS?) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION (SEDIT::START) SEDIT::FIND-SELECTION-BACKWARDS (SEDIT::END) SEDIT::FIND-STRUCTURE (SEDIT::NODE) SEDIT::FIND-STRUCTURE-BACKWARDS (SEDIT::NODE) SEDIT::FIND-SUBSTRUCTURE (SEDIT::MATCH SEDIT::NODE SEDIT::SUPER-NODE SEDIT::NODE-INDEX SEDIT::CONTINUATION? SEDIT::START SEDIT::END) SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (SEDIT::MATCH SEDIT::NODE SEDIT::SUPER-NODE SEDIT::NODE-INDEX SEDIT::CONTINUATION? SEDIT::END SEDIT::START) SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ ( SEDIT::SEARCH-STRING) SEDIT::SEARCH-OBJ-BACKWARDS (SEDIT::SEARCH-STRING) SEDIT::SUBSTITUTE-OBJ ( SEDIT::SCOPE SEDIT::OLDSTR SEDIT::NEWSTR) SEDIT::SUBSTITUTE-STRUCTURE (SEDIT::SCOPE SEDIT::RESUME SEDIT::SCOPE-END SEDIT::TARGET SEDIT::TARGET-SUPER SEDIT::TARGET-INDEX SEDIT::NEW-NODES SEDIT::NUMSUBS ) SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::RESUME SEDIT::SCOPE-END SEDIT::TARGET SEDIT::NEW-NODES SEDIT::NUMSUBS) SEDIT::STRUCTURE-FROM-SELECTION (SEDIT::SUBNODES CL:STRUCTURE SEDIT::INDEX) SEDIT::STRUCTURE-FROM-STRING (SEDIT::VAL SEDIT::RESULTS CL:COUNT A0358) SEDIT::COMMENT-OUT-SELECTION ( SEDIT::X SEDIT::BLANK-BEFORE SEDIT::I A0359) SEDIT::ADD-MENU (SEDIT::MENU) SEDIT::BACKSPACE (SEDIT::NODE ) SEDIT::CHANGE-PACKAGE (SEDIT::NEW-PACKAGE-NAME SEDIT::NEW-PACKAGE) SEDIT::CHANGE-PRINTBASE ( SEDIT::NEW-PRINTBASE-STRING SEDIT::NEW-PRINTBASE) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT ( SEDIT::NODE SEDIT::SELECT-END SEDIT::NEXT-NODE SEDIT::NEW-NODE SEDIT::NUMBER-OF-COMMENTS) SEDIT::CONVERT-COMMENT-STRUCTURE (SEDIT::COMTAIL SEDIT::2-STARS SEDIT::COMCHAR) SEDIT::CONVERT-COMMENT-TAIL (SEDIT::NSPACES X SEDIT::TAIL) SEDIT::CREATE-COMMAND-TABLE (SEDIT::FN SEDIT::ENTRY SEDIT::MENU-LEFT SEDIT::MENU-RIGHT SEDIT::MENU-ITEMS) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD (SEDIT::START) SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION (SEDIT::PROCESS SEDIT::VALUE) SEDIT::EXPAND (SEDIT::EXPANSION) SEDIT::EXTRACT-CURRENT-SELECTION ( SEDIT::NODE CL:STRUCTURE SEDIT::START SEDIT::NEW-STRUCTURES SEDIT::SUBNODES SEDIT::SET-SELECTION?) SEDIT::FIND-COMMENT (SEDIT::NODE) SEDIT::GET-MENU (SEDIT::MENU) SEDIT::EDIT-HELP (SEDIT::ARGS) SEDIT::HELPMENU (SEDIT::EQUALIZED-MENU-LEFT SEDIT::TAB-COLUMN SEDIT::ITEMWIDTH SEDIT::ITEMS SEDIT::LEFT SEDIT::RIGHT SEDIT::ITEM SEDIT::MENU SEDIT::COMMAND) SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (CL:CHAR WHERE SEDIT::NODE) SEDIT::INPUT-QUOTE (SEDIT::SUPER-NODE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::NODE SEDIT::NEW-STRING) SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE (SEDIT::NODE WHERE) SEDIT::INSERT-SPECIAL-CHARACTER (WHERE SEDIT::NODE) SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (TYPE SEDIT::SUBNODES SEDIT::NEW-STRUCTURE SEDIT::SUBNODE SEDIT::INDEX SEDIT::NEW-NODE SEDIT::COMMENT-LEVEL) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN (PACKAGE) SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE (SEDIT::MUTATOR-STRING SEDIT::MUTATOR) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::QUOTE-NODE ) SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME (CL:STRUCTURE) SEDIT::SKIP-TO-GAP ( SEDIT::NODE) SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT (SEDIT::SUBNODE SEDIT::INDEX) NIL SMASHFREE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS (SEDIT::LISP-EDIT-ENVIRONMENT) SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL SMASH SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::SEL) SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ (SEDIT::CONTEXT) SEDIT::SEARCH-OBJ-BACKWARDS ( SEDIT::CONTEXT) SEDIT::SUBSTITUTE-OBJ (SEDIT::CONTEXT) SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION (SEDIT::SELECTION) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE (SEDIT::QUOTE-NODE) SEDIT::CONVERT-COMMENT (SEDIT::SELECTION) SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL (STREAM) SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION ( SEDIT::CONTEXT) SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::POINT SEDIT::SELECTION) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::CONTEXT) SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::POINT SEDIT::CONTEXT) SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE (SEDIT::POINT) SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (SEDIT::SELECTION) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO (SEDIT::CONTEXT) SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO (SEDIT::CONTEXT) SEDIT::UNDO-EXTRACT ( SEDIT::SUBNODE) NIL PROP SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU (SEDIT::MENU REJECTMAINCOMS RESHAPEFN) SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE (SEDIT::MENU) SEDIT::CHANGE-PRINTBASE (SEDIT::MENU) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU (CLOSEFN FM.DONTRESHAPE) SEDIT::EDIT-HELP (WIDTH) SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN (SEDIT::MENU) SEDIT::MENU-FIND-SELECTEDFN (EDIT SEDIT::EDIT-CONTEXT PROCESS) SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN (EDIT) SEDIT::MENU-PRINTBASE-SELECTEDFN ( EDIT) SEDIT::MENU-SELECTEDFN (SEDIT::EDIT-CONTEXT) SEDIT::MENU-SUBSTITUTE-SELECTEDFN (SEDIT::FINDITEM EDIT SEDIT::EDIT-CONTEXT PROCESS) SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL TEST SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION (SEDIT::START SEDIT::END ) SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION (SEDIT::SEL) SEDIT::SELECT-PSEUDO-SEGMENT (SEDIT::START) SEDIT:ADD-COMMAND (SEDIT::KEY-NAME SEDIT::COMMAND-NAME) SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS (SEDIT::STR) SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE (SEDIT::TARGET SEDIT::WRAP? SEDIT::START) SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS (SEDIT::TARGET SEDIT::WRAP? SEDIT::END) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE (SEDIT::TARGET SEDIT::WRAP? SEDIT::START) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (SEDIT::TARGET SEDIT::WRAP? SEDIT::END) SEDIT::FIND-NTH-STRUCTURE (SEDIT::TARGET) SEDIT::FIND-NODE-SUBSTRUCTURE (SEDIT::CONTINUATION? SEDIT::SUBS SEDIT::END SEDIT::DOSUBS?) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (SEDIT::CONTINUATION? SEDIT::SUBS SEDIT::START SEDIT::DOSUBS?) SEDIT::FIND-OBJ (SEDIT::FIND-STRING SEDIT::BACKWARDS?) SEDIT::FIND-SELECTION (SEDIT::START SEDIT::WRAP?) SEDIT::FIND-SELECTION-BACKWARDS (SEDIT::END SEDIT::WRAP?) SEDIT::FIND-STRUCTURE (SEDIT::SCOPE-START SEDIT::START-NODE SEDIT::START-START SEDIT::NODE SEDIT::SCOPE-END ) SEDIT::FIND-STRUCTURE-BACKWARDS (SEDIT::SCOPE-START SEDIT::END-NODE SEDIT::END-START SEDIT::END-END SEDIT::SCOPE-END SEDIT::NODE) SEDIT::FIND-SUBSTRUCTURE (SEDIT::START-NODE SEDIT::NODE) SEDIT::FIND-SUBSTRUCTURE-BACKWARDS (SEDIT::END-NODE SEDIT::NODE) SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ (SEDIT::SELECT-START SEDIT::WRAP? SEDIT::START) SEDIT::SEARCH-OBJ-BACKWARDS (SEDIT::WRAP? SEDIT::END) SEDIT::SUBSTITUTE-OBJ (SEDIT::REMOVE? SEDIT::NEW-SCOPE) SEDIT::SUBSTITUTE-STRUCTURE ( SEDIT::REMOVE? SEDIT::TARGET SEDIT::SCOPE-START SEDIT::RESUME) SEDIT::SUBSTITUTE-SUBSTRUCTURE ( SEDIT::REMOVE? SEDIT::TARGET SEDIT::SCOPE-START SEDIT::RESUME) SEDIT::STRUCTURE-FROM-SELECTION ( SEDIT::START) SEDIT::STRUCTURE-FROM-STRING (SEDIT::STR) SEDIT::COMMENT-OUT-SELECTION (SEDIT::NODE SEDIT::START SEDIT::BLANK-BEFORE SEDIT::STR) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE (SEDIT::NODE) SEDIT::CHANGE-PACKAGE (SEDIT::NEW-PACKAGE SEDIT::NEW-PACKAGE-NAME) SEDIT::CHANGE-PRINTBASE ( SEDIT::NEW-PRINTBASE) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT (SEDIT::NODE SEDIT::START) SEDIT::CONVERT-COMMENT-STRUCTURE (SEDIT::2-STARS) SEDIT::CONVERT-COMMENT-TAIL (SEDIT::TAIL) SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD (SEDIT::NODE) SEDIT::DO-MUTATION (SEDIT::RESULT) SEDIT::EDIT-SELECTION (CL:STRUCTURE) SEDIT::EVAL-SELECTION (CL:STRUCTURE SEDIT::VALUE) SEDIT::EXPAND (SEDIT::NODE SEDIT::EXPANSION) SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::NODE SEDIT::SET-SELECTION?) SEDIT::FIND-COMMENT (SEDIT::NODE) SEDIT::GET-MENU NIL SEDIT::EDIT-HELP (SEDIT::FNAME) SEDIT::HELPMENU (SEDIT::ITEM) SEDIT::INPUT-DOT ( SEDIT::NODE) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE (SEDIT::NODE SEDIT::SUPER-NODE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE (WHERE) SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION ( CL:STRUCTURE) SEDIT::JOIN (SEDIT::NODE SEDIT::START SEDIT::END SEDIT::NEW-STRUCTURE SEDIT::NEW-NODE) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN (SEDIT::PRINT-BASE) SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE (SEDIT::NODE SEDIT::MUTATOR ) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::NODE) SEDIT::REDISPLAY NIL SEDIT::REDO (SEDIT::UNDO-UNDO-LIST ) SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO (SEDIT::UNDO-LIST) SEDIT::UNDO-EXTRACT NIL NIL TESTFREE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND (SEDIT::FIRST-ADD-COMMAND SEDIT::FIRST-ADD-COMMAND-MENU-ENTRY) SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::THIS-CHAR-ESCAPED) SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL PREDICATE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION (CL:LISTP) SEDIT::DECOMPOSE-PSEUDO-SELECTION (CL:LISTP) SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE (=) SEDIT::FIND-NODE-SUBSTRUCTURE (> CL:MISMATCH) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (< CL:MISMATCH) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE (EQUAL < >) SEDIT::FIND-STRUCTURE-BACKWARDS (EQUAL <) SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ (< = TYPEP >) SEDIT::SEARCH-OBJ-BACKWARDS (< = TYPEP >) SEDIT::SUBSTITUTE-OBJ (< = > EQL) SEDIT::SUBSTITUTE-STRUCTURE (=) SEDIT::SUBSTITUTE-SUBSTRUCTURE (=) SEDIT::STRUCTURE-FROM-SELECTION (<= >) SEDIT::STRUCTURE-FROM-STRING (CL:STRINGP NLSETQ) SEDIT::COMMENT-OUT-SELECTION (GREATERP) SEDIT::ADD-MENU (WINDOWPROP) SEDIT::BACKSPACE (TYPENAMEP) SEDIT::CHANGE-PACKAGE (STRINGP CL:MEMBER) SEDIT::CHANGE-PRINTBASE (STRINGP IGREATERP ILEQ ) SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT (FMEMB) SEDIT::CONVERT-COMMENT-STRUCTURE (FMEMB STRINGP IGEQ) SEDIT::CONVERT-COMMENT-TAIL (STRINGP) SEDIT::CREATE-COMMAND-TABLE (CL:CONSP) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD (IGREATERP FMEMB) SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION (CL:FUNCALL) SEDIT::EVAL-SELECTION (PROCESSP CL:EQUAL NUMBERP ATOM STRINGP) SEDIT::EXPAND (CL:CONSP CL:EQUAL) SEDIT::EXTRACT-CURRENT-SELECTION (NLSETQ) SEDIT::FIND-COMMENT (ILESSP IGREATERP) SEDIT::GET-MENU NIL SEDIT::EDIT-HELP (TYPENAMEP LITATOM ILEQ) SEDIT::HELPMENU (CL:LISTP > =) SEDIT::INPUT-DOT (TYPENAMEP) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (IGREATERP ILESSP TYPENAMEP) SEDIT::INPUT-QUOTE (FMEMB TYPENAMEP) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (TYPENAMEP SEDIT::DEAD-NODE?) SEDIT::INPUT-TOKENDELIM (SEDIT::EQ-POINT-TYPE TYPENAMEP) SEDIT::INSERT-MULTI-ESCAPE (TYPENAMEP) SEDIT::INSERT-SPECIAL-CHARACTER (TYPENAMEP) SEDIT::INSPECT-SELECTION (NLSETQ) SEDIT::JOIN (FMEMB GREATERP NUMBERP) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN (EQUAL) SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN (EQUAL) SEDIT::MENU-PRINTBASE-SELECTEDFN (IGREATERP ILEQ) SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN (EQUAL) SEDIT::MUTATE (STRINGP SEDIT::DO-MUTATION) SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME (TYPENAMEP ATOM) SEDIT::SKIP-TO-GAP (SEDIT::SELECT-NEXT-GAP) SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL EFFECT SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION (HELP) SEDIT:REPLACE-SELECTION (SEDIT::PENDING-DELETE SEDIT::INSERT) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE (SEDIT::SELECT-NODE) SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS ( SEDIT::SELECT-NODE) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE (SEDIT::SELECT-PSEUDO-SEGMENT) SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS (SEDIT::SELECT-PSEUDO-SEGMENT) SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE (CL:WHEN CL:UNLESS) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (CL:WHEN CL:UNLESS) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE (CL:WHEN) SEDIT::FIND-STRUCTURE-BACKWARDS (CL:WHEN) SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING (TERPRI) SEDIT::SEARCH-OBJ (CL:FORMAT CL:UNLESS) SEDIT::SEARCH-OBJ-BACKWARDS (CL:FORMAT CL:UNLESS) SEDIT::SUBSTITUTE-OBJ (CL:UNLESS CASE) SEDIT::SUBSTITUTE-STRUCTURE (SEDIT::START-UNDO-BLOCK SEDIT::END-UNDO-BLOCK SEDIT::SET-POINT-NOWHERE SEDIT::SET-SELECTION-NOWHERE SEDIT::SELECT-NODE SEDIT::PENDING-DELETE SEDIT::INSERT-NULL-LIST SEDIT::DELETE-SELECTION SEDIT::INSERT CL:WHEN) SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::START-UNDO-BLOCK SEDIT::END-UNDO-BLOCK SEDIT::SET-POINT-NOWHERE SEDIT::SET-SELECTION-NOWHERE SEDIT::SELECT-PSEUDO-SEGMENT SEDIT::DELETE-SELECTION SEDIT::PENDING-DELETE SEDIT::INSERT) SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (DECLARE CL:CLOSE) SEDIT::COMMENT-OUT-SELECTION (CL:WRITE-CHAR CL:PRIN1 CL:CLOSE SEDIT::START-UNDO-BLOCK SEDIT::DELETE-SELECTION SEDIT::INSERT SEDIT::SELECT-NODE) SEDIT::ADD-MENU (printout TERPRI ATTACHWINDOW WINDOWADDPROP) SEDIT::BACKSPACE (CL:FUNCALL CL:WHEN) SEDIT::CHANGE-PACKAGE (SEDIT::CLOSE-OPEN-NODE CL:WHEN TERPRI CL:FORMAT XCL:SAVE-PROFILE SEDIT::VERIFY-STRUCTURE printout) SEDIT::CHANGE-PRINTBASE (SEDIT::CLOSE-OPEN-NODE CL:WHEN TERPRI XCL:SAVE-PROFILE SEDIT::VERIFY-STRUCTURE printout) SEDIT::CHANGE-QUOTE (RPLACA) SEDIT::CONVERT-COMMENT (SEDIT::START-UNDO-BLOCK CL:WHEN SEDIT::REPLACE-NODE SEDIT::END-UNDO-BLOCK printout TERPRI SEDIT::SET-POINT-NOWHERE) SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL (TCONC LCONC SEDIT::CONVERT-COMMENT-TAIL SELECTQ SELCHARQ) SEDIT::CREATE-COMMAND-TABLE (CL:WHEN) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION (SEDIT::DELETE-NODES CL:WHEN) SEDIT::DELETE-WORD (SEDIT::CLOSE-OPEN-NODE SELECTQ SEDIT::DELETE-NODES SEDIT::MAP-COMMENT-INDEX) SEDIT::DO-MUTATION (SEDIT::REPLACE-NODE) SEDIT::EDIT-SELECTION ( SEDIT::SET-SELECTION-NOWHERE SEDIT::SET-POINT-NOWHERE CL:FORMAT) SEDIT::EVAL-SELECTION (TERPRI CL:WHEN CL:UNLESS SEDIT::SET-SELECTION-NOWHERE) SEDIT::EXPAND (CL:WHEN TERPRI) SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::CLOSE-OPEN-NODE CL:WHEN printout TERPRI CL:UNLESS SEDIT::PENDING-DELETE SEDIT::INSERT CL:FORMAT RPLACD SEDIT::START-UNDO-BLOCK SEDIT::UNDO-BY SEDIT::END-UNDO-BLOCK) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU (FM.RESETMENU WINDOWADDPROP WINDOWPROP SEDIT::MENU-INIT-STATE) SEDIT::EDIT-HELP ( SEDIT::CLOSE-OPEN-NODE CL:WHEN printout TERPRI) SEDIT::HELPMENU (CL:FORMAT CL:DO* CL:DO CL:TERPRI) SEDIT::INPUT-DOT (SEDIT::INPUT-QUOTE SEDIT::DELETE-NODES SEDIT::DOT-THIS-LIST SEDIT::CHANGE-QUOTE) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (printout DECLARE TERPRI CL:WHEN SELECTQ SEDIT::INSERT SEDIT::INSERT-STRING SHOULDNT) SEDIT::INPUT-QUOTE (SEDIT::CLOSE-OPEN-NODE SEDIT::CHANGE-QUOTE SEDIT::INSERT-QUOTED-GAP SEDIT::SET-SELECTION-ME SEDIT::QUOTE-CURRENT-SELECTION SEDIT::SET-SELECTION-NOWHERE SEDIT::SET-POINT SEDIT::PENDING-DELETE SEDIT::START-UNDO-BLOCK SEDIT::REPLACE-STRING SEDIT::END-UNDO-BLOCK) SEDIT::INPUT-SQUARE-BRACKET (printout TERPRI FLASHWINDOW CLEARBUF) SEDIT::INPUT-STRINGDELIM (SEDIT::INSERT SEDIT::SET-SELECTION-NOWHERE) SEDIT::INPUT-TOKENDELIM (SELECTQ SEDIT::INSERT CL:WHEN SHOULDNT) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::INSERT CL:WHEN SEDIT::INSERT-STRING SEDIT::SET-SELECTION-NOWHERE) SEDIT::INSERT-SPECIAL-CHARACTER (SEDIT::INSERT-STRING SEDIT::SET-SELECTION-NOWHERE SEDIT::INSERT) SEDIT::INSPECT-SELECTION (SEDIT::SET-SELECTION-NOWHERE SEDIT::SET-POINT-NOWHERE CL:WHEN DECLARE TERPRI) SEDIT::JOIN (SEDIT::CLOSE-OPEN-NODE TERPRI SEDIT::PENDING-DELETE SEDIT::START-UNDO-BLOCK SELECTQ CL:WHEN FRPLACD SEDIT::DELETE-NODES SEDIT::SET-SELECTION-ME SEDIT::END-UNDO-BLOCK) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN ( SEDIT::MENU-SELECTEDFN) SEDIT::MENU-INIT-STATE (FM.CHANGESTATE FM.CHANGELABEL) SEDIT::MENU-PACKAGE-SELECTEDFN (printout DECLARE TERPRI) SEDIT::MENU-PRINTBASE-SELECTEDFN (printout DECLARE TERPRI) SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN (SEDIT::MENU-SELECTEDFN) SEDIT::MUTATE (TERPRI printout) SEDIT::QUOTE-CURRENT-SELECTION (SEDIT::CLOSE-OPEN-NODE CL:WHEN SEDIT::START-UNDO-BLOCK SEDIT::REPLACE-NODE SEDIT::NOTE-CHANGE SEDIT::SELECT-NODE SEDIT::SET-POINT) SEDIT::REDISPLAY NIL SEDIT::REDO (SEDIT::SET-SELECTION-NOWHERE SEDIT::SET-POINT-NOWHERE SEDIT::UNDO-EVENT printout TERPRI) SEDIT::SELECTED-FN-NAME (SEDIT::CLOSE-OPEN-NODE) SEDIT::SKIP-TO-GAP (CL:UNLESS TERPRI) SEDIT::UNDO (SEDIT::CLOSE-OPEN-NODE SEDIT::SET-SELECTION-NOWHERE SEDIT::SET-POINT-NOWHERE SEDIT::UNDO-EVENT CL:WHEN printout TERPRI) SEDIT::UNDO-EXTRACT (RPLACD SEDIT::DETACH-NODE SEDIT::REVIVE-NODE) NIL CLISP SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION (BIND FOR FROM TO AS ON DO) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE (type?) SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT (BIND WHILE DO) SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL (WHILE BIND DO) SEDIT::CREATE-COMMAND-TABLE (for in do) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD (WHILE DO UNTIL) SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT (BIND UNTIL DO) SEDIT::GET-MENU NIL SEDIT::EDIT-HELP (type?) SEDIT::HELPMENU NIL SEDIT::INPUT-DOT (type?) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (type?) SEDIT::INPUT-QUOTE (type?) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (type?) SEDIT::INPUT-TOKENDELIM ( type?) SEDIT::INSERT-MULTI-ESCAPE (type?) SEDIT::INSERT-SPECIAL-CHARACTER (type?) SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (FOR FROM TO AS IN COLLECT JOIN THEREIS DO) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME (type?) SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT (FOR IN AS FROM DO) NIL SPECVARS SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL LOCALVARS SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (CL::$STRING$ CL::$START$) SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR ($$OUTPUT) SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION ($$OUTPUT) SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN ( $$OUTPUT) SEDIT::MENU-PRINTBASE-SELECTEDFN ($$OUTPUT) SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL APPLY SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION (SEDIT::PARSE-NEW) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE (EQUAL) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (EQUAL) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE (SEDIT::PARSE-NEW SEDIT::COPY-NODE) SEDIT::SUBSTITUTE-SUBSTRUCTURE ( SEDIT::PARSE-NEW SEDIT::COPY-NODE) SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING ( CL:CLOSE) SEDIT::COMMENT-OUT-SELECTION (CL:CLOSE) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::PARSE-NEW) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN (CONCATLIST) SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL ERROR SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION (apply) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE (apply) SEDIT::SUBSTITUTE-SUBSTRUCTURE (apply) SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (apply) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL LOCALFREEVARS SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION (SEDIT::CONTEXT) SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE (SEDIT::CONTEXT) SEDIT::SUBSTITUTE-SUBSTRUCTURE (SEDIT::CONTEXT) SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (SEDIT::S A0358) SEDIT::COMMENT-OUT-SELECTION (SEDIT::S A0359) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (SEDIT::CONTEXT) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL ARGS SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL USERTEMPLATES FCACHE.GETPROP (CALL EVAL PROP . PPE) WINDOWDELPROP (CALL EVAL PROP EVAL . PPE) CH.PROPERTY (CALL PROP) CATCH (CALL |..| EVAL) PROCESSPROP (CALL EVAL PROP EVAL . PPE) OP# (CALL) IBM-INIT (CALL KEYWORDS :FONT-DIRECTORY :MACHINETYPE :DEFAULT-FONTPROFILE :REDEFINE-KEYBOARD) CL:PUSH (NIL @ EXPR (IF (ATOM (CADR EXPR)) THEN (QUOTE (EVAL SET)) ELSE (QUOTE (EVAL SMASH)))) PERFORM (MACRO ARGS (PERFORMTRAN ARGS T)) TEXTPROP (CALL EVAL PROP EVAL . PPE) SHAZAM (CALL |..| NIL) SPREADAPPLY* ( CALL FUNCTIONAL |..| EVAL) CL:INCF (NIL @ EXPR (IF (LITATOM (CAR EXPR)) THEN (QUOTE (SET EVAL)) ELSE ( QUOTE (SMASH EVAL)))) CL:DECF (NIL @ EXPR (IF (LITATOM (CAR EXPR)) THEN (QUOTE (SET EVAL)) ELSE (QUOTE (SMASH EVAL)))) WINDOWPROP (CALL EVAL PROP EVAL . PPE) SETQ.NOREF (CALL SET EVAL . PPE) SPREADAPPLY ( CALL FUNCTIONAL EVAL . PPE) UNINTERRUPTABLY (CALL |..| EVAL) WINDOWADDPROP (CALL EVAL PROP EVAL EVAL . PPE) perform (MACRO ARGS (PERFORMTRAN ARGS T)) FCACHE.PUTPROP (CALL EVAL PROP EVAL . PPE) NIL 0 SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE (SEDIT::EDIT-NODE) SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP ( SEDIT::EDIT-NODE) SEDIT::HELPMENU NIL SEDIT::INPUT-DOT (SEDIT::EDIT-SELECTION) SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR (SEDIT::EDIT-NODE) SEDIT::INPUT-QUOTE (SEDIT::EDIT-NODE) SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM (SEDIT::EDIT-SELECTION) SEDIT::INPUT-TOKENDELIM (SEDIT::EDIT-SELECTION) SEDIT::INSERT-MULTI-ESCAPE (SEDIT::EDIT-NODE) SEDIT::INSERT-SPECIAL-CHARACTER (SEDIT::EDIT-NODE) SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME (SEDIT::EDIT-NODE) SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL FPTYPE SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL KEYACCEPT SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL KEYSPECIFY SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS ( :INITIAL-ELEMENT) SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE (:END2 :TEST) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (:END2 :TEST) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (:ABORT) SEDIT::COMMENT-OUT-SELECTION (:ABORT) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE ( :SIZE :REHASH-SIZE) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (:START) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL KEYCALL SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS (CL:MAKE-STRING ) SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE (CL:MISMATCH) SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS (CL:MISMATCH) SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING (CL:CLOSE) SEDIT::COMMENT-OUT-SELECTION (CL:CLOSE) SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE (CL:MAKE-HASH-TABLE) SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION (CL:READ-FROM-STRING) SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL FLET SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL LABEL SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL MACROLET SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL COMPILER-LET SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL SENDNOTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL SENDSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL IMPLEMENT SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL GETNOTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL GETSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL GETCVSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL GETCVNOTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL PUTNOTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL PUTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL PUTCVSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL PUTCVNOTSELF SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL OBJECT SEDIT::PSEUDO-SELECTION-FROM-SELECTION NIL SEDIT::COMPOSE-PSEUDO-SELECTION NIL SEDIT::DECOMPOSE-PSEUDO-SELECTION NIL SEDIT::SELECTION-FROM-PSEUDO-SELECTION NIL SEDIT::SELECT-PSEUDO-SEGMENT NIL SEDIT:ADD-COMMAND NIL SEDIT:GET-SELECTION NIL SEDIT:REPLACE-SELECTION NIL SEDIT:RESET-COMMANDS NIL SEDIT:DEFAULT-COMMANDS NIL SEDIT::EQUALIZE-STRING-WIDTHS NIL SEDIT::MINIMUM-STRING-WIDTH NIL SEDIT::MAXIMUM-STRING-WIDTH NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE NIL SEDIT::FIND-AND-DISPLAY-STRUCTURE-BACKWARDS NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE NIL SEDIT::FIND-AND-DISPLAY-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-NTH-STRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE NIL SEDIT::FIND-NODE-SUBSTRUCTURE-BACKWARDS NIL SEDIT::FIND-OBJ NIL SEDIT::FIND-SELECTION NIL SEDIT::FIND-SELECTION-BACKWARDS NIL SEDIT::FIND-STRUCTURE NIL SEDIT::FIND-STRUCTURE-BACKWARDS NIL SEDIT::FIND-SUBSTRUCTURE NIL SEDIT::FIND-SUBSTRUCTURE-BACKWARDS NIL SEDIT::GET-USER-STRING NIL SEDIT::SEARCH-OBJ NIL SEDIT::SEARCH-OBJ-BACKWARDS NIL SEDIT::SUBSTITUTE-OBJ NIL SEDIT::SUBSTITUTE-STRUCTURE NIL SEDIT::SUBSTITUTE-SUBSTRUCTURE NIL SEDIT::STRUCTURE-FROM-SELECTION NIL SEDIT::STRUCTURE-FROM-STRING NIL SEDIT::COMMENT-OUT-SELECTION NIL SEDIT::ADD-MENU NIL SEDIT::BACKSPACE NIL SEDIT::CHANGE-PACKAGE NIL SEDIT::CHANGE-PRINTBASE NIL SEDIT::CHANGE-QUOTE NIL SEDIT::CONVERT-COMMENT NIL SEDIT::CONVERT-COMMENT-STRUCTURE NIL SEDIT::CONVERT-COMMENT-TAIL NIL SEDIT::CREATE-COMMAND-TABLE NIL SEDIT::DEFAULT-EDIT-FN NIL SEDIT::DELETE-SELECTION NIL SEDIT::DELETE-WORD NIL SEDIT::DO-MUTATION NIL SEDIT::EDIT-SELECTION NIL SEDIT::EVAL-SELECTION NIL SEDIT::EXPAND NIL SEDIT::EXTRACT-CURRENT-SELECTION NIL SEDIT::FIND-COMMENT NIL SEDIT::GET-MENU NIL SEDIT::EDIT-HELP NIL SEDIT::HELPMENU NIL SEDIT::INPUT-DOT NIL SEDIT::INPUT-ESCAPE NIL SEDIT::INPUT-NORMAL-CHAR NIL SEDIT::INPUT-QUOTE NIL SEDIT::INPUT-SQUARE-BRACKET NIL SEDIT::INPUT-STRINGDELIM NIL SEDIT::INPUT-TOKENDELIM NIL SEDIT::INSERT-MULTI-ESCAPE NIL SEDIT::INSERT-SPECIAL-CHARACTER NIL SEDIT::INSPECT-SELECTION NIL SEDIT::JOIN NIL SEDIT::MENU-CLOSEFN NIL SEDIT::MENU-FIND-SELECTEDFN NIL SEDIT::MENU-INIT-STATE NIL SEDIT::MENU-PACKAGE-SELECTEDFN NIL SEDIT::MENU-PRINTBASE-SELECTEDFN NIL SEDIT::MENU-SELECTEDFN NIL SEDIT::MENU-SUBSTITUTE-SELECTEDFN NIL SEDIT::MUTATE NIL SEDIT::QUOTE-CURRENT-SELECTION NIL SEDIT::REDISPLAY NIL SEDIT::REDO NIL SEDIT::SELECTED-FN-NAME NIL SEDIT::SKIP-TO-GAP NIL SEDIT::UNDO NIL SEDIT::UNDO-EXTRACT NIL NIL ) \ No newline at end of file