github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-02-26 17:13:17 +00:00
Code Issues Projects Releases Wiki Activity

Rmk36 tedit fifth round (#1857)

Browse Source 
* TMAX updates for compatibility with Tedit changes

* DOC-OBJECTS changes for compatibility with Tedit changes

* MODERNIZE update for Tedit split windows

* Core Tedit files

* IMAGEOBJ: Remove dependency on Tedit internals

* WINDOW: Remove dependency on Tedit internal declaration

Still strange that WFROMDS should have to branch on Tedit

* WINDOWOBJ gets window of TTY process before the window of the stream of the TTY process

So insert into Tedit works

* TEDIT-CHAT: try to use TEXTSTREAM vs TEXTOBJ

* Fix tab-initialization problem in SLIDES.TEDIT

as reported by @nbriggs

* TEDIT-CHAT: use TSTREAM rather than TEXTOBJ

* Updates after lots more testing, particularly scrolling

Some other files dragged along to avoid dependence on Tedit internals

* Remove unwanted SAVE.SYSOUT

* Addresses more end-of-file and empty-file display issues

Try it again

* TEDIT-DEBUG tracking other changes

* Odds and ends

* Adjust EOF selection and caret-scrolling on copy

* More cleanup, plus fixing a few more ancient (Venue) glitches

As usual, the problems have to do with the funky behavior of EOL's in the middle and end of the document.  More abstraction and refactoring to get better control of this (I hope).

* TEDIT-WINDOW: Scroll down of big objects

Trying to fix what happens at the transition when scrolling down brings a big-object's top down in the window.   Approach is to bring down the line above, which may make for a little jump. I hope that solves it.
Scrolling up still needs some adjustment.

* Eliminate junk at top of window after up/down scrolling of big objects

BLTSHADE is OK there for scrolling, but not for redisplay after editing.  In the edit case, the top of the pane above the last valid line is preserved.
Scrolling still has the problem that the window can go blank at the first scroll that brings a tall object into the pane--still working on that.

* Scrolling with tall lines should be more continuous

* Another tweak for scrolling

plus interface extension to TEDIT.MOVE and TEDIT.COPY, a little more on field menus

* More robust strategy for field menu buttons

Surround the field with prefix and suffix pieces with image objects that print the pre and post labels and shift the selection forward or backward into the field.  Doesn't depend on inherited quirky logic in the selection line-scanner.

* Field selection ignores right and middle clicks

* A little more menu/selection tweaking

You can't extend through fields and buttons

* Added CUSTOMBUTTONEVENTFN to menu field buttons

Also, menu buttons in general can't be deleted

* A few more glitches, plus a little selection refactoring for buttons

* Reduce flicker in pargraph menu margin bar

* screen update glitch

* DOC-OBJECTS, TEDIT-SCREEN: Fixes the HCFILES DOC-OBJECTS failure

* TEDIT-BUTTONS:  Field values should always be shown in the specified FIELDFONT

* Abstracting the structure of the history lists

cleanup, but mostly as a precursor to maybe doing a ring buffer of a specified length

* TEDIT-FILE, a little font-reading cleanup

* Include the files from rmk-39 that deal with the text/binary renamefile problem

* TEDIT-PAGE addresses #1905

* Fix BUTTONSTART to STARTPC in Put/Get menu buttons

* Use width of M as width of EOL--easy to select

Also put in function call for potential kerning--needs eventual FONT support

* Rename a few internal functions from TEDIT.-- to \TEDIT.--

* Doesn't make sense for a charlooks to not have a font

* TEDIT-BUTTONS - Fix comment

* Take out Tedit internals from \CARET.FLASH?

Should have included this in fifth round long ago

* TEDIT-FILE:  use DEFAULTFONT for .sh files

Easier to follow the layout

* TEDIT-LOOKS: fix loadup order

* tedit-exports.all  Remove line-has-protection field

Useless

* Make sure that charlooks change as expected

* External format for .sh files is UTF-8

* Better display of history information for debugging

* Button changes: show document font families, better fields

* TEDIT-WINDOW, remove extra truncated line with down-scroll

* TEDIT-SELECTION: suppress line/paragraph selection for built-in menus

Line/para selection would be reasonable for multi-line fields, but most menu lines have protected text that would behave inconsistently.  So just suppress

* Better support for potential kerning

* Fix empty field value

* Simplify ASCII translation code

* Make sure headings have a default tab

* Word boundary at character 1

* Remember that you specified a font class instead of a font

For the charlooks menu, but also so that it is saved on a put

* More items on the Family NWAY-button line

* glitch

* TEDIT-LOOKS: Better algorithm for Ascii translation

* Charmenu remembers previous "Other" fonts, even if not installed

* Fix initial piece index

* Fix fontclass changes (again)
This commit is contained in:
rmkaplan
2024-12-23 11:07:54 -08:00
committed by GitHub
parent a26d061843
commit abdb128636
88 changed files with 18046 additions and 13316 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2455
internal/TEDIT-DEBUG Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
internal/TEDIT-DEBUG.LCOM Normal file
View File

Binary file not shown.

311
library/IMAGEOBJ
View File

@@ -1,137 +1,69 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Dec-95 13:21:56" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1 35602
(FILECREATED " 7-Jul-2024 21:04:16" {WMEDLEY}<library>IMAGEOBJ.;3 34260
:EDIT-BY rmk
:CHANGES-TO (FNS GET.OBJ.FROM.USER)
changes to%: (FNS BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN)
previous date%: " 6-Dec-95 15:18:32" {DSK}<MEDLEY>LIBRARY/IMAGEOBJ.;1)
(* ; "
Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venue & Xerox Corporation. All rights reserved.
")
:PREVIOUS-DATE " 7-Dec-95 13:21:56" {WMEDLEY}<library>IMAGEOBJ.;1)
(PRETTYCOMPRINT IMAGEOBJCOMS)
(RPAQQ IMAGEOBJCOMS
((COMS
(* ;; "Bit-map image objects")
(* ;; "Bit-map image objects")
(FNS BITMAPTEDITOBJ COERCETOBITMAP WINDOWTITLEFONT \PRINTBINARYBITMAP \READBINARYBITMAP
)
(* ;; "fns for the bitmap tedit object.")
(* ;; "fns for the bitmap tedit object.")
(FNS BMOBJ.BUTTONEVENTINFN BMOBJ.COPYFN BMOBJ.DISPLAYFN BMOBJ.IMAGEBOXFN BMOBJ.PUTFN
BMOBJ.INIT BMOBJ.GETFN5 BMOBJ.CREATE.MENU)
(INITVARS (*SMALLSCREEN* (ILESSP SCREENWIDTH 700))
(*SMALLSCREENFACTOR* 0.5))
(FNS SCALED.BITMAP.GETFN BMOBJ.GETFN BMOBJ.GETFN2 BMOBJ.GETFN3 BMOBJ.GETFN4)
(* ;
 "GETFNs for backward compatibility with older objects.")
(* ;
 "GETFNs for backward compatibility with older objects.")
(RECORDS BITMAPOBJ)
[INITVARS (DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1]
(* ;; "make ^O be a character that inserts an object read from the user.")
(* ;; "make ^O be a character that inserts an object read from the user.")
(GLOBALVARS (BITMAP.OBJ.MENU))
(ADDVARS (BackgroundCopyMenuCommands (SNAP (FUNCTION (BITMAPOBJ.SNAPW))
"prompts for an area of the screen to insert."
)
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
"prompts for an area of the screen to insert, scaled down by 50%%."
)
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50."
)
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
"Inserts *INSERT-BITMAP* in a document"))
(IMAGEOBJGETFNS (BMOBJ.GETFN))
(IMAGEOBJGETFNS (BMOBJ.GETFN2))
(IMAGEOBJGETFNS (BMOBJ.GETFN3))
(IMAGEOBJGETFNS (BMOBJ.GETFN4))
(IMAGEOBJGETFNS (BMOBJ.GETFN5))
(IMAGEOBJGETFNS (SCALED.BITMAP.GETFN)))
(VARS (BackgroundCopyMenu))
(FNS GET.OBJ.FROM.USER BITMAPOBJ.SNAPW PROMPTFOREVALED)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (BMOBJ.INIT)))
(FILES EDITBITMAP))))
(* ;; "Bit-map image objects")
(DEFINEQ
(BITMAPTEDITOBJ
[LAMBDA (BITMAP SCALEFACTOR ROTATION DESCENT) (* ; "Edited 13-Aug-93 17:17 by rmk:")
(* ; "Edited 6-Jan-89 16:34 by jds")
@@ -146,8 +78,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
BMOBJDESCENT _ (OR DESCENT 0))
BITMAPIMAGEFNS])
(COERCETOBITMAP
[LAMBDA (BMSPEC) (* ; "Edited 11-Jun-90 16:28 by mitani")
(* tries to interpret X as a spec
@@ -182,16 +112,12 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(fetch (REGION HEIGHT) of CR))
BM])
(WINDOWTITLEFONT
(LAMBDA (FONT) (* rrb " 1-Feb-84 15:26")
(* reset type of function that changes
 the title font)
(DSPFONT FONT WindowTitleDisplayStream)))
(\PRINTBINARYBITMAP
(LAMBDA (BITMAP STREAM) (* rrb "23-Jul-84 15:16")
@@ -211,8 +137,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
BMH BYTESPERWORD))
(RETURN BITMAP))))
(\READBINARYBITMAP
(LAMBDA (STREAM) (* rrb "23-Jul-84 15:17")
@@ -229,23 +153,14 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(ITIMES (fetch (BITMAP BITMAPRASTERWIDTH) of BITMAP)
BMH BYTESPERWORD))
(RETURN BITMAP))))
)
(* ;; "fns for the bitmap tedit object.")
(DEFINEQ
(BMOBJ.BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)
(* ; "Edited 14-Aug-93 19:44 by rmk:")
@@ -315,8 +230,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
 "And clear any cached shrunk bitmaps so the display looks reasonable.")
(RETURN 'CHANGED])
(BMOBJ.COPYFN
[LAMBDA (IMAGEOBJ) (* ; "Edited 13-Aug-93 17:13 by rmk:")
(* ; "Edited 6-Jan-89 16:19 by jds")
@@ -329,8 +242,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(FETCH (BITMAPOBJ BMOBJROTATION) OF BMOBJ)
(FETCH (BITMAPOBJ BMOBJDESCENT) OF BMOBJ])
(BMOBJ.DISPLAYFN
[LAMBDA (IMAGEOBJ IMAGE.STREAM) (* ; "Edited 7-Dec-95 13:20 by ")
@@ -449,8 +360,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
'REPLACE NIL NIL FACTOR])
(BMOBJ.IMAGEBOXFN
[LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN) (* ; "Edited 7-Dec-95 13:20 by ")
@@ -537,8 +446,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
XKERN _ 0])
(BMOBJ.PUTFN
[LAMBDA (BMOBJ STREAM) (* ; "Edited 13-Aug-93 15:41 by rmk:")
(* ; "Edited 11-Jan-89 17:00 by jds")
@@ -558,8 +465,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
STREAM FILERDTBL)
(SPACES 1 STREAM])
(BMOBJ.INIT
[LAMBDA NIL (* ; "Edited 13-Aug-93 14:27 by rmk:")
(* ; "Edited 11-Jan-89 17:01 by jds")
@@ -581,8 +486,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(FUNCTION NILL)
(FUNCTION NILL])
(BMOBJ.GETFN5
[LAMBDA (INPUT.STREAM TEXTSTREAM) (* ; "Edited 13-Aug-93 15:40 by rmk:")
(* jds "30-Oct-85 11:29")
@@ -592,8 +495,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(READ INPUT.STREAM FILERDTBL)
(READ INPUT.STREAM FILERDTBL])
(BMOBJ.CREATE.MENU
[LAMBDA NIL (* ; "Edited 30-Jul-87 19:19 by jds")
@@ -628,21 +529,13 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
MENUOFFSET _ (create POSITION
XCOORD _ -1
YCOORD _ 0])
)
(RPAQ? *SMALLSCREEN* (ILESSP SCREENWIDTH 700))
(RPAQ? *SMALLSCREENFACTOR* 0.5)
(DEFINEQ
(SCALED.BITMAP.GETFN
(LAMBDA (INPUT.STREAM TEXTSTREAM) (* jds "30-Oct-85 11:29")
@@ -654,8 +547,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(RETURN (BITMAPTEDITOBJ BITMAP (FQUOTIENT 1.0 FACTOR)
0)))))
(BMOBJ.GETFN
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:46")
@@ -669,8 +560,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(RETURN (BITMAPTEDITOBJ BITMAP (CAR FIELDS)
(CADR FIELDS)))))))
(BMOBJ.GETFN2
(LAMBDA (STREAM) (* rrb "17-Jul-84 11:29")
@@ -683,8 +572,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
SCALE ROT)))))
(BMOBJ.GETFN3
[LAMBDA (STREAM) (* ; "Edited 11-Jan-89 17:03 by jds")
@@ -702,8 +589,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(RETURN (BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
SCALE 0 DESC])
(BMOBJ.GETFN4
[LAMBDA (STREAM) (* ; "Edited 6-Jan-89 16:33 by jds")
@@ -731,162 +616,90 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
(BITMAPTEDITOBJ (\READBINARYBITMAP STREAM)
SCALE ROT DESCENT])
)
(* ; "GETFNs for backward compatibility with older objects.")
(DECLARE%: EVAL@COMPILE
(RECORD BITMAPOBJ (
(* ;; "Describes a bitmap imageobj")
(* ;; "Describes a bitmap imageobj")
BITMAP (* ; "The bitmap itself")
BMOBJSCALEFACTOR (* ;
 "The factor to scale it by when displaying")
BMOBJROTATION (* ;
 "A rotation to apply when displaying")
BMOBJDESCENT (* ;
 "How far below the base line to display it. NIL => 0.")
))
BITMAP (* ; "The bitmap itself")
BMOBJSCALEFACTOR (* ;
 "The factor to scale it by when displaying")
BMOBJROTATION (* ;
 "A rotation to apply when displaying")
BMOBJDESCENT (* ;
 "How far below the base line to display it. NIL => 0.")
))
)
(RPAQ? DEFAULT.BITMAP.SCALE '(0.75 (DISPLAY 1)))
(* ;; "make ^O be a character that inserts an object read from the user.")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS (BITMAP.OBJ.MENU))
)
(ADDTOVAR BackgroundCopyMenuCommands
(SNAP (FUNCTION (BITMAPOBJ.SNAPW))
"prompts for an area of the screen to insert.")
("Snap 50%%" (FUNCTION (BITMAPOBJ.SNAPW 0.5))
"prompts for an area of the screen to insert, scaled down by 50%%.")
("Snap 50%% & Save" (FUNCTION (BITMAPOBJ.SNAPW 0.5 T))
"prompts for an area of the screen to save in *INSERT-BITMAP*, scaled down by 50.")
("Insert saved" (FUNCTION (COPYINSERT *INSERT-BITMAP*))
"Inserts *INSERT-BITMAP* in a document"))
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN))
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN2))
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN3))
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN4))
(ADDTOVAR IMAGEOBJGETFNS (BMOBJ.GETFN5))
(ADDTOVAR IMAGEOBJGETFNS (SCALED.BITMAP.GETFN))
(RPAQQ BackgroundCopyMenu NIL)
(DEFINEQ
(GET.OBJ.FROM.USER
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 26-Apr-91 10:54 by jds")
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 7-Jul-2024 21:04 by rmk")
(* ; "Edited 26-Apr-91 10:54 by jds")
(* ;; "reads an expression from the user and puts the result into the textstream.")
(* ;; "reads an expression from the user and puts the result into the textstream at the current position of its caret.")
(ERSETQ (PROG ((VAL (PROMPTFOREVALED "Form to eval:"))
(SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
BM)
(CL:TYPECASE VAL
(STRINGP (* ;
 "Atoms and strings get inserted as text.")
(AND VAL (TEDIT.INSERT TEXTSTREAM VAL SEL)))
(LITATOM (* ;
 "Atoms and strings get inserted as text.")
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
SEL)))
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM (SELECTQ (fetch POINT of SEL)
(LEFT (fetch (SELECTION CH#)
of SEL))
(RIGHT (fetch (SELECTION CHLIM)
of SEL))
NIL)))
(T (COND
((SETQ BM (COERCETOBITMAP VAL))
(ERSETQ (LET ((VAL (PROMPTFOREVALED "Form to eval:"))
BM)
(CL:WHEN VAL
(CL:TYPECASE VAL
(STRINGP (* ;
 "Atoms and strings get inserted as text.")
(TEDIT.INSERT TEXTSTREAM VAL))
(LITATOM (* ;
 "Atoms and strings get inserted as text.")
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)))
(IMAGEOBJ (* ; "IMAGEOBJs get inserted as is")
(TEDIT.INSERT.OBJECT VAL TEXTSTREAM))
(T [COND
((SETQ BM (COERCETOBITMAP VAL))
(* ;
 "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
TEXTSTREAM
(SELECTQ (fetch POINT of SEL)
(LEFT (fetch (SELECTION CH#) of SEL))
(RIGHT (fetch (SELECTION CHLIM) of SEL))
NIL)))
(T (* ;
 "Not a bitmap, nor one of the special cases above; complain")
(AND VAL (TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T)
SEL)) (* ;
 "(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT 'Not implemented to have ' VAL ' in documents yet.') T)")
))))])
 "If it can be coerced to a bitmap, do so, then wrap the bitmap up as a nobject")
(TEDIT.INSERT.OBJECT (BITMAPTEDITOBJ BM 1 0)
TEXTSTREAM))
(T (* ;
 "Not a bitmap, nor one of the special cases above; see what happens")
(TEDIT.INSERT TEXTSTREAM (MKSTRING VAL T])))])
(BITMAPOBJ.SNAPW
[LAMBDA (SCALE SAVE) (* ; "Edited 14-Aug-93 19:54 by rmk:")
@@ -911,8 +724,6 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
0]
(RETURN])
(PROMPTFOREVALED
(LAMBDA (MSG WHERE FONT MINWIDTH MINHEIGHT) (* jds "26-Sep-85 16:46")
@@ -950,42 +761,20 @@ Copyright (c) 1984, 1985, 1986, 1987, 1988, 1989, 1990, 1991, 1993, 1995 by Venu
'>)))))
(CLOSEW WIN)
(RETURN NEWVALUE))))
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(BMOBJ.INIT)
)
(FILESLOAD EDITBITMAP)
(PUTPROPS IMAGEOBJ COPYRIGHT ("Venue & Xerox Corporation" 1984 1985 1986 1987 1988 1989 1990 1991 1993
1995))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3164 7671 (BITMAPTEDITOBJ 3176 . 3819) (COERCETOBITMAP 3823 . 5867) (WINDOWTITLEFONT
5871 . 6218) (\PRINTBINARYBITMAP 6222 . 7013) (\READBINARYBITMAP 7017 . 7668)) (7728 23863 (
BMOBJ.BUTTONEVENTINFN 7740 . 12286) (BMOBJ.COPYFN 12290 . 12916) (BMOBJ.DISPLAYFN 12920 . 16649) (
BMOBJ.IMAGEBOXFN 16653 . 19068) (BMOBJ.PUTFN 19072 . 20004) (BMOBJ.INIT 20008 . 21047) (BMOBJ.GETFN5
21051 . 21641) (BMOBJ.CREATE.MENU 21645 . 23860)) (23958 27253 (SCALED.BITMAP.GETFN 23970 . 24396) (
BMOBJ.GETFN 24400 . 24935) (BMOBJ.GETFN2 24939 . 25424) (BMOBJ.GETFN3 25428 . 26216) (BMOBJ.GETFN4
26220 . 27250)) (29245 35381 (GET.OBJ.FROM.USER 29257 . 32020) (BITMAPOBJ.SNAPW 32024 . 33150) (
PROMPTFOREVALED 33154 . 35378)))))
(FILEMAP (NIL (2973 7469 (BITMAPTEDITOBJ 2983 . 3626) (COERCETOBITMAP 3628 . 5672) (WINDOWTITLEFONT
5674 . 6021) (\PRINTBINARYBITMAP 6023 . 6814) (\READBINARYBITMAP 6816 . 7467)) (7520 23638 (
BMOBJ.BUTTONEVENTINFN 7530 . 12076) (BMOBJ.COPYFN 12078 . 12704) (BMOBJ.DISPLAYFN 12706 . 16435) (
BMOBJ.IMAGEBOXFN 16437 . 18852) (BMOBJ.PUTFN 18854 . 19786) (BMOBJ.INIT 19788 . 20827) (BMOBJ.GETFN5
20829 . 21419) (BMOBJ.CREATE.MENU 21421 . 23636)) (23728 27012 (SCALED.BITMAP.GETFN 23738 . 24164) (
BMOBJ.GETFN 24166 . 24701) (BMOBJ.GETFN2 24703 . 25188) (BMOBJ.GETFN3 25190 . 25978) (BMOBJ.GETFN4
25980 . 27010)) (28947 34160 (GET.OBJ.FROM.USER 28957 . 30804) (BITMAPOBJ.SNAPW 30806 . 31932) (
PROMPTFOREVALED 31934 . 34158)))))
STOP

BIN
library/IMAGEOBJ.LCOM
View File

Binary file not shown.

15
library/PDFSTREAM
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56 14033
(FILECREATED "10-Dec-2024 14:36:59" {WMEDLEY}<library>PDFSTREAM.;59 14133
:EDIT-BY rmk
:CHANGES-TO (VARS PDFSTREAMCOMS)
:PREVIOUS-DATE " 9-Oct-2023 00:42:25" {WMEDLEY}<library>PDFSTREAM.;55)
:PREVIOUS-DATE "11-Nov-2023 11:24:42" {WMEDLEY}<library>PDFSTREAM.;56)
(PRETTYCOMPRINT PDFSTREAMCOMS)
@@ -30,6 +30,7 @@
(FONTCREATE POSTSCRIPT.FONTCREATE)
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC]
(ALISTS (DEFAULTFILETYPELIST PDF))
(VARS (DEFAULTPRINTERTYPE 'PDF))
(FNS PDFFILEP PDF.HARDCOPYW PDF.TEXT PDF.TEDIT)
(P (FONTPROFILE.ADDDEVICE 'PDF 'POSTSCRIPT]
@@ -73,6 +74,8 @@
(FONTSAVAILABLE POSTSCRIPT.FONTSAVAILABLE)
(CREATECHARSET \CREATECHARSET.PSC)))
(ADDTOVAR DEFAULTFILETYPELIST (PDF . BINARY))
(RPAQQ DEFAULTPRINTERTYPE PDF)
(DEFINEQ
@@ -280,8 +283,8 @@
thereis (ShellWhich (CAR TEMPLATE])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3162 5776 (PDFFILEP 3172 . 4086) (PDF.HARDCOPYW 4088 . 4686) (PDF.TEXT 4688 . 5405) (
PDF.TEDIT 5407 . 5774)) (6216 13276 (OPEN-PDF-STREAM 6226 . 8362) (CLOSE-PDF-STREAM 8364 . 9651) (
PS-TO-PDF 9653 . 13274)) (13277 13675 (SEE-PDF 13287 . 13673)) (13726 14010 (PDFCONVERTER 13736 .
14008)))))
(FILEMAP (NIL (3262 5876 (PDFFILEP 3272 . 4186) (PDF.HARDCOPYW 4188 . 4786) (PDF.TEXT 4788 . 5505) (
PDF.TEDIT 5507 . 5874)) (6316 13376 (OPEN-PDF-STREAM 6326 . 8462) (CLOSE-PDF-STREAM 8464 . 9751) (
PS-TO-PDF 9753 . 13374)) (13377 13775 (SEE-PDF 13387 . 13773)) (13826 14110 (PDFCONVERTER 13836 .
14108)))))
STOP

BIN
library/PDFSTREAM.LCOM
View File

Binary file not shown.

86
library/POSTSCRIPTSTREAM
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12 258100
(FILECREATED "10-Dec-2024 15:16:36" {WMEDLEY}<library>POSTSCRIPTSTREAM.;15 258118
:EDIT-BY rmk
:CHANGES-TO (FNS POSTSCRIPTFILEP)
:CHANGES-TO (VARS POSTSCRIPTSTREAMCOMS)
:PREVIOUS-DATE "21-Jun-2021 20:29:32" {WMEDLEY}<library>POSTSCRIPTSTREAM.;11)
:PREVIOUS-DATE "21-Nov-2023 17:06:12" {WMEDLEY}<library>POSTSCRIPTSTREAM.;12)
(PRETTYCOMPRINT POSTSCRIPTSTREAMCOMS)
@@ -18,11 +18,11 @@
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS FONTID PSCFONT \POSTSCRIPTDATA POSTSCRIPTXFORM))
(INITRECORDS \POSTSCRIPTDATA)
(FNS POSTSCRIPT.INIT)
(ADDVARS (DEFAULTFILETYPELIST (PS . TEXT)
(PSC . TEXT)
(ADDVARS (DEFAULTFILETYPELIST (PS . BINARY)
(PSC . BINARY)
(PSF . BINARY)
(PSCFONT . BINARY)
(POSTSCRIPT . TEXT))
(POSTSCRIPT . BINARY))
(*DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
(AVANTGARDE-DEMI . AD)
(BECKMAN . BM)
@@ -483,11 +483,11 @@
(\POSTSCRIPT.NSHASH *POSTSCRIPT-NS-TRANSLATIONS*])
)
(ADDTOVAR DEFAULTFILETYPELIST (PS . TEXT)
(PSC . TEXT)
(ADDTOVAR DEFAULTFILETYPELIST (PS . BINARY)
(PSC . BINARY)
(PSF . BINARY)
(PSCFONT . BINARY)
(POSTSCRIPT . TEXT))
(POSTSCRIPT . BINARY))
(ADDTOVAR *DISPLAY-FONT-NAME-MAP* (AVANTGARDE-BOOK . AB)
(AVANTGARDE-DEMI . AD)
@@ -4383,38 +4383,38 @@
(ADDTOVAR LAMA POSTSCRIPT.PUTCOMMAND)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (22199 29303 (POSTSCRIPT.INIT 22209 . 29301)) (30283 65067 (PSCFONT.READFONT 30293 .
32201) (PSCFONT.SPELLFILE 32203 . 32781) (PSCFONT.COERCEFILE 32783 . 34355) (
PSCFONTFROMCACHE.SPELLFILE 34357 . 35342) (PSCFONTFROMCACHE.COERCEFILE 35344 . 36996) (
PSCFONT.WRITEFONT 36998 . 38013) (READ-AFM-FILE 38015 . 43886) (CONVERT-AFM-FILES 43888 . 45100) (
POSTSCRIPT.GETFONTID 45102 . 46497) (POSTSCRIPT.FONTCREATE 46499 . 58898) (
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58900 . 61297) (POSTSCRIPT.FONTSAVAILABLE 61299 . 65065)) (65622
74768 (OPENPOSTSCRIPTSTREAM 65632 . 74434) (CLOSEPOSTSCRIPTSTREAM 74436 . 74766)) (74813 81105 (
POSTSCRIPT.HARDCOPYW 74823 . 78172) (POSTSCRIPT.TEDIT 78174 . 78654) (POSTSCRIPT.TEXT 78656 . 78947) (
POSTSCRIPTFILEP 78949 . 80056) (MAKEEPSFILE 80058 . 81103)) (81106 125992 (POSTSCRIPT.BITMAPSCALE
81116 . 83572) (POSTSCRIPT.CLOSESTRING 83574 . 84108) (POSTSCRIPT.ENDPAGE 84110 . 84981) (
POSTSCRIPT.OUTSTR 84983 . 86004) (POSTSCRIPT.PUTBITMAPBYTES 86006 . 94477) (POSTSCRIPT.PUTCOMMAND
94479 . 95528) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95530 . 100978) (POSTSCRIPT.SHOWACCUM 100980 . 103218) (
POSTSCRIPT.STARTPAGE 103220 . 105799) (\POSTSCRIPTTAB 105801 . 106672) (\PS.BOUTFIXP 106674 . 108024)
(\PS.SCALEHACK 108026 . 110855) (\PS.SCALEREGION 110857 . 111417) (\SCALEDBITBLT.PSC 111419 . 115719)
(\SETPOS.PSC 115721 . 116183) (\SETXFORM.PSC 116185 . 118004) (\STRINGWIDTH.PSC 118006 . 118460) (
\SWITCHFONTS.PSC 118462 . 124619) (\TERPRI.PSC 124621 . 125990)) (126027 181747 (\BITBLT.PSC 126037 .
126590) (\BLTSHADE.PSC 126592 . 130874) (\CHARWIDTH.PSC 130876 . 131643) (\CREATECHARSET.PSC 131645 .
133343) (\DRAWARC.PSC 133345 . 135825) (\DRAWCIRCLE.PSC 135827 . 138236) (\DRAWCURVE.PSC 138238 .
142259) (\DRAWELLIPSE.PSC 142261 . 144738) (\DRAWLINE.PSC 144740 . 147090) (\DRAWPOINT.PSC 147092 .
147680) (\DRAWPOLYGON.PSC 147682 . 150796) (\DSPBOTTOMMARGIN.PSC 150798 . 151363) (
\DSPCLIPPINGREGION.PSC 151365 . 152808) (\DSPCOLOR.PSC 152810 . 153651) (\DSPFONT.PSC 153653 . 157863)
(\DSPLEFTMARGIN.PSC 157865 . 158434) (\DSPLINEFEED.PSC 158436 . 159012) (\DSPPUSHSTATE.PSC 159014 .
160777) (\DSPPOPSTATE.PSC 160779 . 163288) (\DSPRESET.PSC 163290 . 163936) (\DSPRIGHTMARGIN.PSC 163938
. 164510) (\DSPROTATE.PSC 164512 . 165535) (\DSPSCALE.PSC 165537 . 166468) (\DSPSCALE2.PSC 166470 .
167289) (\DSPSPACEFACTOR.PSC 167291 . 168263) (\DSPTOPMARGIN.PSC 168265 . 168982) (\DSPTRANSLATE.PSC
168984 . 171558) (\DSPXPOSITION.PSC 171560 . 172159) (\DSPYPOSITION.PSC 172161 . 172733) (
\FILLCIRCLE.PSC 172735 . 175381) (\FILLPOLYGON.PSC 175383 . 179299) (\FIXLINELENGTH.PSC 179301 .
180795) (\MOVETO.PSC 180797 . 181548) (\NEWPAGE.PSC 181550 . 181745)) (181803 204955 (
\POSTSCRIPT.CHANGECHARSET 181813 . 182617) (\POSTSCRIPT.OUTCHARFN 182619 . 195476) (
\POSTSCRIPT.PRINTSLUG 195478 . 197445) (\POSTSCRIPT.SPECIALOUTCHARFN 197447 . 199879) (\UPDATE.PSC
199881 . 201104) (\POSTSCRIPT.ACCENTFN 201106 . 202048) (\POSTSCRIPT.ACCENTPAIR 202050 . 204953)) (
205053 206698 (\PSC.SPACEDISP 205063 . 205342) (\PSC.SPACEWID 205344 . 205963) (\PSC.SYMBOLS 205965 .
206696)) (206807 209798 (\POSTSCRIPT.NSHASH 206817 . 209796)) (254273 254987 (POSTSCRIPTSEND 254283 .
254985)))))
(FILEMAP (NIL (22211 29315 (POSTSCRIPT.INIT 22221 . 29313)) (30301 65085 (PSCFONT.READFONT 30311 .
32219) (PSCFONT.SPELLFILE 32221 . 32799) (PSCFONT.COERCEFILE 32801 . 34373) (
PSCFONTFROMCACHE.SPELLFILE 34375 . 35360) (PSCFONTFROMCACHE.COERCEFILE 35362 . 37014) (
PSCFONT.WRITEFONT 37016 . 38031) (READ-AFM-FILE 38033 . 43904) (CONVERT-AFM-FILES 43906 . 45118) (
POSTSCRIPT.GETFONTID 45120 . 46515) (POSTSCRIPT.FONTCREATE 46517 . 58916) (
\POSTSCRIPT.SPECIALFONT.SCALEDWIDTHS 58918 . 61315) (POSTSCRIPT.FONTSAVAILABLE 61317 . 65083)) (65640
74786 (OPENPOSTSCRIPTSTREAM 65650 . 74452) (CLOSEPOSTSCRIPTSTREAM 74454 . 74784)) (74831 81123 (
POSTSCRIPT.HARDCOPYW 74841 . 78190) (POSTSCRIPT.TEDIT 78192 . 78672) (POSTSCRIPT.TEXT 78674 . 78965) (
POSTSCRIPTFILEP 78967 . 80074) (MAKEEPSFILE 80076 . 81121)) (81124 126010 (POSTSCRIPT.BITMAPSCALE
81134 . 83590) (POSTSCRIPT.CLOSESTRING 83592 . 84126) (POSTSCRIPT.ENDPAGE 84128 . 84999) (
POSTSCRIPT.OUTSTR 85001 . 86022) (POSTSCRIPT.PUTBITMAPBYTES 86024 . 94495) (POSTSCRIPT.PUTCOMMAND
94497 . 95546) (POSTSCRIPT.SET-FAKE-LANDSCAPE 95548 . 100996) (POSTSCRIPT.SHOWACCUM 100998 . 103236) (
POSTSCRIPT.STARTPAGE 103238 . 105817) (\POSTSCRIPTTAB 105819 . 106690) (\PS.BOUTFIXP 106692 . 108042)
(\PS.SCALEHACK 108044 . 110873) (\PS.SCALEREGION 110875 . 111435) (\SCALEDBITBLT.PSC 111437 . 115737)
(\SETPOS.PSC 115739 . 116201) (\SETXFORM.PSC 116203 . 118022) (\STRINGWIDTH.PSC 118024 . 118478) (
\SWITCHFONTS.PSC 118480 . 124637) (\TERPRI.PSC 124639 . 126008)) (126045 181765 (\BITBLT.PSC 126055 .
126608) (\BLTSHADE.PSC 126610 . 130892) (\CHARWIDTH.PSC 130894 . 131661) (\CREATECHARSET.PSC 131663 .
133361) (\DRAWARC.PSC 133363 . 135843) (\DRAWCIRCLE.PSC 135845 . 138254) (\DRAWCURVE.PSC 138256 .
142277) (\DRAWELLIPSE.PSC 142279 . 144756) (\DRAWLINE.PSC 144758 . 147108) (\DRAWPOINT.PSC 147110 .
147698) (\DRAWPOLYGON.PSC 147700 . 150814) (\DSPBOTTOMMARGIN.PSC 150816 . 151381) (
\DSPCLIPPINGREGION.PSC 151383 . 152826) (\DSPCOLOR.PSC 152828 . 153669) (\DSPFONT.PSC 153671 . 157881)
(\DSPLEFTMARGIN.PSC 157883 . 158452) (\DSPLINEFEED.PSC 158454 . 159030) (\DSPPUSHSTATE.PSC 159032 .
160795) (\DSPPOPSTATE.PSC 160797 . 163306) (\DSPRESET.PSC 163308 . 163954) (\DSPRIGHTMARGIN.PSC 163956
. 164528) (\DSPROTATE.PSC 164530 . 165553) (\DSPSCALE.PSC 165555 . 166486) (\DSPSCALE2.PSC 166488 .
167307) (\DSPSPACEFACTOR.PSC 167309 . 168281) (\DSPTOPMARGIN.PSC 168283 . 169000) (\DSPTRANSLATE.PSC
169002 . 171576) (\DSPXPOSITION.PSC 171578 . 172177) (\DSPYPOSITION.PSC 172179 . 172751) (
\FILLCIRCLE.PSC 172753 . 175399) (\FILLPOLYGON.PSC 175401 . 179317) (\FIXLINELENGTH.PSC 179319 .
180813) (\MOVETO.PSC 180815 . 181566) (\NEWPAGE.PSC 181568 . 181763)) (181821 204973 (
\POSTSCRIPT.CHANGECHARSET 181831 . 182635) (\POSTSCRIPT.OUTCHARFN 182637 . 195494) (
\POSTSCRIPT.PRINTSLUG 195496 . 197463) (\POSTSCRIPT.SPECIALOUTCHARFN 197465 . 199897) (\UPDATE.PSC
199899 . 201122) (\POSTSCRIPT.ACCENTFN 201124 . 202066) (\POSTSCRIPT.ACCENTPAIR 202068 . 204971)) (
205071 206716 (\PSC.SPACEDISP 205081 . 205360) (\PSC.SPACEWID 205362 . 205981) (\PSC.SYMBOLS 205983 .
206714)) (206825 209816 (\POSTSCRIPT.NSHASH 206835 . 209814)) (254291 255005 (POSTSCRIPTSEND 254301 .
255003)))))
STOP

BIN
library/POSTSCRIPTSTREAM.LCOM
View File

Binary file not shown.

2103
library/tedit/TEDIT
View File

File diff suppressed because it is too large Load Diff

205
library/tedit/TEDIT-ABBREV
View File

@@ -1,71 +1,69 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Mar-2024 18:15:40" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;8 9500
(FILECREATED "31-Oct-2024 17:53:21" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;9 10946
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.ABBREV.EXPAND)
:PREVIOUS-DATE "17-Mar-2024 12:06:12"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-ABBREV.;7)
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-ABBREV.;8)
(PRETTYCOMPRINT TEDIT-ABBREVCOMS)
(RPAQQ TEDIT-ABBREVCOMS
[(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
(GLOBALVARS TEDIT.ABBREVS)
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
("n" . "357,44")
("m" . "357,45")
("T" . "357,57")
("d" . "357,60")
("D" . "357,61")
("s" . "0,247")
("'" . "0,271")
("`" . "0,251")
("%"" . "0,252")
("~" . "0,272")
("1/4" . "0,274")
("1/2" . "0,275")
("3/4" . "0,276")
("1/3" . "357,375")
("2/3" . "357,376")
("c" . "0,323")
("c/o" . "357,100")
("%%" . "357,100")
("->" . "0,256")
("ra" . "0,256")
("|" . "0,257")
("da" . "0,257")
("^" . "0,255")
("ua" . "0,255")
("<-" . "0,254")
("la" . "0,254")
("_" . "0,254")
("L" . "0,243")
("o" . "0,260")
("Y" . "0,245")
("+" . "0,261")
("x" . "0,264")
("/" . "0,270")
("=" . "357,121")
("p" . "0,266")
("r" . "0,322")
("t" . "0,324")
("tm" . "0,324")
("box" . "42,42")
("cbox" . "42,61")
("-" . "357,43")
("=" . "357,42")
(" " . "357,41")
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE])
(RPAQQ TEDIT-ABBREVCOMS [(FNS \TEDIT.ABBREV.EXPAND \TEDIT.EXPAND.DATE \TEDIT.TRY.ABBREV)
(GLOBALVARS TEDIT.ABBREVS)
(INITVARS (TEDIT.ABBREVS '(("b" . "357,146")
("n" . "357,44")
("m" . "357,45")
("T" . "357,57")
("d" . "357,60")
("D" . "357,61")
("s" . "0,247")
("'" . "0,271")
("`" . "0,251")
("%"" . "0,252")
("~" . "0,272")
("1/4" . "0,274")
("1/2" . "0,275")
("3/4" . "0,276")
("1/3" . "357,375")
("2/3" . "357,376")
("c" . "0,323")
("c/o" . "357,100")
("%%" . "357,100")
("->" . "0,256")
("ra" . "0,256")
("|" . "0,257")
("da" . "0,257")
("^" . "0,255")
("ua" . "0,255")
("<-" . "0,254")
("la" . "0,254")
("_" . "0,254")
("L" . "0,243")
("o" . "0,260")
("Y" . "0,245")
("+" . "0,261")
("x" . "0,264")
("/" . "0,270")
("=" . "357,121")
("p" . "0,266")
("r" . "0,322")
("t" . "0,324")
("tm" . "0,324")
("box" . "42,42")
("cbox" . "42,61")
("-" . "357,43")
("=" . "357,42")
(" " . "357,41")
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE])
(DEFINEQ
(\TEDIT.ABBREV.EXPAND
[LAMBDA (TSTREAM) (* ; "Edited 17-Mar-2024 12:06 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 31-Oct-2024 17:50 by rmk")
(* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 17-May-2023 13:31 by rmk")
(* ; "Edited 8-Sep-2022 23:53 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
@@ -74,7 +72,7 @@
(PROG ((TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM))
SEL CH# CH OLDLOOKS EXPANSION)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(SETQ CH# (SUB1 (TEDIT.GETPOINT NIL SEL)))
(SETQ CH# (SUB1 (TEDIT.GETPOINT TSTREAM SEL)))
[COND
((ZEROP (GETSEL SEL DCH)) (* ;
 "Point Selection, so use the character to the left")
@@ -158,54 +156,53 @@
(GLOBALVARS TEDIT.ABBREVS)
)
(RPAQ? TEDIT.ABBREVS
'(("b" . "357,146")
("n" . "357,44")
("m" . "357,45")
("T" . "357,57")
("d" . "357,60")
("D" . "357,61")
("s" . "0,247")
("'" . "0,271")
("`" . "0,251")
("%"" . "0,252")
("~" . "0,272")
("1/4" . "0,274")
("1/2" . "0,275")
("3/4" . "0,276")
("1/3" . "357,375")
("2/3" . "357,376")
("c" . "0,323")
("c/o" . "357,100")
("%%" . "357,100")
("->" . "0,256")
("ra" . "0,256")
("|" . "0,257")
("da" . "0,257")
("^" . "0,255")
("ua" . "0,255")
("<-" . "0,254")
("la" . "0,254")
("_" . "0,254")
("L" . "0,243")
("o" . "0,260")
("Y" . "0,245")
("+" . "0,261")
("x" . "0,264")
("/" . "0,270")
("=" . "357,121")
("p" . "0,266")
("r" . "0,322")
("t" . "0,324")
("tm" . "0,324")
("box" . "42,42")
("cbox" . "42,61")
("-" . "357,43")
("=" . "357,42")
(" " . "357,41")
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
(RPAQ? TEDIT.ABBREVS '(("b" . "357,146")
("n" . "357,44")
("m" . "357,45")
("T" . "357,57")
("d" . "357,60")
("D" . "357,61")
("s" . "0,247")
("'" . "0,271")
("`" . "0,251")
("%"" . "0,252")
("~" . "0,272")
("1/4" . "0,274")
("1/2" . "0,275")
("3/4" . "0,276")
("1/3" . "357,375")
("2/3" . "357,376")
("c" . "0,323")
("c/o" . "357,100")
("%%" . "357,100")
("->" . "0,256")
("ra" . "0,256")
("|" . "0,257")
("da" . "0,257")
("^" . "0,255")
("ua" . "0,255")
("<-" . "0,254")
("la" . "0,254")
("_" . "0,254")
("L" . "0,243")
("o" . "0,260")
("Y" . "0,245")
("+" . "0,261")
("x" . "0,264")
("/" . "0,270")
("=" . "357,121")
("p" . "0,266")
("r" . "0,322")
("t" . "0,324")
("tm" . "0,324")
("box" . "42,42")
("cbox" . "42,61")
("-" . "357,43")
("=" . "357,42")
(" " . "357,41")
("DATE" . \TEDIT.EXPAND.DATE)
(">>DATE<<" . \TEDIT.EXPAND.DATE)))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2994 8156 (\TEDIT.ABBREV.EXPAND 3004 . 5371) (\TEDIT.EXPAND.DATE 5373 . 6006) (
\TEDIT.TRY.ABBREV 6008 . 8154)))))
(FILEMAP (NIL (3704 8979 (\TEDIT.ABBREV.EXPAND 3714 . 6194) (\TEDIT.EXPAND.DATE 6196 . 6829) (
\TEDIT.TRY.ABBREV 6831 . 8977)))))
STOP

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

Binary file not shown.

1941
library/tedit/TEDIT-BUTTONS Normal file
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

29
library/tedit/TEDIT-CHAT
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "23-Dec-2023 09:24:21" {WMEDLEY}<library>TEDIT>TEDIT-CHAT.;14 12223
(FILECREATED "24-Jun-2024 00:05:09" {WMEDLEY}<library>tedit>TEDIT-CHAT.;16 12363
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-CHATCOMS)
(FNS TEDITSTREAM.INIT TEDIT.DISPLAYTEXT TEDITCHAT.CHARFN)
:CHANGES-TO (FNS TEDITCHAT.CHARFN)
:PREVIOUS-DATE " 6-Apr-2023 21:40:07" {WMEDLEY}<library>tedit>TEDIT-CHAT.;9)
:PREVIOUS-DATE " 2-May-2024 18:09:26" {WMEDLEY}<library>tedit>TEDIT-CHAT.;15)
(PRETTYCOMPRINT TEDIT-CHATCOMS)
@@ -71,16 +70,18 @@
(replace (CHAT.STATE HELD) of STATE with NIL])
(TEDITCHAT.CHARFN
[LAMBDA (CH CHAT.STATE) (* ; "Edited 22-Dec-2023 23:57 by rmk")
[LAMBDA (CH CHAT.STATE) (* ; "Edited 24-Jun-2024 00:04 by rmk")
(* ; "Edited 2-May-2024 18:09 by rmk")
(* ; "Edited 22-Dec-2023 23:57 by rmk")
(* ; "Edited 18-Mar-2023 20:08 by rmk")
(* ; "Edited 12-Jun-90 18:00 by mitani")
(LET [(TEXTOBJ (TEXTOBJ (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE]
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
(SELCHARQ CH
(BS (\TEDIT.CHARDELETE TEXTOBJ (FGETTOBJ TEXTOBJ SEL)))
(LF NIL)
(BOUT (FGETTOBJ TEXTOBJ STREAMHINT)
CH])
(LET* ((TSTREAM (fetch (CHAT.STATE TEXTSTREAM) of CHAT.STATE))
(TEXTOBJ (TEXTOBJ TSTREAM)))
(\CARET.DOWN (FGETTOBJ TEXTOBJ DS))
(SELCHARQ CH
(BS (\TEDIT.CHARDELETE TSTREAM (FGETTOBJ TEXTOBJ SEL)))
(LF NIL)
(BOUT TSTREAM CH])
)
@@ -212,6 +213,6 @@
CHATDECLS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (960 4404 (TEDITSTREAM.INIT 970 . 1897) (TEDITCHAT.MENUFN 1899 . 3735) (TEDITCHAT.CHARFN
3737 . 4402)) (4451 11335 (TEDIT.DISPLAYTEXT 4461 . 11333)))))
(FILEMAP (NIL (886 4544 (TEDITSTREAM.INIT 896 . 1823) (TEDITCHAT.MENUFN 1825 . 3661) (TEDITCHAT.CHARFN
3663 . 4542)) (4591 11475 (TEDIT.DISPLAYTEXT 4601 . 11473)))))
STOP

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

Binary file not shown.

313
library/tedit/TEDIT-COMMAND
View File

@@ -1,15 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "21-Apr-2024 11:55:17" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;87 53604
(FILECREATED "28-Nov-2024 10:03:03" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;133 49278
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.COPYTOCLIPBOARD \TEDIT.WRITE.SEL)
(MACROS \TEDIT.MOUSESTATE)
:CHANGES-TO (FNS \TEDIT.COMMAND.LOOP)
:PREVIOUS-DATE "21-Apr-2024 10:17:38"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-COMMAND.;80)
:PREVIOUS-DATE "21-Nov-2024 11:53:19" {WMEDLEY}<library>tedit>TEDIT-COMMAND.;128)
(PRETTYCOMPRINT TEDIT-COMMANDCOMS)
@@ -247,8 +244,9 @@
PROC])
(\TEDIT.MARKACTIVE
[LAMBDA (TEXTOBJ) (* ; "Edited 12-Jun-90 18:04 by mitani")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with T)
[LAMBDA (TEXTOBJ OPERATION) (* ; "Edited 29-Jun-2024 10:32 by rmk")
(* ; "Edited 12-Jun-90 18:04 by mitani")
(replace (TEXTOBJ EDITOPACTIVE) of TEXTOBJ with OPERATION)
TEXTOBJ])
(\TEDIT.MARKINACTIVE
@@ -257,193 +255,135 @@
TEXTOBJ])
(\TEDIT.COMMAND.LOOP
[LAMBDA (STREAM RTBL) (* ; "Edited 21-Apr-2024 09:08 by rmk")
(* ; "Edited 2-Apr-2024 15:35 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 28-Nov-2024 10:01 by rmk")
(* ; "Edited 21-Nov-2024 11:51 by rmk")
(* ; "Edited 13-Sep-2024 22:34 by rmk")
(* ; "Edited 26-Aug-2024 23:26 by rmk")
(* ; "Edited 18-Aug-2024 23:05 by rmk")
(* ; "Edited 2-Aug-2024 08:46 by rmk")
(* ; "Edited 13-Jul-2024 23:13 by rmk")
(* ; "Edited 12-Jul-2024 00:39 by rmk")
(* ; "Edited 9-Jul-2024 18:02 by rmk")
(* ; "Edited 7-Jul-2024 16:24 by rmk")
(* ; "Edited 3-Jul-2024 12:31 by rmk")
(* ; "Edited 29-Jun-2024 00:08 by rmk")
(* ; "Edited 18-May-2024 16:21 by rmk")
(* ; "Edited 29-Apr-2024 10:58 by rmk")
(* ; "Edited 7-May-2024 10:42 by rmk")
(* ; "Edited 20-Mar-2024 10:59 by rmk")
(* ; "Edited 15-Mar-2024 14:23 by rmk")
(* ; "Edited 9-Mar-2024 11:35 by rmk")
(* ; "Edited 24-Feb-2024 15:33 by rmk")
(* ; "Edited 21-Feb-2024 14:49 by rmk")
(* ; "Edited 18-Feb-2024 23:35 by rmk")
(* ; "Edited 24-Dec-2023 09:50 by rmk")
(* ; "Edited 22-Sep-2023 20:40 by rmk")
(* ; "Edited 16-Sep-2023 22:48 by rmk")
(* ; "Edited 30-May-91 19:33 by jds")
(* ;; "Main command loop for the TEDIT editor. Includes keyboard polling and command dispatch")
(PROG ((TEXTOBJ (CL:IF (type? STREAM STREAM)
(fetch (TEXTSTREAM TEXTOBJ) of STREAM)
STREAM))
SEL PANES)
(TEXTOBJ! TEXTOBJ)
(SETQ SEL (TEXTSEL TEXTOBJ))
(SETQ PANES (FGETTOBJ TEXTOBJ \WINDOW))
(SETQ RTBL (OR RTBL (FGETTOBJ TEXTOBJ TXTRTBL)
TEDIT.READTABLE)) (* ;
 "Used to derive command characters from type-in")
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
(* ; "Add the pane to this process")
(until (TTY.PROCESSP) do (* ;
(LET
[(TEXTOBJ (TEXTOBJ! (GETTSTR TSTREAM TEXTOBJ]
(for P inpanes TEXTOBJ do (WINDOWPROP P 'PROCESS (THIS.PROCESS)))
(* ; "Add the process to our panes")
(until (TTY.PROCESSP) do (* ;
 "Wait until we really have the TTY before proceeding.")
(DISMISS 250))
(RESETLST
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ PANES)
T))
(LET
(CH FN TCH (READSA (fetch READSA of %#CURRENTRDTBL#))
(TERMSA (OR (FGETTOBJ TEXTOBJ TXTTERMSA)
\PRIMTERMSA))
(TEDITSA (fetch READSA of RTBL))
(TEDITFNHASH (fetch READMACRODEFS of RTBL))
(LOOPFN (GETTEXTPROP TEXTOBJ 'LOOPFN))
(CHARFN (GETTEXTPROP TEXTOBJ 'CHARFN))
SELOPERATION SOURCESEL SELPANE)
(DECLARE (SPECVARS SELOPERATION SOURCESEL SELPANE))
(DISMISS 250))
(RESETLST
(RESETSAVE (\TEDIT.COMMAND.RESET.SETUP (LIST TEXTOBJ)
T))
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
do
(ERSETQ
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
do
(\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
(while (FGETTOBJ TEXTOBJ EDITOPACTIVE) do (\TEDIT.FLASHCARET TEXTOBJ)
(* ;
 "Set by \TEDIT.BUTTONEVENTFN in MOUSE process")
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
do
(ERSETQ
(until (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
do (\WAITFORSYSBUFP 25) (* ; "Await type-in or mouse action")
(until (OR SELOPERATION (NOT (FGETTOBJ TEXTOBJ EDITOPACTIVE)))
do (\TEDIT.FLASHCARET TEXTOBJ)
(BLOCK))
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
(CL:WHEN (FGETTOBJ TEXTOBJ TXTNEEDSUPDATE)
(* ;
 "We got here somehow with the window not in sync with the text. Run an update.")
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UPDATE.SCREEN TEXTOBJ)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T))
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
 "Flash caret while other operation completes")
(BLOCK))
(CL:UNLESS (FGETTOBJ TEXTOBJ EDITFINISHEDFLG)
(\TEDIT.FLASHCARET TEXTOBJ) (* ;
 "Flash the caret periodically (BUT not while we're here only to cleanup and quit.)")
(FSETTOBJ TEXTOBJ EDITOPACTIVE T)
(* ;
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
 "Before starting to work, note that we're doing something.")
(CL:WHEN LOOPFN
(ERSETQ (APPLY* LOOPFN (FGETTOBJ TEXTOBJ STREAMHINT))))
(* ;; "")
(* ;; "")
(* ;;
 "Process any pending selections from \TEDIT.BUTTONEVENTFN, here instead of in MOUSE process")
(* ;; "Handle user type-in")
(SELECTQ (PROG1 SELOPERATION (SETQ SELOPERATION NIL))
(NORMAL (CL:WHEN (FGETSEL SOURCESEL SET)
(SETQ SEL (\TEDIT.COPYSEL SOURCESEL SEL))
(* ; "SOURCESEL is new SEL selection")
(FSETTOBJ TEXTOBJ CARETLOOKS (
\TEDIT.GET.INSERT.CHARLOOKS
TEXTOBJ SEL))
(\TEDIT.SHOWSEL SEL T)))
(MOVE (* ; "Move source to SEL")
(TEDIT.MOVE SOURCESEL SEL))
(COPY (* ; "Copy source to SEL.")
(TEDIT.COPY SOURCESEL SEL))
(COPYLOOKS (* ; "Copy source-looks to SEL")
(if (EQ 'PARA (GETSEL SOURCESEL SELKIND))
then (TEDIT.COPY.PARALOOKS TEXTOBJ SOURCESEL SEL)
else (TEDIT.COPY.LOOKS TEXTOBJ SOURCESEL SEL)))
(DELETE (* ; "Delete CTRL selection")
(\TEDIT.DELETE TEXTOBJ SOURCESEL NIL SELPANE))
NIL)
(* ;; "")
(* ;; "Handle user type-in")
[while (\SYSBUFP)
do (SETQ CH (\GETKEY))
(CL:WHEN CHARFN (* ;
[bind CH TCH FN first (CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ LOOPFN))
(ERSETQ (APPLY* FN TSTREAM))) while (\SYSBUFP)
do (SETQ CH (\GETKEY))
(CL:WHEN (SETQ FN (FGETTOBJ TEXTOBJ CHARFN))
(* ;
 "Give the OEM user control for each character typed.")
(SETQ TCH (APPLY* CHARFN (FGETTOBJ TEXTOBJ STREAMHINT)
CH))
(SETQ TCH (APPLY* FN TSTREAM CH))
(* ;;
(* ;;
 "And let him return one of NIL for 'ignore this char' , T for 'leave it be' or a new charcode.")
(OR (EQ TCH T)
(SETQ CH TCH)))
(SELECTC (AND CH (\SYNCODE TEDITSA CH))
(CHARDELETE.TTC (* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(CHARDELETE.FORWARD.TTC
(\TEDIT.CHARDELETE.FORWARD TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(WORDDELETE.TTC
(\TEDIT.WORDDELETE TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(WORDDELETE.FORWARD.TTC
(\TEDIT.WORDDELETE.FORWARD TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(DELETE.TTC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(UNDO.TTC (* ;
 "He hit the CANCEL key, so go UNDO something")
(TEDIT.UNDO TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(REDO.TTC (* ;
(OR (EQ TCH T)
(SETQ CH TCH)))
(SELECTC (AND CH (\SYNCODE (fetch READSA of (FGETTOBJ TEXTOBJ TXTRTBL))
CH))
(CHARDELETE.TTC
(\TEDIT.CHARDELETE TSTREAM))
(CHARDELETE.FORWARD.TTC
(\TEDIT.CHARDELETE TSTREAM T))
(WORDDELETE.TTC
(\TEDIT.WORDDELETE TSTREAM))
(WORDDELETE.FORWARD.TTC
(\TEDIT.WORDDELETE.FORWARD TSTREAM))
(DELETE.TTC (\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)))
(UNDO.TTC (* ;
 "Take off the BPD, the undoing and put it back on.")
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(TEDIT.UNDO TSTREAM))
(REDO.TTC (* ;
 "He hit the REDO key, so go REDO something")
(TEDIT.REDO TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ))
(FUNCTIONCALL.TTC (* ;
(TEDIT.REDO TSTREAM)
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ))
(FUNCTIONCALL.TTC (* ;
 "This is a special character -- it calls a function")
(CL:WHEN [SETQ FN (CAR (FETCH MACROFN
OF (GETHASH CH TEDITFNHASH]
(CL:WHEN [SETQ FN (CAR (fetch MACROFN
of (GETHASH CH (fetch READMACRODEFS
of (FGETTOBJ TEXTOBJ
TXTRTBL]
(* ;
 "There IS a command function to be called.")
(APPLY* FN (FGETTOBJ TEXTOBJ STREAMHINT)
TEXTOBJ SEL)
(APPLY* FN TSTREAM TEXTOBJ (TEXTSEL TEXTOBJ))
(* ; "do it")
(* ;
 "After a user function (that is not wheelscroll) no more blue-pending-delete")
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
(* ;; "We shouldn't have to test for special characters here, there should be a more general way of marking them")
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
(MEMB CH CLIPBOARDCODES))
(CL:UNLESS (OR (MEMB CH WHEELSCROLLCHARCODES)
(MEMB CH CLIPBOARDCODES))
(* ;
 "The FNs handled the selection. should preserve the highlighting")
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T))))
(NEXT.TTC (* ;
 "Move to the next blank to fill in. For now, blanks are delimited by >>...<<")
(TEDIT.NEXT TEXTOBJ))
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
(\TEDIT.ABBREV.EXPAND (FGETTOBJ TEXTOBJ STREAMHINT
)))
(SELECTC (AND TERMSA CH (fetch TERMCLASS
of (\SYNCODE TERMSA CH)))
(CHARDELETE.TC (* ;
 "Backspace handler: Remove the character just before SEL:CH#.")
(\TEDIT.CHARDELETE TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(WORDDELETE.TC (* ; "Back-WORD handler")
(\TEDIT.WORDDELETE TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(LINEDELETE.TC (* ;
 "DEL Key handler: Delete the selected characters")
(\TEDIT.DELETE TEXTOBJ SEL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL
TEXTOBJ))
(CL:WHEN CH (* ;
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(\TEDIT.SHOWSEL NIL T TEXTOBJ))))
(NEXT.TTC (* ;
 "Move to the next blank to fill in, delimited by >>...<<")
(TEDIT.NEXT TSTREAM))
(EXPAND.TTC (* ; "EXPAND AN ABBREVIATION")
(\TEDIT.ABBREV.EXPAND TSTREAM))
(SELECTC (AND CH (fetch TERMCLASS of (\SYNCODE (OR (FGETTOBJ TEXTOBJ
TXTTERMSA)
\PRIMTERMSA)
CH)))
(CHARDELETE.TC (\TEDIT.CHARDELETE TSTREAM))
(WORDDELETE.TC (\TEDIT.WORDDELETE TSTREAM))
(LINEDELETE.TC (\TEDIT.DELETE TEXTOBJ))
(CL:WHEN CH (* ;
 "Any other key: insert the character.")
(\TEDIT.INSERT CH SEL TEXTOBJ))])
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL))))])
(\TEDIT.INSERT CH (TEXTSEL TEXTOBJ)
TSTREAM NIL T))])
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))
(FSETTOBJ TEXTOBJ EDITOPACTIVE NIL)))])
(\TEDIT.COMMAND.RESET.SETUP
[LAMBDA (TEXT&WIND STARTING) (* ; "Edited 17-Mar-2024 18:54 by rmk")
[LAMBDA (ARGS STARTING) (* ; "Edited 29-Jun-2024 00:10 by rmk")
(* ; "Edited 17-Mar-2024 18:54 by rmk")
(* ; "Edited 22-Feb-2024 23:14 by rmk")
(* ; "Edited 5-Oct-2023 22:41 by rmk")
(* ; "Edited 22-Sep-2023 20:41 by rmk")
@@ -453,21 +393,20 @@
(* ;; "If STARTING is T, set up the reset-driven connections and values for editing; otherwise, break links and reset values for non-editing")
(PROG ((TEXTOBJ (CAR TEXT&WIND))
(PANES (CADR TEXT&WIND))
(OTTYWINDOW (CADDR TEXT&WIND))
(OTTYENTRYFN (CADDDR TEXT&WIND))
(OTTYEXITFN (CAR (CDDDDR TEXT&WIND)))
(OWINDOW (CADR (CDDDDR TEXT&WIND)))
TTYWINDOW)
(PROG ((TEXTOBJ (pop ARGS))
(OTTYWINDOW (pop ARGS))
(OTTYENTRYFN (pop ARGS))
(OTTYEXITFN (pop ARGS))
(OWINDOW (pop ARGS))
TTYWINDOW PRIMPANE)
(SETQ PRIMPANE (FGETTOBJ TEXTOBJ PRIMARYPANE))
[COND
(STARTING (* ;
 "We're going INTO the command loop. Set up all the stuff")
(FSETTOBJ TEXTOBJ EDITOPACTIVE T) (* ;
 "Mark us busy until we're set up, so that nobody tries any funny stuff.")
(SETQ OWINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR PANES))) (* ;
'WINDOW PRIMPANE)) (* ;
 "Attach the process to this window.")
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)) (* ;
 "Disarm all interrupt chars, re-arm them when we leave the edit")
@@ -493,7 +432,7 @@
(* ;
 "So that there isn't a circularity in the PROCESS -> TTYWINDOW -> PROCESS")
(WINDOWPROP TTYWINDOW 'COPYINSERTFN (FUNCTION \TEDIT.COPYINSERTFN))
(WINDOWPROP TTYWINDOW 'MAINWINDOW (CAR PANES)))
(WINDOWPROP TTYWINDOW 'MAINWINDOW PRIMPANE))
(FSETTOBJ TEXTOBJ TXTEDITING T) (* ;
 "Tell TEdit that this document is actively being edited.")
(* ;
@@ -502,21 +441,19 @@
(T (* ;
 "Coming OUT OF the command loop -- reset everything")
(PROCESSPROP (THIS.PROCESS)
'WINDOW
(CAR PANES)) (* ;
'WINDOW PRIMPANE) (* ;
 "Detach the window from the edit process, to prevent circularity there")
(WINDOWPROP (CAR PANES)
'PROCESS NIL)
(WINDOWPROP PRIMPANE 'PROCESS NIL)
(\TEDIT.INTERRUPT.SETUP (THIS.PROCESS)
T) (* ;
 "Re-arm the interrupts we turned off coming in.")
(CL:WHEN [AND (TXTFILE TEXTOBJ)
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of (CAR PANES]
(CL:WHEN (AND (TXTFILE TEXTOBJ)
(NOT (fetch (TEXTWINDOW CLOSINGFILE) of PRIMPANE)))
(* ;
 "Remember to close the file we were editing (Only if the window function isn't closing it.)")
(CLOSEF? (TXTFILE TEXTOBJ)) (* ;
 "Let anyone else who wants to close the file.")
(replace (TEXTWINDOW CLOSINGFILE) of (CAR PANES) with NIL))
(replace (TEXTWINDOW CLOSINGFILE) of PRIMPANE with NIL))
(PROCESSPROP (THIS.PROCESS)
'TTYEXITFN OTTYEXITFN)
(PROCESSPROP (THIS.PROCESS)
@@ -532,7 +469,7 @@
(TTYDISPLAYSTREAM OTTYWINDOW)
(PROCESSPROP (THIS.PROCESS)
'TEDITTTYWINDOW NIL))]
(RETURN (LIST TEXTOBJ PANES OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
(RETURN (LIST TEXTOBJ OTTYWINDOW OTTYENTRYFN OTTYEXITFN OWINDOW])
)
(RPAQ? TEDIT.INTERRUPTS '((2 BREAK)
@@ -974,12 +911,12 @@
(\TEDIT.CLIPBOARD)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8457 30896 (\TEDIT.INTERRUPT.SETUP 8467 . 10114) (\TEDIT.MARKACTIVE 10116 . 10328) (
\TEDIT.MARKINACTIVE 10330 . 10546) (\TEDIT.COMMAND.LOOP 10548 . 24296) (\TEDIT.COMMAND.RESET.SETUP
24298 . 30894)) (31180 46377 (\TEDIT.READTABLE 31190 . 32847) (\TEDIT.WORDBOUND.READTABLE 32849 .
35442) (TEDIT.GETSYNTAX 35444 . 37883) (TEDIT.SETSYNTAX 37885 . 40363) (TEDIT.GETFUNCTION 40365 .
41725) (TEDIT.SETFUNCTION 41727 . 44166) (TEDIT.WORDGET 44168 . 44429) (TEDIT.WORDSET 44431 . 45128) (
TEDIT.ATOMBOUND.READTABLE 45130 . 46375)) (46705 47614 (\TEDIT.WHEELSCROLL 46715 . 47612)) (47767
53347 (\TEDIT.CLIPBOARD 47777 . 49532) (\TEDIT.COPYTOCLIPBOARD 49534 . 50314) (
\TEDIT.EXTRACTTOCLIPBOARD 50316 . 50511) (\TEDIT.WRITE.SEL 50513 . 53345)))))
(FILEMAP (NIL (8312 26570 (\TEDIT.INTERRUPT.SETUP 8322 . 9969) (\TEDIT.MARKACTIVE 9971 . 10300) (
\TEDIT.MARKINACTIVE 10302 . 10518) (\TEDIT.COMMAND.LOOP 10520 . 19978) (\TEDIT.COMMAND.RESET.SETUP
19980 . 26568)) (26854 42051 (\TEDIT.READTABLE 26864 . 28521) (\TEDIT.WORDBOUND.READTABLE 28523 .
31116) (TEDIT.GETSYNTAX 31118 . 33557) (TEDIT.SETSYNTAX 33559 . 36037) (TEDIT.GETFUNCTION 36039 .
37399) (TEDIT.SETFUNCTION 37401 . 39840) (TEDIT.WORDGET 39842 . 40103) (TEDIT.WORDSET 40105 . 40802) (
TEDIT.ATOMBOUND.READTABLE 40804 . 42049)) (42379 43288 (\TEDIT.WHEELSCROLL 42389 . 43286)) (43441
49021 (\TEDIT.CLIPBOARD 43451 . 45206) (\TEDIT.COPYTOCLIPBOARD 45208 . 45988) (
\TEDIT.EXTRACTTOCLIPBOARD 45990 . 46185) (\TEDIT.WRITE.SEL 46187 . 49019)))))
STOP

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

Binary file not shown.

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

720
library/tedit/TEDIT-FIND
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Mar-2024 12:06:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;102 30083
(FILECREATED " 8-Dec-2024 15:49:12" {WMEDLEY}<library>tedit>TEDIT-FIND.;134 36434
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.BASICFIND \TEDIT.BASICFIND.BACKWARD \TEDIT.WCFIND.BACKWARD)
:CHANGES-TO (FNS TEDIT.SUBSTITUTE)
:PREVIOUS-DATE "15-Mar-2024 14:10:05" {WMEDLEY}<library>tedit>TEDIT-FIND.;98)
:PREVIOUS-DATE "26-Nov-2024 23:53:41" {WMEDLEY}<library>TEDIT>TEDIT-FIND.;132)
(PRETTYCOMPRINT TEDIT-FINDCOMS)
@@ -28,7 +28,9 @@
(DEFINEQ
(TEDIT.FIND
[LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS?) (* ; "Edited 19-Jun-2023 22:27 by rmk")
[LAMBDA (TSTREAM TARGET START END WILDCARDS?) (* ; "Edited 10-May-2024 21:55 by rmk")
(* ; "Edited 24-Apr-2024 23:47 by rmk")
(* ; "Edited 19-Jun-2023 22:27 by rmk")
(* ; "Edited 6-May-2018 17:34 by rmk:")
(* ; "Edited 30-May-91 20:56 by jds")
@@ -38,26 +40,30 @@
(* ;; "RMK: FIND isn't undoable, FIND-AGAIN is armed on meta-g. No point in hiding a previous actual edit and then having to undo a find in order to undo the intended previous event. Or maybe undoing FIND would put you back where you started?")
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(CL:WHEN TARGETSTRING
(SETQ TARGETSTRING (MKSTRING TARGETSTRING))
(CL:UNLESS END
(SETQ END (TEXTLEN TEXTOBJ)))
(CL:UNLESS START
(SETQ START (TEDIT.GETPOINT TEXTOBJ)))
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:WHEN TARGET
(* ;; "* and # are implicitly quoted if not WILDCARDS? This could be handled simply by calling CONS instead of \TEDIT.PARSE.SEARCHSTRING")
(CL:WHEN (ILEQ START END)
(CL:IF WILDCARDS?
(\TEDIT.WCFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(\TEDIT.PARSE.SEARCHSTRING TARGETSTRING)
START END)
(CAR (\TEDIT.BASICFIND (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
TARGETSTRING START END)))))])
[if (IMAGEOBJP TARGET)
then (TEDIT.FIND.OBJECT TSTREAM TARGET START END)
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
then (CL:UNLESS END
(SETQ END (FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
TEXTLEN)))
(CL:UNLESS START
(SETQ START (TEDIT.GETPOINT TSTREAM)))
(CL:WHEN (ILEQ START END)
(CL:IF WILDCARDS?
(\TEDIT.WCFIND TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET)
START END)
(CAR (\TEDIT.BASICFIND TSTREAM TARGET START END))))])])
(TEDIT.FIND.BACKWARD
[LAMBDA (TEXTOBJ TARGETSTRING START END WILDCARDS? AGAIN) (* ; "Edited 12-Jul-2023 08:24 by rmk")
[LAMBDA (TSTREAM TARGET START END WILDCARDS? AGAIN) (* ; "Edited 19-May-2024 12:07 by rmk")
(* ; "Edited 10-May-2024 22:00 by rmk")
(* ; "Edited 24-Apr-2024 23:43 by rmk")
(* ; "Edited 12-Jul-2023 08:24 by rmk")
(* ; "Edited 20-Jun-2023 12:12 by rmk")
(* ; "Edited 18-Jun-2023 23:43 by rmk")
(* ; "Edited 30-May-91 19:17 by jds")
@@ -66,197 +72,220 @@
(* ;; "If WILDCARDS?, the value is the pair (MATCHSTART MATCHEND) for that match, since the caller doesn't know the length. But if not WILDCARDS?, just the match-start, since the caller knows the match is (NCHARS TARGETSTRING) long. This is quirky, but that's the way it is documented.")
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(CL:WHEN [AND TARGETSTRING (NEQ 0 (NCHARS (SETQ TARGETSTRING (MKSTRING TARGETSTRING]
(SETQ START (IMAX 1 (OR START 1)))
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TEXTOBJ)))
(TEXTLEN TEXTOBJ)))
(CL:WHEN AGAIN
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:WHEN TARGET
[if (IMAGEOBJP TARGET)
then (TEDIT.FIND.OBJECT.BACKWARD TSTREAM TARGET START END AGAIN)
elseif [NEQ 0 (NCHARS (SETQ TARGET (MKSTRING TARGET]
then (SETQ START (IMAX 1 (OR START 1)))
(SETQ END (IMIN (OR END (SUB1 (TEDIT.GETPOINT TSTREAM)))
(FGETTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)
TEXTLEN)))
(CL:WHEN AGAIN
(* ;; "Assume that we aren't interested in another match at the current position.")
(* ;;
 "Assume that we aren't interested in another match at the current position.")
(ADD END -1))
(CL:WHEN (ILEQ START END)
(CL:IF WILDCARDS?
(\TEDIT.WCFIND.BACKWARD (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
(DREVERSE (\TEDIT.PARSE.SEARCHSTRING TARGETSTRING))
START END)
(CAR (\TEDIT.BASICFIND.BACKWARD (ffetch (TEXTOBJ STREAMHINT) of TEXTOBJ)
TARGETSTRING START END)))))])
(ADD END -1))
(CL:WHEN (ILEQ START END)
(CL:IF WILDCARDS?
(\TEDIT.WCFIND.BACKWARD TSTREAM (\TEDIT.PARSE.SEARCHSTRING TARGET T)
START END)
(CAR (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END))))])])
(TEDIT.SUBSTITUTE
[LAMBDA (TEXTSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 15-Mar-2024 14:09 by rmk")
[LAMBDA (TSTREAM PATTERN REPLACEMENT CONFIRM?) (* ; "Edited 8-Dec-2024 15:47 by rmk")
(* ; "Edited 26-Nov-2024 23:49 by rmk")
(* ; "Edited 15-Aug-2024 09:20 by rmk")
(* ; "Edited 14-Jul-2024 00:24 by rmk")
(* ; "Edited 7-Jul-2024 11:46 by rmk")
(* ; "Edited 29-Jun-2024 10:49 by rmk")
(* ; "Edited 18-May-2024 23:03 by rmk")
(* ; "Edited 9-Mar-2024 11:36 by rmk")
(* ; "Edited 3-Mar-2024 12:24 by rmk")
(* ; "Edited 29-Feb-2024 17:00 by rmk")
(* ; "Edited 27-Feb-2024 08:20 by rmk")
(* ; "Edited 12-May-2024 21:11 by rmk")
(* ; "Edited 15-Mar-2024 14:09 by rmk")
(* ; "Edited 6-Jan-2024 11:09 by rmk")
(* ; "Edited 12-Nov-2023 12:29 by rmk")
(* ; "Edited 22-Sep-2023 20:36 by rmk")
(* ; "Edited 31-May-2023 00:04 by rmk")
(* ; "Edited 24-May-2023 20:01 by rmk")
(* ; "Edited 30-Mar-94 16:04 by jds")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(* ;; "Replace all instances of PATTERN with REPLACEMENT. If CONFIRM? is non-NIL, ask before each replacement.")
(CL:UNLESS (\TEDIT.READONLY TEXTSTREAM)
(PROG ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
(NREPLACEMENTS 0)
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
ACTIONSTRING)
(CL:UNLESS [SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
(\TEDIT.GET.TARGET.STRING TEXTOBJ
'TEDIT.LAST.SUBSTITUTE.STRING]
(* ;
 "If the search pattern is empty, bail out.")
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
(RETURN))
(CL:UNLESS REPLACEMENT
[SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ "Replace string:" (GETTEXTPROP
TEXTOBJ
'
(CL:UNLESS (\TEDIT.READONLY TSTREAM)
(RESETLST
(PROG ((TEXTOBJ (TEXTOBJ TSTREAM))
(NREPLACEMENTS 0)
(YESLIST '("Y" "y" "yes" "YES" "T" "Yes"))
SEARCHSTRING ABORTFLG ENDCHAR# STARTCHAR# RANGE CONFIRMFLG SEL EOLSEEN REPLACE-LEN
ACTIONSTRING)
(* ;; "Don't call \TEDIT.GET.TARGET.STRING because it might pick the search-domain (current selection) as the search string. If the search pattern is empty, bail out.")
[CL:UNLESS (SETQ SEARCHSTRING (OR PATTERN (TEDIT.GETINPUT TEXTOBJ "Search string:"
(GETTEXTPROP TEXTOBJ
'
TEDIT.LAST.SUBSTITUTE.STRING
]
(CL:UNLESS [OR REPLACEMENT (SETQ REPLACEMENT (TEDIT.GETINPUT TEXTOBJ
"Replace string:"
(GETTEXTPROP TEXTOBJ
'
TEDIT.LAST.REPLACEMENT.STRING
])
(if (type? SELPIECES REPLACEMENT)
elseif (OR (STRINGP REPLACEMENT)
(LITATOM REPLACEMENT))
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ))
elseif (LISTP REPLACEMENT)
then (HELP "LISTP REPLACEMENT"))
]
(TEDIT.PROMPTPRINT TEXTOBJ "[Aborted]")
(RETURN))
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(if (type? SELPIECES REPLACEMENT)
elseif (OR (STRINGP REPLACEMENT)
(LITATOM REPLACEMENT))
then (SETQ REPLACEMENT (\TEDIT.SELPIECES.FROM.STRING REPLACEMENT TEXTOBJ)))
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
(* ;; "Could be NIL or empty string, meaning just delete all occurrences.")
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
"delet"
"substitut"))
(SETQ REPLACE-LEN (fetch (SELPIECES SPLEN) of REPLACEMENT))
(SETQ ACTIONSTRING (CL:IF (ZEROP REPLACE-LEN)
"delet"
"substitut"))
(* ;;
 "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")
(* ;;
 "If a pattern is specd in the call, use the caller's confirm flag, otherwise ask for one.")
(SETQ CONFIRMFLG (CL:IF PATTERN
CONFIRM?
(MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each "
ACTIONSTRING "ion?")
"No")
YESLIST)))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
"ing...")
T)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(SETQ CONFIRMFLG (CL:IF PATTERN
CONFIRM?
(MEMBER (TEDIT.GETINPUT TEXTOBJ (CONCAT "Ask before each "
ACTIONSTRING "ion?")
"No")
YESLIST)))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT (L-CASE ACTIONSTRING T)
"ing...")
T)
(SETQ SEL (fetch (TEXTOBJ SEL) of TEXTOBJ))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(* ; "Turn off any blue pending delete")
(* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")
(* ;; "STARTCHAR# and ENDCHAR# bound each search. ENDCHAR# has to be reduced as STARTCHAR# increases, so the search stays within the selection.")
(SETQ STARTCHAR# (GETSEL SEL CH#))
[SETQ ENDCHAR# (IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH]
[if CONFIRMFLG
then
(* ;; "In this case the selection moves along, ending up at the last hit.")
(SETQ STARTCHAR# (GETSEL SEL CH#))
[SETQ ENDCHAR# (CL:IF (ZEROP (GETSEL SEL DCH))
(GETTOBJ TEXTOBJ TEXTLEN)
(IPLUS STARTCHAR# (SUB1 (GETSEL SEL DCH))))]
[if CONFIRMFLG
then
(* ;; "In this case the selection moves along, ending up at the last hit.")
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING
STARTCHAR# ENDCHAR# T))
do (* ;
[bind PENDING.SEL CHOICE while (SETQ RANGE (TEDIT.FIND TEXTOBJ
SEARCHSTRING STARTCHAR#
ENDCHAR# T))
do (* ;
 "Show each substitution site and ask for permission")
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
'RIGHT T))
(\TEDIT.SHOWSEL PENDING.SEL T)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
"OK to replace? ['q' quits]" "Yes")
1))
(Q (RETURN))
(Y (* ; "Do this one")
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ PENDING.SEL)
(add NREPLACEMENTS 1)
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
(SETQ PENDING.SEL (TEDIT.SETSEL TEXTOBJ (CAR RANGE)
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE)))
'RIGHT T))
(\TEDIT.SHOWSEL PENDING.SEL T TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ PENDING.SEL)
(SELECTQ (U-CASE (NTHCHAR (TEDIT.GETINPUT TEXTOBJ
"OK to replace? ['q' quits]" "Yes")
1))
(Q (RETURN))
(Y (* ; "Do this one")
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ PENDING.SEL)
(add NREPLACEMENTS 1)
(SETQ STARTCHAR# (GETSEL PENDING.SEL CHLIM))
(* ; "Next start, compensate for end")
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN (ADD1 (IDIFFERENCE
(CADR RANGE)
(CAR RANGE])
(PROGN
(* ;;
[add ENDCHAR# (IDIFFERENCE REPLACE-LEN
(ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE])
(PROGN
(* ;;
 "Turn off rejected selection, search for next starting one charcter later. ENDCHAR# is still OK.")
(TEDIT.SHOWSEL TEXTOBJ NIL PENDING.SEL)
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
else
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
(\TEDIT.SHOWSEL PENDING.SEL NIL TEXTOBJ)
(SETQ STARTCHAR# (ADD1 (CAR RANGE]
else
(* ;; "No confirmation required. Do the substitutions without showing intermediate work, collect all of the replacement events")
(bind FIRSTHIT HITLEN HITDIFF (TOTALDIFF _ 0)
(SAVESEL _ (\TEDIT.COPYSEL SEL))
while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR# ENDCHAR# T))
collect (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
(SETQ FIRSTHIT (CAR RANGE)))
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE]
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
HITLEN
'RIGHT)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ SEL)
(add NREPLACEMENTS 1)
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
(add ENDCHAR# HITDIFF)
(add TOTALDIFF HITDIFF)
(\TEDIT.POPEVENT TEXTOBJ)
finally (CL:WHEN $$VAL
(bind FIRSTHIT HITLAST HITLEN HITDIFF (TOTALDIFF _ 0)
(SAVESEL _ (\TEDIT.COPYSEL SEL))
EVENTS while (SETQ RANGE (TEDIT.FIND TEXTOBJ SEARCHSTRING STARTCHAR#
ENDCHAR# T))
do (CL:UNLESS FIRSTHIT (* ; "For final line updating.")
(SETQ FIRSTHIT (CAR RANGE)))
[SETQ HITLEN (ADD1 (IDIFFERENCE (CADR RANGE)
(CAR RANGE]
(\TEDIT.UPDATE.SEL SEL (CAR RANGE)
HITLEN
'RIGHT)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY REPLACEMENT
'COPY TEXTOBJ)
TEXTOBJ SEL)
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
(* ;
 "Collect the events for a single composite")
(add NREPLACEMENTS 1)
(SETQ STARTCHAR# (GETSEL SEL CHLIM))
(SETQ HITLAST STARTCHAR#)
(SETQ HITDIFF (IDIFFERENCE REPLACE-LEN HITLEN))
(add ENDCHAR# HITDIFF)
(add TOTALDIFF HITDIFF)
finally (CL:UNLESS (EQ NREPLACEMENTS 0)
(* ;;
 "At least one replacement, update the lines that have changed.")
(* ;;
 "At least one replacement, update the lines that have changed.")
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
(IDIFFERENCE (GETSEL SEL CHLIM)
FIRSTHIT))
(\TEDIT.UPDATE.LINES TEXTOBJ 'INSERTION FIRSTHIT
(IDIFFERENCE (GETSEL SEL CHLIM)
FIRSTHIT))
(* ;; "We want the new selection to begin at the beginning of the original selection, somewhere before the first hit, and end at the position that the prior ending moved to. The text grew or shrank with each hit.")
(* ;; "Not clear what the final selection should be, if there are multiple changes. The original selection? A selection that goes from the beginning of the first subsitution to the end of the last (as here)? Or just the selection of the last substitution?")
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UPDATE.SEL SEL (GETSEL SAVESEL CH#)
(IPLUS (GETSEL SAVESEL DCH)
TOTALDIFF)
'RIGHT)
(\TEDIT.HISTORYADD TEXTOBJ (DREVERSE $$VAL)))]
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL FIRSTHIT (IDIFFERENCE HITLAST FIRSTHIT
)
'RIGHT)
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))]
(* ;; "Save the search & replacement strings to offer for next time:")
(* ;; "Save the search & replacement strings to offer for next time:")
(\TEDIT.SHOWSEL SEL T)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
REPLACEMENT NIL TEXTOBJ))
(TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
(0 (CONCAT " No " ACTIONSTRING "ions made"))
(1 (CONCAT " 1 " ACTIONSTRING "ion made"))
(CONCAT " " (MKSTRING NREPLACEMENTS)
" " ACTIONSTRING "ions made"))
T)
(RETURN NREPLACEMENTS)))])
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.NORMALIZECARET TSTREAM SEL)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.SUBSTITUTE.STRING SEARCHSTRING)
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.REPLACEMENT.STRING (\TEDIT.SELPIECES.TO.STRING
REPLACEMENT NIL TEXTOBJ))
(TEDIT.PROMPTPRINT TEXTOBJ (SELECTQ NREPLACEMENTS
(0 (CONCAT " No " ACTIONSTRING "ions made"))
(1 (CONCAT " 1 " ACTIONSTRING "ion made"))
(CONCAT " " (MKSTRING NREPLACEMENTS)
" " ACTIONSTRING "ions made"))
T)
(RETURN NREPLACEMENTS))))])
(TEDIT.NEXT
[LAMBDA (STREAM) (* ; "Edited 15-Mar-2024 13:34 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 21-Oct-2024 00:40 by rmk")
(* ; "Edited 7-Jul-2024 11:47 by rmk")
(* ; "Edited 18-May-2024 16:23 by rmk")
(* ; "Edited 12-May-2024 21:10 by rmk")
(* ; "Edited 16-Feb-2024 23:48 by rmk")
(* ; "Edited 15-Mar-2024 13:34 by rmk")
(* ; "Edited 14-Dec-2023 21:20 by rmk")
(* ; "Edited 20-Jun-2023 00:05 by rmk")
(* ; "Edited 3-May-2023 23:47 by rmk")
(* ; "Edited 18-Apr-2023 23:46 by rmk")
(* ; "Edited 30-May-91 20:57 by jds")
(LET ((TEXTOBJ (TEXTOBJ STREAM))
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
TARGET SEL OPTION FIELDSEL)
(SETQ SEL (TEXTSEL TEXTOBJ))
(SETQ TARGET (TEDIT.FIND TEXTOBJ ">>*<<" NIL NIL T))(* ;
 "find the first >>delimited<< field")
(SETQ FIELDSEL (MBUTTON.FIND.NEXT.FIELD TEXTOBJ (GETSEL SEL CH#)))
(* ;
(SETQ FIELDSEL (TEDIT.FIND TEXTOBJ "{*}" NIL NIL T))(* ;
 "find the first menu-type insertion field, usually delimited with {}")
[SETQ OPTION (COND
[(AND TARGET FIELDSEL) (* ; "take the first one")
@@ -273,28 +302,30 @@
(replace (TEXTOBJ BLUEPENDINGDELETE) of TEXTOBJ with T)
(* ;
 "Original comment: %"never pending a deletion%", but it is!")
(\TEDIT.SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
 "Set up SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (CAR TARGET)
(IDIFFERENCE (ADD1 (CADR TARGET))
(CAR TARGET))
'RIGHT)
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "Always selected normally")
'RIGHT
'PENDINGDEL)
(\TEDIT.FIXSEL SEL TEXTOBJ) (* ; "Always selected normally")
(TEDIT.NORMALIZECARET TEXTOBJ) (* ; "And get it into the window")
(\TEDIT.SHOWSEL SEL T))
(\TEDIT.SHOWSEL SEL T TEXTOBJ))
(FIELD (* ;
 "Update the selection for this textobj from the scratch sel returned from MBUTTON.FIND.NEXT.FIELD")
(FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
(\TEDIT.SHOWSEL SEL NIL) (* ;
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ) (* ;
 "Set SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (GETSEL FIELDSEL CH#)
(GETSEL FIELDSEL DCH)
'LEFT)
(\TEDIT.SET.SEL.LOOKS SEL 'PENDINGDEL) (* ; "And get it into the window")
'LEFT
'PENDINGDEL) (* ; "And get it into the window")
(\TEDIT.FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ))
(NEITHER (TEDIT.PROMPTPRINT TEXTOBJ "No more blanks to fill in." T)
(SETQ SEL NIL))
(SHOULDNT "No legal value found in selectq in TEDIT.NEXT"))
(\TEDIT.THELP "No legal value found in SELECTQ in TEDIT.NEXT"))
(CL:WHEN SEL (* ;
 "There really IS a selection made here, so set up the charlooks for it properly.")
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL)))])
@@ -307,192 +338,227 @@
(DEFINEQ
(\TEDIT.WCFIND
[LAMBDA (TSTREAM TARGETLIST START END HITSTART ANCHORED) (* ; "Edited 19-Jun-2023 23:50 by rmk")
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:04 by rmk")
(* ; "Edited 23-Jun-2024 12:00 by rmk")
(* ; "Edited 19-May-2024 23:46 by rmk")
(* ; "Edited 3-May-2024 07:11 by rmk")
(* ; "Edited 29-Apr-2024 20:45 by rmk")
(* ; "Edited 17-Mar-2024 11:59 by rmk")
(* ; "Edited 20-Jun-2023 13:52 by rmk")
(* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITSTART is the first character of such a match")
(* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")
(CL:UNLESS (IGREATERP START END)
[LET (RESULT)
(COND
((NULL TARGETLIST) (* ; "Final match")
(LIST (OR HITSTART (SUB1 START))
(SUB1 START)))
[(EQ '%# (CAR TARGETLIST)) (* ;
 "Single-char wildcard, next segment is anchored ")
(OR (\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
(ADD1 START)
END
(OR HITSTART START)
T)
(CL:UNLESS ANCHORED (* ;
 "Initial # didn't match, let it slide in this loop")
(for S from (ADD1 START) to END
when (SETQ RESULT (\TEDIT.WCFIND TSTREAM TARGETLIST S END S T))
do (RETURN RESULT)))]
((EQ '* (CAR TARGETLIST))
(CL:WHEN TARGETLIST
[bind STACK CONFIG HITSTART ANCHORED RESULT TARGETTAIL TARGET (TOPSTART _ (SUB1 START))
do (SETQ CONFIG (pop STACK))
(if CONFIG
then (SETQ START (pop CONFIG))
(SETQ TARGETTAIL (pop CONFIG))
(SETQ HITSTART (pop CONFIG))
(SETQ ANCHORED (pop CONFIG))
elseif (IGEQ TOPSTART END)
then (RETURN NIL) (* ; "No more, failed")
else (add TOPSTART 1) (* ; "First time or outer advance")
(SETQ START TOPSTART)
(SETQ TARGETTAIL TARGETLIST)
(SETQ HITSTART NIL)
(SETQ ANCHORED NIL))
(SETQ TARGET (CAR TARGETTAIL))
(SELECTQ TARGET
(%# (CL:UNLESS (CDR TARGETTAIL)
(RETURN (LIST (OR HITSTART START)
START)))
(CL:WHEN (ILEQ START END) (* ;
 "If we are unanchored, slipping continues")
(push STACK (LIST (ADD1 START)
(CDR TARGETTAIL)
(OR HITSTART START)
ANCHORED))))
(*
(* ;; "Unanchored config for the tail that starts here.")
(* ;; "Variable width wildcard, not anchored so the match can slide along.")
(\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
START END HITSTART))
((SETQ RESULT (\TEDIT.BASICFIND TSTREAM (CAR TARGETLIST)
START END ANCHORED)) (* ;
 "Matched a string segment, keep going")
(\TEDIT.WCFIND TSTREAM (CDR TARGETLIST)
(ADD1 (CADR RESULT))
END
(OR HITSTART (CAR RESULT])])
(push STACK (LIST START (CDR TARGETTAIL)
HITSTART NIL)))
(if (SETQ RESULT (\TEDIT.BASICFIND TSTREAM TARGET START END ANCHORED))
then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!")
(RETURN (LIST (OR HITSTART (CAR RESULT))
(CADR RESULT))))
(SETQ START (ADD1 (CADR RESULT))) (* ; "Next target")
(CL:WHEN (ILEQ START END)
[push STACK (LIST START (CDR TARGETTAIL)
(OR HITSTART (CAR RESULT])
elseif (NOT ANCHORED)
then (RETURN NIL])])
(\TEDIT.BASICFIND
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 12:03 by rmk")
(* ; "Edited 22-Jun-2024 12:01 by rmk")
(* ; "Edited 19-May-2024 23:18 by rmk")
(* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 20-Jun-2023 00:11 by rmk")
(* ; "Edited 30-May-91 20:56 by jds")
(* ;; "Search thru TEXTOBJ, starting where the caret is, for an exact match of TARGETSTRING. Optionally, start the search at character START. ")
(* ;; "Search thru TSTREAM for an exact match of TARGETSTRING. ")
(* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")
(bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
(CHAR1 _ (NTHCHARCODE TARGETSTRING 1))
(ANCHOR _ (SUB1 START)) first [SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
(ANCHOR _ (SUB1 START)) first (CL:WHEN (ZEROP NCHARS)
(RETURN NIL))
[SETQ LASTANCHOR (ADD1 (CL:IF ANCHORED
ANCHOR
(IDIFFERENCE END NCHARS))]
eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
(IDIFFERENCE END NCHARS))]
(* ;; "Match failed, bump the start--single char wild-card # always matches")
while [SETQ ANCHOR (find A from (ADD1 ANCHOR) to LASTANCHOR suchthat (EQ CHAR1 (BIN TSTREAM]
when [OR (EQ NCHARS 1)
(for I from 2 to NCHARS always (EQ (NTHCHARCODE TARGETSTRING I)
(BIN TSTREAM]
do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
(* ;; "LASTANCHOR protects us from running into the EOF")
eachtime (CL:WHEN (IGEQ ANCHOR LASTANCHOR)
(RETURN NIL))
(\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
(add ANCHOR 1) (* ; "Move the anchor up 1")
(* ;; "Match failed, bump the start--single char wild-card # always matches")
when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
(BIN TSTREAM))
(RETURN NIL))
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
(RETURN T))) do (RETURN (LIST ANCHOR (IPLUS ANCHOR (SUB1 NCHARS])
(\TEDIT.WCFIND.BACKWARD
[LAMBDA (TSTREAM TARGETLIST START END HITEND ANCHORED) (* ; "Edited 17-Mar-2024 11:59 by rmk")
[LAMBDA (TSTREAM TARGETLIST START END) (* ; "Edited 26-Jun-2024 08:05 by rmk")
(* ; "Edited 23-Jun-2024 12:02 by rmk")
(* ; "Edited 19-May-2024 23:46 by rmk")
(* ; "Edited 3-May-2024 07:11 by rmk")
(* ; "Edited 29-Apr-2024 20:45 by rmk")
(* ; "Edited 17-Mar-2024 11:59 by rmk")
(* ; "Edited 20-Jun-2023 13:52 by rmk")
(* ;; "Returns the (start end) pair of a match possibly with wild cards, where HITEND is the last character of such a match")
(* ;; "Returns the (start end) pair of the nearest match somewhere at or after START, possibly with wild cards. The basic-find does fast search of simple strings. This is all about backtracking to advance the search on failure, and for wild cards. Note that *'s do not appear on the edges.")
(LET (RESULT)
(COND
((NULL TARGETLIST) (* ; "Final match")
(LIST (ADD1 (\TEDIT.TEXTGETFILEPTR TSTREAM))
(OR HITEND END)))
[(EQ '%# (CAR TARGETLIST)) (* ;
 "Single-char wildcard, next segment is anchored ")
(OR (\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
START
(SUB1 END)
(OR HITEND END)
T)
(CL:UNLESS ANCHORED (* ;
 "Initial # didn't match, let it slide in this loop")
(for E from (SUB1 END) to START by -1
when (SETQ RESULT (\TEDIT.WCFIND.BACKWARD TSTREAM TARGETLIST START E E T))
do (RETURN RESULT)))]
((EQ '* (CAR TARGETLIST))
(CL:WHEN TARGETLIST
[bind STACK CONFIG HITEND ANCHORED RESULT TARGETTAIL TARGET (TOPEND _ (ADD1 END))
do (SETQ CONFIG (pop STACK))
(if CONFIG
then (SETQ END (pop CONFIG))
(SETQ TARGETTAIL (pop CONFIG))
(SETQ HITEND (pop CONFIG))
(SETQ ANCHORED (pop CONFIG))
elseif (ILEQ TOPEND START)
then (RETURN NIL) (* ; "No more, failed")
else (add TOPEND -1) (* ; "First time or outer advance")
(SETQ END TOPEND)
(SETQ TARGETTAIL TARGETLIST)
(SETQ HITEND NIL)
(SETQ ANCHORED NIL))
(SETQ TARGET (CAR TARGETTAIL))
(SELECTQ TARGET
(%# (CL:UNLESS (CDR TARGETTAIL)
(RETURN (LIST END (OR HITEND END))))
(CL:WHEN (ILEQ START END) (* ;
 "If we are unanchored, slipping continues")
(push STACK (LIST (SUB1 END)
(CDR TARGETTAIL)
(OR HITEND (SUB1 END))
ANCHORED))))
(*
(* ;; "Unanchored config for the tail that starts here.")
(* ;; "Variable width wildcard, not anchored so the match can slide along.")
(\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
START END HITEND))
((SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM (CAR TARGETLIST)
START END ANCHORED)) (* ;
 "Matched a string segment, keep going")
(\TEDIT.WCFIND.BACKWARD TSTREAM (CDR TARGETLIST)
START
(SUB1 (CAR RESULT))
(OR HITEND (CADR RESULT])
(push STACK (LIST END (CDR TARGETTAIL)
HITEND NIL)))
(if (SETQ RESULT (\TEDIT.BASICFIND.BACKWARD TSTREAM TARGET START END ANCHORED))
then (CL:UNLESS (CDR TARGETTAIL) (* ; "Success!")
[RETURN (LIST (CAR RESULT)
(OR HITEND (CADR RESULT])
(SETQ END (SUB1 (CADR RESULT))) (* ; "Next target")
(CL:WHEN (ILEQ START END)
[push STACK (LIST END (CDR TARGETTAIL)
(OR HITEND (CADR RESULT])
elseif (NOT ANCHORED)
then (RETURN NIL])])
(\TEDIT.BASICFIND.BACKWARD
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 12-Jul-2023 08:14 by rmk")
(* ; "Edited 23-Apr-2023 12:42 by rmk")
[LAMBDA (TSTREAM TARGETSTRING START END ANCHORED) (* ; "Edited 23-Jun-2024 11:32 by rmk")
(* ; "Edited 19-May-2024 23:07 by rmk")
(* ; "Edited 17-Mar-2024 12:06 by rmk")
(* ; "Edited 20-Jun-2023 00:11 by rmk")
(* ; "Edited 30-May-91 20:56 by jds")
(* ;; "Returns a (Startmatch Endmatch) pair of character positions in TSTREAM that denote the nearest occurrence of TARGETSTRING whose first character is at or ahead of START and whose last character is at or before END. ")
(* ;; "Seach backwards thru TSTREAM for an exact match of TARGETSTRING.")
(* ;; "A better interface would return a selection for the string-match, but we repeat the pair interface that is documented for forward search.")
(* ;; "Returns a (startmatch endmatch) pair of character positions in TSTREAM")
(* ;;
 "Note that caller must decrement END in subsequent calls to avoid looping on the same match.")
(bind LASTANCHOR (NCHARS _ (NCHARS TARGETSTRING))
(ANCHOR _ (ADD1 END)) first (CL:WHEN (ZEROP NCHARS)
(RETURN NIL))
(CL:WHEN ANCHORED
(SETQ START (IDIFFERENCE ANCHOR NCHARS)))
(* ;; "")
(* ;; "LASTANCHOR protects agains the beginning of the stream")
(* ;; "The last target character first matches at END. Setting the initial ANCHOR one past END and going into the anchor backup loop won't work if END points to the last character in the stream--the \TEXTSETFILEPTR would be out of bounds. So the first anchor-match has to be special, by setting the fileptr at END and peeking.")
[SETQ END (IMIN END (TEXTLEN (TEXTOBJ TSTREAM]
(bind ANCHOR LASTANCHOR (NCHARS1 _ (SUB1 (NCHARS TARGETSTRING)))
(CHARN _ (NTHCHARCODE TARGETSTRING -1))
first
(* ;; "NCHARS1 because the last character is matched separately.")
(CL:WHEN (ILESSP (IDIFFERENCE END START)
NCHARS1) (* ; "Too few characters")
(RETURN NIL))
(\TEDIT.TEXTSETFILEPTR TSTREAM (SUB1 END))
(CL:WHEN [AND (EQ CHARN (\TEDIT.TEXTPEEKBIN TSTREAM))
(OR (EQ NCHARS1 0)
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
(\TEDIT.TEXTBACKFILEPTR
TSTREAM]
(RETURN (LIST (IDIFFERENCE END NCHARS1)
END)))
(CL:WHEN ANCHORED (* ; "Anchored at END, didn't match")
(RETURN NIL))
(SETQ ANCHOR (SUB1 END))
(SETQ LASTANCHOR (IPLUS START NCHARS1)) eachtime (\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
(* ;
 "The filepos one before the last CHARN match")
(ADD ANCHOR -1)
(* ; "For next attempt")
while (find old ANCHOR from ANCHOR to LASTANCHOR by -1 suchthat (EQ CHARN (
\TEDIT.TEXTBACKFILEPTR
TSTREAM)))
when [OR (EQ NCHARS1 0)
(for I from NCHARS1 to 1 by -1 always (EQ (NTHCHARCODE TARGETSTRING I)
(\TEDIT.TEXTBACKFILEPTR TSTREAM]
do (ADD ANCHOR 1)
(RETURN (LIST (IDIFFERENCE ANCHOR NCHARS1)
ANCHOR])
[SETQ LASTANCHOR (SUB1 (CL:IF ANCHORED
ANCHOR
(IPLUS START NCHARS))]
eachtime (CL:WHEN (ILESSP ANCHOR LASTANCHOR) (* ; "Won't fit in the frame")
(RETURN NIL))
(add ANCHOR -1) (* ; "Move the anchor back 1")
(\TEDIT.TEXTSETFILEPTR TSTREAM ANCHOR)
when (for I from 1 do (CL:UNLESS (EQ (NTHCHARCODE TARGETSTRING I)
(\TEDIT.TEXTBACKFILEPTR TSTREAM))
(RETURN NIL))
(CL:WHEN (EQ I NCHARS) (* ; "Matched the last char")
(RETURN T))) do (RETURN (LIST (IDIFFERENCE (ADD1 ANCHOR)
NCHARS)
ANCHOR])
(\TEDIT.PARSE.SEARCHSTRING
[LAMBDA (TARGETSTRING) (* ; "Edited 19-Jun-2023 16:42 by rmk")
[LAMBDA (TARGETSTRING BACKWARD) (* ; "Edited 23-Jun-2024 08:02 by rmk")
(* ; "Edited 19-May-2024 22:43 by rmk")
(* ; "Edited 19-Jun-2023 16:42 by rmk")
(* jds "31-Jan-84 13:26")
(* ;;
 "Quote Is an escape if it comes before a wild card. ''# would match ' in front of literal .")
(* ;; "Parse TARGETSTRING into string-segments that are separated by the wild-card characters # and * (or escape). Each # is left as its own segment, multiple *'s collapse to one, and *'s on the edges are removed. ' quotes the following character.")
(for TTAIL C SEG on (CHCON TARGETSTRING)
do (SETQ C (CAR TTAIL))
(SELCHARQ C
(%' (if (MEMB (CADR TTAIL)
(CHARCODE (%# *)))
then (POP TTAIL)
(PUSH SEG (CAR TTAIL))
else (PUSH SEG C)))
(%# (CL:WHEN SEG
(push $$VAL (CONCATCODES (DREVERSE SEG))))
(push $$VAL (CHARACTER C))
(SETQ SEG NIL))
(* (CL:UNLESS (EQ (CAR $$VAL)
'*) (* ; "Reduce adjacent *s to one.")
(CL:WHEN SEG
(push $$VAL (CONCATCODES (DREVERSE SEG))))
(CL:UNLESS $$VAL (* ; "Ignore leading *")
(push $$VAL (CHARACTER C)))
(SETQ SEG NIL)))
(PUSH SEG C)) finally [if SEG
then (PUSH $$VAL (CONCATCODES (DREVERSE SEG)))
else (* ; "Ignore trailing *")
(SETQ $$VAL (find VTAIL on $$VAL
suchthat (NEQ (CAR $$VAL)
'*]
(RETURN (CL:IF $$VAL
(DREVERSE $$VAL)
TARGETSTRING)])
(* ;; "If BACKWARD, the search string segments are reverse, and the characters within each segment are reversed, so that the search can go backwards.")
(* ;; " ")
(for CTAIL C SEGCODES on (CHCON TARGETSTRING) eachtime (SETQ C (CAR CTAIL))
do (SELCHARQ C
((* ESCAPE) (* ;
 "Throw away the first and multiiple *'s")
(CL:WHEN SEGCODES
[push $$VAL (CONCATCODES (CL:IF BACKWARD
SEGCODES
(DREVERSE SEGCODES))]
(SETQ SEGCODES NIL))
(CL:WHEN (AND $$VAL (NEQ '* (CAR $$VAL)))
(push $$VAL '*)))
(%# (* ; "# stands alone")
(CL:WHEN SEGCODES
[push $$VAL (CONCATCODES (CL:IF BACKWARD
SEGCODES
(DREVERSE SEGCODES))])
(push $$VAL '%#)
(SETQ SEGCODES NIL))
(%' (* ; "Quote the next character")
(CL:WHEN (CDR CTAIL)
(push SEGCODES (CADR CTAIL))
(SETQ CTAIL (CDR CTAIL))))
(push SEGCODES C)) finally (if SEGCODES
then [push $$VAL (CONCATCODES (CL:IF BACKWARD
SEGCODES
(DREVERSE SEGCODES))]
elseif (EQ '* (CAR $$VAL))
then
(* ;; "Strip the first edge *")
(pop $$VAL))
(RETURN (CL:IF BACKWARD
$$VAL
(DREVERSE $$VAL))])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (832 18922 (TEDIT.FIND 842 . 2482) (TEDIT.FIND.BACKWARD 2484 . 4297) (TEDIT.SUBSTITUTE
4299 . 14915) (TEDIT.NEXT 14917 . 18920)) (18955 30060 (\TEDIT.WCFIND 18965 . 20966) (\TEDIT.BASICFIND
20968 . 22446) (\TEDIT.WCFIND.BACKWARD 22448 . 24507) (\TEDIT.BASICFIND.BACKWARD 24509 . 28037) (
\TEDIT.PARSE.SEARCHSTRING 28039 . 30058)))))
(FILEMAP (NIL (784 21950 (TEDIT.FIND 794 . 2793) (TEDIT.FIND.BACKWARD 2795 . 5117) (TEDIT.SUBSTITUTE
5119 . 17479) (TEDIT.NEXT 17481 . 21948)) (21983 36411 (\TEDIT.WCFIND 21993 . 25512) (\TEDIT.BASICFIND
25514 . 27605) (\TEDIT.WCFIND.BACKWARD 27607 . 31071) (\TEDIT.BASICFIND.BACKWARD 31073 . 33330) (
\TEDIT.PARSE.SEARCHSTRING 33332 . 36409)))))
STOP

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

Binary file not shown.

323
library/tedit/TEDIT-FNKEYS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "15-Mar-2024 14:07:55" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;74 32961
(FILECREATED "26-Nov-2024 23:53:32" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;101 38718
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.LCASE.SEL \TEDIT.UCASE.SEL \TEDIT.KEY.FIND)
:CHANGES-TO (FNS \TEDIT.KEY.FIND)
:PREVIOUS-DATE " 9-Mar-2024 11:47:31" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;69)
:PREVIOUS-DATE "23-Nov-2024 16:29:11" {WMEDLEY}<library>tedit>TEDIT-FNKEYS.;100)
(PRETTYCOMPRINT TEDIT-FNKEYSCOMS)
@@ -17,12 +17,14 @@
(FNS \TEDIT.BOLD.SEL.OFF \TEDIT.BOLD.SEL.ON \TEDIT.CENTER.SEL \TEDIT.CENTER.SEL.REV
\TEDIT.DEFAULTS.CARET \TEDIT.DEFAULTSSEL \TEDIT.SETDEFAULT.FROM.SEL
\TEDIT.KEY.FIND \TEDIT.GET.TARGET.STRING \TEDIT.KEY.FIND.BACKWARD
\TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN \TEDIT.ITALIC.SEL.OFF
\TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL \TEDIT.SHOWCARETLOOKS
\TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL \TEDIT.UCASE.SEL
\TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON \TEDIT.STRIKEOUT.SEL.ON
\TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL \TEDIT.KEY.SUBSTITUTE))
\TEDIT.KEY.FIND \TEDIT.KEY.FIND.SEARCHSTRING \TEDIT.GET.TARGET.STRING
\TEDIT.KEY.FIND.BACKWARD \TEDIT.FINDAGAIN.BACKWARD \TEDIT.FINDAGAIN
\TEDIT.ITALIC.SEL.OFF \TEDIT.ITALIC.SEL.ON \TEDIT.LARGERSEL \TEDIT.LCASE.SEL
\TEDIT.SHOWCARETLOOKS \TEDIT.SMALLERSEL \TEDIT.SUBSCRIPTSEL \TEDIT.SUPERSCRIPTSEL
\TEDIT.UCASE.SEL \TEDIT.UNDERLINE.SEL.OFF \TEDIT.UNDERLINE.SEL.ON
\TEDIT.STRIKEOUT.SEL.ON \TEDIT.STRIKEOUT.SEL.OFF \TEDIT.SELECT.ALL
\TEDIT.KEY.SUBSTITUTE \TEDIT.MANPAGE \TEDIT.CALL.ED \TEDIT.ONECHAR.BACKWARD
\TEDIT.ONECHAR.FORWARD))
(COMS
(* ;; "Auxiliary functions used in the above main functions:")
@@ -69,12 +71,16 @@
("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
("Meta,a" FN \TEDIT.SELECT.ALL)
("Meta,A" FN \TEDIT.SELECT.ALL)
("Meta,d" FN \TEDIT.MANPAGE)
("Meta,D" FN \TEDIT.MANPAGE)
("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
("Meta,f" FN \TEDIT.KEY.FIND)
("Meta,g" FN \TEDIT.FINDAGAIN)
("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
("Meta,N" NEXT)
("Meta,n" NEXT)
("Meta,o" FN \TEDIT.CALL.ED)
("Meta,O" FN \TEDIT.CALL.ED)
("Meta,p" FN \TEDIT.PRINT.MENU)
("Meta,P" FN \TEDIT.PRINT.MENU)
("Meta,r" REDO)
@@ -84,7 +90,11 @@
("Meta,U" FN \TEDIT.UNDO.UNDO)
("Meta,u" UNDO)
("Meta,z" UNDO)
("Meta,Z" \TEDIT.UNDO.UNDO]
("Meta,Z" \TEDIT.UNDO.UNDO)
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
("Meta,." FN \TEDIT.ONECHAR.FORWARD]
(P (MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
(SELECTQ (CADR ENTRY)
(FN (TEDIT.SETFUNCTION (CAR ENTRY)
@@ -164,92 +174,125 @@
NIL TEXTOBJ])
(\TEDIT.KEY.FIND
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN BACKWARD) (* ; "Edited 15-Mar-2024 13:36 by rmk")
[LAMBDA (TSTREAM TEXTOBJ SEL AGAIN BACKWARD SEARCHSTRING) (* ; "Edited 26-Nov-2024 23:47 by rmk")
(* ; "Edited 23-Nov-2024 16:25 by rmk")
(* ; "Edited 7-Jul-2024 11:47 by rmk")
(* ; "Edited 29-Jun-2024 16:20 by rmk")
(* ; "Edited 22-Jun-2024 10:00 by rmk")
(* ; "Edited 18-May-2024 16:29 by rmk")
(* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 24-Apr-2024 23:39 by rmk")
(* ; "Edited 9-Mar-2024 11:36 by rmk")
(* ; "Edited 29-Feb-2024 17:06 by rmk")
(* ; "Edited 27-Feb-2024 00:22 by rmk")
(* ; "Edited 16-Feb-2024 23:43 by rmk")
(* ; "Edited 14-Dec-2023 21:14 by rmk")
(* ; "Edited 12-Jul-2023 08:26 by rmk")
(* ; "Edited 20-Jun-2023 13:06 by rmk")
(* ; "Edited 6-May-2018 17:14 by rmk:")
(* ; "Edited 30-May-91 21:05 by jds")
(* ;; "just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")
(* ;; "Case sensitive search, with * and # wildcards. Just calls the normal tedit.find starting at the right of the current selection. SEL is passed from the FN key in the readtable, presumably always (fetch SEL of TEXTOBJ).")
(* ;; "AGAIN suppresses confirmation of a previous target, but also assumes that the user is not interested in trying again at the current character position--starts forward or backward from there.")
(* ;; "AGAIN suppresses confirmation of a previous target.")
(LET ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
TARGET CH) (* ;
 "Case sensitive search, with * and # wildcards")
(* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.")
(CL:WHEN AGAIN
(SETQ TARGET (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
(CL:UNLESS TARGET
(SETQ AGAIN NIL) (* ;
 "If no previous target, we aren't %"again%"")
[SETQ TARGET (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
"Backward search string: "
"Search string: ")
(\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING])
(CL:WHEN TARGET
(CL:UNLESS SEL
(SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
(\TEDIT.SHOWSEL SEL NIL) (* ;
 "Save for next search, even if not found")
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING TARGET)
(SETQ CH (if BACKWARD
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %"" TARGET
"%"")
T)
(TEDIT.FIND.BACKWARD TEXTOBJ (MKSTRING TARGET)
NIL NIL T)
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" TARGET "%"")
T)
(TEDIT.FIND TEXTOBJ (MKSTRING TARGET)
NIL NIL T)))
(COND
(CH (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" found")
T) (* ; "We found the target text.")
(\TEDIT.RESET.EXTEND.PENDING.DELETE SEL TEXTOBJ)
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:UNLESS TEXTOBJ
(SETQ TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
(RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ "Find")
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(LET ((TEXTOBJ (TEXTOBJ TSTREAM))
CH)
(CL:UNLESS SEARCHSTRING
(SETQ SEARCHSTRING (\TEDIT.KEY.FIND.SEARCHSTRING TEXTOBJ AGAIN BACKWARD)))
(CL:WHEN (AND SEARCHSTRING (IGEQ (NCHARS SEARCHSTRING)
1))
(CL:UNLESS SEL
(SETQ SEL (FGETTOBJ TEXTOBJ SEL)))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(SETQ CH (if BACKWARD
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching backward for %""
SEARCHSTRING "%"")
T)
(TEDIT.FIND.BACKWARD TSTREAM (MKSTRING SEARCHSTRING)
NIL NIL T)
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Searching for %"" SEARCHSTRING
"%"")
T)
(TEDIT.FIND TSTREAM (MKSTRING SEARCHSTRING)
NIL NIL T)))
(if CH
then (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" found")
T) (* ; "We found the target text.")
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEXTOBJ)
(* ;
 "Set up SELECTION to be the found text")
(\TEDIT.UPDATE.SEL SEL (CAR CH)
(ADD1 (IDIFFERENCE (CADR CH)
(CAR CH)))
(CL:IF BACKWARD
'LEFT
'RIGHT))
(TEDIT.SET.SEL.LOOKS SEL (CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
'PENDINGDEL
'NORMAL))
[SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
(CAR CH)
'WORD
'CHAR]
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(TEDIT.NORMALIZECARET TEXTOBJ))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" TARGET "%" not found")
T)))
(\TEDIT.SHOWSEL SEL T))])
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL (CAR CH)
(ADD1 (IDIFFERENCE (CADR CH)
(CAR CH)))
(CL:IF BACKWARD
'LEFT
'RIGHT)
(CL:IF (FGETTOBJ TEXTOBJ TXTREADONLY)
'PENDINGDEL
'NORMAL))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
[SETSEL SEL SELKIND (CL:IF (IGREATERP (CADR CH)
(CAR CH)
'WORD
'CHAR]
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.GET.INSERT.CHARLOOKS TEXTOBJ SEL))
(TEDIT.NORMALIZECARET TEXTOBJ)
else (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "%"" SEARCHSTRING "%" not found")
T))
(\TEDIT.SHOWSEL SEL T TEXTOBJ))))])
(\TEDIT.KEY.FIND.SEARCHSTRING
[LAMBDA (TEXTOBJ AGAIN BACKWARD) (* ; "Edited 22-Jun-2024 10:17 by rmk")
(* ;; "TEDIT.LAST.FIND.STRING used to be stored as a window property. But then it would only pertain to a particular pane. Better store it on the textobj.")
(LET (SEARCHSTRING)
(CL:WHEN AGAIN
(SETQ SEARCHSTRING (GETTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING)))
(CL:UNLESS SEARCHSTRING
(SETQ SEARCHSTRING (\TEDIT.GET.TARGET.STRING TEXTOBJ 'TEDIT.LAST.FIND.STRING))
(SETQ SEARCHSTRING (TEDIT.GETINPUT TEXTOBJ (CL:IF BACKWARD
"Backward search string: "
"Search string: ")
SEARCHSTRING))
(CL:WHEN SEARCHSTRING (* ;
 "Save for next search, even if not found")
(PUTTEXTPROP TEXTOBJ 'TEDIT.LAST.FIND.STRING SEARCHSTRING)))
SEARCHSTRING])
(\TEDIT.GET.TARGET.STRING
[LAMBDA (TEXTOBJ PROP) (* ; "Edited 29-Feb-2024 17:08 by rmk")
[LAMBDA (TEXTOBJ PROP) (* ; "Edited 14-Jul-2024 00:09 by rmk")
(* ; "Edited 23-Jun-2024 23:06 by rmk")
(* ; "Edited 22-Jun-2024 12:03 by rmk")
(* ; "Edited 29-Feb-2024 17:08 by rmk")
(* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN, TEDIT.SUBSTITUTE. It tries to determine the best tentative target string for a search. PROP is either TEDIT.LAST.FIND.STRING or TEDIT.LAST.SUBSTITUTE.STRING.")
(* ;; "This is called from \TEDIT.KEY.FIND, TEDIT.DEFAULT.MENUFN. It tries to determine the best tentative target string for a search. PROP is presumably TEDIT.LAST.FIND.STRING.")
(* ;; "Current heuristic: use selection if longer than 1 character, otherwise last search string. Note that meta-G goes directly to the last search.")
(* ;; "Current heuristic: If a previous string, use it if it contains wild cards, otherwise the current non-point selection. Note that meta-G goes directly to the last search.")
(if (GETTEXTPROP TEXTOBJ PROP)
then (if (IGREATERP (GETSEL (GETTOBJ TEXTOBJ SEL)
DCH)
(* ;; "TEDIT.SUBSTITUTE doesn't call this because the current selection is the search domain")
(LET [(PREV (STRINGP (GETTEXTPROP TEXTOBJ PROP]
(if [AND PREV (find I from 1 to (NCHARS PREV)
suchthat (AND (MEMB (NTHCHARCODE PREV I)
(CHARCODE (%# ESCAPE *)))
(NEQ (CHARCODE %')
(NTHCHARCODE PREV (SUB1 I]
then PREV
elseif (IGEQ (FGETSEL (FGETTOBJ TEXTOBJ SEL)
DCH)
1)
then (TEDIT.SEL.AS.STRING TEXTOBJ)
else (GETTEXTPROP TEXTOBJ PROP))
else (TEDIT.SEL.AS.STRING TEXTOBJ])
then
(* ;; "TEDIT.SEL.AS.STRING breaks on image objects, should be fixed there.")
(CAR (NLSETQ (TEDIT.SEL.AS.STRING TEXTOBJ)))
else PREV])
(\TEDIT.KEY.FIND.BACKWARD
[LAMBDA (TEXTSTREAM TEXTOBJ SEL AGAIN) (* ; "Edited 20-Jun-2023 13:57 by rmk")
@@ -287,7 +330,8 @@
SEL])
(\TEDIT.LCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:05 by rmk")
(* ; "Edited 15-Mar-2024 13:57 by rmk")
(* ; "Edited 3-Mar-2024 12:28 by rmk")
(* ; "Edited 28-May-2023 00:34 by rmk")
(* ; "Edited 24-May-2023 22:46 by rmk")
@@ -296,7 +340,8 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
\TEDIT.SELPIECES
SEL))
SEL NIL TEXTOBJ
))
(FUNCTION L-CASECODE)
NIL TEXTOBJ)
TEXTOBJ SEL)
@@ -345,7 +390,8 @@
SEL])
(\TEDIT.UCASE.SEL
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 15-Mar-2024 13:57 by rmk")
[LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 7-Jul-2024 09:04 by rmk")
(* ; "Edited 15-Mar-2024 13:57 by rmk")
(* ; "Edited 3-Mar-2024 12:56 by rmk")
(* ; "Edited 28-May-2023 00:33 by rmk")
(* ; "Edited 24-May-2023 22:45 by rmk")
@@ -354,7 +400,8 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.CHARTRANSFORM (\TEDIT.SELPIECES.COPY (
\TEDIT.SELPIECES
SEL))
SEL NIL TEXTOBJ
))
(FUNCTION U-CASECODE)
NIL TEXTOBJ)
TEXTOBJ SEL)
@@ -382,8 +429,9 @@
SEL])
(\TEDIT.SELECT.ALL
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 6-May-2018 12:41 by rmk:")
(TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of TEXTOBJ))
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 29-Jun-2024 15:05 by rmk")
(* ; "Edited 6-May-2018 12:41 by rmk:")
(TEDIT.SETSEL TEXTSTREAM 1 (GETTOBJ TEXTOBJ TEXTLEN)
'LEFT])
(\TEDIT.KEY.SUBSTITUTE
@@ -392,6 +440,50 @@
(* ;; "Stub for function-key")
(TEDIT.SUBSTITUTE TEXTSTREAM NIL NIL T])
(\TEDIT.MANPAGE
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-Jun-2024 11:59 by rmk")
(* ; "Edited 26-May-2024 21:53 by rmk")
(* ; "Edited 25-May-2024 14:50 by rmk")
(* ;; "If meta-D is typed in an existing DINFO window, the new stuff comes up but then the window closes. That could be debugged, but probably not worth it. The DINFO window has its own links to things that it thought were worth indexing.")
(CL:UNLESS (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM)
'DINFOGRAPH)
(GENERIC.MAN.LOOKUP (TEDIT.SEL.AS.STRING TSTREAM SEL)))])
(\TEDIT.CALL.ED
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 25-May-2024 15:03 by rmk")
(ED [MKATOM (CAR (MKLIST (TEDIT.SEL.AS.SEXPR TSTREAM SEL]
'(:DONTWAIT])
(\TEDIT.ONECHAR.BACKWARD
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
(* ; "Edited 1-Sep-2024 10:39 by rmk")
(TEXTOBJ! TEXTOBJ)
(SELECTION! SEL)
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
(CL:UNLESS (ILEQ PT 1)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL (SUB1 PT)
0)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
(\TEDIT.ONECHAR.FORWARD
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 21-Nov-2024 20:31 by rmk")
(* ; "Edited 1-Sep-2024 10:39 by rmk")
(* ;; "Moves caret to a point one character forward.")
(TEXTOBJ! TEXTOBJ)
(LET ((PT (TEDIT.GETPOINT TSTREAM SEL)))
(CL:UNLESS (IGEQ PT (TEXTLEN TEXTOBJ))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL (ADD1 PT)
0)
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ))])
)
@@ -511,13 +603,14 @@
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))])
(\TEDIT.STRIKEOUT.CARET.ON
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 12-Jun-90 18:32 by mitani")
(PROG ((LOOKS (\TEDIT.PARSE.CHARLOOKS.LIST '(STRIKEOUT ON)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
(COND
(LOOKS (TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL])
[LAMBDA (TEXTSTREAM TEXTOBJ SEL) (* ; "Edited 10-Aug-2024 16:31 by rmk")
(* ; "Edited 12-Jun-90 18:32 by mitani")
(LET ((LOOKS (\TEDIT.CHANGE.CHARLOOKS.NEW '(STRIKEOUT ON)
(fetch (TEXTOBJ CARETLOOKS) of TEXTOBJ)
TEXTOBJ)))
(CL:WHEN LOOKS
(TEDIT.CARETLOOKS TEXTSTREAM LOOKS)
(\TEDIT.SHOWCARETLOOKS TEXTSTREAM TEXTOBJ SEL))])
)
@@ -585,12 +678,16 @@
("Function,^A" FN \TEDIT.SHOWCARETLOOKS)
("Meta,a" FN \TEDIT.SELECT.ALL)
("Meta,A" FN \TEDIT.SELECT.ALL)
("Meta,d" FN \TEDIT.MANPAGE)
("Meta,D" FN \TEDIT.MANPAGE)
("Meta,F" FN \TEDIT.KEY.FIND.BACKWARD)
("Meta,f" FN \TEDIT.KEY.FIND)
("Meta,g" FN \TEDIT.FINDAGAIN)
("Meta,G" FN \TEDIT.FINDAGAIN.BACKWARD)
("Meta,N" NEXT)
("Meta,n" NEXT)
("Meta,o" FN \TEDIT.CALL.ED)
("Meta,O" FN \TEDIT.CALL.ED)
("Meta,p" FN \TEDIT.PRINT.MENU)
("Meta,P" FN \TEDIT.PRINT.MENU)
("Meta,r" REDO)
@@ -600,7 +697,11 @@
("Meta,U" FN \TEDIT.UNDO.UNDO)
("Meta,u" UNDO)
("Meta,z" UNDO)
("Meta,Z" \TEDIT.UNDO.UNDO)))
("Meta,Z" \TEDIT.UNDO.UNDO)
("Meta,<" FN \TEDIT.ONECHAR.BACKWARD)
("Meta,," FN \TEDIT.ONECHAR.BACKWARD)
("Meta,>" FN \TEDIT.ONECHAR.FORWARD)
("Meta,." FN \TEDIT.ONECHAR.FORWARD)))
[MAPC \TEDIT.KEYS (FUNCTION (LAMBDA (ENTRY)
(SELECTQ (CADR ENTRY)
@@ -609,21 +710,23 @@
(TEDIT.SETSYNTAX (CAR ENTRY)
(CADR ENTRY]
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5609 23249 (\TEDIT.BOLD.SEL.OFF 5619 . 5957) (\TEDIT.BOLD.SEL.ON 5959 . 6287) (
\TEDIT.CENTER.SEL 6289 . 7805) (\TEDIT.CENTER.SEL.REV 7807 . 8103) (\TEDIT.DEFAULTS.CARET 8105 . 8598)
(\TEDIT.DEFAULTSSEL 8600 . 9047) (\TEDIT.SETDEFAULT.FROM.SEL 9049 . 9726) (\TEDIT.KEY.FIND 9728 .
14757) (\TEDIT.GET.TARGET.STRING 14759 . 15623) (\TEDIT.KEY.FIND.BACKWARD 15625 . 15930) (
\TEDIT.FINDAGAIN.BACKWARD 15932 . 16343) (\TEDIT.FINDAGAIN 16345 . 16636) (\TEDIT.ITALIC.SEL.OFF 16638
. 16890) (\TEDIT.ITALIC.SEL.ON 16892 . 17085) (\TEDIT.LARGERSEL 17087 . 17375) (\TEDIT.LCASE.SEL
17377 . 18564) (\TEDIT.SHOWCARETLOOKS 18566 . 20166) (\TEDIT.SMALLERSEL 20168 . 20459) (
\TEDIT.SUBSCRIPTSEL 20461 . 20664) (\TEDIT.SUPERSCRIPTSEL 20666 . 20870) (\TEDIT.UCASE.SEL 20872 .
22003) (\TEDIT.UNDERLINE.SEL.OFF 22005 . 22203) (\TEDIT.UNDERLINE.SEL.ON 22205 . 22401) (
\TEDIT.STRIKEOUT.SEL.ON 22403 . 22599) (\TEDIT.STRIKEOUT.SEL.OFF 22601 . 22799) (\TEDIT.SELECT.ALL
22801 . 23024) (\TEDIT.KEY.SUBSTITUTE 23026 . 23247)) (23321 29730 (\TEDIT.BOLD.CARET.OFF 23331 .
23866) (\TEDIT.BOLD.CARET.ON 23868 . 24400) (\TEDIT.ITALIC.CARET.OFF 24402 . 24939) (
\TEDIT.ITALIC.CARET.ON 24941 . 25484) (\TEDIT.LARGER.CARET 25486 . 26021) (\TEDIT.SMALLER.CARET 26023
. 26560) (\TEDIT.SUBSCRIPT.CARET 26562 . 27103) (\TEDIT.SUPERSCRIPT.CARET 27105 . 27647) (
\TEDIT.UNDERLINE.CARET.OFF 27649 . 28189) (\TEDIT.UNDERLINE.CARET.ON 28191 . 28729) (
\TEDIT.STRIKEOUT.CARET.OFF 28731 . 29271) (\TEDIT.STRIKEOUT.CARET.ON 29273 . 29728)) (29799 30501 (
\TK.DESCRIBEFONT 29809 . 30499)))))
(FILEMAP (NIL (6220 28574 (\TEDIT.BOLD.SEL.OFF 6230 . 6568) (\TEDIT.BOLD.SEL.ON 6570 . 6898) (
\TEDIT.CENTER.SEL 6900 . 8416) (\TEDIT.CENTER.SEL.REV 8418 . 8714) (\TEDIT.DEFAULTS.CARET 8716 . 9209)
(\TEDIT.DEFAULTSSEL 9211 . 9658) (\TEDIT.SETDEFAULT.FROM.SEL 9660 . 10337) (\TEDIT.KEY.FIND 10339 .
15406) (\TEDIT.KEY.FIND.SEARCHSTRING 15408 . 16548) (\TEDIT.GET.TARGET.STRING 16550 . 18264) (
\TEDIT.KEY.FIND.BACKWARD 18266 . 18571) (\TEDIT.FINDAGAIN.BACKWARD 18573 . 18984) (\TEDIT.FINDAGAIN
18986 . 19277) (\TEDIT.ITALIC.SEL.OFF 19279 . 19531) (\TEDIT.ITALIC.SEL.ON 19533 . 19726) (
\TEDIT.LARGERSEL 19728 . 20016) (\TEDIT.LCASE.SEL 20018 . 21413) (\TEDIT.SHOWCARETLOOKS 21415 . 23015)
(\TEDIT.SMALLERSEL 23017 . 23308) (\TEDIT.SUBSCRIPTSEL 23310 . 23513) (\TEDIT.SUPERSCRIPTSEL 23515 .
23719) (\TEDIT.UCASE.SEL 23721 . 25060) (\TEDIT.UNDERLINE.SEL.OFF 25062 . 25260) (
\TEDIT.UNDERLINE.SEL.ON 25262 . 25458) (\TEDIT.STRIKEOUT.SEL.ON 25460 . 25656) (
\TEDIT.STRIKEOUT.SEL.OFF 25658 . 25856) (\TEDIT.SELECT.ALL 25858 . 26174) (\TEDIT.KEY.SUBSTITUTE 26176
. 26397) (\TEDIT.MANPAGE 26399 . 27155) (\TEDIT.CALL.ED 27157 . 27369) (\TEDIT.ONECHAR.BACKWARD 27371
. 27941) (\TEDIT.ONECHAR.FORWARD 27943 . 28572)) (28646 35157 (\TEDIT.BOLD.CARET.OFF 28656 . 29191) (
\TEDIT.BOLD.CARET.ON 29193 . 29725) (\TEDIT.ITALIC.CARET.OFF 29727 . 30264) (\TEDIT.ITALIC.CARET.ON
30266 . 30809) (\TEDIT.LARGER.CARET 30811 . 31346) (\TEDIT.SMALLER.CARET 31348 . 31885) (
\TEDIT.SUBSCRIPT.CARET 31887 . 32428) (\TEDIT.SUPERSCRIPT.CARET 32430 . 32972) (
\TEDIT.UNDERLINE.CARET.OFF 32974 . 33514) (\TEDIT.UNDERLINE.CARET.ON 33516 . 34054) (
\TEDIT.STRIKEOUT.CARET.OFF 34056 . 34596) (\TEDIT.STRIKEOUT.CARET.ON 34598 . 35155)) (35226 35928 (
\TK.DESCRIBEFONT 35236 . 35926)))))
STOP

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

Binary file not shown.

151
library/tedit/TEDIT-HCPY
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Apr-2024 09:12:32" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;153 33754
(FILECREATED "13-Dec-2024 23:51:23" {WMEDLEY}<library>tedit>TEDIT-HCPY.;164 32996
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE)
:CHANGES-TO (FNS \TEDIT.HARDCOPY.DISPLAYLINE TEDIT.HARDCOPYFN)
:PREVIOUS-DATE "20-Mar-2024 11:05:37" {WMEDLEY}<library>TEDIT>TEDIT-HCPY.;152)
:PREVIOUS-DATE "26-Oct-2024 11:05:00" {WMEDLEY}<library>tedit>TEDIT-HCPY.;160)
(PRETTYCOMPRINT TEDIT-HCPYCOMS)
@@ -87,9 +87,11 @@
"Can't HARDCOPY: No print server specified." T])
(\TEDIT.PRINT.MENU
[LAMBDA (TSTREAM) (* ; "Edited 25-Jun-2023 13:16 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 28-Jun-2024 22:09 by rmk")
(* ; "Edited 25-Jun-2023 13:16 by rmk")
(* ; "Edited 6-Jun-2023 17:48 by rmk")
(LET [(W (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ TSTREAM]
(LET ((W (GETTOBJ (TEXTOBJ TSTREAM)
PRIMARYPANE)))
(SELECTQ [MENU (create MENU
ITEMS _ '(("Print to a file" 'FILE
"Puts image on a file; prompts for filename and format"
@@ -101,7 +103,8 @@
NIL])
(TEDIT.HCPYFILE
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 4-Oct-2022 09:23 by rmk")
[LAMBDA (TSTREAM FILE BREAKPAGETITLE) (* ; "Edited 29-Jun-2024 16:33 by rmk")
(* ; "Edited 4-Oct-2022 09:23 by rmk")
(* ; "Edited 1-Oct-2022 22:12 by rmk")
(* ; "Edited 12-Jun-90 18:36 by mitani")
@@ -125,10 +128,14 @@
'HCPY)
'BODY
(fetch (STREAM FULLFILENAME) of TXTFILE]
(TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE])
(if FILENM
then (TEDIT.FORMAT.HARDCOPY TSTREAM FILENM T BREAKPAGETITLE NIL NIL IMAGETYPE)
else (TEDIT.PROMPTPRINT TSTREAM "No hardcopy file--aborted" T T)))])
(\TEDIT.HARDCOPY.DISPLAYLINE
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 19-Apr-2024 09:09 by rmk")
[LAMBDA (TEXTOBJ LINE REGION PRSTREAM FORMATTINGSTATE) (* ; "Edited 13-Dec-2024 23:49 by rmk")
(* ; "Edited 13-Jun-2024 17:13 by rmk")
(* ; "Edited 19-Apr-2024 09:09 by rmk")
(* ; "Edited 20-Mar-2024 11:04 by rmk")
(* ; "Edited 15-Mar-2024 19:23 by rmk")
(* ; "Edited 24-Dec-2023 22:07 by rmk")
@@ -151,16 +158,16 @@
(FGETTOBJ TEXTOBJ TEXTLEN))
[LET ((THISLINE (FGETTOBJ TEXTOBJ THISLINE)))
(CL:UNLESS (EQ LINE (fetch DESC of THISLINE))
(\TEDIT.FORMATLINE TEXTOBJ (FGETLD LINE LCHAR1)
(\TEDIT.FORMATLINE (FGETTOBJ TEXTOBJ STREAMHINT)
(FGETLD LINE LCHAR1)
LINE REGION PRSTREAM FORMATTINGSTATE))
(* ;; "Use the characters cached in THISLINE.")
(for CHARSLOT CLOOKS CURY KERN LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
(for CHARSLOT CLOOKS CURY LOOKSTARTX SCALESPACES (SPACEFACTOR _ (fetch (THISLINE
TLSPACEFACTOR
)
of THISLINE))
)
of THISLINE))
(FIRST-SCALEDSPACE-SLOT _ (ffetch (THISLINE TLFIRSTSPACE) of THISLINE))
(SCALE _ (DSPSCALE NIL PRSTREAM))
(TX _ (FGETLD LINE LX1)) incharslots THISLINE first (DSPSPACEFACTOR 1 PRSTREAM)
@@ -225,11 +232,7 @@
)
of CLOOKS]
(T (FGETLD LINE YBASE]
(DSPYPOSITION CURY PRSTREAM)
(CL:WHEN (SETQ KERN (LISTGET (fetch (CHARLOOKS CLUSERINFO)
of CLOOKS)
'KERN))
(SETQ KERN (HCSCALE SCALE KERN)))
(DSPYPOSITION CURY PRSTREAM)
(* ;; "LOOKSTARTX: Starting X position for this CLOOKS.")
@@ -253,6 +256,8 @@
(SETQ CHARW (\TEDIT.DISPLAY.DIACRITIC CHARSLOT THISLINE
PRSTREAM))
elseif (EQ 'KERN CHAR)
then (RELMOVETO 0 CHARW PRSTREAM)
else (\OUTCHAR PRSTREAM CHAR))
(add TX CHARW))) finally
@@ -272,13 +277,14 @@
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS
[LAMBDA (TEXTOBJ TSTREAM LINE FMTSPEC CHNO IMAGESTREAM FORMATTINGSTATE)
(* ; "Edited 26-Oct-2024 11:04 by rmk")
(* ; "Edited 17-Mar-2024 17:22 by rmk")
(* ; "Edited 19-Jan-2024 23:19 by rmk")
(* ; "Edited 3-Oct-2022 13:05 by rmk")
(* ;; "Return setup LINE to skip a sequence of heading pieces STATE")
(SELECTQ (fetch (FMTSPEC FMTPARATYPE) of FMTSPEC)
(SELECTQ (GETPARA FMTSPEC FMTPARATYPE)
(PAGEHEADING
(* ;; "This paragraph is the content for a page heading. The pieces are stashed away in the FORMATTING STATE.")
@@ -287,11 +293,11 @@
T)
(EVEN (* ; "Skip an odd page.")
(CL:WHEN (ODDP (GETPFS FORMATTINGSTATE PAGE#))
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
T))
(ODD (* ; "Skip an even page")
(CL:WHEN (EVENP (GETPFS FORMATTINGSTATE PAGE#))
(TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
(\TEDIT.SKIP.SPECIALCOND TSTREAM LINE FMTSPEC CHNO)
T))
NIL])
@@ -337,7 +343,8 @@
(MOVETO CURX CURY PRSTREAM])
(\TEDIT.HCPYFMTSPEC
[LAMBDA (SPEC IMAGESTREAM) (* ; "Edited 15-Mar-2024 19:34 by rmk")
[LAMBDA (DISPLAYFMT IMAGESTREAM) (* ; "Edited 28-Jul-2024 22:25 by rmk")
(* ; "Edited 15-Mar-2024 19:34 by rmk")
(* ; "Edited 7-Mar-2023 21:03 by rmk")
(* ; "Edited 6-Mar-2023 15:14 by rmk")
(* ; "Edited 20-Oct-2022 22:35 by rmk")
@@ -346,44 +353,31 @@
(* ;; "Given a display-type FMTSPEC, create a hardcopy equivalent. (Special positions are made paper-relative first.). ")
(LET ((SCALE (DSPSCALE NIL IMAGESTREAM))
FMTSPEC)
[SETQ FMTSPEC (create FMTSPEC using SPEC FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
(HCSCALE SCALE (fetch (FMTSPEC 1STLEFTMAR) of SPEC))
LEFTMAR _ (HCSCALE SCALE (fetch (FMTSPEC LEFTMAR)
of SPEC))
RIGHTMAR _ (HCSCALE SCALE (fetch (FMTSPEC RIGHTMAR)
of SPEC))
QUAD _ (fetch (FMTSPEC QUAD) of SPEC)
TABSPEC _ (\TEDIT.FORMATLINE.SCALETABS SPEC SCALE)
FMTSPECIALX _ (AND (fetch (FMTSPEC FMTSPECIALX)
of SPEC)
(HCSCALE SCALE
(SCALEPAGEUNITS
(fetch (FMTSPEC FMTSPECIALX)
of SPEC)
1.0 NIL)))
FMTSPECIALY _ (AND (fetch (FMTSPEC FMTSPECIALY)
of SPEC)
(HCSCALE SCALE
(SCALEPAGEUNITS
(fetch (FMTSPEC FMTSPECIALY)
of SPEC)
1.0 NIL)))
LEADBEFORE _ (HCSCALE SCALE (fetch (FMTSPEC LEADBEFORE)
of SPEC))
LEADAFTER _ (HCSCALE SCALE (fetch (FMTSPEC LEADAFTER)
of SPEC))
LINELEAD _ (HCSCALE SCALE (fetch (FMTSPEC LINELEAD)
of SPEC))
FMTBASETOBASE _ (AND (fetch (FMTSPEC FMTBASETOBASE)
of SPEC)
(HCSCALE SCALE (fetch (FMTSPEC
FMTBASETOBASE
)
of SPEC]
FMTSPEC])
(LET* ((SCALE (DSPSCALE NIL IMAGESTREAM)))
(create FMTSPEC using DISPLAYFMT FMTHARDCOPYSCALE _ SCALE 1STLEFTMAR _
(HCSCALE SCALE (FGETPARA DISPLAYFMT 1STLEFTMAR))
LEFTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEFTMAR))
RIGHTMAR _ (HCSCALE SCALE (FGETPARA DISPLAYFMT RIGHTMAR))
QUAD _ (FGETPARA DISPLAYFMT QUAD DISPLAYFMT)
FMTDEFAULTTAB _ (HCSCALE SCALE (FGETPARA DISPLAYFMT FMTDEFAULTTAB))
FMTTABS _ (\TEDIT.SCALE.TABS (FGETPARA DISPLAYFMT FMTTABS)
SCALE)
FMTSPECIALX _ (AND (FGETPARA DISPLAYFMT FMTSPECIALX)
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
DISPLAYFMT
FMTSPECIALX)
1.0 NIL)))
FMTSPECIALY _ (AND (FGETPARA DISPLAYFMT FMTSPECIALY)
(HCSCALE SCALE (SCALEPAGEUNITS (FGETPARA
DISPLAYFMT
FMTSPECIALY)
1.0 NIL)))
LEADBEFORE _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADBEFORE))
LEADAFTER _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LEADAFTER))
LINELEAD _ (HCSCALE SCALE (FGETPARA DISPLAYFMT LINELEAD))
FMTBASETOBASE _ (AND (FGETPARA DISPLAYFMT FMTBASETOBASE)
(HCSCALE SCALE (FGETPARA DISPLAYFMT
FMTBASETOBASE])
(\TEDIT.INTEGER.IMAGEBOX
[LAMBDA (OLDBOX) (* jds "23-Oct-84 13:52")
@@ -451,7 +445,9 @@
(DEFINEQ
(TEDIT.HARDCOPYFN
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 20-Mar-2024 10:49 by rmk")
[LAMBDA (WINDOW IMAGESTREAM) (* ; "Edited 13-Dec-2024 22:33 by rmk")
(* ; "Edited 29-Jun-2024 14:42 by rmk")
(* ; "Edited 20-Mar-2024 10:49 by rmk")
(* ; "Edited 25-Sep-2023 16:29 by rmk")
(* ; "Edited 4-Jul-2023 11:16 by rmk")
(* ; "Edited 21-Sep-2021 15:33 by rmk:")
@@ -459,22 +455,15 @@
(* ;;
 "This is the TEdit HARDCOPYFN, hooking into the system's standard Hardcopy window-menu operation.")
(LET ((TEXTOBJ (TEXTOBJ WINDOW))
(TEXTSTREAM (TEXTSTREAM WINDOW))
WASDIRTY)
(LET ((TEXTSTREAM (TEXTSTREAM WINDOW)))
(* ;; "TEXTSTREAM is bound here so we don't drop the steam on the floor if the window goes away, since the TEXTOBJ only has an XPOINTER to the stream in it. Please don't remove this binding!")
(CL:WHEN (FGETTOBJ TEXTOBJ MENUFLG)
(SETQ WINDOW (\TEDIT.MAINW WINDOW))
(SETQ TEXTOBJ (fetch (TEXTWINDOW WTEXTOBJ) of WINDOW)))
(RESETLST
[RESETSAVE (\TEDIT.MARKACTIVE TEXTOBJ)
'(PROGN (\TEDIT.MARKINACTIVE OLDVALUE]
(FSETTOBJ TEXTOBJ EDITOPACTIVE 'Hardcopy) (* ; "Build the hardcopy")
(SETQ WASDIRTY (FGETTOBJ TEXTOBJ \DIRTY))
(PROG1 (TEDIT.FORMAT.HARDCOPY WINDOW IMAGESTREAM)
(FSETTOBJ TEXTOBJ \DIRTY WASDIRTY)))])
(TEDIT.FORMAT.HARDCOPY (CL:IF (FGETTOBJ (TEXTOBJ WINDOW)
MENUFLG)
(\TEDIT.MAINW WINDOW)
WINDOW)
IMAGESTREAM])
(\TEDIT.HARDCOPYFILEFN
[LAMBDA (W EXT) (* ; "Edited 25-Sep-2023 16:19 by rmk")
@@ -566,11 +555,11 @@
(CLOSEF DOC])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (3475 26808 (TEDIT.HARDCOPY 3485 . 4618) (\TEDIT.PRINT.MENU 4620 . 5474) (TEDIT.HCPYFILE
5476 . 7416) (\TEDIT.HARDCOPY.DISPLAYLINE 7418 . 17356) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17358 .
18765) (\TEDIT.HARDCOPY.MODIFYLOOKS 18767 . 21001) (\TEDIT.HCPYFMTSPEC 21003 . 25137) (
\TEDIT.INTEGER.IMAGEBOX 25139 . 25810) (\TEDIT.DISPLAY.DIACRITIC 25812 . 26806)) (26883 27713 (
\TEDIT.SCALEREGION 26893 . 27711)) (27972 31667 (TEDIT.HARDCOPYFN 27982 . 29442) (
\TEDIT.HARDCOPYFILEFN 29444 . 30005) (\TEDIT.POSTSCRIPT.HARDCOPY 30007 . 30938) (\TEDIT.PRESS.HARDCOPY
30940 . 31665)) (32930 33731 (TEDIT-BOOK 32940 . 33729)))))
(FILEMAP (NIL (3492 26205 (TEDIT.HARDCOPY 3502 . 4635) (\TEDIT.PRINT.MENU 4637 . 5603) (TEDIT.HCPYFILE
5605 . 7779) (\TEDIT.HARDCOPY.DISPLAYLINE 7781 . 17682) (\TEDIT.HARDCOPY.FORMATLINE.HEADINGS 17684 .
19183) (\TEDIT.HARDCOPY.MODIFYLOOKS 19185 . 21419) (\TEDIT.HCPYFMTSPEC 21421 . 24534) (
\TEDIT.INTEGER.IMAGEBOX 24536 . 25207) (\TEDIT.DISPLAY.DIACRITIC 25209 . 26203)) (26280 27110 (
\TEDIT.SCALEREGION 26290 . 27108)) (27369 30909 (TEDIT.HARDCOPYFN 27379 . 28684) (
\TEDIT.HARDCOPYFILEFN 28686 . 29247) (\TEDIT.POSTSCRIPT.HARDCOPY 29249 . 30180) (\TEDIT.PRESS.HARDCOPY
30182 . 30907)) (32172 32973 (TEDIT-BOOK 32182 . 32971)))))
STOP

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

Binary file not shown.

781
library/tedit/TEDIT-HISTORY
View File

@@ -1,21 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Mar-2024 11:05:20" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;154 33348
(FILECREATED " 8-Dec-2024 19:41:55" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;219 53094
:EDIT-BY rmk
:CHANGES-TO (FNS TEDIT.UNDO)
:CHANGES-TO (FNS TEDIT.UNDO \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS \TEDIT.UNDO.UNDO
TEDIT.REDO \TEDIT.HISTORYADD.COMPOSITE \TEDIT.UNDO.MOVE \TEDIT.UNDO.COMPOSITE
\TEDIT.COMPOSITE.EVENT)
(VARS TEDIT-HISTORYCOMS)
(MACROS \TEDIT.HISTORYADD1)
:PREVIOUS-DATE "15-Mar-2024 13:55:42" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;153)
:PREVIOUS-DATE " 7-Dec-2024 21:26:15" {WMEDLEY}<library>tedit>TEDIT-HISTORY.;213)
(PRETTYCOMPRINT TEDIT-HISTORYCOMS)
(RPAQQ TEDIT-HISTORYCOMS
((DECLARE%: EVAL@COMPILE DONTCOPY (EXPORT (RECORDS TEDITHISTORYEVENT)
(MACROS \TEDIT.LASTEVENT \TEDIT.POPEVENT GETTH SETTH)
))
(MACROS \TEDIT.LASTEVENT GETTH SETTH)))
(FNS \TEDIT.HISTORYEVENT.DEFPRINT)
(MACROS \TEDIT.HISTORYADD1)
(INITRECORDS TEDITHISTORYEVENT)
(GLOBALVARS TEDIT.HISTORY.TYPELST TEDIT.HISTORYLST)
(INITVARS (TEDIT.HISTORY.TYPELST NIL)
@@ -23,13 +27,16 @@
(COMS
(* ;; "History-list maintenance functions")
(FNS \TEDIT.HISTORYADD \TEDIT.CUMULATE.EVENTS))
(FNS \TEDIT.HISTORYADD \TEDIT.HISTORYADD.COMPOSITE \TEDIT.CUMULATE.EVENTS
\TEDIT.COMPOSITE.EVENT \TEDIT.HISTORY.PROP \TEDIT.HISTORY.EVENT \TEDIT.POPEVENT))
(COMS
(* ;; "Specialized UNDO & REDO functions.")
(FNS TEDIT.UNDO \TEDIT.UNDO1 TEDIT.REDO \TEDIT.UNDO.UNDO)
(FNS \TEDIT.UNDO.INSERTION \TEDIT.UNDO.DELETION \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE)
(FNS \TEDIT.REDO.INSERTION \TEDIT.REDO.REPLACE \TEDIT.REDO.MOVE))))
(FNS \TEDIT.UNDO.INSERT \TEDIT.UNDO.DELETE \TEDIT.UNDO.MOVE \TEDIT.UNDO.REPLACE
\TEDIT.UNDO.CHARLOOKS \TEDIT.UNDO.PARALOOKS \TEDIT.UNDO.PAGELOOKS
\TEDIT.UNDO.COMPOSITE \TEDIT.UNDO.REPLACECODE)
(FNS \TEDIT.REDO.INSERT \TEDIT.REDO.REPLACE \TEDIT.REDO.COMPOSITE))))
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
@@ -47,16 +54,16 @@
NIL (* ;
 "Was THAUXINFO: Auxiliary info about the event, primarily for redo")
THDELETEDPIECES)
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT
THCH#) of DATUM)
(IPLUS (fetch (
[ACCESSFNS TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (
TEDITHISTORYEVENT
THCH#)
of DATUM)
(fetch (
THCH#)
of DATUM)
0)
(OR (fetch (
TEDITHISTORYEVENT
THLEN)
of DATUM]
THLEN)
of DATUM)
0]
(INIT (DEFPRINT 'TEDITHISTORYEVENT (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT
)))
THPOINT _ 'LEFT)
@@ -80,9 +87,6 @@
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ)
(CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ)
(pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
(PUTPROPS GETTH MACRO ((EVENT FIELD)
(fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
@@ -114,6 +118,15 @@
(CDR LOC)
"}"])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \TEDIT.HISTORYADD1 MACRO ((TEXTOBJ EVENT)
(* ;; "This is the primitive, to be upgraded if we go to a ring.")
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
EVENT)))
)
(/DECLAREDATATYPE 'TEDITHISTORYEVENT '(POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER)
@@ -144,7 +157,11 @@
(DEFINEQ
(\TEDIT.HISTORYADD
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 3-Mar-2024 12:15 by rmk")
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Dec-2024 17:32 by rmk")
(* ; "Edited 29-Aug-2024 12:30 by rmk")
(* ; "Edited 11-Aug-2024 21:57 by rmk")
(* ; "Edited 30-Apr-2024 22:51 by rmk")
(* ; "Edited 3-Mar-2024 12:15 by rmk")
(* ; "Edited 19-Feb-2024 12:09 by rmk")
(* ; "Edited 30-Dec-2023 22:19 by rmk")
(* ; "Edited 11-Aug-2023 14:25 by rmk")
@@ -158,55 +175,73 @@
(* ;; "Not sure what should happen if the second one is to the right of the first, deleting forwards. Old code seemed to treat those as separate events, and only the second/right one could be undone.")
(CL:UNLESS (EQ 'DON'T (GETTOBJ TEXTOBJ TXTHISTORY))
(if (type? TEDITHISTORYEVENT EVENT)
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
(CONSTANT (LIST :Put :Get))) (* ;
(if (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
then
(* ;; "Maybe the first event after setting the textprop--now's the time to flush")
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
(FSETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL)
else (if (type? TEDITHISTORYEVENT EVENT)
then (CL:WHEN (MEMB (GETTH EVENT THACTION)
(CONSTANT (LIST :Put :Get)))
(* ;
 "Can't back up over Put/Get, flush the history.")
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
(FSETTOBJ TEXTOBJ TXTHISTORY NIL))
(* ;; "Somebody may have already done there own fixup.")
(* ;; "Somebody may have already done there own fixup.")
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH EVENT THACTION))
(EQ :Delete (GETTH OLDEVENT THACTION)))
(LET ((OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(CL:WHEN (AND (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH EVENT THACTION))
(EQ :Delete (GETTH OLDEVENT THACTION)))
(* ;;
 "Repeated successive deletions, we can combine them if they are adjacent.")
(* ;;
 "Repeated successive deletions, we can combine them if they are adjacent.")
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
(GETTH OLDEVENT THCH#))
(CL:WHEN (IEQP (GETTH EVENT THCHLIM)
(GETTH OLDEVENT THCH#))
(* ;
 "OLDEVENT is first, EVENT is still delete")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS EVENT OLDEVENT TEXTOBJ))
(\TEDIT.POPEVENT TEXTOBJ) (* ; "Pop OLDEVENT before repushing")
(SETQ OLDEVENT (\TEDIT.LASTEVENT TEXTOBJ)))
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
(* ;; "This may have created a new adjacency, if the accumulation of later deletes comes into with an earlier accumulation")
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH OLDEVENT THACTION))
(IEQP (GETTH OLDEVENT THCHLIM)
(IPLUS (GETTH EVENT THCH#)
(GETTH OLDEVENT THLEN]
(CL:WHEN [AND OLDEVENT (type? TEDITHISTORYEVENT OLDEVENT)
(EQ :Delete (GETTH OLDEVENT THACTION))
(IEQP (GETTH OLDEVENT THCHLIM)
(IPLUS (GETTH EVENT THCH#)
(GETTH OLDEVENT THLEN]
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
(* ;; "The OLDEEVENT deleted in front of EVENT, and itsTCHLIM are in its original coordinates. EVENT came later, with its TCH# in a coordinate system reduced by THLEN. So we have to add it back.")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
(\TEDIT.POPEVENT TEXTOBJ)))
(push (GETTOBJ TEXTOBJ TXTHISTORY)
EVENT))
elseif (LISTP EVENT)
then
(* ;; "A monolithic sequence of undoable events")
(SETQ EVENT (\TEDIT.CUMULATE.EVENTS OLDEVENT EVENT))
(\TEDIT.POPEVENT TEXTOBJ)))
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT))
elseif (LISTP EVENT)
then
(* ;; "A monolithic sequence of undoable events")
(push (GETTOBJ TEXTOBJ TXTHISTORY)
EVENT)))
(* ;; "SHOULDNT HAPPEN ?")
(\TEDIT.HISTORYADD1 TEXTOBJ EVENT)))
EVENT])
(\TEDIT.HISTORYADD.COMPOSITE
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 19:31 by rmk")
(* ; "Edited 22-Sep-2024 18:47 by rmk")
(* ; "Edited 3-Jul-2024 08:02 by rmk")
(* ; "Edited 8-May-2024 12:34 by rmk")
(CL:WHEN EVENTS
(\TEDIT.HISTORYADD TEXTOBJ (CL:IF (CDR EVENTS)
(\TEDIT.HISTORY.EVENT TEXTOBJ :Composite NIL NIL NIL NIL
EVENTS)
(CAR EVENTS))))])
(\TEDIT.CUMULATE.EVENTS
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 15-Mar-2024 13:54 by rmk")
[LAMBDA (EVENT1 EVENT2 TEXTOBJ) (* ; "Edited 8-Dec-2024 17:35 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 3-Mar-2024 12:15 by rmk")
(* ; "Edited 3-Jun-2023 17:09 by rmk")
(* ; "Edited 27-May-2023 00:54 by rmk")
@@ -222,8 +257,68 @@
(SETTH EVENT1 THDELETEDPIECES (\TEDIT.SELPIECES.CONCAT (GETTH EVENT1 THDELETEDPIECES)
(GETTH EVENT2 THDELETEDPIECES)
TEXTOBJ))
(SETTH EVENT1 THLEN (fetch (SELPIECES SPLEN) of (GETTH EVENT1 THDELETEDPIECES)))
(SETTH EVENT1 THLEN (GETSPC (GETTH EVENT1 THDELETEDPIECES)
SPLEN))
EVENT1])
(\TEDIT.COMPOSITE.EVENT
[LAMBDA (TEXTOBJ EVENTS) (* ; "Edited 8-Dec-2024 15:47 by rmk")
(* ; "Edited 22-Sep-2024 18:47 by rmk")
(* ; "Edited 3-Jul-2024 08:02 by rmk")
(* ; "Edited 8-May-2024 12:34 by rmk")
(CL:WHEN EVENTS
(\TEDIT.HISTORYADD (CL:IF (CDR EVENTS)
(\TEDIT.HISTORY.EVENT TEXTOBJ (OR ACTION :Composite)
NIL NIL NIL NIL NEWEVENTS)
(CAR EVENTS))))])
(\TEDIT.HISTORY.PROP
[LAMBDA (TEXTOBJ SETNEWVALUE NEWVALUE) (* ; "Edited 22-Sep-2024 08:42 by rmk")
(* ;; "Called fromTEDIT.TEXT.PROP to manage the history list. History is ON by default, and the events always correspond to the current state of the document. If it's OFF, the next document-changing event will cause HISTORYADD to flush the past and no further events will be recorded until it is turned ON again to start a new epoch. CLEAR flushes old events but then turns on collection.")
(PROG1 (CL:IF (FGETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
'OFF
'ON)
(CL:WHEN SETNEWVALUE
(SELECTQ NEWVALUE
((ON T)
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
((OFF NIL)
(* ;;
 "HISTORYADD will wipe out everything the next time it is called event--gives a chance to back out")
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE T))
(CLEAR (* ;
 "Wipes out current history now, then resumes collection")
(FSETTOBJ TEXTOBJ TXTHISTORY NIL)
(FSETTOBJ TEXTOBJ TXTHISTORYINACTIVE NIL))
(\ILLEGAL.ARG NEWVALUE))))])
(\TEDIT.HISTORY.EVENT
[LAMBDA (TEXTOBJ ACTION CH# LEN POINT FIRSTPIECE OLDINFO DELETEDPIECES)
(* ; "Edited 26-Sep-2024 15:44 by rmk")
(* ; "Edited 23-Sep-2024 16:47 by rmk")
(* ;; "Don't create if it's inactive")
(CL:UNLESS (GETTOBJ TEXTOBJ TXTHISTORYINACTIVE)
(CL:WHEN (AND (NULL LEN)
(type? SELPIECES CH#))
(SETQ LEN (fetch (SELPIECES SPLEN) of CH#))
(SETQ CH# (fetch (SELPIECES SPFIRSTCHAR) of CH#)))
(create TEDITHISTORYEVENT
THACTION _ ACTION
THCH# _ CH#
THLEN _ LEN
THPOINT _ (OR POINT 'LEFT)
THFIRSTPIECE _ FIRSTPIECE
THOLDINFO _ OLDINFO
THDELETEDPIECES _ DELETEDPIECES))])
(\TEDIT.POPEVENT
[LAMBDA (TEXTOBJ) (* ; "Edited 7-Dec-2024 21:24 by rmk")
(pop (GETTOBJ TEXTOBJ TXTHISTORY])
)
@@ -233,7 +328,14 @@
(DEFINEQ
(TEDIT.UNDO
[LAMBDA (TEXTOBJ) (* ; "Edited 20-Mar-2024 11:04 by rmk")
[LAMBDA (TSTREAM NOUNDOUNDO) (* ; "Edited 8-Dec-2024 19:41 by rmk")
(* ; "Edited 25-Nov-2024 13:17 by rmk")
(* ; "Edited 12-Aug-2024 10:49 by rmk")
(* ; "Edited 3-Jul-2024 21:21 by rmk")
(* ; "Edited 18-May-2024 16:23 by rmk")
(* ; "Edited 12-May-2024 21:08 by rmk")
(* ; "Edited 20-Mar-2024 11:04 by rmk")
(* ; "Edited 8-May-2024 11:16 by rmk")
(* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 7-Mar-2024 12:48 by rmk")
(* ; "Edited 3-Mar-2024 20:02 by rmk")
@@ -246,95 +348,123 @@
(* ;; "We push information for undoing the undo onto the TXTHISTORYUNDO list.")
(TEXTOBJ! TEXTOBJ)
(CL:UNLESS (FGETTOBJ TEXTOBJ TXTREADONLY)
(* ;; "Only undo things if the document is allowed to change.")
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
(PROG ((SEL (TEXTSEL TEXTOBJ))
(EVENT (\TEDIT.POPEVENT TEXTOBJ))
PREVEVENTS UNDOEVENT)
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(SEL (TEXTSEL TEXTOBJ))
EVENT PREVEVENT UNDOEVENT)
(CL:WHEN (FGETTOBJ TEXTOBJ TXTREADONLY)
(RETURN))
(SETQ EVENT (\TEDIT.LASTEVENT TEXTOBJ))
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to undo" T)
(RETURN))
(CL:WHEN (MEMB (GETTH EVENT THACTION)
'(:Get :Put))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
T)
(RETURN))
(SETQ EVENT (\TEDIT.POPEVENT TEXTOBJ))
(SETQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ)) (* ;
 "So we can test for the undoundo event.")
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TSTREAM "Nothing to undo" T)
(RETURN))
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
(* ;; "Each main event was popped. Each subfunction must put back on the history-undo list one or more new events that would undo its undoing. ")
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
(* ;; "We can get into trouble if there is an interrupt in the middle of undoing the full set of events for a previous action, or even in the middle of a singleton event.")
(SETQ PREVEVENTS (FGETTOBJ TEXTOBJ TXTHISTORY))
(\TEDIT.SHOWSEL SEL NIL)
(\TEDIT.UNDO1 TEXTOBJ EVENT)
(TEDIT.PROMPTCLEAR TSTREAM)
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UNDO1 TSTREAM EVENT)
(* ;; "Get the event that undid EVENT")
(* ;; "Get the event that undid EVENT--if it was pushed in front of PREVENT ")
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ))
(FSETTOBJ TEXTOBJ TXTHISTORY PREVEVENTS)
(CL:WHEN [OR (NULL PREVEVENTS)
(AND (type? TEDITHISTORYEVENT (CAR (LISTP PREVEVENTS)))
(MEMB (GETTH (CAR PREVEVENTS)
THACTION)
(CONSTANT (LIST :Get :Put]
(SETTOBJ TEXTOBJ \DIRTY NIL))
(CL:UNLESS (EQ PREVEVENT (\TEDIT.LASTEVENT TEXTOBJ))
(SETQ UNDOEVENT (\TEDIT.POPEVENT TEXTOBJ)))
(CL:WHEN [OR (NULL PREVEVENT)
(MEMB (GETTH PREVEVENT THACTION)
(CONSTANT (LIST :Get :Put]
(FSETTOBJ TEXTOBJ \DIRTY NIL))
(CL:UNLESS NOUNDOUNDO
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing.")
(* ;; "The undone list keeps the event that would undo the undoing, the event that was just undone, and the history event that would be undone next (by M-u). This is so that M-U can undo the undoing by redoing the original event.")
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE TEXTOBJ)
(LIST (CAR PREVEVENTS)
UNDOEVENT EVENT))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T)))])
(push (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE)
(LIST PREVEVENT UNDOEVENT EVENT)))
(\TEDIT.FIXSEL SEL TEXTOBJ)
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
(\TEDIT.UNDO1
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 4-Mar-2024 14:55 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 25-Nov-2024 13:56 by rmk")
(* ; "Edited 29-Sep-2024 13:51 by rmk")
(* ; "Edited 22-Sep-2024 21:41 by rmk")
(* ; "Edited 19-Aug-2024 00:11 by rmk")
(* ; "Edited 12-Aug-2024 23:42 by rmk")
(* ; "Edited 7-May-2024 23:10 by rmk")
(* ; "Edited 4-Mar-2024 14:55 by rmk")
(* ; "Edited 16-Jul-2023 11:14 by rmk")
(* ; "Edited 30-May-2023 23:50 by rmk")
(* ; "Edited 25-May-2023 00:33 by rmk")
(SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy)
(\TEDIT.UNDO.INSERTION TEXTOBJ EVENT))
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
(:Delete (* ; "Deletion or case-shift")
(\TEDIT.UNDO.DELETION TEXTOBJ EVENT))
(:Move (\TEDIT.UNDO.MOVE TEXTOBJ EVENT))
(:Looks (* ; "Character-looks change")
(\TEDIT.UNDO.LOOKS TEXTOBJ EVENT))
(:ParaLooks (* ; "PARA looks change")
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
(:PageFormat (* ; "Pageframe change")
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (GETTH EVENT THOLDINFO)
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ
TXTPAGEFRAMES)))
]
(\TEDIT.HISTORYADD TEXTOBJ EVENT))
((LIST :Replace :LowerCase :UpperCase)
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
(LET ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ)))
(CL:WHEN (GETTH EVENT THCH#)
(\TEDIT.SHOWSEL NIL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT)
(\TEDIT.SHOWSEL NIL T TEXTOBJ)
(\TEDIT.SCROLL.CARET TSTREAM))
(PROG1 (SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy)
(\TEDIT.UNDO.INSERT TEXTOBJ EVENT))
(:Move (\TEDIT.UNDO.MOVE TSTREAM EVENT))
(:Delete (* ; "Deletion or case-shift")
(\TEDIT.UNDO.DELETE TEXTOBJ EVENT))
(:CharLooks (* ; "Character-looks change")
(\TEDIT.UNDO.CHARLOOKS TEXTOBJ EVENT))
(:ParaLooks (* ; "PARA looks change")
(\TEDIT.UNDO.PARALOOKS TEXTOBJ EVENT))
(:PageFormat (* ; "Pageframe change")
(\TEDIT.UNDO.PAGELOOKS TEXTOBJ EVENT))
((LIST :Replace :LowerCase :UpperCase)
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(:Closefile (* ; "Closes an included file")
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
(CLOSEF? (GETTH EVENT THOLDINFO))))
((LIST :Get :Put) (* ;
(* ;; "He replaced one piece of text with another ; Lower-casing and upper-casing have the same undo event.")
(\TEDIT.UNDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(:ReplaceCode (\TEDIT.UNDO.REPLACECODE TEXTOBJ EVENT))
(:Closefile (* ; "Closes an included file")
(CL:WHEN (STREAMP (GETTH EVENT THOLDINFO))
(CLOSEF? (GETTH EVENT THOLDINFO))))
(:Composite (\TEDIT.UNDO.COMPOSITE TSTREAM EVENT))
((LIST :Get :Put) (* ;
 "He did a GET or PUT-- not undoable.")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION))
T))
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
TEDIT.HISTORY.TYPELST]
(COND
(UNDOFN
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't undo a " (GETTH EVENT THACTION
))
T))
(LET [(UNDOFN (CADDR (ASSOC (GETTH EVENT THACTION)
TEDIT.HISTORY.TYPELST]
(COND
(UNDOFN
(* ;; "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(* ;;
 "<22>TEDIT.HISTORY.TYPELST is an ALST of form (type redofn undofn)")
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
(GETTH EVENT THCH#)
(GETTH EVENT THFIRSTPIECE)))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for " (GETTH EVENT
THACTION))
T])
(APPLY* UNDOFN TEXTOBJ EVENT (GETTH EVENT THLEN)
(GETTH EVENT THCH#)
(GETTH EVENT THFIRSTPIECE)))
(T (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "UNDO not implemented for "
(GETTH EVENT THACTION))
T])
(TEDIT.REDO
[LAMBDA (TEXTOBJ) (* ; "Edited 15-Mar-2024 13:36 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 17:53 by rmk")
(* ; "Edited 27-Nov-2024 23:11 by rmk")
(* ; "Edited 26-Sep-2024 16:49 by rmk")
(* ; "Edited 29-Jul-2024 23:58 by rmk")
(* ; "Edited 3-Jul-2024 07:41 by rmk")
(* ; "Edited 18-May-2024 16:23 by rmk")
(* ; "Edited 12-May-2024 21:08 by rmk")
(* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 7-May-2024 23:13 by rmk")
(* ; "Edited 4-Mar-2024 21:33 by rmk")
(* ; "Edited 2-Mar-2024 09:41 by rmk")
(* ; "Edited 21-Dec-2023 11:57 by rmk")
@@ -343,71 +473,81 @@
(* ;; "REDO the last thing this guy did.")
(CL:UNLESS (GETTOBJ TEXTOBJ TXTREADONLY)
(PROG ((SEL (GETTOBJ TEXTOBJ SEL))
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
CH)
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
(RETURN))
(CL:UNLESS (GETSEL SEL SET)
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
(RETURN))
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(PROG* ((TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(SEL (GETTOBJ TEXTOBJ SEL))
(EVENT (\TEDIT.LASTEVENT TEXTOBJ))
CH)
(CL:WHEN (\TEDIT.READONLY TEXTOBJ)
(RETURN NIL))
(CL:UNLESS EVENT
(TEDIT.PROMPTPRINT TEXTOBJ "Nothing to redo" T)
(RETURN))
(CL:UNLESS (GETSEL SEL SET)
(TEDIT.PROMPTPRINT TEXTOBJ "Please select a target for the repeated action" T)
(RETURN))
(* ;; "There really is something to redo and something to do it to.")
(* ;; "There really is something to redo and something to do it to.")
(\TEDIT.SHOWSEL SEL NIL)
(SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
(\TEDIT.REDO.INSERTION TEXTOBJ EVENT SEL))
(:Delete (* ; "It was a deletion")
(\TEDIT.DELETE TEXTOBJ SEL))
(:Replace (* ;
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(SELECTC (GETTH EVENT THACTION)
((LIST :Insert :Copy :Move) (* ; "It was an insertion")
(\TEDIT.REDO.INSERT TEXTOBJ EVENT SEL))
(:Delete (* ; "It was a deletion")
(\TEDIT.DELETE TEXTOBJ SEL))
(:Replace (* ;
 "It was a replacement (a del/insert combo)")
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(:LowerCase (* ; "He lower-cased something")
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
(:UpperCase (* ; "He upper-cased something")
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
(:Looks (* ; "It was a character looks change")
(TEDIT.LOOKS TEXTOBJ (PLOOKS (GETTH EVENT THFIRSTPIECE))
SEL))
(:ParaLooks (* ; "It was a Paragraph looks change")
(TEDIT.PARALOOKS TEXTOBJ (PPARALOOKS (GETTH EVENT THFIRSTPIECE))
SEL))
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
(\TEDIT.REDO.REPLACE TEXTOBJ EVENT (GETTH EVENT THACTION)))
(:LowerCase (* ; "He lower-cased something")
(\TEDIT.LCASE.SEL TEXTOBJ TEXTOBJ SEL))
(:UpperCase (* ; "He upper-cased something")
(\TEDIT.UCASE.SEL TEXTOBJ TEXTOBJ SEL))
(:CharLooks (* ; "It was a character looks change")
(\TEDIT.CHANGE.CHARLOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
SEL))
(:ParaLooks (* ; "It was a Paragraph looks change")
(\TEDIT.CHANGE.PARALOOKS TEXTOBJ (CAR (GETTH EVENT THOLDINFO))
SEL))
(:PageFormat (TEDIT.PROMPTPRINT TEXTOBJ "You can't redo a page-format change" T T))
(:Find (* ; "EXACT-MATCH SEARCH COMMAND")
(* (* ;; "RESTLST ?")
 (AND NIL (RESETSAVE (CURSOR
 WAITINGCURSOR))) (TEDIT.PROMPTPRINT
 TEXTOBJ "Searching..." T)
 (SETQ SEL (fetch (TEXTOBJ SEL) of
 TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL)
 (SETQ CH (TEDIT.FIND TEXTOBJ
 TEXTOBJ)) (\TEDIT.SHOWSEL SEL NIL NIL
 TEXTOBJ) (SETQ CH (TEDIT.FIND TEXTOBJ
 (GETTH EVENT THAUXINFO)))
 (COND (CH (TEDIT.PROMPTPRINT TEXTOBJ
 "done.") (\TEDIT.UPDATE.SEL SEL CH
 (NCHARS (GETTH EVENT THAUXINFO))
 (QUOTE RIGHT)) (\TEDIT.FIXSEL SEL
 TEXTOBJ) (TEDIT.NORMALIZECARET TEXTOBJ)
 (\TEDIT.SHOWSEL SEL T))
 (\TEDIT.SHOWSEL SEL T NIL TEXTOBJ))
 (T (TEDIT.PROMPTPRINT TEXTOBJ
 "[Not found]"))))
)
(:Move (* ; "He moved some text")
(\TEDIT.REDO.MOVE TEXTOBJ EVENT (GETTH EVENT THLEN)
(IMAX 1 (TEDIT.GETPOINT NIL SEL))
(GETTH EVENT THFIRSTPIECE)))
((LIST :Get :Put) (* ; "Why can't you redo a get or put ?")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
T T))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
" isn't implemented.")
T))
(\TEDIT.SHOWSEL SEL T)))])
)
(:Move
(* ;; "It doesn't make sense to do the deletion part of a move in the same place or a different place. The insert part is probably OK--that maps to the :Insert clause above.")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
T T))
(:Composite (\TEDIT.REDO.COMPOSITE TEXTOBJ EVENT SEL))
((LIST :Get :Put NIL) (* ; "Why can't you redo a get or put ?")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "You can't redo a " (GETTH EVENT THACTION))
T T))
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Redoing the action " (GETTH EVENT THACTION)
" isn't implemented.")
T))
(\TEDIT.SHOWSEL SEL T TEXTOBJ])
(\TEDIT.UNDO.UNDO
[LAMBDA (TEXTOBJ) (* ; "Edited 3-Mar-2024 21:27 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 8-Dec-2024 18:24 by rmk")
(* ; "Edited 26-Sep-2024 22:57 by rmk")
(* ; "Edited 22-Sep-2024 11:08 by rmk")
(* ; "Edited 12-Aug-2024 23:45 by rmk")
(* ; "Edited 3-Jul-2024 09:50 by rmk")
(* ; "Edited 3-Mar-2024 21:27 by rmk")
(* ; "Edited 13-Jun-2023 15:05 by rmk")
(* ; "Edited 3-Jun-2023 23:04 by rmk")
(* ; "Edited 1-Jun-2023 23:53 by rmk")
@@ -419,33 +559,34 @@
(* ;; "This makes sense only if the document is now in the state immediately after the undoing--if any other events have intervened, the character positions and the general state of the document are unrelated. So the elements of the undo list also contain the state of the (forward) history list after the undoing was undone. If we have moved back to the same point in history, we can do the undoing.")
(SETQ TEXTOBJ (TEXTOBJ TEXTOBJ))
(TEDIT.PROMPTPRINT TEXTOBJ "" T)
(LET [(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
(if (NULL LASTUNDONE)
then (TEDIT.PROMPTPRINT TEXTOBJ "There is no action whose undoing can be reversed" T)
elseif (EQ (CAR LASTUNDONE)
(\TEDIT.LASTEVENT TEXTOBJ))
then
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(LASTUNDONE (pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE]
(TEDIT.PROMPTCLEAR TSTREAM)
(if (NULL LASTUNDONE)
then (TEDIT.PROMPTPRINT TSTREAM "There is no action whose undoing can be reversed")
elseif (EQ (CAR LASTUNDONE)
(\TEDIT.LASTEVENT TEXTOBJ))
then
(* ;; "We tell TEDIT.UNDO that LASTUNDONE is the one we now want to undo.")
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
(CADR LASTUNDONE))
(TEDIT.UNDO TEXTOBJ)
(\TEDIT.HISTORYADD1 TEXTOBJ (CADR LASTUNDONE))
(TEDIT.UNDO TSTREAM)
(TEDIT.PROMPTPRINT TSTREAM "Undo undone" T)
(* ;; "This saved what we just undid, don't want to keep reundoing it.")
(* ;; "This undoing saved what we just undid, don't want to keep reundoing it.")
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
(push (FGETTOBJ TEXTOBJ TXTHISTORY)
(CADDR LASTUNDONE))
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
(pop (FGETTOBJ TEXTOBJ TXTHISTORYUNDONE))
(\TEDIT.HISTORYADD1 TEXTOBJ (CADDR LASTUNDONE))
else (SETTOBJ TEXTOBJ TXTHISTORYUNDONE NIL) (* ;
 "If something else has happened, there are no undos to undo.")
(TEDIT.PROMPTPRINT TEXTOBJ "Cannot undo the previous undo" T])
(TEDIT.PROMPTPRINT TSTREAM "Cannot undo the previous undo" T])
)
(DEFINEQ
(\TEDIT.UNDO.INSERTION
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 30-May-2023 22:54 by rmk")
(\TEDIT.UNDO.INSERT
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 8-Jul-2024 00:07 by rmk")
(* ; "Edited 30-May-2023 22:54 by rmk")
(* ; "Edited 26-May-2023 23:49 by rmk")
(* ; "Edited 24-May-2023 23:53 by rmk")
(* ; "Edited 2-May-2023 23:26 by rmk")
@@ -453,11 +594,13 @@
(* ;; "UNDO a prior Insert, Copy, or Include. ")
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
EVENT])
(\TEDIT.DELETE TEXTOBJ (\TEDIT.FIXSEL (\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT)
TEXTOBJ])
(\TEDIT.UNDO.DELETION
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(\TEDIT.UNDO.DELETE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 29-Sep-2024 00:23 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 30-May-2023 23:31 by rmk")
(* ; "Edited 27-May-2023 23:39 by rmk")
(* ; "Edited 21-Apr-93 12:01 by jds")
@@ -470,35 +613,32 @@
(GETTH EVENT THCH#])
(\TEDIT.UNDO.MOVE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 15-Mar-2024 13:54 by rmk")
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 19:38 by rmk")
(* ; "Edited 25-Nov-2024 14:12 by rmk")
(* ; "Edited 29-Sep-2024 00:23 by rmk")
(* ; "Edited 7-Jul-2024 11:50 by rmk")
(* ; "Edited 3-Jul-2024 10:17 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 4-Mar-2024 16:08 by rmk")
(* ;; "If the deletion from TEDIT.MOVE was not in TEXTOBJ, the FOBJ must have been a separate document. If FOBJ is still in the state just after that deletion, it can be undone there. But if FOBJ is not in that state, undoing doesn't there make sense. The deleted string would reappear in some random place.")
(* ;; "This event includes a deletion and an insert/replace both within TEXTOBJ. (The deletion from a from a foreign textobj is in that document's history.)")
(LET ((DELEVENT (CAR (GETTH EVENT THOLDINFO)))
(FOBJ (CDR (GETTH EVENT THOLDINFO)))
(SEL (FGETTOBJ TEXTOBJ SEL)))
(\TEDIT.DELETE TEXTOBJ (\TEDIT.UPDATE.SEL SEL EVENT))
(* ; "Undo the insert in this document")
(CL:WHEN (GETTH EVENT THDELETEDPIECES) (* ;
 ":Move must have started as :Replace")
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
'INSERT TEXTOBJ)
TEXTOBJ
(GETTH EVENT THCH#)))
(if FOBJ
then (CL:WHEN (EQ DELEVENT (\TEDIT.LASTEVENT FOBJ))
(* ;
 "Delete is last event in other document")
(TEDIT.UNDO FOBJ))
else (\TEDIT.UNDO1 TEXTOBJ DELEVENT))
(* ;; "Put the point back after the original target. Caller wil fix it.")
(\TEDIT.UPDATE.SEL SEL EVENT 0 'LEFT T])
(LET* [(TEXTOBJ (GETTSTR TSTREAM TEXTOBJ))
(SEL (TEXTSEL TEXTOBJ))
(REPLACE (EQ :Replace (GETTH (CAR (GETTH EVENT THOLDINFO))
THACTION]
(\TEDIT.UNDO.COMPOSITE TSTREAM EVENT)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL (if REPLACE
then (FSETTOBJ TEXTOBJ BLUEPENDINGDELETE T)
'PENDINGDEL
else 'NORMAL))
(\TEDIT.FIXSEL SEL TSTREAM)
(\TEDIT.SHOWSEL SEL T TSTREAM])
(\TEDIT.UNDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 13-Sep-2024 23:50 by rmk")
(* ; "Edited 7-Jul-2024 11:59 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 30-May-2023 23:10 by rmk")
(* ; "Edited 27-May-2023 16:49 by rmk")
(* ; "Edited 24-May-2023 22:43 by rmk")
@@ -508,27 +648,176 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (GETTH EVENT THDELETEDPIECES)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
EVENT))
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(\TEDIT.UNDO.CHARLOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 21:59 by rmk")
(* ; "Edited 28-Sep-2024 22:37 by rmk")
(* ; "Edited 26-Sep-2024 16:06 by rmk")
(* ; "Edited 11-Aug-2024 22:11 by rmk")
(* ; "Edited 5-Jul-2024 22:54 by rmk")
(* ; "Edited 18-May-2024 16:21 by rmk")
(* ; "Edited 19-Feb-2024 11:32 by rmk")
(* ; "Edited 14-Dec-2023 21:01 by rmk")
(* ; "Edited 30-May-2023 22:56 by rmk")
(* ; "Edited 18-Apr-2023 23:56 by rmk")
(* ; "Edited 30-May-91 21:44 by jds")
(* ;; "Undo the setting of character looks. The undolist is a list of (NEXTCHNO . OLDCHARLOOKS) pairs, where OLDCHARLOOKS NIL means nothing changed. We have to track the character numbers because pieces may have been split by future events that were then undone. NEXTCHNO is the first character number of the next original piece")
(for U OLDLOOKS NEWUNDOLIST NEXTCHNO (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL))
(CARETPC _ (\TEDIT.CARETPIECE TEXTOBJ)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Revert changes until we see the character number of the next changed piece. The initial NEXTCHNO is ")
(* ;; "Perhaps we should also save the CHNO of the CARETPC")
(SETQ NEXTCHNO (CAR U))
(SETQ OLDLOOKS (CDR U))
(CL:WHEN (AND OLDLOOKS (EQ PC CARETPC))
(FSETTOBJ TEXTOBJ CARETLOOKS (\TEDIT.CARETLOOKS.VERIFY TEXTOBJ OLDLOOKS)))
[push NEWUNDOLIST (CONS NEXTCHNO (CL:IF OLDLOOKS (PLOOKS PC]
(* ;; "U starts at the first piece. We want CHNO to be the start of the next piece, i.e. initialize to (CAR(CDR ...)) But then, what about the last piece. Maybe we have to do our own popping, or look at UTAIL. Or end in (NEXTPC-CHNO . NIL ). Or text for IGEQ THCHLIM")
(for P inpieces PC do (FSETPC P PLOOKS OLDLOOKS)
(add CHNO (PLEN P))
(CL:WHEN (IEQP CHNO NEXTCHNO)(* ; "First piece of the next run")
(SETQ PC P)
(RETURN))) finally
(* ;;
 "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
'NORMAL)
(\TEDIT.UPDATE.LINES TEXTOBJ 'LOOKS
(GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.PROMPTPRINT TEXTOBJ
"Character looks restored" T))
(* ;;
 "Save the event for REDO, even if these pieces didn't change")
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.PARALOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 25-Nov-2024 22:00 by rmk")
(* ; "Edited 28-Sep-2024 22:38 by rmk")
(* ; "Edited 27-Sep-2024 12:23 by rmk")
(* ; "Edited 11-Aug-2024 22:10 by rmk")
(* ; "Edited 5-Jul-2024 22:54 by rmk")
(* ; "Edited 18-May-2024 16:22 by rmk")
(* ; "Edited 19-Feb-2024 11:32 by rmk")
(* ; "Edited 11-Dec-2023 11:10 by rmk")
(* ; "Edited 21-Sep-2023 23:51 by rmk")
(* ; "Edited 30-May-2023 22:55 by rmk")
(* ; "Edited 18-Apr-2023 23:57 by rmk")
(* ; "Edited 30-May-91 21:44 by jds")
(* ;; "Undo the setting of paragraph looks.")
(for U OLDLOOKS NEWUNDOLIST (PC _ (\TEDIT.CHTOPC (GETTH EVENT THCH#)
TEXTOBJ))
(CHNO _ (GETTH EVENT THCH#))
(SEL _ (FGETTOBJ TEXTOBJ SEL)) in (CDR (GETTH EVENT THOLDINFO))
do
(* ;; "Find the first piece of the next changed paragraph")
(for P inpieces PC do (CL:WHEN (IEQP CHNO (CAR U))
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P)))
(SETQ OLDLOOKS (CDR U))
(push NEWUNDOLIST (CONS CHNO (PPARALOOKS PC))) (* ; "Save for UNDO UNDO")
(* ;; "Change all the pieces in this paragraph")
(for P inpieces PC do (FSETPC P PPARALOOKS OLDLOOKS)
(CL:WHEN (PPARALAST P)
(SETQ PC P)
(RETURN))
(add CHNO (PLEN P))) finally
(* ;;
 "Remember the previous looks in case we UNDO the UNDO. (CAR DATUM) is for redo.")
(CL:WHEN NEWUNDOLIST
(change (GETTH EVENT THOLDINFO)
(CONS (CAR DATUM)
(DREVERSE NEWUNDOLIST)))
(\TEDIT.SHOWSEL SEL NIL TEXTOBJ)
(\TEDIT.UPDATE.SEL SEL EVENT NIL NIL
'NORMAL)
(\TEDIT.UPDATE.LINES TEXTOBJ
'LOOKS
(GETTH EVENT THCH#)
(GETTH EVENT THLEN))
(\TEDIT.SHOWSEL SEL T TEXTOBJ)
(TEDIT.PROMPTPRINT TEXTOBJ
"Paragraph looks restored" T))
(* ;;
 "Save the event for REDO, even if these pieces didn't change")
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.PAGELOOKS
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 12-Aug-2024 10:28 by rmk")
[SETTOBJ TEXTOBJ TXTPAGEFRAMES (PROG1 (COPYALL (GETTH EVENT THOLDINFO))
(SETTH EVENT THOLDINFO (GETTOBJ TEXTOBJ TXTPAGEFRAMES)))]
(TEDIT.PROMPTPRINT TEXTOBJ "Page formats restored" T)
(\TEDIT.HISTORYADD TEXTOBJ EVENT])
(\TEDIT.UNDO.COMPOSITE
[LAMBDA (TSTREAM EVENT) (* ; "Edited 8-Dec-2024 15:47 by rmk")
(* ; "Edited 25-Nov-2024 22:27 by rmk")
(* ; "Edited 15-Aug-2024 10:14 by rmk")
(* ; "Edited 7-May-2024 23:17 by rmk")
(* ;; "A composite event is a group of other events that are to be undone at the same time. Only show the selection of the last undo event. We want to end up with a single event on history. We don't want to bump the count. (Presumably EVENT was alread popped)")
(for E EVENTS CUREVENT (TEXTOBJ _ (GETTSTR TSTREAM TEXTOBJ)) in (GETTH EVENT THOLDINFO)
do (SETQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))
(\TEDIT.UNDO1 TSTREAM E)
(CL:UNLESS (EQ CUREVENT (\TEDIT.LASTEVENT TEXTOBJ))(* ; "Something changed")
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ)))
(\TEDIT.SHOWSEL NIL NIL TSTREAM) finally (\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS))
(\TEDIT.SCROLL.CARET TSTREAM])
(\TEDIT.UNDO.REPLACECODE
[LAMBDA (TEXTOBJ EVENT) (* ; "Edited 23-Sep-2024 00:45 by rmk")
(TEDIT.RPLCHARCODE TEXTOBJ (GETTH EVENT THCH#)
(GETTH EVENT THOLDINFO])
)
(DEFINEQ
(\TEDIT.REDO.INSERTION
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Mar-2024 13:54 by rmk")
(\TEDIT.REDO.INSERT
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 15-Aug-2024 10:47 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 31-May-2023 10:26 by rmk")
(* ; "Edited 18-May-2023 19:24 by rmk")
(* ; "Edited 21-Apr-93 01:06 by jds")
(* ;; "Copies of the pieces inserted at the previous insertion EVENT are inserted at SEL's caret. We can extract the relevant pieces from the event's text position, because we know that either EVENT was the last event or other events after it have been undone, and the pieces are back to their original state.")
(\TEDIT.INSERT.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
'INSERT TEXTOBJ)
TEXTOBJ SEL])
(\TEDIT.REDO.REPLACE
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 15-Mar-2024 13:54 by rmk")
[LAMBDA (TEXTOBJ EVENT ACTION) (* ; "Edited 7-Jul-2024 11:59 by rmk")
(* ; "Edited 15-Mar-2024 13:54 by rmk")
(* ; "Edited 2-Oct-2023 11:43 by rmk")
(* ; "Edited 31-May-2023 10:25 by rmk")
(* ; "Edited 27-May-2023 11:16 by rmk")
@@ -540,31 +829,25 @@
(\TEDIT.REPLACE.SELPIECES (\TEDIT.SELPIECES.COPY (\TEDIT.SELPIECES EVENT NIL TEXTOBJ)
NIL TEXTOBJ)
TEXTOBJ
(\TEDIT.UPDATE.SEL (fetch (TEXTOBJ SEL) of TEXTOBJ)
(\TEDIT.UPDATE.SEL (GETTOBJ TEXTOBJ SEL)
EVENT))
(SETTH (\TEDIT.LASTEVENT TEXTOBJ)
THACTION ACTION])
(\TEDIT.REDO.MOVE
[LAMBDA (TEXTOBJ EVENT LEN CH# FIRSTPIECE) (* ; "Edited 15-Mar-2024 13:36 by rmk")
(* ; "Edited 16-Feb-2024 23:36 by rmk")
(* ; "Edited 7-Jun-2023 23:19 by rmk")
(* ; "Edited 27-May-2023 11:18 by rmk")
(* ; "Edited 23-May-2023 12:54 by rmk")
(* ; "Edited 30-May-91 21:28 by jds")
(LET ((SCR2 (GETTOBJ TEXTOBJ SCRATCHSEL2)))
(\TEDIT.UPDATE.SEL SCR2 (GETTH EVENT THCH#)
LEN)
(SETSEL SCR2 SET T)
(\TEDIT.FIXSEL SCR2 TEXTOBJ)
(\TEDIT.SET.SEL.LOOKS SCR2 'MOVE)
(TEDIT.MOVE SCR2 (FGETTOBJ TEXTOBJ SEL])
(\TEDIT.REDO.COMPOSITE
[LAMBDA (TEXTOBJ EVENT SEL) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 7-May-2024 23:12 by rmk")
(\TEDIT.THELP 'Redo-composite])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4834 5855 (\TEDIT.HISTORYEVENT.DEFPRINT 4844 . 5853)) (6621 12187 (\TEDIT.HISTORYADD
6631 . 10707) (\TEDIT.CUMULATE.EVENTS 10709 . 12185)) (12240 26023 (TEDIT.UNDO 12250 . 15439) (
\TEDIT.UNDO1 15441 . 18506) (TEDIT.REDO 18508 . 23783) (\TEDIT.UNDO.UNDO 23785 . 26021)) (26024 30162
(\TEDIT.UNDO.INSERTION 26034 . 26791) (\TEDIT.UNDO.DELETION 26793 . 27480) (\TEDIT.UNDO.MOVE 27482 .
29257) (\TEDIT.UNDO.REPLACE 29259 . 30160)) (30163 33325 (\TEDIT.REDO.INSERTION 30173 . 31123) (
\TEDIT.REDO.REPLACE 31125 . 32366) (\TEDIT.REDO.MOVE 32368 . 33323)))))
(FILEMAP (NIL (5191 6212 (\TEDIT.HISTORYEVENT.DEFPRINT 5201 . 6210)) (7302 17740 (\TEDIT.HISTORYADD
7312 . 12173) (\TEDIT.HISTORYADD.COMPOSITE 12175 . 12934) (\TEDIT.CUMULATE.EVENTS 12936 . 14530) (
\TEDIT.COMPOSITE.EVENT 14532 . 15268) (\TEDIT.HISTORY.PROP 15270 . 16633) (\TEDIT.HISTORY.EVENT 16635
. 17564) (\TEDIT.POPEVENT 17566 . 17738)) (17793 35623 (TEDIT.UNDO 17803 . 22197) (\TEDIT.UNDO1 22199
. 26411) (TEDIT.REDO 26413 . 32777) (\TEDIT.UNDO.UNDO 32779 . 35621)) (35624 50710 (
\TEDIT.UNDO.INSERT 35634 . 36547) (\TEDIT.UNDO.DELETE 36549 . 37343) (\TEDIT.UNDO.MOVE 37345 . 38934)
(\TEDIT.UNDO.REPLACE 38936 . 40032) (\TEDIT.UNDO.CHARLOOKS 40034 . 44608) (\TEDIT.UNDO.PARALOOKS 44610
. 48842) (\TEDIT.UNDO.PAGELOOKS 48844 . 49253) (\TEDIT.UNDO.COMPOSITE 49255 . 50482) (
\TEDIT.UNDO.REPLACECODE 50484 . 50708)) (50711 53071 (\TEDIT.REDO.INSERT 50721 . 51454) (
\TEDIT.REDO.REPLACE 51456 . 52787) (\TEDIT.REDO.COMPOSITE 52789 . 53069)))))
STOP

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

Binary file not shown.

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

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

464
library/tedit/TEDIT-OLDFILE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Mar-2024 11:06:42" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;11 73247
(FILECREATED "23-Oct-2024 16:09:28" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;27 72985
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.GET.PCTB2 \TEDIT.GET.PCTB1)
:CHANGES-TO (FNS \TEDIT.GET.SINGLE.PARALOOKS2 \TEDIT.GET.PARALOOKS1 \TEDIT.GET.PARALOOKS0)
:PREVIOUS-DATE "17-Mar-2024 18:15:40" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;10)
:PREVIOUS-DATE "21-Oct-2024 00:34:06" {WMEDLEY}<library>tedit>TEDIT-OLDFILE.;25)
(PRETTYCOMPRINT TEDIT-OLDFILECOMS)
@@ -46,7 +46,9 @@
(DEFINEQ
(\TEDIT.GET.PCTB2
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 29-Apr-2024 10:28 by rmk")
(* ; "Edited 20-Mar-2024 11:00 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 15-Mar-2024 14:37 by rmk")
(* ; "Edited 21-Jan-2024 10:21 by rmk")
@@ -65,9 +67,10 @@
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
(TEXTOBJ! TEXTOBJ)
(LET (PIECEINFOCH# (CURFILECH# (OR START 0))
LOOKSHASH PARAHASH)
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
PIECEINFOCH#
(CURFILECH# (OR START 0))
LOOKSHASH PARAHASH)
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -167,8 +170,7 @@
PPARALOOKS _ OLDPARALOOKS
PTYPE _ OBJECT.PTYPE
PBYTESPERCHAR _ PCLEN))
(\TEDIT.GET.OBJECT (FGETTOBJ TEXTOBJ STREAMHINT)
PC TEXT CURFILECH# PCLEN)
(\TEDIT.GET.OBJECT TSTREAM PC TEXT CURFILECH# PCLEN)
(add CURFILECH# PCLEN)
(FSETPC PC PLOOKS (if (ZEROP (BIN TEXT))
then
@@ -182,7 +184,7 @@
 "There are new character looks for this object. Read them in.")
(\TEDIT.GET.SINGLE.CHARLOOKS2 TEXT))))
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
(CL:WHEN PC (* ;
 "If we created a piece, save it in the table.")
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
@@ -273,7 +275,8 @@
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.CHARLOOKS2 FILE])
(\TEDIT.GET.SINGLE.CHARLOOKS2
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:53 by rmk")
[LAMBDA (FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 22:53 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:22 by rmk")
(* ; "Edited 7-Nov-2023 22:00 by rmk")
@@ -298,7 +301,7 @@
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
@@ -328,76 +331,68 @@
(RETURN LOOKS])
(\TEDIT.PUT.SINGLE.PARALOOKS2
[LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk")
[LAMBDA (FILE LOOKS) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 29-Jul-2024 23:25 by rmk")
(* ; "Edited 28-Jul-2024 16:07 by rmk")
(* ; "Edited 16-Jan-2024 23:01 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 3-Mar-2023 23:23 by rmk")
(* ; "Edited 30-May-91 20:33 by jds")
(* ;
 "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
(PROG (DEFTAB TABSPECS OUTPUTFORMAT LEN)
(\SMALLPOUT FILE (fetch (FMTSPEC 1STLEFTMAR) of LOOKS))
(* ;
(PROG (DEFTAB TABS OUTPUTFORMAT LEN)
(\SMALLPOUT FILE (FGETPARA LOOKS 1STLEFTMAR)) (* ;
 "Left margin for the first line of the paragraph")
(\SMALLPOUT FILE (fetch (FMTSPEC LEFTMAR) of LOOKS))
(* ;
(\SMALLPOUT FILE (FGETPARA LOOKS LEFTMAR)) (* ;
 "Left margin for the rest of the paragraph")
(\SMALLPOUT FILE (fetch (FMTSPEC RIGHTMAR) of LOOKS))
(* ; "Right margin for the paragraph")
(\SMALLPOUT FILE (fetch (FMTSPEC LEADBEFORE) of LOOKS))
(* ; "Leading before the paragraph")
(\SMALLPOUT FILE (fetch (FMTSPEC LEADAFTER) of LOOKS))
(* ; "Lead after the paragraph")
(\SMALLPOUT FILE (fetch (FMTSPEC LINELEAD) of LOOKS))
(* ; "inter-line leading")
(SETQ DEFTAB (CAR (fetch (FMTSPEC TABSPEC) of LOOKS)))
(SETQ TABSPECS (CDR (fetch (FMTSPEC TABSPEC) of LOOKS)))
(\SMALLPOUT FILE (FGETPARA LOOKS RIGHTMAR)) (* ; "Right margin for the paragraph")
(\SMALLPOUT FILE (FGETPARA LOOKS LEADBEFORE)) (* ; "Leading before the paragraph")
(\SMALLPOUT FILE (FGETPARA LOOKS LEADAFTER)) (* ; "Lead after the paragraph")
(\SMALLPOUT FILE (FGETPARA LOOKS LINELEAD)) (* ; "inter-line leading")
(SETQ DEFTAB (FGETPARA LOOKS FMTDEFAULTTAB))
(SETQ TABS (FGETPARA LOOKS FMTTABS))
(COND
((AND (fetch (FMTSPEC TABSPEC) of LOOKS)
(OR DEFTAB TABSPECS)) (* ;
((AND (OR DEFTAB TABS)) (* ;
 "There are tab specs to save, or there is a default tab setting to save")
(\BOUT FILE 3))
(T (* ;
 "There are no tab looks. Just let him go.")
(\BOUT FILE 2)))
(\BOUT FILE (SELECTQ (fetch (FMTSPEC QUAD) of LOOKS)
(\BOUT FILE (SELECTQ (FGETPARA LOOKS QUAD)
(LEFT 1)
(RIGHT 2)
((CENTER CENTERED)
3)
((JUST JUSTIFIED)
4)
(SHOULDNT)))
[COND
((OR TABSPECS DEFTAB) (* ; "There are tab specs to save.")
(COND
(DEFTAB (\SMALLPOUT FILE DEFTAB))
(T (\SMALLPOUT FILE 0)))
(\BOUT FILE (LENGTH TABSPECS))
(COND
(TABSPECS (* ; "# of tab settings <256!")
(for TAB in TABSPECS do (\SMALLPOUT FILE (fetch TABX of TAB))
(* ; "And setting.")
(\BOUT FILE (SELECTQ (fetch TABKIND of TAB)
(LEFT 0)
(RIGHT 1)
(CENTERED 2)
(DECIMAL 3)
(SHOULDNT)))
(* ; "Tab type")]
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALX) of LOOKS)
(\TEDIT.THELP)))
(CL:WHEN (OR TABS DEFTAB) (* ; "There are tab specs to save.")
(\SMALLPOUT FILE (OR DEFTAB 0))
(\BOUT FILE (LENGTH TABS))
(CL:WHEN TABS (* ; "# of tab settings <256!")
[for TAB in TABS do (\SMALLPOUT FILE (fetch (TAB TABX) of TAB))
(* ; "And setting and type")
(\BOUT FILE (SELECTQ (fetch (TAB TABKIND) of TAB)
(LEFT 0)
(RIGHT 1)
(CENTERED 2)
(DECIMAL 3)
(\TEDIT.THELP]))
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALX)
0))
(\SMALLPOUT FILE (OR (fetch (FMTSPEC FMTSPECIALY) of LOOKS)
(\SMALLPOUT FILE (OR (FGETPARA LOOKS FMTSPECIALY)
0))
(\ARBOUT FILE (fetch (FMTSPEC FMTUSERINFO) of LOOKS))
(\ATMOUT FILE (fetch (FMTSPEC FMTPARATYPE) of LOOKS))
(\ATMOUT FILE (fetch (FMTSPEC FMTPARASUBTYPE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTSTYLE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTCHARSTYLES) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS))
(\ARBOUT FILE (fetch (FMTSPEC FMTNEWPAGEAFTER) of LOOKS])
(\ARBOUT FILE (FGETPARA LOOKS FMTUSERINFO))
(\ATMOUT FILE (FGETPARA LOOKS FMTPARATYPE))
(\ATMOUT FILE (FGETPARA LOOKS FMTPARASUBTYPE))
(\ARBOUT FILE (FGETPARA LOOKS FMTSTYLE))
(\ARBOUT FILE (FGETPARA LOOKS FMTCHARSTYLES))
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEBEFORE))
(\ARBOUT FILE (FGETPARA LOOKS FMTNEWPAGEAFTER])
(\TEDIT.PUT.SINGLE.CHARLOOKS2
[LAMBDA (FILE LOOKS) (* ; "Edited 16-Jan-2024 23:01 by rmk")
[LAMBDA (FILE LOOKS) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:01 by rmk")
(* ; "Edited 19-Dec-2023 10:14 by rmk")
(* ; "Edited 30-May-91 20:26 by jds")
(* ;
@@ -468,7 +463,7 @@
NIL 4)
(T 0))
(COND
((fetch (CHARLOOKS CLSELHERE) of LOOKS)
((fetch (CHARLOOKS CLSELAFTER) of LOOKS)
2)
(T 0))
(COND
@@ -484,69 +479,65 @@
(for I from 1 to (\WIN FILE) collect (\TEDIT.GET.SINGLE.PARALOOKS2 FILE])
(\TEDIT.GET.SINGLE.PARALOOKS2
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:54 by rmk")
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:07 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 5-Aug-2024 09:48 by rmk")
(* ; "Edited 29-Jul-2024 23:22 by rmk")
(* ; "Edited 28-Jul-2024 21:35 by rmk")
(* ; "Edited 16-Jan-2024 22:54 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 3-Mar-2023 23:18 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
(* ; "Edited 30-May-91 20:33 by jds")
(* ;
 "Read a paragraph format spec from the FILE, and return it for later use.")
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(LET ((FMT (create FMTSPEC))
TABFLG DEFTAB TABS)
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the first line of the paragraph")
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the rest of the paragraph")
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
(* ; "Right margin for the paragraph")
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
(* ; "Leading before the paragraph")
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
(* ; "Lead after the paragraph")
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
(* ; "inter-line leading")
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
(* ; "Will be tab specs")
(SETQ TABFLG (BIN FILE))
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(SHOULDNT)))
(COND
((NOT (ZEROP (LOGAND TABFLG 1))) (* ; "There are tabs to read")
(SETQ DEFTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _
(SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(SHOULDNT]
(CL:UNLESS (ZEROP DEFTAB)
(RPLACA TABSPEC DEFTAB))
(RPLACD TABSPEC TABS)))
[COND
((NOT (ZEROP (LOGAND TABFLG 2))) (* ;
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
(SETQ TABFLG (BIN FILE))
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(\TEDIT.THELP)))
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
(SETQ DEFTAB (\SMALLPIN FILE))
(CL:WHEN (ILEQ DEFTAB 1)
(SETQ DEFTAB DEFAULTTAB))
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _
(SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(\TEDIT.THELP]
(FSETPARA FMT FMTTABS TABS))
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
 "There are other paragraph parameters to be read.")
(replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE))
(* ;
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
 "Special X location on page for this paragraph")
(replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE))
(replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE))
(replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE))
(replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE]
(RETURN LOOKS])
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
FMT])
(\TEDIT.PUT.CHARLOOKS.LIST2
[LAMBDA (FILE LOOKSLIST) (* ; "Edited 16-Jan-2024 23:02 by rmk")
@@ -600,7 +591,9 @@
(DEFINEQ
(\TEDIT.GET.PCTB1
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 20-Mar-2024 11:00 by rmk")
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 29-Apr-2024 10:28 by rmk")
(* ; "Edited 20-Mar-2024 11:00 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 21-Jan-2024 10:23 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
@@ -619,8 +612,9 @@
(* ;; "END = use this as eofptr of file. For use in reading files within files.")
(TEXTOBJ! TEXTOBJ)
(LET (PIECEINFOCH# TSTREAM (CURFILECH# (OR START 0)))
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
PIECEINFOCH#
(CURFILECH# (OR START 0)))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -675,8 +669,7 @@
PPARALOOKS _ OLDPARALOOKS
PTYPE _ THINFILE.PTYPE
PBYTESPERCHAR _ PCLEN))
(TEDIT.GET.OBJECT1 (FGETTOBJ TEXTOBJ STREAMHINT)
PC TEXT CURFILECH#)
(TEDIT.GET.OBJECT1 TSTREAM PC TEXT CURFILECH#)
(add CURFILECH# PCLEN)
[COND
((NOT (ZEROP (BIN TEXT))) (* ;
@@ -689,7 +682,7 @@
 "No new looks; steal them from the prior piece.")
(FSETPC PC PLOOKS (OR (AND OLDPC (PLOOKS OLDPC))
DEFAULTCHARLOOKS])
(SHOULDNT "Impossible piece-type code"))
(\TEDIT.THELP "Impossible piece-type code"))
(CL:WHEN PC
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ)
(SETQ OLDPC PC)) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
@@ -702,7 +695,8 @@
(\TEDIT.PARSE.PAGEFRAMES1 (READ FILE])
(\TEDIT.PARSE.PAGEFRAMES1
[LAMBDA (PAGELIST PARENT) (* ; "Edited 7-Nov-2023 13:27 by rmk")
[LAMBDA (PAGELIST PARENT) (* ; "Edited 30-Aug-2024 15:43 by rmk")
(* ; "Edited 7-Nov-2023 13:27 by rmk")
(* ; "Edited 8-Mar-2023 18:14 by rmk")
(* ; "Edited 4-Oct-2022 16:57 by rmk")
(* ; "Edited 1-Oct-2022 16:02 by rmk")
@@ -736,10 +730,14 @@
collect (\TEDIT.PARSE.PAGEFRAMES1 ALIST
PAGEFRAME)))
PAGEFRAME)
(T (for FRAMESPEC in (CAR PAGELIST) collect (\TEDIT.PARSE.PAGEFRAMES1 FRAMESPEC NIL])
(T (SETQ PAGELIST (CAR PAGELIST))
(TEDIT.COMPOUND.PAGEFORMAT (\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST))
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST))
(\TEDIT.PARSE.PAGEFRAMES1 (pop PAGELIST])
(\TEDIT.GET.CHARLOOKS1
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk")
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 22:55 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 25-Nov-2023 23:21 by rmk")
(* ; "Edited 7-Nov-2023 22:02 by rmk")
@@ -776,7 +774,7 @@
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
@@ -805,7 +803,11 @@
(replace (CHARLOOKS CLFONT) of LOOKS with FONT])
(\TEDIT.GET.PARALOOKS1
[LAMBDA (FILE) (* ; "Edited 16-Jan-2024 22:55 by rmk")
[LAMBDA (FILE) (* ; "Edited 23-Oct-2024 16:08 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 5-Aug-2024 09:48 by rmk")
(* ; "Edited 28-Jul-2024 22:00 by rmk")
(* ; "Edited 16-Jan-2024 22:55 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 27-Oct-2023 13:00 by rmk")
(* ; "Edited 3-Mar-2023 23:20 by rmk")
@@ -813,63 +815,57 @@
(* ; "Edited 30-May-91 20:34 by jds")
(* ;
 "Read a paragraph format spec from the FILE, and return it for later use.")
(LET ((LOOKS (create FMTSPEC))
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(LET ((FMT (create FMTSPEC))
TABFLG DEFTAB)
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the first line of the paragraph")
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the rest of the paragraph")
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
(* ; "Right margin for the paragraph")
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
(* ; "Leading before the paragraph")
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
(* ; "Lead after the paragraph")
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
(* ; "inter-line leading")
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
(* ; "Will be tab specs")
(SETQ TABFLG (BIN FILE))
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(SHOULDNT)))
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(\TEDIT.THELP)))
(CL:UNLESS (ZEROP (LOGAND TABFLG 1)) (* ; "There are tabs to read")
(SETQ DEFTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _
(SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(SHOULDNT]
(CL:UNLESS (ZEROP DEFTAB)
(RPLACA TABSPEC DEFTAB))
(RPLACD TABSPEC TABS))
(CL:WHEN (ILEQ DEFTAB 1)
(SETQ DEFTAB DEFAULTTAB))
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
[FSETPARA FMT FMTTABS (for TAB# from 1 to (BIN FILE)
collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _ (SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(\TEDIT.THELP])
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
(CL:UNLESS (ZEROP (LOGAND TABFLG 2)) (* ;
 "There are other paragraph parameters to be read.")
(replace (FMTSPEC FMTSPECIALX) of LOOKS with (\SMALLPIN FILE))
(* ;
(FSETPARA FMT FMTSPECIALX (\SMALLPIN FILE)) (* ;
 "Special X location on page for this paragraph")
(replace (FMTSPEC FMTSPECIALY) of LOOKS with (\SMALLPIN FILE))
(replace (FMTSPEC FMTUSERINFO) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTPARATYPE) of LOOKS with (\ATMIN FILE))
(replace (FMTSPEC FMTPARASUBTYPE) of LOOKS with (\ATMIN FILE))
(replace (FMTSPEC FMTSTYLE) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTCHARSTYLES) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTNEWPAGEBEFORE) of LOOKS with (\ARBIN FILE))
(replace (FMTSPEC FMTNEWPAGEAFTER) of LOOKS with (\ARBIN FILE)))
LOOKS])
(FSETPARA FMT FMTSPECIALY (\SMALLPIN FILE))
(FSETPARA FMT FMTUSERINFO (\ARBIN FILE))
(FSETPARA FMT FMTPARATYPE (\ATMIN FILE))
(FSETPARA FMT FMTPARASUBTYPE (\ATMIN FILE))
(FSETPARA FMT FMTSTYLE (\ARBIN FILE))
(FSETPARA FMT FMTCHARSTYLES (\ARBIN FILE))
(FSETPARA FMT FMTNEWPAGEBEFORE (\ARBIN FILE))
(FSETPARA FMT FMTNEWPAGEAFTER (\ARBIN FILE)))
FMT])
(TEDIT.GET.OBJECT1
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 27-Oct-2023 12:58 by rmk")
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
(* ; "Edited 27-Oct-2023 12:58 by rmk")
(* ; "Edited 6-Aug-2022 09:11 by rmk")
(* ; "Edited 12-Jun-90 18:17 by mitani")
@@ -891,7 +887,8 @@
(FSETPC PIECE PLOOKS (if (PREVPIECE PIECE)
then (PLOOKS (PREVPIECE PIECE))
elseif (FGETTOBJ TEXTOBJ DEFAULTCHARLOOKS)
else (\TEDIT.UNIQUIFY.CHARLOOKS (CHARLOOKS.FROM.FONT DEFAULTFONT)
else (\TEDIT.UNIQUIFY.CHARLOOKS (\TEDIT.CHARLOOKS.FROM.FONT
DEFAULTFONT)
TEXTOBJ)))
(PCONTENTS PIECE])
)
@@ -903,7 +900,9 @@
(DEFINEQ
(\TEDIT.GET.PCTB0
[LAMBDA (TEXT TEXTOBJ PCCOUNT START END) (* ; "Edited 17-Mar-2024 12:41 by rmk")
[LAMBDA (TEXT TSTREAM PCCOUNT START END) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 29-Apr-2024 10:27 by rmk")
(* ; "Edited 17-Mar-2024 12:41 by rmk")
(* ; "Edited 15-Mar-2024 14:47 by rmk")
(* ; "Edited 21-Jan-2024 10:27 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
@@ -915,8 +914,9 @@
(* ;;; "READ OBSOLETE FORMATS OF TEDIT FILE")
(LET (OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
(SBINABLE (fetch (STREAM BINABLE) of TEXT)))
(LET ((TEXTOBJ (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of TSTREAM)))
OLDPC TYPECODE PCLEN PIECEINFOCH# TSTREAM USERFILEFORMAT USERTEMP (CURFILECH# (OR START 0))
(SBINABLE (fetch (STREAM BINABLE) of TEXT)))
(SETFILEPTR TEXT (IDIFFERENCE (OR END (GETEOFPTR TEXT))
8))
(SETQ PIECEINFOCH# (\DWIN TEXT))
@@ -943,8 +943,7 @@
(\TEDIT.GET.CHARLOOKS0 PC TEXT)
(add CURFILECH# (PLEN PC)))
(\PieceDescriptorOBJECT
(\TEDIT.GET.OBJECT0 (AND TEXTOBJ (FGETTOBJ TEXTOBJ STREAMHINT))
PC TEXT CURFILECH#)
(\TEDIT.GET.OBJECT0 TSTREAM PC TEXT CURFILECH#)
(add CURFILECH# (PLEN PC)) (* ;
 "Only object--can't be followed by either of the others.")
(FSETPC PC PLEN 1))
@@ -958,12 +957,13 @@
(\TEDIT.GET.CHARLOOKS0 PC TEXT) (* ; "This document is 'formatted' .")
(add CURFILECH# (PLEN PC))
(AND TEXTOBJ (FSETTOBJ TEXTOBJ FORMATTEDP T)))
(SHOULDNT "Impossible piece-type code in BUILD.PCTB"))
(\TEDIT.THELP "Impossible piece-type code in BUILD.PCTB"))
(SETQ OLDPC PC)
(\TEDIT.INSERTPIECE PC NIL TEXTOBJ) finally (\TEDIT.UNIQUIFY.ALL TEXTOBJ])
(\TEDIT.GET.CHARLOOKS0
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 23:03 by rmk")
[LAMBDA (PC FILE) (* ; "Edited 31-Jul-2024 00:05 by rmk")
(* ; "Edited 16-Jan-2024 23:03 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
(* ; "Edited 30-May-91 20:26 by jds")
@@ -1007,7 +1007,7 @@
[SETQ CLSMALLCAP (NOT (ZEROP (LOGAND 16 PROPS]
[SETQ CLPROTECTED (NOT (ZEROP (LOGAND 8 PROPS]
[SETQ CLINVISIBLE (NOT (ZEROP (LOGAND 4 PROPS]
[SETQ CLSELHERE (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLSELAFTER (NOT (ZEROP (LOGAND 2 PROPS]
[SETQ CLCANCOPY (NOT (ZEROP (LOGAND 1 PROPS]
(SETQ CLSIZE SIZE)
(SETQ CLOFFSET SUPER))
@@ -1027,7 +1027,8 @@
'ITALIC])
(\TEDIT.GET.OBJECT0
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 6-Aug-2022 15:57 by rmk")
[LAMBDA (STREAM PIECE FILE CURCH#) (* ; "Edited 31-Jul-2024 12:09 by rmk")
(* ; "Edited 6-Aug-2022 15:57 by rmk")
(* ; "Edited 12-Jun-90 18:17 by mitani")
(* ;; "Get an object from the file")
@@ -1051,71 +1052,70 @@
(T (OR (fetch (TEXTOBJ DEFAULTCHARLOOKS)
of TEXTOBJ)
(\TEDIT.UNIQUIFY.CHARLOOKS (
CHARLOOKS.FROM.FONT
\TEDIT.CHARLOOKS.FROM.FONT
DEFAULTFONT)
TEXTOBJ]
OBJ])
(\TEDIT.GET.PARALOOKS0
[LAMBDA (PC FILE) (* ; "Edited 16-Jan-2024 22:57 by rmk")
[LAMBDA (PC FILE) (* ; "Edited 23-Oct-2024 16:09 by rmk")
(* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 5-Aug-2024 09:47 by rmk")
(* ; "Edited 29-Jul-2024 23:23 by rmk")
(* ; "Edited 28-Jul-2024 22:23 by rmk")
(* ; "Edited 16-Jan-2024 22:57 by rmk")
(* ; "Edited 19-Dec-2023 10:13 by rmk")
(* ; "Edited 3-Mar-2023 23:14 by rmk")
(* ; "Edited 1-Aug-2022 12:04 by rmk")
(* ; "Edited 30-May-91 20:34 by jds")
(* ;
 "Put a description of LOOKS into FILE. LOOKS apply to characters CH1 thru CHLIM-1")
(PROG ((LOOKS (create FMTSPEC))
TABFLG DEFTAB TABCOUNT TABS TABSPEC)
(replace (PIECE PPARALOOKS) of PC with LOOKS)
(replace (FMTSPEC 1STLEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(LET ((FMT (create FMTSPEC))
TABFLG DEFTAB TABS)
(SETPC PC PPARALOOKS FMT)
(FSETPARA FMT 1STLEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the first line of the paragraph")
(replace (FMTSPEC LEFTMAR) of LOOKS with (\SMALLPIN FILE))
(* ;
(FSETPARA FMT LEFTMAR (\SMALLPIN FILE)) (* ;
 "Left margin for the rest of the paragraph")
(replace (FMTSPEC RIGHTMAR) of LOOKS with (\SMALLPIN FILE))
(* ; "Right margin for the paragraph")
(replace (FMTSPEC LEADBEFORE) of LOOKS with (\SMALLPIN FILE))
(* ; "Leading before the paragraph")
(replace (FMTSPEC LEADAFTER) of LOOKS with (\SMALLPIN FILE))
(* ; "Lead after the paragraph")
(replace (FMTSPEC LINELEAD) of LOOKS with (\SMALLPIN FILE))
(* ; "inter-line leading")
(replace (FMTSPEC TABSPEC) of LOOKS with (SETQ TABSPEC (CONS DEFAULTTAB NIL)))
(* ; "Will be tab specs")
(SETQ TABFLG (BIN FILE))
(replace (FMTSPEC QUAD) of LOOKS with (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(SHOULDNT)))
(COND
((NOT (ZEROP TABFLG)) (* ; "There are tabs to read")
(SETQ DEFTAB (\SMALLPIN FILE))
(SETQ TABCOUNT (BIN FILE))
[SETQ TABS (for TAB# from 1 to TABCOUNT collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _
(SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(SHOULDNT]
(OR (ZEROP DEFTAB)
(RPLACA TABSPEC DEFTAB))
(RPLACD TABSPEC TABS])
(FSETPARA FMT RIGHTMAR (\SMALLPIN FILE)) (* ; "Right margin for the paragraph")
(FSETPARA FMT LEADBEFORE (\SMALLPIN FILE)) (* ; "Leading before the paragraph")
(FSETPARA FMT LEADAFTER (\SMALLPIN FILE)) (* ; "Lead after the paragraph")
(FSETPARA FMT LINELEAD (\SMALLPIN FILE)) (* ; "inter-line leading")
(SETQ TABFLG (BIN FILE))
(FSETPARA FMT QUAD (SELECTC (BIN FILE)
(1 'LEFT)
(2 'RIGHT)
(3 'CENTERED)
(4 'JUSTIFIED)
(\TEDIT.THELP)))
(CL:UNLESS (ZEROP TABFLG) (* ; "There are tabs to read")
(SETQ DEFTAB (\SMALLPIN FILE))
(CL:WHEN (ILEQ DEFTAB 1)
(SETQ DEFTAB DEFAULTTAB))
(FSETPARA FMT FMTDEFAULTTAB DEFTAB)
[SETQ TABS (for TAB# from 1 to (BIN FILE) collect (create TAB
TABX _ (\SMALLPIN FILE)
TABKIND _
(SELECTQ (BIN FILE)
(0 'LEFT)
(1 'RIGHT)
(2 'CENTERED)
(3 'DECIMAL)
(\TEDIT.THELP]
(FSETPARA FMT FMTTABS TABS))
(CL:UNLESS (FGETPARA FMT FMTDEFAULTTAB)
(FSETPARA FMT FMTDEFAULTTAB DEFAULTTAB))
FMT])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1666 38666 (\TEDIT.GET.PCTB2 1676 . 11742) (\TEDIT.GET.PARALOOKS2 11744 . 12333) (
\TEDIT.GET.CHARLOOKS2 12335 . 13666) (\TEDIT.PARSE.PAGEFRAMES2 13668 . 16407) (
\TEDIT.GET.CHARLOOKS.LIST2 16409 . 16916) (\TEDIT.GET.SINGLE.CHARLOOKS2 16918 . 20635) (
\TEDIT.PUT.SINGLE.PARALOOKS2 20637 . 25388) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25390 . 29864) (
\TEDIT.GET.PARALOOKS.LIST2 29866 . 30373) (\TEDIT.GET.SINGLE.PARALOOKS2 30375 . 35384) (
\TEDIT.PUT.CHARLOOKS.LIST2 35386 . 37465) (\TEDIT.PUT.PARALOOKS.LIST2 37467 . 38664)) (38743 59003 (
\TEDIT.GET.PCTB1 38753 . 45217) (\TEDIT.GET.PAGEFRAMES1 45219 . 45671) (\TEDIT.PARSE.PAGEFRAMES1 45673
. 48049) (\TEDIT.GET.CHARLOOKS1 48051 . 52423) (\TEDIT.GET.PARALOOKS1 52425 . 57457) (
TEDIT.GET.OBJECT1 57459 . 59001)) (59063 73224 (\TEDIT.GET.PCTB0 59073 . 62808) (\TEDIT.GET.CHARLOOKS0
62810 . 67397) (\TEDIT.GET.OBJECT0 67399 . 69349) (\TEDIT.GET.PARALOOKS0 69351 . 73222)))))
(FILEMAP (NIL (1705 37969 (\TEDIT.GET.PCTB2 1715 . 12010) (\TEDIT.GET.PARALOOKS2 12012 . 12601) (
\TEDIT.GET.CHARLOOKS2 12603 . 13934) (\TEDIT.PARSE.PAGEFRAMES2 13936 . 16675) (
\TEDIT.GET.CHARLOOKS.LIST2 16677 . 17184) (\TEDIT.GET.SINGLE.CHARLOOKS2 17186 . 21013) (
\TEDIT.PUT.SINGLE.PARALOOKS2 21015 . 25132) (\TEDIT.PUT.SINGLE.CHARLOOKS2 25134 . 29718) (
\TEDIT.GET.PARALOOKS.LIST2 29720 . 30227) (\TEDIT.GET.SINGLE.PARALOOKS2 30229 . 34687) (
\TEDIT.PUT.CHARLOOKS.LIST2 34689 . 36768) (\TEDIT.PUT.PARALOOKS.LIST2 36770 . 37967)) (38046 58482 (
\TEDIT.GET.PCTB1 38056 . 44747) (\TEDIT.GET.PAGEFRAMES1 44749 . 45201) (\TEDIT.PARSE.PAGEFRAMES1 45203
. 47856) (\TEDIT.GET.CHARLOOKS1 47858 . 52340) (\TEDIT.GET.PARALOOKS1 52342 . 56748) (
TEDIT.GET.OBJECT1 56750 . 58480)) (58542 72962 (\TEDIT.GET.PCTB0 58552 . 62515) (\TEDIT.GET.CHARLOOKS0
62517 . 67214) (\TEDIT.GET.OBJECT0 67216 . 69275) (\TEDIT.GET.PARALOOKS0 69277 . 72960)))))
STOP

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

Binary file not shown.

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

85
library/tedit/TEDIT-PCTREE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Mar-2024 11:07:07" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;239 66617
(FILECREATED "27-Nov-2024 23:12:27" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;243 67795
:EDIT-BY rmk
:CHANGES-TO (FNS \TEDIT.INSERTPIECES)
:CHANGES-TO (FNS \TEDIT.DELETEPIECES)
:PREVIOUS-DATE "17-Mar-2024 12:41:57" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;238)
:PREVIOUS-DATE "21-Oct-2024 00:42:44" {WMEDLEY}<library>tedit>TEDIT-PCTREE.;242)
(PRETTYCOMPRINT TEDIT-PCTREECOMS)
@@ -272,10 +272,15 @@
DELTA])
(\TEDIT.FIRSTPIECE
[LAMBDA (TEXTOBJ) (* ; "Edited 31-Oct-2023 19:37 by rmk")
[LAMBDA (TEXTOBJ) (* ; "Edited 21-Aug-2024 16:07 by rmk")
(* ; "Edited 31-Oct-2023 19:37 by rmk")
(* ; "Edited 11-Apr-2023 12:54 by rmk")
(* ; "Edited 24-Aug-2022 12:45 by rmk")
(for (NODE _ (CAR (GETTOBJ TEXTOBJ PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
(for (NODE _ (CAR (GETTOBJ (if (type? TEXTOBJ TEXTOBJ)
then TEXTOBJ
elseif (type? STREAM TEXTOBJ)
then (fetch (TEXTSTREAM TEXTOBJ) of TEXTOBJ))
PCTB))) by (ffetch (BTREENODE DOWN1) of NODE)
unless (type? BTREENODE NODE) do
(* ;; "If we don't bottom out in a piece, something else is screwed up. But we return NIL for the last piece, which is only there to hold the PREV pointer to the real last piece (and maybe the initial looks).")
@@ -284,7 +289,8 @@
NODE])
(\TEDIT.DELETETREE
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 17-Mar-2024 00:22 by rmk")
[LAMBDA (OLD PCNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 17-Mar-2024 00:22 by rmk")
(* ; "Edited 31-Oct-2023 10:23 by rmk")
(* ; "Edited 26-Oct-2023 12:50 by rmk")
(* ; "Edited 30-May-2023 08:58 by rmk")
@@ -313,7 +319,7 @@
(bind TARGET OLDSLOT (LAST _ (\LASTSLOT PCNODE))
first (SETQ OLDSLOT (\FINDSLOT PCNODE OLD))
(CL:UNLESS OLDSLOT (SHOULDNT "Piece/node not in PCNODE"))
(CL:UNLESS OLDSLOT (\TEDIT.THELP "Piece/node not in PCNODE"))
(CL:WHEN (EQ OLDSLOT LAST) (* ; "Just shrink by one")
(\FILLSLOT OLDSLOT NIL 0)
(GO $$OUT))
@@ -504,18 +510,20 @@
(RETURN NODE])
(\TEDIT.SET-TOTLEN
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2023 17:22 by rmk")
[LAMBDA (PCNODE) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 21-Oct-2023 17:22 by rmk")
(* ; "Edited 15-Aug-2022 17:15 by rmk")
(* ; "Edited 9-May-93 15:40 by jds")
(* ;; "Fix the TOTLEN field of a node to match the sum of its childrens' lengths")
(HELP 'NOTCALLED)
(\TEDIT.THELP 'NOTCALLED)
(replace (BTREENODE TOTLEN) of PCNODE with (for S inslots PCNODE sum (fetch (BTSLOT DLEN)
of S])
(\TEDIT.MAKE.VACANT.BTREESLOT
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 16-Mar-2024 10:23 by rmk")
[LAMBDA (BTNODE TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 16-Mar-2024 10:23 by rmk")
(* ; "Edited 7-Dec-2023 21:08 by rmk")
(* ; "Edited 31-Oct-2023 10:32 by rmk")
(* ; "Edited 10-Jun-2023 00:13 by rmk")
@@ -563,7 +571,7 @@
(UNINTERRUPTABLY
(replace (BTREENODE UPWARD) of BTNODE with PARENT)
(RPLACA (OR (FMEMB BTNODE (FGETTOBJ TEXTOBJ PCTB))
(HELP "BTNODE NOT FOUND"))
(\TEDIT.THELP "BTNODE NOT FOUND"))
PARENT)))
(* ;; "Tree is still valid, but PARENT how has a needed empty slot.")
@@ -643,19 +651,21 @@
NEW])
(\TEDIT.UNLINKPIECE
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2023 17:24 by rmk")
[LAMBDA (PREV PC TEXTOBJ) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 21-Oct-2023 17:24 by rmk")
(* ; "Edited 30-May-2023 00:31 by rmk")
(* ;; "Takes PC out of the piece chain, linking prev and next around it.")
(HELP 'NOTCALLED?)
(\TEDIT.THELP 'NOTCALLED?)
(CL:WHEN PREV
(freplace (PIECE NEXTPIECE) of PREV with (NEXTPIECE PC)))
(freplace (PIECE PREVPIECE) of (OR (NEXTPIECE PC)
(ffetch (TEXTOBJ LASTPIECE) of TEXTOBJ)) with PREV])
(\TEDIT.SPLITPIECE
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 17-Mar-2024 00:11 by rmk")
[LAMBDA (PC CHOFFSET TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 17-Mar-2024 00:11 by rmk")
(* ; "Edited 28-Dec-2023 22:17 by rmk")
(* ; "Edited 7-Dec-2023 21:07 by rmk")
(* ; "Edited 25-Nov-2023 11:50 by rmk")
@@ -687,7 +697,7 @@
(CONSTANT (APPEND STRING.PTYPES FILE.PTYPES)))
(* ;
 "Dont' want the error under the UNINTERRABPTABLY. Remove when everything is good.")
(SHOULDNT "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
(\TEDIT.THELP "ATTEMPT TO SPLIT A NONSTRING NONFILE PIECE"))
(* ;; "")
@@ -817,7 +827,8 @@
PIECES])
(\TEDIT.DELETEPIECES
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 16-Mar-2024 10:00 by rmk")
[LAMBDA (SELPIECES TEXTOBJ) (* ; "Edited 26-Nov-2024 10:50 by rmk")
(* ; "Edited 16-Mar-2024 10:00 by rmk")
(* ; "Edited 25-Nov-2023 12:12 by rmk")
(* ; "Edited 4-Nov-2023 23:03 by rmk")
(* ; "Edited 22-Oct-2023 11:43 by rmk")
@@ -837,10 +848,11 @@
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'BEFORE TEXTOBJ)
(for PC PREV NEXT first (FSETTOBJ TEXTOBJ HINTPC NIL)
(SETQ PREV (PREVPIECE (fetch (SELPIECES SPFIRST) of SELPIECES)))
(SETQ PREV (PREVPIECE (GETSPC SELPIECES SPFIRST)))
(* ; "For incremental chain-update")
(SETQ NEXT (OR (NEXTPIECE (fetch (SELPIECES SPLAST) of SELPIECES))
(FGETTOBJ TEXTOBJ LASTPIECE))) inselpieces SELPIECES
(SETQ NEXT (OR (NEXTPIECE (GETSPC SELPIECES SPLAST))
(FGETTOBJ TEXTOBJ LASTPIECE)))
(FSETTOBJ TEXTOBJ \DIRTY T) inselpieces SELPIECES
do (UNINTERRUPTABLY
(\TEDIT.UPDATEPCNODES PC (IMINUS (PLEN PC))
TEXTOBJ)
@@ -856,9 +868,9 @@
(* ;;
 "TEXTOBJ has forgotten the SELPIECES, now make the SELPIECES also forget they were there.")
(FSETPC (fetch (SELPIECES SPFIRST) of SELPIECES)
(FSETPC (GETSPC SELPIECES SPFIRST)
PREVPIECE NIL)
(FSETPC (fetch (SELPIECES SPLAST) of SELPIECES)
(FSETPC (GETSPC SELPIECES SPLAST)
NEXTPIECE NIL))
(\TEDIT.BTVALIDATE '\TEDIT.DELETEPIECES 'AFTER TEXTOBJ])
@@ -1057,12 +1069,13 @@
(\TEDIT.BTFAIL
[LAMBDA (STRING VAL)
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 28-May-2023 08:45 by rmk")
(HELP (CONCAT (OR TAG "")
" "
(OR MSG "")
": " STRING)
VAL])
(DECLARE (USEDFREE TAG MSG)) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 28-May-2023 08:45 by rmk")
(\TEDIT.THELP (CONCAT (OR TAG "")
" "
(OR MSG "")
": " STRING)
VAL])
(\TEDIT.MATCHPCS
[LAMBDA (NODE) (* ; "Edited 16-Mar-2024 11:07 by rmk")
@@ -1085,13 +1098,13 @@
(GLOBALVARS BTVALIDATETAGS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8698 54531 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
\TEDIT.FIRSTPIECE 12557 . 13471) (\TEDIT.DELETETREE 13473 . 16634) (\TEDIT.INSERTTREE 16636 . 19381) (
\TEDIT.LASTPIECE 19383 . 20319) (\TEDIT.PCTOCH 20321 . 22418) (\TEDIT.CHTOPC 22420 . 28482) (
\TEDIT.SET-TOTLEN 28484 . 29155) (\TEDIT.MAKE.VACANT.BTREESLOT 29157 . 35770) (\TEDIT.LINKNEWPIECE
35772 . 37265) (\TEDIT.UNLINKPIECE 37267 . 37878) (\TEDIT.SPLITPIECE 37880 . 42423) (
\TEDIT.INSERTPIECE 42425 . 45578) (\TEDIT.INSERTPIECES 45580 . 48559) (\TEDIT.DELETEPIECES 48561 .
52525) (\TEDIT.ALIGNEDPIECE 52527 . 54529)) (54559 66494 (\TEDIT.BTVALIDATE 54569 . 56110) (
\TEDIT.BTVALIDATE.PRINT 56112 . 57477) (\TEDIT.CHECK-BTREE 57479 . 59691) (\TEDIT.CHECK-BTREE1 59693
. 65193) (\TEDIT.BTFAIL 65195 . 65475) (\TEDIT.MATCHPCS 65477 . 66492)))))
(FILEMAP (NIL (8698 55567 (\TEDIT.MAKEPCTB 8708 . 10259) (\TEDIT.UPDATEPCNODES 10261 . 12555) (
\TEDIT.FIRSTPIECE 12557 . 13853) (\TEDIT.DELETETREE 13855 . 17129) (\TEDIT.INSERTTREE 17131 . 19876) (
\TEDIT.LASTPIECE 19878 . 20814) (\TEDIT.PCTOCH 20816 . 22913) (\TEDIT.CHTOPC 22915 . 28977) (
\TEDIT.SET-TOTLEN 28979 . 29767) (\TEDIT.MAKE.VACANT.BTREESLOT 29769 . 36499) (\TEDIT.LINKNEWPIECE
36501 . 37994) (\TEDIT.UNLINKPIECE 37996 . 38724) (\TEDIT.SPLITPIECE 38726 . 43382) (
\TEDIT.INSERTPIECE 43384 . 46537) (\TEDIT.INSERTPIECES 46539 . 49518) (\TEDIT.DELETEPIECES 49520 .
53561) (\TEDIT.ALIGNEDPIECE 53563 . 55565)) (55595 67672 (\TEDIT.BTVALIDATE 55605 . 57146) (
\TEDIT.BTVALIDATE.PRINT 57148 . 58513) (\TEDIT.CHECK-BTREE 58515 . 60727) (\TEDIT.CHECK-BTREE1 60729
. 66229) (\TEDIT.BTFAIL 66231 . 66653) (\TEDIT.MATCHPCS 66655 . 67670)))))
STOP

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

Binary file not shown.

BIN
library/tedit/TEDIT-RELEASENOTES.TEDIT Normal file
View File

Binary file not shown.

172
library/tedit/TEDIT-RENAMES Normal file
View File

@@ -0,0 +1,172 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Aug-2024 08:48:45" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;5 7187
:EDIT-BY rmk
:CHANGES-TO (VARS TEDITSYMBOLMAP)
:PREVIOUS-DATE "22-Jul-2024 11:31:22" {WMEDLEY}<library>tedit>TEDIT-RENAMES.;4)
(PRETTYCOMPRINT TEDIT-RENAMESCOMS)
(RPAQQ TEDIT-RENAMESCOMS (
(* ;; "TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE).")
(* ;;
 "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
(VARS TEDITSYMBOLMAP)
(VARS FORWARDEDFILES)))
(* ;;
"TEDITSYMBOLMAP is a list that maps names for current TEDIT items (e.g. \TEDIT.FORMATLINE) into the names of those items in earlier Tedits (e.g. \FORMATLINE)."
)
(* ;; "FORWARDEDFILES maps original TEDIT filenames (e.g. PCTREE to TEDIT-PCTREE)")
(RPAQQ TEDITSYMBOLMAP
((MB.NB.ARRANGEBUTTONS MB.NB.PACKITEMS)
(MB.NWAYBUTTON.BUTTONEVENTINFN MB.NWAYBUTTON.SELFN)
(\TEDIT.BTFAIL BTFAIL)
(\TEDIT.BTVALIDATE BTVALIDATE)
(\TEDIT.BTVALIDATE.PRINT BTVALIDATE.PRINT)
(\TEDIT.CHANGE.CHARLOOKS \TEDIT.CHANGE.LOOKS)
(\TEDIT.CHECK-BTREE CHECK-BTREE)
(\TEDIT.CHECK-BTREE1 CHECK-BTREE1)
(\TEDIT.EQCLOOKS EQCLOOKS)
(\TEDIT.EQFMTSPEC EQFMTSPEC)
(\TEDIT.REOPENTEXTSTREAM REOPENTEXTSTREAM)
(\TEDIT.SAMECLOOKS SAMECLOOKS)
(\TEDIT.DO.BLUEPENDINGDELETE TEDIT.DO.BLUEPENDINGDELETE)
(\TEDIT.FORMATBOX TEDIT.FORMATBOX)
(\TEDIT.FORMATFOLIO TEDIT.FORMATFOLIO)
(\TEDIT.FORMATHEADING TEDIT.FORMATHEADING)
(\TEDIT.FORMATPAGE TEDIT.FORMATPAGE)
(\TEDIT.FORMATTEXTBOX TEDIT.FORMATTEXTBOX)
(\TEDIT.GET.CHARLOOKS0 TEDIT.GET.CHARLOOKS0)
(\TEDIT.GET.OBJECT TEDIT.GET.OBJECT)
(\TEDIT.GET.OBJECT0 TEDIT.GET.OBJECT0)
(\TEDIT.GET.PARALOOKS0 TEDIT.GET.PARALOOKS0)
(\TEDIT.GET.PCTB0 TEDIT.GET.PCTB0)
(\TEDIT.PUT.OBJECT TEDIT.PUT.OBJECT)
(\TEDIT.RESET.EXTEND.PENDING.DELETE TEDIT.RESET.EXTEND.PENDING.DELETE)
(\TEDIT.SELECTED.PIECES TEDIT.SELECTED.PIECES)
(\TEDIT.UPDATE.SCREEN TEDIT.UPDATE.SCREEN)
(\TEDIT.ALIGNEDPIECE \ALIGNEDPIECE)
(\TEDIT.BACKFORMAT \BACKFORMAT)
(\TEDIT.CHTOPC \CHTOPC)
(\TEDIT.COPYSEL \COPYSEL)
(\TEDIT.CREATE.TEDIT.RESTART.MENU \CREATE.TEDIT.RESTART.MENU)
(\TEDIT.DELETEPIECES \DELETEPIECES)
(\TEDIT.DELETETREE \DELETETREE)
(\TEDIT.DISPLAYLINE \DISPLAYLINE)
(\TEDIT.DISPLAYLINE.TABS \DISPLAYLINE.TABS)
(\TEDIT.FILLPANE \FILLPANE)
(\TEDIT.FIRSTPIECE \FIRSTPIECE)
(\TEDIT.FIXSEL \FIXSEL)
(\TEDIT.FORMATBLOCK \FORMATBLOCK)
(\TEDIT.FORMATLINE \FORMATLINE)
(\TEDIT.FORMATLINE.EMPTY \FORMATLINE.EMPTY)
(\TEDIT.FORMATLINE.JUSTIFY \FORMATLINE.JUSTIFY)
(\TEDIT.FORMATLINE.LASTLEGAL \FORMATLINE.LASTLEGAL)
(\TEDIT.FORMATLINE.PURGE.SPACES \FORMATLINE.PURGE.SPACES)
(\TEDIT.FORMATLINE.SCALETABS \FORMATLINE.SCALETABS)
(\TEDIT.FORMATLINE.SETUP \FORMATLINE.SETUP)
(\TEDIT.FORMATLINE.TABS \FORMATLINE.TABS)
(\TEDIT.FORMATLINE.UPDATELOOKS \FORMATLINE.UPDATELOOKS)
(\TEDIT.HARDCOPY.FORMATLINE.HEADINGS \HARDCOPY.FORMATLINE.HEADINGS)
(\TEDIT.INSERT TEDIT.\INSERT)
(\TEDIT.INSERTCH \INSERTCH)
(\TEDIT.INSERTCH.EXTEND \INSERTCH.EXTEND)
(\TEDIT.INSERTCH.HISTORY \INSERTCH.HISTORY)
(\TEDIT.INSERTCH.INSERTION \INSERTCH.INSERTION)
(\TEDIT.INSERTEOL \INSERTEOL)
(\TEDIT.INSERTPIECE \INSERTPIECE)
(\TEDIT.INSERTPIECES \INSERTPIECES)
(\TEDIT.INSERTTREE \INSERTTREE)
(\TEDIT.LASTPIECE \LASTPIECE)
(\TEDIT.LINKNEWPIECE \LINKNEWPIECE)
(\TEDIT.MAKE.VACANT.BTREESLOT \MAKE.VACANT.BTREESLOT)
(\TEDIT.MAKEPCTB \MAKEPCTB)
(\TEDIT.MATCHPCS \MATCHPCS)
(\TEDIT.NAMEDTAB.INIT \NAMEDTAB.INIT)
(\TEDIT.PCTOCH \PCTOCH)
(\TEDIT.PRIMARYPANE \TEDIT.PRIMARYW)
(\TEDIT.SELPIECES \SELPIECES)
(\TEDIT.SELPIECES.CHARTRANSFORM \SELPIECES.CHARTRANSFORM)
(\TEDIT.SELPIECES.CONCAT \SELPIECES.CONCAT)
(\TEDIT.SELPIECES.COPY \SELPIECES.COPY)
(\TEDIT.SELPIECES.FROM.STRING \SELPIECES.FROM.STRING)
(\TEDIT.SELPIECES.TO.STRING \SELPIECES.TO.STRING)
(\TEDIT.SHOWSEL \SHOWSEL)
(\TEDIT.SPLITPIECE \SPLITPIECE)
(\TEDIT.TEDIT.FORMATLINES \TEDIT.FORMATLINES)
(\TEDIT.POSTSCRIPT.HARDCOPY \TEDIT.HARDCOPY)
(\TEDIT.TEDIT.HARDCOPY \TEDIT.HARDCOPY)
(\TEDIT.TEXTBACKFILEPTR \TEXTBACKFILEPTR)
(\TEDIT.TEXTBIN \TEXTBIN)
(\TEDIT.TEXTBOUT \TEXTBOUT)
(\TEDIT.TEXTCLOSEF \TEXTCLOSEF)
(\TEDIT.TEXTDSPCHARWIDTH \TEXTDSPCHARWIDTH)
(\TEDIT.TEXTDSPFONT \TEXTDSPFONT)
(\TEDIT.TEXTDSPLINEFEED \TEXTDSPLINEFEED)
(\TEDIT.TEXTDSPSTRINGWIDTH \TEXTDSPSTRINGWIDTH)
(\TEDIT.TEXTDSPXPOSITION \TEXTDSPXPOSITION)
(\TEDIT.TEXTDSPYPOSITION \TEXTDSPYPOSITION)
(\TEDIT.TEXTEOFP \TEXTEOFP)
(\TEDIT.TEXTGETEOFPTR \TEXTGETEOFPTR)
(\TEDIT.TEXTGETFILEPTR \TEXTGETFILEPTR)
(\TEDIT.TEXTINIT \TEXTINIT)
(\TEDIT.TEXTLEFTMARGIN \TEXTLEFTMARGIN)
(\TEDIT.TEXTOPENF \TEXTOPENF)
(\TEDIT.TEXTPEEKBIN \TEXTPEEKBIN)
(\TEDIT.TEXTRIGHTMARGIN \TEXTRIGHTMARGIN)
(\TEDIT.TEXTSETEOF \TEXTSETEOF)
(\TEDIT.TEXTSETFILEPTR \TEXTSETFILEPTR)
(\TEDIT.TEXTBACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
(\TEDIT.TEXTSTREAM.BACKCCODEFN \TEXTSTREAM.BACKCCODEFN)
(\TEDIT.TEXTFORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
(\TEDIT.TEXTSTREAM.FORMATBYTESTREAM \TEXTSTREAM.FORMATBYTESTREAM)
(\TEDIT.TEXTINCCODEFN \TEXTSTREAM.INCCCODEFN)
(\TEDIT.TEXTSTREAM.INCCCODEFN \TEXTSTREAM.INCCCODEFN)
(\TEDIT.TEXTOUTCHARFN \TEXTSTREAM.OUTCHARFN)
(\TEDIT.TEXTSTREAM.OUTCHARFN \TEXTSTREAM.OUTCHARFN)
(\TEDIT.TEXTTTYBOUT \TEXTTTYBOUT)
(\TEDIT.UNLINKPIECE \UNLINKPIECE)
(\TEDIT.UPDATEPCNODES \UPDATEPCNODES)
(\TEDIT.XYTOSEL \TEDIT.SELECT.LINE.SCANNER)))
(RPAQQ FORWARDEDFILES
((PCTREE TEDIT-PCTREE)
(TEDIT TEDIT)
(TEDIT-FILE TEDIT-FILE)
(TEDIT-TEXTOFD TEDIT-STREAM)
(TEDITABBREV TEDIT-ABBREV)
(TEDITCHAT TEDIT-CHAT)
(TEDITCOMMAND TEDIT-COMMAND)
(TEDITDCL TEDITDCL)
(TEDITDEBUG TEDIT-DEBUG)
(TEDITFILE TEDIT-FILE TEDIT-OLDFILE)
(TEDITFIND TEDIT-FIND)
(TEDITFNKEYS TEDIT-FNKEYS)
(TEDITHCPY TEDIT-HCPY)
(TEDITHISTORY TEDIT-HISTORY)
(TEDITLOOKS TEDIT-LOOKS)
(TEDITMENU TEDIT-MENU)
(TEDITPAGE TEDIT-PAGE)
(TEDITSCREEN TEDIT-SCREEN)
(TEDITSELECTION TEDIT-SELECTION)
(TEDITWINDOW TEDIT-WINDOW)
(TFBRAVO TEDIT-TFBRAVO)))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

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

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

1145
library/tedit/TEDIT-STREAM
View File

File diff suppressed because it is too large Load Diff

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

Binary file not shown.

30
library/tedit/TEDIT-STRESS
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "19-Mar-2024 21:34:32" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;70 15296
(FILECREATED "21-Oct-2024 00:27:47" {WMEDLEY}<library>tedit>TEDIT-STRESS.;71 15583
:EDIT-BY rmk
:CHANGES-TO (FNS STRESSHC STRESSRAND STRESSPUT STRESSOPEN STRESSREAD STRESSPEEK)
(VARS TEDIT-STRESSCOMS)
:CHANGES-TO (FNS STRESSHC STRESSPUT EQTEXTSTREAM)
:PREVIOUS-DATE "17-Mar-2024 19:46:53" {WMEDLEY}<library>TEDIT>TEDIT-STRESS.;54)
:PREVIOUS-DATE "19-Mar-2024 21:34:32" {WMEDLEY}<library>tedit>TEDIT-STRESS.;70)
(PRETTYCOMPRINT TEDIT-STRESSCOMS)
@@ -25,6 +24,7 @@
(STRESSHC
[LAMBDA (FILES NSYSOUTS REPS ERROR SEPARATEOUT PDF SYSOUTNAME SINGLESTEP)
(* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 19-Mar-2024 21:33 by rmk")
(* ; "Edited 14-Mar-2024 15:15 by rmk")
(* ; "Edited 13-Mar-2024 00:23 by rmk")
@@ -83,7 +83,7 @@
T))
(CLOSEF? TSTRM)
(CL:WHEN SINGLESTEP
(HELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
(\TEDIT.THELP (CONCAT "Just hardcopied " F " to " HCFILE)))]
(PRINTOUT T " Hardcopied " N " files without failure" T)
finally (RETURN (LIST R N])
@@ -121,7 +121,8 @@
T)) finally (RETURN (LIST R N])
(STRESSPUT
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 19-Mar-2024 21:34 by rmk")
[LAMBDA (FILES REPS NOERROR CHECKEQUIV STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 19-Mar-2024 21:34 by rmk")
(* ; "Edited 12-Mar-2024 09:48 by rmk")
(* ;; "Opens, puts, reopens and tests for equivalence")
@@ -142,13 +143,13 @@
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
(HELP "Get of put not equivalent" F))
(\TEDIT.THELP "Get of put not equivalent" F))
(CLOSEF TSP))
else (SETQ TSTRM (OPENTEXTSTREAM F))
(TEDIT.PUT TSTRM "{CORE}FOO.TEDIT;1")
(SETQ TSP (OPENTEXTSTREAM "{CORE}FOO.TEDIT;1"))
(CL:WHEN (AND CHECKEQUIV (NOT (EQTEXTSTREAM TSTRM TSP STOP)))
(HELP "Get of put not equivalent" F))
(\TEDIT.THELP "Get of put not equivalent" F))
(CLOSEF TSP))
then (CLOSEF TSTRM)
(add N 1)
@@ -242,7 +243,8 @@
(DEFINEQ
(EQTEXTSTREAM
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 11-Mar-2024 16:53 by rmk")
[LAMBDA (TS1 TS2 STOP) (* ; "Edited 21-Oct-2024 00:26 by rmk")
(* ; "Edited 11-Mar-2024 16:53 by rmk")
(AND (IEQP (TEDIT.NCHARS TS1)
(TEDIT.NCHARS TS2))
(OR (for I C1 C2 from 1 to (TEDIT.NCHARS TS1) eachtime (SETQ C1 (TEDIT.NTHCHARCODE TS1 I))
@@ -255,8 +257,8 @@
(AND (IMAGEOBJP C1)
(IMAGEOBJP C2)
(EQUALALL C1 C2))) do (CL:WHEN STOP
(HELP "Different characters: "
(LIST I C1 C2)))
(\TEDIT.THELP "Different characters: "
(LIST I C1 C2)))
(RETURN NIL) finally (RETURN T])
(SYSOUTRING
@@ -293,7 +295,7 @@
finally (CL:UNLESS NORECLAIM (RECLAIM])
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (795 12697 (STRESSHC 805 . 4271) (STRESSRAND 4273 . 6009) (STRESSPUT 6011 . 7854) (
STRESSOPEN 7856 . 9289) (STRESSREAD 9291 . 10826) (STRESSGREP 10828 . 11771) (STRESSPEEK 11773 . 12695
)) (12698 15273 (EQTEXTSTREAM 12708 . 13759) (SYSOUTRING 13761 . 14641) (COPYTOCORE 14643 . 15271)))))
(FILEMAP (NIL (722 12866 (STRESSHC 732 . 4315) (STRESSRAND 4317 . 6053) (STRESSPUT 6055 . 8023) (
STRESSOPEN 8025 . 9458) (STRESSREAD 9460 . 10995) (STRESSGREP 10997 . 11940) (STRESSPEEK 11942 . 12864
)) (12867 15560 (EQTEXTSTREAM 12877 . 14046) (SYSOUTRING 14048 . 14928) (COPYTOCORE 14930 . 15558)))))
STOP

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

Binary file not shown.

223
library/tedit/TEDIT-TFBRAVO
View File

@@ -1,15 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Mar-2024 18:27:18" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;153 91304
(FILECREATED "19-Dec-2024 23:43:59" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;163 92210
:EDIT-BY rmk
:CHANGES-TO (VARS TEDIT-TFBRAVOCOMS)
(FNS \TEDIT.NAMEDTAB.INIT)
:CHANGES-TO (FNS \TFBRAVO.READ.PARALOOKS)
:PREVIOUS-DATE "17-Mar-2024 12:41:56"
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>TEDIT-TFBRAVO.;152)
:PREVIOUS-DATE "21-Oct-2024 00:33:50" {WMEDLEY}<library>TEDIT>TEDIT-TFBRAVO.;162)
(PRETTYCOMPRINT TEDIT-TFBRAVOCOMS)
@@ -124,7 +121,7 @@
(WIDTH (IPLUS (CONSTANT (FIX (FTIMES 8.5 72)))
NUM))
(NIL NUM)
(HELP "UNKNOWN DIMENSION" DIMENSION))))
(\TEDIT.THELP "UNKNOWN DIMENSION" DIMENSION))))
NUM)))
)
@@ -303,7 +300,8 @@
(SETTOBJ TEXTOBJ FMTSPEC USER.CM.FMTSPEC])
(\TFBRAVO.READ.USER.CM
[LAMBDA (USER.CM) (* ; "Edited 18-Aug-2023 22:26 by rmk")
[LAMBDA (USER.CM) (* ; "Edited 27-Aug-2024 18:12 by rmk")
(* ; "Edited 18-Aug-2023 22:26 by rmk")
(* ; "Edited 10-Aug-2023 13:02 by rmk")
(* ; "Edited 7-Aug-2023 12:52 by rmk")
(* ; "Edited 1-Aug-2023 22:11 by rmk")
@@ -330,7 +328,9 @@
LLP (CL:UNLESS (NLSETQ (SETQ LINE (RATOMS (CONSTANT (CHARACTER (CHARCODE EOL)))
USER.CM USER.CM.RDTBL)))
(RETURN ALIST)) (* ;
(CL:UNLESS (ASSOC 'DefaultTab ALIST)
(push ALIST (CONS 'DefaulTab DEFAULTTAB)))
(RETURN ALIST)) (* ;
 "If the '[BRAVO]' section is the last one")
(COND
((NULL LINE) (* ; "ignore blank lines")
@@ -378,7 +378,9 @@
(GO LLP)))])
(\TFBRAVO.INIT.PARALOOKS
[LAMBDA (ALIST) (* ; "Edited 13-Aug-2023 11:27 by rmk")
[LAMBDA (ALIST) (* ; "Edited 4-Aug-2024 22:17 by rmk")
(* ; "Edited 28-Jul-2024 21:36 by rmk")
(* ; "Edited 13-Aug-2023 11:27 by rmk")
(* ; "Edited 8-Aug-2023 23:51 by rmk")
(* ; "Edited 7-Aug-2023 14:59 by rmk")
(* ; "Edited 31-May-91 15:26 by jds")
@@ -400,8 +402,8 @@
(SETQ LEADBEFORE (OR (CADR (ASSOC 'ParagraphLeading ALIST))
0))
(SETQ LEADAFTER 0)
(SETQ TABSPEC (LIST (OR (CADR (ASSOC 'DefaultTab ALIST))
36)))
(SETQ FMTDEFAULTTAB (OR (CADR (ASSOC 'DefaultTab ALIST))
DEFAULTTAB))
(SETQ FMTSPECIALX 0)
(SETQ FMTSPECIALY 0))
INITFMTSPEC])
@@ -491,7 +493,8 @@
(DEFINEQ
(\TFBRAVO.PARSE.PARA
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 14-Nov-2023 13:03 by rmk")
[LAMBDA (OLDFMTSPEC BSTREAM TEXTOBJ) (* ; "Edited 21-Oct-2024 00:33 by rmk")
(* ; "Edited 14-Nov-2023 13:03 by rmk")
(* ; "Edited 7-Nov-2023 21:53 by rmk")
(* ; "Edited 21-Aug-2023 23:41 by rmk")
(* ; "Edited 20-Aug-2023 22:48 by rmk")
@@ -540,14 +543,18 @@
(^Z (SETQ FMTSPEC (\TFBRAVO.READ.PARALOOKS OLDFMTSPEC BSTREAM TEXTOBJ))
(SETQ RUNS (\TFBRAVO.CREATE.RUNS BSTREAM PSTART PLEN)))
(NIL)
(SHOULDNT "Bravo paragraph not ending in ^Z, CR, EOF"))
(\TEDIT.THELP "Bravo paragraph not ending in ^Z, CR, EOF"))
(create PARA
PARAFMTSPEC _ FMTSPEC
RUNS _ RUNS
FORMATPTRS _ FORMATPTRS])
(\TFBRAVO.READ.PARALOOKS
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 9-Sep-2023 21:40 by rmk")
[LAMBDA (OLDFMTSPEC BSTREAM) (* ; "Edited 19-Dec-2024 23:42 by rmk")
(* ; "Edited 21-Oct-2024 00:27 by rmk")
(* ; "Edited 27-Aug-2024 21:59 by rmk")
(* ; "Edited 28-Jul-2024 21:39 by rmk")
(* ; "Edited 9-Sep-2023 21:40 by rmk")
(* ; "Edited 21-Aug-2023 21:43 by rmk")
(* ; "Edited 20-Aug-2023 15:48 by rmk")
(* ; "Edited 18-Aug-2023 23:08 by rmk")
@@ -560,55 +567,55 @@
(* ;;
 "Decodes bravo paragraph looks into a TEDIT FMTSPEC. OLDFMTSPEC is used just for its tabs.")
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME TABDEFAULT NAMEDTABS (NEWFMTSPEC _
(create FMTSPEC
using USER.CM.FMTSPEC))
first (CL:UNLESS (EQ 'PROFILE (fetch (FMTSPEC FMTPARATYPE) of OLDFMTSPEC))
(\DTEST OLDFMTSPEC 'FMTSPEC)
(bind LMFLAG 1LMFLAG COMMAND TABX TABNAME NAMEDTABS (TABDEFAULT _ (GETPARA USER.CM.FMTSPEC
FMTDEFAULTTAB))
(NEWFMTSPEC _ (create FMTSPEC using USER.CM.FMTSPEC))
first (CL:UNLESS (EQ 'PROFILE (FGETPARA OLDFMTSPEC FMTPARATYPE))
(* ;; "It appears that heading-tabs don't carry over to other paragraphs. Although maybe the default interval-tab does?")
(SETQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of OLDFMTSPEC)))
(SETQ TABDEFAULT (OR (FGETPARA OLDFMTSPEC FMTDEFAULTTAB)
(FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
(* ;; "We don't put the NAMEDTABS in the TABSPEC since we don't know which ones will be activated by any particular run. ")
(SETQ NAMEDTABS (COPY (fetch (FMTSPEC FMTUSERINFO) of OLDFMTSPEC))))
(SETQ NAMEDTABS (COPY (FGETPARA OLDFMTSPEC FMTUSERINFO))))
do (SELCHARQ (SETQ COMMAND (BIN BSTREAM))
(l (SETQ LMFLAG T)
(replace (FMTSPEC LEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
'MICATOHALFPICAPOINTS)))
(FSETPARA NEWFMTSPEC LEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
(d (SETQ 1LMFLAG T)
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
'MICATOHALFPICAPOINTS)))
(z (replace (FMTSPEC RIGHTMAR) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T
'MICATOHALFPICAPOINTS)))
(x (replace (FMTSPEC LINELEAD) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
(e (replace (FMTSPEC LEADAFTER) of NEWFMTSPEC with 0)
(replace (FMTSPEC LEADBEFORE) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
(FSETPARA NEWFMTSPEC 1STLEFTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)
))
(z (FSETPARA NEWFMTSPEC RIGHTMAR (\TFBRAVO.READNUM? BSTREAM T 'MICATOHALFPICAPOINTS)))
(x (FSETPARA NEWFMTSPEC LINELEAD (\TFBRAVO.READNUM? BSTREAM T)))
(e (FSETPARA NEWFMTSPEC LEADAFTER 0)
(FSETPARA NEWFMTSPEC LEADBEFORE (\TFBRAVO.READNUM? BSTREAM T)))
(y (* ; "vertical tabs are supported")
(replace (FMTSPEC FMTSPECIALX) of NEWFMTSPEC with 0)
(replace (FMTSPEC FMTSPECIALY) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
(k (replace (FMTSPEC FMTHEADINGKEEP) of NEWFMTSPEC with (\TFBRAVO.READNUM? BSTREAM T)))
(FSETPARA NEWFMTSPEC FMTSPECIALX 0)
(FSETPARA NEWFMTSPEC FMTSPECIALY (\TFBRAVO.READNUM? BSTREAM T)))
(k (FSETPARA NEWFMTSPEC FMTHEADINGKEEP (\TFBRAVO.READNUM? BSTREAM T)))
(w 'HardcopyMode)
(j (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'JUSTIFIED))
(c (replace (FMTSPEC QUAD) of NEWFMTSPEC with 'CENTERED))
(j (FSETPARA NEWFMTSPEC QUAD 'JUSTIFIED))
(c (FSETPARA NEWFMTSPEC QUAD 'CENTERED))
(q
(* ;; "Profiles are marked here but then interpreted at the top")
(replace (FMTSPEC FMTPARATYPE) of NEWFMTSPEC with 'PROFILE))
(FSETPARA NEWFMTSPEC FMTPARATYPE 'PROFILE))
(%( (* ; "Collect the named tabs")
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T)) (* ; "Name or X position")
(* ;; "Tabs apparently round down/truncate, not up.")
(SELCHARQ (SETQ COMMAND (BIN BSTREAM))
(%) (SETQ TABDEFAULT (FIXR (FQUOTIENT TABX MICASPERPT))))
(%) (SETQ TABDEFAULT (HCUNSCALE MICASPERPT TABX)))
(%, (CL:WHEN (IGREATERP TABX 14)
(HELP TABX " is not a legal tab-name"))
(\TEDIT.THELP TABX " is not a legal tab-name"))
(SETQ TABNAME (ADD1 TABX)) (* ; "Adding 1 to align with t1, t2...")
(SETQ TABX (\TFBRAVO.READNUM? BSTREAM T))
(CL:UNLESS (EQ (CHARCODE %))
(BIN BSTREAM))
(HELP "MISSING CLOSING ) IN TABSPEC"))
(\TEDIT.THELP "MISSING CLOSING ) IN TABSPEC"))
(* ;; "Here we collect the tabs declared in this paragraph or inherited from before. 65535 means delete that the named tab (possibly inherited), otherwise the name is given a new TABX for all runs of this paragraph and beyond.")
@@ -618,23 +625,22 @@
else (RPLACD [OR (ASSOC TABNAME NAMEDTABS)
(CAR (push NAMEDTABS (CONS TABNAME]
(create TAB
TABX _ (FIXR (FQUOTIENT TABX MICASPERPT))
TABX _ (HCUNSCALE MICASPERPT TABX)
TABKIND _ 'LEFT])
(HELP "ILLFORMED BRAVO TAB SPEC")))
(\TEDIT.THELP "ILLFORMED BRAVO TAB SPEC")))
(SPACE)
((CR \)
(CL:WHEN (AND LMFLAG (NOT 1LMFLAG)) (* ;
 "If there was a Left margin but no firstline left then default it")
(replace (FMTSPEC 1STLEFTMAR) of NEWFMTSPEC with (fetch (FMTSPEC LEFTMAR)
of NEWFMTSPEC)))
(replace TABSPEC of NEWFMTSPEC with (CONS TABDEFAULT))
(replace (FMTSPEC FMTUSERINFO) of NEWFMTSPEC with (DREVERSE NAMEDTABS))
(FSETPARA NEWFMTSPEC 1STLEFTMAR (FGETPARA NEWFMTSPEC LEFTMAR)))
(FSETPARA NEWFMTSPEC FMTDEFAULTTAB TABDEFAULT)
(FSETPARA NEWFMTSPEC FMTUSERINFO (DREVERSE NAMEDTABS))
(CL:WHEN (EQ COMMAND (CHARCODE CR)) (* ;
 "Read the \ separator, but leave the terminating CR")
(\BACKFILEPTR BSTREAM))
(RETURN NEWFMTSPEC))
(HELP (CHARACTER COMMAND)
'" is not a legal Bravo paragraph-format character"])
(\TEDIT.THELP (CHARACTER COMMAND)
'" is not a legal Bravo paragraph-format character"])
(\TFBRAVO.CREATE.RUNS
[LAMBDA (BSTREAM PSTART PLEN) (* ; "Edited 14-Nov-2023 13:01 by rmk")
@@ -654,7 +660,8 @@
(SETQ OLDCHARLOOKS (fetch (RUN RUNLOOKS) of RUN])
(\TFBRAVO.READ.CHARLOOKS
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 9-Sep-2023 21:39 by rmk")
[LAMBDA (BSTREAM OLDCHARLOOKS RUNSTART PLEN) (* ; "Edited 21-Oct-2024 00:27 by rmk")
(* ; "Edited 9-Sep-2023 21:39 by rmk")
(* ; "Edited 20-Aug-2023 16:15 by rmk")
(* ; "Edited 18-Aug-2023 20:11 by rmk")
(* ; "Edited 31-May-91 15:25 by jds")
@@ -709,8 +716,8 @@
(SETQ LEN PLEN)) (* ;
 "Otherwise, PLEN is what's left for the final substantive run")
(GO $$OUT))
(HELP (CHARACTER COMMAND)
" is not a legal Bravo command character look"))
(\TEDIT.THELP (CHARACTER COMMAND)
" is not a legal Bravo command character look"))
finally
(* ;; "Wait til end to do font, so we have the bold/italic looks for sure. Last run may not have an explicit length")
@@ -1087,7 +1094,9 @@
NEWPARAS])
(\TFBRAVO.RUN.TABSPEC
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 15-Mar-2024 19:42 by rmk")
[LAMBDA (RUN PARAFMTSPEC) (* ; "Edited 27-Aug-2024 22:02 by rmk")
(* ; "Edited 28-Jul-2024 21:30 by rmk")
(* ; "Edited 15-Mar-2024 19:42 by rmk")
(* ; "Edited 22-Aug-2023 16:54 by rmk")
(* ; "Edited 19-Aug-2023 15:47 by rmk")
@@ -1105,41 +1114,43 @@
(* ;; "NOTE: the names in the tab definitions have been bumped up by 1 to match the names in the tab looks (e.g. (0,xxx) is (1,xxx) to correspond to t1. t0 doesn't match.")
(LET ([LASTTAB (CAR (LAST (CDR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
(DECLARE (USEDFREE USER.CM.FMTSPEC))
(LET ([LASTTAB (CAR (LAST (FGETPARA PARAFMTSPEC FMTTABS]
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
(TABDEFAULT (OR (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)
(FGETPARA USER.CM.FMTSPEC FMTDEFAULTTAB)))
(RUNTABS (fetch (RUN RUNTABS) of RUN))
TAB TABSPEC)
TAB TABS)
(CL:WHEN (AND TABDEFS (NULL RUNTABS))
(SETQ RUNTABS (CONS (CAAR TABDEFS))))
(CL:WHEN (AND TABDEFS RUNTABS)
(CL:WHEN (EQUAL RUNTABS '(0)) (* ;
 "If e.g. Tab 0 is set but the run has no tn's, assume that the first tn is intended.")
(SETQ RUNTABS '(1 2)))
[SETQ TABSPEC (for TABNAME in RUNTABS
collect
[SETQ TABS (for TABNAME in RUNTABS
collect
(* ;;
(* ;;
 "For t0 we try to find the tab after the one last used in the previous run.")
(if (CDR (ASSOC TABNAME TABDEFS))
elseif [AND (EQ TABNAME 0)
(for TDTAIL TD on TABDEFS
eachtime (SETQ TD (CAR TDTAIL))
when (EQ LASTTAB (CDR TD))
do [SETQ TABDEFAULT (fetch TABX
of (CDR (CADR TDTAIL]
(RETURN (CDR (CADR TDTAIL]
else (GO $$ITERATE]
(if (CDR (ASSOC TABNAME TABDEFS))
elseif [AND (EQ TABNAME 0)
(for TDTAIL TD on TABDEFS eachtime (SETQ TD
(CAR TDTAIL))
when (EQ LASTTAB (CDR TD))
do [SETQ TABDEFAULT (fetch TABX
of (CDR (CADR TDTAIL]
(RETURN (CDR (CADR TDTAIL]
else (GO $$ITERATE]
(* ;; "This asserts that the tabdefs are constant across a paragraph, that the right number of tabs are on each line in a paragraph. That assumption is mostly reasonable, given the paragraph splitting. The code above allows each run (piece) to have its own tab settings. Although \TEDIT.FORMATLINE.UPDATELOOKS can easily be modified to allow the pieces on a line to change their tab definitions, the paragraph-looks menu assumes that tabs are constant across a paragraph. So things would go bonkers.")
[SETQ TABSPEC (SORT (for TAB in TABDEFS collect (CDR TAB))
(FUNCTION (LAMBDA (T1 T2)
(ILEQ (fetch (TAB TABX) of T1)
(fetch (TAB TABX) of T2]
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT TABSPEC))
))
[SETQ TABS (SORT (for TAB in TABDEFS collect (CDR TAB))
(FUNCTION (LAMBDA (T1 T2)
(ILEQ (fetch (TAB TABX) of T1)
(fetch (TAB TABX) of T2]
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT FMTTABS _
TABS)))
PARAFMTSPEC])
(\TFBRAVO.INSTALL.PAGEFORMAT
@@ -1220,10 +1231,12 @@
(DEFINEQ
(\TFBRAVO.ASSERT
[LAMBDA (X Y) (* ; "Edited 9-Aug-2023 10:32 by rmk")
[LAMBDA (X Y) (* ; "Edited 21-Oct-2024 00:27 by rmk")
(* ; "Edited 9-Aug-2023 10:32 by rmk")
(* gbn "19-Sep-84 21:39")
(CL:UNLESS (EQ X Y)
(HELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y " was found.")))])
(\TEDIT.THELP "While parsing profile paragraph, " (CONCAT X " was expected, but " Y
" was found.")))])
(\TEST.CHARACTER.LOOKS
[LAMBDA (BSTREAM) (* ; "Edited 17-Aug-2023 09:18 by rmk")
@@ -1332,7 +1345,9 @@
(DEFINEQ
(\TFBRAVO.ADD.NAMEDTAB
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 9-Sep-2023 21:44 by rmk")
[LAMBDA (RUN PARAFMTSPEC TEXTOBJ) (* ; "Edited 4-Aug-2024 18:05 by rmk")
(* ; "Edited 28-Jul-2024 21:29 by rmk")
(* ; "Edited 9-Sep-2023 21:44 by rmk")
(* ; "Edited 18-Aug-2023 18:42 by rmk")
(* ; "Edited 15-Aug-2023 00:26 by rmk")
(* ; "Edited 13-Aug-2023 19:56 by rmk")
@@ -1344,38 +1359,38 @@
(* ;; "Bravo's named tabs are defined for a paragraph that might consist of several runs, and each run can pick out by name just just the tabs that it wants. For Tedit the tabs are associated with the pieces that make up a paragraph, so we have to make sure that Bravo runs are mapped to separate TEDIT pieces, and arrange it so that the pieces that correspond to separate runs have different different FMTSPECs. ")
(* ;; "")
(* ; "")
(* ;; "THIS IS NOT USED, TO BE REMOVED. RUNTABOFFSETS DOESN'T EXIST")
(NOTUSED)
(LET ((RUNLOOKS (fetch (RUN RUNLOOKS) of RUN))
(TABDEFS (fetch (FMTSPEC FMTUSERINFO) of PARAFMTSPEC))
(TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC)))
(TABDEFS (FGETPARA PARAFMTSPEC FMTUSERINFO))
(TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB))
(TABOFFSETS '(fetch (RUN RUNTABOFFSETS) of RUN))
TAB TABNAMES TABSPEC)
TAB TABNAMES TABS)
(SETQ TABNAMES (fetch (CHARLOOKS CLUSERINFO) of RUNLOOKS))
(CL:WHEN TABDEFS
[if TABNAMES
then (SETQ TABSPEC (for TN in TABNAMES eachtime (add TN -1)
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
unless (EQ TAB T) until (EQ TN -1) collect TAB))
then (SETQ TABS (for TN in TABNAMES eachtime (add TN -1)
when (SETQ TAB (CDR (ASSOC TN TABDEFS)))
unless (EQ TAB T) until (EQ TN -1) collect TAB))
elseif (CDR TABDEFS)
then
(* ;; "If the run has no names, then assume that its first TAB aligns at the earliest defined tab, next aligns at the second, etc. Sort tabs by increasing TABX, not names. ")
[SETQ TABSPEC (SORT (for TD in TABDEFS collect (CDR TD))
(FUNCTION (LAMBDA (T1 T2)
(ILEQ (fetch (TAB TABX) of T1)
(fetch (TAB TABX) of T2]
[SETQ TABS (SORT (for TD in TABDEFS collect (CDR TD))
(FUNCTION (LAMBDA (T1 T2)
(ILEQ (fetch (TAB TABX) of T1)
(fetch (TAB TABX) of T2]
elseif (EQ 0 (CAR (CAR TABDEFS)))
then
(* ;;
 "No name and 0, make it be the default. How else would we decide where the second tab goes?")
(SETQ TABDEFAULT (fetch (TAB TABX) of (CDAR TABDEFS]
(CL:WHEN [OR TABSPEC (NEQ TABDEFAULT (CAR (fetch (FMTSPEC TABSPEC) of PARAFMTSPEC]
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC TABSPEC _ (CONS TABDEFAULT
TABSPEC)))
(CL:WHEN (OR TABS (NEQ TABDEFAULT (FGETPARA PARAFMTSPEC FMTDEFAULTTAB)))
(SETQ PARAFMTSPEC (create FMTSPEC using PARAFMTSPEC FMTDEFAULTTAB _ TABDEFAULT
FMTTABS _ TABS))
(\TEDIT.UNIQUIFY.PARALOOKS PARAFMTSPEC TEXTOBJ)))
PARAFMTSPEC])
@@ -1450,18 +1465,18 @@
(AND NIL (\TEDIT.NAMEDTAB.INIT))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (6795 13177 (TEDIT.BRAVOFILE? 6805 . 8535) (TEDITFROMBRAVO 8537 . 13175)) (13288 28274 (
\TFBRAVO.GET.USER.CM 13298 . 16108) (\TFBRAVO.USER.CM.LOOKS 16110 . 17285) (\TFBRAVO.READ.USER.CM
17287 . 21624) (\TFBRAVO.INIT.PARALOOKS 21626 . 23387) (\TFBRAVO.INIT.PAGEFORMAT 23389 . 24269) (
\TFBRAVO.GETPARAMS 24271 . 27125) (\TFBRAVO.FIND.LAST.TRAILER 27127 . 28272)) (28316 48329 (
\TFBRAVO.PARSE.PARA 28326 . 32013) (\TFBRAVO.READ.PARALOOKS 32015 . 38649) (\TFBRAVO.CREATE.RUNS 38651
. 40039) (\TFBRAVO.READ.CHARLOOKS 40041 . 45059) (\TFBRAVO.FONT.FROM.CHARLOOKS 45061 . 46430) (
\TFBRAVO.READNUM? 46432 . 48327)) (48366 59117 (\TFBRAVO.HANDLE.HEADING 48376 . 51008) (
\TFBRAVO.PARSE.PROFILE.PARA 51010 . 59115)) (59160 80307 (\TFBRAVO.INSERT.PARA 59170 . 59823) (
\TFBRAVO.INSERT.RUN 59825 . 63022) (\TFBRAVO.SPLIT.PARA 63024 . 70266) (\TFBRAVO.RUN.TABSPEC 70268 .
74612) (\TFBRAVO.INSTALL.PAGEFORMAT 74614 . 80305)) (80308 84268 (\TFBRAVO.ASSERT 80318 . 80665) (
\TEST.CHARACTER.LOOKS 80667 . 82553) (\TEST.PARAGRAPH.LOOKS 82555 . 84266)) (84753 91138 (
\TFBRAVO.ADD.NAMEDTAB 84763 . 88096) (\TFBRAVO.COPY.NAMEDTAB 88098 . 88546) (\TFBRAVO.PUT.NAMEDTAB
88548 . 88828) (\TFBRAVO.GET.NAMEDTAB 88830 . 89207) (\NAMEDTABNYET 89209 . 89369) (\NAMEDTABSIZE
89371 . 89886) (\NAMEDTABPREPRINT 89888 . 90086) (\TEDIT.NAMEDTAB.INIT 90088 . 91136)))))
(FILEMAP (NIL (6681 13063 (TEDIT.BRAVOFILE? 6691 . 8421) (TEDITFROMBRAVO 8423 . 13061)) (13174 28618 (
\TFBRAVO.GET.USER.CM 13184 . 15994) (\TFBRAVO.USER.CM.LOOKS 15996 . 17171) (\TFBRAVO.READ.USER.CM
17173 . 21743) (\TFBRAVO.INIT.PARALOOKS 21745 . 23731) (\TFBRAVO.INIT.PAGEFORMAT 23733 . 24613) (
\TFBRAVO.GETPARAMS 24615 . 27469) (\TFBRAVO.FIND.LAST.TRAILER 27471 . 28616)) (28660 48692 (
\TFBRAVO.PARSE.PARA 28670 . 32470) (\TFBRAVO.READ.PARALOOKS 32472 . 38894) (\TFBRAVO.CREATE.RUNS 38896
. 40284) (\TFBRAVO.READ.CHARLOOKS 40286 . 45422) (\TFBRAVO.FONT.FROM.CHARLOOKS 45424 . 46793) (
\TFBRAVO.READNUM? 46795 . 48690)) (48729 59480 (\TFBRAVO.HANDLE.HEADING 48739 . 51371) (
\TFBRAVO.PARSE.PROFILE.PARA 51373 . 59478)) (59523 80972 (\TFBRAVO.INSERT.PARA 59533 . 60186) (
\TFBRAVO.INSERT.RUN 60188 . 63385) (\TFBRAVO.SPLIT.PARA 63387 . 70629) (\TFBRAVO.RUN.TABSPEC 70631 .
75277) (\TFBRAVO.INSTALL.PAGEFORMAT 75279 . 80970)) (80973 85116 (\TFBRAVO.ASSERT 80983 . 81513) (
\TEST.CHARACTER.LOOKS 81515 . 83401) (\TEST.PARAGRAPH.LOOKS 83403 . 85114)) (85601 92044 (
\TFBRAVO.ADD.NAMEDTAB 85611 . 89002) (\TFBRAVO.COPY.NAMEDTAB 89004 . 89452) (\TFBRAVO.PUT.NAMEDTAB
89454 . 89734) (\TFBRAVO.GET.NAMEDTAB 89736 . 90113) (\NAMEDTABNYET 90115 . 90275) (\NAMEDTABSIZE
90277 . 90792) (\NAMEDTABPREPRINT 90794 . 90992) (\TEDIT.NAMEDTAB.INIT 90994 . 92042)))))
STOP

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

Binary file not shown.

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

397
library/tedit/tedit-exports.all
View File

@@ -1,23 +1,24 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "20-Mar-2024 11:16:36" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;120 47172
(FILECREATED "14-Dec-2024 11:45:45" 
{DSK}<Users>kaplan>Local>medley3.5>working-medley>library>tedit>tedit-exports.all;196 52876
:EDIT-BY rmk
:PREVIOUS-DATE "20-Mar-2024 09:45:21" {WMEDLEY}<library>TEDIT>tedit-exports.all;118)
:PREVIOUS-DATE " 8-Dec-2024 19:52:13" {WMEDLEY}<library>TEDIT>tedit-exports.all;195)
(PRETTYCOMPRINT ((E (MAPC (MKLIST FROMFILES) (FUNCTION (LAMBDA (F) (MAPC (IMPORTFILE F FLG) (FUNCTION
PRINT))))))))
(FILESLOAD (FROM LOADUPS) EXPORTS.ALL)
(PUTPROPS TEDIT-ASSERT MACRO (ARGS (COND (CHECK-TEDIT-ASSERTIONS (BQUOTE (CL:UNLESS (\, (CAR ARGS)) (
HELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS))))))))
\TEDIT.THELP "TEDIT-ASSERT FAILURE" (\, (KWOTE (CAR ARGS))))))) (T (BQUOTE (* (TEDIT-ASSERT (\,@ ARGS)
)))))))
(GLOBALVARS CHECK-TEDIT-ASSERTIONS)
(RPAQ? CHECK-TEDIT-ASSERTIONS T)
(PUTPROPS OBJECT.ALLOWS MACRO ((PC OPERATION FROMTOBJ TOTOBJ) (OR (NOT (EQ OBJECT.PTYPE (PTYPE PC))) (
\TEDIT.APPLY.OBJFN (PCONTENTS PC) OPERATION FROMTOBJ TOTOBJ))))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:26"))
(PUTPROP (QUOTE TEDIT) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 21:39:48"))
(RPAQQ \BTREEWORDSPERSLOT 4)
(RPAQQ \BTREEMAXCOUNT 8)
(CONSTANTS (\BTREEWORDSPERSLOT 4) (\BTREEMAXCOUNT 8))
@@ -52,23 +53,24 @@ DLEN1 DOWN2 DLEN2 DOWN3 DLEN3 DOWN4 DLEN4 DOWN5 DLEN5 DOWN6 DLEN6 DOWN7 DLEN7 DO
(\DTEST (OR (NEXTPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
(I.S.OPR (QUOTE backpieces) NIL (QUOTE (first (SETQ I.V. (\DTEST (OR BODY (GO $$OUT)) (QUOTE PIECE)))
by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:07"))
(PUTPROP (QUOTE TEDIT-PCTREE) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:12:27"))
(DATATYPE SELECTION ((* ;;
"Description of a piece of selected text for TEdit. Text has to be selected before it can be operated on by the user. The caret is to the left of CH# if POINT is LEFT, to the keft of CHLIM if POINT is RIGHT."
) (* ;; "If DCH > 0, highlighting goes from CH# to (SUB1 CHLIM = (SUB1 (IPLUS CH# DCH)).") (* ;;
"If DCH=0, this is a caret-only selection, with no highlighting. In that case CHLIM=(ADD1 CH#) and POINT essentially indicates whether the caret blinks before or after CH#."
) NIL (* ; "Was Y0: Y value of topmost line of selection") X0 (* ;
"X value of left edge of selection on the first line") NIL (* ;
"Was DX: Width of the selection, if it's on one line.") CH# (* ; "CH# of the first selected character"
) XLIM (* ; "X value of right edge of last selected character on the last line") CHLIM (* ;
"X value of left edge of selection on the first line") SELLINES (* ;
"A list of (L1 L2) pairs one for each pane, to replace the separate L1 L2 lists. Was DX: Width of the selection, if it's on one line."
) CH# (* ; "CH# of the first selected character") XLIM (* ;
"X value of right edge of last selected character on the last line") CHLIM (* ;
"Last character is at (SUB1 CHLIM)") DCH (* ;
"# of characters selected (can be zero, for empty/point selection.) This controls highlighting") L1 (*
; "-> line descriptor for the line where the first selected character is") LN (* ;
"-> line descriptor for the line which contains the end of the selection") NIL (* ;
"Was YLIM: Y value of the bottom of the line that ends the selection") POINT (* ;
"Which end should the caret appear at? (LEFT or RIGHT)") (SET FLAG) (* ;
"T if this selection is real; NIL if not") (SELTEXTOBJ FULLXPOINTER) (* ;
"TEXTOBJ that describes the selected text") SELKIND (* ;
"T if this selection is real; NIL if not") (SELTEXTSTREAM FULLXPOINTER) (* ;
"TEXTSTREAM that describes the selected text") SELKIND (* ;
"What kind of selection? CHAR or WORD or LINE or PARA") HOW (* ;
"SHADE used to highlight this selection") HOWHEIGHT (* ;
"Height of the highlight (1 usually, full line for delete selection...)") (HASCARET FLAG) (* ;
@@ -76,44 +78,50 @@ by (\DTEST (OR (PREVPIECE I.V.) (GO $$OUT)) (QUOTE PIECE)))))
"If this selection is inside an object, which object?") (ONFLG FLAG) (* ;
"T if the selection is highlighted on the screen, else NIL") SELOBJINFO (* ;
"A Place for the selected object to put info about selection inside itself.")) (INIT (DEFPRINT (QUOTE
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS (DX (AND (FIXP (fetch (SELECTION X0) of
DATUM)) (FIXP (fetch (SELECTION XLIM) of DATUM)) (IDIFFERENCE (fetch (SELECTION XLIM) of DATUM) (fetch
(SELECTION X0) of DATUM))))) SET _ NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (
QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST NIL))
SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))) (ACCESSFNS ((SELTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ)
of (GETSEL DATUM SELTEXTSTREAM))) (CHLAST (STANDARD (SUB1 (GETSEL DATUM CHLIM)) (SETSEL DATUM CHLIM (
ADD1 NEWVALUE))) (FAST (SUB1 (FSETSEL DATUM CHLIM)) (FSETSEL DATUM CHLIM (ADD1 NEWVALUE)))))) SET _
NIL HOW _ BLACKSHADE HOWHEIGHT _ 1 HASCARET _ T X0 _ 0 POINT _ (QUOTE LEFT) L1 _ (LIST NIL) LN _ (LIST
NIL))
(DATATYPE SELPIECES (SPFIRST SPLAST SPLEN SPFIRSTCHAR SPLASTCHAR))
(DEFPRINT (QUOTE SELECTION) (FUNCTION \TEDIT.SELECTION.DEFPRINT))
(RPAQQ COPYSELSHADE 30583)
(RPAQQ COPYLOOKSSELSHADE 30583)
(RPAQQ EDITMOVESHADE -1)
(RPAQ EDITMOVESHADE BLACKSHADE)
(RPAQQ EDITGRAY 32800)
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE -1) (EDITGRAY 32800))
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (fetch (LINEDESCRIPTOR LCHAR1) of
LINE)) (ILEQ CHNO (fetch (LINEDESCRIPTOR LCHARLIM) of LINE)) LINE)))
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLIM) (AND (IGEQ CHLIM (GETLD L LCHAR1)) (ILEQ CH# (
FGETLD L LCHARLIM)))))
(CONSTANTS (COPYSELSHADE 30583) (COPYLOOKSSELSHADE 30583) (EDITMOVESHADE BLACKSHADE) (EDITGRAY 32800))
(PUTPROPS WITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (GETLD LINE LCHAR1)) (ILESSP CHNO
(FGETLD LINE LCHARLIM)) LINE)))
(PUTPROPS FWITHINLINEP MACRO (OPENLAMBDA (CHNO LINE) (AND (IGEQ CHNO (FGETLD LINE LCHAR1)) (ILESSP
CHNO (FGETLD LINE LCHARLIM)) LINE)))
(PUTPROPS LINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (AND (IGEQ (GETLD L LCHARLAST) CH#) (ILEQ (
FGETLD L LCHAR1) CHLAST))))
(PUTPROPS FLINESELECTEDP MACRO (OPENLAMBDA (L CH# CHLAST) (* ;
"True if a CH#..CHLAST selection would include L") (AND (IGREATERP (FGETLD L LCHARLIM) CH#) (ILEQ (
FGETLD L LCHAR1) CHLAST))))
(PUTPROPS IBETWEENP MACRO (OPENLAMBDA (X LOW HIGH) (AND (IGEQ X LOW) (ILEQ X HIGH))))
(PUTPROPS GETSEL MACRO ((S FIELD) (fetch (SELECTION FIELD) of S)))
(PUTPROPS SETSEL MACRO ((S FIELD NEWVALUE) (replace (SELECTION FIELD) of S with NEWVALUE)))
(PUTPROPS FGETSEL MACRO ((S FIELD) (ffetch (SELECTION FIELD) of S)))
(PUTPROPS FSETSEL MACRO ((S FIELD NEWVALUE) (freplace (SELECTION FIELD) of S with NEWVALUE)))
(PUTPROPS SELECTION! MACRO ((SEL) (\DTEST SEL (QUOTE SELECTION))))
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (BIND
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY DECLARE (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
$$SPLENGTH) FIRST (\DTEST (OR $$SELPIECES (GO $$OUT)) (QUOTE SELPIECES)) (SETQ I.V. (SETQ $$SPFIRST (
\DTEST (ffetch (SELPIECES SPFIRST) of $$SELPIECES) (QUOTE PIECE)))) (SETQ $$SPLAST (\DTEST (ffetch (
SELPIECES SPLAST) of $$SELPIECES) (QUOTE PIECE))) (SETQ $$SPLENGTH (ffetch (SELPIECES SPLEN) of
$$SELPIECES)) REPEATUNTIL (EQ I.V. $$SPLAST) BY (\DTEST (NEXTPIECE I.V.) (QUOTE PIECE)))))) T)
(PUTPROPS GETSPC MACRO ((SP FIELD) (fetch (SELPIECES FIELD) of SP)))
(PUTPROPS SETSPC MACRO ((SP FIELD NEWVALUE) (replace (SELPIECES FIELD) of SP with NEWVALUE)))
(PUTPROPS FGETSPC MACRO ((SP FIELD) (ffetch (SELPIECES FIELD) of SP)))
(PUTPROPS FSETSPC MACRO ((SP FIELD NEWVALUE) (freplace (SELPIECES FIELD) of SP with NEWVALUE)))
(PUTPROPS SELPIECES! MACRO ((SPC) (\DTEST SPC (QUOTE SELPIECES))))
(GLOBALVARS TEDIT.EXTEND.PENDING.DELETE)
(GLOBALVARS TEDIT.SELECTION TEDIT.SHIFTEDSELECTION TEDIT.MOVESELECTION TEDIT.COPYLOOKSSELECTION
TEDIT.DELETESELECTION)
(I.S.OPR (QUOTE inselpieces) NIL (QUOTE (SUBST (GETDUMMYVAR) (QUOTE $$SELPIECES) (QUOTE (bind
$$SPFIRST $$SPLAST $$SPLENGTH $$SELPIECES _ BODY declare (LOCALVARS $$SELPIECES $$SPFIRST $$SPLAST
$$SPLENGTH) first (SETQ I.V. (SETQ $$SPFIRST (\DTEST (OR (fetch (SELPIECES SPFIRST) of $$SELPIECES) (
GO $$OUT)) (QUOTE PIECE)))) (SETQ $$SPLAST (fetch (SELPIECES SPLAST) of $$SELPIECES)) (SETQ $$SPLENGTH
(fetch (SELPIECES SPLEN) of $$SELPIECES)) while I.V. repeatuntil (EQ I.V. $$SPLAST) by (NEXTPIECE
I.V.))))) T)
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:55"))
(DATATYPE THISLINE ((* ;;
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
) CHARSLOTS (* ;
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
(PUTPROP (QUOTE TEDIT-SELECTION) (QUOTE IMPORTDATE) (IDATE " 6-Dec-2024 12:50:42"))
(RECORD TAB (TABX . TABKIND))
(RECORD TABSPEC (DEFAULTTAB . TABS))
(DATATYPE LINECACHE ((* ;; "Image cache for display lines.") LCBITMAP (* ;
"The bitmap that will be used by this instance of the cache") (LCNEXTCACHE FULLXPOINTER) (* ;
"The next cache in the chain, for screen updates.")))
@@ -125,12 +133,13 @@ CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.
RIGHTMARGIN (* ; "Right margin, in screen points") LXLIM (* ;
"X value of right edge of LCHARLIM character on the line (may exceed right margin, if char is a space.). In natural stream units"
) LX1 (* ; "X value of the left edge of LCHAR1 from the left margin, in stream natural units.")
LHEIGHT (* ; "Total height of hte line, Ascent+Descent plus leading") ASCENT (* ;
"Ascent of the line above YBASE, adjusted for line leading") DESCENT (* ;
LHEIGHT (* ;
"Total height of hte line, Ascent+Descent plus leading. Includes paragraph and line leading") LASCENT
(* ; "Ascent of the line above YBASE, adjusted for line and paragraph leading") LDESCENT (* ;
"How far line descends below YBASE, adjusted for line leading") LTRUEDESCENT (* ;
"The TRUE DESCENT for this line, unadjusted for line leading.") LTRUEASCENT (* ;
"The TRUE ASCENT for this line, unadjusted for pre-paragraph leading.") LCHAR1 (* ;
"CH# of the first character on the line.") LCHARLIM (* ; "CH# of the last character on the line")
"CH# of the first character on the line.") LCHARLAST (* ; "CH# of the last character on the line")
FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
"Was CHARTOP: CH# of the character which forced the line break (may be less than CHARLIM)") NEXTLINE
(* ; "Next line chain pointer") (PREVLINE FULLXPOINTER) (* ; "Previous line chain pointer") LMARK (* ;
@@ -141,19 +150,27 @@ FORCED-END (* ; "NIL or character (EOL, FORM...) that forces a line break") (* ;
) NIL (* ;
"Was CACHE: A cached THISLINE, for keeping hardcopy info around while we crunch with the line descriptors to make things fit. Now: THISLINE comes from TEXTOBJ"
) NIL (* ; "Was LDOBJ: The object which lies behind this line of text, for updating, etc.") LFMTSPEC (
* ; "The format spec for this line's paragraph (eventually)") (LDIRTY FLAG) (* ;
"T if this line has changed since it was last formatted.") (NIL FLAG) (* ; "Was FORCED-END flag") (
DELETED FLAG) (* ;
"T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
) (LHASPROT FLAG) (* ; "This line contains protected text.") (LDUMMY FLAG) (* ;
* ; "The format spec for this line's paragraph (eventually)") (NIL FLAG) (* ;
"Was LDIRTY: T if this line has changed since it was last formatted.") (NIL FLAG) (* ;
"Was FORCED-END flag") (NIL FLAG) (* ;
"Was DELETED: T if this line has been completely deleted since it was last formatted or displayed. (Used by deletion routines to detect garbage lines)"
) (NIL FLAG) (* ; "Was LHASPROT This line contains protected text.") (LDUMMY FLAG) (* ;
"This is a dummy line. Was: LHASTABS. But never fetched and this descriptions wasn't true: If this line has a tab in it, this is the line-relative ch# of the final tab. This is to let us punt properly with tabs in a line."
) (1STLN FLAG) (* ; "This line is the first line in a paragraph") (LSTLN FLAG) (* ;
"This is the last line in a paragraph")) (INIT (DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (IPLUS (FGETLD DATUM YBOT) (FGETLD DATUM LHEIGHT))
) (LTRUEHEIGHT (IPLUS (FGETLD DATUM LTRUEASCENT (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYTOP (IPLUS (
GETLD DATUM YBOT) (FGETLD DATUM LTRUEHEIGHT))) (LTRUEYBOT (IDIFFERENCE (FGETLD DATUM YBASE) (FGETLD
DATUM LTRUEDESCENT))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 LCHARLIM _ 1000000 NEXTLINE _ NIL
PREVLINE _ NIL LDIRTY _ NIL YBOT _ 0 YBASE _ 0 LEFTMARGIN _ 0 DELETED _ NIL)
\TEDIT.LINEDESCRIPTOR.DEFPRINT))) (ACCESSFNS ((YTOP (STANDARD (IPLUS (GETLD DATUM YBASE) (GETLD DATUM
LASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM LASCENT)))) (LTRUEYTOP (STANDARD (IPLUS (
GETLD DATUM YBASE) (FGETLD DATUM LTRUEASCENT)) FAST (IPLUS (FGETLD DATUM YBASE) (FGETLD DATUM
LTRUEASCENT)))) (LTRUEHEIGHT (STANDARD (IPLUS (GETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT))
FAST (IPLUS (FGETLD DATUM LTRUEASCENT) (FGETLD DATUM LTRUEDESCENT)))) (LTRUEYBOT (STANDARD (
IDIFFERENCE (GETLD DATUM YBASE) (FGETLD DATUM LTRUEDESCENT)) FAST (IDIFFERENCE (FGETLD DATUM YBASE) (
FGETLD DATUM LTRUEDESCENT)))) (LLEADBEFORE (STANDARD (IDIFFERENCE (GETLD DATUM LASCENT) (FGETLD DATUM
LTRUEASCENT)) FAST (IDIFFERENCE (FGETLD DATUM LASCENT) (FGETLD DATUM LTRUEASCENT)))) (LCHARLIM (
STANDARD (ADD1 (GETLD DATUM LCHARLAST)) FAST (ADD1 (FGETLD DATUM LCHARLAST))) (STANDARD (SETLD DATUM
LCHARLAST (SUB1 NEWVALUE)) FAST (FSETLD DATUM LCHARLAST (SUB1 NEWVALUE)))) (LNCH (STANDARD (
IDIFFERENCE (GETLD DATUM LCHARLIM) (GETLD DATUM LCHAR1)) FAST (IDIFFERENCE (FGETLD DATUM LCHARLIM) (
FGETLD DATUM LCHAR1)))))) LHEIGHT _ 0 LTRUEASCENT _ 0 LTRUEDESCENT _ 0 YBOT _ 0 YBASE _ 0 LEFTMARGIN _
0)
(DEFPRINT (QUOTE LINEDESCRIPTOR) (FUNCTION \TEDIT.LINEDESCRIPTOR.DEFPRINT))
(I.S.OPR (QUOTE inlines) NIL (QUOTE (bind $$PREVLINE declare (LOCALVARS $$PREVLINE) first (SETQ I.V. (
\DTEST (OR BODY (GO $$OUT)) (QUOTE LINEDESCRIPTOR))) by (PROGN (SETQ $$PREVLINE I.V.) (\DTEST (OR (
@@ -165,18 +182,39 @@ fetch (LINEDESCRIPTOR PREVLINE) of I.V.) (GO $$OUT)) (QUOTE LINEDESCRIPTOR))))))
(PUTPROPS FGETLD MACRO ((L FIELD) (ffetch (LINEDESCRIPTOR FIELD) of L)))
(PUTPROPS SETLD MACRO ((L FIELD NEWVALUE) (replace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
(PUTPROPS FSETLD MACRO ((L FIELD NEWVALUE) (freplace (LINEDESCRIPTOR FIELD) of L with NEWVALUE)))
(PUTPROPS SETYPOS MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE DESCENT) (
(PUTPROPS SETYBOT MACRO (OPENLAMBDA (LINE BOTTOM) (FSETLD LINE YBASE (IPLUS (GETLD LINE LDESCENT) (
FSETLD LINE YBOT BOTTOM)))))
(PUTPROPS SETYTOP MACRO (OPENLAMBDA (LINE TOP) (SETYBOT LINE (IDIFFERENCE TOP (GETLD LINE LHEIGHT)))))
(PUTPROPS SETYBASE MACRO (OPENLAMBDA (LINE BASE) (FSETLD LINE YBOT (IDIFFERENCE (GETLD LINE LDESCENT)
(FSETLD LINE YBASE BASE)))))
(PUTPROPS LINKLD MACRO (OPENLAMBDA (LINE1 LINE2) (CL:WHEN LINE1 (SETLD LINE1 NEXTLINE LINE2)) (CL:WHEN
LINE2 (SETLD LINE2 PREVLINE LINE1))))
(PUTPROPS LINEDESCRIPTOR! MACRO ((LD) (\DTEST LD (QUOTE LINEDESCRIPTOR))))
(PUTPROPS HCSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
(PUTPROPS HCUNSCALE MACRO (OPENLAMBDA (SCALE ITEM) (CL:IF (LISTP ITEM) (for I in ITEM collect (FIXR (
FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
(PUTPROPS SCALEUP MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I in
ITEM collect (FIXR (FTIMES SCALE ITEM))) (FIXR (FTIMES SCALE ITEM)))))
(PUTPROPS SCALEDOWN MACRO (OPENLAMBDA (SCALE ITEM) (* ; "List = region?") (CL:IF (LISTP ITEM) (for I
in ITEM collect (FIXR (FQUOTIENT I SCALE))) (FIXR (FQUOTIENT ITEM SCALE)))))
(GLOBALVARS TEDIT.DONT.BREAK.CHARS TEDIT.DONT.LAST.CHARS)
(ADDTOVAR CHARACTERNAMES (EM-DASH "357,045") (SOFT-HYPHEN "357,043") (NONBREAKING-HYPHEN "357,042") (
NONBREAKING-SPACE "357,041"))
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
192) (ILEQ CHAR 207))))
(PUTPROPS \TEDIT.LINE.TALLP MACRO ((LINE HEIGHT) (OR (IGREATERP (FGETLD LINE LHEIGHT) 50) (IGREATERP (
FGETLD LINE LHEIGHT) HEIGHT))))
(* ; "Formatting slots held by THISLINE")
(DATATYPE THISLINE ((* ;;
"Cache for line-related character location info, for selection and line-display code to use.") (DESC
FULLXPOINTER) (* ; "Line descriptor for the line this describes now") TLSPACEFACTOR (* ;
"The SPACEFACTOR to be used in printing this line") TLFIRSTSPACE (* ;
"The first space to which SPACEFACTOR is to apply. This is used sothat spaces to the left of a TAB have their default width."
) CHARSLOTS (* ;
"Pointer block holdomg char/width slots MAXCHARSLOTS (with an extra slot so that there is always storage behind NEXTAVAILABLECHARSLOT"
) NEXTAVAILABLECHARSLOT) (* ; "The last used CHARSLOT is at (PREVCHARSLOT NEXTAVAILABLECHARSLOT)")
CHARSLOTS _ (\ALLOCBLOCK (ITIMES (ADD1 MAXCHARSLOTS) CELLSPERCHARSLOT) PTRBLOCK.GCT))
(BLOCKRECORD CHARSLOT (CHAR CHARW (* ; "If CHAR is NIL, then CHARW is CHARLOOKS.")))
(PUTPROPS CHAR MACRO ((CSLOT) (ffetch (CHARSLOT CHAR) of CSLOT)))
(PUTPROPS CHARW MACRO ((CSLOT) (ffetch (CHARSLOT CHARW) of CSLOT)))
@@ -224,9 +262,7 @@ SETQ I.V. (COND ((TYPE? THISLINE $$STARTSLOT) (PREVCHARSLOT (fetch (THISLINE NEX
THISLINE))) (T $$STARTSLOT))) (SETQ $$CHARSLOTLIMIT (FIRSTCHARSLOT THISLINE)) by (PREVCHARSLOT I.V.)
eachtime (SETQ CHAR (fetch (CHARSLOT CHAR) of I.V.)) (SETQ CHARW (fetch (CHARSLOT CHARW) of I.V.))
repeatuntil (EQ I.V. $$CHARSLOTLIMIT))))) T)
(PUTPROPS DIACRITICP MACRO (OPENLAMBDA (CHAR) (* ;; "An XCCS diacritic") (AND (SMALLP CHAR) (IGEQ CHAR
192) (ILEQ CHAR 207))))
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:35"))
(PUTPROP (QUOTE TEDIT-SCREEN) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:31"))
(DATATYPE PIECE ((* ;
"The piece describes either a string or part of a file. , or a generalized OBJECT.") PCONTENTS (* ;
"The background source of data for this piece (stream, string, block, object, depending on the PTYPE)."
@@ -243,37 +279,39 @@ PNEW FLAG) (* ;
XPOINTER) (* ; "Points to the PCTB tree-node that contains this piece.") (PCHARSET BYTE) (* ;
"High-order charset for FATFILE1 pieces") (PUTF8BYTESPERCHAR BYTE)) (* ;
"The number of bytes in the UTF-8 encoding of all the Unicode characters in this piece") (ACCESSFNS ((
POBJ (IMAGEOBJP (PCONTENTS DATUM))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _
POBJ (AND (EQ OBJECT.PTYPE (PTYPE DATUM)) (type? IMAGEOBJ (PCONTENTS DATUM)) (PCONTENTS DATUM))) (
PCHARLOOKS (PLOOKS DATUM) (STANDARD (replace (PIECE PLOOKS) of DATUM with NEWVALUE) FAST (freplace (
PIECE PLOOKS) of DATUM with NEWVALUE))))) PFPOS _ 0 PLEN _ 0 PBYTELEN _ 0 PPARALOOKS _
TEDIT.DEFAULT.FMTSPEC)
(DATATYPE TEXTOBJ ((* ;;
"This is where TEdit stores its state information, and internal data about the text being edited.")
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PANES (* ;
"A list of panes (subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
PCTB (* ; "The piece table") TEXTLEN (* ; "# of chars in the text") PRIMARYPANE (* ;
"A sequence of panes (split subwindows) that are open on this document. Was INSERTPC: The string-piece that received the last insertion. Now HINTPC"
) LASTPIECE (* ; "The last (end-of-stream) piece of the textstream, for easy insertion at the end")
NIL (* ;
CHARFN (* ;
"Was: INSERTNEXTCH CH# of next char which is typed into that piece. Taken over by HINTPCSTARTCH#")
HINTPC (* ; "Was: Space left in the type-in piece") HINTPCSTARTCH# (* ;
"Was # of characters already in the piece.") INSERTSTRING (* ;
"A substring of storage that is available for an insertion.") TXTHISTORYUNDONE (* ;
"Events that result from undoing other events, for revoking the UNDO. Was: CH# of first char in the piece."
) (TXTLINELEADINGABOVE FLAG) (* ;
"NIL for old/existing Tedit files whose lines are formatted with leading below, T for newer files. Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
) \WINDOW (* ; "The window-pane<s> where this textobj is displayed") MOUSEREGION (* ;
"Section of the window the mouse is in.") NIL (* ;
) (NIL FLAG) (* ;
" Was \INSERTPCVALID. T if it's OK to use the cached piece. Set to NIL by people who require that the next insertion/deletion use a different piece. Now just set HINTPC to NIL."
) (TXTREADONLYQUIET FLAG) (* ; "T => don't print READONLY abort messages") PARABREAKCHARS (* ;
"Characters that cause a paragraph break.Was \WINDOW. The window-pane<s> where this textobj is displayed. Now chained through PRIMARYPANE"
) MOUSEREGION (* ; "Section of the window the mouse is in.") LOOPFN (* ;
"Was: A list of lines (parallel to the panes in \WINDOW) each of which is the top of chain of line descriptors for the part of the text that is visible in the corresponding pane. Now: each PANE has its own PLINES."
) DS (* ;
"NOTE: THIS IS ONLY USED INCORRECTLY BY TEDIT-CHAT Display stream where this textobj is displayed")
SEL (* ; "The current selection within the text") SCRATCHSEL (* ;
"Scratch space for the selection code") SCRATCHSEL2 (* ;
"Was MOVESEL: Source for the next MOVE of text") NIL (* ; "Was SHIFTEDSEL: Source for the next COPY")
NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
"Right edge of the window (or subregion) where this is displayed") WTOP (* ;
SEL (* ; "The current selection within the text") NIL (* ; "Was: Scratch space for the selection code"
) NIL (* ; "Was MOVESEL: Source for the next MOVE of text") NIL (* ;
"Was SHIFTEDSEL: Source for the next COPY") NIL (* ; "Was DELETESEL: Text to be deleted imminently")
WRIGHT (* ; "Right edge of the window (or subregion) where this is displayed") WTOP (* ;
"Top of the window/region") WBOTTOM (* ; "Bottom of the window/region") WLEFT (* ;
"Left edge of the window/region") TXTFILE (* ; "The original text file we're editing") (\XDIRTY FLAG)
(* ; "T => changed since last saved.") (STREAMHINT FULLXPOINTER) (* ;
"-> the TEXTOFD stream which gives access to this textobj") EDITFINISHEDFLG (* ;
"T => The guy has asked the editor to go way") CARET (* ;
"Describes the flashing caret for the editing window") CARETLOOKS (* ;
"T => The guy has asked the editor to go way") NIL (* ;
"Was CARET: Describes the flashing caret for the editing window") CARETLOOKS (* ;
"Font to be used for inserted text.") WINDOWTITLE (* ;
"Original title for this window, of there was one.") THISLINE (* ;
"Cache of line-related info, to speed up selection &c") (MENUFLG FLAG) (* ;
@@ -292,7 +330,8 @@ NIL (* ; "Was DELETESEL: Text to be deleted imminently") WRIGHT (* ;
"The READTABLE to be used to decide on word breaks") EDITPROPS (* ;
"The PROPS that were passed into this edit session") (BLUEPENDINGDELETE FLAG) (* ;
"T if the next insertion in this document is to be preceded by a deletion of the then-current selection"
) TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
) (TXTHISTORYINACTIVE FLAG) (* ; "T if history events are not recorded (e.g. for transcript files)")
TXTHISTORY (* ; "The history list for this edit session.") (SELPANE FULLXPOINTER) (* ;
"The pane in which the last 'real' selection got made for this edit; used by TEDIT.NORMALIZECAREET")
PROMPTWINDOW (* ;
"A window to be used for unscheduled interactions; normally a small window above the edit window")
@@ -302,7 +341,9 @@ DISPLAYCACHEDS (* ; "The DISPLAYSTREAM that is used to build line images") DISPL
) TXTPAGEFRAMES (* ; "A tree of page frames, specifying how the document is to be laid out.")
TXTCHARLOOKSLIST (* ; "List of all the CHARLOOKSs in the document, so they can be kept unique")
TXTPARALOOKSLIST (* ; "List of all the FMTSPECs in the document, so they can be kept unique") (
TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TUPDATE FLAG) (* ;
TXTAPPENDONLY FLAG) (* ;
"Allows updates only at the end of the stream. Was TXTNEEDSUPDATE: T => Screen invalid, need to run updater"
) (TXTDON'TUPDATE FLAG) (* ;
"T if we're holding off on screen updates until later. Used, e.g., by the menu-SHOW code so that you don't get piecemeal updates, but only one at the end of the SHOW."
) TXTRAWINCLUDESTREAM (* ;
"NODIRCORE stream used to cache RAW includes (and maybe later, all includes?)") DOCPROPS (* ;
@@ -310,9 +351,8 @@ TXTNEEDSUPDATE FLAG) (* ; "T => Screen invalid, need to run updater") (TXTDON'TU
"Style sheet local to this document. Not currently saved as part of the file.")) (ACCESSFNS TEXTOBJ (
(\DIRTY (ffetch (TEXTOBJ \XDIRTY) of DATUM) (CL:UNLESS (EQ NEWVALUE (ffetch (TEXTOBJ \XDIRTY) of DATUM
)) (\TEDIT.WINDOW.TITLE DATUM NEWVALUE) (freplace \XDIRTY OF DATUM WITH NEWVALUE))))) SEL _ (create
SELECTION) SCRATCHSEL _ (create SELECTION) SCRATCHSEL2 _ (create SELECTION) TEXTLEN _ 0 WRIGHT _ 0
WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 TXTFILE _ NIL \XDIRTY _ NIL MOUSEREGION _ (QUOTE TEXT) THISLINE _ (
create THISLINE) MENUFLG _ NIL FMTSPEC _ TEDIT.DEFAULT.FMTSPEC FORMATTEDP _ NIL INSERTSTRING _ NIL)
SELECTION) TEXTLEN _ 0 WRIGHT _ 0 WTOP _ 0 WLEFT _ 0 WBOTTOM _ 0 MOUSEREGION _ (QUOTE TEXT) THISLINE _
(create THISLINE) FMTSPEC _ TEDIT.DEFAULT.FMTSPEC PARABREAKCHARS _ (CHARCODE (EOL FORM LF CR)))
(ACCESSFNS TEXTSTREAM ((* ;;
"Overlay for the STREAM record to allow mnemonic access to stream fields for Text streams.") (* ;;
"The # of characters that have already been read from the current piece") (TEXTOBJ (fetch (STREAM F3)
@@ -320,23 +360,25 @@ of DATUM) (REPLACE (STREAM F3) OF DATUM WITH NEWVALUE)) (* ; "The TEXTOBJ that i
(PIECE (fetch (STREAM F5) of DATUM) (REPLACE (STREAM F5) OF DATUM WITH NEWVALUE)) (* ;
"The PIECE we're currently fetching chars from/putting chars into") (PCCHARSLEFT (fetch (STREAM F1) of
DATUM) (replace (STREAM F1) of DATUM with NEWVALUE)) (* ; "Runs from PLEN to 0: piece exhausted") (
CURRENTLOOKS (fetch (STREAM F10) of DATUM) (replace (STREAM F10) of DATUM with NEWVALUE)) (* ;
"The CHARLOOKS that are currently applicable to characters being taken from the stream.") (
CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with
NIL) (* ;
"Was CURRENTLOOKS at F10: The CHARLOOKS that are currently applicable to characters being taken from the stream. This is now CARETLOOKS of the TEXTOBJ."
) (CURRENTPARALOOKS (fetch (STREAM IMAGEDATA) of DATUM) (REPLACE (STREAM IMAGEDATA) of DATUM with
NEWVALUE)) (* ;
"The FMTSPEC that is currently applicable to characters being taken from the stream. This was the only residual field of TEXTIMAGEDATA, now gone."
) (LOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
"Function to be called at every piece change when line-formatting.") (STARTINGCOFFSET (fetch (STREAM
F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE? (AND (type? STREAM DATUM) (type?
TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create STREAM BINABLE _ NIL BOUTABLE _ NIL
ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4
_ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS IMAGEDATA _ NIL)))
) (APPLYLOOKSUPDATEFN (fetch (STREAM F4) of DATUM) (REPLACE (STREAM F4) OF DATUM with NEWVALUE)) (* ;
"Determines whether to call \TEDIT.FORMATLINE.UPDATELOOKS at every piece change when line-formatting."
) (STARTINGCOFFSET (fetch (STREAM F2) of DATUM) (replace (STREAM F2) of DATUM with NEWVALUE))) (TYPE?
(AND (type? STREAM DATUM) (type? TEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of DATUM)))) (CREATE (create
STREAM BINABLE _ NIL BOUTABLE _ NIL ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _
\TEXTFDEV F1 _ NIL F2 _ 0 F3 _ NIL F4 _ NIL F5 _ NIL MAXBUFFERS _ 10 IMAGEOPS _ \TEXTIMAGEOPS
IMAGEDATA _ NIL)))
(PUTPROPS NEXTPIECE MACRO ((PC) (ffetch (PIECE NEXTPIECE) of PC)))
(PUTPROPS PREVPIECE MACRO ((PC) (ffetch (PIECE PREVPIECE) of PC)))
(PUTPROPS PLEN MACRO ((PC) (ffetch (PIECE PLEN) of PC)))
(PUTPROPS PTYPE MACRO ((PC) (ffetch (PIECE PTYPE) of PC)))
(PUTPROPS PCONTENTS MACRO ((PC) (ffetch (PIECE PCONTENTS) of PC)))
(PUTPROPS PLOOKS MACRO ((PC) (ffetch (PIECE PLOOKS) of PC)))
(PUTPROPS PCHARLOOKS MACRO ((PC) (PLOOKS PC)))
(PUTPROPS PCHARSET MACRO ((PC) (ffetch (PIECE PCHARSET) of PC)))
(PUTPROPS PPARALOOKS MACRO ((PC) (ffetch (PIECE PPARALOOKS) of PC)))
(PUTPROPS PPARALAST MACRO ((PC) (ffetch (PIECE PPARALAST) of PC)))
@@ -345,16 +387,16 @@ ACCESS _ (QUOTE BOTH) USERCLOSEABLE _ T USERVISIBLE _ T DEVICE _ \TEXTFDEV F1 _
(PUTPROPS PNEW MACRO ((PC) (ffetch (PIECE PNEW) of PC)))
(PUTPROPS PBINABLE MACRO ((PC) (ffetch (PIECE PBINABLE) of PC)))
(PUTPROPS PBYTESPERCHAR MACRO ((PC) (ffetch (PIECE PBYTESPERCHAR) of PC)))
(PUTPROPS POBJ MACRO ((PC) (ffetch (PIECE POBJ) of PC)))
(PUTPROPS SETPC MACRO ((PC FIELD NEWVALUE) (replace (PIECE FIELD) of PC with NEWVALUE)))
(PUTPROPS FSETPC MACRO ((PC FIELD NEWVALUE) (freplace (PIECE FIELD) of PC with NEWVALUE)))
(PUTPROPS GETPC MACRO ((PC FIELD) (fetch (PIECE FIELD) of PC)))
(PUTPROPS FGETPC MACRO ((PC FIELD) (ffetch (PIECE FIELD) of PC)))
(PUTPROPS THINPIECEP MACRO ((PC) (* ;;
"Assume that objects start out thin, for CHARSET in \TEDIT.PUT.PCTB. The putfn might immediately change that, but we don't care."
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) (OBJECT.PTYPE
T) NIL)))
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (NOT (OR (EQ 0 (PLEN PC)) (fetch (CHARLOOKS CLINVISIBLE) of (
PLOOKS PC))))))
) (SELECTC (PTYPE PC) (THIN.PTYPES T) (UTF8.PTYPE (EQ 1 (FGETPC PC PUTF8BYTESPERCHAR))) NIL)))
(PUTPROPS VISIBLEPIECEP MACRO ((PC) (AND PC (NEQ 0 (PLEN PC)) (NOT (FGETCLOOKS (PCHARLOOKS PC)
CLINVISIBLE)))))
(PUTPROPS \NEXT.VISIBLE.PIECE MACRO ((PC) (find NPC inpieces (AND PC (NEXTPIECE PC)) suchthat (
VISIBLEPIECEP NPC))))
(PUTPROPS \PREV.VISIBLE.PIECE MACRO ((PC) (find PPC backpieces (AND PC (PREVPIECE PC)) suchthat (
@@ -366,12 +408,18 @@ VISIBLEPIECEP PPC))))
(PUTPROPS TEXTLEN MACRO ((TOBJ) (ffetch (TEXTOBJ TEXTLEN) of TOBJ)))
(PUTPROPS TEXTSEL MACRO ((TOBJ) (fetch (TEXTOBJ SEL) of TOBJ)))
(PUTPROPS TEXTOBJ! MACRO ((TOBJ) (\DTEST TOBJ (QUOTE TEXTOBJ))))
(PUTPROPS GETTSTR MACRO ((TSTR FIELD) (fetch (TEXTSTREAM FIELD) of TSTR)))
(PUTPROPS SETTSTR MACRO ((TSTR FIELD NEWVALUE) (replace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
(PUTPROPS FGETTSTR MACRO ((TSTR FIELD) (ffetch (TEXTSTREAM FIELD) of TSTR)))
(PUTPROPS FSETTSTR MACRO ((TSTR FIELD NEWVALUE) (freplace (TEXTSTREAM FIELD) of TSTR with NEWVALUE)))
(PUTPROPS TEXTSTREAM! MACRO (OPENLAMBDA (TSTR) (AND (\DTEST TSTR (QUOTE STREAM)) (TEXTOBJ! (FGETTSTR
TSTR TEXTOBJ)) TSTR)))
(RPAQQ PTYPES ((THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE))))
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))))
(RPAQQ THINFILE.PTYPE 0)
(RPAQQ FATFILE1.PTYPE 1)
(RPAQQ FATFILE2.PTYPE 2)
@@ -388,14 +436,15 @@ UTF16LE.PTYPE))
(RPAQ STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE))
(RPAQ BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
(RPAQ THIN.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE))
(RPAQ FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE))
(CONSTANTS (THINFILE.PTYPE 0) (FATFILE1.PTYPE 1) (FATFILE2.PTYPE 2) (THINSTRING.PTYPE 3) (
FATSTRING.PTYPE 4) (SUBSTREAM.PTYPE 5) (OBJECT.PTYPE 6) (LOOKS.PTYPE 7) (UTF16BE.PTYPE 8) (
UTF16LE.PTYPE 9) (UTF8.PTYPE 11) (FILE.PTYPES (LIST THINFILE.PTYPE FATFILE1.PTYPE FATFILE2.PTYPE
UTF8.PTYPE UTF16BE.PTYPE UTF16LE.PTYPE)) (STRING.PTYPES (LIST THINSTRING.PTYPE FATSTRING.PTYPE)) (
BINABLE.PTYPES (LIST THINFILE.PTYPE THINSTRING.PTYPE)) (THIN.PTYPES (LIST THINFILE.PTYPE
THINSTRING.PTYPE)))
THINSTRING.PTYPE)) (FAT.PTYPES (LIST FATFILE2.PTYPE FATSTRING.PTYPE FATFILE1.PTYPE)))
(GLOBALVARS \TEXTIMAGEOPS \TEXTFDEV)
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:08:37"))
(PUTPROP (QUOTE TEDIT-STREAM) (QUOTE IMPORTDATE) (IDATE "27-Nov-2024 23:17:20"))
(RPAQQ NONE.TTC 0)
(RPAQQ CHARDELETE.TTC 1)
(RPAQQ WORDDELETE.TTC 2)
@@ -414,10 +463,10 @@ THINSTRING.PTYPE)))
(CONSTANTS (NONE.TTC 0) (CHARDELETE.TTC 1) (WORDDELETE.TTC 2) (DELETE.TTC 3) (FUNCTIONCALL.TTC 4) (
REDO.TTC 5) (UNDO.TTC 6) (CMD.TTC 7) (NEXT.TTC 8) (EXPAND.TTC 9) (CHARDELETE.FORWARD.TTC 10) (
WORDDELETE.FORWARD.TTC 11) (PUNCT.TTC 20) (TEXT.TTC 21) (WHITESPACE.TTC 22))
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* Test to see if only the specified mouse button is down.
DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it WAS called.) (
SELECTQ (CAR BUTTON) (LEFT (QUOTE (IEQP LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (IEQP LASTMOUSEBUTTONS 1)
)) (RIGHT (QUOTE (IEQP LASTMOUSEBUTTONS 2))) (SHOULDNT))))
(PUTPROPS \TEDIT.MOUSESTATE MACRO (BUTTON (* ;;
"Test to see if only the specified mouse button is down. DOES NOT call GETMOUSESTATE, so the mouse-button info is the same as the last time it was called."
) (SELECTQ (CAR BUTTON) (LEFT (QUOTE (EQ LASTMOUSEBUTTONS 4))) (MIDDLE (QUOTE (EQ LASTMOUSEBUTTONS 1))
) (RIGHT (QUOTE (EQ LASTMOUSEBUTTONS 2))) (SHOULDNT))))
(PUTPROPS \TEDIT.CHECK MACRO (ARGS (COND ((AND (BOUNDP (QUOTE CHECK)) CHECK) (CONS (QUOTE PROGN) (for
I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (QUOTE HELP)
"TEdit consistency-check failure [RETURN to continue]: " (COND ((STRINGP (CADR J))) (T (KWOTE I))))))
@@ -431,15 +480,16 @@ I in ARGS as J on ARGS when (NOT (STRINGP I)) collect (LIST (QUOTE OR) I (LIST (
(RPAQQ NEWCHAR-IF-SPLIT.LB 32)
(CONSTANTS (NOTBEFORE.LB 1) (NOTAFTER.LB 2) (BEFORE.LB 4) (AFTER.LB 8) (DISAPPEAR-IF-NOT-SPLIT.LB 16)
(NEWCHAR-IF-SPLIT.LB 32))
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:07:16"))
(PUTPROP (QUOTE TEDIT-COMMAND) (QUOTE IMPORTDATE) (IDATE "28-Nov-2024 10:03:03"))
(PUTPROPS \SMALLPIN MACRO (OPENLAMBDA (STREAM) (SIGNED (create WORD HIBYTE _ (\BIN STREAM) LOBYTE _ (
\BIN STREAM)) BITSPERWORD)))
(PUTPROPS \SMALLPOUT MACRO (OPENLAMBDA (STREAM W) (* ; "Signed smallp, unlike \WOUT") (\BOUT STREAM (
LOGAND 255 (LRSH W 8))) (\BOUT STREAM (LOGAND W 255))))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:52"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:42"))
(PUTPROP (QUOTE TEDIT-FILE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 23:00:13"))
(PUTPROP (QUOTE TEDIT-OLDFILE) (QUOTE IMPORTDATE) (IDATE "23-Oct-2024 16:09:28"))
(DATATYPE CHARLOOKS ((* ;; "Describes the appearance (%"Looks%") of characters in a TEdit document.")
CLFONT (* ; "The font descriptor for these characters") CLNAME (* ;;
(* ;; "NOTE: If fields change EQCLOOKS should change too.") CLFONT (* ;
"The font descriptor for these characters") CLNAME (* ;;
"Name of the font (e.g., HELVETICA) THIS FIELD IS A HINT, OR FOR USE IN CHARLOOKS-BUILDING CODE. USE FONTPROP TO GET THE RIGHT VALUE FROM CLFONT."
) CLSIZE (* ; "Font size, in points") (CLITAL FLAG) (* ; "T if the characters are italic, else NIL") (
CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
@@ -450,9 +500,9 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
"T if small caps, else NIL") (CLINVERTED FLAG) (* ;
"T if the characters are to be shown white-on-black") (CLPROTECTED FLAG) (* ;
"T if chars can't be selected, else NIL") (CLINVISIBLE FLAG) (* ;
"T if TEDIT is to ignore these chars; else NIL") (CLSELHERE FLAG) (* ;;
"T if TEDIT can put selection after this char (for menu blanks) else NIL; anything typed after this char will NOT BE PROTECTED."
) (CLCANCOPY FLAG) (* ;;
"T if TEDIT is to ignore these chars; else NIL") (CLSELAFTER FLAG) (* ;
"T if TEDIT can put selection after this char (for menu fields).") (* ;; "Was CLSELHERE. ") (CLCANCOPY
FLAG) (* ;;
"T if this text can be selected for copying, even tho protected (it will become unprotected after the copy; for Dribble/TTY interface)"
) (CLUNBREAKABLE FLAG) (* ; "Spaces are treated as nonbreaking spaces") CLSTYLE (* ;
"The style to be used in marking these characters; overridden by the other fields") CLUSERINFO (* ;
@@ -461,7 +511,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
"For arbitrarily-places horizontal rules. List of pairs, of (widthinpts . offsetfrombaselineinpts). Should be taken account of in ascent/descent calcs."
) (CLMARK FLAG) (* ;;
"Used for a mark-&-sweep of looks at PUT time -- T means this set of looks really IS in use in the document"
)) CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
) (CLSELBEFORE FLAG) (* ; "T if TEDIT can put selection before this char (for menu fields)."))
CLOFFSET _ 0 (INIT (DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))))
(DATATYPE FMTSPEC ((* ;; "Describe the paragraph formatting for a paragraph in a TEdit document.")
1STLEFTMAR (* ; "Left margin of the first line of the paragraph") LEFTMAR (* ;
"Left margin of the rest of the lines in the paragraph") RIGHTMAR (* ;
@@ -471,8 +522,8 @@ CLBOLD FLAG) (* ; "T if the characters are bold, else NIL") (CLULINE FLAG) (* ;
"Leading between lines, in points. This space is added BELOW each line in the para when TEDIT.LINELEADING.BELOW, otherwise above, which is how it is documented."
) FMTBASETOBASE (* ;
"The baseline-to-baseline spacing between lines in this paragraph. THIS OVERRIDES THE LINE LEADING")
TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default tab width") QUAD (* ;
"How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
NIL (* ; "Was TABSPEC: The list of tabs for this paragraph, including CAR for a default tab width")
QUAD (* ; "How the para is formatted: one of LEFT, RIGHT, CENTERED, JUSTIFIED") FMTSTYLE (* ;
"The STYLE that controls this paragraph's appearance") FMTCHARSTYLES (* ;
"The characterstyles that control the appearance of characters in this para (maybe? may be part of the fmtstyle.)"
) FMTUSERINFO (* ; "Space for a PLIST of user info") FMTSPECIALX (* ;
@@ -492,17 +543,28 @@ TABSPEC (* ; "The list of tabs for this paragraph, including CAR for a default t
) (FMTHARDCOPY FLAG) (* ; "T if this paragraph is to be displayed in hardcopy-format.") FMTREVISED (*
;
"T (or perhaps a revision level or revision-mark spec??) if this paragraph is to be marked as changed on output."
) FMTHARDCOPYSCALE) (* ;
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T)"
) (INIT (DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0
LINELEAD _ 0 TABSPEC _ (CONS DEFAULTTAB NIL))
) FMTHARDCOPYSCALE (* ;
"The units-per-point (DSPSCALE) of the hardcopy stream that is simulated in hardcopy-display mode (FMTHARDCOPY=T"
) FMTDEFAULTTAB (* ; "Default tab in points)") FMTTABS) (* ; "List of tabs (in points)") (INIT (
DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))) LEADBEFORE _ 0 LEADAFTER _ 0 LINELEAD _
0)
(DEFPRINT (QUOTE CHARLOOKS) (FUNCTION \TEDIT.CHARLOOKS.DEFPRINT))
(DEFPRINT (QUOTE FMTSPEC) (FUNCTION \TEDIT.FMTSPEC.DEFPRINT))
(PUTPROPS \WORDSETA DMACRO (OPENLAMBDA (A J V) (CHECK (AND (ARRAYP A) (ZEROP (fetch (ARRAYP ORIG) of A
)) (EQ \ST.POS16 (fetch (ARRAYP TYP) of A)))) (CHECK (IGREATERP (fetch (ARRAYP LENGTH) of A) J)) (
\PUTBASE (fetch (ARRAYP BASE) of A) (IPLUS (fetch (ARRAYP OFFST) of A) J) V)))
(PUTPROPS ONOFF MACRO (OPENLAMBDA (VAL) (COND (VAL (QUOTE ON)) (T (QUOTE OFF)))))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:29"))
(PUTPROPS FSETPARA MACRO ((F FIELD NEWVALUE) (freplace (FMTSPEC FIELD) of F with NEWVALUE)))
(PUTPROPS FGETPARA MACRO ((F FIELD) (ffetch (FMTSPEC FIELD) of F)))
(PUTPROPS GETPARA MACRO ((F FIELD) (fetch (FMTSPEC FIELD) of F)))
(PUTPROPS SETPARA MACRO ((F FIELD NEWVALUE) (replace (FMTSPEC FIELD) of F with NEWVALUE)))
(PUTPROPS GETCLOOKS MACRO ((CL FIELD) (fetch (CHARLOOKS FIELD) of CL)))
(PUTPROPS SETCLOOKS MACRO ((CL FIELD NEWVALUE) (replace (CHARLOOKS FIELD) of CL with NEWVALUE)))
(PUTPROPS FGETCLOOKS MACRO ((CL FIELD) (ffetch (CHARLOOKS FIELD) of CL)))
(PUTPROPS FSETCLOOKS MACRO ((CL FIELD NEWVALUE) (freplace (CHARLOOKS FIELD) of CL with NEWVALUE)))
(PUTPROPS PARALOOKS! MACRO ((PL) (\DTEST PL (QUOTE FMTSPEC))))
(PUTPROPS CHARLOOKS! MACRO ((CL) (\DTEST CL (QUOTE CHARLOOKS))))
(PUTPROP (QUOTE TEDIT-LOOKS) (QUOTE IMPORTDATE) (IDATE " 3-Dec-2024 00:01:46"))
(DATATYPE TEDITCARET (TCNOWTIME (* Used to hold the current time, when checking to see if a transition
is due) TCTHENTIME (* Time when the next transition is to take place) TCFORCEDDOWN (* TCFORCEDOWN = T
means (Make the caret visible at the next call to \EDIT.FLIPCARET.)) TCUP (* TCUP = T => The caret is
@@ -513,64 +575,79 @@ the caret up during screen updates) TCCARETX (* X position in the window that th
TCCARETY (* Y position in the window where the caret appears) TCCARET (* A lisp CARET to be flashed (
eventually))) TCNOWTIME _ (CREATECELL \FIXP) TCTHENTIME _ (CREATECELL \FIXP) TCCURSORBM _ BXCARET
TCCARETRATE _ \CARETRATE TCUP _ T TCCARET _ (\CARET.CREATE BXCARET))
(ACCESSFNS TEXTWINDOW ((NEXTPANE (GETWINDOWPROP DATUM (QUOTE TEDIT-NEXT-PANE-DOWN)) (PUTWINDOWPROP
DATUM (QUOTE TEDIT-NEXT-PANE-DOWN) NEWVALUE)) (WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (
PUTWINDOWPROP DATUM (QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (
TEXTWINDOW WTEXTSTREAM) of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
WTEXTSTREAM) of DATUM))) (WLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM (QUOTE LINES
) NEWVALUE)) (CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (
QUOTE TEDIT.CURSORREGION) NEWVALUE)) (PLINES (GETWINDOWPROP DATUM (QUOTE LINES)) (PUTWINDOWPROP DATUM
(QUOTE LINES) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (PUTWINDOWPROP
DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (WITHINSCREEN (GETWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN))
(LET ((NV NEWVALUE)) (PUTWINDOWPROP DATUM (QUOTE TEDIT-WITHIN-SCREEN) NV) NV))))
(DATATYPE PANE ((XPWINDOW FULLXPOINTER) PLINES PCARET HOLDDUMMYFIRSTLINE NEXTPANE (PREVPANE XPOINTER))
(ACCESSFNS (PWINDOW (PROGN DATUM))))
(PUTPROPS FGETPANE MACRO ((P FIELD) (ffetch (PANE FIELD) of P)))
(PUTPROPS GETPANE MACRO ((P FIELD) (fetch (PANE FIELD) of P)))
(PUTPROPS SETPANE MACRO ((P FIELD NEWVALUE) (replace (PANE FIELD) of P with NEWVALUE)))
(PUTPROPS FSETPANE MACRO ((P FIELD NEWVALUE) (freplace (PANE FIELD) of P with NEWVALUE)))
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (inside (fetch (TEXTOBJ \WINDOW) of BODY))))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:16:27"))
(TYPERECORD MB.3STATE ((* ;; "Describes a 3-state menu button.") MBLABEL (* ;
"Label for the button on the screen") MBFONT (* ; "Font the label text should appear in")
MBCHANGESTATEFN (* ; "Function to call when the button's state changes") MBINITSTATE (* ;
"Button's initial state.")) MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
(TYPERECORD MB.BUTTON (MBLABEL MBBUTTONEVENTFN MBFONT) MBBUTTONEVENTFN _ (QUOTE MB.DEFAULTBUTTON.FN)
MBFONT _ (FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
(TYPERECORD MB.INSERT (MBINITENTRY))
(TYPERECORD MB.MARGINBAR (ignoredfield))
(TYPERECORD MB.NWAY (MBBUTTONS MBFONT MBCHANGESTATEFN MBINITSTATE MBMAXITEMSPERLINE) MBFONT _ (
FONTCREATE (QUOTE HELVETICA) 8 (QUOTE BOLD)))
(TYPERECORD MB.TEXT (MBSTRING MBFONT))
(TYPERECORD MB.TOGGLE (MBTEXT MBFONT MBCHANGESTATEFN MBINITSTATE) MBFONT _ (FONTCREATE (QUOTE
HELVETICA) 8 (QUOTE BOLD)))
(RECORD MBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (OR (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (
QUOTE MB.DISPLAY)) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.THREESTATE.DISPLAY)) (EQ (
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE \TEXTMENU.TOGGLE.DISPLAY))))))
(RECORD NWAYBUTTON NIL (TYPE? (AND (IMAGEOBJP DATUM) (EQ (IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE
MB.NB.DISPLAYFN)))))
(RECORD MARGINBAR (MARL1 MARLN MARR MARTABS MARUNIT MARTABTYPE) (TYPE? (AND (IMAGEOBJP DATUM) (EQ (
IMAGEOBJPROP DATUM (QUOTE DISPLAYFN)) (QUOTE MB.MARGINBAR.DISPLAYFN)))))
(RECORD TAB (TABX . TABKIND))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:06:06"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 12:06:12"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "15-Mar-2024 14:07:55"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:37"))
(ACCESSFNS TEXTWINDOW ((WTEXTSTREAM (GETWINDOWPROP DATUM (QUOTE TEXTSTREAM)) (PUTWINDOWPROP DATUM (
QUOTE TEXTSTREAM) NEWVALUE)) (WTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM)
of DATUM))) (PTEXTOBJ (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW WTEXTSTREAM) of DATUM))) (
CURSORREGION (GETWINDOWPROP DATUM (QUOTE TEDIT.CURSORREGION)) (PUTWINDOWPROP DATUM (QUOTE
TEDIT.CURSORREGION) NEWVALUE)) (CLOSINGFILE (GETWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE)) (
PUTWINDOWPROP DATUM (QUOTE TEDIT-CLOSING-FILE) NIL)) (PANEPROPS (GETWINDOWPROP DATUM (QUOTE PANEPROPS)
) (PUTWINDOWPROP DATUM (QUOTE PANEPROPS) NEWVALUE))) (TYPE? (AND (WINDOWP DATUM) (TYPENAMEP (fetch (
TEXTWINDOW PTEXTOBJ) of DATUM) (QUOTE TEXTOBJ)))))
(DATATYPE PANEPROPS ((PWINDOW FULLXPOINTER) (* ; "The window with these PANEPROPS") PREFIXLINE (* ;
"Dummy line that covers all the characters above the first visible line") SUFFIXLINE (* ;
"Dummy line that covers all the characters below the last visible line") PCARET NEXTPANE (PREVPANE
XPOINTER) PANEHEIGHT PANEWIDTH PANELEFT PANERIGHT PANEBOTTOM PANETOP PANEREGION))
(PUTPROPS FGETPANEPROP MACRO ((P FIELD) (ffetch (PANEPROPS FIELD) of P)))
(PUTPROPS GETPANEPROP MACRO ((P FIELD) (fetch (PANEPROPS FIELD) of P)))
(PUTPROPS SETPANEPROP MACRO ((P FIELD NEWVALUE) (replace (PANEPROPS FIELD) of P with NEWVALUE)))
(PUTPROPS FSETPANEPROP MACRO ((P FIELD NEWVALUE) (freplace (PANEPROPS FIELD) of P with NEWVALUE)))
(PUTPROPS PANEPROPS MACRO ((PANE) (fetch (TEXTWINDOW PANEPROPS) of PANE)))
(PUTPROPS PANEPREFIX MACRO ((PANE) (LINEDESCRIPTOR! (GETPANEPROP (PANEPROPS PANE) PREFIXLINE))))
(PUTPROPS PANESUFFIX MACRO ((PANE) (GETPANEPROP (PANEPROPS PANE) SUFFIXLINE)))
(PUTPROPS PANETOPLINE MACRO ((PANE) (FGETLD (PANEPREFIX PANE) NEXTLINE)))
(PUTPROPS PANECARET MACRO ((PANE) (\DTEST (GETPANEPROP (PANEPROPS PANE) PCARET) (QUOTE TEDITCARET))))
(PUTPROPS PANESTREAM MACRO ((PANE) (fetch (TEXTWINDOW WTEXTSTREAM) of PANE)))
(PUTPROPS PANETOBJ MACRO ((PANE) (TEXTOBJ! (fetch (TEXTSTREAM TEXTOBJ) of (fetch (TEXTWINDOW
WTEXTSTREAM) of PANE)))))
(PUTPROPS PANEBOTTOMLINE MACRO ((PANE) (GETLD (PANESUFFIX PANE) PREVLINE)))
(PUTPROPS \TEDIT.PREFIX.LCHARLIM MACRO ((PANE CHNO) (FSETLD (PANEPREFIX PANE) LCHARLAST CHNO)))
(PUTPROPS PANETOP MACRO ((PANE PREG) (fetch (REGION TOP) of (OR PREG (DSPCLIPPINGREGION NIL PANE)))))
(PUTPROPS PANEWIDTH MACRO ((PANE PREG) (fetch (REGION WIDTH) of (OR PREG (DSPCLIPPINGREGION NIL PANE))
)))
(PUTPROPS PANELEFT MACRO ((PANE PREG) (fetch (REGION LEFT) of (OR PREG (DSPCLIPPINGREGION NIL PANE))))
)
(PUTPROPS PANEBOTTOM MACRO ((PANE PREG) (fetch (REGION BOTTOM) of (OR PREG (DSPCLIPPINGREGION NIL PANE
)))))
(PUTPROPS PANEHEIGHT MACRO ((PANE PREG) (fetch (REGION HEIGHT) of (OR PREG (DSPCLIPPINGREGION NIL PANE
)))))
(PUTPROPS PANEREGION MACRO ((PANE PREG) (OR PREG (DSPCLIPPINGREGION NIL PANE))))
(I.S.OPR (QUOTE inpanes) NIL (QUOTE (bind $$BODY _ BODY declare (LOCALVARS $$BODY) first (SETQ I.V. (
OR (CL:IF (TYPENAMEP $$BODY (QUOTE TEXTOBJ)) (FGETTOBJ $$BODY PRIMARYPANE) $$BODY) (GO $$OUT))) by (OR
(GETPANEPROP (PANEPROPS I.V.) NEXTPANE) (GO $$OUT)))))
(I.S.OPR (QUOTE backpanes) NIL (QUOTE (first (SETQ I.V. (OR (find P inpanes BODY suchthat (NULL (
GETPANEPROP (PANEPROPS P) NEXTPANE))) (GO $$OUT))) by (OR (GETPANEPROP (PANEPROPS I.V.) PREVPANE) (GO
$$OUT)))))
(PUTPROPS ALLBUTTONSUP MACRO (NIL (ZEROP (LOGAND 7 LASTMOUSEBUTTONS))))
(PUTPROP (QUOTE TEDIT-WINDOW) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:00:10"))
(PUTPROP (QUOTE TEDIT-BUTTONS) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 09:24:22"))
(RPAQQ PTSPERPICA 12)
(RPAQQ PTSPERINCH 72)
(RPAQQ PICASPERINCH 6)
(RPAQQ MICASPERINCH 2540)
(RPAQ PTSPERCM (FQUOTIENT PTSPERINCH 2.54))
(RPAQ PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH))
(RPAQ MICASPERPOINT (FQUOTIENT MICASPERINCH PTSPERINCH))
(CONSTANTS (PTSPERPICA 12) (PTSPERINCH 72) (PICASPERINCH 6) (MICASPERINCH 2540) (PTSPERCM (FQUOTIENT
PTSPERINCH 2.54)) (PTSPERMICA (FQUOTIENT PTSPERINCH MICASPERINCH)) (MICASPERPOINT (FQUOTIENT
MICASPERINCH PTSPERINCH)))
(PUTPROP (QUOTE TEDIT-MENU) (QUOTE IMPORTDATE) (IDATE " 7-Dec-2024 21:21:48"))
(PUTPROP (QUOTE TEDIT-FIND) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 15:49:12"))
(PUTPROP (QUOTE TEDIT-FNKEYS) (QUOTE IMPORTDATE) (IDATE "26-Nov-2024 23:53:32"))
(PUTPROP (QUOTE TEDIT-HCPY) (QUOTE IMPORTDATE) (IDATE "13-Dec-2024 23:51:23"))
(DATATYPE TEDITHISTORYEVENT ((* ;; "Describes one event on the TEdit edit history list.") THACTION (*
; "A keyword specifying what the event was") THPOINT (* ; "Was the selection to the left or right?")
THLEN (* ; "The # of chars involved") THCH# (* ; "The starting ch#") THFIRSTPIECE (* ;
"First piece involved") THOLDINFO (* ; "Old info, for undo") NIL (* ;
"Was THAUXINFO: Auxiliary info about the event, primarily for redo") THDELETEDPIECES) (ACCESSFNS
TEDITHISTORYEVENT ((THCHLIM (AND (fetch (TEDITHISTORYEVENT THCH#) of DATUM) (IPLUS (fetch (
TEDITHISTORYEVENT THCH#) of DATUM) (fetch (TEDITHISTORYEVENT THLEN) of DATUM)))))) (INIT (DEFPRINT (
QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
TEDITHISTORYEVENT ((THCHLIM (IPLUS (OR (fetch (TEDITHISTORYEVENT THCH#) of DATUM) 0) (OR (fetch (
TEDITHISTORYEVENT THLEN) of DATUM) 0))))) (INIT (DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION
\TEDIT.HISTORYEVENT.DEFPRINT))) THPOINT _ (QUOTE LEFT))
(DEFPRINT (QUOTE TEDITHISTORYEVENT) (FUNCTION \TEDIT.HISTORYEVENT.DEFPRINT))
(PUTPROPS \TEDIT.LASTEVENT MACRO ((TOBJ) (CAR (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
(PUTPROPS \TEDIT.POPEVENT MACRO ((TOBJ) (pop (fetch (TEXTOBJ TXTHISTORY) of TOBJ))))
(PUTPROPS GETTH MACRO ((EVENT FIELD) (fetch (TEDITHISTORYEVENT FIELD) of EVENT)))
(PUTPROPS SETTH MACRO ((EVENT FIELD NEWVALUE) (replace (TEDITHISTORYEVENT FIELD) of EVENT with
NEWVALUE)))
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE "20-Mar-2024 11:05:20"))
(PUTPROP (QUOTE TEDIT-HISTORY) (QUOTE IMPORTDATE) (IDATE " 8-Dec-2024 19:41:55"))
(RECORD PAGEFORMATTINGSTATE ((* ;; "Contains the state for a TEdit page-formatting job.") PAGE# (* ;
"The current page number. Counted from 1") FIRSTPAGE (* ;;
"T if the current page is the 'first page' . Is set initially, and can be set again by the user at will. Gets reset after each page image is printed."
@@ -601,9 +678,9 @@ REGIONPARENT FULLXPOINTER) (* ; "The parent node for this box, for sub-boxes") R
(PUTPROPS GETPFS MACRO ((FS FIELD) (fetch (PAGEFORMATTINGSTATE FIELD) of FS)))
(PUTPROPS SETPFS MACRO ((FS FIELD NEWVALUE) (replace (PAGEFORMATTINGSTATE FIELD) of FS with NEWVALUE))
)
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:15:40"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "17-Mar-2024 18:27:18"))
(PUTPROP (QUOTE TEDIT-PAGE) (QUOTE IMPORTDATE) (IDATE "11-Dec-2024 22:39:52"))
(PUTPROP (QUOTE TEDIT-ABBREV) (QUOTE IMPORTDATE) (IDATE "31-Oct-2024 17:53:21"))
(PUTPROP (QUOTE TEDIT-TFBRAVO) (QUOTE IMPORTDATE) (IDATE "21-Oct-2024 00:33:50"))
(DECLARE%: DONTCOPY
(FILEMAP (NIL)))
STOP

395
lispusers/DOC-OBJECTS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Mar-2024 23:42:37" {WMEDLEY}<lispusers>DOC-OBJECTS.;36 52788
(FILECREATED " 9-Dec-2024 21:07:13" {WMEDLEY}<lispusers>DOC-OBJECTS.;58 52672
:EDIT-BY rmk
:CHANGES-TO (FNS DOCOBJ-INCLUDE-EDIT-WINDOWP)
:CHANGES-TO (FNS DOCOBJ-STRING-IMAGEBOX)
:PREVIOUS-DATE "19-Mar-2024 19:36:25" {WMEDLEY}<lispusers>DOC-OBJECTS.;35)
:PREVIOUS-DATE " 8-Dec-2024 15:49:01" {WMEDLEY}<lispusers>DOC-OBJECTS.;57)
(PRETTYCOMPRINT DOC-OBJECTSCOMS)
@@ -17,7 +17,7 @@
(* ;;; "This TEdit subsystem implements an extensible facility originally intended to provide bibliography and citation capabilities. The TEdit function GET.OBJ.FROM.USER, the one triggered by typing ^O, calls the function PROMPTFOREVALED which is redefined by this subsystem to be equivalent to the function DocObj-Acquire-Object. This function inserts IMAGEOBJects into the current TEdit, and is driven by the variables DocObjectsMenu and DocObjectsMenuCommands (analogous to BackgroundMenu and BackgroundMenuCommands). Each menu entry contains a form that, when EVAL'd, creates and returns a particular kind of IMAGEOBJ. Note that this form is EVAL'd under the function DocObj-Acquire-Object, which runs under the function GET.OBJ.FROM.USER, which gets TEXTSTREAM and TEXTOBJ as arguments. They can be (and are) used freely to record state or other desired info. The image objects supplied by this subsystem are 'Eval`d Form' (i.e., the original behavior of ^O), 'Screen Snap' (equivalent to right-buttoning in the background while holding the SHIFT key down), etc.")
(FILES (SYSLOAD)
TEDIT TEDIT IMAGEOBJ)
TEDIT IMAGEOBJ)
(DECLARE%: EVAL@COMPILE DONTCOPY (FILES TEDIT-EXPORTS.ALL))
(VARS (DocObjectsMenu NIL)
(DocObjectsConfirmEditMenu NIL))
@@ -28,7 +28,7 @@
(FNS DOCOBJ-ACQUIRE-OBJECT DOCOBJ-INIT DOCOBJ-TEDIT-MENU-ENTRY DOCOBJ-GET-LOOKS
DOCOBJ-REGISTER-OBJECT DOCOBJ-STRING-IMAGEBOX DOCOBJ-WAIT-MOUSE
DOCOBJ-INVOKE-IMAGEOBJFN DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
DOCOBJ-BEFOREHARDCOPYFN DOCOBJ-AFTERHARDCOPYFN))
[COMS
(* ;; "Eval'd Form")
@@ -108,7 +108,7 @@
(FILESLOAD (SYSLOAD)
TEDIT TEDIT IMAGEOBJ)
TEDIT IMAGEOBJ)
(DECLARE%: EVAL@COMPILE DONTCOPY
(FILESLOAD TEDIT-EXPORTS.ALL)
@@ -167,44 +167,37 @@
(GET.OBJ.FROM.USER TEXTSTREAM (TEXTOBJ TEXTSTREAM])
(DOCOBJ-GET-LOOKS
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 19-Mar-2024 19:36 by rmk")
[LAMBDA (TEXTOBJ CH#ORCHARLOOKS) (* ; "Edited 5-Apr-2024 12:20 by rmk")
(* ; "Edited 19-Mar-2024 19:36 by rmk")
(* ; "Edited 29-Oct-2022 21:30 by rmk")
(* Koomen " 4-Feb-87 23:37")
(* ;;; "Adapted from {ERIS}<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) (* ;
(LET ((TEXTOBJ (TEXTOBJ TEXTOBJ)))
(if (type? CHARLOOKS CH#ORCHARLOOKS)
then (* ;
 "He handed us a CHARLOOKS. Unparse it for him.")
(SETQ LOOKS CH#ORCHARLOOKS))
((ZEROP (FGETTOBJ TEXTOBJ TEXTLEN)) (* ;
CH#ORCHARLOOKS
elseif (ZEROP (FGETTOBJ TEXTOBJ TEXTLEN))
then (* ;
 "There's no text in the document. Use the extant caret looks.")
(SETQ LOOKS (FGETTOBJ TEXTOBJ CARETLOOKS)))
[(FIXP CH#ORCHARLOOKS) (* ;
(FGETTOBJ TEXTOBJ CARETLOOKS)
else (PLOOKS (\TEDIT.CHTOPC (if (FIXP CH#ORCHARLOOKS)
then (* ;
 "He gave us a CH# to get the looks of. Grab it.")
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
CH#ORCHARLOOKS)
TEXTOBJ]
[(type? SELECTION CH#ORCHARLOOKS) (* ;
CH#ORCHARLOOKS
elseif (type? SELECTION CH#ORCHARLOOKS)
then (* ;
 "Get the looks of the selected text")
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
(GETSEL CH#ORCHARLOOKS CH#))
TEXTOBJ]
((NULL CH#ORCHARLOOKS) (* ;
(GETSEL CH#ORCHARLOOKS CH#)
elseif (NULL CH#ORCHARLOOKS)
then (* ;
 "Get the looks of the selected text")
(SETQ LOOKS (PLOOKS (\TEDIT.CHTOPC (IMIN (FGETTOBJ TEXTOBJ TEXTLEN)
(GETSEL (FGETTOBJ TEXTOBJ SEL)
CH#))
TEXTOBJ]
(RETURN LOOKS)
(* ;;; "Now break the looks apart into a PROPLIST")
(SETQ NLOOKS (\TEDIT.UNPARSE.CHARLOOKS.LIST LOOKS))
(RETURN NLOOKS])
(GETSEL (FGETTOBJ TEXTOBJ SEL)
CH#))
TEXTOBJ])
(DOCOBJ-REGISTER-OBJECT
[LAMBDA (OBJECT) (* ; "Edited 23-Oct-87 14:48 by Koomen")
@@ -218,8 +211,9 @@
OBJECT])
(DOCOBJ-STRING-IMAGEBOX
[LAMBDA (STRING IMAGESTREAM) (* Koomen " 9-Feb-87 17:22")
(DECLARE (SPECVARS CHNO TEXTOBJ))
[LAMBDA (STRING IMAGESTREAM) (* ; "Edited 9-Dec-2024 21:04 by rmk")
(* Koomen " 9-Feb-87 17:22")
(DECLARE (USEDFREE CHNO TEXTOBJ))
(PROG (LOOKS CLOFFSET FONT DEVICE HEIGHT DESCENT)
(SETQ LOOKS (DOCOBJ-GET-LOOKS TEXTOBJ CHNO))
(SETQ CLOFFSET (fetch (CHARLOOKS CLOFFSET) of LOOKS))
@@ -230,10 +224,10 @@
(SETQ HEIGHT (FONTHEIGHT FONT))
(SETQ DESCENT (FONTPROP FONT 'DESCENT))
(RETURN (create IMAGEBOX
XSIZE _ (STRINGWIDTH STRING FONT)
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
XKERN _ 0])
XSIZE _ (STRINGWIDTH STRING FONT)
YSIZE _ (IPLUS HEIGHT (IABS CLOFFSET))
YDESC _ (IDIFFERENCE DESCENT CLOFFSET)
XKERN _ 0])
(DOCOBJ-WAIT-MOUSE
[LAMBDA (STREAM) (* ;
@@ -245,108 +239,104 @@
(LASTMOUSEY STREAM)))
then (RETURN NIL)) finally (RETURN T])
(DOCOBJ-INVOKE-IMAGEOBJFN
[LAMBDA (CH# PIECE IMAGEOBJFNNAME) (* ; "Edited 28-Jun-2023 19:45 by rmk")
(* ; "Edited 9-Sep-2022 16:10 by rmk")
(* ; "Edited 7-Sep-2022 23:11 by rmk")
(* ; "Edited 6-Sep-2022 10:05 by rmk")
(* ; "Edited 15-Oct-87 23:35 by Koomen")
(* ;; "If PIECE is an IMAGEOBJ, invoke the function associated with the ImageObj property IMAGEOBJFNNAME on the IMAGEOBJ and the character position where the IMAGEOBJ is located. ")
(CL:WHEN (AND (type? PIECE PIECE)
(EQ OBJECT.PTYPE (PTYPE PIECE)))
(LET ((IMAGEOBJ (PCONTENTS PIECE))
IMAGEOBJFN)
(SETQ IMAGEOBJFN (IMAGEOBJPROP IMAGEOBJ IMAGEOBJFNNAME))
(CL:WHEN (AND IMAGEOBJFN (DEFINEDP IMAGEOBJFN))
(APPLY* IMAGEOBJFN IMAGEOBJ CH# PIECE))))])
(DOCOBJ-BEFOREHARDCOPYFN
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 16-Mar-2024 10:05 by rmk")
[LAMBDA (TEXTSTREAM) (* ; "Edited 8-Dec-2024 15:48 by rmk")
(* ; "Edited 12-Jul-2024 12:46 by rmk")
(* ; "Edited 7-Jul-2024 00:09 by rmk")
(* ; "Edited 8-May-2024 00:05 by rmk")
(* ; "Edited 6-May-2024 22:50 by rmk")
(* ; "Edited 5-Apr-2024 08:03 by rmk")
(* ; "Edited 16-Mar-2024 10:05 by rmk")
(* ; "Edited 16-Jul-2023 16:53 by rmk")
(* ; "Edited 10-Jul-2023 22:29 by rmk")
(* ;
 "Edited 25-May-93 13:07 by sybalsky:mv:envos")
(* ;; "This is the only BEFOREHARDCOPYFN, provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and the piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
(* ;; "This is the only BEFOREHARDCOPYFN provided by DOC-OBJECTS. If the text doesn't contain any such objects, the property is NIL and te piece-scan doesn't happen. This is installed in the TEXTOBJ by the call to DOCOBJ-REGISTER-OBJECT from every DOCOBJ create function.")
(* ;; "This runs through the file applying the BEFOREHARDCOPYFN of every object that has one. For example, an include object will replace the object by its target file.")
(* ;; "This records all of the history events created during the object pass into a single composite even so that the DOCOBJ-AFTERHARDCOPYFN can restore the stream to its original state.")
(RESETLST
(* ;; "We don't want to update the display lines to show the intermediate state while we are updating the pieces. ")
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
(LET ((PREVEVENTS (GETTOBJ TEXTOBJ TXTHISTORY))
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
FAILED)
(TEDIT.DEFER.UPDATES TEXTSTREAM)
(LET* ((TEXTOBJ (TEXTOBJ TEXTSTREAM))
(OLDDIRTY (GETTOBJ TEXTOBJ \DIRTY))
(PREVSEL (\TEDIT.COPYSEL (TEXTSEL TEXTOBJ)))
FAILED EVENTS)
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
(* ;; "This is a little tricky because the imageobj function may screw around with the piece containining the object, delete it or replace it with something else. But presumably it links into the previous saved piece, and we continue from there.")
[bind OBJ FN PREVPC (CH# _ 1)
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
(SETQ OBJ (PCONTENTS PC))
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
(DEFINEDP FN))
then (SETQ PREVPC (PREVPIECE PC))
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
(SETQ FAILED T)
(RETURN))
(if PREVPC
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
then
(* ;;
[bind OBJ FN PREVPC (CH# _ 1)
(PC _ (\TEDIT.FIRSTPIECE TEXTOBJ)) while PC
do (SETQ PC (if (AND (EQ OBJECT.PTYPE (PTYPE PC))
(SETQ OBJ (PCONTENTS PC))
(SETQ FN (IMAGEOBJPROP OBJ 'BEFOREHARDCOPYFN))
(DEFINEDP FN))
then (SETQ PREVPC (PREVPIECE PC))
(CL:UNLESS (APPLY* FN TEXTOBJ OBJ PC CH#)
(SETQ FAILED T)
(RETURN))
(push EVENTS (\TEDIT.POPEVENT TEXTOBJ))
(* ; "Accumulate undo events")
(if PREVPC
then (NEXTPIECE (if (EQ PC (NEXTPIECE PREVPC))
then
(* ;;
 "Nothing affected this PC, advance")
(add CH# (PLEN PC))
PC
else
(* ;;
(add CH# (PLEN PC))
PC
else
(* ;;
 "Otherwise investigate its replacement")
PREVPC))
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
then (add CH# (PLEN PC))
(NEXTPIECE PC)
else
(* ;;
PREVPC))
elseif (EQ PC (\TEDIT.FIRSTPIECE TEXTOBJ))
then (add CH# (PLEN PC))
(NEXTPIECE PC)
else
(* ;;
 "Investigate the replacement of the previous first piece.")
(\TEDIT.FIRSTPIECE TEXTOBJ))
else (add CH# (PLEN PC))
(NEXTPIECE PC] (* ; "Restore previous settings")
(\TEDIT.FIRSTPIECE TEXTOBJ))
else (add CH# (PLEN PC))
(NEXTPIECE PC] (* ; "Restore previous settings")
(* ;
 "The history event may restore SEL, but...")
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
(SETTOBJ TEXTOBJ \DIRTY OLDDIRTY)
(* ;; "Make a single undoing event for the after fn")
(* ;; "Make a single event for the afterfn to undo")
(for ETAIL on (GETTOBJ TEXTOBJ TXTHISTORY) until (EQ ETAIL PREVEVENTS)
collect (CAR ETAIL) finally (SETTOBJ TEXTOBJ TXTHISTORY (CONS $$VAL PREVEVENTS)))
(* ;; "In case something screws up, at least redisplaying will show something correctly (even if we aren't \DIRTY)")
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
(CL:WHEN FAILED
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM TEXTOBJ) (* ; "UNDO whatever was saved")
(SETTOBJ TEXTOBJ SEL PREVSEL)
'DON'T)))])
(\TEDIT.HISTORYADD.COMPOSITE TEXTOBJ EVENTS)
(CL:WHEN FAILED
(DOCOBJ-AFTERHARDCOPYFN TEXTSTREAM) (* ; "UNDO whatever was saved")
(SETTOBJ TEXTOBJ SEL PREVSEL)
'DON'T)))])
(DOCOBJ-AFTERHARDCOPYFN
[LAMBDA (TEXTSTREAM TEXTOBJ) (* ; "Edited 15-Mar-2024 14:24 by rmk")
[LAMBDA (TSTREAM) (* ; "Edited 7-Jul-2024 00:07 by rmk")
(* ; "Edited 5-Jul-2024 22:59 by rmk")
(* ; "Edited 3-Jul-2024 09:55 by rmk")
(* ; "Edited 8-May-2024 10:42 by rmk")
(* ; "Edited 7-May-2024 08:20 by rmk")
(* ; "Edited 5-Apr-2024 08:05 by rmk")
(* ; "Edited 15-Mar-2024 14:24 by rmk")
(* ; "Edited 15-Jul-2023 15:57 by rmk")
(* ;
 "Edited 25-May-93 13:08 by sybalsky:mv:envos")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(RESETLST
(RESETSAVE (TEXTPROP TEXTOBJ 'DON'TUPDATE T)
`(TEXTPROP ,TEXTOBJ 'DON'TUPDATE OLDVALUE))
(LET ((PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
(TEDIT.UNDO TEXTOBJ)
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)
(\TEDIT.MARK.LINES.DIRTY TEXTOBJ 1 (TEXTLEN TEXTOBJ))
(\TEDIT.UPDATE.SCREEN TEXTOBJ)))])
[RESETSAVE (TEXTPROP TSTREAM 'DON'TUPDATE T)
`(PROGN (TEXTPROP ,TSTREAM 'DON'TUPDATE OLDVALUE)
(\TEDIT.FILL.PANES ,TSTREAM]
(LET* ((TEXTOBJ (TEXTOBJ TSTREAM))
(PREVUNDONE (GETTOBJ TEXTOBJ TXTHISTORYUNDONE)))
(TEDIT.UNDO TSTREAM T)
(SETTOBJ TEXTOBJ TXTHISTORYUNDONE PREVUNDONE)))])
)
@@ -750,11 +740,10 @@
IMAGEOBJ])
(DOCOBJ-INCLUDE-EDIT
[LAMBDA (INCLOBJ) (* ; "Edited 9-May-2018 11:09 by rmk:")
(* ; "Edited 9-May-2018 10:35 by rmk:")
(* ;
 "Edited 26-Oct-87 19:57 by Koomen")
(DECLARE (SPECVARS TEXTOBJ))
[LAMBDA (INCLOBJ TSTREAM) (* ; "Edited 12-May-2024 09:03 by rmk")
(* ; "Edited 9-May-2018 11:09 by rmk:")
(* ; "Edited 9-May-2018 10:35 by rmk:")
(* ; "Edited 26-Oct-87 19:57 by Koomen")
(SELECTQ [MENU (OR DOCOBJ-INCLUDE-EDITMENU (SETQ DOCOBJ-INCLUDE-EDITMENU
(create MENU
TITLE _ "Edit Include"
@@ -771,41 +760,38 @@
CENTERFLG _ T
MENUOFFSET _ '(-1 . 30)
CHANGEOFFSETFLG _ 'Y]
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TEXTOBJ "Enter new file name: " (fetch
(INCLOBJ FILENAME)
(NEW.FILE (LET [(NEWNAME (TEDIT.GETINPUT TSTREAM "Enter new file name: " (fetch (INCLOBJ
FILENAME)
of INCLOBJ]
(if [AND NEWNAME (SETQ NEWNAME (MKSTRING NEWNAME))
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
(NOT (EQUAL NEWNAME (fetch (INCLOBJ FILENAME) of INCLOBJ]
then (replace (INCLOBJ FILENAME) of INCLOBJ with NEWNAME)
T)))
T)))
(EDIT.FILE (for W in (OPENWINDOWS)
bind [FULLNAME _ (OR [FINDFILE (fetch (INCLOBJ FILENAME) of INCLOBJ
)
T
(CONS (PACKFILENAME.STRING 'HOST
(FILENAMEFIELD (FETCH TXTFILE
OF TEXTOBJ)
'HOST)
'DIRECTORY
(FILENAMEFIELD (FETCH TXTFILE
OF TEXTOBJ)
'DIRECTORY]
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
bind [FULLNAME _ (OR (FINDFILE-WITH-EXTENSIONS
(fetch (INCLOBJ FILENAME) of INCLOBJ)
(CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
TXTFILE
'HOST)
'DIRECTORY
(FILENAMEFIELD TXTFILE 'DIRECTORY))
DIRECTORIES)
*TEDIT-EXTENSIONS*)
(INFILEP (fetch (INCLOBJ FILENAME) of INCLOBJ]
first (if (NULL FULLNAME)
then (TEDIT.PROMPTPRINT TEXTOBJ "Can't find " T)
(TEDIT.PROMPTPRINT TEXTOBJ (fetch (INCLOBJ FILENAME)
of INCLOBJ))
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP
FULLNAME W))
then (TEDIT.PROMPTPRINT TSTREAM "Can't find " T)
(TEDIT.PROMPTPRINT TSTREAM (fetch (INCLOBJ FILENAME)
of INCLOBJ))
(RETURN)) when (SETQ W (DOCOBJ-INCLUDE-EDIT-WINDOWP FULLNAME W))
do (TOTOPW W)
(GIVE.TTY.PROCESS W)
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
(GIVE.TTY.PROCESS W)
(RETURN) finally (TEDIT (MKATOM FULLNAME))))
(ENABLE (if (NOT (fetch (INCLOBJ ENABLEDP) of INCLOBJ))
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with T)
T))
T))
(DISABLE (if (fetch (INCLOBJ ENABLEDP) of INCLOBJ)
then (replace (INCLOBJ ENABLEDP) of INCLOBJ with NIL)
T))
T))
NIL])
(DOCOBJ-INCLUDE-EDIT-WINDOWP
@@ -842,56 +828,51 @@
(DEFINEQ
(DOCOBJ-INCLUDE-BEFOREHARDCOPYFN
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 16-Feb-2024 23:47 by rmk")
[LAMBDA (TEXTOBJ OBJ PC CH#) (* ; "Edited 13-Sep-2024 15:13 by rmk")
(* ; "Edited 12-May-2024 08:48 by rmk")
(* ; "Edited 7-May-2024 23:33 by rmk")
(* ; "Edited 16-Feb-2024 23:47 by rmk")
(* ; "Edited 23-Jul-2023 22:45 by rmk")
(* ; "Edited 16-Jul-2023 11:14 by rmk")
(* ; "Edited 10-Jul-2023 22:18 by rmk")
(* ; "Edited 22-Jun-2023 16:44 by rmk")
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the lookos of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.'")
(* ;; "This replaces the PC, the piece with an included-file object, with the contents of that file. The undo event will restore the object. Since the piece with the object is deleted, its paragraph looks are ignored and only the looks of the inserted file are interpreted. E.g., to get a page break before the included file, either the first piece of that file must be a page break, or a blank NEWPAGEBEFORE paragraph must come before the OBJ.")
(* ;; "Returns T if the inclusion is succeeds as intended, NIL otherwise.")
(* ;; "Not sure why the INCLUDEDP property. If enabled, it's included.")
(if (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
then (LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE))
INCLSTREAM)
[SETQ INCLFILE (FINDFILE INCLFILE T (AND TXTFILE (CONS (PACKFILENAME.STRING
'HOST
(FILENAMEFIELD TXTFILE
'HOST)
'DIRECTORY
(FILENAMEFIELD TXTFILE
'DIRECTORY))
DIRECTORIES]
(if INCLFILE
then
(* ;; "No point in prompting: it just flashes by")
(CL:WHEN (fetch (INCLOBJ ENABLEDP) of (IMAGEOBJPROP OBJ 'OBJECTDATUM))
(LET ([INCLFILE (fetch (INCLOBJ FILENAME) of (IMAGEOBJPROP OBJ 'OBJECTDATUM]
(TXTFILE (GETTOBJ TEXTOBJ TXTFILE)))
(SETQ INCLFILE (FINDFILE-WITH-EXTENSIONS INCLFILE
(AND TXTFILE (CONS (PACKFILENAME.STRING 'HOST (FILENAMEFIELD
TXTFILE
'HOST)
'DIRECTORY
(FILENAMEFIELD TXTFILE 'DIRECTORY))
DIRECTORIES))
*TEDIT-EXTENSIONS*))
(if INCLFILE
then (* ; "Don't update/show until end")
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
CH# 1 'LEFT) (* ; "Deletes this include-object")
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ))
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included " INCLFILE))
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE "...")
T))
(\TEDIT.UPDATE.SEL (TEXTSEL TEXTOBJ)
CH# 1 'LEFT T) (* ; "Set the destination")
(\TEDIT.DELETE TEXTOBJ (TEXTSEL TEXTOBJ)
T)
(TEDIT.INCLUDE TEXTOBJ INCLFILE NIL NIL DOCOBJ-INCLUDE-SAFE)
(AND NIL (TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Including " INCLFILE
"...done")))
else
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
(* ;; "Succeeded as intended")
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME
)
of OBJ)
" not found")
T T)
NIL))
else
(* ;; "Succeeded as intended")
T
else
(* ;; "Did not succeed as intended. Caller should restore the stream, maybe selecting and highlighting the bad inclusion.")
T])
(TEDIT.PROMPTPRINT TEXTOBJ (CONCAT "Included file " (fetch (INCLOBJ FILENAME)
of OBJ)
" not found")
T T)
NIL)))])
(DOCOBJ-INCLUDE-CLEANUPFN
[LAMBDA (TEXTSTREAM STARTPOS LEN) (* ; "Edited 15-Mar-2024 14:08 by rmk")
@@ -919,12 +900,13 @@
(DOCOBJ-INCLUDE-BUTTONEVENTINFN
[LAMBDA (IMAGEOBJ WINDOWSTREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
(* ; "Edited 12-May-2024 09:01 by rmk")
(* ; "Edited 23-Oct-87 00:46 by Koomen")
(if (AND (EQ BUTTON 'MIDDLE)
(DOCOBJ-WAIT-MOUSE WINDOWSTREAM))
then (ALLOW.BUTTON.EVENTS)
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
(if (DOCOBJ-INCLUDE-EDIT (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
HOSTSTREAM)
then (DOCOBJ-INCLUDE-RESET-OBJ IMAGEOBJ)
'CHANGED])
@@ -1011,30 +993,29 @@
(PUTPROPS DOC-OBJECTS MAKEFILE-ENVIRONMENT (:READTABLE "INTERLISP" :PACKAGE "INTERLISP" :BASE 10))
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (7682 21029 (DOCOBJ-ACQUIRE-OBJECT 7692 . 8693) (DOCOBJ-INIT 8695 . 9323) (
DOCOBJ-TEDIT-MENU-ENTRY 9325 . 9747) (DOCOBJ-GET-LOOKS 9749 . 12364) (DOCOBJ-REGISTER-OBJECT 12366 .
13020) (DOCOBJ-STRING-IMAGEBOX 13022 . 13970) (DOCOBJ-WAIT-MOUSE 13972 . 14432) (
DOCOBJ-INVOKE-IMAGEOBJFN 14434 . 15557) (DOCOBJ-BEFOREHARDCOPYFN 15559 . 20205) (
DOCOBJ-AFTERHARDCOPYFN 20207 . 21027)) (21059 21326 (DOCOBJ-ACQUIRE-EVALED-OBJECT 21069 . 21324)) (
21526 21668 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21536 . 21666)) (22007 26803 (DOCOBJ-EDIT-TIMESTAMP 22017
. 22546) (DOCOBJ-MAKE-TIMESTAMP 22548 . 22959) (DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 22961 . 24031) (
DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24033 . 24564) (DOCOBJ-TIMESTAMP-COPYFN 24566 . 24891) (
DOCOBJ-TIMESTAMP-DISPLAYFN 24893 . 25186) (DOCOBJ-TIMESTAMP-GETFN 25188 . 25428) (
DOCOBJ-TIMESTAMP-IMAGEBOXFN 25430 . 25786) (DOCOBJ-TIMESTAMP-PREPRINTFN 25788 . 26019) (
DOCOBJ-TIMESTAMP-PUTFN 26021 . 26390) (DOCOBJ-TIMESTAMP-TO-STRING 26392 . 26801)) (27097 31404 (
DOCOBJ-MAKE-FILESTAMP 27107 . 27448) (DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27450 . 28492) (
DOCOBJ-FILESTAMP-COPYFN 28494 . 28809) (DOCOBJ-FILESTAMP-DISPLAYFN 28811 . 29099) (
DOCOBJ-FILESTAMP-GETFN 29101 . 29454) (DOCOBJ-FILESTAMP-IMAGEBOXFN 29456 . 29794) (
DOCOBJ-FILESTAMP-GET-FULLNAME 29796 . 30414) (DOCOBJ-FILESTAMP-NEW-FULLNAME 30416 . 30889) (
DOCOBJ-FILESTAMP-PREPRINTFN 30891 . 31100) (DOCOBJ-FILESTAMP-PUTFN 31102 . 31402)) (31727 34224 (
DOCOBJ-MAKE-HRULE 31737 . 32151) (DOCOBJ-EDIT-HRULE 32153 . 32625) (DOCOBJ-HRULE-INIT 32627 . 32959) (
DOCOBJ-HRULE-GET-WIDTH 32961 . 33772) (DOCOBJ-HRULE-BUTTONEVENTINFN 33774 . 34222)) (34643 43315 (
DOCOBJ-MAKE-INCLUDE 34653 . 35054) (DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35056 . 36061) (
DOCOBJ-INCLUDE-CREATE-OBJ 36063 . 36831) (DOCOBJ-INCLUDE-EDIT 36833 . 41432) (
DOCOBJ-INCLUDE-EDIT-WINDOWP 41434 . 42290) (DOCOBJ-INCLUDE-RESET-OBJ 42292 . 43313)) (43316 52247 (
DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43326 . 47048) (DOCOBJ-INCLUDE-CLEANUPFN 47050 . 48569) (
DOCOBJ-INCLUDE-BUTTONEVENTINFN 48571 . 49105) (DOCOBJ-INCLUDE-COPYFN 49107 . 49325) (
DOCOBJ-INCLUDE-DISPLAYFN 49327 . 50079) (DOCOBJ-INCLUDE-GETFN 50081 . 50804) (
DOCOBJ-INCLUDE-IMAGEBOXFN 50806 . 51815) (DOCOBJ-INCLUDE-PREPRINTFN 51817 . 52036) (
DOCOBJ-INCLUDE-PUTFN 52038 . 52245)))))
(FILEMAP (NIL (7640 21328 (DOCOBJ-ACQUIRE-OBJECT 7650 . 8651) (DOCOBJ-INIT 8653 . 9281) (
DOCOBJ-TEDIT-MENU-ENTRY 9283 . 9705) (DOCOBJ-GET-LOOKS 9707 . 12167) (DOCOBJ-REGISTER-OBJECT 12169 .
12823) (DOCOBJ-STRING-IMAGEBOX 12825 . 13881) (DOCOBJ-WAIT-MOUSE 13883 . 14343) (
DOCOBJ-BEFOREHARDCOPYFN 14345 . 19815) (DOCOBJ-AFTERHARDCOPYFN 19817 . 21326)) (21358 21625 (
DOCOBJ-ACQUIRE-EVALED-OBJECT 21368 . 21623)) (21825 21967 (DOCOBJ-ACQUIRE-SNAPPED-OBJECT 21835 . 21965
)) (22306 27102 (DOCOBJ-EDIT-TIMESTAMP 22316 . 22845) (DOCOBJ-MAKE-TIMESTAMP 22847 . 23258) (
DOCOBJ-MAKE-TIMESTAMP-IMAGEFNS 23260 . 24330) (DOCOBJ-TIMESTAMP-BUTTONEVENTINFN 24332 . 24863) (
DOCOBJ-TIMESTAMP-COPYFN 24865 . 25190) (DOCOBJ-TIMESTAMP-DISPLAYFN 25192 . 25485) (
DOCOBJ-TIMESTAMP-GETFN 25487 . 25727) (DOCOBJ-TIMESTAMP-IMAGEBOXFN 25729 . 26085) (
DOCOBJ-TIMESTAMP-PREPRINTFN 26087 . 26318) (DOCOBJ-TIMESTAMP-PUTFN 26320 . 26689) (
DOCOBJ-TIMESTAMP-TO-STRING 26691 . 27100)) (27396 31703 (DOCOBJ-MAKE-FILESTAMP 27406 . 27747) (
DOCOBJ-MAKE-FILESTAMP-IMAGEFNS 27749 . 28791) (DOCOBJ-FILESTAMP-COPYFN 28793 . 29108) (
DOCOBJ-FILESTAMP-DISPLAYFN 29110 . 29398) (DOCOBJ-FILESTAMP-GETFN 29400 . 29753) (
DOCOBJ-FILESTAMP-IMAGEBOXFN 29755 . 30093) (DOCOBJ-FILESTAMP-GET-FULLNAME 30095 . 30713) (
DOCOBJ-FILESTAMP-NEW-FULLNAME 30715 . 31188) (DOCOBJ-FILESTAMP-PREPRINTFN 31190 . 31399) (
DOCOBJ-FILESTAMP-PUTFN 31401 . 31701)) (32026 34523 (DOCOBJ-MAKE-HRULE 32036 . 32450) (
DOCOBJ-EDIT-HRULE 32452 . 32924) (DOCOBJ-HRULE-INIT 32926 . 33258) (DOCOBJ-HRULE-GET-WIDTH 33260 .
34071) (DOCOBJ-HRULE-BUTTONEVENTINFN 34073 . 34521)) (34942 43284 (DOCOBJ-MAKE-INCLUDE 34952 . 35353)
(DOCOBJ-MAKE-INCLUDE-IMAGEFNS 35355 . 36360) (DOCOBJ-INCLUDE-CREATE-OBJ 36362 . 37130) (
DOCOBJ-INCLUDE-EDIT 37132 . 41401) (DOCOBJ-INCLUDE-EDIT-WINDOWP 41403 . 42259) (
DOCOBJ-INCLUDE-RESET-OBJ 42261 . 43282)) (43285 52131 (DOCOBJ-INCLUDE-BEFOREHARDCOPYFN 43295 . 46789)
(DOCOBJ-INCLUDE-CLEANUPFN 46791 . 48310) (DOCOBJ-INCLUDE-BUTTONEVENTINFN 48312 . 48989) (
DOCOBJ-INCLUDE-COPYFN 48991 . 49209) (DOCOBJ-INCLUDE-DISPLAYFN 49211 . 49963) (DOCOBJ-INCLUDE-GETFN
49965 . 50688) (DOCOBJ-INCLUDE-IMAGEBOXFN 50690 . 51699) (DOCOBJ-INCLUDE-PREPRINTFN 51701 . 51920) (
DOCOBJ-INCLUDE-PUTFN 51922 . 52129)))))
STOP

BIN
lispusers/DOC-OBJECTS.LCOM
View File

Binary file not shown.

119
lispusers/EQUATIONS
View File

@@ -1,24 +1,22 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(FILECREATED " 3-Mar-88 13:51:10" {ERINYES}<LISPUSERS>LYRIC>EQUATIONS.;1 86057
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
changes to%: (FNS EQIO.Put EQIO.Get)
(FILECREATED "28-Jun-2024 22:11:21" {WMEDLEY}<lispusers>EQUATIONS.;2 85831
previous date%: "27-May-87 11:20:49" |{IE:PARC:XEROX}<LISP>LYRIC>LISPUSERS>EQUATIONS.;1|)
:EDIT-BY rmk
:CHANGES-TO (FNS EQN.WindowFromText)
:PREVIOUS-DATE " 3-Mar-88 13:51:10" {WMEDLEY}<lispusers>EQUATIONS.;1)
(* "
Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT EQUATIONSCOMS)
(RPAQQ EQUATIONSCOMS
(RPAQQ EQUATIONSCOMS
(
(* ;;; "EQUATION module: Part 1 of 3")
(* ; "functions for image object")
(FNS EQIO.CreateFns EQIO.Create EQIO.Imagebox EQIO.Display EQIO.ButtonEventIn EQIO.Copy
EQIO.CopyList EQIO.Get EQIO.Put EQIO.WhenDeleted EQIO.SelectRegion EQIO.Selection
EQIO.DefaultSelectFn EQIO.MakeSelectionMenu)
@@ -32,7 +30,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ;;; "functions to handle equation specification info")
(FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined
(FNS EQIO.AddType EQIO.GetInfo EQIO.SetInfo EQIO.TypeProp EQIO.ResetTypeProps EQIO.IsDefined
EQIO.GetBox EQIO.GetDataSpec EQIO.GetDataSpecList EQIO.GetDataPosition
EQIO.GetDataSelectRegion EQIO.MakeSpec EQIO.MakeDataSpec)
@@ -46,7 +44,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
[P (TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
(P (* ;
 "needed to force the getfn to be recognized before any new eqns defined")
(SETQ EquationImageFns (EQIO.CreateFns)))
(VARS UnknownEquationData)
(PROP ARGNAMES EQIO.TypeProp EQIO.NumPieces EQIO.AllProps EQIO.EqnProperty)
@@ -61,7 +58,6 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ;;; "EQUATIONEDIT module: Part 2 of 3")
(* ; "functions to edit data pieces")
(FNS EQN.AbortEdit EQN.StopEdit EQN.ContinueEdit EQN.FinishEdit EQN.MakeEditWindow
EQN.SetUpEdit EQN.StartEdit EQN.StartNextEdit EQN.UpdateEdit EQN.DefaultData
EQN.TypeMenu)
@@ -69,7 +65,7 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ;;; "hooks to control behavior of equation subeditor")
(FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn
(FNS EQN.Equation EQN.NextPiece EQN.FinishEqn EQN.NoUpdateAbort EQN.PreventUpdate EQN.CharFn
EQN.TEditSpecialChar EQN.SnuggleWindows EQN.SnuggleMainWindow)
@@ -680,25 +676,27 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(RPAQ? EquationInfo NIL)
(RPAQ? EquationDefaultSelectFn 'EQIO.DefaultSelectFn)
[TEDIT.ADD.MENUITEM TEDIT.DEFAULT.MENU '(Equation 'EQN.Equation]
(* ;
 "needed to force the getfn to be recognized before any new eqns defined")
(SETQ EquationImageFns (EQIO.CreateFns))
(SETQ EquationImageFns (EQIO.CreateFns))
(RPAQQ UnknownEquationData (((Gacha 10)
"[unknown equation]")))
(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue})
(PUTPROPS EQIO.TypeProp ARGNAMES (NIL (type prop {newValue})
args))
(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue})
(PUTPROPS EQIO.NumPieces ARGNAMES (NIL (eqnObj {newValue})
args))
(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue})
(PUTPROPS EQIO.AllProps ARGNAMES (NIL (eqnObj {newValue})
args))
(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue})
(PUTPROPS EQIO.EqnProperty ARGNAMES (NIL (eqnObj prop {newValue})
args))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -1316,13 +1314,12 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(EQN.ResultWindow window])
(EQN.WindowFromText
[LAMBDA (textObjORStream) (* thh%: "28-Jun-85 14:32")
(* gets window corresponding to a text
 object or stream)
(* note%: \WINDOW field actually is a list whose only element is the window)
[LAMBDA (textObjORStream) (* ; "Edited 28-Jun-2024 22:11 by rmk")
(* thh%: "28-Jun-85 14:32")
(LET [(w (fetch \WINDOW of (TEXTOBJ textObjORStream]
(* ;; "gets window corresponding to a text object or stream")
(LET [(w (\TEDIT.PRIMARYPANE (TEXTOBJ textObjORStream]
(OR (WINDOWP w)
(WINDOWP (CAR w))
(ERROR "EQN.WindowFromText: unable to find window for textobj/stream = " textObjORStream
@@ -1477,22 +1474,22 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
) (TimesRoman 12) NIL))))
(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow})
(PUTPROPS EQN.ObjEditWindow ARGNAMES (NIL (eqnObj {newEditWindow})
args))
(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg})
(PUTPROPS EQN.ContinueFlg ARGNAMES (NIL (editWindow {continueFlg})
args))
(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber})
(PUTPROPS EQN.PieceNumber ARGNAMES (NIL (editWindow {pieceNumber})
args))
(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj})
(PUTPROPS EQN.ResultObj ARGNAMES (NIL (editWindow {resultObj})
args))
(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow})
(PUTPROPS EQN.ResultWindow ARGNAMES (NIL (editWindow {resultWindow})
args))
(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow})
(PUTPROPS EQN.EditWindow ARGNAMES (NIL (window {editWindow})
args))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
@@ -1797,37 +1794,37 @@ Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
(* ;;; "Now load EQUATIONFORMS")
(FILESLOAD EQUATIONFORMS)
(PUTPROPS EQUATIONS COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4524 19553 (EQIO.CreateFns 4534 . 5067) (EQIO.Create 5069 . 6335) (EQIO.Imagebox 6337
. 6749) (EQIO.Display 6751 . 8362) (EQIO.ButtonEventIn 8364 . 12205) (EQIO.Copy 12207 . 12588) (
EQIO.CopyList 12590 . 13161) (EQIO.Get 13163 . 13571) (EQIO.Put 13573 . 14128) (EQIO.WhenDeleted 14130
. 14624) (EQIO.SelectRegion 14626 . 15773) (EQIO.Selection 15775 . 17279) (EQIO.DefaultSelectFn 17281
. 18519) (EQIO.MakeSelectionMenu 18521 . 19551)) (19627 25629 (EQIO.EqnType 19637 . 19888) (
EQIO.EqnDataList 19890 . 20230) (EQIO.SetDataList 20232 . 20629) (EQIO.EqnData 20631 . 20810) (
EQIO.EqnProperty 20812 . 21740) (EQIO.AllProps 21742 . 22257) (EQIO.Specify 22259 . 22756) (
EQIO.GetInitialProps 22758 . 23890) (EQIO.NumPieces 23892 . 25135) (EQIO.NewStructure 25137 . 25627))
(25696 30158 (EQIO.AddType 25706 . 26219) (EQIO.GetInfo 26221 . 26571) (EQIO.SetInfo 26573 . 27214) (
EQIO.TypeProp 27216 . 28162) (EQIO.ResetTypeProps 28164 . 28486) (EQIO.IsDefined 28488 . 28773) (
EQIO.GetBox 28775 . 28995) (EQIO.GetDataSpec 28997 . 29330) (EQIO.GetDataSpecList 29332 . 29477) (
EQIO.GetDataPosition 29479 . 29619) (EQIO.GetDataSelectRegion 29621 . 29765) (EQIO.MakeSpec 29767 .
30003) (EQIO.MakeDataSpec 30005 . 30156)) (31711 48815 (EQN.AbortEdit 31721 . 32233) (EQN.StopEdit
32235 . 32682) (EQN.ContinueEdit 32684 . 36336) (EQN.FinishEdit 36338 . 37071) (EQN.MakeEditWindow
37073 . 38492) (EQN.SetUpEdit 38494 . 39671) (EQN.StartEdit 39673 . 42974) (EQN.StartNextEdit 42976 .
43493) (EQN.UpdateEdit 43495 . 44892) (EQN.DefaultData 44894 . 47579) (EQN.TypeMenu 47581 . 48813)) (
48882 56790 (EQN.Equation 48892 . 50151) (EQN.NextPiece 50153 . 50878) (EQN.FinishEqn 50880 . 51409) (
EQN.NoUpdateAbort 51411 . 51824) (EQN.PreventUpdate 51826 . 52261) (EQN.CharFn 52263 . 54348) (
EQN.TEditSpecialChar 54350 . 55069) (EQN.SnuggleWindows 55071 . 55662) (EQN.SnuggleMainWindow 55664 .
56788)) (56844 58583 (EQN.EquationFontNumber 56854 . 57613) (EQN.EquationFont 57615 . 57957) (
EQN.GetEqnFont 57959 . 58140) (EQN.MakeFS 58142 . 58581)) (58612 61753 (EQN.AdjustWindow 58622 . 60582
) (EQN.CheckWindowSize 60584 . 61751)) (61754 67638 (EQN.SubEditorP 61764 . 61997) (EQN.WindowFromText
61999 . 62656) (EQN.EditWindow 62658 . 63736) (EQN.ResultWindow 63738 . 64288) (EQN.ResultObj 64290
. 64758) (EQN.PieceNumber 64760 . 65309) (EQN.ContinueFlg 65311 . 65874) (EQN.ValidEditWindow 65876
. 66310) (EQN.ObjEditWindow 66312 . 67636)) (67639 68756 (EQN.Make 67649 . 68754)) (69964 85899 (
FS.Box 69974 . 72220) (FS.Copy 72222 . 72862) (FS.Display 72864 . 75850) (FS.Get 75852 . 76321) (
FS.Put 76323 . 76794) (FS.ItemFont 76796 . 77157) (FS.ItemValue 77159 . 77565) (FS.ItemShift 77567 .
77947) (FS.MakeItem 77949 . 78371) (FS.Extract 78373 . 82297) (FS.ExtractFont 82299 . 82902) (
FS.ExtractShift 82904 . 83467) (FS.Insert 83469 . 85458) (FS.AllowedChar 85460 . 85697) (
FS.RealStringP 85699 . 85897)))))
(FILEMAP (NIL (4439 19468 (EQIO.CreateFns 4449 . 4982) (EQIO.Create 4984 . 6250) (EQIO.Imagebox 6252
. 6664) (EQIO.Display 6666 . 8277) (EQIO.ButtonEventIn 8279 . 12120) (EQIO.Copy 12122 . 12503) (
EQIO.CopyList 12505 . 13076) (EQIO.Get 13078 . 13486) (EQIO.Put 13488 . 14043) (EQIO.WhenDeleted 14045
. 14539) (EQIO.SelectRegion 14541 . 15688) (EQIO.Selection 15690 . 17194) (EQIO.DefaultSelectFn 17196
. 18434) (EQIO.MakeSelectionMenu 18436 . 19466)) (19542 25544 (EQIO.EqnType 19552 . 19803) (
EQIO.EqnDataList 19805 . 20145) (EQIO.SetDataList 20147 . 20544) (EQIO.EqnData 20546 . 20725) (
EQIO.EqnProperty 20727 . 21655) (EQIO.AllProps 21657 . 22172) (EQIO.Specify 22174 . 22671) (
EQIO.GetInitialProps 22673 . 23805) (EQIO.NumPieces 23807 . 25050) (EQIO.NewStructure 25052 . 25542))
(25611 30073 (EQIO.AddType 25621 . 26134) (EQIO.GetInfo 26136 . 26486) (EQIO.SetInfo 26488 . 27129) (
EQIO.TypeProp 27131 . 28077) (EQIO.ResetTypeProps 28079 . 28401) (EQIO.IsDefined 28403 . 28688) (
EQIO.GetBox 28690 . 28910) (EQIO.GetDataSpec 28912 . 29245) (EQIO.GetDataSpecList 29247 . 29392) (
EQIO.GetDataPosition 29394 . 29534) (EQIO.GetDataSelectRegion 29536 . 29680) (EQIO.MakeSpec 29682 .
29918) (EQIO.MakeDataSpec 29920 . 30071)) (31648 48752 (EQN.AbortEdit 31658 . 32170) (EQN.StopEdit
32172 . 32619) (EQN.ContinueEdit 32621 . 36273) (EQN.FinishEdit 36275 . 37008) (EQN.MakeEditWindow
37010 . 38429) (EQN.SetUpEdit 38431 . 39608) (EQN.StartEdit 39610 . 42911) (EQN.StartNextEdit 42913 .
43430) (EQN.UpdateEdit 43432 . 44829) (EQN.DefaultData 44831 . 47516) (EQN.TypeMenu 47518 . 48750)) (
48819 56727 (EQN.Equation 48829 . 50088) (EQN.NextPiece 50090 . 50815) (EQN.FinishEqn 50817 . 51346) (
EQN.NoUpdateAbort 51348 . 51761) (EQN.PreventUpdate 51763 . 52198) (EQN.CharFn 52200 . 54285) (
EQN.TEditSpecialChar 54287 . 55006) (EQN.SnuggleWindows 55008 . 55599) (EQN.SnuggleMainWindow 55601 .
56725)) (56781 58520 (EQN.EquationFontNumber 56791 . 57550) (EQN.EquationFont 57552 . 57894) (
EQN.GetEqnFont 57896 . 58077) (EQN.MakeFS 58079 . 58518)) (58549 61690 (EQN.AdjustWindow 58559 . 60519
) (EQN.CheckWindowSize 60521 . 61688)) (61691 67455 (EQN.SubEditorP 61701 . 61934) (EQN.WindowFromText
61936 . 62473) (EQN.EditWindow 62475 . 63553) (EQN.ResultWindow 63555 . 64105) (EQN.ResultObj 64107
. 64575) (EQN.PieceNumber 64577 . 65126) (EQN.ContinueFlg 65128 . 65691) (EQN.ValidEditWindow 65693
. 66127) (EQN.ObjEditWindow 66129 . 67453)) (67456 68573 (EQN.Make 67466 . 68571)) (69805 85740 (
FS.Box 69815 . 72061) (FS.Copy 72063 . 72703) (FS.Display 72705 . 75691) (FS.Get 75693 . 76162) (
FS.Put 76164 . 76635) (FS.ItemFont 76637 . 76998) (FS.ItemValue 77000 . 77406) (FS.ItemShift 77408 .
77788) (FS.MakeItem 77790 . 78212) (FS.Extract 78214 . 82138) (FS.ExtractFont 82140 . 82743) (
FS.ExtractShift 82745 . 83308) (FS.Insert 83310 . 85299) (FS.AllowedChar 85301 . 85538) (
FS.RealStringP 85540 . 85738)))))
STOP

BIN
lispusers/EQUATIONS.LCOM
View File

Binary file not shown.

BIN
lispusers/GITFNS.PDF Normal file
View File

Binary file not shown.

22
lispusers/GREP
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31 6115
(FILECREATED "10-Sep-2024 12:54:27" {WMEDLEY}<lispusers>GREP.;34 6309
:EDIT-BY rmk
:CHANGES-TO (FNS DOGREP)
:CHANGES-TO (FNS TGREP)
:PREVIOUS-DATE "15-Mar-2024 16:28:09" {WMEDLEY}<lispusers>GREP.;29)
:PREVIOUS-DATE "16-Mar-2024 11:16:38" {WMEDLEY}<lispusers>GREP.;31)
(PRETTYCOMPRINT GREPCOMS)
@@ -115,9 +115,15 @@
OUTSTREAM)])
(TGREP
[LAMBDA (STRS FILES) (* ; "Edited 20-Jan-2024 14:14 by rmk")
(TEXTSTREAM (TEDIT (GREP STRS FILES (OPENTEXTSTREAM))
'TGREP NIL '(READONLY T])
[LAMBDA (STRS FILES DONTDEFER) (* ; "Edited 10-Sep-2024 12:54 by rmk")
(* ;; "TSTREAM to return the text stream")
 (* ; "Edited 20-Jan-2024 14:14 by rmk")
(TEVAL (PROGN (GREP STRS FILES)
TSTREAM)
'TGREP
`(TGREP ,STRS ,FILES)
DONTDEFER])
)
(MOVD? 'NILL 'TEDIT.FORMATTEDFILEP)
@@ -130,6 +136,6 @@
(RPAQ? PHONELISTFILES )
(DECLARE%: DONTCOPY
(FILEMAP (NIL (496 5830 (DOGREP 506 . 4544) (GREP 4546 . 5596) (TGREP 5598 . 5828)) (5868 6063 (PHONE
5878 . 6061)))))
(FILEMAP (NIL (495 6024 (DOGREP 505 . 4543) (GREP 4545 . 5595) (TGREP 5597 . 6022)) (6062 6257 (PHONE
6072 . 6255)))))
STOP

BIN
lispusers/GREP.LCOM
View File

Binary file not shown.

28
lispusers/MODERNIZE
View File

@@ -1,11 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Jan-2024 13:38:15" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;7 30816
(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50 30912
:EDIT-BY rmk
:CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
:PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}<home>frank>il>medley>gmedley>lispusers>MODERNIZE.;6
)
:PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}<lispusers>MODERNIZE.;49)
(PRETTYCOMPRINT MODERNIZECOMS)
@@ -499,7 +500,8 @@
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
(\MODERNIZED.TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 29-Jul-2023 10:48 by rmk")
[LAMBDA (W STREAM) (* ; "Edited 30-Jun-2024 22:29 by rmk")
(* ; "Edited 29-Jul-2023 10:48 by rmk")
(* ; "Edited 13-Oct-2021 21:43 by rmk:")
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
@@ -510,8 +512,8 @@
NIL
(WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
[APPLY (FUNCTION UNIONREGIONS)
(bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION)
repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN]
(for PANE in (\TEDIT.PANELIST (CENTRALWINDOW W)) collect (WINDOWPROP PANE
'REGION]
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
)
@@ -614,11 +616,11 @@
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW
9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) (
11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 .
21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW
22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489
29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053)))))
(FILEMAP (NIL (5066 11428 (MODERNWINDOW 5076 . 6616) (MODERNWINDOW.SETUP 6618 . 9567) (UNMODERNWINDOW
9569 . 9963) (MODERNWINDOW.UNSETUP 9965 . 10777) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10779 . 11426)) (
11493 22459 (MODERNWINDOW.BUTTONEVENTFN 11503 . 18530) (NEARTOP 18532 . 19460) (NEARESTCORNER 19462 .
21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW
22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460
29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149)))))
STOP

BIN
lispusers/MODERNIZE.LCOM
View File

Binary file not shown.

30
lispusers/REGIONMANAGER
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133 41064
(FILECREATED "27-Oct-2024 21:59:33" {WMEDLEY}<lispusers>REGIONMANAGER.;134 41230
:EDIT-BY rmk
:CHANGES-TO (FNS RM-CREATEW)
:CHANGES-TO (FNS CLOSE-TYPED-W)
:PREVIOUS-DATE "10-Oct-2023 22:19:05" {WMEDLEY}<lispusers>REGIONMANAGER.;129)
:PREVIOUS-DATE " 2-Nov-2023 23:48:28" {WMEDLEY}<lispusers>REGIONMANAGER.;133)
(PRETTYCOMPRINT REGIONMANAGERCOMS)
@@ -248,15 +248,17 @@
REGION])
(CLOSE-TYPED-W
[LAMBDA (TYPE) (* ; "Edited 14-Sep-2023 07:39 by rmk")
[LAMBDA (TYPE) (* ; "Edited 27-Oct-2024 21:59 by rmk")
(* ; "Edited 14-Sep-2023 07:39 by rmk")
(* ; "Edited 29-Dec-2021 15:58 by rmk")
(* ; "Edited 27-Nov-2021 11:50 by rmk:")
(* ;; "Closes all windows whose regions are of type TYPE")
(* ;; "Closes all windows whose regions are of type TYPE (case-independent)")
(CL:WHEN TYPE
(for W R in (OPENWINDOWS) eachtime [SETQ WT (CAR (WINDOWPROP W 'TYPED-REGION]
when (AND WT (EQMEMB WT TYPE)) do (CLOSEW W)))])
(for W TRPROP in (OPENWINDOWS) eachtime (SETQ TRPROP (WINDOWPROP W 'TYPED-REGION))
when (STRING.EQUAL (CAR TRPROP)
TYPE) do (CLOSEW W)))])
)
(RPAQ? TYPED-REGIONS )
@@ -730,11 +732,11 @@
)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1612 6730 (SET-TYPED-REGIONS 1622 . 3797) (GRAB-TYPED-REGION 3799 . 4825) (
REGISTER-TYPED-REGION 4827 . 6124) (REGION-TYPE 6126 . 6728)) (6731 14637 (RM-CREATEW 6741 . 8864) (
RM-CLOSEW 8866 . 11884) (RM-GETREGION 11886 . 14035) (CLOSE-TYPED-W 14037 . 14635)) (15280 22759 (
RELCREATEREGION 15290 . 19913) (RELGETREGION 19915 . 22522) (RELCREATEPOSITION 22524 . 22757)) (22760
29564 (\RELCREATEREGION.REF 22770 . 26521) (\RELCREATEREGION.SIZE 26523 . 29562)) (29617 38959 (
RM-ATTACHWINDOW 29627 . 38957)) (38960 40694 (CLOSEWITH 38970 . 39497) (CLOSEWITH.DOIT 39499 . 39779)
(MOVEWITH 39781 . 40304) (MOVEWITH.DOIT 40306 . 40692)))))
(FILEMAP (NIL (1615 6733 (SET-TYPED-REGIONS 1625 . 3800) (GRAB-TYPED-REGION 3802 . 4828) (
REGISTER-TYPED-REGION 4830 . 6127) (REGION-TYPE 6129 . 6731)) (6734 14803 (RM-CREATEW 6744 . 8867) (
RM-CLOSEW 8869 . 11887) (RM-GETREGION 11889 . 14038) (CLOSE-TYPED-W 14040 . 14801)) (15446 22925 (
RELCREATEREGION 15456 . 20079) (RELGETREGION 20081 . 22688) (RELCREATEPOSITION 22690 . 22923)) (22926
29730 (\RELCREATEREGION.REF 22936 . 26687) (\RELCREATEREGION.SIZE 26689 . 29728)) (29783 39125 (
RM-ATTACHWINDOW 29793 . 39123)) (39126 40860 (CLOSEWITH 39136 . 39663) (CLOSEWITH.DOIT 39665 . 39945)
(MOVEWITH 39947 . 40470) (MOVEWITH.DOIT 40472 . 40858)))))
STOP

BIN
lispusers/REGIONMANAGER.LCOM
View File

Binary file not shown.

60
lispusers/TEDIT-PF-SEE
View File

@@ -1,29 +1,33 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "27-Mar-2024 23:45:38" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;119 8322
(FILECREATED "31-Oct-2024 17:27:44" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;124 10208
:EDIT-BY rmk
:CHANGES-TO (FNS PF-TEDIT)
:CHANGES-TO (VARS TEDIT-PF-SEECOMS)
:PREVIOUS-DATE "25-Dec-2023 12:29:39" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;118)
:PREVIOUS-DATE "31-Oct-2024 17:25:56" {WMEDLEY}<lispusers>TEDIT-PF-SEE.;123)
(PRETTYCOMPRINT TEDIT-PF-SEECOMS)
(RPAQQ TEDIT-PF-SEECOMS
[(FNS PF-TEDIT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(RPAQQ TEDIT-PF-SEECOMS [(FNS PF-TEDIT PF-TEDIT-FROM-TEXT)
(COMMANDS ts tf)
(FILES (SYSLOAD)
REGIONMANAGER)
(P (MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML)
(LAMA])
(DEFINEQ
(PF-TEDIT
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Mar-2024 23:45 by rmk")
[LAMBDA (FN IFILES REPRINT) (* ; "Edited 27-Aug-2024 13:03 by rmk")
(* ; "Edited 27-Mar-2024 23:45 by rmk")
(* ; "Edited 25-Dec-2023 12:24 by rmk")
(* ; "Edited 5-Dec-2023 23:50 by rmk")
(* ; "Edited 12-Oct-2023 00:19 by rmk")
@@ -80,6 +84,8 @@
(SETFILEINFO ISTREAM 'FORMAT ENV)
(SETQ TSTREAM (OPENTEXTSTREAM))
(DSPFONT DEFAULTFONT TSTREAM)
(PRINTOUT TSTREAM 5 "[From " (FULLNAME ISTREAM)
"]" T)
(PRINT-READER-ENVIRONMENT ENV TSTREAM)
(IF REPRINT
THEN (SETFILEPTR ISTREAM (POP LOC))
@@ -126,6 +132,26 @@
ELSE (printout T FN " not found on " LOC "." T)))
(SETQ *LAST-DF* FN)
ELSE (PRINTOUT T FN " has no function definition" T])
(PF-TEDIT-FROM-TEXT
[LAMBDA (TSTREAM TEXTOBJ SEL) (* ; "Edited 26-Aug-2024 23:13 by rmk")
(* ;; "The function key for the meta,T and meta,t keys. This shows in a separate Tedit window the definition in TSTREAM of the function named by the selection SEL.")
(SETQ TSTREAM (TEXTSTREAM TSTREAM))
(CL:UNLESS SEL
(SETQ SEL (TEDIT.GETSEL TSTREAM)))
(LET [[FILENAME (OR (TEXTPROP TSTREAM 'FILENAME)
(AND (\TEDIT.PRIMARYPANE TSTREAM)
(CADR (WINDOWPROP (\TEDIT.PRIMARYPANE TSTREAM TSTREAM)
'TF]
(FN (MKATOM (TEDIT.SEL.AS.STRING TSTREAM SEL]
(if (EQ 0 (NCHARS FN))
then (TEDIT.PROMPTPRINT TSTREAM "Please select a function to display" T)
elseif FILENAME
then (PF-TEDIT FN FILENAME)
else (TEDIT.PROMPTPRINT TSTREAM (CONCAT FN " not found")
T])
)
(DEFCOMMAND ts (FILE WINDOW FORMAT)
@@ -140,6 +166,12 @@
REGIONMANAGER)
(MOVD? 'PFCOPYBYTES 'PFI.MAYBE.PP.DEFINITION)
(MOVD? 'NILL (FUNCTION TEDIT.SETFUNCTION))
(TEDIT.SETFUNCTION "Meta,T" (FUNCTION PF-TEDIT-FROM-TEXT))
(TEDIT.SETFUNCTION "Meta,t" (FUNCTION PF-TEDIT-FROM-TEXT))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
@@ -149,5 +181,5 @@
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (782 7802 (PF-TEDIT 792 . 7800)))))
(FILEMAP (NIL (1243 9524 (PF-TEDIT 1253 . 8506) (PF-TEDIT-FROM-TEXT 8508 . 9522)))))
STOP

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

Binary file not shown.

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

Binary file not shown.

37
lispusers/tmax/TMAX
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 4-Mar-2024 16:23:18" {WMEDLEY}<lispusers>tmax>TMAX.;10 25460
(FILECREATED "29-Apr-2024 10:01:10" {WMEDLEY}<lispusers>TMAX>TMAX.;11 25484
:EDIT-BY rmk
:CHANGES-TO (FNS TSP.LIST.OF.OBJECTS)
:CHANGES-TO (FNS TSP.SETUP.FMMENU)
:PREVIOUS-DATE "19-Jul-2023 09:14:13" {WMEDLEY}<lispusers>tmax>TMAX.;9)
:PREVIOUS-DATE " 4-Mar-2024 16:23:18" {WMEDLEY}<lispusers>TMAX>TMAX.;10)
(PRETTYCOMPRINT TMAXCOMS)
@@ -212,14 +212,13 @@
OBJMENUW])
(TSP.SETUP.FMMENU
[LAMBDA (WINDOW) (* fsg "24-Aug-87 16:04")
(* * Here to set up things like the FreeMenu, hasharrays, etc.
 the first time through.)
[LAMBDA (WINDOW) (* ; "Edited 29-Apr-2024 09:56 by rmk")
(* fsg "24-Aug-87 16:04")
(* ;;; "Here to set up things like the FreeMenu, hasharrays, etc. the first time through. WINDOW is the primary window of a text stream")
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(TSP.FMMENU (OR (CAR (NLSETQ (TEXTSTREAM WINDOW)))
(with STREAM (with TEXTOBJ TEXTOBJ STREAMHINT)
FULLNAME])
(TSP.FMMENU (fetch (TEXTWINDOW WTEXTSTREAM) of WINDOW])
(TSP.FMMENU
[LAMBDA (STREAM) (* ; "Edited 2-May-97 17:02 by rmk:")
@@ -554,14 +553,14 @@
(TSP.FUNCTION.HOOKS)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8081 15296 (TSP.DISPLAY.FMMENU 8091 . 8656) (TSP.SETUP.FILENAMES 8658 . 9909) (
TSP.SETUP.FMMENU 9911 . 10371) (TSP.FMMENU 10373 . 11559) (TSP.FM.APPLY 11561 . 11880) (UPDATE.ALL
11882 . 12554) (DOWNDATE.ALL 12556 . 12926) (TSP.FUNCTION.HOOKS 12928 . 14358) (TSP.GETFN 14360 .
14920) (TSP.PUTFN 14922 . 15294)) (15342 17591 (AutoUpdate.TOGGLE 15352 . 15588) (UPDATE? 15590 .
15735) (NGROUP.Menu.TOGGLE 15737 . 16119) (NGROUPMENU.ENABLED? 16121 . 16357) (
NGROUP.Text-Before.TOGGLE 16359 . 16609) (TEXTBEFORE.ENABLED? 16611 . 16774) (NGROUP.Text-After.TOGGLE
16776 . 17024) (TEXTAFTER.ENABLED? 17026 . 17187) (Manual.Index.TOGGLE 17189 . 17428) (
MANUALINDEX.ENABLED? 17430 . 17589)) (17625 23098 (GET.TSP.FONT 17635 . 18799) (GET.TSP.FONT.FAMILY
18801 . 19649) (GET.TSP.FONT.SIZE 19651 . 20139) (GET.TSP.FONT.FACE 20141 . 20840) (ABBREVIATE.FONT
20842 . 22342) (TMAX.SHADEOBJ 22344 . 23096)) (23138 24048 (TSP.LIST.OF.OBJECTS 23148 . 24046)))))
(FILEMAP (NIL (8079 15320 (TSP.DISPLAY.FMMENU 8089 . 8654) (TSP.SETUP.FILENAMES 8656 . 9907) (
TSP.SETUP.FMMENU 9909 . 10395) (TSP.FMMENU 10397 . 11583) (TSP.FM.APPLY 11585 . 11904) (UPDATE.ALL
11906 . 12578) (DOWNDATE.ALL 12580 . 12950) (TSP.FUNCTION.HOOKS 12952 . 14382) (TSP.GETFN 14384 .
14944) (TSP.PUTFN 14946 . 15318)) (15366 17615 (AutoUpdate.TOGGLE 15376 . 15612) (UPDATE? 15614 .
15759) (NGROUP.Menu.TOGGLE 15761 . 16143) (NGROUPMENU.ENABLED? 16145 . 16381) (
NGROUP.Text-Before.TOGGLE 16383 . 16633) (TEXTBEFORE.ENABLED? 16635 . 16798) (NGROUP.Text-After.TOGGLE
16800 . 17048) (TEXTAFTER.ENABLED? 17050 . 17211) (Manual.Index.TOGGLE 17213 . 17452) (
MANUALINDEX.ENABLED? 17454 . 17613)) (17649 23122 (GET.TSP.FONT 17659 . 18823) (GET.TSP.FONT.FAMILY
18825 . 19673) (GET.TSP.FONT.SIZE 19675 . 20163) (GET.TSP.FONT.FACE 20165 . 20864) (ABBREVIATE.FONT
20866 . 22366) (TMAX.SHADEOBJ 22368 . 23120)) (23162 24072 (TSP.LIST.OF.OBJECTS 23172 . 24070)))))
STOP

67
lispusers/tmax/TMAX-DATE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}<lispusers>tmax>TMAX-DATE.;4| 14846
(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}<lispusers>tmax>TMAX-DATE.;8| 15021
:EDIT-BY |rmk|
:CHANGES-TO (FNS DATE.GETFN)
:PREVIOUS-DATE "17-Mar-2022 23:03:32" |{WMEDLEY}<lispusers>tmax>TMAX-DATE.;3|)
:PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}<lispusers>tmax>TMAX-DATE.;7|)
(PRETTYCOMPRINT TMAX-DATECOMS)
@@ -82,19 +82,15 @@
(prin1 (|fetch| display.date |of| (|fetch| objectdatum |of| obj))
stream)))
(date.imageboxfn
(lambda (obj stream currentx rightmargin) (* |ss:| "27-Jun-87 15:38")
(* * |Return| |the| |ImageBox| |for| |the| |date| |string.|
 |The| |size| |is| |determined| |by| |the| |stream's| |current| |font.|)
(dspfont (current.display.font stream)
stream)
(|create| imagebox
xsize _ (stringwidth (|fetch| display.date |of| (|fetch| objectdatum |of| obj))
stream)
ysize _ (fontprop stream 'height)
ydesc _ (fontprop stream 'descent)
xkern _ 0)))
(DATE.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 25-May-2024 20:34 by rmk")
(* |ss:| "27-Jun-87 15:38")
(|create| IMAGEBOX
XSIZE _ (STRINGWIDTH (|fetch| DISPLAY.DATE |of| (|fetch| OBJECTDATUM |of| OBJ))
STREAM)
YSIZE _ (FONTPROP STREAM 'HEIGHT)
YDESC _ (FONTPROP STREAM 'DESCENT)
XKERN _ 0)))
(date.putfn
(lambda (obj stream) (* |ss:| "27-Jun-87 15:38")
@@ -102,9 +98,11 @@
stream)))
(DATE.GETFN
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:45 by rmk")
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:45 by rmk")
(* |fsg| "20-Aug-87 14:56")
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ))
(DECLARE (USEDFREE TSTREAM))
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM))
(APPLY (FUNCTION DATEOBJ)
(OR COPY.OBJECT (CADR (READ STREAM))))))
@@ -148,19 +146,20 @@
(DEFINEQ
(current.display.font
(lambda (stream) (* \; "Edited 12-Mar-88 15:28 by drc:")
(CURRENT.DISPLAY.FONT
(LAMBDA (TEXTOBJ) (* \; "Edited 25-May-2024 20:36 by rmk")
(* \; "Edited 9-May-2024 10:05 by rmk")
(* \; "Edited 12-Mar-88 15:28 by drc:")
(* |;;;| "Return the current font. This function is here instead of TMAX because the DATE code is also used in the LetterHead code.")
(* |;;;| "Return the current font. This function is not now used in TMAX, but the comment says \"this code is also used in the LetterHead code.\" ")
(let ((current.font (|fetch| clfont |of| (|with| textstream (textstream textobj)
currentlooks))))
(cond
((typenamep current.font 'fontdescriptor)
current.font)
((typenamep current.font 'fontclass)
(|fetch| displayfd |of| current.font))
(t (shouldnt "Can't get current font"))))))
(LET ((CURRENT.FONT (|fetch| CLFONT |of| (GETTOBJ TEXTOBJ CARETLOOKS))))
(COND
((TYPENAMEP CURRENT.FONT 'FONTDESCRIPTOR)
CURRENT.FONT)
((TYPENAMEP CURRENT.FONT 'FONTCLASS)
(|fetch| DISPLAYFD |of| CURRENT.FONT))
(T (SHOULDNT "Can't get current font"))))))
(CHANGE.DATE.FORMAT
(LAMBDA (DATE TEMPLATE) (* \;
@@ -350,10 +349,10 @@
)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (1378 6167 (DATEOBJ 1388 . 2155) (DATEOBJP 2157 . 2591) (DATE.DISPLAYFN 2593 . 2915) (
DATE.IMAGEBOXFN 2917 . 3544) (DATE.PUTFN 3546 . 3744) (DATE.GETFN 3746 . 4095) (DATE.COPYFN 4097 .
4629) (DATE.BUTTONEVENTINFN 4631 . 6165)) (6211 8864 (CURRENT.DISPLAY.FONT 6221 . 6927) (
CHANGE.DATE.FORMAT 6929 . 8862)) (8917 13316 (FINDTIME 8927 . 10706) (FINDHOUR 10708 . 11069) (AMPM
11071 . 11370) (FINDDAY 11372 . 11643) (NUMP 11645 . 11874) (FINDMONTH 11876 . 12992) (FINDYEAR 12994
. 13314)) (14028 14594 (MAKE.DATEOBJ.IMAGEFNS 14038 . 14592)))))
(FILEMAP (NIL (1378 6194 (DATEOBJ 1388 . 2155) (DATEOBJP 2157 . 2591) (DATE.DISPLAYFN 2593 . 2915) (
DATE.IMAGEBOXFN 2917 . 3422) (DATE.PUTFN 3424 . 3622) (DATE.GETFN 3624 . 4122) (DATE.COPYFN 4124 .
4656) (DATE.BUTTONEVENTINFN 4658 . 6192)) (6238 9039 (CURRENT.DISPLAY.FONT 6248 . 7102) (
CHANGE.DATE.FORMAT 7104 . 9037)) (9092 13491 (FINDTIME 9102 . 10881) (FINDHOUR 10883 . 11244) (AMPM
11246 . 11545) (FINDDAY 11547 . 11818) (NUMP 11820 . 12049) (FINDMONTH 12051 . 13167) (FINDYEAR 13169
. 13489)) (14203 14769 (MAKE.DATEOBJ.IMAGEFNS 14213 . 14767)))))
STOP

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

Binary file not shown.

16
lispusers/tmax/TMAX-ENDNOTE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}<lispusers>tmax>TMAX-ENDNOTE.;4| 23729
(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}<lispusers>tmax>TMAX-ENDNOTE.;6| 23878
:EDIT-BY |rmk|
:CHANGES-TO (FNS REGMARK.GETFN)
:PREVIOUS-DATE "26-Jun-2022 18:15:33" |{WMEDLEY}<lispusers>tmax>TMAX-ENDNOTE.;3|)
:PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}<lispusers>tmax>TMAX-ENDNOTE.;5|)
(PRETTYCOMPRINT TMAX-ENDNOTECOMS)
@@ -387,9 +387,11 @@
STREAM)))
(REGMARK.GETFN
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:45 by rmk")
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:45 by rmk")
(* |fsg| "20-Aug-87 14:58")
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ))
(DECLARE (USEDFREE TSTREAM))
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM))
(APPLY (FUNCTION REGMARKOBJ)
(OR COPY.OBJECT (CDR (READ STREAM))))))
@@ -451,8 +453,8 @@ INSERT.ENDNOTES.TEXT 5286 . 6715) (DELETE.ENDNOTES 6717 . 7708) (NOTESREGIONP 77
SET.ENDNOTE.STYLE 7974 . 10647) (MAP.ENDNOTE.LOOKS 10649 . 11416) (GET.ENDNOTE.FONTS 11418 . 12026)) (
12029 15944 (ENDNOTEP 12039 . 12380) (NOTE.PUTFN 12382 . 13034) (NOTE.GETFN 13036 . 13616) (
NOTE.BUTTONEVENTINFN 13618 . 14398) (NOTE.WHENSELECTEDFN 14400 . 15942)) (16702 19106 (AUX.TEDIT 16712
. 17674) (AUX.TEDIT.AFTERQUITFN 17676 . 18119) (AUX.TEDIT.TITLEMENUFN 18121 . 19104)) (19191 23089 (
. 17674) (AUX.TEDIT.AFTERQUITFN 17676 . 18119) (AUX.TEDIT.TITLEMENUFN 18121 . 19104)) (19191 23238 (
REGMARKOBJ 19201 . 19608) (REGMARKOBJP 19610 . 19804) (REGMARK.DISPLAYFN 19806 . 20052) (
REGMARK.IMAGEBOXFN 20054 . 20405) (REGMARK.PUTFN 20407 . 20878) (REGMARK.GETFN 20880 . 21234) (
REGMARK.COPYFN 21236 . 21774) (REGMARK.BUTTONEVENTINFN 21776 . 23087)))))
REGMARK.IMAGEBOXFN 20054 . 20405) (REGMARK.PUTFN 20407 . 20878) (REGMARK.GETFN 20880 . 21383) (
REGMARK.COPYFN 21385 . 21923) (REGMARK.BUTTONEVENTINFN 21925 . 23236)))))
STOP

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

Binary file not shown.

39
lispusers/tmax/TMAX-INDEX
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 07:51:29" |{WMEDLEY}<lispusers>tmax>TMAX-INDEX.;4| 46587
(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}<lispusers>tmax>TMAX-INDEX.;6| 46698
:EDIT-BY |rmk|
:CHANGES-TO (VARS TMAX-INDEXCOMS)
(FNS INDEX.DISPLAYFN)
:CHANGES-TO (FNS INDEX.DISPLAYFN)
:PREVIOUS-DATE "20-Feb-97 17:58:09" |{WMEDLEY}<lispusers>tmax>TMAX-INDEX.;1|)
:PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}<lispusers>tmax>TMAX-INDEX.;5|)
(PRETTYCOMPRINT TMAX-INDEXCOMS)
@@ -123,12 +122,14 @@
'indexobj))))
(INDEX.DISPLAYFN
(LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 16-Mar-2024 07:46 by rmk")
(LAMBDA (OBJ IMAGESTREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:46 by rmk")
(* \; "Edited 14-Feb-97 09:30 by rmk:")
(* |fsg| "17-Sep-87 11:14")
(* |;;| "Display an Index imageobject. If the stream-type is display, then just type Index or Extended Index followed by their args. Otherwise the stream-type is hardcopy. In this case, type nothing and replace the CAR of the hash array entry with a list of page numbers in which this index appears.")
(DECLARE (USEDFREE TSTREAM))
(SELECTQ (IMAGESTREAMTYPE IMAGESTREAM)
(DISPLAY (CL:UNLESS (EQ 'INVISIBLE INDEXDISPLAYAPPEARANCE)
(DSPFONT |GP.DefaultFont| IMAGESTREAM)
@@ -139,7 +140,7 @@
(PRIN3 (INDEX.STRING OBJ)
IMAGESTREAM)))))
(LET ((PGS/IMOBJS (GETHASH.INDEX OBJ IMAGESTREAM))
(CURRENT.PAGE (INDEX.PAGE.NUMBER (\\TEDIT.PRIMARYW TEXTOBJ))))
(CURRENT.PAGE (INDEX.PAGE.NUMBER (\\TEDIT.PRIMARYPANE TSTREAM))))
(COND
((LISTP (CAR PGS/IMOBJS))
(OR (MEMB CURRENT.PAGE (CAR PGS/IMOBJS))
@@ -866,17 +867,17 @@
(* |;;;| "IMAGE OBJECT for causing the index to be written, without using the menu")
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3112 10886 (INDEXOBJ 3122 . 4145) (INDEXOBJP 4147 . 4595) (INDEX.DISPLAYFN 4597 . 6265)
(INDEX.IMAGEBOXFN 6267 . 7813) (INDEX.PUTFN 7815 . 8245) (INDEX.GETFN 8247 . 8638) (INDEX.COPYFN 8640
. 9275) (INDEX.BUTTONEVENTINFN 9277 . 10884)) (10925 18798 (INSERT.INDEX 10935 . 11522) (
INSERT.INDEXENTRY 11524 . 14291) (INSERT.KNOWN.INDEX 14293 . 16370) (SUBITEM.SELECTFN 16372 . 17366) (
ADD.NEW.INDEX 17368 . 18796)) (18864 22795 (CHANGE.INDEX 18874 . 19442) (CHANGE.INDEXENTRY 19444 .
20194) (CHANGE.XINDEX.KEY 20196 . 20754) (CHANGE.XINDEX.ENTRY 20756 . 21389) (CHANGE.XINDEX.FONT 21391
. 22260) (CHANGE.XINDEX.NUMBER 22262 . 22793)) (22837 30558 (GETHASH.INDEX 22847 . 23514) (
INDEX.PAGE.NUMBER 23516 . 25095) (INDEX.MANUAL.DELIMITER 25097 . 25788) (INDEX.STRING 25790 . 26800) (
GET.INDEXENTRY.NUMBER 26802 . 27822) (INDEX.LIST.REFS 27824 . 29314) (LIST.OF.INDEXENTRIES 29316 .
30556)) (30600 40804 (CREATE.INDEX.FILE 30610 . 32489) (DUMP.INDEX 32491 . 34911) (VIEW.INDEX.FILE
34913 . 36177) (GET.INDEX.FILE 36179 . 36569) (WRITE.INDEX.FILE 36571 . 38972) (
WRITE.INDEX.PAGENUMBERS 38974 . 40174) (RESET.INDEX.PAGENUMBERS 40176 . 40802)) (41002 45056 (
SELECTION.TO.STRING 41012 . 43844) (SELECTION.TO.INDEX 43846 . 45054)))))
(FILEMAP (NIL (3074 10997 (INDEXOBJ 3084 . 4107) (INDEXOBJP 4109 . 4557) (INDEX.DISPLAYFN 4559 . 6376)
(INDEX.IMAGEBOXFN 6378 . 7924) (INDEX.PUTFN 7926 . 8356) (INDEX.GETFN 8358 . 8749) (INDEX.COPYFN 8751
. 9386) (INDEX.BUTTONEVENTINFN 9388 . 10995)) (11036 18909 (INSERT.INDEX 11046 . 11633) (
INSERT.INDEXENTRY 11635 . 14402) (INSERT.KNOWN.INDEX 14404 . 16481) (SUBITEM.SELECTFN 16483 . 17477) (
ADD.NEW.INDEX 17479 . 18907)) (18975 22906 (CHANGE.INDEX 18985 . 19553) (CHANGE.INDEXENTRY 19555 .
20305) (CHANGE.XINDEX.KEY 20307 . 20865) (CHANGE.XINDEX.ENTRY 20867 . 21500) (CHANGE.XINDEX.FONT 21502
. 22371) (CHANGE.XINDEX.NUMBER 22373 . 22904)) (22948 30669 (GETHASH.INDEX 22958 . 23625) (
INDEX.PAGE.NUMBER 23627 . 25206) (INDEX.MANUAL.DELIMITER 25208 . 25899) (INDEX.STRING 25901 . 26911) (
GET.INDEXENTRY.NUMBER 26913 . 27933) (INDEX.LIST.REFS 27935 . 29425) (LIST.OF.INDEXENTRIES 29427 .
30667)) (30711 40915 (CREATE.INDEX.FILE 30721 . 32600) (DUMP.INDEX 32602 . 35022) (VIEW.INDEX.FILE
35024 . 36288) (GET.INDEX.FILE 36290 . 36680) (WRITE.INDEX.FILE 36682 . 39083) (
WRITE.INDEX.PAGENUMBERS 39085 . 40285) (RESET.INDEX.PAGENUMBERS 40287 . 40913)) (41113 45167 (
SELECTION.TO.STRING 41123 . 43955) (SELECTION.TO.INDEX 43957 . 45165)))))
STOP

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

Binary file not shown.

116
lispusers/tmax/TMAX-NUMBER
View File

@@ -1,13 +1,13 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 07:49:47" |{WMEDLEY}<lispusers>tmax>TMAX-NUMBER.;3| 33943
(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}<lispusers>tmax>TMAX-NUMBER.;6| 34833
:EDIT-BY |rmk|
:CHANGES-TO (FNS NUMBER.DISPLAYFN NUMBER.PREPRINTFN NUMBER.IMAGEBOXFN NUMBER.PUTFN NUMBER.GETFN
NUMBER.COPYFN)
:PREVIOUS-DATE "18-Mar-2022 07:06:06" |{WMEDLEY}<lispusers>tmax>TMAX-NUMBER.;2|)
:PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}<lispusers>tmax>TMAX-NUMBER.;5|)
(PRETTYCOMPRINT TMAX-NUMBERCOMS)
@@ -94,13 +94,15 @@
'ngroup))))
(NUMBER.DISPLAYFN
(LAMBDA (IMAGE.OBJ STREAM) (* \; "Edited 16-Mar-2024 07:46 by rmk")
(LAMBDA (IMAGE.OBJ STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:46 by rmk")
(* |fsg| "24-Sep-87 14:56")
(* |;;| "Display function for numberobjs. Allows different formats for display according to the use to which the numberobj is being put. If no specific action is specified, displaying defaults to printing out as a plain number.*")
(DECLARE (USEDFREE TSTREAM))
(|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| IMAGE.OBJ)
(LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))
(LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM))
(IMAGE.TAG (IMAGEOBJPROP IMAGE.OBJ 'TAG))
(OLD.FONT (DSPFONT NIL STREAM))
(NBR.FONT (SELECTQ USE
@@ -140,14 +142,16 @@
(DSPFONT OLD.FONT STREAM)))))
(NUMBER.PREPRINTFN
(LAMBDA (IMAGE.OBJ) (* \; "Edited 16-Mar-2024 07:47 by rmk")
(LAMBDA (IMAGE.OBJ) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:47 by rmk")
(* \; "Edited 18-May-99 22:51 by rmk:")
(* |fsg| "24-Sep-87 14:56")
(* |;;| "Returns string that represents the number object, for plaintext put. If no specific action is specified, displaying defaults to printing out as a plain number.*")
(DECLARE (USEDFREE TSTREAM))
(WITH NUMBEROBJ (FETCH OBJECTDATUM OF IMAGE.OBJ)
(LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))
(LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM))
(IMAGE.TAG (IMAGEOBJPROP IMAGE.OBJ 'TAG)))
(AND IMAGE.TAG (OR (TSP.GETCODEVAL IMAGE.TAG MAIN.WINDOW)
(TSP.PUTCODE IMAGE.TAG IMAGE.OBJ MAIN.WINDOW)))
@@ -159,46 +163,51 @@
NIL)))))
(NUMBER.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 16-Mar-2024 07:47 by rmk")
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 25-May-2024 20:46 by rmk")
(* \; "Edited 16-Mar-2024 07:47 by rmk")
(* |fsg| " 4-Aug-87 14:56")
(* |;;;| "For Endnote numbers, the YSize is the current font height plus 0.25 times the Endnote number font height. We do this so the the Endnote number will be superscripted but not too much.")
(* |;;| "For Endnote numbers, the YSize is the current font height plus 0.25 times the Endnote number font height. We do this so the the Endnote number will be superscripted but not too much.")
(* |;;;| "The YSize is computed as the current font height plus half of the NOTE or NGroup font. The reason is weird. Ask Sami for more details.")
(* |;;| "WHY ARE THE NOTES HUNG AS WINDOWPROPS INSTEAD OF TEXTPROPS ")
(|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ)
(LET* ((MAIN.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))
(IMOBJ.STRING (MKSTRING NUMSTRING))
(NBR.FONT (SELECTQ USE
(NOTE (|fetch| (ENDNOTEFONTS NUMBER.FONT) |of| (GET.ENDNOTE.FONTS
MAIN.WINDOW)))
(NGROUP FONT)
(ERROR "Undefined USE field" USE))))
(AND (EQ USE 'NGROUP)
(PROGN (AND (STRINGP TEXT.BEFORE#)
(SETQ IMOBJ.STRING (CONCAT TEXT.BEFORE# IMOBJ.STRING)))
(AND (STRINGP TEXT.AFTER#)
(SETQ IMOBJ.STRING (CONCAT IMOBJ.STRING TEXT.AFTER#)))))
(AND (FONTP NBR.FONT)
(DSPFONT (FONTCREATE (FONTPROP NBR.FONT 'FAMILY)
(FONTPROP NBR.FONT 'SIZE)
(FONTPROP NBR.FONT 'FACE))
STREAM))
(|create| IMAGEBOX
XSIZE _ (STRINGWIDTH IMOBJ.STRING STREAM)
YSIZE _ (SELECTQ USE
(NOTE (FIX (PLUS (TIMES (DSPSCALE NIL STREAM)
(FONTPROP (CURRENT.DISPLAY.FONT STREAM)
'HEIGHT))
(TIMES 0.25 (FONTPROP STREAM 'HEIGHT)))))
(FONTPROP STREAM 'HEIGHT))
YDESC _ (FONTPROP STREAM 'DESCENT)
XKERN _ 0)))))
(DECLARE (USEDFREE TSTREAM))
(LET* ((NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ))
(IMOBJ.STRING (MKSTRING (|fetch| (NUMBEROBJ NUMSTRING) |of| NUMBEROBJ)))
(USE (|fetch| (NUMBEROBJ USE) |of| NUMBEROBJ))
(FONT (SELECTQ USE
(NOTE (|fetch| (ENDNOTEFONTS NUMBER.FONT) |of| (GET.ENDNOTE.FONTS (
\\TEDIT.PRIMARYPANE
TSTREAM))))
(NGROUP (|fetch| (NUMBEROBJ FONT) |of| NUMBEROBJ))
(ERROR "Undefined USE field" USE)))
(HEIGHT (FONTPROP FONT 'HEIGHT)))
(CL:WHEN (EQ USE 'NGROUP)
(SETQ IMOBJ.STRING (CONCAT (OR (STRINGP (|fetch| (NUMBEROBJ TEXT.BEFORE#) |of|
NUMBEROBJ
))
"")
IMOBJ.STRING
(OR (STRINGP (|fetch| (NUMBEROBJ TEXT.AFTER#) |of| NUMBEROBJ)
)
""))))
(|create| IMAGEBOX
XSIZE _ (STRINGWIDTH IMOBJ.STRING FONT)
YSIZE _ (SELECTQ USE
(NOTE (FIX (PLUS (TIMES (DSPSCALE NIL STREAM)
HEIGHT)
(TIMES 0.25 HEIGHT))))
HEIGHT)
YDESC _ (FONTPROP FONT 'DESCENT)
XKERN _ 0))))
(NUMBER.PUTFN
(LAMBDA (OBJ STREAM) (* \; "Edited 16-Mar-2024 07:48 by rmk")
(LAMBDA (OBJ STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:48 by rmk")
(* |fsg| " 5-Aug-87 08:24")
(LET ((WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))
(DECLARE (USEDFREE TSTREAM))
(LET ((WINDOW (\\TEDIT.PRIMARYPANE TSTREAM))
(USE (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ)
USE))
(OLD.FONT (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| OBJ)
@@ -215,14 +224,16 @@
(ERROR "Unknown NUMBER ImageObject type" USE)))))
(NUMBER.GETFN
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:48 by rmk")
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:48 by rmk")
(* |fsg| " 3-Sep-87 15:17")
(* |;;;| "If COPY.OBJECT is non-NIL then we are COPYing it to this window.")
(DECLARE (USEDFREE TSTREAM))
(LET ((NBROBJ.DATUM (OR COPY.OBJECT (CDR (READ STREAM))))
(NEWOBJ (NUMBEROBJ))
(WINDOW (\\TEDIT.PRIMARYW TEXTOBJ)))
(WINDOW (\\TEDIT.PRIMARYPANE TSTREAM)))
(TSP.SETUP.FMMENU WINDOW)
(AND (ILESSP (LENGTH NBROBJ.DATUM)
3)
@@ -255,14 +266,15 @@
NEWOBJ)))
(NUMBER.COPYFN
(LAMBDA (IMAGE.OBJ SOURCE.STREAM TARGET.STREAM) (* \; "Edited 16-Mar-2024 07:48 by rmk")
(LAMBDA (IMAGE.OBJ SOURCE.STREAM TARGET.STREAM) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:48 by rmk")
(* |fsg| " 4-Aug-87 09:46")
(* |;;;| "Here to COPY a Number Image Object. If we are copying to our own window, we delete the TAG if any so we don't get two ImageObjs with the same TAG name.")
(DECLARE (USEDFREE TSTREAM))
(SELECTQ (IMAGESTREAMTYPE TARGET.STREAM)
(TEXT (LET ((SOURCE.WINDOW (\\TEDIT.PRIMARYW TEXTOBJ))
(TEXTOBJ (TEXTOBJ TARGET.STREAM)))
(TEXT (LET ((SOURCE.WINDOW (\\TEDIT.PRIMARYPANE TSTREAM)))
(APPLY* (IMAGEOBJPROP IMAGE.OBJ 'GETFN)
TARGET.STREAM
(LIST (|with| NUMBEROBJ (|fetch| OBJECTDATUM |of| IMAGE.OBJ)
@@ -585,12 +597,12 @@
)
)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (2562 18335 (NUMBEROBJ 2572 . 3678) (NUMBEROBJP 3680 . 4220) (NGROUPP 4222 . 4576) (
NUMBER.DISPLAYFN 4578 . 7583) (NUMBER.PREPRINTFN 7585 . 8717) (NUMBER.IMAGEBOXFN 8719 . 11110) (
NUMBER.PUTFN 11112 . 12284) (NUMBER.GETFN 12286 . 14471) (NUMBER.COPYFN 14473 . 16156) (
NUMBER.BUTTONEVENTINFN 16158 . 18063) (NUMBEROBJ.TEDIT-TO-TEX-FN 18065 . 18333)) (18336 27507 (
COPY.NGROUP.BRANCH 18346 . 19802) (DUMP.NGROUP.GRAPH 19804 . 20680) (NGROUP.BUTTONEVENTINFN 20682 .
21382) (NGROUP.DEFINE.TAG 21384 . 21987) (NUMBER.DELETE.TAG 21989 . 22248) (NGROUP.SHOW.TAG 22250 .
22572) (CHANGE.INSERTED.NGROUP.FORMAT 22574 . 24369) (CHANGE.NGROUP.FORMAT.#TEXT 24371 . 25957) (
SHOW.INSERTED.NGROUP.FORMAT 25959 . 27505)))))
(FILEMAP (NIL (2562 19225 (NUMBEROBJ 2572 . 3678) (NUMBEROBJP 3680 . 4220) (NGROUPP 4222 . 4576) (
NUMBER.DISPLAYFN 4578 . 7732) (NUMBER.PREPRINTFN 7734 . 9015) (NUMBER.IMAGEBOXFN 9017 . 11607) (
NUMBER.PUTFN 11609 . 12930) (NUMBER.GETFN 12932 . 15266) (NUMBER.COPYFN 15268 . 17046) (
NUMBER.BUTTONEVENTINFN 17048 . 18953) (NUMBEROBJ.TEDIT-TO-TEX-FN 18955 . 19223)) (19226 28397 (
COPY.NGROUP.BRANCH 19236 . 20692) (DUMP.NGROUP.GRAPH 20694 . 21570) (NGROUP.BUTTONEVENTINFN 21572 .
22272) (NGROUP.DEFINE.TAG 22274 . 22877) (NUMBER.DELETE.TAG 22879 . 23138) (NGROUP.SHOW.TAG 23140 .
23462) (CHANGE.INSERTED.NGROUP.FORMAT 23464 . 25259) (CHANGE.NGROUP.FORMAT.#TEXT 25261 . 26847) (
SHOW.INSERTED.NGROUP.FORMAT 26849 . 28395)))))
STOP

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

Binary file not shown.

66
lispusers/tmax/TMAX-XREF
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
(FILECREATED "16-Mar-2024 07:55:53" |{WMEDLEY}<lispusers>tmax>TMAX-XREF.;7| 23813
(FILECREATED "25-Jun-2024 12:00:23" |{WMEDLEY}<lispusers>tmax>TMAX-XREF.;13| 24116
:EDIT-BY |rmk|
:CHANGES-TO (VARS XREF.DISPLAY.METHODS)
(FNS XREF.BUTTONEVENTINFN XREF.GETFN XREF.GET.TOOBJ)
:CHANGES-TO (FNS XREF.GETFN XREF.GET.TOOBJ)
:PREVIOUS-DATE "16-Mar-2024 07:52:25" |{WMEDLEY}<lispusers>tmax>TMAX-XREF.;6|)
:PREVIOUS-DATE "24-Jun-2024 23:30:47" |{WMEDLEY}<lispusers>tmax>TMAX-XREF.;12|)
(PRETTYCOMPRINT TMAX-XREFCOMS)
@@ -110,20 +109,18 @@
(prin1 (xref.get.display.text obj)
stream)))
(xref.imageboxfn
(lambda (obj stream) (* |ss:| "27-Jun-87 16:39")
(* |Returns| |the| |size| |of| |an| xref |imageobject| |based| |on| |the|
 |string| |that| |will| |be| |used| |to| |display| |it| |which| |is| |found|
 |using| xref.get.display.text.)
(XREF.IMAGEBOXFN
(LAMBDA (OBJ STREAM) (* \; "Edited 25-May-2024 20:34 by rmk")
(* |ss:| "27-Jun-87 16:39")
(dspfont (current.display.font stream)
stream)
(|create| imagebox
xsize _ (tedit.stringwidth (xref.get.display.text obj)
stream)
ysize _ (fontprop stream 'height)
ydesc _ (fontprop stream 'descent)
xkern _ 0)))
(* |;;| "Returns the size of an XREF imageobject based on the string that will be used to display it which is found using XREF.GET.DISPLAY.TEXT.")
(|create| IMAGEBOX
XSIZE _ (TEDIT.STRINGWIDTH (XREF.GET.DISPLAY.TEXT OBJ)
STREAM)
YSIZE _ (FONTPROP STREAM 'HEIGHT)
YDESC _ (FONTPROP STREAM 'DESCENT)
XKERN _ 0)))
(xref.putfn
(lambda (obj stream) (* |fsg| "29-Jul-87 09:08")
@@ -132,9 +129,11 @@
stream)))
(XREF.GETFN
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 16-Mar-2024 07:49 by rmk")
(LAMBDA (STREAM COPY.OBJECT) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:49 by rmk")
(* |fsg| "20-Aug-87 14:59")
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYW TEXTOBJ))
(DECLARE (USEDFREE TSTREAM))
(TSP.SETUP.FMMENU (\\TEDIT.PRIMARYPANE TSTREAM))
(LET* ((XREF.ARGS (OR COPY.OBJECT (CDR (READ STREAM))))
(XREF.OBJ (XREF (CAR XREF.ARGS))))
(IMAGEOBJPROP XREF.OBJ 'REFERENCE.BY (OR (CADR XREF.ARGS)
@@ -155,6 +154,7 @@
(XREF.BUTTONEVENTINFN
(LAMBDA (XREFOBJ STREAM SELECTION RELX RELY WINDOW HOSTSTREAM BUTTON)
(* \; "Edited 20-Apr-2024 12:56 by rmk")
(* \; "Edited 16-Mar-2024 07:55 by rmk")
(* \; "Edited 26-Dec-2023 11:56 by rmk")
(* \; "Edited 9-Nov-97 08:09 by rmk:")
@@ -186,7 +186,7 @@
'RIGHT NIL T 'INVERTED)
(AND NIL (TEDIT.SHOWSEL HOSTSTREAM T)
(TEDIT.NORMALIZECARET HOSTSTREAM))
(RETFROM (FUNCTION \\TEDIT.SELECT.LINE.SCANNER)
(RETFROM (FUNCTION \\TEDIT.XYTOSEL)
(TEDIT.GETSEL HOSTSTREAM))
ELSE (TEDIT.PROMPTPRINT STREAM "Reference has no definition!" T))
NIL))
@@ -252,12 +252,14 @@
"/" reference.by ">"))))))
(XREF.GET.TOOBJ
(LAMBDA (TAG) (* \; "Edited 16-Mar-2024 07:49 by rmk")
(LAMBDA (TAG) (* \; "Edited 25-Jun-2024 11:59 by rmk")
(* \; "Edited 16-Mar-2024 07:49 by rmk")
(* |fsg| "13-Jul-87 11:13")
(DECLARE (USEDFREE TSTREAM))
(* |;;| "This function is called in a specific context where a reference must be displayed. It is called by an XREF object and should return the IMAGEOBJECT that the XREF object is referencing.")
(GETHASH TAG (WINDOWPROP (\\TEDIT.PRIMARYW TEXTOBJ)
(GETHASH TAG (WINDOWPROP (\\TEDIT.PRIMARYPANE TSTREAM)
'TSP.CODE.ARRAY))))
(tspobj.gettype
@@ -476,14 +478,14 @@
(FILESLOAD (COMPILED SYSLOAD)
TMAX)
(DECLARE\: DONTCOPY
(FILEMAP (NIL (3691 11273 (XREF 3701 . 4268) (XREFP 4270 . 4657) (XREF.DISPLAYFN 4659 . 5093) (
XREF.IMAGEBOXFN 5095 . 5747) (XREF.PUTFN 5749 . 5995) (XREF.GETFN 5997 . 6526) (XREF.COPYFN 6528 .
7138) (XREF.BUTTONEVENTINFN 7140 . 10246) (XREF.WHENDELETEDFN 10248 . 10822) (XREF.TEDIT-TO-TEX-FN
10824 . 11271)) (11274 13249 (XREF.GET.DISPLAY.TEXT 11284 . 12568) (XREF.GET.TOOBJ 12570 . 13098) (
TSPOBJ.GETTYPE 13100 . 13247)) (13250 19624 (UPDATE.XREFS 13260 . 15643) (INSERT.REF 15645 . 16057) (
GET.REF 16059 . 17114) (GET.REFERENCE.BY 17116 . 18103) (TSP.LIST.REFS 18105 . 18557) (TSP.GET.INCODE
18559 . 19213) (TSP.GETCODEVAL 19215 . 19437) (TSP.PUTCODE 19439 . 19622)) (19716 20687 (
XREF.ADD.DISPLAYFN 19726 . 20240) (XREF.GET.DISPLAYFN 20242 . 20685)) (20747 23109 (
NGROUP.XREF.DISPLAYFN 20757 . 21717) (NGROUP.XREF.DISPLAY.TEXT 21719 . 22355) (NOTE.XREF.DISPLAYFN
22357 . 23107)))))
(FILEMAP (NIL (3626 11427 (XREF 3636 . 4203) (XREFP 4205 . 4592) (XREF.DISPLAYFN 4594 . 5028) (
XREF.IMAGEBOXFN 5030 . 5655) (XREF.PUTFN 5657 . 5903) (XREF.GETFN 5905 . 6583) (XREF.COPYFN 6585 .
7195) (XREF.BUTTONEVENTINFN 7197 . 10400) (XREF.WHENDELETEDFN 10402 . 10976) (XREF.TEDIT-TO-TEX-FN
10978 . 11425)) (11428 13552 (XREF.GET.DISPLAY.TEXT 11438 . 12722) (XREF.GET.TOOBJ 12724 . 13401) (
TSPOBJ.GETTYPE 13403 . 13550)) (13553 19927 (UPDATE.XREFS 13563 . 15946) (INSERT.REF 15948 . 16360) (
GET.REF 16362 . 17417) (GET.REFERENCE.BY 17419 . 18406) (TSP.LIST.REFS 18408 . 18860) (TSP.GET.INCODE
18862 . 19516) (TSP.GETCODEVAL 19518 . 19740) (TSP.PUTCODE 19742 . 19925)) (20019 20990 (
XREF.ADD.DISPLAYFN 20029 . 20543) (XREF.GET.DISPLAYFN 20545 . 20988)) (21050 23412 (
NGROUP.XREF.DISPLAYFN 21060 . 22020) (NGROUP.XREF.DISPLAY.TEXT 22022 . 22658) (NOTE.XREF.DISPLAYFN
22660 . 23410)))))
STOP

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

Binary file not shown.

BIN
lispusers/tmax/TMAX.LCOM
View File

Binary file not shown.

BIN
lispusers/tmax/TMAX.pdf Normal file
View File

Binary file not shown.

89
sources/ADISPLAY
View File

@@ -1,13 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 2-Nov-2023 23:35:15" {WMEDLEY}<sources>ADISPLAY.;12 245350
(FILECREATED "19-Dec-2023 11:23:08" {WMEDLEY}<sources>ADISPLAY.;13 245192
:EDIT-BY rmk
:CHANGES-TO (VARS ADISPLAYCOMS)
(FNS SCREENREGIONP)
:CHANGES-TO (FNS \CARET.FLASH?)
:PREVIOUS-DATE " 1-Mar-2023 07:49:03" {WMEDLEY}<sources>ADISPLAY.;11)
:PREVIOUS-DATE " 2-Nov-2023 23:35:15" {WMEDLEY}<sources>ADISPLAY.;12)
(PRETTYCOMPRINT ADISPLAYCOMS)
@@ -751,9 +750,10 @@
\CARET.TIMER])
(\CARET.FLASH?
[LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* AJB "17-Jul-85 12:47")
[LAMBDA (STREAM CARET ONRATE OFFRATE X Y) (* ; "Edited 19-Dec-2023 11:22 by rmk")
(* AJB "17-Jul-85 12:47")
(* ;;; "Flashes the CARET at the ONRATE/OFFRATE at the X,Y position in the current TTY window. If CARET is NIL, uses \CARET.DEFAULT as the caret. Takes either a display stream or a textstream as the destination stream to flash the caret. The caret is not flashed on a shift-selection in a window")
(* ;;; "Flashes the CARET at the ONRATE/OFFRATE at the X,Y position in the current TTY window. If CARET is NIL, uses \CARET.DEFAULT as the caret. Takes either a display stream as the destination stream to flash the caret. The caret is not flashed on a shift-selection in a window")
(COND
(\CARET.UP [COND
@@ -765,10 +765,7 @@
NIL)
((AND (OR CARET (SETQ CARET \CARET.DEFAULT))
(TIMEREXPIRED? \CARET.TIMER)
[OR [DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM]
(AND (IMAGESTREAMTYPEP STREAM 'TEXT)
(SETQ STREAM (WINDOWPROP (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ STREAM)))
'DSP]
[DISPLAYSTREAMP (OR STREAM (SETQ STREAM (TTYDISPLAYSTREAM]
(\CARET.FLASH CARET STREAM OFFRATE (OR (KEYDOWNP 'LSHIFT)
(KEYDOWNP 'RSHIFT)
(KEYDOWNP 'COPY))
@@ -4437,40 +4434,40 @@
(ADDTOVAR LAMA UNIONREGIONS INTERSECTREGIONS)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (10558 10752 (SCREENREGIONP 10568 . 10750)) (12196 19557 (\BBTCURVEPT 12206 . 19555)) (
19558 29374 (CREATETEXTUREFROMBITMAP 19568 . 21498) (PRINTBITMAP 21500 . 22851) (PRINT-BITMAPS-NICELY
22853 . 26704) (PRINTCURSOR 26706 . 27739) (\WRITEBITMAP 27741 . 29372)) (29417 31965 (\GETINTEGERPART
29427 . 30972) (\CONVERTTOFRACTION 30974 . 31963)) (32102 32974 (CURSORP 32112 . 32331) (CURSORBITMAP
32333 . 32379) (CreateCursorBitMap 32381 . 32972)) (37336 46379 (CARET 37346 . 39106) (\CARET.CREATE
39108 . 39286) (\CARET.DOWN 39288 . 40640) (\CARET.FLASH? 40642 . 42456) (\CARET.SHOW 42458 . 43027) (
CARETRATE 43029 . 43687) (\CARET.FLASH.AGAIN 43689 . 44855) (\CARET.FLASH.MULTIPLE 44857 . 45380) (
\CARET.FLASH 45382 . 46377)) (46380 51452 (\MEDW.CARET.SHOW 46390 . 51450)) (51816 53651 (
\AREAVISIBLE? 51826 . 52750) (\REGIONOVERLAPAREAP 52752 . 53297) (\AREAINREGIONP 53299 . 53649)) (
53700 66176 (CREATEREGION 53710 . 54046) (REGIONP 54048 . 54194) (INTERSECTREGIONS 54196 . 56966) (
UNIONREGIONS 56968 . 59119) (REGIONSINTERSECTP 59121 . 59729) (SUBREGIONP 59731 . 60376) (EXTENDREGION
60378 . 62535) (EXTENDREGIONBOTTOM 62537 . 63179) (EXTENDREGIONLEFT 63181 . 63800) (EXTENDREGIONRIGHT
63802 . 64355) (EXTENDREGIONTOP 64357 . 64898) (INSIDEP 64900 . 65668) (STRINGREGION 65670 . 66174))
(66421 71695 (\BRUSHBITMAP 66431 . 68148) (\GETBRUSH 68150 . 68461) (\GETBRUSHBBT 68463 . 70491) (
\InitCurveBrushes 70493 . 71559) (\BrushFromWidth 71561 . 71693)) (71696 74763 (\MAKEBRUSH.DIAGONAL
71706 . 71986) (\MAKEBRUSH.HORIZONTAL 71988 . 72382) (\MAKEBRUSH.VERTICAL 72384 . 72696) (
\MAKEBRUSH.SQUARE 72698 . 72975) (\MAKEBRUSH.ROUND 72977 . 74761)) (74764 75929 (INSTALLBRUSH 74774 .
75927)) (76330 87732 (\DRAWLINE.DISPLAY 76340 . 86447) (RELMOVETO 86449 . 86836) (MOVETOUPPERLEFT
86838 . 87730)) (87733 111218 (\CLIPANDDRAWLINE 87743 . 94189) (\CLIPANDDRAWLINE1 94191 . 105939) (
\CLIPCODE 105941 . 107315) (\LEASTPTAT 107317 . 107915) (\GREATESTPTAT 107917 . 108545) (\DRAWLINE1
108547 . 109663) (\DRAWLINE.UFN 109665 . 111216)) (115748 161795 (\DRAWCIRCLE.DISPLAY 115758 . 124571)
(\DRAWARC.DISPLAY 124573 . 124863) (\DRAWARC.GENERIC 124865 . 125618) (\COMPUTE.ARC.POINTS 125620 .
127885) (\DRAWELLIPSE.DISPLAY 127887 . 143556) (\DRAWCURVE.DISPLAY 143558 . 145847) (
\DRAWPOINT.DISPLAY 145849 . 147045) (\DRAWPOLYGON.DISPLAY 147047 . 150575) (\LINEWITHBRUSH 150577 .
161793)) (161796 193488 (LOADPOLY 161806 . 162366) (PARAMETRICSPLINE 162368 . 172565) (\CURVE 172567
. 178169) (\CURVE2 178171 . 189502) (\CURVEEND 189504 . 189986) (\CURVESLOPE 189988 . 192471) (
\CURVESTART 192473 . 192797) (\FDIFS/FROM/DERIVS 192799 . 193486)) (206017 220353 (\FILLCIRCLE.DISPLAY
206027 . 216775) (\LINEBLT 216777 . 220351)) (220397 222397 (SCREENBITMAP 220407 . 220884) (BITMAPP
220886 . 221120) (BITMAPHEIGHT 221122 . 221498) (BITSPERPIXEL 221500 . 222395)) (223038 224031 (
DSPFILL 223048 . 223731) (INVERTW 223733 . 224029)) (224032 227675 (\DSPCOLOR.DISPLAY 224042 . 225339)
(\DSPBACKCOLOR.DISPLAY 225341 . 226720) (DSPEOLFN 226722 . 227673)) (228108 232762 (DSPCLEOL 228118
. 228994) (DSPRUBOUTCHAR 228996 . 229428) (\DSPMOVELR 229430 . 232760)) (232892 234010 (
\CURSOR.DEFPRINT 232902 . 234008)) (234422 242996 (TEXTUREOFCOLOR 234432 . 235694) (\PRIMARYTEXTURE
235696 . 236278) (\LEVELTEXTURE 236280 . 236781) (INSURE.B&W.TEXTURE 236783 . 238178) (
INSURE.RGB.COLOR 238180 . 239608) (\LOOKUPCOLORNAME 239610 . 239880) (RGBP 239882 . 240647) (HLSP
240649 . 241024) (HLSTORGB 241026 . 242166) (\HLSVALUEFN 242168 . 242994)))))
(FILEMAP (NIL (10520 10714 (SCREENREGIONP 10530 . 10712)) (12158 19519 (\BBTCURVEPT 12168 . 19517)) (
19520 29336 (CREATETEXTUREFROMBITMAP 19530 . 21460) (PRINTBITMAP 21462 . 22813) (PRINT-BITMAPS-NICELY
22815 . 26666) (PRINTCURSOR 26668 . 27701) (\WRITEBITMAP 27703 . 29334)) (29379 31927 (\GETINTEGERPART
29389 . 30934) (\CONVERTTOFRACTION 30936 . 31925)) (32064 32936 (CURSORP 32074 . 32293) (CURSORBITMAP
32295 . 32341) (CreateCursorBitMap 32343 . 32934)) (37298 46221 (CARET 37308 . 39068) (\CARET.CREATE
39070 . 39248) (\CARET.DOWN 39250 . 40602) (\CARET.FLASH? 40604 . 42298) (\CARET.SHOW 42300 . 42869) (
CARETRATE 42871 . 43529) (\CARET.FLASH.AGAIN 43531 . 44697) (\CARET.FLASH.MULTIPLE 44699 . 45222) (
\CARET.FLASH 45224 . 46219)) (46222 51294 (\MEDW.CARET.SHOW 46232 . 51292)) (51658 53493 (
\AREAVISIBLE? 51668 . 52592) (\REGIONOVERLAPAREAP 52594 . 53139) (\AREAINREGIONP 53141 . 53491)) (
53542 66018 (CREATEREGION 53552 . 53888) (REGIONP 53890 . 54036) (INTERSECTREGIONS 54038 . 56808) (
UNIONREGIONS 56810 . 58961) (REGIONSINTERSECTP 58963 . 59571) (SUBREGIONP 59573 . 60218) (EXTENDREGION
60220 . 62377) (EXTENDREGIONBOTTOM 62379 . 63021) (EXTENDREGIONLEFT 63023 . 63642) (EXTENDREGIONRIGHT
63644 . 64197) (EXTENDREGIONTOP 64199 . 64740) (INSIDEP 64742 . 65510) (STRINGREGION 65512 . 66016))
(66263 71537 (\BRUSHBITMAP 66273 . 67990) (\GETBRUSH 67992 . 68303) (\GETBRUSHBBT 68305 . 70333) (
\InitCurveBrushes 70335 . 71401) (\BrushFromWidth 71403 . 71535)) (71538 74605 (\MAKEBRUSH.DIAGONAL
71548 . 71828) (\MAKEBRUSH.HORIZONTAL 71830 . 72224) (\MAKEBRUSH.VERTICAL 72226 . 72538) (
\MAKEBRUSH.SQUARE 72540 . 72817) (\MAKEBRUSH.ROUND 72819 . 74603)) (74606 75771 (INSTALLBRUSH 74616 .
75769)) (76172 87574 (\DRAWLINE.DISPLAY 76182 . 86289) (RELMOVETO 86291 . 86678) (MOVETOUPPERLEFT
86680 . 87572)) (87575 111060 (\CLIPANDDRAWLINE 87585 . 94031) (\CLIPANDDRAWLINE1 94033 . 105781) (
\CLIPCODE 105783 . 107157) (\LEASTPTAT 107159 . 107757) (\GREATESTPTAT 107759 . 108387) (\DRAWLINE1
108389 . 109505) (\DRAWLINE.UFN 109507 . 111058)) (115590 161637 (\DRAWCIRCLE.DISPLAY 115600 . 124413)
(\DRAWARC.DISPLAY 124415 . 124705) (\DRAWARC.GENERIC 124707 . 125460) (\COMPUTE.ARC.POINTS 125462 .
127727) (\DRAWELLIPSE.DISPLAY 127729 . 143398) (\DRAWCURVE.DISPLAY 143400 . 145689) (
\DRAWPOINT.DISPLAY 145691 . 146887) (\DRAWPOLYGON.DISPLAY 146889 . 150417) (\LINEWITHBRUSH 150419 .
161635)) (161638 193330 (LOADPOLY 161648 . 162208) (PARAMETRICSPLINE 162210 . 172407) (\CURVE 172409
. 178011) (\CURVE2 178013 . 189344) (\CURVEEND 189346 . 189828) (\CURVESLOPE 189830 . 192313) (
\CURVESTART 192315 . 192639) (\FDIFS/FROM/DERIVS 192641 . 193328)) (205859 220195 (\FILLCIRCLE.DISPLAY
205869 . 216617) (\LINEBLT 216619 . 220193)) (220239 222239 (SCREENBITMAP 220249 . 220726) (BITMAPP
220728 . 220962) (BITMAPHEIGHT 220964 . 221340) (BITSPERPIXEL 221342 . 222237)) (222880 223873 (
DSPFILL 222890 . 223573) (INVERTW 223575 . 223871)) (223874 227517 (\DSPCOLOR.DISPLAY 223884 . 225181)
(\DSPBACKCOLOR.DISPLAY 225183 . 226562) (DSPEOLFN 226564 . 227515)) (227950 232604 (DSPCLEOL 227960
. 228836) (DSPRUBOUTCHAR 228838 . 229270) (\DSPMOVELR 229272 . 232602)) (232734 233852 (
\CURSOR.DEFPRINT 232744 . 233850)) (234264 242838 (TEXTUREOFCOLOR 234274 . 235536) (\PRIMARYTEXTURE
235538 . 236120) (\LEVELTEXTURE 236122 . 236623) (INSURE.B&W.TEXTURE 236625 . 238020) (
INSURE.RGB.COLOR 238022 . 239450) (\LOOKUPCOLORNAME 239452 . 239722) (RGBP 239724 . 240489) (HLSP
240491 . 240866) (HLSTORGB 240868 . 242008) (\HLSVALUEFN 242010 . 242836)))))
STOP

BIN
sources/ADISPLAY.LCOM
View File

Binary file not shown.

50
sources/UFS
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Sep-2023 09:22:55" {DSK}<Users>briggs>Projects>medley>sources>UFS.;2 78813
(FILECREATED "10-Dec-2024 14:53:34" {WMEDLEY}<sources>UFS.;36 78539
:EDIT-BY "briggs"
:EDIT-BY rmk
:CHANGES-TO (FNS \UFSCloseFile)
:CHANGES-TO (VARS UFSCOMS)
:PREVIOUS-DATE "29-Mar-2022 11:29:33" {DSK}<Users>briggs>Projects>medley>sources>UFS.;1)
:PREVIOUS-DATE "16-Sep-2023 09:22:55" {WMEDLEY}<sources>UFS.;33)
(PRETTYCOMPRINT UFSCOMS)
@@ -89,8 +89,6 @@
(HTML . TEXT)
(HTM . TEXT)
(TEX . TEXT)
(PS . TEXT)
(PDF . TEXT)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
@@ -797,8 +795,6 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(HTML . TEXT)
(HTM . TEXT)
(TEX . TEXT)
(PS . TEXT)
(PDF . TEXT)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
@@ -1156,23 +1152,23 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(ADDTOVAR LAMA )
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (8909 10462 (\UFSCreateDevice 8919 . 9284) (\UFS.CREATE.DEVICE 9286 . 10142) (
\UFSOpenDevice 10144 . 10321) (\UFSCloseDevice 10323 . 10460)) (14725 51227 (\UFSOpenFile 14735 .
18029) (\UFS.OPENP 18031 . 18528) (\UFS.RECOGNIZE.FILE 18530 . 19283) (\UFS.DIRECTORY.NAME 19285 .
20028) (\UFSCloseFile 20030 . 21935) (\UFSGetFileName 21937 . 22136) (\UFSDeleteFile 22138 . 22678) (
\UFSRenameFile 22680 . 23845) (\UFSReadPages 23847 . 24982) (\UFSWritePages 24984 . 26204) (
\UFSTruncateFile 26206 . 27703) (\UFSDirectoryNameP 27705 . 28759) (\UFSEventFn 28761 . 29423) (
\UFSGetFileInfo 29425 . 31707) (\UFS.CREATE.PROPS 31709 . 32062) (\UFSSetFileInfo 32064 . 33293) (
\UFSGenerateFiles 33295 . 40175) (\UFS.NEXTFILEFN 40177 . 47815) (\UFS.FILEINFOFN 47817 . 49266) (
\UFS.VALID.PROPP 49268 . 49560) (\UFS.REGISTER.GFS 49562 . 49817) (\UFS.UNREGISTER.GFS 49819 . 50402)
(\UFS.ABORT.DIRECTORY 50404 . 50752) (\UFS.ABORT.CL-DIRECTORY 50754 . 51041) (\UFS.CLEANUP.GFS.TABLE
51043 . 51225)) (51262 57946 (\UFSMakeUnixFormatName 51272 . 52293) (\UFSParseNameString 52295 . 52669
) (\UFSParse-Directory 52671 . 53212) (\UFS.PARSE.BODY 53214 . 53759) (\UFS.ADJUST.HOST 53761 . 53920)
(\UFS.FULLNAME 53922 . 55130) (\UFS.ADD.HOST.FIELD 55132 . 55492) (\UFS.REMOVE.HOST.FIELD 55494 .
57164) (\UFS.HANDLE.RELATIVEDIRECTORY 57166 . 57944)) (58762 59375 (CHDIR 58772 . 59373)) (59447 60433
(\DEVICEFILE.EOSERROR 59457 . 60431)) (60506 61743 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60516 . 61361)
(\UNVISIBLE.FLUSH.OPEN.STREAMS 61363 . 61741)) (61776 63402 (\UFSError 61786 . 63400)) (63446 65861 (
\UFSGetFileType 63456 . 64057) (\UFSSetFileType 64059 . 64656) (\UFSeol 64658 . 65859)) (74508 75632 (
\UFSGetPrintFileType 74518 . 74930) (\UFSGetFileTypeConfirm 74932 . 75380) (\UFSPrintTypeMenu 75382 .
75630)) (75662 78500 (\UFStoOtherCopyMess 75672 . 77350) (\UFStoOtherRenameMess 77352 . 78498)))))
(FILEMAP (NIL (8676 10229 (\UFSCreateDevice 8686 . 9051) (\UFS.CREATE.DEVICE 9053 . 9909) (
\UFSOpenDevice 9911 . 10088) (\UFSCloseDevice 10090 . 10227)) (14492 50994 (\UFSOpenFile 14502 . 17796
) (\UFS.OPENP 17798 . 18295) (\UFS.RECOGNIZE.FILE 18297 . 19050) (\UFS.DIRECTORY.NAME 19052 . 19795) (
\UFSCloseFile 19797 . 21702) (\UFSGetFileName 21704 . 21903) (\UFSDeleteFile 21905 . 22445) (
\UFSRenameFile 22447 . 23612) (\UFSReadPages 23614 . 24749) (\UFSWritePages 24751 . 25971) (
\UFSTruncateFile 25973 . 27470) (\UFSDirectoryNameP 27472 . 28526) (\UFSEventFn 28528 . 29190) (
\UFSGetFileInfo 29192 . 31474) (\UFS.CREATE.PROPS 31476 . 31829) (\UFSSetFileInfo 31831 . 33060) (
\UFSGenerateFiles 33062 . 39942) (\UFS.NEXTFILEFN 39944 . 47582) (\UFS.FILEINFOFN 47584 . 49033) (
\UFS.VALID.PROPP 49035 . 49327) (\UFS.REGISTER.GFS 49329 . 49584) (\UFS.UNREGISTER.GFS 49586 . 50169)
(\UFS.ABORT.DIRECTORY 50171 . 50519) (\UFS.ABORT.CL-DIRECTORY 50521 . 50808) (\UFS.CLEANUP.GFS.TABLE
50810 . 50992)) (51029 57713 (\UFSMakeUnixFormatName 51039 . 52060) (\UFSParseNameString 52062 . 52436
) (\UFSParse-Directory 52438 . 52979) (\UFS.PARSE.BODY 52981 . 53526) (\UFS.ADJUST.HOST 53528 . 53687)
(\UFS.FULLNAME 53689 . 54897) (\UFS.ADD.HOST.FIELD 54899 . 55259) (\UFS.REMOVE.HOST.FIELD 55261 .
56931) (\UFS.HANDLE.RELATIVEDIRECTORY 56933 . 57711)) (58529 59142 (CHDIR 58539 . 59140)) (59214 60200
(\DEVICEFILE.EOSERROR 59224 . 60198)) (60273 61510 (\UNVISIBLE.PAGED.REVALIDATEFILELST 60283 . 61128)
(\UNVISIBLE.FLUSH.OPEN.STREAMS 61130 . 61508)) (61543 63169 (\UFSError 61553 . 63167)) (63213 65628 (
\UFSGetFileType 63223 . 63824) (\UFSSetFileType 63826 . 64423) (\UFSeol 64425 . 65626)) (74234 75358 (
\UFSGetPrintFileType 74244 . 74656) (\UFSGetFileTypeConfirm 74658 . 75106) (\UFSPrintTypeMenu 75108 .
75356)) (75388 78226 (\UFStoOtherCopyMess 75398 . 77076) (\UFStoOtherRenameMess 77078 . 78224)))))
STOP

BIN
sources/UFS.LCOM
View File

Binary file not shown.

187
sources/WINDOW
View File

@@ -1,21 +1,17 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "10-Apr-2023 07:05:18" {DSK}<home>larry>il>medley>sources>WINDOW.;2 222381
(FILECREATED "29-Jun-2024 00:18:05" {WMEDLEY}<sources>WINDOW.;21 221668
:EDIT-BY "lmm"
:EDIT-BY rmk
:CHANGES-TO (VARS WINDOWCOMS)
:CHANGES-TO (FNS WFROMDS)
:PREVIOUS-DATE " 9-Jul-2022 11:10:09" {DSK}<home>larry>il>medley>sources>WINDOW.;1)
:PREVIOUS-DATE "10-Apr-2023 07:05:18" {WMEDLEY}<sources>WINDOW.;20)
(* ; "
Copyright (c) 1982-1988, 1990-1994, 1999-2000, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT WINDOWCOMS)
(RPAQQ WINDOWCOMS
(RPAQQ WINDOWCOMS
[(COMS (FNS WINDOWWORLD WINDOWWORLDP CHANGEBACKGROUND CHANGEBACKGROUNDBORDER TILE
\TTY.CREATING.DISPLAYSTREAM \CREATE.TTY.OUTCHARFN \CREATE.TTYDISPLAYSTREAM
HASTTYWINDOWP TTYINFOSTREAM CREATESCREEN \INSURESCREEN \BITMAPTOSCREEN MAINSCREEN)
@@ -1390,23 +1386,23 @@ Middle button down moves closest corner.")
)
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
[PUTPROPS .COPYKEYDOWNP. MACRO (NIL (OR (KEYDOWNP 'LSHIFT)
(PUTPROPS .COPYKEYDOWNP. MACRO [NIL (OR (KEYDOWNP 'LSHIFT)
(KEYDOWNP 'RSHIFT)
(KEYDOWNP 'COPY]
(KEYDOWNP 'COPY])
[PUTPROPS WSOP MACRO (ARGS (LET ((METHOD (CADR (CAR ARGS)))
(PUTPROPS WSOP MACRO [ARGS (LET ((METHOD (CADR (CAR ARGS)))
(DISPLAY (CADR ARGS))
(OTHERARGS (CDDR ARGS)))
`(SPREADAPPLY* (fetch (WSOPS ,METHOD) of (fetch (FDEV WINDOWOPS)
of ,DISPLAY))
,DISPLAY
,@OTHERARGS]
,@OTHERARGS])
)
(* "END EXPORTED DEFINITIONS")
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
(PUTPROPS WSOP ARGNAMES (METHOD DISPLAY . OTHERARGS))
(DECLARE%: EVAL@COMPILE
(RECORD WSOPS (STARTBOARD STARTCOLOR STOPCOLOR EVENTFN SENDCOLORMAPENTRY SENDPAGE PILOTBITBLT))
@@ -1807,7 +1803,8 @@ Middle button down moves closest corner.")
(DEFINEQ
(WFROMDS
[LAMBDA (DS DONTCREATE) (* ; "Edited 7-Jan-94 12:12 by nilsson")
[LAMBDA (DS DONTCREATE) (* ; "Edited 29-Jun-2024 00:17 by rmk")
(* ; "Edited 7-Jan-94 12:12 by nilsson")
(* ;; "Finds or creates a window for a display stream")
@@ -1822,9 +1819,9 @@ Middle button down moves closest corner.")
[COND
((IMAGESTREAMTYPEP DS 'TEXT)
(* ;; "generalize this mess!!!")
(* ;; "generalize this mess!!! (If type TEXT exists, then these functions exist)")
(RETURN (CAR (fetch (TEXTOBJ \WINDOW) of (TEXTOBJ DS]
(RETURN (\TEDIT.PRIMARYPANE (TEXTOBJ DS]
(SETQ DD (\GETDISPLAYDATA DS DS))
(RETURN (COND
((AND (SETQ HINTW (fetch (\DISPLAYDATA XWINDOWHINT) of DD))
@@ -1834,7 +1831,7 @@ Middle button down moves closest corner.")
[(AND (EQ DS \DEFAULTTTYDISPLAYSTREAM)
(EQ (TTYDISPLAYSTREAM)
\DEFAULTTTYDISPLAYSTREAM))(* ;
 "assume this process is doing something with T.")
 "assume this process is doing something with T.")
(COND
((NOT DONTCREATE)
(\CREATE.TTYDISPLAYSTREAM)
@@ -1842,7 +1839,7 @@ Middle button down moves closest corner.")
([SETQ HINTW (for WINDOW in (OPENWINDOWS T)
thereis (EQ DS (fetch (WINDOW DSP) of WINDOW]
(* ;
 "(OPENWINDOWS T) returns all windows on all screens")
 "(OPENWINDOWS T) returns all windows on all screens")
HINTW)
((NOT DONTCREATE)
(CREATEW NIL NIL NIL T])
@@ -1869,15 +1866,15 @@ Middle button down moves closest corner.")
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
[PUTPROPS \COERCETODS MACRO (OPENLAMBDA (X)
(PUTPROPS \COERCETODS MACRO [OPENLAMBDA (X)
(COND
((type? WINDOW X)
(fetch (WINDOW DSP) of X))
(T (\ILLEGAL.ARG X]
(T (\ILLEGAL.ARG X])
[PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(PUTPROPS .WHILE.ON.TOP. MACRO ((FIRST . REST)
(UNINTERRUPTABLY
(\INTERNALTOTOPW FIRST) . REST)]
(\INTERNALTOTOPW FIRST) . REST)))
)
(* "END EXPORTED DEFINITIONS")
@@ -2043,7 +2040,7 @@ Middle button down moves closest corner.")
(* ; "Compiled WINDOWPROP")
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(PUTPROPS WINDOWPROP ARGNAMES (NIL (WINDOW PROP {NEWVALUE}) . U))
(DEFOPTIMIZER WINDOWPROP (&REST ARGS)
(CWINDOWPROP ARGS))
@@ -3512,7 +3509,7 @@ Middle button down moves closest corner.")
(DECLARE%: EVAL@COMPILE DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
[PUTPROPS WINDOWOP DMACRO (ARGS (LET ((OPNAME (CAR ARGS))
(PUTPROPS WINDOWOP DMACRO [ARGS (LET ((OPNAME (CAR ARGS))
(METHOD-DEVICE (CADR ARGS))
(TAIL (CDDR ARGS)))
(COND
@@ -3523,7 +3520,7 @@ Middle button down moves closest corner.")
of ,METHOD-DEVICE)
,METHOD-DEVICE
,@TAIL]
(T (ERROR "OPNAME not quoted: " OPNAME]
(T (ERROR "OPNAME not quoted: " OPNAME])
)
(* "END EXPORTED DEFINITIONS")
@@ -3938,42 +3935,40 @@ Middle button down moves closest corner.")
(FILESLOAD PAINTW)
(ADDTOVAR WindowMenuCommands (Close '\INTERACTIVE.CLOSEW "Closes a window")
(Snap 'SNAPW "Saves a snapshot of a region of the screen.")
(Paint 'PAINTW
(ADDTOVAR WindowMenuCommands
(Close '\INTERACTIVE.CLOSEW "Closes a window")
(Snap 'SNAPW "Saves a snapshot of a region of the screen.")
(Paint 'PAINTW
"Starts a painting mode in which the mouse can be
used to draw pictures or make notes on windows.")
(Clear 'CLEARW "Clears a window to its gray.")
(Bury 'BURYW "Puts a window on the bottom.")
(Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.")
(Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE
"Puts image on a file; prompts for filename and format"
)
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
"Sends image to a printer of your choosing")))
(Move 'MOVEW "Moves a window by a corner.")
(Shape 'SHAPEW "Gets a new region for a window.
(Clear 'CLEARW "Clears a window to its gray.")
(Bury 'BURYW "Puts a window on the bottom.")
(Redisplay 'REDISPLAYW "Redisplays a window using its REPAINTFN.")
(Hardcopy 'HARDCOPYIMAGEW "Prints a window using its HARDCOPYFN."
(SUBITEMS ("To a file" 'HARDCOPYIMAGEW.TOFILE
"Puts image on a file; prompts for filename and format")
("To a printer" 'HARDCOPYIMAGEW.TOPRINTER
"Sends image to a printer of your choosing")))
(Move 'MOVEW "Moves a window by a corner.")
(Shape 'SHAPEW "Gets a new region for a window.
Left button down marks fixed corner; sweep to other corner.
Middle button down moves closest corner.")
(Shrink 'SHRINKW
"Replaces this window with its icon (or title if it doesn't have an icon."
))
(Shrink 'SHRINKW "Replaces this window with its icon (or title if it doesn't have an icon."
))
(ADDTOVAR BackgroundMenuCommands (SaveVM '(SAVEVM)
"Updates the virtual memory.")
(Snap '(SNAPW)
"Saves a snapshot of a region of the screen.")
(Hardcopy '(HARDCOPYW)
"Send hardcopy of screen region to printer."
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
(ADDTOVAR BackgroundMenuCommands
(SaveVM '(SAVEVM)
"Updates the virtual memory.")
(Snap '(SNAPW)
"Saves a snapshot of a region of the screen.")
(Hardcopy '(HARDCOPYW)
"Send hardcopy of screen region to printer."
(SUBITEMS ("To a file" '(HARDCOPYREGION.TOFILE)
"Writes a region of screen to a file; prompts for filename and format"
)
("To a printer" '(HARDCOPYREGION.TOPRINTER)
"Sends a region of screen to a printer of your choosing"
))))
)
("To a printer" '(HARDCOPYREGION.TOPRINTER)
"Sends a region of screen to a printer of your choosing"))))
(ADDTOVAR WINDOWUSERFORMS )
@@ -3998,7 +3993,7 @@ Middle button down moves closest corner.")
(* ;; "Arrange for the proper compiler")
(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE)
(PUTPROPS WINDOW FILETYPE :FAKE-COMPILE-FILE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
@@ -4007,45 +4002,43 @@ Middle button down moves closest corner.")
(ADDTOVAR LAMA PROMPTPRINT WINDOWPROP DOWINDOWCOM)
)
(PUTPROPS WINDOW COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1990 1991
1992 1993 1994 1999 2000 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11535 26175 (WINDOWWORLD 11545 . 15298) (WINDOWWORLDP 15300 . 15600) (CHANGEBACKGROUND
15602 . 16639) (CHANGEBACKGROUNDBORDER 16641 . 17192) (TILE 17194 . 17786) (
\TTY.CREATING.DISPLAYSTREAM 17788 . 18335) (\CREATE.TTY.OUTCHARFN 18337 . 18637) (
\CREATE.TTYDISPLAYSTREAM 18639 . 21678) (HASTTYWINDOWP 21680 . 21960) (TTYINFOSTREAM 21962 . 22486) (
CREATESCREEN 22488 . 25431) (\INSURESCREEN 25433 . 25682) (\BITMAPTOSCREEN 25684 . 26045) (MAINSCREEN
26047 . 26173)) (26822 44105 (WINDOW.MOUSE.HANDLER 26832 . 39627) (\PROTECTED.APPLY 39629 . 39877) (
DOWINDOWCOM 39879 . 41899) (DOBACKGROUNDCOM 41901 . 43059) (DEFAULT.BACKGROUND.COPYFN 43061 . 44103))
(44186 76069 (BURYW 44196 . 44484) (CLEARW 44486 . 44876) (CLOSEW 44878 . 45652) (\CLOSEW1 45654 .
46007) (\OKTOCLOSEW 46009 . 46368) (\INTERACTIVE.CLOSEW 46370 . 47193) (OPENW 47195 . 48250) (
DOUSERFNS 48252 . 49413) (DOUSERFNS2 49415 . 49911) (\USERFNISDON'T 49913 . 50184) (\OPENW1 50186 .
50536) (CREATEW 50538 . 51802) (CREATEW1 51804 . 54082) (\CREATEW1 54084 . 55303) (OPENDISPLAYSTREAM
55305 . 55628) (MOVEW 55630 . 55845) (PPROMPT3 55847 . 56175) (\ONSCREENCLIPPINGREGION 56177 . 56728)
(RELMOVEW 56730 . 57028) (SHAPEW 57030 . 61949) (SHAPEW1 61951 . 64653) (\SHAPEW2 64655 . 67341) (
RESHOWBORDER 67343 . 67854) (\RESHOWBORDER1 67856 . 72782) (TRACKW 72784 . 73899) (SNAPW 73901 . 75574
) (WINDOWREGION 75576 . 76067)) (76070 76766 (MINIMUMWINDOWSIZE 76080 . 76764)) (78391 101656 (
ADVISEWDS 78401 . 86344) (SHOWWFRAME 86346 . 88098) (SHOWWTITLE 88100 . 92134) (\STRINGWIDTHGUESS
92136 . 92495) (RESHOWTITLE 92497 . 97138) (TOTOPW 97140 . 97379) (\INTERNALTOTOPW 97381 . 98471) (
\TTW1 98473 . 101073) (WHICHW 101075 . 101654)) (101785 104623 (WFROMDS 101795 . 103793) (NU\TOTOPWDS
103795 . 104231) (\COERCETODS 104233 . 104621)) (105248 112048 (WINDOWP 105258 . 105404) (
INSURE.WINDOW 105406 . 105745) (WINDOWPROP 105747 . 106179) (WINDOWADDPROP 106181 . 107915) (
WINDOWDELPROP 107917 . 108343) (GETWINDOWPROP 108345 . 108895) (GETWINDOWUSERPROP 108897 . 109324) (
PUTWINDOWPROP 109326 . 109791) (REMWINDOWPROP 109793 . 110848) (WINDOWADDFNPROP 110850 . 112046)) (
112248 119812 (CWINDOWPROP 112258 . 113263) (CGETWINDOWPROP 113265 . 118483) (\GETWINDOWHEIGHT 118485
. 119393) (\GETWINDOWWIDTH 119395 . 119810)) (119813 120472 (WINDOW.BITMAP 119823 . 120470)) (120498
135946 (OPENWP 120508 . 120786) (TOPWP 120788 . 121071) (RESHAPEBYREPAINTFN 121073 . 131325) (
\INBETWEENP 131327 . 131543) (DECODE/WINDOW/OR/DISPLAYSTREAM 131545 . 133585) (GROW/REGION 133587 .
134150) (CLRPROMPT 134152 . 134556) (PROMPTPRINT 134558 . 134822) (OPENWINDOWS 134824 . 135608) (
\INSUREWINDOW 135610 . 135944)) (136077 139326 (OVERLAPPINGWINDOWS 136087 . 138369) (WOVERLAPP 138371
. 138626) (ORDERFROMBOTTOMTOTOP 138628 . 139324)) (139375 144158 (\ONSCREENW 139385 . 140091) (
\PUTONSCREENW 140093 . 140920) (\UPDATECACHEDFIELDS 140922 . 141186) (\WWCHANGESCREENSIZE 141188 .
142577) (CREATEWFROMIMAGE 142579 . 143542) (UPDATEWFROMIMAGE 143544 . 144156)) (144715 197317 (
\MEDW.CREATEW 144725 . 149399) (\MEDW.OPENW 149401 . 151759) (\MEDW.CLOSEW 151761 . 153127) (
\MEDW.MOVEW 153129 . 163741) (\MEDW.RELMOVEW 163743 . 164122) (\MEDW.SHRINKW 164124 . 172308) (
\MEDW.EXPANDW 172310 . 174577) (\MEDW.SHAPEW 174579 . 179185) (\MEDW.REDISPLAYW 179187 . 181142) (
\MEDW.BURYW 181144 . 182426) (\MEDW.TOTOPW 182428 . 183776) (\MEDW.DSPCREATE 183778 . 184579) (
\GENERIC.DSPCREATE 184581 . 186298) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186300 . 186486) (
\MEDW.GETWINDOWPROP 186488 . 188726) (\MEDW.PUTWINDOWPROP 188728 . 195513) (\MEDW.CURSOR 195515 .
197315)) (197318 197938 (\GENERIC.CURSOR 197328 . 197936)))))
(FILEMAP (NIL (11403 26043 (WINDOWWORLD 11413 . 15166) (WINDOWWORLDP 15168 . 15468) (CHANGEBACKGROUND
15470 . 16507) (CHANGEBACKGROUNDBORDER 16509 . 17060) (TILE 17062 . 17654) (
\TTY.CREATING.DISPLAYSTREAM 17656 . 18203) (\CREATE.TTY.OUTCHARFN 18205 . 18505) (
\CREATE.TTYDISPLAYSTREAM 18507 . 21546) (HASTTYWINDOWP 21548 . 21828) (TTYINFOSTREAM 21830 . 22354) (
CREATESCREEN 22356 . 25299) (\INSURESCREEN 25301 . 25550) (\BITMAPTOSCREEN 25552 . 25913) (MAINSCREEN
25915 . 26041)) (26690 43973 (WINDOW.MOUSE.HANDLER 26700 . 39495) (\PROTECTED.APPLY 39497 . 39745) (
DOWINDOWCOM 39747 . 41767) (DOBACKGROUNDCOM 41769 . 42927) (DEFAULT.BACKGROUND.COPYFN 42929 . 43971))
(44054 75937 (BURYW 44064 . 44352) (CLEARW 44354 . 44744) (CLOSEW 44746 . 45520) (\CLOSEW1 45522 .
45875) (\OKTOCLOSEW 45877 . 46236) (\INTERACTIVE.CLOSEW 46238 . 47061) (OPENW 47063 . 48118) (
DOUSERFNS 48120 . 49281) (DOUSERFNS2 49283 . 49779) (\USERFNISDON'T 49781 . 50052) (\OPENW1 50054 .
50404) (CREATEW 50406 . 51670) (CREATEW1 51672 . 53950) (\CREATEW1 53952 . 55171) (OPENDISPLAYSTREAM
55173 . 55496) (MOVEW 55498 . 55713) (PPROMPT3 55715 . 56043) (\ONSCREENCLIPPINGREGION 56045 . 56596)
(RELMOVEW 56598 . 56896) (SHAPEW 56898 . 61817) (SHAPEW1 61819 . 64521) (\SHAPEW2 64523 . 67209) (
RESHOWBORDER 67211 . 67722) (\RESHOWBORDER1 67724 . 72650) (TRACKW 72652 . 73767) (SNAPW 73769 . 75442
) (WINDOWREGION 75444 . 75935)) (75938 76634 (MINIMUMWINDOWSIZE 75948 . 76632)) (78281 101546 (
ADVISEWDS 78291 . 86234) (SHOWWFRAME 86236 . 87988) (SHOWWTITLE 87990 . 92024) (\STRINGWIDTHGUESS
92026 . 92385) (RESHOWTITLE 92387 . 97028) (TOTOPW 97030 . 97269) (\INTERNALTOTOPW 97271 . 98361) (
\TTW1 98363 . 100963) (WHICHW 100965 . 101544)) (101675 104661 (WFROMDS 101685 . 103831) (NU\TOTOPWDS
103833 . 104269) (\COERCETODS 104271 . 104659)) (105304 112104 (WINDOWP 105314 . 105460) (
INSURE.WINDOW 105462 . 105801) (WINDOWPROP 105803 . 106235) (WINDOWADDPROP 106237 . 107971) (
WINDOWDELPROP 107973 . 108399) (GETWINDOWPROP 108401 . 108951) (GETWINDOWUSERPROP 108953 . 109380) (
PUTWINDOWPROP 109382 . 109847) (REMWINDOWPROP 109849 . 110904) (WINDOWADDFNPROP 110906 . 112102)) (
112308 119872 (CWINDOWPROP 112318 . 113323) (CGETWINDOWPROP 113325 . 118543) (\GETWINDOWHEIGHT 118545
. 119453) (\GETWINDOWWIDTH 119455 . 119870)) (119873 120532 (WINDOW.BITMAP 119883 . 120530)) (120558
136006 (OPENWP 120568 . 120846) (TOPWP 120848 . 121131) (RESHAPEBYREPAINTFN 121133 . 131385) (
\INBETWEENP 131387 . 131603) (DECODE/WINDOW/OR/DISPLAYSTREAM 131605 . 133645) (GROW/REGION 133647 .
134210) (CLRPROMPT 134212 . 134616) (PROMPTPRINT 134618 . 134882) (OPENWINDOWS 134884 . 135668) (
\INSUREWINDOW 135670 . 136004)) (136137 139386 (OVERLAPPINGWINDOWS 136147 . 138429) (WOVERLAPP 138431
. 138686) (ORDERFROMBOTTOMTOTOP 138688 . 139384)) (139435 144218 (\ONSCREENW 139445 . 140151) (
\PUTONSCREENW 140153 . 140980) (\UPDATECACHEDFIELDS 140982 . 141246) (\WWCHANGESCREENSIZE 141248 .
142637) (CREATEWFROMIMAGE 142639 . 143602) (UPDATEWFROMIMAGE 143604 . 144216)) (144775 197377 (
\MEDW.CREATEW 144785 . 149459) (\MEDW.OPENW 149461 . 151819) (\MEDW.CLOSEW 151821 . 153187) (
\MEDW.MOVEW 153189 . 163801) (\MEDW.RELMOVEW 163803 . 164182) (\MEDW.SHRINKW 164184 . 172368) (
\MEDW.EXPANDW 172370 . 174637) (\MEDW.SHAPEW 174639 . 179245) (\MEDW.REDISPLAYW 179247 . 181202) (
\MEDW.BURYW 181204 . 182486) (\MEDW.TOTOPW 182488 . 183836) (\MEDW.DSPCREATE 183838 . 184639) (
\GENERIC.DSPCREATE 184641 . 186358) (\GENERIC.DSPCREATE.DESTINATION.BITMAP? 186360 . 186546) (
\MEDW.GETWINDOWPROP 186548 . 188786) (\MEDW.PUTWINDOWPROP 188788 . 195573) (\MEDW.CURSOR 195575 .
197375)) (197378 197998 (\GENERIC.CURSOR 197388 . 197996)))))
STOP

BIN
sources/WINDOW.LCOM
View File

Binary file not shown.

32
sources/WINDOWOBJ
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "17-Jul-2024 21:54:38" {WMEDLEY}<sources>WINDOWOBJ.;27 32550
(FILECREATED " 4-Sep-2024 20:52:28" {WMEDLEY}<sources>WINDOWOBJ.;29 32954
:EDIT-BY rmk
:CHANGES-TO (FNS IMAGEFNSCREATE)
:CHANGES-TO (FNS COPYINSERT)
:PREVIOUS-DATE "23-Apr-2024 18:08:13" {WMEDLEY}<sources>WINDOWOBJ.;26)
:PREVIOUS-DATE "27-Aug-2024 11:51:24" {WMEDLEY}<sources>WINDOWOBJ.;28)
(PRETTYCOMPRINT WINDOWOBJCOMS)
@@ -97,16 +97,24 @@
(COPYINSERT
[LAMBDA (IMAGEOBJ)
(* ;; "Edited 4-Sep-2024 20:52 by rmk")
(* ;; "Edited 27-Aug-2024 11:09 by rmk")
(* ;; "Edited 20-Dec-2021 23:47 by rmk: IMAGEOBJ can now also be a list of objects in the COPYINSERTFN case")
(* ;; "Edited 17-Sep-90 13:19 by jds")
(* ;;; "inserts IMAGEOBJ into the window that currently has the tty. If this window has a COPYINSERTFN property, that is called, otherwise BKSYSBUF is called.")
(PROG ([TTYW (\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS]
(* ;; "RMK: Take the window of the TTY process, if it has one (e.g. Tedit). Otherwise, (old behavior), get (or make) the window associated with the underlying TTY display stream")
(PROG ([TTYW (OR (WINDOWP (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(\INSUREWINDOW (WFROMDS (PROCESS.TTY (TTY.PROCESS]
INSERTFN)
(COND
((SETQ INSERTFN (WINDOWPROP TTYW 'COPYINSERTFN))
([SETQ INSERTFN (AND TTYW (WINDOWPROP TTYW 'COPYINSERTFN]
(for IMOBJ inside IMAGEOBJ do (APPLY* INSERTFN IMOBJ TTYW)))
(T (* ;
 "IMAGEOBJ can be a list of things too.")
@@ -596,11 +604,11 @@ Either delete this image object or load its support files." IMAGEOBJ)
(ADDTOVAR LAMA IMAGEOBJPROP)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (4785 23416 (COPYINSERT 4795 . 6322) (IMAGEBOX 6324 . 6504) (IMAGEFNSCREATE 6506 . 7844)
(IMAGEFNSP 7846 . 8087) (IMAGEOBJCREATE 8089 . 8634) (IMAGEOBJP 8636 . 8877) (IMAGEOBJPROP 8879 .
14771) (\IMAGEUSERPROP 14773 . 15367) (HPRINT.IMAGEOBJ 15369 . 15958) (COPYIMAGEOBJ 15960 . 16703) (
READIMAGEOBJ 16705 . 22062) (WRITEIMAGEOBJ 22064 . 23414)) (23630 32272 (
ENCAPSULATEDOBJ.BUTTONEVENTINFN 23640 . 25423) (ENCAPSULATEDOBJ.PUTFN 25425 . 26540) (
ENCAPSULATEDOBJ.DISPLAYFN 26542 . 28345) (ENCAPSULATEDOBJ.IMAGEBOXFN 28347 . 30523) (ENCAPSULATEDOBJP
30525 . 30833) (ENCAPSULATEDIMAGEFNS 30835 . 32270)))))
(FILEMAP (NIL (4781 23820 (COPYINSERT 4791 . 6726) (IMAGEBOX 6728 . 6908) (IMAGEFNSCREATE 6910 . 8248)
(IMAGEFNSP 8250 . 8491) (IMAGEOBJCREATE 8493 . 9038) (IMAGEOBJP 9040 . 9281) (IMAGEOBJPROP 9283 .
15175) (\IMAGEUSERPROP 15177 . 15771) (HPRINT.IMAGEOBJ 15773 . 16362) (COPYIMAGEOBJ 16364 . 17107) (
READIMAGEOBJ 17109 . 22466) (WRITEIMAGEOBJ 22468 . 23818)) (24034 32676 (
ENCAPSULATEDOBJ.BUTTONEVENTINFN 24044 . 25827) (ENCAPSULATEDOBJ.PUTFN 25829 . 26944) (
ENCAPSULATEDOBJ.DISPLAYFN 26946 . 28749) (ENCAPSULATEDOBJ.IMAGEBOXFN 28751 . 30927) (ENCAPSULATEDOBJP
30929 . 31237) (ENCAPSULATEDIMAGEFNS 31239 . 32674)))))
STOP

BIN
sources/WINDOWOBJ.LCOM
View File

Binary file not shown.