github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-28 11:02:53 +00:00
Code Issues Projects Releases Wiki Activity

Tedit 4th round (#1352)

Browse Source 
* 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 <nicholas.h.briggs@gmail.com>
Co-authored-by: Larry Masinter <lmm@acm.org>
This commit is contained in:
rmkaplan
2024-03-11 23:12:46 -07:00
committed by GitHub
parent 35b7195ed5
commit 44e42940a9
79 changed files with 26500 additions and 28510 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
library/CLIPBOARD
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Jul-2022 23:53:01" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;7 9243
(FILECREATED "19-Oct-2023 00:20:01" {WMEDLEY}<library>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}<Users>kaplan>Local>medley3.5>working-medley>library>CLIPBOARD.;6)
:CHANGES-TO (FNS TEDIT.EXTRACTTOCLIPBOARD)
:PREVIOUS-DATE " 7-Jul-2022 23:53:01" {WMEDLEY}<library>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

BIN
library/CLIPBOARD.LCOM
View File

Binary file not shown.

17
library/CLIPBOARD.TXT
View File

@@ -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.

219
library/TEXEC
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Jul-2022 23:42:20" 
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>TEXEC.;3| 196212
(FILECREATED "18-Jun-2023 09:48:54" |{WMEDLEY}<library>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}<Users>kaplan>Local>medley3.5>working-medley>library>TEXEC.;2|)
:CHANGES-TO (VARS TEXECCOMS)
:PREVIOUS-DATE "16-Jul-2022 23:42:20" |{WMEDLEY}<library>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

BIN
library/TEXEC.LCOM
View File

Binary file not shown.

1677
library/UNICODE
View File

File diff suppressed because it is too large Load Diff

BIN
library/UNICODE.LCOM
View File

Binary file not shown.

BIN
library/UNICODE.TEDIT
View File

Binary file not shown.

147
library/lafite/LAFITECOMMANDS
View File

@@ -1,18 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Feb-2022 12:04:09" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;2 164626
(FILECREATED "14-Jan-2024 16:35:53" {WMEDLEY}<library>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}<Users>kaplan>Local>medley3.5>my-medley>library>lafite>LAFITECOMMANDS.;1)
:CHANGES-TO (FNS MESSAGEDISPLAYER)
:PREVIOUS-DATE " 7-Feb-2022 12:04:09" {WMEDLEY}<library>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

BIN
library/lafite/LAFITECOMMANDS.LCOM
View File

Binary file not shown.

224
library/lafite/LAFITETEDIT
View File

@@ -1,36 +1,26 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Jul-2022 23:37:24" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>lafite>LAFITETEDIT.;5 12306
(FILECREATED "18-Jan-2024 10:34:16" {WMEDLEY}<library>lafite>LAFITETEDIT.;33 6622
:CHANGES-TO (VARS LAFITETEDITCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "30-Sep-2021 23:07:55"
{DSK}<users>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}<library>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

BIN
library/lafite/LAFITETEDIT.LCOM
View File

Binary file not shown.

3854
library/tedit/TEDIT
View File

File diff suppressed because it is too large Load Diff

77
library/tedit/TEDIT-ABBREV
View File

@@ -1,20 +1,16 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jul-2022 16:53:34" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;1 9767
(FILECREATED "12-Jun-2023 10:34:12" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;6 9257
:PREVIOUS-DATE "14-Jul-2022 11:08:10"
{DSK}<users>kaplan>local>medley3.5>working-medley>library>newtedit>TEDIT-ABBREV.;3)
:EDIT-BY rmk
:PREVIOUS-DATE "17-May-2023 13:40:00" {WMEDLEY}<library>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

BIN
library/tedit/TEDIT-ABBREV.LCOM
View File

Binary file not shown.

260
library/tedit/TEDIT-CHAT
View File

@@ -1,199 +1,42 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jul-2022 16:55:43" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-CHAT.;1 21593
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14 12223
:PREVIOUS-DATE "14-Jul-2022 10:40:06"
{DSK}<users>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}<library>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

BIN
library/tedit/TEDIT-CHAT.LCOM
View File

Binary file not shown.

847
library/tedit/TEDIT-COMMAND
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-COMMAND.LCOM
View File

Binary file not shown.

1646
library/tedit/TEDIT-DCL
View File

File diff suppressed because it is too large Load Diff

464
library/tedit/TEDIT-DCL.LCOM
View File

@@ -1,464 +0,0 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jul-2022 17:04:17" ("compiled on "
{DSK}<users>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}<users>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}<users>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<s> 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

88
library/tedit/TEDIT-DEFAULT-USER.CM Normal file
View File

@@ -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

5292
library/tedit/TEDIT-FILE
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-FILE.LCOM
View File

Binary file not shown.

1007
library/tedit/TEDIT-FIND
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-FIND.LCOM
View File

Binary file not shown.

692
library/tedit/TEDIT-FNKEYS
View File

@@ -1,29 +1,28 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "14-Jul-2022 16:55:47" 
{DSK}<users>kaplan>local>medley3.5>working-medley>library>tedit>TEDIT-FNKEYS.;1 29919
(FILECREATED " 4-Mar-2024 22:50:23" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;68 32048
:PREVIOUS-DATE "14-Jul-2022 11:08:01"
{DSK}<users>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}<library>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

BIN
library/tedit/TEDIT-FNKEYS.LCOM
View File

Binary file not shown.

1593
library/tedit/TEDIT-HCPY
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-HCPY.LCOM
View File

Binary file not shown.

954
library/tedit/TEDIT-HISTORY
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-HISTORY.LCOM
View File

Binary file not shown.

3360
library/tedit/TEDIT-LOOKS
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-LOOKS.LCOM
View File

Binary file not shown.

3953
library/tedit/TEDIT-MENU
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-MENU.LCOM
View File

Binary file not shown.

1115
library/tedit/TEDIT-OLDFILE Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-OLDFILE.LCOM Normal file
View File

Binary file not shown.

2222
library/tedit/TEDIT-PAGE
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-PAGE.LCOM
View File

Binary file not shown.

1538
library/tedit/TEDIT-PCTREE
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-PCTREE.LCOM
View File

Binary file not shown.

5212
library/tedit/TEDIT-SCREEN
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-SCREEN.LCOM
View File

Binary file not shown.

3815
library/tedit/TEDIT-SELECTION
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-SELECTION.LCOM
View File

Binary file not shown.

2428
library/tedit/TEDIT-STREAM Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-STREAM.LCOM Normal file
View File

Binary file not shown.

2624
library/tedit/TEDIT-TEXTOFD
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-TEXTOFD.LCOM
View File

Binary file not shown.

2467
library/tedit/TEDIT-TFBRAVO
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-TFBRAVO.LCOM
View File

Binary file not shown.

4489
library/tedit/TEDIT-WINDOW
View File

File diff suppressed because it is too large Load Diff

BIN
library/tedit/TEDIT-WINDOW.LCOM
View File

Binary file not shown.

BIN
library/tedit/TEDIT.LCOM
View File

Binary file not shown.

598
library/tedit/tedit-exports.all Normal file
View File

@@ -0,0 +1,598 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 22:49:16" 
{DSK}<Users>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}<library>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<s> 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

104
lispusers/COMPARESOURCES
View File

@@ -1,18 +1,15 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jun-2023 15:22:40" {WMEDLEY}<lispusers>COMPARESOURCES.;131 39663
(FILECREATED " 7-Feb-2024 16:08:54" {WMEDLEY}<lispusers>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}<lispusers>COMPARESOURCES.;128)
:PREVIOUS-DATE "17-Jun-2023 15:22:40" {WMEDLEY}<lispusers>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

BIN
lispusers/COMPARESOURCES.LCOM
View File

Binary file not shown.

553
lispusers/DOC-OBJECTS
View File

@@ -1,50 +1,48 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP" BASE 10)
(FILECREATED " 9-May-2018 11:09:43" 
{DSK}<Users>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}<lispusers>DOC-OBJECTS.;28 52405
previous date%: " 9-May-2018 10:35:47"
{DSK}<Users>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}<lispusers>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}<TEDIT>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}<TEDIT>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

BIN
lispusers/DOC-OBJECTS.LCOM
View File

Binary file not shown.

35
lispusers/EDITKEYS
View File

@@ -1,35 +1,31 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Jul-2022 08:41:05" 
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>EDITKEYS.;3 7073
(FILECREATED " 4-Dec-2023 21:06:15" {WMEDLEY}<lispusers>EDITKEYS.;6 7146
:CHANGES-TO (FNS BUILDFNKEYS)
(VARS EDITKEYSCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE " 9-Feb-87 21:28:31"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>EDITKEYS.;1)
:CHANGES-TO (VARS EDITKEYSCOMS)
:PREVIOUS-DATE "25-Oct-2022 10:58:27" {WMEDLEY}<lispusers>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

BIN
lispusers/EDITKEYS.LCOM
View File

Binary file not shown.

164
lispusers/MULTIPLE-HARDCOPY
View File

@@ -1,22 +1,26 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 1-Feb-2022 16:50:25" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;2 10662
(FILECREATED " 3-Nov-2023 22:12:06" {WMEDLEY}<lispusers>MULTIPLE-HARDCOPY.;7 10341
:CHANGES-TO (FNS TOC)
:EDIT-BY rmk
:PREVIOUS-DATE "22-Aug-86 12:23:34"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MULTIPLE-HARDCOPY.;1)
:CHANGES-TO (VARS MULTIPLE-HARDCOPYCOMS)
:PREVIOUS-DATE " 3-Nov-2023 22:11:07" {WMEDLEY}<lispusers>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%: (<starting page#> %.
 <list of pairs>) where each pair is of the form
 (<name of file> <start page# of file>))
(* ;; "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: (<starting page#> . <list of pairs>) where each pair is of the form (<name of file> <start page# of file>)")
(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

BIN
lispusers/MULTIPLE-HARDCOPY.LCOM
View File

Binary file not shown.

36
lispusers/TEDIT-PF-SEE
View File

@@ -1,10 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "25-Sep-2022 11:00:07" 
{DSK}<users>kaplan>local>medley3.5>working-medley>lispusers>TEDIT-PF-SEE.;113 7734
(FILECREATED "25-Dec-2023 12:29:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;118 8191
:PREVIOUS-DATE " 5-May-2022 23:48:59"
{DSK}<users>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}<lispusers>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

BIN
lispusers/TEDIT-PF-SEE.LCOM
View File

Binary file not shown.

BIN
lispusers/TEDIT-PROCESS-KILLER.LCOM
View File

Binary file not shown.

439
lispusers/TEDITDORADOKEYS
View File

@@ -1,311 +1,50 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Jul-2022 23:40:36" 
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDITDORADOKEYS.;2| 22214
(FILECREATED "26-Feb-2024 11:19:15" |{WMEDLEY}<lispusers>TEDITDORADOKEYS.;8| 5385
:EDIT-BY |rmk|
:CHANGES-TO (VARS TEDITDORADOKEYSCOMS)
:PREVIOUS-DATE "19-Apr-2018 12:27:21"
|{DSK}<Users>kaplan>Local>medley3.5>working-medley>lispusers>TEDITDORADOKEYS.;1|)
:PREVIOUS-DATE "15-Sep-2022 10:10:07" |{WMEDLEY}<lispusers>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

BIN
lispusers/TEDITDORADOKEYS.LCOM
View File

Binary file not shown.

431
lispusers/TEDITKEY
View File

@@ -1,36 +1,36 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED "10-Nov-87 14:55:24" {ERINYES}<LISPUSERS>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}<lispusers>TEDITKEY.;4 93014
previous date%: " 1-Apr-86 22:36:26" {ERINYES}<LISP>LYRIC>LISPUSERS>TEDITKEY.;1)
:EDIT-BY rmk
:CHANGES-TO (FNS \SEL.LINEDESC)
:PREVIOUS-DATE "24-Oct-2022 15:25:58" {WMEDLEY}<lispusers>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

BIN
lispusers/TEDITKEY.LCOM
View File

Binary file not shown.

137
lispusers/WHEELSCROLL
View File

@@ -1,12 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "29-Nov-2021 22:06:33" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>WHEELSCROLL.;21 11690
(FILECREATED " 2-Oct-2023 10:15:55" {WMEDLEY}<lispusers>WHEELSCROLL.;24 10480
changes to%: (FNS INSTALL-WHEELSCROLL)
:EDIT-BY rmk
previous date%: "29-Nov-2021 21:58:55"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>WHEELSCROLL.;20)
:CHANGES-TO (VARS WHEELSCROLLCOMS)
(FNS ENABLEWHEELSCROLL)
:PREVIOUS-DATE " 6-Apr-2023 18:34:48" {WMEDLEY}<lispusers>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

BIN
lispusers/WHEELSCROLL.LCOM
View File

Binary file not shown.

51
lispusers/tedit-process-killer
View File

@@ -1,25 +1,28 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 9-Mar-89 15:01:15" {ERINYES}<LISPUSERS>MEDLEY>TEDIT-PROCESS-KILLER.;2 16040
changes to%: (FNS MAKE-NEW-TEDIT-PROCESS)
(FILECREATED "20-Oct-2023 00:11:10" {WMEDLEY}<lispusers>tedit-process-killer.;2 16210
previous date%: " 2-Feb-88 14:21:07" {ERINYES}<LISPUSERS>MEDLEY>TEDIT-PROCESS-KILLER.;1)
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT-PROCESS-P)
:PREVIOUS-DATE " 9-Mar-89 15:01:15" {WMEDLEY}<lispusers>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

69
lispusers/tmax/TMAX
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "18-Jul-2023 12:34:39" {DSK}<home>frank>il>medley>gmedley>lispusers>tmax>TMAX.;2 25955
(FILECREATED " 4-Mar-2024 16:23:18" {WMEDLEY}<lispusers>tmax>TMAX.;10 25460
:CHANGES-TO (VARS TMAXCOMS)
:EDIT-BY rmk
:PREVIOUS-DATE "17-Mar-2022 23:12:47" {DSK}<home>frank>il>medley>gmedley>lispusers>tmax>TMAX.;1
)
:CHANGES-TO (FNS TSP.LIST.OF.OBJECTS)
:PREVIOUS-DATE "19-Jul-2023 09:14:13" {WMEDLEY}<lispusers>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

80
lispusers/tmax/TMAX-XREF
View File

@@ -1,15 +1,14 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "18-Mar-2022 07:07:27" 
|{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>TMAX-XREF.;5| 23662
(FILECREATED "26-Dec-2023 11:56:52" |{WMEDLEY}<lispusers>TMAX>TMAX-XREF.;4| 23618
:CHANGES-TO (VARS TMAX-XREFCOMS)
:EDIT-BY |rmk|
:PREVIOUS-DATE "17-Mar-2022 23:36:37"
|{DSK}<Users>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}<lispusers>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

BIN
lispusers/tmax/TMAX-XREF.LCOM
View File

Binary file not shown.

BIN
lispusers/tmax/TMAX.LCOM
View File

Binary file not shown.

1
sources/SEDIT-COMMANDS.DATABASE
View File

File diff suppressed because one or more lines are too long